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

(* File: SetExpr.m3                                            *)
(* Last modified on Fri May 29 16:20:09 PDT 1992 by muller     *)
(*      modified on Tue May 12 08:31:11 PDT 1992 by kalsow     *)

MODULE SetExpr;

IMPORT Expr, ExprRep, Type, Error, IntegerExpr, EnumExpr;
IMPORT RangeExpr, KeywordExpr, SetType, AssignStmt, CompareExpr;
IMPORT Int, Target, Emit, Temp, MBuf, Bool, String, Word, Frame;

TYPE
  Node = UNTRACED REF RECORD
    next : Node;
    min  : INTEGER;
    max  : INTEGER;
  END;

TYPE
  P = Expr.T OBJECT
        tipe    : Type.T;
        args    : Expr.List;
        mapped  : BOOLEAN;
        tree    : Node;
        others  : Expr.List;
        nOthers : INTEGER;
      OVERRIDES
        typeOf       := ExprRep.NoType;
        check        := Check;
        compile      := Compile;
        evaluate     := Fold;
        fprint       := FPrinter;
        write        := ExprRep.NoWriter;
        isEqual      := EqCheck;
        getBounds    := ExprRep.NoBounds;
        isWritable   := ExprRep.IsNever;
        isDesignator := ExprRep.IsNever;
        isZeroes     := IsZeroes;
        note_write   := ExprRep.NotWritable;
        genLiteral   := GenLiteral;
      END;

