cpkg2c improvements.

Signed-off-by: Pierre Habouzit <madcoder@debian.org>

diff --git a/cmake/Cpkg2c.cmake b/cmake/Cpkg2c.cmake
index 0d1c01c..ad01413 100644 (file)
--- a/cmake/Cpkg2c.cmake
+++ b/cmake/Cpkg2c.cmake
@@ -11,13 +11,13 @@ macro (MADMUTT_SOURCES _result _gen)
             add_custom_command(
                 OUTPUT ${_li}
                 MAIN_DEPENDENCY ${_abs}
-                COMMAND ${madmutt_SOURCE_DIR}/tools/cpkg2c -h ${_abs} > ${_li} || \(${RM} ${_li}; exit 1\)
+                COMMAND ${madmutt_SOURCE_DIR}/tools/cpkg2c -h ${_abs} -o ${_li}
                 COMMENT "Generating ${_li} from ${_abs}"
             )
             add_custom_command(
                 OUTPUT ${_c}
                 MAIN_DEPENDENCY ${_abs}
-                COMMAND ${madmutt_SOURCE_DIR}/tools/cpkg2c -c ${_abs} > ${_c} || \(${RM} ${_c}; exit 1\)
+                COMMAND ${madmutt_SOURCE_DIR}/tools/cpkg2c -c ${_abs} -o ${_c}
                 COMMENT "Generating ${_c} from ${_abs}"
             )
             list(APPEND ${_result} ${_li} ${_c})

diff --git a/tools/cpkg2c.mll b/tools/cpkg2c.mll
index 2e76dd9..cefc389 100644 (file)
--- a/tools/cpkg2c.mll
+++ b/tools/cpkg2c.mll
@@ -29,10 +29,12 @@
     output_string stderr (sprintf "%s:%d: %s\n" fpos lpos s);
     exit 1
 
-  let put_line = printf "#line %d \"%s\"\n"
+  let put_line ob = fprintf ob "#line %d \"%s\"\n"
 
   let isspace = function |' '|'\t' -> true | _ -> false
 
+  let output_endline ob s = output_string ob s; output_char ob '\n'
+
   let strip s =
     let l = ref 0 and r = ref (String.length s) in
     while (isspace s.[!l]     && !l < !r) do incr l done;
@@ -386,193 +388,193 @@ and ext_member m f = parse
       Str.global_replace (Str.regexp_string "$$") v tpl
     )
 
-  let dump_struct_type begwith pkg endwith =
-    printf "%sstruct luaM_%s_t {\n" begwith pkg.name;
+  let dump_struct_type ob begwith pkg endwith =
+    fprintf ob "%sstruct luaM_%s_t {\n" begwith pkg.name;
     List.iter (function (m, f, l) ->
-      put_line l f;
+      put_line ob l f;
       let ctype = t1 (snd m.typ).ctype in
-      print_string "    ";
-      if fst m.typ then print_string "const ";
+      output_string ob "    ";
+      if fst m.typ then output_string ob "const ";
       let i = try String.index ctype ':' with Not_found -> String.length ctype in
-      printf "%s %s%s;\n" (Str.string_before ctype i)
+      fprintf ob "%s %s%s;\n" (Str.string_before ctype i)
         m.mname (Str.string_after ctype i)
     ) pkg.members;
-    print_endline ("}" ^ endwith)
+    output_endline ob ("}" ^ endwith)
 
-  let do_h =
+  let do_h ob =
     let do_h_aux = function
       | Buf _ -> ()
       | Pkg pkg ->
-          printf "\n#ifndef MUTT_LUA_%s_H\n" (upper pkg.name);
-          printf "#define MUTT_LUA_%s_H\n\n" (upper pkg.name);
+          fprintf ob "\n#ifndef MUTT_LUA_%s_H\n" (upper pkg.name);
+          fprintf ob "#define MUTT_LUA_%s_H\n\n" (upper pkg.name);
           if not pkg.static then (
-            dump_struct_type "" pkg ";";
-            printf "extern struct luaM_%s_t %s;\n" pkg.name pkg.name;
+            dump_struct_type ob "" pkg ";";
+            fprintf ob "extern struct luaM_%s_t %s;\n" pkg.name pkg.name;
           );
