Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 2009 Matthew Fluet. |
2 | * Copyright (C) 2005 Henry Cejtin, Matthew Fluet, Suresh | |
3 | * Jagannathan, and Stephen Weeks. | |
4 | * | |
5 | * MLton is released under a BSD-style license. | |
6 | * See the file MLton-LICENSE for details. | |
7 | *) | |
8 | ||
9 | (* SML/NJ uses an old version of datatype IEEEReal.float_class. *) | |
10 | signature IEEE_REAL = | |
11 | sig | |
12 | exception Unordered | |
13 | datatype real_order = EQUAL | GREATER | LESS | UNORDERED | |
14 | datatype float_class = INF | NAN | NORMAL | SUBNORMAL | ZERO | |
15 | datatype rounding_mode = TO_NEAREST | TO_NEGINF | TO_POSINF | TO_ZERO | |
16 | val setRoundingMode : rounding_mode -> unit | |
17 | val getRoundingMode : unit -> rounding_mode | |
18 | type decimal_approx = {digits:int list, exp:int, kind:float_class, sign:bool} | |
19 | val toString : decimal_approx -> string | |
20 | val fromString : string -> decimal_approx option | |
21 | val scan : (char,'a) StringCvt.reader -> (decimal_approx,'a) StringCvt.reader | |
22 | end | |
23 | ||
24 | structure IEEEReal : IEEE_REAL = | |
25 | struct | |
26 | open IEEEReal | |
27 | ||
28 | datatype float_class = NAN | INF | ZERO | NORMAL | SUBNORMAL | |
29 | type decimal_approx = {digits:int list, exp:int, kind:float_class, sign:bool} | |
30 | ||
31 | local | |
32 | structure P = Pervasive.IEEEReal | |
33 | fun toGoodFC c = | |
34 | case c of | |
35 | P.NAN _ => NAN | |
36 | | P.INF => INF | |
37 | | P.ZERO => ZERO | |
38 | | P.NORMAL => NORMAL | |
39 | | P.SUBNORMAL => SUBNORMAL | |
40 | fun toBadFC c = | |
41 | case c of | |
42 | NAN => P.NAN P.QUIET | |
43 | | INF => P.INF | |
44 | | ZERO => P.ZERO | |
45 | | NORMAL => P.NORMAL | |
46 | | SUBNORMAL => P.SUBNORMAL | |
47 | fun toGoodDA {digits, exp, kind, sign} = | |
48 | {digits = digits, exp = exp, kind = toGoodFC kind, sign = sign} | |
49 | fun toBadDA {digits, exp, kind, sign} = | |
50 | {digits = digits, exp = exp, kind = toBadFC kind, sign = sign} | |
51 | in | |
52 | val toString = P.toString o toBadDA | |
53 | val fromString = (Option.map toGoodDA) o P.fromString | |
54 | fun scan r s = | |
55 | Option.map (fn (da,x) => (toGoodDA da,x)) (P.scan r s) | |
56 | end | |
57 | ||
58 | end |