1 functor Test (structure Real: REAL
10 datatype z
= datatype IEEEReal
.float_class
11 datatype z
= datatype IEEEReal
.rounding_mode
12 datatype z
= datatype General
.order
14 val b2s
= Bool.toString
15 val i2s
= Int.toString
16 val exact
= fmt
StringCvt.EXACT
18 val s2r
= valOf
o fromString
23 val nan
= posInf
+ negInf
25 val halfMaxFinite
= maxFinite
/ two
26 val halfMinNormalPos
= minNormalPos
/ two
43 fun for f
= (List.app f reals
; List.app (f
o ~
) reals
)
49 maxFinite
* s2r
"2.0"]
51 fun for
' f
= (for f
; List.app f reals
')
53 val _
= print (concat
["\nTesting Real", Int.toString size
, "\n"])
55 val _
= print
"\nTesting fmt\n"
60 List.app (fn spec
=> print (concat
[fmt spec r
, "\n"]))
64 [EXACT
, SCI NONE
, FIX NONE
, GEN NONE
,
65 SCI (SOME
0), FIX (SOME
0), GEN (SOME
1),
66 SCI (SOME
10), FIX (SOME
10), GEN (SOME
10)]
71 fun doit (s
,r
, s0
, s1
, s2
, s6
) =
72 if (fmt (StringCvt.FIX (SOME
0)) r
= s0
73 andalso fmt (StringCvt.FIX (SOME
1)) r
= s1
74 andalso fmt (StringCvt.FIX (SOME
2)) r
= s2
75 andalso fmt (StringCvt.FIX (SOME
6)) r
= s6
76 andalso fmt (StringCvt.FIX NONE
) r
= s6
)
78 else raise Fail (concat
["fmt bug: ", s
, " ", exact r
])
81 (fn (s
,r
, s0
, s1
, s2
, s6
) =>
82 (doit (s
,r
, s0
, s1
, s2
, s6
)
85 else doit (s^
"~",~r
, "~"^s0
, "~"^s1
, "~"^s2
, "~"^s6
)))
86 [("a", s2r
"0.0", "0", "0.0", "0.00", "0.000000"),
87 ("b", s2r
"1.0", "1", "1.0", "1.00", "1.000000"),
88 ("c", s2r
"1.4", "1", "1.4", "1.40", "1.400000"),
89 ("d", s2r
"1.5", "2", "1.5", "1.50", "1.500000"),
90 ("e", s2r
"2.5", "2", "2.5", "2.50", "2.500000"),
91 ("f", s2r
"1.6", "2", "1.6", "1.60", "1.600000"),
92 ("h", s2r
"3.141592653589", "3", "3.1", "3.14", "3.141593"),
93 ("j", s2r
"91827365478400.0", "91827365478400", "91827365478400.0",
94 "91827365478400.00", "91827365478400.000000")]
99 fun chkSCI (r
, s0
, s1
, s2
, s6
) =
100 fmt (StringCvt.SCI (SOME
0)) r
= s0
101 andalso fmt (StringCvt.SCI (SOME
1)) r
= s1
102 andalso fmt (StringCvt.SCI (SOME
2)) r
= s2
103 andalso fmt (StringCvt.SCI (SOME
6)) r
= s6
104 andalso fmt (StringCvt.SCI NONE
) r
= s6
107 (fn (r
, s0
, s1
, s2
, s6
) =>
108 if chkSCI(r
, s0
, s1
, s2
, s6
)
109 andalso (r
== zero
orelse chkSCI(~r
, "~"^s0
, "~"^s1
, "~"^s2
, "~"^s6
))
111 else raise Fail (concat
["fmt SCI bug: ", exact r
]))
112 [(s2r
"0.0", "0E0", "0.0E0", "0.00E0", "0.000000E0"),
113 (s2r
"0.0012345678", "1E~3", "1.2E~3", "1.23E~3", "1.234568E~3"),
114 (s2r
"1.0", "1E0", "1.0E0", "1.00E0", "1.000000E0"),
115 (s2r
"1.4", "1E0", "1.4E0", "1.40E0", "1.400000E0"),
116 (s2r
"1.5", "2E0", "1.5E0", "1.50E0", "1.500000E0"),
117 (s2r
"1.6", "2E0", "1.6E0", "1.60E0", "1.600000E0"),
118 (s2r
"3.141592653589", "3E0", "3.1E0", "3.14E0", "3.141593E0"),
119 (s2r
"91827365478400.0", "9E13", "9.2E13", "9.18E13", "9.182737E13")]
124 fun chkGEN (r
, s1
, s2
, s6
, s12
) =
125 fmt (StringCvt.GEN (SOME
1)) r
= s1
126 andalso fmt (StringCvt.GEN (SOME
2)) r
= s2
127 andalso fmt (StringCvt.GEN (SOME
6)) r
= s6
128 andalso fmt (StringCvt.GEN (SOME
12)) r
= s12
129 andalso fmt (StringCvt.GEN NONE
) r
= s12
130 andalso toString r
= s12
;
133 (fn (r
, s1
, s2
, s6
, s12
) =>
134 if chkGEN(r
, s1
, s2
, s6
, s12
)
135 andalso (r
== zero
orelse
136 chkGEN(~r
, "~"^s1
, "~"^s2
, "~"^s6
, "~"^s12
))
138 else raise Fail (concat
["fmt GEN bug: ", exact r
]))
139 [(s2r
"0.0", "0", "0", "0", "0"),
140 (s2r
"1.0", "1", "1", "1", "1"),
141 (s2r
"1.5", "2", "1.5", "1.5", "1.5"),
142 (s2r
"91827365478400.0", "9E13", "9.2E13", "9.18274E13",
146 val _
= print
"\nTesting scan\n"
148 val _
= for
' (fn r
=>
150 val r
' = valOf (StringCvt.scanString
scan (exact r
))
151 val _
= print (concat
[exact r
, "\t", exact r
', "\n"])
153 if r
== r
' orelse unordered (r
, r
')
155 else raise Fail
"scan bug"
158 val _
= print
"\nTesting checkFloat\n"
163 INF
=> ((checkFloat r
; false) handle Overflow
=> true | _
=> false)
164 | NAN
=> ((checkFloat r
; false) handle Div
=> true | _
=> false)
165 | _
=> (checkFloat r
; true) handle _
=> false)
167 else raise Fail
"checkFloat bug")
169 val _
= print
"\nTesting class, isFinite, isNan, isNormal\n"
179 | SUBNORMAL
=> "subnormal"
182 print (concat
[exact r
, "\t", c
, "\n",
183 "\tisFinite = ", b2s (isFinite r
),
184 "\tisNan = ", b2s (isNan r
),
185 "\tisNormal = ", b2s (isNormal r
),
189 val _
= print
"\nTesting maxFinite, minPos, minNormalPos\n"
192 val isNormal
= Real.isNormal
193 val isFinite
= Real.isFinite
194 val isPositive
= fn r
=>
197 | SUBNORMAL
=> r
> zero
201 fun min (p
: real -> bool): real =
203 fun loop (x
: real): real =
215 val minNormalPos
= min isNormal
216 val minPos
= min isPositive
220 fun up (x
: real): real =
228 fun down (x
: real, y
: real): real =
243 val _
= print ((Real.toString maxFinite
) ^
"\n")
244 val _
= print ((Real.toString
Real.maxFinite
) ^
"\n")
245 val _
= print ((Bool.toString (Real.==(Real.maxFinite
, maxFinite
))) ^
"\n")
246 val _
= print ((Real.toString minPos
) ^
"\n")
247 val _
= print ((Real.toString
Real.minPos
) ^
"\n")
248 val _
= print ((Bool.toString (Real.==(Real.minPos
, minPos
))) ^
"\n")
249 val _
= print ((Real.toString minNormalPos
) ^
"\n")
250 val _
= print ((Real.toString
Real.minNormalPos
) ^
"\n")
251 val _
= print ((Bool.toString (Real.==(Real.minNormalPos
, minNormalPos
))) ^
"\n")
253 val _
= print
"\nTestring fromString\n"
258 if valOf (fromString s1
) == valOf (fromString s2
)
260 else raise Fail
"fromString bug")
275 ("156.25", "156.25"),
276 ("+156.25", "156.25"),
277 ("~156.25", "~156.25"),
278 ("-156.25", "~156.25"),
283 ("156E024", "156E024"),
284 ("+156E024", "156E024"),
285 ("~156E024", "~156E024"),
286 ("-156E024", "~156E024"),
287 ("156.25E024", "156.25E024"),
288 ("+156.25E024", "156.25E024"),
289 ("~156.25E024", "~156.25E024"),
290 ("-156.25E024", "~156.25E024"),
291 (".25E024", "0.25E024"),
292 ("+.25E024", "0.25E024"),
293 ("~.25E024", "~0.25E024"),
294 ("-.25E024", "~0.25E024"),
295 ("156E+024", "156E024"),
296 ("+156E+024", "156E024"),
297 ("~156E+024", "~156E024"),
298 ("-156E+024", "~156E024"),
299 ("156.25E+024", "156.25E024"),
300 ("+156.25E+024", "156.25E024"),
301 ("~156.25E+024", "~156.25E024"),
302 ("-156.25E+024", "~156.25E024"),
303 (".25E+024", "0.25E024"),
304 ("+.25E+024", "0.25E024"),
305 ("~.25E+024", "~0.25E024"),
306 ("-.25E+024", "~0.25E024"),
307 ("156E~024", "156E~024"),
308 ("+156E~024", "156E~024"),
309 ("~156E~024", "~156E~024"),
310 ("-156E~024", "~156E~024"),
311 ("156.25E~024", "156.25E~024"),
312 ("+156.25E~024", "156.25E~024"),
313 ("~156.25E~024", "~156.25E~024"),
314 ("-156.25E~024", "~156.25E~024"),
315 (".25E~024", "0.25E~024"),
316 ("+.25E~024", "0.25E~024"),
317 ("~.25E~024", "~0.25E~024"),
318 ("-.25E~024", "~0.25E~024"),
319 ("156E-024", "156E~024"),
320 ("+156E-024", "156E~024"),
321 ("~156E-024", "~156E~024"),
322 ("-156E-024", "~156E~024"),
323 ("156.25E-024", "156.25E~024"),
324 ("+156.25E-024", "156.25E~024"),
325 ("~156.25E-024", "~156.25E~024"),
326 ("-156.25E-024", "~156.25E~024"),
327 (".25E-024", "0.25E~024"),
328 ("+.25E-024", "0.25E~024"),
329 ("~.25E-024", "~0.25E~024"),
330 ("-.25E-024", "~0.25E~024"),
331 ("156e024", "156E024"),
332 ("+156e024", "156E024"),
333 ("~156e024", "~156E024"),
334 ("-156e024", "~156E024"),
335 ("156.25e024", "156.25E024"),
336 ("+156.25e024", "156.25E024"),
337 ("~156.25e024", "~156.25E024"),
338 ("-156.25e024", "~156.25E024"),
339 (".25e024", "0.25E024"),
340 ("+.25e024", "0.25E024"),
341 ("~.25e024", "~0.25E024"),
342 ("-.25e024", "~0.25E024"),
343 ("156e+024", "156E024"),
344 ("+156e+024", "156E024"),
345 ("~156e+024", "~156E024"),
346 ("-156e+024", "~156E024"),
347 ("156.25e+024", "156.25E024"),
348 ("+156.25e+024", "156.25E024"),
349 ("~156.25e+024", "~156.25E024"),
350 ("-156.25e+024", "~156.25E024"),
351 (".25e+024", "0.25E024"),
352 ("+.25e+024", "0.25E024"),
353 ("~.25e+024", "~0.25E024"),
354 ("-.25e+024", "~0.25E024"),
355 ("156e~024", "156E~024"),
356 ("+156e~024", "156E~024"),
357 ("~156e~024", "~156E~024"),
358 ("-156e~024", "~156E~024"),
359 ("156.25e~024", "156.25E~024"),
360 ("+156.25e~024", "156.25E~024"),
361 ("~156.25e~024", "~156.25E~024"),
362 ("-156.25e~024", "~156.25E~024"),
363 (".25e~024", "0.25E~024"),
364 ("+.25e~024", "0.25E~024"),
365 ("~.25e~024", "~0.25E~024"),
366 ("-.25e~024", "~0.25E~024"),
367 ("156e-024", "156E~024"),
368 ("+156e-024", "156E~024"),
369 ("~156e-024", "~156E~024"),
370 ("-156e-024", "~156E~024"),
371 ("156.25e-024", "156.25E~024"),
372 ("+156.25e-024", "156.25E~024"),
373 ("~156.25e-024", "~156.25E~024"),
374 ("-156.25e-024", "~156.25E~024"),
375 (".25e-024", "0.25E~024"),
376 ("+.25e-024", "0.25E~024"),
377 ("~.25e-024", "~0.25E~024"),
378 ("-.25e-024", "~0.25E~024")]
381 val _
= print
"\nTesting {from,to}Decimal\n"
386 val da
= valOf (IEEEReal
.fromString r
)
387 val s1
= IEEEReal
.toString da
388 val x
= valOf (fromDecimal da
)
390 val da
' = toDecimal x
391 val b
= Bool.toString (da
= da
')
393 print (concat
[s1
, " ", s2
, " ", b
, "\n"])
395 ["inf", "+inF", "~iNf", "-Inf",
396 "infinity", "+infinity", "~infinity", "-infinity",
397 "nan", "+naN", "~nAn", "-Nan",
398 "0", "0.0", "0.0E0", "~0",
410 "1E12345678901234567890"]
412 val _
= print
"\nTesting {from,to}LargeInt\n"
417 val i
= toLargeInt IEEEReal
.TO_NEGINF r
418 val r
' = fromLargeInt i
419 val _
= print (concat
[exact r
,
420 "\t", LargeInt
.toString i
,
426 else raise Fail
"bug"
430 [(TO_NEAREST
, "nearest"),
431 (TO_NEGINF
, "neginf"),
432 (TO_POSINF
, "posinf"),
437 fun doit (x
, mode
, name
) =
439 val i
= toLargeInt mode x
441 print (concat
[name
, "\t", exact x
, "\t", LargeInt
.toString i
, "\n"])
451 ; doit (~ x
, mode
, name
)
452 ; doit (s2r
"1E12" + x
, mode
, name
)
453 ; doit (s2r
"~1E12" + x
, mode
, name
)
455 ["0.0", "0.25", "0.5", "0.75", "1.0", "1.25", "1.5", "1.75", "2.0",
460 val _
= print
"\nTesting fromInt\n"
465 case SOME (round r
) handle Overflow
=> NONE
of
471 if r
== fromInt (round r
)
473 else raise Fail
"fromInt bug"
476 val _
= print
"\nTesting toInt\n"
483 case SOME (toInt mode r
) handle Overflow
=> NONE
of
485 | SOME i
=> if i
= LargeInt
.toInt (toLargeInt mode r
)
487 else raise Fail
"bug")
490 val _
= print
"\nTesting ceil,floor,round,trunc\n"
497 case SOME (toInt mode r
) handle Overflow
=> NONE
of
499 | SOME i
=> if i
= f r
501 else raise Fail
"bug")
502 [(TO_NEAREST
, round
),
507 val _
= print
"\nTesting copySign, sameSign, sign, signBit\n"
513 if unordered (r1
, r2
)
515 then print (concat
[b2s (signBit r1
), "\t",
516 b2s (signBit r2
), "\t",
518 b2s (sameSign (r1
, r2
)), "\t",
519 exact (copySign (r1
, r2
)), "\n"])
521 ; (signBit r1
= Int.< (sign r1
, 0)
523 andalso (sameSign (r1
, r2
)) = (signBit r1
= signBit r2
)
524 andalso sameSign (r2
, copySign (r1
, r2
)))
526 else raise Fail
"bug")))
528 val _
= print
"\nTesting max, min\n"
536 val max
= max (r1
, r2
)
537 val min
= min (r1
, r2
)
539 if (isNan r1
orelse (r1
<= max
andalso min
<= r1
))
540 andalso (isNan r2
orelse (r2
<= max
andalso min
<= r2
))
541 andalso (r1
== max
orelse r2
== max
542 orelse (isNan r1
andalso isNan r2
))
543 andalso (r1
== min
orelse r2
== min
544 orelse (isNan r1
andalso isNan r2
))
546 else raise Fail
"bug"
549 val _
= print
"\nTesting Real.Math.{acos,asin,atan,cos,cosh,exp,ln,log10,sin,sinh,sqrt,tan,tanh}\n"
554 (fn (name
, f
, except
) =>
555 if List.exists (fn r
' => r
== r
') except
558 print (concat
[(*name
, " ", exact r
, " = ", *)
559 fmt (StringCvt.GEN (SOME
10)) (f r
), "\n"]))
566 ("cos", cos
, [maxFinite
, halfMaxFinite
,
567 ~maxFinite
, ~halfMaxFinite
]),
568 ("cosh", cosh
, [s2r
"12.3", s2r
"~12.3", e
, ~e
]),
569 ("exp", exp
, [s2r
"12.3", pi
, s2r
"1.23",
570 s2r
"~12.3", ~pi
, s2r
"~1.23"]),
572 ("log10", log10
, [s2r
"1.23", pi
]),
573 ("sin", sin
, [maxFinite
, halfMaxFinite
,
574 ~maxFinite
, ~halfMaxFinite
, pi
, ~pi
]),
575 ("sinh", sinh
, [pi
, ~pi
, s2r
"0.123", s2r
"~0.123"]),
576 ("sqrt", sqrt
, [maxFinite
]),
577 ("tan", tan
, [maxFinite
, halfMaxFinite
,
578 ~maxFinite
, ~halfMaxFinite
, pi
, ~pi
]),
579 ("tanh", tanh
, [s2r
"0.123", s2r
"~0.123"])]
582 val _
= print
"\nTesting Real.{*,+,-,/,nextAfter,rem} Real.Math.{atan2,pow}\n"
589 (fn (name
, f
, except
) =>
590 if List.exists (fn (r1
', r2
') => r1
== r1
' andalso r2
== r2
') except
593 print (concat
[(*name
, " (", exact r1
, ", ", exact r2
, ") = ", *)
594 exact (f (r1
, r2
)), "\n"]))
598 ("/", op /, [(s2r
"1.23", halfMaxFinite
),
599 (s2r
"1.23", ~halfMaxFinite
),
600 (s2r
"~1.23", halfMaxFinite
),
601 (s2r
"~1.23", ~halfMaxFinite
)
603 ("nextAfter", nextAfter
, [])
604 (* ("rem", rem
, []), *)
605 (* ("atan2", Math
.atan2
, []), *)
606 (* ("pow", Math
.pow
, [(halfMaxFinite
, s2r
"0.123"), (pi
, e
)]) *)
610 if List.all (op ==) [(posInf
+ posInf
, posInf
),
611 (negInf
+ negInf
, negInf
),
612 (posInf
- negInf
, posInf
),
613 (negInf
- posInf
, negInf
)]
614 andalso List.all isNan
[nan
, nan
+ one
, nan
- one
, nan
* one
, nan
/ one
]
615 andalso List.all isNan
[posInf
+ negInf
, negInf
+ posInf
, posInf
- posInf
,
618 else raise Fail
"bug"
620 val _
= print
"\nTesting *+, *-\n"
628 if *+ (r1
, r2
, r3
) == r1
* r2
+ r3
630 else raise Fail
"*+ bug")))
632 val _
= print
"\nTesting Real.{realCeil,realFloor,realTrunc}\n"
637 val ceil
= realCeil r
638 val floor
= realFloor r
639 val trunc
= realTrunc r
640 val _
= print (concat
[exact r
, " ",
647 andalso abs trunc
<= abs r
649 else raise Fail
"bug"
652 val _
= print
"\nTesting Real.{<,<=,>,>=,==,!=,?=,unordered}\n"
663 print (concat
[(* name
, " (", exact r1
, ", ", exact r2
, ") = ", *)
664 b2s (f (r1
, r2
)), "\n"]))
670 if unordered (r1
, r2
) = (isNan r1
orelse isNan r2
)
671 andalso (r1
!= r2
) = not (r1
== r2
)
672 andalso if unordered (r1
, r2
)
673 then (false = (r1
<= r2
)
674 andalso false = (r1
< r2
)
675 andalso false = (r1
>= r2
)
676 andalso false = (r1
> r2
)
677 andalso false = (r1
== r2
)
678 andalso if isNan r1
andalso isNan r2
679 then true = ?
= (r1
, r2
)
681 else ((r1
< r2
) = not (r1
>= r2
)
682 andalso (r1
> r2
) = not (r1
<= r2
))
684 else raise Fail
"bug"
687 val _
= print
"\nTesting compare, compareReal\n"
696 case SOME (compare (r
, r
')) handle IEEEReal
.Unordered
=> NONE
of
701 | GREATER
=> "GREATER"
703 datatype z
= datatype IEEEReal
.real_order
705 case compareReal (r
, r
') of
707 | GREATER
=> "GREATER"
709 | UNORDERED
=> "UNORDERED"
711 print (concat
[(* exact r
, " ", exact r
', "\t", *)
714 if compareReal (r
, r
') = (case compareReal (r
', r
) of
718 | UNORDERED
=> UNORDERED
)
720 else raise Fail
"compareReal bug"
723 val _
= print
"\nTesting abs\n"
726 if abs r
== abs (~ r
)
728 else raise Fail
"abs bug")
730 val _
= print
"\nTesting {from,to}ManExp\n"
735 if List.exists (fn y
=> x
== y
) [halfMinNormalPos
, minPos
,
736 ~halfMinNormalPos
, ~minPos
]
740 val {exp
, man
} = toManExp x
744 print (concat
[exact x
, " = ", exact man
, " * 2^", i2s exp
,
747 val x
' = fromManExp
{exp
= exp
, man
= man
}
751 print (concat
["\t = ", exact x
', "\n"])
756 else raise Fail
"bug"
759 val _
= print
"\nTesting split\n"
764 val {whole
, frac
} = split r
768 print (concat
["split ", exact r
, " = {whole = ",
769 exact whole
, ", frac = ", exact frac
, "}\n",
770 "realMod ", exact whole
, " = ",
771 exact (realMod whole
), "\t",
772 b2s (sameSign (r
, whole
)), "\t",
773 b2s (sameSign (r
, frac
)), "\n"])
777 andalso realMod whole
== zero
778 andalso abs frac
< one
779 andalso sameSign (r
, whole
)
780 andalso sameSign (r
, frac
)
781 andalso (case class r
of
782 INF
=> whole
== r
andalso frac
== zero
783 | NAN
=> isNan whole
andalso isNan frac
784 | _
=> r
== whole
+ frac
)
786 else raise Fail
"bug"
789 val _
= print
"\nTesting {from,to}Large\n"
794 if r
== fromLarge
TO_NEAREST (toLarge r
)
796 else raise Fail
"{from,to}Large bug")
800 structure Z
= Test (structure Real = Real32
802 structure Z
= Test (structure Real = Real64