[MLton-commit] r6848

Vesa Karvonen vesak at mlton.org
Thu Sep 11 23:39:05 PDT 2008


Modified implementation of a few FP operations to expose opportunities for
FPCF optimization.

Tested on amd64 linux (and x86 linux when MLton is compiled with MLton)
and does not seem to introduce any (new) regressions.

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

U   mlton/trunk/basis-library/real/real.sml

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

Modified: mlton/trunk/basis-library/real/real.sml
===================================================================
--- mlton/trunk/basis-library/real/real.sml	2008-09-12 06:36:31 UTC (rev 6847)
+++ mlton/trunk/basis-library/real/real.sml	2008-09-12 06:39:03 UTC (rev 6848)
@@ -116,10 +116,7 @@
              | _ => if signBit x then ~x else x
 
       fun isFinite r =
-         case class r of
-            INF => false
-          | NAN => false
-          | _ => true
+         abs r <= maxFinite
 
       val op == = Prim.==
 
@@ -153,10 +150,10 @@
          else y
 
       fun sign (x: real): int =
-         case class x of
-            NAN => raise Domain
-          | ZERO => 0
-          | _ => if x > zero then 1 else ~1
+         if x > zero then 1
+         else if x < zero then ~1
+         else if x == zero then 0
+         else raise Domain
 
       fun sameSign (x, y) = signBit x = signBit y
 
@@ -266,10 +263,9 @@
       val realMod = #frac o split
 
       fun checkFloat x =
-         case class x of
-            INF => raise Overflow
-          | NAN => raise Div
-          | _ => x
+         if isFinite x then x
+         else if isNan x then raise Div
+         else raise Overflow
 
       fun roundReal (x: real, m: rounding_mode): real =
          IEEEReal.withRoundingMode (m, fn () => R.round x)
@@ -623,61 +619,72 @@
                                minInt': 'a,
                                precision': int}} =
             (fromIntUnsafe,
-             if Int.< (precision, #precision' other)
-                then let
-                        val maxInt' = #maxInt' other
-                        val minInt' = #minInt' other
-                        (* maxInt can't be represented exactly. *)
-                        (* minInt can be represented exactly. *)
-                        val (maxInt,minInt) = 
-                           IEEEReal.withRoundingMode
-                           (TO_ZERO, fn () => (fromIntUnsafe maxInt',
-                                               fromIntUnsafe minInt'))
-                     in
-                        fn (m: rounding_mode) => fn x =>
-                        case class x of
-                           INF => raise Overflow
-                         | NAN => raise Domain
-                         | _ => if minInt <= x andalso x <= maxInt
-                                   then toIntUnsafe (roundReal (x, m))
-                                else raise Overflow
-                     end
-             else let
-                     val maxInt' = #maxInt' other
-                     val minInt' = #minInt' other
-                     val maxInt = fromIntUnsafe maxInt'
-                     val minInt = fromIntUnsafe minInt'
-                  in
-                     fn (m: rounding_mode) => fn x =>
-                     case class x of
-                        INF => raise Overflow
-                      | NAN => raise Domain
-                      | _ => if minInt <= x
-                                then if x <= maxInt
-                                        then toIntUnsafe (roundReal (x, m))
-                             else if x < maxInt + one
-                                then (case m of
-                                         TO_NEGINF => maxInt'
-                                       | TO_POSINF => raise Overflow
-                                       | TO_ZERO => maxInt'
-                                       | TO_NEAREST =>
-                                            (* Depends on maxInt being odd. *)
-                                            if x - maxInt >= half
-                                               then raise Overflow
-                                            else maxInt')
-                                else raise Overflow
-                             else if x > minInt - one
-                                then (case m of
-                                         TO_NEGINF => raise Overflow
-                                       | TO_POSINF => minInt'
-                                       | TO_ZERO => minInt'
-                                       | TO_NEAREST =>
-                                            (* Depends on minInt being even. *)
-                                            if x - minInt < ~half
-                                               then raise Overflow
-                                            else minInt')
-                             else raise Overflow
-                  end)
+             if Int.< (precision, #precision' other) then
+                let
+                   val maxInt' = #maxInt' other
+                   val minInt' = #minInt' other
+                   (* maxInt can't be represented exactly. *)
+                   (* minInt can be represented exactly. *)
+                   val (maxInt,minInt) =
+                       IEEEReal.withRoundingMode
+                       (TO_ZERO, fn () => (fromIntUnsafe maxInt',
+                                           fromIntUnsafe minInt'))
+                in
+                   fn (m: rounding_mode) => fn x =>
+                   if minInt <= x then
+                      if x <= maxInt then
+                         toIntUnsafe (roundReal (x, m))
+                      else
+                         raise Overflow
+                   else
+                      if x < minInt then
+                         raise Overflow
+                      else
+                         raise Domain (* NaN *)
+                end
+             else
+                let
+                   val maxInt' = #maxInt' other
+                   val minInt' = #minInt' other
+                   val maxInt = fromIntUnsafe maxInt'
+                   val minInt = fromIntUnsafe minInt'
+                in
+                   fn (m: rounding_mode) => fn x =>
+                   if minInt <= x then
+                      if x <= maxInt then
+                         toIntUnsafe (roundReal (x, m))
+                      else
+                         if x < maxInt + one then
+                            (case m of
+                                TO_NEGINF => maxInt'
+                              | TO_POSINF => raise Overflow
+                              | TO_ZERO => maxInt'
+                              | TO_NEAREST =>
+                                (* Depends on maxInt being odd. *)
+                                if x - maxInt >= half then
+                                   raise Overflow
+                                else
+                                   maxInt')
+                         else
+                            raise Overflow
+                   else
+                      if x < minInt then
+                         if minInt - one < x then
+                            (case m of
+                                TO_NEGINF => raise Overflow
+                              | TO_POSINF => minInt'
+                              | TO_ZERO => minInt'
+                              | TO_NEAREST =>
+                                (* Depends on minInt being even. *)
+                                if x - minInt < ~half then
+                                   raise Overflow
+                                else
+                                   minInt')
+                         else
+                            raise Overflow
+                      else
+                         raise Domain (* NaN *)
+                end)
       in
          val (fromInt8,toInt8) =
             make {fromIntUnsafe = R.fromInt8Unsafe,




More information about the MLton-commit mailing list