From: Pierre Habouzit Date: Mon, 26 Mar 2007 21:37:55 +0000 (+0200) Subject: Finish the caml lua<->C bindings generator. X-Git-Url: http://git.madism.org/?p=apps%2Fmadmutt.git;a=commitdiff_plain;h=a19e0acbcbc4a8d4238cda051ca702653450c1cb Finish the caml lua<->C bindings generator. Surprisingly enough, it works, don't look at the code, it hurts. Signed-off-by: Pierre Habouzit --- diff --git a/tools/cpkg2c.mll b/tools/cpkg2c.mll index 3ec98ea..0eccf47 100644 --- a/tools/cpkg2c.mll +++ b/tools/cpkg2c.mll @@ -142,7 +142,9 @@ let find_import relpath file = if Filename.is_relative file then - Filename.concat (Filename.dirname relpath) file + match Filename.dirname relpath with + | "." -> file + | s -> Filename.concat s file else file @@ -283,9 +285,9 @@ and ext_pkg pkg = parse } | '(' ((typdecl ',')* typdecl as ret) ')' sp* (ident as fname) - '('((typdecl ident sp* ',')* typdecl ident sp* as args)')' + '('((typdecl ident sp* ',')* typdecl ident sp* as args)')' sp* | (typdecl as ret) (ident as fname) - '('((typdecl ident sp* ',')* typdecl ident sp* as args)')' + '('((typdecl ident sp* ',')* typdecl ident sp* as args)')' sp* { let rettype = parse_rettype (lnum lexbuf) pkg.file ret in let args = parse_args (lnum lexbuf) pkg.file args in @@ -330,14 +332,14 @@ and ext_bodycode buf = parse (* }}} *) { - let upper = String.capitalize + let upper = String.uppercase let tplize tpl v = Str.global_replace (Str.regexp_string "$L") "L" ( Str.global_replace (Str.regexp_string "$$") v tpl ) let dump_struct_type begwith pkg endwith = - printf "%sstrict luaM_%s_t {\n" begwith pkg.name; + printf "%sstruct luaM_%s_t {\n" begwith pkg.name; List.iter (function (m, f, l) -> put_line l f; let ctype = t1 (snd m.typ).ctype in @@ -355,46 +357,84 @@ and ext_bodycode buf = parse | Pkg pkg -> printf "\n#ifndef MUTT_LUA_%s_H\n" (upper pkg.name); printf "#define MUTT_LUA_%s_H\n\n" (upper pkg.name); - if not pkg.static then dump_struct_type "" pkg ";"; + if not pkg.static then ( + dump_struct_type "" pkg ";"; + printf "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); in List.iter do_h_aux let do_func pkg (fn, f, l) = + (* return inline function *) + printf "\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 + ) 0 fn.rettype in + printf ")\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)); + 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)) + ); i + ) 0 fn.rettype) ; + printf " return %d;\n}\n" retlen; + + (* main function *) printf "\nstatic int luaM_%s_%s(lua_State *L)\n{\n" pkg.name fn.fname; - let i = ref 0 in - List.iter (function ((const, typ), name) -> - incr i; + 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)) + printf " 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)) + printf " %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) + (string_of_int i) in put_line l f; printf " %s %s = %s;\n" ctype name (tplize ctor v) - ) - ) fn.args; - printf "}\n" + ); i + ) 0 fn.args); + printf "\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 + ) 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" + ); + put_line l f; + printf " %s\n#undef RAISE\n#undef RETURN\n}\n" fn.body let do_c = let do_c_aux = function - | Buf (s, f, l) -> printf "#line %d %s\n%s" l f s + | Buf (s, f, l) -> put_line l f; print_string s | Pkg pkg -> (* dump struct const init *) (if pkg.static then - dump_struct_type "static" pkg (sprintf " %s = {\n" pkg.name) + dump_struct_type "static " pkg (sprintf " %s = {\n" pkg.name) else printf "struct luaM_%s_t %s = {\n" pkg.name pkg.name ); @@ -433,28 +473,30 @@ and ext_bodycode buf = parse printf " const char *idx = luaL_checkstring(L, 2);\n\n"; printf " switch (mlua_which_token(idx, -1)) {\n"; List.iter (function (m, _, _) -> - let t = snd m.typ in - printf " 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 (sprintf "%s.%s" pkg.name m.mname)) - ); - (match t.ctor with - | None -> - let (c, f, l) = t.check in - put_line l f; - printf " %s.%s = %s;\n" pkg.name m.mname (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 = %s;\n" pkg.name m.mname (tplize ctor v) - ); - printf " return 1;\n" + match m.typ with + | true, _ -> () + | false, t -> + printf " 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 (sprintf "&%s.%s" pkg.name m.mname)) + ); + (match t.ctor with + | None -> + let (c, f, l) = t.check in + put_line l f; + printf " %s.%s = %s;\n" pkg.name m.mname (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 = %s;\n" pkg.name m.mname (tplize ctor v) + ); + printf " return 1;\n" ) pkg.members; printf " default:\n"; printf " return 1;\n"; @@ -467,7 +509,7 @@ and ext_bodycode buf = parse printf " { \"%s\", luaM_%s_%s },\n" f.fname pkg.name f.fname) pkg.methods; print_string (Str.global_replace (Str.regexp "%s") pkg.name -" { NULL, NULL }; +" { NULL, NULL }, }; int luaopen_%s(lua_State *L) @@ -509,8 +551,7 @@ int luaopen_%s(lua_State *L) in List.iter do_c_aux let usage () = - print_string "usage: cpkg2c (-h | -c) file.cpkg"; - print_newline(); + output_string stderr "usage: cpkg2c (-h | -c) file.cpkg\n"; exit 1 let _ =