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

(* File: ArrayExpr.m3                                          *)
(* Last modified on Sat Jun 30 02:32:10 1990 by muller         *)
(*      modified on Mon Feb 12 09:35:55 1990 by kalsow         *)


MODULE ArrayExpr;

IMPORT Expr, ExprRep, Error, Type, ArrayType, String, Wr;
IMPORT KeywordExpr, RangeExpr, Temp, Emit, Int, Target;
IMPORT IntegerExpr, EnumExpr, TypeExpr, SubrangeType;

TYPE
  P = Expr.T OBJECT
        tipe  : Type.T;
	args  : Expr.List;
	dots  : BOOLEAN;
	index : Type.T;
      METHODS
        bind         := Bind;
        check        := Check;
        compile      := Compile;
        evaluate     := Fold;
        fprint       := FPrinter;
        write        := ExprRep.NoWriter;
        isEqual      := EqCheck;
        getBounds    := ExprRep.NoBounds;
        isWritable   := ExprRep.IsNever;
        isDesignator := ExprRep.IsNever;
	isZeroes     := IsZeroes;
	genLiteral   := GenLiteral;
      END;

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;
    ELSIF (index = NIL) THEN (* open array type => fixed *)
      IF (dots) THEN
        Error.Msg ("trailing \'..\' not allowed on open array constructors");
      END;
      index := SubrangeType.New (0, LAST (args^), Int.T);
      type := ArrayType.New (index, element);
    ELSIF NUMBER (args^) = 0 THEN
      Error.Msg ("two few elements in array constructor"); 
    END;
    p.tipe  := type;
    p.index := index;
    p.args  := args;
    p.dots  := dots;
    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 (index = NIL) THEN RETURN FALSE END;
    IF (NOT IntegerExpr.Split (index, i))
      AND (NOT EnumExpr.Split (index, i, t)) THEN
      RETURN FALSE;
    END;
    Type.GetBounds (p.index, min, max);
    i := i - min; (* correct for the base index of the array *)
    IF (i < 0) OR (max-min < i) 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 Bind (p: P) =
  BEGIN
    p.index := Type.Bind (p.index);
    p.tipe  := Type.Bind (p.tipe);
    p.type  := p.tipe;
    FOR i := 0 TO LAST (p.args^) DO Expr.Bind (p.args[i]) END;
  END Bind;

PROCEDURE Check (p: P) =
  VAR
    n: INTEGER;
    e, value, minE, maxE: Expr.T;
    index, element: Type.T;
    key: String.T;
  BEGIN
    Type.Check (p.tipe);
    IF NOT ArrayType.Split (p.tipe, index, element) THEN
      Error.Msg ("expecting array type on array constructor");
      FOR i := 0 TO LAST (p.args^) DO Expr.TypeCheck (p.args[i]) END;
      RETURN;
    END;

    n := Type.Number (index);
    IF (n < NUMBER (p.args^)) THEN
      Error.Msg ("too many values specified");
    END;

    FOR i := 0 TO LAST (p.args^) DO
      e := p.args[i];
      Expr.TypeCheck (e);
      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 (Expr.TypeOf (e), element) THEN
        Error.Msg ("expression is not assignable to array element");
      END;
    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))
      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: Temp.T;  index, element: Type.T;  n: INTEGER;
  BEGIN
    VAR b: BOOLEAN := ArrayType.Split (p.tipe, index, element);
    BEGIN <* ASSERT b *> END;
    t1 := Temp.Alloc (p);

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

    IF (p.dots) AND (n < Type.Number (p.index)) THEN
      Emit.Op ("{\001\nregister int ae;\n");
      Emit.OpII ("for (ae = @; ae < @; ae++) {\001\n", n+1,Type.Number(index));
      Emit.OpT  ("@.elts[ae] = ", t1);
      Emit.OpTI ("@.elts[@];\n\002};\n\002};\n", t1, n);
    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.Map;  wr: Wr.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 GenLiteral (p: P) =
  VAR index, element: Type.T;  j, k, last: INTEGER;
  BEGIN
    VAR b: BOOLEAN := ArrayType.Split (p.tipe, index, element);
    BEGIN <* ASSERT b *> END;

    (* 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 GenLiteral;

BEGIN
END ArrayExpr.