-          printf "\nint luaopen_%s(lua_State *L);\n\n" pkg.name;
-          printf "#endif /* MUTT_LUA_%s_H */\n" (upper pkg.name);
+          fprintf ob "\nint luaopen_%s(lua_State *L);\n\n" pkg.name;
+          fprintf ob "#endif /* MUTT_LUA_%s_H */\n" (upper pkg.name);
     in List.iter do_h_aux
 
-  let do_func pkg (fn, f, l) = 
+  let do_func ob pkg (fn, f, l) = 
     (* return inline function *)
-    printf "\nstatic int luaM_ret_%s_%s(lua_State *L" pkg.name fn.fname;
+    fprintf ob "\nstatic int luaM_ret_%s_%s(lua_State *L" pkg.name fn.fname;
     let retlen = List.fold_left (fun i t ->
       let i = i + 1 in
       match t with
-      | true, typ -> printf ", const %s luaM_x%d" (t1 typ.ctype) i; i
-      | false, typ -> printf ", %s luaM_x%d" (t1 typ.ctype) i; i
+      | true, typ -> fprintf ob ", const %s luaM_x%d" (t1 typ.ctype) i; i
+      | false, typ -> fprintf ob ", %s luaM_x%d" (t1 typ.ctype) i; i
       ) 0 fn.rettype in
-    printf ")\n{\n";
+    fprintf ob ")\n{\n";
     ignore (List.fold_left (fun i (const, typ) ->
       let i = i + 1 in
       let (p, f, l) = typ.push in
-      put_line l f;
-      printf "    %s;\n" (tplize p (sprintf "luaM_x%d" i));
+      put_line ob l f;
+      fprintf ob "    %s;\n" (tplize p (sprintf "luaM_x%d" i));
       if not const then (
         match typ.dtor with
         | None             -> ()
         | Some(dtor, f, l) ->
-            put_line l f;
-            printf "    %s;\n" (tplize dtor (sprintf "&luaM_x%d" i))
+            put_line ob l f;
+            fprintf ob "    %s;\n" (tplize dtor (sprintf "&luaM_x%d" i))
       ); i
     ) 0 fn.rettype) ;
-    printf "    return %d;\n}\n" retlen;
+    fprintf ob "    return %d;\n}\n" retlen;
 
     (* main function *)
-    printf "\nstatic int luaM_%s_%s(lua_State *L)\n{\n" pkg.name fn.fname;
+    fprintf ob "\nstatic int luaM_%s_%s(lua_State *L)\n{\n" pkg.name fn.fname;
     ignore (List.fold_left (fun i ((const, typ), name) ->
       let i = i + 1 in
       let ctype = t1 typ.ctype in
       if const then (
         let (c, f, l) = typ.check in
-        put_line l f;
-        printf "    const %s %s = %s;\n" ctype name (tplize c (string_of_int i))
+        put_line ob l f;
+        fprintf ob "    const %s %s = %s;\n" ctype name (tplize c (string_of_int i))
       ) else (
         match typ.ctor with
         | None ->
           let (c, f, l) = typ.check in
-          put_line l f;
-          printf "    %s %s = %s;\n" ctype name (tplize c (string_of_int i))
+          put_line ob l f;
+          fprintf ob "    %s %s = %s;\n" ctype name (tplize c (string_of_int i))
         | Some (ctor, f, l) ->
           let v =
             let c, f, l = typ.check in
             tplize (sprintf "\n#line %d \"%s\"\n        %s" l f c)
               (string_of_int i)
           in
-          put_line l f;
-          printf "    %s %s = %s;\n" ctype name (tplize ctor v)
+          put_line ob l f;
+          fprintf ob "    %s %s = %s;\n" ctype name (tplize ctor v)
       ); i
     ) 0 fn.args);
-    printf "\n#define RAISE(s)  luaL_error(L, (s))\n";
+    fprintf ob "\n#define RAISE(s)  luaL_error(L, (s))\n";
     if fn.rettype = [] then (
-      printf "#define RETURN()  return luaM_ret_%s_%s(L)\n" pkg.name fn.fname
+      fprintf ob "#define RETURN()  return luaM_ret_%s_%s(L)\n" pkg.name fn.fname
     ) else (
-      printf "#define RETURN(luaM_x1";
-      for i = 2 to retlen do printf ", luaM_x%d" i done;
-      printf ") \\\n        return luaM_ret_%s_%s(L" pkg.name fn.fname;
-      for i = 1 to retlen do printf ", luaM_x%d" i done;
-      printf ")\n"
+      fprintf ob "#define RETURN(luaM_x1";
+      for i = 2 to retlen do fprintf ob ", luaM_x%d" i done;
+      fprintf ob ") \\\n        return luaM_ret_%s_%s(L" pkg.name fn.fname;
+      for i = 1 to retlen do fprintf ob ", luaM_x%d" i done;
+      fprintf ob ")\n"
     );
