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

(* File: RecordExpr.m3                                         *)
(* Last modified on Mon Feb 12 09:32:15 1990 by kalsow         *)
(*      modified on Sat Jan 20 03:53:14 1990 by muller         *)


MODULE RecordExpr;

IMPORT Expr, ExprRep, Error, Type, Scope, RecordType, Temp, Emit, String;
IMPORT Value, ValueRep, Field, KeywordExpr, RangeExpr, AssignStmt, Wr;

TYPE
  P = Expr.T OBJECT
        tipe  : Type.T;
        args  : Expr.List;
        map   : Expr.List;
        names : UNTRACED REF ARRAY OF String.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): Expr.T =
  VAR p: P;
  BEGIN
    p := NEW (P);
    ExprRep.Init (p);
    p.tipe  := type;
    p.args  := args;
    p.map   := NIL;
    p.names := NIL;
    RETURN p;
  END New;

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

PROCEDURE Qualify (e: Expr.T;  id: String.T;  VAR result: Expr.T): BOOLEAN =
  VAR
    p          : P;
    fields     : Scope.T;
    val        : Value.T;
    offset     : INTEGER;
    type       : Type.T;
    z, default : Expr.T;
    key        : String.T;
    value      : Expr.T;
  BEGIN
    TYPECASE e OF
    | NULL => RETURN FALSE;
    | P(x) => p := x;
    ELSE      RETURN FALSE;
    END;
    IF NOT RecordType.Split (p.tipe, fields) THEN RETURN FALSE END;
    val := Scope.LookUpInScope (fields, id);
    IF (val = NIL) THEN RETURN FALSE END;
    VAR b: BOOLEAN := Field.Split (val, offset, type, default);
    BEGIN <* ASSERT b *> END;
    FOR i := 0 TO LAST (p.args^) DO
      z := p.args[i];
      IF (KeywordExpr.Split (z, key, value)) THEN
        IF (key = id) THEN result := value; RETURN TRUE END;
      ELSIF (i = offset) THEN
        result := z;  RETURN TRUE;
      END;
    END;
    RETURN FALSE;
  END Qualify;

PROCEDURE Bind (p: P) =
  BEGIN
    p.tipe := Type.Bind (p.tipe);
    FOR i := 0 TO LAST (p.args^) DO  Expr.Bind (p.args[i])  END;
    p.type := p.tipe;
  END Bind;

PROCEDURE Check (p: P) =
  VAR
    n        : INTEGER;
    fields   : Scope.T;
    key      : String.T;
    value, e : Expr.T;
    posOK    : BOOLEAN;
    objs     : Scope.ValueList;
    offset   : INTEGER;
    type     : Type.T;
    default  : Expr.T;
    done     : REF ARRAY OF BOOLEAN;
    types    : REF ARRAY OF Type.T;
  BEGIN
    Type.Check (p.tipe);
    IF NOT RecordType.Split (p.tipe, fields) THEN
      Error.Msg ("record constructor must specify a record type");
      FOR i := 0 TO LAST (p.args^) DO Expr.TypeCheck (p.args[i]) END;
      RETURN;
    END;
    Scope.ToList (fields, objs, n);
    done := NEW (REF ARRAY OF BOOLEAN, n);
    types := NEW (REF ARRAY OF Type.T, n);
    p.names := NEW (UNTRACED REF ARRAY OF String.T, n);
    p.map := NEW (Expr.List, n);
    FOR i := 0 TO n - 1 DO
      done[i] := FALSE;
      VAR b: BOOLEAN := Field.Split (objs[i], offset, type, default);
      BEGIN <* ASSERT b *> END;
      types[offset] := type;
      p.names[offset] := objs[i].name;
      p.map[offset] := default;
    END;
    posOK := TRUE;
    EVAL Fold (p);  (* make sure that the everything that can be folded is *)
    FOR i := 0 TO LAST (p.args^) DO
      e := p.args[i];
      Expr.TypeCheck (e);
      IF RangeExpr.Split (e, value, default) THEN
        Error.Msg ("range expressions not allowed in record constructors");
      END;
      IF KeywordExpr.Split (e, key, value) THEN
        posOK := FALSE;
        offset := 0;
        e := value;
        LOOP
          IF (offset >= n) THEN
            Error.Str (key, "unknown field");
            offset := i;
            EXIT;
          END;
          IF (p.names[offset] = key) THEN EXIT END;
          INC (offset);
        END;
      ELSE (* positional parameter *)
        IF (NOT posOK) THEN
          Error.Msg ("positional values must precede keyword values");
        END;
        IF (i >= n)
	  THEN  Error.Msg ("too many values");  offset := n - 1;
          ELSE  offset := i;
        END;
      END;
      IF (done[offset]) THEN
        Error.Str (p.names[offset], "field already specified");
      END;
      done[offset] := TRUE;
      IF NOT Type.IsAssignable (types[offset], Expr.TypeOf (e)) THEN
        Error.Str (p.names[offset], "expression is not assignable to field");
      ELSE
        p.map[offset] := AssignStmt.CheckRHS (types[offset], e);
      END;
    END;
    FOR i := 0 TO n - 1 DO
      IF (NOT done[i]) AND (p.map[i] = NIL) THEN
        Error.Str (p.names[i], "no value specified for field");
      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.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;
  BEGIN
    t1 := Temp.Alloc (p);
    FOR i := 0 TO LAST (p.map^) DO
      t2 := Expr.Compile (p.map[i]);
      Emit.OpT ("@.", t1);
      Emit.OpS ("_@ = ", p.names[i]); (* BUG? do a full assignment? *)
      Emit.OpT ("@;\n", t2);
      Temp.Free (t2);
    END;
    RETURN t1;
  END Compile;

PROCEDURE Fold (p: P): Expr.T =
  VAR result := p;
  BEGIN
    FOR i := 0 TO LAST (p.args^) DO
      WITH e = Expr.ConstValue (p.args[i]) DO
        IF (e = NIL) THEN result := NIL; ELSE p.args[i] := e; END;
      END;
    END;
    RETURN result;
  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.map^) DO
      Expr.Fingerprint (p.map[i], map, wr);
    END;
  END FPrinter;

PROCEDURE IsZeroes (p: P): BOOLEAN =
  BEGIN
    <* ASSERT p.map # NIL *> (* must already be checked *)
    FOR i := 0 TO LAST (p.map^) DO
      IF NOT Expr.IsZeroes (p.map[i]) THEN RETURN FALSE END;
    END;
    RETURN TRUE;
  END IsZeroes;

PROCEDURE GenLiteral (p: P) =
  VAR last: INTEGER;
  BEGIN
    <* ASSERT p.map # NIL *> (* must already be checked *)
    last := LAST (p.map^);
    WHILE (last > 0) AND (Expr.IsZeroes (p.map[last])) DO DEC (last) END;
    IF (last >= 0) THEN
      Emit.Op ("{\001\n");
      FOR i := 0 TO last DO
        IF (i # 0) THEN Emit.Op (",\n") END;
        WITH e = Expr.ConstValue (p.map[i]) DO
	  <* ASSERT e # NIL *>
          p.map[i] := e;
          Expr.GenLiteral (e);
        END;
      END;
      Emit.Op ("\n\002}");
    END;
  END GenLiteral;

BEGIN
END RecordExpr.