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 3 - (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 :     | (IntField, LINT i) => decimal i
156 :     | (IntField, INT i) => decimal(Int.toLarge i)
157 :     | (HexField, LINT i) => hexidecimal i
158 :     | (HexField, INT i) => hexidecimal(Int.toLarge i)
159 :     | (CapHexField, LINT i) => capHexidecimal i
160 :     | (CapHexField, INT i) => capHexidecimal(Int.toLarge i)
161 :     | (CharField, CHR c) => padFn(String.str c)
162 :     | (BoolField, BOOL false) => padFn "false"
163 :     | (BoolField, BOOL true) => padFn "true"
164 :     | (StrField, ATOM s) => padFn(Atom.toString s)
165 :     | (StrField, STR s) => padFn s
166 :     | (RealField{prec, format=F_Format}, REAL r) => let
167 :     val {sign, mantissa} = RealFormat.realFFormat(r, prec)
168 :     val sign = doRealSign sign
169 :     in
170 :     if ((prec = 0) andalso (#base flags))
171 :     then padFn(concat[sign, mantissa, "."])
172 :     else padFn(sign ^ mantissa)
173 :     end
174 :     | (RealField{prec, format=E_Format isCap}, REAL r) => let
175 :     val {sign, mantissa, exp} = RealFormat.realEFormat(r, prec)
176 :     val sign = doRealSign sign
177 :     val expStr = doExpSign(exp, isCap)
178 :     in
179 :     if ((prec = 0) andalso (#base flags))
180 :     then padFn(concat(sign :: mantissa :: "." :: expStr))
181 :     else padFn(concat(sign :: mantissa :: expStr))
182 :     end
183 :     | (RealField{prec, format=G_Format isCap}, REAL r) => let
184 :     val prec = if (prec = 0) then 1 else prec
185 :     val {sign, whole, frac, exp} =
186 :     RealFormat.realGFormat(r, prec)
187 :     val sign = doRealSign sign
188 :     val expStr = (case exp
189 :     of SOME e => doExpSign(e, isCap)
190 :     | NONE => [])
191 :     val num = if (#base flags)
192 :     then let
193 :     val diff = prec - ((size whole) + (size frac))
194 :     in
195 :     if (diff > 0)
196 :     then zeroRPad(frac, (size frac)+diff)
197 :     else frac
198 :     end
199 :     else if (frac = "")
200 :     then ""
201 :     else ("." ^ frac)
202 :     in
203 :     padFn(concat(sign::whole::frac::expStr))
204 :     end
205 :     | (_, LEFT(w, arg)) => let
206 :     val flags = {
207 :     sign = (#sign flags), neg_char = (#neg_char flags),
208 :     zero_pad = (#zero_pad flags), base = (#base flags),
209 :     ljust = true, large = false
210 :     }
211 :     in
212 :     doField (flags, Wid w, ty, arg)
213 :     end
214 :     | (_, RIGHT(w, arg)) => doField (flags, Wid w, ty, arg)
215 :     | _ => raise BadFmtList
216 :     (* end case *)
217 :     end
218 :     fun doArgs ([], [], l) = SS.concat(rev l)
219 :     | doArgs ((Raw s)::rf, args, l) = doArgs(rf, args, s::l)
220 :     | doArgs (Field(flags, wid, ty)::rf, arg::ra, l) =
221 :     doArgs (rf, ra, SS.all (doField (flags, wid, ty, arg)) :: l)
222 :     | doArgs _ = raise BadFmtList
223 :     in
224 :     fn args => doArgs (fmts, args, [])
225 :     end (* format *)
226 :    
227 :     fun formatf fmt = let
228 :     val f = format fmt
229 :     in
230 :     fn consumer => fn args => consumer(f args)
231 :     end
232 :    
233 :     end (* Format *)

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