You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@couchdb.apache.org by be...@apache.org on 2014/02/13 17:35:41 UTC
[08/23] goldrush commit: updated refs/heads/import-master to 71e6321
Factor out code generation functions
Project: http://git-wip-us.apache.org/repos/asf/couchdb-goldrush/repo
Commit: http://git-wip-us.apache.org/repos/asf/couchdb-goldrush/commit/1bbdb93e
Tree: http://git-wip-us.apache.org/repos/asf/couchdb-goldrush/tree/1bbdb93e
Diff: http://git-wip-us.apache.org/repos/asf/couchdb-goldrush/diff/1bbdb93e
Branch: refs/heads/import-master
Commit: 1bbdb93e5d22ef2f811a14d1e7697ccd4d977036
Parents: b232963
Author: Magnus Klaar <kl...@ninenines.fr>
Authored: Tue May 1 21:35:16 2012 +0200
Committer: Magnus Klaar <kl...@ninenines.fr>
Committed: Tue May 1 21:35:16 2012 +0200
----------------------------------------------------------------------
src/glc.erl | 404 ++++++--------------------------------------------
src/glc_code.erl | 367 +++++++++++++++++++++++++++++++++++++++++++++
src/glc_lib.erl | 152 ++++++++++++++-----
3 files changed, 527 insertions(+), 396 deletions(-)
----------------------------------------------------------------------
http://git-wip-us.apache.org/repos/asf/couchdb-goldrush/blob/1bbdb93e/src/glc.erl
----------------------------------------------------------------------
diff --git a/src/glc.erl b/src/glc.erl
index a444e7b..269adea 100644
--- a/src/glc.erl
+++ b/src/glc.erl
@@ -88,27 +88,17 @@
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()]).
--type q() :: tuple().
-
--spec lt(atom(), term()) -> q().
-lt(Key, Term) when is_atom(Key) -> {Key, '<', Term}.
+-spec lt(atom(), term()) -> glc_ops:op().
+lt(Key, Term) ->
+ glc_ops:lt(Key, Term).
--spec eq(atom(), term()) -> q().
-eq(Key, Term) when is_atom(Key) -> {Key, '=', Term}.
+-spec eq(atom(), term()) -> glc_ops:op().
+eq(Key, Term) ->
+ glc_ops:eq(Key, Term).
--spec gt(atom(), term()) -> q().
-gt(Key, Term) when is_atom(Key) -> {Key, '>', Term}.
+-spec gt(atom(), term()) -> glc_ops:op().
+gt(Key, Term) ->
+ glc_ops:gt(Key, Term).
%% @doc Filter the input using multiple filters.
@@ -117,11 +107,10 @@ gt(Key, Term) when is_atom(Key) -> {Key, '>', Term}.
%% in the list must hold for the input event. The list is expected to
%% be a non-empty list. If the list of filters is an empty list a `badarg'
%% error will be thrown.
--spec all([q()]) -> q().
-all([_|_]=Conds) ->
- {all, Conds};
-all(Other) ->
- erlang:error(badarg, [Other]).
+-spec all([glc_ops:op()]) -> glc_ops:op().
+all(Filters) ->
+ glc_ops:all(Filters).
+
%% @doc Filter the input using one of multiple filters.
%%
@@ -129,31 +118,40 @@ all(Other) ->
%% in the list must hold for the input event. The list is expected to be
%% a non-empty list. If the list of filters is an empty list a `badarg'
%% error will be thrown.
--spec any([q()]) -> q().
-any([_|_]=Conds) ->
- {any, Conds};
-any(Other) ->
- erlang:error(badarg, [Other]).
+-spec any([glc_ops:op()]) -> glc_ops:op().
+any(Filters) ->
+ glc_ops:any(Filters).
%% @doc Always return `true' or `false'.
--spec null(boolean()) -> q().
-null(Result) when is_boolean(Result) ->
- {null, Result}.
+-spec null(boolean()) -> glc_ops:op().
+null(Result) ->
+ glc_ops:null(Result).
+
%% @doc Apply a function to each output of a query.
%%
%% Updating the output action of a query finalizes it. Attempting
%% to use a finalized query to construct a new query will result
%% in a `badarg' error.
--spec with(q(), fun((gre:event()) -> term())) -> q().
-with(Query, Fun) when is_function(Fun, 1) ->
- {with, Query, Fun}.
+-spec with(glc_ops:op(), fun((gre:event()) -> term())) -> glc_ops:op().
+with(Query, Action) ->
+ glc_ops:with(Query, Action).
+
%% @doc Return a union of multiple queries.
--spec union([q()]) -> q().
+%%
+%% The union of multiple queries is the equivalent of executing multiple
+%% queries separately on the same input event. The advantage is that filter
+%% conditions that are common to all or some of the queries only need to
+%% be tested once.
+%%
+%% All queries are expected to be valid and have an output action other
+%% than the default which is `output'. If these expectations don't hold
+%% a `badarg' error will be thrown.
+-spec union([glc_ops:op()]) -> glc_ops:op().
union(Queries) ->
- {union, Queries}.
+ glc_ops:union(Queries).
%% @doc Compile a query to a module.
@@ -164,10 +162,10 @@ union(Queries) ->
-spec compile(atom(), list()) -> {ok, atom()}.
compile(Module, Query) ->
{ok, ModuleData} = module_data(Query),
- {ok, forms, Forms} = abstract_module(Module, ModuleData),
- {ok, Module, Binary} = compile_forms(Forms, []),
- {ok, loaded, Module} = load_binary(Module, Binary),
- {ok, Module}.
+ case glc_code:compile(Module, ModuleData) of
+ {ok, Module} ->
+ {ok, Module}
+ end.
%% @doc Handle an event using a compiled query.
%%
@@ -206,6 +204,7 @@ module_data(Query) ->
{ok, #module{'query'=Query, tables=Tables, qtree=Query2}}.
+%% @todo Move comment.
%% @private Map a query to a simplified query tree term.
%%
%% The simplified query tree is used to combine multiple queries into one
@@ -228,324 +227,6 @@ module_data(Query) ->
%%
%% If an event must be selected based on the runtime state of an event handler
%% this must be done in the body of the handler.
--type qcond() ::
- {atom(), '<', term()} |
- {atom(), '=', term()} |
- {atom(), '>', term()} |
- {any, [qcond()]} |
- {all, [qcond()]}.
-
-
-%% 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(q(), #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_(qcond(), 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{fields=Fields}=State2) ->
- {_, Field} = lists:keyfind(Key, 1, Fields),
- [erl_syntax:case_expr(
- erl_syntax:application(
- erl_syntax:atom(erlang), erl_syntax:atom(Opname),
- [Field, 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([qcond()], 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([qcond()], 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),
- field_variable(Key)])], none,
- OnMatch(State#state{
- fields=[{Key, 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.
-%% @todo Encode non-alphanumeric characters as integer values.
--spec field_variable(atom()) -> syntaxTree().
-field_variable(Key) ->
- erl_syntax:variable("Field_" ++ atom_to_list(Key)).
-
-%% @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 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).
-ifdef(TEST).
@@ -671,9 +352,8 @@ with_function_test() ->
?assertEqual(1, receive Msg -> Msg after 0 -> notcalled end),
done.
-union_single_test() ->
- {compiled, _Mod} = setup_query(testmod13,
- glc:union([glc:eq(a, 1)])),
+union_error_test() ->
+ ?assertError(badarg, glc:union([glc:eq(a, 1)])),
done.
-endif.
http://git-wip-us.apache.org/repos/asf/couchdb-goldrush/blob/1bbdb93e/src/glc_code.erl
----------------------------------------------------------------------
diff --git a/src/glc_code.erl b/src/glc_code.erl
new file mode 100644
index 0000000..ded9d33
--- /dev/null
+++ b/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).
http://git-wip-us.apache.org/repos/asf/couchdb-goldrush/blob/1bbdb93e/src/glc_lib.erl
----------------------------------------------------------------------
diff --git a/src/glc_lib.erl b/src/glc_lib.erl
index 97b7786..014054b 100644
--- a/src/glc_lib.erl
+++ b/src/glc_lib.erl
@@ -16,9 +16,20 @@
-module(glc_lib).
-export([
- reduce/1
+ reduce/1,
+ matches/2,
+ onoutput/1,
+ onoutput/2
]).
+-ifdef(TEST).
+-include_lib("eunit/include/eunit.hrl").
+-undef(LET).
+-ifdef(PROPER).
+-include_lib("proper/include/proper.hrl").
+-endif.
+-endif.
+
%% @doc Return a reduced version of a query.
%%
%% The purpose of this function is to ensure that a query filter
@@ -26,22 +37,65 @@
%% from this function is functionally equivalent to the original.
reduce(Query) ->
repeat(Query, fun(Q0) ->
- Q1 = flatten(Q0),
+ Q1 = repeat(Q0, fun flatten/1),
Q2 = required(Q1),
- Q3 = flatten(Q2),
+ Q3 = repeat(Q2, fun flatten/1),
Q4 = common(Q3),
- Q4
+ Q5 = repeat(Q4, fun flatten/1),
+ Q6 = constants(Q5),
+ Q6
end).
+
+%% @doc Test if an event matches a query.
+%% This function is only intended to be used for testing purposes.
+matches({any, Conds}, Event) ->
+ lists:any(fun(Cond) -> matches(Cond, Event) end, Conds);
+matches({all, Conds}, Event) ->
+ lists:all(fun(Cond) -> matches(Cond, Event) end, Conds);
+matches({null, Const}, _Event) ->
+ Const;
+matches({Key, '<', Term}, Event) ->
+ case gre:find(Key, Event) of
+ {true, Term2} -> Term2 < Term;
+ false -> false
+ end;
+matches({Key, '=', Term}, Event) ->
+ case gre:find(Key, Event) of
+ {true, Term2} -> Term2 =:= Term;
+ false -> false
+ end;
+matches({Key, '>', Term}, Event) ->
+ case gre:find(Key, Event) of
+ {true, Term2} -> Term2 > Term;
+ false -> false
+ end.
+
%% @private Repeatedly apply a function to a query.
-%% This is used for query transformation functions
-%% applied multiple times
+%% This is used for query transformation functions that must be applied
+%% multiple times to yield the simplest possible version of a query.
repeat(Query, Fun) ->
case Fun(Query) of
Query -> Query;
Query2 -> repeat(Query2, Fun)
end.
+
+%% @doc Return the output action of a query.
+onoutput({_, '<', _}) ->
+ output;
+onoutput({_, '=', _}) ->
+ output;
+onoutput({_, '>', _}) ->
+ output;
+onoutput(Query) ->
+ erlang:error(badarg, [Query]).
+
+%% @doc Modify the output action of a query.
+onoutput(Action, Query) ->
+ erlang:error(badarg, [Action, Query]).
+
+
%% @private Flatten a condition tree.
flatten({all, [Cond]}) ->
Cond;
@@ -54,29 +108,23 @@ flatten({any, [_|_]=Conds}) ->
flatten({with, Cond, Action}) ->
{with, flatten(Cond), Action};
flatten(Other) ->
- return_valid(Other).
+ valid(Other).
%% @private Flatten and remove duplicate members of an "all" filter.
flatten_all(Conds) ->
- {all, lists:usort(flatten_all_(Conds))}.
-
-flatten_all_([{all, Conds}|T]) ->
- Conds ++ flatten_all_(T);
-flatten_all_([H|T]) ->
- [H|flatten_all_(T)];
-flatten_all_([]) ->
- [].
+ {all, lists:usort(flatten_tag(all, Conds))}.
%% @private Flatten and remove duplicate members of an "any" filter.
flatten_any(Conds) ->
- {any, lists:usort(flatten_any_(Conds))}.
-
-flatten_any_([{any, Conds}|T]) ->
- Conds ++ flatten_any_(T);
-flatten_any_([H|T]) ->
- [H|flatten_any_(T)];
-flatten_any_([]) ->
+ {any, lists:usort(flatten_tag(any, Conds))}.
+
+%% @private Common function for flattening "all" or "and" filters.
+flatten_tag(Tag, [{Tag, Conds}|T]) ->
+ Conds ++ flatten_tag(Tag, T);
+flatten_tag(Tag, [H|T]) ->
+ [H|flatten_tag(Tag, T)];
+flatten_tag(_Tag, []) ->
[].
%% @private Factor out required filters.
@@ -90,10 +138,10 @@ flatten_any_([]) ->
required({any, [H|_]=Conds}) ->
Init = ordsets:from_list(case H of {all, Init2} -> Init2; H -> [H] end),
case required(Conds, Init) of
- [] ->
+ nonefound ->
Conds2 = [required(Cond) || Cond <- Conds],
{any, Conds2};
- [_|_]=Req ->
+ {found, Req} ->
Conds2 = [required(deleteall(Cond, Req)) || Cond <- Conds],
{all, [{all, Req}, {any, Conds2}]}
end;
@@ -108,8 +156,10 @@ required([{any, _}|_]=Cond, Acc) ->
erlang:error(badarg, [Cond, Acc]);
required([H|T], Acc) ->
required(T, ordsets:intersection(ordsets:from_list([H]), Acc));
-required([], Acc) ->
- Acc.
+required([], [_|_]=Req) ->
+ {found, Req};
+required([], []) ->
+ nonefound.
%% @private Factor our common filters.
%%
@@ -147,8 +197,15 @@ common_([H|T], Seen) ->
end;
common_([], _Seen) ->
nonefound.
-
+%% @private Delete all occurances of constants.
+%%
+%% An "all" or "any" filter may be reduced to a constant outcome when all
+%% sub-filters has been factored out from the filter. In these cases the
+%% filter can be removed from the query.
+constants(Query) ->
+ delete(Query, {null, true}).
+
%% @private Delete all occurances of a filter.
@@ -190,13 +247,9 @@ is_valid(_Other) ->
%% @private Assert that a term is a valid filter.
%% If the term is a valid filter. The original term will be returned.
%% If the term is not a valid filter. A `badarg' error is thrown.
-return_valid(Term) ->
- case is_valid(Term) of
- true -> Term;
- false ->
- io:format(user, "~w~n", [Term]),
- erlang:error(badarg, [Term])
- end.
+valid(Term) ->
+ is_valid(Term) orelse erlang:error(badarg, [Term]),
+ Term.
-ifdef(TEST).
@@ -288,4 +341,35 @@ delete_from_any_test() ->
glc:any([glc:eq(a, 1),glc:eq(b,2)]), [glc:eq(a, 1)])
).
+default_is_output_test_() ->
+ [?_assertEqual(output, glc_lib:onoutput(glc:lt(a, 1))),
+ ?_assertEqual(output, glc_lib:onoutput(glc:eq(a, 1))),
+ ?_assertEqual(output, glc_lib:onoutput(glc:gt(a, 1)))
+ ].
+
+-ifdef(PROPER).
+
+
+prop_reduce_returns() ->
+ ?FORALL(Query, glc_ops:op(),
+ returns(fun() -> glc_lib:reduce(Query) end)).
+
+reduce_returns_test() ->
+ ?assert(proper:quickcheck(prop_reduce_returns())).
+
+prop_matches_returns_boolean() ->
+ ?FORALL({Query, Event}, {glc_ops:op(), [{atom(), term()}]},
+ is_boolean(glc_lib:matches(Query, gre:make(Event, [list])))).
+
+matches_returns_boolean_test() ->
+ ?assert(proper:quickcheck(prop_matches_returns_boolean())).
+
+returns(Fun) ->
+ try Fun(),
+ true
+ catch _:_ ->
+ false
+ end.
+
+-endif.
-endif.