1: # 14 "./lpsrc/flx_cformat.ipk"
2: open String
3: open List
4: open Flx_ast
5: open Flx_exceptions
6:
7: let fmts = [
8: ("hhd","tiny");
9: ("hhi","tiny");
10: ("hho","utiny");
11: ("hhx","utiny");
12: ("hhX", "utiny");
13:
14: ("hd","short");
15: ("hi","short");
16: ("ho","ushort");
17: ("hx","ushort");
18: ("hX", "ushort");
19:
20: ("d","int");
21: ("i","int");
22: ("o","uint");
23: ("x","uint");
24: ("X", "uint");
25:
26: ("ld","long");
27: ("li","long");
28: ("lo","ulong");
29: ("lx","ulong");
30: ("lX","ulong");
31:
32: ("lld","vlong");
33: ("lli","vlong");
34: ("llo","uvlong");
35: ("llx","uvlong");
36: ("llX","uvlong");
37:
38: ("zd","size");
39: ("zi","size");
40: ("zo","size");
41: ("zx","size");
42: ("zX","size");
43:
44: ("td","ptrdiff");
45: ("ti","ptrdiff");
46: ("to","ptrdiff");
47: ("tx","ptrdiff");
48: ("tX","ptrdiff");
49:
50: ("e","double");
51: ("E","double");
52: ("f","double");
53: ("F","double");
54: ("g","double");
55: ("G","double");
56: ("a","double");
57: ("A","double");
58:
59: ("Le","ldouble");
60: ("LE","ldouble");
61: ("Lf","ldouble");
62: ("LF","ldouble");
63: ("Lg","ldouble");
64: ("LG","ldouble");
65: ("La","ldouble");
66: ("LA","ldouble");
67:
68: ("c","int");
69:
70: ("s","C_hack::charp");
71: ("p","C_hack::address");
72: ("P","C_hack::address");
73: ]
74:
75:
76: let is_final ch =
77: try ignore(index "dioxXeEfFgGaAcspPn" ch); true
78: with Not_found -> false
79:
80: let is_alpha ch =
81: try ignore(index "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" ch); true
82: with Not_found -> false
83:
84: let is_ok ch =
85: try ignore(index "+-0123456789." ch); true
86: with Not_found -> false
87:
88:
89:
90: type mode_t = [
91: | `Skip
92: | `Scan
93: ]
94:
95: let strchr ch = String.make 1 ch
96:
97: let types_of_cformat_string sr s =
98: let types = ref [] in
99: let mode = ref `Skip in
100: let fmt = ref "" in
101: let space_used = ref false in
102:
103: for i = 0 to String.length s - 1 do
104: match !mode with
105: (* look for leading % sign *)
106: | `Skip -> if s.[i]='%' then mode := `Scan
107:
108: | `Scan ->
109: let ch = s.[i] in
110:
111: (* just emit % sign *)
112: if ch = '%' then
113: begin
114: mode := `Skip;
115: space_used := false;
116: fmt := ""
117: end
118:
119: (* last char of format spec *)
120: else if is_final ch then
121: begin
122: let xfmt = !fmt ^ strchr ch in
123: try
124: types := assoc xfmt fmts :: !types;
125: mode := `Skip;
126: with Not_found ->
127: clierr sr ("Unsupported format '" ^ xfmt ^ "'")
128: end
129:
130: (* some other alpha char *)
131: else if is_alpha ch then fmt := !fmt ^ strchr ch
132:
133: (* an * spec, add a new format immediately *)
134: else if ch = '*' then types := "int" :: !types
135:
136: (* something else, scan over it *)
137: else if is_ok ch then ()
138:
139: (* one space is allowed after the % *)
140: else if ch = ' ' && !fmt = "" && not !space_used then
141: space_used := true
142: else
143: clierr sr ("unsupported format '" ^ !fmt ^ strchr ch ^ "'")
144: done;
145: rev_map (fun s -> `AST_name (sr,s,[])) !types
146: