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

(* File: EnumType.m3                                           *)
(* Last modified on Mon Jun  8 08:54:49 PDT 1992 by kalsow     *)
(*      modified on Fri May 29 16:14:21 PDT 1992 by muller     *)

MODULE EnumType;

IMPORT Type, TypeRep, String, Value, Scope, Scanner, Ident;
IMPORT Emit, EnumElt, Token, Target, CChar, Bool, MBuf, Word, M3;

TYPE
  Rep = {u_char, u_short, s_int};

TYPE
  P = Type.T BRANDED "EnumType.m3" OBJECT
	nElts      : INTEGER;
	scope      : Scope.T;
	rep        : Rep;
      OVERRIDES
        check      := Check;
        base       := TypeRep.SelfBase;
        isEqual    := EqualChk;
        isSubtype  := Subtyper;
        count      := Counter;
        bounds     := Bounder;
        size       := Sizer;
        minSize    := MinSizer;
        alignment  := Aligner;
	isEmpty    := IsEmpty;
        dependsOn  := TypeRep.DependsOnNone;
        compile    := Compiler;
        initCost   := InitCoster;
        initValue  := GenInit;
        mapper     := TypeRep.NoMapper;
        fprint     := FPrinter;
        class      := MyClass;
      END;

PROCEDURE Parse (READONLY fail: Token.Set): Type.T =
  TYPE TK = Token.T;
  VAR n, j: INTEGER;  p: P;
  BEGIN
    p := Create (Scope.PushNew (FALSE, NIL));
    n := 0;
    Scanner.Match (TK.tLBRACE, fail, Token.Set {TK.tIDENT, TK.tRBRACE});
    IF (Scanner.cur.token = TK.tIDENT) THEN
      n := Ident.ParseList (fail + Token.Set {TK.tRBRACE});
      j := Ident.top - n;
      FOR i := 0 TO n - 1 DO
        Scope.Insert (EnumElt.New (Ident.stack[j + i], i, p));
      END;
      DEC (Ident.top, n);
    END;
    Scanner.Match1 (TK.tRBRACE, fail);
    Scope.PopNew ();
    p.nElts := n;
    SetRep (p);
    RETURN p;
  END Parse;

PROCEDURE New (nElts: INTEGER;  elts: Scope.T): Type.T =
  VAR p: P;
  BEGIN
    p         := Create (elts);
    p.checked := TRUE;
    p.nElts   := nElts;
    SetRep (p);
    RETURN p;
  END New;

<*INLINE*> PROCEDURE Is (t: Type.T): BOOLEAN =
  BEGIN
    TYPECASE Type.Strip (t) OF
    | NULL => RETURN FALSE;
    | P    => RETURN TRUE;
    ELSE      RETURN FALSE;
    END;
  END Is;

