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

(* File: SubscriptExpr.m3                                      *)
(* Last modified on Thu Apr  5 00:37:27 1990 by muller         *)
(*      modified on Sat Feb 10 20:13:59 1990 by kalsow         *)


MODULE SubscriptExpr;

IMPORT Expr, ExprAB, ExprRep, ArrayType, Error, Type, Int, Emit;
IMPORT EnumElt, String, ArrayExpr, OpenArray;
IMPORT CheckExpr, SubtractExpr, IntegerExpr, Target;
IMPORT RefType, DerefExpr, Temp, Wr;

TYPE
  P = ExprAB.T OBJECT
      METHODS
        bind         := Bind;
        check        := Check;
        compile      := Compile;
        evaluate     := Fold;
        fprint       := FPrinter;
        write        := Writer;
        isEqual      := ExprAB.EqCheck;
        getBounds    := ExprRep.NoBounds;
        isWritable   := IsWritable;
        isDesignator := IsDesignator;
	isZeroes     := ExprRep.IsNever;
	genLiteral   := ExprRep.NoLiteral;
      END;

PROCEDURE New (a, b: Expr.T): Expr.T =
  VAR p: P;
  BEGIN
    p := NEW (P);
    ExprRep.Init (p);
    p.a := a;
    p.b := b;
    RETURN p;
  END New;

PROCEDURE Bind (p: P) =
  VAR ta, ti, te: Type.T;
  BEGIN
    Expr.Bind (p.a);
    Expr.Bind (p.b);
    ta := Type.Base (Expr.TypeOf (p.a));

    IF RefType.Is (ta) THEN
      (* auto-magic dereference *)
      p.a := DerefExpr.New (p.a);
      Expr.Bind (p.a);
      ta := Type.Base (Expr.TypeOf (p.a));
    END;

    IF ArrayType.Split (ta, ti, te)
      THEN p.type := te;
      ELSE p.type := Int.T;
    END;
  END Bind;

