Add access to macro environment inside macros, first version

Macro functions now have two arguments, the whole argument list
of macro call, and the current macro environment in $ENV. This allows
explicitly expanding forms inside a macro definition. The shell now
supports this with a $ENV variable.

README

@@ -17,6 +17,13 @@ I will try to make a better fix soon. Sorry about that.
 v0.7
 ----
 
+Add access to current macro environment through the variable $ENV
+within macros which allows explicit macro expansion.
+
+First version of match-specifiction generator.
+
+Add ets/mnesia match patterns to records.
+
 Arithmetic functions + - * / and comparison functions > >= < =< == /=
 =:= =/= now take multiple arguments. This is experimental and as yet
 only implemented as macros.

ebin/lfe.app

@@ -3,6 +3,7 @@
               {vsn,"0.6.2"},
               {modules,[lfe_boot,lfe_codegen,lfe_comp,lfe_eval,lfe_gen,lfe_io,
                         lfe_io_format,lfe_io_pretty,lfe_lib,lfe_lint,
-                        lfe_macro,lfe_parse,lfe_pmod,lfe_scan,lfe_shell]},
+                        lfe_macro,lfe_ms,lfe_parse,lfe_pmod,lfe_scan,
+                        lfe_shell]},
               {registered,[]},
               {applications,[kernel,stdlib]}]}.

src/ChangeLog

@@ -1,3 +1,14 @@
+2011-06-15  Robert Virding  <rv@renat.local>
+
+	* lfe_shell.erl (macroexpand, macroexpand-1, macroexpand-all): No
+	longer shell functions.
+
+	* lfe_lib.erl (del_vbinding): New function.
+
+2011-06-14  Robert Virding  <rv@renat.local>
+
+	* lfe_io_pretty.erl (indent_type): Add funcall.
+
 2011-06-08  Robert Virding  <rv@renat.local>
 
 	* lfe_macro.erl (exp_predef): Add match-spec macro.

src/lfe_io_pretty.erl

@@ -206,6 +206,7 @@ indent_type('case') -> 1;
 indent_type('receive') -> 0;
 indent_type('catch') -> 0;
 indent_type('try') -> 1;
+indent_type('funcall') -> 1;
 indent_type('call') -> 2;
 indent_type('define-function') -> 1;
 indent_type('define-macro') -> 1;

src/lfe_lib.erl

@@ -32,7 +32,7 @@
 %% Environment functions.
 -export([new_env/0,add_env/2,
 	 add_vbinding/3,add_vbindings/2,is_vbound/2,get_vbinding/2,
-	 fetch_vbinding/2,update_vbinding/3,
+	 fetch_vbinding/2,update_vbinding/3,del_vbinding/2,
 	 add_fbinding/4,add_fbindings/2,update_fbinding/4,
 	 is_fbound/3,get_fbinding/3,add_ibinding/5,
 	 is_gbound/3,get_gbinding/3,
@@ -48,7 +48,9 @@
 %% Standard lisp library.
 -export([is_lfe_bif/2,acons/3,assoc/2,rassoc/2,
 	 subst/3,'subst-if'/3,'subst-if-not'/3,
-	 eval/1]).
+	 eval/1,eval/2,macroexpand/1,macroexpand/2,
+	 'macroexpand-1'/1,'macroexpand-1'/2,
+	 'macroexpand-all'/1,'macroexpand-all'/2]).
 
 %% Miscellaneous useful LFE functions.
 -export([format_exception/6,format_stacktrace/3]).
@@ -117,6 +119,10 @@ get_vbinding(_, []) -> no.
 fetch_vbinding(N, [{variable,N,V}|_]) -> V;
 fetch_vbinding(N, [_|Env]) -> fetch_vbinding(N, Env).
 
+del_vbinding(N, [{variable,N,_}|Env]) -> Env;
+del_vbinding(N, [Vb|Env]) -> [Vb|del_vbinding(N, Env)];
+del_vbinding(_, []) -> [].			%Be nice but should we
+
 add_fbinding(N, A, V, Env) -> [{function,N,A,V}|Env].
 
 add_fbindings(Fbs, Env) ->
