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 469 - (view) (download)
Original Path: sml/branches/SMLNJ/src/smlnj-lib/Util/format.sml

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 :     datatype posint = PosInt of LargeInt.int | MaxInt
49 :     fun intToOctal MaxInt = maxInt8
50 :     | intToOctal (PosInt i) = LargeInt.fmt SC.OCT i
51 :     fun intToStr MaxInt = maxInt10
52 :     | intToStr (PosInt i) = LargeInt.toString i
53 :     fun intToHex MaxInt = maxInt16
54 :     | intToHex (PosInt i) = LargeInt.fmt SC.HEX i
55 :     fun intToHeX i =
56 :     String.implode (
57 :     CharVector.foldr (fn (c, l) => Char.toUpper c :: l) [] (intToHex i))
58 :     end (* local *)
59 :    
60 :     fun compileFormat str = let
61 :     val split = SS.splitl (fn #"%" => false | _ => true)
62 :     fun scan (ss, l) =
63 :     if (SS.isEmpty ss)
64 :     then rev l
65 :     else let val (ss1, ss2) = split ss
66 :     in
67 :     case (SS.getc ss2)
68 :     of (SOME(#"%", ss')) => let val (field, ss3) = scanField ss'
69 :     in
70 :     scan(ss3, field::(Raw ss1)::l)
71 :     end
72 :     | _ => rev((Raw ss1)::l)
73 :     (* end case *)
74 :     end
75 :     in
76 :     scan (Substring.all str, [])
77 :     end
78 :    
79 :     fun format s = let
80 :     val fmts = compileFormat s
81 :     fun doField (flags, wid, ty, arg) = let
82 :     fun padFn s = (case (#ljust flags, wid)
83 :     of (_, NoPad) => s
84 :     | (false, Wid i) => padLeft(s, i)
85 :     | (true, Wid i) => padRight(s, i)
86 :     (* end case *))
87 :     fun zeroPadFn (sign, s) = (case wid
88 :     of NoPad => raise BadFormat
89 :     | (Wid i) => zeroLPad(s, i - (String.size sign))
90 :     (* end case *))
91 :     fun negate i = ((PosInt(~i)) handle _ => MaxInt)
92 :     fun doSign i = (case (i < 0, #sign flags, #neg_char flags)
93 :     of (false, AlwaysSign, _) => ("+", PosInt i)
94 :     | (false, BlankSign, _) => (" ", PosInt i)
95 :     | (false, _, _) => ("", PosInt i)
96 :     | (true, _, TildeSign) => ("~", negate i)
97 :     | (true, _, _) => ("-", negate i)
98 :     (* end case *))
99 :     fun doRealSign sign = (case (sign, #sign flags, #neg_char flags)
100 :     of (false, AlwaysSign, _) => "+"
101 :     | (false, BlankSign, _) => " "
102 :     | (false, _, _) => ""
103 :     | (true, _, TildeSign) => "~"
104 :     | (true, _, _) => "-"
105 :     (* end case *))
106 :     fun doExpSign (exp, isCap) = let
107 :     val e = if isCap then "E" else "e"
108 :     fun mkExp e = zeroLPad(Int.toString e, 2)
109 :     in
110 :     case (exp < 0, #neg_char flags)
111 :     of (false, _) => [e, mkExp exp]
112 :     | (true, TildeSign) => [e, "~", mkExp(~exp)]
113 :     | (true, _) => [e, "-", mkExp(~exp)]
114 :     (* end case *)
115 :     end
116 :     fun octal i = let
117 :     val (sign, i) = doSign i
118 :     val sign = if (#base flags) then sign^"0" else sign
119 :     val s = intToOctal i
120 :     in
121 :     if (#zero_pad flags)
122 :     then sign ^ zeroPadFn(sign, s)
123 :     else padFn (sign ^ s)
124 :     end
125 :     fun decimal i = let
126 :     val (sign, i) = doSign i
127 :     val s = intToStr i
128 :     in
129 :     if (#zero_pad flags)
130 :     then sign ^ zeroPadFn(sign, s)
131 :     else padFn (sign ^ s)
132 :     end
133 :     fun hexidecimal i = let
134 :     val (sign, i) = doSign i
135 :     val sign = if (#base flags) then sign^"0x" else sign
136 :     val s = intToHex i
137 :     in
138 :     if (#zero_pad flags)
139 :     then sign ^ zeroPadFn(sign, s)
140 :     else padFn (sign ^ s)
141 :     end
142 :     fun capHexidecimal 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 :     in
152 :     case (ty, arg)
153 :     of (OctalField, LINT i) => octal i
154 :     | (OctalField, INT i) => octal(Int.toLarge i)
155 : monnier 469 | (OctalField, WORD w) => octal(Word.toLargeInt w)
156 :     | (OctalField, LWORD w) => raise Fail "LWORD"
157 :     | (OctalField, WORD8 w) => octal(Word8.toLargeInt w)
158 : monnier 2 | (IntField, LINT i) => decimal i
159 :     | (IntField, INT i) => decimal(Int.toLarge i)
160 : monnier 469 | (IntField, WORD w) => decimal(Word.toLargeInt w)
161 :     | (IntField, LWORD w) => raise Fail "LWORD"
162 :     | (IntField, WORD8 w) => decimal(Word8.toLargeInt w)
163 : monnier 2 | (HexField, LINT i) => hexidecimal i
164 :     | (HexField, INT i) => hexidecimal(Int.toLarge i)
165 : monnier 469 | (HexField, WORD w) => hexidecimal(Word.toLargeInt w)
166 :     | (HexField, LWORD w) => raise Fail "LWORD"
167 :     | (HexField, WORD8 w) => hexidecimal(Word8.toLargeInt w)
168 : monnier 2 | (CapHexField, LINT i) => capHexidecimal i
169 :     | (CapHexField, INT i) => capHexidecimal(Int.toLarge i)
170 : monnier 469 | (CapHexField, WORD w) => capHexidecimal(Word.toLargeInt w)
171 :     | (CapHexField, LWORD w) => raise Fail "LWORD"
172 :     | (CapHexField, WORD8 w) => capHexidecimal(Word8.toLargeInt w)
173 : monnier 2 | (CharField, CHR c) => padFn(String.str c)
174 :     | (BoolField, BOOL false) => padFn "false"
175 :     | (BoolField, BOOL true) => padFn "true"
176 :     | (StrField, ATOM s) => padFn(Atom.toString s)
177 :     | (StrField, STR s) => padFn s
178 :     | (RealField{prec, format=F_Format}, REAL r) => let
179 :     val {sign, mantissa} = RealFormat.realFFormat(r, prec)
180 :     val sign = doRealSign sign
181 :     in
182 :     if ((prec = 0) andalso (#base flags))
183 :     then padFn(concat[sign, mantissa, "."])
184 :     else padFn(sign ^ mantissa)
185 :     end
186 :     | (RealField{prec, format=E_Format isCap}, REAL r) => let
187 :     val {sign, mantissa, exp} = RealFormat.realEFormat(r, prec)
188 :     val sign = doRealSign sign
189 :     val expStr = doExpSign(exp, isCap)
190 :     in
191 :     if ((prec = 0) andalso (#base flags))
192 :     then padFn(concat(sign :: mantissa :: "." :: expStr))
193 :     else padFn(concat(sign :: mantissa :: expStr))
194 :     end
195 :     | (RealField{prec, format=G_Format isCap}, REAL r) => let
196 :     val prec = if (prec = 0) then 1 else prec
197 :     val {sign, whole, frac, exp} =
198 :     RealFormat.realGFormat(r, prec)
199 :     val sign = doRealSign sign
200 :     val expStr = (case exp
201 :     of SOME e => doExpSign(e, isCap)
202 :     | NONE => [])
203 :     val num = if (#base flags)
204 :     then let
205 :     val diff = prec - ((size whole) + (size frac))
206 :     in
207 :     if (diff > 0)
208 :     then zeroRPad(frac, (size frac)+diff)
209 :     else frac
210 :     end
211 :     else if (frac = "")
212 :     then ""
213 :     else ("." ^ frac)
214 :     in
215 :     padFn(concat(sign::whole::frac::expStr))
216 :     end
217 :     | (_, LEFT(w, arg)) => let
218 :     val flags = {
219 :     sign = (#sign flags), neg_char = (#neg_char flags),
220 :     zero_pad = (#zero_pad flags), base = (#base flags),
221 :     ljust = true, large = false
222 :     }
223 :     in
224 :     doField (flags, Wid w, ty, arg)
225 :     end
226 :     | (_, RIGHT(w, arg)) => doField (flags, Wid w, ty, arg)
227 :     | _ => raise BadFmtList
228 :     (* end case *)
229 :     end
230 :     fun doArgs ([], [], l) = SS.concat(rev l)
231 :     | doArgs ((Raw s)::rf, args, l) = doArgs(rf, args, s::l)
232 :     | doArgs (Field(flags, wid, ty)::rf, arg::ra, l) =
233 :     doArgs (rf, ra, SS.all (doField (flags, wid, ty, arg)) :: l)
234 :     | doArgs _ = raise BadFmtList
235 :     in
236 :     fn args => doArgs (fmts, args, [])
237 :     end (* format *)
238 :    
239 :     fun formatf fmt = let
240 :     val f = format fmt
241 :     in
242 :     fn consumer => fn args => consumer(f args)
243 :     end
244 :    
245 :     end (* Format *)

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