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

(* File: SetType.m3                                            *)
(* Last modified on Fri Mar  6 14:56:40 PST 1992 by kalsow     *)
(*      modified on Wed Sep 26 19:01:24 1990 by muller         *)

MODULE SetType;

IMPORT Type, TypeRep, Emit, Target, Error, Token, Scanner, Word, MBuf;
IMPORT ParamCode;

CONST
  Grain = Target.INTSIZE;

TYPE
  P = Type.T OBJECT
	range      : Type.T;
      OVERRIDES
        check      := Check;
        base       := TypeRep.SelfBase;
        isEqual    := EqualChk;
        isSubtype  := Subtyper;
        count      := TypeRep.NotOrdinal;
        bounds     := TypeRep.NotBounded;
        size       := Sizer;
        minSize    := MinSizer;
        alignment  := Aligner;
	isEmpty    := TypeRep.IsNever;
        dependsOn  := DependsOn;
        compile    := Compiler;
        initCost   := InitCoster;
        initValue  := GenInit;
        paramEncoding := ParamEnc;
        mapper     := TypeRep.NoMapper;
        fprint     := FPrinter;
        class      := MyClass;
      END;

PROCEDURE Parse (READONLY fail: Token.Set): Type.T =
  TYPE TK = Token.T;
  BEGIN
    Scanner.Match (TK.tSET, fail, Token.Set {TK.tOF} + Token.TypeStart);
    Scanner.Match (TK.tOF, fail, Token.TypeStart);
    RETURN New (Type.Parse (fail));
  END Parse;

PROCEDURE New (range: Type.T): Type.T =
  VAR p: P;
  BEGIN
    p := NEW (P);
    TypeRep.Init (p);
    p.range := range;
    RETURN p;
  END New;

PROCEDURE Split (t: Type.T;  VAR range: Type.T): BOOLEAN =
  BEGIN
    TYPECASE Type.Strip (t) OF
    | NULL => RETURN FALSE;
    | P(p) => range := p.range;  RETURN TRUE;
    ELSE      RETURN FALSE;
    END;
  END Split;

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

PROCEDURE Check (p: P) =
  BEGIN
    Type.Check (p.range);
    IF (Type.Number (p.range) < 0) THEN
      Error.Msg ("domain of a set type must be an ordinal type");
    END;
    p.hash := Word.Times (811, p.range.hash);
  END Check;

PROCEDURE Compiler (p: P) =
  VAR n: INTEGER;
  BEGIN
    Type.Compile (p.range);

    n := Type.Number (p.range);
    n := (n + Grain - 1) DIV Grain;
    n := MAX (n, 1);
    Emit.OpI ("typedef struct { int elts[@]; } ", n);
    Emit.OpF ("@;\n", p);

    IF TypeRep.StartLinkInfo (p) THEN RETURN END;

    Emit.Op ("C\n");
    Emit.OpI ("typedef struct { int elts[@]; } ", n);
    Emit.OpF ("@;\n", p);
    Emit.Op ("*\n");
  END Compiler;

PROCEDURE EqualChk (a: P;  t: Type.T;  x: Type.Assumption): BOOLEAN =
  BEGIN
    TYPECASE Type.Strip (t) OF
    | NULL => RETURN FALSE;
    | P(b) => RETURN Type.IsEqual (a.range, b.range, x);
    ELSE      RETURN FALSE;
    END;
  END EqualChk;

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

PROCEDURE Sizer (p: P): INTEGER =
  BEGIN
    RETURN (Type.Number (p.range) + Grain - 1) DIV Grain * Grain;
  END Sizer;

(*** The current implementation doesn't support packed sets ***)
PROCEDURE MinSizer (p: P): INTEGER =
  BEGIN
    RETURN Sizer (p);
    (* RETURN Type.Number (p.range); *)
  END MinSizer;

PROCEDURE Aligner (<*UNUSED*> t: Type.T): INTEGER =
  BEGIN
    RETURN MAX (Target.INTALIGN, Target.STRUCTURESIZEBOUNDARY);
  END Aligner;

PROCEDURE DependsOn (p: P;  t: Type.T): BOOLEAN =
  BEGIN
    RETURN Type.DependsOn (p.range, t);
  END DependsOn;

PROCEDURE InitCoster (<*UNUSED*> p: P; <*UNUSED*> zeroed: BOOLEAN): INTEGER =
  BEGIN
    RETURN 0;
  END InitCoster;

PROCEDURE GenInit (<*UNUSED*> p: P) =
  BEGIN
    <* ASSERT FALSE *>
  END GenInit;

PROCEDURE ParamEnc (p: P): TEXT =
  VAR s: CARDINAL := Type.Size (p);
      enc: TEXT := "";
  BEGIN
    <* ASSERT s MOD Grain = 0 *>
    s := s DIV Grain;
    WHILE s # 0 DO
      enc := enc & ParamCode.Word;  DEC( s )
    END;
    RETURN enc
  END ParamEnc;

PROCEDURE FPrinter (p: P;  map: Type.FPMap;  wr: MBuf.T) =
  BEGIN
    MBuf.PutText (wr, "SET ");
    Type.Fingerprint (p.range, map, wr);
  END FPrinter;

BEGIN
END SetType.