Home My Page Projects Code Snippets Project Openings diderot

# SCM Repository

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

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

 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 : val toString : float -> string 43 : 44 : (* external representation (for pickling) *) 45 : val toBytes : float -> Word8Vector.vector 46 : val fromBytes : Word8Vector.vector -> float 47 : 48 : end = struct 49 : 50 : structure SS = Substring 51 : structure W = Word 52 : structure W8V = Word8Vector 53 : 54 : (* The value {isNeg, digits=[d0, ..., dn], exp} represents the number 55 : * 56 : * [+/-] 0.d0...dn * 10^exp 57 : * 58 : * where the sign is negative if isNeg is true. 59 : *) 60 : jhr 42 datatype float 61 : = PosInf (* positive infinity *) 62 : | NegInf (* negative infinity *) 63 : | NaN (* some quiet NaN *) 64 : | Flt of {isNeg : bool, digits : int list, exp : int} 65 : jhr 26 66 : jhr 42 (* special floats *) 67 : val nan = NaN 68 : val posInf = PosInf 69 : val negInf = NegInf 70 : 71 : fun isZero (Flt{isNeg, digits=[0], exp}) = true 72 : jhr 26 | isZero _ = false 73 : 74 : jhr 42 fun zero isNeg = Flt{isNeg = isNeg, digits = [0], exp = 0} 75 : jhr 26 76 : jhr 42 val one = Flt{isNeg = false, digits = [1], exp = 1} 77 : val m_one = Flt{isNeg = true, digits = [1], exp = 1} 78 : jhr 26 79 : (* negate a float *) 80 : jhr 42 fun negate PosInf = NegInf 81 : | negate NegInf = PosInf 82 : | negate NaN = raise Fail "negate nan" 83 : | negate (Flt{isNeg, digits, exp}) = 84 : Flt{isNeg = not isNeg, digits = digits, exp = exp} 85 : jhr 26 86 : (* equality, comparisons, and hashing functions *) 87 : jhr 42 fun same (NegInf, NegInf) = true 88 : | same (PosInf, PosInf) = true 89 : | same (NaN, NaN) = true 90 : | same (Flt f1, Flt f2) = 91 : jhr 26 (#isNeg f1 = #isNeg f2) andalso (#exp f1 = #exp f2) 92 : andalso (#digits f1 = #digits f2) 93 : jhr 42 | same _ = false 94 : jhr 26 95 : jhr 42 fun compare (NegInf, NegInf) = EQUAL 96 : | compare (NegInf, _) = LESS 97 : | compare (_, NegInf) = GREATER 98 : | compare (PosInf, PosInf) = EQUAL 99 : | compare (PosInf, _) = LESS 100 : | compare (_, PosInf) = GREATER 101 : | compare (NaN, NaN) = EQUAL 102 : | compare (NaN, _) = LESS 103 : | compare (_, NaN) = GREATER 104 : | compare (Flt f1, Flt f2) = (case (#isNeg f1, #isNeg f2) 105 : jhr 26 of (false, true) => GREATER 106 : | (true, false) => LESS 107 : | _ => (case Int.compare(#exp f1, #exp f2) 108 : of EQUAL => let 109 : fun cmp ([], []) = EQUAL 110 : | cmp ([], _) = LESS 111 : | cmp (_, []) = GREATER 112 : | cmp (d1::r1, d2::r2) = (case Int.compare(d1, d2) 113 : of EQUAL => cmp(r1, r2) 114 : | order => order 115 : (* end case *)) 116 : in 117 : cmp (#digits f1, #digits f2) 118 : end 119 : | order => order 120 : (* end case *)) 121 : (* end case *)) 122 : 123 : jhr 42 fun hash PosInf = 0w1 124 : | hash NegInf = 0w3 125 : | hash NaN = 0w5 126 : | hash (Flt{isNeg, digits, exp}) = let 127 : jhr 26 fun hashDigits ([], h, _) = h 128 : | hashDigits (d::r, h, i) = 129 : hashDigits (r, W.<<(W.fromInt d, i+0w4), W.andb(i+0w1, 0wxf)) 130 : in 131 : hashDigits(digits, W.fromInt exp, 0w0) 132 : end 133 : 134 : fun float {isNeg, whole, frac, exp} = let 135 : fun cvtDigit (c, l) = (Char.ord c - Char.ord #"0") :: l 136 : fun isZero #"0" = true | isZero _ = false 137 : (* whole digits with leading zeros removed *) 138 : val whole = SS.dropl isZero (SS.full whole) 139 : (* fractional digits with trailing zeros removed *) 140 : val frac = SS.dropr isZero (SS.full frac) 141 : (* normalize by stripping leading zero digits *) 142 : fun normalize {isNeg, digits=[], exp} = zero isNeg 143 : | normalize {isNeg, digits=0::r, exp} = 144 : normalize {isNeg=isNeg, digits=r, exp=exp-1} 145 : jhr 42 | normalize flt = Flt flt 146 : jhr 26 in 147 : case SS.foldr cvtDigit (SS.foldr cvtDigit [] frac) whole 148 : of [] => zero isNeg 149 : | digits => normalize { 150 : isNeg = isNeg, 151 : digits = digits, 152 : exp = exp + SS.size whole 153 : } 154 : (* end case *) 155 : end 156 : 157 : jhr 42 fun toString PosInf = "+inf" 158 : | toString NegInf = "-inf" 159 : | toString NaN = "nan" 160 : | toString (Flt{isNeg, digits, exp}) = let 161 : jhr 26 val s = if isNeg then "-0." else "0." 162 : val e = if exp < 0 163 : then ["e-", Int.toString(~exp)] 164 : else ["e", Int.toString exp] 165 : in 166 : concat(s :: List.foldr (fn (d, ds) => Int.toString d :: ds) e digits) 167 : end 168 : 169 : 170 : 171 : (***** external representation (for pickling) ***** 172 : * 173 : * The representation we use is a sequence of bytes: 174 : * 175 : * [sign, d0, ..., dn, exp0, ..., exp3] 176 : * 177 : * where 178 : * sign == 0 or 1 179 : * di == ith digit 180 : * expi == ith byte of exponent (exp0 is lsb, exp3 is msb). 181 : * 182 : jhr 42 * we encode Infs and NaNs using the sign byte: 183 : * 184 : * 2 == PosInf 185 : * 3 == NegInf 186 : * 4 == NaN 187 : * 188 : jhr 26 * NOTE: we could pack the sign and digits into 4-bit nibbles, but we are keeping 189 : * things simple for now. 190 : *) 191 : 192 : jhr 42 fun toBytes PosInf = Word8Vector.fromList [0w2] 193 : | toBytes NegInf = Word8Vector.fromList [0w3] 194 : | toBytes NaN = Word8Vector.fromList [0w4] 195 : | toBytes (Flt{isNeg, digits, exp}) = let 196 : jhr 26 val sign = if isNeg then 0w1 else 0w0 197 : val digits = List.map Word8.fromInt digits 198 : val exp' = W.fromInt exp 199 : fun byte i = Word8.fromLargeWord(W.toLargeWord((W.>>(exp', 0w8*i)))) 200 : val exp = [byte 0w0, byte 0w1, byte 0w2, byte 0w3] 201 : in 202 : Word8Vector.fromList(sign :: (digits @ exp)) 203 : end 204 : 205 : fun fromBytes v = let 206 : fun error () = raise Fail "Bogus float pickle" 207 : jhr 42 val len = W8V.length v 208 : in 209 : if (len = 1) 210 : then (case W8V.sub(v, 0) (* special float value *) 211 : of 0w2 => PosInf 212 : | 0w3 => NegInf 213 : | 0w4 => NaN 214 : jhr 26 | _ => error() 215 : (* end case *)) 216 : jhr 42 else let 217 : val ndigits = W8V.length v - 5 218 : val _ = if (ndigits < 1) then error() else () 219 : val isNeg = (case W8V.sub(v, 0) 220 : of 0w0 => false 221 : | 0w1 => true 222 : | _ => error() 223 : (* end case *)) 224 : fun digit i = Word8.toInt(W8V.sub(v, i+1)) 225 : fun byte i = W.<<( 226 : W.fromLargeWord(Word8.toLargeWord(W8V.sub(v, ndigits+1+i))), 227 : W.fromInt(8*i)) 228 : val exp = W.toIntX(W.orb(byte 3, W.orb(byte 2, W.orb(byte 1, byte 0)))) 229 : in 230 : Flt{isNeg = isNeg, digits = List.tabulate(ndigits, digit), exp = exp} 231 : end 232 : jhr 26 end 233 : 234 : end 235 :