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

(* File: Floatt.m3                                             *)
(* Last Modified On Tue Mar 20 03:09:57 1990 By muller         *)
(*      Modified On Fri Jul 14 17:03:47 1989 By kalsow         *)

MODULE Floatt;

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

VAR
  Z: CallExpr.MethodList;


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

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

PROCEDURE DoCheck (name: Text.T; args: Expr.List) =
  VAR t: Type.T;
  BEGIN
    t := Type.Base (Expr.TypeOf (args[0]));
    IF (t # Int.T) AND (t # Reel.T) AND (t # Longreal.T) THEN
      Error.ID (name, "wrong argument type");
    END;
  END DoCheck;

PROCEDURE Compile (<*UNUSED*> proc: Expr.T; args: Expr.List): Temp.T =
  VAR t: Type.T; e: Expr.T; t1, t2: Temp.T;
  BEGIN
    e := args[0];
    t := Type.Base (Expr.TypeOf (e));
    t1 := Expr.Compile (e);
    t2 := Temp.AllocEmpty (Reel.T);
    IF (t = Int.T) THEN
      Emit.OpTT ("@ = CVTIF (@);\n", t2, t1);
    ELSIF (t = Longreal.T) THEN
      Emit.OpTT ("@ = CVTLF (@);\n", t2, t1);
    ELSE (*t = Real.T *)
      Emit.OpTT ("@ = @;\n", t2, t1);
    END;
    Temp.Free (t1);
    RETURN t2;
  END Compile;

PROCEDURE Fold (<*UNUSED*> proc: Expr.T; args: Expr.List): Expr.T =
  VAR e: Expr.T; i: INTEGER; r: LONGREAL;
  BEGIN
    e := Expr.ConstValue (args[0]);
    IF (e = NIL) THEN
      RETURN NIL;
    ELSIF IntegerExpr.Split (e, i) THEN
      RETURN RealExpr.New (LONGFLOAT (i));
    ELSIF LongrealExpr.Split (e, r) THEN
      RETURN RealExpr.New (r);
    ELSIF RealExpr.Split (e, r) THEN
      RETURN e;
    ELSE
      RETURN NIL;
    END;
  END Fold;

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

BEGIN
END Floatt.