From c855a6e8e9522ac9add840b18a869c831030f569 Mon Sep 17 00:00:00 2001 From: Pierre Habouzit Date: Sat, 19 May 2007 17:28:38 +0200 Subject: [PATCH 1/1] cpkg2c improvements. Signed-off-by: Pierre Habouzit --- cmake/Cpkg2c.cmake | 4 +- tools/cpkg2c.mll | 190 +++++++++++++++++++++++---------------------- 2 files changed, 100 insertions(+), 94 deletions(-) diff --git a/cmake/Cpkg2c.cmake b/cmake/Cpkg2c.cmake index 0d1c01c..ad01413 100644 --- 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 --- 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(); } -- 2.20.1