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

(* File: First.m3                                              *)
(* Last Modified On Tue Mar 20 03:08:49 1990 By muller         *)
(*      Modified On Wed Jul 26 09:49:58 1989 By kalsow         *)

MODULE First;

IMPORT CallExpr, Expr, Type, Procedure, Emit, Error, ArrayType, TypeExpr;
IMPORT Int, EnumType, IntegerExpr, Temp, Text;

VAR
  Z: CallExpr.MethodList;


PROCEDURE Bind (<*UNUSED*> proc: Expr.T; args: Expr.List): Type.T =
  BEGIN
    RETURN DoBind (args);
  END Bind;

PROCEDURE DoBind (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 index := Int.T END;
      ELSE
        index := t;
      END;
    ELSE
      index := Int.T;
    END;
    RETURN index;
  END DoBind;

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

PROCEDURE DoCheck (name: Text.T; args: Expr.List) =
  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
      Error.ID (name,
                "argument must be an ordinal type, array type or array");
    END;
  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;
    IF ArrayType.Split (t, index, element) THEN t := index END;
    Type.GetBounds (t, min, max);
    IF (t = NIL) THEN min := 0 END;
    x := Temp.AllocEmpty (Int.T);
    Emit.OpTI ("@ = @;\n", x, min);
    RETURN x;
  END Compile;

PROCEDURE Fold (<*UNUSED*> proc: Expr.T; args: Expr.List): Expr.T =
  VAR t, elem: Type.T; min, max: INTEGER;
  BEGIN
    IF TypeExpr.Split (args[0], t) THEN
      IF ArrayType.Split (t, t, elem) AND (t = NIL) THEN RETURN NIL END;
    ELSE
      IF ArrayType.Split (Expr.TypeOf (args[0]), t, elem) THEN
        IF (t = NIL) THEN RETURN IntegerExpr.New (0) END;
      ELSE (* expr is not an array *)
        RETURN NIL;
      END;
    END;
    Type.GetBounds (t, min, max);
    RETURN IntegerExpr.New (min);
  END Fold;

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

BEGIN
END First.