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 =
}
let typedef0 =
{ lpos = 0; fpos = "";
- ctype = ("", "", 0);
- check = ("", "", 0);
- push = ("", "", 0);
+ ctype = "", "", 0;
+ check = "", "", 0;
+ push = "", "", 0;
ctor = None;
dtor = None
}
type typinst = bool * typedef
type members =
- { typ: typinst; mname: string; init: string }
+ { typ: typinst; mname: string;
+ init: string anchor; onchange: string anchor option; }
+ let member0 =
+ { typ = false, typedef0;
+ mname = "";
+ init = "", "", 0;
+ onchange = None;
+ }
type methods =
{ rettype: typinst list; args: (typinst * string) list;
| [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 =
| [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 {{{ *)
| '\n' { ext_pkg pkg (nextl lexbuf) }
| "/*" { let _ = cComment (B.create 1024) lexbuf in
ext_pkg pkg lexbuf }
+| ("const" sp+ as const)? (ident as typ) sp+
+ (ident as member) sp* '=' sp* '{'
+ {
+ let m = {member0 with mname = member;
+ typ = const != None, type_find (lnum lexbuf)
+ pkg.file typ; } in
+ let m = ext_member m pkg.file lexbuf in
+ ext_pkg {pkg with members = (m, pkg.file, lnum lexbuf)::pkg.members} lexbuf
+ }
| ("const" sp+ as const)? (ident as typ) sp+
(ident as member) sp* '=' sp* ([^';''\n']* as init)';'
{
let m = { typ = const != None,
type_find (lnum lexbuf) pkg.file typ;
mname = member;
- init = init; }, pkg.file, lnum lexbuf in
+ init = init, pkg.file, lnum lexbuf;
+ onchange = None; }, pkg.file, lnum lexbuf in
ext_pkg {pkg with members = m::pkg.members} lexbuf
}
| '(' ((typdecl ',')* typdecl as ret) ')' sp*
| '}' as c { buf @< c }
| _ as c { ext_bodycode (buf @< c) lexbuf }
+(* }}} *)
+(* parse extended member {{{ *)
+
+and ext_member m f = parse
+| sp+
+| "//" to_eol { ext_member m f lexbuf }
+| '\n' { ext_member m f (nextl lexbuf) }
+| "/*" { let _ = cComment (B.create 1024) lexbuf in
+ ext_member m f lexbuf }
+| '.' (ident as member) sp* '=' sp* ([^';''\n']+ as s) ';'
+ {
+ ext_member (
+ let do_anch s = s, f, lnum lexbuf in
+ match member with
+ | "init" -> {m with init = do_anch s}
+ | "onchange" -> {m with onchange = Some(do_anch s)}
+ | _ ->
+ die (lnum lexbuf) f
+ (sprintf "Unknown directive `%s'" member)
+ ) f lexbuf
+ }
+| '}' sp* ';' { m }
+| "" { die (lnum lexbuf) f "Syntax error" }
+
(* }}} *)
{
) 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
+ 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;
else
printf "struct luaM_%s_t %s = {\n" pkg.name pkg.name
);
- List.iter (function (m, f, l) ->
+ List.iter (function (m, _, _) ->
+ let (init, f, l) = m.init in
put_line l f;
- printf " %s,\n" (if fst m.typ then m.init else "0")
+ printf " %s,\n" (if fst m.typ then init else "0")
) pkg.members;
printf "};\n";
(* dump struct init func *)
printf "\nstatic void %s_init(void)\n{\n" pkg.name;
- List.iter (function (m, f, l) ->
+ List.iter (function (m, _, _) ->
if not (fst m.typ) then
- printf "#line %d \"%s\"\n %s.%s = %s;\n"
- l f pkg.name m.mname m.init) pkg.members;
+ 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;
+ match m.onchange with
+ | None -> ()
+ | Some(on, f, l) ->
+ put_line l f; printf " %s;\n" (tplize on field)
+ ) pkg.members;
printf "};\n\n";
(* dump __index *)
printf " const char *idx = luaL_checkstring(L, 2);\n\n";
printf " 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 ->
| None -> ()
| Some (dtor, f, l) ->
put_line l f;
- printf " %s;\n" (tplize dtor (sprintf "&%s.%s" pkg.name m.mname))
+ printf " %s;\n" (tplize dtor ("&" ^ field))
);
(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")
+ printf " %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 = %s;\n" pkg.name m.mname (tplize ctor v)
+ printf " %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)
);
printf " return 1;\n"
) pkg.members;
projects / apps / madmutt.git / blobdiff