PROCEDURE Check (p: P) =
  VAR ta, tb, ti, te: Type.T;  mini, maxi, minb, maxb: INTEGER;
  BEGIN
    Expr.TypeCheck (p.a);
    Expr.TypeCheck (p.b);
    ta := Type.Base (Expr.TypeOf (p.a));
    tb := Expr.TypeOf (p.b);
    IF  NOT ArrayType.Split (ta, ti, te) THEN
      Error.Msg ("subscripted expression is not an array");
      RETURN ;
    END;
    Type.GetBounds (ti, mini, maxi);
    Expr.GetBounds (p.b, minb, maxb);

    IF (ti = NIL) THEN
      (* a is an open array *)
      IF Type.IsSubtype (tb, Int.T) THEN
        IF (minb < 0) THEN
          p.b := CheckExpr.NewLower (p.b, 0);
          Expr.Bind (p.b);
          Expr.TypeCheck (p.b);
        END;
      ELSE
        Error.Msg ("open arrays must be indexed by integer expressions");
      END;

    ELSIF Type.IsSubtype (tb, Type.Base (ti)) THEN
      (* the index value's type has a common base type with the index type *)
      IF (mini # 0) THEN
        p.b := SubtractExpr.New (p.b, IntegerExpr.New (mini));
        Expr.Bind (p.b);
        Expr.TypeCheck (p.b);
      END;
      IF (minb < mini) AND (maxb > maxi) THEN
        p.b := CheckExpr.New (p.b, 0, maxi - mini);
        Expr.Bind (p.b);
        Expr.TypeCheck (p.b);
      ELSIF (minb < mini) THEN
        p.b := CheckExpr.NewLower (p.b, 0);
        Expr.Bind (p.b);
        Expr.TypeCheck (p.b);
      ELSIF (maxb > maxi) THEN
        p.b := CheckExpr.NewUpper (p.b, maxi - mini);
        Expr.Bind (p.b);
        Expr.TypeCheck (p.b);
      END;

    ELSE
      Error.Msg ("incompatible array index");
    END;
  END Check;

PROCEDURE Compile (p: P): Temp.T =
  VAR ta, ti, te: Type.T;  zz, depth: INTEGER;  t1, t2, t3, t4, t5: Temp.T;
  BEGIN
    ta := Type.Base (Expr.TypeOf (p.a));
    depth := ArrayType.OpenDepth (ta);
    t2 := Expr.Compile (p.a);
    t3 := Expr.Compile (p.b);

    IF (depth = 0) THEN
      (* a is a fixed array *)
      t1 := Temp.AllocMacro (p, TRUE);
      Temp.Depend (t1, t2);
      Temp.Depend (t1, t3);
      RETURN t1;

    ELSIF (depth = 1) THEN
      (* a is a single dimension open array *)
      VAR b: BOOLEAN := ArrayType.Split (ta, ti, te);
      BEGIN <* ASSERT b *> END;
      t5 := Temp.AllocEmpty (Int.T);
      t4 := Temp.Alloc (p.b);
      zz := Type.Name (ArrayType.OpenImpl (ta));
      Emit.OpIT ("{\001\nregister t@* array = & @;\n", zz, t2);
      Emit.OpTT ("@ = @;\n", t4, t3);
      Emit.OpT ("if (@ >= (array->size[0])) RANGEFAULT;\n", t4);
      Emit.OpT ("@ = (int)", t5);
      Emit.OpTI ("(array->elts + (@ * @));\n", t4, 
		 Type.Size (te) DIV Target.CHARSIZE);
      Emit.Op ("\002};\n");
      Temp.Free (t2);
      Temp.Free (t3);
      Temp.Free (t4);
      t1 := Temp.AllocMacro (p, TRUE);
      Temp.Depend (t1, t5);
      RETURN t1;

    ELSE
      (* a is a multi-dimensional open array *)
      VAR b: BOOLEAN := ArrayType.Split (ta, ti, te);
      BEGIN <* ASSERT b *> END;
      t1 := Temp.AllocEmpty (ArrayType.OpenImpl (te), TRUE);
      t4 := Temp.Alloc (p.b);
      zz := Type.Name (ArrayType.OpenImpl (ta));
      Emit.OpIT ("{\001\nregister t@* array = & @;\n", zz, t2);
      Emit.OpTT ("@ = @;\n", t4, t3);
      Emit.OpT ("if (@ >= (array->size[0])) RANGEFAULT;\n", t4);
      FOR i := 1 TO depth - 1 DO
        Emit.OpTI ("@.size[@] = ", t1, i - 1);
        Emit.OpI ("array->size[@];\n", i);
      END;
      Emit.OpTT ("@.elts = array->elts + (@ * ", t1, t4);
      FOR i := 1 TO depth - 1 DO
        Emit.OpI ("(array->size[@]) * ", i);
        VAR b: BOOLEAN := ArrayType.Split (Type.Base (te), ti, te);
        BEGIN <* ASSERT b AND ti = NIL *> END;
      END;
      Emit.OpI ("@);\n", Type.Size (te) DIV Target.CHARSIZE);
      Emit.Op ("\002};\n");
      Temp.Free (t2);
      Temp.Free (t3);
      Temp.Free (t4);
      RETURN t1;
    END;
  END Compile;

PROCEDURE Writer (p: P;  t1, t2: Temp.T) =
  VAR ta: Type.T;  depth: INTEGER;
  BEGIN
    ta := Type.Base (Expr.TypeOf (p.a));
    depth := ArrayType.OpenDepth (ta);
    IF (depth = 0) THEN
      Emit.OpTT ("(@.elts[@])", t1, t2);
    ELSIF (depth = 1) THEN
      Emit.OpIT ("(*(t@*)@)", Type.Name (p.type), t1);
    ELSE
      <* ASSERT FALSE *>
    END;
  END Writer;

PROCEDURE IsDesignator (p: P): BOOLEAN =
  BEGIN
    RETURN Expr.IsDesignator (p.a);
  END IsDesignator;

PROCEDURE IsWritable (p: P): BOOLEAN =
  BEGIN
    RETURN Expr.IsWritable (p.a);
  END IsWritable;

PROCEDURE Fold (p: P): Expr.T =
  VAR e1, e2, e3: Expr.T;
  BEGIN
    e1 := Expr.ConstValue (p.a);
    e2 := Expr.ConstValue (p.b);
    e3 := NIL;
    IF    (e1 = NIL) OR (e2 = NIL) THEN
    ELSIF ArrayExpr.Subscript (e1, e2, e3) THEN
    END;
    RETURN e3;
  END Fold;

PROCEDURE FPrinter (p: P;  map: Type.Map;  wr: Wr.T) =
  BEGIN
    Wr.PutText (wr, "[] ");
    Expr.Fingerprint (p.a, map, wr);
    Expr.Fingerprint (p.b, map, wr);
  END FPrinter;

BEGIN
END SubscriptExpr.