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

(* File: Number.m3                                             *)
(* Last Modified On Tue Jun 30 08:54:21 PDT 1992 By kalsow     *)
(*      Modified On Fri Dec 21 01:16:23 1990 By muller         *)

MODULE Number;

IMPORT CallExpr, Expr, Type, Procedure, Card, Error, ArrayExpr, Fault;
IMPORT ArrayType, Emit, TypeExpr, IntegerExpr, Temp, Int, EnumType;

VAR Z: CallExpr.MethodList;

PROCEDURE Check (<*UNUSED*> proc: Expr.T; VAR args: Expr.List;  <*UNUSED*> VAR cs: Expr.CheckState): 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.Msg ("NUMBER: argument cannot be an open array type");
          index := Int.T;
        END;
      ELSE
        index := t;
      END;
    ELSE
      Error.Msg ("NUMBER: argument must be a type or array");
      index := Int.T;
    END;
    IF EnumType.Is (index) THEN
      IF (Type.Number (index) <= 0) THEN
        Error.Msg ("NUMBER: empty enumeration type");
      END;
    ELSIF Type.Number (index) >= 0 THEN (* ordinal type => OK*)
    ELSE
      Error.Msg ("NUMBER: argument must be an ordinal type, floating type, array type or array");
    END;
    RETURN Card.T;
  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; t1, t2: Temp.T;
  BEGIN
    e := args[0];
    t := Expr.TypeOf (e);
    Type.Compile (t);
    t1 := Temp.AllocEmpty (Card.T);
    IF ArrayType.Split (t, index, element) THEN
      IF (index = NIL) THEN
        t2 := Expr.Compile (e);
        Emit.OpTT ("@ = @.size[0];\n", t1, t2);
        Temp.Free (t2);
        RETURN t1;
      END;
    ELSE
      VAR b: BOOLEAN := TypeExpr.Split (e, index);
      BEGIN <* ASSERT b *> END;
      IF ArrayType.Split (index, index, element) THEN END;
    END;
    EVAL Type.GetBounds (index, min, max);
    IF (min > max) THEN max := min - 1 END;
    IF (min <= 0) AND (min + LAST (INTEGER) <= max) THEN
      Error.Warn (2, "result of NUMBER too large");
      Fault.Range ();
    ELSE
      Emit.OpTI ("@ = @;\n", t1, max - min + 1);
    END;
    RETURN t1;
  END Compile;

PROCEDURE Fold (<*UNUSED*> proc: Expr.T; args: Expr.List): Expr.T =
  VAR min, max: INTEGER;  t, index, elem: Type.T;  e: Expr.T;
  BEGIN
    e := args[0];
    IF NOT TypeExpr.Split (e, t) THEN
      t := Expr.TypeOf (e);
      IF NOT ArrayType.Split (t, index, elem) THEN RETURN NIL END;
      IF (index = NIL) THEN
        (* NUMBER (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 - min + 1);
          ELSE RETURN NIL;
        END;
      END;
    END;
    IF ArrayType.Split (t, t, elem) AND (t = NIL) THEN RETURN NIL; END;
    IF NOT Type.GetBounds (t, min, max) THEN RETURN NIL; END;

    IF (min > max) THEN max := min - 1 END;
    IF (min <= 0) AND (min + LAST (INTEGER) <= max) THEN RETURN NIL END;
    RETURN IntegerExpr.New (max - min + 1);
  END Fold;

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

BEGIN
END Number.