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

Parent Directory | Revision Log

---

Revision 353 - (view) (download)

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

---

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