Copyright (C) 1994, Digital Equipment Corp.
File: CallExpr.m3
MODULE CallExpr;
IMPORT CG, Expr, ExprRep, Error, ProcType, Type, UserProc;
IMPORT KeywordExpr, ESet, QualifyExpr, ErrType, Value;
REVEAL
MethodList = BRANDED "CallExpr.MethodList" REF RECORD
minArgs : INTEGER;
maxArgs : INTEGER;
functional : BOOLEAN;
keywords : BOOLEAN;
strict : BOOLEAN;
fixedType : Type.T;
typeOf : Typer;
need_addr : Visitor;
checker : TypeChecker;
prep : Compiler;
compiler : Compiler;
prepLV : CompilerLV;
compilerLV : CompilerLV;
prepBR : CompilerBR;
compilerBR : CompilerBR;
evaluator : Evaluator;
isWritable : Predicate;
isDesignator : Predicate;
noteWriter : NoteWriter;
END;
REVEAL
T = T_ BRANDED "CallExpr.P" OBJECT
methods : MethodList;
proc_type: Type.T;
OVERRIDES
typeOf := TypeOf;
check := Check;
need_addr := NeedsAddress;
prep := Prep;
compile := Compile;
prepLV := PrepLV;
compileLV := CompileLV;
prepBR := PrepBR;
compileBR := CompileBR;
evaluate := Fold;
isEqual := ExprRep.NeverEq;
getBounds := ExprRep.NoBounds;
isWritable := IsWritable;
isDesignator := IsDesignator;
isZeroes := ExprRep.IsNever;
genFPLiteral := ExprRep.NoFPLiteral;
prepLiteral := ExprRep.NoPrepLiteral;
genLiteral := ExprRep.NoLiteral;
note_write := NoteWrites;
END;
PROCEDURE New (proc: Expr.T; args: Expr.List): Expr.T =
VAR p := NEW (T);
BEGIN
ExprRep.Init (p);
p.proc := proc;
p.args := args;
p.tmp := NIL;
p.methods := NIL;
p.proc_type := NIL;
p.direct_ok := TRUE;
RETURN p;
END New;
PROCEDURE Is (e: Expr.T): BOOLEAN =
BEGIN
TYPECASE e OF
| NULL => RETURN FALSE;
| T => RETURN TRUE;
ELSE RETURN FALSE;
END;
END Is;
PROCEDURE IsUserProc (e: Expr.T): BOOLEAN =
BEGIN
TYPECASE e OF
| NULL => RETURN FALSE;
| T(t) => Resolve (t); RETURN (t.methods = UserProc.Methods);
ELSE RETURN FALSE;
END;
END IsUserProc;
PROCEDURE NewMethodList (minArgs, maxArgs: INTEGER;
functional : BOOLEAN;
keywords : BOOLEAN;
strict : BOOLEAN;
fixedType : Type.T;
typeOf : Typer;
need_addr : Visitor;
checker : TypeChecker;
prep : Compiler;
compiler : Compiler;
prepLV : CompilerLV;
compilerLV : CompilerLV;
prepBR : CompilerBR;
compilerBR : CompilerBR;
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.strict := strict;
m.fixedType := fixedType;
m.typeOf := typeOf;
m.need_addr := need_addr;
m.checker := checker;
m.prep := prep;
m.compiler := compiler;
m.prepLV := prepLV;
m.compilerLV := compilerLV;
m.prepBR := prepBR;
m.compilerBR := compilerBR;
m.evaluator := evaluator;
m.isWritable := isWritable;
m.isDesignator := isDesignator;
m.noteWriter := noteWriter;
RETURN m;
END NewMethodList;
PROCEDURE IsNever (<*UNUSED*> t: T): BOOLEAN =
BEGIN
RETURN FALSE;
END IsNever;
PROCEDURE IsAlways (<*UNUSED*> t: T): BOOLEAN =
BEGIN
RETURN TRUE;
END IsAlways;
PROCEDURE NoValue (<*UNUSED*> t: T): Expr.T =
BEGIN
RETURN NIL;
END NoValue;
PROCEDURE NotAddressable (<*UNUSED*> t: T) =
BEGIN
<* ASSERT FALSE *>
END NotAddressable;
PROCEDURE PrepArgs (t: T) =
BEGIN
FOR i := 0 TO LAST (t.args^) DO
Expr.Prep (t.args[i]);
END;
END PrepArgs;
PROCEDURE NoLValue (<*UNUSED*> t: T) =
BEGIN
<*ASSERT FALSE*>
END NoLValue;
PROCEDURE NotBoolean (<*UNUSED*> t: T;
<*UNUSED*> true, false: CG.Label;
<*UNUSED*> freq: CG.Frequency) =
BEGIN
<*ASSERT FALSE*>
END NotBoolean;
PROCEDURE PrepNoBranch (t: T; true, false: CG.Label; freq: CG.Frequency) =
BEGIN
t.prep ();
t.compile ();
IF (true # CG.No_label)
THEN CG.If_true (true, freq);
ELSE CG.If_false (false, freq);
END;
END PrepNoBranch;
PROCEDURE NoBranch (<*UNUSED*> t: T;
<*UNUSED*> true, false: CG.Label;
<*UNUSED*> freq: CG.Frequency) =
BEGIN
(* all the work was done by prep *)
END NoBranch;
PROCEDURE NotWritable (<*UNUSED*> t: T)=
BEGIN
(* skip *)
END NotWritable;
*********************************************************************
PROCEDURE Resolve (p: T) =
VAR t: Type.T;
BEGIN
IF (p.methods # NIL) THEN RETURN END;
t := Expr.TypeOf (p.proc);
IF (t = NIL) THEN
t := QualifyExpr.MethodType (p.proc);
(* we need this hack because "TypeOf(obj.method)" returns NIL
so that you can't use it as a vanilla procedure value. *)
END;
p.methods := ProcType.Methods (t);
p.proc_type := t;
END Resolve;
PROCEDURE TypeOf (p: T): Type.T =
BEGIN
Resolve (p);
IF (p.methods = NIL) THEN
p.type := NIL;
ELSIF (p.methods.fixedType # NIL) OR (p.methods.typeOf = NIL) THEN
p.type := p.methods.fixedType;
ELSE
FixArgs (p);
p.type := p.methods.typeOf (p);
END;
RETURN p.type;
END TypeOf;
PROCEDURE Check (p: T; VAR cs: Expr.CheckState) =
VAR
nErrs0, nErrs1, nWarns: INTEGER;
arg: Expr.T;
keywords: BOOLEAN;
BEGIN
(* check the procedure *)
Error.Count (nErrs0, nWarns);
Expr.TypeCheck (p.proc, cs);
Resolve (p);
Error.Count (nErrs1, nWarns);
IF (p.methods = NIL) AND (nErrs0 = nErrs1) THEN
Error.Msg ("attempting to call a non-procedure" & ProcName (p));
p.type := ErrType.T;
END;
(* check its args *)
keywords := (p.methods = NIL) OR (p.methods.keywords);
FOR i := 0 TO LAST (p.args^) DO
arg := p.args[i];
Expr.TypeCheck (arg, cs);
IF (Expr.TypeOf (arg) = ErrType.T) THEN
p.type := ErrType.T;
ELSIF (NOT keywords) AND KeywordExpr.Is (arg) THEN
Error.Msg ("keyword parameters not allowed on builtin operations" &
ProcName (p));
END;
END;
(* finally, do the procedure specific checking *)
IF (p.type # ErrType.T) AND (p.methods # NIL) THEN
FixArgs (p);
p.methods.checker (p, cs);
END;
(* check the exceptions *)
ESet.NoteExceptions (cs, ProcType.Raises (p.proc_type));
END Check;
PROCEDURE FixArgs (p: T) =
VAR z: Expr.List;
BEGIN
IF (NUMBER (p.args^) < p.methods.minArgs) THEN
Error.Msg ("too few arguments" & ProcName (p));
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" & ProcName (p));
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 ProcName (p: T): TEXT =
VAR v: Value.T;
BEGIN
IF (p.proc # NIL) AND UserProc.IsProcedureLiteral (p.proc, v) THEN
RETURN ": " & Value.GlobalName (v, dots := TRUE, with_module := TRUE);
ELSE
RETURN "";
END;
END ProcName;
PROCEDURE NeedsAddress (p: T) =
BEGIN
IF (p.methods # NIL) THEN
p.methods.need_addr (p);
END;
END NeedsAddress;
PROCEDURE Prep (p: T) =
BEGIN
p.methods.prep (p);
END Prep;
PROCEDURE Compile (p: T) =
BEGIN
p.methods.compiler (p);
END Compile;
PROCEDURE PrepLV (p: T) =
BEGIN
p.methods.prepLV (p);
END PrepLV;
PROCEDURE CompileLV (p: T) =
BEGIN
p.methods.compilerLV (p);
END CompileLV;
PROCEDURE PrepBR (p: T; true, false: CG.Label; freq: CG.Frequency) =
BEGIN
p.methods.prepBR (p, true, false, freq);
END PrepBR;
PROCEDURE CompileBR (p: T; true, false: CG.Label; freq: CG.Frequency) =
BEGIN
p.methods.compilerBR (p, true, false, freq);
END CompileBR;
PROCEDURE NoteWrites (p: T) =
BEGIN
IF p.methods # NIL THEN
p.methods.noteWriter (p);
END;
END NoteWrites;
PROCEDURE Fold (p: T): Expr.T =
BEGIN
Resolve (p);
IF (p.methods = NIL) THEN RETURN NIL END;
RETURN p.methods.evaluator (p);
END Fold;
PROCEDURE IsDesignator (p: T): BOOLEAN =
BEGIN
Resolve (p);
IF p.methods = NIL THEN RETURN FALSE END;
RETURN p.methods.isDesignator (p);
END IsDesignator;
PROCEDURE IsWritable (p: T): BOOLEAN =
BEGIN
Resolve (p);
IF p.methods = NIL THEN RETURN FALSE END;
RETURN p.methods.isWritable (p);
END IsWritable;
BEGIN
END CallExpr.