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

(* File: AddExpr.m3                                            *)
(* Last modified on Fri Apr 27 23:49:34 1990 by muller         *)
(*      modified on Sat Feb 10 19:54:39 1990 by kalsow         *)


MODULE AddExpr;

IMPORT Expr, ExprAB, ExprRep, Type, Int, Reel, Longreal, SetType;
IMPORT Address, Emit, Void, Module, IntegerExpr, RealExpr, LongrealExpr;
IMPORT AddressExpr, Temp, Wr, SetExpr, Error;

TYPE
  Class = { cINT, cREAL, cLONG, cADDR, cSET };

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

PROCEDURE New (a, b: Expr.T): Expr.T =
  VAR p: P;
  BEGIN
    p := NEW (P);
    ExprRep.Init (p);
    p.a := a;
    p.b := b;
    RETURN p;
  END New;

PROCEDURE Bind (p: P) =
  VAR ta, tb, range: Type.T;
  BEGIN
    Expr.Bind (p.a);
    Expr.Bind (p.b);
    ta := Type.Base (Expr.TypeOf (p.a));
    tb := Type.Base (Expr.TypeOf (p.b));
    IF    (ta = Int.T)      AND (tb = Int.T)      THEN p.class := Class.cINT;
    ELSIF (ta = Reel.T)     AND (tb = Reel.T)     THEN p.class := Class.cREAL;
    ELSIF (ta = Longreal.T) AND (tb = Longreal.T) THEN p.class := Class.cLONG;
    ELSIF SetType.Split (ta, range)               THEN p.class := Class.cSET;
    ELSE (* assume address+integer *) p.class := Class.cADDR; ta := Address.T;
    END;
    p.type := ta;
  END Bind;

PROCEDURE Check (p: P) =
  VAR ta, tb: Type.T;
  BEGIN
    Expr.TypeCheck (p.a);
    Expr.TypeCheck (p.b);
    CASE p.class OF
    | Class.cINT, Class.cREAL, Class.cLONG =>
        (* ok, checking done *)
    | Class.cSET =>
        ta := Type.Base (Expr.TypeOf (p.a));
        tb := Type.Base (Expr.TypeOf (p.b));
        IF  NOT Type.IsEqual (ta, tb) THEN Err () END;
    | Class.cADDR =>
        ta := Type.Base (Expr.TypeOf (p.a));
        tb := Type.Base (Expr.TypeOf (p.b));
        IF  NOT Type.IsSubtype (ta, Address.T) THEN Err ();
        ELSIF (tb # Int.T)                     THEN Err ();
        ELSIF Module.IsSafe ()                 THEN Error.Msg ("unsafe");
        ELSE (* ok *)
        END;
    END;
  END Check;

PROCEDURE Err () =
  BEGIN
    Error.Msg ("illegal operands for \'+\'");
  END Err;

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);
    CASE p.class OF
    | Class.cSET =>  SetExpr.CompileUnion (t1, t2, t3, p.type);
    | Class.cADDR => Emit.OpTTT ("@ = ((char*)@) + @;\n", t3, t1, t2);
    ELSE             Emit.OpTTT ("@ = @ + @;\n", t3, t1, t2); END;
    Temp.Free (t1);
    Temp.Free (t2);
    RETURN t3;
  END Compile;

PROCEDURE Fold (p: P): Expr.T =
  VAR e1, e2, e3: Expr.T;
  BEGIN
    e1 := Expr.ConstValue (p.a);
    e2 := Expr.ConstValue (p.b);
    e3 := NIL;
    IF    (e1 = NIL) OR (e2 = NIL)      THEN
    ELSIF IntegerExpr.Add  (e1, e2, e3) THEN
    ELSIF RealExpr.Add     (e1, e2, e3) THEN
    ELSIF LongrealExpr.Add (e1, e2, e3) THEN
    ELSIF AddressExpr.Add  (e1, e2, e3) THEN
    ELSIF SetExpr.Union    (e1, e2, e3) THEN
    END;
    RETURN e3;
  END Fold;

PROCEDURE FPrinter (p: P;  map: Type.Map;  wr: Wr.T) =
  BEGIN
    Wr.PutText (wr, "+ ");
    Expr.Fingerprint (p.a, map, wr);
    Expr.Fingerprint (p.b, map, wr);
  END FPrinter;

BEGIN
END AddExpr.