Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Annotation of /trunk/src/compiler/common/float-lit.sml
ViewVC logotype

Annotation of /trunk/src/compiler/common/float-lit.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3349 - (view) (download)

1 : jhr 26 (* float-lit.sml
2 :     *
3 : jhr 3349 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2015 The University of Chicago
6 : jhr 26 * All rights reserved.
7 :     *
8 :     * Internal representation of floating-point literals with limited
9 :     * support for arithmetic.
10 :     *)
11 :    
12 :     structure FloatLit :> sig
13 :    
14 :     type float
15 :    
16 : jhr 1113 (* predicates *)
17 :     val isZero : float -> bool (* true for 0 or -0 *)
18 :     val isNeg : float -> bool (* true for negative numbers (incl. -0) *)
19 : jhr 26
20 : jhr 2356 (* return the representation of +/-0.0, where zero true is -0.0 *)
21 : jhr 83 val zero : bool -> float
22 : jhr 26
23 :     (* plus and minus one *)
24 :     val one : float
25 :     val m_one : float
26 :    
27 : jhr 1113 val pi : float
28 :    
29 : jhr 26 (* negate a float *)
30 :     val negate : float -> float
31 :    
32 :     (* equality, comparisons, and hashing functions *)
33 :     val same : (float * float) -> bool
34 : jhr 42 val compare : (float * float) -> order (* not ordering on reals *)
35 : jhr 26 val hash : float -> word
36 :    
37 : jhr 42 (* special floats *)
38 :     val nan : float (* some quiet NaN *)
39 :     val posInf : float (* positive infinity *)
40 :     val negInf : float (* negative infinity *)
41 :    
42 : jhr 26 (* create a float from pieces: isNeg is true if the number is negative, whole
43 :     * is the whole-number part, frac is the fractional part, and exp is the
44 :     * exponent. This function may raise Overflow, when the exponent of the
45 :     * normalized representation is too small or too large.
46 :     *)
47 :     val float : {isNeg : bool, whole : string, frac : string, exp : int} -> float
48 : jhr 328
49 : jhr 462 (* create a float literal from a sign, decimal fraction, and exponent *)
50 :     val fromDigits : {isNeg : bool, digits : int list, exp : int} -> float
51 :    
52 : jhr 328 (* create a float literal from an integer *)
53 : jhr 2356 val fromInt : IntInf.int -> float
54 : jhr 328
55 : jhr 26 val toString : float -> string
56 : jhr 234 val toReal : float -> real
57 : jhr 26
58 :     (* external representation (for pickling) *)
59 :     val toBytes : float -> Word8Vector.vector
60 :     val fromBytes : Word8Vector.vector -> float
61 :    
62 :     end = struct
63 :    
64 :     structure SS = Substring
65 :     structure W = Word
66 :     structure W8V = Word8Vector
67 :    
68 :     (* The value {isNeg, digits=[d0, ..., dn], exp} represents the number
69 :     *
70 :     * [+/-] 0.d0...dn * 10^exp
71 :     *
72 :     * where the sign is negative if isNeg is true.
73 :     *)
74 : jhr 42 datatype float
75 :     = PosInf (* positive infinity *)
76 :     | NegInf (* negative infinity *)
77 :     | NaN (* some quiet NaN *)
78 :     | Flt of {isNeg : bool, digits : int list, exp : int}
79 : jhr 26
80 : jhr 42 (* special floats *)
81 :     val nan = NaN
82 :     val posInf = PosInf
83 :     val negInf = NegInf
84 :    
85 :     fun isZero (Flt{isNeg, digits=[0], exp}) = true
86 : jhr 26 | isZero _ = false
87 :    
88 : jhr 1113 fun isNeg NegInf = true
89 :     | isNeg (Flt{isNeg, ...}) = isNeg
90 :     | isNeg _ = false
91 :    
92 : jhr 42 fun zero isNeg = Flt{isNeg = isNeg, digits = [0], exp = 0}
93 : jhr 26
94 : jhr 42 val one = Flt{isNeg = false, digits = [1], exp = 1}
95 :     val m_one = Flt{isNeg = true, digits = [1], exp = 1}
96 : jhr 26
97 : jhr 1113 val pi = Flt{
98 :     isNeg = false,
99 :     digits=[3,1,4,1,5,9,2,6,5,3,5,8,9,7,9,3,2,3,8,4,6,2,6,4,3,3,8,3,2,8],
100 :     exp = 1
101 :     }
102 :    
103 : jhr 26 (* negate a float *)
104 : jhr 42 fun negate PosInf = NegInf
105 :     | negate NegInf = PosInf
106 :     | negate NaN = raise Fail "negate nan"
107 :     | negate (Flt{isNeg, digits, exp}) =
108 :     Flt{isNeg = not isNeg, digits = digits, exp = exp}
109 : jhr 26
110 :     (* equality, comparisons, and hashing functions *)
111 : jhr 42 fun same (NegInf, NegInf) = true
112 :     | same (PosInf, PosInf) = true
113 :     | same (NaN, NaN) = true
114 :     | same (Flt f1, Flt f2) =
115 : jhr 26 (#isNeg f1 = #isNeg f2) andalso (#exp f1 = #exp f2)
116 :     andalso (#digits f1 = #digits f2)
117 : jhr 42 | same _ = false
118 : jhr 26
119 : jhr 42 fun compare (NegInf, NegInf) = EQUAL
120 :     | compare (NegInf, _) = LESS
121 :     | compare (_, NegInf) = GREATER
122 :     | compare (PosInf, PosInf) = EQUAL
123 :     | compare (PosInf, _) = LESS
124 :     | compare (_, PosInf) = GREATER
125 :     | compare (NaN, NaN) = EQUAL
126 :     | compare (NaN, _) = LESS
127 :     | compare (_, NaN) = GREATER
128 :     | compare (Flt f1, Flt f2) = (case (#isNeg f1, #isNeg f2)
129 : jhr 26 of (false, true) => GREATER
130 :     | (true, false) => LESS
131 :     | _ => (case Int.compare(#exp f1, #exp f2)
132 :     of EQUAL => let
133 :     fun cmp ([], []) = EQUAL
134 :     | cmp ([], _) = LESS
135 :     | cmp (_, []) = GREATER
136 :     | cmp (d1::r1, d2::r2) = (case Int.compare(d1, d2)
137 :     of EQUAL => cmp(r1, r2)
138 :     | order => order
139 :     (* end case *))
140 :     in
141 :     cmp (#digits f1, #digits f2)
142 :     end
143 :     | order => order
144 :     (* end case *))
145 :     (* end case *))
146 :    
147 : jhr 42 fun hash PosInf = 0w1
148 :     | hash NegInf = 0w3
149 :     | hash NaN = 0w5
150 :     | hash (Flt{isNeg, digits, exp}) = let
151 : jhr 26 fun hashDigits ([], h, _) = h
152 :     | hashDigits (d::r, h, i) =
153 :     hashDigits (r, W.<<(W.fromInt d, i+0w4), W.andb(i+0w1, 0wxf))
154 :     in
155 :     hashDigits(digits, W.fromInt exp, 0w0)
156 :     end
157 :    
158 :     fun float {isNeg, whole, frac, exp} = let
159 :     fun cvtDigit (c, l) = (Char.ord c - Char.ord #"0") :: l
160 :     fun isZero #"0" = true | isZero _ = false
161 :     (* whole digits with leading zeros removed *)
162 :     val whole = SS.dropl isZero (SS.full whole)
163 :     (* fractional digits with trailing zeros removed *)
164 :     val frac = SS.dropr isZero (SS.full frac)
165 :     (* normalize by stripping leading zero digits *)
166 :     fun normalize {isNeg, digits=[], exp} = zero isNeg
167 :     | normalize {isNeg, digits=0::r, exp} =
168 :     normalize {isNeg=isNeg, digits=r, exp=exp-1}
169 : jhr 42 | normalize flt = Flt flt
170 : jhr 26 in
171 :     case SS.foldr cvtDigit (SS.foldr cvtDigit [] frac) whole
172 :     of [] => zero isNeg
173 :     | digits => normalize {
174 :     isNeg = isNeg,
175 :     digits = digits,
176 :     exp = exp + SS.size whole
177 :     }
178 :     (* end case *)
179 :     end
180 :    
181 : jhr 462 (* create a float literal from a sign, decimal fraction, and exponent *)
182 :     fun fromDigits arg = let
183 :     (* normalize by stripping leading zero digits *)
184 :     fun normalize {isNeg, digits=[], exp} = zero isNeg
185 :     | normalize {isNeg, digits=0::r, exp} =
186 :     normalize {isNeg=isNeg, digits=r, exp=exp-1}
187 :     | normalize flt = Flt flt
188 :     in
189 :     normalize arg
190 :     end
191 :    
192 : jhr 328 fun fromInt 0 = zero false
193 :     | fromInt n = let
194 : jhr 353 val (isNeg, n) = if (n < 0) then (true, ~n) else (false, n)
195 : jhr 328 fun toDigits (n, d) = if n < 10
196 : jhr 2356 then IntInf.toInt n :: d
197 :     else toDigits(IntInf.quot(n, 10), IntInf.toInt(IntInf.rem(n, 10)) :: d)
198 : jhr 328 fun cvt isNeg = let
199 :     val digits = toDigits(n, [])
200 :     in
201 :     Flt{isNeg = isNeg, digits = digits, exp = List.length digits}
202 :     end
203 :     in
204 : jhr 353 cvt isNeg
205 : jhr 328 end
206 :    
207 : jhr 42 fun toString PosInf = "+inf"
208 :     | toString NegInf = "-inf"
209 :     | toString NaN = "nan"
210 : jhr 1113 | toString (Flt{isNeg, digits=[0], ...}) = if isNeg then "-0.0" else "0.0"
211 : jhr 42 | toString (Flt{isNeg, digits, exp}) = let
212 : jhr 26 val s = if isNeg then "-0." else "0."
213 :     val e = if exp < 0
214 :     then ["e-", Int.toString(~exp)]
215 :     else ["e", Int.toString exp]
216 :     in
217 :     concat(s :: List.foldr (fn (d, ds) => Int.toString d :: ds) e digits)
218 :     end
219 :    
220 : jhr 234 fun toReal PosInf = Real.posInf
221 :     | toReal NegInf = Real.negInf
222 :     | toReal NaN = 0.0 / 0.0
223 :     | toReal x = valOf(Real.fromString(toString x)) (* FIXME *)
224 : jhr 26
225 :    
226 :     (***** external representation (for pickling) *****
227 :     *
228 :     * The representation we use is a sequence of bytes:
229 :     *
230 :     * [sign, d0, ..., dn, exp0, ..., exp3]
231 :     *
232 :     * where
233 :     * sign == 0 or 1
234 :     * di == ith digit
235 :     * expi == ith byte of exponent (exp0 is lsb, exp3 is msb).
236 :     *
237 : jhr 42 * we encode Infs and NaNs using the sign byte:
238 :     *
239 :     * 2 == PosInf
240 :     * 3 == NegInf
241 :     * 4 == NaN
242 :     *
243 : jhr 26 * NOTE: we could pack the sign and digits into 4-bit nibbles, but we are keeping
244 :     * things simple for now.
245 :     *)
246 :    
247 : jhr 42 fun toBytes PosInf = Word8Vector.fromList [0w2]
248 :     | toBytes NegInf = Word8Vector.fromList [0w3]
249 :     | toBytes NaN = Word8Vector.fromList [0w4]
250 :     | toBytes (Flt{isNeg, digits, exp}) = let
251 : jhr 26 val sign = if isNeg then 0w1 else 0w0
252 :     val digits = List.map Word8.fromInt digits
253 :     val exp' = W.fromInt exp
254 :     fun byte i = Word8.fromLargeWord(W.toLargeWord((W.>>(exp', 0w8*i))))
255 :     val exp = [byte 0w0, byte 0w1, byte 0w2, byte 0w3]
256 :     in
257 :     Word8Vector.fromList(sign :: (digits @ exp))
258 :     end
259 :    
260 :     fun fromBytes v = let
261 :     fun error () = raise Fail "Bogus float pickle"
262 : jhr 42 val len = W8V.length v
263 :     in
264 :     if (len = 1)
265 :     then (case W8V.sub(v, 0) (* special float value *)
266 :     of 0w2 => PosInf
267 :     | 0w3 => NegInf
268 :     | 0w4 => NaN
269 : jhr 26 | _ => error()
270 :     (* end case *))
271 : jhr 42 else let
272 :     val ndigits = W8V.length v - 5
273 :     val _ = if (ndigits < 1) then error() else ()
274 :     val isNeg = (case W8V.sub(v, 0)
275 :     of 0w0 => false
276 :     | 0w1 => true
277 :     | _ => error()
278 :     (* end case *))
279 :     fun digit i = Word8.toInt(W8V.sub(v, i+1))
280 :     fun byte i = W.<<(
281 :     W.fromLargeWord(Word8.toLargeWord(W8V.sub(v, ndigits+1+i))),
282 :     W.fromInt(8*i))
283 :     val exp = W.toIntX(W.orb(byte 3, W.orb(byte 2, W.orb(byte 1, byte 0))))
284 :     in
285 :     Flt{isNeg = isNeg, digits = List.tabulate(ndigits, digit), exp = exp}
286 :     end
287 : jhr 26 end
288 :    
289 :     end
290 :    

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0