[MLton-devel] Real.fromLargeInt

[Stephen Weeks]

> Did you try that code with the test program I sent?  
...
> The fromLargeInt looks fine, but I got an uncaught Overflow
> exception on the first call to toLargeInt.

I tried your test, which is now the real.toFromLargeInt regression
test.  There was one more bug, which has now been fixed.  Sorry about
that.

      local
	 fun negateMode m =
	    case m of
	       TO_NEAREST => TO_NEAREST
	     | TO_NEGINF => TO_POSINF
	     | TO_POSINF => TO_NEGINF
	     | TO_ZERO => TO_ZERO

	 val m: int = 52 (* The number of mantissa bits in 64 bit IEEE 854. *)
	 val half = Int.quot (m, 2)
	 val two = IntInf.fromInt 2
	 val twoPowHalf = IntInf.pow (two, half)
      in
	 fun fromLargeInt (i: IntInf.int): real =
	    let
	       fun pos (i: IntInf.int, mode): real = 
		  case SOME (IntInf.log2 i) handle Overflow => NONE of
		     NONE => posInf
		   | SOME exp =>
			if Int.< (exp, Int.- (valOf Int.precision, 1))
			   then fromInt (IntInf.toInt i)
			else if Int.>= (exp, 1024)
		           then posInf
			else
			   let
			      val shift = Int.- (exp, m)
			      val (man: IntInf.int, extra: IntInf.int) =
				 if Int.>= (shift, 0)
				    then
				       let
					  val (q, r) =
					     IntInf.quotRem
					     (i, IntInf.pow (two, shift))
					  val extra =
					     case mode of
						TO_NEAREST =>
						   if IntInf.> (r, 0)
						      andalso IntInf.log2 r =
						      Int.- (shift, 1)
						      then 1
						   else 0
					      | TO_NEGINF => 0
					      | TO_POSINF =>
						   if IntInf.> (r, 0)
						      then 1
						   else 0
					      | TO_ZERO => 0
				       in
					  (q, extra)
				       end
				 else
				    (IntInf.* (i, IntInf.pow (two, Int.~ shift)),
				     0)
			      (* 2^m <= man < 2^(m+1) *)
			      val (q, r) = IntInf.quotRem (man, twoPowHalf)
			      fun conv (man, exp) =
				 fromManExp {man = fromInt (IntInf.toInt man),
					     exp = exp}
			   in
			      conv (q, Int.+ (half, shift))
			      + conv (IntInf.+ (r, extra), shift)
			   end
	       val mode = getRoundingMode ()
	    in
	       case IntInf.compare (i, IntInf.fromInt 0) of
		  General.LESS => ~ (pos (IntInf.~ i, negateMode mode))
		| General.EQUAL => 0.0
		| General.GREATER => pos (i, mode)
	    end

	 val toLargeInt: IEEEReal.rounding_mode -> real -> IntInf.int =
	    fn mode => fn x =>
 	    (IntInf.fromInt (toInt mode x)
 	     handle Overflow =>
	     case class x of
		INF => raise Overflow
	      | _ => 
		   let
		      fun pos (x, mode) =
			 let 
			    val {frac, whole} = split x
			    val extra =
			       if mode = TO_NEAREST
				  andalso Real.== (frac, 0.5)
				  then
				     if Real.== (0.5, realMod (whole / 2.0))
					then 1
				     else 0
			       else IntInf.fromInt (toInt mode frac)
			    val {man, exp} = toManExp whole
			    (* 1 <= man < 2 *)
			    val man = fromManExp {man = man, exp = half}
			    (* 2^half <= man < 2^(half+1) *)
			    val {frac = lower, whole = upper} = split man
			    val upper = IntInf.* (IntInf.fromInt (floor upper),
						  twoPowHalf)
			    (* 2^m <= upper < 2^(m+1) *)
			    val {whole = lower, ...} =
			       split (fromManExp {man = lower, exp = half})
			    (* 0 <= lower < 2^half *)
			    val lower = IntInf.fromInt (floor lower)
			    val int = IntInf.+ (upper, lower)
			    (* 2^m <= int < 2^(m+1) *)
			    val shift = Int.- (exp, m)
			    val int =
			       if Int.>= (shift, 0)
				  then IntInf.* (int, IntInf.pow (2, shift))
			       else IntInf.quot (int,
						 IntInf.pow (2, Int.~ shift))
			 in
			    IntInf.+ (int, extra)
			 end
		   in
		      if x > 0.0
			 then pos (x, mode)
		      else IntInf.~ (pos (~ x, negateMode mode))
		   end)
      end


-------------------------------------------------------
This sf.net email is sponsored by: Influence the future 
of Java(TM) technology. Join the Java Community 
Process(SM) (JCP(SM)) program now. 
http://ads.sourceforge.net/cgi-bin/redirect.pl?sunm0002en

_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel