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

(* File: ArrayType.m3                                          *)
(* Last modified on Wed Sep  2 11:59:25 PDT 1992 by rustan     *)
(*      modified on Mon Mar  2 11:15:46 PST 1992 by kalsow     *)
(*      modified on Sun Feb 24 04:39:01 1991 by muller         *)

MODULE ArrayType;

IMPORT Type, TypeRep, Error, Emit, Token, Target, OpenArrayType;
IMPORT MBuf, String, Word, PackedType, Frame;
IMPORT TrOffsets;
FROM Scanner IMPORT Match, GetToken, cur;

CONST
  MAXSIZE = LAST (INTEGER);

TYPE
  P = Type.T BRANDED "ArrayType.P" OBJECT
        index      : Type.T;
        element    : Type.T;
        numElts    : INTEGER;
        totalSize  : INTEGER;
        eltSize    : INTEGER;
        openCousin : Type.T;  (* == ARRAY OF element *)
      OVERRIDES
        check      := Check;
        base       := TypeRep.SelfBase;
        isEqual    := EqualChk;
        isSubtype  := Subtyper;
        count      := TypeRep.NotOrdinal;
        bounds     := TypeRep.NotBounded;
        size       := Sizer;
        minSize    := Sizer;
        alignment  := Aligner;
	isEmpty    := IsEmpty;
        dependsOn  := DependsOn;
        compile    := Compiler;
        initCost   := InitCoster;
        initValue  := GenInit;
        tracedOffs := TracedOffs;
        paramEncoding := ParamEnc;
        mapper     := GenMap;
        fprint     := FPrinter;
        class      := MyClass;
      END;