-    put_line l f;
-    printf "    %s\n#undef RAISE\n#undef RETURN\n}\n" fn.body
+    put_line ob l f;
+    fprintf ob "    %s\n#undef RAISE\n#undef RETURN\n}\n" fn.body
 
-  let do_c =
+  let do_c ob =
     let do_c_aux = function
-      | Buf (s, f, l) -> put_line l f; print_string s
+      | Buf (s, f, l) -> put_line ob l f; output_string ob s
       | Pkg pkg       ->
           (* dump struct const init *)
           (if pkg.static then
-            dump_struct_type "static " pkg (sprintf " %s = {\n" pkg.name)
+            dump_struct_type ob "static " pkg (sprintf " %s = {\n" pkg.name)
           else
-            printf "struct luaM_%s_t %s = {\n" pkg.name pkg.name
+            fprintf ob "struct luaM_%s_t %s = {\n" pkg.name pkg.name
           );
           List.iter (function (m, _, _) ->
               let (init, f, l) = m.init in
-              put_line l f;
-              printf "    %s,\n" (if fst m.typ then init else "0")
+              put_line ob l f;
+              fprintf ob "    %s,\n" (if fst m.typ then init else "0")
             ) pkg.members;
-          printf "};\n";
+          fprintf ob "};\n";
 
           (* dump struct init func *)
-          printf "\nstatic void %s_init(void)\n{\n" pkg.name;
+          fprintf ob "\nstatic void %s_init(void)\n{\n" pkg.name;
           List.iter (function (m, _, _) ->
             if not (fst m.typ) then
               let init, f, l = m.init in
               let field = sprintf "%s.%s" pkg.name m.mname in
-              put_line l f;
-              printf "    %s = %s;\n" field init;
+              put_line ob l f;
+              fprintf ob "    %s = %s;\n" field init;
               match m.onchange with
               | None           -> ()
               | Some(on, f, l) ->
-                  put_line l f; printf "    %s;\n" (tplize on field)
+                  put_line ob l f; fprintf ob "    %s;\n" (tplize on field)
             ) pkg.members;
-          printf "};\n\n";
+          fprintf ob "};\n\n";
 
           (* dump __index *)
-          printf "static int luaM_%s_index(lua_State *L)\n{\n" pkg.name;
-          printf "    const char *idx = luaL_checkstring(L, 2);\n\n";
-          printf "    switch (mlua_which_token(idx, -1)) {\n";
+          fprintf ob "static int luaM_%s_index(lua_State *L)\n{\n" pkg.name;
+          fprintf ob "    const char *idx = luaL_checkstring(L, 2);\n\n";
+          fprintf ob "    switch (mlua_which_token(idx, -1)) {\n";
           List.iter (function (m, _, _) ->
-            printf "      case LTK_%s:\n" (upper m.mname);
+            fprintf ob "      case LTK_%s:\n" (upper m.mname);
             let push, f, l = (snd m.typ).push in
-            put_line l f;
-            printf "        %s;\n" (tplize push (sprintf "%s.%s" pkg.name m.mname));
-            printf "        return 1;\n"
+            put_line ob l f;
+            fprintf ob "        %s;\n" (tplize push (sprintf "%s.%s" pkg.name m.mname));
+            fprintf ob "        return 1;\n"
           ) pkg.members;
-          printf "      default:\n";
-          printf "        lua_rawget(L, lua_upvalueindex(1));\n";
-          printf "        return 1;\n";
-          printf "    }\n}\n\n";
+          fprintf ob "      default:\n";
+          fprintf ob "        lua_rawget(L, lua_upvalueindex(1));\n";
+          fprintf ob "        return 1;\n";
+          fprintf ob "    }\n}\n\n";
 
           (* dump __newindex *)