@@ -255,7 +261,7 @@ is_core_form(_) -> false.
 %%  Process a (progn ... ) nested list of forms where top level list
 %%  has elements {Form,LineNumber}. Return a flat list of results and
 %%  passes through State. All the elements are processed left to
-%%  right.
+%%  right. The accumulator is in reverse order!
 
 proc_forms(Fun, Fs, St) -> proc_forms(Fun, Fs, [], St).
 
@@ -302,6 +308,9 @@ proc_forms_progn(_, [], _, Rs, St) ->
 %% subst-if(New, Test, Tree) -> Tree.
 %% subst-if-not(New, Test, Tree) -> Tree.
 %% eval(Sexpr) -> Value.
+%% macroexpand(Form [,Environment]) -> {yes,Expansion} | no.
+%% macroexpand-1(Form [,Environment]) -> {yes,Expansion} | no.
+%% macroexpand-all(Form [,Environment]) -> {yes,Expansion} | no.
 
 is_lfe_bif(acons, 3) -> true;
 is_lfe_bif(assoc, 2) -> true;
@@ -310,6 +319,13 @@ is_lfe_bif(subst, 3) -> true;
 is_lfe_bif('subst-if', 3) -> true;
 is_lfe_bif('subst-if-not', 3) -> true;
 is_lfe_bif(eval, 1) -> true;
+is_lfe_bif(eval, 2) -> true;
+is_lfe_bif(macroexpand, 1) -> true;
+is_lfe_bif(macroexpand, 2) -> true;
+is_lfe_bif('macroexpand-1', 1) -> true;
+is_lfe_bif('macroexpand-1', 2) -> true;
+is_lfe_bif('macroexpand-all', 1) -> true;
+is_lfe_bif('macroexpand-all', 2) -> true;
 is_lfe_bif(_, _) -> false.
 
 acons(K, V, Alist) -> [[K|V]|Alist].
@@ -355,7 +371,25 @@ subst(_, _, Tree) -> Tree.
 	    end
     end.
 
-eval(Sexpr) -> lfe_eval:expr(Sexpr, new_env()).	%Empty environment.
+eval(Sexpr) -> eval(Sexpr, new_env()).		%Empty environment.
+eval(Sexpr, Env) -> lfe_eval:expr(Sexpr, Env).
+
+macroexpand(Form) -> macroexpand(Form, new_env()).
+macroexpand(Form, Env) ->
+    case lfe_macro:expand_expr(Form, Env) of
+	{yes,Exp} -> Exp;
+	no -> Form
+    end.
+
+'macroexpand-1'(Form) -> 'macroexpand-1'(Form, new_env()).
+'macroexpand-1'(Form, Env) ->
+    case lfe_macro:expand_expr_1(Form, Env) of
+	{yes,Exp} -> Exp;
+	no -> Form
+    end.
+
+'macroexpand-all'(Form) -> 'macroexpand-all'(Form, new_env()).
+'macroexpand-all'(Form, Env) -> lfe_macro:expand_expr_all(Form, Env).
 
 %% Miscellaneous useful LFE functions.
 

src/lfe_macro.erl

@@ -507,7 +507,7 @@ exp_userdef_macro([Mac|Args], Def0, Env, St0) ->
 %%	{Exp,St1}.
     try
 	{Def1,St1} = expand(Def0, Env, St0),	%Expand definition
-	Exp = lfe_eval:apply(Def1, [Args], Env),
+	Exp = lfe_eval:apply(Def1, [Args,Env], Env),
 	{yes,Exp,St1}
     catch
 	error:Error ->
@@ -711,8 +711,6 @@ exp_predef(['define',Head|Body], _, St) ->
 exp_predef(['define-record'|Def], _, St) ->
     {yes,[defrecord|Def],St};
 exp_predef(['define-syntax',Name,Def], _, St) ->
-    %% N.B. New macro definition is function of 1 argument, whole
-    %% argument list of macro call.
     Mdef = exp_syntax(Name, Def),
     {yes,['define-macro'|Mdef],St};
 exp_predef(['let-syntax',Defs|Body], _, St) ->
@@ -732,8 +730,6 @@ exp_predef([defmacro,Name|Def], _, St) ->
     Mdef = exp_defmacro(Name, Def),
     {yes,['define-macro'|Mdef],St};
 exp_predef([defsyntax,Name|Rules], _, St) ->
