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

(* File: Max.m3                                                *)
(* Last Modified On Tue Mar 20 03:16:59 1990 By muller         *)
(*      Modified On Fri Jul  7 13:26:26 1989 By kalsow         *)

MODULE Max;

IMPORT CallExpr, Expr, Type, Procedure, Error, Emit;
IMPORT Int, Reel, Longreal, SubrangeType, VarExpr, Text;
IMPORT IntegerExpr, EnumExpr, RealExpr, LongrealExpr, Temp;

VAR
  Z: CallExpr.MethodList;


PROCEDURE Bind (<*UNUSED*> proc: Expr.T; args: Expr.List): Type.T =
  BEGIN
    RETURN DoBind (args);
  END Bind;

PROCEDURE DoBind (args: Expr.List): Type.T =
  VAR ta, tb, ua, ub: Type.T; mina, maxa, minb, maxb, minc, maxc: INTEGER;
  BEGIN
    ta := Expr.TypeOf (args[0]);
    tb := Expr.TypeOf (args[1]);
    ua := Type.Base (ta);
    ub := Type.Base (tb);
    IF (ua = Int.T) OR (Type.Number (ua) >= 0) THEN
      Type.GetBounds (ta, mina, maxa);
      Type.GetBounds (tb, minb, maxb);
      minc := MIN (mina, minb);
      maxc := MAX (maxa, maxb);
      IF (minc = mina) AND (maxc = maxa) THEN (* ok *)
      ELSIF (minc = minb) AND (maxc = maxb) THEN
        ta := tb;
      ELSE
        ta := Type.Bind (SubrangeType.New (minc, maxc, ua));
      END;
    ELSIF (ua = Reel.T) OR (ua = Longreal.T) THEN
      (* ok *)
    ELSE
      ta := Int.T;
    END;
    RETURN ta;
  END DoBind;

PROCEDURE Check (<*UNUSED*> proc: Expr.T; VAR args: Expr.List) =
  BEGIN
    DoCheck ("MAX", args);
  END Check;

PROCEDURE DoCheck (name: Text.T; args: Expr.List) =
  VAR ua, ub: Type.T;
  BEGIN
    ua := Type.Base (Expr.TypeOf (args[0]));
    ub := Type.Base (Expr.TypeOf (args[1]));
    IF ( NOT Type.IsEqual (ua, ub)) THEN
      Error.ID (name, "incompatible argument types");
    ELSIF (ua = Int.T) OR (Type.Number (ua) >= 0) THEN
      (* ok *)
    ELSIF (ua = Reel.T) OR (ua = Longreal.T) THEN
      (* ok *)
    ELSE
      Error.ID (name, "wrong argument types");
    END;
  END DoCheck;

PROCEDURE Compile (<*UNUSED*> proc: Expr.T; args: Expr.List): Temp.T =
  VAR t1, t2, t3, t4: Temp.T;
  BEGIN
    t1 := Expr.Compile (args[0]);
    t2 := Expr.Compile (args[1]);
    t3 := Temp.AllocEmpty (Expr.TypeOf (args[0]));
    t4 := Temp.Alloc (args[1]);
    Emit.OpTT ("@ = @;\n", t3, t1);
    Emit.OpTT ("@ = @;\n", t4, t2);
    Emit.OpTT ("if (@ < @) ", t3, t4);
    Emit.OpTT ("@ = @;\n", t3, t4);
    Temp.Free (t1);
    Temp.Free (t2);
    Temp.Free (t4);
    RETURN t3;
  END Compile;

PROCEDURE Fold (<*UNUSED*> proc: Expr.T; args: Expr.List): Expr.T =
  VAR e1, e2: Expr.T; i1, i2: INTEGER; r1, r2: LONGREAL; t: Type.T;
  BEGIN
    e1 := Expr.ConstValue (args[0]);
    IF (e1 = NIL) THEN RETURN NIL END;
    e2 := Expr.ConstValue (args[1]);
    IF (e2 = NIL) THEN RETURN NIL END;
    IF IntegerExpr.Split (e1, i1) AND IntegerExpr.Split (e2, i2) THEN
      RETURN IntegerExpr.New (MAX (i1, i2));
    ELSIF EnumExpr.Split (e1, i1, t) AND EnumExpr.Split (e2, i2, t) THEN
      RETURN EnumExpr.New (t, MAX (i1, i2));
    ELSIF RealExpr.Split (e1, r1) AND RealExpr.Split (e2, r2) THEN
      RETURN RealExpr.New (MAX (r1, r2));
    ELSIF LongrealExpr.Split (e1, r1) AND LongrealExpr.Split (e2, r2) THEN
      RETURN LongrealExpr.New (MAX (r1, r2));
    ELSE
      RETURN NIL;
    END;
  END Fold;

PROCEDURE Initialize () =
  BEGIN
    Z := CallExpr.NewMethodList (2, 2, TRUE, Bind, Check, Compile, Fold,
                                 CallExpr.IsNever, (* writable *)
                                 CallExpr.IsNever(* designator *));
    Procedure.Define ("MAX", Z);
  END Initialize;

BEGIN
END Max.