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

(* File: CompareExpr.m3                                        *)
(* Last modified on Sat Apr 28 00:47:21 1990 by muller         *)
(*      modified on Sat Feb 10 17:32:54 1990 by kalsow         *)


MODULE CompareExpr;

IMPORT Expr, ExprRep, ExprAB, ExprABC, Token, Type, Int, Reel, Longreal;
IMPORT EnumType, SetType, Bool, Emit, Module, Address;
IMPORT IntegerExpr, EnumExpr, RealExpr, LongrealExpr, AddressExpr;
IMPORT SetExpr, String, Temp, Wr, Text, Error;

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

TYPE
  P = ExprABC.T OBJECT
        op: Op;
      METHODS
        bind         := ExprAB.Bind;
        check        := Check;
        compile      := Compile;
        evaluate     := Fold;
        fprint       := FPrinter;
        write        := ExprRep.NoWriter;
        isEqual      := EqCheck;
        getBounds    := ExprRep.NoBounds;
        isWritable   := ExprRep.IsNever;
        isDesignator := ExprRep.IsNever;
	isZeroes     := ExprRep.IsNever;
	genLiteral   := ExprRep.NoLiteral;
      END;

VAR Ops: ARRAY Op OF RECORD
           relop : Text.T;
           signA : INTEGER;
           signB : INTEGER;
           tag   : Text.T;
         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 ta, tb, range: Type.T;
  BEGIN
    Expr.TypeCheck (p.a);
    Expr.TypeCheck (p.b);
    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 = Longreal.T) AND (tb = Longreal.T) THEN  p.class := cLONG;
    ELSIF (Type.IsSubtype (ta, Address.T))
             AND (Type.IsSubtype (tb, Address.T)) THEN  p.class := cADDR;
      IF Module.IsSafe () THEN Error.Msg ("unsafe operation") END;
    ELSIF  NOT Type.IsEqual (ta, tb) 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);
    t3 := Temp.Alloc (p);
    IF p.class # cSET THEN
      Emit.OpTTT (Ops[p.op].relop, t3, t1, t2);
    ELSE
      SetExpr.CompileCompareT (t1, t2, t3, p.a.type, p.op);
    END;
    Temp.Free (t1);
    Temp.Free (t2);
    RETURN t3;
  END Compile;

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 RealExpr.Compare (e1, e2, s)    OR LongrealExpr.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.Map; wr: Wr.T) =
  BEGIN
    Wr.PutText (wr, Ops[p.op].tag & " ");
    Expr.Fingerprint (p.a, map, wr);
    Expr.Fingerprint (p.b, map, wr);
  END FPrinter;

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