Commits

Anonymous committed d771c31

Initial commit.

Comments (0)

Files changed (2)

haikuml_generator.erl

+-module(haikuml_generator).
+-compile(export_all).
+-define(CLASSES,
+	["BApplication", "BClipboard", "BCursor", "BHandler", "BInvoker",
+		"BLooper", "BMessage", "BMessageFilter", "BMessageQueue",
+		"BMessageRunner", "BMessenger", "BPropertyInfo", "BRoster",
+		"BDirectWindow", "BFileGameSound", "BGameSound",
+		"BPushGameSound", "BSimpleGameSound", "BStreamingGameSound",
+		"BWindowScreen", "BInputDevice", "BInputServerDevice",
+		"BInputServerFilter", "BInputServerMethod",
+		"BAlert", "BBitmap", "BBox", "BButton", "BCheckBox",
+		"BColorControl", "BControl", "BDragger", "BFont",
+		"BListItem", "BListView", "BMenu", "BMenuBar",
+		"BMenuField", "BMenuItem", "BOutlineListView", "BPicture",
+		"BPictureButton", "BPoint", "BPolygon", "BPopUpMenu",
+		"BPrintJob", "BRadioButton", "BRect", "BRegion", "BScreen",
+		"BScrollBar", "BScrollView", "BSeparatorItem", "BShape",
+		"BShapeIterator", "BShelf", "BSlider", "BStatusBar",
+		"BStringItem", "BStringView", "BTab", "BTabView",
+		"BTextControl", "BTextView", "BView", "BWindow",
+		"BMailMessage", "BBuffer", "BBufferConsumer",
+		"BBufferGroup", "BBufferProducer", "BContinuousParameter",
+		"BControllable", "BDiscreteParameter", "BFileInterface",
+		"BMediaAddOn", "BMediaBufferDecoder", "BMediaBufferEncoder",
+		"BMediaDecoder", "BMediaEncoder", "BMediaEventLooper",
+		"BMediaFile", "BMediaFiles", "BMediaFormats", "BMediaNode",
+		"BMediaRoster", "BMediaTheme", "BMediaTrack", "BNullParameter",
+		"BParameter", "BParameterGroup", "BParameterWeb",
+		"BSmallBuffer", "BSoundPlayer", "BTimeCode", "BTimedEventQueue",
+		"BTimeSource", "BMidi", "BMidiPort", "BMidiStore",
+		"BMidiSynth", "BMidiSynthFile", "BMidiText", "BSamples",
+		"BSynth", "BNetAddress", "BNetBuffer", "BNetDebug",
+		"BNetEndpoint", "BGLView", "BAppFileInfo", "BDirectory",
+		"BEntry", "BEntryList", "BFile", "BFilePanel", "BMimeType",
+		"BNode", "BNodeInfo", "BPath", "BQuery", "BRefFilter",
+		"BResources", "BStatable", "BSymLink", "BVolume",
+		"BVolumeRoster", "BArchivable", "BAutolock", "BBlockCache",
+		"BDataIO", "BFlattenable", "BList", "BLocker", "BMallocIO",
+		"BMemoryIO", "BPositionIO", "BStopWatch", "BString",
+		"BBitmapStream", "BTranslationUtils", 
+		"BTranslator", "BTranslatorRoster"]).
+
+start() ->
+	os:cmd("rm -rf generated"),
+	os:cmd("mkdir generated"),
+	[ generate_module(haikuml_getclass:get_class(X)) || X <- ?CLASSES ].
+
+generate_module({{module, Name}, {methods, List}}) ->
+	Header = generate_header(Name, List),
+	CppSource = generate_cpp(Name, List),
+	OCamlSource = generate_ocaml(Name, List),
+	{ok, HeaderIoDevice} =
+		file:open("generated/" ++ Name ++ "ML.hpp", [write]),
+	{ok, CppIoDevice} =
+		file:open("generated/" ++ Name ++ "ML.cpp", [write]),
+	{ok, OCamlIoDevice} =
+		file:open("generated/" ++ string:to_lower(Name) ++
+			".ml", [write]),
+	file:write(HeaderIoDevice, Header),
+	file:write(CppIoDevice, CppSource),
+	file:write(OCamlIoDevice, OCamlSource),
+	file:close(HeaderIoDevice),
+	file:close(CppIoDevice),
+	file:close(OCamlIoDevice).
+
+generate_header(Name, List) ->
+	NameML = Name ++ "ML",
+	NameML_H = string:to_upper(Name) ++ "ML_H",
+	HeaderStart =
+		"#ifndef " ++ NameML_H ++ "\n" ++
+		"#define " ++ NameML_H ++ "\n" ++
+		"extern \"C\" { #include \"HaikuML.h\" }\n" ++
+		"class " ++ NameML ++ " : public " ++ Name ++ "\n" ++
+		"{\n" ++
+		"public:\n",
+	HeaderBody = generate_header(Name, List, [], "private:\n"),
+	HeaderEnd = "};\n\n#endif",
+	HeaderStart ++ HeaderBody ++ HeaderEnd.
+
+
+generate_header(_, [], AccStart, AccEnd) ->
+	AccStart ++ AccEnd;
+
+generate_header(Name, [{constructor, ArgList}|T],
+		AccStart, AccEnd) ->
+	Line = "\t" ++ Name ++ "ML" ++
+		generate_header_args(ArgList) ++ ";\n",
+	generate_header(Name, T, AccStart ++ Line, AccEnd);
+
+generate_header(Name, [{{hook, Type}, HookName, ArgList}|T],
+		AccStart, AccEnd) ->
+	HookLine = "\t" ++ type_to_string(Type, c) ++ " " ++ HookName ++
+		generate_header_args(ArgList) ++ ";\n",
+	SetterLine = "\t" ++ "void set" ++ HookName ++ "(value cb_" ++
+		HookName ++ ");\n",
+	ClosureLine = "\tvalue closure_" ++ HookName ++ ";\n",
+	generate_header(Name, T,
+		AccStart ++ HookLine ++ SetterLine,
+		AccEnd ++ ClosureLine);
+
+generate_header(Name, [{{function, _}, _, _}|T], AccStart, AccEnd) ->
+	generate_header(Name, T, AccStart, AccEnd).
+
+
+generate_header_args(List) ->
+	generate_header_args(List, "(").
+
+generate_header_args([], Acc) ->
+	string:strip(Acc, both, $,) ++ ")";
+generate_header_args([{string, ArgName}|T], Acc) ->
+	generate_header_args(T,
+		Acc ++ "const char * " ++ ArgName ++ ",");
+generate_header_args([{Type, ArgName}|T], Acc) when is_atom(Type) ->
+	generate_header_args(T,
+		Acc ++ atom_to_list(Type) ++ " " ++ ArgName ++ ",");
+generate_header_args([{Type, ArgName}|T], Acc) ->
+	generate_header_args(T, Acc ++ Type ++ " " ++ ArgName ++ ",").
+
+
+generate_cpp(Name, List) ->
+	SourceStart = "#include " ++ Name ++ "ML.h\n",
+	SourceEnd = "}",
+	Source = generate_cpp(Name, [], List, [], "extern \"C\" {\n"),
+	SourceStart ++ Source ++ SourceEnd.
+
+generate_cpp(_, _, [], AccStart, AccEnd) ->
+	AccStart ++ AccEnd;
+
+generate_cpp(Name, ImplementedMethods, [Method|T], AccStart, AccEnd) ->
+	FirstPart = cpp_definition(Name, Method),
+	SecondPart = c_usage(Name, Method, ImplementedMethods, T),
+	generate_cpp(Name, [Method|ImplementedMethods], T,
+		AccStart ++ FirstPart, AccEnd ++ SecondPart).
+
+cpp_definition(Name, {constructor, ArgList}) ->
+	Name ++ "ML::" ++ Name ++ "ML" ++
+		generate_cpp_args(ArgList) ++ "\n\t:" ++ Name ++
+		generate_cpp_args_untyped(ArgList) ++ "\n{\n}\n";
+
+cpp_definition(Name, {{hook, Type}, HookName, ArgList}) ->
+	type_to_string(Type, c) ++ "\n" ++ Name ++ "ML::" ++
+		HookName ++ generate_cpp_args(ArgList) ++
+		"\n{\n\tif (closure_" ++ HookName ++
+		")\n\t{\n" ++ cpp_caml_callback(HookName, ArgList) ++
+		";\n\t} else\n\t{\n\t\t" ++ Name ++ "::" ++ HookName ++
+		generate_cpp_args_untyped(ArgList) ++ ";\n\t}\n}\n" ++
+		"void\n" ++ Name ++ "ML::" ++ "set" ++ HookName ++
+		"(value cb_" ++ HookName ++ ")\n{\n\tclosure_" ++
+		HookName ++ " = cb_" ++ HookName ++ ";\n}\n";
+
+cpp_definition(_, {{function, _}, _, _}) -> [].
+
+generate_cpp_args(ArgList) ->
+	"(" ++ string:join(
+		[ type_to_string(Type, c) ++ " " ++ Name
+			|| {Type, Name} <- ArgList ], ", ") ++ ")".
+
+generate_cpp_args_untyped(ArgList) ->
+	"(" ++ string:join([ Name || {_, Name} <- ArgList ], ", ") ++ ")".
+
+cpp_caml_callback(HookName, []) ->
+	"\t\treturn caml_callback(closure_" ++ HookName ++ ", Val_unit)";
+cpp_caml_callback(HookName, ArgList) ->
+	"\t\tvalue arglist = { " ++
+		string:join([ arg_to_value(Arg) || Arg <- ArgList ], ", ") ++
+		" };\n\t\treturn caml_callbackN(closure_" ++ HookName ++
+		", " ++ integer_to_list(length(ArgList)) ++ ", arglist)".
+
+arg_to_value({int, ArgName}) -> "Val_int(" ++ ArgName ++ ")";
+arg_to_value({bool, ArgName}) -> "Val_bool(" ++ ArgName ++ ")";
+arg_to_value({string, ArgName}) -> "Val_string(" ++ ArgName ++ ")";
+arg_to_value({_, ArgName}) -> "(value)" ++ ArgName.
+
+
+c_usage(Name, {constructor, ArgList}, ImplementedMethods, RestMethods) ->
+	ConstructorsImplemented =
+		lists:sum([ 1 || {constructor, _} <- ImplementedMethods ]),
+	ConstructorsRest =
+		lists:sum([ 1 || {constructor, _} <- RestMethods ]),
+	MethodName = case {ConstructorsImplemented, ConstructorsRest} of
+		{0, 0} -> string:to_lower(Name) ++ "_constructor";
+		{N, _} when N > 0 ->
+			string:to_lower(Name) ++ "_constructor_" ++
+				integer_to_list(N + 1);
+		{0, _N} -> string:to_lower(Name) ++ "_constructor_1"
+	end,
+	case length(ArgList) of
+		K when K =< 5 ->
+			"CAMLprim value " ++ MethodName ++ generate_c_args(ArgList) ++
+				"\n{\n" ++ c_caml_param(ArgList) ++ "\t" ++
+				Name ++ "ML *res = new " ++
+				Name ++ "ML" ++ generate_c_args_converted(ArgList) ++ ";\n" ++
+				"\tCAMLreturn((value)res);\n}\n";
+		K ->
+			"CAMLprim value " ++ MethodName ++ "_native" ++
+				generate_c_args(ArgList) ++ "\n{\n" ++ c_caml_param(ArgList) ++
+				"\t" ++ Name ++ "ML *res = new " ++ Name ++ "ML" ++
+				generate_c_args_converted(ArgList) ++ ";\n" ++
+				"\tCAMLreturn((value)res);\n}\n" ++
+				"CAMLprim value " ++ MethodName ++ "_bytecode" ++
+				"(value* argv, int argn)\n{\n\treturn " ++ MethodName ++
+				"_native(" ++
+				string:join([ "argv[" ++ integer_to_list(X) ++ "]"
+					|| X <- lists:seq(0, K - 1) ], ", ") ++ ");\n}\n"
+	end;
+
+c_usage(Name, {{hook, _Type}, HookName, _ArgList},
+		ImplementedMethods, RestMethods) ->
+	NumberImplemented =
+		lists:sum([ 1 ||
+			{{hook, _}, HookNameString, _} <- ImplementedMethods,
+			HookNameString == HookName ]),
+	NumberRest =
+		lists:sum([ 1 ||
+			{{hook, _}, HookNameString, _} <- RestMethods,
+			HookNameString == HookName ]),
+	MethodName = case {NumberImplemented, NumberRest} of
+		{0, 0} -> string:to_lower(Name) ++ "_set" ++ HookName;
+		{N, _} when N > 0 ->
+			string:to_lower(Name) ++ "_set" ++ HookName ++ "_" ++
+				integer_to_list(N + 1);
+		{0, _N} ->
+			string:to_lower(Name) ++ "_set" ++ HookName ++ "_1"
+	end,
+	"CAMLprim value " ++ MethodName ++ "(value v_self, value v_cb)\n" ++
+		"{\n\tCAMLparam2(v_self, v_cb);\n\t((" ++ Name ++ "ML*)v_self)" ++
+		"->set" ++ HookName ++ "(v_cb);\n\tCAMLreturn(Val_unit);\n}\n";
+
+c_usage(Name, {{function, Type}, FunctionName, ArgList},
+		ImplementedMethods, RestMethods) ->
+	NumberImplemented =
+		lists:sum([ 1 ||
+			{{function, _}, FunctionNameString, _} <- ImplementedMethods,
+			FunctionNameString == FunctionName ]),
+	NumberRest =
+		lists:sum([ 1 ||
+			{{function, _}, FunctionNameString, _} <- RestMethods,
+			FunctionNameString == FunctionName ]),
+	MethodName = case {NumberImplemented, NumberRest} of
+		{0, 0} -> string:to_lower(Name) ++ FunctionName;
+		{N, _} when N > 0 ->
+			string:to_lower(Name) ++ FunctionName ++ "_" ++
+				integer_to_list(N + 1);
+		{0, _N} ->
+			string:to_lower(Name) ++ FunctionName ++ "_1"
+	end,
+	case length(ArgList) of
+		K when K =< 4 ->
+			"CAMLprim value " ++ MethodName ++
+				generate_c_args([{Name, "self"}|ArgList]) ++
+				"\n{\n" ++ c_caml_param([{Name, "self"}|ArgList]) ++
+				caml_return(Type,
+					"((" ++ Name ++ "*)v_self)->" ++
+						FunctionName ++
+						generate_c_args_converted(ArgList) ++ ";") ++
+				"}\n";
+		K ->
+			"CAMLprim value " ++ MethodName ++ "_native" ++
+				generate_c_args([{Name, "self"}|ArgList]) ++
+				"\n{\n" ++ c_caml_param([{Name, "self"}|ArgList]) ++
+				caml_return(Type,
+					"((" ++ Name ++ "*)v_self)->" ++
+						FunctionName ++
+						generate_c_args_converted(ArgList) ++ ";") ++
+				"}\n" ++
+				"CAMLprim value " ++ MethodName ++ "_bytecode" ++
+				"(value* argv, int argn)\n{\n\treturn " ++ MethodName ++
+				"_native(" ++
+				string:join([ "argv[" ++ integer_to_list(X) ++ "]"
+					|| X <- lists:seq(0, K) ], ", ") ++ ");\n}\n"
+	end;
+c_usage(_, _, _, _) -> "".
+
+generate_c_args(ArgList) ->
+	"(" ++
+		string:join([ "value v_" ++ Name || {_, Name} <- ArgList], ", ") ++
+		")".
+
+generate_c_args_converted(ArgList) ->
+	"(" ++
+		string:join([
+			c_from_value(Type, "v_" ++ Name)
+			|| {Type, Name} <- ArgList ], ", ") ++ ")".
+
+
+c_caml_param([]) -> "CAMLparam0();\n";
+c_caml_param(ArgList) when length(ArgList) =< 5 ->
+	"\tCAMLparam" ++ integer_to_list(length(ArgList)) ++
+		"(" ++ string:join([ "v_" ++ Name || {_, Name} <- ArgList ], ", ") ++
+		");\n";
+c_caml_param(ArgList) ->
+	{Part1, Part2} = lists:split(5, ArgList),
+	"\tCAMLparam5(" ++
+		string:join([ "v_" ++ Name || {_, Name} <- Part1 ], ", ") ++
+		");\n" ++ c_caml_xparam(Part2).
+
+c_caml_xparam(ArgList) when length(ArgList) =<5 ->
+	"\tCAMLxparam" ++ integer_to_list(length(ArgList)) ++
+		"(" ++ string:join([ "v_" ++ Name || {_, Name} <- ArgList ], ", ") ++
+		");\n";
+c_caml_xparam(ArgList) ->
+	{Part1, Part2} = lists:split(5, ArgList),
+	"\tCAMLxparam5(" ++
+		string:join([ "v_" ++ Name || {_, Name} <- Part1 ], ", ") ++
+		");\n" ++ c_caml_xparam(Part2).
+
+
+type_to_string(void, c) -> "void";
+type_to_string(void, ocaml) -> "unit";
+type_to_string("void*", ocaml) -> "pointer";
+type_to_string(int, _) -> "int";
+type_to_string(float, _) -> "float";
+type_to_string(string, c) -> "const char *";
+type_to_string(string, ocaml) -> "string";
+type_to_string(bool, _) -> "bool";
+type_to_string(Type, ocaml) ->
+	string:strip(string:to_lower(Type), both, $*);
+type_to_string(Type, c) -> Type.
+
+c_from_value(int, Name) -> "Int_val(" ++ Name ++ ")";
+c_from_value(float, Name) -> "Double_val(" ++ Name ++ ")";
+c_from_value(string, Name) -> "String_val(" ++ Name ++ ")";
+c_from_value(bool, Name) -> "Bool_val(" ++ Name ++ ")";
+c_from_value("BPoint", Name) -> "*((BPoint*)" ++ Name ++ ")";
+c_from_value("BRect", Name) -> "*((BRect*)" ++ Name ++ ")";
+c_from_value(Type, Name) -> "(" ++ Type ++ ")" ++ Name.
+
+caml_return(void, InvokedMethodString) ->
+	"\t" ++ InvokedMethodString ++ "\n\tCAMLreturn(Val_unit);\n";
+caml_return(int, InvokedMethodString) ->
+	"\tint res = " ++ InvokedMethodString ++
+		"\n\tCAMLreturn(Val_int(res));\n";
+caml_return(float, InvokedMethodString) ->
+	"\tfloat res = " ++ InvokedMethodString ++
+		"\n\tCAMLreturn(Val_double(res));\n";
+caml_return(bool, InvokedMethodString) ->
+	"\tbool res = " ++ InvokedMethodString ++
+		"\n\tCAMLreturn(Val_bool(res));\n";
+caml_return(string, InvokedMethodString) ->
+	"\tconst char * res = " ++ InvokedMethodString ++
+		"\n\t\CAMLreturn(Val_string(res));\n";
+caml_return(Type, InvokedMethodString) ->
+	"\t" ++ Type ++ " res = " ++ InvokedMethodString ++
+		"\n\tCAMLreturn((value)res);\n".
+
+generate_ocaml(Name, List) ->
+	End = "module " ++ Name ++ " =\nstruct\n",
+	generate_ocaml(Name, [], End, [], List).
+
+generate_ocaml(_, Start, End, _, []) ->
+	Start ++ End ++ "end";
+
+generate_ocaml(Name, Start, End, Impl,
+		[{constructor, ArgList}|T]) ->
+	case
+			{[ X || {constructor, _} = X <- Impl ],
+			[ X || {constructor, _} = X <- T ]} of
+		{[], []} ->
+			Sig =
+				ml_signature(string:to_lower(Name) ++ "_constructor",
+					string:to_lower(Name), ArgList),
+			Usage = "\tlet " ++ string:to_lower(Name) ++ " " ++
+				string:join([ "~" ++ ArgName
+					|| {_, ArgName} <- ArgList ], " ") ++
+				" () =\n\t\t" ++
+				string:to_lower(Name) ++ "_constructor " ++
+				string:join([ ArgName || {_, ArgName} <- ArgList ], " ") ++
+				"\n",
+			generate_ocaml(Name, Start ++ Sig, End ++ Usage,
+				[{constructor, ArgList}|Impl], T);
+		{[], L} ->
+			{_, Sig} = lists:foldl(
+				fun({_, ArgL}, {N, Acc}) ->
+					{N + 1,
+						Acc ++ ml_signature(
+							string:to_lower(Name) ++ "_constructor_" ++
+								integer_to_list(N + 1),
+							string:to_lower(Name), ArgL)}
+				end, {0, []}, [{constructor, ArgList}|L]),
+			Usage = ml_usage(Name, "constructor",
+				[{constructor, ArgList}|L]),
+			generate_ocaml(Name, Start ++ Sig, End ++ Usage,
+				[{constructor, ArgList}|Impl], T);
+		_ ->
+			generate_ocaml(Name, Start, End,
+				[{constructor, ArgList}|Impl], T)
+	end;
+
+generate_ocaml(Name, Start, End, Impl,
+		[{{hook, HookType}, HookName, HookArgs}|T]) ->
+	case
+			{[ X || {{hook, XType}, XName, _} = X <- Impl,
+				XType == HookType, XName == HookName ],
+			[ X || {{hook, XType}, XName, _} = X <- T,
+				XType == HookType, XName == HookName ]} of
+		{[], []} ->
+			Sig =
+				ml_signature(string:to_lower(Name) ++ "_set" ++ HookName,
+					"unit", [{Name, "self"}, {"'a", any}]),
+			Usage = "\tlet set" ++ HookName ++
+				" ~self ~cb () =\n\t\t" ++
+				string:to_lower(Name) ++ "_set" ++ HookName ++
+				" self cb\n\n",
+			generate_ocaml(Name, Start ++ Sig, End ++ Usage,
+				[{{hook, HookType}, HookName, HookArgs}|Impl], T);
+		{[], L} ->
+			{_, Sig} = lists:foldl(
+				fun({{hook, _}, _, _}, {N, Acc}) ->
+					{N + 1,
+						Acc ++ ml_signature(
+							string:to_lower(Name) ++ "_set" ++ HookName ++
+								"_" ++ integer_to_list(N + 1),
+							"unit",
+							[{Name, "self"}, {"'a", any}])}
+				end, {0, []}, [{{hook, HookType}, HookName, HookArgs}|L]),
+			Usage = ml_usage(Name, "set" ++ HookName,
+				[{{hook, HookType}, HookName, HookArgs}|L]),
+			generate_ocaml(Name, Start ++ Sig, End ++ Usage,
+				[{{hook, HookType}, HookName, HookArgs}|Impl], T);
+		_ ->
+			generate_ocaml(Name, Start, End,
+				[{{hook, HookType}, HookName, HookArgs}|Impl], T)
+	end;
+
+generate_ocaml(Name, Start, End, Impl,
+		[{{function, FType}, FName, ArgList}|T]) ->
+	case
+			{[ X || {{function, XType}, XName, _} = X <- Impl,
+				XType == FType, XName == FName ],
+			[ X || {{function, XType}, XName, _} = X <- T,
+				XType == FType, XName == FName ]} of
+		{[], []} ->
+			Sig =
+				ml_signature(string:to_lower(Name) ++ "_" ++ FName,
+					string:to_lower(type_to_string(FType,ocaml)),
+					[{Name, "self"}|ArgList]),
+			Usage = "\tlet " ++ string:to_lower(Name) ++ "_" ++ FName
+				++ " " ++
+				string:join([ "~" ++ ArgName
+					|| {_, ArgName} <- [{Name, "self"}|ArgList] ], " ") ++
+				" () =\n\t\t" ++
+				string:to_lower(Name) ++ "_" ++ FName ++ " " ++
+				string:join([
+					ArgName
+					|| {_, ArgName} <- [{Name, "self"}|ArgList] ], " ") ++
+				"\n\n",
+			generate_ocaml(Name, Start ++ Sig, End ++ Usage,
+				[{{function, FType}, FName, ArgList}|Impl], T);
+		{[], L} ->
+			{_, Sig} = lists:foldl(
+				fun({{function, _}, _, ArgL}, {N, Acc}) ->
+					{N + 1,
+						Acc ++ ml_signature(
+							string:to_lower(Name) ++ "_" ++ FName ++ "_" ++
+								integer_to_list(N + 1),
+							string:to_lower(type_to_string(FType, ocaml)),
+							ArgL)}
+				end, {0, []}, [{{function, FType}, FName, ArgList}|L]),
+			Usage = ml_usage(Name, FName,
+				[{{function, FType}, FName, ArgList}|L]),
+			generate_ocaml(Name, Start ++ Sig, End ++ Usage,
+				[{{function, FType}, FName, ArgList}|Impl], T);
+		_ ->
+			generate_ocaml(Name, Start, End,
+				[{{function, FType}, FName, ArgList}|Impl], T)
+	end;
+
+
+generate_ocaml(Name, Start, End, Impl, [M|T]) ->
+	generate_ocaml(Name, Start, End, [M|Impl], T).
+
+ml_signature(MethodName, ReturnType, ArgList) ->
+	"external " ++ MethodName ++ " :\n" ++
+		"\t" ++
+		string:join([ type_to_string(ArgType, ocaml)
+			|| {ArgType, _} <- ArgList ], " -> ") ++
+		" -> " ++ ReturnType ++ " =\n\t" ++
+		if
+			length(ArgList) =< 5 ->
+				"\"" ++ MethodName ++ "\"\n";
+			true ->
+				"\"" ++ MethodName ++ "_native\"\n\t\"" ++
+				MethodName ++ "_bytecode\"\n"
+		end.
+
+ml_usage(ModuleName, MethodName, [{constructor, _}|_] = MethodList) ->
+	UniqueArgs = sets:to_list(sets:from_list(lists:flatten([
+			Args 
+			|| {constructor, Args} <- MethodList ]))),
+	LetMethod = "\tlet " ++ MethodName ++ " " ++
+		string:join([ "?" ++ ArgName || {_, ArgName} <- UniqueArgs ], " ") ++
+		" () =\n",
+	MatchArgs = "\t\tmatch " ++
+		string:join([ ArgName || {_, ArgName} <- UniqueArgs ], ", ") ++
+		" with\n",
+	{_, ClauseLines} = lists:foldl(
+		fun({constructor, Args}, {N, Acc}) ->
+			{N + 1, Acc ++ "\t\t| " ++ string:join([
+				case lists:member(SomeArg, Args) of
+					true -> "Some " ++ SomeArgName;
+					false -> "None"
+				end
+				|| {_, SomeArgName} = SomeArg <- UniqueArgs ], ", ") ++
+			" -> " ++ string:to_lower(ModuleName) ++ "_" ++
+			MethodName ++
+				if
+					length(MethodList) > 1 ->
+						"_" ++ integer_to_list(N + 1);
+					true -> ""
+				end ++ " " ++
+			string:join([ SomeArg || {_, SomeArg} <- Args ], " ") ++ "\n"}
+		end, {0, []}, MethodList),
+	WrongArgsRow = "\t\t| " ++
+		string:join([ "None" || _ <- UniqueArgs ], ", ") ++
+		" -> invalid_arg \"Wrong arg in " ++ ModuleName ++ "." ++
+		MethodName ++ "\"\n\n",
+	LetMethod ++ MatchArgs ++ ClauseLines ++ WrongArgsRow ++ "\n";
+
+ml_usage(ModuleName, MethodName,
+		[{{hook, _HookType}, _HookName, _}|_]) ->
+	"\tlet " ++ MethodName ++ " ~self ~cb () =\n" ++
+		"\t\t" ++ ModuleName ++ "_" ++ MethodName ++ " self cb\n\n";
+
+ml_usage(ModuleName, MethodName, [{{function, _}, _, _}|_] = MethodList) ->
+	UniqueArgs = sets:to_list(sets:from_list(lists:flatten([
+			Args 
+			|| {{function, _}, _, Args} <- MethodList ]))),
+	LetMethod = "\tlet " ++ MethodName ++ " " ++
+		string:join([ "?" ++ ArgName || {_, ArgName} <- UniqueArgs ], " ") ++
+		" () =\n",
+	MatchArgs = "\t\tmatch " ++
+		string:join([ ArgName || {_, ArgName} <- UniqueArgs ], ", ") ++
+		" with\n",
+	{_, ClauseLines} = lists:foldl(
+		fun({{function, _}, _, Args}, {N, Acc}) ->
+			{N + 1, Acc ++ "\t\t| " ++ string:join([
+				case lists:member(SomeArg, Args) of
+					true -> "Some " ++ SomeArgName;
+					false -> "None"
+				end
+				|| {_, SomeArgName} = SomeArg <- UniqueArgs ], ", ") ++
+			" -> " ++ string:to_lower(ModuleName) ++ "_" ++
+			MethodName ++
+				if
+					length(MethodList) > 1 ->
+						"_" ++ integer_to_list(N + 1);
+					true -> ""
+				end ++ " " ++
+			string:join([ SomeArg || {_, SomeArg} <- Args ], " ") ++ "\n"}
+		end, {0, []}, MethodList),
+	WrongArgsRow = "\t\t| " ++
+		string:join([ "None" || _ <- UniqueArgs ], ", ") ++
+		" -> invalid_arg \"Wrong arg in " ++ ModuleName ++ "." ++
+		MethodName ++ "\"\n\n",
+	LetMethod ++ MatchArgs ++ ClauseLines ++ WrongArgsRow ++ "\n";
+	
+ml_usage(_, _, _) -> "".

