gproc.erl 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862
  1. %% ``The contents of this file are subject to the Erlang Public License,
  2. %% Version 1.1, (the "License"); you may not use this file except in
  3. %% compliance with the License. You should have received a copy of the
  4. %% Erlang Public License along with this software. If not, it can be
  5. %% retrieved via the world wide web at http://www.erlang.org/.
  6. %%
  7. %% Software distributed under the License is distributed on an "AS IS"
  8. %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
  9. %% the License for the specific language governing rights and limitations
  10. %% under the License.
  11. %%
  12. %% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
  13. %% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
  14. %% AB. All Rights Reserved.''
  15. %%
  16. %% @author Ulf Wiger <ulf.wiger@ericsson.com>
  17. %%
  18. %% @doc Extended process registry
  19. %% <p>This module implements an extended process registry</p>
  20. %% <p>For a detailed description, see gproc/doc/erlang07-wiger.pdf.</p>
  21. %%
  22. %% @type type() = n | p | c | a. n = name; p = property; c = counter;
  23. %% a = aggregate_counter
  24. %% @type scope() = l | g. l = local registration; g = global registration
  25. %% @type context() = {scope(), type()} | type(). Local scope is the default
  26. %% @type sel_type() = n | p | c | a |
  27. %% names | props | counters | aggr_counters.
  28. %% @type headpat() = {keypat(),pidpat(),ValPat}.
  29. %% @type keypat() = {sel_type() | sel_var(),
  30. %% l | g | sel_var(),
  31. %% any()}.
  32. %% @type pidpat() = pid() | sel_var().
  33. %% sel_var() = DollarVar | '_'.
  34. %% @type sel_pattern() = [{headpat(), Guards, Prod}].
  35. %% @type key() = {type(), scope(), any()}
  36. %% @end
  37. -module(gproc).
  38. -behaviour(gen_server).
  39. -export([start_link/0,
  40. reg/1, reg/2, unreg/1,
  41. mreg/3,
  42. set_value/2,
  43. get_value/1,
  44. where/1,
  45. lookup_pid/1,
  46. lookup_pids/1,
  47. update_counter/2,
  48. send/2,
  49. info/1, info/2,
  50. select/1, select/2, select/3,
  51. first/1,
  52. next/2,
  53. prev/2,
  54. last/1,
  55. table/1, table/2]).
  56. %%% internal exports
  57. -export([init/1,
  58. handle_cast/2,
  59. handle_call/3,
  60. handle_info/2,
  61. code_change/3,
  62. terminate/2]).
  63. -include("gproc.hrl").
  64. -define(SERVER, ?MODULE).
  65. %%-define(l, l(?LINE)). % when activated, calls a traceable empty function
  66. -define(l, ignore).
  67. -define(CHK_DIST,
  68. case whereis(gproc_dist) of
  69. undefined ->
  70. erlang:error(local_only);
  71. _ ->
  72. ok
  73. end).
  74. -record(state, {}).
  75. start_link() ->
  76. create_tabs(),
  77. gen_server:start({local, ?SERVER}, ?MODULE, [], []).
  78. %% @spec reg(Key::key()) -> true
  79. %%
  80. %% @doc
  81. %% @equiv reg(Key, undefined)
  82. %% @end
  83. reg(Key) ->
  84. reg(Key, undefined).
  85. %% @spec reg(Key::key(), Value) -> true
  86. %%
  87. %% @doc Register a name or property for the current process
  88. %%
  89. %%
  90. reg({_,g,_} = Key, Value) ->
  91. %% anything global
  92. ?CHK_DIST,
  93. gproc_dist:reg(Key, Value);
  94. reg({T,l,_} = Key, Value) when T==n; T==a ->
  95. %% local names and aggregated counters
  96. call({reg, Key, Value});
  97. reg({c,l,_} = Key, Value) ->
  98. %% local counter
  99. if is_integer(Value) ->
  100. call({reg, Key, Value});
  101. true ->
  102. erlang:error(badarg)
  103. end;
  104. reg({_,l,_} = Key, Value) ->
  105. %% local property
  106. local_reg(Key, Value);
  107. reg(_, _) ->
  108. erlang:error(badarg).
  109. %% @spec mreg(type(), scope(), [{Key::any(), Value::any()}]) -> true
  110. %%
  111. %% @doc Register multiple {Key,Value} pairs of a given type and scope.
  112. %%
  113. %% This function is more efficient than calling {@link reg/2} repeatedly.
  114. %% @end
  115. mreg(T, g, KVL) ->
  116. ?CHK_DIST,
  117. gproc_dist:mreg(T, KVL);
  118. mreg(T, l, KVL) when T==a; T==n ->
  119. if is_list(KVL) ->
  120. call({mreg, T, l, KVL});
  121. true ->
  122. erlang:error(badarg)
  123. end;
  124. mreg(p, l, KVL) ->
  125. local_mreg(p, KVL);
  126. mreg(_, _, _) ->
  127. erlang:error(badarg).
  128. %% @spec (Key:: key()) -> true
  129. %%
  130. %% @doc Unregister a name or property.
  131. %% @end
  132. unreg(Key) ->
  133. case Key of
  134. {_, g, _} ->
  135. ?CHK_DIST,
  136. gproc_dist:unreg(Key);
  137. {T, l, _} when T == n;
  138. T == a -> call({unreg, Key});
  139. {_, l, _} ->
  140. case ets:member(?TAB, {Key,self()}) of
  141. true ->
  142. gproc_lib:remove_reg(Key, self());
  143. false ->
  144. erlang:error(badarg)
  145. end
  146. end.
  147. %% @spec (select_pattern()) -> list(sel_object())
  148. %% @doc
  149. %% @equiv select(all, Pat)
  150. %% @end
  151. select(Pat) ->
  152. select(all, Pat).
  153. %% @spec (Type::sel_type(), Pat::sel_pattern()) -> [{Key, Pid, Value}]
  154. %%
  155. %% @doc Perform a select operation on the process registry.
  156. %%
  157. %% The physical representation in the registry may differ from the above,
  158. %% but the select patterns are transformed appropriately.
  159. %% @end
  160. select(Type, Pat) ->
  161. ets:select(?TAB, pattern(Pat, Type)).
  162. %% @spec (Type::sel_type(), Pat::sel_patten(), Limit::integer()) ->
  163. %% [{Key, Pid, Value}]
  164. %% @doc Like {@link select/2} but returns Limit objects at a time.
  165. %%
  166. %% See [http://www.erlang.org/doc/man/ets.html#select-3].
  167. %% @end
  168. select(Type, Pat, Limit) ->
  169. ets:select(?TAB, pattern(Pat, Type), Limit).
  170. %%% Local properties can be registered in the local process, since
  171. %%% no other process can interfere.
  172. %%%
  173. local_reg(Key, Value) ->
  174. case gproc_lib:insert_reg(Key, Value, self(), l) of
  175. false -> erlang:error(badarg);
  176. true -> monitor_me()
  177. end.
  178. local_mreg(_, []) -> true;
  179. local_mreg(T, [_|_] = KVL) ->
  180. case gproc_lib:insert_many(T, l, KVL, self()) of
  181. false -> erlang:error(badarg);
  182. {true,_} -> monitor_me()
  183. end.
  184. %% @spec (Key :: key(), Value) -> true
  185. %% @doc Sets the value of the registeration entry given by Key
  186. %%
  187. %% Key is assumed to exist and belong to the calling process.
  188. %% If it doesn't, this function will exit.
  189. %%
  190. %% Value can be any term, unless the object is a counter, in which case
  191. %% it must be an integer.
  192. %% @end
  193. %%
  194. set_value({_,g,_} = Key, Value) ->
  195. ?CHK_DIST,
  196. gproc_dist:set_value(Key, Value);
  197. set_value({a,l,_} = Key, Value) when is_integer(Value) ->
  198. call({set, Key, Value});
  199. set_value({n,l,_} = Key, Value) ->
  200. %% we cannot do this locally, since we have to check that the object
  201. %% exists first - not an atomic update.
  202. call({set, Key, Value});
  203. set_value({p,l,_} = Key, Value) ->
  204. %% we _can_ to this locally, since there is no race condition - no
  205. %% other process can update our properties.
  206. case gproc_lib:do_set_value(Key, Value, self()) of
  207. true -> true;
  208. false ->
  209. erlang:error(badarg)
  210. end;
  211. set_value({c,l,_} = Key, Value) when is_integer(Value) ->
  212. gproc_lib:do_set_counter_value(Key, Value, self());
  213. set_value(_, _) ->
  214. erlang:error(badarg).
  215. %% @spec (Key) -> Value
  216. %% @doc Read the value stored with a key registered to the current process.
  217. %%
  218. %% If no such key is registered to the current process, this function exits.
  219. %% @end
  220. get_value(Key) ->
  221. get_value(Key, self()).
  222. get_value({T,_,_} = Key, Pid) when is_pid(Pid) ->
  223. if T==n orelse T==a ->
  224. case ets:lookup(?TAB, {Key, T}) of
  225. [{_, P, Value}] when P == Pid -> Value;
  226. _ -> erlang:error(badarg)
  227. end;
  228. true ->
  229. ets:lookup_element(?TAB, {Key, Pid}, 3)
  230. end;
  231. get_value(_, _) ->
  232. erlang:error(badarg).
  233. %% @spec (Key) -> Pid
  234. %% @doc Lookup the Pid stored with a key.
  235. %%
  236. lookup_pid({_T,_,_} = Key) ->
  237. case where(Key) of
  238. undefined -> erlang:error(badarg);
  239. P -> P
  240. end.
  241. %% @spec (Key::key()) -> pid()
  242. %%
  243. %% @doc Returns the pid registered as Key
  244. %%
  245. %% The type of registration entry must be either name or aggregated counter.
  246. %% Otherwise this function will exit. Use {@link lookup_pids/1} in these
  247. %% cases.
  248. %% @end
  249. %%
  250. where({T,_,_}=Key) ->
  251. if T==n orelse T==a ->
  252. case ets:lookup(?TAB, {Key,T}) of
  253. [] ->
  254. undefined;
  255. [{_, P, _Value}] ->
  256. P
  257. end;
  258. true ->
  259. erlang:error(badarg)
  260. end.
  261. %% @spec (Key::key()) -> [pid()]
  262. %%
  263. %% @doc Returns a list of pids with the published key Key
  264. %%
  265. %% If the type of registration entry is either name or aggregated counter,
  266. %% this function will return either an empty list, or a list of one pid.
  267. %% For non-unique types, the return value can be a list of any length.
  268. %% @end
  269. %%
  270. lookup_pids({T,_,_} = Key) ->
  271. if T==n orelse T==a ->
  272. ets:select(?TAB, [{{{Key,T}, '$1', '_'},[],['$1']}]);
  273. T==c ->
  274. ets:select(?TAB, [{{{Key,'_'}, '$1', '_'},[],['$1']}]);
  275. true ->
  276. erlang:error(badarg)
  277. end.
  278. %% @spec (Key::key(), Incr::integer()) -> integer()
  279. %%
  280. %% @doc Updates the counter registered as Key for the current process.
  281. %%
  282. %% This function works like ets:update_counter/3
  283. %% (see [http://www.erlang.org/doc/man/ets.html#update_counter-3]), but
  284. %% will fail if the type of object referred to by Key is not a counter.
  285. %% @end
  286. %%
  287. update_counter({c,l,_} = Key, Incr) when is_integer(Incr) ->
  288. gproc_lib:update_counter(Key, Incr, self());
  289. update_counter({c,g,_} = Key, Incr) when is_integer(Incr) ->
  290. ?CHK_DIST,
  291. gproc_dist:update_counter(Key, Incr);
  292. update_counter(_, _) ->
  293. erlang:error(badarg).
  294. %% @spec (Key::key(), Msg::any()) -> Msg
  295. %%
  296. %% @doc Sends a message to the process, or processes, corresponding to Key.
  297. %%
  298. %% If Key belongs to a unique object (name or aggregated counter), this
  299. %% function will send a message to the corresponding process, or fail if there
  300. %% is no such process. If Key is for a non-unique object type (counter or
  301. %% property), Msg will be send to all processes that have such an object.
  302. %% @end
  303. %%
  304. send({T,C,_} = Key, Msg) when C==l; C==g ->
  305. if T == n orelse T == a ->
  306. case ets:lookup(?TAB, {Key, T}) of
  307. [{_, Pid, _}] ->
  308. Pid ! Msg;
  309. [] ->
  310. erlang:error(badarg)
  311. end;
  312. T==p orelse T==c ->
  313. %% BUG - if the key part contains select wildcards, we may end up
  314. %% sending multiple messages to the same pid
  315. Head = {{Key,'$1'},'_'},
  316. Pids = ets:select(?TAB, [{Head,[],['$1']}]),
  317. lists:foreach(fun(Pid) ->
  318. Pid ! Msg
  319. end, Pids),
  320. Msg;
  321. true ->
  322. erlang:error(badarg)
  323. end;
  324. send(_, _) ->
  325. erlang:error(badarg).
  326. %% @spec (Type :: type()) -> key() | '$end_of_table'
  327. %%
  328. %% @doc Behaves as ets:first(Tab) for a given type of registration object.
  329. %%
  330. %% See [http://www.erlang.org/doc/man/ets.html#first-1].
  331. %% The registry behaves as an ordered_set table.
  332. %% @end
  333. %%
  334. first(Type) ->
  335. {HeadPat,_} = headpat(Type, '_', '_', '_'),
  336. case ets:select(?TAB, [{HeadPat,[],[{element,1,'$_'}]}], 1) of
  337. {[First], _} ->
  338. First;
  339. _ ->
  340. '$end_of_table'
  341. end.
  342. %% @spec (Context :: context()) -> key() | '$end_of_table'
  343. %%
  344. %% @doc Behaves as ets:last(Tab) for a given type of registration object.
  345. %%
  346. %% See [http://www.erlang.org/doc/man/ets.html#last-1].
  347. %% The registry behaves as an ordered_set table.
  348. %% @end
  349. %%
  350. last(Context) ->
  351. {S, T} = get_s_t(Context),
  352. S1 = if S == '_'; S == l -> m;
  353. S == g -> h
  354. end,
  355. Beyond = {{T,S1,[]},[]},
  356. step(ets:prev(?TAB, Beyond), S, T).
  357. %% @spec (Context::context(), Key::key()) -> key() | '$end_of_table'
  358. %%
  359. %% @doc Behaves as ets:next(Tab,Key) for a given type of registration object.
  360. %%
  361. %% See [http://www.erlang.org/doc/man/ets.html#next-2].
  362. %% The registry behaves as an ordered_set table.
  363. %% @end
  364. %%
  365. next(Context, K) ->
  366. {S,T} = get_s_t(Context),
  367. step(ets:next(?TAB,K), S, T).
  368. %% @spec (Context::context(), Key::key()) -> key() | '$end_of_table'
  369. %%
  370. %% @doc Behaves as ets:prev(Tab,Key) for a given type of registration object.
  371. %%
  372. %% See [http://www.erlang.org/doc/man/ets.html#prev-2].
  373. %% The registry behaves as an ordered_set table.
  374. %% @end
  375. %%
  376. prev(Context, K) ->
  377. {S, T} = get_s_t(Context),
  378. step(ets:prev(?TAB, K), S, T).
  379. step(Key, '_', '_') ->
  380. case Key of
  381. {{_,_,_},_} -> Key;
  382. _ -> '$end_of_table'
  383. end;
  384. step(Key, '_', T) ->
  385. case Key of
  386. {{T,_,_},_} -> Key;
  387. _ -> '$end_of_table'
  388. end;
  389. step(Key, S, '_') ->
  390. case Key of
  391. {{_, S, _}, _} -> Key;
  392. _ -> '$end_of_table'
  393. end;
  394. step(Key, S, T) ->
  395. case Key of
  396. {{T, S, _}, _} -> Key;
  397. _ -> '$end_of_table'
  398. end.
  399. %% @spec (Pid::pid()) -> ProcessInfo
  400. %% ProcessInfo = [{gproc, [{Key,Value}]} | ProcessInfo]
  401. %%
  402. %% @doc Similar to `process_info(Pid)' but with additional gproc info.
  403. %%
  404. %% Returns the same information as process_info(Pid), but with the
  405. %% addition of a `gproc' information item, containing the `{Key,Value}'
  406. %% pairs registered to the process.
  407. %% @end
  408. info(Pid) when is_pid(Pid) ->
  409. Items = [?MODULE | [ I || {I,_} <- process_info(self())]],
  410. [info(Pid,I) || I <- Items].
  411. %% @spec (Pid::pid(), Item::atom()) -> {Item, Info}
  412. %%
  413. %% @doc Similar to process_info(Pid, Item), but with additional gproc info.
  414. %%
  415. %% For `Item = gproc', this function returns a list of `{Key, Value}' pairs
  416. %% registered to the process Pid. For other values of Item, it returns the
  417. %% same as [http://www.erlang.org/doc/man/erlang.html#process_info-2].
  418. %% @end
  419. info(Pid, ?MODULE) ->
  420. Keys = ets:select(?TAB, [{ {{Pid,'$1'}}, [], ['$1'] }]),
  421. {?MODULE, lists:zf(
  422. fun(K) ->
  423. try V = get_value(K, Pid),
  424. {true, {K,V}}
  425. catch
  426. error:_ ->
  427. false
  428. end
  429. end, Keys)};
  430. info(Pid, I) ->
  431. process_info(Pid, I).
  432. %%% ==========================================================
  433. %% @hidden
  434. handle_cast({monitor_me, Pid}, S) ->
  435. erlang:monitor(process, Pid),
  436. {noreply, S}.
  437. %% @hidden
  438. handle_call({reg, {_T,l,_} = Key, Val}, {Pid,_}, S) ->
  439. case try_insert_reg(Key, Val, Pid) of
  440. true ->
  441. ensure_monitor(Pid),
  442. {reply, true, S};
  443. false ->
  444. {reply, badarg, S}
  445. end;
  446. handle_call({unreg, {_,l,_} = Key}, {Pid,_}, S) ->
  447. case ets:member(?TAB, {Pid,Key}) of
  448. true ->
  449. gproc_lib:remove_reg(Key, Pid),
  450. {reply, true, S};
  451. false ->
  452. {reply, badarg, S}
  453. end;
  454. handle_call({mreg, T, l, L}, {Pid,_}, S) ->
  455. try gproc_lib:insert_many(T, l, L, Pid) of
  456. {true,_} -> {reply, true, S};
  457. false -> {reply, badarg, S}
  458. catch
  459. error:_ -> {reply, badarg, S}
  460. end;
  461. handle_call({set, {_,l,_} = Key, Value}, {Pid,_}, S) ->
  462. case gproc_lib:do_set_value(Key, Value, Pid) of
  463. true ->
  464. {reply, true, S};
  465. false ->
  466. {reply, badarg, S}
  467. end;
  468. handle_call(_, _, S) ->
  469. {reply, badarg, S}.
  470. %% @hidden
  471. handle_info({'DOWN', _MRef, process, Pid, _}, S) ->
  472. process_is_down(Pid),
  473. {noreply, S};
  474. handle_info(_, S) ->
  475. {noreply, S}.
  476. %% @hidden
  477. code_change(_FromVsn, S, _Extra) ->
  478. {ok, S}.
  479. %% @hidden
  480. terminate(_Reason, _S) ->
  481. ok.
  482. call(Req) ->
  483. case gen_server:call(?MODULE, Req) of
  484. badarg -> erlang:error(badarg, Req);
  485. Reply -> Reply
  486. end.
  487. cast(Msg) ->
  488. gen_server:cast(?MODULE, Msg).
  489. try_insert_reg({T,l,_} = Key, Val, Pid) ->
  490. case gproc_lib:insert_reg(Key, Val, Pid, l) of
  491. false ->
  492. case ets:lookup(?TAB, {Key,T}) of
  493. [{_, OtherPid, _}] ->
  494. case is_process_alive(OtherPid) of
  495. true ->
  496. false;
  497. false ->
  498. process_is_down(Pid),
  499. true = gproc_lib:insert_reg(Key, Val, Pid, l)
  500. end;
  501. [] ->
  502. false
  503. end;
  504. true ->
  505. true
  506. end.
  507. process_is_down(Pid) ->
  508. Keys = ets:select(?TAB, [{{{Pid,'$1'}},
  509. [{'==',{element,2,'$1'},l}], ['$1']}]),
  510. ets:select_delete(?TAB, [{{{Pid,{'_',l,'_'}}}, [], [true]}]),
  511. ets:delete(?TAB, Pid),
  512. lists:foreach(fun(Key) -> gproc_lib:remove_reg_1(Key, Pid) end, Keys).
  513. create_tabs() ->
  514. ets:new(?MODULE, [ordered_set, public, named_table]).
  515. %% @hidden
  516. init([]) ->
  517. {ok, #state{}}.
  518. ensure_monitor(Pid) when node(Pid) == node() ->
  519. case ets:insert_new(?TAB, {Pid}) of
  520. false -> ok;
  521. true -> erlang:monitor(process, Pid)
  522. end;
  523. ensure_monitor(_) ->
  524. true.
  525. monitor_me() ->
  526. case ets:insert_new(?TAB, {self()}) of
  527. false -> true;
  528. true ->
  529. cast({monitor_me,self()}),
  530. true
  531. end.
  532. pattern([{'_', Gs, As}], T) ->
  533. ?l,
  534. {HeadPat, Vs} = headpat(T, '$1', '$2', '$3'),
  535. [{HeadPat, rewrite(Gs,Vs), rewrite(As,Vs)}];
  536. pattern([{{A,B,C},Gs,As}], Scope) ->
  537. ?l,
  538. {HeadPat, Vars} = headpat(Scope, A,B,C),
  539. [{HeadPat, rewrite(Gs,Vars), rewrite(As,Vars)}];
  540. pattern([{Head, Gs, As}], Scope) ->
  541. ?l,
  542. case is_var(Head) of
  543. {true,_N} ->
  544. HeadPat = {{{type(Scope),'_','_'},'_'},'_','_'},
  545. Vs = [{Head, obj_prod()}],
  546. %% {HeadPat, Vs} = headpat(Scope, A,B,C),
  547. %% the headpat function should somehow verify that Head is
  548. %% consistent with Scope (or should we add a guard?)
  549. [{HeadPat, rewrite(Gs, Vs), rewrite(As, Vs)}];
  550. false ->
  551. erlang:error(badarg)
  552. end.
  553. %% This is the expression to use in guards and the RHS to address the whole
  554. %% object, in its logical representation.
  555. obj_prod() ->
  556. {{ {element,1,{element,1,'$_'}},
  557. {element,2,'$_'},
  558. {element,3,'$_'} }}.
  559. obj_prod_l() ->
  560. [ {element,1,{element,1,'$_'}},
  561. {element,2,'$_'},
  562. {element,3,'$_'} ].
  563. headpat({S, T}, V1,V2,V3) when S==global; S==local; S==all ->
  564. headpat(type(T), scope(S), V1,V2,V3);
  565. headpat(T, V1, V2, V3) when is_atom(T) ->
  566. headpat(type(T), l, V1, V2, V3);
  567. headpat(_, _, _, _) -> erlang:error(badarg).
  568. headpat(T, C, V1,V2,V3) ->
  569. Rf = fun(Pos) ->
  570. {element,Pos,{element,1,{element,1,'$_'}}}
  571. end,
  572. K2 = if T==n orelse T==a -> T;
  573. true -> '_'
  574. end,
  575. {Kp,Vars} = case V1 of
  576. {Vt,Vc,Vn} ->
  577. ?l,
  578. {T1,Vs1} = subst(T,Vt,fun() -> Rf(1) end,[]),
  579. {C1,Vs2} = subst(C,Vc,fun() -> Rf(2) end,Vs1),
  580. {{T1,C1,Vn}, Vs2};
  581. '_' ->
  582. ?l,
  583. {{T,C,'_'}, []};
  584. _ ->
  585. ?l,
  586. case is_var(V1) of
  587. {true,_} ->
  588. {{T,C,V1}, [{V1, {element,1,
  589. {element,1,'$_'}}}]};
  590. false ->
  591. erlang:error(badarg)
  592. end
  593. end,
  594. {{{Kp,K2},V2,V3}, Vars}.
  595. %% l(L) -> L.
  596. subst(X, '_', _F, Vs) ->
  597. {X, Vs};
  598. subst(X, V, F, Vs) ->
  599. case is_var(V) of
  600. {true,_} ->
  601. {X, [{V,F()}|Vs]};
  602. false ->
  603. {V, Vs}
  604. end.
  605. scope(all) -> '_';
  606. scope(global) -> g;
  607. scope(local) -> l.
  608. type(all) -> '_';
  609. type(T) when T==n; T==p; T==c; T==a -> T;
  610. type(names) -> n;
  611. type(props) -> p;
  612. type(counters) -> c;
  613. type(aggr_counters) -> a.
  614. keypat(Context) ->
  615. {S,T} = get_s_t(Context),
  616. {{T,S,'_'},'_'}.
  617. get_s_t({S,T}) -> {scope(S), type(T)};
  618. get_s_t(T) when is_atom(T) ->
  619. {l, type(T)}.
  620. is_var('$1') -> {true,1};
  621. is_var('$2') -> {true,2};
  622. is_var('$3') -> {true,3};
  623. is_var('$4') -> {true,4};
  624. is_var('$5') -> {true,5};
  625. is_var('$6') -> {true,6};
  626. is_var('$7') -> {true,7};
  627. is_var('$8') -> {true,8};
  628. is_var('$9') -> {true,9};
  629. is_var(X) when is_atom(X) ->
  630. case atom_to_list(X) of
  631. "$" ++ Tl ->
  632. try N = list_to_integer(Tl),
  633. {true,N}
  634. catch
  635. error:_ ->
  636. false
  637. end;
  638. _ ->
  639. false
  640. end;
  641. is_var(_) -> false.
  642. rewrite(Gs, R) ->
  643. [rewrite1(G, R) || G <- Gs].
  644. rewrite1('$_', _) ->
  645. obj_prod();
  646. rewrite1('$$', _) ->
  647. obj_prod_l();
  648. rewrite1(Guard, R) when is_tuple(Guard) ->
  649. list_to_tuple([rewrite1(G, R) || G <- tuple_to_list(Guard)]);
  650. rewrite1(Exprs, R) when is_list(Exprs) ->
  651. [rewrite1(E, R) || E <- Exprs];
  652. rewrite1(V, R) when is_atom(V) ->
  653. case is_var(V) of
  654. {true,_N} ->
  655. case lists:keysearch(V, 1, R) of
  656. {value, {_, V1}} ->
  657. V1;
  658. false ->
  659. V
  660. end;
  661. false ->
  662. V
  663. end;
  664. rewrite1(Expr, _) ->
  665. Expr.
  666. table(Type) ->
  667. table(Type, []).
  668. table(T, Opts) ->
  669. [Traverse, NObjs] = [proplists:get_value(K,Opts,Def) ||
  670. {K,Def} <- [{traverse,select}, {n_objects,100}]],
  671. TF = case Traverse of
  672. first_next ->
  673. fun() -> qlc_next(T, first(T)) end;
  674. last_prev -> fun() -> qlc_prev(T, last(T)) end;
  675. select ->
  676. fun(MS) -> qlc_select(select(T, MS, NObjs)) end;
  677. {select,MS} ->
  678. fun() -> qlc_select(select(T, MS, NObjs)) end;
  679. _ ->
  680. erlang:error(badarg, [T,Opts])
  681. end,
  682. InfoFun = fun(indices) -> [2];
  683. (is_unique_objects) -> is_unique(T);
  684. (keypos) -> 1;
  685. (is_sorted_key) -> true;
  686. (num_of_objects) ->
  687. %% this is just a guesstimate.
  688. trunc(ets:info(?TAB,size) / 2.5)
  689. end,
  690. LookupFun =
  691. case Traverse of
  692. {select, _MS} -> undefined;
  693. _ -> fun(Pos, Ks) -> qlc_lookup(T, Pos, Ks) end
  694. end,
  695. qlc:table(TF, [{info_fun, InfoFun},
  696. {lookup_fun, LookupFun}] ++ [{K,V} || {K,V} <- Opts,
  697. K =/= traverse,
  698. K =/= n_objects]).
  699. qlc_lookup(_Scope, 1, Keys) ->
  700. lists:flatmap(
  701. fun(Key) ->
  702. ets:select(?TAB, [{ {{Key,'_'},'_','_'}, [],
  703. [{{ {element,1,{element,1,'$_'}},
  704. {element,2,'$_'},
  705. {element,3,'$_'} }}] }])
  706. end, Keys);
  707. qlc_lookup(Scope, 2, Pids) ->
  708. lists:flatmap(fun(Pid) ->
  709. Found =
  710. ets:select(?TAB, [{ {{Pid,keypat(Scope)}},
  711. [], ['$_']}]),
  712. lists:flatmap(
  713. fun({{_,{T,_,_}=K}}) ->
  714. K2 = if T==n orelse T==a -> T;
  715. true -> Pid
  716. end,
  717. case ets:lookup(?TAB, {K,K2}) of
  718. [{{Key,_},_,Value}] ->
  719. [{Key, Pid, Value}];
  720. [] ->
  721. []
  722. end
  723. end, Found)
  724. end, Pids).
  725. qlc_next(_, '$end_of_table') -> [];
  726. qlc_next(Scope, K) ->
  727. case ets:lookup(?TAB, K) of
  728. [{{Key,_}, Pid, V}] ->
  729. [{Key,Pid,V} | fun() -> qlc_next(Scope, next(Scope, K)) end];
  730. [] ->
  731. qlc_next(Scope, next(Scope, K))
  732. end.
  733. qlc_prev(_, '$end_of_table') -> [];
  734. qlc_prev(Scope, K) ->
  735. case ets:lookup(?TAB, K) of
  736. [{{Key,_},Pid,V}] ->
  737. [{Key,Pid,V} | fun() -> qlc_prev(Scope, prev(Scope, K)) end];
  738. [] ->
  739. qlc_prev(Scope, prev(Scope, K))
  740. end.
  741. qlc_select('$end_of_table') ->
  742. [];
  743. qlc_select({Objects, Cont}) ->
  744. Objects ++ fun() -> qlc_select(ets:select(Cont)) end.
  745. is_unique(names) -> true;
  746. is_unique(aggr_counters) -> true;
  747. is_unique({_, names}) -> true;
  748. is_unique({_, aggr_counters}) -> true;
  749. is_unique(n) -> true;
  750. is_unique(a) -> true;
  751. is_unique({_,n}) -> true;
  752. is_unique({_,a}) -> true;
  753. is_unique(_) -> false.