Magnus Klaar
преди 13 години
променени са 3 файла, в които са добавени 527 реда и са изтрити 396 реда
-
+42 -362src/glc.erl
-
+367 -0src/glc_code.erl
-
+118 -34src/glc_lib.erl
+ 42
- 362
src/glc.erl
Целия файл
+ 367
- 0
src/glc_code.erl
Целия файл
| @ -0,0 +1,367 @@ | |||
| %% @doc Code generation functions. | |||
| -module(glc_code). | |||
| -export([ | |||
| compile/2 | |||
| ]). | |||
| -record(module, { | |||
| 'query' :: term(), | |||
| tables :: [{atom(), ets:tid()}], | |||
| qtree :: term() | |||
| }). | |||
| -type syntaxTree() :: erl_syntax:syntaxTree(). | |||
| -record(state, { | |||
| event = undefined :: syntaxTree(), | |||
| fields = [] :: [{atom(), syntaxTree()}], | |||
| fieldc = 0 :: non_neg_integer(), | |||
| paramvars = [] :: [{term(), syntaxTree()}], | |||
| paramstab = undefined :: ets:tid() | |||
| }). | |||
| -type nextFun() :: fun((#state{}) -> [syntaxTree()]). | |||
| compile(Module, ModuleData) -> | |||
| {ok, forms, Forms} = abstract_module(Module, ModuleData), | |||
| {ok, Module, Binary} = compile_forms(Forms, []), | |||
| {ok, loaded, Module} = load_binary(Module, Binary), | |||
| {ok, Module}. | |||
| %% abstract code geneation functions | |||
| %% @private Generate an abstract dispatch module. | |||
| -spec abstract_module(atom(), #module{}) -> {ok, forms, list()}. | |||
| abstract_module(Module, Data) -> | |||
| Forms = [erl_syntax:revert(E) || E <- abstract_module_(Module, Data)], | |||
| case lists:keyfind(errors, 1, erl_syntax_lib:analyze_forms(Forms)) of | |||
| false -> {ok, forms, Forms}; | |||
| {_, []} -> {ok, forms, Forms}; | |||
| {_, [_|_]}=Errors -> Errors | |||
| end. | |||
| %% @private Generate an abstract dispatch module. | |||
| -spec abstract_module_(atom(), #module{}) -> [erl_syntax:syntaxTree()]. | |||
| abstract_module_(Module, #module{tables=Tables, qtree=Tree}=Data) -> | |||
| {_, ParamsTable} = lists:keyfind(params, 1, Tables), | |||
| AbstractMod = [ | |||
| %% -module(Module) | |||
| erl_syntax:attribute(erl_syntax:atom(module), [erl_syntax:atom(Module)]), | |||
| %% -export([ | |||
| erl_syntax:attribute( | |||
| erl_syntax:atom(export), | |||
| [erl_syntax:list([ | |||
| %% info/1 | |||
| erl_syntax:arity_qualifier( | |||
| erl_syntax:atom(info), | |||
| erl_syntax:integer(1)), | |||
| %% table/1 | |||
| erl_syntax:arity_qualifier( | |||
| erl_syntax:atom(table), | |||
| erl_syntax:integer(1)), | |||
| %% handle/1 | |||
| erl_syntax:arity_qualifier( | |||
| erl_syntax:atom(handle), | |||
| erl_syntax:integer(1))])]), | |||
| %% ]). | |||
| %% info(Name) -> Term. | |||
| erl_syntax:function( | |||
| erl_syntax:atom(info), | |||
| abstract_info(Data) ++ | |||
| [erl_syntax:clause( | |||
| [erl_syntax:underscore()], none, | |||
| [abstract_apply(erlang, error, [erl_syntax:atom(badarg)])])]), | |||
| %% table(Name) -> ets:tid(). | |||
| erl_syntax:function( | |||
| erl_syntax:atom(table), | |||
| abstract_tables(Tables) ++ | |||
| [erl_syntax:clause( | |||
| [erl_syntax:underscore()], none, | |||
| [abstract_apply(erlang, error, [erl_syntax:atom(badarg)])])]), | |||
| %% handle(Event) - entry function | |||
| erl_syntax:function( | |||
| erl_syntax:atom(handle), | |||
| [erl_syntax:clause([erl_syntax:variable("Event")], none, | |||
| [abstract_count(input), | |||
| erl_syntax:application(none, | |||
| erl_syntax:atom(handle_), [erl_syntax:variable("Event")])])]), | |||
| %% input_(Node, App, Pid, Tags, Values) - filter roots | |||
| erl_syntax:function( | |||
| erl_syntax:atom(handle_), | |||
| [erl_syntax:clause([erl_syntax:variable("Event")], none, | |||
| abstract_filter(Tree, #state{ | |||
| event=erl_syntax:variable("Event"), | |||
| paramstab=ParamsTable}))]) | |||
| ], | |||
| %% Transform Term -> Key to Key -> Term | |||
| ParamsList = [{K, V} || {V, K} <- ets:tab2list(ParamsTable)], | |||
| ets:delete_all_objects(ParamsTable), | |||
| ets:insert(ParamsTable, ParamsList), | |||
| AbstractMod. | |||
| %% @private Return the clauses of the table/1 function. | |||
| abstract_tables(Tables) -> | |||
| [erl_syntax:clause( | |||
| [erl_syntax:abstract(K)], none, | |||
| [erl_syntax:abstract(V)]) | |||
| || {K, V} <- Tables]. | |||
| %% @private Return the clauses of the info/1 function. | |||
| abstract_info(#module{'query'=Query}) -> | |||
| [erl_syntax:clause([erl_syntax:abstract(K)], none, V) | |||
| || {K, V} <- [ | |||
| {'query', abstract_query(Query)}, | |||
| {input, abstract_getcount(input)}, | |||
| {filter, abstract_getcount(filter)}, | |||
| {output, abstract_getcount(output)} | |||
| ]]. | |||
| %% @private Return the original query as an expression. | |||
| abstract_query({with, _, _}) -> | |||
| [erl_syntax:abstract([])]; | |||
| abstract_query(Query) -> | |||
| [erl_syntax:abstract(Query)]. | |||
| %% @private Return a list of expressions to apply a filter. | |||
| %% @todo Allow mulitple functions to be specified using `with/2'. | |||
| -spec abstract_filter(glc_ops:op(), #state{}) -> [syntaxTree()]. | |||
| abstract_filter({with, Cond, Fun}, State) -> | |||
| abstract_filter_(Cond, | |||
| _OnMatch=fun(State2) -> | |||
| [abstract_count(output)] ++ abstract_with(Fun, State2) end, | |||
| _OnNomatch=fun(_State2) -> [abstract_count(filter)] end, State); | |||
| abstract_filter(Cond, State) -> | |||
| abstract_filter_(Cond, | |||
| _OnMatch=fun(_State2) -> [abstract_count(output)] end, | |||
| _OnNomatch=fun(_State2) -> [abstract_count(filter)] end, State). | |||
| %% @private Return a list of expressions to apply a filter. | |||
| %% A filter expects two continuation functions which generates the expressions | |||
| %% to apply when the filter matches or fails to match. The state passed to the | |||
| %% functions will be contain all variable bindings to previously accessed | |||
| %% fields and parameters. | |||
| -spec abstract_filter_(glc_ops:op(), nextFun(), nextFun(), #state{}) -> | |||
| syntaxTree(). | |||
| abstract_filter_({null, true}, OnMatch, _OnNomatch, State) -> | |||
| OnMatch(State); | |||
| abstract_filter_({null, false}, _OnMatch, OnNomatch, State) -> | |||
| OnNomatch(State); | |||
| abstract_filter_({Key, Op, Value}, OnMatch, OnNomatch, State) | |||
| when Op =:= '>'; Op =:= '='; Op =:= '<' -> | |||
| Op2 = case Op of '=' -> '=:='; Op -> Op end, | |||
| abstract_opfilter(Key, Op2, Value, OnMatch, OnNomatch, State); | |||
| abstract_filter_({'any', Conds}, OnMatch, OnNomatch, State) -> | |||
| abstract_any(Conds, OnMatch, OnNomatch, State); | |||
| abstract_filter_({'all', Conds}, OnMatch, OnNomatch, State) -> | |||
| abstract_all(Conds, OnMatch, OnNomatch, State). | |||
| %% @private Return a branch based on a built in operator. | |||
| -spec abstract_opfilter(atom(), atom(), term(), nextFun(), | |||
| nextFun(), #state{}) -> [syntaxTree()]. | |||
| abstract_opfilter(Key, Opname, Value, OnMatch, OnNomatch, State) -> | |||
| abstract_getkey(Key, | |||
| _OnMatch=fun(#state{}=State2) -> | |||
| [erl_syntax:case_expr( | |||
| erl_syntax:application( | |||
| erl_syntax:atom(erlang), erl_syntax:atom(Opname), [ | |||
| erl_syntax:variable(field_variable(Key)), | |||
| erl_syntax:abstract(Value) | |||
| ]), | |||
| [erl_syntax:clause([erl_syntax:atom(true)], none, | |||
| OnMatch(State2)), | |||
| erl_syntax:clause([erl_syntax:atom(false)], none, | |||
| OnNomatch(State2))])] end, | |||
| _OnNomatch=fun(State2) -> OnNomatch(State2) end, State). | |||
| %% @private Generate an `all' filter. | |||
| %% An `all' filter is evaluated by testing all conditions that must hold. If | |||
| %% any of the conditions does not hold the evaluation is short circuted at that | |||
| %% point. This means that the `OnNomatch' branch is executed once for each | |||
| %% condition. The `OnMatch' branch is only executed once. | |||
| -spec abstract_all([glc_ops:op()], nextFun(), nextFun(), #state{}) -> | |||
| [syntaxTree()]. | |||
| abstract_all([H|T], OnMatch, OnNomatch, State) -> | |||
| abstract_filter_(H, | |||
| _OnMatch=fun(State2) -> abstract_all(T, OnMatch, OnNomatch, State2) | |||
| end, OnNomatch, State); | |||
| abstract_all([], OnMatch, _OnNomatch, State) -> | |||
| OnMatch(State). | |||
| %% @private | |||
| -spec abstract_any([glc_ops:op()], nextFun(), nextFun(), #state{}) -> | |||
| [syntaxTree()]. | |||
| abstract_any([H|T], OnMatch, OnNomatch, State) -> | |||
| abstract_filter_(H, OnMatch, | |||
| _OnNomatch=fun(State2) -> abstract_any(T, OnMatch, OnNomatch, State2) | |||
| end, State); | |||
| abstract_any([], _OnMatch, OnNomatch, State) -> | |||
| OnNomatch(State). | |||
| %% @private | |||
| -spec abstract_with(fun((gre:event()) -> term()), #state{}) -> [syntaxTree()]. | |||
| abstract_with(Fun, State) when is_function(Fun, 1) -> | |||
| abstract_getparam(Fun, fun(#state{event=Event, paramvars=Params}) -> | |||
| {_, Fun2} = lists:keyfind(Fun, 1, Params), | |||
| [erl_syntax:application(none, Fun2, [Event])] | |||
| end, State). | |||
| %% @private Bind the value of a field to a variable. | |||
| %% If the value of a field has already been bound to a variable the previous | |||
| %% binding is reused over re-accessing the value. The `OnMatch' function is | |||
| %% expected to access the variable stored in the state record. The `OnNomatch' | |||
| %% function must not attempt to access the variable. | |||
| -spec abstract_getkey(atom(), nextFun(), nextFun(), #state{}) -> | |||
| [syntaxTree()]. | |||
| abstract_getkey(Key, OnMatch, OnNomatch, #state{fields=Fields}=State) -> | |||
| case lists:keyfind(Key, 1, Fields) of | |||
| {Key, _Variable} -> OnMatch(State); | |||
| false -> abstract_getkey_(Key, OnMatch, OnNomatch, State) | |||
| end. | |||
| -spec abstract_getkey_(atom(), nextFun(), nextFun(), #state{}) -> | |||
| [syntaxTree()]. | |||
| abstract_getkey_(Key, OnMatch, OnNomatch, #state{ | |||
| event=Event, fields=Fields}=State) -> | |||
| [erl_syntax:case_expr( | |||
| abstract_apply(gre, find, [erl_syntax:atom(Key), Event]), | |||
| [erl_syntax:clause([ | |||
| erl_syntax:tuple([ | |||
| erl_syntax:atom(true), | |||
| erl_syntax:variable(field_variable(Key))])], none, | |||
| OnMatch(State#state{ | |||
| fields=[{Key, erl_syntax:variable(field_variable(Key))} | |||
| |Fields]})), | |||
| erl_syntax:clause([ | |||
| erl_syntax:atom(false)], none, | |||
| OnNomatch(State)) | |||
| ] | |||
| )]. | |||
| %% @private Bind the value of a parameter to a variable. | |||
| %% During code generation the parameter value is used as the identity of the | |||
| %% parameter. At runtime a unique integer is used as the identity. | |||
| -spec abstract_getparam(term(), nextFun(), #state{}) -> [syntaxTree()]. | |||
| abstract_getparam(Term, OnBound, #state{paramvars=Params}=State) -> | |||
| case lists:keyfind(Term, 1, Params) of | |||
| {_, _Variable} -> OnBound(State); | |||
| %% parameter not bound to variable in this scope. | |||
| false -> abstract_getparam_(Term, OnBound, State) | |||
| end. | |||
| -spec abstract_getparam_(term(), nextFun(), #state{}) -> [syntaxTree()]. | |||
| abstract_getparam_(Term, OnBound, #state{paramstab=Table, | |||
| paramvars=Params}=State) -> | |||
| Key = case ets:lookup(Table, Term) of | |||
| [{_, Key2}] -> | |||
| Key2; | |||
| [] -> | |||
| Key2 = ets:info(Table, size), | |||
| ets:insert(Table, {Term, Key2}), | |||
| Key2 | |||
| end, | |||
| [erl_syntax:match_expr( | |||
| param_variable(Key), | |||
| abstract_apply(ets, lookup_element, | |||
| [abstract_apply(table, [erl_syntax:atom(params)]), | |||
| erl_syntax:abstract(Key), | |||
| erl_syntax:abstract(2)])) | |||
| ] ++ OnBound(State#state{paramvars=[{Term, param_variable(Key)}|Params]}). | |||
| %% @private Generate a variable name for the value of a field. | |||
| -spec field_variable(atom()) -> string(). | |||
| field_variable(Key) -> | |||
| "Field_" ++ field_variable_(atom_to_list(Key)). | |||
| %% @private Escape non-alphanumeric values. | |||
| -spec field_variable_(string()) -> string(). | |||
| field_variable_([H|T]) when H >= $0, H =< $9 -> | |||
| [H|field_variable_(T)]; | |||
| field_variable_([H|T]) when H >= $A, H =< $Z -> | |||
| [H|field_variable_(T)]; | |||
| field_variable_([H|T]) when H >= $a, H =< $z -> | |||
| [H|field_variable_(T)]; | |||
| field_variable_([H|T]) -> | |||
| "_" ++ integer_to_list(H, 16) ++ "_" ++ field_variable_(T); | |||
| field_variable_([]) -> | |||
| []. | |||
| %% @private Generate a variable name for the value of a parameter. | |||
| -spec param_variable(integer()) -> syntaxTree(). | |||
| param_variable(Key) -> | |||
| erl_syntax:variable("Param_" ++ integer_to_list(Key)). | |||
| %% @private Generate a list of field variable names. | |||
| %% Walk the query tree and generate a safe variable name string for each field | |||
| %% that is accessed by the conditions in the query. Only allow alpha-numeric. | |||
| %%-spec field_variables(glc_ops:op()) -> [{atom(), string()}]. | |||
| %%field_variables(Query) -> | |||
| %% lists:usort(field_variables_(Query)). | |||
| %%-spec field_variables(glc_ops:op()) -> [{atom(), string()}]. | |||
| %%field_variables_({Key, '=', _Term}) -> | |||
| %% [{Key, field_variable(Key)}]. | |||
| %% @private Return an expression to increment a counter. | |||
| %% @todo Pass state record. Only Generate code if `statistics' is enabled. | |||
| -spec abstract_count(atom()) -> syntaxTree(). | |||
| abstract_count(Counter) -> | |||
| abstract_apply(ets, update_counter, | |||
| [abstract_apply(table, [erl_syntax:atom(counters)]), | |||
| erl_syntax:abstract(Counter), | |||
| erl_syntax:abstract({2,1})]). | |||
| %% @private Return an expression to get the value of a counter. | |||
| %% @todo Pass state record. Only Generate code if `statistics' is enabled. | |||
| -spec abstract_getcount(atom()) -> [syntaxTree()]. | |||
| abstract_getcount(Counter) -> | |||
| [abstract_apply(ets, lookup_element, | |||
| [abstract_apply(table, [erl_syntax:atom(counters)]), | |||
| erl_syntax:abstract(Counter), | |||
| erl_syntax:abstract(2)])]. | |||
| %% abstract code util functions | |||
| %% @private Compile an abstract module. | |||
| -spec compile_forms(term(), [term()]) -> {ok, atom(), binary()}. | |||
| compile_forms(Forms, _Opts) -> | |||
| case compile:forms(Forms) of | |||
| {ok, Module, Binary} -> | |||
| {ok, Module, Binary}; | |||
| {ok, Module, Binary, _Warnings} -> | |||
| {ok, Module, Binary}; | |||
| Error -> | |||
| erlang:error({compile_forms, Error}) | |||
| end. | |||
| %% @private Load a module binary. | |||
| -spec load_binary(atom(), binary()) -> {ok, loaded, atom()}. | |||
| load_binary(Module, Binary) -> | |||
| case code:load_binary(Module, "", Binary) of | |||
| {module, Module} -> {ok, loaded, Module}; | |||
| {error, Reason} -> exit({error_loading_module, Module, Reason}) | |||
| end. | |||
| %% @private Apply an exported function. | |||
| -spec abstract_apply(atom(), atom(), [syntaxTree()]) -> syntaxTree(). | |||
| abstract_apply(Module, Function, Arguments) -> | |||
| erl_syntax:application( | |||
| erl_syntax:atom(Module), | |||
| erl_syntax:atom(Function), | |||
| Arguments). | |||
| %% @private Apply a module local function. | |||
| -spec abstract_apply(atom(), [syntaxTree()]) -> syntaxTree(). | |||
| abstract_apply(Function, Arguments) -> | |||
| erl_syntax:application( | |||
| erl_syntax:atom(Function), | |||
| Arguments). | |||