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/src/smlnj-lib/Util/format.sml
ViewVC logotype

Annotation of /sml/trunk/src/smlnj-lib/Util/format.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 688 - (view) (download)

1 : monnier 2 (* format.sml
2 :     *
3 :     * COPYRIGHT (c) 1992 by AT&T Bell Laboratories. See COPYRIGHT file for details.
4 :     *
5 :     * AUTHOR: John Reppy
6 :     * AT&T Bell Laboratories
7 :     * Murray Hill, NJ 07974
8 :     * jhr@research.att.com
9 :     *
10 :     * TODO
11 :     * - field widths in scan
12 :     * - add PREC of (int * fmt_item) constructor to allow dynamic control of
13 :     * precision.
14 :     * - precision in %d, %s, ...
15 :     * - * flag in scan (checks, but doesn't scan input)
16 :     * - %n specifier in scan
17 :     *)
18 :    
19 :     structure Format : FORMAT =
20 :     struct
21 :    
22 :     structure SS = Substring
23 :     structure SC = StringCvt
24 :    
25 :     open FmtFields
26 :    
27 :     exception BadFmtList
28 :    
29 :     fun padLeft (str, pad) = SC.padLeft #" " pad str
30 :     fun padRight (str, pad) = SC.padRight #" " pad str
31 :     fun zeroLPad (str, pad) = SC.padLeft #"0" pad str
32 :     fun zeroRPad (str, pad) = SC.padRight #"0" pad str
33 :    
34 :     (* int to string conversions (for positive integers only) *)
35 :     local
36 :     val (maxInt8, maxInt10, maxInt16) = (case LargeInt.maxInt
37 :     of (SOME n) => let
38 :     val maxP1 = LargeWord.fromLargeInt n + 0w1
39 :     in
40 :     ( LargeWord.fmt SC.OCT maxP1,
41 :     LargeWord.fmt SC.DEC maxP1,
42 :     LargeWord.fmt SC.HEX maxP1
43 :     )
44 :     end
45 :     | NONE => ("", "", "")
46 :     (* end case *))
47 :     in
48 : jhr 688 (* MaxInt is used to represent the absolute value of the largest negative
49 :     * representable integer.
50 :     *)
51 : monnier 2 datatype posint = PosInt of LargeInt.int | MaxInt
52 :     fun intToOctal MaxInt = maxInt8
53 :     | intToOctal (PosInt i) = LargeInt.fmt SC.OCT i
54 :     fun intToStr MaxInt = maxInt10
55 :     | intToStr (PosInt i) = LargeInt.toString i
56 :     fun intToHex MaxInt = maxInt16
57 :     | intToHex (PosInt i) = LargeInt.fmt SC.HEX i
58 :     fun intToHeX i =
59 :     String.implode (
60 :     CharVector.foldr (fn (c, l) => Char.toUpper c :: l) [] (intToHex i))
61 :     end (* local *)
62 :    
63 : jhr 688 (* word to string conversions *)
64 :     val wordToOctal = LargeWord.fmt SC.OCT
65 :     val wordToStr = LargeWord.fmt SC.DEC
66 :     val wordToHex = LargeWord.fmt SC.HEX
67 :     fun wordToHeX i = String.map Char.toUpper (wordToHex i)
68 :    
69 : monnier 2 fun compileFormat str = let
70 :     val split = SS.splitl (fn #"%" => false | _ => true)
71 :     fun scan (ss, l) =
72 :     if (SS.isEmpty ss)
73 :     then rev l
74 :     else let val (ss1, ss2) = split ss
75 :     in
76 :     case (SS.getc ss2)
77 :     of (SOME(#"%", ss')) => let val (field, ss3) = scanField ss'
78 :     in
79 :     scan(ss3, field::(Raw ss1)::l)
80 :     end
81 :     | _ => rev((Raw ss1)::l)
82 :     (* end case *)
83 :     end
84 :     in
85 :     scan (Substring.all str, [])
86 :     end
87 :    
88 :     fun format s = let
89 :     val fmts = compileFormat s
90 :     fun doField (flags, wid, ty, arg) = let
91 :     fun padFn s = (case (#ljust flags, wid)
92 :     of (_, NoPad) => s
93 :     | (false, Wid i) => padLeft(s, i)
94 :     | (true, Wid i) => padRight(s, i)
95 :     (* end case *))
96 :     fun zeroPadFn (sign, s) = (case wid
97 :     of NoPad => raise BadFormat
98 :     | (Wid i) => zeroLPad(s, i - (String.size sign))
99 :     (* end case *))
100 :     fun negate i = ((PosInt(~i)) handle _ => MaxInt)
101 :     fun doSign i = (case (i < 0, #sign flags, #neg_char flags)
102 :     of (false, AlwaysSign, _) => ("+", PosInt i)
103 :     | (false, BlankSign, _) => (" ", PosInt i)
104 :     | (false, _, _) => ("", PosInt i)
105 :     | (true, _, TildeSign) => ("~", negate i)
106 :     | (true, _, _) => ("-", negate i)
107 :     (* end case *))
108 :     fun doRealSign sign = (case (sign, #sign flags, #neg_char flags)
109 :     of (false, AlwaysSign, _) => "+"
110 :     | (false, BlankSign, _) => " "
111 :     | (false, _, _) => ""
112 :     | (true, _, TildeSign) => "~"
113 :     | (true, _, _) => "-"
114 :     (* end case *))
115 :     fun doExpSign (exp, isCap) = let
116 :     val e = if isCap then "E" else "e"
117 :     fun mkExp e = zeroLPad(Int.toString e, 2)
118 :     in
119 :     case (exp < 0, #neg_char flags)
120 :     of (false, _) => [e, mkExp exp]
121 :     | (true, TildeSign) => [e, "~", mkExp(~exp)]
122 :     | (true, _) => [e, "-", mkExp(~exp)]
123 :     (* end case *)
124 :     end
125 :     fun octal i = let
126 :     val (sign, i) = doSign i
127 :     val sign = if (#base flags) then sign^"0" else sign
128 :     val s = intToOctal i
129 :     in
130 :     if (#zero_pad flags)
131 :     then sign ^ zeroPadFn(sign, s)
132 :     else padFn (sign ^ s)
133 :     end
134 :     fun decimal i = let
135 :     val (sign, i) = doSign i
136 :     val s = intToStr i
137 :     in
138 :     if (#zero_pad flags)
139 :     then sign ^ zeroPadFn(sign, s)
140 :     else padFn (sign ^ s)
141 :     end
142 :     fun hexidecimal i = let
143 :     val (sign, i) = doSign i
144 :     val sign = if (#base flags) then sign^"0x" else sign
145 :     val s = intToHex i
146 :     in
147 :     if (#zero_pad flags)
148 :     then sign ^ zeroPadFn(sign, s)
149 :     else padFn (sign ^ s)
150 :     end
151 :     fun capHexidecimal i = let
152 :     val (sign, i) = doSign i
153 :     val sign = if (#base flags) then sign^"0X" else sign
154 :     val s = intToHeX i
155 :     in
156 :     if (#zero_pad flags)
157 :     then sign ^ zeroPadFn(sign, s)
158 :     else padFn (sign ^ s)
159 :     end
160 : jhr 688 (* word formatting *)
161 :     fun doWordSign () = (case (#sign flags)
162 :     of AlwaysSign => "+"
163 :     | BlankSign => " "
164 :     | _ => ""
165 :     (* end case *))
166 :     fun octalW i = let
167 :     val sign = doWordSign ()
168 :     val sign = if (#base flags) then sign^"0" else sign
169 :     val s = wordToOctal i
170 :     in
171 :     if (#zero_pad flags)
172 :     then sign ^ zeroPadFn(sign, s)
173 :     else padFn (sign ^ s)
174 :     end
175 :     fun decimalW i = let
176 :     val sign = doWordSign ()
177 :     val s = wordToStr i
178 :     in
179 :     if (#zero_pad flags)
180 :     then sign ^ zeroPadFn(sign, s)
181 :     else padFn (sign ^ s)
182 :     end
183 :     fun hexidecimalW i = let
184 :     val sign = doWordSign ()
185 :     val sign = if (#base flags) then sign^"0x" else sign
186 :     val s = wordToHex i
187 :     in
188 :     if (#zero_pad flags)
189 :     then sign ^ zeroPadFn(sign, s)
190 :     else padFn (sign ^ s)
191 :     end
192 :     fun capHexidecimalW i = let
193 :     val sign = doWordSign ()
194 :     val sign = if (#base flags) then sign^"0X" else sign
195 :     val s = wordToHeX i
196 :     in
197 :     if (#zero_pad flags)
198 :     then sign ^ zeroPadFn(sign, s)
199 :     else padFn (sign ^ s)
200 :     end
201 : monnier 2 in
202 :     case (ty, arg)
203 :     of (OctalField, LINT i) => octal i
204 :     | (OctalField, INT i) => octal(Int.toLarge i)
205 : jhr 688 | (OctalField, WORD w) => octalW (Word.toLargeWord w)
206 :     | (OctalField, LWORD w) => octalW w
207 :     | (OctalField, WORD8 w) => octalW (Word8.toLargeWord w)
208 : monnier 2 | (IntField, LINT i) => decimal i
209 :     | (IntField, INT i) => decimal(Int.toLarge i)
210 : jhr 688 | (IntField, WORD w) => decimalW (Word.toLargeWord w)
211 :     | (IntField, LWORD w) => decimalW w
212 :     | (IntField, WORD8 w) => decimalW (Word8.toLargeWord w)
213 : monnier 2 | (HexField, LINT i) => hexidecimal i
214 :     | (HexField, INT i) => hexidecimal(Int.toLarge i)
215 : jhr 688 | (HexField, WORD w) => hexidecimalW (Word.toLargeWord w)
216 :     | (HexField, LWORD w) => hexidecimalW w
217 :     | (HexField, WORD8 w) => hexidecimalW (Word8.toLargeWord w)
218 : monnier 2 | (CapHexField, LINT i) => capHexidecimal i
219 :     | (CapHexField, INT i) => capHexidecimal(Int.toLarge i)
220 : jhr 688 | (CapHexField, WORD w) => capHexidecimalW (Word.toLargeWord w)
221 :     | (CapHexField, LWORD w) => capHexidecimalW w
222 :     | (CapHexField, WORD8 w) => capHexidecimalW (Word8.toLargeWord w)
223 : monnier 2 | (CharField, CHR c) => padFn(String.str c)
224 :     | (BoolField, BOOL false) => padFn "false"
225 :     | (BoolField, BOOL true) => padFn "true"
226 :     | (StrField, ATOM s) => padFn(Atom.toString s)
227 :     | (StrField, STR s) => padFn s
228 :     | (RealField{prec, format=F_Format}, REAL r) => let
229 :     val {sign, mantissa} = RealFormat.realFFormat(r, prec)
230 :     val sign = doRealSign sign
231 :     in
232 :     if ((prec = 0) andalso (#base flags))
233 :     then padFn(concat[sign, mantissa, "."])
234 :     else padFn(sign ^ mantissa)
235 :     end
236 :     | (RealField{prec, format=E_Format isCap}, REAL r) => let
237 :     val {sign, mantissa, exp} = RealFormat.realEFormat(r, prec)
238 :     val sign = doRealSign sign
239 :     val expStr = doExpSign(exp, isCap)
240 :     in
241 :     if ((prec = 0) andalso (#base flags))
242 :     then padFn(concat(sign :: mantissa :: "." :: expStr))
243 :     else padFn(concat(sign :: mantissa :: expStr))
244 :     end
245 :     | (RealField{prec, format=G_Format isCap}, REAL r) => let
246 :     val prec = if (prec = 0) then 1 else prec
247 :     val {sign, whole, frac, exp} =
248 :     RealFormat.realGFormat(r, prec)
249 :     val sign = doRealSign sign
250 :     val expStr = (case exp
251 :     of SOME e => doExpSign(e, isCap)
252 :     | NONE => [])
253 :     val num = if (#base flags)
254 :     then let
255 :     val diff = prec - ((size whole) + (size frac))
256 :     in
257 :     if (diff > 0)
258 :     then zeroRPad(frac, (size frac)+diff)
259 :     else frac
260 :     end
261 :     else if (frac = "")
262 :     then ""
263 :     else ("." ^ frac)
264 :     in
265 :     padFn(concat(sign::whole::frac::expStr))
266 :     end
267 :     | (_, LEFT(w, arg)) => let
268 :     val flags = {
269 :     sign = (#sign flags), neg_char = (#neg_char flags),
270 :     zero_pad = (#zero_pad flags), base = (#base flags),
271 :     ljust = true, large = false
272 :     }
273 :     in
274 :     doField (flags, Wid w, ty, arg)
275 :     end
276 :     | (_, RIGHT(w, arg)) => doField (flags, Wid w, ty, arg)
277 :     | _ => raise BadFmtList
278 :     (* end case *)
279 :     end
280 :     fun doArgs ([], [], l) = SS.concat(rev l)
281 :     | doArgs ((Raw s)::rf, args, l) = doArgs(rf, args, s::l)
282 :     | doArgs (Field(flags, wid, ty)::rf, arg::ra, l) =
283 :     doArgs (rf, ra, SS.all (doField (flags, wid, ty, arg)) :: l)
284 :     | doArgs _ = raise BadFmtList
285 :     in
286 :     fn args => doArgs (fmts, args, [])
287 :     end (* format *)
288 :    
289 :     fun formatf fmt = let
290 :     val f = format fmt
291 :     in
292 :     fn consumer => fn args => consumer(f args)
293 :     end
294 :    
295 :     end (* Format *)

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