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

(* File: Field.m3                                              *)
(* Last modified on Fri Apr 20 06:47:07 1990 by muller         *)
(*      modified on Sat Feb 10 20:57:40 1990 by kalsow         *)


MODULE Field;

IMPORT Value, ValueRep, Type, String, Expr, Error, ArrayType;
IMPORT AssignStmt, Temp, Wr, Fmt;

TYPE
  T = Value.T BRANDED OBJECT
        offset  : INTEGER;
        tipe    : Type.T;
        default : Expr.T;
      METHODS
        bind        := Bind;
        typeCheck   := TypeCheck;
	class       := MyClass;
        fingerprint := FPrinter;
        load        := ValueRep.NoLoader;
        write       := ValueRep.NoWriter;
        select      := ValueRep.NoDuplicates;
        declare0    := Declarer;
        declare1    := Compile;
        needsDecl   := ValueRep.Never;
	toExpr      := ValueRep.NoExpr;
	toType      := ValueRep.NoType;
      END;

PROCEDURE Create (name: String.T): T =
  VAR t: T;
  BEGIN
    t := NEW (T);
    ValueRep.Init (t, name);
    t.offset  := 0;
    t.tipe    := NIL;
    t.default := NIL;
    RETURN t;
  END Create;

PROCEDURE New (name: String.T;  offset: INTEGER;
                 type: Type.T;  default: Expr.T): Value.T =
  VAR t: T;
  BEGIN
    t := Create (name);
    t.offset  := offset;
    t.tipe    := type;
    t.default := default;
    RETURN t;
  END New;

PROCEDURE Split (field: Value.T;  VAR offset: INTEGER;  VAR type: Type.T;
                                              VAR default: Expr.T): BOOLEAN =
  BEGIN
    TYPECASE field OF
    | NULL =>  RETURN FALSE;

    | T(t) =>  offset  := t.offset;
               type    := t.tipe;
               default := t.default;
               RETURN TRUE;

    ELSE RETURN FALSE;
    END;
  END Split;

PROCEDURE SplitX (field: Value.T;  VAR offset: INTEGER;  VAR type: Type.T;
                                              VAR default: Expr.T) =
  VAR b: BOOLEAN;
  BEGIN
    b := Split (field, offset, type, default);
    <* ASSERT b *>
  END SplitX;

PROCEDURE SetOffset (field: Value.T;  newOffset: INTEGER) =
  BEGIN
    NARROW (field, T).offset := newOffset;
  END SetOffset;

PROCEDURE TypeCheck (t: T) =
  VAR index, elt: Type.T;
  BEGIN
    Type.Check (t.tipe);
    IF Type.IsEmpty (t.tipe) THEN
      Error.Str (t.name, "empty field type");
    END;
    IF ArrayType.Split (t.tipe, index, elt) AND (index = NIL) THEN
      Error.Str (t.name, "open arrays may not used in record fields");
    END;
    IF (t.default # NIL) THEN
      (* check for assignability!! *)
      Expr.TypeCheck (t.default);
      t.default := AssignStmt.CheckRHS (t.tipe, t.default);
      IF (Expr.ConstValue (t.default) = NIL) THEN
        Error.Str (t.name, "default is not a constant");
      END;
    END;
  END TypeCheck;

PROCEDURE Bind (t: T) =
  BEGIN
    Expr.Bind (t.default);
    IF (t.tipe # NIL)
      THEN t.tipe := Type.Bind (t.tipe);
      ELSE t.tipe := Expr.TypeOf (t.default);
    END;
    t.type := t.tipe;
  END Bind;

PROCEDURE Compile (t: T) =
  BEGIN
    Type.Compile (t.tipe);
  END Compile;

PROCEDURE MyClass (<*UNUSED*> t: T): Value.Class =
  BEGIN
    RETURN Value.Class.Field;
  END MyClass;

PROCEDURE Declarer (t: T): BOOLEAN =
  BEGIN
    Error.Str (t.name, "field declaration??");
    <* ASSERT FALSE *>
    RETURN FALSE;
  END Declarer;

PROCEDURE FPrinter (t: T;  map: Type.Map;  wr: Wr.T) =
  BEGIN
    Wr.PutText (wr, "FIELD " & Fmt.Int (t.offset) & " ");
    Type.Fingerprint (t.tipe, map, wr);
    IF (t.default # NIL) THEN
      Wr.PutText (wr, " := ");
      Expr.Fingerprint (Expr.ConstValue (t.default), map, wr);
    END;
  END FPrinter;

BEGIN
END Field.