1: # 14 "./lpsrc/flx_cformat.ipk"
2: open String
3: open List
4: open Flx_ast
5: open Flx_exceptions
6: open Flx_util
7: open Flx_print
8:
9: let fmts = [
10: ("hhd","tiny");
11: ("hhi","tiny");
12: ("hho","utiny");
13: ("hhx","utiny");
14: ("hhX", "utiny");
15:
16: ("hd","short");
17: ("hi","short");
18: ("hu","ushort");
19: ("ho","ushort");
20: ("hx","ushort");
21: ("hX", "ushort");
22:
23: ("d","int");
24: ("i","int");
25: ("u","uint");
26: ("o","uint");
27: ("x","uint");
28: ("X", "uint");
29:
30: ("ld","long");
31: ("li","long");
32: ("lu","ulong");
33: ("lo","ulong");
34: ("lx","ulong");
35: ("lX","ulong");
36:
37: ("lld","vlong");
38: ("lli","vlong");
39: ("llu","uvlong");
40: ("llo","uvlong");
41: ("llx","uvlong");
42: ("llX","uvlong");
43:
44: ("zd","size");
45: ("zi","size");
46: ("zu","size");
47: ("zo","size");
48: ("zx","size");
49: ("zX","size");
50:
51: ("td","ptrdiff");
52: ("ti","ptrdiff");
53: ("tu","ptrdiff");
54: ("to","ptrdiff");
55: ("tx","ptrdiff");
56: ("tX","ptrdiff");
57:
58: ("e","double");
59: ("E","double");
60: ("f","double");
61: ("F","double");
62: ("g","double");
63: ("G","double");
64: ("a","double");
65: ("A","double");
66:
67: ("Le","ldouble");
68: ("LE","ldouble");
69: ("Lf","ldouble");
70: ("LF","ldouble");
71: ("Lg","ldouble");
72: ("LG","ldouble");
73: ("La","ldouble");
74: ("LA","ldouble");
75:
76: ("c","int");
77:
78: ("S","string");
79: ("s","charp");
80: ("p","address");
81: ("P","address");
82: ]
83:
84:
85: let is_final ch =
86: try ignore(index "udioxXeEfFgGaAcsSpPn" ch); true
87: with Not_found -> false
88:
89: let is_alpha ch =
90: try ignore(index "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" ch); true
91: with Not_found -> false
92:
93: let is_num ch =
94: try ignore(index "0123456789" ch); true
95: with Not_found -> false
96:
97:
98:
99: type mode_t = [
100: | `Skip
101: | `Scan
102: ]
103:
104: let strchr ch = String.make 1 ch
105:
106: let ast i =
107: let s = String.make (i+1) ' 'in
108: s.[i] <- '*';
109: s
110:
111: let numval ch = index "0123456789" ch
112:
113: let types_of_cformat_string sr s =
114: let err i msg = clierr sr ("In format, pos="^si i^"\n"^string_of_string s^"\n "^ast i^"\n"^msg) in
115: let outfmt = ref "" in
116: let tent = ref "" in
117: let types = ref [] in
118: let mode = ref `Skip in
119: let fmt = ref "" in
120: let space_used = ref false in
121: let sign = ref ' ' in
122: let dp = ref ' ' in
123: let argno = ref 1 in
124:
125: let width = ref None in
126: let prec = ref None in
127: let pos = ref None in
128: let acc = ref None in
129:
130: let drop () = tent := "" in
131: let commit () = outfmt := !outfmt ^ !tent; drop () in
132: let app ch = commit(); outfmt := !outfmt ^ String.make 1 ch in
133: let ten ch = tent := !tent ^ String.make 1 ch in
134:
135: for i = 0 to String.length s - 1 do
136: match !mode with
137: (* look for leading % sign *)
138: | `Skip ->
139: app s.[i];
140: if s.[i]='%' then mode := `Scan
141:
142: | `Scan ->
143: let ch = s.[i] in
144:
145: (* just emit % sign *)
146: if ch = '%' then
147: begin
148: mode := `Skip;
149: space_used := false;
150: fmt := "";
151: app ch;
152: end
153:
154: (* last char of format spec *)
155: else if is_final ch then
156: begin
157: app (if ch = 'S' then 's' else ch); (* convert string to charp *)
158: let xfmt = !fmt ^ strchr ch in
159: begin
160: match !acc with | None -> () | Some j ->
161: match !width with | None -> width := !acc | Some _ -> prec := !acc
162: end
163: ;
164: try
165: let arg = match !pos with None -> !argno | Some j -> j in
166: types := (arg,assoc xfmt fmts) :: !types;
167: mode := `Skip;
168: acc := None;
169: width := None;
170: prec := None;
171: sign := ' ';
172: dp := ' ';
173: begin match !pos with None -> incr argno | Some _ -> () end;
174: pos := None;
175: with Not_found ->
176: err i ("Unsupported format '" ^ xfmt ^ "'")
177: end
178:
179: (* some other alpha char *)
180: else if is_alpha ch then begin
181: fmt := !fmt ^ strchr ch;
182: app ch;
183: end
184:
185: (* an * spec, add a new format immediately *)
186: (* hacked: you can't do *99$ at the moment! *)
187: else if ch = '*' then begin
188: let arg = !argno in incr argno;
189: types := (arg,"int") :: !types;
190: app ch;
191: end
192:
193: (* sign *)
194: else if ch = '+' or ch = '-' then begin
195: if !sign <> ' ' then err i "Extra sign"
196: else
197: sign := ch;
198: app ch;
199: end
200:
201: (* decimal point *)
202: else if ch = '.' then begin
203: if !dp <> ' ' then err i "Duplicate decimal point"
204: else begin
205: width := !acc;
206: acc := None;
207: dp := '.';
208: app ch;
209: end
210: end
211:
212: (* digit *)
213: else if is_num ch then begin
214: ten ch;
215: match !acc with
216: | None -> acc := Some (numval ch)
217: | Some j -> acc := Some (10 * j + numval ch)
218: end
219:
220: (* dollar sign *)
221: else if ch = '$' then begin
222: drop();
223: pos := !acc;
224: acc := None;
225: end
226:
227: (* one space is allowed after the % *)
228: else if ch = ' ' && !fmt = "" && not !space_used then begin
229: space_used := true;
230: app ch
231: end
232:
233: else
234: clierr sr ("unsupported format '" ^ !fmt ^ strchr ch ^ "'")
235: done;
236: commit();
237: !outfmt,
238: rev_map (fun (i,s) -> i,`AST_name (sr,s,[])) !types
239: