Sign Up
Log In
Log In
or
Sign Up
Places
All Projects
Status Monitor
Collapse sidebar
home:Ledest:erlang:22
lfe
0001-Make-constructor-less-patterns-illegal.patch
Overview
Repositories
Revisions
Requests
Users
Attributes
Meta
File 0001-Make-constructor-less-patterns-illegal.patch of Package lfe
From 091e1d0820786f5be0c99b6b1ad3983d8628c77d Mon Sep 17 00:00:00 2001 From: Robert Virding <rvirding@gmail.com> Date: Wed, 23 Nov 2016 15:49:13 +0100 Subject: [PATCH] Make constructor-less patterns illegal They have been deprecated long enough, now is the time to make them illegal. --- bin/lfec | 2 +- src/lfe_eval.erl | 122 +++++++++++++++++++++++++++++++++++++----------------- src/lfe_lint.erl | 8 +--- src/lfe_shell.erl | 9 +--- 4 files changed, 88 insertions(+), 53 deletions(-) diff --git a/bin/lfec b/bin/lfec index 9575c8b..02ecbcf 100755 --- a/bin/lfec +++ b/bin/lfec @@ -39,7 +39,7 @@ (parse-opts as (cons 'debug-print opts))) ([(cons "-Werror" as) opts] (parse-opts as (cons 'warnings-as-errors opts))) - ([(cons (++ "-W" _) as) opts] ;Ignore this here + ([(cons (++* "-W" _) as) opts] ;Ignore this here (parse-opts as opts)) ([(cons "-D" as) opts] (parse-opts as (cons 'debug-print opts))) diff --git a/src/lfe_eval.erl b/src/lfe_eval.erl index 00defcf..96a9731 100644 --- a/src/lfe_eval.erl +++ b/src/lfe_eval.erl @@ -23,7 +23,8 @@ -export([expr/1,expr/2,literal/1,literal/2,body/1,body/2, gexpr/1,gexpr/2,guard/1,guard/2,match/3,match_when/4, apply/2,apply/3, - make_letrec_env/2,add_lexical_func/4,add_dynamic_func/4]). + make_letrec_env/2,add_lexical_func/4,add_dynamic_func/4, + format_error/1]). %% Deprecated exports. -export([eval/1,eval/2,eval_list/2]). @@ -47,6 +48,30 @@ %% -compile([export_all]). +%% Errors. +format_error(badarg) -> "bad argument"; +format_error({badmatch,Val}) -> + lfe_io:format1("bad match: ~w", [Val]); +format_error(if_expression) -> "non-boolean if test"; +format_error(function_clause) -> "no function clause matching"; +format_error({case_clause,Val}) -> + lfe_io:format1("no case clause matching: ~w", [Val]); +format_error({multi_var,V}) -> + lfe_io:format1("multiple occurrence of variable: ~w", [V]); +format_error(illegal_bitsize) -> "illegal bitsize"; +format_error(illegal_bitseg) -> "illegal bitsegment"; +format_error(illegal_pattern) -> "illegal pattern"; +format_error(illegal_literal) -> "illegal literal value"; +format_error(illegal_mapkey) -> "illegal map key"; +format_error(bad_arity) -> "arity mismatch"; +format_error({argument_limit,Arity}) -> + lfe_io:format1("too many arguments: ~w", [Arity]); +format_error({bad_form,Form}) -> + lfe_io:format1("bad form: ~w", [Form]); +%% Everything we don't recognise or know about. +format_error(Error) -> + lfe_io:prettyprint1(Error). + %% eval(Sexpr) -> Value. %% eval(Sexpr, Env) -> Value. @@ -177,18 +202,18 @@ eval_expr([Fun|Es], Env) when is_atom(Fun) -> case get_fbinding(Fun, Ar, Env) of {yes,M,F} -> erlang:apply(M, F, eval_list(Es, Env)); {yes,F} -> eval_apply(F, eval_list(Es, Env), Env); - no -> eval_error({unbound_func,{Fun,Ar}}) + no -> unbound_func_error({Fun,Ar}) end; eval_expr([_|_]=S, _) -> %Test if string literal case is_posint_list(S) of true -> S; %It an "atomic" type false -> %It is a bad application form - eval_error({bad_form,application}) + bad_form_error(application) end; eval_expr(Symb, Env) when is_atom(Symb) -> case get_vbinding(Symb, Env) of {yes,Val} -> Val; - no -> eval_error({unbound_symb,Symb}) + no -> unbound_symb_error(Symb) end; eval_expr(E, _) -> E. %Atomic evaluate to themselves @@ -330,10 +355,10 @@ map_key([quote,E], _) -> E; map_key([_|_]=L, _) -> case is_posint_list(L) of true -> L; %Literal strings only - false -> eval_error(illegal_mapkey) + false -> illegal_mapkey_error() end; map_key(E, _) when not is_atom(E) -> E; %Everything else -map_key(_, _) -> eval_error(illegal_mapkey). +map_key(_, _) -> illegal_mapkey_error(). -endif. %% new_vars(N) -> Vars. @@ -352,7 +377,7 @@ eval_lambda([lambda,Args|Body], Env) -> Apply = fun (Vals) -> apply_lambda(Args, Body, Vals, Env) end, make_lambda(length(Args), Apply); eval_lambda(_, _) -> - eval_error({bad_form,lambda}). + bad_form_error(lambda). eval_match_lambda(['match-lambda'|Cls], Env) -> Apply = fun(Vals) -> apply_match_lambda(Cls, Vals, Env) end, @@ -381,7 +406,7 @@ make_lambda(Arity, Apply) -> Apply([A,B,C,D,E,F,G,H,I,J,K,L,M,N]) end; 15 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O) -> Apply([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O]) end; - _ -> eval_error(argument_limit) + _ -> eval_error({argument_limit,Arity}) end. apply_lambda(Args, Body, Vals, Env0) -> @@ -405,9 +430,10 @@ apply_match_lambda([[Pats|B0]|Cls], Vals, Env) -> {yes,B1,Vbs} -> eval_body(B1, add_vbindings(Vbs, Env)); no -> apply_match_lambda(Cls, Vals, Env) end; - true -> eval_error(badarity) + true -> eval_error(bad_arity) end; -apply_match_lambda(_, _, _) -> eval_error(function_clause). +apply_match_lambda([], Vals, _) -> eval_error({function_clause,Vals}); +apply_match_lambda(_, _, _) -> bad_form_error('match-lambda'). %% eval_let([PatBindings|Body], Env) -> Value. @@ -425,7 +451,7 @@ eval_let([Vbs|Body], Env0) -> {yes,[],Bs} -> add_vbindings(Bs, Env); no -> eval_error({badmatch,Val}) end; - (_, _) -> eval_error({bad_form,'let'}) + (_, _) -> bad_form_error('let') end, Env0, Vbs), eval_body(Body, Env1). @@ -440,7 +466,7 @@ eval_let_function([Fbs|Body], Env0) -> ([V,['match-lambda',[Pats|_]|_]=Match], E) when is_atom(V) -> Add(V, length(Pats), Match, Env0, E); - (_, _) -> eval_error({bad_form,'let-function'}) + (_, _) -> bad_form_error('let-function') end, Env0, Fbs), %% io:fwrite("elf: ~p\n", [{Body,Env1}]), eval_body(Body, Env1). @@ -455,7 +481,7 @@ eval_letrec_function([Fbs0|Body], Env0) -> {V,length(Args),Lambda}; ([V,['match-lambda',[Pats|_]|_]=Match]) when is_atom(V) -> {V,length(Pats),Match}; - (_) -> eval_error({bad_form,'letrec-function'}) + (_) -> bad_form_error('letrec-function') end, Fbs0), Env1 = make_letrec_env(Fbs1, Env0), %% io:fwrite("elrf: ~p\n", [{Env0,Env1}]), @@ -534,7 +560,7 @@ eval_if(Test, True, False, Env) -> case eval_expr(Test, Env) of true -> eval_expr(True, Env); false -> eval_expr(False, Env); - _ -> eval_error(if_clause) %Explicit error here + _ -> eval_error(if_expression) %Explicit error here end. %% eval_case(CaseBody, Env) -> Value. @@ -640,14 +666,18 @@ send_all([], _) -> true. eval_try([E,['case'|Cls]|Catch], Env) -> eval_try_catch(Catch, E, {yes,Cls}, Env); eval_try([E|Catch], Env) -> - eval_try_catch(Catch, E, no, Env). + eval_try_catch(Catch, E, no, Env); +eval_try(_, _) -> + bad_form_error('try'). eval_try_catch([['catch'|Cls]], E, Case, Env) -> eval_try(E, Case, {yes,Cls}, no, Env); eval_try_catch([['catch'|Cls],['after'|B]], E, Case, Env) -> eval_try(E, Case, {yes,Cls}, {yes,B}, Env); eval_try_catch([['after'|B]], E, Case, Env) -> - eval_try(E, Case, no, {yes,B}, Env). + eval_try(E, Case, no, {yes,B}, Env); +eval_try_catch(_, _, _, _) -> + bad_form_error('try'). %% We do it all in one, not so efficient but easier. eval_try(E, Case, Catch, After, Env) -> @@ -769,20 +799,20 @@ eval_gexpr([call,[quote,erlang],F0|As], Env) -> F1 = eval_gexpr(F0, Env), case get_gbinding(F1, Ar, Env) of {yes,M,F} -> erlang:apply(M, F, eval_glist(As, Env)); - _ -> eval_error({unbound_func,{F1,Ar}}) + _ -> unbound_func_error({F1,Ar}) end; eval_gexpr([Fun|Es], Env) when is_atom(Fun) -> Ar = length(Es), case get_gbinding(Fun, Ar, Env) of {yes,M,F} -> erlang:apply(M, F, eval_glist(Es, Env)); - _ -> eval_error({unbound_func,Fun}) + _ -> unbound_func_error(Fun) end; eval_gexpr([_|_], _) -> eval_error(illegal_guard); eval_gexpr(Symb, Env) when is_atom(Symb) -> case get_vbinding(Symb, Env) of {yes,Val} -> Val; - no -> eval_error({unbound_symb,Symb}) + no -> unbound_symb_error(Symb) end; eval_gexpr(E, _) -> E. %Atoms evaluate to themselves. @@ -816,10 +846,10 @@ gmap_key([quote,E], _) -> E; gmap_key([_|_]=L, _) -> case is_posint_list(L) of true -> L; %Literal strings only - false -> eval_error(illegal_mapkey) + false -> illegal_mapkey_error() end; gmap_key(E, _) when not is_atom(E) -> E; %Everything else -gmap_key(_, _) -> eval_error(illegal_mapkey). +gmap_key(_, _) -> illegal_mapkey_error(). -endif. %% eval_gif(IfBody, Env) -> Val. @@ -842,7 +872,7 @@ eval_gif(Test, True, False, Env) -> match(Pat, Val, Env) -> match(Pat, Val, [], Env). match([quote,P], Val, Pbs, _) -> - if P == Val -> {yes,Pbs}; + if P =:= Val -> {yes,Pbs}; true -> no end; match(['=',P1,P2], Val, Pbs0, Env) -> %Aliases @@ -850,11 +880,8 @@ match(['=',P1,P2], Val, Pbs0, Env) -> %Aliases {yes,Pbs1} -> match(P2, Val, Pbs1, Env); no -> no end; -match([cons,H,T], [V|Vs], Pbs0, Env) -> %Explicit cons constructor - case match(H, V, Pbs0, Env) of - {yes,Pbs1} -> match(T, Vs, Pbs1, Env); - no -> no - end; +match([cons,H,T], Val, Pbs, Env) -> %Explicit cons constructor + match_cons(H, T, Val, Pbs, Env); match([list|Ps], Val, Pbs, Env) -> %Explicit list constructor match_list(Ps, Val, Pbs, Env); match([tuple|Ps], Val, Pbs, Env) -> @@ -873,20 +900,27 @@ match([map|Ps], Val, Pbs, Env) -> true -> match_map(Ps, Val, Pbs, Env); false -> no end; -%% Use old no contructor list forms. -match([P|Ps], [V|Vs], Pbs0, Env) -> - case match(P, V, Pbs0, Env) of - {yes,Pbs1} -> match(Ps, Vs, Pbs1, Env); - no -> no +match([_|_]=List, Val, Pbs, _) -> %No constructor + case is_posint_list(List) of %Accept strings + true -> + if List =:= Val -> {yes,Pbs}; + true -> no + end; + false -> eval_error(illegal_pattern) end; -%% match([_|_], _, _, _) -> %No constructor -%% eval_error(illegal_pattern); match([], [], Pbs, _) -> {yes,Pbs}; match(Symb, Val, Pbs, Env) when is_atom(Symb) -> match_symb(Symb, Val, Pbs, Env); match(Val, Val, Pbs, _) -> {yes,Pbs}; match(_, _, _, _) -> no. +match_cons(H, T, [V|Vs], Pbs0, Env) -> + case match(H, V, Pbs0, Env) of + {yes,Pbs1} -> match(T, Vs, Pbs1, Env); + no -> no + end; +match_cons(_, _, _, _, _) -> no. + match_list([P|Ps], [V|Vs], Pbs0, Env) -> case match(P, V, Pbs0, Env) of {yes,Pbs1} -> match_list(Ps, Vs, Pbs1, Env); @@ -948,7 +982,7 @@ get_pat_bitsize(S, _, Bbs, _, Env) when is_atom(S) -> no -> case find(S, Bbs) of {ok,V} -> V; - error -> eval_error({unbound_symb,S}) + error -> unbound_symb_error(S) end end. @@ -1065,10 +1099,10 @@ pat_map_key([quote,E]) -> E; pat_map_key([_|_]=L) -> case is_posint_list(L) of true -> L; %Literal strings only - false -> eval_error(illegal_mapkey) + false -> illegal_mapkey_error() end; pat_map_key(E) when not is_atom(E) -> E; %Everything else -pat_map_key(_) -> eval_error(illegal_mapkey). +pat_map_key(_) -> illegal_mapkey_error(). %% eval_lit(Literal, Env) -> Value. %% Evaluate a literal expression. Error if invalid. @@ -1090,7 +1124,7 @@ eval_lit([_|_], _) -> %All other lists illegal eval_lit(Symb, Env) when is_atom(Symb) -> case get_vbinding(Symb, Env) of {yes,Val} -> Val; - no -> eval_error({unbound_symb,Symb}) + no -> unbound_symb_error(Symb) end; eval_lit(Key, _) -> Key. %Literal values @@ -1108,6 +1142,18 @@ eval_lit_map([], _) -> []. %% Error functions. {?MODULE,eval_expr,2} is the stacktrace. +unbound_symb_error(Sym) -> + eval_error({unbound_symb,Sym}). + +unbound_func_error(Func) -> + eval_error({unbound_func,Func}). + +bad_form_error(Form) -> + eval_error({bad_form,Form}). + +illegal_mapkey_error() -> + eval_error(illegal_mapkey). + eval_error(Error) -> erlang:raise(error, Error, stacktrace()). diff --git a/src/lfe_lint.erl b/src/lfe_lint.erl index 253e3e9..cf202d4 100644 --- a/src/lfe_lint.erl +++ b/src/lfe_lint.erl @@ -1059,16 +1059,12 @@ pattern([binary|Segs], Pvs, Env, L, St) -> pattern([map|As], Pvs, Env, L, St) -> pat_map(As, Pvs, Env, L, St); %% Check old no contructor list forms. -pattern([H|T]=List, Pvs0, Env, L, St0) -> +pattern([_|_]=List, Pvs0, _, L, St0) -> case is_posint_list(List) of true -> {Pvs0,St0}; %A string false -> %Illegal pattern - St1 = depr_warning(L, "no constructor in list pattern", St0), - {Pvs1,St2} = pattern(H, Pvs0, Env, L, St1), - pattern(T, Pvs1, Env, L, St2) + {Pvs0,add_error(L, illegal_pattern, St0)} end; -%% pattern([_|_], Pvs, _, L, St) -> -%% {Pvs,add_error(L, illegal_pattern, St)}; pattern([], Pvs, _, _, St) -> {Pvs,St}; pattern(Symb, Pvs, _, L, St) when is_atom(Symb) -> pat_symb(Symb, Pvs, L, St); diff --git a/src/lfe_shell.erl b/src/lfe_shell.erl index 7319ab7..3b22b0a 100644 --- a/src/lfe_shell.erl +++ b/src/lfe_shell.erl @@ -442,19 +442,12 @@ list_ews(Format, Ews) -> set([], St) -> {[],St}; set([Pat|Rest], #state{curr=Ce}=St) -> Epat = lfe_macro:expand_expr_all(Pat, Ce), %Expand macros in pattern - %% Special case to lint pattern. - case lfe_lint:pattern(Epat, Ce) of - {ok,_,Ws} -> list_warnings(Ws); - {error,Es,Ws} -> - list_errors(Es), - list_warnings(Ws) - end, set_1(Epat, Rest, St). set_1(Pat, [['when'|_]=G,Exp], St) -> set_1(Pat, [G], Exp, St); %Just the guard set_1(Pat, [Exp], St) -> - set_1(Pat, [], Exp, St); %Empty body + set_1(Pat, [], Exp, St); %Empty guard body set_1(_, _, _) -> erlang:error({bad_form,'set'}). set_1(Pat, Guard, Exp, #state{curr=Ce0}=St) -> -- 2.11.0
Locations
Projects
Search
Status Monitor
Help
OpenBuildService.org
Documentation
API Documentation
Code of Conduct
Contact
Support
@OBShq
Terms
openSUSE Build Service is sponsored by
The Open Build Service is an
openSUSE project
.
Sign Up
Log In
Places
Places
All Projects
Status Monitor