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

(* File: Constant.m3                                           *)
(* Last Modified On Wed Apr 15 09:56:29 PDT 1992 By kalsow     *)

MODULE Constant;

IMPORT Value, ValueRep, String, Type, Expr, Scope, Error, Target;
IMPORT Token, AssignStmt, Temp, MBuf, Emit, Scanner, UserProc;
IMPORT RecordType, ArrayType, Decl, ProcType, ArrayExpr, Procedure;
FROM Scanner IMPORT GetToken, Match, Match1, MatchID, cur;

TYPE
  T = Value.T BRANDED "Constant.T" OBJECT
        tipe     : Type.T;
	value    : Expr.T;
	explicit : BOOLEAN;
        written  : BOOLEAN;
        loaded   : BOOLEAN;
        next     : T;
      OVERRIDES
        typeCheck   := Check;
	class       := MyClass;
        fingerprint := FPrinter;
        load        := Load;
        write       := Write;
        declare0    := Declarer;
        declare1    := Compile;
	toExpr      := ToExpr;
	toType      := ValueRep.NoType;
        typeOf      := TypeOf;
      END;

PROCEDURE ParseDecl (READONLY fail: Token.Set; att: Decl.Attributes) =
  TYPE TK = Token.T;
  VAR t: T; id: String.T;
  BEGIN
    IF att.isExternal THEN Error.Msg ("a constant cannot be external"); END;
    IF att.isInline   THEN Error.Msg ("a constant cannot be inline"); END;
    
    Match (TK.tCONST, fail, Token.Set {TK.tIDENT});
    WHILE (cur.token = TK.tIDENT) DO
      id := MatchID (fail, Token.Set {TK.tCOLON, TK.tEQUAL}
                                + Token.ExprStart);
      t := Create (id);
      t.unused := att.isUnused;
      t.obsolete := att.isObsolete;
      IF (cur.token = TK.tCOLON) THEN
        GetToken ();
        t.tipe := Type.Parse (fail + Token.Set{TK.tEQUAL}+Token.ExprStart);
      END;
      Match (TK.tEQUAL, fail, Token.ExprStart);
      t.value := Expr.Parse (fail);
      Scope.Insert (t);
      Match1 (TK.tSEMI, fail);
    END;
  END ParseDecl;

VAR
  allConstants: T;

PROCEDURE Reset () =
  VAR t: T;
  BEGIN
    t := allConstants;
    WHILE (t # NIL) DO
      t.written := FALSE;
      t.loaded  := FALSE;
      t := t.next;
    END;
  END Reset;

PROCEDURE Create (name: String.T): T =
  VAR t: T;
  BEGIN
    t := NEW (T);
    ValueRep.Init (t, name);
    t.next     := allConstants;  allConstants := t;
    t.readonly := TRUE;
    t.tipe     := NIL;
    t.value    := NIL;
    t.explicit := FALSE;
    t.written  := FALSE;
    t.loaded   := FALSE;
    RETURN t;
  END Create;

PROCEDURE Declare (name: TEXT;  value: Expr.T;  reserved: BOOLEAN) =
  VAR t: T;
  BEGIN
    t := Create (String.Add (name));
    t.tipe := Expr.TypeOf (value);
    t.value := value;
    Scope.Insert (t);
    IF (reserved) THEN Scanner.NoteReserved (t.name, t) END;
  END Declare;

PROCEDURE TypeOf (t: T): Type.T =
  BEGIN
    IF (t.tipe = NIL) THEN t.tipe := Expr.TypeOf (t.value) END;
    RETURN t.tipe;
  END TypeOf;

PROCEDURE Check (t: T;  VAR cs: Value.CheckState) =
  VAR e: Expr.T;  index, elt: Type.T;  proc: Value.T;  scope: Scope.T;
  BEGIN
    Expr.TypeCheck (t.value, cs);
    Type.Check (TypeOf (t));

    IF ProcType.Is (t.tipe)
      AND UserProc.IsProcedureLiteral (t.value, proc)
      AND Procedure.IsNested (proc) THEN
      Error.Msg ("nested procedures are not constants");
    END;

    t.value := AssignStmt.CheckRHS (t.tipe, t.value, cs);
    e := Expr.ConstValue (t.value);
    IF (t.value # NIL) AND (e = NIL)
      THEN Error.Msg ("value is not constant");
      ELSE t.value := e;
    END;
    t.explicit := ArrayType.Split (t.tipe, index, elt)
                   OR RecordType.Split (t.tipe, scope)
                   OR (Type.Size (t.tipe) >= 2 * Target.INTSIZE);
  END Check;

PROCEDURE Load (t: T): Temp.T =
  BEGIN
    IF (t.explicit)
      THEN RETURN Temp.FromValue (t);
      ELSE RETURN Expr.Compile (t.value);
    END;
  END Load;

PROCEDURE Write (t: T) =
  BEGIN
    t.loaded := TRUE;
    Emit.OpN ("@", t);
  END Write;

PROCEDURE DeclareAllStructuredConstants () =
  VAR t: T;  save: Emit.Stream;
  BEGIN
    save := Emit.Switch (Emit.Stream.Constants);
    t := allConstants;
    WHILE t # NIL DO
      (*****
      t.used := t.used OR t.loaded;
      Value.Declare0 (t);
      *****)
      EVAL Declarer (t);
      t := t.next;
    END;
    EVAL Emit.Switch (save);
  END DeclareAllStructuredConstants;

PROCEDURE Declarer (t: T): BOOLEAN =
  BEGIN
    IF (t.exported) THEN Type.Compile (t.tipe) END;
    IF (t.explicit) THEN
      IF t.written THEN RETURN TRUE; END;
      Type.Compile (t.tipe);
      IF (t.exported) THEN
        ArrayExpr.PreGenLiteral (t.value);
        Emit.OpF ("_EXPORT @ ", t.tipe);
	Emit.OpN ("@ = ", t);
	Expr.GenLiteral (t.value);
	Emit.Op (";\n");
        t.written := TRUE;
      ELSIF (t.imported) AND (t.loaded) THEN
        ArrayExpr.PreGenLiteral (t.value);
        Emit.OpF ("_IMPORT @ ", t.tipe);
	Emit.OpN ("@;\n", t);
        t.written := TRUE;
      ELSIF (t.loaded) THEN
        ArrayExpr.PreGenLiteral (t.value);
        Emit.OpF ("_PRIVATE @ ", t.tipe);
	Emit.OpN ("@ = ", t);
        Expr.GenLiteral (t.value);
	Emit.Op (";\n");
        t.written := TRUE;
      END;
    END;
    RETURN TRUE;
  END Declarer;

PROCEDURE Compile (<*UNUSED*> t: T) =
  BEGIN
  END Compile;

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

PROCEDURE ToExpr (t: T): Expr.T =
  BEGIN
    RETURN t.value;
  END ToExpr;

PROCEDURE FPrinter (t: T; map: Type.FPMap; wr: MBuf.T) =
  BEGIN
    MBuf.PutText (wr, "CONST ");
    Type.Fingerprint (t.tipe, map, wr);
    MBuf.PutText (wr, " = ");
    Expr.Fingerprint (Expr.ConstValue (t.value), map, wr);
  END FPrinter;

BEGIN
END Constant.