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

(* File: First.m3                                              *)
(* Last Modified On Tue Jun 30 08:51:36 PDT 1992 By kalsow     *)
(*      Modified On Fri Dec 21 01:35:21 1990 By muller         *)

MODULE First;

IMPORT CallExpr, Expr, Type, Procedure, Emit, Error, ArrayType, TypeExpr;
IMPORT Int, EnumType, IntegerExpr, EnumExpr, Temp;
IMPORT Reel, LReel, EReel, ReelExpr, Target, String;

TYPE
  Prec = ReelExpr.Precision;

VAR Z: CallExpr.MethodList;

PROCEDURE TypeOf (<*UNUSED*> proc: Expr.T;  VAR args: Expr.List): Type.T =
  VAR e: Expr.T;  t, index, element: Type.T;
  BEGIN
    e := 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;

PROCEDURE Check (<*UNUSED*> proc: Expr.T; VAR args: Expr.List;  <*UNUSED*> VAR cs: Expr.CheckState): Type.T =
  BEGIN
    RETURN DoCheck ("FIRST", args);
  END Check;

PROCEDURE DoCheck (name: TEXT; args: Expr.List): Type.T =
  VAR e: Expr.T; t, index, element: Type.T;
  BEGIN
    e := 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.ID (name, "argument cannot be an open array type");
          index := Int.T;
        END;
      ELSE
        index := t;
      END;
    ELSE
      Error.ID (name, "argument must be a type or array");
      index := Int.T;
    END;
    IF EnumType.Is (index) THEN
      IF (Type.Number (index) <= 0) THEN
        Error.ID (name, "empty enumeration type");
      END;
    ELSIF Type.Number  (index) >= 0          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.ID (name, "argument must be an ordinal type, floating type, array type or array");
    END;
    RETURN Type.Base (index);
  END DoCheck;

PROCEDURE Compile (<*UNUSED*> proc: Expr.T; args: Expr.List): Temp.T =
  VAR e: Expr.T; min, max: INTEGER; t, index, element: Type.T;  x: Temp.T;
  BEGIN
    e := args[0];
    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 *)
      x := Temp.AllocEmpty (Int.T);
      Emit.OpT ("@ = 0;\n", x);
    ELSIF Type.GetBounds (t, min, max) THEN
      (* ordinal type *)
      x := Temp.AllocEmpty (Int.T);
      Emit.OpTI ("@ = @;\n", x, min);
    ELSIF Type.IsEqual (t, Reel.T, NIL) THEN
      x := Expr.Compile (RealConstant (Target.MINREAL, Prec.Short));
    ELSIF Type.IsEqual (t, LReel.T, NIL) THEN
      x := Expr.Compile (RealConstant (Target.MINLONGREAL, Prec.Long));
    ELSIF Type.IsEqual (t, EReel.T, NIL) THEN
      x := Expr.Compile (RealConstant (Target.MINEXTENDED, Prec.Extended));
    ELSE
      <* ASSERT FALSE *>
    END;
    
    RETURN x;
  END Compile;

PROCEDURE Fold (<*UNUSED*> proc: Expr.T; args: Expr.List): Expr.T =
  VAR t, index, elem: Type.T;  e: Expr.T;
  BEGIN
    e := 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;

PROCEDURE FirstOfType (t: Type.T): Expr.T =
  VAR min, max: INTEGER;  elem, t_base: Type.T;
  BEGIN
    IF ArrayType.Split (t, t, elem) AND (t = NIL) THEN
      RETURN IntegerExpr.New (0);
    END;
    t_base := Type.Base (t);
    IF Type.GetBounds (t, min, max) THEN
      IF t_base = Int.T
        THEN RETURN IntegerExpr.New (min);
        ELSE RETURN EnumExpr.New (t, min);
      END;
    ELSIF t_base = Reel.T THEN
      RETURN RealConstant (Target.MINREAL, Prec.Short);
    ELSIF t_base = LReel.T THEN
      RETURN RealConstant (Target.MINLONGREAL, Prec.Long);
    ELSIF t_base = EReel.T THEN
      RETURN RealConstant (Target.MINEXTENDED, Prec.Extended);
    ELSE
      RETURN NIL;
    END;
  END FirstOfType;

PROCEDURE RealConstant (val: TEXT;  pre: ReelExpr.Precision): Expr.T =
  BEGIN
    RETURN ReelExpr.New (String.Add (val), pre);
  END RealConstant;

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

BEGIN
END First.