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

(* File: Val.m3                                                *)
(* Last Modified On Tue Mar 20 03:24:22 1990 By muller         *)
(*      Modified On Fri Jul  7 13:45:16 1989 By kalsow         *)

MODULE Val;

IMPORT CallExpr, Expr, Type, Procedure, Error, TypeExpr, Int;
IMPORT VarExpr, IntegerExpr, EnumExpr, EnumType, Temp, CheckExpr;

VAR
  Z: CallExpr.MethodList;


PROCEDURE Bind (<*UNUSED*> proc: Expr.T; args: Expr.List): Type.T =
  VAR t: Type.T;
  BEGIN
    IF TypeExpr.Split (args[1], t) THEN RETURN t;  ELSE RETURN Int.T;  END;
  END Bind;

PROCEDURE Check (<*UNUSED*> proc: Expr.T; VAR args: Expr.List) =
  VAR t, u: Type.T; mint, maxt, minu, maxu: INTEGER;
  BEGIN
    u := Expr.TypeOf (args[0]);
    t := Int.T;
    IF  NOT Type.IsSubtype (u, Int.T) THEN
      Error.Msg ("VAL: first argument must be an INTEGER");
    ELSIF  NOT TypeExpr.Split (args[1], t) THEN
      Error.Msg ("VAL: second argument must be a type");
    ELSIF  NOT (Type.Number (t) >= 0) THEN
      Error.Msg ("VAL: second argument must be an ordinal type");
    ELSE (* looks ok *)
      Type.GetBounds (t, mint, maxt);
      Type.GetBounds (u, minu, maxu);
      IF (mint <= minu) AND (maxu <= maxt) THEN
        (* ok => no runtime check *)
      ELSIF (minu < mint) AND (maxu <= maxt) THEN
        args[0] := CheckExpr.NewLower (args[0], mint);
        Expr.Bind (args[0]);
        Expr.TypeCheck (args[0]);
      ELSIF (mint <= minu) AND (maxt < maxu) THEN
        args[0] := CheckExpr.NewUpper (args[0], maxt);
        Expr.Bind (args[0]);
        Expr.TypeCheck (args[0]);
      ELSE (* minu < mint  AND  maxt < maxu  *)
        args[0] := CheckExpr.New (args[0], mint, maxt);
        Expr.Bind (args[0]);
        Expr.TypeCheck (args[0]);
      END;
    END;
  END Check;

PROCEDURE Compile (<*UNUSED*> proc: Expr.T; args: Expr.List): Temp.T =
  BEGIN
    RETURN Expr.Compile (args[0]);
  END Compile;

PROCEDURE Fold (<*UNUSED*> proc: Expr.T; args: Expr.List): Expr.T =
  VAR t: Type.T; e: Expr.T; x, min, max: INTEGER;
  BEGIN
    e := Expr.ConstValue (args[0]);
    IF (e = NIL) OR ( NOT IntegerExpr.Split (e, x))
      OR ( NOT TypeExpr.Split (args[1], t)) THEN
      RETURN NIL;
    END;
    t := Type.Base (t);
    Type.GetBounds (t, min, max);
    IF (x < min) OR (max < x) THEN
      Error.Msg ("VAL: value out of range");
      RETURN NIL;
    END;
    IF EnumType.Is (t)
      THEN RETURN EnumExpr.New (t, x);
      ELSE RETURN IntegerExpr.New (x);
    END;
  END Fold;

PROCEDURE Initialize () =
  BEGIN
    Z := CallExpr.NewMethodList (2, 2, TRUE, Bind, Check, Compile, Fold,
                                 CallExpr.IsNever, (* writable *)
                                 CallExpr.IsNever(* designator *));
    Procedure.Define ("VAL", Z);
  END Initialize;

BEGIN
END Val.