PROCEDURE Parse (READONLY fail: Token.Set): Type.T =
  TYPE TK = Token.T;
  VAR p, p0: P;
  BEGIN
    Match (TK.tARRAY, fail, Token.Set {TK.tOF} + Token.TypeStart);
    IF (cur.token IN Token.TypeStart) THEN
      p0 := New (NIL, NIL);  p := p0;
      LOOP
        p.index := Type.Parse (fail + Token.Set{TK.tOF} + Token.TypeStart);
        IF (cur.token # TK.tCOMMA) THEN EXIT END;
        GetToken (); (* , *)
	p.element := New (NIL, NIL);
        p := p.element;
      END;
      Match (TK.tOF, fail, Token.TypeStart);
      p.element := Type.Parse (fail);
      RETURN p0;
    ELSE
      (* must be an open array *)
      Match (TK.tOF, fail, Token.TypeStart);
      RETURN OpenArrayType.New (Type.Parse (fail));
    END;
  END Parse;

PROCEDURE New (index, element: Type.T): Type.T =
  VAR p: P;
  BEGIN
    p := NEW (P);
    TypeRep.Init (p);
    p.index      := index;
    p.element    := element;
    p.numElts    := 0;
    p.totalSize  := 0;
    p.eltSize    := 0;
    p.openCousin := NIL;
    RETURN p;
  END New;

PROCEDURE Split (t: Type.T;  VAR index, element: Type.T): BOOLEAN =
  VAR p: P;
  BEGIN
    IF Reduce (t, p) THEN
      index := p.index;  element := p.element;
      RETURN TRUE;
    ELSIF OpenArrayType.Split (t, element) THEN
      index := NIL;
      RETURN TRUE;
    ELSE
      RETURN FALSE;
    END;
  END Split;

PROCEDURE OpenCousin (t: Type.T): Type.T =
  VAR p: P;
  BEGIN
    IF Reduce (t, p) THEN
      IF (p.openCousin = NIL) THEN
        p.openCousin := OpenArrayType.New (p.element);
      END;
      RETURN p.openCousin;
    ELSE
      RETURN t;
    END;
  END OpenCousin;

PROCEDURE MyClass (<*UNUSED*> p: P): TypeRep.Class =
  BEGIN
    RETURN TypeRep.Class.Array;
  END MyClass;

PROCEDURE Check (p: P) =
  VAR e, n, bits: INTEGER;  eltelt: Type.T;
  BEGIN
    Type.Check (p.index);
    n := Type.Number (p.index);
    IF (n < 0) THEN
      Error.Msg ("array index type must be an ordinal type");
    END;

    Type.Check (p.element);
    e := Type.Size (p.element);
    IF OpenArrayType.Split (p.element, eltelt) THEN
      Error.Msg ("array element type cannot be an open array");
    END;
    IF PackedType.Split (p.element, bits, eltelt) THEN
      IF (bits # Type.Size (eltelt)) THEN
        Error.Msg ("SRC Modula-3 does not support this type");
      END;
    END;

    p.eltSize := e;
    p.numElts := n;
    IF (n > 0) AND (e > 0) AND (n > MAXSIZE DIV e) THEN
      Error.Msg ("array type too large");
      e := 0;
    END;
    p.totalSize := (e * n);
    p.isTraced := Type.IsTraced (p.element);
    p.hasUntraced := Type.HasUntraced (p.element);
    p.isLocalOnly := Type.IsLocalOnly (p.element);
    p.hash := Word.Plus (Word.Times(23,p.numElts), Word.Times(29,p.eltSize));
  END Check;

PROCEDURE Compiler (p: P) =
  BEGIN
    Type.Compile (p.index);
    Type.Compile (p.element);
    IF TypeRep.IsCompiled (p) THEN RETURN END;
    GenDecl (p);

    IF TypeRep.StartLinkInfo (p) THEN RETURN END;

    Emit.OpF  ("d@\n", p.element);
    Emit.Op   ("C\n");
    GenDecl   (p);
    Emit.Op   ("*\n");
  END Compiler;

PROCEDURE GenDecl (p: P) =
  BEGIN
    Emit.OpFF ("struct _array@ { @ ", p, p.element);
    Emit.OpI  ("elts[@]; };\n", MAX (p.numElts, 1));
    Emit.OpFF ("typedef struct _array@ @;\n", p, p);
  END GenDecl;

PROCEDURE EqualChk (a: P;  t: Type.T;  x: Type.Assumption): BOOLEAN =
  VAR b: P;
  BEGIN
    RETURN Reduce (t, b)
       AND Type.IsEqual (a.element, b.element, x)
       AND Type.IsEqual (a.index, b.index, x);
  END EqualChk;

PROCEDURE Subtyper (a: P;  tb: Type.T): BOOLEAN =
  VAR ta, eb: Type.T;  b: P;
  BEGIN
    ta := a;

    (* peel off the fixed dimensions of A and open dimensions of B *)
    WHILE Reduce (ta, a) AND OpenArrayType.Split (tb, eb) DO
      ta := a.element;
      tb := eb;
    END;

    (* peel off the fixed dimensions as long as the sizes are equal *)
    WHILE Reduce (ta, a) AND Reduce (tb, b) DO
      IF Type.Number (a.index) # Type.Number (b.index) THEN RETURN FALSE END;
      ta := a.element;
      tb := b.element;
    END;

    RETURN Type.IsEqual (ta, tb, NIL);
  END Subtyper;

<*INLINE*> PROCEDURE Reduce (t: Type.T;  VAR p: P): BOOLEAN =
  BEGIN
    TYPECASE Type.Strip (t) OF
    | NULL => RETURN FALSE;
    | P(x) => p := x;  RETURN TRUE;
    ELSE      RETURN FALSE;
    END;
  END Reduce;

PROCEDURE Sizer (p: P): INTEGER =
  BEGIN
    IF (p.checked) THEN RETURN p.totalSize END;
    RETURN Type.Number (p.index) * Type.Size (p.element);
  END Sizer;

PROCEDURE Aligner (p: P): INTEGER =
  BEGIN
    RETURN MAX (Type.Alignment (p.element), Target.STRUCTURESIZEBOUNDARY);
  END Aligner;

PROCEDURE IsEmpty (p: P): BOOLEAN =
  BEGIN
    RETURN (**Type.IsEmpty (p.index) OR**) Type.IsEmpty (p.element);
  END IsEmpty;

PROCEDURE DependsOn (p: P;  t: Type.T): BOOLEAN =
  BEGIN
    RETURN Type.DependsOn (p.element, t)
  END DependsOn;

PROCEDURE InitCoster (p: P; zeroed: BOOLEAN): INTEGER =
  VAR n, m: INTEGER;
  BEGIN
    m := Type.InitCost (p.element, zeroed);
    n := Type.Number (p.index);
    IF (n > 0) THEN m := MIN (Target.MAXINT DIV n, m);  END;
    RETURN n * m;
  END InitCoster;

PROCEDURE GenInit (<*UNUSED*> p: P) =
  BEGIN
    <* ASSERT FALSE *>
  END GenInit;

PROCEDURE TracedOffs (p: P;  offset: CARDINAL): TrOffsets.T =
  VAR bitsize := Type.Size( p.element );
  BEGIN
    RETURN TrOffsets.NewArray( offset,
                               p.numElts,
                               (bitsize+Target.ADDRUNIT-1) DIV Target.ADDRUNIT,
                               Type.TracedOffsets( p.element ))
  END TracedOffs;

PROCEDURE ParamEnc (p: P): TEXT =
  VAR s := Type.Number( p.index );
      enc: TEXT := "";
      elEnc: TEXT := Type.ParamEncoding( p.element );
  BEGIN
    WHILE s > 0 DO
      enc := enc & elEnc;  DEC( s )
    END;
    RETURN enc
  END ParamEnc;

VAR aptr, bptr: String.T := NIL;

PROCEDURE GenMap (p: P;  VAR prefix: String.Stack) =
  VAR block: INTEGER;
  BEGIN
    IF Type.IsTraced (p.element) OR Type.HasUntraced (p.element) THEN
      Frame.PushBlock (block, 1);
      Emit.OpI ("int _i@;\n", prefix.top);
      Emit.OpI ("for (_i@ = 0; ", prefix.top);
      Emit.OpI ("_i@ < ", prefix.top);
      Emit.OpI ("@; ", p.numElts);
      Emit.OpI ("_i@++) {\001\n", prefix.top);
      IF (aptr = NIL) THEN aptr := String.Add (".elts[_i"); END;
      IF (bptr = NIL) THEN bptr := String.Add ("]"); END;
      prefix.stk [prefix.top]   := aptr;
      prefix.stk [prefix.top+1] := String.AddInt (prefix.top);
      prefix.stk [prefix.top+2] := bptr;
      INC (prefix.top, 3);
      Type.GenMap (p.element, prefix);
      DEC (prefix.top, 3);
      Emit.Op ("\002}\n");
      Frame.PopBlock (block);
    END;
  END GenMap;

PROCEDURE FPrinter (p: P;  map: Type.FPMap;  wr: MBuf.T) =
  BEGIN
    MBuf.PutText (wr, "ARRAY ");
    Type.Fingerprint (p.index, map, wr);
    Type.Fingerprint (p.element, map, wr);
  END FPrinter;

BEGIN
END ArrayType.