(* Copyright (C) 1989, Digital Equipment Corporation           *)
(* All rights reserved.                                        *)
(* See the file COPYRIGHT for a full description.              *)

(* File: CallExpr.m3                                           *)
(* Last modified on Fri Jun 15 23:51:34 1990 by muller         *)
(*      modified on Sat Feb 10 17:31:12 1990 by kalsow         *)


MODULE CallExpr;

IMPORT Expr, ExprRep, Error, ProcType, Procedure, Value, Type;
IMPORT NamedType, ProcExpr, Wr, Temp, Void, NamedExpr, String;

REVEAL
  MethodList = UNTRACED BRANDED REF RECORD
                 minArgs      : INTEGER;
                 maxArgs      : INTEGER;
                 functional   : BOOLEAN;
                 binder       : Binder;
                 checker      : TypeChecker;
                 compiler     : Compiler;
                 evaluator    : Evaluator;
                 isWritable   : Predicate;
                 isDesignator : Predicate;
               END;

TYPE
  P = Expr.T OBJECT
        proc    : Expr.T;
	args    : Expr.List;
	methods : MethodList;
      METHODS
        bind         := Bind;
        check        := Check;
        compile      := Compile;
        evaluate     := Fold;
        fprint       := FPrinter;
        write        := ExprRep.NoWriter;
        isEqual      := ExprRep.NeverEq;
        getBounds    := ExprRep.NoBounds;
        isWritable   := IsWritable;
        isDesignator := IsDesignator;
	isZeroes     := ExprRep.IsNever;
	genLiteral   := ExprRep.NoLiteral;
      END;

PROCEDURE New (proc: Expr.T;  args: Expr.List): Expr.T =
  VAR p: P;
  BEGIN
    p := NEW (P);
    ExprRep.Init (p);
    p.proc    := proc;
    p.args    := args;
    p.methods := NIL;
    RETURN p;
  END New;

PROCEDURE NewMethodList (minArgs, maxArgs: INTEGER;
                         functional: BOOLEAN;
			 binder       : Binder;
                         checker      : TypeChecker;
			 compiler     : Compiler;
                         evaluator    : Evaluator;
                         isWritable   : Predicate;
                         isDesignator : Predicate): MethodList =
  VAR m: MethodList;
  BEGIN
    m := NEW (MethodList);
    m.minArgs      := minArgs;
    m.maxArgs      := maxArgs;
    m.functional   := functional;
    m.binder       := binder;
    m.checker      := checker;
    m.compiler     := compiler;
    m.evaluator    := evaluator;
    m.isWritable   := isWritable;
    m.isDesignator := isDesignator;
    RETURN m;
  END NewMethodList;

PROCEDURE IsNever (<*UNUSED*> proc: Expr.T;  
                   <*UNUSED*> args: Expr.List): BOOLEAN =
  BEGIN
    RETURN FALSE;
  END IsNever;

PROCEDURE IsAlways (<*UNUSED*> proc: Expr.T;  
                    <*UNUSED*> args: Expr.List): BOOLEAN =
  BEGIN
    RETURN TRUE;
  END IsAlways;

PROCEDURE NoValue (<*UNUSED*> proc: Expr.T;  
                   <*UNUSED*> args: Expr.List): Expr.T =
  BEGIN
    RETURN NIL;
  END NoValue;

(***********************************************************************)

PROCEDURE Bind (p: P) =
  VAR t: Type.T;  z: Expr.List;
  BEGIN
    Expr.Bind (p.proc);
    FOR i := 0 TO LAST (p.args^) DO Expr.Bind (p.args[i]) END;
    t := NamedType.Strip (Expr.TypeOf (p.proc));
    p.methods := ProcType.Methods (t);
    IF (p.methods # NIL) THEN
      IF (NUMBER (p.args^) < p.methods.minArgs) THEN
        Error.Msg ("too few arguments");
        z := NEW (Expr.List, p.methods.minArgs);
        FOR i := 0 TO LAST (p.args^) DO z[i] := p.args[i] END;
        p.args := z;
      ELSIF (NUMBER (p.args^) > p.methods.maxArgs) THEN
        Error.Msg ("too many arguments");
        z := NEW (Expr.List, p.methods.maxArgs);
        FOR i := 0 TO p.methods.maxArgs - 1 DO z[i] := p.args[i] END;
        p.args := z;
      END;
      p.type := p.methods.binder (p.proc, p.args);
    ELSE
      Error.Msg ("attempting to call a non-procedure");
      p.type := Void.T;
    END;
  END Bind;

PROCEDURE Check (p: P) =
  BEGIN
    Expr.TypeCheck (p.proc);
    FOR i := 0 TO LAST (p.args^) DO Expr.TypeCheck (p.args[i]) END;
    IF (p.methods # NIL) THEN p.methods.checker (p.proc, p.args) END;
  END Check;

PROCEDURE Compile (p: P): Temp.T =
  VAR tmp: Temp.T;  e: Expr.T;
  BEGIN
    e := Fold (p);
    IF (e = NIL) THEN
      (* not a constant *)
      tmp := p.methods.compiler (p.proc, p.args);
      IF NOT p.methods.functional THEN Temp.KillValues () END;
    ELSE (* result is a constant *)
      tmp := Expr.Compile (e);
    END;
    RETURN tmp;
  END Compile;

PROCEDURE Fold (p: P): Expr.T =
  VAR proc: Expr.T;  val: Value.T;
  BEGIN
    proc := Expr.ConstValue (p.proc);
    IF (proc = NIL) THEN RETURN NIL END;
    IF (p.methods = NIL) THEN
      IF NOT ProcExpr.Split (proc, val) THEN RETURN NIL END;
      IF (Value.ClassOf (val) # Value.Class.Procedure) THEN RETURN NIL END;
      p.methods := ProcType.Methods (Procedure.Signature (val));
    END;
    IF (p.methods = NIL) THEN RETURN NIL END;
    RETURN p.methods.evaluator (p.proc, p.args);
  END Fold;

PROCEDURE IsDesignator (p: P): BOOLEAN =
  BEGIN
    IF p = NIL OR p.methods = NIL OR p.methods.isDesignator = NIL THEN
      RETURN FALSE;
    END;
    RETURN p.methods.isDesignator (p.proc, p.args);
  END IsDesignator;

PROCEDURE IsWritable (p: P): BOOLEAN =
  BEGIN
    IF p = NIL OR p.methods = NIL OR p.methods.isDesignator = NIL THEN
      RETURN FALSE;
    END;
    RETURN p.methods.isWritable (p.proc, p.args);
  END IsWritable;

PROCEDURE FPrinter (p: P;  map: Type.Map;  wr: Wr.T) =
  BEGIN
    Wr.PutText (wr, "APPLY ");
    Expr.Fingerprint (p.proc, map, wr);
    FOR i := 0 TO LAST (p.args^) DO
      Expr.Fingerprint (p.args[i], map, wr)
    END;
  END FPrinter;

BEGIN
END CallExpr.