Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/branches/idlbasis-devel/src/system/Basis/Implementation/ieee-real.sml
ViewVC logotype

Diff of /sml/branches/idlbasis-devel/src/system/Basis/Implementation/ieee-real.sml

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

revision 1236, Fri Jun 7 18:52:21 2002 UTC revision 1237, Mon Jun 10 20:08:08 2002 UTC
# Line 74  Line 74 
74              (* end case *)              (* end case *)
75            end            end
76    
77  (** TODO: implement fromString **)    (* FSM-based implementation of scan: *)
78      fun fromString s = NONE      fun scan gc = let
79    
80  (** TODO: implement scan **)          val isDigit = CharImp.isDigit
81      fun scan _ = raise Fail "notyet"          val toLower = CharImp.toLower
82    
83    end;          (* check for a literal sequence of case-insensitive chanacters *)
84            fun check ([], ss) = SOME ss
85              | check (x :: xs, ss) =
86                (case gc ss of
87                     NONE => NONE
88                   | SOME (c, ss') =>
89                     if toLower c = x then check (xs, ss') else NONE)
90    
91            (* return INF or NAN *)
92            fun infnan (class, sign, ss) =
93                SOME ({ class = class,
94                        sign = sign,
95                        digits = [],
96                        exp = 0 },
97                      ss)
98    
99            (* we have seen "i" (or "I"), now check for "nf(inity)?" *)
100            fun check_nf_inity (sign, ss) =
101                case check ([#"n", #"f"], ss) of
102                    NONE => NONE
103                  | SOME ss' =>
104                    (case check ([#"i", #"n", #"i", #"t", #"y"], ss') of
105                         NONE => infnan (INF, sign, ss')
106                       | SOME ss'' => infnan (INF, sign, ss''))
107    
108            (* we have seen "n" (or "N"), now check for "an" *)
109            fun check_an (sign, ss) =
110                case check ([#"a", #"n"], ss) of
111                    NONE => NONE
112                  | SOME ss' => infnan (NAN, sign, ss')
113    
114            (* we have succeeded constructing a normal number,
115             * dl is still reversed and might have trailing zeros... *)
116            fun normal (ss, sign, dl, n) = let
117                fun srev ([], r) = r
118                  | srev (0 :: l, []) = srev (l, [])
119                  | srev (x :: l, r) = srev (l, x :: r)
120            in
121                SOME (case srev (dl, []) of
122                          [] => { class = ZERO,
123                                  sign = sign,
124                                  digits = [],
125                                  exp = 0 }
126                        | digits => { class = NORMAL,
127                                      sign = sign,
128                                      digits = digits,
129                                      exp = n },
130                      ss)
131            end
132    
133            (* scanned exponent (e), adjusted by position of decimal point (n) *)
134            fun exponent (n, esign, e) = n + (if esign then ~e else e)
135    
136            (* scanning the remaining digits of the exponent *)
137            fun edigits (ss, sign, dl, n, esign, e) =
138                case gc ss of
139                    NONE => normal (ss, sign, dl, exponent (n, esign, e))
140                  | SOME (dg, ss') =>
141                    if isDigit dg then
142                        edigits (ss', sign, dl, n, esign,
143                                 10 * e + ord dg - ord #"0")
144                    else
145                        normal (ss, sign, dl, exponent (n, esign, e))
146    
147            (* scanning first digit of exponent *)
148            fun edigit1 (ss, sign, dl, n, esign) =
149                case gc ss of
150                    NONE => NONE
151                  | SOME (dg, ss') =>
152                    if isDigit dg then
153                        edigits (ss', sign, dl, n, esign, ord dg - ord #"0")
154                    else NONE
155    
156            (* we have seen the "e" (or "E") and are now scanning an exponent *)
157            fun exp (ss, sign, dl, n) =
158                case gc ss of
159                    NONE => NONE
160                  | SOME (#"+", ss') => edigit1 (ss', sign, dl, n, false)
161                  | SOME ((#"-" | #"~"), ss') => edigit1 (ss', sign, dl, n, true)
162                  | SOME _ => edigit1 (ss, sign, dl, n, false)
163    
164            (* digits in fractional part *)
165            fun fdigits (ss, sign, dl, n) = let
166                fun dig (ss, dg) =
167                    fdigits (ss, sign, (ord dg - ord #"0") :: dl, n)
168            in
169                case gc ss of
170                    NONE => normal (ss, sign, dl, n)
171                  | SOME ((#"e" | #"E"), ss') => exp (ss', sign, dl, n)
172                  | SOME (#"0", ss') =>
173                    (case dl of
174                         [] => fdigits (ss', sign, dl, n - 1)
175                       | _ => dig (ss', #"0"))
176                  | SOME (dg, ss') =>
177                    if isDigit dg then dig (ss', dg) else normal (ss, sign, dl, n)
178            end
179    
180            (* digits in integral part *)
181            fun idigits (ss, sign, dl, n) = let
182                fun dig (ss', dg) =
183                    idigits (ss', sign, (ord dg - ord #"0") :: dl, n + 1)
184            in
185                case gc ss of
186                    NONE => normal (ss, sign, dl, n)
187                  | SOME (#".", ss') => fdigits (ss', sign, dl, n)
188                  | SOME ((#"e" | #"E"), ss') => exp (ss', sign, dl, n)
189                  | SOME (#"0", ss') =>
190                    (case dl of
191                         (* ignore leading zeros in integral part *)
192                         [] => idigits (ss', sign, dl, n)
193                       | _ => dig (ss', #"0"))
194                  | SOME (dg, ss') =>
195                    if isDigit dg then dig (ss', dg) else normal (ss, sign, dl, n)
196            end
197    
198            (* we know the sign of the mantissa, now let's get it *)
199            fun signed (sign, ss) =
200                case gc ss of
201                    NONE => NONE
202                  | SOME ((#"i" | #"I"), ss') => check_nf_inity (sign, ss')
203                  | SOME ((#"n" | #"N"), ss') => check_an (sign, ss')
204                  | SOME (#".", ss') => fdigits (ss', sign, [], 0)
205                  | SOME (dg, _) => if isDigit dg then idigits (ss, sign, [], 0)
206                                    else NONE
207    
208            (* start state: check for sign of mantissa *)
209            fun start ss =
210                case gc ss of
211                    NONE => NONE
212                  | SOME (#"+", ss') => signed (false, ss')
213                  | SOME ((#"-" | #"~"), ss') => signed (true, ss')
214                  | SOME _ => signed (false, ss)
215        in
216            start
217        end
218    
219      (* use "scan" to implement "fromString" *)
220        fun fromString s = StringCvt.scanString scan s
221    
222      end;

Legend:
Removed from v.1236  
changed lines
  Added in v.1237

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