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

(* File: ArrayExpr.m3                                          *)
(* Last modified on Tue Oct 13 16:54:50 PDT 1992 by kalsow     *)
(*      modified on Tue Mar 12 00:29:44 1991 by muller         *)

MODULE ArrayExpr;

IMPORT Expr, ExprRep, Error, Type, ArrayType, String, MBuf, Host;
IMPORT KeywordExpr, RangeExpr, Temp, Emit, Int, Target, OpenArrayType;
IMPORT IntegerExpr, EnumExpr, SubrangeType;
IMPORT AssignStmt, RefType, Frame, Fault;

TYPE
  P = Expr.T BRANDED "ArrayExpr.P" OBJECT
        tipe      : Type.T;
	args      : Expr.List;
	dots      : BOOLEAN;
	index     : Type.T;
        uid       : INTEGER;
        refType   : Type.T; (* REF ARRAY OF T for open arrays with runtime
                               determined sizes and shapes *)
        solidType : Type.T; (* ARRAY [0..n-1] OF T for open arrays with
                               compile time determined sizes and shapes *)
      OVERRIDES
        typeOf       := ExprRep.NoType;
        check        := Check;
        compile      := Compile;
        evaluate     := Fold;
        fprint       := FPrinter;
        write        := ExprRep.NoWriter;
        isEqual      := EqCheck;
        getBounds    := ExprRep.NoBounds;
        isWritable   := ExprRep.IsNever;
        isDesignator := ExprRep.IsNever;
	isZeroes     := IsZeroes;
	note_write   := ExprRep.NotWritable;
	genLiteral   := GenLiteral;
      END;

VAR uid := 0;

PROCEDURE New (type: Type.T;  args: Expr.List;  dots: BOOLEAN): Expr.T =
  VAR p := NEW (P);  index, element: Type.T;
  BEGIN
    ExprRep.Init (p);
    IF  NOT ArrayType.Split (type, index, element) THEN
      Error.Msg ("expecting array type on array constructor");
      index := NIL;
    END;
    p.type      := type;
    p.tipe      := type;
    p.index     := index;
    p.args      := args;
    p.dots      := dots;
    p.refType   := NIL;
    p.solidType := NIL;
    RETURN p;
  END New;

PROCEDURE Is (e: Expr.T): BOOLEAN =
  BEGIN
    RETURN (TYPECODE (e) = TYPECODE (P));
  END Is;

PROCEDURE Subscript (array, index: Expr.T;  VAR e: Expr.T): BOOLEAN =
  VAR p: P;  i, n, min, max: INTEGER;  t: Type.T;
  BEGIN
    TYPECASE array OF
    | NULL => RETURN FALSE;
    | P(x) => p := x;
    ELSE      RETURN FALSE;
    END;
    index := Expr.ConstValue (index);
    IF (NOT IntegerExpr.Split (index, i))
      AND (NOT EnumExpr.Split (index, i, t)) THEN
      RETURN FALSE;
    END;
    IF p.index = NIL THEN 
      min := FIRST (p.args^);
      max := LAST (p.args^);
    ELSE
      EVAL Type.GetBounds (p.index, min, max);
    END;
    i := i - min; (* correct for the base index of the array *)
    IF (i < 0)  THEN RETURN FALSE END;
    n := LAST (p.args^);
    IF (i <= n) THEN e := p.args[i]; RETURN TRUE END;
    IF (p.dots) THEN e := p.args[n]; RETURN TRUE END;
    RETURN FALSE;
  END Subscript;

PROCEDURE GetBounds (array: Expr.T; VAR min, max: INTEGER): BOOLEAN =
  BEGIN
    TYPECASE array OF 
    | NULL => RETURN FALSE;
    | P(p) => IF p.index = NIL THEN
                (* open array type *)
                min := FIRST (p.args^);
                max := LAST (p.args^);
                RETURN TRUE;
              ELSE
                RETURN Type.GetBounds (p.index, min, max);
              END;
    ELSE     RETURN FALSE;
    END;
  END GetBounds;

