regression/real-int.sml

   1 functor Test (structure Real : REAL) =
   2 struct
   3
   4 datatype z = datatype IEEEReal.float_class
   5 datatype z = datatype IEEEReal.rounding_mode
   6
   7 fun showReal r =
   8    print (Real.fmt StringCvt.EXACT r)
   9
  10 fun showInt i =
  11    print (Int.fmt StringCvt.DEC i)
  12
  13 fun showLargeInt li =
  14    print (LargeInt.fmt StringCvt.DEC li)
  15
  16 fun showMode mode =
  17    case mode of
  18       TO_NEAREST => print "TO_NEAREST"
  19     | TO_NEGINF => print "TO_NEGINF"
  20     | TO_POSINF => print "TO_POSINF"
  21     | TO_ZERO => print "TO_ZERO"
  22
  23 datatype 'a res = OK of 'a | OVERFLOW
  24 fun showRes showOk r =
  25    case r of
  26       OK x => showOk x
  27     | OVERFLOW => print "Overflow"
  28 fun wrap th = (OK (th ())) handle Overflow => OVERFLOW
  29
  30 fun checkIntToReal i =
  31    let
  32       val li = Int.toLarge i
  33       val ri = Real.fromInt i
  34       val rli = Real.fromLargeInt li
  35    in
  36       ()
  37       ; print "["
  38       ; showInt i
  39       ; print ","
  40       ; showLargeInt li
  41       ; print "] --> ["
  42       ; showReal ri
  43       ; print ","
  44       ; showReal rli
  45       ; print "] --> "
  46       ; print (if Real.== (ri, rli) then "OK\n" else "BAD\n")
  47       ; ()
  48    end
  49
  50 fun checkRealToInt mode r =
  51    let
  52       val i = wrap (fn () => Real.toInt mode r)
  53       val li = Real.toLargeInt mode r
  54    in
  55       ()
  56       ; print "["
  57       ; showReal r
  58       ; print ","
  59       ; showMode mode
  60       ; print "] --> ["
  61       ; showRes showInt i
  62       ; print ","
  63       ; showLargeInt li
  64       ; print "] --> "
  65       ; print (if wrap (fn () => Int.fromLarge li) = i then "OK\n" else "BAD\n")
  66       ; ()
  67    end
  68
  69 val is : Int.int list =
  70    let
  71       val op + = Int.+
  72       val op div = Int.div
  73       val op * = Int.*
  74       val ~ = Int.~
  75       val op - = Int.-
  76       val minInt = valOf Int.minInt
  77       val maxInt = valOf Int.maxInt
  78       val (zero,one,two,three) =
  79          (Int.fromInt 0, Int.fromInt 1,
  80           Int.fromInt 2, Int.fromInt 3)
  81       val one_half = maxInt div two
  82       val four = two * two
  83       val one_fourth = maxInt div four
  84       val eight = four * two
  85       val one_eighth = maxInt div eight
  86       val sixteen = eight * two
  87       val one_sixteenth = maxInt div sixteen
  88       val thirtytwo = sixteen * two
  89       val one_thirtysecond = maxInt div thirtytwo
  90       val sixtyfour = thirtytwo * two
  91       val one_sixtyfourth = maxInt div sixtyfour
  92    in
  93       [minInt, minInt + one, minInt + two, minInt + three,
  94        minInt + one_sixtyfourth, minInt + one_thirtysecond,
  95        minInt + one_sixteenth, minInt + one_eighth,
  96        minInt + one_fourth, minInt + one_half,
  97        ~three,~two,~one,zero,one,two,three,
  98        maxInt - one_half, maxInt - one_fourth,
  99        maxInt - one_eighth, maxInt - one_sixteenth,
 100        maxInt - one_thirtysecond, maxInt - one_sixtyfourth,
 101        maxInt - three, maxInt - two, maxInt - one, maxInt]
 102    end
 103 val () = List.app checkIntToReal is
 104 val rs =
 105    List.map
 106    (fn i => let
 107                val r = Real.fromInt i
 108                fun make (fold,inf) =
 109                   fold
 110                   (fn (_,(r,l)) => let
 111                                       val r' = Real.nextAfter (r, inf)
 112                                    in
 113                                       (r',r'::l)
 114                                    end)
 115                   (r,[]) (List.tabulate (64,fn _ => ()))
 116                val make = fn (fold,inf) => #2 (make (fold,inf))
 117             in
 118                (make (foldl,Real.negInf)) @
 119                [r] @
 120                (make (foldr,Real.posInf))
 121             end)
 122    is
 123 val rs = List.concat rs
 124 val () = List.app (checkRealToInt TO_NEAREST) rs
 125 val () = List.app (checkRealToInt TO_NEGINF) rs
 126 val () = List.app (checkRealToInt TO_POSINF) rs
 127 val () = List.app (checkRealToInt TO_ZERO) rs
 128
 129 end
 130
 131 structure Z = Test (structure Real = Real32)
 132 structure Z = Test (structure Real = Real64)