From 5ee43a7f45cbef44f849cf73cf19cbad9b696da5 Mon Sep 17 00:00:00 2001 From: Robert Virding Date: Thu, 17 Sep 2009 01:12:49 +0200 Subject: [PATCH] Lambda args can now have don't care variables, plus small cleanups. --- examples/lfe_eval.lfe | 19 ++++++++++--------- src/ChangeLog | 13 +++++++++++++ src/lfe_codegen.erl | 24 ++++++++++++++---------- src/lfe_eval.erl | 7 +++++-- src/lfe_io_pretty.erl | 12 ++++++++---- src/lfe_lint.erl | 10 +++------- test/{test_bin.erl => test_bin_e.erl} | 4 ++-- 7 files changed, 55 insertions(+), 34 deletions(-) rename test/{test_bin.erl => test_bin_e.erl} (97%) diff --git a/examples/lfe_eval.lfe b/examples/lfe_eval.lfe index bce33b97..e41d414a 100644 --- a/examples/lfe_eval.lfe +++ b/examples/lfe_eval.lfe @@ -269,13 +269,13 @@ ))) (defun eval-lambda (vals args body env) - (let ((env (bind-args args vals env))) - (eval-body body env))) - -(defun bind-args - (((a . as) (e . es) env) (when (is_atom a)) - (bind-args as es (add_vbinding a e env))) - ((() () env) env)) + (fletrec ((bind-args + ([('_ . as) (_ . es) env] ;Ignore don't care variables + (bind-args as es env)) + ([(a . as) (e . es) env] (when (is_atom a)) + (bind-args as es (add_vbinding a e env))) + ([() () env] env))) + (eval-body body (bind-args args vals env)))) (defun eval-match-lambda (cls env) ;; This is a really ugly hack! @@ -313,12 +313,13 @@ (defun eval-match-clauses (as cls env) (case cls - (((pats . body) . cls) + ([(pats . body) . cls] (if (== (length as) (length pats)) (case (match-when pats as body env) ((tuple 'yes body1 vbs) (eval-body body1 (add_vbindings vbs env))) ('no (eval-match-clauses as cls env))) - (eval-match-clauses as cls env))))) + (: erlang error 'badarity))) + ([_ _] (: erlang error 'function_clause)))) ;; (eval-let (PatBindings . Body) Env) -> Value. diff --git a/src/ChangeLog b/src/ChangeLog index 05c1d1e4..f0911603 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,16 @@ +2009-09-16 Robert Virding + + * lfe_eval.erl (eval-lambda): Lambda args can now hold don't care + variable. + + * lfe_lint.erl (check_lambda_args): Lambda args can now hold don't + care variable. + + * lfe_codegen.erl (comp_lambda): Lambda args can now hold don't + care variable. + (comp_let): Simple lets without matching can now hold don't care + variables. + 2009-08-31 Robert Virding * lfe_io_pretty.erl (print1_list_max, print1_tail_max): Get it diff --git a/src/lfe_codegen.erl b/src/lfe_codegen.erl index e31b8f69..08a8ffb2 100644 --- a/src/lfe_codegen.erl +++ b/src/lfe_codegen.erl @@ -341,10 +341,15 @@ comp_args(As, Env, L, St) -> %% Compile a (lambda (...) ...). comp_lambda(Args, Body, Env, L, St0) -> - Pvs = foldl(fun (A, Pvs) -> add_element(A, Pvs) end, [], Args), - Cvs = map(fun (A) -> c_var(A, L) end, Args), - {Cb,St1} = comp_body(Body, add_vbindings(Pvs, Env), L, St0), - {c_fun(Cvs, Cb, L),St1}. + {Cvs,Pvs,St1} = comp_lambda_args(Args, L, St0), + {Cb,St2} = comp_body(Body, add_vbindings(Pvs, Env), L, St1), + {c_fun(Cvs, Cb, L),St2}. + +comp_lambda_args(Args, L, St) -> + foldr(fun (A, {Cvs,Pvs0,St0}) -> + {Cv,Pvs1,St1} = pat_symb(A, L, Pvs0, St0), + {[Cv|Cvs],Pvs1,St1} + end, {[],[],St}, Args). lambda_arity([Args|_]) -> length(Args). @@ -398,15 +403,14 @@ comp_let(Vbs, B, Env, L, St0) -> case Simple of true -> %% This is not really necessary, but fun. - Pvs = foldl(fun ([V|_], Pvs) -> add_element(V, Pvs) end, [], Vbs), - Cvs = map(fun ([V|_]) -> c_var(V, L) end, Vbs), - {Ces,St1} = mapfoldl(fun ([_,E], St) -> comp_expr(E, Env, L, St) end, - St0, Vbs), - {Cb,St2} = comp_body(B, add_vbindings(Pvs, Env), L, St1), + {Cvs,Pvs,St1} = comp_lambda_args([ V || [V|_] <- Vbs ], L, St0), + {Ces,St2} = mapfoldl(fun ([_,E], St) -> comp_expr(E, Env, L, St) end, + St1, Vbs), + {Cb,St3} = comp_body(B, add_vbindings(Pvs, Env), L, St2), {#c_let{anno=[L], vars=Cvs, arg=c_values(Ces, L), - body=Cb},St2}; + body=Cb},St3}; false -> %% This would be much easier to do by building a clause %% and compiling it directly. but then we would have to diff --git a/src/lfe_eval.erl b/src/lfe_eval.erl index 604afcf1..c801d466 100644 --- a/src/lfe_eval.erl +++ b/src/lfe_eval.erl @@ -308,6 +308,8 @@ eval_lambda(Vals, Args, Body, Env0) -> Env1 = bind_args(Args, Vals, Env0), eval_body(Body, Env1). +bind_args(['_'|As], [_|Es], Env) -> %Ignore don't care variables + bind_args(As, Es, Env); bind_args([A|As], [E|Es], Env) when is_atom(A) -> bind_args(As, Es, add_vbinding(A, E, Env)); bind_args([], [], Env) -> Env. @@ -354,8 +356,9 @@ eval_match_clauses(Vals, [[Pats|B0]|Cls], Env) -> {yes,B1,Vbs} -> eval_body(B1, add_vbindings(Vbs, Env)); no -> eval_match_clauses(Vals, Cls, Env) end; - true -> eval_match_clauses(Vals, Cls, Env) - end. + true -> erlang:error(badarity) + end; +eval_match_clauses(_, _, _) -> erlang:error(function_clause). eval_let([Vbs|Body], Env0) -> Env1 = foldl(fun ([Pat,E], Env) -> diff --git a/src/lfe_io_pretty.erl b/src/lfe_io_pretty.erl index d855583e..511a61ff 100644 --- a/src/lfe_io_pretty.erl +++ b/src/lfe_io_pretty.erl @@ -116,11 +116,13 @@ print1_list_max([], _, _, _) -> {yes,[]}. %% print1_tail_max(Tail, Depth, Indentation, LineLength) -> {yes,Chars} | no. %% Maybe print the tail of a list on one line, but abort if it goes -%% past LineLength. We know about dotted pairs. +%% past LineLength. We know about dotted pairs. When we reach depth 0 +%% we just quit as we know necessary "..." will have come from an +%% earlier print1 at same depth. print1_tail_max(_, _, I, L, _) when I >= L -> no; %No more room -print1_tail_max([], _, _, _, Acc) -> {yes,reverse(Acc)}; print1_tail_max(_, 0, _, _, Acc) -> {yes,reverse(Acc)}; +print1_tail_max([], _, _, _, Acc) -> {yes,reverse(Acc)}; print1_tail_max([Car|Cdr], D, I, L, Acc) -> Cs = print1(Car, D-1, 0, 99999), %Never break the line print1_tail_max(Cdr, D-1, I + flatlength(Cs) + 1, L, [Cs," "|Acc]); @@ -137,10 +139,12 @@ print1_list([Car|Cdr], D, I, L) -> print1_list([], _, _, _) -> []. %% print1_tail(Tail, Depth, Indentation, LineLength) -%% Print the tail of a list. We know about dotted pairs. +%% Print the tail of a list. We know about dotted pairs. When we +%% reach depth 0 we just quit as we know necessary "..." will have +%% come from an earlier print1 at same depth. -print1_tail([], _, _, _) -> ""; print1_tail(_, 0, _, _) -> ""; +print1_tail([], _, _, _) -> ""; print1_tail([Car|Cdr], D, I, L) -> ["\n",blanks(I, []),print1(Car, D-1, I, L),print1_tail(Cdr, D-1, I, L)]; print1_tail(S, D, I, L) -> diff --git a/src/lfe_lint.erl b/src/lfe_lint.erl index 46ddbcfc..6bde05ab 100644 --- a/src/lfe_lint.erl +++ b/src/lfe_lint.erl @@ -403,13 +403,9 @@ check_lambda([Args|Body], Env, L, St0) -> check_lambda(_, _, L, St) -> bad_form_error(L, lambda, St). check_lambda_args(Args, L, St) -> - %% Check for multiple variables - Check = fun (A, {As,S}) -> - case is_element(A, As) of - true -> {As,multi_var_error(L, A, S)}; - false -> {add_element(A, As),S} - end - end, + %% Check for multiple variables but allow don't care variables, + %% same rules as for pattern symbols. + Check = fun (A, {As,S}) -> pat_symb(A, As, L, S) end, case is_symb_list(Args) of true -> foldl(Check, {[],St}, Args); false -> {[],bad_form_error(L, lambda, St)} diff --git a/test/test_bin.erl b/test/test_bin_e.erl similarity index 97% rename from test/test_bin.erl rename to test/test_bin_e.erl index b3d41c35..88eb6a76 100644 --- a/test/test_bin.erl +++ b/test/test_bin_e.erl @@ -1,8 +1,8 @@ -%%% File : test_bin.erl +%%% File : test_bin_e.erl %%% Author : Robert Virding %%% Purpose : Test binaries. --module(test_bin). +-module(test_bin_e). -export([a/0,a/1,af/2,afp/2,a/3]). %Constructors -export([p1/1,p2/1,p2p/1,p3/1]). %Patterns