-          printf "static int luaM_%s_newindex(lua_State *L)\n{\n" pkg.name;
-          printf "    const char *idx = luaL_checkstring(L, 2);\n\n";
-          printf "    switch (mlua_which_token(idx, -1)) {\n";
+          fprintf ob "static int luaM_%s_newindex(lua_State *L)\n{\n" pkg.name;
+          fprintf ob "    const char *idx = luaL_checkstring(L, 2);\n\n";
+          fprintf ob "    switch (mlua_which_token(idx, -1)) {\n";
           List.iter (function (m, _, _) ->
             let field = sprintf "%s.%s" pkg.name m.mname in
             match m.typ with
             | true, _ -> ()
             | false, t ->
-              printf "      case LTK_%s:\n" (upper m.mname);
+              fprintf ob "      case LTK_%s:\n" (upper m.mname);
               (match t.dtor with
               | None -> ()
               | Some (dtor, f, l) ->
-                  put_line l f;
-                  printf "        %s;\n" (tplize dtor ("&" ^ field))
+                  put_line ob l f;
+                  fprintf ob "        %s;\n" (tplize dtor ("&" ^ field))
               );
               (match t.ctor with
               | None ->
                   let (c, f, l) = t.check in
-                  put_line l f;
-                  printf "        %s = %s;\n" field (tplize c "3")
+                  put_line ob l f;
+                  fprintf ob "        %s = %s;\n" field (tplize c "3")
               | Some (ctor, f, l) ->
                   let v =
                     let c, f, l = t.check in
                     tplize (sprintf "\n#line %d \"%s\"\n            %s" l f c) "3"
                   in
-                  put_line l f;
-                  printf "        %s = %s;\n" field (tplize ctor v)
+                  put_line ob l f;
+                  fprintf ob "        %s = %s;\n" field (tplize ctor v)
               );
               (match m.onchange with
               | None           -> ()
               | Some(on, f, l) ->
-                  put_line l f;
-                  printf "        %s;\n" (tplize on field)
+                  put_line ob l f;
+                  fprintf ob "        %s;\n" (tplize on field)
               );
-              printf "        return 1;\n"
+              fprintf ob "        return 1;\n"
           ) pkg.members;
-          printf "      default:\n";
-          printf "        lua_rawset(L, lua_upvalueindex(1));\n";
-          printf "        return 1;\n";
-          printf "    }\n}\n";
+          fprintf ob "      default:\n";
+          fprintf ob "        lua_rawset(L, lua_upvalueindex(1));\n";
+          fprintf ob "        return 1;\n";
+          fprintf ob "    }\n}\n";
 
           (* dump methods *)
-          List.iter (do_func pkg) pkg.methods;
-          printf "\nstatic const luaL_reg luaM_%s_methods[] = {\n" pkg.name;
+          List.iter (do_func ob pkg) pkg.methods;
+          fprintf ob "\nstatic const luaL_reg luaM_%s_methods[] = {\n" pkg.name;
           List.iter (function (f, _, _) ->
-              printf "    { \"%s\", luaM_%s_%s },\n" f.fname pkg.name f.fname)
+              fprintf ob "    { \"%s\", luaM_%s_%s },\n" f.fname pkg.name f.fname)
             pkg.methods;
-          print_string (Str.global_replace (Str.regexp "%s") pkg.name
+          output_string ob (Str.global_replace (Str.regexp "%s") pkg.name
 "    { NULL, NULL },
 };
 
@@ -619,17 +621,21 @@ int luaopen_%s(lua_State *L)
 (* }}} *)
 
   let usage () =
-    output_string stderr "usage: cpkg2c (-h | -c) file.cpkg\n";
+    output_string stderr "usage: cpkg2c (-h | -c) file.cpkg -o output\n";
     exit 1
 
   let _ =
-    let warn () = print_endline "/*** THIS FILE IS AUTOGENERATED !!! ***/" in
-    if Array.length Sys.argv <= 2 then usage();
+    let warn ob = output_endline ob "/*** THIS FILE IS AUTOGENERATED !!! ***/" in
+    if Array.length Sys.argv != 5 then usage();
     let file   = Sys.argv.(2) in
     let lexbuf = L.from_channel (open_in file) in
     let l      = (startchunk cLine file lexbuf) in
-    match Sys.argv.(1) with
-    | "-h" -> warn (); do_h l
-    | "-c" -> warn (); do_c l
-    | _    -> usage ()
+    if Sys.argv.(3) = "-o" then
+        let ob = open_out_gen [ Open_trunc ; Open_wronly; Open_creat ] 0444 Sys.argv.(4) in
+        match Sys.argv.(1) with
+        | "-h" -> warn ob; do_h ob l; close_out ob
+        | "-c" -> warn ob; do_c ob l; close_out ob
+        | _    -> usage ()
+    else
+      usage();
 }