-    %% Expand into call function which expands macro an invocation
-    %% time, this saves much space and costs us nothing.
     {yes,['define-macro'|exp_rules(Name, [], Rules)],St};
 exp_predef([flet,Defs|Body], _, St) ->
     Fdefs = map(fun ([Name|Def]) -> exp_defun(Name, Def) end, Defs),
@@ -830,17 +826,17 @@ exp_defun(Name, [Args|Rest]) ->
 %%  Educated guess whether traditional (defmacro name (a1 a2 ...) ...)
 %%  or matching (defmacro name (patlist1 ...) (patlist2 ...)). Special
 %%  case (defmacro name arg ...) to make arg be whole argument list.
-%%  N.B. New macro definition is function of 1 argument, whole
-%%  argument list of macro call.
+%%  N.B. New macro definition is function of 2 arguments, the whole
+%%  argument list of macro call, and the current macro environment.
 
 exp_defmacro(Name, [Args|Rest]=Cls) ->
     case is_symb_list(Args) of
-	true -> [Name,['match-lambda',[[[list|Args]]|Rest]]];
+	true -> [Name,['match-lambda',[[[list|Args],'$ENV']|Rest]]];
 	false ->
 	    if is_atom(Args) ->			%Args is symbol
-		    [Name,['match-lambda',[[Args]|Rest]]];
+		    [Name,['match-lambda',[[Args,'$ENV']|Rest]]];
 	       true ->
-		    Mcls = map(fun ([Head|Body]) -> [[Head]|Body] end, Cls),
+		    Mcls = map(fun ([Head|Body]) -> [[Head,'$ENV']|Body] end, Cls),
 		    [Name,['match-lambda'|Mcls]]
 	    end
     end.
@@ -941,13 +937,13 @@ exp_defrec_fields(Fs, Name, St) ->
 	   end, [], Fis), St}.
 
 %% exp_syntax(Name, Def) -> Lambda | MatchLambda.
-%%  N.B. New macro definition is function of 1 argument, whole
-%%  argument list of macro call.
+%%  N.B. New macro definition is function of 2 arguments, the whole
+%%  argument list of macro call, and the current macro environment.
 
 exp_syntax(Name, Def) ->
     case Def of
 	[macro|Cls] ->
-	    Mcls = map(fun ([Pat|Body]) -> [[Pat]|Body] end, Cls),
+	    Mcls = map(fun ([Pat|Body]) -> [[Pat,'$ENV']|Body] end, Cls),
 	    [Name,['match-lambda'|Mcls]];
 	['syntax-rules'|Rules] ->
 	    exp_rules(Name, [], Rules)
@@ -956,9 +952,11 @@ exp_syntax(Name, Def) ->
 %% exp_rules(Name, Keywords, Rules) -> Lambda.
 %%  Expand into call function which expands macro an invocation time,
 %%  this saves much space and costs us nothing.
+%%  N.B. New macro definition is function of 2 arguments, the whole
+%%  argument list of macro call, and the current macro environment.
 
 exp_rules(Name, Keywords, Rules) ->