PROCEDURE Check (p: P;  VAR cs: Expr.CheckState) =
  VAR
    n: INTEGER;
    e, value, minE, maxE: Expr.T;
    index, element, solidElt: Type.T;
    key: String.T;
  BEGIN
    Type.Check (p.index);
    Type.Check (p.tipe);
    p.type := p.tipe;
    WITH b = ArrayType.Split (p.tipe, index, element) DO <* ASSERT b *> END;

    n := Type.Number (index);
    IF (index # NIL) THEN
      IF n < NUMBER (p.args^) THEN
        Error.Msg ("too many values specified");
      ELSIF n > NUMBER (p.args^) AND NOT p.dots THEN
        Error.Msg ("not enough values specified");
      END;
    ELSIF (p.dots) THEN
      Error.Warn (1, "\"..\" ignored in open array constructor");
    END;

    FOR i := 0 TO LAST (p.args^) DO
      e := p.args[i];
      Expr.TypeCheck (e, cs);
      IF KeywordExpr.Split (e, key, value) THEN
        Error.Msg ("keyword values not allowed in array constructors");
        e := value;
      END;
      IF RangeExpr.Split (e, minE, maxE) THEN
        Error.Msg ("range values not allowed in array constructors");
        e := value;
      END;

      IF NOT Type.IsAssignable (element, Expr.TypeOf (e)) THEN
        Error.Msg ("expression is not assignable to array element");
      ELSE
        p.args[i] := AssignStmt.CheckRHS (element, e, cs); 
      END;
    END;

    IF (index = NIL) THEN
      INC (uid);  p.uid := uid;

      IF (NUMBER (p.args^) > 0) THEN
        (* try to determine my shape *)
        solidElt := NIL;
        IF Type.Size (element) > 0 THEN
          solidElt := element;
        ELSE
          FOR i := 0 TO LAST (p.args^) DO
            element := Expr.TypeOf (p.args[i]);
            IF (Type.Size (element) > 0) THEN
              (* we found one! *)
              solidElt := element;
              EXIT;
            END;
          END;
        END;
        IF (solidElt # NIL) THEN
          index := SubrangeType.New (0, LAST (p.args^), Int.T);
          p.solidType := ArrayType.New (index, solidElt);
          Type.Check (p.solidType);
        ELSE
          p.refType := RefType.New (p.tipe, traced := TRUE, brand := NIL);
          Type.Check (p.refType);
        END;
      END;
    ELSE
      p.uid := 0;
    END;
  END Check;

PROCEDURE EqCheck (a: P;  e: Expr.T): BOOLEAN =
  VAR b: P;
  BEGIN
    TYPECASE e OF
    | NULL => RETURN FALSE;
    | P(p) => b := p;
    ELSE      RETURN FALSE;
    END;
    IF   (NOT Type.IsEqual (a.tipe, b.tipe, NIL))
      OR (a.dots # b.dots)
      OR ((a.args = NIL) # (b.args = NIL))
      OR ((a.args # NIL) AND (NUMBER (a.args^) # NUMBER (b.args^))) THEN
      RETURN FALSE;
    END;
    FOR i := 0 TO LAST (a.args^) DO
      IF NOT Expr.IsEqual (a.args[i], b.args[i]) THEN RETURN FALSE END;
    END;
    RETURN TRUE;
  END EqCheck;

PROCEDURE Compile (p: P): Temp.T =
  VAR
    t1, t2, t3: Temp.T;
    index, element, actual, solidElt: Type.T; 
    depth, openDepth, j, block: INTEGER;
  BEGIN
    Type.Compile (p.tipe);
    Type.Compile (p.refType);
    Type.Compile (p.solidType);
    WITH b = ArrayType.Split (p.tipe, index, element) DO <* ASSERT b *> END;
    t1 := Temp.Alloc (p);

    IF index # NIL THEN
      WITH n = LAST (p.args^) DO
        FOR i := 0 TO n DO
          t2 := Expr.Compile (p.args[i]);
          Emit.OpTI ("@.elts[@] = ", t1, i);
          Emit.OpT ("@;\n", t2);
          Temp.Free (t2);
        END;

        IF (p.dots) AND (n < Type.Number (p.index)) THEN
          Frame.PushBlock (block, 1);
          Emit.Op ("int _ae;\n");
          Emit.OpII ("for (_ae=@; _ae<@; _ae++) { ", n+1, Type.Number (index));
          Emit.OpT  ("@.elts[_ae] = ", t1);
          Emit.OpTI ("@.elts[@]; }\n", t1, n);
          Frame.PopBlock (block);
        END;
      END; 

    ELSIF NUMBER (p.args^) = 0 THEN
      Emit.OpT ("@.size[0] = 0;\n", t1);
      Emit.OpT ("@.elts = 0;\n", t1);

    ELSE (* it's an open array *)

      (* build the dope vector *)
      Emit.OpTI ("@.size[0] = @;\n", t1, NUMBER (p.args^));
      t2 := Expr.Compile (p.args[0]);
      IF (p.solidType # NIL) THEN (* shape is known at compile time *)
        EVAL ArrayType.Split (p.solidType, index, actual);
        openDepth := 1;
        WHILE OpenArrayType.Split (element, element) DO
          Emit.OpTI ("@.size[@] = ", t1, openDepth);
          EVAL ArrayType.Split (actual, index, actual);
          <*ASSERT index # NIL*>
          Emit.OpI ("@;\n", Type.Number (index));
          INC (openDepth);
        END;
      ELSE (* an open array whose shape is determined at runtime *)
        actual := Expr.TypeOf (p.args[0]);
        openDepth := 1;
        WHILE OpenArrayType.Split (element, element) DO
          Emit.OpTI ("@.size[@] = ", t1, openDepth);
          EVAL ArrayType.Split (actual, index, actual);
          IF index = NIL THEN
            Emit.OpTI ("@.size[@];\n", t2, openDepth - 1);
          ELSE 
            Emit.OpI ("@;\n", Type.Number (index));
          END;
          INC (openDepth);
        END;
      END;

      Frame.PushBlock (block, 3);

      (* compute the size of the expr *)
      Emit.Op ("int _nb_elts = ");
      FOR j := 1 TO openDepth - 1 DO Emit.OpTI ("@.size[@] * ", t1, j); END;
      Emit.Op ("1;\n");

      Emit.Op  ("int _elt_size = _nb_elts * ");
      Emit.OpI ("@;\n", Type.Size (element) DIV Target.CHARSIZE);

      solidElt := OpenArrayType.OpenType (element);
      Emit.OpF ("@* _dst;\n", solidElt); 

      (* allocate space for the value *)
      IF (p.solidType # NIL) THEN
        t3 := Temp.AllocEmpty (p.solidType);
        Temp.Depend (t1, t3);
        Emit.OpFT ("_dst = (@*) @.elts;\n", solidElt, t3);
      ELSE (* runtime size and shape *)
        INC (Frame.cur.size, 3);
        Emit.Op   ("struct {int* elts; int nElts} _sizes;\n");
        Emit.OpF  ("@* _ref;\n", p.tipe);
        Emit.OpT  ("_sizes.elts = @.size;\n", t1);
        Emit.OpI  ("_sizes.nElts = @;\n", openDepth);
        Emit.OpFF ("_ref = (@*)_TNEWA (@_TC, &_sizes);\n", p.tipe, p.refType);
        Emit.OpF  ("_dst = (@ *)(_ref->elts);\n", solidElt); 
      END;
      Emit.OpT ("@.elts = _dst;\n", t1);

      (* fill with the elements *)
      j := 0;
      LOOP
        IF openDepth > 1 THEN
          (* check that thing has the right number of elements *)
          IF j # 0 THEN
            actual := Expr.TypeOf (p.args[j]);
            depth := 1;
            WHILE depth < openDepth DO
              EVAL ArrayType.Split (actual, index, actual);
              IF Host.doNarrowChk THEN
                Emit.OpTI ("if (@.size[@] != ", t1, depth);
                IF index = NIL
                  THEN Emit.OpTI ("@.size[@]) ", t2, depth - 1);
                  ELSE Emit.OpI  ("@) ", Type.Number (index))
                END;
                Fault.Narrow ();
              END;
              INC (depth);
            END;
          END;
          Emit.OpT ("_COPY (@.elts, _dst, _elt_size);\n", t2);
        ELSE
          Emit.OpT ("*_dst = @;\n", t2);
        END;
        Emit.Op ("_dst += _nb_elts;\n");
        Temp.Free (t2);
        INC (j);
        IF j >= NUMBER (p.args^) THEN EXIT END;
        t2 := Expr.Compile (p.args[j]);
      END;

      Frame.PopBlock (block);
    END;

    RETURN t1;

  END Compile;

PROCEDURE Fold (p: P): Expr.T =
  VAR e: Expr.T;
  BEGIN
    FOR i := 0 TO LAST (p.args^) DO
      e := Expr.ConstValue (p.args[i]);
      IF (e = NIL) THEN RETURN NIL END;
      p.args[i] := e;
    END;
    RETURN p;
  END Fold;

PROCEDURE FPrinter (p: P;  map: Type.FPMap;  wr: MBuf.T) =
  BEGIN
    Type.Fingerprint (p.tipe, map, wr);
    FOR i := 0 TO LAST (p.args^) DO
      Expr.Fingerprint (p.args[i], map, wr);
    END;
  END FPrinter;

PROCEDURE IsZeroes (p: P): BOOLEAN =
  BEGIN
    FOR i := 0 TO LAST (p.args^) DO
      IF NOT Expr.IsZeroes (p.args[i]) THEN RETURN FALSE END;
    END;
    RETURN TRUE;
  END IsZeroes;

PROCEDURE GenOpenLiteral (e: Expr.T) = 
  BEGIN
    TYPECASE e OF
    | NULL => RETURN;
    | P(p) => FOR i := FIRST (p.args^) TO LAST (p.args^) DO
                GenOpenLiteral (p.args[i]); 
                IF i # LAST (p.args^) THEN Emit.Op (", "); END;
              END;
    ELSE      Expr.GenLiteral (e);
    END;
  END GenOpenLiteral;

PROCEDURE PreGenLiteral (array: Expr.T) =
  BEGIN
    TYPECASE array OF
    | NULL => RETURN;
    | P(p) => IF (p.uid # 0) AND NUMBER (p.args^) # 0 THEN
                Emit.OpF ("_PRIVATE _VOLATILE @ ", OpenArrayType.OpenType (p.tipe));
                Emit.OpI ("_openConst@ [] = {", p.uid);
                GenOpenLiteral (p);
                Emit.Op ("};\n");
              END;
    ELSE      RETURN;
    END;
  END PreGenLiteral;

PROCEDURE GenOpenDim (e: Expr.T;  depth: INTEGER) = 
  BEGIN
    WHILE (depth > 0) DO
      TYPECASE e OF
      | NULL => Emit.Op  (", 0");
      | P(p) => Emit.OpI (", @", NUMBER (p.args^));
                IF (NUMBER (p.args^) # 0)
                  THEN e := p.args[0];
                  ELSE e := NIL;
                END;
      ELSE      Emit.Op (", 0");
      END;
      DEC (depth);
    END;
  END GenOpenDim;

PROCEDURE GenLiteral (p: P) =
  VAR index, element: Type.T;  j, k, last: INTEGER;
  BEGIN
    WITH b = ArrayType.Split (p.tipe, index, element) DO <* ASSERT b *> END;

    IF index = NIL THEN
      IF NUMBER (p.args^) # 0
        THEN Emit.OpI ("{ _openConst@", p.uid);
        ELSE Emit.Op ("{ 0"); 
      END;
      GenOpenDim (p, OpenArrayType.OpenDepth (p.tipe));
      Emit.Op ("}\n");
    ELSE
      (* find the last non-zero element *)
      last := LAST (p.args^);
      WHILE (last > 0) AND Expr.IsZeroes (p.args[last]) DO DEC (last) END;
 
      IF (NUMBER (p.args^) > 0) THEN
        Emit.Op ("{{\001\n");
        j := 0;
        k := MAX (1, 5 * Target.INTSIZE DIV Type.Size (element)); (*elts/line*)
        FOR i := 0 TO last DO
          IF (i # 0) THEN Emit.Op (", ") END;
          IF (j > k) THEN Emit.Op ("\n");  j := 0; END;
          Expr.GenLiteral (p.args[i]);
          INC (j);
        END;
        IF (p.dots) AND (last = LAST (p.args^)) THEN
          FOR z := last+1 TO Type.Number (index)-1 DO
            Emit.Op (", ");
            IF (j > k) THEN Emit.Op ("\n");  j := 0; END;
            Expr.GenLiteral (p.args[last]);
            INC (j);
          END;
        END;
        IF (j # 0) THEN Emit.Op ("\n") END;
        Emit.Op ("\002}}");
      ELSE (* empty array *)
        (* generate nothing... *)
      END;
    END;
  END GenLiteral;

BEGIN
END ArrayExpr.