@@ -17,6 +17,13 @@ I will try to make a better fix soon. Sorry about that. v0.5 ---- +Added macro list*. + +Added a new shell command to set variables in the shell. + +Cleaned up compiler options and made them more like the vanilla +compiler. + Added unicode types to binaries: utf-8, utf-16 and utf-32. Shell and compiler now print error data in LFE instead of vanilla. @@ -32,6 +39,8 @@ formatted output while lfe_io:format1 returns the string. Improved pretty-printing. +Many internal improvements. + v0.4 ---- This will be the last development version for Erlang R12B-5 and older, README @@ -1,10 +1,26 @@ +2009-10-14 Robert Virding <rv@stanislaw.local> + + * lfe_macro.erl (exp_predef): Added macro list* and restructured + code a little. + +2009-10-13 Robert Virding <rv@stanislaw.local> + + * lfe_eval.lfe (eval-binary, match-binary): Restructured code. + + * lfe_eval.erl (eval_binary, match_binary): Restructured code. + +2009-10-06 Robert Virding <rv@stanislaw.local> + + * lfe_codegen.erl (comp_args, comp_call): Sequentialised + evaluation of arguments enforcing left-to-right semantics. + 2009-10-02 Robert Virding <rv@stanislaw.local> * lfe_codegen.erl: Cleaned up handling of literals. 2009-09-26 Robert Virding <rv@stanislaw.local> - * lfe-eval.erl (eval-binary, match-binary): Cleaned up handling of + * lfe_eval.lfe (eval-binary, match-binary): Cleaned up handling of binaries. * lfe_eval.erl (eval_binary, match_binary): Cleaned up handling of src/ChangeLog @@ -224,24 +224,27 @@ comp_expr(Bin, _, _, St) when is_binary(Bin) -> %% Handle the Core data special forms. comp_call([quote,E], _, _, St) -> {comp_lit(E),St}; -comp_call([cons,H,T], Env, L, St0) -> - {Ch,St1} = comp_expr(H, Env, L, St0), - {Ct,St2} = comp_expr(T, Env, L, St1), - {c_cons(Ch, Ct),St2}; +comp_call([cons,H,T], Env, L, St) -> + Call = fun ([Ch,Ct], _, _, St) -> {c_cons(Ch, Ct),St} end, + comp_args([H,T], Call, Env, L, St); +%% {Ch,St1} = comp_expr(H, Env, L, St0), +%% {Ct,St2} = comp_expr(T, Env, L, St1), +%% {c_cons(Ch, Ct),St2}; comp_call([car,E], Env, L, St) -> %Provide lisp names comp_call([hd,E], Env, L, St); comp_call([cdr,E], Env, L, St) -> comp_call([tl,E], Env, L, St); comp_call([list|Es], Env, L, St) -> - foldr(fun (E, {T,St0}) -> - {Ce,St1} = comp_expr(E, Env, L, St0), - {c_cons(Ce, T),St1} - end, {c_nil(),St}, Es); -comp_call([tuple|As], Env, L, St0) -> - {Cas,St1} = comp_args(As, Env, L, St0), - sequentialise_args(Cas, fun (Args, _, _, St) -> - {c_tuple(Args),St} - end, Env, L, St1); + Call = fun (Ces, _, _, St) -> + {foldr(fun (E, T) -> c_cons(E, T) end, c_nil(), Ces),St} + end, + comp_args(Es, Call, Env, L, St); +%% foldr(fun (E, {T,St0}) -> +%% {Ce,St1} = comp_expr(E, Env, L, St0), +%% {c_cons(Ce, T),St1} +%% end, {c_nil(),St}, Es); +comp_call([tuple|As], Env, L, St) -> + comp_args(As, fun (Args, _, _, St) -> {c_tuple(Args),St} end, Env, L, St); %% {Cas,St1} = comp_args(As, Env, L, St0), %% {c_tuple(Cas),St1}; comp_call([binary|Segs], Env, L, St) -> @@ -279,31 +282,32 @@ comp_call(['funcall',F|As], Env, L, St) -> comp_funcall(F, As, Env, L, St); %%comp_call([call,[quote,erlang],[quote,primop]|As], Env, L, St) -> %% An interesting thought to open up system. -comp_call([call,M,N|As], Env, L, St0) -> +comp_call([call,M,N|As], Env, L, St) -> %% Call a function in another module. - {Cm,St1} = comp_expr(M, Env, L, St0), - {Cn,St2} = comp_expr(N, Env, L, St1), - {Cas,St3} = comp_args(As, Env, L, St2), - {#c_call{anno=[L],module=Cm,name=Cn,args=Cas},St3}; + Call = fun ([Cm,Cn|Cas], _, L, St) -> + {#c_call{anno=[L],module=Cm,name=Cn,args=Cas},St} + end, + comp_args([M,N|As], Call, Env, L, St); +%% {[Cm,Cn|Cas],St1} = comp_args([M,N|As], Env, L, St0), +%% {#c_call{anno=[L],module=Cm,name=Cn,args=Cas},St1}; %% General function calls. -comp_call([Fun|As], Env, L, St0) when is_atom(Fun) -> +comp_call([Fun|As], Env, L, St) when is_atom(Fun) -> %% Fun is a symbol which is either a known BIF or function. - {Cas,St1} = comp_args(As, Env, L, St0), - Call = fun (Args, Env, L, St) -> - Ar = length(Args), + Call = fun (Cas, Env, L, St) -> + Ar = length(Cas), case get_fbinding(Fun, Ar, Env) of {yes,M,F} -> %Import {#c_call{anno=[L],module=c_atom(M), - name=c_atom(F),args=Args}, - St}; + name=c_atom(F),args=Cas},St}; {yes,Name} -> %% Might have been renamed, use real function name. {#c_apply{anno=[L],op=c_fname(Name, Ar), - args=Args},St} + args=Cas},St} end end, - sequentialise_args(Cas, Call, Env, L, St1). + comp_args(As, Call, Env, L, St). +%% {Cas,St1} = comp_args(As, Env, L, St), %% Ar = length(As), %% case get_fbinding(Fun, Ar, Env) of %% {yes,M,F} -> %Import @@ -314,31 +318,35 @@ comp_call([Fun|As], Env, L, St0) when is_atom(Fun) -> %% {#c_apply{anno=[L],op=c_fname(Name, Ar),args=Cas},St1} %% end. -%% sequentialise_args(CompiledArgs, UseCall, Env, Line, State) -> -%% {CoreCall,State}. +%% comp_args(Args, Env, Line, State) -> {ArgList,State}. + +comp_args(As, Env, L, St) -> + mapfoldl(fun (A, Sta) -> comp_expr(A, Env, L, Sta) end, St, As). + +%% comp_args(Args, CallFun, Env, Line, State) -> {Call,State}. +%% Sequentialise the evaluation of Args building the Call at the +%% bottom. For non-simple arguments use let to break the arg +%% evaluation out from the main call. Cannot use foldr as we pass +%% data both in an out. -sequentialise_args(Cas, Call, Env, L, St) -> - sequentialise_args(Cas, Call, [], Env, L, St). +comp_args(As, Call, Env, L, St) -> + comp_args(As, Call, [], Env, L, St). -sequentialise_args([Ca|Cas], Call, Sas, Env, L, St0) -> +comp_args([A|As], Call, Cas, Env, L, St0) -> + {Ca,St1} = comp_expr(A, Env, L, St0), %% Use erlang core compiler lib which does what we want. case core_lib:is_simple(Ca) of - true -> sequentialise_args(Cas, Call, [Ca|Sas], Env, L, St0); + true -> comp_args(As, Call, [Ca|Cas], Env, L, St1); false -> - {Var,St1} = new_c_var(L, St0), - {Rest,St2} = sequentialise_args(Cas, Call, [Var|Sas], Env, L, St1), + {Cv,St2} = new_c_var(L, St1), + {Rest,St3} = comp_args(As, Call, [Cv|Cas], Env, L, St2), {#c_let{anno=[L], - vars=[Var], + vars=[Cv], arg=Ca, - body=Rest},St2} + body=Rest},St3} end; -sequentialise_args([], Call, Sas, Env, L, St) -> - Call(reverse(Sas), Env, L, St). - -%% comp_args(Args, Env, Line, State) -> {ArgList,State}. - -comp_args(As, Env, L, St) -> - mapfoldl(fun (A, Sta) -> comp_expr(A, Env, L, Sta) end, St, As). +comp_args([], Call, Cas, Env, L, St) -> + Call(reverse(Cas), Env, L, St). %% comp_lambda(Args, Body, Env, Line, State) -> {#c_fun{},State}. %% Compile a (lambda (...) ...). @@ -395,7 +403,7 @@ comp_match_clause([Pats|Body], Env0, L, St0) -> %% comp_let(VarBindings, Body, Env, L, State) -> {#c_let{}|#c_case{},State}. %% Compile a let expr. We are a little cunning in that we specialise -%% the the case where all the patterns are variables and there a re no +%% the the case where all the patterns are variables and there are no %% guards, the simple case. comp_let(Vbs, B, Env, L, St0) -> @@ -714,9 +722,8 @@ comp_funcall(F, As, Env, L, St0) -> comp_funcall_1(F, As, Env, L, St0). %Naively just do it. comp_funcall_1(F, As, Env, L, St0) -> - {Cf,St1} = comp_expr(F, Env, L, St0), - {Cas,St2} = comp_args(As, Env, L, St1), - {#c_apply{anno=[L],op=Cf,args=Cas},St2}. + {[Cf|Cas],St1} = comp_args([F|As], Env, L, St0), + {#c_apply{anno=[L],op=Cf,args=Cas},St1}. %% comp_binary(Segs, Env, Line, State) -> {#c_binary{},State}. src/lfe_codegen.erl @@ -117,7 +117,7 @@ scan_and_parse(Io, Ts0) -> E -> exit(E) end end. - + %% print([IoDevice], Sexpr) -> ok. %% print1(Sexpr) -> [char()]. %% print1(Sexpr, Depth) -> [char()]. @@ -189,7 +189,7 @@ print1_bits(Bits, _) -> %0 < Size < 8 %% Print the tail of a list. We know about dotted pairs. print1_tail([], _) -> ""; -print1_tail(_, 1) -> " ..."; +print1_tail(_, 1) -> " ..."; print1_tail([S|Ss], D) -> [$\s,print1(S, D-1)|print1_tail(Ss, D-1)]; print1_tail(S, D) -> [" . "|print1(S, D-1)]. src/lfe_io.erl @@ -135,7 +135,7 @@ is_fbound(N, A, [{function,N,A,_,_}|_]) -> true; is_fbound(N, _, [{macro,N,_}|_]) -> false; %Macros shadow is_fbound(N, A, [_|Env]) -> is_fbound(N, A, Env); is_fbound(N, A, []) -> is_bif(N, A). %Known BIF, LFE or erlang - + get_fbinding(N, A, [{function,N,A,V}|_]) -> {yes,V}; get_fbinding(N, A, [{function,N,A,M,F}|_]) -> {yes,M,F}; %Import get_fbinding(N, _, [{macro,N,_}|_]) -> no; %Macros shadow @@ -175,7 +175,7 @@ is_mbound(N, [{function,N,_,_,_}|_]) -> false; %Functions shadow is_mbound(N, [{macro,N,_}|_]) -> true; is_mbound(N, [_|Env]) -> is_mbound(N, Env); is_mbound(_, []) -> false. - + get_mbinding(N, [{function,N,_,_}|_]) -> no; %Functions shadow get_mbinding(N, [{function,N,_,_,_}|_]) -> no; %Functions shadow get_mbinding(N, [{macro,N,V}|_]) -> {yes,V}; @@ -355,8 +355,8 @@ subst(_, _, Tree) -> Tree. _ -> Tree end end. - -eval(Sexpr) -> lfe_eval:eval(Sexpr, new_env()). %Empty environment. + +eval(Sexpr) -> lfe_eval:expr(Sexpr, new_env()). %Empty environment. %% Miscellaneous useful LFE functions. src/lfe_lib.erl @@ -607,7 +607,7 @@ check_try_catch([['catch'|Cls],['after'|B]], Env, L, St0) -> check_body(B, Env, L, St1); check_try_catch([['after'|B]], Env, L, St) -> check_body(B, Env, L, St); -check_try_catch(C, _, L, St) -> bad_form_error(L, {'try',C}, St). +check_try_catch(_, _, L, St) -> bad_form_error(L, 'try', St). %% check_pat_guard([Pat{,Guard}|Body, Env, L, State) -> %% {Body,PatVars,Env,State}. src/lfe_lint.erl @@ -293,7 +293,7 @@ def_record(Name, Fdefs, Env, St0) -> [[rec],['is_record',rec,[quote,Name],length(Fields)+1]]], ['defmacro',Match, [fds, - ['let',[[def,[list|lists:duplicate(length(Fields), ?Q('_'))]]], + ['let',[[def,[list|lists:duplicate(length(Fields),?Q('_'))]]], [backquote, [tuple,?Q(Name),['unquote-splicing',[Fu,fds,def]]]]]]], ['defmacro',Set, @@ -569,38 +569,49 @@ exp_macro([Mac|Args], Def0, Env, St0) -> exp_predef([backquote,Bq], _, St) -> {yes,bq_expand(Bq),St}; exp_predef(['++'|Abody], _, St) -> - case Abody of - [E] -> {yes,E,St}; - [E|Es] -> {yes,[call,?Q(erlang),?Q('++'),E,['++'|Es]],St}; - [] -> {yes,[],St} - end; + Exp = case Abody of + [E] -> E; + [E|Es] -> [call,?Q(erlang),?Q('++'),E,['++'|Es]]; + [] -> [] + end, + {yes,Exp,St}; exp_predef([':',M,F|As], _, St) -> {yes,['call',?Q(M),?Q(F)|As], St}; exp_predef(['?'], _, St) -> {yes,['receive',['omega','omega']], St}; +exp_predef(['list*'|As], _, St) -> + Exp = case As of + [E] -> E; + [E|Es] -> [cons,E,['list*'|Es]]; + [] -> [] + end, + {yes,Exp,St}; exp_predef(['let*'|Lbody], _, St) -> - case Lbody of - [[Vb|Vbs]|B] -> {yes,['let',[Vb],['let*',Vbs|B]], St}; - [[]|B] -> {yes,['progn'|B], St}; - [Vb|B] -> {yes,['let',Vb|B], St} %Pass error to let for lint. - end; + Exp = case Lbody of + [[Vb|Vbs]|B] -> ['let',[Vb],['let*',Vbs|B]]; + [[]|B] -> ['progn'|B]; + [Vb|B] -> ['let',Vb|B] %Pass error to let for lint. + end, + {yes,Exp,St}; exp_predef(['flet*'|Lbody], _, St) -> - case Lbody of - [[Vb|Vbs]|B] -> {yes,['flet',[Vb],['flet*',Vbs|B]], St}; - [[]|B] -> {yes,['progn'|B], St}; - [Vb|B] -> {yes,['flet',Vb|B], St} %Pass error to flet for lint. - end; + Exp = case Lbody of + [[Vb|Vbs]|B] -> ['flet',[Vb],['flet*',Vbs|B]]; + [[]|B] -> ['progn'|B]; + [Vb|B] -> ['flet',Vb|B] %Pass error to flet for lint. + end, + {yes,Exp,St}; exp_predef(['cond'|Cbody], _, St) -> - case Cbody of - [['else'|B]] -> {yes,['progn'|B], St}; - [[['?=',P,E]|B]|Cond] -> - {yes,['case',E,[P|B],['_',['cond'|Cond]]], St}; - [[['?=',P,['when',_]=G,E]|B]|Cond] -> - {yes,['case',E,[P,G|B],['_',['cond'|Cond]]], St}; - [[Test|B]|Cond] -> - {yes,['if',Test,['progn'|B],['cond'|Cond]], St}; - [] -> {yes,?Q(false),St} - end; + Exp = case Cbody of + [['else'|B]] -> ['progn'|B]; + [[['?=',P,E]|B]|Cond] -> + ['case',E,[P|B],['_',['cond'|Cond]]]; + [[['?=',P,['when',_]=G,E]|B]|Cond] -> + ['case',E,[P,G|B],['_',['cond'|Cond]]]; + [[Test|B]|Cond] -> + ['if',Test,['progn'|B],['cond'|Cond]]; + [] -> ?Q(false) + end, + {yes,Exp,St}; exp_predef(['do'|Dbody], _, St0) -> %% (do ((v i c) ...) (test val) . body) but of limited use as it %% stands as we have to everything in new values. @@ -625,21 +636,21 @@ exp_predef([bc|Bbody], _, St0) -> {Exp,St1} = bc_te(E, Qs, St0), {yes,Exp,St1}; exp_predef(['andalso'|Abody], _, St) -> - case Abody of - [E] -> {yes,E,St}; - [E|Es] -> - Exp = ['case',E,[?Q(true),['andalso'|Es]],[?Q(false),?Q(false)]], - {yes,Exp,St}; - [] -> {yes,?Q(true),St} - end; + Exp = case Abody of + [E] -> E; %Let user check last call + [E|Es] -> + ['case',E,[?Q(true),['andalso'|Es]],[?Q(false),?Q(false)]]; + [] -> ?Q(true) + end, + {yes,Exp,St}; exp_predef(['orelse'|Obody], _, St) -> - case Obody of - [E] -> {yes,E,St}; %Let user check last call - [E|Es] -> - Exp = ['case',E,[?Q(true),?Q(true)],[?Q(false),['orelse'|Es]]], - {yes,Exp,St}; - [] -> {yes,?Q(false),St} - end; + Exp = case Obody of + [E] -> E; %Let user check last call + [E|Es] -> + ['case',E,[?Q(true),?Q(true)],[?Q(false),['orelse'|Es]]]; + [] -> ?Q(false) + end, + {yes,Exp,St}; exp_predef(['fun',F,Ar], _, St0) when is_atom(F), is_integer(Ar), Ar >= 0 -> {Vs,St1} = new_symbs(Ar, St0), {yes,['lambda',Vs,[F|Vs]],St1}; @@ -659,13 +670,14 @@ exp_predef(['include-file'|Ibody], _, St) -> exp_predef(['begin'|Body], _, St) -> {yes,['progn'|Body],St}; exp_predef(['define',Head|Body], _, St) -> - case is_symb_list(Head) of - true -> - {yes,['define-function',hd(Head),[lambda,tl(Head)|Body]],St}; - false -> - %% Let next step catch errors here. - {yes,['define-function',Head|Body],St} - end; + Exp = case is_symb_list(Head) of + true -> + ['define-function',hd(Head),[lambda,tl(Head)|Body]]; + false -> + %% Let next step catch errors here. + ['define-function',Head|Body] + end, + {yes,Exp,St}; exp_predef(['define-record'|Def], _, St) -> {yes,[defrecord|Def],St}; exp_predef(['define-syntax',Name,Def], _, St) -> @@ -724,11 +736,11 @@ expand_defun(Name, [Args|Rest]) -> %% N.B. New macro definition is function of 1 argument, whole %% argument list of macro call. -expand_defmacro(Name, [Args|Rest]) -> +expand_defmacro(Name, [Args|Rest]=Cls) -> case is_symb_list(Args) of true -> [Name,['match-lambda',[[Args]|Rest]]]; false -> - Mcls = map(fun ([Head|Body]) -> [[Head]|Body] end, [Args|Rest]), + Mcls = map(fun ([Head|Body]) -> [[Head]|Body] end, Cls), [Name,['match-lambda'|Mcls]] end. src/lfe_macro.erl @@ -84,7 +84,7 @@ sexpr1([{'#B(',_}|Ts0]) -> case proper_list(Ts0) of {List,[{')',_}|Ts1]} -> %% Build and eval a binary sexpr. - case catch lfe_eval:eval([binary|List]) of + case catch lfe_eval:expr([binary|List]) of Bin when is_bitstring(Bin) -> {Bin,Ts1}; _ -> throw({error,{illegal,binary},Ts1}) end; src/lfe_parse.erl @@ -136,9 +136,17 @@ collect_imps(Is, St) -> S#param{env=Env} end, St, Is). +%% exp_function(Lambda, State) -> Lambda. +%% The resultant code matches the arguments in two steps: first the +%% THIS arguemnt is matched and then the expanded function body +%% ((match-)lambda) is funcalled. We KNOW that funcall of a +%% (match-)lambda is inline expanded into a let or case so this is +%% efficient. + exp_function(Lambda, #param{this=Th,env=Env}) -> As = new_args(lambda_arity(Lambda)), ['match-lambda',[As ++ [Th],[funcall,exp_expr(Lambda, Env)|As]]]. + %% exp_function(['match-lambda'|Cls0], #param{this=Th,env=Env}) -> %% Cls1 = map(fun ([As|Body]) -> %% exp_clause([As ++ [Th]|Body], Env) src/lfe_pmod.erl @@ -106,7 +106,7 @@ update_shell_vars(Form, Value, Env) -> {'+',Form}, {'***',fetch_vbinding('**', Env)}, {'**',fetch_vbinding('*', Env)}, - {'*',Value}]). + {'*',Value}]). add_shell_macros(Env0) -> %% We write macros in LFE and expand them with macro package. @@ -239,7 +239,7 @@ set(_, _, _) -> no. %% added to the standard base environment. -record(slurp, {mod,imps=[]}). %For slurping - + slurp([File], Eenv, Benv) -> Name = lfe_eval:expr(File, Eenv), %Get file name {ok,Fs0} = lfe_io:parse_file(Name), @@ -309,7 +309,7 @@ safe_fetch(Key, D, Def) -> {ok,Val} -> Val; error -> Def end. - + %% (defsyntax safe_fetch %% ((key d def) %% (case (find key d) src/lfe_shell.erl 8388e38d5199457623ecc03ec9e0f81c2de5e45f Robert Virding rvirding@gmail.com http://github.com/rvirding/lfe/commit/79acf10817890d87e4d6b63797b318173416c8ec 79acf10817890d87e4d6b63797b318173416c8ec 2009-10-13T16:12:21-07:00 2009-10-13T16:12:21-07:00 A maze if twisty little patches, all alike. 5a84642da3fa73210d3a8dde46b9ecc6c6643b56 Robert Virding rvirding@gmail.com