1 (* Copyright (C
) 2009 Matthew Fluet
.
2 * Copyright (C
) 1999-2006 Henry Cejtin
, Matthew Fluet
, Suresh
3 * Jagannathan
, and Stephen Weeks
.
4 * Copyright (C
) 1997-2000 NEC Research Institute
.
6 * MLton is released under a BSD
-style license
.
7 * See the file MLton
-LICENSE for details
.
10 (* SML
/NJ uses an old version
of datatype IEEEReal
.float_class
. *)
15 structure Math
: MATH
where type real = real
17 val != : real * real -> bool
18 val * : real * real -> real
19 val *+ : real * real * real -> real
20 val *- : real * real * real -> real
21 val + : real * real -> real
22 val - : real * real -> real
23 val / : real * real -> real
24 val < : real * real -> bool
25 val <= : real * real -> bool
26 val == : real * real -> bool
27 val > : real * real -> bool
28 val >= : real * real -> bool
29 val ?
= : real * real -> bool
31 val checkFloat
: real -> real
32 val class
: real -> IEEEReal
.float_class
33 val compare
: real * real -> order
34 val compareReal
: real * real -> IEEEReal
.real_order
35 val copySign
: real * real -> real
36 val fmt
: StringCvt.realfmt
-> real -> string
37 val fromDecimal
: IEEEReal
.decimal_approx
-> real option
38 val fromInt
: int -> real
39 val fromLarge
: IEEEReal
.rounding_mode
-> LargeReal
.real -> real
40 val fromLargeInt
: LargeInt
.int -> real
41 val fromManExp
: {man
: real, exp
: int} -> real
42 val fromString
: string -> real option
43 val isFinite
: real -> bool
44 val isNan
: real -> bool
45 val isNormal
: real -> bool
46 val max
: real * real -> real
48 val min
: real * real -> real
49 val minNormalPos
: real
52 val nextAfter
: real * real -> real
56 val realCeil
: real -> real
57 val realFloor
: real -> real
58 val realMod
: real -> real
59 val realRound
: real -> real
60 val realTrunc
: real -> real
61 val rem
: real * real -> real
62 val round
: real -> Int.int
63 val sameSign
: real * real -> bool
64 val scan
: (char
, 'a
) StringCvt.reader
-> (real, 'a
) StringCvt.reader
66 val signBit
: real -> bool
67 val split
: real -> {whole
: real, frac
: real}
68 val toDecimal
: real -> IEEEReal
.decimal_approx
69 val toInt
: IEEEReal
.rounding_mode
-> real -> int
70 val toLarge
: real -> LargeReal
.real
71 val toLargeInt
: IEEEReal
.rounding_mode
-> real -> LargeInt
.int
72 val toManExp
: real -> {man
: real, exp
: int}
73 val toString
: real -> string
74 val unordered
: real * real -> bool
76 val ceil
: real -> Int.int
77 val floor
: real -> Int.int
78 val trunc
: real -> Int.int
81 functor FixReal(PReal
: sig include PERVASIVE_REAL
val zero
: real end) : REAL
=
86 datatype z
= datatype IEEEReal
.float_class
87 structure P
= Pervasive
.IEEEReal
94 | P
.SUBNORMAL
=> SUBNORMAL
101 | SUBNORMAL
=> P
.SUBNORMAL
102 fun toGoodDA
{digits
, exp
, kind
, sign
} =
103 {digits
= digits
, exp
= exp
, kind
= toGoodFC kind
, sign
= sign
}
104 fun toBadDA
{digits
, exp
, kind
, sign
} =
105 {digits
= digits
, exp
= exp
, kind
= toBadFC kind
, sign
= sign
}
107 val class
= toGoodFC
o class
108 val fromDecimal
= SOME
o fromDecimal
o toBadDA
109 val toDecimal
= toGoodDA
o toDecimal
112 (* SML
/NJ doesn
't support EXACT
113 * and doesn
't
include a leading
"~" for ~
0.0.
120 datatype z
= datatype StringCvt.realfmt
123 EXACT
=> StringCvt.GEN NONE
124 | FIX io
=> StringCvt.FIX io
125 | GEN io
=> StringCvt.GEN io
126 | SCI io
=> StringCvt.SCI io
130 if == (zero
, r
) andalso signBit r
135 (* SML
/NJ doesn
't
handle "[+~-]?(inf|infinity|nan)"
136 * and raises Overflow on large exponents
.
141 |
"infinity" => SOME posInf
142 |
"+inf" => SOME posInf
143 |
"+infinity" => SOME posInf
144 |
"~inf" => SOME negInf
145 |
"~infinity" => SOME negInf
146 |
"-inf" => SOME negInf
147 |
"-infinity" => SOME negInf
148 |
"nan" => SOME (negInf
+ posInf
)
149 |
"+nan" => SOME (negInf
+ posInf
)
150 |
"~nan" => SOME (negInf
+ posInf
)
151 |
"-nan" => SOME (negInf
+ posInf
)
153 (case SOME (PReal
.fromString s
) handle Overflow
=> NONE
of
158 (fn c
=> c
= #
"e" orelse c
= #
"E")
161 String.sub (s
, 0) = #
"~"
162 orelse String.sub (s
, 0) = #
"+"
165 (fn c
=> Char.<= (#
"1", c
) andalso Char.<= (c
, #
"9"))
172 else if isNonzero man
180 structure LargeReal
= FixReal(struct open Pervasive
.LargeReal
val zero
: real = 0.0 end)
181 structure Real = FixReal(struct open Pervasive
.Real val zero
: real = 0.0 end)
182 structure Real64
= FixReal(struct open Pervasive
.Real64
val zero
: real = 0.0 end)
183 structure Real32
= Real64
185 (* Dummy implementation that will not be used at run
-time
. *)
186 structure PackReal32Big
: PACK_REAL
where type real = Real32
.real = struct
187 type real = Real32
.real
189 val isBigEndian
= false
190 fun toBytes _
= raise Fail
"PackReal32Big.toBytes"
191 fun fromBytes _
= raise Fail
"PackReal32Big.fromBytes"
192 fun subVec _
= raise Fail
"PackReal32Big.subVec"
193 fun subArr _
= raise Fail
"PackReal32Big.subArr"
194 fun update _
= raise Fail
"PackReal32Big.update"
196 (* Dummy implementation that will not be used at run
-time
. *)
197 structure PackReal32Little
: PACK_REAL
where type real = Real32
.real = struct
198 type real = Real32
.real
200 val isBigEndian
= false
201 fun toBytes _
= raise Fail
"PackReal32Little.toBytes"
202 fun fromBytes _
= raise Fail
"PackReal32Little.fromBytes"
203 fun subVec _
= raise Fail
"PackReal32Little.subVec"
204 fun subArr _
= raise Fail
"PackReal32Little.subArr"
205 fun update _
= raise Fail
"PackReal32Little.update"
208 (* Dummy implementation that will not be used at run
-time
. *)
209 structure PackReal64Big
: PACK_REAL
where type real = Real64
.real = struct
210 type real = Real64
.real
212 val isBigEndian
= false
213 fun toBytes _
= raise Fail
"PackReal64Big.toBytes"
214 fun fromBytes _
= raise Fail
"PackReal64Big.fromBytes"
215 fun subVec _
= raise Fail
"PackReal64Big.subVec"
216 fun subArr _
= raise Fail
"PackReal64Big.subArr"
217 fun update _
= raise Fail
"PackReal64Big.update"
219 (* Dummy implementation that will not be used at run
-time
. *)
220 structure PackReal64Little
: PACK_REAL
where type real = Real64
.real = struct
221 type real = Real64
.real
223 val isBigEndian
= false
224 fun toBytes _
= raise Fail
"PackReal64Little.toBytes"
225 fun fromBytes _
= raise Fail
"PackReal64Little.fromBytes"
226 fun subVec _
= raise Fail
"PackReal64Little.subVec"
227 fun subArr _
= raise Fail
"PackReal64Little.subArr"
228 fun update _
= raise Fail
"PackReal64Little.update"