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

Parent Directory | 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