haikuml_getclass.erl

+-module(haikuml_getclass).
+-export([get_class/1]).
+-define(URLBASE, "http://haiku-os.org/legacy-docs/bebook/").
+-define(BANNED_STRINGS,
+	[
+		"GetRunningAppInfo(be_app-&gt", "Team(), theInfo)",
+		"status_t SetStreamHook(void (*hook)(void * cookie, void* inBuffer, size_t byteCount, BStreamingGameSound* object), void* cookie)",
+		"void Draw(BRectupdateRect)",
+		"void DoForEach(bool (*func)(BListItem*))",
+		"void DoForEach(bool (*func)(BListItem*), void* arg2)",
+		"void* SortItems(int (*compareFunc)( void* , void* ))",
+		"BListItem* EachItemUnder(BListItem* underItem, bool oneLevelOnly, BListItem* (*eachFunc) (BListItem*, void* ), void* data)",
+		"void FullListDoForEach(bool (*func)(BListItem*))",
+		"void FullListDoForEach(bool (*func)(BListItem*), void* ))",
+		"void FullListDoForEach(bool (*func)(BListItem*), void* ), void* )",
+		"void FullListSortItems(int (*compareFunc)( BListItem *, BListItem *))",
+		"void SortItemsUnder(BListItem* underItem, bool oneLevelOnly, int (*compareFunc)( BListItem *, BListItem *))",
+		"BTimeSource( char* name = NULL, void (*PlayBuffer) (void* , void* buffer, size_t size, media_raw_audio_format& format) = NULL, void (*Notifier) (void* , sound_player_notification what) = NULL, void* cookie = NULL)",
+		"BTimeSource( media_raw_audio_format* format, char* name = NULL, void (*PlayBuffer) (void* , void* buffer, size_t size, media_raw_audio_format& format) = NULL, void (*Notifier) (void* , sound_player_notification what) = NULL, void* cookie = NULL)",
+		"void SetNotifier(void (*Notifier)(void* , sound_player_notification what, ...)))",
+		"void DoForEach(bool (*func)(void * ))",
+		"void DoForEach(bool (*func)(void * ), void* arg2)",
+		"void* SortItems(int (*compareFunc)( void * , void * ))"
+		]).
+
+get_class(ClassName) ->
+	URL = ?URLBASE ++ ClassName ++ ".html",
+	{ok, HTML} = get_url_contents(URL),
+	Constructors = get_constructors(HTML),
+	Hooks = get_hooks(HTML),
+	Functions = get_functions(HTML),
+	Module = {{module, ClassName},
+		{methods, Constructors ++ Hooks ++ Functions}},
+	Module.
+
+get_constructors(HTML) ->
+	L = re:split(HTML, "(<code class=\"constru.*/code>)",
+			[{return, list}]) --
+		re:split(HTML, "<code class=\"constru.*/code>",
+			[{return, list}]),
+	R= [
+		re:replace(
+			re:replace(
+				re:replace(
+					re:replace(
+						re:replace(
+							re:replace(X, "</?code.*>", "",
+								[{return, list}, ungreedy, global]),
+							"</?span.*>", "",
+							[{return, list}, ungreedy, global]),
+						"</?a.*>", "",
+						[{return, list}, ungreedy, global]),
+					"virtual", "",
+					[{return, list}, ungreedy, global]),
+				"const", "",
+				[{return, list}, ungreedy, global]),
+			"\302\240", " ",
+			[{return, list}, ungreedy, global])
+		|| X <- L ],
+	E = [
+		re:replace(
+			re:replace(
+				re:replace(
+					re:replace(X, "<br.*>", "",
+						[{return, list}, ungreedy, global]),
+					"\\n", " ",
+					[{return, list}, ungreedy, global]),
+				"\\s+", " ",
+				[{return, list}, global]),
+			"<p>", "",
+			[{return, list}, global])
+		|| X <- R ],
+	M = lists:foldl(
+		fun(X, Acc) ->
+			Acc ++ [ string:strip(Y)
+			|| Y <- re:split(
+					re:replace(X, "\\&amp;", "\\&", [{return, list}]),
+					";", [{return, list}]),
+				Y =/= [] ]
+		end, [], E),
+	io:fwrite("~p~n", [E]),
+	[
+		begin	
+			io:fwrite("~p~n", [X]),
+			[_, ArgString] = string:tokens(X, "("),
+			Args = string:tokens(
+				string:strip(ArgString, both, $)),
+				","),
+			ArgTuples = [
+				begin
+					[YType, YName|_] = string:tokens(Y, " "),
+					{string_to_type(YType), YName}
+				end
+				|| Y <- Args ],
+			{constructor, ArgTuples}
+		end
+	|| X <- M,
+		not lists:member(X, ?BANNED_STRINGS),
+		[lists:nth(1, lists:reverse(X))] == ")",
+		[lists:nth(1, X)] /= "<",
+		length(string:tokens(
+			lists:nth(1, string:tokens(X, "(")),
+			" ")) == 1 ].
+
+get_hooks(HTML) ->
+	case re:split(HTML, "</a>Hook Functions</h3>",
+			[ungreedy, {return, list}]) of
+		[_, P] ->
+			HookL = hd(re:split(P, "/h3", [ungreedy, {return, list}])),
+			L = re:split(HookL, "(<code class=\"methodsyn.*/code>)",
+					[{return, list}]) --
+				re:split(HookL, "<code class=\"methodsyn.*/code>",
+					[{return, list}]),
+			R= [
+				re:replace(
+					re:replace(
+						re:replace(
+							re:replace(
+								re:replace(
+									re:replace(X, "</?code.*>", "",
+										[{return, list}, ungreedy, global]),
+									"</?span.*>", "",
+									[{return, list}, ungreedy, global]),
+								"</?a.*>", "",
+								[{return, list}, ungreedy, global]),
+							"virtual", "",
+							[{return, list}, ungreedy, global]),
+						"const", "",
+						[{return, list}, ungreedy, global]),
+					"\302\240", " ",
+					[{return, list}, ungreedy, global])
+				|| X <- L ],
+			E = [
+				re:replace(
+					re:replace(
+						re:replace(
+							re:replace(X, "<br.*>", "",
+								[{return, list}, ungreedy, global]),
+							"\\n", " ",
+							[{return, list}, ungreedy, global]),
+						"\\s+", " ",
+						[{return, list}, global]),
+					"<p>", "",
+					[{return, list}, global])
+				|| X <- R ],
+			M = lists:foldl(
+				fun(X, Acc) ->
+					Acc ++ [ string:strip(Y)
+					|| Y <- re:split(X, ";", [{return, list}]),
+						Y =/= [] ]
+				end, [], E),
+			[
+				begin	
+					io:fwrite("~p~n", [X]),
+					[TypeAndName, ArgString] = string:tokens(X, "("),
+					[TypeString, NameString] =
+						string:tokens(TypeAndName, " "),
+					Args = string:tokens(
+						string:strip(ArgString, both, $)),
+						","),
+					ArgTuples = [
+						begin
+							[YType, YName|_] = string:tokens(Y, " "),
+							{string_to_type(YType), YName}
+						end
+						|| Y <- Args ],
+					{{hook, string_to_type(TypeString)}, NameString, ArgTuples}
+				end
+			|| X <- M, not lists:member(X, ?BANNED_STRINGS),
+				[lists:nth(1, lists:reverse(X))] == ")",
+				[lists:nth(1, X)] /= "<",
+				length(string:tokens(
+					lists:nth(1, string:tokens(X, "(")),
+					" ")) == 2 ];
+		_ -> []
+	end.
+
+get_functions(HTML) ->
+	case re:split(HTML, "</a>Member Functions</h3>",
+			[ungreedy, {return, list}]) of
+		[_, P] ->
+			FunL = hd(re:split(P, "/h3", [ungreedy, {return, list}])),
+			L = re:split(FunL, "(<code class=\"methodsyn.*/code>)",
+					[{return, list}]) --
+				re:split(FunL, "<code class=\"methodsyn.*/code>",
+					[{return, list}]),
+			R= [
+				re:replace(
+					re:replace(
+						re:replace(
+							re:replace(
+								re:replace(
+									re:replace(X, "</?code.*>", "",
+										[{return, list}, ungreedy, global]),
+									"</?span.*>", "",
+									[{return, list}, ungreedy, global]),
+								"</?a.*>", "",
+								[{return, list}, ungreedy, global]),
+							"virtual", "",
+							[{return, list}, ungreedy, global]),
+						"const", "",
+						[{return, list}, ungreedy, global]),
+					"\302\240", " ",
+					[{return, list}, ungreedy, global])
+				|| X <- L ],
+			E = [
+				re:replace(
+					re:replace(
+						re:replace(
+							re:replace(X, "<br.*>", "",
+								[{return, list}, ungreedy, global]),
+							"\\n", " ",
+							[{return, list}, ungreedy, global]),
+						"\\s+", " ",
+						[{return, list}, global]),
+					"<p>", "",
+					[{return, list}, global])
+				|| X <- R ],
+			M = lists:foldl(
+				fun(X, Acc) ->
+					Acc ++ [ string:strip(Y)
+					|| Y <- re:split(X, ";", [{return, list}]),
+						Y =/= [] ]
+				end, [], E),
+			[
+				begin
+					io:fwrite("~p~n", [X]),
+					[TypeAndName, ArgString] = string:tokens(X, "("),
+					[TypeString, NameString] =
+						string:tokens(TypeAndName, " "),
+					Args = string:tokens(
+						string:strip(ArgString, both, $)),
+						","),
+					ArgTuples = [
+						begin
+							[YType, YName|_] = string:tokens(Y, " "),
+							{string_to_type(YType), YName}
+						end
+						|| Y <- Args ],
+					{{function, string_to_type(TypeString)},
+						NameString, ArgTuples}
+				end
+			|| X <- M, not lists:member(X, ?BANNED_STRINGS),
+				[lists:nth(1, lists:reverse(X))] == ")",
+				[lists:nth(1, X)] /= "<",
+				length(string:tokens(
+					lists:nth(1, string:tokens(X, "(")),
+					" ")) == 2 ];
+		_ -> []
+	end.
+
+
+string_to_type("void") -> void;
+string_to_type("float") -> float;
+string_to_type("uint32") -> int;
+string_to_type("int32") -> int;
+string_to_type("int") -> int;
+string_to_type("char*") -> string;
+string_to_type("bool") -> bool;
+string_to_type(Type) -> Type.
+
+
+get_url_contents(Url) ->
+	inets:start(),
+	get_url_contents(Url, 5).
+
+get_url_contents(_Url, 0) -> failed;
+get_url_contents(Url, MaxFailures) ->
+  case http:request(Url) of
+      {ok, {{_, RetCode, _}, _, Result}} -> if
+	  	RetCode == 200;RetCode == 201 ->
+			{ok, Result};
+		RetCode >= 500 ->
+			% server error, retry 
+			%io:format("HTTP code ~p~n", [RetCode]),
+			timer:sleep(1000),
+			get_url_contents(Url, MaxFailures-1);
+		true ->
+			% all other errors
+			failed
+		end;
+	{error, _Why} ->
+		%io:format("failed request: ~s : ~w~n", [Url, Why]), 
+		timer:sleep(1000),
+		get_url_contents(Url, MaxFailures-1)
+	end.