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

(* File: OpenArrayExpr.m3                                      *)
(* Last Modified On Tue Jun 30 08:42:08 PDT 1992 By kalsow     *)
(*      Modified On Fri Feb 15 03:07:27 1991 By muller         *)

MODULE OpenArrayExpr;

IMPORT Expr, ExprRep, Type, Emit, OpenArrayType, ArrayType;
IMPORT Temp, MBuf, AssignStmt, Error, Target, Host, Frame, Fault;

REVEAL
  P = Expr.T BRANDED "OpenArrayExpr.P" OBJECT
        targetT : Type.T;
        sourceE : Expr.T;
        sourceT : Type.T;
        kind    : AssignStmt.Kind;
      OVERRIDES
        typeOf       := ExprRep.NoType;
        check        := Check;
        compile      := Compile;
        evaluate     := Fold;
        fprint       := FPrinter;
        write        := Writer;
        isEqual      := EqCheck;
        getBounds    := ExprRep.NoBounds;
        isWritable   := IsWritable;
        isDesignator := IsDesignator;
	isZeroes     := ExprRep.IsNever;
	note_write   := NoteWrites;
	genLiteral   := ExprRep.NoLiteral;
      END;

PROCEDURE New (targetT: Type.T; sourceE: Expr.T; 
               kind := AssignStmt.Kind.assign): Expr.T =
  VAR p: P; sourceT: Type.T;
  BEGIN
    targetT := Type.Strip (targetT);
    sourceT := Type.Strip (Expr.TypeOf (sourceE));
    IF     NOT Type.IsAssignable (sourceT, targetT) 
       AND NOT Type.IsAssignable (targetT, sourceT) THEN
      Error.Msg ("types are not assignable");
    END;
    IF Type.IsEqual (targetT, sourceT, NIL)
       AND (kind # AssignStmt.Kind.assign
            OR OpenArrayType.OpenDepth (sourceT) = 0) THEN
      RETURN sourceE;
    END;
    p := NEW (P);
    ExprRep.Init (p);
    p.origin  := sourceE.origin;
    p.type    := targetT;
    p.targetT := targetT;
    p.sourceT := sourceT;
    p.sourceE := sourceE;
    p.kind    := kind;
    RETURN p;
  END New;

PROCEDURE Check (p: P;  VAR cs: Expr.CheckState) =
  BEGIN
    Type.Check (p.targetT);
    Expr.TypeCheck (p.sourceE, cs);
    p.type := p.targetT;
  END Check;

PROCEDURE EqCheck (a: P;  e: Expr.T): BOOLEAN =
  BEGIN
    TYPECASE e OF
    | NULL => RETURN FALSE;
    | P(b) => RETURN Type.IsEqual (a.targetT, b.targetT, NIL)
                 AND Expr.IsEqual (a.sourceE, b.sourceE);
    ELSE      RETURN FALSE;
    END;
  END EqCheck;

PROCEDURE Is (e: Expr.T): BOOLEAN =
  BEGIN
    TYPECASE e OF
    | NULL => RETURN FALSE;
    | P    => RETURN TRUE;
    ELSE      RETURN FALSE;
    END;
  END Is;

PROCEDURE Compile (p: P): Temp.T =
  VAR ns, nt, i: INTEGER; ts, tt: Temp.T; t, s, ti, te, si, se: Type.T; 
  BEGIN
    Type.Compile (p.targetT);
    Type.Compile (p.sourceT);

    ts := Expr.Compile (p.sourceE);

    s := p.sourceT;
    t := p.targetT;
    ns := OpenArrayType.OpenDepth (s);
    nt := OpenArrayType.OpenDepth (t);

    IF nt = 0 AND p.kind # AssignStmt.Kind.assign THEN
      tt := Temp.AllocMacro (p, TRUE);
      Temp.Depend (tt, ts);
    ELSIF p.kind # AssignStmt.Kind.assign THEN
      tt := Temp.AllocEmpty (p.targetT, TRUE);
      Temp.Depend (tt, ts);
    ELSE
      tt := ts;
    END;
   
    FOR i := 1 TO MIN (ns, nt) DO
      EVAL OpenArrayType.Split (s, s);
      EVAL OpenArrayType.Split (t, t);
    END;

    IF (nt < ns) THEN
      i := MIN (ns, nt);
      WHILE OpenArrayType.Split (s, s) DO
        EVAL ArrayType.Split (t, ti, t);
        IF Host.doNarrowChk THEN
          Emit.OpTI ("if (@.size[@] != ", ts, i);
          Emit.OpI  ("@) ", Type.Number (ti));
          Fault.Narrow ();
        END;
        INC (i);
      END;
    END;

    IF p.kind # AssignStmt.Kind.assign AND nt # 0 THEN
      (* get the pointer to the original data *)
      Emit.OpT  ("@.elts = ", tt);
      Emit.OpF ("(@*)", OpenArrayType.OpenType (p.targetT));
      Emit.OpT ("((@).elts);\n", ts);

      (* build the dope vector *)
      i := 0;
      t := p.targetT;
      s := p.sourceT;
      WHILE OpenArrayType.Split (t, te) DO
        VAR b:= ArrayType.Split (s, si, se);
        BEGIN <* ASSERT b *> END;
        Emit.OpTI ("@.size[@] = ", tt, i);
        IF (si = NIL)
          THEN Emit.OpTI ("@.size[@];\n", ts, i);
          ELSE Emit.OpI ("@;\n", Type.Number (si));
        END;
        t := Type.Strip (te);
        s := Type.Strip (se);
        INC (i);
      END;
    END;

    RETURN tt;
  END Compile;

