[MLton-devel] Real.fromLargeInt

[Stephen Weeks]

> Real.fromLargeInt's pos function doesn't seem to be affected by the
> current rounding mode.  Furthermore, ~ (pos (IntInf.~ i)) won't always
> give the correct result for some rounding modes. 

Agreed.  I've attached my latest attempt, which fixes these problems,
below.

> Real.toLargeInt doesn't seem to work for "large" real numbers.

Oops, that's due to a separate problem with Real.split that is fixed
in my branch, but not in the trunk.  Real_modf is incorrectly marked
as Functional, when it should be marked SideEffect.  Here's the fix.

diff -c -r1.36 -r1.36.2.1
*** prim.fun	25 Aug 2002 22:23:57 -0000	1.36
--- prim.fun	23 Oct 2002 00:38:26 -0000	1.36.2.1
***************
*** 351,357 ****
  	  (Real_ldexp, Functional, "Real_ldexp"),
  	  (Real_le, Functional, "Real_le"),
  	  (Real_lt, Functional, "Real_lt"),
! 	  (Real_modf, Functional, "Real_modf"),
  	  (Real_mul, Functional, "Real_mul"),
  	  (Real_muladd, Functional, "Real_muladd"),
  	  (Real_mulsub, Functional, "Real_mulsub"),
--- 351,357 ----
  	  (Real_ldexp, Functional, "Real_ldexp"),
  	  (Real_le, Functional, "Real_le"),
  	  (Real_lt, Functional, "Real_lt"),
! 	  (Real_modf, SideEffect, "Real_modf"),
  	  (Real_mul, Functional, "Real_mul"),
  	  (Real_muladd, Functional, "Real_muladd"),
  	  (Real_mulsub, Functional, "Real_mulsub"),

> Some might argue that it is the responsibility of the maintainer of the
> basis-2002 branch to bring the behaviour into accordance with the new
> spec.  Others might counter with the argument that because the function
> wasn't present when basis-2002 was branched, it is the responsibility of
> the author.  ;)

Others might argue that branching times are irrelevant and that it is
the responsibility of the developer who merges into the trunk to make
sure that the trunk matches the spec.  So, since my changes are being
made on the on-20021018-prof-branch, then the responsibility falls to
whoever merges last.  :-)

Nevertheless, in anticipation of you merging first, I have made
fromLargeInt take into account the rounding mode.

--------------------------------------------------------------------------------

      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.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