The
The
While ordinary list comprehensions evaluate to lists, calling
Syntactically QLCs have the same parts as ordinary list comprehensions:
[Expression || Qualifier1, Qualifier2, ...]
The evaluation of a query handle begins by the inspection of
options and the collection of information about tables. As a
result qualifiers are modified during the optimization phase.
Next all list expressions are evaluated. If a cursor has been
created evaluation takes place in the cursor process. For those
list expressions that are QLCs, the list expressions of the
QLCs' generators are evaluated as well. One has to be careful if
list expressions have side effects since the order in which list
expressions are evaluated is unspecified. Finally the answers
are found by evaluating the qualifiers from left to right,
backtracking when some filter returns
Filters that do not return
The
The
The join is to be expressed as a guard filter. The filter must
be placed immediately after the two joined generators, possibly
after guard filters that use variables from no other generators
but the two joined generators. The
The following options are accepted by
Many list comprehension expressions can be evaluated by the
What the
Besides
As another example, consider concatenating the answers to two
queries QH1 and QH2 while removing all duplicates. The means to
accomplish this is to use the
The cost is substantial: every returned answer will be stored
in an ETS table. Before returning an answer it is looked up in
the ETS table to check if it has already been returned. Without
the
If the order of the answers is not important there is the alternative to sort the answers uniquely:
This query also removes duplicates but the answers will be sorted. If there are many answers temporary files will be used. Note that in order to get the first unique answer all answers have to be found and sorted. Both alternatives find duplicates by comparing answers, that is, if A1 and A2 are answers found in that order, then A2 is a removed if A1 == A2.
To return just a few answers cursors can be used. The following code returns no more than five answers using an ETS table for storing the unique answers:
Query list comprehensions are convenient for stating constraints on data from two or more tables. An example that does a natural join on two query handles on position 2:
The
The
In this case the filter will be applied to every possible pair of answers to QH1 and QH2, one at a time. If there are M answers to QH1 and N answers to QH2 the filter will be run M*N times.
If QH2 is a call to the function for
or just
The effect of the
There is an option
TF = fun() -> qlc_next(gb_trees:next(gb_trees:iterator(T))) end,
InfoFun = fun(num_of_objects) -> gb_trees:size(T);
(keypos) -> 1;
(is_sorted_key) -> true;
(is_unique_objects) -> true;
(_) -> undefined
end,
LookupFun =
fun(1, Ks) ->
lists:flatmap(fun(K) ->
case gb_trees:lookup(K, T) of
{value, V} -> [{K,V}];
none -> []
end
end, Ks)
end,
FormatFun =
fun({all, NElements, ElementFun}) ->
ValsS = io_lib:format("gb_trees:from_orddict(~w)",
[gb_nodes(T, NElements, ElementFun)]),
io_lib:format("gb_table:table(~s)", [ValsS]);
({lookup, 1, KeyValues, _NElements, ElementFun}) ->
ValsS = io_lib:format("gb_trees:from_orddict(~w)",
[gb_nodes(T, infinity, ElementFun)]),
io_lib:format("lists:flatmap(fun(K) -> "
"case gb_trees:lookup(K, ~s) of "
"{value, V} -> [{K,V}];none -> [] end "
"end, ~w)",
[ValsS, [ElementFun(KV) || KV <- KeyValues]])
end,
qlc:table(TF, [{info_fun, InfoFun}, {format_fun, FormatFun},
{lookup_fun, LookupFun},{key_equality,'=='}]).
qlc_next({X, V, S}) ->
[{X,V} | fun() -> qlc_next(gb_trees:next(S)) end];
qlc_next(none) ->
[].
gb_nodes(T, infinity, ElementFun) ->
gb_nodes(T, -1, ElementFun);
gb_nodes(T, NElements, ElementFun) ->
gb_iter(gb_trees:iterator(T), NElements, ElementFun).
gb_iter(_I, 0, _EFun) ->
'...';
gb_iter(I0, N, EFun) ->
case gb_trees:next(I0) of
{X, V, I} ->
[EFun({X,V}) | gb_iter(I, N-1, EFun)];
none ->
[]
end.]]>
The lookup function is optional. It is assumed that the lookup
function always finds values much faster than it would take to
traverse the table. The first argument is the position of the
key. Since
The format function is also optional. It is called by
Whether the whole table will be traversed or just some keys looked up depends on how the query is stated. If the query has the form
and P is a tuple, the
In Erlang there are two operators for testing term equality,
namely
If the
1> E1 = ets:new(t, [set]), % uses =:=/2 for key equality Q1 = qlc:q([K || {K} <- ets:table(E1), K == 2.71 orelse K == a]), io:format("~s~n", [qlc:info(Q1)]). ets:match_spec_run(lists:flatmap(fun(V) -> ets:lookup(20493, V) end, [a,2.71]), ets:match_spec_compile([{{'$1'},[],['$1']}]))
In the example the
2> E2 = ets:new(t, [set]), true = ets:insert(E2, [{{2,2},a},{{2,2.0},b},{{2.0,2},c}]), F2 = fun(I) -> qlc:q([V || {K,V} <- ets:table(E2), K == I]) end, Q2 = F2({2,2}), io:format("~s~n", [qlc:info(Q2)]). ets:table(53264, [{traverse, {select,[{{'$1','$2'},[{'==','$1',{const,{2,2}}}],['$2']}]}}]) 3> lists:sort(qlc:e(Q2)). [a,b,c]
Looking up just
If the table uses
4> E3 = ets:new(t, [ordered_set]), % uses ==/2 for key equality true = ets:insert(E3, [{{2,2.0},b}]), F3 = fun(I) -> qlc:q([V || {K,V} <- ets:table(E3), K == I]) end, Q3 = F3({2,2}), io:format("~s~n", [qlc:info(Q3)]). ets:match_spec_run(ets:lookup(86033, {2,2}), ets:match_spec_compile([{{'$1','$2'},[],['$2']}])) 5> qlc:e(Q3). [b]
Lookup join is handled analogously to lookup of constants in a
table: if the join operator is
Parse trees for Erlang expression, see the
Match specification, see the
Actually an integer > 1.
A
A
A literal
See
Returns a query handle. When evaluating the query handle
Returns a query handle. When evaluating the query handle
1> QH = qlc:q([{X,Y} || X <- [a,b], Y <- [1,2]]), QC = qlc:cursor(QH), qlc:next_answers(QC, 1). [{a,1}] 2> qlc:next_answers(QC, 1). [{a,2}] 3> qlc:next_answers(QC, all_remaining). [{b,1},{b,2}] 4> qlc:delete_cursor(QC). ok
Deletes a query cursor. Only the owner of the cursor can delete the cursor.
1> QH = qlc:q([{X,Y} || X <- [a,b], Y <- [1,2]]), qlc:eval(QH). [{a,1},{a,2},{b,1},{b,2}]
Calls
1> QH = [1,2,3,4,5,6], qlc:fold(fun(X, Sum) -> X + Sum end, 0, QH). 21
Returns a descriptive string in English of an error tuple
returned by some of the functions of the
The information has the form of an Erlang expression where QLCs most likely occur. Depending on the format functions of mentioned QLC tables it may not be absolutely accurate.
The default is to return a sequence of QLCs in a block, but
if the option
1> QH = qlc:q([{X,Y} || X <- [x,y], Y <- [a,b]]), io:format("~s~n", [qlc:info(QH, unique_all)]). begin V1 = qlc:q([ SQV || SQV <- [x,y] ], [{unique,true}]), V2 = qlc:q([ SQV || SQV <- [a,b] ], [{unique,true}]), qlc:q([ {X,Y} || X <- V1, Y <- V2 ], [{unique,true}]) end
In this example two simple QLCs have been inserted just to
hold the
1> E1 = ets:new(e1, []), E2 = ets:new(e2, []), true = ets:insert(E1, [{1,a},{2,b}]), true = ets:insert(E2, [{a,1},{b,2}]), Q = qlc:q([{X,Z,W} || {X, Z} <- ets:table(E1), {W, Y} <- ets:table(E2), X =:= Y]), io:format("~s~n", [qlc:info(Q)]). begin V1 = qlc:q([ P0 || P0 = {W,Y} <- ets:table(17) ]), V2 = qlc:q([ [G1|G2] || G2 <- V1, G1 <- ets:table(16), element(2, G1) =:= element(1, G2) ], [{join,lookup}]), qlc:q([ {X,Z,W} || [{X,Z}|{W,Y}] <- V2 ]) end
In this example the query list comprehension
Returns a query handle. When evaluating the query handle
The sorter will use temporary files only if
Returns some or all of the remaining answers to a query
cursor. Only the owner of
The optional argument
-include_lib("stdlib/include/qlc.hrl").
to the source file. This causes a parse transform to substitute a fun for the query list comprehension. The (compiled) fun will be called when the query handle is evaluated.
When calling
To be very explicit, this will not work:
... A = [X || {X} <- [{1},{2}]], QH = qlc:q(A), ...
The variable
The
The
The
The
The
1> Q = qlc:q([{A,X,Z,W} || A <- [a,b,c], {X,Z} <- [{a,1},{b,4},{c,6}], {W,Y} <- [{2,a},{3,b},{4,c}], X =:= Y], {cache, list}), io:format("~s~n", [qlc:info(Q)]). begin V1 = qlc:q([ P0 || P0 = {X,Z} <- qlc:keysort(1, [{a,1},{b,4},{c,6}], []) ]), V2 = qlc:q([ P0 || P0 = {W,Y} <- qlc:keysort(2, [{2,a},{3,b},{4,c}], []) ]), V3 = qlc:q([ [G1|G2] || G1 <- V1, G2 <- V2, element(1, G1) == element(2, G2) ], [{join,merge},{cache,list}]), qlc:q([ {A,X,Z,W} || A <- [a,b,c], [{X,Z}|{W,Y}] <- V3, X =:= Y ]) end
In this example the cached results of the merge join are
traversed for each value of
Sometimes (see
1> T = gb_trees:empty(), QH = qlc:q([X || {{X,Y},_} <- gb_table:table(T), ((X == 1) or (X == 2)) andalso ((Y == a) or (Y == b) or (Y == c))]), io:format("~s~n", [qlc:info(QH)]). ets:match_spec_run( lists:flatmap(fun(K) -> case gb_trees:lookup(K, gb_trees:from_orddict([])) of {value,V} -> [{K,V}]; none -> [] end end, [{1,a},{1,b},{1,c},{2,a},{2,b},{2,c}]), ets:match_spec_compile([{{{'$1','$2'},'_'},[],['$1']}]))
In this example using the
The
The
Returns a query handle. When evaluating the query handle
The sorter will use temporary files only if
A string version of
1> L = [1,2,3], Bs = erl_eval:add_binding('L', L, erl_eval:new_bindings()), QH = qlc:string_to_handle("[X+1 || X <- L].", [], Bs), qlc:eval(QH). [2,3,4]
This function is probably useful mostly when called from outside of Erlang, for instance from a driver written in C.
The callback function
The unary callback function
The unary callback function
See