PageRenderTime 56ms CodeModel.GetById 28ms RepoModel.GetById 0ms app.codeStats 0ms

/lib/gtkNode/priv/generator/src/generator.erl

https://github.com/bmizerany/jungerl
Erlang | 403 lines | 338 code | 48 blank | 17 comment | 10 complexity | a5217b8eb63cf5bee5fdb5bee5a61ef2 MD5 | raw file
Possible License(s): LGPL-2.1, BSD-3-Clause, AGPL-1.0
  1. %%%-------------------------------------------------------------------
  2. %%% File : generate.erl
  3. %%% Author : Mats Cronqvist <qthmacr@mwux005>
  4. %%% Description : generates C code that gtkNode_cnode can call.
  5. %%% each function marshals args and calls one gtk function.
  6. %%% reads the .defs files from h2def.py
  7. %%%
  8. %%% Created : 27 Oct 2004 by Mats Cronqvist <qthmacr@mwux005>
  9. %%%-------------------------------------------------------------------
  10. -module(generator).
  11. -export([go/0,go/1]).
  12. -import(filename, [join/1,dirname/1]).
  13. -import(io, [put_chars/2, get_line/2]).
  14. -import(lists,[foreach/2, map/2,foldl/3,reverse/1, sort/1]).
  15. -record(func, {black=no,cname,pref,ret,const=no,paras=[]}).
  16. -record(type, {what,cname,gtype,etype,cast}).
  17. go() -> go(dirname(dirname(code:which(?MODULE)))).
  18. go(Dir) ->
  19. Vsn = vsn(),
  20. ets_new(types),
  21. ets_new(funcs),
  22. ets_new(bogus,[{keypos,1}]),
  23. FNs = [gname(Dir,F,"",Vsn,"defs") || F<-["gtk","gdk","g"]],
  24. foreach(fun do_types/1, FNs), %populate the types table
  25. lists(Dir),
  26. structs(Dir),
  27. basic_types(),
  28. R = [gen(F,Dir,Vsn) || F<-["gtk","gdk","g"]],
  29. io:fwrite("~w ~p~n~n", [?MODULE, R]).
  30. gen(Pref, Dir, Vsn) ->
  31. do_funcs(gname(Dir,Pref,"_white",Vsn,"defs")), %populate the funcs table
  32. do_black(join([Dir,src,Pref++"_black.txt"])), %de-populate the funcs table
  33. {ok,FDc} = file:open(gname(Dir,Pref,"_generated",Vsn,"h"),[write]),
  34. {ok,FDok} = file:open(gname(Dir,Pref,"_funcs",Vsn,"txt"),[write]),
  35. {ok,FDcrap} = file:open(gname(Dir,Pref,"_crap_funcs",Vsn,"txt"),[write]),
  36. {ok,FDtypes} = file:open(gname(Dir,Pref,"_crap_types",Vsn,"txt"),[write]),
  37. vsn(Vsn,[FDc,FDok,FDcrap,FDtypes]),
  38. FRWAs = ets:match(funcs,{func,no,'$1',Pref,'$2','$3','$4'}),
  39. foreach(fun(FRWA)-> gen_one(FDc, FDcrap, FDok,Pref,FRWA) end, FRWAs),
  40. log_types(FDtypes),
  41. {Pref, length(FRWAs), ets:lookup(bogus,good),ets:lookup(bogus,bad)}.
  42. vsn() ->
  43. case os:cmd("pkg-config --modversion gtk+-2.0") of
  44. "sh:"++_ -> exit({not_found, 'pkg-config'});
  45. "Package "++_ -> exit({not_found,'gtk+-2.0'});
  46. Vsn -> reverse(tl(reverse(Vsn)))
  47. end.
  48. vsn(_, []) -> ok;
  49. vsn(Vsn, [FD|FDs]) ->
  50. io:fwrite(FD, "/* GTK version: ~s */~n", [Vsn]),
  51. vsn(Vsn,FDs).
  52. gen_one(FDc, FDcrap, FDok, Pref, [Func,Ret,Const,Args]) ->
  53. unstick(),
  54. emit_head(Pref, Func),
  55. emit_argdefs(Args),
  56. emit_retdef(Ret,Const),
  57. emit_ari_chk(Args),
  58. emit_arg_chk(Args),
  59. emit_call(Func, Ret, Args),
  60. emit_free(Args),
  61. emit_return(Ret),
  62. emit_final(),
  63. unstick(FDc,FDcrap,FDok).
  64. emit_head(Pref, Func) ->
  65. estick({UFunc = upcase_1st(Func), rem_pref(Func, Pref)}),
  66. stick("/*******************************/~n"
  67. "gboolean ~s(int ARI, ei_x_buff *XBUF, char *B, int *I){~n~n", [UFunc]).
  68. emit_argdefs([]) -> stick("~n",[]);
  69. emit_argdefs([{Typ,Name,_Doc}|Args]) ->
  70. stick(" ~s ~s;~n", [Typ,Name]),
  71. emit_argdefs(Args).
  72. emit_retdef(Ret,Const) ->
  73. case what_group(Ret) of
  74. object -> stick(" GObject* R;~n~n",[]);
  75. struct -> stick(" ~s R;~n~n", [Ret]);
  76. none -> stick(" /* no return value */~n~n",[]);
  77. crap -> stick(" ~s R;~n~n", ["CRAP_"++Ret]);
  78. list ->
  79. mark_as_crap("list_"++Ret),
  80. stick(" ~s R;~n~n", ["CRAP_list_"++Ret]);
  81. _ ->
  82. case Const of
  83. yes -> stick(" const ~s R; /* return value */~n~n", [Ret]);
  84. no -> stick(" ~s R; /* return value */~n~n", [Ret])
  85. end
  86. end.
  87. emit_ari_chk(Args) ->
  88. stick(" if ( ! gn_check_arity(XBUF, ~p, ARI) )"
  89. " return FALSE;~n", [length(Args)]).
  90. emit_arg_chk([]) -> ok;
  91. emit_arg_chk([{Typ,Name,_Doc}|Args]) ->
  92. estick(Name),
  93. case Kind = what_group(Typ) of
  94. crap ->
  95. stick(" if ( ! gn_get_arg_CRAP(XBUF, B, I, ~p, &~s) )"
  96. " return FALSE;~n",
  97. [Typ,Name]);
  98. list ->
  99. stick(" if ( ! gn_get_arg_~s(XBUF, B, I, ~p, ~s&~s) )"
  100. " return FALSE;~n",
  101. [Kind,unstar(Typ),"(void**)",Name]);
  102. struct ->
  103. stick(" if ( ! gn_get_arg_~s(XBUF, B, I, ~p, ~s&~s) )"
  104. " return FALSE;~n",
  105. [Kind,unstar(Typ),"(void**)",Name]);
  106. basic ->
  107. stick(" if ( ! gn_get_arg_~s(XBUF, B, I, &~s) )"
  108. " return FALSE;~n",
  109. [unstar(Typ),Name]);
  110. flags ->
  111. stick(" if ( ! gn_get_arg_~s(XBUF, B, I, ~p, ~s&~s) )"
  112. " return FALSE;~n",
  113. [Kind,unstar(Typ),"(gint*)",Name]);
  114. enum ->
  115. stick(" if ( ! gn_get_arg_~s(XBUF, B, I, ~p, ~s&~s) )"
  116. " return FALSE;~n",
  117. [Kind,unstar(Typ),"(gint*)",Name]);
  118. object ->
  119. stick(" if ( ! gn_get_arg_~w(XBUF, B, I, ~s, ~s&~s) )"
  120. " return FALSE;~n",
  121. [Kind,what_gtype(unstar(Typ)),"(GObject**)",Name])
  122. end,
  123. emit_arg_chk(Args).
  124. emit_call(Func, Ret, Args) ->
  125. case what_group(Ret) of
  126. none -> stick(" ~s(",[Func]);
  127. object -> stick(" R = (GObject*)~s(",[Func]);
  128. list -> stick(" R = (~s)~s(", ["CRAP_"++Ret,Func]);
  129. crap -> stick(" R = (~s)~s(", ["CRAP_"++Ret,Func]);
  130. _ -> stick(" R = ~s(", [Func])
  131. end,
  132. emit_call_arg(Args).
  133. emit_call_arg([{_,Name,_}|As]) -> stick("~s", [Name]),emit_call_args(As);
  134. emit_call_arg(A) -> emit_call_args(A).
  135. emit_call_args([]) -> stick(");~n",[]);
  136. emit_call_args([{_,Name,_}|Args]) ->
  137. stick(", ~s", [Name]),
  138. emit_call_args(Args).
  139. emit_free([]) -> ok;
  140. emit_free([{Type,Name,_}|Args]) ->
  141. case {Type,what_group(Type)} of
  142. {_,list} -> stick(" g_free(~s);~n", [Name]);
  143. {"gchar*",_}-> stick(" free(~s);~n", [Name]);
  144. {"char*",_}-> stick(" free(~s);~n", [Name]);
  145. _ -> ok
  146. end,
  147. emit_free(Args).
  148. emit_return(Ret) ->
  149. case what_group(Ret) of
  150. basic ->
  151. {ET,Cast} = what_etype(Ret),
  152. stick(" gn_put_~w(XBUF,(~s)R);~n", [ET,Cast]);
  153. none -> stick(" gn_put_void(XBUF);~n", []);
  154. object -> stick(" gn_put_object(XBUF,R);~n", []);
  155. struct -> stick(" gn_put_struct(XBUF,~p,(void*)R);~n", [unstar(Ret)]);
  156. crap -> stick(" gn_put_CRAP(XBUF,~p,R);~n", [Ret]);
  157. Kind -> stick(" gn_put_~w(XBUF,~p,R);~n", [Kind, Ret])
  158. end.
  159. emit_final() ->
  160. stick(" return TRUE;~n}~n",[]).
  161. what_gtype(This) ->
  162. [#type{what=object,gtype=Type}] = ets:lookup(types,This),
  163. Type.
  164. what_etype(Basic) ->
  165. [#type{what=basic,etype=Type,cast=Cast}] = ets:lookup(types,Basic),
  166. {Type,Cast}.
  167. what_group([]) -> none;
  168. what_group("none") -> none;
  169. what_group(Typ) ->
  170. case {ets:lookup(types,Typ),ets:lookup(types,unstar(Typ))} of
  171. {[#type{what = object}],_} -> object;
  172. {[],[#type{what = object}]} -> object;
  173. {[#type{what = basic}],_} -> basic;
  174. {[#type{what = enum}],_} -> enum;
  175. {[#type{what = flags}],_} -> flags;
  176. {[#type{what = list}],_} -> list;
  177. {_,[#type{what = struct}]} -> struct;
  178. _ -> mark_as_crap(Typ)
  179. end.
  180. mark_as_crap(Typ) ->
  181. put(crap,crap),
  182. ets_upd(bogus,{type,Typ}),
  183. crap.
  184. estick(X) ->
  185. case get(efunc) of
  186. undefined -> put(efunc, {X,[]});
  187. {F,As} -> put(efunc,{F,[X|As]})
  188. end.
  189. stick(Form, Args) ->
  190. S = io_lib:fwrite(Form, Args),
  191. case get(cfunc) of
  192. undefined -> put(cfunc, S);
  193. SS -> put(cfunc, SS++S)
  194. end.
  195. unstick() -> erase(cfunc), erase(efunc), erase(crap).
  196. unstick(FD1,FD2,FDok) ->
  197. case get(crap) of
  198. crap -> ets_upd(bogus,bad),cunstick(FD2);
  199. _ -> ets_upd(bogus,good),cunstick(FD1), eunstick(FDok)
  200. end,
  201. unstick().
  202. cunstick(FD) -> io:fwrite(FD, "~s", [lists:flatten(get(cfunc))]).
  203. eunstick(FD) ->
  204. {{Cname,_Ename},As} = get(efunc),
  205. io:fwrite(FD, "~s(",[Cname]),
  206. eunstick_args(FD,As),
  207. io:fwrite(FD, ")~n",[]).
  208. eunstick_args(_FD,[]) -> ok;
  209. eunstick_args(FD,As) ->
  210. [A1|AT] = reverse(As),
  211. io:fwrite(FD,"~s",[upcase_1st(A1)]),
  212. foreach(fun(A)->io:fwrite(FD,",~s",[upcase_1st(A)]) end, AT).
  213. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  214. do_black(FN) ->
  215. bio:string(FN, fun do_black/2, nil).
  216. do_black(Str,_State) ->
  217. case ets:lookup(funcs,Str) of
  218. [] -> ok;
  219. [Rec] -> ets:insert(funcs, Rec#func{black=yes})
  220. end.
  221. gname(Dir,Pref,Mid,Vsn,Ext) ->
  222. join([Dir,gen,Pref++Mid++"-"++Vsn++"."++Ext]).
  223. do_funcs(FN) ->
  224. io:fwrite("~p~n", [FN]),
  225. bio:string(FN, fun do_funcl/2, nil).
  226. do_funcl("",State) ->
  227. State;
  228. do_funcl(";"++_,State) ->
  229. State;
  230. do_funcl(")", bogus) ->
  231. nil;
  232. do_funcl(")", {_,Data}) ->
  233. ets:insert(funcs,Data),
  234. nil;
  235. do_funcl("(define-function "++_, nil) ->
  236. {func,#func{}};
  237. do_funcl("(define-method "++_, nil) ->
  238. {meth,#func{}};
  239. do_funcl(" (parameters", {Flag,Func}) ->
  240. {para, {Flag, Func}};
  241. do_funcl(_, bogus) ->
  242. bogus;
  243. do_funcl(" (varargs #t)", _) ->
  244. bogus;
  245. do_funcl(" )", {para, {Flag, Func}}) ->
  246. {Flag, Func};
  247. %%do_funcl(" )", {para, {Flag, Func}}) ->
  248. %% {Flag, Func};
  249. do_funcl(Str, {para, {Flag, Func}}) ->
  250. OP = Func#func.paras,
  251. case string:tokens(Str,"'()\" ") of
  252. ["const-"++Para, Name|_Doc] ->
  253. {para, {Flag, Func#func{paras=OP++[{Para,Name,const}]}}};
  254. [Para, Name|_Doc] ->
  255. {para, {Flag, Func#func{paras=OP++[{Para,Name,no}]}}}
  256. end;
  257. do_funcl(" (c-name \""++C, {Flag,Func}) ->
  258. {Flag,Func#func{cname=trnc(2,C), pref=pref(C)}};
  259. do_funcl(" (return-type \""++C, {Flag,Func}) ->
  260. case trnc(2,C) of
  261. "const-"++R -> {Flag,Func#func{ret=R,const=yes}};
  262. R -> {Flag,Func#func{ret=R}}
  263. end;
  264. do_funcl(" (of-object \""++C, {meth,Func}) ->
  265. %%% {meth,Func#func{this=trnc(2,C)}};
  266. {meth,Func#func{paras=[{trnc(2,C)++"*","object",no}]}};
  267. do_funcl(_,State) ->
  268. State.
  269. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  270. lists(_Dir) ->
  271. Lists = ["GType*"],
  272. foreach(fun ins_list/1, Lists).
  273. ins_list(L) -> ets:insert(types,#type{what=list,cname=L,cast=""}).
  274. structs(Dir) ->
  275. io:fwrite("dir is ~p~n",[Dir]),
  276. FN = join([dirname(dirname(Dir)),src,"gtkNode_structs.c"]),
  277. Structs = bio:string(FN, fun do_structs/2, []),
  278. foreach(fun ins_struct/1, Structs).
  279. do_structs(Str, Acc) ->
  280. case regexp:match(Str,"gn_construct_.*\\(") of
  281. nomatch -> Acc;
  282. {match,St,Le} -> [string:substr(Str,St+13,Le-14)|Acc]
  283. end.
  284. ins_struct(S) -> ets:insert(types,#type{what=struct,cname=S,cast=""}).
  285. basic_types() ->
  286. Basic = [{boolean, "int", ["gboolean","boolean"]},
  287. {string, "char*", ["gchar*","char*"]},
  288. {double, "double", ["gdouble","gfloat"]},
  289. {longlong, "long long", ["gint64","gint","int","size_t"]},
  290. {ulonglong, "unsigned long long",
  291. ["guint","guint8","guint16","guint32"]},
  292. {void,none,["void"]}],
  293. foreach(fun ins_basic/1, Basic).
  294. ins_basic({ET,Cast,Bs}) ->
  295. foreach(fun(B) -> ins_basic(B,ET,Cast) end, Bs).
  296. ins_basic(B,ET,Cast) ->
  297. ets:insert(types,#type{what=basic,cname=B,etype=ET,cast=Cast}).
  298. do_types(FN) ->
  299. io:fwrite("~p~n", [FN]),
  300. bio:string(FN, fun do_typel/2, nil).
  301. do_typel("",State) ->
  302. State;
  303. do_typel(";"++_,State) ->
  304. State;
  305. do_typel(")", {_,Data}) ->
  306. ets:insert(types,Data),
  307. nil;
  308. do_typel("(define-boxed "++_, nil) ->
  309. {define_boxed,#type{what=boxed}};
  310. do_typel("(define-enum "++_, nil) ->
  311. {define_enum,#type{what=enum}};
  312. do_typel("(define-flags "++_, nil) ->
  313. {define_flags,#type{what=flags}};
  314. do_typel("(define-object "++_, nil) ->
  315. {define_object,#type{what=object}};
  316. do_typel("(define-pointer "++_, nil) ->
  317. {define_pointer,#type{what=pointer}};
  318. do_typel(" (c-name \""++C, {Flag,Type}) ->
  319. {Flag,Type#type{cname=trnc(2,C)}};
  320. do_typel(" (gtype-id \""++C, {Flag,Type}) ->
  321. {Flag,Type#type{gtype=trnc(2,C),cast=cast(trnc(2,C))}};
  322. do_typel(_,State) ->
  323. State.
  324. cast(C) ->
  325. [Pref,"TYPE"|Toks] = string:tokens(C,"_"),
  326. string_join([Pref|Toks], "_").
  327. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  328. upcase_1st(Str) -> [hd(Str)+$A-$a|tl(Str)].
  329. rem_pref([X|Func], [X|Pref]) -> rem_pref(Func, Pref);
  330. rem_pref([$_|Func], []) -> Func.
  331. pref(C) -> hd(string:tokens(C,"_")).
  332. unstar(Str) ->
  333. case reverse(Str) of
  334. "*"++X -> reverse(X);
  335. _ -> Str
  336. end.
  337. trnc(N,C) -> lists:sublist(C, length(C)-N).
  338. string_join([Pref|Toks], Sep) ->
  339. foldl(fun(Tok,O) -> O++Sep++Tok end, Pref, Toks).
  340. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  341. log_types(FD) ->
  342. F = fun(E) -> io:fwrite(FD, "~4w - ~s~n", E) end,
  343. foreach(F,reverse(sort(ets:match(bogus,{{type,'$2'},'$1'})))).
  344. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  345. ets_new(Tab) ->
  346. catch ets:delete(Tab),
  347. ets_new(Tab, [{keypos,3}]).
  348. ets_new(Tab, Opt) ->
  349. catch ets:delete(Tab),
  350. ets:new(Tab,[named_table,ordered_set]++Opt).
  351. ets_upd(Tab, Key) ->
  352. case catch ets:update_counter(Tab, Key, 1) of
  353. {'EXIT',_} -> ets:insert(Tab, {Key,1});
  354. _ -> ok
  355. end.