PROCEDURE CompileAssign (p: P; tRHS, tLHS: Temp.T) =
  VAR
    t, s, tt, ss: Type.T;
    openLHS, openRHS: BOOLEAN;
    block: INTEGER;
  BEGIN
    <* ASSERT p.kind = AssignStmt.Kind.assign *>
    t := p.targetT;
    s := p.sourceT;
    openLHS := OpenArrayType.Split (t, tt);
    openRHS := OpenArrayType.Split (s, ss);

    Frame.PushBlock (block, 2);
    IF openRHS AND openLHS THEN
      Emit.OpF ("@* _src",  s);
      Emit.OpT (" = &@;\n", tRHS);
      Emit.OpF ("@* _dest", t);
      Emit.OpT (" = &@;\n", tLHS);
      GenOpenArraySizeChecks (t, s);
      Emit.Op ("_COPY (_src->elts, _dest->elts, ");
      GenOpenArraySize (t, s);
      Emit.Op (");\n");
    ELSIF openRHS THEN
      Emit.OpF  ("@* _src",  s);
      Emit.OpT  (" = &@;\n", tRHS);
      Emit.OpFF ("@* _dest = (@*)", t, t);
      Emit.OpT  ("(& @);\n", tLHS);
      Emit.OpI  ("_COPY (_src->elts, _dest->elts, @);\n", 
                  Type.Size (t) DIV Target.CHARSIZE);
    ELSIF openLHS THEN
      Emit.OpFF ("@* _src = (@*)", s, s);
      Emit.OpT  ("(& @);\n", tRHS);
      Emit.OpF  ("@* _dest", t);
      Emit.OpT  (" = &@;\n", tLHS);
      GenOpenArraySizeChecks (t, s);
      Emit.OpI ("_COPY (_src->elts, _dest->elts, @);\n", 
                Type.Size (s) DIV Target.CHARSIZE);
    ELSE
      <*ASSERT FALSE*>
    END;
    Frame.PopBlock (block);
  END CompileAssign;

PROCEDURE GenOpenArraySizeChecks (t, s: Type.T) =
  VAR s1: Type.T; i := 0;
  BEGIN
    IF NOT Host.doNarrowChk THEN RETURN END;
    WHILE OpenArrayType.Split (t, t) DO
      VAR b := ArrayType.Split (s, s1, s);
      BEGIN <* ASSERT b *> END;
      Emit.OpI ("if (_dest->size[@] != ", i);
      IF (s1 = NIL)
        THEN Emit.OpI ("_src->size[@]) ", i);
        ELSE Emit.OpI ("@) ", Type.Number (s1));
      END;
      Fault.Narrow ();
      INC (i);
    END;
  END GenOpenArraySizeChecks;

PROCEDURE GenOpenArraySize (t, u: Type.T) =
  VAR b1, b2: BOOLEAN;  i: INTEGER;
  BEGIN
    i := 0;
    b1 := OpenArrayType.Split (t, t);
    b2 := OpenArrayType.Split (u, u);
    WHILE b1 AND b2 DO
      Emit.OpI ("(_src->size[@]) * ", i);
      b1 := OpenArrayType.Split (t, t);
      b2 := OpenArrayType.Split (u, u);
      INC (i);
    END;
    IF NOT b1 
      THEN Emit.OpI ("@", Type.Size (t) DIV Target.CHARSIZE);
      ELSE Emit.OpI ("@", Type.Size (u) DIV Target.CHARSIZE);
    END;
  END GenOpenArraySize;

PROCEDURE Fold (p: P): Expr.T =
  BEGIN
    RETURN Expr.ConstValue (p.sourceE);
  END Fold;

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

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

PROCEDURE NoteWrites (p: P) =
  BEGIN
    Expr.NoteWrite (p.sourceE);
  END NoteWrites;

PROCEDURE Writer (p: P;  t1: Temp.T; <*UNUSED*> t2: Temp.T) =
  BEGIN
    Emit.OpF ("(*((@*)", p.targetT);
    Emit.OpT ("(@.elts)))", t1);
  END Writer;

PROCEDURE FPrinter (p: P;  map: Type.FPMap;  wr: MBuf.T) =
  BEGIN
    MBuf.PutText (wr, "OPENARRAY ");
    Type.Fingerprint (p.targetT, map, wr);
    Expr.Fingerprint (p.sourceE, map, wr);
  END FPrinter;

BEGIN
END OpenArrayExpr.