exprecs now also generates functional lenses

2024-11-06 00:25:16 +00:00 · 2013-01-24 21:17:46 +01:00 · 2013-01-24 21:17:46 +01:00 · 072a7ef0ab
commit 072a7ef0ab
parent b372ea5153
5 changed files with 269 additions and 50 deletions
--- a/README.md
+++ b/README.md
@ -64,10 +64,10 @@ Forms = [{attribute,1,file,{"./ex1.erl",1}},


 <table width="100%" border="0" summary="list of modules">
-<tr><td><a href="http://github.com/esl/parse_trans/blob/2.5.4/doc/ct_expand.md" class="module">ct_expand</a></td></tr>
-<tr><td><a href="http://github.com/esl/parse_trans/blob/2.5.4/doc/exprecs.md" class="module">exprecs</a></td></tr>
-<tr><td><a href="http://github.com/esl/parse_trans/blob/2.5.4/doc/parse_trans.md" class="module">parse_trans</a></td></tr>
-<tr><td><a href="http://github.com/esl/parse_trans/blob/2.5.4/doc/parse_trans_codegen.md" class="module">parse_trans_codegen</a></td></tr>
-<tr><td><a href="http://github.com/esl/parse_trans/blob/2.5.4/doc/parse_trans_mod.md" class="module">parse_trans_mod</a></td></tr>
-<tr><td><a href="http://github.com/esl/parse_trans/blob/2.5.4/doc/parse_trans_pp.md" class="module">parse_trans_pp</a></td></tr></table>
+<tr><td><a href="http://github.com/esl/parse_trans/blob/master/doc/ct_expand.md" class="module">ct_expand</a></td></tr>
+<tr><td><a href="http://github.com/esl/parse_trans/blob/master/doc/exprecs.md" class="module">exprecs</a></td></tr>
+<tr><td><a href="http://github.com/esl/parse_trans/blob/master/doc/parse_trans.md" class="module">parse_trans</a></td></tr>
+<tr><td><a href="http://github.com/esl/parse_trans/blob/master/doc/parse_trans_codegen.md" class="module">parse_trans_codegen</a></td></tr>
+<tr><td><a href="http://github.com/esl/parse_trans/blob/master/doc/parse_trans_mod.md" class="module">parse_trans_mod</a></td></tr>
+<tr><td><a href="http://github.com/esl/parse_trans/blob/master/doc/parse_trans_pp.md" class="module">parse_trans_pp</a></td></tr></table>

--- a/doc/exprecs.md
+++ b/doc/exprecs.md
@ -47,7 +47,10 @@ to lay out access functions for the exported records:As an example, consider the
  -record(s,{a}).
  -export_records([r,s]).
  f() ->
-      {new,'#new-r'([])}.</pre><pre>
+      {new,'#new-r'([])}.</pre>
+
+Compiling this (assuming exprecs is in the path) will produce the
+following code.<pre>
  -module(test_exprecs).
  -compile({pt_pp_src,true}).
  -export([f/0]).
@ -64,6 +67,7 @@ to lay out access functions for the exported records:As an example, consider the
           '#get-'/2,
           '#set-'/2,
           '#fromlist-'/2,
+           '#lens-'/2,
           '#new-r'/0,
           '#new-r'/1,
           '#get-r'/2,
@ -72,6 +76,7 @@ to lay out access functions for the exported records:As an example, consider the
           '#fromlist-r'/1,
           '#fromlist-r'/2,
           '#info-r'/1,
+           '#lens-r'/1,
           '#new-s'/0,
           '#new-s'/1,
           '#get-s'/2,
@ -79,7 +84,8 @@ to lay out access functions for the exported records:As an example, consider the
           '#pos-s'/1,
           '#fromlist-s'/1,
           '#fromlist-s'/2,
-           '#info-s'/1]).
+           '#info-s'/1,
+           '#lens-s'/1]).
  -type '#prop-r'() :: {a, integer()} | {b, integer()} | {c, integer()}.
  -type '#attr-r'() :: a | b | c.
  -type '#prop-s'() :: {a, any()}.
@ -156,6 +162,14 @@ to lay out access functions for the exported records:As an example, consider the
      '#fromlist-r'(Vals, Rec);
  '#fromlist-'(Vals, Rec) when is_record(Rec, s) ->
      '#fromlist-s'(Vals, Rec).
