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

(* File: Narrow.m3                                             *)
(* Last Modified On Tue Jun 30 09:38:29 PDT 1992 By kalsow     *)
(*      Modified On Sat Dec  8 00:54:20 1990 By muller         *)

MODULE Narrow;

IMPORT CallExpr, Expr, Type, Error, TypeExpr, NarrowExpr;
IMPORT Temp, Procedure;

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 Expr.TypeOf (args[0]);
    END;
  END TypeOf;

PROCEDURE Check (<*UNUSED*> proc: Expr.T; VAR args: Expr.List;  VAR cs: Expr.CheckState): Type.T =
  VAR t: Type.T;
  BEGIN
    IF NOT TypeExpr.Split (args[1], t) THEN
      Error.Msg ("NARROW: second argument must be a type");
      RETURN Expr.TypeOf (args[0]);
    END;
    args[0] := NarrowExpr.New (args[0], t, implicit := FALSE);
    Expr.TypeCheck (args[0], cs);
    RETURN t;
  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 =
  BEGIN
    RETURN Expr.ConstValue (args[0]);
  END Fold;

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

PROCEDURE Initialize () =
  BEGIN
    Z := CallExpr.NewMethodList (2, 2, TRUE, FALSE, NIL,
                                 TypeOf, Check, Compile, Fold,
                                 CallExpr.IsNever, (* writable *)
                                 CallExpr.IsNever, (* designator *)
                                 NoteWrites);
    Procedure.Define ("NARROW", Z, TRUE);
  END Initialize;

BEGIN
END Narrow.