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

(* File: Val.m3                                                *)
(* Last Modified On Tue Jun 30 08:55:34 PDT 1992 By kalsow     *)
(*      Modified On Fri Dec 21 01:18:57 1990 By muller         *)

MODULE Val;

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

VAR Z: CallExpr.MethodList;

PROCEDURE TypeOf (<*UNUSED*> proc: Expr.T; VAR 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 TypeOf;

PROCEDURE Check (<*UNUSED*> proc: Expr.T; VAR args: Expr.List;  VAR cs: Expr.CheckState): Type.T =
  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 *)
      EVAL Type.GetBounds (t, mint, maxt);
      EVAL 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.TypeCheck (args[0], cs);
      ELSIF (mint <= minu) AND (maxt < maxu) THEN
        args[0] := CheckExpr.NewUpper (args[0], maxt);
        Expr.TypeCheck (args[0], cs);
      ELSE (* minu < mint  AND  maxt < maxu  *)
        args[0] := CheckExpr.New (args[0], mint, maxt);
        Expr.TypeCheck (args[0], cs);
      END;
    END;
    RETURN t;
  END Check;

PROCEDURE Compile (<*UNUSED*> proc: Expr.T; args: Expr.List): Temp.T =
  VAR t: Type.T;
  BEGIN
    IF TypeExpr.Split (args[1], t) THEN Type.Compile (t) END;
    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;
    EVAL Type.GetBounds (t, min, max);
    IF (x < min) OR (max < x) THEN
      Error.Msg ("VAL: value out of range");
      RETURN NIL;
    END;
    t := Type.Base (t);
    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, FALSE, NIL,
                                 TypeOf, Check, Compile, Fold,
                                 CallExpr.IsNever, (* writable *)
                                 CallExpr.IsNever, (* designator *)
                                 CallExpr.NotWritable (* noteWriter *));
    Procedure.Define ("VAL", Z, TRUE);
  END Initialize;

BEGIN
END Val.