Browse Source

bug in select pattern rewrite

git-svn-id: http://svn.ulf.wiger.net/gproc/branches/experimental-0906/gproc@32 f3948e33-8234-0410-8a80-a07eae3b6c4d
uwiger 15 years ago
parent
commit
cf8cd2a99e
1 changed files with 56 additions and 24 deletions
  1. 56 24
      src/gproc.erl

+ 56 - 24
src/gproc.erl

@@ -23,7 +23,7 @@
 -behaviour(gen_server).
 
 -export([start_link/0,
-         reg/2, unreg/1,
+         reg/1, reg/2, unreg/1,
          mreg/3,
          set_value/2,
          get_value/1,
@@ -51,6 +51,7 @@
 -include("gproc.hrl").
 
 -define(SERVER, ?MODULE).
+-define(l, l(?LINE)).
 
 -define(CHK_DIST,
         case whereis(gproc_dist) of
@@ -67,6 +68,18 @@ start_link() ->
     gen_server:start({local, ?SERVER}, ?MODULE, [], []).
 
 
+%%% @spec({Class,Scope, Key}) -> true
+%%% {@equiv reg(Key, undefined)}
+%%%    Class = n  - unique name
+%%%          | p  - non-unique property
+%%%          | c  - counter
+%%%          | a  - aggregated counter
+%%%    Scope = l | g (global or local)
+%%%
+reg(Key) ->
+    reg(Key, undefined).
+
+
 %%% @spec({Class,Scope, Key}, Value) -> true
 %%% @doc
 %%%    Class = n  - unique name
@@ -460,16 +473,20 @@ monitor_me() ->
 
 
 pattern([{'_', Gs, As}], T) ->
+    ?l,
     {HeadPat, Vs} = headpat(T, '$1', '$2', '$3'),
     [{HeadPat, rewrite(Gs,Vs), rewrite(As,Vs)}];
 pattern([{{A,B,C},Gs,As}], Scope) ->
+    ?l,
     {HeadPat, Vars} = headpat(Scope, A,B,C),
     [{HeadPat, rewrite(Gs,Vars), rewrite(As,Vars)}];
 pattern([{Head, Gs, As}], Scope) ->
+    ?l,
     case is_var(Head) of
-        {true,N} ->
-            {A,B,C} = vars(N),
-            {HeadPat, Vs} = headpat(Scope, A,B,C),
+        {true,_N} ->
+            HeadPat = {{{type(Scope),'_','_'},'_'},'_','_'},
+            Vs = [{Head, obj_prod()}],
+%%            {HeadPat, Vs} = headpat(Scope, A,B,C),
             %% the headpat function should somehow verify that Head is
             %% consistent with Scope (or should we add a guard?)
             [{HeadPat, rewrite(Gs, Vs), rewrite(As, Vs)}];
@@ -477,6 +494,19 @@ pattern([{Head, Gs, As}], Scope) ->
             erlang:error(badarg)
     end.
 
+%% This is the expression to use in guards and the RHS to address the whole
+%% object, in its logical representation.
+obj_prod() ->
+    {{ {element,1,{element,1,'$_'}},
+       {element,2,'$_'},
+       {element,3,'$_'} }}.
+
+obj_prod_l() ->
+    [ {element,1,{element,1,'$_'}},
+      {element,2,'$_'},
+      {element,3,'$_'} ].
+
+
 headpat({C, T}, V1,V2,V3) when C==global; C==local; C==all ->
     headpat(type(T), ctxt(C), V1,V2,V3);
 headpat(T, V1, V2, V3) when is_atom(T) ->
@@ -492,28 +522,34 @@ headpat(T, C, V1,V2,V3) ->
          end,
     {Kp,Vars} = case V1 of
                     {Vt,Vc,Vn} ->
+                        ?l,
                         {T1,Vs1} = subst(T,Vt,fun() -> Rf(1) end,[]),
                         {C1,Vs2} = subst(C,Vc,fun() -> Rf(2) end,Vs1),
                         {{T1,C1,Vn}, Vs2};
                     '_' ->
+                        ?l,
                         {{T,C,'_'}, []};
                     _ ->
+                        ?l,
                         case is_var(V1) of
-                            true ->
-                                {{T,C,'_'}, [{V1, {element,1,
-                                                   {element,1,'$_'}}}]};
+                            {true,_} ->
+                                {{T,C,V1}, [{V1, {element,1,
+                                                  {element,1,'$_'}}}]};
                             false ->
                                 erlang:error(badarg)
                         end
                 end,
     {{{Kp,K2},V2,V3}, Vars}.
 
+l(L) -> L.
+    
+
 
 subst(X, '_', _F, Vs) ->
     {X, Vs};
 subst(X, V, F, Vs) ->
     case is_var(V) of
-        true ->
+        {true,_} ->
             {X, [{V,F()}|Vs]};
         false ->
             {V, Vs}
@@ -539,15 +575,15 @@ get_c_t({C,T}) -> {ctxt(C), type(T)};
 get_c_t(T) when is_atom(T) ->
     {l, type(T)}.
 
-is_var('$1') -> true;
-is_var('$2') -> true;
-is_var('$3') -> true;
-is_var('$4') -> true;
-is_var('$5') -> true;
-is_var('$6') -> true;
-is_var('$7') -> true;
-is_var('$8') -> true;
-is_var('$9') -> true;
+is_var('$1') -> {true,1};
+is_var('$2') -> {true,2};
+is_var('$3') -> {true,3};
+is_var('$4') -> {true,4};
+is_var('$5') -> {true,5};
+is_var('$6') -> {true,6};
+is_var('$7') -> {true,7};
+is_var('$8') -> {true,8};
+is_var('$9') -> {true,9};
 is_var(X) when is_atom(X) ->
     case atom_to_list(X) of
         "$" ++ Tl ->
@@ -572,20 +608,16 @@ rewrite(Gs, R) ->
     [rewrite1(G, R) || G <- Gs].
 
 rewrite1('$_', _) ->
-    {{ {element,1,{element,1,'$_'}},
-       {element,2,'$_'},
-       {element,3,'$_'} }};
+    obj_prod();
 rewrite1('$$', _) ->
-    [ {element,1,{element,1,'$_'}},
-      {element,2,'$_'},
-      {element,3,'$_'} ];
+    obj_prod_l();
 rewrite1(Guard, R) when is_tuple(Guard) ->
     list_to_tuple([rewrite1(G, R) || G <- tuple_to_list(Guard)]);
 rewrite1(Exprs, R) when is_list(Exprs) ->
     [rewrite1(E, R) || E <- Exprs];
 rewrite1(V, R) when is_atom(V) ->
     case is_var(V) of
-        true ->
+        {true,_N} ->
             case lists:keysearch(V, 1, R) of
                 {value, {_, V1}} ->
                     V1;