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 /smlnj-lib/trunk/Util/fmt-fields.sml
ViewVC logotype

Annotation of /smlnj-lib/trunk/Util/fmt-fields.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2144 - (view) (download)

1 : monnier 2 (* fmt-fields.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 AT&T Research.
4 :     *
5 :     * This module defines types and routines that are common to both
6 :     * the Format and Scan structures.
7 :     *)
8 :    
9 :     structure FmtFields : sig
10 :    
11 :     (* precompiled format specifiers *)
12 :     datatype sign
13 :     = DfltSign (* default: put a sign on negative numbers *)
14 :     | AlwaysSign (* "+" always has sign (+ or -) *)
15 :     | BlankSign (* " " put a blank in the sign field for positive numbers *)
16 :     datatype neg_sign
17 :     = MinusSign (* default: use "-" for negative numbers *)
18 :     | TildeSign (* "~" use "~" for negative numbers *)
19 :     type field_flags = {
20 :     sign : sign,
21 :     neg_char : neg_sign,
22 :     zero_pad : bool,
23 :     base : bool,
24 :     ljust : bool,
25 :     large : bool
26 :     }
27 :    
28 :     datatype field_wid = NoPad | Wid of int
29 :    
30 :     datatype real_format
31 :     = F_Format (* "%f" *)
32 :     | E_Format of bool (* "%e" or "%E" *)
33 :     | G_Format of bool (* "%g" or "%G" *)
34 :    
35 :     datatype field_type
36 :     = OctalField
37 :     | IntField
38 :     | HexField
39 :     | CapHexField
40 :     | CharField
41 :     | BoolField
42 :     | StrField
43 :     | RealField of {prec : int, format : real_format}
44 :    
45 :     datatype fmt_spec
46 :     = Raw of substring
47 :     | CharSet of char -> bool
48 :     | Field of (field_flags * field_wid * field_type)
49 :    
50 :     datatype fmt_item
51 :     = ATOM of Atom.atom
52 :     | LINT of LargeInt.int
53 :     | INT of Int.int
54 :     | LWORD of LargeWord.word
55 :     | WORD of Word.word
56 :     | WORD8 of Word8.word
57 :     | BOOL of bool
58 :     | CHR of char
59 :     | STR of string
60 :     | REAL of Real.real
61 :     | LREAL of LargeReal.real
62 :     | LEFT of (int * fmt_item) (* left justify in field of given width *)
63 :     | RIGHT of (int * fmt_item) (* right justify in field of given width *)
64 :    
65 :     exception BadFormat (* bad format string *)
66 :    
67 :     val scanFieldSpec : substring -> (fmt_spec * substring)
68 :     val scanField : substring -> (fmt_spec * substring)
69 :    
70 :     end = struct
71 :    
72 :     structure SS = Substring
73 :     structure SC = StringCvt
74 :    
75 :     (* precompiled format specifiers *)
76 :     datatype sign
77 :     = DfltSign (* default: put a sign on negative numbers *)
78 :     | AlwaysSign (* "+" always has sign (+ or -) *)
79 :     | BlankSign (* " " put a blank in the sign field for positive numbers *)
80 :     datatype neg_sign
81 :     = MinusSign (* default: use "-" for negative numbers *)
82 :     | TildeSign (* "~" use "~" for negative numbers *)
83 :     type field_flags = {
84 :     sign : sign,
85 :     neg_char : neg_sign,
86 :     zero_pad : bool,
87 :     base : bool,
88 :     ljust : bool,
89 :     large : bool
90 :     }
91 :    
92 :     datatype field_wid = NoPad | Wid of int
93 :    
94 :     datatype real_format
95 :     = F_Format (* "%f" *)
96 :     | E_Format of bool (* "%e" or "%E" *)
97 :     | G_Format of bool (* "%g" or "%G" *)
98 :    
99 :     datatype field_type
100 :     = OctalField
101 :     | IntField
102 :     | HexField
103 :     | CapHexField
104 :     | CharField
105 :     | BoolField
106 :     | StrField
107 :     | RealField of {prec : int, format : real_format}
108 :    
109 :     datatype fmt_spec
110 :     = Raw of substring
111 :     | CharSet of char -> bool
112 :     | Field of (field_flags * field_wid * field_type)
113 :    
114 :     datatype fmt_item
115 :     = ATOM of Atom.atom
116 :     | LINT of LargeInt.int
117 :     | INT of Int.int
118 :     | LWORD of LargeWord.word
119 :     | WORD of Word.word
120 :     | WORD8 of Word8.word
121 :     | BOOL of bool
122 :     | CHR of char
123 :     | STR of string
124 :     | REAL of Real.real
125 :     | LREAL of LargeReal.real
126 :     | LEFT of (int * fmt_item) (* left justify in field of given width *)
127 :     | RIGHT of (int * fmt_item) (* right justify in field of given width *)
128 :    
129 :     exception BadFormat (* bad format string *)
130 :    
131 :     (* string to int conversions *)
132 :     val decToInt : (char, substring) SC.reader -> (Int.int, substring) SC.reader
133 :     = Int.scan SC.DEC
134 :    
135 :     (* scan a field specification. Assume that the previous character in the
136 :     * base string was "%" and that the first character in the substring fmtStr
137 :     * is not "%".
138 :     *)
139 :     fun scanFieldSpec fmtStr = let
140 :     val (fmtStr, flags) = let
141 :     fun doFlags (ss, flags : field_flags) = (
142 :     case (SS.getc ss, flags)
143 :     of (SOME(#" ", ss'), {sign=AlwaysSign, ...}) =>
144 :     raise BadFormat
145 :     | (SOME(#" ", ss'), _) =>
146 :     doFlags (ss', {
147 :     sign = BlankSign, neg_char = #neg_char flags,
148 :     zero_pad = #zero_pad flags, base = #base flags,
149 :     ljust = #ljust flags, large = #large flags
150 :     })
151 :     | (SOME(#"+", ss'), {sign=BlankSign, ...}) =>
152 :     raise BadFormat
153 :     | (SOME(#"+", ss'), _) =>
154 :     doFlags (ss', {
155 :     sign = AlwaysSign, neg_char = #neg_char flags,
156 :     zero_pad = #zero_pad flags, base = #base flags,
157 :     ljust = #ljust flags, large = #large flags
158 :     })
159 :     | (SOME(#"~", ss'), _) =>
160 :     doFlags (ss', {
161 :     sign = #sign flags, neg_char = TildeSign,
162 :     zero_pad = #zero_pad flags, base = #base flags,
163 :     ljust = #ljust flags, large = #large flags
164 :     })
165 :     | (SOME(#"-", ss'), _) =>
166 :     doFlags (ss', {
167 :     sign = #sign flags, neg_char = MinusSign,
168 :     zero_pad = #zero_pad flags, base = #base flags,
169 :     ljust = #ljust flags, large = #large flags
170 :     })
171 :     | (SOME(#"#", ss'), _) =>
172 :     doFlags (ss', {
173 :     sign = #sign flags, neg_char = #neg_char flags,
174 :     zero_pad = #zero_pad flags, base = true,
175 :     ljust = #ljust flags, large = #large flags
176 :     })
177 :     | (SOME(#"0", ss'), _) =>
178 :     (ss', {
179 :     sign = #sign flags, neg_char = #neg_char flags,
180 :     zero_pad = true, base = #base flags,
181 :     ljust = #ljust flags, large = #large flags
182 :     })
183 :     | _ => (fmtStr, flags)
184 :     (* end case *))
185 :     in
186 :     doFlags (fmtStr, {
187 :     sign = DfltSign, neg_char = MinusSign,
188 :     zero_pad = false, base = false, ljust = false,
189 :     large = false
190 :     })
191 :     end
192 :     val (wid, fmtStr) = if (Char.isDigit(valOf(SS.first fmtStr)))
193 :     then let
194 :     val (n, fmtStr) = valOf (decToInt SS.getc fmtStr)
195 :     in (Wid n, fmtStr) end
196 :     else (NoPad, fmtStr)
197 :     val (ty, fmtStr) = (case SS.getc fmtStr
198 :     of (SOME(#"d", ss)) => (IntField, ss)
199 :     | (SOME(#"X", ss)) => (CapHexField, ss)
200 :     | (SOME(#"x", ss)) => (HexField, ss)
201 :     | (SOME(#"o", ss)) => (OctalField, ss)
202 :     | (SOME(#"c", ss)) => (CharField, ss)
203 :     | (SOME(#"s", ss)) => (StrField, ss)
204 :     | (SOME(#"b", ss)) => (BoolField, ss)
205 :     | (SOME(#".", ss)) => let
206 :     (* NOTE: "." ought to be allowed for d,X,x,o and s formats as it is in ANSI C *)
207 :     val (n, ss) = valOf(decToInt SS.getc ss)
208 :     val (format, ss) = (case SS.getc ss
209 :     of (SOME(#"E" , ss))=> (E_Format true, ss)
210 :     | (SOME(#"e" , ss))=> (E_Format false, ss)
211 :     | (SOME(#"f" , ss))=> (F_Format, ss)
212 :     | (SOME(#"G" , ss))=> (G_Format true, ss)
213 :     | (SOME(#"g", ss)) => (G_Format false, ss)
214 :     | _ => raise BadFormat
215 :     (* end case *))
216 :     in
217 :     (RealField{prec = n, format = format}, ss)
218 :     end
219 :     | (SOME(#"E", ss)) => (RealField{prec=6, format=E_Format true}, ss)
220 :     | (SOME(#"e", ss)) => (RealField{prec=6, format=E_Format false}, ss)
221 :     | (SOME(#"f", ss)) => (RealField{prec=6, format=F_Format}, ss)
222 :     | (SOME(#"G", ss)) => (RealField{prec=6, format=G_Format true}, ss)
223 :     | (SOME(#"g", ss)) => (RealField{prec=6, format=G_Format false}, ss)
224 :     | _ => raise BadFormat
225 :     (* end case *))
226 :     in
227 :     (Field(flags, wid, ty), fmtStr)
228 :     end (* scanFieldSpec *)
229 :    
230 :     fun scanField fmtStr = (case SS.getc fmtStr
231 : monnier 8 of (SOME(#"%", fmtStr')) => (Raw(SS.slice(fmtStr, 0, SOME 1)), fmtStr')
232 : monnier 2 | _ => scanFieldSpec fmtStr
233 :     (* end case *))
234 :    
235 :     end

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