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

SCM Repository

[smlnj] Annotation of /sml/trunk/benchmarks/todo/format/makestring.sml
ViewVC logotype

Annotation of /sml/trunk/benchmarks/todo/format/makestring.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 193 - (view) (download)

1 : monnier 193 (* makestring.sml
2 :     *
3 :     * COPYRIGHT (c) 1992 by AT&T Bell Laboratories.
4 :     *
5 :     * Basic value to string conversions.
6 :     *
7 :     * AUTHOR: Emden Gansner & John Reppy
8 :     * AT&T Bell Laboratories
9 :     * Murray Hill, NJ 07974
10 :     * erg@ulysses.att.com & jhr@research.att.com
11 :     *)
12 :    
13 :     structure Makestring : MAKESTRING =
14 :     struct
15 :    
16 :     local
17 :     fun pad padChars = let
18 :     fun mkP (i, l) = if (i <= 0)
19 :     then l
20 :     else if (i <= 20)
21 :     then (substring(padChars, 0, i) :: l)
22 :     else mkP (i-20, padChars :: l)
23 :     in
24 :     mkP
25 :     end
26 :     val mkPad = pad " "
27 :     val mkZeroPad = pad "00000000000000000000"
28 :     in
29 :     fun padLeft (str, pad) = implode (mkPad (pad - (String.size str), [str]))
30 :     fun padRight (str, pad) = implode (str :: mkPad (pad - (String.size str), []))
31 :     fun zeroLPad (str, pad) = implode (mkZeroPad (pad - (String.size str), [str]))
32 :     fun zeroRPad (str, pad) = implode (str :: mkZeroPad (pad - (String.size str), []))
33 :     end
34 :    
35 :     fun boolToStr true = "true"
36 :     | boolToStr false = "false"
37 :    
38 :     (* convert an integer between 0..35 to a single digit *)
39 :     fun mkDigit (i : int) : string =
40 :     System.Unsafe.cast(System.Unsafe.ordof("0123456789abcdef", i))
41 :    
42 :     fun intToBin i = (let
43 :     fun mkBit i = if (Bits.andb(i, 0x1) = 0) then "0" else "1"
44 :     fun f (0, l) = ("0" :: l)
45 :     | f (i, l) = if (i = 1)
46 :     then ("1" :: l)
47 :     else f(Bits.rshift(i, 1), (mkBit i) :: l)
48 :     in
49 :     if (i < 0)
50 :     then implode("~" :: f (~i, []))
51 :     else implode(f (i, []))
52 :     end
53 :     handle _ => "~10000000000000000000000000000000" (* MaxNegInt *))
54 :     fun intToOct i = (let
55 :     fun f (i, l) = if (i < 8)
56 :     then ((mkDigit i) :: l)
57 :     else f(Bits.rshift(i, 3), mkDigit(Bits.andb(i, 0x7)) :: l)
58 :     in
59 :     if (i < 0)
60 :     then implode("~" :: f (~i, []))
61 :     else implode(f (i, []))
62 :     end
63 :     handle _ => "~10000000000" (* MaxNegInt *))
64 :     fun intToStr i = (let
65 :     fun f (i, l) = if (i < 10)
66 :     then ((mkDigit i) :: l)
67 :     else let val j = i quot 10 in f (j, mkDigit(i - 10*j) :: l) end
68 :     in
69 :     if (i < 0) then implode( "~" :: f(~i, [])) else implode(f(i, []))
70 :     end
71 :     handle _ => "~1073741824")
72 :     fun intToHex i = (let
73 :     fun f (i, l) = if (i < 16)
74 :     then ((mkDigit i) :: l)
75 :     else f(Bits.rshift(i, 4), mkDigit(Bits.andb(i, 0xf)) :: l)
76 :     in
77 :     if (i < 0)
78 :     then implode("~" :: f(~i, []))
79 :     else implode(f(i, []))
80 :     end
81 :     handle _ => "~40000000" (* MaxNegInt *))
82 :    
83 :    
84 :     exception BadPrecision
85 :     (* raised by real to string conversions, if the precision is < 0. *)
86 :    
87 :     (* decompose a non-zero real into a list of at most maxPrec significant digits
88 :     * (the first digit non-zero), and integer exponent. The return value
89 :     * (a::b::c..., exp)
90 :     * is produced from real argument
91 :     * a.bc... * (10 ^^ exp)
92 :     * If the list would consist of all 9's, the list consisting of 1 followed by
93 :     * all 0's is returned instead.
94 :     *)
95 :     val maxPrec = 15
96 :     fun decompose (f, e, precisionFn) = let
97 :     fun scaleUp (x, e) = if (x < 1.0) then scaleUp(10.0*x, e-1) else (x, e)
98 :     fun scaleDn (x, e) = if (x >= 10.0) then scaleDn(0.1*x, e+1) else (x, e)
99 :     fun mkdigits (f, 0) = ([], if f < 5.0 then 0 else 1)
100 :     | mkdigits (f, i) = let
101 :     val d = floor f
102 :     val (digits, carry) = mkdigits (10.0 * (f - real d), i - 1)
103 :     val (digit, c) = (case (d, carry)
104 :     of (9, 1) => (0, 1)
105 :     | _ => (d + carry, 0)
106 :     (* end case *))
107 :     in
108 :     (digit::digits, c)
109 :     end
110 :     val (f, e) = if (f < 1.0)
111 :     then scaleUp (f, e)
112 :     else if (f >= 10.0)
113 :     then scaleDn (f, e)
114 :     else (f, e)
115 :     val (digits, carry) = mkdigits(f, max(0, min(precisionFn e, maxPrec)))
116 :     in
117 :     case carry
118 :     of 0 => (digits, e)
119 :     | _ => (1::digits, e+1)
120 :     end
121 :    
122 :     fun realFFormat (r, prec) = let
123 :     fun pf e = e + prec + 1
124 :     fun rtoa (digits, e) = let
125 :     fun doFrac (_, 0, l) = implode(rev l)
126 :     | doFrac ([], p, l) = doFrac([], p-1, "0"::l)
127 :     | doFrac (hd::tl, p, l) = doFrac(tl, p-1, (mkDigit hd) :: l)
128 :     fun doWhole ([], e, l) = if e >= 0
129 :     then doWhole ([], e-1, "0" :: l)
130 :     else if prec = 0
131 :     then implode(rev l)
132 :     else doFrac ([], prec, "." :: l)
133 :     | doWhole (arg as (hd::tl), e, l) = if e >= 0
134 :     then doWhole(tl, e-1, (mkDigit hd) :: l)
135 :     else if prec = 0
136 :     then implode(rev l)
137 :     else doFrac(arg, prec, "." :: l)
138 :     fun doZeros (n, 0, l) = implode(rev l)
139 :     | doZeros (1, p, l) = doFrac(digits, p, l)
140 :     | doZeros (n, p, l) = doZeros(n-1, p-1, "0" :: l)
141 :     in
142 :     if (e >= 0)
143 :     then doWhole(digits, e, [])
144 :     else if (prec = 0)
145 :     then "0"
146 :     else doZeros (~e, prec, ["0."])
147 :     end
148 :     in
149 :     if (prec < 0) then raise BadPrecision else ();
150 :     if (r < 0.0)
151 :     then {sign = true, mantissa = rtoa(decompose(~r, 0, pf))}
152 :     else if (r > 0.0)
153 :     then {sign=false, mantissa = rtoa(decompose(r, 0, pf))}
154 :     else if (prec = 0)
155 :     then {sign=false, mantissa = "0"}
156 :     else {sign=false, mantissa = zeroRPad("0.", prec+2)}
157 :     end (* realFFormat *)
158 :    
159 :     fun realEFormat (r, prec) = let
160 :     fun pf _ = prec + 1
161 :     fun rtoa (sign, (digits, e)) = let
162 :     fun mkRes (m, e) = {sign = sign, mantissa = m, exp = e}
163 :     fun doFrac (_, 0, l) = implode(rev l)
164 :     | doFrac ([], n, l) = zeroRPad(implode(rev l), n)
165 :     | doFrac (hd::tl, n, l) = doFrac (tl, n-1, (mkDigit hd) :: l)
166 :     in
167 :     if (prec = 0)
168 :     then mkRes(mkDigit(hd digits), e)
169 :     else mkRes(doFrac(tl digits, prec, [".", mkDigit(hd digits)]), e)
170 :     end
171 :     in
172 :     if (prec < 0) then raise BadPrecision else ();
173 :     if (r < 0.0)
174 :     then rtoa (true, decompose(~r, 0, pf))
175 :     else if (r > 0.0)
176 :     then rtoa (false, decompose(r, 0, pf))
177 :     else if (prec = 0)
178 :     then {sign = false, mantissa = "0", exp = 0}
179 :     else {sign = false, mantissa = zeroRPad("0.", prec+2), exp=0}
180 :     end (* realEFormat *)
181 :    
182 :     fun realGFormat (r, prec) = let
183 :     fun pf _ = prec
184 :     fun rtoa (sign, (digits, e)) = let
185 :     fun mkRes (w, f, e) = {sign = sign, whole = w, frac = f, exp = e}
186 :     fun doFrac [] = []
187 :     | doFrac (0::tl) = (case doFrac tl
188 :     of [] => []
189 :     | rest => "0" :: rest
190 :     (* end case *))
191 :     | doFrac (hd::tl) = (mkDigit hd) :: (doFrac tl)
192 :     fun doWhole ([], e, wh) =
193 :     if e >= 0
194 :     then doWhole([], e-1, "0"::wh)
195 :     else mkRes(implode(rev wh), "", NONE)
196 :     | doWhole (arg as (hd::tl), e, wh) =
197 :     if e >= 0
198 :     then doWhole(tl, e-1, (mkDigit hd)::wh)
199 :     else mkRes(implode(rev wh), implode(doFrac arg), NONE)
200 :     in
201 :     if (e < ~4) orelse (e >= prec)
202 :     then mkRes(mkDigit(hd digits), implode(doFrac(tl digits)), SOME e)
203 :     else if e >= 0
204 :     then doWhole(digits, e, [])
205 :     else mkRes("0", zeroLPad(implode(doFrac digits), ~1 - e), NONE)
206 :     end
207 :     in
208 :     if (prec < 1) then raise BadPrecision else ();
209 :     if (r < 0.0)
210 :     then rtoa(true, decompose(~r, 0, pf))
211 :     else if (r > 0.0)
212 :     then rtoa(false, decompose(r, 0, pf))
213 :     else {sign=false, whole="0", frac="", exp=NONE}
214 :     end (* realGFormat *)
215 :    
216 :     (* convert a real number to a string of the form [~]ddd.ddd, where
217 :     * the precision (number of fractional digits) is specified by the
218 :     * second argument.
219 :     *)
220 :     fun realToFloStr arg = let
221 :     val {sign, mantissa} = realFFormat arg
222 :     in
223 :     if sign then "~"^mantissa else mantissa
224 :     end
225 :    
226 :     (* convert a real number to a string of the form [~]d.dddE[~]dd, where
227 :     * the precision (number of fractional digits) is specified by the
228 :     * second argument.
229 :     *)
230 :     fun realToSciStr arg = let
231 :     val {sign, mantissa, exp} = realEFormat arg
232 :     in
233 :     if sign
234 :     then implode["~", mantissa, "E", intToStr exp]
235 :     else implode[mantissa, "E", intToStr exp]
236 :     end
237 :    
238 :     end (* Makestring *)

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