%% -*- mode: erlang; erlang-indent-level: 2 -*- %%% Author : Mats Cronqvist %%% Created : 10 Mar 2010 by Mats Cronqvist %% msc - match spec compiler %% transforms a string to a call trace expression; %% {MFA,MatchSpec} == {{M,F,A},{Head,Cond,Body}} -module('redbug_msc'). -export([transform/1]). transform(E) -> try compile(parse(to_string(E))) catch throw:{R,Info} -> exit({syntax_error,{R,Info}}) end. -define(is_string(Str), (Str=="" orelse (9= atom_to_list(A); to_string(S) when ?is_string(S) -> S; to_string(X) -> throw({illegal_input,X}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% compiler %% returns {{Module,Function,Arity},[{Head,Cond,Body}],[Flag]} %% i.e. the args to erlang:trace_pattern/3 compile({Mod,F,As,Gs,Acts}) -> {Fun,Arg} = compile_function(F,As), {Vars,Args} = compile_args(As), Guards = compile_guards(Gs,Vars), Actions = compile_acts(Acts), Flags = compile_flags(F,Acts), {{Mod,Fun,Arg},[{Args,Guards,Actions}],Flags}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% compile function name compile_function(' ',_) -> {'_','_'}; compile_function(F,'_') -> {F,'_'}; compile_function(F,As) -> {F,length(As)}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% compile argument list compile_args('_') -> {[{'$_','$_'}],'_'}; compile_args(As) -> lists:foldl(fun ca_fun/2,{[],[]},As). ca_fun({map,Map},{Vars,O}) -> {Vs,Ps} = ca_map(Map,Vars), {Vs,O++[maps:from_list(Ps)]}; ca_fun({list,Es},{Vars,O}) -> {Vs,Ps} = ca_list(Es,Vars), {Vs,O++[Ps]}; ca_fun({tuple,Es},{Vars,O}) -> {Vs,Ps} = ca_list(Es,Vars), {Vs,O++[list_to_tuple(Ps)]}; ca_fun({var,'_'},{Vars,O}) -> {Vars,O++['_']}; ca_fun({var,Var},{Vars,O}) -> V = get_var(Var, Vars), {[{Var,V}|Vars],O++[V]}; ca_fun({Type,Val},{Vars,O}) -> assert_type(Type,Val), {Vars,O++[Val]}. ca_map(Fs,Vars) -> cfm(Fs,{Vars,[]}). cfm([],O) -> O; cfm([{K,V}|Fs],{V0,P0}) -> {[],[PK]} = ca_fun(K,{[],[]}), {Vs,[PV]} = ca_fun(V,{V0,[]}), cfm(Fs,{lists:usort(V0++Vs),P0++[{PK,PV}]}). ca_list(Es,Vars) -> cfl(Es,{Vars,[]}). cfl([],O) -> O; cfl([E|Es],{V0,P0}) when is_list(Es) -> {V,P} = ca_fun(E,{V0,[]}), cfl(Es,{lists:usort(V0++V),P0++P}); cfl([E1|E2],{V0,P0}) -> %% non-proper list / tail match {V1,[P1]} = ca_fun(E1,{V0,[]}), {V2,[P2]} = ca_fun(E2,{lists:usort(V0++V1),[]}), {lists:usort(V0++V1++V2),P0++[P1|P2]}. get_var(Var,Vars) -> case proplists:get_value(Var,Vars) of undefined -> list_to_atom("\$"++integer_to_list(length(Vars)+1)); X -> X end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% compile guards compile_guards(Gs,Vars) -> {Vars,O} = lists:foldr(fun gd_fun/2,{Vars,[]},Gs), O. gd_fun({Op,As},{Vars,O}) when is_list(As) -> % function {Vars,[unpack_op(Op,As,Vars)|O]}; gd_fun({Op,V},{Vars,O}) -> % unary {Vars,[{Op,unpack_var(V,Vars)}|O]}; gd_fun({Op,V1,V2},{Vars,O}) -> % binary {Vars,[{Op,unpack_var(V1,Vars),unpack_var(V2,Vars)}|O]}. unpack_op(Op,As,Vars) -> list_to_tuple([Op|[unpack_var(A,Vars)||A<-As]]). unpack_var({map,M},Vars) -> maps:from_list([{unpack_var(K,Vars),unpack_var(V,Vars)}||{K,V}<-M]); unpack_var({tuple,Es},Vars) -> {list_to_tuple([unpack_var(E,Vars)||E<-Es])}; unpack_var({list,Es},Vars) -> [unpack_var(E,Vars)||E<-Es]; unpack_var({string,S},_) -> S; unpack_var({var,Var},Vars) -> case proplists:get_value(Var,Vars) of undefined -> throw({unbound_var,Var}); V -> V end; unpack_var({Op,As},Vars) when is_list(As) -> unpack_op(Op,As,Vars); unpack_var({Op,V1,V2},Vars) -> unpack_op(Op,[V1,V2],Vars); unpack_var({Type,Val},_) -> assert_type(Type,Val), Val. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% compile trace flags compile_flags(F,Acts) -> LG = case F of ' ' -> global; _ -> local end, lists:foldr(fun(E,A)->try [fl_fun(E)|A] catch _:_ -> A end end,[LG],Acts). fl_fun("count") -> call_count; fl_fun("time") -> call_time. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% compile actions compile_acts(As) -> lists:foldr(fun(E,A)->try [ac_fun(E)|A] catch _:_ -> A end end,[],As). ac_fun("stack") -> {message,{process_dump}}; ac_fun("return")-> {exception_trace}. assert_type(Type,Val) -> case lists:member(Type,[integer,atom,string,char,bin]) of true -> ok; false-> throw({bad_type,{Type,Val}}) end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% parser %% accepts strings like; %% "a","a:b","a:b/2","a:b(X,y)", %% "a:b(X,Y)when is_record(X,rec) and Y==0, (X==z)" %% "a:b->stack", "a:b(X)whenX==2->return" %% returns %% {atom(M),atom(F),list(Arg)|atom('_'),list(Guard),list(Action)} parse(Str) -> {Body,Guard,Action} = split(Str), {M,F,A} = body(Body), Guards = guards(Guard), Actions = actions(Action), {M,F,A,Guards,Actions}. %% split the input string in three parts; body, guards, actions %% we parse them separately split(Str) -> %% strip off the actions, if any {St,Action} = case re:run(Str,"^(.+)->\\s*([a-z;,]+)\\s*\$",[{capture,[1,2],list}]) of {match,[Z,A]} -> {Z,A}; nomatch -> {Str,""} end, %% strip off the guards, if any {Body,Guard} = case re:run(St,"^(.+[\\s)])+when\\s(.+)\$",[{capture,[1,2],list}]) of {match,[Y,G]} -> {Y,G}; nomatch -> {St,""} end, {Body,Guard,Action}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% parse body body(Str) -> case erl_scan:tokens([],Str++". ",1) of {done,{ok,Toks,1},[]} -> case erl_parse:parse_exprs(Toks) of {ok,[{op,_,'/',{remote,_,{atom,_,M},{atom,_,F}},{integer,_,Ari}}]} -> {M,F,lists:duplicate(Ari,{var,'_'})}; % m:f/2 {ok,[{call,_,{remote,_,{atom,_,M},{atom,_,F}},Args}]} -> {M,F,[arg(A) || A<-Args]}; % m:f(...) {ok,[{call,_,{remote,_,{atom,_,M},{var,_,'_'}},Args}]} -> {M,' ',[arg(A) || A<-Args]}; % m:_(...) {ok,[{call,_,{remote,_,{atom,_,M},{var,_,_}},Args}]} -> {M,' ',[arg(A) || A<-Args]}; % m:V(...) {ok,[{remote,_,{atom,_,M},{atom,_,F}}]} -> {M,F,'_'}; % m:f {ok,[{remote,_,{atom,_,M},{var,_,'_'}}]} -> {M,' ','_'}; % m:_ {ok,[{remote,_,{atom,_,M},{var,_,_}}]} -> {M,' ','_'}; % m:V {ok,[{atom,_,M}]} -> {M,'_','_'}; % m {ok,C} -> throw({parse_error,C}); {error,{_,erl_parse,L}} -> throw({parse_error,lists:flatten(L)}) end; _ -> throw({scan_error,Str}) end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% parse guards guards("") -> ""; guards(Str) -> case erl_scan:tokens([],Str++". ",1) of {done,{ok,Toks,1},[]} -> case erl_parse:parse_exprs(disjunct_guard(Toks)) of {ok,Guards} -> [guard(G)||G<-Guards]; {error,{_,erl_parse,L}} -> throw({parse_error,lists:flatten(L)}) end; _ -> throw({scan_error,Str}) end. %% deal with disjunct guards by replacing ';' with 'orelse' disjunct_guard(Toks) -> [case T of {';',1} -> {'orelse',1}; _ -> T end||T<-Toks]. guard({call,_,{atom,_,G},As}) -> {G,[guard(A) || A<-As]}; % function guard({op,_,Op,One,Two}) -> {Op,guard(One),guard(Two)};% binary op guard({op,_,Op,One}) -> {Op,guard(One)}; % unary op guard(Guard) -> arg(Guard). % variable %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% parse actions actions(Str) -> Acts = string:tokens(Str,";,"), [throw({unknown_action,A}) || A <- Acts,not lists:member(A,acts())], Acts. acts() -> ["stack","return","time","count"]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% parse arguments arg({op,_,'++',A1,A2}) -> plusplus(A1,A2); arg({nil,_}) -> {list,[]}; arg({cons,_,H,T}) -> {list,arg_list({cons,1,H,T})}; arg({tuple,_,Args}) -> {tuple,[arg(A)||A<-Args]}; arg({map,_,Map}) -> {map,[{arg(K),arg(V)}||{_,_,K,V}<-Map]}; arg({bin,_,Bin}) -> {bin,eval_bin(Bin)}; arg({T,_,Var}) -> {T,Var}. plusplus({string,_,[]},Var) -> arg(Var); plusplus({string,_,St},Var) -> {list,arg_list(consa(St,Var))}; plusplus(A1,A2) -> throw({illegal_plusplus,{A1,A2}}). consa([C],T) -> {cons,1,{char,1,C},T}; consa([C|Cs],T) -> {cons,1,{char,1,C},consa(Cs,T)}. arg_list({cons,_,H,T}) -> [arg(H)|arg_list(T)]; arg_list({nil,_}) -> []; arg_list(V) -> arg(V). eval_bin(Bin) -> try {value,B,[]} = erl_eval:expr({bin,1,Bin},[]), B catch _:R -> throw({bad_binary,R}) end.