Commit | Line | Data |
---|---|---|
7f918cf1 CE |
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) |