PROCEDURE LookUp (t: Type.T;  name: String.T;  VAR value: Value.T): BOOLEAN =
  BEGIN
    TYPECASE Type.Strip (t) OF
    | NULL => RETURN FALSE;
    | P(p) => value := Scope.LookUp (p.scope, name, TRUE);
              RETURN (value # NIL);
    ELSE RETURN FALSE;
    END;
  END LookUp;

(************************************************************************)

PROCEDURE Create (elts: Scope.T): P =
  VAR p: P;
  BEGIN
    p := NEW (P);
    TypeRep.Init (p);
    p.scope := elts;
    p.nElts := 0;
    RETURN p;
  END Create;

PROCEDURE SetSize (t: Type.T; size: INTEGER) =
  BEGIN
    SetRep (t, size);
  END SetSize;

PROCEDURE SetRep (p: P; size:= 0) =
  BEGIN
    IF size = 0 THEN size := p.nElts - 1; END;
    IF    (size <= Target.MAXUCHAR)  THEN p.rep := Rep.u_char;
    ELSIF (size <= Target.MAXUSHORT) THEN p.rep := Rep.u_short;
    ELSE                                  p.rep := Rep.s_int;
    END;
  END SetRep;

PROCEDURE MyClass (<*UNUSED*> p: P): TypeRep.Class =
  BEGIN
    RETURN TypeRep.Class.Enum;
  END MyClass;

PROCEDURE Check (p: P) =
  VAR objs: Scope.ValueList;  n, x: INTEGER;  cs := M3.OuterCheckState;
  BEGIN
    Scope.TypeCheck (p.scope, cs);
    x := 37;
    Scope.ToList (p.scope, objs, n);
    FOR i := 0 TO n - 1 DO
      x := Word.Plus (Word.Times (x, 67), String.Hash (Value.CName (objs[i])));
    END;
    p.hash := x;
  END Check;

PROCEDURE Split (t: Type.T; nElts: INTEGER; elts: Scope.T) : BOOLEAN =
  BEGIN
    TYPECASE Type.Strip (t) OF
    | NULL => RETURN FALSE;
    | P(p) => nElts:= p.nElts; elts := p.scope;  RETURN TRUE;
    ELSE      RETURN FALSE;
    END;
  END Split;

PROCEDURE Compiler (p: P) =
  CONST RepMap = ARRAY Rep OF TEXT{
                   "unsigned char\n", "unsigned short\n", "int\n"};
  BEGIN
    Emit.OpF ("\003#define @ ", p);
    Emit.Op (RepMap [p.rep]);

    IF TypeRep.StartLinkInfo (p) THEN RETURN END;

    Emit.Op  ("C\n");
    Emit.OpF ("\003#define @ ", p);
    Emit.Op  (RepMap [p.rep]);
    Emit.Op  ("*\n");
  END Compiler;

PROCEDURE EqualChk (a: P;  t: Type.T;  <*UNUSED*>x: Type.Assumption): BOOLEAN =
  VAR
    b      : P;
    na, nb : INTEGER;
    oa, ob : Value.T;
    objs_a : Scope.ValueList;
    objs_b : Scope.ValueList;
  BEGIN
    TYPECASE Type.Strip (t) OF
    | NULL => RETURN FALSE;
    | P(p) => b := p;
    ELSE      RETURN FALSE;
    END;

    IF (a.nElts # b.nElts) THEN RETURN FALSE END;
    IF (a.nElts = 0) THEN RETURN TRUE END;
    IF (a.scope = NIL) OR (b.scope = NIL) THEN
      RETURN (a.scope = b.scope);
    END;

    (* get a handle on the elements *)
    Scope.ToList (a.scope, objs_a, na);  <* ASSERT na = a.nElts *>
    Scope.ToList (b.scope, objs_b, nb);  <* ASSERT nb = b.nElts *>

    (* compare the elements *)
    FOR i := 0 TO na - 1 DO
      oa := objs_a[i];
      ob := objs_b[i];
      IF EnumElt.OrdValue (oa) # EnumElt.OrdValue (ob) THEN RETURN FALSE END;
      IF Value.CName (oa) # Value.CName (ob) THEN RETURN FALSE END;
    END;

    RETURN TRUE;
  END EqualChk;

PROCEDURE Subtyper (a: P;  t: Type.T): BOOLEAN =
  BEGIN
    RETURN EqualChk (a, t, NIL);
  END Subtyper;

PROCEDURE Counter (p: P): INTEGER =
  BEGIN
    RETURN p.nElts;
  END Counter;

PROCEDURE Bounder (p: P;  VAR min, max: INTEGER): BOOLEAN =
  BEGIN
    min := 0;
    max := p.nElts - 1;
    RETURN TRUE;
  END Bounder;

PROCEDURE Sizer (p: P): INTEGER =
  BEGIN
    CASE p.rep OF 
    | Rep.s_int   => RETURN (Target.INTSIZE);
    | Rep.u_char  => RETURN (Target.CHARSIZE);
    | Rep.u_short => RETURN (Target.SHORTSIZE);
    END;
  END Sizer;

PROCEDURE MinSizer (p: P): INTEGER =
  VAR i, j, n: INTEGER;
  BEGIN
    IF (p = NIL) THEN RETURN 0 END;
    j := 1;  i := 2;  n := p.nElts;
    WHILE (n > i) DO INC (j); INC (i, i);  END;
    RETURN j;
  END MinSizer;

PROCEDURE Aligner (p: P): INTEGER =
  BEGIN
    CASE p.rep OF 
    | Rep.s_int   => RETURN (Target.INTALIGN);
    | Rep.u_char  => RETURN (Target.CHARALIGN);
    | Rep.u_short => RETURN (Target.SHORTALIGN);
    END;
  END Aligner;

PROCEDURE IsEmpty (p: P): BOOLEAN =
  BEGIN
    RETURN (p.nElts <= 0);
  END IsEmpty;

PROCEDURE InitCoster (p: P;  zeroed: BOOLEAN): INTEGER =
  BEGIN
    IF (p.nElts <= 0) OR (zeroed) THEN RETURN 0; END;
    CASE p.rep OF
    | Rep.u_char   => RETURN ORD (p.nElts < Target.MAXUCHAR + 1);
    | Rep.u_short  => RETURN ORD (p.nElts < Target.MAXUSHORT + 1);
    ELSE              RETURN 1;
    END;
  END InitCoster;

PROCEDURE GenInit (<*UNUSED*> p: P) =
  BEGIN
    Emit.Op ("0");
  END GenInit;

PROCEDURE FPrinter (p: P;  <*UNUSED*> map: Type.FPMap;  wr: MBuf.T) =
  VAR n: INTEGER;  elts: Scope.ValueList;
  BEGIN
    IF Type.IsEqual (p, CChar.T, NIL) THEN
      MBuf.PutText (wr, "$char");
    ELSIF Type.IsEqual (p, Bool.T, NIL) THEN
      MBuf.PutText (wr, "$boolean");
    ELSE
      MBuf.PutText (wr, "ENUM");
      Scope.ToList (p.scope, elts, n);
      FOR i := 0 TO n - 1 DO
        (* NOTE: we're assuming that the values are in the correct order *)
        MBuf.PutText (wr, " ");
        String.Put (wr, Value.CName (elts[i]));
      END;
    END;
  END FPrinter;

BEGIN
END EnumType.