File: CallExpr.m3 Last modified on Tue Jun 20 15:09:15 PDT 1995 by kalsow modified on Thu Jun 15 11:11:20 PDT 1995 by ericv modified on Wed Nov 7 01:30:54 1990 by muller
MODULE*********************************************************************; IMPORT CG, Expr, ExprRep, Error, ProcType, Type, UserProc; IMPORT KeywordExpr, ESet, QualifyExpr, ErrType, Value, Target; 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; bounder : Bounder; isWritable : Predicate; isDesignator : Predicate; noteWriter : NoteWriter; isIndirect : Predicate; 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 := GetBounds; isWritable := IsWritable; isDesignator := IsDesignator; isZeroes := ExprRep.IsNever; genFPLiteral := ExprRep.NoFPLiteral; prepLiteral := ExprRep.NoPrepLiteral; genLiteral := ExprRep.NoLiteral; note_write := NoteWrites; END; PROCEDURE CallExpr 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; PROCEDUREIs (e: Expr.T): BOOLEAN = BEGIN TYPECASE e OF | NULL => RETURN FALSE; | T => RETURN TRUE; ELSE RETURN FALSE; END; END Is; PROCEDUREIsUserProc (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; PROCEDURENewMethodList (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; bounder : Bounder; 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.bounder := bounder; m.isWritable := isWritable; m.isDesignator := isDesignator; m.noteWriter := noteWriter; RETURN m; END NewMethodList; PROCEDUREIsNever (<*UNUSED*> t: T; <*UNUSED*> lhs: BOOLEAN): BOOLEAN = BEGIN RETURN FALSE; END IsNever; PROCEDUREIsAlways (<*UNUSED*> t: T): BOOLEAN = BEGIN RETURN TRUE; END IsAlways; PROCEDURENoValue (<*UNUSED*> t: T): Expr.T = BEGIN RETURN NIL; END NoValue; PROCEDURENoBounds (t: T; VAR min, max: Target.Int) = BEGIN ExprRep.NoBounds (t, min, max); END NoBounds; PROCEDURENotAddressable (<*UNUSED*> t: T) = BEGIN <* ASSERT FALSE *> END NotAddressable; PROCEDUREPrepArgs (t: T) = BEGIN FOR i := 0 TO LAST (t.args^) DO Expr.Prep (t.args[i]); END; END PrepArgs; PROCEDURENoLValue (<*UNUSED*> t: T; <*UNUSED*> traced: BOOLEAN) = BEGIN <*ASSERT FALSE*> END NoLValue; PROCEDURENotBoolean (<*UNUSED*> t: T; <*UNUSED*> true, false: CG.Label; <*UNUSED*> freq: CG.Frequency) = BEGIN <*ASSERT FALSE*> END NotBoolean; PROCEDUREPrepNoBranch (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; PROCEDURENoBranch (<*UNUSED*> t: T; <*UNUSED*> true, false: CG.Label; <*UNUSED*> freq: CG.Frequency) = BEGIN (* all the work was done by prep *) END NoBranch; PROCEDURENotWritable (<*UNUSED*> t: T)= BEGIN (* skip *) END NotWritable;
PROCEDUREResolve (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; PROCEDURETypeOf (p: T): Type.T = BEGIN Resolve (p); IF (p.methods = NIL) THEN p.type := ErrType.T; 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; PROCEDURECheck (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) THEN IF (nErrs0 = nErrs1) AND (Expr.TypeOf (p.proc) # ErrType.T) THEN Error.Msg ("attempting to call a non-procedure" & ProcName (p)); END; 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; PROCEDUREFixArgs (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; PROCEDUREProcName (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; PROCEDURENeedsAddress (p: T) = BEGIN IF (p.methods # NIL) THEN p.methods.need_addr (p); END; END NeedsAddress; PROCEDUREPrep (p: T) = BEGIN p.methods.prep (p); END Prep; PROCEDURECompile (p: T) = BEGIN p.methods.compiler (p); END Compile; PROCEDUREPrepLV (p: T; traced: BOOLEAN) = BEGIN p.methods.prepLV (p, traced); END PrepLV; PROCEDURECompileLV (p: T; traced: BOOLEAN) = BEGIN p.methods.compilerLV (p, traced); END CompileLV; PROCEDUREPrepBR (p: T; true, false: CG.Label; freq: CG.Frequency) = BEGIN p.methods.prepBR (p, true, false, freq); END PrepBR; PROCEDURECompileBR (p: T; true, false: CG.Label; freq: CG.Frequency) = BEGIN p.methods.compilerBR (p, true, false, freq); END CompileBR; PROCEDURENoteWrites (p: T) = BEGIN IF p.methods # NIL THEN p.methods.noteWriter (p); END; END NoteWrites; PROCEDUREFold (p: T): Expr.T = BEGIN Resolve (p); IF (p.methods = NIL) THEN RETURN NIL END; RETURN p.methods.evaluator (p); END Fold; PROCEDUREGetBounds (p: T; VAR min, max: Target.Int) = VAR e := Fold (p); BEGIN IF (e # NIL) AND (e # p) THEN Expr.GetBounds (e, min, max); ELSIF (p.methods = NIL) THEN ExprRep.NoBounds (p, min, max); ELSE p.methods.bounder (p, min, max); END; END GetBounds; PROCEDUREIsDesignator (p: T; <*UNUSED*> lhs: BOOLEAN): BOOLEAN = BEGIN Resolve (p); IF p.methods = NIL THEN RETURN FALSE END; RETURN p.methods.isDesignator (p); END IsDesignator; PROCEDUREIsWritable (p: T; lhs: BOOLEAN): BOOLEAN = BEGIN Resolve (p); IF p.methods = NIL THEN RETURN FALSE END; RETURN p.methods.isWritable (p, lhs); END IsWritable; BEGIN END CallExpr.