+  -spec '#lens-'('#prop-r'(), r) ->
+                   {fun((#r{}) -> any()), fun((any(), #r{}) -> #r{})};
+               ('#prop-s'(), s) ->
+                   {fun((#s{}) -> any()), fun((any(), #s{}) -> #s{})}.
+  '#lens-'(Attr, r) ->
+      '#lens-r'(Attr);
+  '#lens-'(Attr, s) ->
+      '#lens-s'(Attr).
  -spec '#new-r'() -> #r{}.
  '#new-r'() ->
      #r{}.
@ -225,6 +239,29 @@ to lay out access functions for the exported records:As an example, consider the
      record_info(fields, r);
  '#info-r'(size) ->
      record_info(size, r).
+  -spec '#lens-r'('#prop-r'()) ->
+                    {fun((#r{}) -> any()), fun((any(), #r{}) -> #r{})}.
+  '#lens-r'(a) ->
+      {fun(R) ->
+              '#get-r'(a, R)
+       end,
+       fun(X, R) ->
+              '#set-r'([{a,X}], R)
+       end};
+  '#lens-r'(b) ->
+      {fun(R) ->
+              '#get-r'(b, R)
+       end,
+       fun(X, R) ->
+              '#set-r'([{b,X}], R)
+       end};
+  '#lens-r'(c) ->
+      {fun(R) ->
+              '#get-r'(c, R)
+       end,
+       fun(X, R) ->
+              '#set-r'([{c,X}], R)
+       end}.
  -spec '#new-s'() -> #s{}.
  '#new-s'() ->
      #s{}.
@ -280,6 +317,15 @@ to lay out access functions for the exported records:As an example, consider the
      record_info(fields, s);
  '#info-s'(size) ->
      record_info(size, s).
+  -spec '#lens-s'('#prop-s'()) ->
+                    {fun((#s{}) -> any()), fun((any(), #s{}) -> #s{})}.
+  '#lens-s'(a) ->
+      {fun(R) ->
+              '#get-s'(a, R)
+       end,
+       fun(X, R) ->
+              '#set-s'([{a,X}], R)
+       end}.
  f() ->
      {new,'#new-r'([])}.</pre>

@ -301,25 +347,105 @@ Exprecs will substitute the control atoms with the string values of the
 corresponding items. The result will then be flattened and converted to an
 atom (a valid function or type name).`operation` is one of:

-* `new`

-* `get`

-* `set`
+<dt><code>new</code></dt>

-* `fromlist`
 
-* `info`

-* `pos`
+<dd>Creates a new record</dd>

-* `is_record`

-* `convert`

-* `prop`

-* `attr`
+<dt><code>get</code></dt>
+
+ 
+
+<dd>Retrieves given attribute values from a record</dd>
+
+
+
+
+<dt><code>set</code></dt>
+
+ 
+
+<dd>Sets given attribute values in a record</dd>
+
+
+
+
+<dt><code>fromlist</code></dt>
+
+ 
+
+<dd>Creates a record from a key-value list</dd>
+
+
+
+
+<dt><code>info</code></dt>
+
+ 
+
+<dd>Equivalent to record_info/2</dd>
+
+
+
+
+<dt><code>pos</code></dt>
+
+ 
+
+<dd>Returns the position of a given attribute</dd>
+
+
+
+
+<dt><code>is_record</code></dt>
+
+ 
+
+<dd>Tests if a value is a specific record</dd>
+
+
+
+
+<dt><code>convert</code></dt>
+
+ 
+
+<dd>Converts an old record to the current version</dd>
+
+
+
+
+<dt><code>prop</code></dt>
+
+ 
+
+<dd>Used only in type specs</dd>
+
+
+
+
+<dt><code>attr</code></dt>
+
+ 
+
+<dd>Used only in type specs</dd>
+
+
+
+
+<dt><code>lens</code></dt>
+
+ 
+
+<dd>Returns a 'lens' (an accessor pair) as described in
+<a href="http://github.com/jlouis/erl-lenses" target="_top"><tt>http://github.com/jlouis/erl-lenses</tt></a></dd>
+



--- a/examples/test_exprecs.erl
+++ b/examples/test_exprecs.erl
@ -1,6 +1,7 @@
 -module(test_exprecs).

-compile({pt_pp_src, true}).
+-pt_renumber(true).
+-pt_log_forms(true).

 -export([f/0]).

--- a/src/exprecs.erl
+++ b/src/exprecs.erl
@ -63,6 +63,9 @@
 %%     {new,'#new-r'([])}.
 %% </pre>
 %%
+%% Compiling this (assuming exprecs is in the path) will produce the
+%% following code.
+%%
 %% <pre>
 %% -module(test_exprecs).
 %% -compile({pt_pp_src,true}).
@ -80,6 +83,7 @@
 %%          '#get-'/2,
 %%          '#set-'/2,
 %%          '#fromlist-'/2,
+%%          '#lens-'/2,
 %%          '#new-r'/0,
 %%          '#new-r'/1,
 %%          '#get-r'/2,
@ -88,6 +92,7 @@
 %%          '#fromlist-r'/1,
 %%          '#fromlist-r'/2,
 %%          '#info-r'/1,
+%%          '#lens-r'/1,
 %%          '#new-s'/0,
 %%          '#new-s'/1,
 %%          '#get-s'/2,
@ -95,7 +100,8 @@
 %%          '#pos-s'/1,
 %%          '#fromlist-s'/1,
 %%          '#fromlist-s'/2,
-%%          '#info-s'/1]).
+%%          '#info-s'/1,
+%%          '#lens-s'/1]).
 %%
 %% -type '#prop-r'() :: {a, integer()} | {b, integer()} | {c, integer()}.
 %% -type '#attr-r'() :: a | b | c.
@ -184,6 +190,15 @@
 %% '#fromlist-'(Vals, Rec) when is_record(Rec, s) -&gt;
 %%     '#fromlist-s'(Vals, Rec).
 %%
+%% -spec '#lens-'('#prop-r'(), r) -&gt;
+%%                  {fun((#r{}) -&gt; any()), fun((any(), #r{}) -&gt; #r{})};
+%%              ('#prop-s'(), s) -&gt;
+%%                  {fun((#s{}) -&gt; any()), fun((any(), #s{}) -&gt; #s{})}.
+%% '#lens-'(Attr, r) -&gt;
+%%     '#lens-r'(Attr);
+%% '#lens-'(Attr, s) -&gt;
+%%     '#lens-s'(Attr).
+%%
 %% -spec '#new-r'() -&gt; #r{}.
 %% '#new-r'() -&gt;
 %%     #r{}.
@ -261,6 +276,30 @@
 %% '#info-r'(size) -&gt;
 %%     record_info(size, r).
 %%
+%% -spec '#lens-r'('#prop-r'()) -&gt;
+%%                   {fun((#r{}) -&gt; any()), fun((any(), #r{}) -&gt; #r{})}.
+%% '#lens-r'(a) -&gt;
+%%     {fun(R) -&gt;
+%%             '#get-r'(a, R)
+%%      end,
+%%      fun(X, R) -&gt;
+%%             '#set-r'([{a,X}], R)
+%%      end};
+%% '#lens-r'(b) -&gt;
+%%     {fun(R) -&gt;
+%%             '#get-r'(b, R)
+%%      end,
+%%      fun(X, R) -&gt;
+%%             '#set-r'([{b,X}], R)
+%%      end};
+%% '#lens-r'(c) -&gt;
+%%     {fun(R) -&gt;
+%%             '#get-r'(c, R)
+%%      end,
+%%      fun(X, R) -&gt;
+%%             '#set-r'([{c,X}], R)
+%%      end}.
+%%
 %% -spec '#new-s'() -&gt; #s{}.
 %% '#new-s'() -&gt;
 %%     #s{}.
@ -324,6 +363,16 @@
 %% '#info-s'(size) -&gt;
 %%     record_info(size, s).
 %%
+%% -spec '#lens-s'('#prop-s'()) -&gt;
+%%                   {fun((#s{}) -&gt; any()), fun((any(), #s{}) -&gt; #s{})}.
+%% '#lens-s'(a) -&gt;
+%%     {fun(R) -&gt;
+%%             '#get-s'(a, R)
+%%      end,
+%%      fun(X, R) -&gt;
+%%             '#set-s'([{a,X}], R)
+%%      end}.
+%%
 %% f() -&gt;
 %%     {new,'#new-r'([])}.
 %%
@ -351,18 +400,20 @@
 %% atom (a valid function or type name).
 %%
 %% `operation' is one of:
-%% <ul>
-%% <li>`new'</li>
-%% <li>`get'</li>
-%% <li>`set'</li>
-%% <li>`fromlist'</li>
-%% <li>`info'</li>
-%% <li>`pos'</li>
-%% <li>`is_record'</li>
-%% <li>`convert'</li>
-%% <li>`prop'</li>
-%% <li>`attr'</li>
-%% </ul>
+%% <dl>
+%% <dt>`new'</dt> <dd>Creates a new record</dd>
+%% <dt>`get'</dt> <dd>Retrieves given attribute values from a record</dd>
+%% <dt>`set'</dt> <dd>Sets given attribute values in a record</dd>
+%% <dt>`fromlist'</dt> <dd>Creates a record from a key-value list</dd>
+%% <dt>`info'</dt> <dd>Equivalent to record_info/2</dd>
+%% <dt>`pos'</dt> <dd>Returns the position of a given attribute</dd>
+%% <dt>`is_record'</dt> <dd>Tests if a value is a specific record</dd>
+%% <dt>`convert'</dt> <dd>Converts an old record to the current version</dd>
+%% <dt>`prop'</dt> <dd>Used only in type specs</dd>
+%% <dt>`attr'</dt> <dd>Used only in type specs</dd>
+%% <dt>`lens'</dt> <dd>Returns a 'lens' (an accessor pair) as described in
+%%              [http://github.com/jlouis/erl-lenses]</dd>
+%% </dl>
 %%
 %% @end

@ -483,7 +534,8 @@ generate_f(attribute, {attribute,L,export_records,_} = Form, _Ctxt,
 	       {fname(is_record, Acc), 2},
 	       {fname(get, Acc), 2},
 	       {fname(set, Acc), 2},
-	       {fname(fromlist, Acc), 2} |
+	       {fname(fromlist, Acc), 2},
+	       {fname(lens, Acc), 2} |
 	       lists:flatmap(
 		 fun(Rec) ->
 			 RecS = atom_to_list(Rec),
@ -494,7 +546,8 @@ generate_f(attribute, {attribute,L,export_records,_} = Form, _Ctxt,
 			  {fname(pos, RecS, Acc), 1},
 			  {fname(fromlist, RecS, Acc), 1},
 			  {fname(fromlist, RecS, Acc), 2},
-			  {fname(info, RecS, Acc), 1}]
+			  {fname(info, RecS, Acc), 1},
+			  {fname(lens, RecS, Acc), 1}]
 		 end, Es)] ++ version_exports(Vsns, Acc),
    {[], Form,
     [{attribute,L,export,Exports}],
@ -610,7 +663,8 @@ generate_accessors(L, Acc) ->
       f_isrec_2(Acc, L),
       f_get(Acc, L),
       f_set(Acc, L),
-       f_fromlist(Acc, L) |
+       f_fromlist(Acc, L),
+       f_lens_(Acc, L)|
       lists:append(
 	 lists:map(
 	   fun(Rname) ->
@ -622,7 +676,8 @@ generate_accessors(L, Acc) ->
 		    f_fromlist_1(Rname, L, Acc),
 		    f_fromlist_2(Rname, Fields, L, Acc),
 		    f_pos_1(Rname, Fields, L, Acc),
-		    f_info_1(Rname, Acc, L)]
+		    f_info_1(Rname, Acc, L),
+		    f_lens_1(Rname, Fields, L, Acc)]
 	   end, Acc#pass1.exports))] ++ version_accessors(L, Acc)).

 get_flds(Rname, #pass1{records = Rs}) ->
@ -756,14 +811,14 @@ t_atom(L, A)     -> {atom, L, A}.
 t_integer(L)      -> {type, L, integer, []}.
 t_integer(L, I)   -> {integer, L, I}.
 t_list(L, Es)     -> {type, L, list, Es}.
-%% t_tuple(L, Es) -> {type, L, tuple, Es}.
+t_fun(L, As, Res) -> {type, L, 'fun', [{type, L, product, As}, Res]}.
+t_tuple(L, Es)    -> {type, L, tuple, Es}.
 t_record(L, A)   -> {type, L, record, [{atom, L, A}]}.

 f_set_2(Rname, Flds, L, Acc) ->
    Fname = fname(set, Rname, Acc),
    TRec = t_record(L, Rname),
-    [funspec(L, Fname, [t_list(L, [t_prop(L, Rname, Acc)]), TRec],
-	     TRec),
+    [funspec(L, Fname, [t_list(L, [t_prop(L, Rname, Acc)]), TRec], TRec),
     {function, L, Fname, 2,
      [{clause, L, [{var, L, 'Vals'}, {var, L, 'Rec'}], [],
 	[{match, L, {var, L, 'F'},
@ -1163,6 +1218,47 @@ f_convert(_Vsns, L, Acc) ->
                    {var, L, 'Discarded'}]}]
      }]}.

+f_lens_(#pass1{exports = Es} = Acc, L) ->
+    Fname = fname(lens, Acc),
+    [
+     funspec(L, Fname, [ {[t_prop(L, Rname, Acc), t_atom(L, Rname)],
+     			  t_tuple(L, [t_fun(L, [t_record(L, Rname)], t_any(L)),
+     				      t_fun(L, [t_any(L),
+     						t_record(L, Rname)],
+     					    t_record(L, Rname))])}
+     			 || Rname <- Es]),
+     {function, L, Fname, 2,
+      [{clause, L, [{var, L, 'Attr'}, {atom, L, Re}], [],
+	[{call, L, {atom, L, fname(lens, Re, Acc)}, [{var, L, 'Attr'}]}]}
+	 || Re <- Es]}
+    ].
+
+f_lens_1(Rname, Flds, L, Acc) ->
+    Fname = fname(lens, Rname, Acc),
+    [funspec(L, Fname, [ {[t_prop(L, Rname, Acc)],
+     			  t_tuple(L, [t_fun(L, [t_record(L, Rname)], t_any(L)),
+     				      t_fun(L, [t_any(L),
+     						t_record(L, Rname)],
+     					    t_record(L, Rname))])} ]),
+     {function, L, Fname, 1,
+      [{clause, L, [{atom, L, Attr}], [],
+	[{tuple, L, [{'fun', L,
+		      {clauses,
+		       [{clause, L, [{var, L, 'R'}], [],
+			 [{call, L, {atom, L, fname(get, Rname, Acc)},
+			   [{atom, L, Attr}, {var, L, 'R'}]}]}
+		       ]}},
+		     {'fun', L,
+		      {clauses,
+		       [{clause, L, [{var, L, 'X'}, {var, L, 'R'}], [],
+			 [{call, L, {atom, L, fname(set, Rname, Acc)},
+			   [{cons,L, {tuple, L, [{atom, L, Attr},
+						 {var, L, 'X'}]}, {nil,L}},
+			    {var, L, 'R'}]}]
+			}]}}
+		    ]}]} || Attr <- Flds]
+     }].
+
 %%% ========== generic parse_transform stuff ==============

 -spec context(atom(), #context{}) ->
--- a/src/parse_trans.erl
+++ b/src/parse_trans.erl
@ -291,9 +291,7 @@ function_exists(Fname, Arity, Forms) ->
    #context{}.
 initial_context(Forms, Options) ->
    File = get_file(Forms),
-%%    io:fwrite("File = ~p~n", [File]),
    Module = get_module(Forms),
-%%    io:fwrite("Module = ~p~n", [Module]),
    #context{file = File,
             module = Module,
             options = Options}.
@ -399,7 +397,6 @@ insert_below([F|Rest], Insert) ->
 optionally_pretty_print(Result, Options, Context) ->
    DoPP = option_value(pt_pp_src, Options, Result),
    DoLFs = option_value(pt_log_forms, Options, Result),
-    io:fwrite("DoPP = ~p; DoLFs = ~p~n", [DoPP, DoLFs]),
    File = Context#context.file,
    if DoLFs ->
 	    Out1 = outfile(File, forms),
@ -696,7 +693,6 @@ context(options,  #context{options = O} ) -> O.
 -spec do_inspect(insp_f(), term(), forms(), #context{}) ->
    term().
 do_inspect(F, Acc, Forms, Context) ->
-%%    io:fwrite("do_inspect/4~n", []),
    F1 =
        fun(Form, Acc0) ->
                Type = type(Form),