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

MODULE Constant;

IMPORT Value, ValueRep, String, Type, Expr, Scope, Error, Target;
IMPORT Token, AssignStmt, Temp, Wr, Text, ExprRep (*!!!*), Emit;
IMPORT ArrayType, Decl, ProcType;

FROM Scanner IMPORT GetToken, Fail, Match, MatchID, cur;

TYPE
  T = Value.T BRANDED OBJECT
        tipe     : Type.T;
	value    : Expr.T;
	explicit : BOOLEAN;
        written  : BOOLEAN;
      METHODS
        bind        := Bind;
        typeCheck   := Check;
	class       := MyClass;
        fingerprint := FPrinter;
        load        := Load;
        write       := Write;
        select      := ValueRep.NoDuplicates;
        declare0    := Declarer;
        declare1    := Compile;
        needsDecl   := ValueRep.Always;
	toExpr      := ToExpr;
	toType      := ValueRep.NoType;
      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);
      Match (TK.tSEMI, fail, Token.Set {});
    END;
  END ParseDecl;

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

PROCEDURE Declare (name: Text.T;  value: Expr.T) =
  VAR t: T;
  BEGIN
    t := Create (String.Add (name));
    t.type   := value.type;
    t.tipe   := value.type;
    t.value  := value;
    Scope.Insert (t);
  END Declare;

PROCEDURE Bind (t: T) =
  BEGIN
    Expr.Bind (t.value);
    IF (t.tipe # NIL)
      THEN t.tipe := Type.Bind (t.tipe);
      ELSE t.tipe := Expr.TypeOf (t.value);
    END;
    IF ProcType.Is (t.tipe) THEN
      Error.WarnNonStandard ("constant cannot be procedures");
    END;
    t.type := t.tipe;
  END Bind;

PROCEDURE Check (t: T) =
  VAR e: Expr.T;  index, elt: Type.T;
  BEGIN
    Type.Check (t.tipe);
    Expr.TypeCheck (t.value);
    t.value := AssignStmt.CheckRHS (t.type, t.value);
    e := Expr.ConstValue (t.value);
    IF (t.value # NIL) AND (e = NIL)
      THEN Error.Msg ("value is not a legal constant");
      ELSE t.value := e;
    END;
    IF ArrayType.Split (t.tipe, index, elt) AND index = NIL THEN
      Error.Str (t.name, "constant has empty value");
    END;
    t.explicit := (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
    Emit.OpN ("@", t);
  END Write;

PROCEDURE Declarer (t: T): BOOLEAN =
  BEGIN
    IF t.explicit THEN
      IF (t.exported) THEN
        Emit.OpI ("EXPORT t@ ", Type.Name (t.tipe));
	Emit.OpN ("@ = ", t);
	Expr.GenLiteral (t.value);
	Emit.Op (";\n");
      ELSIF (t.imported) THEN
        Emit.OpI ("IMPORT t@ ", Type.Name (t.tipe));
	Emit.OpN ("@;\n", t);
      ELSE
        Emit.OpI ("PRIVATE t@ ", Type.Name (t.tipe));
	Emit.OpN ("@ = ", t);
        Expr.GenLiteral (t.value);
	Emit.Op (";\n");
      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.Map; wr: Wr.T) =
  BEGIN
    Wr.PutText (wr, "CONST ");
    Type.Fingerprint (t.tipe, map, wr);
    Wr.PutText (wr, " = ");
    Expr.Fingerprint (Expr.ConstValue (t.value), map, wr);
  END FPrinter;

BEGIN
END Constant.