(* Copyright (C) 1992, Digital Equipment Corporation *) (* All rights reserved. *) (* See the file COPYRIGHT for a full description. *) (* File: ProcCheckExpr.m3 *) (* Last Modified On Mon Mar 2 10:54:39 PST 1992 By kalsow *) (* Modified On Fri Feb 15 03:08:03 1991 By muller *) MODULE ProcCheckExpr; IMPORT Expr, ExprRep, Type, Emit, ProcExpr, Temp, MBuf; IMPORT Host, Fault, Value, Procedure; TYPE P = ExprRep.Ta BRANDED "ProcCheckExpr.P" OBJECT OVERRIDES typeOf := TypeOf; check := Check; compile := Compile; evaluate := Fold; fprint := FPrinter; write := ExprRep.NoWriter; isEqual := ExprRep.EqCheckA; getBounds := ExprRep.NoBounds; isWritable := ExprRep.IsNever; isDesignator := ExprRep.IsNever; isZeroes := ExprRep.IsNever; note_write := ExprRep.NotWritable; genLiteral := ExprRep.NoLiteral; END; PROCEDURE New (a: Expr.T): Expr.T = VAR p: P; BEGIN IF (NOT Host.doNarrowChk) THEN RETURN a END; p := NEW (P); ExprRep.Init (p); p.a := a; RETURN p; END New; PROCEDURE TypeOf (p: P): Type.T = BEGIN RETURN Expr.TypeOf (p.a); END TypeOf; PROCEDURE Check (p: P; VAR cs: Expr.CheckState) = BEGIN Expr.TypeCheck (p.a, cs); p.type := Expr.TypeOf (p.a); END Check; PROCEDURE Compile (p: P): Temp.T = VAR t1, t2: Temp.T; BEGIN t1 := Expr.Compile (p.a); t2 := Temp.Alloc (p); Emit.OpTT ("@ = @;\n", t2, t1); Emit.OpT ("if (_IS_CLOSURE (@)) ", t2); Fault.Narrow (); Temp.Free (t1); RETURN t2; END Compile; PROCEDURE Fold (p: P): Expr.T = VAR e: Expr.T; proc: Value.T; BEGIN e := Expr.ConstValue (p.a); IF (e = NIL) THEN RETURN NIL END; IF NOT ProcExpr.Split (e, proc) THEN RETURN NIL END; IF Procedure.IsNested (proc) THEN RETURN NIL END; RETURN e; END Fold; PROCEDURE FPrinter (p: P; map: Type.FPMap; wr: MBuf.T) = BEGIN MBuf.PutText (wr, "CHKP "); Expr.Fingerprint (p.a, map, wr); END FPrinter; BEGIN END ProcCheckExpr.