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:   string * (int * 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: 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: 
End ocaml section to src/flx_cformat.ml[1]