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

(* File: CompareExpr.m3                                        *)
(* Last modified on Fri May 29 16:40:25 PDT 1992 by muller     *)
(*      modified on Wed Apr 15 09:52:46 PDT 1992 by kalsow     *)

MODULE CompareExpr;

IMPORT Expr, ExprRep, Type, Int, Reel, LReel, EReel;
IMPORT EnumType, SetType, Bool, Emit, Module, Addr, CastExpr;
IMPORT IntegerExpr, EnumExpr, ReelExpr, AddressExpr;
IMPORT SetExpr, Temp, MBuf, Error;

CONST
  cINT   = 0;
  cREAL  = 1;
  cLONG  = 2;
  cEXTND = 3;
  cADDR  = 4;
  cENUM  = 5;
  cSET   = 6;

TYPE
  P = ExprRep.Tabc BRANDED "CompareExpr.P" OBJECT
        op: Op;
      OVERRIDES
        typeOf       := ExprRep.NoType;
        check        := Check;
        compile      := Compile;
        evaluate     := Fold;
        fprint       := FPrinter;
        write        := Writer;
        isEqual      := EqCheck;
        getBounds    := ExprRep.NoBounds;
        isWritable   := ExprRep.IsNever;
        isDesignator := ExprRep.IsNever;
	isZeroes     := ExprRep.IsNever;
	note_write   := ExprRep.NotWritable;
	genLiteral   := ExprRep.NoLiteral;
      END;

VAR Ops: ARRAY Op OF RECORD
           relop : TEXT;
           signA : INTEGER;
           signB : INTEGER;
           tag   : TEXT;
         END;

PROCEDURE NewLT (a, b: Expr.T): Expr.T =
  BEGIN RETURN Create (a, b, Op.LT) END NewLT;

PROCEDURE NewLE (a, b: Expr.T): Expr.T =
  BEGIN RETURN Create (a, b, Op.LE) END NewLE;

PROCEDURE NewGT (a, b: Expr.T): Expr.T =
  BEGIN RETURN Create (a, b, Op.GT) END NewGT;

PROCEDURE NewGE (a, b: Expr.T): Expr.T =
  BEGIN RETURN Create (a, b, Op.GE) END NewGE;

PROCEDURE Create (a, b: Expr.T;  op: Op): Expr.T =
  VAR p: P;
  BEGIN
    p := NEW (P);
    ExprRep.Init (p);
    p.a    := a;
    p.b    := b;
    p.op   := op;
    p.type := Bool.T;
    RETURN p;
  END Create;

PROCEDURE Check (p: P;  VAR cs: Expr.CheckState) =
  VAR ta, tb, range: Type.T;
  BEGIN
    Expr.TypeCheck (p.a, cs);
    Expr.TypeCheck (p.b, cs);
    ta := Type.Base (Expr.TypeOf (p.a));
    tb := Type.Base (Expr.TypeOf (p.b));
    p.class := cINT;
    IF    (ta = Int.T)   AND (tb = Int.T)    THEN  p.class := cINT;
    ELSIF (ta = Reel.T)  AND (tb = Reel.T)   THEN  p.class := cREAL;
    ELSIF (ta = LReel.T) AND (tb = LReel.T)  THEN  p.class := cLONG;
    ELSIF (ta = EReel.T) AND (tb = EReel.T)  THEN  p.class := cEXTND;
    ELSIF (Type.IsSubtype (ta, Addr.T)) AND (Type.IsSubtype (tb, Addr.T)) THEN
      p.class := cADDR;
      IF Module.IsSafe () THEN Error.Msg ("unsafe operation") END;
      IF NOT Type.IsEqual (ta, Addr.T, NIL) THEN
        p.a := CastExpr.New (p.a, Addr.T, lvalue := FALSE);
        Expr.TypeCheck (p.a, cs);
      END;
      IF NOT Type.IsEqual (tb, Addr.T, NIL) THEN
        p.b := CastExpr.New (p.b, Addr.T, lvalue := FALSE);
        Expr.TypeCheck (p.b, cs);
      END;
    ELSIF  NOT Type.IsEqual (ta, tb, NIL) THEN
      Error.Msg ("illegal operands for comparison");
    ELSIF EnumType.Is (ta)                   THEN  p.class := cENUM;
    ELSIF SetType.Split (ta, range)          THEN  p.class := cSET;
    ELSE  Error.Msg ("illegal operands for comparison");
    END;
  END Check;

PROCEDURE EqCheck (a: P;  e: Expr.T): BOOLEAN =
  BEGIN
    TYPECASE e OF
    | NULL => RETURN FALSE;
    | P(b) => RETURN (a.class = b.class)
                 AND (a.op = b.op)
		 AND Expr.IsEqual (a.a, b.a)
                 AND Expr.IsEqual (a.b, b.b);
    ELSE RETURN FALSE;
    END;
  END EqCheck;

PROCEDURE Compile (p: P): Temp.T =
  VAR t1, t2, t3: Temp.T;
  BEGIN
    t1 := Expr.Compile (p.a);
    t2 := Expr.Compile (p.b);
    IF p.class # cSET THEN
      t3 := Temp.AllocMacro (p, FALSE);
      Temp.Depend (t3, t1);
      Temp.Depend (t3, t2);
    ELSE
      t3 := Temp.Alloc (p);
      SetExpr.CompileTCompare (t1, t2, t3, p.a.type, p.op);
      Temp.Free (t1);
      Temp.Free (t2);
    END;
    RETURN t3;
  END Compile;

PROCEDURE Writer (p: P;  t1, t2: Temp.T) =
  BEGIN
    Emit.OpTT (Ops[p.op].relop, t1, t2);
  END Writer;

PROCEDURE Fold (p: P): Expr.T =
  VAR e1, e2: Expr.T;  s: INTEGER;  op: Op;
  BEGIN
    e1 := Expr.ConstValue (p.a);
    IF (e1 = NIL) THEN RETURN NIL END;
    e2 := Expr.ConstValue (p.b);
    IF (e2 = NIL) THEN RETURN NIL END;
    op := p.op;
    IF   IntegerExpr.Compare (e1, e2, s)
      OR EnumExpr.Compare (e1, e2, s)
      OR ReelExpr.Compare (e1, e2, s)
      OR AddressExpr.Compare (e1, e2, s)
      OR SetExpr.Compare (e1, e2, s)
      THEN
      RETURN Bool.Map[(s = Ops[op].signA) OR (s = Ops[op].signB)];
    END;
    RETURN NIL;
  END Fold;

PROCEDURE FPrinter (p: P; map: Type.FPMap; wr: MBuf.T) =
  BEGIN
    MBuf.PutText (wr, Ops[p.op].tag);
    MBuf.PutText (wr, " ");
    Expr.Fingerprint (p.a, map, wr);
    Expr.Fingerprint (p.b, map, wr);
  END FPrinter;

BEGIN
    WITH z = Ops [Op.LT] DO
      z.relop := "(@ < @)";
      z.signA :=  -1;
      z.signB :=  -1;
      z.tag   := "<";
    END;
    WITH z = Ops [Op.LE] DO
      z.relop := "(@ <= @)";
      z.signA :=  -1;
      z.signB := 0;
      z.tag   := "<=";
    END;
    WITH z = Ops [Op.GT] DO
      z.relop := "(@ > @)";
      z.signA := 1;
      z.signB := 1;
      z.tag   := ">";
    END;
    WITH z = Ops [Op.GE] DO
      z.relop := "(@ >= @)";
      z.signA := 1;
      z.signB := 0;
      z.tag   := ">=";
    END;
END CompareExpr.