Select syntax parse transform

[Sean Hinde]

Hi all,

Well, I've had a go at a parse transform for the match syntax stuff. It
seems to work on some small test programs..

The idea is that in one of the standard select statements (ets:select/2,3,
mnesia:select/2,3, ets:test_ms/2) you can use a fun like syntax rather than
the standard select syntax. e.g.

-module(test).

-compile({parse_transform,match_id_trans}).
-compile(export_all).

main() ->
    ets:test_ms({1,2}, fun({'$1','$2'}) when '$1' + '$2' == 3,
is_integer('$1') ->
			           '$1' + '$2'
		           end).

main2() ->
    A="se",
    ets:test_ms({"sean",2}, fun({A++"en",'$2'})  ->
				          '$_'
			          end).

You can also have multiple function headers in your fun like:

fun({A++"an",'$2'}) ->
      '$_';
   ({1,2}) ->
      ok
end

It is a hack of erl_id_trans. I didn't bother with trying to ensure that
only guard functions are used as the final syntax is checked at runtime
anyway. I'm pretty sure there will be bugs (well it is rather late - that's
my excuse anyway!)

Sorry Francesco - no support for your tracing problems.. though a bit of
erl_scan and erl_parse might make a neat transform function Hmmm.

Sean

----------------------------------------------------------------------------
---
-module(match_id_trans).

%% A identity transformer of Erlang abstract syntax.

%% This module only traverses legal Erlang code. This is most noticeable
%% in guards where only a limited number of expressions are allowed.
%% N.B. if this module is to be used as a basis for tranforms then
%% all the error cases must be handled otherwise this module just crashes!

%% Modified by Sean Hinde to do parse transforms for select syntax

%%e.g. ets:select(tab, fun({'$1', '$2'}) when is_integer('$1') ->
%%			     '$_'
%%		     end).

%%-compile([export_all]).
-export([parse_transform/2]).

parse_transform(Forms, Options) ->
    forms(Forms).

%% forms(Fs) -> lists:map(fun (F) -> form(F) end, Fs).

forms([F0|Fs0]) ->
    F1 = form(F0),
    Fs1 = forms(Fs0),
    [F1|Fs1];
forms([]) -> [].

form({function,Line,Name0,Arity0,Clauses0}) ->
    {Name,Arity,Clauses} = function(Name0, Arity0, Clauses0),
    {function,Line,Name,Arity,Clauses};
form(Else) ->
    Else.

function(Name, Arity, Clauses0) ->
    Clauses1 = clauses0(Clauses0),
    {Name,Arity,Clauses1}.

clauses0([C0|Cs]) ->
    C1 = clause0(C0),
    [C1|clauses0(Cs)];
clauses0([]) -> [].

clause0({clause,Line,H0,G0,B0}) ->
    B1 = exprs0(B0),
    {clause,Line,H0,G0,B1}.

%% -type exprs([Expression]) -> [Expression].
%%  These expressions are processed "sequentially" for purposes of variable
%%  definition etc.

exprs0([E0|Es]) ->
    E1 = expr0(E0),
    [E1|exprs0(Es)];
exprs0([]) -> [].


%% -type expr(Expression) -> Expression.

expr0({call,Line,F0,As0}) ->
    case is_select_call(F0, length(As0)) of
	true ->
	    select_trans(Line, F0, As0);
	false ->
	    {call,Line,F0,As0}
    end;
expr0(Else) ->
    Else.

is_select_call({remote, _, {atom, _, M}, {atom, _, F}}, A) ->
    is_select_call1(M,F,A);
is_select_call(_, _) ->
    false.

% 2nd arg is always the match spec which is nice for us
is_select_call1(ets, select, 2) -> true;
is_select_call1(ets, select, 3) -> true;
is_select_call1(ets, test_ms, 2) -> true;
is_select_call1(mnesia, dirty_select, 2) -> true;
is_select_call1(mnesia, select, 2) -> true;
is_select_call1(mnesia, select, 3) -> true;
is_select_call1(_, _, _) -> false.

% first check if it looks like a normal select syntax..
select_trans(Line, F0, [A1, {cons, L, H, T}|T1]) ->
    {call,Line,F0,[A1, {cons, L, H, T}|T1]};
select_trans(Line, F0, [A1, Fun|T]) ->
    Sel = fun_to_sel(Fun),
    {call,Line,F0,[A1, Sel|T]}.

fun_to_sel({'fun', Line, {clauses, Cs}}) ->
    fun_clauses(Cs).


fun_clauses([{clause,Line,[H0],G0,B0}|Cs]) ->
    G1 = if G0 == [] -> [];
	    true  -> hd(G0)
	 end,
    G2 = guard(G1),
    B1 = guard(B0),
    {cons, Line, {tuple, Line, [H0,G2,B1]}, fun_clauses(Cs)};
fun_clauses([]) -> {nil, 23}.

% can only have simple guard tests, not compound (e.g is_integer(A);A=1)
guard([G0|Gs]) ->
    {Line, G1} = guard_test(G0),
    {cons, Line, G1, guard(Gs)};
guard([]) -> {nil, 1}.

%% -type guard_test(GuardTest) -> GuardTest.
%%  All function calls here must be type tests and only comparison
%%  operators are allowed here! Note record/2 tests are special and
%%  will be expanded later.

guard_test({atom,Line,Atom}) -> {Line, {atom,Line,Atom}};
guard_test({call,Line,{atom,La,F},[As0]}) ->
    As1 = gexpr(As0),
    {Line,{tuple, Line, [{atom,La,F},As1]}};
guard_test({op,Line,Op,L0,R0}) ->
    L1 = gexpr(L0),
    R1 = gexpr(R0),			%They see the same variables
    {Line,{tuple, Line, [{atom, Line, Op},L1,R1]}}.

%% -type gexpr(GuardExpr) -> GuardExpr.


gexpr({call,Line,{atom,La,F},As0}) ->
    As1 = gexpr_list(As0),
    {tuple,Line,{atom,La,F},As1};
gexpr({op,Line,Op,A0}) ->
    A1 = gexpr(A0),
    {tuple,Line,[{atom, Line, Op},A1]};
gexpr({op,Line,Op,L0,R0}) ->
    L1 = gexpr(L0),
    R1 = gexpr(R0),			%They see the same variables
    {tuple,Line,[{atom, Line, Op},L1,R1]};
gexpr(Else) -> Else.

%% -type gexpr_list([GuardExpr]) -> [GuardExpr].
%%  These expressions are processed "in parallel" for purposes of variable
%%  definition etc.

gexpr_list([E0|Es]) ->
    E1 = gexpr(E0),
    [E1|gexpr_list(Es)];
gexpr_list([]) -> [].



NOTICE AND DISCLAIMER:
This email (including attachments) is confidential.  If you have received
this email in error please notify the sender immediately and delete this
email from your system without copying or disseminating it or placing any
reliance upon its contents.  We cannot accept liability for any breaches of
confidence arising through use of email.  Any opinions expressed in this
email (including attachments) are those of the author and do not necessarily
reflect our opinions.  We will not accept responsibility for any commitments
made by our employees outside the scope of our business.  We do not warrant
the accuracy or completeness of such information.