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

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

MODULE Last;

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

TYPE
  Prec = ReelExpr.Precision;

VAR Z: CallExpr.MethodList;

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

PROCEDURE Compile (<*UNUSED*> proc: Expr.T; args: Expr.List): Temp.T =
  VAR e: Expr.T; t, index, element: Type.T; min, max: INTEGER; x, y: 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);
      y := Expr.Compile (e);
      Emit.OpTT ("@ = @.size[0] - 1;\n", x, y);
      Temp.Free (y);
    ELSIF Type.GetBounds (t, min, max) THEN
      (* ordinal type *)
      IF (max > min) THEN max := 1 END;
      x := Temp.AllocEmpty (Int.T);
      Emit.OpTI ("@ = @;\n", x, max);
    ELSIF Type.IsEqual (t, Reel.T, NIL) THEN
      x := Expr.Compile (RealConstant (Target.MAXREAL, Prec.Short));
    ELSIF Type.IsEqual (t, LReel.T, NIL) THEN
      x := Expr.Compile (RealConstant (Target.MAXLONGREAL, Prec.Long));
    ELSIF Type.IsEqual (t, EReel.T, NIL) THEN
      x := Expr.Compile (RealConstant (Target.MAXEXTENDED, 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;  min, max: INTEGER;
  BEGIN
    e := args[0];
    IF TypeExpr.Split (e, t) THEN RETURN LastOfType (t) END;
    t := Expr.TypeOf (e);
    IF NOT ArrayType.Split (t, index, elem) THEN RETURN NIL END;
    IF (index = NIL) THEN
      (* LAST (open array value) => try for constant open array *)
      e := Expr.ConstValue (e);
      IF (e = NIL) THEN RETURN NIL END;
      IF ArrayExpr.GetBounds (e, min, max)
        THEN RETURN IntegerExpr.New (max);
        ELSE RETURN NIL;
      END;
    END;
    RETURN LastOfType (t);
  END Fold;

PROCEDURE LastOfType (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 NIL;
    END;
    t_base:= Type.Base (t);
    IF Type.GetBounds (t, min, max) THEN
      IF t_base = Int.T
        THEN RETURN IntegerExpr.New (max);
        ELSE RETURN EnumExpr.New (t, max);
      END;
    ELSIF t_base = Reel.T THEN
      RETURN RealConstant (Target.MAXREAL, Prec.Short);
    ELSIF t_base = LReel.T THEN
      RETURN RealConstant (Target.MAXLONGREAL, Prec.Long);
    ELSIF t_base = EReel.T THEN
      RETURN RealConstant (Target.MAXEXTENDED, Prec.Extended);
    ELSE
      RETURN NIL;
    END;
  END LastOfType;

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,
                                 First.TypeOf, Check, Compile, Fold,
                                 CallExpr.IsNever, (* writable *)
                                 CallExpr.IsNever, (* designator *)
                                 CallExpr.NotWritable (* noteWriter *));
    Procedure.Define ("LAST", Z, TRUE);
  END Initialize;

BEGIN
END Last.