-    [Name,[lambda,[args],
+    [Name,[lambda,[args,'$ENV'],
 	   [':',lfe_macro,mbe_syntax_rules_proc,
 	    [quote,Name],[quote,Keywords],[quote,Rules],args]]].
 

src/lfe_shell.erl

@@ -33,7 +33,7 @@
 
 -import(lfe_lib, [new_env/0,add_env/2,
 		  add_vbinding/3,add_vbindings/2,is_vbound/2,get_vbinding/2,
-		  fetch_vbinding/2,update_vbinding/3,
+		  fetch_vbinding/2,update_vbinding/3,del_vbinding/2,
 		  add_fbinding/4,add_fbindings/3,get_fbinding/3,add_ibinding/5,
 		  get_gbinding/3,add_mbinding/3]).
 
@@ -97,20 +97,25 @@ server_loop(Env0, BaseEnv) ->
 	  end,
     server_loop(Env, BaseEnv).
 
-add_shell_vars(Env) ->
+add_shell_vars(Env0) ->
     %% Add default shell expression variables.
-    foldl(fun (Symb, E) -> add_vbinding(Symb, [], E) end, Env,
-	  ['+','++','+++','-','*','**','***']).
-
-update_shell_vars(Form, Value, Env) ->
-    foldl(fun ({Symb,Val}, E) -> update_vbinding(Symb, Val, E) end,
-	  Env,
-	  [{'+++',fetch_vbinding('++', Env)},
-	   {'++',fetch_vbinding('+', Env)},
-	   {'+',Form},
-	   {'***',fetch_vbinding('**', Env)},
-	   {'**',fetch_vbinding('*', Env)},
-	   {'*',Value}]).
+    Env1 = foldl(fun (Symb, E) -> add_vbinding(Symb, [], E) end, Env0,
+		 ['+','++','+++','-','*','**','***']),
+    add_vbinding('$ENV', Env1, Env1).		%This gets it all
+
+update_shell_vars(Form, Value, Env0) ->
+    Env1 = foldl(fun ({Symb,Val}, E) -> update_vbinding(Symb, Val, E) end,
+		 Env0,
+		 [{'+++',fetch_vbinding('++', Env0)},
+		  {'++',fetch_vbinding('+', Env0)},
+		  {'+',Form},
+		  {'***',fetch_vbinding('**', Env0)},
+		  {'**',fetch_vbinding('*', Env0)},
+		  {'*',Value}]),
+    %% Be cunning with $ENV, remove self references so it doesn't grow
+    %% indefinitely.
+    Env2 = del_vbinding('$ENV', Env1),
+    add_vbinding('$ENV', Env2, Env2).
 
 add_shell_macros(Env0) ->
     %% We write macros in LFE and expand them with macro package.
@@ -158,12 +163,6 @@ eval_internal([l|Args], Eenv, Benv) ->		%Load modules
     l(Args, Eenv, Benv);
 eval_internal([m|Args], Eenv, Benv) ->		%Module info
     m(Args, Eenv, Benv);
-eval_internal([macroexpand,S], Eenv, Benv) ->	%Macroexpand top of form
-    macroexpand(S, Eenv, Benv);
-eval_internal(['macroexpand-1',S], Eenv, Benv) ->
-    macroexpand_1(S, Eenv, Benv);
-eval_internal(['macroexpand-all',S], Eenv, Benv) ->
-    macroexpand_all(S, Eenv, Benv);
 eval_internal([set|Args], Eenv, Benv) ->	%Set variables in shell
     set(Args, Eenv, Benv);
 eval_internal(_, _, _) -> no.			%Not an internal function
@@ -212,30 +211,6 @@ m([], Eenv, _) -> {yes,c:m(),Eenv};
 m(Args, Eenv, _) ->
     {yes,map(fun (M) -> c:m(lfe_eval:expr(M, Eenv)) end, Args), Eenv}.
 
-%% macroexpand(Sexpr, EvalEnv, BaseEnv) -> {yes,Res,Env}.
-%% macroexpand_1(Sexpr, EvalEnv, BaseEnv) -> {yes,Res,Env}.
-%% macroexpand_all(Sexpr, EvalEnv, BaseEnv) -> {yes,Res,Env}.
-%%  We special case these at shell level so as to get shell environment.
-
-macroexpand(S, Eenv, _) ->
-    Arg = lfe_eval:expr(S, Eenv),
-    case lfe_macro:expand_expr(Arg, Eenv) of
-	{yes,Exp} -> {yes,Exp,Eenv};
-	no -> {yes,Arg,Eenv}
-    end.
-
-macroexpand_1(S, Eenv, _) ->
-    Arg = lfe_eval:expr(S, Eenv),
-    case lfe_macro:expand_expr_1(Arg, Eenv) of
-	{yes,Exp} -> {yes,Exp,Eenv};
-	no -> {yes,Arg,Eenv}
-    end.
-
-macroexpand_all(S, Eenv, _) ->
-    Arg = lfe_eval:expr(S, Eenv),
-    Exp = lfe_macro:expand_expr_all(Arg, Eenv),
-    {yes,Exp,Eenv}.
-
 %% set(Args, EvalEnv, BaseEnv) -> {yes,Result,Env} | no.
 
 set([Pat,Exp], Eenv, _) ->