Current section
Files
Jump to
Current section
Files
src/lfe_lint.erl
%% Copyright (c) 2008-2023 Robert Virding
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%% http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%% File : lfe_lint.erl
%% Author : Robert Virding
%% Purpose : Lisp Flavoured Erlang syntax checker.
%%% We get a lot help here from the Erlang linter as our code is
%%% passed on into it when the erlng code is compiled. This means that
%%% if we miss anything it will catch it. How much do we really needt
%%% to do here?
%%% In a fun argument where when matching a binary we import the size
%%% of bitseg as a variable from the environment not just from earlier
%%% segments. No other argument variables are imported.
-module(lfe_lint).
-export([module/1,module/2,form/1,expr/1,expr/2,
pattern/1,pattern/2,format_error/1]).
%% -compile(export_all).
-include("lfe_comp.hrl").
-include("lfe.hrl").
-record(lfe_lint, {module=[], %Module name
mline=0, %Module definition line
exports=orddict:new(), %Exported function-line
imports=orddict:new(), %Imported function-{module,func}
aliases=orddict:new(), %Module-alias
onload=[], %Onload
funcs=orddict:new(), %Defined function-line
types=[], %Known types
texps=orddict:new(), %Exported types
specs=[], %Known func specs
records=orddict:new(), %Known record definitions
struct=undefined, %Struct definition
env=[], %Top-level environment
func=[], %Current function
file="no file", %File name
opts=[], %Compiler options
errors=[], %Errors
warnings=[] %Warnings
}).
%% Errors.
%% Module definition.
format_error({bad_module_def,D}) ->
%% This can handle both atom and string error value.
lfe_io:format1(<<"bad ~s in module definition">>, [D]);
format_error({bad_attribute,A}) ->
lfe_io:format1(<<"bad ~w attribute">>, [A]);
format_error({bad_meta_def,M}) ->
lfe_io:format1(<<"bad ~w metadata definition">>, [M]);
%% Forms and code.
format_error({bad_body_def,Form}) ->
lfe_io:format1(<<"bad body in ~w">>, [Form]);
format_error(bad_guard_def) -> "bad guard definition";
format_error(bad_args) -> "bad argument list";
format_error(bad_gargs) -> "bad guard argument list";
format_error(bad_pat_alias) -> "bad pattern alias";
format_error(bad_head_arity) -> "function head arity mismatch";
format_error({bad_form,Form}) ->
lfe_io:format1(<<"bad ~w form">>, [Form]);
format_error({bad_guard_form,Form}) ->
lfe_io:format1(<<"bad ~w guard form">>, [Form]);
format_error({bad_pattern,Pat}) ->
lfe_io:format1(<<"bad ~w pattern">>, [Pat]);
format_error({unbound_symbol,S}) ->
lfe_io:format1(<<"symbol ~w is unbound">>, [S]);
format_error({undefined_function,{F,Ar}}) ->
lfe_io:format1("function ~w/~w undefined", [F,Ar]);
format_error({multi_var,S}) ->
lfe_io:format1("variable ~w multiply defined", [S]);
%% Functions, imports, exports, on_loads and aliases.
format_error({redefine_function,{F,Ar}}) ->
lfe_io:format1("function ~w/~w already defined", [F,Ar]);
format_error({bad_fdef,F}) ->
lfe_io:format1("bad definition of function ~w", [F]);
format_error({reimport_function,{F,Ar},M1,M2}) ->
lfe_io:format1(<<"importing ~w/~w from ~w, already imported from ~w">>,
[F,Ar,M1,M2]);
format_error({define_imported_function,{F,Ar}}) ->
lfe_io:format1(<<"defining imported function ~w/~w">>, [F,Ar]);
format_error({undefined_onload_function,{F,Ar}}) ->
lfe_io:format1("on_load function ~w/~w undefined", [F,Ar]);
format_error({redefine_module_alias,A}) ->
lfe_io:format1(<<"redefining ~w module alias">>, [A]);
format_error({circular_module_alias,A}) ->
lfe_io:format1(<<"circular module alias for ~w">>, [A]);
%% Others
format_error({illegal_literal,Lit}) ->
lfe_io:format1(<<"illegal literal value ~w">>, [Lit]);
format_error({illegal_pattern,Pat}) ->
lfe_io:format1(<<"illegal pattern ~w">>, [Pat]);
format_error(illegal_guard) -> <<"illegal guard expression">>;
format_error({illegal_mapkey,Key}) ->
lfe_io:format1(<<"illegal map key ~w">>, [Key]);
format_error(illegal_bitseg) -> "illegal bit segment";
format_error(illegal_bitsize) -> "illegal bit size";
format_error({deprecated,What}) ->
lfe_io:format1("~s is deprecated", [What]);
format_error(unknown_form) -> "unknown form";
%% Try-catches.
format_error({illegal_stacktrace,S}) ->
lfe_io:format1(<<"stacktrace ~w must be unbound variable">>, [S]);
format_error({illegal_exception,E}) ->
lfe_io:format1(<<"illegal exception ~w">>, [E]);
%% Records.
format_error({bad_record_def,Name}) ->
lfe_io:format1(<<"bad definition of record ~w">>, [Name]);
format_error({bad_record_name,Name}) ->
lfe_io:format1(<<"bad record name ~w">>, [Name]);
format_error({bad_record_field,Name,Field}) ->
lfe_io:format1(<<"bad field ~w in record ~w">>, [Field,Name]);
format_error({redefine_record,Name}) ->
lfe_io:format1(<<"record ~w already defined">>, [Name]);
format_error({missing_record_field_value,Name,Field}) ->
lfe_io:format1(<<"missing value to field ~w in record ~w">>,[Field,Name]);
%% Structs.
format_error(redefine_struct) ->
<<"struct already defined">>;
format_error(bad_struct_def) ->
<<"bad definition of struct">>;
format_error({bad_struct_def,Name}) ->
lfe_io:format1(<<"bad definition of struct ~w">>, [Name]);
format_error({bad_struct_field,Field}) ->
lfe_io:format1(<<"bad field ~w in struct">>, [Field]);
%% format_error({bad_struct_field,Name,Field}) ->
%% lfe_io:format1(<<"bad field ~w in struct ~w">>, [Field,Name]);
format_error({missing_struct_field_value,Name,Field}) ->
lfe_io:format1(<<"missing value to field ~w in struct ~w">>,[Field,Name]);
%% These are also used in lfe_eval.
format_error({undefined_record,Name}) ->
lfe_io:format1(<<"record ~w undefined">>, [Name]);
format_error({undefined_record_field,Name,Field}) ->
lfe_io:format1(<<"field ~w undefined in record ~w">>, [Field,Name]);
format_error({undefined_struct,Name}) ->
lfe_io:format1(<<"struct ~w undefined">>, [Name]);
format_error({undefined_struct_field,Name,Field}) ->
lfe_io:format1(<<"field ~w undefined in struct ~w">>, [Field,Name]);
%% Type and spec errors.
format_error({undefined_type,{T,A}}) ->
lfe_io:format1("type ~w/~w undefined", [T,A]);
format_error({builtin_type,{T,A}}) ->
lfe_io:format1("type ~w/~w is a builtin type", [T,A]);
format_error({redefine_type,{T,A}}) ->
lfe_io:format1("type ~w/~w already defined", [T,A]);
format_error({redefine_spec,{F,A}}) ->
lfe_io:format1("spec for ~w/~w is already defined", [F,A]);
format_error({singleton_typevar,V}) ->
lfe_io:format1("type variable ~w is only used once", [V]);
%% Type and spec errors. These are also returned from lfe_types.
format_error({bad_type_def,T}) ->
lfe_io:format1("bad ~w type definition", [T]);
format_error({bad_type_syntax,T}) ->
lfe_io:format1("bad ~w type syntax", [T]);
format_error({bad_function_spec,S}) ->
lfe_io:format1("bad function specification: ~w", [S]);
%% These are signaled from lfe_bits.
format_error({undefined_bittype,S}) ->
lfe_io:format1("bit type ~w undefined", [S]);
format_error(bittype_unit) ->
<<"bit unit size can only be specified together with size">>;
format_error(Error) ->
lfe_io:format1("Unknown error ~p", [Error]).
%% expr(Expr) -> {ok,[Warning]} | {error,[Error],[Warning]}.
%% expr(Expr, Env) -> {ok,[Warning]} | {error,[Error],[Warning]}.
expr(E) -> expr(E, le_new()).
expr(E, Env) ->
St0 = #lfe_lint{},
St1 = check_expr(E, Env, 1, St0),
return_status(St1).
%% pattern(Pattern) -> {ok,[Warning]} | {error,[Error],[Warning]}.
%% pattern(Pattern, Env) -> {ok,[Warning]} | {error,[Error],[Warning]}.
pattern(P) -> pattern(P, le_new()).
pattern(P, Env) ->
St0 = #lfe_lint{},
{_,St1} = pattern(P, Env, 1, St0),
return_status(St1).
%% form(Form) -> {ok,[Warning]} | {error,[Error],[Warning]}.
%% Create a dummy module then test the form, a function.
form(F) ->
module([{['define-module',dummy,[],[]],1},{F,2}]).
%% module(ModuleForms) ->
%% {ok,ModuleName,[Warning]} | {error,[Error],[Warning]}.
%% module(ModuleForms, CompInfo) ->
%% {ok,ModuleName,[Warning]} | {error,[Error],[Warning]}.
%% Lint the forms in one module file.
module(Ms) -> module(Ms, #cinfo{file="nofile",opts=[]}).
module(Ms, #cinfo{file=F,opts=Os}) ->
St0 = #lfe_lint{file=F,opts=Os}, %Initialise the lint record
St1 = check_module(Ms, St0),
?DEBUG("#lfe_lint: ~s\n", [io_lib:format("~p",[St1])], Os),
return_status(St1).
return_status(#lfe_lint{module=M,errors=[]}=St) ->
{ok,M,St#lfe_lint.warnings};
return_status(St) ->
{error,St#lfe_lint.errors,St#lfe_lint.warnings}.
%% check_module(ModuleForms, State) -> State.
%% Do all the actual work checking a module.
check_module(Mfs, St0) ->
{Fbs0,St1} = collect_module(Mfs, St0),
%% Make an initial environment and set up state.
{Predefs,Env0,St2} = init_state(St1),
%% io:format("~p\n", [Env0]),
Fbs1 = Predefs ++ Fbs0,
%% Now check definitions.
{Funcs,Env1,St3} = check_functions(Fbs1, Env0, St2),
%% io:format("~p\n", [Env1]),
%% Save functions and environment and post check.
St4 = St3#lfe_lint{funcs=Funcs,env=Env1},
post_check_module(St4).
%% post_check_module(State) -> State.
%% Ru checks which can only be done when everything has been collected.
post_check_module(St0) ->
St1 = check_valid_exports(St0),
St2 = check_valid_imports(St1),
St3 = check_valid_onload(St2),
check_valid_type_exports(St3).
%% collect_module(ModuleForms, State) -> {Fbs,State}.
%% Collect valid forms and module data. Returns function bindings and
%% puts module data into state. Flag unknown forms and define-module
%% not first. We use lfe_proc_forms to automatically handle nested
%% progn forms for us.
collect_module(Mfs, St) ->
lfe_lib:proc_forms(fun collect_form/3, Mfs, St).
%% Fun = fun (F, L, S) ->
%% io:format("~p ~w\n", [F,L]),
%% collect_form(F, L, S)
%% end,
%% lfe_lib:proc_forms(Fun, Mfs, St).
%% collect_form(Form, Line, State) -> {Fbs,State}.
collect_form(['define-module',Mod,Meta,Atts], L, St0) ->
St1 = check_mod_def(Meta, Atts, L, St0#lfe_lint{module=Mod,mline=L}),
if is_atom(Mod) -> %Normal module
{[],St1};
true -> %Bad module name
{[],bad_module_def_error(L, name, St1)}
end;
collect_form(_, L, #lfe_lint{module=[]}=St) ->
%% Set module name so this only triggers once.
{[],bad_module_def_error(L, name, St#lfe_lint{module='-no-module-'})};
collect_form(['extend-module',Metas,Atts], L, St) ->
{[],check_mod_def(Metas, Atts, L, St)};
collect_form(['define-type',Type,Def], L, St) ->
{[],check_type_def(Type, Def, L, St)};
collect_form(['define-opaque-type',Type,Def], L, St) ->
{[],check_type_def(Type, Def, L, St)};
collect_form(['define-function-spec',Func,Specs], L, St) ->
{[],check_func_spec(Func, Specs, L, St)};
collect_form(['define-record',Name,Fields], L, St) ->
{[],check_record_def(Name, Fields, L, St)};
collect_form(['define-struct',Fields], L, St) ->
{[],check_struct_def(Fields, L, St)};
collect_form(['define-function',Func,Meta,Def], L, St) ->
collect_function(Func, Meta, Def, L, [], St);
%% lfe_lib:proc_forms handles nested progn.
%% Ignore macro definitions and eval-when-compile forms.
collect_form(['define-macro'|_], _, St) -> {[],St};
collect_form(['eval-when-compile'|_], _, St) -> {[],St};
collect_form(_, L, St) ->
{[],add_error(L, unknown_form, St)}.
%% check_mod_def(Metadata, Attributes, Line, State) -> State.
%% Check a module definition, its metasdata and attributes.
check_mod_def(Metas, Atts, L, St0) ->
St1 = check_mod_metas(Metas, L, St0),
check_mod_attrs(Atts, L, St1).
%% check_mod_metas(Metas, Line, State) -> State.
%% Only allow docs and type definitions.
check_mod_metas(Ms, L, St) ->
check_foreach(fun (M, S) -> check_mod_meta(M, L, S) end,
fun (S) -> bad_module_def_error(L, <<"meta form">>, S) end,
St, Ms).
check_mod_meta([doc|Docs], L, St) ->
?IF(is_docs_list(Docs), St, bad_meta_def_error(L, doc, St));
check_mod_meta([type|Tds], L, St) ->
check_type_defs(Tds, L, St);
check_mod_meta([opaque|Tds], L, St) ->
check_type_defs(Tds, L, St);
check_mod_meta([spec|Sps], L, St) ->
check_func_specs(Sps, L, St);
check_mod_meta([record|Rdefs], L, St) ->
%% deprecated_error(L, <<"module record definition">>, St);
check_record_defs(Rdefs, L, St);
check_mod_meta(_, L, St) -> bad_module_def_error(L, meta, St).
%% check_mod_attrs(Attributes, Line, State) -> State.
%% Check the attributes of the module.
check_mod_attrs(As, L, St) ->
check_foreach(fun (A, S) -> check_mod_attr(A, L, S) end,
fun (S) -> bad_module_def_error(L, <<"attribute form">>, S) end,
St, As).
check_mod_attr([export,all], _, St) -> St; %Ignore 'all' here
check_mod_attr([export|Es], L, St) ->
check_export_attr(Es, L, St);
check_mod_attr([import|Is], L, St) ->
check_import_attr(Is, L, St);
check_mod_attr(['module-alias'|As], L, St) ->
check_alias_attr(As, L, St);
check_mod_attr(['export-type'|Ts], L, St) ->
check_export_types(Ts, L, St);
check_mod_attr([doc|Docs], L, St0) ->
St1 = deprecated_warning(L, <<"module documentation attribute">>, St0),
check_doc_attr(Docs, L, St1);
check_mod_attr([record|_Rds], L, St) ->
deprecated_error(L, <<"module record definition">>, St);
check_mod_attr([on_load|Onload], L, St) ->
check_onload_attr(Onload, L, St);
%% Note we don't allow type and spec as normal attributes here.
check_mod_attr([A|Vals], L, St) ->
%% Meta tags are not allowed in attributes.
?IF(is_meta_tag(A), bad_attr_error(L, A, St),
%% Other attributes, must be list and have symbol name.
?IF(is_atom(A) and lfe_lib:is_proper_list(Vals),
St, bad_attr_error(L, A, St)));
check_mod_attr(_, L, St) -> bad_module_def_error(L, <<"attribute form">>, St).
is_meta_tag(doc) -> true;
is_meta_tag(spec) -> true;
is_meta_tag(Tag) -> lfe_types:is_type_decl(Tag).
%% check_doc_attr(Doc, Line, State) -> State.
%% Check the format of the docimentation.
check_doc_attr(Docs, L, St) ->
?IF(is_docs_list(Docs), St, bad_attr_error(L, doc, St)).
%% check_export_attr(Exports, Line, State) -> State.
check_export_attr(Es, L, St) ->
case is_func_list(Es) of
{yes,Fs} ->
Exps = add_exports(Fs, L, St#lfe_lint.exports),
St#lfe_lint{exports=Exps};
no -> bad_module_def_error(L, export, St)
end.
%% check_import_attr(Imports, Line, State) -> State.
check_import_attr(Imports, L, St) ->
check_foreach(fun (Import, S) -> check_imports(Import, L, S) end,
fun (S) -> import_error(L, S) end, St, Imports).
check_imports([from,Mod|Fs], L, St0) when is_atom(Mod) ->
Add = fun ([F,Ar], Is, S) when is_atom(F),
is_integer(Ar), Ar >= 0 ->
check_import(F, Ar, Mod, F, Is, L, S);
(_, Is, S) ->
{Is,bad_module_def_error(L, <<"import from">>, S)}
end,
{Imps,St1} = check_foldl(Add, fun (S) -> S end,
St0#lfe_lint.imports, St0, Fs),
St1#lfe_lint{imports=Imps};
check_imports([rename,Mod|Fs], L, St0) when is_atom(Mod) ->
Add = fun ([[F,Ar],R], Is, S) when is_atom(F),
is_integer(Ar), Ar >= 0,
is_atom(R) ->
check_import(R, Ar, Mod, F, Is, L, S);
(_, Is, S) ->
{Is,bad_module_def_error(L, <<"import rename">>, S)}
end,
{Imps,St1} = check_foldl(Add, fun (S) -> S end,
St0#lfe_lint.imports, St0, Fs),
St1#lfe_lint{imports=Imps};
check_imports([prefix,Mod,Pre], L, St0) when is_atom(Mod), is_atom(Pre) ->
deprecated_error(L, <<"import prefix">>, St0);
check_imports(_, L, St) ->
import_error(L, St).
%% check_import(LocalName, Arity, Module, RemoteName, Imports, Line, State) ->
%% {Imports,State}.
check_import(F, Ar, Mod, Rem, Imps, L, St) ->
case orddict:find({F,Ar}, Imps) of
{ok,{M,_}} when M =/= Mod ->
{Imps,add_error(L, {reimport_function,{F,Ar},Mod,M}, St)};
_Other ->
{orddict:store({F,Ar}, {Mod,Rem}, Imps),St}
end.
import_error(L, St) -> bad_module_def_error(L, import, St).
%% check_alias_attr(ModAliases, Line, State) -> State.
check_alias_attr(Aliases, L, St) ->
check_foreach(fun (Alias, S) -> check_alias(Alias, L, S) end,
fun (S) -> bad_module_def_error(L, 'module-alias', S) end,
St, Aliases).
check_alias([Mod,Alias], L, #lfe_lint{aliases=As0}=St0) when is_atom(Mod),
is_atom(Alias) ->
%% Test if we redefine alias or get circular aliases.
St1 = case orddict:is_key(Alias, As0) of
true -> add_error(L, {redefine_module_alias,Alias}, St0);
false -> St0
end,
St2 = case orddict:is_key(Mod, As0) of
true -> add_error(L, {circular_module_alias,Alias}, St1);
false -> St1
end,
As1 = orddict:store(Alias, Mod, As0), %Add the alias
St2#lfe_lint{aliases=As1};
check_alias(_, L, St) ->
bad_module_def_error(L, 'module-alias', St).
%% check_export_types(Types, Line, State) -> State.
check_export_types(Ts, L, St) ->
case is_func_list(Ts) of
{yes,Fs} ->
Texps = add_exports(Fs, L, St#lfe_lint.texps),
St#lfe_lint{texps=Texps};
no ->
bad_module_def_error(L, 'export-type', St)
end.
%% is_func_ref([Name,Arity]) ->
%% is_atom(Name) and is_integer(Arity) and Arity >= 0;
%% is_func_ref(_Other) -> false.
is_func_list(Fs) -> is_func_list(Fs, ordsets:new()).
is_func_list([[F,Ar]|Fs], Funcs) when is_atom(F), is_integer(Ar), Ar >= 0 ->
is_func_list(Fs, ordsets:add_element({F,Ar}, Funcs));
is_func_list([], Funcs) -> {yes,Funcs};
is_func_list(_, _) -> no.
%% check_onload_attr(Onload, Line, State) -> State.
%% Check the onl_load attribute that it is a valid function reference
%% and that there is only one.
check_onload_attr([[F,Ar]=LoadF], L, St) when is_atom(F), is_integer(Ar) ->
Onload = St#lfe_lint.onload,
if (Onload =:= []) or (Onload =:= LoadF) ->
St#lfe_lint{onload=LoadF};
true ->
bad_attr_error(L, on_load, St)
end;
check_onload_attr(_Onload, L, St) ->
bad_attr_error(L, on_load, St).
%% check_type_defs(TypeDefs, Line, State) -> State.
%% check_type_def(TypeDef, Line, State) -> State.
%% check_type_def(Type, Def, Line, State) -> State.
%% Check a type definition.
check_type_defs(Tds, L, St) ->
check_foreach(fun (Td, S) -> check_type_def(Td, L, S) end,
fun (S) -> bad_meta_def_error(L, type, S) end,
St, Tds).
check_type_def([Type,Def], L, St) ->
check_type_def(Type, Def, L, St);
check_type_def(_, L, St) ->
bad_meta_def_error(L, type, St).
check_type_def(Type, Def, L, St0) ->
{Tvs0,St1} = check_type_name(Type, L, St0),
%% case lfe_types:check_type_def(Def, St1#lfe_lint.types, Tvs0) of
case lfe_types:check_type_def(Def, St1#lfe_lint.records, Tvs0) of
{ok,Tvs1} -> check_type_vars(Tvs1, L, St1);
{error,Error,Tvs1} ->
St2 = add_error(L, Error, St1),
check_type_vars(Tvs1, L, St2)
end.
check_type_name([T|Args], L, #lfe_lint{types=Kts}=St) when is_atom(T) ->
case lfe_lib:is_symb_list(Args) of
true ->
Arity = length(Args),
Kt = {T,Arity},
Tvs = lists:foldl(fun (V, S) -> orddict:update_counter(V, 1, S) end,
[], Args),
case lists:member(Kt, Kts) of
true -> {Tvs,add_error(L, {redefine_type,{T,Arity}}, St)};
false ->
case lfe_internal:is_type(T, Arity) of
true ->
{Tvs,add_error(L, {builtin_type,{T,Arity}}, St)};
false ->
{Tvs,St#lfe_lint{types=[Kt|Kts]}}
end
end;
false -> {[],bad_type_def_error(L, T, St)}
end;
check_type_name(T, L, St) -> %Type name wrong format
{[],bad_type_def_error(L, T, St)}.
%% check_type_vars(TypeVars, Line, State) -> State.
%% Check for singleton type variables except for _ which we allow.
check_type_vars(Tvs, L, St) ->
Check = fun (V, 1, S) when V =/= '_' ->
add_error(L, {singleton_typevar,V}, S);
(_, _, S) -> S
end,
orddict:fold(Check, St, Tvs).
%% check_func_specs(FuncSpecs, Line, State) -> State.
%% check_func_spec(FuncSpec, Line, State) -> State.
%% check_func_spec(Func, Specs, Line, State) -> State.
%% Check a function specification.
check_func_specs(Sps, L, St) ->
check_foreach(fun (Sp, S) -> check_func_spec(Sp, L, S) end,
fun (S) -> bad_meta_def_error(L, spec, S) end,
St, Sps).
check_func_spec([Func|Specs], L, St) ->
check_func_spec(Func, Specs, L, St);
check_func_spec(_, L, St) ->
bad_meta_def_error(L, spec, St).
check_func_spec(Func, Specs, L, St0) ->
{Ar,St1} = check_func_name(Func, L, St0),
case lfe_types:check_func_spec_list(Specs, Ar, St1#lfe_lint.records) of
{ok,Tvss} ->
check_type_vars_list(Tvss, L, St1);
{error,Error,Tvss} ->
St2 = add_error(L, Error, St1),
check_type_vars_list(Tvss, L, St2)
end.
check_func_name([F,Ar], L, #lfe_lint{specs=Kss}=St)
when is_atom(F), is_integer(Ar), Ar >= 0 ->
Ks = {F,Ar},
case lists:member(Ks, Kss) of
true -> {Ar,add_error(L, {redefine_spec,{F,Ar}}, St)};
false -> {Ar,St#lfe_lint{specs=[Ks|Kss]}}
end;
check_func_name(F, L, St) ->
{0,add_error(L, {bad_function_spec,F}, St)}.
check_type_vars_list(Tvss, L, St) ->
lists:foldl(fun (Tvs, S) -> check_type_vars(Tvs, L, S) end, St, Tvss).
%% collect_function(Name, Meta, Def, Line, Fbs, State) -> {Fbs,State}.
%% Collect function and do some basic checks.
collect_function(Name, Meta, Def, L, Fbs, St0) ->
St1 = check_func_metas(Name, Meta, L, St0),
{[{Name,Def,L}|Fbs],St1}.
%% check_func_metas(Name, Metas, Line, State) -> State.
check_func_metas(N, Ms, L, St) ->
check_foreach(fun (M, S) -> check_func_meta(N, M, L, S) end,
fun (S) -> bad_form_error(L, 'define-function', S) end,
St, Ms).
check_func_meta(N, [doc|Docs], L, St) ->
?IF(is_docs_list(Docs), St, bad_meta_def_error(L, N, St));
%% Need to get arity in here.
%% check_func_meta(N, [spec|Specs], L, St0) ->
%% case lfe_types:check_func_spec_list(Specs, Ar, St#lfe_lint.records) of
%% {ok,Tvss} ->
%% check_type_vars_list(Tvss, L, St0);
%% {error,Error,Tvss} ->
%% St1 = add_error(L, Error, St0),
%% check_type_vars_list(Tvss, L, St1)
%% end;
check_func_meta(N, [M|Vals], L, St) ->
?IF(is_atom(M) and lfe_lib:is_proper_list(Vals),
St, bad_meta_def_error(L, N, St));
check_func_meta(N, _, L, St) -> bad_meta_def_error(L, N, St).
%% is_docs_list(Docs) -> boolean().
is_docs_list(Docs) ->
Fun = fun (D) -> lfe_lib:is_doc_string(D) end,
lfe_lib:is_proper_list(Docs) andalso lists:all(Fun, Docs).
%% check_record_defs(RecordDefs, Line, State) -> State.
%% check_record_def(RecordDef, Line, State) -> State.
%% check_record_def(RecordName, Fields, Line, State) -> State.
%% Check a record definition.
check_record_defs(Rdefs, L, St) ->
check_foreach(fun (Rdef, S) -> check_record_def(Rdef, L, S) end,
fun (S) -> bad_meta_def_error(L, record, S) end,
St, Rdefs).
check_record_def([Name,Fields], L, St) ->
check_record_def(Name, Fields, L, St);
check_record_def(_, L, St) ->
bad_meta_def_error(L, record, St).
check_record_def(Name, Fds, L, #lfe_lint{records=Recs}=St0)
when is_atom(Name) ->
case orddict:is_key(Name, Recs) of
true ->
add_error(L, {redefine_record,Name}, St0);
false ->
%% Insert the record with no fields yet.
St1 = St0#lfe_lint{records=orddict:store(Name, [], Recs)},
check_foreach(fun (Fd, S) ->
check_record_field_def(Name, Fd, L, S) end,
fun (S) -> bad_record_def_error(L, Name, S) end,
St1, Fds)
end;
check_record_def(Name, _, L, St) ->
bad_record_def_error(L, Name, St).
check_record_field_def(Name, [Field,D,Type], L, St0) ->
St1 = check_record_field_def(Name, [Field,D], L, St0),
case lfe_types:check_type_def(Type, St1#lfe_lint.records, []) of
{ok,Tvs} -> check_type_vars(Tvs, L, St1);
{error,Error,Tvs} ->
St2 = add_error(L, Error, St1),
check_type_vars(Tvs, L, St2)
end;
check_record_field_def(Name, [Field,_D], L, St) ->
%% Default value checked when record is made.
check_record_field_def(Name, Field, L, St);
check_record_field_def(Name, [Field], L, St) ->
check_record_field_def_1(Name, Field, L, St);
check_record_field_def(Name, Field, L, St) ->
check_record_field_def_1(Name, Field, L, St).
check_record_field_def_1(Name, Field, L, #lfe_lint{records=Recs}=St) ->
if is_atom(Field) ->
St#lfe_lint{records=orddict:append(Name, Field, Recs)};
true ->
bad_record_field_error(L, Name, Field, St)
end.
%% check_struct_def(StructDef, Line, State) -> State.
%% Check a struct definition.
check_struct_def(Fields, L, St) ->
case St#lfe_lint.struct of
undefined ->
check_foreach(fun (Fd, S) ->
check_struct_field_def(Fd, L, S) end,
fun (S) -> bad_struct_def_error(L, S) end,
St#lfe_lint{struct=[]}, Fields);
_Fs ->
add_error(L, redefine_struct, St)
end.
check_struct_field_def([Field,D,Type], L, St0) ->
St1 = check_struct_field_def([Field,D], L, St0),
case lfe_types:check_type_def(Type, St1#lfe_lint.records, []) of
{ok,Tvs} -> check_type_vars(Tvs, L, St1);
{error,Error,Tvs} ->
St2 = add_error(L, Error, St1),
check_type_vars(Tvs, L, St2)
end;
check_struct_field_def([Field,_D], L, St) ->
%% Default value a literal here so no checking.
check_struct_field_def(Field, L, St);
check_struct_field_def([Field], L, St) ->
check_struct_field_def_1(Field, L, St);
check_struct_field_def(Field, L, St) ->
check_struct_field_def_1(Field, L, St).
check_struct_field_def_1(Field, L, #lfe_lint{struct=Fs}=St) ->
if is_atom(Field) ->
St#lfe_lint{struct=[Field|Fs]};
true ->
bad_struct_field_error(L, Field, St)
end.
%% init_state(State) -> {Predefs,Env,State}.
%% Setup the initial predefines and state. Build dummies for
%% predefined module_info which makes it easier to later check
%% redefines.
init_state(St) ->
Env0 = le_new(),
%% Add original import name to the environment.
Env1 = orddict:fold(fun ({F,Ar}, {_Mod,_Ren}, E) ->
le_addf(F, Ar, E)
end, Env0, St#lfe_lint.imports),
%% Basic predefines
Predefs0 = [{module_info,[lambda,[],?Q(dummy)],1},
{module_info,[lambda,[x],?Q(dummy)],1},
{'__info__',[lambda,[x],?Q(dummy)],1},
{'__struct__',[lambda,[],?Q(dummy)],1},
{'__struct__',[lambda,[x],?Q(dummy)],1}
],
Exps0 = [{module_info,0},{module_info,1},
{'__info__',1},{'__struct__',0},{'__struct__',1}],
Exps1 = add_exports(Exps0, St#lfe_lint.mline, St#lfe_lint.exports),
{Predefs0,Env1,St#lfe_lint{exports=Exps1}}.
%% check_functions(FuncBindings, Env, State) -> {Funcs,Env,State}.
%% Check the top-level functions definitions. These have the format
%% as in letrec but the environment only contains explicit imports
%% and the module info functions.
check_functions(Fbs, Env0, St0) ->
{Fs,St1} = check_fbindings(Fbs, St0),
%% Add to the environment.
Env1 = lists:foldl(fun ({{F,A},_L}, Env) -> le_addf(F, A, Env) end,
Env0, Fs),
%% Now check function definitions.
St2 = lists:foldl(fun ({_,[lambda|Lambda],L}, St) ->
check_lambda(Lambda, Env1, L, St);
({_,['match-lambda'|Match],L}, St) ->
check_match_lambda(Match, Env1, L, St);
({F,_,L}, St) -> %Flag error here
bad_fdef_error(L, F, St)
end, St1, Fbs),
{Fs,Env1,St2}.
%% check_valid_exports(State) -> State.
%% Check that all the exports are defined functions.
check_valid_exports(#lfe_lint{exports=Exps,funcs=Funcs}=St) ->
Fun = fun (FAr, L, S) ->
?IF(orddict:is_key(FAr, Funcs),
S,
undefined_function_error(L, FAr, S))
end,
orddict:fold(Fun, St, Exps).
%% check_valid_imports(State) -> State.
check_valid_imports(#lfe_lint{imports=Imps,funcs=Funcs}=St) ->
Fun = fun (FAr, {_Mod,_R}, S) ->
?IF(orddict:is_key(FAr, Funcs),
add_error(orddict:fetch(FAr, Funcs),
{define_imported_function,FAr}, S),
S)
end,
orddict:fold(Fun, St, Imps).
%% add_exports(More, Line, Exports) -> New.
%% Add exports preserving line number of earliest entry.
add_exports(More, L, Exps) ->
Fun = fun (FAr, Es) ->
orddict:update(FAr, fun (Old) -> Old end, L, Es)
end,
lists:foldl(Fun, Exps, More).
%% check_valid_onload(State) -> State.
%% Check that the on_load function is a defined function.
check_valid_onload(#lfe_lint{mline=L,onload=[F,Ar],env=Env}=St) ->
case le_hasf(F, Ar, Env) of
true -> St;
false ->
add_error(L, {undefined_onload_function,{F,Ar}}, St)
end;
check_valid_onload(#lfe_lint{onload=[]}=St) ->
St.
%% check_valid_type_exports(State) -> State.
check_valid_type_exports(#lfe_lint{types=Types,texps=Texps}=St) ->
Fun = fun (E, L, S) ->
?IF(lists:member(E, Types), S,
add_error(L, {undefined_type,E}, S))
end,
orddict:fold(Fun, St, Texps).
%% check_expr(Expr, Env, Line, State) -> State.
%% Check an expression.
%% Check the Core data special forms.
check_expr(?Q(Lit), Env, L, St) -> literal(Lit, Env, L, St);
check_expr([cons|[_,_]=As], Env, L, St) -> check_args(As, Env, L, St);
check_expr([car,E], Env, L, St) -> check_expr(E, Env, L, St);
check_expr([cdr,E], Env, L, St) -> check_expr(E, Env, L, St);
check_expr([list|As], Env, L, St) -> check_args(As, Env, L, St);
check_expr([tuple|As], Env, L, St) -> check_args(As, Env, L, St);
check_expr([tref|[_,_]=As], Env, L, St) -> check_args(As, Env, L, St);
check_expr([tset|[_,_,_]=As], Env, L, St) -> check_args(As, Env, L, St);
check_expr([binary|Segs], Env, L, St) -> expr_bitsegs(Segs, Env, L, St);
check_expr([map|As], Env, L, St) ->
check_map(As, Env, L, St);
check_expr(['msiz',Map], Env, L, St) ->
check_map_size(msiz, Map, Env, L, St);
check_expr(['mref',Map,Key], Env, L, St) ->
check_map_get(mref, Map, Key, Env, L, St);
check_expr(['mset',Map|As], Env, L, St) ->
check_map_set(mset, Map, As, Env, L, St);
check_expr(['mupd',Map|As], Env, L, St) ->
check_map_update(mupd, Map, As, Env, L, St);
check_expr(['mrem',Map|Ks], Env, L, St) ->
check_map_remove(mrem, Map, Ks, Env, L, St);
check_expr(['map-size',Map], Env, L, St) ->
check_map_size('map-size', Map, Env, L, St);
check_expr(['map-get',Map,Key], Env, L, St) ->
check_map_get('map-get', Map, Key, Env, L, St);
check_expr(['map-set',Map|As], Env, L, St) ->
check_map_set('map-set', Map, As, Env, L, St);
check_expr(['map-update',Map|As], Env, L, St) ->
check_map_update('map-update', Map, As, Env, L, St);
check_expr(['map-remove',Map|Ks], Env, L, St) ->
check_map_remove('map-remove', Map, Ks, Env, L, St);
check_expr([function,F,Ar], Env, L, St) ->
%% Check for the right types.
if is_atom(F) and is_integer(Ar) and (Ar >= 0) ->
check_func(F, Ar, Env, L, St);
true -> bad_form_error(L, function, St)
end;
check_expr([function,M,F,Ar], _, L, St) ->
%% Just need the right types here.
if is_atom(M) and is_atom(F) and is_integer(Ar) and (Ar >= 0) -> St;
true -> bad_form_error(L, function, St)
end;
%% Check record special forms.
check_expr(['record',Name|Fs], Env, L, St) ->
check_record(Name, Fs, Env, L, St);
%% make-record has been deprecated but we sill accept it for now.
check_expr(['make-record',Name|Fs], Env, L, St) ->
check_record(Name, Fs, Env, L, St);
check_expr(['is-record',E,Name], Env, L, St0) ->
St1 = check_expr(E, Env, L, St0),
check_record(Name, L, St1);
check_expr(['record-index',Name,F], _Env, L, St) ->
check_record_field(Name, F, L, St);
check_expr(['record-field',E,Name,F], Env, L, St0) ->
St1 = check_expr(E, Env, L, St0),
check_record_field(Name, F, L, St1);
check_expr(['record-update',E,Name|Fs], Env, L, St0) ->
St1 = check_expr(E, Env, L, St0),
check_record(Name, Fs, Env, L, St1);
%% Check struct special forms.
check_expr(['struct',Name|Fs], Env, L, St) ->
check_struct(Name, Fs, Env, L, St);
check_expr(['is-struct',E], Env, L, St) ->
check_expr(E, Env, L, St);
check_expr(['is-struct',E,Name], Env, L, St0) ->
St1 = check_expr(E, Env, L, St0),
check_struct(Name, L, St1);
check_expr(['struct-field',E,Name,F], Env, L, St0) ->
St1 = check_expr(E, Env, L, St0),
check_struct_field(Name, F, L, St1);
check_expr(['struct-update',E,Name|Fs], Env, L, St0) ->
St1 = check_expr(E, Env, L, St0),
check_struct(Name, Fs, Env, L, St1);
%% Special known data type operations.
check_expr(['andalso'|Es], Env, L, St) ->
check_args(Es, Env, L, St);
check_expr(['orelse'|Es], Env, L, St) ->
check_args(Es, Env, L, St);
%% Check the Core closure special forms.
check_expr(['lambda'|Lambda], Env, L, St) ->
check_lambda(Lambda, Env, L, St);
check_expr(['match-lambda'|Match], Env, L, St) ->
check_match_lambda(Match, Env, L, St);
check_expr(['let'|Let], Env, L, St) ->
check_let(Let, Env, L, St);
check_expr(['let-function'|Flet], Env, L, St) ->
check_let_function(Flet, Env, L, St);
check_expr(['letrec-function'|Fletrec], Env, L, St) ->
check_letrec_function(Fletrec, Env, L, St);
check_expr(['let-macro'|_], _, L, St) ->
%% This should never occur! Removed by macro expander.
bad_form_error(L, 'let-macro', St);
%% Check the Core control special forms.
check_expr(['progn'|B], Env, L, St) ->
check_body(progn, B, Env, L, St);
check_expr(['if'|B], Env, L, St) ->
check_if(B, Env, L, St);
check_expr(['case'|B], Env, L, St) ->
check_case(B, Env, L, St);
check_expr(['receive'|Cls], Env, L, St) ->
check_rec_clauses(Cls, Env, L, St);
check_expr(['catch'|B], Env, L, St) ->
check_body('catch', B, Env, L, St);
check_expr(['try'|B], Env, L, St) ->
check_try(B, Env, L, St);
check_expr(['funcall'|As], Env, L, St) ->
check_args(As, Env, L, St);
%% List/binary comprehensions.
check_expr(['lc',Qs,E], Env, L, St) ->
check_comp(Qs, E, Env, L, St);
check_expr(['list-comp',Qs,E], Env, L, St) ->
check_comp(Qs, E, Env, L, St);
check_expr(['bc',Qs,BS], Env, L, St) ->
check_comp(Qs, BS, Env, L, St);
check_expr(['binary-comp',Qs,BS], Env, L, St) ->
check_comp(Qs, BS, Env, L, St);
%% Finally the general cases.
check_expr(['call'|As], Env, L, St) ->
check_args(As, Env, L, St);
check_expr([Fun|As], Env, L, St0) when is_atom(Fun) ->
St1 = check_args(As, Env, L, St0), %Check arguments first
check_func(Fun, safe_length(As), Env, L, St1);
check_expr([_|As]=S, Env, L, St0) -> %Test if literal string
case lfe_lib:is_posint_list(S) of
true -> St0;
false ->
%% Function here is an expression, report error and check args.
St1 = bad_form_error(L, application, St0),
check_args(As, Env, L, St1)
end;
check_expr(Symb, Env, L, St) when is_atom(Symb) ->
check_symb(Symb, Env, L, St);
check_expr(Lit, Env, L, St) -> %Everything else is a literal
literal(Lit, Env, L, St).
%% check_symb(Symbol, Env, Line, State) -> State.
%% Check if Symbol is bound.
check_symb(Symb, Env, L, St) ->
%% case lfe_env:is_vbound(Symb, Env) of
case le_hasv(Symb, Env) of
true -> St;
false -> add_error(L, {unbound_symbol,Symb}, St)
end.
%% check_func(Func, Arity, Env, Line, State) -> State.
%% Check if Func/Arity is bound or an auto-imported BIF.
check_func(F, Ar, Env, L, St) ->
%% case lfe_env:is_fbound(F, Ar, Env) orelse
case le_hasf(F, Ar, Env) orelse
lfe_internal:is_lfe_bif(F, Ar) orelse
lfe_internal:is_erl_bif(F, Ar) of
true -> St;
false -> undefined_function_error(L, {F,Ar}, St)
end.
%% check_body(Form, Body, Env, Line, State) -> State.
%% Check the calls in a body. A body is a proper list of calls. Env is
%% the set of known bound variables.
check_body(Form, Body, Env, L, St) ->
check_foreach(fun (E, S) -> check_expr(E, Env, L, S) end,
fun (S) -> add_error(L, {bad_body_def,Form}, S) end,
St, Body).
%% check_args(Args, Env, Line, State) -> State.
%% Check the expressions in an argument list.
check_args(Args, Env, L, St) ->
check_foreach(fun (A, S) -> check_expr(A, Env, L, S) end,
fun (S) -> add_error(L, bad_args, S) end,
St, Args).
%% check_exprs(Exprs, Env, Line, State) -> State.
%% Check a list of expressions. We know it's a proper list.
check_exprs(Es, Env, L, St) ->
lists:foldl(fun (E, S) -> check_expr(E, Env, L, S) end, St, Es).
%% expr_bitsegs(BitSegs, Env, Line, State) -> State.
expr_bitsegs(Segs, Env, L, St0) ->
BitSeg = fun (S, St) -> check_bitseg(fun check_expr/4, S, Env, L, St) end,
foreach_form(BitSeg, binary, L, St0, Segs).
%% check_bitseg(CheckFun, BitSeg, Env, Line, State) -> State.
%% bitspecs(CheckFun, BitSpecs, Env, Line, State) -> State.
%% bit_size(CheckFun, Size, Type, Env, Line, State) -> State.
%% Functions for checking expression bitsegments.
check_bitseg(Check, [Val|Specs]=Seg, Env, L, St0) ->
%% io:format("cb ~p\n", [Seg]),
case lfe_lib:is_posint_list(Seg) of %Is bitseg a string?
true -> St0; %A string
false -> %A value and spec
St1 = bitspecs(Check, Specs, Env, L, St0),
case lfe_lib:is_posint_list(Val) of %Is Val a string?
true -> St1;
false -> Check(Val, Env, L, St1)
end
end;
check_bitseg(Check, Val, Env, L, St) ->
Check(Val, Env, L, St).
bitspecs(Check, Specs, Env, L, St) ->
case lfe_bits:get_bitspecs(Specs) of
{ok,Sz,Ty} -> bit_size(Check, Sz, Ty, Env, L, St);
{error,E} -> add_error(L, E, St)
end.
%% Catch the case where size was explicitly given as 'undefined' or
%% 'all' for the wrong type.
bit_size(_Check, all, {Ty,_,_,_}, _, L, St) ->
if Ty =:= binary -> St;
true -> illegal_bitsize_error(L, St)
end;
bit_size(_Check, undefined, {Ty,_,_,_}, _, L, St) ->
if Ty =:= utf8; Ty =:= utf16; Ty =:= utf32 -> St;
true -> illegal_bitsize_error(L, St)
end;
bit_size(Check, Sz, _, Env, L, St) -> Check(Sz, Env, L, St).
%% check_map(Pairs, Env, Line, State) -> State.
%% check_map_size(Form, Map, Env, Line, State) -> State.
%% check_map_get(Form, Map, Key, Env, Line, State) -> State.
%% check_map_set(Form, Map, Pairs, Line, State) -> State.
%% check_map_update(Form, Args, Pairs, Line, State) -> State.
%% check_map_remove(Form, Args, Keys, Line, State) -> State.
%% Functions for checking maps, these always return errors if system
%% does not support maps.
-ifdef(HAS_MAPS).
check_map(Pairs, Env, L, St) ->
check_map_pairs(map, Pairs, Env, L, St).
check_map_size(_Form, Map, Env, L, St) ->
check_expr(Map, Env, L, St).
check_map_get(_Form, Map, Key, Env, L, St0) ->
St1 = check_expr(Map, Env, L, St0),
map_key(Key, Env, L, St1).
check_map_set(Form, Map, Pairs, Env, L, St0) ->
St1 = check_expr(Map, Env, L, St0),
check_map_pairs(Form, Pairs, Env, L, St1).
check_map_update(Form, Map, Pairs, Env, L, St0) ->
St1 = check_expr(Map, Env, L, St0),
check_map_pairs(Form, Pairs, Env, L, St1).
check_map_remove(_Form, Map, Keys, Env, L, St0) ->
St1 = check_expr(Map, Env, L, St0),
check_exprs(Keys, Env, L, St1).
check_map_pairs(Form, [K,V|As], Env, L, St0) ->
St1 = check_map_assoc(K, V, Env, L, St0),
check_map_pairs(Form, As, Env, L, St1);
check_map_pairs(_, [], _, _, St) -> St;
check_map_pairs(Form, _, _, L, St) ->
bad_form_error(L, Form, St).
check_map_assoc(K, V, Env, L, St0) ->
St1 = map_key(K, Env, L, St0),
check_expr(V, Env, L, St1).
%% map_key(Key, Env, L, State) -> State.
%% A map key can only be a literal in 17 but can be anything in 18.
-ifdef(HAS_FULL_KEYS).
map_key(Key, Env, L, St) ->
check_expr(Key, Env, L, St).
-else.
map_key(Key, _, L, St) ->
case is_map_key(Key) of
true -> St;
false -> illegal_mapkey_error(L, Key, St)
end.
is_map_key(?Q(Lit)) -> is_literal(Lit);
is_map_key([_|_]=L) ->
lfe_lib:is_posint_list(L); %Literal strings only
is_map_key(E) when is_atom(E) -> false;
is_map_key(Lit) -> is_literal(Lit).
-endif.
-else.
check_map(Ps, _, L, St) ->
undefined_function_error(L, {map,safe_length(Ps)}, St).
check_map_size(Form, _, _, L, St) ->
undefined_function_error(L, {Form,1}, St).
check_map_get(Form, _, _, _, L, St) ->
undefined_function_error(L, {Form,2}, St).
check_map_set(Form, _, Ps, _, L, St) ->
undefined_function_error(L, {Form,safe_length(Ps)+1}, St).
check_map_update(Form, _, Ps, _, L, St) ->
undefined_function_error(L, {Form,safe_length(Ps)+1}, St).
check_map_remove(Form, _, Ks, _, L, St) ->
undefined_function_error(L, {Form,safe_length(Ks)+1}, St).
-endif.
%% check_record(RecordName, Line, State) -> State.
%% check_record(RecordName, Fields, Env, Line, State) -> State.
%% Check record usage against its definition.
check_record(Name, L, #lfe_lint{records=Recs}=St) when is_atom(Name) ->
case orddict:is_key(Name, Recs) of
true -> St;
false ->
undefined_record_error(L, Name, St)
end;
check_record(Name, L, St) ->
bad_record_name_error(L, Name, St).
check_record(Name, Fields, Env, L, #lfe_lint{records=Recs}=St)
when is_atom(Name) ->
case orddict:find(Name, Recs) of
{ok,Rfields} ->
check_record_fields(Name, Rfields, Fields, Env, L, St);
error ->
undefined_record_error(L, Name, St)
end;
check_record(Name, _, _, L, St) ->
bad_record_name_error(L, Name, St).
%% check_record_fields(RecordName, RecordFields, Fields, Env, Line, State) ->
%% State.
check_record_fields(Name, Rfs, ['_',_Val|Fs], Env, L, St) ->
%% The _ field is special!
check_record_fields(Name, Rfs, Fs, Env, L, St);
check_record_fields(Name, Rfs, [F,Val|Fs], Env, L, St0) ->
St1 = case lists:member(F, Rfs) of
true ->
check_expr(Val, Env, L, St0);
false ->
undefined_record_field_error(L, Name, F, St0)
end,
check_record_fields(Name, Rfs, Fs, Env, L, St1);
check_record_fields(Name, _Rfs, [F], _Env, L, St) ->
missing_record_field_value_error(L, Name, F, St);
check_record_fields(_Name, _Rfs, [], _Env, _L, St) -> St;
check_record_fields(Name, _Rfs, Pat, _Env, L, St) ->
bad_record_field_error(L, Name, Pat, St).
%% check_record_field(RecordName, Field, Line, State) -> State.
%% Check whether record has beeen defined and has a field.
check_record_field(Name, F, L, #lfe_lint{records=Recs}=St)
when is_atom(Name) ->
case orddict:find(Name, Recs) of
{ok,Rfields} ->
case lists:member(F, Rfields) of
true -> St;
false ->
undefined_record_field_error(L, Name, F, St)
end;
error ->
undefined_record_error(L, Name, St)
end;
check_record_field(Name, _F, L, St) ->
bad_record_name_error(L, Name, St).
%% check_struct(StructName, Line, State) -> State.
%% check_struct(StructName, Fields, Env, Line, State) -> State.
%% Check struct usage against its definition.
check_struct(Name, L, St0) ->
case get_struct_fields(Name, L, St0) of
{ok,_Sfields} -> St0;
{error,St1} -> St1
end.
check_struct(Name, Fields, Env, L, St0) ->
case get_struct_fields(Name, L, St0) of
{ok,Sfields} ->
check_struct_fields(Name, Sfields, Fields, Env, L, St0);
{error,St1} -> St1
end.
%% check_struct_field(StructName, Field, Line, State) -> State.
check_struct_field(Name, Field, L, St0) ->
case get_struct_fields(Name, L, St0) of
{ok,Sfields} ->
case lists:member(Field, Sfields) of
true -> St0;
false ->
undefined_struct_field_error(L, Name, Field, St0)
end;
{error,St1} -> St1
end.
%% get_struct_fields(StructName, Line, State) -> {ok,Fields} | {error,State}.
%% Check if struct exists either in this module or in another module
%% and if so return the fields
get_struct_fields(Name, L, #lfe_lint{module=Mod}=St) when Name =:= Mod ->
case St#lfe_lint.struct of
undefined ->
{error,undefined_struct_error(L, Name, St)};
Sfields -> {ok,Sfields}
end;
get_struct_fields(Name, L, St) ->
try
Sfields = maps:keys(Name:'__struct__'()),
{ok,Sfields}
catch
_:_ -> {error,undefined_struct_error(L, Name, St)}
end.
%% check_struct_fields(StructName, StructFields, Fields, Env, Line, State) ->
%% State.
check_struct_fields(Name, Sfs, [F,Val|Fs], Env, L, St0) ->
St1 = case lists:member(F, Sfs) of
true ->
check_expr(Val, Env, L, St0);
false ->
undefined_struct_field_error(L, Name, F, St0)
end,
check_struct_fields(Name, Sfs, Fs, Env, L, St1);
check_struct_fields(Name, _Sfs, [F], _Env, L, St) ->
missing_struct_field_value_error(L, Name, F, St);
check_struct_fields(_Name, _Sfs, [], _Env, _L, St) -> St;
check_struct_fields(Name, _Sfs, _Field, _Env, L, St) ->
bad_struct_def_error(L, Name, St).
%% check_lambda(LambdaBody, Env, Line, State) -> State.
%% Check form (lambda Args ...).
check_lambda([Args|Body], Env, L, St0) ->
{Vs,St1} = check_lambda_args(Args, L, St0),
check_body(lambda, Body, le_addvs(Vs, Env), L, St1);
check_lambda(_, _, L, St) -> bad_form_error(L, lambda, St).
check_lambda_args(Args, L, St) ->
%% 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 lfe_lib:is_symb_list(Args) of
true -> lists:foldl(Check, {[],St}, Args);
false -> {[],bad_form_error(L, lambda, St)}
end.
%% check_match_lambda(MatchBody, Env, Line, State) -> State.
%% Check form (match-lambda Clause ...), must be at least one clause.
%% Use arity of 1st as THE arity. Do one pass to get errors in right
%% order.
check_match_lambda([C|_]=Cls, Env, L, St) ->
Ar = ml_arity(C), %Arity of 1st clause
check_ml_clauses(Cls, Ar, Env, L, St);
check_match_lambda(_, _, L, St) -> %Totally wrong, no clauses
bad_form_error(L, 'match-lambda', St).
ml_arity([Pat|_]) ->
safe_length(Pat, -1);
ml_arity(_) -> -1.
check_ml_clause([Pat|Rest]=C, Ar, Env0, L, St0) ->
St1 = case ml_arity(C) =:= Ar of
true -> St0;
false -> add_error(L, bad_head_arity, St0)
end,
check_clause('match-lambda', [[list|Pat]|Rest], Env0, L, St1);
check_ml_clause(_, _, _, L, St) ->
bad_form_error(L, clause, St).
check_ml_clauses(Cls, Ar, Env, L, St) ->
foreach_form(fun (C, S) -> check_ml_clause(C, Ar, Env, L, S) end,
'match-lambda', L, St, Cls).
%% check_let(LetBody, Env, Line, State) -> {Env,State}.
%% Check let variable bindings and then body. Must be careful to use
%% correct bindings.
check_let([Vbs|Body], Env, L, St0) ->
Check = fun (Vb, Pvs, Sta) ->
{Pv,Stb} = check_let_vb(Vb, Env, L, Sta),
Stc = case ordsets:intersection(Pv, Pvs) of
[] -> Stb;
Ivs -> multi_var_error(L, Ivs, Stb)
end,
{ordsets:union(Pv, Pvs), Stc}
end,
{Pvs,St1} = foldl_form(Check, 'let', L, [], St0, Vbs),
check_body('let', Body, le_addvs(Pvs, Env), L, St1);
check_let(_, _, L, St) ->
bad_form_error(L, 'let', St).
%% check_let_vb(VarBind, Env, Line, State) -> {Env,State}.
%% Check a variable binding of form [Pat,[when,Guard],Val] or
%% [Pat,Val].
check_let_vb([_|_]=Vb, Env, L, St0) ->
%% Get the environments right here!
case pattern_guard(Vb, Env, L, St0) of
{[Val],Pvs,_,St1} -> %One value expression only
{Pvs,check_expr(Val, Env, L, St1)};
{_,_,_,St1} -> {[],bad_form_error(L, 'let', St1)}
end;
check_let_vb(_, _, L, St) -> {[],bad_form_error(L, 'let', St)}.
%% check_let_function(FletBody, Env, Line, State) -> {Env,State}.
%% Check a let-function form (let-function FuncBindings ... ).
check_let_function([Fbs0|Body], Env0, L, St0) ->
%% Collect correct function definitions.
{Fbs1,St1} = collect_let_funcs(Fbs0, 'let-function', L, St0),
{_,Env1,St2} = check_let_bindings(Fbs1, Env0, St1),
check_body('let-function', Body, Env1, L, St2).
%% check_letrec_function(FletrecBody, Env, Line, State) -> {Env,State}.
%% Check a letrec-function form (letrec-function FuncBindings ... ).
check_letrec_function([Fbs0|Body], Env0, L, St0) ->
%% Collect correct function definitions.
{Fbs1,St1} = collect_let_funcs(Fbs0, 'letrec-function', L, St0),
{_,Env1,St2} = check_letrec_bindings(Fbs1, Env0, St1),
check_body('letrec-function', Body, Env1, L, St2).
%% collect_let_funcs(FuncDefs, Type, Line, State) -> {Funcbindings,State}.
%% Collect the function definitions for a let/letrec-function
%% checking right types. Returns same format as top-level collect.
collect_let_funcs(Fbs0, Type, L, St0) ->
Check = fun ([V,['lambda'|_]=Lambda], Fbs, St) when is_atom(V) ->
{[{V,Lambda,L}|Fbs],St};
([V,['match-lambda'|_]=Match], Fbs, St) when is_atom(V) ->
{[{V,Match,L}|Fbs],St};
(_, Fbs, St) -> {Fbs,bad_form_error(L, Type, St)}
end,
foldr_form(Check, Type, L, [], St0, Fbs0). %Preserve order
%% check_let_bindings(FuncBindings, Env, State) -> {Funcs,Env,State}.
%% Check the function bindings and return new environment. We only
%% have to worry about checking for the valid forms as the rest will
%% already be reported. Use explicit line number in element.
check_let_bindings(Fbs, Env0, St0) ->
{Funcs,St1} = check_fbindings(Fbs, St0),
%% Now check function definitions.
St2 = lists:foldl(fun ({_,[lambda|Lambda],L}, St) ->
check_lambda(Lambda, Env0, L, St);
({_,['match-lambda'|Match],L}, St) ->
check_match_lambda(Match, Env0, L, St)
end, St1, Fbs),
%% Add to environment
Env1 = lists:foldl(fun ({{F,A},_L}, Env) -> le_addf(F, A, Env) end,
Env0, Funcs),
{Funcs,Env1,St2}.
%% check_letrec_bindings(FuncBindings, Env, State) -> {Funcs,Env,State}.
%% Check the function bindings and return new environment. We only
%% have to worry about checking for the valid forms as the rest will
%% already be reported. Use explicit line number in element.
check_letrec_bindings(Fbs, Env0, St0) ->
{Funcs,St1} = check_fbindings(Fbs, St0),
%% Add to the environment.
Env1 = lists:foldl(fun ({{F,A},_L}, Env) -> le_addf(F, A, Env) end,
Env0, Funcs),
%% Now check function definitions.
St2 = lists:foldl(fun ({_,[lambda|Lambda],L}, St) ->
check_lambda(Lambda, Env1, L, St);
({_,['match-lambda'|Match],L}, St) ->
check_match_lambda(Match, Env1, L, St)
end, St1, Fbs),
{Funcs,Env1,St2}.
%% check_fbindings(FuncBindings, State) -> {Funcs,State}.
%% Check function bindings for format and for multiple fucntion
%% definitions.
check_fbindings(Fbs0, St0) ->
AddFb = fun(FAr, Funcs, L, St) ->
case orddict:is_key(FAr, Funcs) of
true ->
{Funcs,add_error(L, {redefine_function,FAr}, St)};
false -> {orddict:store(FAr, L, Funcs),St}
end
end,
Check = fun ({V,[lambda,Args|_],L}, {Funcs,St}) ->
case lfe_lib:is_symb_list(Args) of
true -> AddFb({V,length(Args)}, Funcs, L, St);
false -> {Funcs,bad_form_error(L, lambda, St)}
end;
({V,['match-lambda',[Pats|_]|_],L}, {Funcs,St}) ->
case lfe_lib:is_proper_list(Pats) of
true -> AddFb({V,length(Pats)}, Funcs, L, St);
false -> {Funcs,bad_form_error(L, 'match-lambda', St)}
end;
(_, Acc) -> Acc %Error here flagged elsewhere
end,
lists:foldl(Check, {orddict:new(),St0}, Fbs0).
%% check_if(IfBody, Env, Line, State) -> State.
%% Check form (if Test True [False]).
check_if([Test,True,False], Env, L, St) ->
check_exprs([Test,True,False], Env, L, St);
check_if([Test,True], Env, L, St) ->
check_exprs([Test,True], Env, L, St);
check_if(_, _, L, St) ->
bad_form_error(L, 'if', St).
%% check_case(CaseBody, Env, Line, State) -> State.
%% Check form (case Expr Clause ...), must be at least one clause.
check_case([E|[_|_]=Cls], Env, L, St0) ->
St1 = check_expr(E, Env, L, St0),
check_case_clauses(Cls, Env, L, St1);
check_case(_, _, L, St) ->
bad_form_error(L, 'case', St).
check_case_clauses(Cls, Env, L, St) ->
foreach_form(fun (Cl, S) -> check_clause('case', Cl, Env, L, S) end,
'case', L, St, Cls).
check_rec_clauses([['after',T|B]], Env, L, St0) ->
St1 = check_expr(T, Env, L, St0),
check_body('receive', B, Env, L, St1);
check_rec_clauses([['after'|_]|Cls], Env, L, St) ->
%% Only allow after last and with timeout.
check_rec_clauses(Cls, Env, L, bad_form_error(L, 'receive', St));
check_rec_clauses([Cl|Cls], Env, L, St) ->
check_rec_clauses(Cls, Env, L, check_clause('receive', Cl, Env, L, St));
check_rec_clauses([], _, _, St) -> St;
check_rec_clauses(_, _, L, St) -> bad_form_error(L, 'receive', St).
check_clause(Form, [_|_]=Cl, Env0, L, St0) ->
{B,_,Env1,St1} = pattern_guard(Cl, Env0, L, St0),
check_body(Form, B, Env1, L, St1);
check_clause(Form, _, _, L, St) -> bad_form_error(L, Form, St).
%% check_try(TryBody, Env, Line, State) -> State.
%% Check a (try ...) form making sure that the right combination of
%% options are present. Case is optional, but we must have at least
%% one of catch and after.
check_try([E,['case'|Cls]|Catch], Env, L, St0) ->
St1 = check_expr(E, Env, L, St0),
St2 = check_case_clauses(Cls, Env, L, St1),
check_try_catch(Catch, Env, L, St2);
check_try([E|Catch], Env, L, St0) ->
St1 = check_expr(E, Env, L, St0),
check_try_catch(Catch, Env, L, St1);
check_try(_, _, L, St) -> bad_form_error(L, 'try', St).
check_try_catch([['catch'|Catch]], Env, L, St) ->
check_catch_clauses(Catch, Env, L, St);
check_try_catch([['catch'|Catch],['after'|After]], Env, L, St0) ->
St1 = check_catch_clauses(Catch, Env, L, St0),
check_body('try', After, Env, L, St1);
check_try_catch([['after'|After]], Env, L, St) ->
check_body('try', After, Env, L, St);
check_try_catch(_, _, L, St) -> bad_form_error(L, 'try', St).
check_catch_clauses(Cls, Env, L, St) ->
foreach_form(fun (C, S) -> check_catch_clause(C, Env, L, S) end,
'try', L, St, Cls).
check_catch_clause(['_'|_]=Cl, Env, L, St) ->
check_clause('catch', Cl, Env, L, St);
check_catch_clause([[tuple,_,_,Stack]|_]=Cl, Env, L, St0) ->
%% Stack must be an unbound variable.
%% St1 = case is_atom(Stack) and not lfe_env:is_vbound(Stack, Env) of
St1 = case is_atom(Stack) and not le_hasv(Stack, Env) of
true -> St0;
false -> add_error(L, {illegal_stacktrace,Stack}, St0)
end,
check_clause('catch', Cl, Env, L, St1);
check_catch_clause([Other|_], _Env, L, St) ->
add_error(L, {illegal_exception,Other}, St).
%% check_comp(Qualifiers, Expr, Env, LineNumber, State) -> State.
%% Check a comprehension. We can use the same function for both list
%% and binary comprehensions here and push any extra tests to the
%% Erlang compiler.
check_comp(Qs, Expr, Env0, L, St0) ->
%% io:format("~p ~p ~p\n", [L,Qs,BitExpr]),
{Env1,St1} = check_comp_quals(Qs, Env0, L, St0),
check_expr(Expr, Env1, L, St1).
%% check_comp_quals(Qualifiers, Env, LineNumber, State) ->
%% {Env,State}.
%% Note that the explicit guards are now tested as guards.
check_comp_quals([['<-',Pat,E]|Qs], Env0, L, St0) ->
{Pvs,St1} = pattern(Pat, Env0, L, St0),
Env1 = le_addvs(Pvs, Env0),
St2 = check_expr(E, Env1, L, St1),
check_comp_quals(Qs, Env1, L, St2);
check_comp_quals([['<-',Pat,['when'|G],E]|Qs], Env0, L, St0) ->
{Pvs,St1} = pattern(Pat, Env0, L, St0),
Env1 = le_addvs(Pvs, Env0),
St2 = check_guard(G, Env1, L, St1),
St3 = check_expr(E, Env1, L, St2),
check_comp_quals(Qs, Env1, L, St3);
check_comp_quals([['<=',Pat,E]|Qs], Env0, L, St0) ->
{Pvs,St1} = check_bitstring_pattern(Pat, Env0, L, St0),
Env1 = le_addvs(Pvs, Env0),
St2 = check_expr(E, Env1, L, St1),
check_comp_quals(Qs, Env1, L, St2);
check_comp_quals([['<=',Pat,['when'|G],E]|Qs], Env0, L, St0) ->
{Pvs,St1} = check_bitstring_pattern(Pat, Env0, L, St0),
Env1 = le_addvs(Pvs, Env0),
St2 = check_guard(G, Env1, L, St1),
St3 = check_expr(E, Env1, L, St2),
check_comp_quals(Qs, Env1, L, St3);
check_comp_quals([Test|Qs], Env, L, St0) ->
St1 = check_expr(Test, Env, L, St0),
check_comp_quals(Qs, Env, L, St1);
check_comp_quals([], Env, _L, St) ->
{Env,St}.
%% check_bitstring_pattern(Pattern, Env, LineNumber, State) -> {PatVars,State}.
%% The bitstring pattern must be a binary.
check_bitstring_pattern(Pat, Env, L, St) ->
pattern(Pat, Env, L, St).
%% check_bitstring_pattern([binary|Segs], Env, L, St) ->
%% pat_binary(Segs, [], Env, L, St);
%% check_bitstring_pattern(Pat, _Env, L, St) ->
%% {[],illegal_pattern_error(L, Pat, St)}.
%% pattern_guard([Pat{,Guard}|Body], Env, L, State) ->
%% {Body,PatVars,Env,State}.
%% Check pattern and guard in a clause. We know there is at least pattern!
pattern_guard([Pat,['when'|G]|Body], Env0, L, St0) ->
{Pvs,St1} = pattern(Pat, Env0, L, St0),
Env1 = le_addvs(Pvs, Env0),
St2 = check_guard(G, Env1, L, St1),
{Body,Pvs,Env1,St2};
pattern_guard([Pat|Body], Env0, L, St0) ->
{Pvs,St1} = pattern(Pat, Env0, L, St0),
Env1 = le_addvs(Pvs, Env0),
{Body,Pvs,Env1,St1}.
%% check_guard(GuardTests, Env, Line, State) -> State.
%% Check a guard.
check_guard(G, Env, L, St) -> check_gbody(G, Env, L, St).
%% check_gbody(Body, Env, Line, State) -> State.
%% Check guard expressions in a body
check_gbody(Exprs, Env, L, St) ->
check_foreach(fun (E, S) -> check_gexpr(E, Env, L, S) end,
fun (S) -> add_error(L, bad_guard_def, S) end,
St, Exprs).
%% check_gexpr(Call, Env, Line, State) -> State.
%% Check a guard expression. This is a restricted body expression.
%% Check the Core data special cases.
check_gexpr(?Q(Lit), Env, L, St) -> literal(Lit, Env, L, St);
check_gexpr([cons|[_,_]=As], Env, L, St) -> check_gargs(As, Env, L, St);
check_gexpr([car,E], Env, L, St) -> check_gexpr(E, Env, L, St);
check_gexpr([cdr,E], Env, L, St) -> check_gexpr(E, Env, L, St);
check_gexpr([list|As], Env, L, St) -> check_gargs(As, Env, L, St);
check_gexpr([tuple|As], Env, L, St) -> check_gargs(As, Env, L, St);
check_gexpr([tref|[_,_]=As], Env, L, St) -> check_gargs(As, Env, L, St);
check_gexpr([binary|Segs], Env, L, St) -> gexpr_bitsegs(Segs, Env, L, St);
%% Check map special forms which translate into legal guard expressions.
check_gexpr([map|As], Env, L, St) ->
check_gmap(As, Env, L, St);
check_gexpr([msiz,Map], Env, L, St) ->
check_gmap_size(msiz, Map, Env, L, St);
check_gexpr([mref,Map,Key], Env, L, St) ->
check_gmap_get(mref, Map, Key, Env, L, St);
check_gexpr([mset,Map|As], Env, L, St) ->
check_gmap_set(mset, Map, As, Env, L, St);
check_gexpr([mupd,Map|As], Env, L, St) ->
check_gmap_update(mupd, Map, As, Env, L, St);
check_gexpr(['map-size',Map], Env, L, St) ->
check_gmap_size('map-size', Map, Env, L, St);
check_gexpr(['map-get',Map,Key], Env, L, St) ->
check_gmap_get('map-get', Map, Key, Env, L, St);
check_gexpr(['map-set',Map|As], Env, L, St) ->
check_gmap_set('map-set', Map, As, Env, L, St);
check_gexpr(['map-update',Map|As], Env, L, St) ->
check_gmap_update('map-update', Map, As, Env, L, St);
%% Check record special forms.
check_gexpr(['is-record',E,Name], Env, L, St0) ->
St1 = check_gexpr(E, Env, L, St0),
check_record(Name, L, St1);
check_gexpr(['record-index',Name,F], _Env, L, St) ->
check_record_field(Name, F, L, St);
check_gexpr(['record-field',E,Name,F], Env, L, St0) ->
St1 = check_gexpr(E, Env, L, St0),
check_record_field(Name, F, L, St1);
%% Check struct special forms.
check_gexpr(['is-struct',E], Env, L, St) ->
check_gexpr(E, Env, L, St);
check_gexpr(['is-struct',E,Name], Env, L, St0) ->
St1 = check_gexpr(E, Env, L, St0),
check_struct(Name, L, St1);
check_gexpr(['struct-field',E,Name,F], Env, L, St0) ->
St1 = check_gexpr(E, Env, L, St0),
check_struct_field(Name, F, L, St1);
%% Special known data type operations.
check_gexpr(['andalso'|Es], Env, L, St) ->
check_gargs(Es, Env, L, St);
check_gexpr(['orelse'|Es], Env, L, St) ->
check_gargs(Es, Env, L, St);
check_gexpr([call,?Q(erlang),?Q(Fun)|As], Env, L, St0) ->
St1 = check_gargs(As, Env, L, St0),
%% It must be a legal guard bif here.
case lfe_internal:is_guard_bif(Fun, safe_length(As)) of
true -> St1;
false -> illegal_guard_error(L, St1)
end;
%% Finally the general case.
check_gexpr([call|_], _, L, St) -> %Other calls not allowed
illegal_guard_error(L, St);
check_gexpr([Fun|As], Env, L, St0) when is_atom(Fun) ->
St1 = check_gargs(As, Env, L, St0),
check_gfunc(Fun, safe_length(As), Env, L, St1);
check_gexpr([_|As]=S, Env, L, St0) -> %Test if literal string
case lfe_lib:is_posint_list(S) of
true -> St0;
false ->
%% Function here is an expression, report error and check args.
St1 = bad_guard_form_error(L, application, St0),
check_gargs(As, Env, L, St1)
end;
check_gexpr(Symb, Env, L, St) when is_atom(Symb) ->
check_symb(Symb, Env, L, St);
check_gexpr(Lit, Env, L, St) -> %Everything else is a literal
literal(Lit, Env, L, St).
%% check_gfunc(Func, Arity, Env, Line, State) -> State.
%% Check if Func/Arity is not bound and an auto-imported guard BIF.
check_gfunc(F, Ar, Env, L, St) ->
%% case (not lfe_env:is_fbound(F, Ar, Env)) andalso
case (not le_hasf(F, Ar, Env)) andalso
lfe_internal:is_guard_bif(F, Ar) of
true -> St;
false -> illegal_guard_error(L, St)
end.
%% check_gargs(Args, Env, Line, State) -> State.
%% check_gexprs(Exprs, Env, Line, State) -> State.
%% The guard counter parts. Check_gexprs assumes a proper list.
check_gargs(Args, Env, L, St) ->
check_foreach(fun (A, S) -> check_gexpr(A, Env, L, S) end,
fun (S) -> add_error(L, bad_gargs, S) end,
St, Args).
%% check_gexprs(Es, Env, L, St) ->
%% foldl(fun (E, S) -> check_gexpr(E, Env, L, S) end, St, Es).
%% gexpr_bitsegs(BitSegs, Env, Line, State) -> State.
gexpr_bitsegs(Segs, Env, L, St0) ->
BitSeg = fun (S, St) -> check_bitseg(fun check_gexpr/4, S, Env, L, St) end,
check_foreach(BitSeg,
fun (St) -> bad_guard_form_error(L, binary, St) end,
St0, Segs).
%% check_gmap_size(Form, Map, Env, Line, State) -> State.
%% check_gmap_get(Form, Map, Key, Env, Line, State) -> State.
%% check_gmap_set(Form, Map, Pairs, Line, State) -> State.
%% check_gmap_update(Form, Args, Pairs, Line, State) -> State.
%% Functions for checking maps, these always return errors if system
%% does not support maps. Note the special check if map-get is
%% guardable.
-ifdef(HAS_MAPS).
check_gmap(Pairs, Env, L, St) ->
check_gmap_pairs(map, Pairs, Env, L, St).
check_gmap_size(_Form, Map, Env, L, St) ->
check_gexpr(Map, Env, L, St).
check_gmap_get(Form, Map, Key, Env, L, St0) ->
case lfe_internal:is_guard_bif(map_get, 2) of
true ->
St1 = check_gexpr(Map, Env, L, St0),
gmap_key(Key, Env, L, St1);
false ->
undefined_function_error(L, {Form,2}, St0)
end.
check_gmap_set(Form, Map, Pairs, Env, L, St0) ->
St1 = check_expr(Map, Env, L, St0),
check_gmap_pairs(Form, Pairs, Env, L, St1).
check_gmap_update(Form, Map, Pairs, Env, L, St0) ->
St1 = check_gexpr(Map, Env, L, St0),
check_gmap_pairs(Form, Pairs, Env, L, St1).
check_gmap_pairs(Form, [K,V|As], Env, L, St0) ->
St1 = check_gmap_assoc(K, V, Env, L, St0),
check_gmap_pairs(Form, As, Env, L, St1);
check_gmap_pairs(_, [], _, _, St) -> St;
check_gmap_pairs(Form, _, _, L, St) ->
bad_form_error(L, Form, St).
check_gmap_assoc(K, V, Env, L, St0) ->
St1 = gmap_key(K, Env, L, St0),
check_gexpr(V, Env, L, St1).
%% gmap_key(Key, Env, L, State) -> State.
%% A map key can only be a literal in 17 but can be anything in 18.
-ifdef(HAS_FULL_KEYS).
gmap_key(Key, Env, L, St) ->
check_gexpr(Key, Env, L, St).
-else.
gmap_key(Key, _, L, St) ->
case is_map_key(Key) of
true -> St;
false -> illegal_mapkey_error(L, Key, St)
end.
-endif.
-else.
check_gmap(Ps, _, L, St) ->
undefined_function_error(L, {map,safe_length(Ps)}, St).
check_gmap_size(Form, _, _, L, St) ->
undefined_function_error(L, {Form,1}, St).
check_gmap_get(Form, _, _, _, L, St) ->
undefined_function_error(L, {Form,2}, St).
check_gmap_set(Form, _, Ps, _, L, St) ->
undefined_function_error(L, {Form,safe_length(Ps)+1}, St).
check_gmap_update(Form, _, Ps, _, L, St) ->
undefined_function_error(L, {Form,safe_length(Ps)+1}, St).
-endif.
%% pattern(Pattern, Env, L, State) -> {PatVars,State}.
%% pattern(Pattern, PatVars, Env, L, State) -> {PatVars,State}.
%% Return the *set* of Variables in Pattern. Patterns are
%% complicated by the fact that we don't allow multiple occurrence of
%% variables, this is an error. Explicit guards tests are
%% necessary. So we need to carry around the current pattern
%% variables as well as the environment.
pattern(Pat, Env, L, St) ->
%% io:fwrite("pat: ~p\n", [Pat]),
%% pattern/5 should never fail!
pattern(Pat, [], Env, L, St).
%% try
%% pattern(Pat, [], Env, L, St)
%% catch
%% _:_ -> {[],illegal_pattern_error(L, Pat, St)}
%% end.
pattern(?Q(Lit), Pvs, Env, L, St) ->
{Pvs,literal(Lit, Env, L, St)};
pattern(['=',P1,P2], Pvs0, Env, L, St0) ->
%% Must check patterns together as same variable can occur
%% in both branches.
{Pvs1,St1} = pattern(P1, Pvs0, Env, L, St0),
{Pvs2,St2} = pattern(P2, Pvs1, Env, L, St1),
St3 = case is_pat_alias(P1, P2) of
true -> St2; %Union of variables now visible
false -> add_error(L, bad_pat_alias, St2)
end,
{Pvs2,St3};
pattern([cons,H,T], Pvs0, Env, L, St0) -> %Explicit cons constructor
{Pvs1,St1} = pattern(H, Pvs0, Env, L, St0),
pattern(T, Pvs1, Env, L, St1);
pattern([list|Ps], Pvs, Env, L, St) -> %Explicit list constructor
pat_list(Ps, Pvs, Env, L, St);
pattern([tuple|Ps], Pvs, Env, L, St) -> %Tuple elements
pat_list(Ps, Pvs, Env, L, St);
pattern([binary|Segs], Pvs, Env, L, St) ->
pat_binary(Segs, Pvs, Env, L, St);
pattern([map|Ps], Pvs, Env, L, St) ->
pat_map(Ps, Pvs, Env, L, St);
%% Check record patterns.
pattern(['record',Name|Fs], Pvs, Env, L, St) ->
check_record_pat(Name, Fs, Pvs, Env, L, St);
%% make-record has been deprecated but we sill accept it for now.
pattern(['make-record',Name|Fs], Pvs, Env, L, St) ->
check_record_pat(Name, Fs, Pvs, Env, L, St);
pattern(['record-index',Name,F], _Pvs, _Env, L, St) ->
check_record_field(Name, F, L, St);
%% Check struct patterns.
pattern(['struct',Name|Fs], Pvs, Env, L, St) ->
check_struct_pat(Name, Fs, Pvs, Env, L, St);
%% Check old no contructor list forms.
pattern([_|_]=List, Pvs, _, L, St) ->
case lfe_lib:is_posint_list(List) of
true -> {Pvs,St}; %A string
false -> %Illegal pattern
{Pvs,illegal_pattern_error(L, List, St)}
end;
pattern([], Pvs, _, _, St) -> {Pvs,St};
pattern(Symb, Pvs, _, L, St) when is_atom(Symb) ->
pat_symb(Symb, Pvs, L, St);
pattern(Lit, Pvs, Env, L, St) ->
{Pvs,literal(Lit, Env, L, St)}. %Everything else is a literal
pat_list([P|Ps], Pvs0, Env, L, St0) ->
{Pvs1,St1} = pattern(P, Pvs0, Env, L, St0),
pat_list(Ps, Pvs1, Env, L, St1);
pat_list([], Pvs, _, _, St) -> {Pvs,St};
pat_list(Pat, Pvs, _, L, St) ->
{Pvs,illegal_pattern_error(L, Pat, St)}.
pat_symb('_', Pvs, _, St) -> {Pvs,St}; %Don't care variable
pat_symb(Symb, Pvs, _, St) ->
{ordsets:add_element(Symb, Pvs),St}. %Add that to pattern vars
%% is_pat_alias(Pattern, Pattern) -> true | false.
%% Check if two pattern aliases are compatible. Note that binaries
%% can never be aliased, this is from erlang.
is_pat_alias(?Q(P1), ?Q(P2)) -> P1 =:= P2;
is_pat_alias([tuple|Ps1], [tuple|Ps2]) ->
is_pat_alias_list(Ps1, Ps2);
%% is_pat_alias([tuple|Ps1], P2) when is_tuple(P2) ->
%% is_pat_alias_list(Ps1, tuple_to_list(P2));
%% is_pat_alias(P1, [tuple|Ps2]) when is_tuple(P1) ->
%% is_pat_alias_list(tuple_to_list(P1), Ps2);
is_pat_alias([binary|_], [binary|_]) -> false;
is_pat_alias([cons,H1,T1], [cons,H2,T2]) ->
is_pat_alias(H1, H2) andalso is_pat_alias(T1, T2);
is_pat_alias([cons,H1,T1], [list,H2|T2]) ->
is_pat_alias(H1, H2) andalso is_pat_alias(T1, [list|T2]);
is_pat_alias([list|Ps1], [list|Ps2]) ->
is_pat_alias_list(Ps1, Ps2);
is_pat_alias([list,H1|T1], [cons,H2,T2]) ->
is_pat_alias(H1, H2) andalso is_pat_alias([list|T1], T2);
%% Check against old no contructor list forms.
is_pat_alias([list|_]=P1, P2) when is_list(P2) ->
is_pat_alias(P1, [list|P2]);
is_pat_alias([cons,_,_]=P1, [H2|T2]) ->
is_pat_alias(P1, [cons,H2,T2]);
is_pat_alias(P1, [list|_]=P2) when is_list(P1) ->
is_pat_alias([list|P1], P2);
is_pat_alias([H1|T1], [cons,_,_]=P2) ->
is_pat_alias([cons,H1,T1], P2);
%% Check old against old no constructor list forms.
is_pat_alias([P1|Ps1], [P2|Ps2]) ->
is_pat_alias(P1, P2) andalso is_pat_alias(Ps1, Ps2);
is_pat_alias(P1, _) when is_atom(P1) -> true; %Variable
is_pat_alias(_, P2) when is_atom(P2) -> true;
is_pat_alias(P1, P2) -> P1 =:= P2. %Atomic
is_pat_alias_list([P1|Ps1], [P2|Ps2]) ->
is_pat_alias(P1, P2) andalso is_pat_alias_list(Ps1, Ps2);
is_pat_alias_list([], []) -> true;
is_pat_alias_list(_, _) -> false.
%% pat_binary(BitSegs, PatVars, Env, Line, State) -> {PatVars,State}.
%% pat_bitsegs(BitSegs, BitVars, PatVars, Env, Line, State) ->
%% {PatVars,State}.
%% pat_bitseg(BitSeg, BitVars, PatVars, Env, Line, State) ->
%% {BitVars,State}.
%% pat_bitspecs(BitSpecs, BitVars, PatVars, Env, Line, State) -> State.
%% pat_bit_size(Size, Type, BitVars, PatVars, Env, Line, State) -> State.
%% pat_bit_expr(BitElement, BitVars, PatVars, Env, Line, State) ->
%% {BitVars,State}.
%% Functions for checking pattern bitsegments. This gets a bit
%% complex as we allow using values from left to right within the
%% binary pattern but only as sizes, no implicit equality checks so
%% multiple pattern variables are an error. We only update BitVars
%% during the match.
pat_binary(Segs, Pvs, Env, L, St) ->
pat_bitsegs(Segs, [], Pvs, Env, L, St).
pat_bitsegs(Segs, Bvs0, Pvs, Env, L, St0) ->
{Bvs1,St1} =
check_foldl(fun (Seg, Bvs, St) ->
pat_bitseg(Seg, Bvs, Pvs, Env, L, St)
end,
fun (St) -> bad_pattern_error(L, binary, St) end,
Bvs0, St0, Segs),
{ordsets:union(Bvs1, Pvs),St1}. %Add bitvars to patvars
pat_bitseg([Pat|Specs]=Seg, Bvs, Pvs, Env, L, St0) ->
case lfe_lib:is_posint_list(Seg) of %Is bitseg a string?
true -> {Bvs,St0}; %A string
false -> %A pattern and spec
St1 = pat_bitspecs(Specs, Bvs, Pvs, Env, L, St0),
case lfe_lib:is_posint_list(Pat) of %Is Pat a string?
true -> {Bvs,St1};
false -> pat_bit_expr(Pat, Bvs, Pvs, Env, L, St1)
end
end;
pat_bitseg(Pat, Bvs, Pvs, Env, L, St) ->
pat_bit_expr(Pat, Bvs, Pvs, Env, L, St).
pat_bitspecs(Specs, Bvs, Pvs, Env, L, St) ->
case lfe_bits:get_bitspecs(Specs) of
{ok,Sz,Ty} -> pat_bit_size(Sz, Ty, Bvs, Pvs, Env, L, St);
{error,E} -> add_error(L, E, St)
end.
%% Catch the case where size was explicitly given as 'undefined' or
%% 'all' for the wrong type.
pat_bit_size(all, {Ty,_,_,_}, _, _, _, L, St) ->
if Ty =:= binary -> St;
true -> illegal_bitsize_error(L, St)
end;
pat_bit_size(undefined, {Ty,_,_,_}, _, _, _, L, St) ->
if Ty =:= utf8; Ty =:= utf16; Ty =:= utf32 -> St;
true -> illegal_bitsize_error(L, St)
end;
pat_bit_size(N, _, _, _, _, _, St) when is_integer(N), N > 0 -> St;
pat_bit_size(S, _, Bvs, _, Env, L, St) when is_atom(S) ->
%% Size must be bound here or occur earlier in binary pattern.
%% case is_element(S, Bvs) or lfe_env:is_vbound(S, Env) of
case ordsets:is_element(S, Bvs) or le_hasv(S, Env) of
true -> St;
false -> add_error(L, {unbound_symbol,S}, St)
end;
pat_bit_size(_, _, _, _, _, L, St) -> illegal_bitsize_error(L, St).
pat_bit_expr(N, Bvs, _, _, _, St) when is_number(N) -> {Bvs,St};
pat_bit_expr('_', Bvs, _, _, _, St) -> {Bvs,St};
pat_bit_expr(S, Bvs, _, _, _, St) when is_atom(S) ->
{ordsets:add_element(S, Bvs),St};
pat_bit_expr(_, Bvs, _, _, L, St) ->
{Bvs,add_error(L, illegal_bitseg, St)}.
%% pat_map(Pairs, PatVars, Env, Line, State) -> {PatVars,State}.
-ifdef(HAS_MAPS).
pat_map([K,V|As], Pvs0, Env, L, St0) ->
{Pvs1,St1} = pat_map_assoc(K, V, Pvs0, Env, L, St0),
pat_map(As, Pvs1, Env, L, St1);
pat_map([], Pvs, _, _, St) -> {Pvs,St};
pat_map(_, Pvs, _, L, St) ->
{Pvs,bad_form_error(L, map, St)}.
pat_map_assoc(K, V, Pvs, Env, L, St0) ->
St1 = pat_map_key(K, Env, L, St0),
pattern(V, Pvs, Env, L, St1).
%% pat_map_key(Key, Env, L, State) -> State.
%% A pattern map key can currently only be a literal.
pat_map_key(Key, _, L, St) ->
case is_pat_map_key(Key) of
true -> St;
false -> illegal_mapkey_error(L, Key, St)
end.
is_pat_map_key(?Q(Lit)) -> is_literal(Lit);
is_pat_map_key([_|_]=L) ->
lfe_lib:is_posint_list(L); %Literal strings only
is_pat_map_key(E) when is_atom(E) -> false;
is_pat_map_key(Lit) -> is_literal(Lit).
-else.
pat_map(Ps, Pvs, _, L, St) ->
{Pvs,illegal_pattern_error(L, Ps, St)}.
-endif.
%% check_record_pat(Name, Fields, PatVars, Env, Line State) -> {PatVars,State}.
check_record_pat(Name, Fields, Pvs, Env, L, #lfe_lint{records=Recs}=St)
when is_atom(Name) ->
case orddict:find(Name, Recs) of
{ok,Rfields} ->
check_record_pat_fields(Name, Fields, Rfields, Pvs, Env, L, St);
error ->
{Pvs,undefined_record_error(L, Name, St)}
end;
check_record_pat(Name, _, Pvs, _, L, St) ->
{Pvs,bad_record_def_error(L, Name, St)}.
check_record_pat_fields(Name, ['_',_Val|Fs], Rfs, Pvs, Env, L, St) ->
%% The _ field is special!
check_record_pat_fields(Name, Fs, Rfs, Pvs, Env, L, St);
check_record_pat_fields(Name, [F,Pat|Fs], Rfs, Pvs0, Env, L, St0) ->
{Pvs1,St1} = case lists:member(F, Rfs) of
true ->
pattern(Pat, Pvs0, Env, L, St0);
false ->
{Pvs0,undefined_record_field_error(L, Name, F, St0)}
end,
check_record_pat_fields(Name, Fs, Rfs, Pvs1, Env, L, St1);
check_record_pat_fields(_Name, [], _, Pvs, _, _, St) -> {Pvs,St};
check_record_pat_fields(Name, _, _, Pvs, _, L, St) ->
{Pvs,bad_record_def_error(L, Name, St)}.
%% check_struct_pat(Name, Fields, PatVars, Env, Line, State) -> {PatVars,State}.
check_struct_pat(Name, Fields, Pvs, Env, L, St0) ->
case get_struct_fields(Name, L, St0) of
{ok,Sfields} ->
check_struct_pat_fields(Name, Fields, Sfields, Pvs, Env, L, St0);
{error,St1} -> {Pvs,St1}
end.
check_struct_pat_fields(Name, [F,Pat|Fs], Sfs, Pvs0, Env, L, St0) ->
{Pvs1,St1} = case lists:member(F, Sfs) of
true ->
pattern(Pat, Pvs0, Env, L, St0);
false ->
{Pvs0,undefined_struct_field_error(L, Name, F, St0)}
end,
check_struct_pat_fields(Name, Fs, Sfs, Pvs1, Env, L, St1);
check_struct_pat_fields(_Name, [], _, Pvs, _, _, St) -> {Pvs,St};
check_struct_pat_fields(Name, _Field, _, Pvs, _, L, St) ->
{Pvs,bad_struct_def_error(L, Name, St)}.
%% is_literal(Literal) -> true | false.
%% literal(Literal, Env, Line, State) -> State.
%% Check for legal literals. We have to be extra careful here as the
%% input can be any forms. We assume that special cases at the top
%% level, for example atoms as variables and lists as calls, are
%% handled before the call to literal/4.
literal(Lit, _, L, St) ->
case is_literal(Lit) of
true -> St;
false -> add_error(L, {illegal_literal,Lit}, St)
end.
is_literal(A) when is_atom(A) -> true;
is_literal(N) when is_number(N) -> true;
is_literal(B) when is_bitstring(B) -> true;
is_literal(List) when is_list(List) ->
is_lit_list(List);
is_literal(Tup) when is_tuple(Tup) ->
is_lit_list(tuple_to_list(Tup));
is_literal(Map) -> %Handles maps and non-maps
is_lit_map(Map).
is_lit_list([Lit|Lits]) ->
is_literal(Lit) andalso is_lit_list(Lits);
is_lit_list([]) -> true;
is_lit_list(Lit) ->
is_literal(Lit).
-ifdef(HAS_MAPS).
is_lit_map(Map) when is_map(Map) ->
is_lit_list(maps:to_list(Map));
is_lit_map(_) -> false.
-else.
is_lit_map(_) -> false.
-endif.
%% Functions for checking lists of forms, generate bad_form error if
%% not proper list.
foreach_form(Check, T, L, St, Fs) ->
check_foreach(Check, fun (S) -> bad_form_error(L, T, S) end, St, Fs).
%% map_form(Check, T, L, St, Fs) ->
%% check_map(Check, fun (S) -> bad_form_error(L, T, S) end, St, Fs).
foldl_form(Fun, T, L, Acc, St, Fs) ->
check_foldl(Fun, fun (S) -> bad_form_error(L, T, S) end, Acc, St, Fs).
foldr_form(Fun, T, L, Acc, St, Fs) ->
check_foldr(Fun, fun (S) -> bad_form_error(L, T, S) end, Acc, St, Fs).
%% check_foreach(Check, Err, State, Forms) -> State.
%% check_map(Check, Err, State, Forms) -> {Results,State}.
%% check_foldl(Check, Err, Acc, State, Forms) -> {Acc,State}.
%% check_foldr(Check, Err, Acc, State, Forms) -> {Acc,State}.
%% These functions automatically manage a state variable and check for
%% proper top list. Could easily and clearly be done with a Lisp
%% macro.
check_foreach(Check, Err, St0, [F|Fs]) ->
St1 = Check(F, St0),
check_foreach(Check, Err, St1, Fs);
check_foreach(_, _, St, []) -> St;
check_foreach(_, Err, St, _) -> Err(St).
check_foldl(Check, Err, Acc0, St0, [F|Fs]) ->
{Acc1,St1} = Check(F, Acc0, St0),
check_foldl(Check, Err, Acc1, St1, Fs);
check_foldl(_, _, Acc, St, []) -> {Acc,St};
check_foldl(_, Err, Acc, St, _) -> {Acc,Err(St)}.
check_foldr(Check, Err, Acc0, St0, [F|Fs]) ->
{Acc1,St1} = check_foldr(Check, Err, Acc0, St0, Fs),
Check(F, Acc1, St1);
check_foldr(_, _, Acc, St, []) -> {Acc,St};
check_foldr(_, Err, Acc, St, _) -> {Acc,Err(St)}.
%% Versions which only check for proper top list.
%% check_foreach(Check, Err, St, Fs) ->
%% case lfe_lib:is_proper_list(Fs) of
%% true -> lists:foldl(Check, St, Fs);
%% false -> Err(St)
%% end.
%% check_map(Check, Err, St, Fs) ->
%% case lfe_lib:is_proper_list(Fs) of
%% true -> lists:foldl(Check, St, Fs);
%% false -> {[],Err(St)}
%% end.
%% check_foldl(Check, Err, Acc, St, Fs) ->
%% case lfe_lib:is_proper_list(Fs) of
%% true ->
%% lists:foldl(fun (F, {A,S}) -> Check(F, A, S) end, {Acc,St}, F);
%% false -> {Acc,Err(St)}
%% end.
%% check_foldr(Check, Err, Acc, St, Fs) ->
%% case lfe_lib:is_proper_list(Fs) of
%% true ->
%% lists:foldl(fun (F, {A,S}) -> Check(F, A, S) end, {Acc,St}, F);
%% false -> {Acc,Err(St)}
%% end.
%% Versions which completely wrap with a try. These may catch too much!
%% check_foreach(Fun, Err, St, Fs) ->
%% try
%% foldl(Fun, St, Fs)
%% catch
%% _:_ -> Err(St)
%% end.
%% check_map(Fun, Err, St, Fs) ->
%% try
%% mapfoldl(Fun, St, Fs)
%% catch
%% _:_ -> {[],Err(St)}
%% end.
%% check_foldl(Fun, Err, Acc, St, Fs) ->
%% try
%% foldl(fun (F, {A,S}) -> Fun(F, A, S) end, {Acc,St}, Fs)
%% catch
%% _:_ -> {Acc,Err(St)}
%% end.
%% check_foldr(Fun, Err, St, Acc, Fs) ->
%% try
%% foldr(fun (F, {A,S}) -> Fun(F, A, S) end, {Acc,St}, Fs)
%% catch
%% _:_ -> {Acc,Err(St)}
%% end.
%% safe_length(List) -> Length.
%% Safely check length of list, can handle improper lists.
safe_length(L) -> safe_length(L, 0).
safe_length([_|L], Acc) -> safe_length(L, Acc+1);
safe_length(_, Acc) -> Acc.
%% safe_fetch(Key, Dict, Default) -> Value.
%% Fetch a value with a default if it doesn't exist.
%% safe_fetch(Key, D, Def) ->
%% case orddict:find(Key, D) of
%% {ok,Val} -> Val;
%% error -> Def
%% end.
%% add_error(Line, Error, State) -> State.
%% add_warning(Line, Warning, State) -> State.
%% add_errors(Line, Errors, State) -> State.
add_error(L, E, #lfe_lint{errors=Errs}=St) ->
St#lfe_lint{errors=Errs ++ [{L,?MODULE,E}]}.
add_warning(L, W, #lfe_lint{warnings=Warns}=St) ->
St#lfe_lint{warnings=Warns ++ [{L,?MODULE,W}]}.
%% add_errors(L, Es, #lfe_lint{errors=Errs}=St) ->
%% St#lfe_lint{errors=Errs ++ [ {L,?MODULE,E} || E <- Es ]}.
bad_attr_error(L, A, St) ->
add_error(L, {bad_attribute,A}, St).
bad_meta_def_error(L, A, St) ->
add_error(L, {bad_meta_def,A}, St).
bad_form_error(L, F, St) ->
add_error(L, {bad_form,F}, St).
bad_guard_form_error(L, F, St) ->
add_error(L, {bad_guard_form,F}, St).
-ifdef(HAS_MAPS).
illegal_mapkey_error(L, K, St) ->
add_error(L, {illegal_mapkey,K}, St).
-endif.
illegal_bitsize_error(L, St) ->
add_error(L, illegal_bitsize, St).
bad_pattern_error(L, F, St) ->
add_error(L, {bad_pattern,F}, St).
illegal_pattern_error(L, P, St) ->
add_error(L, {illegal_pattern,P}, St).
bad_module_def_error(L, D, St) ->
add_error(L, {bad_module_def,D}, St).
%% Record errors.
bad_record_def_error(L, R, St) ->
add_error(L, {bad_record_def,R}, St).
bad_record_name_error(L, R, St) ->
add_error(L, {bad_record_name,R}, St).
bad_record_field_error(L, R, F, St) ->
add_error(L, {bad_record_field,R,F}, St).
undefined_record_error(L, R, St) ->
add_error(L, {undefined_record,R}, St).
undefined_record_field_error(L, R, F, St) ->
add_error(L, {undefined_record_field,R,F}, St).
missing_record_field_value_error(L, R, F, St) ->
add_error(L, {missing_record_field_value,R,F}, St).
%% Struct errors.
bad_struct_def_error(L, St) ->
add_error(L, bad_struct_def, St).
bad_struct_def_error(L, Name, St) ->
add_error(L, {bad_struct_def,Name}, St).
bad_struct_field_error(L, F, St) ->
add_error(L, {bad_struct_field,F}, St).
undefined_struct_error(L, Name, St) ->
add_error(L, {undefined_struct,Name}, St).
undefined_struct_field_error(L, Name, F, St) ->
add_error(L, {undefined_struct_field,Name,F}, St).
missing_struct_field_value_error(L, Name, F, St) ->
add_error(L, {missing_struct_field_value,Name,F}, St).
bad_fdef_error(L, D, St) ->
add_error(L, {bad_fdef,D}, St).
multi_var_error(L, V, St) ->
add_error(L, {multi_var,V}, St).
undefined_function_error(L, F, St) ->
add_error(L, {undefined_function,F}, St).
illegal_guard_error(L, St) ->
add_error(L, illegal_guard, St).
bad_type_def_error(L, T, St) ->
add_error(L, {bad_type_def,T}, St).
%% Deprecated errors.
deprecated_error(L, D, St) ->
add_error(L, {deprecated,D}, St).
deprecated_warning(L, D, St) ->
add_warning(L, {deprecated,D}, St).
%% Accessing our local environment of functions and variables. We just
%% need to know their existence here here so we use ordsets.
le_new() -> #{funs => ordsets:new(), vars => ordsets:new()}.
le_addv(V, #{vars := Vars} = LE) ->
LE#{vars := ordsets:add_element(V, Vars)}.
le_addvs(Vs, Env) ->
lists:foldl(fun (V, E) -> le_addv(V, E) end, Env, Vs).
le_hasv(V, #{vars := Vars}) ->
ordsets:is_element(V, Vars).
le_addf(F, Ar, #{funs := Funs} = LE) ->
LE#{funs := ordsets:add_element({F,Ar}, Funs)}.
le_hasf(F, Ar, #{funs := Funs}) ->
ordsets:is_element({F,Ar}, Funs).