5.30. C format string

Start ocaml section to src/flx_cformat.mli[1 /1 ]
     1: # 4 "./lpsrc/flx_cformat.ipk"
     2: open Flx_srcref
     3: open Flx_ast
     4: 
     5: val types_of_cformat_string:
     6:   range_srcref ->
     7:   string ->
     8:   typecode_t list
     9: 
End ocaml section to src/flx_cformat.mli[1]
Start ocaml section to src/flx_cformat.ml[1 /1 ]
     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: 
End ocaml section to src/flx_cformat.ml[1]