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

SCM Repository

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

Diff of /trunk/src/common/float-lit.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 41, Wed Mar 3 17:38:27 2010 UTC revision 42, Wed Mar 3 18:26:50 2010 UTC
# Line 25  Line 25 
25    
26    (* equality, comparisons, and hashing functions *)    (* equality, comparisons, and hashing functions *)
27      val same : (float * float) -> bool      val same : (float * float) -> bool
28      val compare : (float * float) -> order      val compare : (float * float) -> order (* not ordering on reals *)
29      val hash : float -> word      val hash : float -> word
30    
31      (* special floats *)
32        val nan : float             (* some quiet NaN *)
33        val posInf : float          (* positive infinity *)
34        val negInf : float          (* negative infinity *)
35    
36    (* create a float from pieces: isNeg is true if the number is negative, whole    (* 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     * 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     * exponent.  This function may raise Overflow, when the exponent of the
# Line 52  Line 57 
57     *     *
58     * where the sign is negative if isNeg is true.     * where the sign is negative if isNeg is true.
59     *)     *)
60      type float = {isNeg : bool, digits : int list, exp : int}      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    
66      (* special floats *)
67        val nan = NaN
68        val posInf = PosInf
69        val negInf = NegInf
70    
71      fun isZero {isNeg, digits=[0], exp} = true      fun isZero (Flt{isNeg, digits=[0], exp}) = true
72        | isZero _ = false        | isZero _ = false
73    
74      fun zero isNeg = {isNeg = isNeg, digits = [0], exp = 0}      fun zero isNeg = Flt{isNeg = isNeg, digits = [0], exp = 0}
75    
76      val one = {isNeg = false, digits = [1], exp = 1}      val one = Flt{isNeg = false, digits = [1], exp = 1}
77      val m_one = {isNeg = true, digits = [1], exp = 1}      val m_one = Flt{isNeg = true, digits = [1], exp = 1}
78    
79    (* negate a float *)    (* negate a float *)
80      fun negate {isNeg, digits, exp} =      fun negate PosInf = NegInf
81            {isNeg = not isNeg, digits = digits, exp = exp}        | 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    
86    (* equality, comparisons, and hashing functions *)    (* equality, comparisons, and hashing functions *)
87      fun same (f1 : float, f2 : float) =      fun same (NegInf, NegInf) = true
88          | same (PosInf, PosInf) = true
89          | same (NaN, NaN) = true
90          | same (Flt f1, Flt f2) =
91            (#isNeg f1 = #isNeg f2) andalso (#exp f1 = #exp f2)            (#isNeg f1 = #isNeg f2) andalso (#exp f1 = #exp f2)
92            andalso (#digits f1 = #digits f2)            andalso (#digits f1 = #digits f2)
93          | same _ = false
94    
95      fun compare (f1 : float, f2 : float) = (case (#isNeg f1, #isNeg f2)      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             of (false, true) => GREATER             of (false, true) => GREATER
106              | (true, false) => LESS              | (true, false) => LESS
107              | _ => (case Int.compare(#exp f1, #exp f2)              | _ => (case Int.compare(#exp f1, #exp f2)
# Line 90  Line 120 
120                  (* end case *))                  (* end case *))
121            (* end case *))            (* end case *))
122    
123      fun hash {isNeg, digits, exp} = let      fun hash PosInf = 0w1
124          | hash NegInf = 0w3
125          | hash NaN = 0w5
126          | hash (Flt{isNeg, digits, exp}) = let
127            fun hashDigits ([], h, _) = h            fun hashDigits ([], h, _) = h
128              | hashDigits (d::r, h, i) =              | hashDigits (d::r, h, i) =
129                  hashDigits (r, W.<<(W.fromInt d, i+0w4), W.andb(i+0w1, 0wxf))                  hashDigits (r, W.<<(W.fromInt d, i+0w4), W.andb(i+0w1, 0wxf))
# Line 109  Line 142 
142            fun normalize {isNeg, digits=[], exp} = zero isNeg            fun normalize {isNeg, digits=[], exp} = zero isNeg
143              | normalize {isNeg, digits=0::r, exp} =              | normalize {isNeg, digits=0::r, exp} =
144                  normalize {isNeg=isNeg, digits=r, exp=exp-1}                  normalize {isNeg=isNeg, digits=r, exp=exp-1}
145              | normalize flt = flt              | normalize flt = Flt flt
146            in            in
147              case SS.foldr cvtDigit (SS.foldr cvtDigit [] frac) whole              case SS.foldr cvtDigit (SS.foldr cvtDigit [] frac) whole
148               of [] => zero isNeg               of [] => zero isNeg
# Line 121  Line 154 
154              (* end case *)              (* end case *)
155            end            end
156    
157      fun toString {isNeg, digits, exp} = let      fun toString PosInf = "+inf"
158          | toString NegInf = "-inf"
159          | toString NaN = "nan"
160          | toString (Flt{isNeg, digits, exp}) = let
161            val s = if isNeg then "-0." else "0."            val s = if isNeg then "-0." else "0."
162            val e = if exp < 0            val e = if exp < 0
163                  then ["e-", Int.toString(~exp)]                  then ["e-", Int.toString(~exp)]
# Line 143  Line 179 
179     *    di      == ith digit     *    di      == ith digit
180     *    expi    == ith byte of exponent (exp0 is lsb, exp3 is msb).     *    expi    == ith byte of exponent (exp0 is lsb, exp3 is msb).
181     *     *
182       * we encode Infs and NaNs using the sign byte:
183       *
184       *    2       == PosInf
185       *    3       == NegInf
186       *    4       == NaN
187       *
188     * NOTE: we could pack the sign and digits into 4-bit nibbles, but we are keeping     * NOTE: we could pack the sign and digits into 4-bit nibbles, but we are keeping
189     * things simple for now.     * things simple for now.
190     *)     *)
191    
192      fun toBytes {isNeg, digits, exp} = let      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            val sign = if isNeg then 0w1 else 0w0            val sign = if isNeg then 0w1 else 0w0
197            val digits = List.map Word8.fromInt digits            val digits = List.map Word8.fromInt digits
198            val exp' = W.fromInt exp            val exp' = W.fromInt exp
# Line 158  Line 203 
203            end            end
204    
205      fun fromBytes v = let      fun fromBytes v = let
           val ndigits = W8V.length v - 5  
206            fun error () = raise Fail "Bogus float pickle"            fun error () = raise Fail "Bogus float pickle"
207              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                      | _ => error()
215                    (* end case *))
216                  else let
217                    val ndigits = W8V.length v - 5
218            val _ = if (ndigits < 1) then error() else ()            val _ = if (ndigits < 1) then error() else ()
219            val isNeg = (case W8V.sub(v, 0)            val isNeg = (case W8V.sub(v, 0)
220                   of 0w0 => false                   of 0w0 => false
# Line 172  Line 227 
227                  W.fromInt(8*i))                  W.fromInt(8*i))
228            val exp = W.toIntX(W.orb(byte 3, W.orb(byte 2, W.orb(byte 1, byte 0))))            val exp = W.toIntX(W.orb(byte 3, W.orb(byte 2, W.orb(byte 1, byte 0))))
229            in            in
230              {isNeg = isNeg, digits = List.tabulate(ndigits, digit), exp = exp}                    Flt{isNeg = isNeg, digits = List.tabulate(ndigits, digit), exp = exp}
231                    end
232            end            end
233    
234    end    end

Legend:
Removed from v.41  
changed lines
  Added in v.42

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