File: First.m3 Last Modified On Fri Jun 24 12:35:52 PDT 1994 By kalsow Modified On Fri Dec 21 01:35:21 1990 By muller
MODULE; IMPORT CG, CallExpr, Expr, ExprRep, Type, Procedure, Error, ArrayType; IMPORT Int, LInt, EnumType, IntegerExpr, EnumExpr, TypeExpr; IMPORT Reel, LReel, EReel, ReelExpr, Target, TInt; VAR Z: CallExpr.MethodList; PROCEDURE First TypeOf (ce: CallExpr.T): Type.T = VAR e: Expr.T; t, index, element: Type.T; BEGIN e := ce.args[0]; t := Expr.TypeOf (e); index := NIL; IF ArrayType.Split (t, index, element) THEN IF (index = NIL) THEN index := Int.T END; ELSIF TypeExpr.Split (e, t) THEN IF NOT ArrayType.Split (t, index, element) THEN index := t END; END; IF (index = NIL) THEN index := Int.T; END; RETURN Type.Base (index); END TypeOf; PROCEDURECheck (ce: CallExpr.T; <*UNUSED*> VAR cs: Expr.CheckState) = BEGIN DoCheck ("FIRST", ce); END Check; PROCEDUREDoCheck (name: TEXT; ce: CallExpr.T) = VAR e: Expr.T; t, index, element: Type.T; BEGIN e := ce.args[0]; t := Expr.TypeOf (e); IF ArrayType.Split (t, index, element) THEN IF (index = NIL) THEN index := Int.T END; ELSIF TypeExpr.Split (e, t) THEN IF ArrayType.Split (t, index, element) THEN IF (index = NIL) THEN Error.Txt (name, "argument cannot be an open array type"); index := Int.T; END; ELSE index := t; END; ELSE Error.Txt (name, "argument must be a type or array"); index := Int.T; END; IF EnumType.Is (index) THEN IF NOT TInt.LT (TInt.Zero, Type.Number (index)) THEN Error.Txt (name, "empty enumeration type"); END; ELSIF Type.IsOrdinal (index) THEN (* ordinal type => OK*) ELSIF Type.IsEqual (index, Reel.T, NIL) THEN (* OK *) ELSIF Type.IsEqual (index, LReel.T, NIL) THEN (* OK *) ELSIF Type.IsEqual (index, EReel.T, NIL) THEN (* OK *) ELSE Error.Txt (name, "argument must be an ordinal type, floating type, array type or array"); END; ce.type := Type.Base (index); END DoCheck; PROCEDUREPrep (<*UNUSED*> ce: CallExpr.T) = BEGIN (* skip *) END Prep; PROCEDURECompile (ce: CallExpr.T) = VAR e := ce.args[0]; min, max: Target.Int; t, index, element: Type.T; BEGIN IF NOT TypeExpr.Split (e, t) THEN t := Expr.TypeOf (e) END; Type.Compile (t); IF ArrayType.Split (t, index, element) THEN t := index END; IF (t = NIL) THEN (* open array *) CG.Load_integer (Target.Integer.cg_type, TInt.Zero); ELSIF Type.GetBounds (t, min, max) THEN (* ordinal type *) IF Type.IsSubtype (t, LInt.T) THEN CG.Load_integer (Target.Longint.cg_type, min); ELSE CG.Load_integer (Target.Integer.cg_type, min); END; ELSIF Type.IsEqual (t, Reel.T, NIL) THEN CG.Load_float (Target.Real.min); ELSIF Type.IsEqual (t, LReel.T, NIL) THEN CG.Load_float (Target.Longreal.min); ELSIF Type.IsEqual (t, EReel.T, NIL) THEN CG.Load_float (Target.Extended.min); ELSE <* ASSERT FALSE *> END; END Compile; PROCEDUREFold (ce: CallExpr.T): Expr.T = VAR t, index, elem: Type.T; e: Expr.T; BEGIN e := ce.args[0]; IF TypeExpr.Split (e, t) THEN RETURN FirstOfType (t) END; t := Expr.TypeOf (e); IF NOT ArrayType.Split (t, index, elem) THEN RETURN NIL END; RETURN FirstOfType (t); END Fold; PROCEDUREFirstOfType (t: Type.T): Expr.T = VAR min, max: Target.Int; elem, t_base: Type.T; BEGIN IF ArrayType.Split (t, t, elem) AND (t = NIL) THEN RETURN IntegerExpr.New (Int.T, TInt.Zero); END; t_base := Type.Base (t); IF Type.GetBounds (t, min, max) THEN IF t_base = Int.T OR t_base = LInt.T THEN RETURN IntegerExpr.New (t_base, min); ELSE RETURN EnumExpr.New (t, min); END; ELSIF t_base = Reel.T THEN RETURN ReelExpr.New (Target.Real.min); ELSIF t_base = LReel.T THEN RETURN ReelExpr.New (Target.Longreal.min); ELSIF t_base = EReel.T THEN RETURN ReelExpr.New (Target.Extended.min); ELSE RETURN NIL; END; END FirstOfType; PROCEDUREInitialize () = BEGIN Z := CallExpr.NewMethodList (1, 1, TRUE, FALSE, FALSE, NIL, TypeOf, CallExpr.NotAddressable, Check, Prep, Compile, CallExpr.NoLValue, CallExpr.NoLValue, CallExpr.PrepNoBranch, CallExpr.NoBranch, Fold, CallExpr.NoBounds, CallExpr.IsNever, (* writable *) CallExpr.IsNever, (* designator *) CallExpr.NotWritable (* noteWriter *)); Procedure.Define ("FIRST", Z, TRUE); END Initialize; BEGIN END First.