X-Git-Url: http://git.madism.org/?p=apps%2Fmadmutt.git;a=blobdiff_plain;f=tools%2Fcpkg2c.mll;h=57e825895b6d07158aa9c61b6190ec68aceac110;hp=3ec98ea647fa450b38626220c9b3cb9724845033;hb=94c83f42e786ffbebb2ea3defcd6df95efe116f0;hpb=07f92763f437c569cd9994154fc367c66279e21a

diff --git a/tools/cpkg2c.mll b/tools/cpkg2c.mll
index 3ec98ea..57e8258 100644
--- a/tools/cpkg2c.mll
+++ b/tools/cpkg2c.mll
@@ -22,11 +22,8 @@
   module H = Hashtbl
   module B = Buffer
 
-  type 'a anchor = ('a * string * int)
-
+  type 'a anchor   = ('a * string * int)
   let t1 (a, _, _) = a
-  let t2 (_, a, _) = a
-  let t3 (_, _, a) = a
 
   let die lpos fpos s =
     output_string stderr (sprintf "%s:%d: %s\n" fpos lpos s);
@@ -34,6 +31,14 @@
 
   let put_line = printf "#line %d \"%s\"\n"
 
+  let isspace = function |' '|'\t' -> true | _ -> false
+
+  let strip s =
+    let l = ref 0 and r = ref (String.length s) in
+    while (isspace s.[!l]     && !l < !r) do incr l done;
+    while (isspace s.[!r - 1] && !l < !r) do decr r done;
+    String.sub s !l (!r - !l)
+
 (* @types related {{{ *)
 
   type typedef =
@@ -94,9 +99,9 @@
       | [t]          -> (false, type_find lpos fpos t)
       | _ -> assert false
     in
-    match s with
+    match strip s with
     | "void" -> []
-    | s      -> List.map aux (Str.split (Str.regexp "[ \t]+,[ \t]+") s)
+    | s      -> List.map aux (Str.split (Str.regexp "[ \t]*,[ \t]*") s)
 
   let parse_args lpos fpos s =
     let aux t =
@@ -105,9 +110,9 @@
       | [t; n]          -> ((false, type_find lpos fpos t), n)
       | _ -> assert false
     in
-    match s with
+    match strip s with
     | "void" -> []
-    | s      -> List.map aux (Str.split (Str.regexp "[ \t]+,[ \t]+") s)
+    | s      -> List.map aux (Str.split (Str.regexp "[ \t]*,[ \t]*") s)
 
 (* }}} *)
 (* parsing helpers {{{ *)
@@ -142,7 +147,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
 
@@ -158,7 +165,6 @@ let sp     = [' ''\t']
 let typdecl = sp* ("const" sp+)? ident sp*
 
 (* }}} *)
-
 (* entry point {{{ *)
 
 rule cLine lpos fpos buf = parse
@@ -283,9 +289,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 +336,16 @@ and ext_bodycode buf = parse
 (* }}} *)
 
 {
-  let upper = String.capitalize
+(* templating functions {{{ *)
+
+  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 +363,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 +479,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 +515,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)
@@ -484,7 +532,7 @@ int luaopen_%s(lua_State *L)
     luaL_newmetatable(L, \"%s\");
     mt = lua_gettop(L);
 
-    lua_pushliteral(L, \"%s\");
+    lua_pushliteral(L, \"__index\");
     lua_pushvalue(L, mt);                       /* upvalue 1         */
     lua_pushvalue(L, methods);                  /* upvalue 2         */
     lua_pushcclosure(L, &luaM_%s_index, 2);
@@ -501,16 +549,17 @@ int luaopen_%s(lua_State *L)
 
     lua_setmetatable(L, methods);
 
-    lua_pop(L, 1);                              /* drop mt           */
-    return 1;                                   /* return methods    */
+    lua_pop(L, 2);                              /* drop mt + methods */
+    return 1;
 }
 
 ")
     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 _ =