TYPE
  VisitState = RECORD
    a, b       : Node;    (* private to the iterator *)
    amin, amax : INTEGER; (* " *)
    bmin, bmax : INTEGER; (* " *)
    min, max   : INTEGER; (* resulting range *)
    inA, inB   : BOOLEAN; (* location of resulting range *)
  END;

VAR full: INTEGER;        
VAR left, right: ARRAY [0..Target.INTSIZE] OF INTEGER;
VAR setelts: String.T := NIL;

PROCEDURE New (type: Type.T;  args: Expr.List): Expr.T =
  VAR p: P;
  BEGIN
    p := NEW (P);
    ExprRep.Init (p);
    p.type    := type;
    p.tipe    := type;
    p.args    := args;
    p.mapped  := FALSE;
    p.tree    := NIL;
    p.others  := NIL;
    p.nOthers := -1;
    RETURN p;
  END New;

PROCEDURE NewFromTree (p: P;  node: Node): Expr.T =
  VAR c: P;
  BEGIN
    c := NEW (P);
    c.origin  := p.origin;
    c.type    := p.type;
    c.checked := p.checked;
    c.tipe    := p.tipe;
    c.args    := p.args;
    c.mapped  := TRUE;
    c.tree    := NormalizeTree (node);
    c.others  := NIL;
    p.nOthers := -1;
    RETURN c;
  END NewFromTree;

PROCEDURE Is (e: Expr.T): BOOLEAN =
  BEGIN
    RETURN (TYPECODE (e) = TYPECODE (P));
  END Is;

PROCEDURE Compare (a, b: Expr.T;  VAR sign: INTEGER): BOOLEAN =
  VAR p, q: P;  le, eq, ge: BOOLEAN := TRUE;  s: VisitState;
  BEGIN
    IF NOT CheckPair (a, b, p, q) THEN RETURN FALSE END;
    SetupVisit (s, p.tree, q.tree);
    WHILE Visit (s) DO
      IF (s.min <= s.max) THEN
        (* we got a non-empty range *)
        IF (s.inA) AND (NOT s.inB) THEN
          eq := FALSE;  le := FALSE;
        ELSIF (s.inB) AND (NOT s.inA) THEN
          eq := FALSE;  ge := FALSE;
        END;
      END;
    END;
    IF    (le AND NOT eq) THEN sign :=  -1
    ELSIF (ge AND NOT eq) THEN sign := 1
    ELSIF (eq)            THEN sign := 0
    ELSE                       sign :=  -99;
    END;
    RETURN TRUE;
  END Compare;

PROCEDURE Union (a, b: Expr.T;  VAR c: Expr.T): BOOLEAN =
  VAR p, q: P;  n, x: Node;
  BEGIN
    IF NOT CheckPair (a, b, p, q) THEN RETURN FALSE END;
    n := NIL;
    x := p.tree;
    WHILE (x # NIL) DO
      n := AddNode (n, x.min, x.max);
      x := x.next;
    END;
    x := q.tree;
    WHILE (x # NIL) DO
      n := AddNode (n, x.min, x.max);
      x := x.next;
    END;
    c := NewFromTree (p, n);
    RETURN TRUE;
  END Union;

PROCEDURE Intersection (a, b: Expr.T;  VAR c: Expr.T): BOOLEAN =
  VAR p, q: P;  n: Node;  s: VisitState;
  BEGIN
    IF NOT CheckPair (a, b, p, q) THEN RETURN FALSE END;
    n := NIL;
    SetupVisit (s, p.tree, q.tree);
    WHILE Visit (s) DO
      IF (s.min <= s.max) AND (s.inA) AND (s.inB) THEN
        n := AddNode (n, s.min, s.max);
      END;
    END;
    c := NewFromTree (p, n);
    RETURN TRUE;
  END Intersection;

PROCEDURE Difference (a, b: Expr.T;  VAR c: Expr.T): BOOLEAN =
  VAR p, q: P;  n: Node;  s: VisitState;
  BEGIN
    IF NOT CheckPair (a, b, p, q) THEN RETURN FALSE END;
    n := NIL;
    SetupVisit (s, p.tree, q.tree);
    WHILE Visit (s) DO
      IF (s.min <= s.max) AND (s.inA) AND (NOT s.inB) THEN
        n := AddNode (n, s.min, s.max);
      END;
    END;
    c := NewFromTree (p, n);
    RETURN TRUE;
  END Difference;

PROCEDURE SymDifference (a, b: Expr.T;  VAR c: Expr.T): BOOLEAN =
  VAR p, q: P;  n: Node;  s: VisitState;
  BEGIN
    IF NOT CheckPair (a, b, p, q) THEN RETURN FALSE END;
    n := NIL;
    SetupVisit (s, p.tree, q.tree);
    WHILE Visit (s) DO
      IF (s.min <= s.max) AND (s.inA # s.inB) THEN
        n := AddNode (n, s.min, s.max);
      END;
    END;
    c := NewFromTree (p, n);
    RETURN TRUE;
  END SymDifference;

PROCEDURE Include (set, elt: Expr.T;  VAR c: Expr.T): BOOLEAN =
  VAR p: P;  i: INTEGER;  n, x: Node;
  BEGIN
    IF NOT ConstElt (elt, i) THEN RETURN FALSE END;
    IF NOT BuildMap (set, p) THEN RETURN FALSE END;
    n := AddNode (NIL, i, i);
    x := p.tree;
    WHILE (x # NIL) DO
      n := AddNode (n, x.min, x.max);
      x := x.next;
    END;
    c := NewFromTree (p, n);
    RETURN TRUE;
  END Include;

PROCEDURE Exclude (set, elt: Expr.T;  VAR c: Expr.T): BOOLEAN =
  VAR p: P;  i: INTEGER;  n, x: Node;
  BEGIN
    IF NOT ConstElt (elt, i) THEN RETURN FALSE END;
    IF NOT BuildMap (set, p) THEN RETURN FALSE END;
    n := NIL;
    x := p.tree;
    WHILE (x # NIL) DO
      IF (x.min <= i) AND (i <= x.max) THEN
        n := AddNode (n, x.min, i-1);
        n := AddNode (n, i+1, x.max);
      ELSE
        n := AddNode (n, x.min, x.max);
      END;
      x := x.next;
    END;
    c := NewFromTree (p, n);
    RETURN TRUE;
  END Exclude;

PROCEDURE Member (set, elt: Expr.T;  VAR c: Expr.T): BOOLEAN =
  VAR p: P;  i: INTEGER;  x: Node;
  BEGIN
    IF NOT ConstElt (elt, i) THEN RETURN FALSE END;
    IF NOT BuildMap (set, p) THEN RETURN FALSE END;
    x := p.tree;
    WHILE (x # NIL) DO
      IF (x.min <= i) AND (i <= x.max) THEN
        c := Bool.Map [TRUE];
        RETURN TRUE;
      END;
      x := x.next;
    END;
    c := Bool.Map [FALSE];
    RETURN TRUE;
  END Member;

PROCEDURE ConstElt (elt: Expr.T;  VAR i: INTEGER): BOOLEAN =
  VAR t: Type.T;
  BEGIN
    elt := Expr.ConstValue (elt);
    IF (elt = NIL) THEN RETURN FALSE END;
    RETURN IntegerExpr.Split (elt, i) OR EnumExpr.Split (elt, i, t);
  END ConstElt;

PROCEDURE CheckPair (a, b: Expr.T;  VAR p, q: P): BOOLEAN =
  BEGIN
    RETURN BuildMap (a, p)
       AND BuildMap (b, q)
       AND Type.IsEqual (p.tipe, q.tipe, NIL);
  END CheckPair;

PROCEDURE SetupVisit (VAR s: VisitState;  x, y: Node) =
  BEGIN
    s.a := x;
    s.b := y;
    IF (x # NIL) THEN s.amin := x.min;  s.amax := x.max END;
    IF (y # NIL) THEN s.bmin := y.min;  s.bmax := y.max END;
  END SetupVisit;

PROCEDURE Visit (VAR s: VisitState): BOOLEAN =
  BEGIN
    IF (s.a = NIL) AND (s.b = NIL) THEN
      (* both lists are empty *)
      RETURN FALSE;
    ELSIF (s.a = NIL) THEN
      (* A list is empty *)
      s.min := s.bmin;  s.max := s.bmax;  s.inA := FALSE;  s.inB := TRUE;
      s.bmin := s.bmax+1;
    ELSIF (s.b = NIL) THEN
      (* B list is empty *)
      s.min := s.amin;  s.max := s.amax;  s.inA := TRUE;  s.inB := FALSE;
      s.amin := s.amax+1;
    ELSE (* both lists are non-empty *)
      IF (s.amin < s.bmin) THEN
        s.min := s.amin;    s.inA := TRUE;  s.inB := FALSE;
        IF (s.amax < s.bmin) THEN
          s.max := s.amax;  s.amin := s.amax+1;
        ELSE (* s.amax >= s.bmin *)
          s.max := s.bmin-1;  s.amin := s.bmin;  s.bmin := s.amin;
        END;
      ELSIF (s.amin = s.bmin) THEN
        s.min := s.amin;  s.inA := TRUE;  s.inB := TRUE;
        IF (s.amax <= s.bmax) THEN
          s.max := s.amax;  s.amin := s.amax + 1;
        ELSE (* s.amax > s.bmax *)
          s.max := s.bmax;  s.amin := s.bmax+1;
        END;
        s.bmin := s.amin;
      ELSE (* s.amin > s.bmin *)
        s.min := s.bmin;  s.inA := FALSE;   s.inB := TRUE;
        IF (s.amin > s.bmax) THEN
          s.max := s.bmax;  s.bmin := s.bmax+1;
        ELSE (* s.amin <= s.bmax *)
          s.max := s.amin-1;  s.amin := s.amin;  s.bmin := s.amin;
        END;
      END;
    END;
    IF (s.amin > s.amax) AND (s.a # NIL) THEN
      s.a := s.a.next;
      IF (s.a # NIL) THEN s.amin := s.a.min;  s.amax := s.a.max  END;
    END;
    IF (s.bmin > s.bmax) AND (s.b # NIL) THEN
      s.b := s.b.next;
      IF (s.b # NIL) THEN s.bmin := s.b.min;  s.bmax := s.b.max  END;
    END;
    RETURN TRUE;
  END Visit;

PROCEDURE BuildMap (e: Expr.T;  VAR p: P): BOOLEAN =
  VAR
    t, range: Type.T;
    elt, eMin, eMax: Expr.T;
    from, to, min, max: INTEGER;
  BEGIN
    TYPECASE e OF
    | NULL => RETURN FALSE;
    | P(x) => p := x;
    ELSE      RETURN FALSE;
    END;
    IF (p.mapped) THEN RETURN (p.others = NIL) END;
    p.mapped := TRUE;
    IF NOT SetType.Split (p.tipe, range) THEN RETURN FALSE END;
    EVAL Type.GetBounds (range, min, max);
    IF (max < min) THEN RETURN FALSE END;
    FOR i := 0 TO LAST (p.args^) DO
      elt := Expr.ConstValue (p.args[i]);
      IF (elt = NIL) THEN
        (* not a constant *)
        AddOther (p, p.args[i]);
      ELSIF IntegerExpr.Split (elt, from) OR EnumExpr.Split (elt, from, t) THEN
        IF (from < min) OR (max < from)
          THEN Error.Warn (2, "set element out of range"); AddOther (p, elt);
          ELSE p.tree := AddNode (p.tree, from, from);
        END;
      ELSIF (RangeExpr.Split (elt, eMin, eMax)) THEN
        eMin := Expr.ConstValue (eMin);
        eMax := Expr.ConstValue (eMax);
        IF (eMin # NIL) AND (eMax # NIL)
          AND (IntegerExpr.Split (eMin,from) OR EnumExpr.Split (eMin, from, t))
          AND (IntegerExpr.Split (eMax, to)  OR EnumExpr.Split (eMax, to, t))
          THEN
          IF (from < min) OR (max < from)
            THEN Error.Warn (2, "set element out of range"); AddOther (p, elt);
            ELSE p.tree := AddNode (p.tree, from, to);
          END;
        ELSE (* not a constant range *)
          AddOther (p, elt);
        END;
      ELSE
        Error.Warn (2, "set element is not an ordinal");
        AddOther (p, elt);
      END;
    END;
    p.tree := NormalizeTree (p.tree);
    RETURN (p.others = NIL);
  END BuildMap;

PROCEDURE AddOther (p: P;  elt: Expr.T) =
  BEGIN
    IF (p.others = NIL) THEN
      p.others := NEW (Expr.List, NUMBER (p.args^));
      p.nOthers := 0;
    END;
    p.others[p.nOthers] := elt;
    INC (p.nOthers);
  END AddOther;

PROCEDURE AddNode (n: Node;  min, max: INTEGER): Node =
  VAR x: Node;
  BEGIN
    IF (min > max) THEN RETURN n END;
    x := n;
    LOOP
      IF (x = NIL) THEN
        x := NEW (Node);  x.next := n;  x.min := min;  x.max := max;
        RETURN x;
      END;
      IF ((x.min <= min) AND (min <= x.max))
        OR ((x.min <= max) AND (max <= x.min)) THEN
        x.min := MIN (x.min, min);
        x.max := MAX (x.max, max);
        RETURN n;
      END;
      x := x.next;
    END;
  END AddNode;

PROCEDURE NormalizeTree (n: Node): Node =
  VAR x1, x2, x3: Node;  done: BOOLEAN;
  BEGIN
    IF (n = NIL) THEN RETURN NIL END;

    (* destructively sort the input list *)
    done := FALSE;
    WHILE (NOT done) DO
      done := TRUE;
      x1 := n.next;  x2 := n;  x3 := NIL;
      WHILE (x1 # NIL) DO
        IF (x1.min < x2.min) THEN
          (* swap x1 and x2 *)
          x2.next := x1.next;
          x1.next := x2;
          IF (x3 = NIL) THEN n := x1 ELSE x3.next := x1 END;
          x2 := x1;
          x1 := x2.next;
          done := FALSE;
        END;
        x3 := x2;  x2 := x1;  x1 := x1.next;
      END;
    END;

    (* merge adjacent nodes *)
    x1 := n.next;  x2 := n;
    WHILE (x1 # NIL) DO
      IF (x2.min <= x1.min) AND (x1.min <= x2.max) THEN
        x2.max := MAX (x2.max, x1.max);
        x1 := x1.next;
        x2.next := x1;
      ELSE
        x2 := x1;  x1 := x1.next;
      END;
    END;

    RETURN n;
  END NormalizeTree;

PROCEDURE Check (p: P;  VAR cs: Expr.CheckState) =
  VAR
    t, range   : Type.T;
    minT, maxT : INTEGER;
    minE, maxE : INTEGER;
    min, max   : Expr.T;
    e1, e2     : Expr.T;
    e, value   : Expr.T;
    key        : String.T;
  BEGIN
    Type.Check (p.tipe);
    FOR i := 0 TO LAST (p.args^) DO Expr.TypeCheck (p.args[i], cs) END;
    p.type := p.tipe;
    IF NOT SetType.Split (p.tipe, range) THEN
      Error.Msg ("set constructor must specify a set type");
      RETURN;
    END;
    EVAL Type.GetBounds (range, minT, maxT);
    FOR i := 0 TO LAST (p.args^) DO
      e := p.args[i];
      t := Expr.TypeOf (e);

      IF KeywordExpr.Split (e, key, value) THEN
        Error.Msg ("keyword values not allowed in set constructors");
        e := value;
        p.args[i] := value;
      END;

      IF RangeExpr.Split (e, min, max) THEN
        (* do any required range checks *)
        e1 := AssignStmt.CheckRHS (range, min, cs);
        e2 := AssignStmt.CheckRHS (range, max, cs);
        IF (min # e1) OR (max # e2) THEN
          (* build a new range expr with checking *)
          e := RangeExpr.New (e1, e2);
          Expr.TypeCheck (e, cs);
          p.args[i] := e;
          min := e1;
          max := e2;
        END;
        min := Expr.ConstValue (min);
        max := Expr.ConstValue (max);
      ELSE (* single value *)
        e1 := AssignStmt.CheckRHS (range, e, cs);
        IF (e # e1) THEN
          (* remember the checked expr *)
          p.args[i] := e1;
          e := e1;
        END;
        min := Expr.ConstValue (e);
        max := min;
      END;

      IF (min # NIL) AND (max # NIL)
        AND (IntegerExpr.Split (min,minE) OR EnumExpr.Split (min,minE,t))
        AND (IntegerExpr.Split (max,maxE) OR EnumExpr.Split (max,maxE,t)) THEN
        IF (minE < minT) OR (maxT < maxE) THEN
          Error.Msg ("illegal set value");
        END;
      END;

    END;
  END Check;

PROCEDURE EqCheck (a: P;  e: Expr.T): BOOLEAN =
  VAR b: P;  ax, bx: Expr.T;
  BEGIN
    TYPECASE e OF
    | NULL  => RETURN FALSE;
    | P(bb) => b := bb;
    ELSE       RETURN FALSE;
    END;

    IF (NOT Type.IsEqual (a.tipe, b.tipe, NIL))
      OR ((a.args = NIL) # (b.args = NIL))
      OR ((a.args # NIL) AND (NUMBER (a.args^) # NUMBER (b.args^))) THEN
      RETURN FALSE;
    END;

    FOR i := 0 TO LAST (a.args^) DO
      ax := Expr.ConstValue (a.args[i]);
      IF (ax = NIL) THEN ax := a.args[i] END;
      bx := Expr.ConstValue (b.args[i]);
      IF (bx = NIL) THEN bx := b.args[i] END;
      IF NOT Expr.IsEqual (ax, bx) THEN RETURN FALSE END;
    END;

    RETURN TRUE;
  END EqCheck;

PROCEDURE Compile (p: P): Temp.T =
  VAR
    range      : Type.T;
    w1, w2     : INTEGER;
    b1, b2     : INTEGER;
    minT, maxT : INTEGER;
    min, max   : Expr.T;
    e          : Expr.T;
    t1, t2     : Temp.T;
    t3, t4     : Temp.T;
    nAssigns   : INTEGER;
    nWords     : INTEGER;
    zeroed     : BOOLEAN;
    lastDone   : INTEGER;
    curWord    : INTEGER;
    curMask    : INTEGER;
    n          : Node;
    block      : INTEGER;
    ss         : String.Stack;
  BEGIN
    Type.Compile (p.tipe);

    VAR b := SetType.Split (p.tipe, range); BEGIN <* ASSERT b *> END;
    EVAL Type.GetBounds (range, minT, maxT);

    EVAL BuildMap (p, p);  (* evaluate the constants *)
    nAssigns := CountWords (p.tree, minT);
    nWords := Type.Size (p.tipe) DIV Target.INTSIZE;

    t1 := Temp.Alloc (p);

    (* first, zero the set *)
    zeroed := (nWords > 4) AND (nAssigns + nAssigns < nWords);
    IF (zeroed) THEN
      Frame.PushBlock (block, 1);
      Emit.Op ("register int* _set_elts;\n");
      Emit.OpT ("_set_elts = @.elts;\n", t1);
      IF (setelts = NIL) THEN setelts := String.Add ("(*_set_elts)") END;
      ss.stk[0] := setelts;  ss.top := 1;
      Emit.Zero (p.tipe, ss);
      Frame.PopBlock (block);
    END;

    (* generate the constant words *)
    n := p.tree;  curWord := 0;   curMask := 0;  lastDone := -1;
    WHILE (n # NIL) DO
      w1 := (n.min - minT) DIV Target.INTSIZE; 
      b1 := (n.min - minT) MOD Target.INTSIZE;
      w2 := (n.max - minT) DIV Target.INTSIZE;
      b2 := (n.max - minT) MOD Target.INTSIZE;
      IF (w1 # curWord) THEN
        IF (NOT zeroed) THEN
          FOR i := lastDone+1 TO curWord-1 DO  EmitAssign (t1, i, 0) END;
        END;
        EmitAssign (t1, curWord, curMask);
        lastDone := curWord;
        curWord := w1;
        curMask := 0;
      END;
      IF (w1 # w2) THEN
        EmitAssign (t1, w1, Word.Or (curMask, left [b1]));
        FOR i := w1 + 1 TO w2 - 1 DO  EmitAssign (t1, i, full)  END;
        lastDone := w2 - 1;
        curWord := w2;
        curMask := right [b2];
      ELSE (* x = y *)
        curMask := Word.Or (curMask, Word.And (left [b1], right[b2]));
      END;
      n := n.next;
    END; (* while *)

    (* write zeros up to the last pending mask *)
    IF (NOT zeroed) THEN
      FOR i := lastDone+1 TO curWord-1 DO  EmitAssign (t1, i, 0)  END;
    END;

    (* write the last mask *)
    EmitAssign (t1, curWord, curMask);

    (* write zeros for the remainder of the set *)
    IF (NOT zeroed) THEN
      FOR i := curWord+1 TO nWords-1 DO EmitAssign (t1, i, 0) END;
    END;

    (* finally, add the non-constant elements *)
    t4 := Temp.AllocEmpty (Int.T);
    FOR i := 0 TO p.nOthers-1 DO
      e := p.others[i];
      IF RangeExpr.Split (e, min, max) THEN
        t2 := Expr.Compile (min);
        t3 := Expr.Compile (max);
        Emit.OpT ("_INCL (@.elts, ", t1);
        Emit.OpT ("@", t2);   IF (minT # 0) THEN Emit.OpI (" - @", minT) END;
        Emit.OpT (", @", t3); IF (minT # 0) THEN Emit.OpI (" - @", minT) END;
        Emit.Op (");\n");
        Temp.Free (t2);
        Temp.Free (t3);
      ELSE (* single value *)
        t2 := Expr.Compile (e);
        Emit.OpTT ("@ = @", t4, t2);
        IF (minT # 0) THEN Emit.OpI (" - @", minT) END;
        IF (nWords <= 1) THEN
          Emit.OpTT (";\n@.elts[0] |= 1 << @;\n", t1, t4);
        ELSE
          Emit.OpTT (";\n@.elts[@ / ", t1, t4);
          Emit.OpI  ("@] |= 1 << ", Target.INTSIZE);
          Emit.OpTI ("(@ % @);\n", t4, Target.INTSIZE);
        END;
        Temp.Free (t2);
      END;
    END;
    Temp.Free (t4);

    RETURN t1;
  END Compile;

PROCEDURE CountWords (n: Node;  base: INTEGER): INTEGER =
  VAR nWords := 0;  lastWord := -1;  x, y: INTEGER;
  BEGIN
    WHILE (n # NIL) DO
      <* ASSERT (base <= n.min) AND (n.min <= n.max) *>
      x := (n.min - base) DIV Target.INTSIZE;
      y := (n.max - base) DIV Target.INTSIZE;
      IF (x = lastWord) THEN INC (x) END;
      IF (x <= y) THEN  INC (nWords, y-x+1);  lastWord := y  END;
      n := n.next;
    END;
    RETURN nWords;
  END CountWords;

PROCEDURE EmitAssign (set: Temp.T;  index, value: INTEGER) =
  BEGIN
    IF (value = 0) THEN
      Emit.OpTI ("@.elts [@] = 0;\n", set, index);
    ELSE
      Emit.OpTI ("@.elts [@] = ", set, index);
      Emit.OpH  ("0x@;\n", value);
    END;
  END EmitAssign;

PROCEDURE Fold (e: Expr.T): Expr.T =
  VAR p: P;
  BEGIN
    IF BuildMap (e, p)
      THEN RETURN e;
      ELSE RETURN NIL;
    END;
  END Fold;

PROCEDURE FPrinter (p: P;  map: Type.FPMap;  wr: MBuf.T) =
  BEGIN
    Type.Fingerprint (p.tipe, map, wr);
    FOR i := 0 TO LAST (p.args^) DO
      Expr.Fingerprint (p.args[i], map, wr);
    END;
  END FPrinter;

PROCEDURE IsZeroes (p: P): BOOLEAN =
  BEGIN
    RETURN (p.args = NIL) OR (NUMBER (p.args^) <= 0);
  END IsZeroes;

PROCEDURE GenLiteral (p: P) =
  VAR
    j          : INTEGER;
    range      : Type.T;
    minT, maxT : INTEGER;
    w1, w2     : INTEGER;
    b1, b2     : INTEGER;
    curWord    : INTEGER;
    curMask    : INTEGER;
    lastDone   : INTEGER;
    n          : Node;
  BEGIN
    VAR b: BOOLEAN := SetType.Split (p.tipe, range);
    BEGIN <* ASSERT b *> END;
    EVAL Type.GetBounds (range, minT, maxT);

    EVAL BuildMap (p, p);
    <* ASSERT p.others = NIL *>

    Emit.Op ("{{\001 ");   j := 0;

    n := p.tree;  curWord := 0;   curMask := 0;  lastDone := -1;
    WHILE (n # NIL) DO
      w1 := (n.min - minT) DIV Target.INTSIZE;
      b1 := (n.min - minT) MOD Target.INTSIZE;
      w2 := (n.max - minT) DIV Target.INTSIZE;
      b2 := (n.max - minT) MOD Target.INTSIZE;
      IF (w1 # curWord) THEN
        FOR i := lastDone+1 TO curWord-1 DO  EmitOne (0, j) END;
        EmitOne (curMask, j);
        lastDone := curWord;
        curWord := w1;
        curMask := 0;
      END;
      IF (w1 # w2) THEN
        EmitOne (Word.Or (curMask, left [b1]), j);
        FOR i := w1 + 1 TO w2 - 1 DO EmitOne (full, j) END;
        lastDone := w2 - 1;
        curWord := w2;
        curMask := right [b2];
      ELSE
        curMask := Word.Or (curMask, Word.And (left [b1], right[b2]));
      END;
      n := n.next;
    END;

    (* write zeros up to the last pending mask *)
    FOR i := lastDone+1 TO curWord-1 DO EmitOne (0, j) END;

    (* write the last mask *)
    EmitOne (curMask, j);

    Emit.Op ("\002 }}");
  END GenLiteral;

PROCEDURE EmitOne (n: INTEGER;  VAR cnt: INTEGER) =
  BEGIN
    IF (cnt # 0) THEN Emit.Op (", ") END;
    IF (cnt MOD 8 = 7) THEN Emit.Op ("\n") END;
    IF (n = 0)
      THEN Emit.Op ("0");
      ELSE Emit.OpH ("0x@", n);
    END;
    INC (cnt);
  END EmitOne;

PROCEDURE CompileAssign (range: Type.T;  l, r: Temp.T) =
  VAR min, max, n: INTEGER;
  BEGIN
    EVAL Type.GetBounds (range, min, max);
    n := (max - min + Target.INTSIZE) DIV Target.INTSIZE;
    IF (n <= 4) THEN
      FOR i := 0 TO n - 1 DO
        Emit.OpTI ("@.elts[@] = ", l, i);
        Emit.OpTI ("@.elts[@];\n", r, i);
      END;
    ELSE
      Emit.OpTT ("@ = @;\n", l, r);
    END;
  END CompileAssign;

PROCEDURE NWords (t: Type.T): INTEGER =
  VAR range: Type.T;  b := SetType.Split (Type.Base (t), range);
  BEGIN
    <* ASSERT b *>
    RETURN (Type.Number (range) + Target.INTSIZE - 1) DIV Target.INTSIZE;
  END NWords;

PROCEDURE CompileOp (t1, t2, t3: Temp.T; t: Type.T;  op: TEXT) =
  VAR n := NWords (t);  index: Temp.T;
  BEGIN
    IF (n <= 4) THEN
      FOR i := 0 TO n - 1 DO
        Emit.OpTI ("@.elts[@] = ", t3, i);
        Emit.OpTI ("@.elts[@] ", t1, i);
        Emit.Op   (op);
        Emit.OpTI (" @.elts[@];\n", t2, i);
      END;
    ELSE
      index := Temp.AllocEmpty (Int.T);
      Emit.OpT  ("for (@ = 0; ", index);
      Emit.OpTI ("@ < @; ", index, n);
      Emit.OpT  ("@++) {\n\001", index);
      Emit.OpTT ("@.elts[@] = ", t3, index);
      Emit.OpTT ("@.elts[@] ", t1, index);
      Emit.Op   (op);
      Emit.OpTT (" @.elts[@];\n", t2, index);
      Emit.Op   ("\002}\n");
      Temp.Free (index);
    END;
  END CompileOp;

PROCEDURE CompileUnion (t1, t2, t3: Temp.T; t: Type.T) =
  BEGIN
    CompileOp (t1, t2, t3, t, "|");
  END CompileUnion;

PROCEDURE CompileInter (t1, t2, t3: Temp.T; t: Type.T) =
  BEGIN
    CompileOp (t1, t2, t3, t, "&");
  END CompileInter;

PROCEDURE CompileDiff (t1, t2, t3: Temp.T; t: Type.T) =
  BEGIN
    CompileOp (t1, t2, t3, t, "& ~");
  END CompileDiff;

PROCEDURE CompileDiv (t1, t2, t3: Temp.T; t: Type.T) =
  BEGIN
    CompileOp (t1, t2, t3, t, "^");
  END CompileDiv;

PROCEDURE CompileTCompare (t1,t2,t3: Temp.T; t: Type.T; op: CompareExpr.Op) =
  TYPE  Cmp      = CompareExpr.Op;
  CONST InitZero = SET OF Cmp { Cmp.LT, Cmp.NE, Cmp.GT };
  CONST Zero     = ARRAY BOOLEAN OF INTEGER { 1, 0 };
  VAR n := NWords (t);  index: Temp.T;
  BEGIN
    index := Temp.AllocEmpty (Int.T);
    Emit.OpTI ("@ = @;\n", t3, Zero [op IN InitZero]);
    Emit.OpT  ("for (@ = 0; ", index);
    Emit.OpTI ("@ < @; ", index, n);
    Emit.OpT  ("@++) {\n\001", index);
    CASE op OF
    | Cmp.LT => 
        Emit.OpTT ("if ((@.elts[@] & ~ ", t1, index);
        Emit.OpTT ("@.elts[@]) != 0) ", t2, index);
        Emit.OpT  ("{ @ = 0; break; }\n", t3);
        Emit.OpT  ("@ |= ", t3);
        Emit.OpTT ("(@.elts[@] != ", t1, index);
        Emit.OpTT ("@.elts[@]);\n", t2, index);
    | Cmp.LE => 
        Emit.OpTT ("if ((@.elts[@] & ~ ", t1, index);
        Emit.OpTT ("@.elts[@]) != 0) ", t2, index);
        Emit.OpT  ("{ @ = 0; break; }\n", t3);
    | Cmp.EQ =>
        Emit.OpTT ("if (@.elts[@] != ", t1, index);
        Emit.OpTT ("@.elts[@]) ", t2, index);
        Emit.OpT  ("{ @ = 0; break; }\n", t3);
    | Cmp.NE =>
        Emit.OpTT ("if (@.elts[@] != ", t1, index);
        Emit.OpTT ("@.elts[@]) ", t2, index);
        Emit.OpT  ("{ @ = 1; break; }\n", t3);
    | Cmp.GE =>
        Emit.OpTT ("if ((~@.elts[@] & ", t1, index);
        Emit.OpTT ("@.elts[@]) != 0) ", t2, index);
        Emit.OpT  ("{ @ = 0; break; }\n", t3);
    | Cmp.GT => 
        Emit.OpTT ("if ((~@.elts[@] & ", t1, index);
        Emit.OpTT ("@.elts[@]) != 0) ", t2, index);
        Emit.OpT  ("{ @ = 0; break; }\n", t3);
        Emit.OpT  ("@ |= ", t3);
        Emit.OpTT ("(@.elts[@] != ", t1, index);
        Emit.OpTT ("@.elts[@]);\n", t2, index);
    END;
    Emit.Op ("\002}\n");
    Temp.Free (index);
  END CompileTCompare;

PROCEDURE CompileLCompare (p1, p2: Temp.T;  label: INTEGER; t: Type.T) =
  VAR n := NWords (t);  index: Temp.T;
  BEGIN
    index := Temp.AllocEmpty (Int.T);
    Emit.OpT  ("for (@ = 0; ", index);
    Emit.OpTI ("@ < @; ", index, n);
    Emit.OpT  ("@++) {\001\n", index);
    Emit.OpF  ("if ((*(@*)", t);
    Emit.OpTT ("@).elts[@]", p1, index);
    Emit.Op   (" != ");
    Emit.OpF  ("(*(@*)", t);
    Emit.OpTT ("@).elts[@]) ", p2, index);
    Emit.OpL  ("goto @;\n\002}\n", label);
    Temp.Free (index);
  END CompileLCompare;
    
PROCEDURE CompileMember (e1, e2: Expr.T; t3: Temp.T; t: Type.T) =
  VAR
    range: Type.T;
    b := SetType.Split (Type.Base (t), range);
    min, max, i: INTEGER;
    emin, emax: INTEGER;
    t1, t2, offset: Temp.T;
  BEGIN
    <* ASSERT b *> 
    EVAL Type.GetBounds (range, min, max);
    IF NOT ConstElt (e2, i) THEN
      Expr.GetBounds (e2, emin, emax);
      t1 := Expr.Compile (e1);
      t2 := Expr.Compile (e2);
      offset := Temp.AllocEmpty (Int.T);
      Emit.OpTT ("@ = @", offset, t2);
      IF (min # 0) THEN Emit.OpI (" - @", min) END;
      Emit.OpT  (";\n@ = ", t3);
      IF (emin < min) THEN
        Emit.OpT  ("(0 <= @) && ", offset);
      END;
      IF (max < emax) THEN
        Emit.OpTI ("(@ <= @) && ", offset, max - min);
      END;
      Emit.OpT  ("((@.elts ", t1);
      IF (max - min < Target.INTSIZE) THEN
        Emit.OpT  ("[0] & (1 << @)) != 0);\n", offset);
      ELSE
        Emit.OpTI ("[@/@] ", offset, Target.INTSIZE);
        Emit.OpTI ("& (1 << (@ % @))) != 0);\n", offset, Target.INTSIZE);
      END;
      Temp.Free (offset);
      Temp.Free (t1);
      Temp.Free (t2);
    ELSIF min <= i AND i <= max THEN
      t1 := Expr.Compile (e1);
      i := i - min;
      Emit.OpTT ("@ = ((@.elts ", t3, t1);
      Emit.OpII ("[@] & (1 << @)) != 0);\n",
                 i DIV Target.INTSIZE, i MOD Target.INTSIZE);
      Temp.Free (t1);
    ELSE
      Emit.OpT ("@ = 0;\n", t3);
   END;
  END CompileMember;

BEGIN
  full := Word.Not (0);
  FOR i := 0 TO Target.INTSIZE - 1 DO
    right [i] := Word.Shift (full, i + 1 - Target.INTSIZE);
    left [i]  := Word.Shift (full, i);
  END;
END SetExpr.