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

(* File: CallExpr.m3                                           *)
(* Last modified on Tue Jun 30 11:53:15 PDT 1992 by kalsow     *)
(*      modified on Wed Nov  7 01:30:54 1990 by muller         *)

MODULE CallExpr;

IMPORT Expr, ExprRep, Error, ProcType, Procedure, Value, Type, KeywordExpr;
IMPORT ProcExpr, MBuf, Temp, Void, ESet, QualifyExpr;

REVEAL
  MethodList = UNTRACED BRANDED REF RECORD
                 minArgs      : INTEGER;
                 maxArgs      : INTEGER;
                 functional   : BOOLEAN;
                 keywords     : BOOLEAN;
                 fixedType    : Type.T;
                 typeOf       : Typer;
                 checker      : TypeChecker;
                 compiler     : Compiler;
                 evaluator    : Evaluator;
                 isWritable   : Predicate;
                 isDesignator : Predicate;
                 noteWriter   : NoteWriter;
               END;

TYPE
  P = Expr.T BRANDED "CallExpr.P" OBJECT
        proc    : Expr.T;
	args    : Expr.List;
	methods : MethodList;
      OVERRIDES
        typeOf       := TypeOf;
        check        := Check;
        compile      := Compile;
        evaluate     := Fold;
        fprint       := FPrinter;
        write        := ExprRep.NoWriter;
        isEqual      := ExprRep.NeverEq;
        getBounds    := ExprRep.NoBounds;
        isWritable   := IsWritable;
        isDesignator := IsDesignator;
	isZeroes     := ExprRep.IsNever;
	note_write   := NoteWrites;
	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 Is (e: Expr.T): BOOLEAN =
  BEGIN
    TYPECASE e OF
      | NULL => RETURN FALSE;
      | P    => RETURN TRUE;
      ELSE      RETURN FALSE;
    END;   
  END Is;

PROCEDURE NewMethodList (minArgs, maxArgs: INTEGER;
                         functional   : BOOLEAN;
                         keywords     : BOOLEAN;
                         fixedType    : Type.T;
                         typeOf       : Typer;
                         checker      : TypeChecker;
			 compiler     : Compiler;
                         evaluator    : Evaluator;
                         isWritable   : Predicate;
                         isDesignator : Predicate;
                         noteWriter   : NoteWriter): MethodList =
  VAR m: MethodList;
  BEGIN
    m := NEW (MethodList);
    m.minArgs      := minArgs;
    m.maxArgs      := maxArgs;
    m.functional   := functional;
    m.keywords     := keywords;
    m.fixedType    := fixedType;
    m.typeOf       := typeOf;
    m.checker      := checker;
    m.compiler     := compiler;
    m.evaluator    := evaluator;
    m.isWritable   := isWritable;
    m.isDesignator := isDesignator;
    m.noteWriter   := noteWriter;
    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 NotWritable (<*UNUSED*> proc: Expr.T;  
                       <*UNUSED*> args: Expr.List) =
  BEGIN
    (* skip *)
  END NotWritable;

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

PROCEDURE TypeOf (p: P): Type.T =
  VAR t: Type.T;
  BEGIN
    t := Expr.TypeOf (p.proc);
    IF (t = NIL) OR (t = Void.T) THEN t := QualifyExpr.MethodType (p.proc) END;
    p.methods := ProcType.Methods (t);
    IF (p.methods = NIL) THEN RETURN Void.T END;
    IF (p.methods.fixedType # NIL) THEN RETURN p.methods.fixedType END;
    FixArgs (p);
    RETURN p.methods.typeOf (p.proc, p.args);
  END TypeOf;

PROCEDURE Check (p: P;  VAR cs: Expr.CheckState) =
  VAR t: Type.T;  nErrs0, nErrs1, nWarns: INTEGER;  keywords: BOOLEAN;
  BEGIN
    (* check the procedure *)
    Error.Count (nErrs0, nWarns);
    Expr.TypeCheck (p.proc, cs);
    t := Expr.TypeOf (p.proc);
    IF (t = NIL) OR (t = Void.T) THEN t := QualifyExpr.MethodType (p.proc) END;
    p.methods := ProcType.Methods (t);
    Error.Count (nErrs1, nWarns);
    IF (p.methods = NIL) AND (nErrs0 = nErrs1) THEN
      Error.Msg ("attempting to call a non-procedure");
    END;

    (* check its args *)
    keywords := (p.methods = NIL) OR (p.methods.keywords);
    FOR i := 0 TO LAST (p.args^) DO
      Expr.TypeCheck (p.args[i], cs);
      IF (NOT keywords) AND KeywordExpr.Is (p.args[i]) THEN
        Error.Msg ("keyword parameters not allowed on builtin operations");
      END;
    END;

    (* finally, do the procedure specific checking *)
    IF (p.methods # NIL) THEN
      FixArgs (p);
      p.type := p.methods.checker (p.proc, p.args, cs);
    ELSIF (p.type = NIL) THEN
      p.type := Void.T;
    END;

    (* check the exceptions *)
    ESet.NoteExceptions (cs, ProcType.Raises (t));
  END Check;

PROCEDURE FixArgs (p: P) =
  VAR z: Expr.List;
  BEGIN
    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;
  END FixArgs;

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 NoteWrites (p: P) =
  BEGIN
    IF p.methods # NIL THEN
      p.methods.noteWriter (p.proc, p.args);
    END;
  END NoteWrites;

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;
      val := Value.Base (val);
      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.FPMap;  wr: MBuf.T) =
  BEGIN
    MBuf.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.