From 37bb19424efcb780f1bb156cf987c5f81d381c01 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Fri, 29 Oct 2021 16:05:20 +0300 Subject: [PATCH 01/85] Get MFA to Kfun mappings Store original specs in kmodule Get mfas to specs mappings debug commit xxx added spec checker, updated kfun api added update of kmodules added fixpoint computation, ready to change annotating function kmodule updates unification changes Bugfix at updating kmodule add cuter_maybe_error annotation added the dynamic check bugfix updated cuter spec checker unreachable clauses analysis corrected module loading by xref support opaque type declarations Changed isForced flag to Options map. Pruning is now clever removed obsolete functions from cuter_log Support records in function spec and type extraction added some unit tests for the static ananlysis corrected unit tests, multiple spec functions discarded Updated unreachable clauses logic added dynamic type dependent function call and apply check Bugfix bugfix in type from pattern removed unnecessary uncallable state deleted trash code fix point type passing removed obsolete functions --- Makefile.in | 6 +- cuter | 3 + include/cuter_macros.hrl | 10 + src/cuter.erl | 29 +- src/cuter_cerl.erl | 55 +- src/cuter_codeserver.erl | 31 +- src/cuter_eval.erl | 454 ++++++++------- src/cuter_graphs.erl | 333 +++++++++++ src/cuter_log.erl | 6 +- src/cuter_maybe_error_annotation.erl | 515 +++++++++++++++++ src/cuter_spec_checker.erl | 749 +++++++++++++++++++++++++ src/cuter_type_dependent_functions.erl | 350 ++++++++++++ src/cuter_types.erl | 218 +++++++ test/ftest/src/reduce_search_space.erl | 91 ++- test/ftests.json | 42 +- 15 files changed, 2658 insertions(+), 234 deletions(-) create mode 100644 src/cuter_graphs.erl create mode 100644 src/cuter_maybe_error_annotation.erl create mode 100644 src/cuter_spec_checker.erl create mode 100644 src/cuter_type_dependent_functions.erl diff --git a/Makefile.in b/Makefile.in index f011d5f1..175ce18a 100644 --- a/Makefile.in +++ b/Makefile.in @@ -82,7 +82,11 @@ SRC_MODULES = \ cuter_strategy \ cuter_bfs_strategy \ cuter_metrics \ - cuter_config + cuter_config \ + cuter_spec_checker \ + cuter_graphs \ + cuter_maybe_error_annotation \ + cuter_type_dependent_functions UTEST_MODULES = \ cuter_tests_lib \ diff --git a/cuter b/cuter index 9a72d699..d369aa64 100755 --- a/cuter +++ b/cuter @@ -38,6 +38,7 @@ def main(): parser.add_argument("-m", "--metrics", action='store_true', help="report collected metrics") parser.add_argument("--debug-keep-traces", action='store_true', help="keep execution traces for debugging") parser.add_argument("--debug-solver-fsm", action='store_true', help="output debug logs for the solver FSM") + parser.add_argument("-ps", "--prune-safe", action='store_true', help="prune safe paths and stop the execution early") # Parse the arguments args = parser.parse_args() @@ -109,6 +110,8 @@ def main(): opts.append("debug_keep_traces") if args.debug_solver_fsm: opts.append("debug_solver_fsm") + if args.prune_safe: + opts.append("prune_safe") strOpts = ",".join(opts) # Run CutEr diff --git a/include/cuter_macros.hrl b/include/cuter_macros.hrl index 8572c4cd..d9af4a12 100644 --- a/include/cuter_macros.hrl +++ b/include/cuter_macros.hrl @@ -89,6 +89,8 @@ -define(NUM_SOLVERS, number_of_solvers). %% Sets the number of concurrent concolic execution processes. -define(NUM_POLLERS, number_of_pollers). +%% Prune safe paths. +-define(PRUNE_SAFE, prune_safe). -type runtime_options() :: {?Z3_TIMEOUT, pos_integer()} | ?REPORT_METRICS @@ -104,6 +106,7 @@ | {?NUM_SOLVERS, pos_integer()} | {?NUM_POLLERS, pos_integer()} | {?WORKING_DIR, file:filename()} + | ?PRUNE_SAFE . %%==================================================================== @@ -156,3 +159,10 @@ %% Empty tag ID -define(EMPTY_TAG_ID, 0). + +%%==================================================================== +%% Miscellaneous stored values in cuter config +%%==================================================================== + +%% Entry point for concolic testing +-define(ENTRY_POINT, entry_point). diff --git a/src/cuter.erl b/src/cuter.erl index 62bdc126..729c1e66 100644 --- a/src/cuter.erl +++ b/src/cuter.erl @@ -48,7 +48,7 @@ run(M, F, As, Depth, Options) -> Seeds = [{M, F, As, Depth}], run(Seeds, Options). --spec run([seed()], options()) -> erroneous_inputs(). +-spec run([seed(),...], options()) -> erroneous_inputs(). %% Runs CutEr on multiple units. run(Seeds, Options) -> State = state_from_options_and_seeds(Options, Seeds), @@ -87,7 +87,8 @@ run_from_file(File, Options) -> %% The tasks to run during the app initialization. init_tasks() -> [fun ensure_exported_entry_points/1, - fun compute_callgraph/1]. + fun compute_callgraph/1, + fun annotate_for_possible_errors/1]. -spec init(state()) -> ok | error. init(State) -> @@ -128,10 +129,17 @@ compute_callgraph(State) -> Mfas = mfas_from_state(State), cuter_codeserver:calculate_callgraph(State#st.codeServer, Mfas). - mfas_from_state(State) -> [{M, F, length(As)} || {M, F, As, _} <- State#st.seeds]. +annotate_for_possible_errors(State) -> + case cuter_config:fetch(?PRUNE_SAFE) of + {ok, true} -> + cuter_codeserver:annotate_for_possible_errors(State#st.codeServer); + _ -> + ok + end. + %% ---------------------------------------------------------------------------- %% Manage the concolic executions %% ---------------------------------------------------------------------------- @@ -143,8 +151,7 @@ start(State) -> -spec start([seed()], state()) -> state(). start([], State) -> State; -start([{M, F, As, Depth}|Seeds], State) -> - CodeServer = State#st.codeServer, +start([{M, F, As, Depth}|Seeds], State) -> CodeServer = State#st.codeServer, Scheduler = State#st.scheduler, Errors = start_one(M, F, As, Depth, CodeServer, Scheduler), NewErrors = [{{M, F, length(As)}, Errors}|State#st.errors], @@ -239,7 +246,7 @@ stop(State) -> %% Generate the system state %% ---------------------------------------------------------------------------- --spec state_from_options_and_seeds(options(), [seed()]) -> state(). +-spec state_from_options_and_seeds(options(), [seed(),...]) -> state(). state_from_options_and_seeds(Options, Seeds) -> process_flag(trap_exit, true), error_logger:tty(false), %% disable error_logger @@ -247,7 +254,7 @@ state_from_options_and_seeds(Options, Seeds) -> ok = cuter_metrics:start(), ok = define_metrics(), enable_debug_config(Options), - enable_runtime_config(Options), + enable_runtime_config(Options, Seeds), ok = cuter_pp:start(), CodeServer = cuter_codeserver:start(), SchedPid = cuter_scheduler:start(?DEFAULT_DEPTH, CodeServer), @@ -265,8 +272,8 @@ enable_debug_config(Options) -> cuter_config:store(?DEBUG_SMT, proplists:get_bool(?DEBUG_SMT, Options)), cuter_config:store(?DEBUG_SOLVER_FSM, proplists:get_bool(?DEBUG_SOLVER_FSM, Options)). --spec enable_runtime_config(options()) -> ok. -enable_runtime_config(Options) -> +-spec enable_runtime_config(options(), [seed(),...]) -> ok. +enable_runtime_config(Options, [{M, F, I, _D}|_]) -> {ok, CWD} = file:get_cwd(), cuter_config:store(?WORKING_DIR, cuter_lib:get_tmp_dir(proplists:get_value(?WORKING_DIR, Options, CWD))), @@ -284,7 +291,9 @@ enable_runtime_config(Options) -> cuter_config:store(?SORTED_ERRORS, proplists:get_bool(?SORTED_ERRORS, Options)), cuter_config:store(?WHITELISTED_MFAS, whitelisted_mfas(Options)), cuter_config:store(?NUM_SOLVERS, proplists:get_value(?NUM_SOLVERS, Options, ?ONE)), - cuter_config:store(?NUM_POLLERS, proplists:get_value(?NUM_POLLERS, Options, ?ONE)). + cuter_config:store(?NUM_POLLERS, proplists:get_value(?NUM_POLLERS, Options, ?ONE)), + cuter_config:store(?PRUNE_SAFE, proplists:get_bool(?PRUNE_SAFE, Options)), + cuter_config:store(?ENTRY_POINT, {M, F, length(I)}). verbosity_level(Options) -> Default = cuter_pp:default_reporting_level(), diff --git a/src/cuter_cerl.erl b/src/cuter_cerl.erl index b62ce444..69e53bc1 100644 --- a/src/cuter_cerl.erl +++ b/src/cuter_cerl.erl @@ -14,10 +14,11 @@ %% Exported for debugging use. -export([classify_attributes/1]). %% kfun API. --export([kfun/2, kfun_code/1, kfun_is_exported/1]). +-export([kfun/2, kfun_code/1, kfun_is_exported/1, kfun_update_code/2]). %% kmodule API. --export([destroy_kmodule/1, kmodule/4, kmodule_kfun/2, kmodule_mfa_spec/2, - kmodule_specs/1, kmodule_types/1]). +-export([destroy_kmodule/1, kmodule/6, kmodule_kfun/2, kmodule_mfa_spec/2, + kmodule_specs/1, kmodule_types/1, kmodule_ast/1, kmodule_update_kfun/3, kmodule_mfas_with_kfuns/1, kmodule_specs_forms/1, + kmodule_mfas_with_specs_forms/1]). %% We are using the records representation of Core Erlang Abstract Syntax Trees -include_lib("compiler/src/core_parse.hrl"). @@ -169,7 +170,7 @@ load(M, TagGen, WithPmatch) -> Specs = cuter_types:retrieve_specs(SpecAttrs), Defs = cerl:module_defs(AST), Funs = [process_fundef(D, Exports, M, TagGen) || D <- Defs], - {ok, kmodule(M, Types, Specs, Funs)}; + {ok, kmodule(M, AST, Types, Specs, Funs, SpecAttrs)}; {error, _} = Error -> Error end. @@ -177,14 +178,22 @@ load(M, TagGen, WithPmatch) -> %% kmodule API %% ------------------------------------------------------------------- --spec kmodule(module(), cuter_types:stored_types(), cuter_types:stored_specs(), [{mfa(), kfun()}]) -> kmodule(). -kmodule(M, Types, Specs, Funs) -> +-spec kmodule(module(), cerl:cerl(), cuter_types:stored_types(), cuter_types:stored_specs(), [{mfa(), kfun()}], [spec_info()]) -> kmodule(). +kmodule(M, AST, Types, Specs, Funs, SpecsForms) -> Kmodule = ets:new(M, [ordered_set, protected]), + ets:insert(Kmodule, {ast, AST}), + ets:insert(Kmodule, {name, M}), ets:insert(Kmodule, {types, Types}), ets:insert(Kmodule, {specs, Specs}), + ets:insert(Kmodule, {specs_forms, SpecsForms}), lists:foreach(fun({Mfa, Kfun}) -> ets:insert(Kmodule, {Mfa, Kfun}) end, Funs), Kmodule. +-spec kmodule_ast(kmodule()) -> cerl:cerl(). +kmodule_ast(Kmodule) -> + [{ast, AST}] = ets:lookup(Kmodule, ast), + AST. + -spec kmodule_specs(kmodule()) -> cuter_types:stored_specs(). kmodule_specs(Kmodule) -> [{specs, Specs}] = ets:lookup(Kmodule, specs), @@ -214,6 +223,37 @@ destroy_kmodule(Kmodule) -> ets:delete(Kmodule), ok. +-spec kmodule_mfas_with_kfuns(kmodule()) -> dict:dict(mfa(), kfun()). +kmodule_mfas_with_kfuns(Kmodule) -> + Fn = fun({Key, Val}, Acc) -> + case is_mfa(Key) of + true -> dict:store(Key, Val, Acc); + false -> Acc + end + end, + ets:foldl(Fn, dict:new(), Kmodule). + +is_mfa({M, F, A}) when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> true; +is_mfa(_Mfa) -> false. + +-spec kmodule_specs_forms(kmodule()) -> [spec_info()]. +kmodule_specs_forms(Kmodule) -> + [{specs_forms, SpecsForms}] = ets:lookup(Kmodule, specs_forms), + SpecsForms. + +-spec kmodule_mfas_with_specs_forms(kmodule()) -> dict:dict(mfa(), any()). +kmodule_mfas_with_specs_forms(Kmodule) -> + [{name, M}] = ets:lookup(Kmodule, name), + SpecsForms = kmodule_specs_forms(Kmodule), + Fn = fun({{F, A}, Spec}, Acc) -> + dict:store({M, F, A}, Spec, Acc) + end, + lists:foldl(Fn, dict:new(), SpecsForms). + +% updates the kfun of the given MFa +-spec kmodule_update_kfun(kmodule(), mfa(), kfun()) -> true. +kmodule_update_kfun(Kmodule, MFa, Kfun) -> ets:insert(Kmodule, {MFa, Kfun}). + %% ------------------------------------------------------------------- %% kfun API %% ------------------------------------------------------------------- @@ -228,6 +268,9 @@ kfun_is_exported(#{is_exported := IsExported}) -> IsExported. -spec kfun_code(kfun()) -> code(). kfun_code(#{code := Code}) -> Code. +-spec kfun_update_code(kfun(), code()) -> kfun(). +kfun_update_code(Fun, Code) -> Fun#{code=>Code}. + %% =================================================================== %% Internal functions %% =================================================================== diff --git a/src/cuter_codeserver.erl b/src/cuter_codeserver.erl index d4962a51..9946097b 100644 --- a/src/cuter_codeserver.erl +++ b/src/cuter_codeserver.erl @@ -10,6 +10,8 @@ visit_tag/2, calculate_callgraph/2, %% Work with module cache merge_dumped_cached_modules/2, modules_of_dumped_cache/1, + %% Code annotations + annotate_for_possible_errors/1, %% Access logs cachedMods_of_logs/1, visitedTags_of_logs/1, tagsAddedNo_of_logs/1, unsupportedMfas_of_logs/1, loadedMods_of_logs/1]). @@ -142,6 +144,11 @@ calculate_callgraph(CodeServer, Mfas) -> get_feasible_tags(CodeServer, NodeTypes) -> gen_server:call(CodeServer, {get_feasible_tags, NodeTypes}). +%% Annotates the code for possible errors. +-spec annotate_for_possible_errors(codeserver()) -> ok. +annotate_for_possible_errors(CodeServer) -> + gen_server:call(CodeServer, annotate_for_possible_errors). + %% ---------------------------------------------------------------------------- %% gen_server callbacks (Server Implementation) %% ---------------------------------------------------------------------------- @@ -182,6 +189,7 @@ handle_info(_Msg, State) -> ; (get_whitelist, from(), state()) -> {reply, cuter_mock:whitelist(), state()} ; ({get_feasible_tags, cuter_cerl:node_types()}, from(), state()) -> {reply, cuter_cerl:visited_tags(), state()} ; ({calculate_callgraph, [mfa()]}, from(), state()) -> {reply, ok, state()} + ; (annotate_for_possible_errors, from(), state()) -> {reply, ok, state()} . handle_call({load, M}, _From, State) -> {reply, try_load(M, State), State}; @@ -231,7 +239,28 @@ handle_call({calculate_callgraph, Mfas}, _From, State=#st{whitelist = Whitelist} end, cuter_callgraph:foreachModule(LoadFn, Callgraph), {reply, ok, State#st{callgraph = Callgraph}} - end. + end; +handle_call(annotate_for_possible_errors, _From, State=#st{db = Db}) -> + Fn = fun({M, Kmodule}, {KfunAcc, AstAcc}) -> + KfunMappings = cuter_cerl:kmodule_mfas_with_kfuns(Kmodule), + TrivialMergeFn = fun(_K, V1, _V2) -> V1 end, + KfunAcc1 = dict:merge(TrivialMergeFn, KfunAcc, KfunMappings), + AstAcc1 = [{M, cuter_cerl:kmodule_ast(Kmodule)}|AstAcc], + {KfunAcc1, AstAcc1} + end, + {ok, EntryPoint} = cuter_config:fetch(?ENTRY_POINT), + {MfasToKfuns, CodeList} = ets:foldl(Fn, {dict:new(), []}, Db), + %io:format("Before Specs~n"), + MfasToSpecs = cuter_types:parse_specs(CodeList), + UpdatedKfuns = cuter_maybe_error_annotation:preprocess(EntryPoint, MfasToKfuns, MfasToSpecs, true), + RFn = fun({M, F, A}, Kfun, _Acc) -> + [{_M, Kmodule}] = ets:lookup(Db, M), + cuter_cerl:kmodule_update_kfun(Kmodule, {M, F, A}, Kfun) + end, + dict:fold(RFn, ok, UpdatedKfuns), + %io:format("ast: ~p~n", [cuter_cerl:kfun_code(dict:fetch(EntryPoint, UpdatedKfuns))]), + {reply, ok, State}. + %% gen_server callback : handle_cast/2 -spec handle_cast(stop, state()) -> {stop, normal, state()} | {noreply, state()} diff --git a/src/cuter_eval.erl b/src/cuter_eval.erl index 1dfe51db..c4e2a32e 100644 --- a/src/cuter_eval.erl +++ b/src/cuter_eval.erl @@ -139,12 +139,15 @@ log_mfa_spec(_, _, _) -> ok. %% Concrete/Symbolic Evaluation and Logging of an MFA call %% ------------------------------------------------------------------- -spec eval(eval(), [any()], [any()], calltype(), servers(), file:io_device()) -> result(). - +eval(A, CAs, SAs, CallType, Servers, Fd) -> + DefaultOptions = #{isForced => false, constraintLogging => true, distrustTypeDependent => false}, + eval(A, CAs, SAs, CallType, Servers, Fd, DefaultOptions). %% Handle spawns so that the spawned process will be interpreted %% and not directly executed %% spawn/{1,2,3,4} & spawn_link/{1,2,3,4} -eval({named, erlang, F}, CAs, SAs, _CallType, Servers, Fd) when F =:= spawn; F =:= spawn_link -> +-spec eval(eval(), [any()], [any()], calltype(), servers(), file:io_device(), maps:map()) -> result(). +eval({named, erlang, F}, CAs, SAs, _CallType, Servers, Fd, Options) when F =:= spawn; F =:= spawn_link -> Arity = length(CAs), SAs_e = cuter_symbolic:ensure_list(SAs, Arity, Fd), Rf = erlang:make_ref(), @@ -183,12 +186,12 @@ eval({named, erlang, F}, CAs, SAs, _CallType, Servers, Fd) when F =:= spawn; F = end, receive {ChildP, registered} -> - cuter_log:log_spawn(Fd, ChildP, Rf), + conditional_log(fun cuter_log:log_spawn/3, [Fd, ChildP, Rf], Options), mk_result(ChildP, ChildP) end; %% spawn_monitor/{1,3} -eval({named, erlang, spawn_monitor}, CAs, SAs, _CallType, Servers, Fd) -> +eval({named, erlang, spawn_monitor}, CAs, SAs, _CallType, Servers, Fd, Options) -> Arity = length(CAs), SAs_e = cuter_symbolic:ensure_list(SAs, Arity, Fd), Rf = erlang:make_ref(), @@ -210,12 +213,12 @@ eval({named, erlang, spawn_monitor}, CAs, SAs, _CallType, Servers, Fd) -> {ChildP, _ChildRef} = CC = erlang:spawn_monitor(Child), receive {ChildP, registered} -> - cuter_log:log_spawn(Fd, ChildP, Rf), + conditional_log(fun cuter_log:log_spawn/3, [Fd, ChildP, Rf], Options), mk_result(CC, CC) end; %% spawn_opt/{1,3,4,5} -eval({named, erlang, spawn_opt}, CAs, SAs, _CallType, Servers, Fd) -> +eval({named, erlang, spawn_opt}, CAs, SAs, _CallType, Servers, Fd, Options) -> Arity = length(CAs), SAs_e = cuter_symbolic:ensure_list(SAs, Arity, Fd), Rf = erlang:make_ref(), @@ -259,7 +262,7 @@ eval({named, erlang, spawn_opt}, CAs, SAs, _CallType, Servers, Fd) -> end, receive {ChildP, registered} -> - cuter_log:log_spawn(Fd, ChildP, Rf), + conditional_log(fun cuter_log:log_spawn/3, [Fd, ChildP, Rf], Options), mk_result(R, R) end; @@ -267,11 +270,11 @@ eval({named, erlang, spawn_opt}, CAs, SAs, _CallType, Servers, Fd) -> %% so as to zip the concrete and symbolic message %% Redirect erlang:'!'/2 to erlang:send/2 -eval({named, erlang, '!'}, [_, _] = CAs, SAs, CallType, Servers, Fd) -> - eval({named, erlang, send}, CAs, SAs, CallType, Servers, Fd); +eval({named, erlang, '!'}, [_, _] = CAs, SAs, CallType, Servers, Fd, Options) -> + eval({named, erlang, send}, CAs, SAs, CallType, Servers, Fd, Options); %% send/{2,3} -eval({named, erlang, send}, CAs, SAs, _CallType, Servers, Fd) -> +eval({named, erlang, send}, CAs, SAs, _CallType, Servers, Fd, _) -> Arity = length(CAs), SAs_e = cuter_symbolic:ensure_list(SAs, Arity, Fd), case CAs of @@ -294,7 +297,7 @@ eval({named, erlang, send}, CAs, SAs, _CallType, Servers, Fd) -> end; %% send_after/3 -eval({named, erlang, send_after}, CAs, SAs, _CallType, Servers, Fd) -> +eval({named, erlang, send_after}, CAs, SAs, _CallType, Servers, Fd, _Options) -> Arity = length(CAs), SAs_e = cuter_symbolic:ensure_list(SAs, Arity, Fd), case CAs of @@ -310,7 +313,7 @@ eval({named, erlang, send_after}, CAs, SAs, _CallType, Servers, Fd) -> end; %% send_nosuspend/{2,3} -eval({named, erlang, send_nosuspend}, CAs, SAs, _CallType, Servers, Fd) -> +eval({named, erlang, send_nosuspend}, CAs, SAs, _CallType, Servers, Fd, _Options) -> Arity = length(CAs), SAs_e = cuter_symbolic:ensure_list(SAs, Arity, Fd), case CAs of @@ -336,7 +339,7 @@ eval({named, erlang, send_nosuspend}, CAs, SAs, _CallType, Servers, Fd) -> %% so as to zip the concrete and symbolic reason %% throw/1 -eval({named, erlang, throw}, CAs, SAs, _CallType, _Servers, Fd) -> +eval({named, erlang, throw}, CAs, SAs, _CallType, _Servers, Fd, _Options) -> Arity = length(CAs), SAs_e = cuter_symbolic:ensure_list(SAs, Arity, Fd), case CAs of @@ -349,7 +352,7 @@ eval({named, erlang, throw}, CAs, SAs, _CallType, _Servers, Fd) -> end; %% exit/{1,2} -eval({named, erlang, exit}, CAs, SAs, _CallType, _Servers, Fd) -> +eval({named, erlang, exit}, CAs, SAs, _CallType, _Servers, Fd, _Options) -> Arity = length(CAs), SAs_e = cuter_symbolic:ensure_list(SAs, Arity, Fd), case CAs of @@ -380,7 +383,7 @@ eval({named, erlang, exit}, CAs, SAs, _CallType, _Servers, Fd) -> end; %% error/{1,2} -eval({named, erlang, error}, CAs, SAs, _CallType, _Servers, Fd) -> +eval({named, erlang, error}, CAs, SAs, _CallType, _Servers, Fd, _Options) -> Arity = length(CAs), SAs_e = cuter_symbolic:ensure_list(SAs, Arity, Fd), case CAs of @@ -398,7 +401,7 @@ eval({named, erlang, error}, CAs, SAs, _CallType, _Servers, Fd) -> end; %% raise/3 -eval({named, erlang, raise}, CAs, SAs, _CallType, _Servers, Fd) -> +eval({named, erlang, raise}, CAs, SAs, _CallType, _Servers, Fd, _Options) -> Arity = length(CAs), SAs_e = cuter_symbolic:ensure_list(SAs, Arity, Fd), case CAs of @@ -414,30 +417,30 @@ eval({named, erlang, raise}, CAs, SAs, _CallType, _Servers, Fd) -> %% Handle other important functions %% make_fun/3 -eval({named, erlang, make_fun}, CAs, SAs, _CallType, Servers, Fd) -> +eval({named, erlang, make_fun}, CAs, SAs, _CallType, Servers, Fd, Options) -> Arity = length(CAs), _ = cuter_symbolic:ensure_list(SAs, Arity, Fd), case CAs of [M, F, A] -> - make_fun(M, F, A, Servers, Fd); + make_fun(M, F, A, Servers, Fd, Options); _ -> exception(error, {undef, {erlang, make_fun, Arity}}) end; %% apply/{2,3} -eval({named, erlang, apply}, CAs, SAs, _CallType, Servers, Fd) -> +eval({named, erlang, apply}, CAs, SAs, _CallType, Servers, Fd, Options) -> Arity = length(CAs), SAs_e = cuter_symbolic:ensure_list(SAs, Arity, Fd), case CAs of [Fun, Args] -> [SFun, SArgs] = SAs_e, %% Constraint: Fun=SFun - eval({lambda, Fun, SFun}, Args, SArgs, local, Servers, Fd); + eval({lambda, Fun, SFun}, Args, SArgs, local, Servers, Fd, Options); [M, F, Args] -> [_SMod, _SFun, SArgs] = SAs_e, %% Constraints: SMod = M, SFun=F Call = find_call_type(erlang, M), - eval({named, M, F}, Args, SArgs, Call, Servers, Fd); + eval({named, M, F}, Args, SArgs, Call, Servers, Fd, Options); _ -> exception(error, {undef, {erlang, apply, Arity}}) end; @@ -445,7 +448,7 @@ eval({named, erlang, apply}, CAs, SAs, _CallType, Servers, Fd) -> %% Generic case %% Handle an MFA -eval({named, M, F}, CAs_b, SAs_b, CallType, Servers, Fd) -> +eval({named, M, F}, CAs_b, SAs_b, CallType, Servers, Fd, Options) -> {CAs, SAs} = adjust_arguments(M, F, CAs_b, SAs_b, Fd), Arity = length(CAs), SAs_e = cuter_symbolic:ensure_list(SAs, Arity, Fd), @@ -460,11 +463,11 @@ eval({named, M, F}, CAs_b, SAs_b, CallType, Servers, Fd) -> NSenv = cuter_env:new_environment(), Cenv = cuter_env:bind_parameters(CAs, Code#c_fun.vars, NCenv), Senv = cuter_env:bind_parameters(SAs_e, Code#c_fun.vars, NSenv), - eval_expr(Code#c_fun.body, NM, Cenv, Senv, Servers, Fd) + eval_expr(Code#c_fun.body, NM, Cenv, Senv, Servers, Fd, Options) end; %% Handle a Closure -eval({lambda, Closure, ClosureSymb}, CAs, SAs, _CallType, _Servers, Fd) -> +eval({lambda, Closure, ClosureSymb}, CAs, SAs, _CallType, _Servers, Fd, Options) -> Arity = length(CAs), SAs_e = cuter_symbolic:ensure_list(SAs, Arity, Fd), ZAs = zip_args(CAs, SAs_e), @@ -487,42 +490,49 @@ eval({lambda, Closure, ClosureSymb}, CAs, SAs, _CallType, _Servers, Fd) -> mk_result(Cv, R); true -> Sv = get_symbolic(Cv), - cuter_log:log_evaluated_closure(Fd, ClosureSymb, SAs_e, Sv), + conditional_log(fun cuter_log:log_evaluated_closure/4, [Fd, ClosureSymb, SAs_e, Sv], Options), Cv end end end; %% Handle a function bound in a letrec expression -eval({letrec_func, {M, _F, Def, E}}, CAs, SAs, _CallType, Servers, Fd) -> +eval({letrec_func, {M, _F, Def, E}}, CAs, SAs, _CallType, Servers, Fd, Options) -> {Cenv, Senv} = E(), SAs_e = cuter_symbolic:ensure_list(SAs, length(CAs), Fd), NCenv = cuter_env:bind_parameters(CAs, Def#c_fun.vars, Cenv), NSenv = cuter_env:bind_parameters(SAs_e, Def#c_fun.vars, Senv), - eval_expr(Def#c_fun.body, M, NCenv, NSenv, Servers, Fd). + eval_expr(Def#c_fun.body, M, NCenv, NSenv, Servers, Fd, Options). %% -------------------------------------------------------- %% eval_expr %% %% Evaluates a Core Erlang expression %% -------------------------------------------------------- --spec eval_expr(cerl:cerl(), module(), cuter_env:environment(), cuter_env:environment(), servers(), file:io_device()) -> result(). +-spec eval_expr(cerl:cerl(), module(), cuter_env:environment(), cuter_env:environment(), servers(), file:io_device(), maps:map()) -> result(). %% c_apply -eval_expr({c_apply, _Anno, Op, Args}, M, Cenv, Senv, Servers, Fd) -> - Op_ev = eval_expr(Op, M, Cenv, Senv, Servers, Fd), +eval_expr({c_apply, Anno, Op, Args}, M, Cenv, Senv, Servers, Fd, Options) -> + Op_ev = eval_expr(Op, M, Cenv, Senv, Servers, Fd, Options), + DT = cuter_maybe_error_annotation:get_distrust_type_dependent(Anno), + case DT of + true -> + NewOptions = maps:update(distrustTypeDependent, DT, Options); + false -> + NewOptions = Options + end, Fun = fun(A) -> - A_ev = eval_expr(A, M, Cenv, Senv, Servers, Fd), + A_ev = eval_expr(A, M, Cenv, Senv, Servers, Fd, NewOptions), %% Will create closures where appropriate case get_concrete(A_ev) of {?FUNCTION_PREFIX, {F, Arity}} -> %% local func (external func is already in make_fun/3 in core erlang) - create_closure(M, F, Arity, local, Servers, Fd); + create_closure(M, F, Arity, local, Servers, Fd, NewOptions); {letrec_func, {Mod, F, Arity, Def, E}} -> %% letrec func {Ce, Se} = E(), - create_closure(Mod, F, Arity, {letrec_func, {Def, Ce, Se}}, Servers, Fd); + create_closure(Mod, F, Arity, {letrec_func, {Def, Ce, Se}}, Servers, Fd, NewOptions); _ -> A_ev end @@ -531,37 +541,37 @@ eval_expr({c_apply, _Anno, Op, Args}, M, Cenv, Senv, Servers, Fd) -> {CAs, SAs} = cuter_lib:unzip_with(fun to_tuple/1, ZAs), case get_concrete(Op_ev) of % See eval_expr(#c_var{}, ...) output for reference {?FUNCTION_PREFIX, {Func, _Arity}} -> - eval({named, M, Func}, CAs, SAs, local, Servers, Fd); + eval({named, M, Func}, CAs, SAs, local, Servers, Fd, NewOptions); {letrec_func, {Mod, Func, _Arity, Def, E}} -> - eval({letrec_func, {Mod, Func, Def, E}}, CAs, SAs, local, Servers, Fd); + eval({letrec_func, {Mod, Func, Def, E}}, CAs, SAs, local, Servers, Fd, NewOptions); Closure -> %% Constraint OP_s = OP_c (in case closure is made by make_fun) - eval({lambda, Closure, get_symbolic(Op_ev)}, CAs, SAs, local, Servers, Fd) + eval({lambda, Closure, get_symbolic(Op_ev)}, CAs, SAs, local, Servers, Fd, NewOptions) end; %% c_binary %% TODO Use the tags of segments. -eval_expr({c_binary, _Anno, Segments}, M, Cenv, Senv, Servers, Fd) -> - Segs = [eval_expr(S, M, Cenv, Senv, Servers, Fd) || S <- Segments], +eval_expr({c_binary, _Anno, Segments}, M, Cenv, Senv, Servers, Fd, Options) -> + Segs = [eval_expr(S, M, Cenv, Senv, Servers, Fd, Options) || S <- Segments], {Cs, Ss} = cuter_lib:unzip_with(fun to_tuple/1, Segs), append_segments(Cs, Ss, Fd); %% c_bitstr -eval_expr({c_bitstr, _Anno, Val, Size, Unit, Type, Flags}, M, Cenv, Senv, Servers, Fd) -> +eval_expr({c_bitstr, _Anno, Val, Size, Unit, Type, Flags}, M, Cenv, Senv, Servers, Fd, Options) -> %% Evaluate the value and the encoding. - Val_ev = eval_expr(Val, M, Cenv, Senv, Servers, Fd), + Val_ev = eval_expr(Val, M, Cenv, Senv, Servers, Fd, Options), Val_c = get_concrete(Val_ev), Val_s = get_symbolic(Val_ev), - Size_ev = eval_expr(Size, M, Cenv, Senv, Servers, Fd), - Unit_ev = eval_expr(Unit, M, Cenv, Senv, Servers, Fd), - Type_ev = eval_expr(Type, M, Cenv, Senv, Servers, Fd), - Flags_ev = eval_expr(Flags, M, Cenv, Senv, Servers, Fd), + Size_ev = eval_expr(Size, M, Cenv, Senv, Servers, Fd, Options), + Unit_ev = eval_expr(Unit, M, Cenv, Senv, Servers, Fd, Options), + Type_ev = eval_expr(Type, M, Cenv, Senv, Servers, Fd, Options), + Flags_ev = eval_expr(Flags, M, Cenv, Senv, Servers, Fd, Options), Size_c = get_concrete(Size_ev), Size_s = get_symbolic(Size_ev), %% Log constraints on type mismatch before construction. - log_bistr_type_mismatch(Val_c, Val_s, Type, Fd), % Type is always a literal. + conditional_log(fun log_bistr_type_mismatch/4, [Val_c, Val_s, Type, Fd], Options), % Type is always a literal. %% Log constraints on negative sizes before construction. - log_bitstr_neg_size(Size_c, Size_s, Fd), + conditional_log(fun log_bitstr_neg_size/3, [Size_c, Size_s, Fd], Options), %% Generate the concrete value. Bin_c = cuter_binlib:make_bitstring(Val_c, Size_c, get_concrete(Unit_ev), get_concrete(Type_ev), get_concrete(Flags_ev)), @@ -573,21 +583,28 @@ eval_expr({c_bitstr, _Anno, Val, Size, Unit, Type, Flags}, M, Cenv, Senv, Server mk_result(Bin_c, Bin_s); %% c_call -eval_expr({c_call, _Anno, Mod, Name, Args}, M, Cenv, Senv, Servers, Fd) -> - Mod_ev = eval_expr(Mod, M, Cenv, Senv, Servers, Fd), - Fv_ev = eval_expr(Name, M, Cenv, Senv, Servers, Fd), +eval_expr({c_call, Anno, Mod, Name, Args}, M, Cenv, Senv, Servers, Fd, Options) -> + Mod_ev = eval_expr(Mod, M, Cenv, Senv, Servers, Fd, Options), + Fv_ev = eval_expr(Name, M, Cenv, Senv, Servers, Fd, Options), + DT = cuter_maybe_error_annotation:get_distrust_type_dependent(Anno), + case DT of + true -> + NewOptions = maps:update(distrustTypeDependent, true, Options); + false -> + NewOptions = Options + end, Fun = fun(A) -> - A_ev = eval_expr(A, M, Cenv, Senv, Servers, Fd), + A_ev = eval_expr(A, M, Cenv, Senv, Servers, Fd, NewOptions), %% Will create closures where appropriate case get_concrete(A_ev) of {?FUNCTION_PREFIX, {F, Arity}} -> %% local func (external func is already in make_fun/3 in core erlang) - create_closure(M, F, Arity, local, Servers, Fd); + create_closure(M, F, Arity, local, Servers, Fd, NewOptions); {letrec_func, {Mod, F, Arity, Def, E}} -> %% letrec func {Ce, Se} = E(), - create_closure(Mod, F, Arity, {letrec_func, {Def, Ce, Se}}, Servers, Fd); + create_closure(Mod, F, Arity, {letrec_func, {Def, Ce, Se}}, Servers, Fd, NewOptions); _ -> A_ev end @@ -596,20 +613,27 @@ eval_expr({c_call, _Anno, Mod, Name, Args}, M, Cenv, Senv, Servers, Fd) -> {CAs, SAs} = cuter_lib:unzip_with(fun to_tuple/1, ZAs), %% Constraints Mod_c = Mod_s and Fv_c = Fv_s Mod_c = get_concrete(Mod_ev), - eval({named, Mod_c, get_concrete(Fv_ev)}, CAs, SAs, find_call_type(M, Mod_c), Servers, Fd); + eval({named, Mod_c, get_concrete(Fv_ev)}, CAs, SAs, find_call_type(M, Mod_c), Servers, Fd, NewOptions); %% c_case -eval_expr({c_case, _Anno, Arg, Clauses}, M, Cenv, Senv, Servers, Fd) -> - Arg_ev = eval_expr(Arg, M, Cenv, Senv, Servers, Fd), - {Body, Ce, Se, _Cnt} = find_clause(Clauses, M, 'case', get_concrete(Arg_ev), get_symbolic(Arg_ev), Cenv, Senv, Servers, Fd), +eval_expr({c_case, Anno, Arg, Clauses}, M, Cenv, Senv, Servers, Fd, Options) -> + DT = maps:get(distrustTypeDependent, Options), + NewOptions = maps:update(isForced, cuter_maybe_error_annotation:get_maybe_error_bin_anno(Anno, DT) or maps:get(isForced, Options), Options), + Arg_ev = eval_expr(Arg, M, Cenv, Senv, Servers, Fd, NewOptions), + {Body, Ce, Se, _Cnt} = find_clause(Clauses, M, 'case', get_concrete(Arg_ev), get_symbolic(Arg_ev), Cenv, Senv, Servers, Fd, NewOptions), + NewOptions1 = + case not cuter_maybe_error_annotation:get_maybe_error_bin(Body, DT) andalso not maps:get(isForced, Options) of + true -> maps:update(constraintLogging, false, Options); + false -> Options + end, cuter_log:reduce_constraint_counter(), % TODO Should also add this call to c_receive - eval_expr(Body, M, Ce, Se, Servers, Fd); + eval_expr(Body, M, Ce, Se, Servers, Fd, NewOptions1); %% c_catch %% Commented code: allow the exceptions to propagate -eval_expr({c_catch, _Anno, Body}, M, Cenv, Senv, Servers, Fd) -> +eval_expr({c_catch, _Anno, Body}, M, Cenv, Senv, Servers, Fd, Options) -> try - eval_expr(Body, M, Cenv, Senv, Servers, Fd) + eval_expr(Body, M, Cenv, Senv, Servers, Fd, Options) catch throw:Throw -> unzip_one(Throw); @@ -633,22 +657,24 @@ eval_expr({c_catch, _Anno, Body}, M, Cenv, Senv, Servers, Fd) -> %% eval_expr(Body, M, Cenv, Senv, Servers, Fd); %% c_cons -eval_expr({c_cons, _Anno, Hd, Tl}, M, Cenv, Senv, Servers, Fd) -> - Hd_ev = eval_expr(Hd, M, Cenv, Senv, Servers, Fd), - Tl_ev = eval_expr(Tl, M, Cenv, Senv, Servers, Fd), +eval_expr({c_cons, _Anno, Hd, Tl}, M, Cenv, Senv, Servers, Fd, Options) -> + Hd_ev = eval_expr(Hd, M, Cenv, Senv, Servers, Fd, Options), + Tl_ev = eval_expr(Tl, M, Cenv, Senv, Servers, Fd, Options), Cv = [get_concrete(Hd_ev) | get_concrete(Tl_ev)], Sv = cuter_symbolic:cons(get_symbolic(Hd_ev), get_symbolic(Tl_ev), Cv, Fd), mk_result(Cv, Sv); %% c_fun -eval_expr({c_fun, _Anno, Vars, Body}, M, Cenv, Senv, Servers, Fd) -> +eval_expr({c_fun, _Anno, Vars, Body}, M, Cenv, Senv, Servers, Fd, Options) -> Arity = length(Vars), - make_fun(Vars, Body, M, Arity, Cenv, Senv, Servers, Fd); + make_fun(Vars, Body, M, Arity, Cenv, Senv, Servers, Fd, Options); %% c_let -eval_expr({c_let, _Anno, Vars, Arg, Body}, M, Cenv, Senv, Servers, Fd) -> +eval_expr({c_let, Anno, Vars, Arg, Body}, M, Cenv, Senv, Servers, Fd, Options) -> Deg = length(Vars), - Arg_ev = eval_expr(Arg, M, Cenv, Senv, Servers, Fd), + IsForced1 = cuter_maybe_error_annotation:get_force_constraint_logging(Anno), + NewOptions = maps:update(isForced, IsForced1 orelse maps:get(isForced, Options), Options), + Arg_ev = eval_expr(Arg, M, Cenv, Senv, Servers, Fd, NewOptions), Arg_c = get_concrete(Arg_ev), Arg_s = get_symbolic(Arg_ev), case Deg of @@ -661,10 +687,10 @@ eval_expr({c_let, _Anno, Vars, Arg, Body}, M, Cenv, Senv, Servers, Fd) -> end, Ce = cuter_env:bind_parameters(CAs, Vars, Cenv), Se = cuter_env:bind_parameters(SAs, Vars, Senv), - eval_expr(Body, M, Ce, Se, Servers, Fd); + eval_expr(Body, M, Ce, Se, Servers, Fd, Options); %% c_letrec -eval_expr({c_letrec, _Anno, Defs, Body}, M, Cenv, Senv, Servers, Fd) -> +eval_expr({c_letrec, _Anno, Defs, Body}, M, Cenv, Senv, Servers, Fd, Options) -> H = fun(F) -> fun() -> lists:foldl( fun({Func, Def}, {E_c, E_s}) -> @@ -680,10 +706,10 @@ eval_expr({c_letrec, _Anno, Defs, Body}, M, Cenv, Senv, Servers, Fd) -> ) end end, {NCe, NSe} = (y(H))(), - eval_expr(Body, M, NCe, NSe, Servers, Fd); + eval_expr(Body, M, NCe, NSe, Servers, Fd, Options); %% c_literal -eval_expr({c_literal, _Anno, V}, _M, _Cenv, _Senv, Servers, Fd) -> +eval_expr({c_literal, _Anno, V}, _M, _Cenv, _Senv, Servers, Fd, Options) -> case erlang:is_function(V) of false -> mk_result(V, V); true -> @@ -698,15 +724,15 @@ eval_expr({c_literal, _Anno, V}, _M, _Cenv, _Senv, Servers, Fd) -> mk_result(V, LambdaS); Mod -> Func = proplists:get_value(name, Info), - make_fun(Mod, Func, Arity, Servers, Fd) + make_fun(Mod, Func, Arity, Servers, Fd, Options) end end end; %% c_primop -eval_expr({c_primop, _Anno, Name, Args}, M, Cenv, Senv, Servers, Fd) -> +eval_expr({c_primop, _Anno, Name, Args}, M, Cenv, Senv, Servers, Fd, Options) -> PrimOp = Name#c_literal.val, - ZAs = [eval_expr(A, M, Cenv, Senv, Servers, Fd) || A <- Args], + ZAs = [eval_expr(A, M, Cenv, Senv, Servers, Fd, Options) || A <- Args], {CAs, SAs} = cuter_lib:unzip_with(fun to_tuple/1, ZAs), %% TODO need to record and implement more primops %% like 'bs_context_to_binary', 'bs_init_writable' @@ -715,44 +741,44 @@ eval_expr({c_primop, _Anno, Name, Args}, M, Cenv, Senv, Servers, Fd) -> [Class_c, Reason_c] = CAs, [_Class_s, Reason_s] = SAs, %% CONSTRAINT: Class_c = Class_s - eval({named, erlang, Class_c}, [Reason_c], [Reason_s], external, Servers, Fd); + eval({named, erlang, Class_c}, [Reason_c], [Reason_s], external, Servers, Fd, Options); match_fail -> [Cv] = CAs, [Sv] = SAs, - eval({named, erlang, error}, [{badmatch, Cv}], [{badmatch, Sv}], external, Servers, Fd); + eval({named, erlang, error}, [{badmatch, Cv}], [{badmatch, Sv}], external, Servers, Fd, Options); _ -> exception(error, {primop_not_supported, PrimOp}) end; %% c_receive -eval_expr({c_receive, _Anno, Clauses, Timeout, Action}, M, Cenv, Senv, Servers, Fd) -> - Timeout_ev = eval_expr(Timeout, M, Cenv, Senv, Servers, Fd), +eval_expr({c_receive, _Anno, Clauses, Timeout, Action}, M, Cenv, Senv, Servers, Fd, Options) -> + Timeout_ev = eval_expr(Timeout, M, Cenv, Senv, Servers, Fd, Options), Timeout_c = get_concrete(Timeout_ev), Timeout_s = get_symbolic(Timeout_ev), true = check_timeout(Timeout_c, Timeout_s, Fd), Start = os:timestamp(), %% Start time of timeout timer {messages, Mailbox} = erlang:process_info(self(), messages), - Message = find_message(Mailbox, Clauses, M, Cenv, Senv, Servers, Fd), + Message = find_message(Mailbox, Clauses, M, Cenv, Senv, Servers, Fd, Options), case Message of {Msg, Body, NCenv, NSenv, _Cnt} -> %% Matched a message already in the mailbox receive Msg -> ok end, %% Just consume the message - eval_expr(Body, M, NCenv, NSenv, Servers, Fd); + eval_expr(Body, M, NCenv, NSenv, Servers, Fd, Options); false -> %% No mailbox message matched, thus need to enter a receive loop CurrMsgs = length(Mailbox), - find_message_loop(Clauses, Action, Timeout_c, Timeout_s, Start, CurrMsgs, M, Cenv, Senv, Servers, Fd) + find_message_loop(Clauses, Action, Timeout_c, Timeout_s, Start, CurrMsgs, M, Cenv, Senv, Servers, Fd, Options) end; %% c_seq -eval_expr({c_seq, _Anno, Arg, Body}, M, Cenv, Senv, Servers, Fd) -> - _ = eval_expr(Arg, M, Cenv, Senv, Servers, Fd), - eval_expr(Body, M, Cenv, Senv, Servers, Fd); +eval_expr({c_seq, _Anno, Arg, Body}, M, Cenv, Senv, Servers, Fd, Options) -> + _ = eval_expr(Arg, M, Cenv, Senv, Servers, Fd, Options), + eval_expr(Body, M, Cenv, Senv, Servers, Fd, Options); %% c_try %% Commented code: allow the exceptions to propagate -eval_expr({c_try, _Anno, Arg, Vars, Body, Evars, Handler}, M, Cenv, Senv, Servers, Fd) -> +eval_expr({c_try, _Anno, Arg, Vars, Body, Evars, Handler}, M, Cenv, Senv, Servers, Fd, Options) -> try Deg = length(Vars), - A_ev = eval_expr(Arg, M, Cenv, Senv, Servers, Fd), + A_ev = eval_expr(Arg, M, Cenv, Senv, Servers, Fd, Options), A_c = get_concrete(A_ev), A_s = get_concrete(A_ev), case Deg of @@ -765,7 +791,7 @@ eval_expr({c_try, _Anno, Arg, Vars, Body, Evars, Handler}, M, Cenv, Senv, Server end, Ce = cuter_env:bind_parameters(CAs, Vars, Cenv), Se = cuter_env:bind_parameters(SAs, Vars, Senv), - eval_expr(Body, M, Ce, Se, Servers, Fd) + eval_expr(Body, M, Ce, Se, Servers, Fd, Options) catch Class:Reason -> Reason1 = unzip_one(Reason), @@ -783,7 +809,7 @@ eval_expr({c_try, _Anno, Arg, Vars, Body, Evars, Handler}, M, Cenv, Senv, Server end, ECe = cuter_env:bind_parameters(Cs, Evars, Cenv), ESe = cuter_env:bind_parameters(Ss, Evars, Senv), - eval_expr(Handler, M, ECe, ESe, Servers, Fd) + eval_expr(Handler, M, ECe, ESe, Servers, Fd, Options) end; %%eval_expr({c_try, _Anno, Arg, Vars, Body, _Evars, _Handler}, M, Cenv, Senv, Servers, Fd) -> %% Deg = length(Vars), @@ -801,24 +827,24 @@ eval_expr({c_try, _Anno, Arg, Vars, Body, Evars, Handler}, M, Cenv, Senv, Server %% eval_expr(Body, M, Ce, Se, Servers, Fd); %% c_tuple -eval_expr({c_tuple, _Anno, Es}, M, Cenv, Senv, Servers, Fd) -> - Zes = [eval_expr(E, M, Cenv, Senv, Servers, Fd) || E <- Es], +eval_expr({c_tuple, _Anno, Es}, M, Cenv, Senv, Servers, Fd, Options) -> + Zes = [eval_expr(E, M, Cenv, Senv, Servers, Fd, Options) || E <- Es], {Es_c, Es_s} = cuter_lib:unzip_with(fun to_tuple/1, Zes), Cv = list_to_tuple(Es_c), Sv = cuter_symbolic:make_tuple(Es_s, Cv, Fd), mk_result(Cv, Sv); %% c_values -eval_expr({c_values, _Anno, Es}, M, Cenv, Senv, Servers, Fd) -> +eval_expr({c_values, _Anno, Es}, M, Cenv, Senv, Servers, Fd, Options) -> Deg = length(Es), - Zes = [eval_expr(E, M, Cenv, Senv, Servers, Fd) || E <- Es], + Zes = [eval_expr(E, M, Cenv, Senv, Servers, Fd, Options) || E <- Es], {Es_c, Es_s} = cuter_lib:unzip_with(fun to_tuple/1, Zes), Cv = #valuelist{values=Es_c, degree=Deg}, Sv = #valuelist{values=Es_s, degree=Deg}, mk_result(Cv, Sv); %% c_var -eval_expr({c_var, _Anno, Name}, _M, Cenv, Senv, _Servers, _Fd) when is_tuple(Name) -> +eval_expr({c_var, _Anno, Name}, _M, Cenv, Senv, _Servers, _Fd, _Options) when is_tuple(Name) -> %% If Name is a function case cuter_env:get_value(Name, Cenv) of {ok, {letrec_func, {Mod, Def, E}}} -> @@ -835,13 +861,13 @@ eval_expr({c_var, _Anno, Name}, _M, Cenv, Senv, _Servers, _Fd) when is_tuple(Nam R = {?FUNCTION_PREFIX, Name}, mk_result(R, R) end; -eval_expr({c_var, _Anno, Name}, _M, Cenv, Senv, _Servers, _Fd) -> +eval_expr({c_var, _Anno, Name}, _M, Cenv, Senv, _Servers, _Fd, _Options) -> %% If it's a variable then return its value {ok, Cv} = cuter_env:get_value(Name, Cenv), {ok, Sv} = cuter_env:get_value(Name, Senv), mk_result(Cv, Sv); -eval_expr(Cerl, _M, _Cenv, _Senv, _Servers, _Fd) -> +eval_expr(Cerl, _M, _Cenv, _Senv, _Servers, _Fd, _Options) -> exception(error, {unknown_cerl, Cerl}). @@ -950,16 +976,16 @@ exception(Class, Reason) -> %% Enters a loop waiting for a message that will match. %% Wraps calls to run_message_loop to check for timeout. %% -------------------------------------------------------- -find_message_loop(Clauses, Action, infinity, STimetout, Start, Msgs, M, Cenv, Senv, Servers, Fd) -> - run_message_loop(Clauses, Action, infinity, STimetout, Start, Msgs, M, Cenv, Senv, Servers, Fd); -find_message_loop(Clauses, Action, CTimeout, STimeout, Start, Msgs, M, Cenv, Senv, Servers, Fd) -> +find_message_loop(Clauses, Action, infinity, STimetout, Start, Msgs, M, Cenv, Senv, Servers, Fd, Options) -> + run_message_loop(Clauses, Action, infinity, STimetout, Start, Msgs, M, Cenv, Senv, Servers, Fd, Options); +find_message_loop(Clauses, Action, CTimeout, STimeout, Start, Msgs, M, Cenv, Senv, Servers, Fd, Options) -> Now = os:timestamp(), Passed = timer:now_diff(Now, Start) / 1000, case Passed >= CTimeout of true -> - eval_expr(Action, M, Cenv, Senv, Servers, Fd); + eval_expr(Action, M, Cenv, Senv, Servers, Fd, Options); false -> - run_message_loop(Clauses, Action, CTimeout, STimeout, Start, Msgs, M, Cenv, Senv, Servers, Fd) + run_message_loop(Clauses, Action, CTimeout, STimeout, Start, Msgs, M, Cenv, Senv, Servers, Fd, Options) end. %% -------------------------------------------------------- @@ -967,23 +993,23 @@ find_message_loop(Clauses, Action, CTimeout, STimeout, Start, Msgs, M, Cenv, Sen %% %% Implements the actual waiting receive loop %% -------------------------------------------------------- -run_message_loop(Clauses, Action, CTimeout, STimeout, Start, Msgs, M, Cenv, Senv, Servers, Fd) -> +run_message_loop(Clauses, Action, CTimeout, STimeout, Start, Msgs, M, Cenv, Senv, Servers, Fd, Options) -> erlang:yield(), {message_queue_len, CurrMsgs} = erlang:process_info(self(), message_queue_len), %% New messages will appended at the end of the mailbox case CurrMsgs > Msgs of false -> %% No new messages - find_message_loop(Clauses, Action, CTimeout, STimeout, Start, Msgs, M, Cenv, Senv, Servers, Fd); + find_message_loop(Clauses, Action, CTimeout, STimeout, Start, Msgs, M, Cenv, Senv, Servers, Fd, Options); true -> {messages, Mailbox} = erlang:process_info(self(), messages), NewMsgs = lists:nthtail(Msgs, Mailbox), - Message = find_message(NewMsgs, Clauses, M, Cenv, Senv, Servers, Fd), + Message = find_message(NewMsgs, Clauses, M, Cenv, Senv, Servers, Fd, Options), case Message of false -> - find_message_loop(Clauses, Action, CTimeout, STimeout, Start, CurrMsgs, M, Cenv, Senv, Servers, Fd); + find_message_loop(Clauses, Action, CTimeout, STimeout, Start, CurrMsgs, M, Cenv, Senv, Servers, Fd, Options); {Msg, Body, NCenv, NSenv, _Cnt} -> receive Msg -> ok end, %% Just consume the matched message - eval_expr(Body, M, NCenv, NSenv, Servers, Fd) + eval_expr(Body, M, NCenv, NSenv, Servers, Fd, Options) end end. @@ -993,16 +1019,16 @@ run_message_loop(Clauses, Action, CTimeout, STimeout, Start, Msgs, M, Cenv, Senv %% Wraps calls to find_clause when trying to match %% a message against a series of patterns %% -------------------------------------------------------- -find_message([], _Clauses, _M, _Cenv, _Senv, _Servers, _Fd) -> +find_message([], _Clauses, _M, _Cenv, _Senv, _Servers, _Fd, _Options) -> false; -find_message([Msg|Mailbox], Clauses, M, Cenv, Senv, Servers, Fd) -> +find_message([Msg|Mailbox], Clauses, M, Cenv, Senv, Servers, Fd, Options) -> {LoggerFun, Msg1} = decode_msg(Msg, Fd), - case find_clause(Clauses, M, 'receive', get_concrete(Msg1), get_symbolic(Msg1), Cenv, Senv, Servers, Fd) of + case find_clause(Clauses, M, 'receive', get_concrete(Msg1), get_symbolic(Msg1), Cenv, Senv, Servers, Fd, Options) of false -> - find_message(Mailbox, Clauses, M, Cenv, Senv, Servers, Fd); + find_message(Mailbox, Clauses, M, Cenv, Senv, Servers, Fd, Options); {Body, NCenv, NSenv, Cnt} -> - log_successful_msg_match(LoggerFun), + conditional_log(fun log_successful_msg_match/1, [LoggerFun], Options), %% I can log the received Msg here {Msg, Body, NCenv, NSenv, Cnt} end. @@ -1021,16 +1047,16 @@ log_successful_msg_match({withLogger, Fun}) -> Fun(). %% compiler adds a catch all clause at the end of every %% case statement. %% -------------------------------------------------------- -find_clause(Clauses, M, Mode, Cv, Sv, Cenv, Senv, Servers, Fd) -> - find_clause(Clauses, M, Mode, Cv, Sv, Cenv, Senv, Servers, Fd, 1). +find_clause(Clauses, M, Mode, Cv, Sv, Cenv, Senv, Servers, Fd, Options) -> + find_clause(Clauses, M, Mode, Cv, Sv, Cenv, Senv, Servers, Fd, 1, Options). -find_clause([], _M, _Mode, _Cv, _Sv, _Cenv, _Senv, _Servers, _Fd, _Cnt) -> +find_clause([], _M, _Mode, _Cv, _Sv, _Cenv, _Senv, _Servers, _Fd, _Cnt, _Options) -> false; -find_clause([Cl|Cls], M, Mode, Cv, Sv, Cenv, Senv, Servers, Fd, Cnt) -> - Match = match_clause(Cl, M, Mode, Cv, Sv, Cenv, Senv, Servers, Fd, Cnt), +find_clause([Cl|Cls], M, Mode, Cv, Sv, Cenv, Senv, Servers, Fd, Cnt, Options) -> + Match = match_clause(Cl, M, Mode, Cv, Sv, Cenv, Senv, Servers, Fd, Cnt, Options), case Match of false -> - find_clause(Cls, M, Mode, Cv, Sv, Cenv, Senv, Servers, Fd, Cnt+1); + find_clause(Cls, M, Mode, Cv, Sv, Cenv, Senv, Servers, Fd, Cnt+1, Options); {true, {_Body, _NCenv, _NSenv, Cnt} = Matched} -> Matched end. @@ -1041,7 +1067,7 @@ find_clause([Cl|Cls], M, Mode, Cv, Sv, Cenv, Senv, Servers, Fd, Cnt) -> %% Match a pair of concrete & symbolic values against %% a specific clause (i.e. with patterns and guard) %% -------------------------------------------------------- -match_clause({c_clause, Anno, Pats, Guard, Body}, M, Mode, Cv, Sv, Cenv, Senv, Servers, Fd, Cnt) -> +match_clause({c_clause, Anno, Pats, Guard, Body}, M, Mode, Cv, Sv, Cenv, Senv, Servers, Fd, Cnt, Options) -> case is_patlist_compatible(Pats, Cv) of false -> false; true -> @@ -1057,7 +1083,7 @@ match_clause({c_clause, Anno, Pats, Guard, Body}, M, Mode, Cv, Sv, Cenv, Senv, S %% BitInfo is needed for parameterized bit-syntax patterns BitInfo = {M, Cenv, Senv}, Ss_e = cuter_symbolic:ensure_list(Ss, length(Cs), Fd), - Match = pattern_match_all(Pats, BitInfo, Mode, Cs, Ss_e, Servers, Fd), + Match = pattern_match_all(Pats, BitInfo, Mode, Cs, Ss_e, Servers, Fd, Options), case Match of false -> false; {true, {CMs, SMs}} -> @@ -1065,17 +1091,17 @@ match_clause({c_clause, Anno, Pats, Guard, Body}, M, Mode, Cv, Sv, Cenv, Senv, S Se = cuter_env:add_mappings_to_environment(SMs, Senv), %% Make silent guards Tags = cuter_cerl:get_tags(Anno), - Guard_ev = eval_expr(Guard, M, Ce, Se, Servers, Fd), + Guard_ev = eval_expr(Guard, M, Ce, Se, Servers, Fd, Options), try to_tuple(Guard_ev) of {true, SGv} -> %% CONSTRAINT: SGv is a True guard visit_tag(Servers#svs.code, Tags#tags.this), - cuter_log:log_guard(Fd, true, SGv, Tags#tags.next), + conditional_log(fun cuter_log:log_guard/4, [Fd, true, SGv, Tags#tags.next], Options), {true, {Body, Ce, Se, Cnt}}; {false, SGv} -> %% CONSTRAINT: SGv is a False guard visit_tag(Servers#svs.code, Tags#tags.next), - cuter_log:log_guard(Fd, false, SGv, Tags#tags.this), + conditional_log(fun cuter_log:log_guard/4, [Fd, false, SGv, Tags#tags.this], Options), false catch error:_E -> false @@ -1090,17 +1116,17 @@ match_clause({c_clause, Anno, Pats, Guard, Body}, M, Mode, Cv, Sv, Cenv, Senv, S %% patterns (short-circuited match) %% -------------------------------------------------------- -pattern_match_all(Pats, BitInfo, Mode, Cs, Ss, Servers, Fd) -> - pattern_match_all(Pats, BitInfo, Mode, Cs, Ss, [], [], Servers, Fd). +pattern_match_all(Pats, BitInfo, Mode, Cs, Ss, Servers, Fd, Options) -> + pattern_match_all(Pats, BitInfo, Mode, Cs, Ss, [], [], Servers, Fd, Options). -pattern_match_all([], _BitInfo, _Mode, [], [], CMaps, SMaps, _Servers, _Fd) -> +pattern_match_all([], _BitInfo, _Mode, [], [], CMaps, SMaps, _Servers, _Fd, _Options) -> {true, {CMaps, SMaps}}; -pattern_match_all([P|Ps], BitInfo, Mode, [Cv|Cvs], [Sv|Svs], CMaps, SMaps, Servers, Fd) -> - Match = pattern_match(P, BitInfo, Mode, Cv, Sv, CMaps, SMaps, Servers, Fd), +pattern_match_all([P|Ps], BitInfo, Mode, [Cv|Cvs], [Sv|Svs], CMaps, SMaps, Servers, Fd, Options) -> + Match = pattern_match(P, BitInfo, Mode, Cv, Sv, CMaps, SMaps, Servers, Fd, Options), case Match of false -> false; {true, {CMs, SMs}} -> - pattern_match_all(Ps, BitInfo, Mode, Cvs, Svs, CMs, SMs, Servers, Fd) + pattern_match_all(Ps, BitInfo, Mode, Cvs, Svs, CMs, SMs, Servers, Fd, Options) end. %% -------------------------------------------------------- @@ -1111,29 +1137,29 @@ pattern_match_all([P|Ps], BitInfo, Mode, [Cv|Cvs], [Sv|Svs], CMaps, SMaps, Serve %% -------------------------------------------------------- %% AtomicLiteral pattern -pattern_match({c_literal, Anno, LitVal}, _Bitinfo, _Mode, Cv, Sv, CMaps, SMaps, Servers, Fd) -> +pattern_match({c_literal, Anno, LitVal}, _Bitinfo, _Mode, Cv, Sv, CMaps, SMaps, Servers, Fd, Options) -> Tags = cuter_cerl:get_tags(Anno), case LitVal =:= Cv of true -> %% CONSTRAINT: Sv =:= Litval visit_tag(Servers#svs.code, Tags#tags.this), - log_literal_match_success(Fd, LitVal, Sv, Tags#tags.next), + conditional_log(fun log_literal_match_success/4, [Fd, LitVal, Sv, Tags#tags.next], Options), {true, {CMaps, SMaps}}; false -> %% CONSTRAINT: Sv =/= Litval visit_tag(Servers#svs.code, Tags#tags.next), - log_literal_match_failure(Fd, LitVal, Sv, Tags#tags.this), + conditional_log(fun log_literal_match_failure/4, [Fd, LitVal, Sv, Tags#tags.this], Options), false end; %% VariableName pattern -pattern_match({c_var, _Anno, Name}, _BitInfo, _Mode, Cv, Sv, CMaps, SMaps, _Servers, _Fd) -> +pattern_match({c_var, _Anno, Name}, _BitInfo, _Mode, Cv, Sv, CMaps, SMaps, _Servers, _Fd, _Options) -> CMs = [{Name, Cv}|CMaps], SMs = [{Name, Sv}|SMaps], {true, {CMs, SMs}}; %% Tuple pattern -pattern_match({c_tuple, Anno, Es}, BitInfo, Mode, Cv, Sv, CMaps, SMaps, Servers, Fd) when is_tuple(Cv) -> +pattern_match({c_tuple, Anno, Es}, BitInfo, Mode, Cv, Sv, CMaps, SMaps, Servers, Fd, Options) when is_tuple(Cv) -> Ne = length(Es), Tags = cuter_cerl:get_tags(Anno), case tuple_size(Cv) =:= Ne of @@ -1141,51 +1167,51 @@ pattern_match({c_tuple, Anno, Es}, BitInfo, Mode, Cv, Sv, CMaps, SMaps, Servers, Cv_l = tuple_to_list(Cv), %% CONSTRAINT: Sv is a tuple of Ne elements visit_tag(Servers#svs.code, Tags#tags.this), - cuter_log:log_tuple(Fd, sz, Sv, Ne, Tags#tags.next), + conditional_log(fun cuter_log:log_tuple/5, [Fd, sz, Sv, Ne, Tags#tags.next], Options), Sv_l = cuter_symbolic:tpl_to_list(Sv, Ne, Fd), - pattern_match_all(Es, BitInfo, Mode, Cv_l, Sv_l, CMaps, SMaps, Servers, Fd); + pattern_match_all(Es, BitInfo, Mode, Cv_l, Sv_l, CMaps, SMaps, Servers, Fd, Options); false -> %% CONSTRAINT: Sv is a tuple of not Ne elements visit_tag(Servers#svs.code, Tags#tags.next), - cuter_log:log_tuple(Fd, not_sz, Sv, Ne, Tags#tags.this), + conditional_log(fun cuter_log:log_tuple/5, [Fd, not_sz, Sv, Ne, Tags#tags.this], Options), false end; -pattern_match({c_tuple, Anno, Es}, _BitInfo, _Mode, _Cv, Sv, _CMaps, _SMaps, Servers, Fd) -> +pattern_match({c_tuple, Anno, Es}, _BitInfo, _Mode, _Cv, Sv, _CMaps, _SMaps, Servers, Fd, Options) -> Ne = length(Es), Tags = cuter_cerl:get_tags(Anno), %% CONSTRAINT: Sv is not a tuple visit_tag(Servers#svs.code, Tags#tags.next), - cuter_log:log_tuple(Fd, not_tpl, Sv, Ne, Tags#tags.this), + conditional_log(fun cuter_log:log_tuple/5, [Fd, not_tpl, Sv, Ne, Tags#tags.this], Options), false; %% List constructor pattern -pattern_match({c_cons, Anno, _Hd, _Tl}, _BitInfo, _Mode, [], Sv, _CMaps, _SMaps, Servers, Fd) -> +pattern_match({c_cons, Anno, _Hd, _Tl}, _BitInfo, _Mode, [], Sv, _CMaps, _SMaps, Servers, Fd, Options) -> Tags = cuter_cerl:get_tags(Anno), %% CONSTRAINT: Sv is an empty list visit_tag(Servers#svs.code, Tags#tags.next), - cuter_log:log_list(Fd, empty, Sv, Tags#tags.this), + conditional_log(fun cuter_log:log_list/4, [Fd, empty, Sv, Tags#tags.this], Options), false; -pattern_match({c_cons, Anno, Hd, Tl}, BitInfo, Mode, [Cv|Cvs], Sv, CMaps, SMaps, Servers, Fd) -> +pattern_match({c_cons, Anno, Hd, Tl}, BitInfo, Mode, [Cv|Cvs], Sv, CMaps, SMaps, Servers, Fd, Options) -> Tags = cuter_cerl:get_tags(Anno), %% CONSTRAINT: S is a non empty list visit_tag(Servers#svs.code, Tags#tags.this), - cuter_log:log_list(Fd, nonempty, Sv, Tags#tags.next), + conditional_log(fun cuter_log:log_list/4, [Fd, nonempty, Sv, Tags#tags.next], Options), Sv_h = cuter_symbolic:head(Sv, Fd), Sv_t = cuter_symbolic:tail(Sv, Fd), - case pattern_match(Hd, BitInfo, Mode, Cv, Sv_h, CMaps, SMaps, Servers, Fd) of + case pattern_match(Hd, BitInfo, Mode, Cv, Sv_h, CMaps, SMaps, Servers, Fd, Options) of false -> false; - {true, {CMs, SMs}} -> pattern_match(Tl, BitInfo, Mode, Cvs, Sv_t, CMs, SMs, Servers, Fd) + {true, {CMs, SMs}} -> pattern_match(Tl, BitInfo, Mode, Cvs, Sv_t, CMs, SMs, Servers, Fd, Options) end; -pattern_match({c_cons, Anno, _Hd, _Tl}, _BitInfo, _Mode, _Cv, Sv, _CMaps, _SMaps, Servers, Fd) -> +pattern_match({c_cons, Anno, _Hd, _Tl}, _BitInfo, _Mode, _Cv, Sv, _CMaps, _SMaps, Servers, Fd, Options) -> Tags = cuter_cerl:get_tags(Anno), %% CONSTRAINT: Sv is not a list visit_tag(Servers#svs.code, Tags#tags.next), - cuter_log:log_list(Fd, not_lst, Sv, Tags#tags.this), + conditional_log(fun cuter_log:log_list/4, [Fd, not_lst, Sv, Tags#tags.this], Options), false; %% Alias pattern -pattern_match({c_alias, _Anno, Var, Pat}, BitInfo, Mode, Cv, Sv, CMaps, SMaps, Servers, Fd) -> - Match = pattern_match(Pat, BitInfo, Mode, Cv, Sv, CMaps, SMaps, Servers, Fd), +pattern_match({c_alias, _Anno, Var, Pat}, BitInfo, Mode, Cv, Sv, CMaps, SMaps, Servers, Fd, Options) -> + Match = pattern_match(Pat, BitInfo, Mode, Cv, Sv, CMaps, SMaps, Servers, Fd, Options), case Match of false -> false; {true, {CMs, SMs}} -> @@ -1196,43 +1222,43 @@ pattern_match({c_alias, _Anno, Var, Pat}, BitInfo, Mode, Cv, Sv, CMaps, SMaps, S end; %% Binary pattern -pattern_match({c_binary, Anno, Segments}, BitInfo, Mode, Cv, Sv, CMaps, SMaps, Servers, Fd) -> - bit_pattern_match(Anno, Segments, BitInfo, Mode, Cv, Sv, CMaps, SMaps, Servers, Fd). +pattern_match({c_binary, Anno, Segments}, BitInfo, Mode, Cv, Sv, CMaps, SMaps, Servers, Fd, Options) -> + bit_pattern_match(Anno, Segments, BitInfo, Mode, Cv, Sv, CMaps, SMaps, Servers, Fd, Options). %% -------------------------------------------------------- %% bit_pattern_match %% %% -------------------------------------------------------- -bit_pattern_match(BinAnno, [], _BitInfo, _Mode, <<>>, Sv, CMaps, SMaps, Servers, Fd) -> +bit_pattern_match(BinAnno, [], _BitInfo, _Mode, <<>>, Sv, CMaps, SMaps, Servers, Fd, Options) -> %% CONSTRAINT: Sv =:= <<>> Tags = cuter_cerl:get_tags(BinAnno), visit_tag(Servers#svs.code, Tags#tags.this), - cuter_log:log_equal(Fd, true, <<>>, Sv, Tags#tags.next), + conditional_log(fun cuter_log:log_equal/5, [Fd, true, <<>>, Sv, Tags#tags.next], Options), {true, {CMaps, SMaps}}; -bit_pattern_match(BinAnno, [], _BitInfo, _Mode, _Cv, Sv, _CMaps, _SMaps, Servers, Fd) -> +bit_pattern_match(BinAnno, [], _BitInfo, _Mode, _Cv, Sv, _CMaps, _SMaps, Servers, Fd, Options) -> %% CONSTRAINT: Sv =/= <<>> Tags = cuter_cerl:get_tags(BinAnno), visit_tag(Servers#svs.code, Tags#tags.next), - cuter_log:log_equal(Fd, false, <<>>, Sv, Tags#tags.this), + conditional_log(fun cuter_log:log_equal/5, [Fd, false, <<>>, Sv, Tags#tags.this], Options), false; -bit_pattern_match(BinAnno, [{c_bitstr, Anno, {c_literal, _, LVal}, Sz, Unit, Tp, Fgs}|Bs], {M, Cenv, Senv} = Bnfo, Mode, Cv, Sv, CMaps, SMaps, Svs, Fd) -> - Size_ev = eval_expr(Sz, M, Cenv, Senv, Svs, Fd), - Unit_ev = eval_expr(Unit, M, Cenv, Senv, Svs, Fd), - Type_ev = eval_expr(Tp, M, Cenv, Senv, Svs, Fd), - Flags_ev = eval_expr(Fgs, M, Cenv, Senv, Svs, Fd), +bit_pattern_match(BinAnno, [{c_bitstr, Anno, {c_literal, _, LVal}, Sz, Unit, Tp, Fgs}|Bs], {M, Cenv, Senv} = Bnfo, Mode, Cv, Sv, CMaps, SMaps, Svs, Fd, Options) -> + Size_ev = eval_expr(Sz, M, Cenv, Senv, Svs, Fd, Options), + Unit_ev = eval_expr(Unit, M, Cenv, Senv, Svs, Fd, Options), + Type_ev = eval_expr(Tp, M, Cenv, Senv, Svs, Fd, Options), + Flags_ev = eval_expr(Fgs, M, Cenv, Senv, Svs, Fd, Options), Size_c = get_concrete(Size_ev), Size_s = get_symbolic(Size_ev), Enc_s = {Size_s, get_symbolic(Unit_ev), get_symbolic(Type_ev), get_symbolic(Flags_ev)}, Tags = cuter_cerl:get_tags(Anno), %% Log constraints on negative sizes before matching. - log_bitstr_neg_size(Size_c, Size_s, Fd), + conditional_log(fun log_bitstr_neg_size/3, [Size_c, Size_s, Fd], Options), try cuter_binlib:match_bitstring_const(LVal, Size_c, get_concrete(Unit_ev), get_concrete(Type_ev), get_concrete(Flags_ev), Cv) of Rest_c -> visit_tag(Svs#svs.code, Tags#tags.this), Rest_s = cuter_symbolic:match_bitstring_const_true(LVal, Enc_s, Sv, Rest_c, Size_c, Tags#tags.next, Fd), - bit_pattern_match(BinAnno, Bs, Bnfo, Mode, Rest_c, Rest_s, CMaps, SMaps, Svs, Fd) + bit_pattern_match(BinAnno, Bs, Bnfo, Mode, Rest_c, Rest_s, CMaps, SMaps, Svs, Fd, Options) catch error:_e -> visit_tag(Svs#svs.code, Tags#tags.next), @@ -1240,17 +1266,17 @@ bit_pattern_match(BinAnno, [{c_bitstr, Anno, {c_literal, _, LVal}, Sz, Unit, Tp, false end; -bit_pattern_match(BinAnno, [{c_bitstr, Anno, {c_var, _, VarName}, Sz, Unit, Tp, Fgs}|Bs], {M, Cenv, Senv}, Mode, Cv, Sv, CMaps, SMaps, Svs, Fd) -> - Size_ev = eval_expr(Sz, M, Cenv, Senv, Svs, Fd), - Unit_ev = eval_expr(Unit, M, Cenv, Senv, Svs, Fd), - Type_ev = eval_expr(Tp, M, Cenv, Senv, Svs, Fd), - Flags_ev = eval_expr(Fgs, M, Cenv, Senv, Svs, Fd), +bit_pattern_match(BinAnno, [{c_bitstr, Anno, {c_var, _, VarName}, Sz, Unit, Tp, Fgs}|Bs], {M, Cenv, Senv}, Mode, Cv, Sv, CMaps, SMaps, Svs, Fd, Options) -> + Size_ev = eval_expr(Sz, M, Cenv, Senv, Svs, Fd, Options), + Unit_ev = eval_expr(Unit, M, Cenv, Senv, Svs, Fd, Options), + Type_ev = eval_expr(Tp, M, Cenv, Senv, Svs, Fd, Options), + Flags_ev = eval_expr(Fgs, M, Cenv, Senv, Svs, Fd, Options), Size_c = get_concrete(Size_ev), Size_s = get_symbolic(Size_ev), Enc_s = {Size_s, get_symbolic(Unit_ev), get_symbolic(Type_ev), get_symbolic(Flags_ev)}, Tags = cuter_cerl:get_tags(Anno), %% Log constraints on negative sizes before matching. - log_bitstr_neg_size(Size_c, Size_s, Fd), + conditional_log(fun log_bitstr_neg_size/3, [Size_c, Size_s, Fd], Options), try cuter_binlib:match_bitstring_var(Size_c, get_concrete(Unit_ev), get_concrete(Type_ev), get_concrete(Flags_ev), Cv) of {X_c, Rest_c} -> visit_tag(Svs#svs.code, Tags#tags.this), @@ -1266,7 +1292,7 @@ bit_pattern_match(BinAnno, [{c_bitstr, Anno, {c_var, _, VarName}, Sz, Unit, Tp, end, NCenv = cuter_env:add_binding(VarName, X_c, Cenv), NSenv = cuter_env:add_binding(VarName, X_s, Senv), - bit_pattern_match(BinAnno, Bs, {M, NCenv, NSenv}, Mode, Rest_c, Rest_s, CMs, SMs, Svs, Fd) + bit_pattern_match(BinAnno, Bs, {M, NCenv, NSenv}, Mode, Rest_c, Rest_s, CMs, SMs, Svs, Fd, Options) catch error:_E -> visit_tag(Svs#svs.code, Tags#tags.next), @@ -1280,18 +1306,18 @@ bit_pattern_match(BinAnno, [{c_bitstr, Anno, {c_var, _, VarName}, Sz, Unit, Tp, %% -------------------------------------------------------- %% Create a Closure of a local function -create_closure(M, F, Arity, local, Servers, Fd) -> +create_closure(M, F, Arity, local, Servers, Fd, Options) -> Mfa = {NM, _NF, NA} = cuter_mock:maybe_override_mfa({M, F, Arity}), %% Module is already loaded since create_closure is called by eval_expr. {ok, Kfun} = get_kfun(Mfa, Servers), Code = cuter_cerl:kfun_code(Kfun), Cenv = cuter_env:new_environment(), Senv = cuter_env:new_environment(), - make_fun(Code#c_fun.vars, Code#c_fun.body, NM, NA, Cenv, Senv, Servers, Fd); + make_fun(Code#c_fun.vars, Code#c_fun.body, NM, NA, Cenv, Senv, Servers, Fd, Options); %% Create a Closure when the MFA is a function bound in a letrec -create_closure(M, _F, Arity, {letrec_func, {Def, Cenv, Senv}}, Servers, Fd) -> - make_fun(Def#c_fun.vars, Def#c_fun.body, M, Arity, Cenv, Senv, Servers, Fd). +create_closure(M, _F, Arity, {letrec_func, {Def, Cenv, Senv}}, Servers, Fd, Options) -> + make_fun(Def#c_fun.vars, Def#c_fun.body, M, Arity, Cenv, Senv, Servers, Fd, Options). %% -------------------------------------------------------- %% Create closures. @@ -1304,7 +1330,7 @@ create_closure(M, _F, Arity, {letrec_func, {Def, Cenv, Senv}}, Servers, Fd) -> %% Creates a closure from Core Erlang code. %% The interpreted code is wrapped in a call to eval_expr. -make_fun(Vars, Body, Mod, Arity, Cenv, Senv, Servers, Fd) -> +make_fun(Vars, Body, Mod, Arity, Cenv, Senv, Servers, Fd, Options) -> Creator = self(), LambdaS = cuter_symbolic:fresh_lambda(Arity, Fd), add_to_created_closure(LambdaS), @@ -1312,94 +1338,94 @@ make_fun(Vars, Body, Mod, Arity, Cenv, Senv, Servers, Fd) -> case Arity of 0 -> fun() -> - make_fun_h1(Mod, [], Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd) + make_fun_h1(Mod, [], Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd, Options) end; 1 -> fun(A) -> Args = [A], - make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd) + make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd, Options) end; 2 -> fun(A, B) -> Args = [A, B], - make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd) + make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd, Options) end; 3 -> fun(A, B, C) -> Args = [A, B, C], - make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd) + make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd, Options) end; 4 -> fun(A, B, C, D) -> Args = [A, B, C, D], - make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd) + make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd, Options) end; 5 -> fun(A, B, C, D, E) -> Args = [A, B, C, D, E], - make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd) + make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd, Options) end; 6 -> fun(A, B, C, D, E, F) -> Args = [A, B, C, D, E, F], - make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd) + make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd, Options) end; 7 -> fun(A, B, C, D, E, F, G) -> Args = [A, B, C, D, E, F, G], - make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd) + make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd, Options) end; 8 -> fun(A, B, C, D, E, F, G, H) -> Args = [A, B, C, D, E, F, G, H], - make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd) + make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd, Options) end; 9 -> fun(A, B, C, D, E, F, G, H, I) -> Args = [A, B, C, D, E, F, G, H, I], - make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd) + make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd, Options) end; 10 -> fun(A, B, C, D, E, F, G, H, I, J) -> Args = [A, B, C, D, E, F, G, H, I, J], - make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd) + make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd, Options) end; 11 -> fun(A, B, C, D, E, F, G, H, I, J, K) -> Args = [A, B, C, D, E, F, G, H, I, J, K], - make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd) + make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd, Options) end; 12 -> fun(A, B, C, D, E, F, G, H, I, J, K, L) -> Args = [A, B, C, D, E, F, G, H, I, J, K, L], - make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd) + make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd, Options) end; 13 -> fun(A, B, C, D, E, F, G, H, I, J, K, L, M) -> Args = [A, B, C, D, E, F, G, H, I, J, K, L, M], - make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd) + make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd, Options) end; 14 -> fun(A, B, C, D, E, F, G, H, I, J, K, L, M, N) -> Args = [A, B, C, D, E, F, G, H, I, J, K, L, M, N], - make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd) + make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd, Options) end; 15 -> fun(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O) -> Args = [A, B, C, D, E, F, G, H, I, J, K, L, M, N, O], - make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd) + make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, Fd, Options) end; _ -> exception(error, {over_lambda_fun_argument_limit, Arity}) end, mk_result(LambdaC, LambdaS). -make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, FileDescr) -> +make_fun_h1(Mod, Args, Servers, Vars, Body, Cenv, Senv, Creator, LambdaS, FileDescr, Options) -> {Ce, Se, SAs} = register_new_environments(Args, Vars, Cenv, Senv), NSvs = validate_servers(Servers), Fd = validate_file_descriptor(NSvs#svs.monitor, Creator, FileDescr), - Ret = eval_expr(Body, Mod, Ce, Se, NSvs, Fd), - cuter_log:log_evaluated_closure(Fd, LambdaS, SAs, get_symbolic(Ret)), + Ret = eval_expr(Body, Mod, Ce, Se, NSvs, Fd, Options), + conditional_log(fun cuter_log:log_evaluated_closure/4, [Fd, LambdaS, SAs, get_symbolic(Ret)], Options), Ret. register_new_environments([], _Vars, Cenv, Senv) -> @@ -1413,7 +1439,7 @@ register_new_environments(Args, Vars, Cenv, Senv) -> %% Creates a closure from an MFA (emulates the behaviour %% of erlang:make_fun/3) -make_fun(Mod, Func, Arity, Servers, Fd) -> +make_fun(Mod, Func, Arity, Servers, Fd, Options) -> Creator = self(), LambdaS = cuter_symbolic:fresh_lambda(Arity, Fd), add_to_created_closure(LambdaS), @@ -1421,94 +1447,94 @@ make_fun(Mod, Func, Arity, Servers, Fd) -> case Arity of 0 -> fun() -> - make_fun_h(Mod, Func, [], Servers, Creator, LambdaS, Fd) + make_fun_h(Mod, Func, [], Servers, Creator, LambdaS, Fd, Options) end; 1 -> fun(A) -> Args = [A], - make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd) + make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd, Options) end; 2 -> fun(A, B) -> Args = [A, B], - make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd) + make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd, Options) end; 3 -> fun(A, B, C) -> Args = [A, B, C], - make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd) + make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd, Options) end; 4 -> fun(A, B, C, D) -> Args = [A, B, C, D], - make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd) + make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd, Options) end; 5 -> fun(A, B, C, D, E) -> Args = [A, B, C, D, E], - make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd) + make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd, Options) end; 6 -> fun(A, B, C, D, E, F) -> Args = [A, B, C, D, E, F], - make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd) + make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd, Options) end; 7 -> fun(A, B, C, D, E, F, G) -> Args = [A, B, C, D, E, F, G], - make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd) + make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd, Options) end; 8 -> fun(A, B, C, D, E, F, G, H) -> Args = [A, B, C, D, E, F, G, H], - make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd) + make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd, Options) end; 9 -> fun(A, B, C, D, E, F, G, H, I) -> Args = [A, B, C, D, E, F, G, H, I], - make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd) + make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd, Options) end; 10 -> fun(A, B, C, D, E, F, G, H, I, J) -> Args = [A, B, C, D, E, F, G, H, I, J], - make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd) + make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd, Options) end; 11 -> fun(A, B, C, D, E, F, G, H, I, J, K) -> Args = [A, B, C, D, E, F, G, H, I, J, K], - make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd) + make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd, Options) end; 12 -> fun(A, B, C, D, E, F, G, H, I, J, K, L) -> Args = [A, B, C, D, E, F, G, H, I, J, K, L], - make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd) + make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd, Options) end; 13 -> fun(A, B, C, D, E, F, G, H, I, J, K, L, M) -> Args = [A, B, C, D, E, F, G, H, I, J, K, L, M], - make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd) + make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd, Options) end; 14 -> fun(A, B, C, D, E, F, G, H, I, J, K, L, M, N) -> Args = [A, B, C, D, E, F, G, H, I, J, K, L, M, N], - make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd) + make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd, Options) end; 15 -> fun(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O) -> Args = [A, B, C, D, E, F, G, H, I, J, K, L, M, N, O], - make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd) + make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, Fd, Options) end; _ -> exception(error, {over_lambda_fun_argument_limit, Arity}) end, mk_result(LambdaC, LambdaS). -make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, FileDescr) -> +make_fun_h(Mod, Func, Args, Servers, Creator, LambdaS, FileDescr, Options) -> {CAs, SAs} = unzip_args(Args), %% If Args =:= [] then unzip_args([]) will return {[], []} NSvs = validate_servers(Servers), Fd = validate_file_descriptor(NSvs#svs.monitor, Creator, FileDescr), - Ret = eval({named, Mod, Func}, CAs, SAs, external, NSvs, Fd), - cuter_log:log_evaluated_closure(Fd, LambdaS, SAs, get_symbolic(Ret)), + Ret = eval({named, Mod, Func}, CAs, SAs, external, NSvs, Fd, Options), + conditional_log(fun cuter_log:log_evaluated_closure/4, [Fd, LambdaS, SAs, get_symbolic(Ret)], Options), Ret. %% -------------------------------------------------------- @@ -1947,3 +1973,11 @@ log_bistr_type_mismatch(Cv, Sv, Type, Fd) -> throw({unknown_bitstr_type, Type}) end end. + +conditional_log(LogFun, Args, Options) -> + case maps:get(constraintLogging, Options) of + true -> + apply(LogFun, Args); + false -> + ok + end. diff --git a/src/cuter_graphs.erl b/src/cuter_graphs.erl new file mode 100644 index 00000000..1a20e28c --- /dev/null +++ b/src/cuter_graphs.erl @@ -0,0 +1,333 @@ +-module(cuter_graphs). +-export([children/2, list_contains/2, calculate_dag_callgraph/1]). +-export_type([graph/0, graph_node/0]). +%debugging +-export([print_graph/1, report_callgraphs/1]). + + +% ================ +% types for graphs +% ================ + +-type graph() :: dict:dict(). +-type graph_node() :: mfa() + | {node, mfa()} + | {cycle, [mfa()]}. + + +% ========================= +% graph implementation +% ========================= + +new_graph() -> + dict:new(). + +add_node(Node, Graph) -> + dict:store(Node, [], Graph). + +add_edge({Node1, Node2}, Graph) -> + dict:store(Node1, [Node2|element(2, dict:find(Node1, Graph))], Graph). + +add_node_with_children(Node, Children, Graph) -> + NewGraph = add_node(Node, Graph), + lists:foldl(fun(A, B) -> add_edge({Node, A}, B) end, NewGraph, Children). + +make_graph_from_children(Nodes, Children) -> + G = lists:foldl(fun add_node/2, new_graph(), Nodes), + lists:foldl(fun({Node, Ch}, B) -> dict:store(Node, Ch, B) end, G, lists:zip(Nodes, Children)). + +-spec children(graph_node(), graph()) -> [graph_node()]. +children(Node, Graph) -> + {ok, C} = dict:find(Node, Graph), + C. + +get_nodes(Graph) -> + dict:fetch_keys(Graph). + +has_node(Node, Graph) -> + dict:is_key(Node, Graph). + + +% =========== +% find cycles +% =========== + +-spec cycle_nodes(graph_node(), graph()) -> [[graph_node()]]. +cycle_nodes(EntryPoint, Graph) -> + {Cycled, _, _} = cycle_nodes(EntryPoint, Graph, sets:new(), sets:new()), + Cycled. + +cycle_nodes(Node, Graph, Visited, Ignored) -> + C = children(Node, Graph), + TC = lists:filter( + fun(Y) -> not (sets:is_element(Y, Visited) or sets:is_element(Node, Ignored)) end, + C + ), + {ChildrenCycled, ChildrenActiveCycled, VisitedBelow} = cycle_nodes_children(TC, Graph, sets:add_element(Node, Visited), Ignored), + ActiveCycled = lists:filter(fun(X) -> sets:is_element(X, Visited) end, C), + {Cycles, ActiveCycles} = update_active_cycles(Node, ActiveCycled, ChildrenCycled, ChildrenActiveCycled), + {Cycles, ActiveCycles, sets:add_element(Node, VisitedBelow)}. + +cycle_nodes_children(C, G, V, I) -> + cycle_nodes_children(C, G, V, I, [], [], sets:new()). + +cycle_nodes_children([], _, _, _, CycleAcc, ActiveCycleAcc, VisitedAcc) -> + {CycleAcc, ActiveCycleAcc, VisitedAcc}; +cycle_nodes_children([Ch|C], G, V, I, CycleAcc, ActiveCycleAcc, VisitedAcc) -> + {Cycle, ActiveCycle, VisitedBelow} = cycle_nodes(Ch, G, V, I), + cycle_nodes_children(C, G, V, sets:union([I, VisitedBelow]), lists:append([CycleAcc, Cycle]), lists:append([ActiveCycleAcc, ActiveCycle]), sets:union([VisitedAcc, VisitedBelow])). + +-spec update_active_cycles(graph_node(), [{graph_node(), [graph_node()]}], [[graph_node()]], [{graph_node(), [graph_node()]}]) -> {[[graph_node()]], [{graph_node(), [graph_node()]}]}. +update_active_cycles(Node, ActiveCycled, ChildrenCycled, ChildrenActiveCycled) -> + ActiveCycled1 = create_new_cycles(ActiveCycled, ChildrenActiveCycled), + {Cycles1, ActiveCycled2} = update_all_cycles(Node, ActiveCycled1), + {lists:append([Cycles1, ChildrenCycled]), ActiveCycled2}. + +-spec create_new_cycles([graph_node()], [{graph_node(), [graph_node()]}]) -> [{graph_node(), [graph_node()]}]. +create_new_cycles([], Acc) -> + Acc; +create_new_cycles([H|T], Acc) -> + [{H,[]}|create_new_cycles(T, Acc)]. + +-spec update_all_cycles(graph_node(), [{graph_node(), [graph_node()]}]) -> {[[graph_node()]], [{graph_node(), [graph_node()]}]}. +update_all_cycles(Node, ActiveCycled) -> + update_all_cycles(Node, ActiveCycled, [], []). + +-spec update_all_cycles(graph_node(), [{graph_node(), [graph_node()]}], [{graph_node(), [graph_node()]}], [[graph_node()]]) -> {[[graph_node()]], [{graph_node(), [graph_node()]}]}. +update_all_cycles(_, [], ActiveAcc, CyclesAcc) -> + {CyclesAcc, ActiveAcc}; +update_all_cycles(Node, [{First, List}|T], ActiveAcc, CyclesAcc) -> + case First of + Node -> + CyclesAcc1 = [[Node|List]|CyclesAcc], + ActiveAcc1 = ActiveAcc; + _ -> + CyclesAcc1 = CyclesAcc, + ActiveAcc1 = [{First, [Node|List]}|ActiveAcc] + end, + update_all_cycles(Node, T, ActiveAcc1, CyclesAcc1). + + +% ========================= +% merge overlapping cycles +% ========================= + +merge_cycles(Cycles) -> + G = make_help_graph(Cycles), + connected_components(G). + +-spec make_help_graph([[graph_node()]]) -> dict:dict(). +make_help_graph(Cycles) -> + G = dict:new(), + lists:foldl(fun put_cycle/2, G, Cycles). + +-spec put_cycle([graph_node()], dict:dict()) -> dict:dict(). +put_cycle(Cycle, Graph) -> + put_cycle(nonode, Cycle, Graph). + +put_cycle(_, [], Graph) -> + Graph; +put_cycle(Prev, [N|Ns], Graph) -> + Graph1 = case dict:is_key(N, Graph) of + true -> + Graph; + false -> + dict:store(N, [], Graph) + end, + Graph2 = case Prev of + nonode -> + Graph1; + _ -> + G = dict:append_list(Prev, [N], Graph1), + dict:append_list(N, [Prev], G) + end, + put_cycle(N, Ns, Graph2). + +-spec connected_components(dict:dict()) -> [sets:set()]. +connected_components(G) -> + connected_components(G, []). + +-spec connected_components(dict:dict(), [sets:set()]) -> [sets:set()]. +connected_components(G, Acc) -> + case dict:is_empty(G) of + true -> + Acc; + false -> + C = connected_component(G), + G1 = remove_keys(C, G), + connected_components(G1, [C|Acc]) + end. + +-spec connected_component(dict:dict()) -> sets:set(). +connected_component(G) -> + connected_component(hd(dict:fetch_keys(G)), sets:new(), G). + +-spec connected_component(graph_node(), sets:set(), dict:dict()) -> sets:set(). +connected_component(Node, Visited, Graph) -> + {ok, Children} = dict:find(Node, Graph), + Visited1 = sets:add_element(Node, Visited), + connected_component_children(Children, Visited1, Graph). + +-spec connected_component_children([graph_node()], sets:set(), dict:dict()) -> sets:set(). +connected_component_children([], Visited, _) -> Visited; +connected_component_children([C|Cs], Visited, Graph) -> + case sets:is_element(C, Visited) of + false -> + Visited1 = connected_component(C, Visited, Graph); + true -> + Visited1 = Visited + end, + connected_component_children(Cs, Visited1, Graph). + +-spec remove_keys(sets:set(), dict:dict()) -> dict:dict(). +remove_keys(C, G) -> + lists:foldl(fun dict:erase/2, G, sets:to_list(C)). + + +% =================================== +% make new graph merging cycled nodes +% =================================== + +remake_graph(EntryPoint, Graph) -> + Cycles = merge_cycles(cycle_nodes(EntryPoint, Graph)), + CycleNodes = [{cycle, sets:to_list(X)} || X <- Cycles], + AllCycledNodes = sets:union(Cycles), + Children = find_children([A || {cycle, A} <- CycleNodes], Graph), + NewNodes = [{node, X} || X <- get_nodes(Graph), not sets:is_element(X, AllCycledNodes)], + NewChildren = [update_children(children(Y, Graph), AllCycledNodes, Cycles, CycleNodes) || {node, Y} <- NewNodes], + CycleChildren = [update_children(Z, AllCycledNodes, Cycles, CycleNodes) || Z <- Children], + Nodes = lists:append(NewNodes, CycleNodes), + ChildrenPerNodeTemp = [sets:to_list(sets:from_list(W)) || W <- lists:append(NewChildren, CycleChildren)], + ChildrenPerNode = [try_remove(B, C) || {B, C} <- lists:zip(Nodes, ChildrenPerNodeTemp)], + make_graph_from_children(Nodes, ChildrenPerNode). + +-spec find_children([sets:set()], graph()) -> [[graph_node()]]. +find_children(Cycles, Graph) -> + find_children(Cycles, Graph, []). + +-spec find_children([sets:set()], graph(), [[graph_node()]]) -> [[graph_node()]]. +find_children([], _, Acc) -> lists:reverse(Acc); +find_children([C|Cs], Graph, Acc) -> + find_children(Cs, Graph, [lists:append([children(X, Graph) || X <- C])|Acc]). + +-spec update_children([[graph_node()]], sets:set(), [sets:set()], [{atom(), [graph_node()]}]) -> [{atom(), [graph_node()]}]. +update_children(Children, AllCycledNodes, Cycles, CyclesAsLists) -> + update_children(Children, AllCycledNodes, Cycles, CyclesAsLists, []). + +-spec update_children([[graph_node()]], sets:set(), [sets:set()], [{atom(), [graph_node()]}], [{atom(), [graph_node()]}]) -> [{atom(), [graph_node()] | graph_node()}]. +update_children([], _, _, _, Acc) -> Acc; +update_children([C|Cs], AllCycles, Cycles, CyclesAsLists, Acc) -> + case sets:is_element(C, AllCycles) of + true -> + update_children(Cs, AllCycles, Cycles, CyclesAsLists, [which_cycle(C, Cycles, CyclesAsLists)|Acc]); + false -> + update_children(Cs, AllCycles, Cycles, CyclesAsLists, [{node, C}|Acc]) + end. + +which_cycle(_, [], _) -> error('cycle not found'); +which_cycle(Node, [C|Cs], [CL|CLs]) -> + case sets:is_element(Node, C) of + true -> + CL; + false -> + which_cycle(Node, Cs, CLs) + end. + +try_remove(Node, Children) -> + try_remove(Node, Children, []). + +try_remove(_, [], Acc) -> Acc; +try_remove(Node, [C|Cs], Acc) -> + case Node == C of + true -> + try_remove(Node, Cs, Acc); + false -> + try_remove(Node, Cs, [C|Acc]) + end. + + +% =================== +% Calculate callgraph +% =================== + +-spec calculate_dag_callgraph(mfa()) -> {graph(), sets:set(), graph_node()}. +calculate_dag_callgraph(EntryPoint) -> + Original = calculate_callgraph(EntryPoint), + CallGraph = remake_graph(EntryPoint, Original), + NewEntryPoint = find_node(EntryPoint, CallGraph), + {CallGraph, sets:from_list(dict:fetch_keys(Original)), NewEntryPoint}. + +find_node(EntryPoint, Graph) -> + case has_node({node, EntryPoint}, Graph) of + true -> + {node, EntryPoint}; + false -> + {cycle, hd([C || {cycle, C} <- get_nodes(Graph), list_contains(EntryPoint, C)])} + end. + +-spec calculate_callgraph(mfa()) -> graph(). +calculate_callgraph(EntryPoint) -> + xref:start(s), + _FoundModules = add_modules_rec(EntryPoint), + CallGraph = make_callgraph(EntryPoint, new_graph()), + xref:stop(s), + CallGraph. + +add_modules_rec(MFA) -> + add_modules_rec(MFA, sets:new(), sets:new()). + +add_modules_rec({M, F, A}, Found, FoundNodes) -> + Valid = fun({_, {M1, F1, _A}}) -> hd(atom_to_list(M1)) =/= 36 andalso hd(atom_to_list(F1)) =/= 36 end, + NewFound = case sets:is_element(M, Found) of + false -> + xref:add_module(s, code:which(M)), + sets:add_element(M, Found); + true -> + Found + end, + {ok, Edges1} = xref:q(s, lists:concat(["E | ", mfa_to_str({M, F, A})])), + Edges = lists:filter(Valid, Edges1), + NewFoundNodes = sets:add_element({M, F, A}, FoundNodes), + lists:foldl(fun(X, Y) -> add_modules_rec(X, Y, NewFoundNodes) end, NewFound, [B || {_A, B} <- Edges, not sets:is_element(B, FoundNodes)]). + +-spec make_callgraph(mfa(), graph()) -> graph(). +make_callgraph(MFA, Graph) -> + case has_node(MFA, Graph) of + true -> Graph; + false -> + Valid = fun({_, {M1, F1, _A}}) -> hd(atom_to_list(M1)) =/= 36 andalso hd(atom_to_list(F1)) =/= 36 end, + {ok, ChildEdges1} = xref:q(s, lists:concat(["E | ", mfa_to_str(MFA)])), + ChildEdges = lists:filter(Valid, ChildEdges1), + Children = [B || {_A,B} <- ChildEdges], + NewGraph = add_node_with_children(MFA, Children, Graph), + lists:foldl(fun make_callgraph/2, NewGraph, Children) + end. + +-spec list_contains(any(), [any()]) -> boolean(). +list_contains(_, []) -> false; +list_contains(X, [H|_T]) when X == H -> true; +list_contains(X, [_H|T]) -> list_contains(X, T). + +-spec mfa_to_str(mfa()) -> string(). +mfa_to_str({M, F, A}) -> + lists:concat([atom_to_list(M), ":", atom_to_list(F), "/", lists:flatten(io_lib:format("~p", [A]))]). + + +% ============= +% for debugging +% ============= + +-spec print_graph(graph()) -> ok. +print_graph(Graph) -> + lists:foreach(fun(A) -> io:format("~p: ~p;~n", [A, children(A, Graph)]) end, get_nodes(Graph)). + +-spec report_callgraphs(mfa()) -> ok. +report_callgraphs(EntryPoint) -> + Original = calculate_callgraph(EntryPoint), + io:format("Original callgraph:~n"), + graphs:print_graph(Original), + CallGraph = remake_graph(EntryPoint, Original), + NewEntryPoint = find_node(EntryPoint, CallGraph), + io:format("Final callgraph:~n"), + graphs:print_graph(CallGraph), + io:format("New Entry Point: ~p ~n", [NewEntryPoint]). diff --git a/src/cuter_log.erl b/src/cuter_log.erl index 146fb50f..850641f7 100644 --- a/src/cuter_log.erl +++ b/src/cuter_log.erl @@ -331,10 +331,10 @@ log(Fd, OpCode, TagID, Data) -> N when is_integer(N), N > 0 -> IsConstraint = is_constraint(OpCode), try cuter_serial:to_log_entry(OpCode, Data, IsConstraint, TagID) of - Jdata -> - write_data(Fd, Jdata) + Jdata -> + write_data(Fd, Jdata) catch - throw:{unsupported_term, _} -> ok + throw:{unsupported_term, _} -> ok end end. -else. diff --git a/src/cuter_maybe_error_annotation.erl b/src/cuter_maybe_error_annotation.erl new file mode 100644 index 00000000..9bda2b23 --- /dev/null +++ b/src/cuter_maybe_error_annotation.erl @@ -0,0 +1,515 @@ +-module(cuter_maybe_error_annotation). +-export([preprocess/3, preprocess/4, get_force_constraint_logging/1, get_maybe_error_bin/2, get_maybe_error_bin_anno/2, get_distrust_type_dependent/1]). +-export_type([maybe_error/0, symbol_table/0]). + +%% ===== +%% types +%% ===== + +-type maybe_error() :: false | type_dependent | true. +-type symbol_table() :: dict:dict(). + +%% ============================ +%% annotating a callgraph logic +%% ============================ + +-spec st_from_tsm() -> dict:dict(). +st_from_tsm() -> + lists:foldl( + fun({Fun, _}, ST) -> + dict:store(Fun, {type_dependent, 'fun'}, ST) + end, + dict:new(), + dict:to_list(cuter_type_dependent_functions:original_tsm()) + ). + +-spec annotate_callgraph(cuter_graphs:graph_node(), dict:dict(), cuter_graphs:graph(), boolean()) -> dict:dict(). +annotate_callgraph(EntryPoint, FunctionAsts, Graph, CheckTypes) -> + {Annotated, _} = + case CheckTypes of + false -> annotate_callgraph(EntryPoint, FunctionAsts, Graph, dict:new(), CheckTypes); + true -> annotate_callgraph(EntryPoint, FunctionAsts, Graph, st_from_tsm(), CheckTypes) + end, + Annotated. + +-spec annotate_callgraph(cuter_graphs:graph_node(), dict:dict(), cuter_graphs:graph(), symbol_table(), boolean()) -> {dict:dict(), symbol_table()}. +annotate_callgraph(Node, FunctionAsts, Graph, ST, CheckTypes) -> + {FunctionAsts1, ST1} = lists:foldl(fun(A, {Funs, SmT}) -> annotate_callgraph(A, Funs, Graph, SmT, CheckTypes) end, {FunctionAsts, ST}, cuter_graphs:children(Node, Graph)), + case Node of + {node, Name} -> + {ok, PrevAST} = dict:find(Name, FunctionAsts1), + {NewAST, _C, _SelfReffed} = annotate_maybe_error(PrevAST, ST1, sets:new(), element(1, Name), CheckTypes), + {dict:store(Name, NewAST, FunctionAsts1), dict:store(Name, {get_maybe_error(NewAST), 'fun'}, ST1)}; + {cycle, Cycle} -> + cycle_annotation(Cycle, FunctionAsts1, ST1, CheckTypes) + end. + +cycle_annotation(Cycle, FunctionAsts, ST, CheckTypes) -> + ASTS = [element(2, dict:find(A, FunctionAsts)) || A <- Cycle], + CycleSet = sets:from_list(Cycle), + {NewASTS, NewST} = cycle_annotation_helper(Cycle, ASTS, ST, CycleSet, CheckTypes), + { + lists:foldl( + fun({Name, AST}, Y) -> dict:store(Name, AST, Y) end, + FunctionAsts, + lists:zip(Cycle, NewASTS) + ), + NewST + }. + +cycle_annotation_helper(Cycle, ASTS, ST, CycleSet, CheckTypes) -> + {NewASTS, ST1, C} = cycle_pass(Cycle, ASTS, ST, CycleSet, CheckTypes), + case C of + false -> + {NewASTS, ST1}; + true -> + cycle_annotation_helper(Cycle, NewASTS, ST1, CycleSet, CheckTypes) + end. + +cycle_pass(Cycle, ASTS, ST, CycleSet, CheckTypes) -> + cycle_pass_helper(CycleSet, Cycle, ASTS, ST, [], false, CheckTypes). + +cycle_pass_helper(_, [], _, ST, AccAST, AccC, _) -> {lists:reverse(AccAST), ST, AccC}; +cycle_pass_helper(CycleSet, [Name|Names], [AST|ASTS], ST, AccAST, AccC, CheckTypes) -> + {NewAST, C, IgnoredFound} = annotate_maybe_error(AST, ST, CycleSet, element(1, Name), CheckTypes), + ST1 = dict:store(Name, {get_maybe_error(NewAST), 'fun'}, ST), + cycle_pass_helper(CycleSet, Names, ASTS, ST1, [NewAST|AccAST], AccC or C or IgnoredFound, CheckTypes). + + +%% =========================== +%% annotating a function logic +%% =========================== + +-spec update_ann(cerl:cerl(), maybe_error()) -> cerl:cerl(). +update_ann(T, Maybe_Error) -> + Anno = cerl:get_ann(T), + cerl:set_ann(T, update_ann(Anno, Maybe_Error, [], false)). + +-spec update_ann([any()], maybe_error(), [any()], atom()) -> [any()]. +update_ann([], Maybe_Error, Acc, false) -> [{maybe_error, Maybe_Error}|Acc]; +update_ann([], _, Acc, true) -> Acc; +update_ann([{maybe_error, _}|T], Maybe_Error, Acc, _) -> update_ann(T, Maybe_Error, [{maybe_error, Maybe_Error}|Acc], true); +update_ann([H|T], Maybe_Error, Acc, Found) -> update_ann(T, Maybe_Error, [H|Acc], Found). + +-spec add_force_constraint_logging(cerl:cerl()) -> cerl:cerl(). +add_force_constraint_logging(Tree) -> + Anno = cerl:get_ann(Tree), + case cuter_graphs:list_contains({force_constraint_logging, true}, Anno) of + true -> Tree; + false -> cerl:add_ann([{force_constraint_logging, true}], Tree) + end. + +add_distrust_type_dependent(Tree) -> + Anno = cerl:get_ann(Tree), + case cuter_graphs:list_contains({distrust_type_dependent, true}, Anno) of + true -> Tree; + false -> cerl:add_ann([{distrust_type_dependent, true}], Tree) + end. + +put_vars(Vars, Flags, SM) -> + lists:foldl(fun({Var, Flag}, B) -> dict:store(cerl:var_name(Var), Flag, B) end, SM, lists:zip(Vars, Flags)). + +annotate_maybe_error(AST, ST, Ignored, Mod, CheckTypes) -> + {NewAST, C, _, IgnoredCall} = annotate_maybe_error(AST, ST, false, Ignored, Mod, CheckTypes), + {NewAST, C, IgnoredCall}. + +-spec annotate_maybe_error(cerl:cerl(), symbol_table(), boolean(), sets:set(), module(), boolean()) -> {cerl:cerl(), boolean(), sets:set(), boolean()}. +annotate_maybe_error(Tree, SM, Force, Ignored, Mod, CheckTypes) -> + CurMaybe_Error = get_maybe_error(Tree), + case cerl:type(Tree) of +% alias -> + 'apply' -> + Op = cerl:apply_op(Tree), + {Op1, C1, IgnoreFound1} = + case cerl:type(Op) of + var -> + case cerl:var_name(Op) of + {F, A} -> + case dict:find({Mod, F, A}, SM) of + {ok, {Value, 'fun'}} -> + case Value of + type_dependent when CheckTypes -> + case cuter_spec_checker:get_cerl_type(Tree) of + notype -> {update_ann(Op, true), true =/= CurMaybe_Error, false}; + _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false} + end; + _ -> {update_ann(Op, Value), Value =/= CurMaybe_Error, false} + end; + _ -> + case dict:find({F, A}, SM) of + {ok, {Value, FunType}} when FunType =:= 'fun' orelse FunType =:= letvar -> + case Value of + type_dependent when CheckTypes -> + case cuter_spec_checker:get_cerl_type(Tree) of + notype -> {update_ann(Op, true), true =/= CurMaybe_Error, false}; + _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false} + end; + _ -> + {update_ann(Op, Value), Value =/= CurMaybe_Error, false} + end; + _ -> + case sets:is_element({Mod, F, A}, Ignored) of + false -> + {update_ann(Op, true), true =/= CurMaybe_Error, false}; + true -> + {update_ann(Op, false), true =/= CurMaybe_Error, true} + end + end + end; + Name -> + case dict:find(Name, SM) of + {ok, {Value, _FunType}} -> %when FunType =:= 'fun' orelse FunType =:= letvar -> + case Value of + type_dependent when CheckTypes -> + case cuter_spec_checker:get_cerl_type(Tree) of + notype -> {update_ann(Op, true), true =/= CurMaybe_Error, false}; + _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false} + end; + _ -> + {update_ann(Op, Value), Value =/= CurMaybe_Error, false} + end; + _ -> + {update_ann(Op, true), true =/= CurMaybe_Error, false} + end + end; + _ -> + error("unhandled op") + end, + {Args, C2, Found, IgnoreFound2} = annotate_maybe_error_all(cerl:apply_args(Tree), SM, Force, Ignored, Mod, CheckTypes), + NewMaybe_Error = maybe_error_or([get_maybe_error(Op1), get_all_maybe_error(Args)]), + case get_all_maybe_error(Args) of + true -> + Tree1 = add_distrust_type_dependent(Tree); + _ -> + Tree1 = Tree + end, + {cerl:update_c_apply(update_ann(Tree1, NewMaybe_Error), Op1, Args), C1 or C2, Found, IgnoreFound1 or IgnoreFound2}; +% binary -> meta +% bitstr -> meta + call -> + ModName = cerl:call_module(Tree), + Name = cerl:call_name(Tree), + Arity = length(cerl:call_args(Tree)), + {NewAnn, IgnoreFound1} = + case cerl:is_literal(ModName) andalso cerl:is_literal(Name) of + true -> + case dict:find({element(3, ModName), element(3, Name), Arity}, SM) of + {ok, {Value, 'fun'}} -> + case Value of + type_dependent when CheckTypes -> + case cuter_spec_checker:get_cerl_type(Tree) of + notype -> {true, false}; + _ -> {type_dependent, false} + end; + _ -> {Value, false} + end; + _ -> + case sets:is_element({element(3, ModName), element(3, Name), Arity}, Ignored) of + false -> + {true, false}; + true -> + {true, true} + end + end; + _ -> throw("Unsupported call") + end, + {Args, C1, Found, IgnoreFound2} = annotate_maybe_error_all(cerl:call_args(Tree), SM, Force, Ignored, Mod, CheckTypes), + NewMaybe_Error = maybe_error_or([NewAnn, get_all_maybe_error(Args)]), + C2 = NewMaybe_Error =/= CurMaybe_Error, + case get_all_maybe_error(Args) of + true -> + Tree1 = add_distrust_type_dependent(Tree); + _ -> + Tree1 = Tree + end, + {cerl:update_c_call(update_ann(Tree1, NewMaybe_Error), ModName, Name, Args), C1 or C2, Found, IgnoreFound1 or IgnoreFound2}; + 'case' -> + {Clauses, C1, Found1, IgnoreFound1} = annotate_maybe_error_all(cerl:case_clauses(Tree), SM, Force, Ignored, Mod, CheckTypes), + ClausesError1 = get_all_maybe_error(Clauses), + ClausesError = + case unreachable_clauses(Clauses) of + true -> maybe_error_or([ClausesError1, type_dependent]); + false -> ClausesError1 + end, + {Arg, C2, Found2, IgnoreFound2} = + case ClausesError of + true -> annotate_maybe_error(cerl:case_arg(Tree), SM, true, Ignored, Mod, CheckTypes); + type_dependent -> annotate_maybe_error(cerl:case_arg(Tree), SM, Force, Ignored, Mod, CheckTypes); + false -> annotate_maybe_error(cerl:case_arg(Tree), SM, Force, Ignored, Mod, CheckTypes) + end, + NewMaybe_Error = maybe_error_or([get_maybe_error(Arg), ClausesError]), + {cerl:update_c_case(update_ann(Tree, NewMaybe_Error), Arg, Clauses), C1 or C2, sets:union([Found1, Found2]), IgnoreFound1 or IgnoreFound2}; + clause -> + {Pats, C1, Found1, SM1} = annotate_maybe_error_pattern_all(cerl:clause_pats(Tree), SM, Force), + IgnoreFound1 = false, + {Guard, C2, Found2, IgnoreFound2} = annotate_maybe_error(cerl:clause_guard(Tree), SM1, Force, Ignored, Mod, CheckTypes), + {Body, C3, Found3, IgnoreFound3} = annotate_maybe_error(cerl:clause_body(Tree), SM1, Force, Ignored, Mod, CheckTypes), + NewIgnoreFound = IgnoreFound1 or IgnoreFound2 or IgnoreFound3, + NewMaybe_Error = maybe_error_or([get_maybe_error(Body), get_all_maybe_error(Pats), get_maybe_error(Guard)]), + {cerl:update_c_clause(update_ann(Tree, NewMaybe_Error), Pats, Guard, Body), C1 or C2 or C3, sets:union([Found1, Found2, Found3]), NewIgnoreFound}; + cons -> + {Hd, C1, Found1, IgnoreFound1} = annotate_maybe_error(cerl:cons_hd(Tree), SM, Force, Ignored, Mod, CheckTypes), + {Tl, C2, Found2, IgnoreFound2} = annotate_maybe_error(cerl:cons_tl(Tree), SM, Force, Ignored, Mod, CheckTypes), + NewIgnoreFound = IgnoreFound1 or IgnoreFound2, + NewMaybe_Error = maybe_error_or([get_maybe_error(Hd), get_maybe_error(Tl)]), + {cerl:update_c_cons_skel(update_ann(Tree, NewMaybe_Error), Hd, Tl), C1 or C2, sets:union([Found1, Found2]), NewIgnoreFound}; + 'fun' -> + Flags = make_fun_flags(cerl:fun_vars(Tree)), + SM1 = put_vars(cerl:fun_vars(Tree), Flags, SM), + {Vars, C1, Found1, IgnoreFound1} = annotate_maybe_error_all(cerl:fun_vars(Tree), SM1, Force, Ignored, Mod, CheckTypes), + {Body, C2, Found2, IgnoreFound2} = annotate_maybe_error(cerl:fun_body(Tree), SM1, Force, Ignored, Mod, CheckTypes), + NewMaybe_Error = maybe_error_or([get_maybe_error(Body), get_all_maybe_error(Vars)]), + {cerl:update_c_fun(update_ann(Tree, NewMaybe_Error), Vars, Body), C1 or C2, sets:union([Found1, Found2]), IgnoreFound1 or IgnoreFound2}; + 'let' -> + {Arg, C2, Found1, IgnoreFound1} = annotate_maybe_error(cerl:let_arg(Tree), SM, Force, Ignored, Mod, CheckTypes), + SM1 = put_vars(cerl:let_vars(Tree), get_arg_maybe_errors(Arg), SM), + {Vars, C1, Found2, IgnoreFound2} = annotate_maybe_error_all(cerl:let_vars(Tree), SM1, Force, Ignored, Mod, CheckTypes), + {Body, C3, Found3, IgnoreFound3} = annotate_maybe_error(cerl:let_body(Tree), SM1, Force, Ignored, Mod, CheckTypes), + Tree1 = + case vars_in_set(cerl:let_vars(Tree), Found3) of + true -> + add_force_constraint_logging(Tree); + false -> + Tree + end, + NewMaybe_Error = maybe_error_or([get_all_maybe_error(Vars), get_maybe_error(Arg), get_maybe_error(Body)]), + NewIgnoreFound = IgnoreFound1 or IgnoreFound2 or IgnoreFound3, + {cerl:update_c_let(update_ann(Tree1, NewMaybe_Error), Vars, Arg, Body), C1 or C2 or C3, sets:union([Found1, Found2, Found3]), NewIgnoreFound}; + letrec -> + {Names, Funsb} = lists:unzip(cerl:letrec_defs(Tree)), + {Funs, C1, Found1, IgnoreFound1} = annotate_maybe_error_all(Funsb, SM, Force, Ignored, Mod, CheckTypes), + SM1 = put_vars(Names, [{get_maybe_error_pessimistic(A), letvar} || A <- Funs], SM), + {Body, C2, Found2, IgnoreFound2} = annotate_maybe_error(cerl:letrec_body(Tree), SM1, Force, Ignored, Mod, CheckTypes), + NewMaybe_Error = get_maybe_error(Body), + {cerl:update_c_letrec(update_ann(Tree, NewMaybe_Error), lists:zip(Names, Funs), Body), C1 or C2, sets:union([Found1, Found2]), IgnoreFound1 or IgnoreFound2}; + literal -> + {update_ann(Tree, false), true == CurMaybe_Error, sets:new(), false}; + primop -> + {update_ann(Tree, true), false == CurMaybe_Error, sets:new(), false}; + 'receive' -> throw("Error annotation not supporting receive at the moment"); + seq -> + {Arg, C1, Found1, IgnoreFound1} = annotate_maybe_error(cerl:seq_arg(Tree), SM, Force, Ignored, Mod, CheckTypes), + {Body, C2, Found2, IgnoreFound2} = annotate_maybe_error(cerl:seq_body(Tree), SM, Force, Ignored, Mod, CheckTypes), + NewIgnoreFound = IgnoreFound1 or IgnoreFound2, + NewMaybe_Error = maybe_error_or([get_maybe_error(Arg), get_maybe_error(Body)]), + {cerl:update_c_seq(update_ann(Tree, NewMaybe_Error), Arg, Body), C1 or C2, sets:union([Found1, Found2]), NewIgnoreFound}; + 'try' -> + {Arg, C1, Found1, IgnoreFound1} = annotate_maybe_error(cerl:try_arg(Tree), SM, Force, Ignored, Mod, CheckTypes), + {Vars, C2, Found2, IgnoreFound2} = annotate_maybe_error_all(cerl:try_vars(Tree), SM, Force, Ignored, Mod, CheckTypes), + {Body, C3, Found3, IgnoreFound3} = annotate_maybe_error(cerl:try_body(Tree), SM, Force, Ignored, Mod, CheckTypes), + {Evars, C4, Found4, IgnoreFound4} = annotate_maybe_error_all(cerl:try_evars(Tree), SM, Force, Ignored, Mod, CheckTypes), + {Handler, C5, Found5, IgnoreFound5} = annotate_maybe_error(cerl:try_handler(Tree), SM, Force, Ignored, Mod, CheckTypes), + NewIgnoreFound = IgnoreFound1 or IgnoreFound2 or IgnoreFound3 or IgnoreFound4 or IgnoreFound5, + NewMaybe_Error = get_maybe_error(Arg), + {cerl:update_c_try(update_ann(Tree, NewMaybe_Error), Arg, Vars, Body, Evars, Handler), C1 or C2 or C3 or C4 or C5, sets:union([Found1, Found2, Found3, Found4, Found5]), NewIgnoreFound}; +% 'catch' -> + tuple -> + {Es, C, Found, IgnoreFound} = annotate_maybe_error_all(cerl:tuple_es(Tree), SM, Force, Ignored, Mod, CheckTypes), + NewMaybe_Error = get_all_maybe_error(Es), + {cerl:update_c_tuple(update_ann(Tree, NewMaybe_Error), Es), C, Found, IgnoreFound}; + values -> + {Es, C, Found, IgnoreFound} = annotate_maybe_error_all(cerl:values_es(Tree), SM, Force, Ignored, Mod, CheckTypes), + NewMaybe_Error = get_all_maybe_error(Es), + {cerl:update_c_values(update_ann(Tree, NewMaybe_Error), Es), C, Found, IgnoreFound}; + var -> + Found = + case Force of + true -> sets:add_element(cerl:var_name(Tree), sets:new()); + false -> sets:new() + end, + case dict:find(cerl:var_name(Tree), SM) of + {ok, {Value, _}} -> + {update_ann(Tree, Value), Value =/= CurMaybe_Error, Found, false}; + error -> + {update_ann(Tree, true), true =/= CurMaybe_Error, Found, false} + end; + _ -> + {update_ann(Tree, true), true =/= CurMaybe_Error, sets:new(), false} + end. + +annotate_maybe_error_pattern(Tree, SM, Force) -> + CurMaybe_Error = get_maybe_error(Tree), + case cerl:type(Tree) of + literal -> + {update_ann(Tree, false), true == CurMaybe_Error, sets:new(), SM}; + var -> + Found = + case Force of + true -> sets:add_element(cerl:var_name(Tree), sets:new()); + false -> sets:new() + end, + case dict:find(cerl:var_name(Tree), SM) of + {ok, {Value, _}} -> + {update_ann(Tree, Value), Value =/= CurMaybe_Error, Found, SM}; + error -> + {update_ann(Tree, false), false =/= CurMaybe_Error, Found, put_vars([Tree], [{type_dependent, 'var'}], SM)} + end; + cons -> + {Hd, C1, Found1, SM1} = annotate_maybe_error_pattern(cerl:cons_hd(Tree), SM, Force), + {Tl, C2, Found2, SM2} = annotate_maybe_error_pattern(cerl:cons_tl(Tree), SM1, Force), + NewMaybe_Error = maybe_error_or([get_maybe_error(Hd), get_maybe_error(Tl)]), + {cerl:update_c_cons_skel(update_ann(Tree, NewMaybe_Error), Hd, Tl), C1 or C2, sets:union([Found1, Found2]), SM2}; + tuple -> + {Es, C, Found, SM1} = annotate_maybe_error_pattern_all(cerl:tuple_es(Tree), SM, Force), + NewMaybe_Error = get_all_maybe_error(Es), + {cerl:update_c_tuple(update_ann(Tree, NewMaybe_Error), Es), C, Found, SM1} + end. + +-spec get_arg_maybe_errors(cerl:cerl()) -> [{maybe_error(), atom()}]. +get_arg_maybe_errors(Arg) -> + [{get_maybe_error_pessimistic(Arg), letvar}]. + +annotate_maybe_error_all(Trees, SM, Force, Ignored, Mod, CheckTypes) -> + X = [annotate_maybe_error(T, SM, Force, Ignored, Mod, CheckTypes) || T <- Trees], + MyOr = fun(E) -> fun(A, B) -> B or element(E, A) end end, + {[element(1, Y) || Y <- X], lists:foldl(MyOr(2), false, X), sets:union([element(3, Z) || Z <- X]), lists:foldl(MyOr(4), false, X)}. + +annotate_maybe_error_pattern_all(Trees, SM, Force) -> + annotate_maybe_error_pattern_all(Trees, SM, Force, [], false, sets:new()). + +annotate_maybe_error_pattern_all([], SM, _, AccTrees, AccC, AccFound) -> {lists:reverse(AccTrees), AccC, AccFound, SM}; +annotate_maybe_error_pattern_all([Tree|Trees], SM, Force, AccTrees, AccC, AccFound) -> + {NewTree, C, Found, SM1} = annotate_maybe_error_pattern(Tree, SM, Force), + annotate_maybe_error_pattern_all(Trees, SM1, Force, [NewTree|AccTrees], C or AccC, sets:union([AccFound, Found])). + +-spec get_maybe_error(cerl:cerl()) -> maybe_error(). +get_maybe_error(Tree) -> + Anno = cerl:get_ann(Tree), + get_maybe_error_anno(Anno). + +-spec get_maybe_error_anno([any()]) -> maybe_error(). +get_maybe_error_anno([]) -> false; +get_maybe_error_anno([{maybe_error, V}|_]) -> V; +get_maybe_error_anno([_|Tl]) -> get_maybe_error_anno(Tl). + +-spec get_maybe_error_bin(cerl:cerl(), boolean()) -> boolean(). +get_maybe_error_bin(Tree, DT) -> + Anno = cerl:get_ann(Tree), + get_maybe_error_bin_anno(Anno, DT). + +-spec get_maybe_error_bin_anno([any()], boolean()) -> boolean(). +get_maybe_error_bin_anno([], _DT) -> true; +get_maybe_error_bin_anno([{maybe_error, V}|_], DT) -> + case V of + type_dependent -> DT; + V1 -> V1 + end; +get_maybe_error_bin_anno([_|Tl], DT) -> get_maybe_error_bin_anno(Tl, DT). + +get_maybe_error_pessimistic(Tree) -> + get_maybe_error_pessimistic_anno(cerl:get_ann(Tree)). + +get_maybe_error_pessimistic_anno([]) -> true; +get_maybe_error_pessimistic_anno([{maybe_error, V}|_]) -> V; +get_maybe_error_pessimistic_anno([_|Tl]) -> get_maybe_error_pessimistic_anno(Tl). + +-spec get_all_maybe_error([cerl:cerl()]) -> maybe_error(). +get_all_maybe_error(Trees) -> + maybe_error_or([get_maybe_error(T) || T <- Trees, not cuter_spec_checker:get_type_dependent_unreachable(T)]). + +vars_in_set([], _) -> false; +vars_in_set([Hd|Tl], Set) -> + case sets:is_element(cerl:var_name(Hd), Set) of + true -> + true; + false -> + vars_in_set(Tl, Set) + end. + +-spec get_force_constraint_logging([any()]) -> boolean(). +get_force_constraint_logging([]) -> false; +get_force_constraint_logging([Hd|Tl]) -> + case Hd of + {force_constraint_logging, Value} -> + Value; + _ -> + get_force_constraint_logging(Tl) + end. + +-spec get_distrust_type_dependent([any()]) -> boolean(). +get_distrust_type_dependent([]) -> false; +get_distrust_type_dependent([Hd|Tl]) -> + case Hd of + {distrust_type_dependent, Value} -> + Value; + _ -> + get_distrust_type_dependent(Tl) + end. + +-spec maybe_error_or([maybe_error()]) -> maybe_error(). +maybe_error_or(E) -> + lists:foldl( + fun(A, B) -> + case A of + true -> true; + false -> B; + type_dependent -> + case B of + true -> true; + _ -> type_dependent + end + end + end, + false, + E + ). + +unreachable_clauses(Clauses) -> + lists:foldl(fun(Clause, Acc) -> Acc orelse cuter_spec_checker:get_type_dependent_unreachable(Clause) end, false, Clauses). + +make_fun_flags(Vars) -> + Fn = fun(Var) -> + case cuter_spec_checker:get_cerl_type(Var) of + notype -> {false, var}; + T -> + case erl_types:t_is_fun(T) of + true -> {type_dependent, var}; + false -> {false, var} + end + end + end, + lists:map(Fn, Vars). + +%% ================================================================================ +%% The preprocess function: +%% Takes an entry point {M, F, A}, calculates the callgraph with this entrypoint as +%% its root, merges the nodes belonging to a cycle until the callgraph is a DAG and +%% then annotates it from the leaves to the root, in a DFS order +%% ================================================================================ + +-spec preprocess(mfa(), dict:dict(), boolean()) -> dict:dict(). +preprocess(EntryPoint, KFunctionASTS, CheckTypes) -> + FunctionASTS = + dict:map( + fun(_, Value) -> + cuter_cerl:kfun_code(Value) + end, + KFunctionASTS + ), + {CallGraph, _Funs, NewEntryPoint} = cuter_graphs:calculate_dag_callgraph(EntryPoint), + AnnotatedASTS = annotate_callgraph(NewEntryPoint, FunctionASTS, CallGraph, CheckTypes), + dict:map( + fun(Key, Value) -> + cuter_cerl:kfun_update_code(Value, dict:fetch(Key, AnnotatedASTS)) + end, + KFunctionASTS + ). + +-spec preprocess(mfa(), dict:dict(), dict:dict(), boolean()) -> dict:dict(). +preprocess(EntryPoint, KFunctionASTS, MfasToSpecs, CheckTypes) -> + FunctionASTS = + dict:map( + fun(_, Value) -> + cuter_cerl:kfun_code(Value) + end, + KFunctionASTS + ), + {CallGraph, Funs, NewEntryPoint} = cuter_graphs:calculate_dag_callgraph(EntryPoint), + TypedASTS = cuter_spec_checker:annotate_types(FunctionASTS, MfasToSpecs, Funs), + AnnotatedASTS = annotate_callgraph(NewEntryPoint, TypedASTS, CallGraph, CheckTypes), + dict:map( + fun(Key, Value) -> + cuter_cerl:kfun_update_code(Value, dict:fetch(Key, AnnotatedASTS)) + end, + KFunctionASTS + ). diff --git a/src/cuter_spec_checker.erl b/src/cuter_spec_checker.erl new file mode 100644 index 00000000..70a66d33 --- /dev/null +++ b/src/cuter_spec_checker.erl @@ -0,0 +1,749 @@ +-module(cuter_spec_checker). +-export([get_cerl_type/1, get_type_dependent_unreachable/1, annotate_types/3]). + +%% ========================= +%% multi function annotation +%% ========================= + +-spec annotate_types(dict:dict(), dict:dict(), sets:set()) -> dict:dict(). +annotate_types(FunctionASTS, Sigs, FSet) -> + TSM = + lists:foldl( + fun ({MFA, Sig}, T) -> + dict:store(MFA, Sig, T) + end, + cuter_type_dependent_functions:original_tsm(), + dict:to_list(Sigs) + ), + NoSpec = find_nospec(FSet, Sigs), + OpenSet = make_open_set(FSet, Sigs), + annotate_types_helper(FunctionASTS, TSM, OpenSet, NoSpec). + +annotate_types_helper(FunctionASTS, TSM, OpenSet, NoSpec) -> + case sets:size(OpenSet) of + 0 -> FunctionASTS; + _ -> + O = sets:to_list(OpenSet), + {FASTS1, TSM1, OpenSet1} = annotate_types_helper_pass(FunctionASTS, TSM, O, NoSpec), + annotate_types_helper(FASTS1, TSM1, OpenSet1, NoSpec) + end. + +annotate_types_helper_pass(FunctionASTS, TSM, OpenSet, NoSpec) -> + annotate_types_helper_pass(FunctionASTS, TSM, OpenSet, NoSpec, sets:new()). + +annotate_types_helper_pass(FunctionASTS, TSM, [], _NoSpec, OpenSet1) -> {FunctionASTS, TSM, OpenSet1}; +annotate_types_helper_pass(FunctionASTS, TSM, [Mfa|Mfas], NoSpec, OpenSet1) -> + AST = dict:fetch(Mfa, FunctionASTS), + Spec = dict:fetch(Mfa, TSM), + {NewAST, D, C} = pass_down_fun_types(Mfa, AST, Spec, TSM, NoSpec), + case C or (length(D) > 0) of + true -> + OpenSet2 = sets:add_element(Mfa, OpenSet1); + false -> + OpenSet2 = OpenSet1 + end, + {TSM1, OpenSet3} = update_from_detected(D, TSM, OpenSet2), + case sets:is_element(Mfa, NoSpec) of + true -> + T = get_cerl_type(NewAST), + case erl_types:is_erl_type(T) of + true -> + [S] = dict:fetch(Mfa, TSM1), + NewS = erl_types:t_fun(erl_types:t_fun_args(S), T), + TSM2 = dict:store(Mfa, [NewS], TSM1); + false -> TSM2 = TSM1 + end; + false -> + TSM2 = TSM1 + end, + NewASTS = dict:store(Mfa, NewAST, FunctionASTS), + annotate_types_helper_pass(NewASTS, TSM2, Mfas, NoSpec, OpenSet3). + +update_from_detected([], TSM, OpenSet) -> {TSM, OpenSet}; +update_from_detected([{Mfa, Spec}|Rest], TSM, OpenSet) -> + OpenSet1 = sets:add_element(Mfa, OpenSet), + case dict:find(Mfa, TSM) of + {ok, [Cur]} -> + TSM1 = dict:store(Mfa, [erl_types:t_sup(Cur, Spec)], TSM); + error -> + TSM1 = dict:store(Mfa, [Spec], TSM) + end, + update_from_detected(Rest, TSM1, OpenSet1). +find_nospec(FSet, Sigs) -> + Fn = fun(F) -> not dict:is_key(F, Sigs) end, + sets:filter(Fn, FSet). + +make_open_set(FSet, Sigs) -> + Fn = fun(F) -> + case dict:is_key(F, Sigs) of + true -> length(dict:fetch(F, Sigs)) =:= 1; + false -> false + end + end, + sets:filter(Fn, FSet). + +%% ========================== +%% single function annotation +%% ========================== + +get_type([]) -> notype; +get_type([Hd|Tl]) -> + case Hd of + {node_type, Value} -> + Value; + _ -> + get_type(Tl) + end. + +-spec get_cerl_type(cerl:cerl()) -> erl_types:erl_type() | notype. +get_cerl_type(T) -> get_type(cerl:get_ann(T)). + +update_type(Tree, Type) -> + Anno = cerl:get_ann(Tree), + cerl:set_ann(Tree, update_type(Anno, Type, [], false)). + +update_type([], Type, Acc, false) -> [{node_type, Type}|Acc]; +update_type([], _, Acc, true) -> Acc; +update_type([{node_type, _}|T], Type, Acc, _) -> update_type(T, Type, [{node_type, Type}|Acc], true); +update_type([H|T], Type, Acc, Found) -> update_type(T, Type, [H|Acc], Found). + +has_type(Tree) -> + Anno = cerl:get_ann(Tree), + lists:foldl( + fun erlang:'or'/2, + false, + lists:map( + fun(A) -> + case A of + {node_type, T} when T =/= notype -> true; + _ -> false + end + end, + Anno + ) + ). + +arg_types(Args) -> + lists:map(fun get_cerl_type/1, Args). + +let_arg_types(Arg) -> + case cerl:type(Arg) of + values -> + arg_types(cerl:values_es(Arg)); + _ -> [get_cerl_type(Arg)] + end. + +put_vars(Vars, Types, TSM) -> + F = + fun({Var, Type}, B) -> + case Type of + notype -> B; + [notype] -> B; + _ -> dict:store(cerl:var_name(Var), Type, B) + end + end, + lists:foldl(F, TSM, lists:zip(Vars, Types)). + +%% ===================== +%% helper type functions +%% ===================== + +t_from_pattern(Tree, TSM, TSM2) -> + case cerl:type(Tree) of + literal -> + erl_types:t_from_term(element(3, Tree)); + var -> + case dict:find(cerl:var_name(Tree), TSM2) of + {ok, Type} -> + Type; + error -> + case dict:find(cerl:var_name(Tree), TSM) of + {ok, _} -> erl_types:t_none(); + error -> + erl_types:t_any() + end + end; + cons -> + Hd = t_from_pattern(cerl:cons_hd(Tree), TSM, TSM2), + Tl = t_from_pattern(cerl:cons_tl(Tree), TSM, TSM2), + case erl_types:t_is_nil(Tl) of + true -> erl_types:t_none(); + false -> + case erl_types:t_is_none(Tl) of + true -> erl_types:t_none(); + false -> erl_types:t_cons(Hd, Tl) + end + end; + tuple -> + Es = lists:map(fun(E) -> t_from_pattern(E, TSM, TSM2) end, cerl:tuple_es(Tree)), + erl_types:t_tuple(Es); + _ -> erl_types:t_none() + end. + +application_type(Spec, ArgTypes) when not is_list(Spec) -> + application_type([Spec], ArgTypes); +application_type([], _) -> error; +application_type([Spec|Specs], ArgTypes) -> + SpecArgs = erl_types:t_fun_args(Spec), + case lists:foldl( + fun erlang:'and'/2, + true, + lists:zipwith( + fun erl_types:t_is_subtype/2, + lists:map( + fun(A) -> + case A of + notype -> erl_types:t_any(); + B -> B + end + end, + ArgTypes), + SpecArgs)) of + true -> + {ok, erl_types:t_fun_range(Spec)}; + false -> + application_type(Specs, ArgTypes) + end. + +t_union(Types) -> + t_union(Types, erl_types:t_none()). + +t_union([], T) -> T; +t_union([Type|Types], T) -> t_union(Types, erl_types:t_sup(Type, T)). + +unify_pattern(Tree, TSM, Type) -> + case cerl:type(Tree) of + literal -> + {ok, TSM}; + var -> + case dict:find(cerl:var_name(Tree), TSM) of + {ok, VarType} -> + try erl_types:t_unify(VarType, Type) of + _ -> {ok, TSM} + catch + _ -> {error, mismatch} + end; + error -> + {ok, dict:store(cerl:var_name(Tree), Type, TSM)} + end; + cons -> + case erl_types:t_is_list(Type) of + true -> + NewType = erl_types:t_nonempty_list(erl_types:t_list_elements(Type)), + Hdt = unify_pattern(cerl:cons_hd(Tree), TSM, erl_types:t_cons_hd(NewType)), + case Hdt of + {ok, TSM1} -> + Tlt = unify_pattern(cerl:cons_tl(Tree), TSM1, erl_types:t_cons_tl(NewType)), + case Tlt of + {ok, TSM2} -> {ok, TSM2}; + _ ->{error, mismatch} + end; + _ -> + {error, mismatch} + end; + false -> + {error, mismatch} + end; + tuple -> + case erl_types:t_is_tuple(Type) of + true -> + case length(cerl:tuple_es(Tree)) == erl_types:t_tuple_size(Type) of + true -> + lists:foldl( + fun({E, Et}, V) -> + case V of + {ok, V1} -> + unify_pattern(E, V1, Et); + {error, _} -> + {error, mismatch} + end + end, + {ok, TSM}, + lists:zip(cerl:tuple_es(Tree), erl_types:t_tuple_args(Type)) + ); + false -> {error, mismatch} + end; + false -> {error, mismatch} + end; + _ -> + {ok, TSM} + end. + + +%% ================== +%% passing down types +%% ================== + +pass_down_fun_types({M, _F, _A}, AST, Spec, TSM, NoSpec) -> + pass_down_types_helper(AST, Spec, TSM, M, NoSpec). + +pass_down_types_helper(Fun, Spec, TSM, Mod, NoSpec) -> + TSM2 = put_vars(cerl:fun_vars(Fun), erl_types:t_fun_args(hd(Spec)), TSM), + {Body, D, C} = pass_down_types(cerl:fun_body(Fun), TSM2, Mod, notype, NoSpec), + {cerl:update_c_fun(Fun, cerl:fun_vars(Fun), Body), D, C}. + +pass_down_types(Tree, TSM, Mod, ArgType, NoSpec) -> + CurType = get_cerl_type(Tree), + case cerl:type(Tree) of + %%alias -> + 'apply' -> + {Args, D1, C1} = pass_down_types_all(cerl:apply_args(Tree), TSM, Mod, ArgType, NoSpec), + Op = cerl:apply_op(Tree), + {Tree1, D2, C2} = + case lists:all(fun has_type/1, Args) of + true -> + case cerl:type(Op) of + var -> + OpN = case cerl:var_name(Op) of {F, A} -> {Mod, F, A}; Name -> Name end, + case dict:find(OpN, TSM) of + {ok, Specs} -> + case application_type(Specs, arg_types(Args)) of + {ok, Type} -> + {update_type(Tree, Type), D1, false}; + error -> + case sets:is_element(OpN, NoSpec) of + true -> + NewSpec = rewrite_spec(arg_types(Args), Specs), + {Tree, [{OpN, NewSpec} | D1], true}; + false -> + {Tree, D1, false} + end + end; + error -> + case sets:is_element(OpN, NoSpec) of + true -> + {Tree, [{OpN, erl_types:t_fun(arg_types(Args), erl_types:t_any())} | D1], true}; + false -> + {Tree, D1, false} + end + end; + _ -> + error("unhandled op") + end; + _ -> {Tree, D1, false} + end, + Change = C1 or C2 or (CurType =/= get_cerl_type(Tree1)), + {cerl:update_c_apply(Tree1, Op, Args), D2, Change}; + %%binary -> meta + %%bitstr -> meta + call -> + {Args, D1, C1} = pass_down_types_all(cerl:call_args(Tree), TSM, Mod, ArgType, NoSpec), + ModName = cerl:call_module(Tree), + Name = cerl:call_name(Tree), + Arity = length(cerl:call_args(Tree)), + {Tree1, D2, C2} = + case lists:all(fun has_type/1, Args) of + true -> + case cerl:is_literal(ModName) andalso cerl:is_literal(Name) of + true -> + OpN = {element(3, ModName), element(3, Name), Arity}, + case dict:find(OpN, TSM) of + {ok, Specs} -> + case application_type(Specs, arg_types(Args)) of + {ok, Type} -> + {update_type(Tree, Type), D1, false}; + _ -> + case sets:is_element(OpN, NoSpec) of + true -> + NewSpec = rewrite_spec(arg_types(Args), Specs), + {Tree, [{OpN, NewSpec} | D1], true}; + false -> {Tree, D1, false} + end + end; + error -> + case sets:is_element(OpN, NoSpec) of + true -> + {Tree, [{OpN, erl_types:t_fun(arg_types(Args), erl_types:t_any())} | D1], true}; + false -> + {Tree, D1, false} + end + end; + _ -> throw("Unsupported call") + end; + _ -> {Tree, D1, false} + end, + Change = C1 or C2 or (CurType =/= get_cerl_type(Tree1)), + {cerl:update_c_call(Tree1, ModName, Name, Args), D2, Change}; + 'case' -> + {Arg, D1, C1} = pass_down_types(cerl:case_arg(Tree), TSM, Mod, ArgType, NoSpec), + {Clauses1, D2, C2} = pass_down_types_all(cerl:case_clauses(Tree), TSM, Mod, get_cerl_type(Arg), NoSpec), + Clauses = mark_unreachable_clauses(Clauses1, get_cerl_type(Arg), TSM, Arg), + Clauses2 = [Clause || Clause <- Clauses, not get_type_dependent_unreachable(Clause)], + Type = + case lists:all(fun has_type/1, Clauses2) of + true -> + T = arg_types(Clauses2), + case listcontains(notype, T) of + true -> notype; + false -> t_union(T) + end; + false -> + notype + end, + Change = C1 or C2 or (CurType =/= Type), + {cerl:update_c_case(update_type(Tree, Type), Arg, Clauses), lists:append(D1, D2), Change}; + clause -> + Fn = fun({Pat, AType}, V) -> + case V of + {ok, V1} -> + unify_pattern(Pat, V1, AType); + {error, mismatch} -> {error, mismatch} + end + end, + case length(cerl:clause_pats(Tree)) > 1 of + true -> + case erl_types:t_is_tuple(ArgType) of + true -> + ATypes = erl_types:t_tuple_args(ArgType), + case length(ATypes) =:= length(cerl:clause_pats(Tree)) of + true -> + ArgTypes = ATypes; + false -> + ArgTypes = [notype || _ <- cerl:clause_pats(Tree)] + end; + false -> ArgTypes = [notype || _ <- cerl:clause_pats(Tree)] + end; + false -> ArgTypes = [ArgType] + end, + case length(ArgTypes) =/= length(cerl:clause_pats(Tree)) of + true -> + TSMt = {error, arglen}; + false -> + TSMt = lists:foldl(Fn, {ok, TSM}, lists:zip(cerl:clause_pats(Tree), ArgTypes)) + end, + case TSMt of + {ok, TSMU} -> + TSM1 = TSMU; + {error, _} -> + TSM1 = TSM + end, + {Pats, D1, C1} = pass_down_types_all(cerl:clause_pats(Tree), TSM1, Mod, ArgType, NoSpec), + {Guard, D2, C2} = pass_down_types(cerl:clause_guard(Tree), TSM1, Mod, ArgType, NoSpec), + {Body, D3, C3} = pass_down_types(cerl:clause_body(Tree), TSM1, Mod, ArgType, NoSpec), + Change = C1 or C2 or C3 or (CurType =/= get_cerl_type(Body)), + D = lists:append([D1, D2, D3]), + {cerl:update_c_clause(update_type(Tree, get_cerl_type(Body)), Pats, Guard, Body), D, Change}; + cons -> + {Hd, D1, C1} = pass_down_types(cerl:cons_hd(Tree), TSM, Mod, ArgType, NoSpec), + {Tl, D2, C2} = pass_down_types(cerl:cons_tl(Tree), TSM, Mod, ArgType, NoSpec), + Tree1 = + case {get_cerl_type(Hd), get_cerl_type(Tl)} of + {X, Y} when X =:= notype orelse Y =:= notype -> update_type(Tree, notype); + _ -> update_type(Tree, erl_types:t_cons(get_cerl_type(Hd), get_cerl_type(Tl))) + end, + Change = C1 or C2 or (CurType =/= get_cerl_type(Tree1)), + D = lists:append([D1, D2]), + {cerl:update_c_cons(Tree1, Hd, Tl), D, Change}; + tuple -> + {Es, D, C} = pass_down_types_all(cerl:tuple_es(Tree), TSM, Mod, ArgType, NoSpec), + Tree1 = + case lists:foldl(fun(X, Y) -> Y orelse (get_cerl_type(X) =:= notype) end, false, Es) of + true -> + update_type(Tree, notype); + false -> update_type(Tree, erl_types:t_tuple(lists:map(fun get_cerl_type/1, Es))) + end, + Change = C or (CurType =/= get_cerl_type(Tree1)), + {cerl:update_c_tuple(Tree1, Es), D, Change}; + 'fun' -> + TSM1 = put_vars(cerl:fun_vars(Tree), [erl_types:t_any() || _ <- cerl:fun_vars(Tree)], TSM), + {Vars, _D1, _C1} = pass_down_types_all(cerl:fun_vars(Tree), TSM1, Mod, ArgType, NoSpec), + {Body, D1, C1} = pass_down_types(cerl:fun_body(Tree), TSM1, Mod, ArgType, NoSpec), + Tree1 = + case has_type(Body) of + true -> + case get_cerl_type(Body) of + notype -> update_type(Tree, notype); + _ -> + Type = erl_types:t_fun([erl_types:t_any() || _ <- cerl:fun_vars(Tree)], get_cerl_type(Body)), + update_type(Tree, Type) + end; + _ -> update_type(Tree, notype) + end, + Change = C1 or (CurType =/= get_cerl_type(Tree1)), + {cerl:update_c_fun(Tree1, Vars, Body), D1, Change}; + 'let' -> + {Arg, D1, C1} = pass_down_types(cerl:let_arg(Tree), TSM, Mod, ArgType, NoSpec), + TSM1 = put_vars(cerl:let_vars(Tree), let_arg_types(Arg), TSM), + {Vars, D2, C2} = pass_down_types_all(cerl:let_vars(Tree), TSM1, Mod, ArgType, NoSpec), + {Body, D3, C3} = pass_down_types(cerl:let_body(Tree), TSM1, Mod, ArgType, NoSpec), + Tree1 = + case has_type(Body) of + true -> + update_type(Tree, get_cerl_type(Body)); + false -> + update_type(Tree, notype) + end, + Change = C1 or C2 or C3 or (CurType =/= get_cerl_type(Tree1)), + D = lists:append([D1, D2, D3]), + {cerl:update_c_let(Tree1, Vars, Arg, Body), D, Change}; + letrec -> + {Names, Funsb} = lists:unzip(cerl:letrec_defs(Tree)), + {Funs, D1, C1} = pass_down_types_all(Funsb, TSM, Mod, ArgType, NoSpec), + TSM1 = put_vars(Names, [[get_cerl_type(F)] || F <- Funs], TSM), + {Body, D2, C2} = pass_down_types(cerl:letrec_body(Tree), TSM1, Mod, ArgType, NoSpec), + Change = C1 or C2 or (CurType =/= get_cerl_type(Body)), + D = lists:append(D1, D2), + {cerl:update_c_letrec(update_type(Tree, get_cerl_type(Body)), lists:zip(Names, Funs), Body), D, Change}; + literal -> + {update_type(Tree, erl_types:t_from_term(element(3, Tree))), [], false}; + seq -> + {Arg, D1, C1} = pass_down_types(cerl:seq_arg(Tree), TSM, Mod, ArgType, NoSpec), + {Body, D2, C2} = pass_down_types(cerl:seq_body(Tree), TSM, Mod, ArgType, NoSpec), + Change = C1 or C2 or (CurType =/= get_cerl_type(Body)), + D = lists:append(D1, D2), + {cerl:update_c_seq(update_type(Tree, get_cerl_type(Body)), Arg, Body), D, Change}; + 'try' -> + {Arg, D1, C1} = pass_down_types(cerl:try_arg(Tree), TSM, Mod, ArgType, NoSpec), + {Vars, D2, C2} = pass_down_types_all(cerl:try_vars(Tree), TSM, Mod, ArgType, NoSpec), + {Body, D3, C3} = pass_down_types(cerl:try_body(Tree), TSM, Mod, ArgType, NoSpec), + {Evars, D4, C4} = pass_down_types_all(cerl:try_evars(Tree), TSM, Mod, ArgType, NoSpec), + {Handler, D5, C5} = pass_down_types(cerl:try_handler(Tree), TSM, Mod, ArgType, NoSpec), + Change = C1 or C2 or C3 or C4 or C5 or (CurType =/= get_cerl_type(Body)), + D = lists:append([D1, D2, D3, D4, D5]), + {cerl:update_c_try(update_type(Tree, get_cerl_type(Body)), Arg, Vars, Body, Evars, Handler), D, Change}; + %% 'catch' -> + primop -> + {update_type(Tree, notype), [], false}; + values -> + {Es, D1, C1} = pass_down_types_all(cerl:values_es(Tree), TSM, Mod, ArgType, NoSpec), + case lists:all(fun has_type/1, Es) of + true -> + {cerl:update_c_values(update_type(Tree, erl_types:t_tuple([get_cerl_type(T) || T <- Es])), Es), D1, C1}; + false -> + {cerl:update_c_values(update_type(Tree, notype), Es), D1, C1 or (CurType =/= notype)} + end; + var -> + case dict:find(cerl:var_name(Tree), TSM) of + {ok, Type} -> + {update_type(Tree, Type), [], false}; + _ -> {update_type(Tree, notype), [], false} + end; + _ -> + Tree + end. + +pass_down_types_all(Trees, TSM, Mod, ArgType, NoSpec) -> + R = lists:map(fun(A) -> pass_down_types(A, TSM, Mod, ArgType, NoSpec) end, Trees), + {NewTrees, AllDetected, Changes} = lists:unzip3(R), + {NewTrees, lists:append(AllDetected), lists:foldl(fun erlang:'or'/2, false, Changes)}. + +rewrite_spec(ArgTypes, [Spec]) -> + erl_types:t_fun(ArgTypes, erl_types:t_fun_range(Spec)). + +mark_unreachable_clauses(Clauses, ArgType, TSM, Arg) -> + case cerl:type(Arg) =:= values of + true -> + ArgList = cerl:values_es(Arg); + false -> + ArgList = [Arg] + end, + case ArgType =:= notype of + false -> + Fn = fun(C) -> valid_guard(C, TSM, ArgList) end, + case lists:all(Fn, Clauses) of + true -> + mark_unreachable_clauses(Clauses, ArgType, TSM, ArgList, []); + false -> + Clauses + end; + true -> Clauses + end. + +mark_unreachable_clauses([], _, _, _, NewClauses) -> lists:reverse(NewClauses); +mark_unreachable_clauses([Clause|Clauses], ArgType, TSM, Arg, NewClauses) -> + Pats = cerl:clause_pats(Clause), + NewClause = + case erl_types:t_is_none(ArgType) of + true -> + cerl:add_ann([type_dependent_unreachable], Clause); + false -> + Clause + end, + SafeSub = fun(A, B) -> + try erl_types:t_subtract(A, B) of + T -> T + catch + _:_ -> A + end + end, + {A, TSMorT} = update_tsm_from_guard(cerl:clause_guard(Clause), TSM, Arg), + case A of + {argtype, ArgName} -> + PatTypes1 = lists:map(fun (X) -> t_from_pattern(X, TSM, dict:new()) end, Pats), + PatTypes = [PatType || PatType <- PatTypes1, PatType =/= notype], + case length(PatTypes) =:= length(Arg) of + true -> + PatTypes2 = replace_guard_type(Arg, ArgName, PatTypes, TSMorT), + case length(PatTypes) > 1 of + true -> + PatTypes3 = erl_types:t_tuple(PatTypes2), + T = SafeSub(ArgType, PatTypes3); + false -> + PatTypes3 = hd(PatTypes2), + T = SafeSub(ArgType, PatTypes3) + end; + false -> + T = ArgType + end; + tsm -> + PatTypes1 = lists:map(fun (X) -> t_from_pattern(X, TSM, TSMorT) end, Pats), + PatTypes = [PatType || PatType <- PatTypes1, PatType =/= notype], + case length(PatTypes) =:= length(Arg) of + true -> + case length(PatTypes) > 1 of + true -> + PatTypes3 = erl_types:t_tuple(PatTypes), + T = SafeSub(ArgType, PatTypes3); + false -> + PatTypes3 = hd(PatTypes), + T = SafeSub(ArgType, PatTypes3) + end; + false -> + T = ArgType + end + end, + mark_unreachable_clauses(Clauses, T, TSM, Arg, [NewClause|NewClauses]). + +replace_guard_type([], _ArgName, [], _TSMorT) -> []; +replace_guard_type([Arg|Args], ArgName, [PatType|PatTypes], TSMorT) -> + case cerl:type(Arg) =:= var of + true -> + case cerl:var_name(Arg) =:= ArgName of + true -> + [TSMorT|PatTypes]; + false -> + [PatType|replace_guard_type(Args, ArgName, PatTypes, TSMorT)] + end; + false -> + [PatType|replace_guard_type(Args, ArgName, PatTypes, TSMorT)] + end. + +valid_guard(Clause, TSM, ArgList) -> + Guard = cerl:clause_guard(Clause), + case cerl:type(Guard) of + literal when element(3, Guard) =:= true -> true; + call -> Args = cerl:call_args(Guard), + case get_call_mfa(Guard) of + {erlang, is_integer, 1} -> is_unknown_var(hd(Args), TSM, ArgList); + {erlang, is_atom, 1} -> is_unknown_var(hd(Args), TSM, ArgList); + {erlang, is_function, 1} -> is_unknown_var(hd(Args), TSM, ArgList); + {erlang, is_function, 2} -> + C1 = is_unknown_var(hd(Args), TSM, ArgList), + C2 = cerl:type(lists:nth(2, Args)) =:= literal, + C1 or C2; + _ -> false + end; + 'try' -> + TryArg = cerl:try_arg(Guard), + case cerl:type(TryArg) of + 'let' -> + case length(cerl:let_vars(TryArg)) =:= 1 of + true -> + LetVar = hd(cerl:let_vars(TryArg)), + LetBody = cerl:let_body(TryArg), + LetArg = cerl:let_arg(TryArg), + case cerl:type(LetArg) of + 'call' -> + case get_call_mfa(LetArg) of + {erlang, is_function, 2} -> + case cerl:type(LetBody) of + 'call' -> + case is_right_call(LetBody, LetVar) of + true -> + is_unknown_var(hd(cerl:call_args(LetArg)), TSM, ArgList); + false -> false + end; + _ -> false + end; + _ -> false + end; + _ -> false + end; + false -> false + end; + _ -> false + end; + _ -> false + end. + +get_call_mfa(Guard) -> + ModName = cerl:call_module(Guard), + Name = cerl:call_name(Guard), + Arity = length(cerl:call_args(Guard)), + case cerl:type(ModName) =:= literal andalso cerl:type(Name) =:= literal of + true -> {element(3, ModName), element(3, Name), Arity}; + false -> unmatched + end. + +is_unknown_var(X, TSM, ArgList) -> + case cerl:type(X) of + var -> + ArgVarNames = [cerl:var_name(Var) || Var <- ArgList, cerl:type(Var) =:= var], + case dict:find(cerl:var_name(X), TSM) of + {ok, _} -> listcontains(cerl:var_name(X), ArgVarNames); + error ->true + end; + _ -> false + end. + +is_right_call(Call, LetVar) -> + case get_call_mfa(Call) =:= {erlang, '=:=', 2} of + true -> + [Arg1, Arg2] = cerl:call_args(Call), + case cerl:type(Arg1) =:= var andalso cerl:type(Arg2) =:= literal of + true -> cerl:var_name(LetVar) =:= cerl:var_name(Arg1) andalso element(3, Arg2) =:= true; + false -> false + end; + false -> false + end. + +update_tsm_from_guard(Guard, TSM, ArgList) -> + case cerl:type(Guard) of + literal when element(3, Guard) =:= true -> {tsm, TSM}; + call -> + Args = cerl:call_args(Guard), + case get_call_mfa(Guard) of + {erlang, is_integer, 1} -> + update_tsm_from_guard_helper(Args, ArgList, erl_types:t_integer()); + {erlang, is_atom, 1} -> + update_tsm_from_guard_helper(Args, ArgList, erl_types:t_atom()); + {erlang, is_function, 1} -> + update_tsm_from_guard_helper(Args, ArgList, erl_types:t_fun()); + {erlang, is_function, 2}-> + Arity = element(3, lists:nth(2, Args)), + update_tsm_from_guard_helper(Args, ArgList, erl_types:t_fun(Arity, erl_types:t_any())) + end; + 'try' -> + TryArg = cerl:try_arg(Guard), + LetArg = cerl:let_arg(TryArg), + Args = cerl:call_args(LetArg), + case get_call_mfa(LetArg) of + {erlang, is_function, 2} -> + Arity = element(3, lists:nth(2, Args)), + update_tsm_from_guard_helper(Args, ArgList, erl_types:t_fun(Arity, erl_types:t_any())) + end + end. + +update_tsm_from_guard_helper(Args, ArgList, Type) -> + FunArgName = cerl:var_name(hd(Args)), + ArgVarNames = [cerl:var_name(Var) || Var <- ArgList, cerl:type(Var) =:= var], + case listcontains(FunArgName, ArgVarNames) of + true -> {{argtype, FunArgName}, Type}; + _ -> {tsm, dict:store(FunArgName, Type, dict:new())} + end. + +get_ann_type_dependent_unreachable([]) -> false; +get_ann_type_dependent_unreachable([Hd|Tl]) -> + case Hd of + type_dependent_unreachable -> + true; + _ -> + get_ann_type_dependent_unreachable(Tl) + end. + +-spec get_type_dependent_unreachable(cerl:cerl()) -> boolean(). +get_type_dependent_unreachable(T) -> get_ann_type_dependent_unreachable(cerl:get_ann(T)). + +listcontains(_, []) -> false; +listcontains(X, [H|_]) when X =:= H -> true; +listcontains(X, [H|T]) when X =/= H -> listcontains(X, T). diff --git a/src/cuter_type_dependent_functions.erl b/src/cuter_type_dependent_functions.erl new file mode 100644 index 00000000..b58299d5 --- /dev/null +++ b/src/cuter_type_dependent_functions.erl @@ -0,0 +1,350 @@ +-module(cuter_type_dependent_functions). +-export([original_tsm/0]). + +-spec original_tsm() -> dict:dict(). +original_tsm() -> + TSM = dict:from_list( + [ + { + {erlang,'+',2}, + [{c,function, + [{c,product, + [{c,number,{int_rng,1,pos_inf},integer}, + {c,number,{int_rng,1,pos_inf},integer}], + unknown}, + {c,number,{int_rng,1,pos_inf},integer}], + unknown}, + {c,function, + [{c,product, + [{c,number,any,integer},{c,number,any,integer}], + unknown}, + {c,number,any,integer}], + unknown}, + {c,function, + [{c,product, + [{c,number,any,unknown},{c,number,any,unknown}], + unknown}, + {c,number,any,unknown}], + unknown}] + }, + { + {erlang,'-',2}, + [{c,function, + [{c,product, + [{c,number,any,integer},{c,number,any,integer}], + unknown}, + {c,number,any,integer}], + unknown}, + {c,function, + [{c,product, + [{c,number,any,unknown},{c,number,any,unknown}], + unknown}, + {c,number,any,unknown}], + unknown}] + }, + { + {erlang,'*',2}, + [{c,function, + [{c,product, + [{c,number,{int_rng,1,pos_inf},integer}, + {c,number,{int_rng,1,pos_inf},integer}], + unknown}, + {c,number,{int_rng,1,pos_inf},integer}], + unknown}, + {c,function, + [{c,product, + [{c,number,any,integer},{c,number,any,integer}], + unknown}, + {c,number,any,integer}], + unknown}, + {c,function, + [{c,product, + [{c,number,any,unknown},{c,number,any,unknown}], + unknown}, + {c,number,any,unknown}], + unknown}] + }, + { + {erlang,'rem',2}, + [{c,function, + [{c,product, + [{c,number,any,integer}, + {c,number,{int_rng,1,pos_inf},integer}], + unknown}, + {c,number,any,integer}], + unknown}, + {c,function, + [{c,product, + [{c,number,any,integer}, + {c,number,{int_rng,neg_inf,-1},integer}], + unknown}, + {c,number,any,integer}], + unknown}] + }, + { + {erlang,'div',2}, + [{c,function, + [{c,product, + [{c,number,any,integer}, + {c,number,{int_rng,1,pos_inf},integer}], + unknown}, + {c,number,any,integer}], + unknown}, + {c,function, + [{c,product, + [{c,number,any,integer}, + {c,number,{int_rng,neg_inf,-1},integer}], + unknown}, + {c,number,any,integer}], + unknown}] + }, + { + {erlang,'=:=',2}, + [{c,function, + [{c,product,[any,any],unknown}, + {c,atom,[false,true],unknown}], + unknown}] + }, + { + {erlang,length,1}, + [{c,function, + [{c,product, + [{c,list,[any,{c,nil,[],unknown}],unknown}], + unknown}, + {c,number,{int_rng,0,pos_inf},integer}], + unknown}] + }, + { + {erlang,tuple_size,1}, + [{c,function, + [{c,product,[{c,tuple,any,{any,any}}],unknown}, + {c,number,{int_rng,0,pos_inf},integer}], + unknown}] + }, + { + {erlang,float,1}, + [{c,function, + [{c,product,[{c,number,any,unknown}],unknown}, + {c,number,any,float}], + unknown}] + }, + { + {erlang,list_to_tuple,1}, + [{c,function, + [{c,product, + [{c,list,[any,{c,nil,[],unknown}],unknown}], + unknown}, + {c,tuple,any,{any,any}}], + unknown}] + }, + { + {erlang,tuple_to_list,1}, + [{c,function, + [{c,product,[{c,tuple,any,{any,any}}],unknown}, + {c,list,[any,{c,nil,[],unknown}],unknown}], + unknown}] + }, + { + {erlang,int_to_char,1}, + [{c,function, + [{c,product, + [{c,number,{int_set,[0,1,2,3,4,5,6,7,8,9]},integer}], + unknown}, + {c,number,{int_set,"0123456789"},integer}], + unknown}] + }, + { + {erlang,integer_to_list,1}, + [{c,function, + [{c,product,[{c,number,any,integer}],unknown}, + {c,list, + [{c,number,{int_set,"-0123456789"},integer}, + {c,nil,[],unknown}], + nonempty}], + unknown}] + }, + { + {erlang,list_to_integer,1}, + [{c,function, + [{c,product, + [{c,list, + [{c,number,{int_set,"+-0123456789"},integer}, + {c,nil,[],unknown}], + nonempty}], + unknown}, + {c,number,any,integer}], + unknown}] + }, + { + {erlang,abs,1}, + [{c,function, + [{c,product,[{c,number,any,integer}],unknown}, + {c,number,{int_rng,0,pos_inf},integer}], + unknown}, + {c,function, + [{c,product,[{c,number,any,float}],unknown}, + {c,number,any,float}], + unknown}] + }, + { + {erlang,trunc,1}, + [{c,function, + [{c,product,[{c,number,any,unknown}],unknown}, + {c,number,any,integer}], + unknown}] + }, + { + {erlang,'not',1}, + [{c,function, + [{c,product,[{c,atom,[false,true],unknown}],unknown}, + {c,atom,[false,true],unknown}], + unknown}] + }, + { + {erlang,'and',2}, + [{c,function, + [{c,product, + [{c,atom,[false,true],unknown}, + {c,atom,[false,true],unknown}], + unknown}, + {c,atom,[false,true],unknown}], + unknown}] + }, + { + {erlang,'andalso',2}, + [{c,function, + [{c,product, + [{c,atom,[false,true],unknown}, + {c,atom,[false,true],unknown}], + unknown}, + {c,atom,[false,true],unknown}], + unknown}] + }, + { + {erlang,'or',2}, + [{c,function, + [{c,product, + [{c,atom,[false,true],unknown}, + {c,atom,[false,true],unknown}], + unknown}, + {c,atom,[false,true],unknown}], + unknown}] + }, + { + {erlang,'orelse',2}, + [{c,function, + [{c,product, + [{c,atom,[false,true],unknown}, + {c,atom,[false,true],unknown}], + unknown}, + {c,atom,[false,true],unknown}], + unknown}] + }, + { + {erlang,'xor',2}, + [{c,function, + [{c,product, + [{c,atom,[false,true],unknown}, + {c,atom,[false,true],unknown}], + unknown}, + {c,atom,[false,true],unknown}], + unknown}] + }, + { + {erlang,'=/=',2}, + [{c,function, + [{c,product,[any,any],unknown}, + {c,atom,[false,true],unknown}], + unknown}] + }, + { + {erlang,'==',2}, + [{c,function, + [{c,product,[any,any],unknown}, + {c,atom,[false,true],unknown}], + unknown}] + }, + { + {erlang,'/=',2}, + [{c,function, + [{c,product,[any,any],unknown}, + {c,atom,[false,true],unknown}], + unknown}] + }, + { + {erlang,hd,1}, + [{c,function, + [{c,product, + [{c,list,[any,{c,nil,[],unknown}],nonempty}], + unknown}, + any], + unknown}] + }, + { + {erlang,tl,1}, + [{c,function, + [{c,product, + [{c,list,[any,{c,nil,[],unknown}],nonempty}], + unknown}, + any], + unknown}] + }, + { + {erlang,'++',2}, + [{c,function, + [{c,product, + [{c,list,[any,{c,nil,[],unknown}],unknown}, + {c,list,[any,{c,nil,[],unknown}],unknown}], + unknown}, + {c,list,[any,{c,nil,[],unknown}],unknown}], + unknown}] + }, + { + {lists,reverse,2}, + [{c,function, + [{c,product, + [{c,list,[any,{c,nil,[],unknown}],unknown}, + {c,list,[any,{c,nil,[],unknown}],unknown}], + unknown}, + {c,list,[any,{c,nil,[],unknown}],unknown}], + unknown}] + }, + { + {lists,member,2}, + [{c,function, + [{c,product, + [any,{c,list,[any,{c,nil,[],unknown}],unknown}], + unknown}, + {c,atom,[false,true],unknown}], + unknown}] + }, + { + {erlang,is_integer,1}, + [{c,function, + [{c,product,[any],unknown},{c,atom,[false,true],unknown}], + unknown}] + }, + { + {erlang,is_atom,1}, + [{c,function, + [{c,product,[any],unknown},{c,atom,[false,true],unknown}], + unknown}] + }, + { + {erlang,is_function,1}, + [{c,function, + [{c,product,[any],unknown},{c,atom,[false,true],unknown}], + unknown}] + }, + { + {erlang,is_function,2}, + [{c,function, + [{c,product, + [any,{c,number,{int_rng,1,255},integer}], + unknown}, + {c,atom,[false,true],unknown}], + unknown}] + } + ] + ), + TSM. diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 06f9532c..de388dc2 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -23,6 +23,8 @@ -export([erl_type_deps_map/2, get_type_name_from_type_dep/1, get_type_from_type_dep/1, unique_type_name/3]). +-export([parse_specs/1]). + -export_type([erl_type/0, erl_spec_clause/0, erl_spec/0, stored_specs/0, stored_types/0, stored_spec_value/0, t_range_limit/0]). -export_type([erl_type_dep/0, erl_type_deps/0]). @@ -1209,3 +1211,219 @@ get_type_name_from_type_dep({Name, _Type}) -> -spec get_type_from_type_dep(erl_type_dep()) -> erl_type(). get_type_from_type_dep({_Name, Type}) -> Type. + +%% ---------------------------------------------------------------------------- +%% API for erl_types:erl_type(). +%% Here a fix point computation is defined which converts all specs in a list +%% of modules to their erl_type representation +%% ---------------------------------------------------------------------------- + +var_name({var, _, X}) -> + X. + +-spec parse_specs(list({module(), cerl:cerl()})) -> dict:dict(). +parse_specs(CodeList) -> + RecDict = ets:new(recdict, []), + ExpTypes = sets:from_list(lists:append([lists:append([[{Mod, Tname, Tarity} || {Tname, Tarity} <- T] || {{c_literal, _, export_type}, {c_literal, _, T}} <- cerl:module_attrs(M)]) || {Mod, M} <- CodeList])), + Unhandled = lists:foldl( + fun ({Mod, M}, Acc) -> + TypesLines = all_types_from_cerl(M), + U = sets:from_list([{TName, length(Vars)} || {{TName, _T, Vars}, _L} <- TypesLines]), + dict:store(Mod, U, Acc) + end, + dict:new(), + CodeList), + Ret = parse_specs_fix(CodeList, ExpTypes, RecDict, Unhandled, CodeList, false, dict:new()), + ets:delete(RecDict), + Ret. + + +parse_specs_fix([], ExpTypes, RecDict, Unhandled, All, true, GatheredSpecs) -> parse_specs_fix(All, ExpTypes, RecDict, Unhandled, All, false, GatheredSpecs); +parse_specs_fix([], _ExpTypes, _RecDict, _Unhandled, _All, false, GatheredSpecs) -> GatheredSpecs; +parse_specs_fix([{Mod, M}|Mods], ExpTypes, RecDict, Unhandled, All, Acc, GatheredSpecs) -> + PrevUnhandled = dict:fetch(Mod, Unhandled), + {Specs, NewUnhandled} = parse_mod_specs(Mod, M, ExpTypes, RecDict, PrevUnhandled), + GatheredSpecs1 = lists:foldl( + fun ({MFA, Spec}, G) -> + dict:store(MFA, Spec, G) + end, + GatheredSpecs, + Specs), + case equal_sets(NewUnhandled, PrevUnhandled) of + true -> parse_specs_fix(Mods, ExpTypes, RecDict, Unhandled, All, Acc, GatheredSpecs1); + false -> parse_specs_fix(Mods, ExpTypes, RecDict, dict:store(Mod, NewUnhandled, Unhandled), All, true, GatheredSpecs1) + end. + +parse_mod_specs(Mod, M, ExpTypes, RecDict, PrevUnhandled) -> + TypesLines = all_types_from_cerl(M), + Specs1 = lists:append([Spec || {{c_literal, _, spec}, {c_literal, _, Spec}} <- cerl:module_attrs(M)]), + Unhandled = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled), + Specs = lists:map( + fun ({{F, A}, S1}) -> + S = spec_replace_records(spec_replace_bounded(S1)), + ErlSpecs = convert_list_to_erl(S, {Mod, F, A}, ExpTypes, RecDict), + {{Mod, F, A}, ErlSpecs} + end, + Specs1), + {Specs, Unhandled}. + +fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled) -> + F = fun ({{Tname, T, Vars}, L}, Acc) -> + A = length(Vars), + {{T1, _C}, D1} = + try erl_types:t_from_form(T, ExpTypes, {'type', {Mod, Tname, A}}, RecDict, erl_types:var_table__new(), erl_types:cache__new()) of + Ret -> {Ret, false} + catch + _:_ -> + {{none, none}, true} + end, + case D1 of + false -> + case ets:lookup(RecDict, Mod) of + [{Mod, VT}] -> + ets:insert(RecDict, {Mod, maps:put({'type', Tname, A}, {{Mod, {lists:append(atom_to_list(Mod), ".erl"), L}, T, [var_name(Var) || Var <- Vars]}, T1}, VT)}), + Acc; + _ -> + ets:insert(RecDict, {Mod, maps:put({'type', Tname, A}, {{Mod, {lists:append(atom_to_list(Mod), ".erl"), L}, T, [var_name(Var) || Var <- Vars]}, T1}, maps:new())}), + Acc + end; + true -> + sets:add_element({Tname, A}, Acc) + end + end, + D = lists:foldl(F, sets:new(), TypesLines), + case equal_sets(PrevUnhandled, D) of + false -> + fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, D); + true -> + D + end. + +convert_list_to_erl(S, MFA, ExpTypes, RecDict) -> + convert_list_to_erl(S, MFA, ExpTypes, RecDict, []). + +convert_list_to_erl([], _MFA, _ExpTypes, _RecDict, Acc) -> lists:reverse(Acc); +convert_list_to_erl([Spec|Specs], MFA, ExpTypes, RecDict, Acc) -> + ErlSpec = + try erl_types:t_from_form(Spec, ExpTypes, {'spec', MFA}, RecDict, erl_types:var_table__new(), erl_types:cache__new()) of + {S, _C} -> S + catch + _:_ -> nospec + end, + case ErlSpec of + nospec -> + convert_list_to_erl(Specs, MFA, ExpTypes, RecDict, Acc); + _ -> + convert_list_to_erl(Specs, MFA, ExpTypes, RecDict, [ErlSpec|Acc]) + end. + +equal_sets(A, B) -> + sets:size(A) == sets:size(B) andalso sets:size(sets:union(A, B)) == sets:size(B). + +all_types_from_cerl(M) -> + TypesOpaques = [{type_replace_records(Type), Line} || {{c_literal, _, TypeClass}, {c_literal, [Line|_], [Type]}} <- cerl:module_attrs(M), TypeClass =:= type orelse TypeClass =:= opaque], + Records = records_as_types(M), + lists:append(TypesOpaques, Records). + +type_replace_records({Name, Type, Args}) -> + {Name, replace_records(Type), Args}. + +spec_replace_records(FunSpecs) -> + Fn = fun({type, Line, F, L}) -> + {type, Line, F, lists:map(fun replace_records/1, L)} + end, + lists:map(Fn, FunSpecs). + +replace_records({type, L, record, [{atom, _, Name}]}) -> + {user_type, L, record_name(Name), []}; +replace_records({T, L, Type, Args}) when T =:= type orelse T =:= user_type -> + case is_list(Args) of + true -> + {T, L, Type, lists:map(fun replace_records/1, Args)}; + false -> + {T, L, Type, Args} + end; +replace_records(Rest) -> Rest. + +records_as_types(M) -> + R = [{RecName, Line, RecFields} || {{c_literal, [Line], record}, {c_literal, _, [{RecName, RecFields}]}} <- cerl:module_attrs(M)], + lists:map(fun type_from_record/1, R). + +type_from_record({Name, Line, Fields}) -> + Fn = fun ({typed_record_field, _, T}) -> + replace_records(T) + end, + NewFields = lists:map(Fn, Fields), + NewName = record_name(Name), + RecType = {type, Line, tuple, [{atom, Line, Name} | NewFields]}, + {{NewName, RecType, []}, Line}. + +record_name(Name) -> + list_to_atom(atom_to_list(Name) ++ "RECORDTYPE"). + +spec_replace_bounded(Specs) -> lists:map(fun handle_bounded_fun/1, Specs). + +handle_bounded_fun({type, _L, 'fun', _Rest} = S) -> S; +handle_bounded_fun({type, _, 'bounded_fun', [Spec, Constraints]} = S) -> + Fn = fun({type, _, constraint, [{atom, _, is_subtype}, [Key, Value]]}, D) -> + dict:store(element(3, Key), Value, D) + end, + D = lists:foldl(Fn, dict:new(), Constraints), + {D1, Rec} = fix_update_vars(D), + case Rec of + true -> + make_normal_spec(Spec, D1); + false -> + S + end. + +replace_vars({type, L, record, R}, _D) -> {{type, L, record, R}, false}; +replace_vars({T, L, Type, Args}, D) when is_list(Args) -> + Fn = fun(Arg) -> replace_vars(Arg, D) end, + {NewArgs, Changes} = lists:unzip(lists:map(Fn, Args)), + Change = lists:foldl(fun erlang:'or'/2, false, Changes), + {{T, L, Type, NewArgs}, Change}; +replace_vars({var, _L, Name}, D) -> + case dict:find(Name, D) of + {ok, T} -> + {T, true}; + error -> + {any, true} + end; +replace_vars({ann_type, _L, [_T, T1]}, D) -> + {T2, _C} = replace_vars(T1, D), + {T2, true}; +replace_vars(Rest, _D) -> {Rest, false}. + +fix_update_vars(D) -> + fix_update_vars(D, dict:size(D) + 1, 0). + +fix_update_vars(D, Lim, Depth) -> + Keys = dict:fetch_keys(D), + Fn = fun(Key, {Acc1, Acc2}) -> + T = dict:fetch(Key, D), + {NewT, C} = replace_vars(T, D), + case C of + true -> + {dict:store(Key, NewT, Acc1), true}; + false -> + {Acc1, Acc2} + end + end, + {NewD, Change} = lists:foldl(Fn, {D, false}, Keys), + case Change of + true -> + case Depth > Lim of + true -> + {rec, false}; + false -> + fix_update_vars(NewD, Lim, Depth + 1) + end; + false -> + {NewD, true} + end. + +make_normal_spec({type, L, 'fun', [Args, Range]}, D) -> + {NewArgs, _C1} = replace_vars(Args, D), + {NewRange, _C2} = replace_vars(Range, D), + {type, L, 'fun', [NewArgs, NewRange]}. diff --git a/test/ftest/src/reduce_search_space.erl b/test/ftest/src/reduce_search_space.erl index 3f82d55f..cb3c264c 100644 --- a/test/ftest/src/reduce_search_space.erl +++ b/test/ftest/src/reduce_search_space.erl @@ -1,5 +1,5 @@ -module(reduce_search_space). --export([f/1]). +-export([f/1, f6/1, f7/2, f9/1]). %% Functions that showcase situations where we can prune %% the search space of executions. @@ -23,3 +23,92 @@ h(6) -> 1; h(1) -> 7; h(3) -> 5; h(_) -> 23. + + +%% Tests f1-f6 compose a graph if f6 is called. Testing f6 tests the integrity +%% of the callgraph calculation and transformation + +f1(X) -> % error-free + case X of + 3 -> + f2(2); + 2 -> + f2(1); + _ -> 1 + end. + +f2(X) -> % error-free + case X of + 3 -> + f1(2); + 2 -> + f1(1); + _ -> 1 + end. + +f3(X) -> % possibly-erroneous + case X of + 3 -> + f4(2); + 2 -> + f4(1); + 1 -> 1 + end. + +f4(X) -> % possibly-erroneous + case X of + 3 -> + f4(2); + 2 -> + f3(1); + 1 -> 1 + end. + +f5(X) -> % possibly-erroneous + case f1(X) of + 1 -> + f3(X); + _ -> 1 + end. + +f6(X) -> + case f5(X) of + 1 -> + g(X); + _ -> 1 + end. + +f7(X, Y) -> % possibly-erroneous + case f8(X) of % this call to f8 should not be pruned + 1 -> f8(Y); % this one should + _ -> error("error") + end. + +f8(X) -> % error-free + case X of + 1 -> 1; + 2 -> 2; + _ -> 1 + end. + +-spec f9(integer()) -> boolean(). +f9(X) -> % error free + f9(X, []). + +-spec f9(integer(), [integer()]) -> boolean(). +f9(X, Found) -> + case X of + 1 -> true; + _ -> + case lists:member(X, Found) of + false -> + case X rem 2 of + 0 -> + f9(X div 2, [X|Found]); + _ -> + f9(3 * X + 1, [X|Found]) + end; + true -> + false + end + end. diff --git a/test/ftests.json b/test/ftests.json index aeca4bda..748b4eac 100644 --- a/test/ftests.json +++ b/test/ftests.json @@ -1243,14 +1243,52 @@ "depth": "25", "errors": true, "arity": 1, + "opts": "-ps --disable-pmatch", "solutions": [ "[3]" ], "solver": { - "SAT": 3, - "UNSAT": 6 + "SAT": 3 }, "skip": false + }, + { + "module": "reduce_search_space", + "function": "f6", + "args": "[0]", + "depth": "25", + "errors": true, + "nondeterministic": true, + "arity": 1, + "opts": "-ps --disable-pmatch", + "solutions": [ + "$1 != 1 and $1 != 2 and $1 != 3" + ], + "skip": false + }, + { + "module": "reduce_search_space", + "function": "f7", + "args": "[0, 0]", + "depth": "25", + "errors": true, + "nondeterministic": true, + "arity": 2, + "opts": "-ps --disable-pmatch", + "solutions": [ + "$1 == 2" + ], + "skip": false + }, + { + "module": "reduce_search_space", + "function": "f9", + "args": "[10]", + "depth": "25", + "errors": false, + "arity": 1, + "opts": "-ps --disable-pmatch", + "skip": false } ] } From c702f3bf3d25f12bec4cd41727a4a6c43ed1be43 Mon Sep 17 00:00:00 2001 From: Dspil Date: Sat, 22 Jan 2022 17:47:34 +0200 Subject: [PATCH 02/85] kmodule api refactor --- src/cuter_cerl.erl | 49 +++++++++++++++++++++++++++++++--------- src/cuter_codeserver.erl | 14 +++++++----- src/cuter_types.erl | 42 ++++++++++++++++++---------------- 3 files changed, 68 insertions(+), 37 deletions(-) diff --git a/src/cuter_cerl.erl b/src/cuter_cerl.erl index 69e53bc1..b9545abe 100644 --- a/src/cuter_cerl.erl +++ b/src/cuter_cerl.erl @@ -16,7 +16,7 @@ %% kfun API. -export([kfun/2, kfun_code/1, kfun_is_exported/1, kfun_update_code/2]). %% kmodule API. --export([destroy_kmodule/1, kmodule/6, kmodule_kfun/2, kmodule_mfa_spec/2, +-export([kmodule_spec_forms/1, kmodule_record_forms/1, kmodule_type_forms/1, kmodule_exported_types/1, kmodule_name/1, destroy_kmodule/1, kmodule/3, kmodule_kfun/2, kmodule_mfa_spec/2, kmodule_specs/1, kmodule_types/1, kmodule_ast/1, kmodule_update_kfun/3, kmodule_mfas_with_kfuns/1, kmodule_specs_forms/1, kmodule_mfas_with_specs_forms/1]). @@ -164,13 +164,7 @@ load(M, TagGen, WithPmatch) -> case get_core(M, WithPmatch) of {ok, #c_module{}=AST} -> % just a sanity check that we get back a module - Exports = extract_exports(M, AST), - {TypeAttrs, SpecAttrs} = classify_attributes(cerl:module_attrs(AST)), - Types = cuter_types:retrieve_types(TypeAttrs), - Specs = cuter_types:retrieve_specs(SpecAttrs), - Defs = cerl:module_defs(AST), - Funs = [process_fundef(D, Exports, M, TagGen) || D <- Defs], - {ok, kmodule(M, AST, Types, Specs, Funs, SpecAttrs)}; + {ok, kmodule(M, AST, TagGen)}; {error, _} = Error -> Error end. @@ -178,22 +172,45 @@ load(M, TagGen, WithPmatch) -> %% kmodule API %% ------------------------------------------------------------------- --spec kmodule(module(), cerl:cerl(), cuter_types:stored_types(), cuter_types:stored_specs(), [{mfa(), kfun()}], [spec_info()]) -> kmodule(). -kmodule(M, AST, Types, Specs, Funs, SpecsForms) -> +-spec kmodule(module(), cerl:cerl(), tag_generator()) -> kmodule(). +kmodule(M, AST, TagGen) -> Kmodule = ets:new(M, [ordered_set, protected]), + Exports = extract_exports(M, AST), + {TypeAttrs, SpecAttrs} = classify_attributes(cerl:module_attrs(AST)), + Types = cuter_types:retrieve_types(TypeAttrs), + Specs = cuter_types:retrieve_specs(SpecAttrs), + Defs = cerl:module_defs(AST), + Funs = [process_fundef(D, Exports, M, TagGen) || D <- Defs], ets:insert(Kmodule, {ast, AST}), ets:insert(Kmodule, {name, M}), ets:insert(Kmodule, {types, Types}), ets:insert(Kmodule, {specs, Specs}), - ets:insert(Kmodule, {specs_forms, SpecsForms}), + ets:insert(Kmodule, {specs_forms, SpecAttrs}), lists:foreach(fun({Mfa, Kfun}) -> ets:insert(Kmodule, {Mfa, Kfun}) end, Funs), Kmodule. +-spec kmodule_exported_types(kmodule()) -> sets:set({module(), atom(), arity()}). +kmodule_exported_types(Kmodule) -> + M = kmodule_ast(Kmodule), + Mod = kmodule_name(Kmodule), + Filtered = [T || {{c_literal, _, export_type}, {c_literal, _, T}} <- cerl:module_attrs(M)], + sets:from_list(lists:append([{Mod, Tname, Tarity} || {Tname, Tarity} <- Filtered])). + +-spec kmodule_spec_forms(kmodule()) -> [cerl:cerl()]. +kmodule_spec_forms(Kmodule) -> + M = kmodule_ast(Kmodule), + [S || {{c_literal, _, spec}, _}=S <- cerl:module_attrs(M)]. + -spec kmodule_ast(kmodule()) -> cerl:cerl(). kmodule_ast(Kmodule) -> [{ast, AST}] = ets:lookup(Kmodule, ast), AST. +-spec kmodule_name(kmodule()) -> module(). +kmodule_name(Kmodule) -> + [{name, Name}] = ets:lookup(Kmodule, name), + Name. + -spec kmodule_specs(kmodule()) -> cuter_types:stored_specs(). kmodule_specs(Kmodule) -> [{specs, Specs}] = ets:lookup(Kmodule, specs), @@ -204,6 +221,16 @@ kmodule_types(Kmodule) -> [{types, Types}] = ets:lookup(Kmodule, types), Types. +-spec kmodule_type_forms(kmodule()) -> [cerl:cerl()]. +kmodule_type_forms(Kmodule) -> + AST = kmodule_ast(Kmodule), + [T || {{c_literal, _, TC}, _}=T <- cerl:module_attrs(AST), TC =:= type orelse TC =:= opaque]. + +-spec kmodule_record_forms(kmodule()) -> [cerl:cerl()]. +kmodule_record_forms(Kmodule) -> + AST = kmodule_ast(Kmodule), + [R || {{c_literal, _, record}, _}=R <- cerl:module_attrs(AST)]. + %% Retrieves the kfun() for the given MFA. -spec kmodule_kfun(kmodule(), mfa()) -> {ok, kfun()} | error. kmodule_kfun(Kmodule, Mfa) -> diff --git a/src/cuter_codeserver.erl b/src/cuter_codeserver.erl index 9946097b..db321ca9 100644 --- a/src/cuter_codeserver.erl +++ b/src/cuter_codeserver.erl @@ -241,17 +241,19 @@ handle_call({calculate_callgraph, Mfas}, _From, State=#st{whitelist = Whitelist} {reply, ok, State#st{callgraph = Callgraph}} end; handle_call(annotate_for_possible_errors, _From, State=#st{db = Db}) -> - Fn = fun({M, Kmodule}, {KfunAcc, AstAcc}) -> + Fn = fun({_M, Kmodule}, KfunAcc) -> KfunMappings = cuter_cerl:kmodule_mfas_with_kfuns(Kmodule), TrivialMergeFn = fun(_K, V1, _V2) -> V1 end, - KfunAcc1 = dict:merge(TrivialMergeFn, KfunAcc, KfunMappings), - AstAcc1 = [{M, cuter_cerl:kmodule_ast(Kmodule)}|AstAcc], - {KfunAcc1, AstAcc1} + dict:merge(TrivialMergeFn, KfunAcc, KfunMappings) end, + Fn2 = fun({_M, Kmodule}, Acc) -> + [Kmodule|Acc] + end, + Kmodules = ets:foldl(Fn2, [], Db), {ok, EntryPoint} = cuter_config:fetch(?ENTRY_POINT), - {MfasToKfuns, CodeList} = ets:foldl(Fn, {dict:new(), []}, Db), + MfasToKfuns = ets:foldl(Fn, dict:new(), Db), %io:format("Before Specs~n"), - MfasToSpecs = cuter_types:parse_specs(CodeList), + MfasToSpecs = cuter_types:parse_specs(Kmodules), UpdatedKfuns = cuter_maybe_error_annotation:preprocess(EntryPoint, MfasToKfuns, MfasToSpecs, true), RFn = fun({M, F, A}, Kfun, _Acc) -> [{_M, Kmodule}] = ets:lookup(Db, M), diff --git a/src/cuter_types.erl b/src/cuter_types.erl index de388dc2..2b64356d 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1221,28 +1221,29 @@ get_type_from_type_dep({_Name, Type}) -> var_name({var, _, X}) -> X. --spec parse_specs(list({module(), cerl:cerl()})) -> dict:dict(). -parse_specs(CodeList) -> +-spec parse_specs([cuter_cerl:kmodule()]) -> dict:dict(). +parse_specs(Kmodules) -> RecDict = ets:new(recdict, []), - ExpTypes = sets:from_list(lists:append([lists:append([[{Mod, Tname, Tarity} || {Tname, Tarity} <- T] || {{c_literal, _, export_type}, {c_literal, _, T}} <- cerl:module_attrs(M)]) || {Mod, M} <- CodeList])), + ExpTypes = sets:union([cuter_cerl:kmodule_exported_types(M) || M <- Kmodules]), Unhandled = lists:foldl( - fun ({Mod, M}, Acc) -> - TypesLines = all_types_from_cerl(M), + fun (Kmodule, Acc) -> + Mod = cuter_cerl:kmodule_name(Kmodule), + TypesLines = all_types_from_cerl(Kmodule), U = sets:from_list([{TName, length(Vars)} || {{TName, _T, Vars}, _L} <- TypesLines]), dict:store(Mod, U, Acc) end, dict:new(), - CodeList), - Ret = parse_specs_fix(CodeList, ExpTypes, RecDict, Unhandled, CodeList, false, dict:new()), + Kmodules), + Ret = parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, Kmodules, false, dict:new()), ets:delete(RecDict), Ret. - parse_specs_fix([], ExpTypes, RecDict, Unhandled, All, true, GatheredSpecs) -> parse_specs_fix(All, ExpTypes, RecDict, Unhandled, All, false, GatheredSpecs); parse_specs_fix([], _ExpTypes, _RecDict, _Unhandled, _All, false, GatheredSpecs) -> GatheredSpecs; -parse_specs_fix([{Mod, M}|Mods], ExpTypes, RecDict, Unhandled, All, Acc, GatheredSpecs) -> +parse_specs_fix([Kmodule|Kmodules], ExpTypes, RecDict, Unhandled, All, Acc, GatheredSpecs) -> + Mod = cuter_cerl:kmodule_name(Kmodule), PrevUnhandled = dict:fetch(Mod, Unhandled), - {Specs, NewUnhandled} = parse_mod_specs(Mod, M, ExpTypes, RecDict, PrevUnhandled), + {Specs, NewUnhandled} = parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled), GatheredSpecs1 = lists:foldl( fun ({MFA, Spec}, G) -> dict:store(MFA, Spec, G) @@ -1250,13 +1251,14 @@ parse_specs_fix([{Mod, M}|Mods], ExpTypes, RecDict, Unhandled, All, Acc, Gathere GatheredSpecs, Specs), case equal_sets(NewUnhandled, PrevUnhandled) of - true -> parse_specs_fix(Mods, ExpTypes, RecDict, Unhandled, All, Acc, GatheredSpecs1); - false -> parse_specs_fix(Mods, ExpTypes, RecDict, dict:store(Mod, NewUnhandled, Unhandled), All, true, GatheredSpecs1) + true -> parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, All, Acc, GatheredSpecs1); + false -> parse_specs_fix(Kmodules, ExpTypes, RecDict, dict:store(Mod, NewUnhandled, Unhandled), All, true, GatheredSpecs1) end. -parse_mod_specs(Mod, M, ExpTypes, RecDict, PrevUnhandled) -> - TypesLines = all_types_from_cerl(M), - Specs1 = lists:append([Spec || {{c_literal, _, spec}, {c_literal, _, Spec}} <- cerl:module_attrs(M)]), +parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled) -> + TypesLines = all_types_from_cerl(Kmodule), + Mod = cuter_cerl:kmodule_name(Kmodule), + Specs1 = lists:append([Spec || {_, {c_literal, _, Spec}} <- cuter_cerl:kmodule_spec_forms(Kmodule)]), Unhandled = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled), Specs = lists:map( fun ({{F, A}, S1}) -> @@ -1320,9 +1322,9 @@ convert_list_to_erl([Spec|Specs], MFA, ExpTypes, RecDict, Acc) -> equal_sets(A, B) -> sets:size(A) == sets:size(B) andalso sets:size(sets:union(A, B)) == sets:size(B). -all_types_from_cerl(M) -> - TypesOpaques = [{type_replace_records(Type), Line} || {{c_literal, _, TypeClass}, {c_literal, [Line|_], [Type]}} <- cerl:module_attrs(M), TypeClass =:= type orelse TypeClass =:= opaque], - Records = records_as_types(M), +all_types_from_cerl(Kmodule) -> + TypesOpaques = [{type_replace_records(Type), Line} || {_, {c_literal, [Line|_], [Type]}} <- cuter_cerl:kmodule_type_forms(Kmodule)], + Records = records_as_types(Kmodule), lists:append(TypesOpaques, Records). type_replace_records({Name, Type, Args}) -> @@ -1345,8 +1347,8 @@ replace_records({T, L, Type, Args}) when T =:= type orelse T =:= user_type -> end; replace_records(Rest) -> Rest. -records_as_types(M) -> - R = [{RecName, Line, RecFields} || {{c_literal, [Line], record}, {c_literal, _, [{RecName, RecFields}]}} <- cerl:module_attrs(M)], +records_as_types(Kmodule) -> + R = [{RecName, Line, RecFields} || {{c_literal, [Line], record}, {c_literal, _, [{RecName, RecFields}]}} <- cuter_cerl:kmodule_record_forms(Kmodule)], lists:map(fun type_from_record/1, R). type_from_record({Name, Line, Fields}) -> From 956d5ae8a8ffff296e346a11bf5d79f611d7325f Mon Sep 17 00:00:00 2001 From: Dspil Date: Sat, 22 Jan 2022 18:47:01 +0200 Subject: [PATCH 03/85] kmodule api updated --- src/cuter_cerl.erl | 56 +++++++++++++++++++++------------------- src/cuter_codeserver.erl | 1 + src/cuter_types.erl | 11 ++++---- 3 files changed, 35 insertions(+), 33 deletions(-) diff --git a/src/cuter_cerl.erl b/src/cuter_cerl.erl index b9545abe..896cc9ad 100644 --- a/src/cuter_cerl.erl +++ b/src/cuter_cerl.erl @@ -17,8 +17,8 @@ -export([kfun/2, kfun_code/1, kfun_is_exported/1, kfun_update_code/2]). %% kmodule API. -export([kmodule_spec_forms/1, kmodule_record_forms/1, kmodule_type_forms/1, kmodule_exported_types/1, kmodule_name/1, destroy_kmodule/1, kmodule/3, kmodule_kfun/2, kmodule_mfa_spec/2, - kmodule_specs/1, kmodule_types/1, kmodule_ast/1, kmodule_update_kfun/3, kmodule_mfas_with_kfuns/1, kmodule_specs_forms/1, - kmodule_mfas_with_specs_forms/1]). + kmodule_specs/1, kmodule_types/1, kmodule_ast/1, kmodule_update_kfun/3, kmodule_mfas_with_kfuns/1, + kmodule_mfas_with_spec_forms/1]). %% We are using the records representation of Core Erlang Abstract Syntax Trees -include_lib("compiler/src/core_parse.hrl"). @@ -176,6 +176,7 @@ load(M, TagGen, WithPmatch) -> kmodule(M, AST, TagGen) -> Kmodule = ets:new(M, [ordered_set, protected]), Exports = extract_exports(M, AST), + Attrs = cerl:module_attrs(AST), {TypeAttrs, SpecAttrs} = classify_attributes(cerl:module_attrs(AST)), Types = cuter_types:retrieve_types(TypeAttrs), Specs = cuter_types:retrieve_specs(SpecAttrs), @@ -185,21 +186,16 @@ kmodule(M, AST, TagGen) -> ets:insert(Kmodule, {name, M}), ets:insert(Kmodule, {types, Types}), ets:insert(Kmodule, {specs, Specs}), - ets:insert(Kmodule, {specs_forms, SpecAttrs}), + ets:insert(Kmodule, {spec_forms, SpecAttrs}), + ets:insert(Kmodule, {exported_types, extract_exported_types(M, Attrs)}), + ets:insert(Kmodule, {type_forms, TypeAttrs}), lists:foreach(fun({Mfa, Kfun}) -> ets:insert(Kmodule, {Mfa, Kfun}) end, Funs), Kmodule. -spec kmodule_exported_types(kmodule()) -> sets:set({module(), atom(), arity()}). kmodule_exported_types(Kmodule) -> - M = kmodule_ast(Kmodule), - Mod = kmodule_name(Kmodule), - Filtered = [T || {{c_literal, _, export_type}, {c_literal, _, T}} <- cerl:module_attrs(M)], - sets:from_list(lists:append([{Mod, Tname, Tarity} || {Tname, Tarity} <- Filtered])). - --spec kmodule_spec_forms(kmodule()) -> [cerl:cerl()]. -kmodule_spec_forms(Kmodule) -> - M = kmodule_ast(Kmodule), - [S || {{c_literal, _, spec}, _}=S <- cerl:module_attrs(M)]. + [{exported_types, ExpTypes}] = ets:lookup(Kmodule, exported_types), + ExpTypes. -spec kmodule_ast(kmodule()) -> cerl:cerl(). kmodule_ast(Kmodule) -> @@ -223,13 +219,13 @@ kmodule_types(Kmodule) -> -spec kmodule_type_forms(kmodule()) -> [cerl:cerl()]. kmodule_type_forms(Kmodule) -> - AST = kmodule_ast(Kmodule), - [T || {{c_literal, _, TC}, _}=T <- cerl:module_attrs(AST), TC =:= type orelse TC =:= opaque]. + [{type_forms, TypeForms}] = ets:lookup(Kmodule, type_forms), + TypeForms. -spec kmodule_record_forms(kmodule()) -> [cerl:cerl()]. kmodule_record_forms(Kmodule) -> - AST = kmodule_ast(Kmodule), - [R || {{c_literal, _, record}, _}=R <- cerl:module_attrs(AST)]. + [{type_forms, TypeForms}] = ets:lookup(Kmodule, type_forms), + TypeForms. %% Retrieves the kfun() for the given MFA. -spec kmodule_kfun(kmodule(), mfa()) -> {ok, kfun()} | error. @@ -263,15 +259,15 @@ kmodule_mfas_with_kfuns(Kmodule) -> is_mfa({M, F, A}) when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> true; is_mfa(_Mfa) -> false. --spec kmodule_specs_forms(kmodule()) -> [spec_info()]. -kmodule_specs_forms(Kmodule) -> - [{specs_forms, SpecsForms}] = ets:lookup(Kmodule, specs_forms), +-spec kmodule_spec_forms(kmodule()) -> [cerl:cerl()]. +kmodule_spec_forms(Kmodule) -> + [{spec_forms, SpecsForms}] = ets:lookup(Kmodule, spec_forms), SpecsForms. --spec kmodule_mfas_with_specs_forms(kmodule()) -> dict:dict(mfa(), any()). -kmodule_mfas_with_specs_forms(Kmodule) -> +-spec kmodule_mfas_with_spec_forms(kmodule()) -> dict:dict(mfa(), any()). +kmodule_mfas_with_spec_forms(Kmodule) -> [{name, M}] = ets:lookup(Kmodule, name), - SpecsForms = kmodule_specs_forms(Kmodule), + SpecsForms = kmodule_spec_forms(Kmodule), Fn = fun({{F, A}, Spec}, Acc) -> dict:store({M, F, A}, Spec, Acc) end, @@ -307,6 +303,10 @@ extract_exports(M, AST) -> Exports = cerl:module_exports(AST), [mfa_from_var(M, E) || E <- Exports]. +extract_exported_types(Mod, Attrs) -> + Filtered = [T || {#c_literal{val = export_type}, #c_literal{val = T}} <- Attrs], + sets:from_list(lists:append([{Mod, Tname, Tarity} || {Tname, Tarity} <- Filtered])). + -spec process_fundef({cerl:c_var(), code()}, [mfa()], module(), tag_generator()) -> {mfa(), kfun()}. process_fundef({FunVar, Def}, Exports, M, TagGen) -> Mfa = mfa_from_var(M, FunVar), @@ -359,7 +359,7 @@ get_abstract_code(Mod, Beam) -> _ -> throw(cuter_pp:abstract_code_missing(Mod)) end. --type type_info() :: {'type', cerl_typedef()} +-type type_info() :: {'type', integer(), cerl_typedef()} | {'record', cerl_recdef()}. -type spec_info() :: cerl_attr_spec(). -type classify_attr_ret() :: {[type_info()], [spec_info()]}. @@ -371,19 +371,21 @@ classify_attributes(Attrs) -> -spec classify_attributes([cerl_attr()], [type_info()], [spec_info()]) -> classify_attr_ret(). classify_attributes([], Types, Specs) -> {lists:reverse(Types), lists:reverse(Specs)}; -classify_attributes([{What, #c_literal{val = Val}}|Attrs], Types, Specs) -> +classify_attributes([{What, #c_literal{val = Val}=A}|Attrs], Types, Specs) -> case cerl:atom_val(What) of Tp when Tp =:= type orelse Tp =:= opaque -> [V] = Val, + Line = hd(cerl:get_ann(A)), case V of {{record, Name}, Fields, []} -> % for OTP 18.x and earlier - classify_attributes(Attrs, [{record, {Name, Fields}}|Types], Specs); + classify_attributes(Attrs, [{record, Line, {Name, Fields}}|Types], Specs); _ -> - classify_attributes(Attrs, [{type, V}|Types], Specs) + classify_attributes(Attrs, [{type, Line, V}|Types], Specs) end; record -> % for OTP 19.x and newer + Line = hd(cerl:get_ann(A)), [V] = Val, - classify_attributes(Attrs, [{record, V}|Types], Specs); + classify_attributes(Attrs, [{record, Line, V}|Types], Specs); spec -> [V] = Val, classify_attributes(Attrs, Types, [V|Specs]); diff --git a/src/cuter_codeserver.erl b/src/cuter_codeserver.erl index db321ca9..f4b25f0d 100644 --- a/src/cuter_codeserver.erl +++ b/src/cuter_codeserver.erl @@ -260,6 +260,7 @@ handle_call(annotate_for_possible_errors, _From, State=#st{db = Db}) -> cuter_cerl:kmodule_update_kfun(Kmodule, {M, F, A}, Kfun) end, dict:fold(RFn, ok, UpdatedKfuns), + %io:format("spec: ~p~n", [dict:find(EntryPoint, MfasToSpecs)]), %io:format("ast: ~p~n", [cuter_cerl:kfun_code(dict:fetch(EntryPoint, UpdatedKfuns))]), {reply, ok, State}. diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 2b64356d..2fef2edb 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -218,7 +218,7 @@ retrieve_types(TypeAttrs) -> -spec process_type_attr(cuter_cerl:type_info(), stored_types()) -> stored_types(). %% Processes the declaration of a record. -process_type_attr({record, {Name, Fields}}, Processed) -> +process_type_attr({record, _Line, {Name, Fields}}, Processed) -> %% Process each field of the record. Fs = [t_field_from_form(Field) || Field <- Fields], %% Construct the representation of the record. @@ -226,7 +226,7 @@ process_type_attr({record, {Name, Fields}}, Processed) -> %% Store the record in the proccessed dict. dict:store({record, Name}, Record, Processed); %% Processes the declaration of a type. -process_type_attr({type, {Name, Repr, Vars}}, Processed) -> +process_type_attr({type, _Line, {Name, Repr, Vars}}, Processed) -> %% Process the type's representation. Type = safe_t_from_form(Repr), %% Parse the type parameters. @@ -1258,7 +1258,6 @@ parse_specs_fix([Kmodule|Kmodules], ExpTypes, RecDict, Unhandled, All, Acc, Gath parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled) -> TypesLines = all_types_from_cerl(Kmodule), Mod = cuter_cerl:kmodule_name(Kmodule), - Specs1 = lists:append([Spec || {_, {c_literal, _, Spec}} <- cuter_cerl:kmodule_spec_forms(Kmodule)]), Unhandled = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled), Specs = lists:map( fun ({{F, A}, S1}) -> @@ -1266,7 +1265,7 @@ parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled) -> ErlSpecs = convert_list_to_erl(S, {Mod, F, A}, ExpTypes, RecDict), {{Mod, F, A}, ErlSpecs} end, - Specs1), + cuter_cerl:kmodule_spec_forms(Kmodule)), {Specs, Unhandled}. fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled) -> @@ -1323,7 +1322,7 @@ equal_sets(A, B) -> sets:size(A) == sets:size(B) andalso sets:size(sets:union(A, B)) == sets:size(B). all_types_from_cerl(Kmodule) -> - TypesOpaques = [{type_replace_records(Type), Line} || {_, {c_literal, [Line|_], [Type]}} <- cuter_cerl:kmodule_type_forms(Kmodule)], + TypesOpaques = [{type_replace_records(Type), Line} || {type, Line, Type} <- cuter_cerl:kmodule_type_forms(Kmodule)], Records = records_as_types(Kmodule), lists:append(TypesOpaques, Records). @@ -1348,7 +1347,7 @@ replace_records({T, L, Type, Args}) when T =:= type orelse T =:= user_type -> replace_records(Rest) -> Rest. records_as_types(Kmodule) -> - R = [{RecName, Line, RecFields} || {{c_literal, [Line], record}, {c_literal, _, [{RecName, RecFields}]}} <- cuter_cerl:kmodule_record_forms(Kmodule)], + R = [{RecName, Line, RecFields} || {record, Line, {RecName, RecFields}} <- cuter_cerl:kmodule_record_forms(Kmodule)], lists:map(fun type_from_record/1, R). type_from_record({Name, Line, Fields}) -> From 4c78b6ec5367d677c953224b99919f4e1d1103b0 Mon Sep 17 00:00:00 2001 From: Dspil Date: Sat, 22 Jan 2022 19:12:59 +0200 Subject: [PATCH 04/85] kmodule api update --- src/cuter_cerl.erl | 78 +++++++++++++++++++++++++++++---------------- src/cuter_types.erl | 32 ++++++++++--------- 2 files changed, 68 insertions(+), 42 deletions(-) diff --git a/src/cuter_cerl.erl b/src/cuter_cerl.erl index 896cc9ad..549a90d8 100644 --- a/src/cuter_cerl.erl +++ b/src/cuter_cerl.erl @@ -11,8 +11,6 @@ -export([node_types_branches/0, node_types_branches_nocomp/0, node_types_all/0, node_types_conditions/0, node_types_conditions_nocomp/0, node_types_paths/0, node_types_paths_nocomp/0]). -%% Exported for debugging use. --export([classify_attributes/1]). %% kfun API. -export([kfun/2, kfun_code/1, kfun_is_exported/1, kfun_update_code/2]). %% kmodule API. @@ -67,10 +65,6 @@ -type lineno() :: integer(). -type name() :: atom(). -type fa() :: {name(), arity()}. --type cerl_attr() :: {#c_literal{val :: 'type' | opaque}, #c_literal{val :: cerl_attr_type()}} - | {#c_literal{val :: 'record'}, #c_literal{val :: cerl_recdef()}} % for OTP 19.x - | {#c_literal{val :: 'spec'}, #c_literal{val :: cerl_attr_spec()}} - | {#c_literal{val :: 'export_type' | 'behaviour'}, cerl:c_literal()}. -type cerl_attr_type() :: cerl_recdef() | cerl_typedef(). -type cerl_attr_spec() :: cerl_specdef(). @@ -177,18 +171,21 @@ kmodule(M, AST, TagGen) -> Kmodule = ets:new(M, [ordered_set, protected]), Exports = extract_exports(M, AST), Attrs = cerl:module_attrs(AST), - {TypeAttrs, SpecAttrs} = classify_attributes(cerl:module_attrs(AST)), - Types = cuter_types:retrieve_types(TypeAttrs), - Specs = cuter_types:retrieve_specs(SpecAttrs), + RecordForms = extract_record_forms(Attrs), + TypeForms = extract_type_forms(Attrs), + SpecForms = extract_spec_forms(Attrs), + Types = cuter_types:retrieve_types(TypeForms, RecordForms), + Specs = cuter_types:retrieve_specs(SpecForms), Defs = cerl:module_defs(AST), Funs = [process_fundef(D, Exports, M, TagGen) || D <- Defs], ets:insert(Kmodule, {ast, AST}), ets:insert(Kmodule, {name, M}), ets:insert(Kmodule, {types, Types}), ets:insert(Kmodule, {specs, Specs}), - ets:insert(Kmodule, {spec_forms, SpecAttrs}), + ets:insert(Kmodule, {spec_forms, SpecForms}), ets:insert(Kmodule, {exported_types, extract_exported_types(M, Attrs)}), - ets:insert(Kmodule, {type_forms, TypeAttrs}), + ets:insert(Kmodule, {type_forms, TypeForms}), + ets:insert(Kmodule, {record_forms, RecordForms}), lists:foreach(fun({Mfa, Kfun}) -> ets:insert(Kmodule, {Mfa, Kfun}) end, Funs), Kmodule. @@ -224,8 +221,8 @@ kmodule_type_forms(Kmodule) -> -spec kmodule_record_forms(kmodule()) -> [cerl:cerl()]. kmodule_record_forms(Kmodule) -> - [{type_forms, TypeForms}] = ets:lookup(Kmodule, type_forms), - TypeForms. + [{record_forms, RecordForms}] = ets:lookup(Kmodule, record_forms), + RecordForms. %% Retrieves the kfun() for the given MFA. -spec kmodule_kfun(kmodule(), mfa()) -> {ok, kfun()} | error. @@ -362,35 +359,62 @@ get_abstract_code(Mod, Beam) -> -type type_info() :: {'type', integer(), cerl_typedef()} | {'record', cerl_recdef()}. -type spec_info() :: cerl_attr_spec(). --type classify_attr_ret() :: {[type_info()], [spec_info()]}. --spec classify_attributes([cerl_attr()]) -> classify_attr_ret(). -classify_attributes(Attrs) -> - classify_attributes(Attrs, [], []). +extract_record_forms(Attrs) -> + extract_record_forms(Attrs, []). --spec classify_attributes([cerl_attr()], [type_info()], [spec_info()]) -> classify_attr_ret(). -classify_attributes([], Types, Specs) -> - {lists:reverse(Types), lists:reverse(Specs)}; -classify_attributes([{What, #c_literal{val = Val}=A}|Attrs], Types, Specs) -> +extract_record_forms([], Acc) -> lists:reverse(Acc); +extract_record_forms([{What, #c_literal{val = Val}=A}|Attrs], Acc) -> case cerl:atom_val(What) of Tp when Tp =:= type orelse Tp =:= opaque -> [V] = Val, Line = hd(cerl:get_ann(A)), case V of {{record, Name}, Fields, []} -> % for OTP 18.x and earlier - classify_attributes(Attrs, [{record, Line, {Name, Fields}}|Types], Specs); + extract_record_forms(Attrs, [{Line, {Name, Fields}}|Acc]); _ -> - classify_attributes(Attrs, [{type, Line, V}|Types], Specs) + extract_record_forms(Attrs, Acc) end; record -> % for OTP 19.x and newer Line = hd(cerl:get_ann(A)), [V] = Val, - classify_attributes(Attrs, [{record, Line, V}|Types], Specs); + extract_record_forms(Attrs, [{Line, V}|Acc]); + _ -> + extract_record_forms(Attrs, Acc) + end. + +extract_type_forms(Attrs) -> + extract_type_forms(Attrs, []). + +extract_type_forms([], Acc) -> + lists:reverse(Acc); +extract_type_forms([{What, #c_literal{val = Val}=A}|Attrs], Acc) -> + case cerl:atom_val(What) of + Tp when Tp =:= type orelse Tp =:= opaque -> + [V] = Val, + Line = hd(cerl:get_ann(A)), + case V of + {{record, _Name}, _Fields, []} -> % for OTP 18.x and earlier + extract_type_forms(Attrs, Acc); + _ -> + extract_type_forms(Attrs, [{Line, V}|Acc]) + end; + _ -> + extract_type_forms(Attrs, Acc) + end. + +extract_spec_forms(Attrs) -> + extract_spec_forms(Attrs, []). + +extract_spec_forms([], Acc) -> + lists:reverse(Acc); +extract_spec_forms([{What, #c_literal{val = Val}}|Attrs], Acc) -> + case cerl:atom_val(What) of spec -> [V] = Val, - classify_attributes(Attrs, Types, [V|Specs]); - _Ignore -> - classify_attributes(Attrs, Types, Specs) + extract_spec_forms(Attrs, [V|Acc]); + _ -> + extract_spec_forms(Attrs, Acc) end. %% ---------------------------------------------------------------------------- diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 2fef2edb..f392eed2 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -2,7 +2,7 @@ %%------------------------------------------------------------------------------ -module(cuter_types). --export([parse_spec/3, retrieve_types/1, retrieve_specs/1, find_spec/2, +-export([parse_spec/3, retrieve_types/2, retrieve_specs/1, find_spec/2, get_kind/1, find_remote_deps_of_type/2, find_remote_deps_of_spec/2]). -export([params_of_t_function_det/1, ret_of_t_function/1, atom_of_t_atom_lit/1, @@ -212,21 +212,15 @@ %% ============================================================================ %% Pre-processes the type & record declarations. --spec retrieve_types([cuter_cerl:type_info()]) -> stored_types(). -retrieve_types(TypeAttrs) -> - lists:foldl(fun process_type_attr/2, dict:new(), TypeAttrs). +-spec retrieve_types([cuter_cerl:type_info()], any()) -> stored_types(). +retrieve_types(TypeAttrs, RecordAttrs) -> + T = lists:foldl(fun process_type_attr/2, dict:new(), TypeAttrs), + R = lists:foldl(fun process_record_attr/2, dict:new(), RecordAttrs), + dict:merge(fun (_Key, V1, _V2) -> V1 end, T, R). -spec process_type_attr(cuter_cerl:type_info(), stored_types()) -> stored_types(). -%% Processes the declaration of a record. -process_type_attr({record, _Line, {Name, Fields}}, Processed) -> - %% Process each field of the record. - Fs = [t_field_from_form(Field) || Field <- Fields], - %% Construct the representation of the record. - Record = t_record(Name, Fs), - %% Store the record in the proccessed dict. - dict:store({record, Name}, Record, Processed); %% Processes the declaration of a type. -process_type_attr({type, _Line, {Name, Repr, Vars}}, Processed) -> +process_type_attr({_Line, {Name, Repr, Vars}}, Processed) -> %% Process the type's representation. Type = safe_t_from_form(Repr), %% Parse the type parameters. @@ -234,6 +228,14 @@ process_type_attr({type, _Line, {Name, Repr, Vars}}, Processed) -> %% Store the type in the processed dict. dict:store({type, Name, length(Vs)}, {Type, Vs}, Processed). +process_record_attr({_Line, {Name, Fields}}, Processed) -> + %% Process each field of the record. + Fs = [t_field_from_form(Field) || Field <- Fields], + %% Construct the representation of the record. + Record = t_record(Name, Fs), + %% Store the record in the proccessed dict. + dict:store({record, Name}, Record, Processed). + %% Processes the declaration of a record's field. -spec t_field_from_form(cuter_cerl:cerl_record_field()) -> record_field_type(). %% A simple field. @@ -1322,7 +1324,7 @@ equal_sets(A, B) -> sets:size(A) == sets:size(B) andalso sets:size(sets:union(A, B)) == sets:size(B). all_types_from_cerl(Kmodule) -> - TypesOpaques = [{type_replace_records(Type), Line} || {type, Line, Type} <- cuter_cerl:kmodule_type_forms(Kmodule)], + TypesOpaques = [{type_replace_records(Type), Line} || {Line, Type} <- cuter_cerl:kmodule_type_forms(Kmodule)], Records = records_as_types(Kmodule), lists:append(TypesOpaques, Records). @@ -1347,7 +1349,7 @@ replace_records({T, L, Type, Args}) when T =:= type orelse T =:= user_type -> replace_records(Rest) -> Rest. records_as_types(Kmodule) -> - R = [{RecName, Line, RecFields} || {record, Line, {RecName, RecFields}} <- cuter_cerl:kmodule_record_forms(Kmodule)], + R = [{RecName, Line, RecFields} || {Line, {RecName, RecFields}} <- cuter_cerl:kmodule_record_forms(Kmodule)], lists:map(fun type_from_record/1, R). type_from_record({Name, Line, Fields}) -> From 18559fac5df3082399c425e1b77670de71c54914 Mon Sep 17 00:00:00 2001 From: Dspil Date: Sat, 22 Jan 2022 19:18:47 +0200 Subject: [PATCH 05/85] kmodule api update --- src/cuter_cerl.erl | 4 ++-- src/cuter_debug.erl | 18 +----------------- 2 files changed, 3 insertions(+), 19 deletions(-) diff --git a/src/cuter_cerl.erl b/src/cuter_cerl.erl index 549a90d8..fbf5cecc 100644 --- a/src/cuter_cerl.erl +++ b/src/cuter_cerl.erl @@ -214,12 +214,12 @@ kmodule_types(Kmodule) -> [{types, Types}] = ets:lookup(Kmodule, types), Types. --spec kmodule_type_forms(kmodule()) -> [cerl:cerl()]. +-spec kmodule_type_forms(kmodule()) -> [{integer(), cerl:cerl()}]. kmodule_type_forms(Kmodule) -> [{type_forms, TypeForms}] = ets:lookup(Kmodule, type_forms), TypeForms. --spec kmodule_record_forms(kmodule()) -> [cerl:cerl()]. +-spec kmodule_record_forms(kmodule()) -> [{integer(), {atom(), [cerl:cerl()]}}]. kmodule_record_forms(Kmodule) -> [{record_forms, RecordForms}] = ets:lookup(Kmodule, record_forms), RecordForms. diff --git a/src/cuter_debug.erl b/src/cuter_debug.erl index d02b76a2..886e301d 100644 --- a/src/cuter_debug.erl +++ b/src/cuter_debug.erl @@ -9,25 +9,9 @@ %% erl -noshell -eval "cuter_debug:parse_module_specs(crypto, true)" -s init stop -spec parse_module_specs(module(), boolean()) -> ok. -parse_module_specs(Module, WithPmatch) -> - Attrs = get_module_attrs(Module, WithPmatch), - {TypeAttrs, SpecAttrs} = cuter_cerl:classify_attributes(Attrs), - io:format("[**] Classified Attributes~n"), - _Types = cuter_types:retrieve_types(TypeAttrs), - io:format("[**] Retrieved Types~n"), - _Specs = cuter_types:retrieve_specs(SpecAttrs), - io:format("[**] Retrieved Specs~n"), +parse_module_specs(_Module, _WithPmatch) -> ok. -get_module_attrs(Module, WithPmatch) -> - Beam = code:which(Module), - {ok, {Module, [{abstract_code, {_, AbstractCode}}]}} = beam_lib:chunks(Beam, [abstract_code]), - {ok, Module, AST} = compile:forms(AbstractCode, compile_options(WithPmatch)), - cerl:module_attrs(AST). - -compile_options(true) -> [to_core, {core_transform, cerl_pmatch}]; -compile_options(false) -> [to_core]. - %% Prints the AST of a module. %% Run as: %% erl -noshell -pa ebin/ -eval "cuter_debug:parse_module(lists)" -s init stop From d6761601601a75f3f81effa90bc48feeff49ad3e Mon Sep 17 00:00:00 2001 From: Dspil Date: Sat, 22 Jan 2022 19:41:39 +0200 Subject: [PATCH 06/85] utest fixed --- src/cuter_cerl.erl | 8 +----- test/utest/src/cuter_cerl_tests.erl | 41 ++++++++++++++++++++++++++--- 2 files changed, 39 insertions(+), 10 deletions(-) diff --git a/src/cuter_cerl.erl b/src/cuter_cerl.erl index fbf5cecc..f7e6b10e 100644 --- a/src/cuter_cerl.erl +++ b/src/cuter_cerl.erl @@ -15,7 +15,7 @@ -export([kfun/2, kfun_code/1, kfun_is_exported/1, kfun_update_code/2]). %% kmodule API. -export([kmodule_spec_forms/1, kmodule_record_forms/1, kmodule_type_forms/1, kmodule_exported_types/1, kmodule_name/1, destroy_kmodule/1, kmodule/3, kmodule_kfun/2, kmodule_mfa_spec/2, - kmodule_specs/1, kmodule_types/1, kmodule_ast/1, kmodule_update_kfun/3, kmodule_mfas_with_kfuns/1, + kmodule_specs/1, kmodule_types/1, kmodule_update_kfun/3, kmodule_mfas_with_kfuns/1, kmodule_mfas_with_spec_forms/1]). %% We are using the records representation of Core Erlang Abstract Syntax Trees @@ -178,7 +178,6 @@ kmodule(M, AST, TagGen) -> Specs = cuter_types:retrieve_specs(SpecForms), Defs = cerl:module_defs(AST), Funs = [process_fundef(D, Exports, M, TagGen) || D <- Defs], - ets:insert(Kmodule, {ast, AST}), ets:insert(Kmodule, {name, M}), ets:insert(Kmodule, {types, Types}), ets:insert(Kmodule, {specs, Specs}), @@ -194,11 +193,6 @@ kmodule_exported_types(Kmodule) -> [{exported_types, ExpTypes}] = ets:lookup(Kmodule, exported_types), ExpTypes. --spec kmodule_ast(kmodule()) -> cerl:cerl(). -kmodule_ast(Kmodule) -> - [{ast, AST}] = ets:lookup(Kmodule, ast), - AST. - -spec kmodule_name(kmodule()) -> module(). kmodule_name(Kmodule) -> [{name, Name}] = ets:lookup(Kmodule, name), diff --git a/test/utest/src/cuter_cerl_tests.erl b/test/utest/src/cuter_cerl_tests.erl index 5f7e0a56..968c5185 100644 --- a/test/utest/src/cuter_cerl_tests.erl +++ b/test/utest/src/cuter_cerl_tests.erl @@ -79,10 +79,45 @@ construct_and_access_kfun_test() -> -spec construct_and_access_kmodule_test() -> any. construct_and_access_kmodule_test() -> - Code = cerl:c_fun([cerl:c_nil()], cerl:c_nil()), + Code = {c_fun, + [{function,{f,1}},4], + [{c_var,[4],0}], + {c_var,[{function,{f,1}},4],0}}, Kfun = cuter_cerl:kfun(Code, true), - Mfa = {some_module, some_fun, 1}, - Kmodule = cuter_cerl:kmodule(some_module, nil, nil, [{Mfa, Kfun}]), + Mfa = {some_module, f, 1}, + AST = {c_module,[], + {c_literal,[],some_module}, + [{c_var,[],{f,1}}, + {c_var,[],{module_info,0}}, + {c_var,[],{module_info,1}}], + [{{c_literal,[1],file},{c_literal,[1],[{"some_module.erl",1}]}}], + [{{c_var,[],{f,1}}, + {c_fun, + [{function,{f,1}},4], + [{c_var,[4],0}], + {c_var,[{function,{f,1}},4],0}}}, + {{c_var,[],{module_info,0}}, + {c_fun, + [{function,{module_info,0}},0], + [], + {c_call, + [0], + {c_literal,[0],erlang}, + {c_literal,[0],get_module_info}, + [{c_literal,[0],some_module}]}}}, + {{c_var,[],{module_info,1}}, + {c_fun, + [{function,{module_info,1}},0], + [{c_var,[0],0}], + {c_call, + [0], + {c_literal,[0],erlang}, + {c_literal,[0],get_module_info}, + [{c_literal,[0],some_module}, + {c_var, + [{function,{module_info,1}},0], + 0}]}}}]}, + Kmodule = cuter_cerl:kmodule(some_module, AST, fun() -> ok end), GotKfun = cuter_cerl:kmodule_kfun(Kmodule, Mfa), RS = cuter_cerl:kmodule_specs(Kmodule), RT = cuter_cerl:kmodule_types(Kmodule), From 196c8b297d4295e06fac665ff18cc10b142f9d91 Mon Sep 17 00:00:00 2001 From: Dspil Date: Wed, 26 Jan 2022 17:23:39 +0200 Subject: [PATCH 07/85] updated mark unreachable clauses logic --- src/cuter_codeserver.erl | 4 ++ src/cuter_maybe_error_annotation.erl | 10 +++- src/cuter_spec_checker.erl | 83 ++++++++++++++++------------ 3 files changed, 61 insertions(+), 36 deletions(-) diff --git a/src/cuter_codeserver.erl b/src/cuter_codeserver.erl index f4b25f0d..cc0e9a38 100644 --- a/src/cuter_codeserver.erl +++ b/src/cuter_codeserver.erl @@ -253,6 +253,7 @@ handle_call(annotate_for_possible_errors, _From, State=#st{db = Db}) -> {ok, EntryPoint} = cuter_config:fetch(?ENTRY_POINT), MfasToKfuns = ets:foldl(Fn, dict:new(), Db), %io:format("Before Specs~n"), + %io:format("ast: ~p~n", [cuter_cerl:kfun_code(dict:fetch({lists, unzip, 3}, MfasToKfuns))]), MfasToSpecs = cuter_types:parse_specs(Kmodules), UpdatedKfuns = cuter_maybe_error_annotation:preprocess(EntryPoint, MfasToKfuns, MfasToSpecs, true), RFn = fun({M, F, A}, Kfun, _Acc) -> @@ -261,7 +262,10 @@ handle_call(annotate_for_possible_errors, _From, State=#st{db = Db}) -> end, dict:fold(RFn, ok, UpdatedKfuns), %io:format("spec: ~p~n", [dict:find(EntryPoint, MfasToSpecs)]), + %io:format("spec unzip 3: ~p~n", [dict:find({lists, unzip, 3}, MfasToSpecs)]), %io:format("ast: ~p~n", [cuter_cerl:kfun_code(dict:fetch(EntryPoint, UpdatedKfuns))]), + %io:format("ast unzip3 ~p~n", [cuter_cerl:kfun_code(dict:fetch({lists, unzip, 3}, UpdatedKfuns))]), + %io:format("ast: reverse ~p~n", [cuter_cerl:kfun_code(dict:fetch({lists, reverse, 1}, UpdatedKfuns))]), {reply, ok, State}. diff --git a/src/cuter_maybe_error_annotation.erl b/src/cuter_maybe_error_annotation.erl index 9bda2b23..2c09f72d 100644 --- a/src/cuter_maybe_error_annotation.erl +++ b/src/cuter_maybe_error_annotation.erl @@ -352,7 +352,15 @@ annotate_maybe_error_pattern(Tree, SM, Force) -> tuple -> {Es, C, Found, SM1} = annotate_maybe_error_pattern_all(cerl:tuple_es(Tree), SM, Force), NewMaybe_Error = get_all_maybe_error(Es), - {cerl:update_c_tuple(update_ann(Tree, NewMaybe_Error), Es), C, Found, SM1} + {cerl:update_c_tuple(update_ann(Tree, NewMaybe_Error), Es), C, Found, SM1}; + alias -> + {Pat, C1, Found, SM1} = annotate_maybe_error_pattern(cerl:alias_pat(Tree), SM, Force), + Var = cerl:alias_var(Tree), + SM2 = put_vars([Var], [{type_dependent, 'var'}], SM1), + Var1 = update_ann(Var, type_dependent), + Tree1 = update_ann(Tree, type_dependent), + C2 = CurMaybe_Error =/= type_dependent, + {cerl:update_c_alias(Tree1, Var1, Pat), C1 or C2, Found, SM2} end. -spec get_arg_maybe_errors(cerl:cerl()) -> [{maybe_error(), atom()}]. diff --git a/src/cuter_spec_checker.erl b/src/cuter_spec_checker.erl index 70a66d33..a7956fda 100644 --- a/src/cuter_spec_checker.erl +++ b/src/cuter_spec_checker.erl @@ -69,12 +69,13 @@ update_from_detected([{Mfa, Spec}|Rest], TSM, OpenSet) -> TSM1 = dict:store(Mfa, [Spec], TSM) end, update_from_detected(Rest, TSM1, OpenSet1). + find_nospec(FSet, Sigs) -> Fn = fun(F) -> not dict:is_key(F, Sigs) end, sets:filter(Fn, FSet). make_open_set(FSet, Sigs) -> - Fn = fun(F) -> + Fn = fun(F) -> case dict:is_key(F, Sigs) of true -> length(dict:fetch(F, Sigs)) =:= 1; false -> false @@ -177,6 +178,9 @@ t_from_pattern(Tree, TSM, TSM2) -> tuple -> Es = lists:map(fun(E) -> t_from_pattern(E, TSM, TSM2) end, cerl:tuple_es(Tree)), erl_types:t_tuple(Es); + alias -> + Pat = cerl:alias_pat(Tree), + t_from_pattern(Pat, TSM, TSM2); _ -> erl_types:t_none() end. @@ -285,7 +289,14 @@ pass_down_types_helper(Fun, Spec, TSM, Mod, NoSpec) -> pass_down_types(Tree, TSM, Mod, ArgType, NoSpec) -> CurType = get_cerl_type(Tree), case cerl:type(Tree) of - %%alias -> + alias -> + {Pat, D1, C1} = pass_down_types(cerl:alias_pat(Tree), TSM, Mod, ArgType, NoSpec), + Var = cerl:alias_var(Tree), + T = get_cerl_type(Pat), + Var1 = update_type(Var, T), + Change = C1 or (CurType =/= T), + Tree1 = update_type(Tree, T), + {cerl:update_c_alias(Tree1, Var1, Pat), D1, Change}; 'apply' -> {Args, D1, C1} = pass_down_types_all(cerl:apply_args(Tree), TSM, Mod, ArgType, NoSpec), Op = cerl:apply_op(Tree), @@ -539,13 +550,7 @@ mark_unreachable_clauses(Clauses, ArgType, TSM, Arg) -> end, case ArgType =:= notype of false -> - Fn = fun(C) -> valid_guard(C, TSM, ArgList) end, - case lists:all(Fn, Clauses) of - true -> - mark_unreachable_clauses(Clauses, ArgType, TSM, ArgList, []); - false -> - Clauses - end; + mark_unreachable_clauses(Clauses, ArgType, TSM, ArgList, []); true -> Clauses end. @@ -566,7 +571,7 @@ mark_unreachable_clauses([Clause|Clauses], ArgType, TSM, Arg, NewClauses) -> _:_ -> A end end, - {A, TSMorT} = update_tsm_from_guard(cerl:clause_guard(Clause), TSM, Arg), + {A, TSMorT} = update_tsm_from_guard(Clause, TSM, Arg), case A of {argtype, ArgName} -> PatTypes1 = lists:map(fun (X) -> t_from_pattern(X, TSM, dict:new()) end, Pats), @@ -600,7 +605,9 @@ mark_unreachable_clauses([Clause|Clauses], ArgType, TSM, Arg, NewClauses) -> end; false -> T = ArgType - end + end; + invalid -> + T = ArgType end, mark_unreachable_clauses(Clauses, T, TSM, Arg, [NewClause|NewClauses]). @@ -697,31 +704,37 @@ is_right_call(Call, LetVar) -> false -> false end. -update_tsm_from_guard(Guard, TSM, ArgList) -> - case cerl:type(Guard) of - literal when element(3, Guard) =:= true -> {tsm, TSM}; - call -> - Args = cerl:call_args(Guard), - case get_call_mfa(Guard) of - {erlang, is_integer, 1} -> - update_tsm_from_guard_helper(Args, ArgList, erl_types:t_integer()); - {erlang, is_atom, 1} -> - update_tsm_from_guard_helper(Args, ArgList, erl_types:t_atom()); - {erlang, is_function, 1} -> - update_tsm_from_guard_helper(Args, ArgList, erl_types:t_fun()); - {erlang, is_function, 2}-> - Arity = element(3, lists:nth(2, Args)), - update_tsm_from_guard_helper(Args, ArgList, erl_types:t_fun(Arity, erl_types:t_any())) +update_tsm_from_guard(Clause, TSM, ArgList) -> + case valid_guard(Clause, TSM, ArgList) of + true -> + Guard = cerl:clause_guard(Clause), + case cerl:type(Guard) of + literal when element(3, Guard) =:= true -> {tsm, TSM}; + call -> + Args = cerl:call_args(Guard), + case get_call_mfa(Guard) of + {erlang, is_integer, 1} -> + update_tsm_from_guard_helper(Args, ArgList, erl_types:t_integer()); + {erlang, is_atom, 1} -> + update_tsm_from_guard_helper(Args, ArgList, erl_types:t_atom()); + {erlang, is_function, 1} -> + update_tsm_from_guard_helper(Args, ArgList, erl_types:t_fun()); + {erlang, is_function, 2}-> + Arity = element(3, lists:nth(2, Args)), + update_tsm_from_guard_helper(Args, ArgList, erl_types:t_fun(Arity, erl_types:t_any())) + end; + 'try' -> + TryArg = cerl:try_arg(Guard), + LetArg = cerl:let_arg(TryArg), + Args = cerl:call_args(LetArg), + case get_call_mfa(LetArg) of + {erlang, is_function, 2} -> + Arity = element(3, lists:nth(2, Args)), + update_tsm_from_guard_helper(Args, ArgList, erl_types:t_fun(Arity, erl_types:t_any())) + end end; - 'try' -> - TryArg = cerl:try_arg(Guard), - LetArg = cerl:let_arg(TryArg), - Args = cerl:call_args(LetArg), - case get_call_mfa(LetArg) of - {erlang, is_function, 2} -> - Arity = element(3, lists:nth(2, Args)), - update_tsm_from_guard_helper(Args, ArgList, erl_types:t_fun(Arity, erl_types:t_any())) - end + false -> + {invalid, none} end. update_tsm_from_guard_helper(Args, ArgList, Type) -> From b1308b05442fa45a37ff3f785f46e9c72007318e Mon Sep 17 00:00:00 2001 From: Dspil Date: Wed, 26 Jan 2022 20:02:00 +0200 Subject: [PATCH 08/85] bugfix to type_dependent_unreachable annotation stacking --- src/cuter_codeserver.erl | 6 ++---- src/cuter_spec_checker.erl | 17 +++++++++++++++-- 2 files changed, 17 insertions(+), 6 deletions(-) diff --git a/src/cuter_codeserver.erl b/src/cuter_codeserver.erl index cc0e9a38..f30ffa35 100644 --- a/src/cuter_codeserver.erl +++ b/src/cuter_codeserver.erl @@ -255,6 +255,7 @@ handle_call(annotate_for_possible_errors, _From, State=#st{db = Db}) -> %io:format("Before Specs~n"), %io:format("ast: ~p~n", [cuter_cerl:kfun_code(dict:fetch({lists, unzip, 3}, MfasToKfuns))]), MfasToSpecs = cuter_types:parse_specs(Kmodules), + %io:format("Before Preprocess~n"), UpdatedKfuns = cuter_maybe_error_annotation:preprocess(EntryPoint, MfasToKfuns, MfasToSpecs, true), RFn = fun({M, F, A}, Kfun, _Acc) -> [{_M, Kmodule}] = ets:lookup(Db, M), @@ -262,10 +263,7 @@ handle_call(annotate_for_possible_errors, _From, State=#st{db = Db}) -> end, dict:fold(RFn, ok, UpdatedKfuns), %io:format("spec: ~p~n", [dict:find(EntryPoint, MfasToSpecs)]), - %io:format("spec unzip 3: ~p~n", [dict:find({lists, unzip, 3}, MfasToSpecs)]), - %io:format("ast: ~p~n", [cuter_cerl:kfun_code(dict:fetch(EntryPoint, UpdatedKfuns))]), - %io:format("ast unzip3 ~p~n", [cuter_cerl:kfun_code(dict:fetch({lists, unzip, 3}, UpdatedKfuns))]), - %io:format("ast: reverse ~p~n", [cuter_cerl:kfun_code(dict:fetch({lists, reverse, 1}, UpdatedKfuns))]), + io:format("ast: ~p~n", [cuter_cerl:kfun_code(dict:fetch(EntryPoint, UpdatedKfuns))]), {reply, ok, State}. diff --git a/src/cuter_spec_checker.erl b/src/cuter_spec_checker.erl index a7956fda..585b7b15 100644 --- a/src/cuter_spec_checker.erl +++ b/src/cuter_spec_checker.erl @@ -108,6 +108,19 @@ update_type([], _, Acc, true) -> Acc; update_type([{node_type, _}|T], Type, Acc, _) -> update_type(T, Type, [{node_type, Type}|Acc], true); update_type([H|T], Type, Acc, Found) -> update_type(T, Type, [H|Acc], Found). +mark_as_unreachable(Clause) -> + Anno = cerl:get_ann(Clause), + case cuter_graphs:list_contains(type_dependent_unreachable, Anno) of + false -> + cerl:add_ann([type_dependent_unreachable], Clause); + true -> + Clause + end. + +mark_as_reachable(Clause) -> + Anno = [T || T <- cerl:get_ann(Clause), T =/= type_dependent_unreachable], + cerl:set_ann(Clause, Anno). + has_type(Tree) -> Anno = cerl:get_ann(Tree), lists:foldl( @@ -560,9 +573,9 @@ mark_unreachable_clauses([Clause|Clauses], ArgType, TSM, Arg, NewClauses) -> NewClause = case erl_types:t_is_none(ArgType) of true -> - cerl:add_ann([type_dependent_unreachable], Clause); + mark_as_unreachable(Clause); false -> - Clause + mark_as_reachable(Clause) end, SafeSub = fun(A, B) -> try erl_types:t_subtract(A, B) of From d8aadcc434e248938bae332ef7b32ca6e3ef1a75 Mon Sep 17 00:00:00 2001 From: Dspil Date: Wed, 26 Jan 2022 20:11:20 +0200 Subject: [PATCH 09/85] made openset in passing down types fix point computation a queue --- src/cuter_codeserver.erl | 2 +- src/cuter_spec_checker.erl | 19 +++++++++---------- 2 files changed, 10 insertions(+), 11 deletions(-) diff --git a/src/cuter_codeserver.erl b/src/cuter_codeserver.erl index f30ffa35..c1abdc5c 100644 --- a/src/cuter_codeserver.erl +++ b/src/cuter_codeserver.erl @@ -263,7 +263,7 @@ handle_call(annotate_for_possible_errors, _From, State=#st{db = Db}) -> end, dict:fold(RFn, ok, UpdatedKfuns), %io:format("spec: ~p~n", [dict:find(EntryPoint, MfasToSpecs)]), - io:format("ast: ~p~n", [cuter_cerl:kfun_code(dict:fetch(EntryPoint, UpdatedKfuns))]), + %io:format("ast: ~p~n", [cuter_cerl:kfun_code(dict:fetch(EntryPoint, UpdatedKfuns))]), {reply, ok, State}. diff --git a/src/cuter_spec_checker.erl b/src/cuter_spec_checker.erl index 585b7b15..3e44078f 100644 --- a/src/cuter_spec_checker.erl +++ b/src/cuter_spec_checker.erl @@ -20,29 +20,28 @@ annotate_types(FunctionASTS, Sigs, FSet) -> annotate_types_helper(FunctionASTS, TSM, OpenSet, NoSpec). annotate_types_helper(FunctionASTS, TSM, OpenSet, NoSpec) -> - case sets:size(OpenSet) of + case length(OpenSet) of 0 -> FunctionASTS; _ -> - O = sets:to_list(OpenSet), - {FASTS1, TSM1, OpenSet1} = annotate_types_helper_pass(FunctionASTS, TSM, O, NoSpec), + {FASTS1, TSM1, OpenSet1} = annotate_types_helper_pass(FunctionASTS, TSM, OpenSet, NoSpec), annotate_types_helper(FASTS1, TSM1, OpenSet1, NoSpec) end. annotate_types_helper_pass(FunctionASTS, TSM, OpenSet, NoSpec) -> - annotate_types_helper_pass(FunctionASTS, TSM, OpenSet, NoSpec, sets:new()). + annotate_types_helper_pass(FunctionASTS, TSM, OpenSet, NoSpec, []). -annotate_types_helper_pass(FunctionASTS, TSM, [], _NoSpec, OpenSet1) -> {FunctionASTS, TSM, OpenSet1}; +annotate_types_helper_pass(FunctionASTS, TSM, [], _NoSpec, OpenSet1) -> {FunctionASTS, TSM, lists:reverse(OpenSet1)}; annotate_types_helper_pass(FunctionASTS, TSM, [Mfa|Mfas], NoSpec, OpenSet1) -> AST = dict:fetch(Mfa, FunctionASTS), Spec = dict:fetch(Mfa, TSM), {NewAST, D, C} = pass_down_fun_types(Mfa, AST, Spec, TSM, NoSpec), + {TSM1, OpenSet2} = update_from_detected(D, TSM, OpenSet1), case C or (length(D) > 0) of true -> - OpenSet2 = sets:add_element(Mfa, OpenSet1); + OpenSet3 = [Mfa|OpenSet2]; false -> - OpenSet2 = OpenSet1 + OpenSet3 = OpenSet2 end, - {TSM1, OpenSet3} = update_from_detected(D, TSM, OpenSet2), case sets:is_element(Mfa, NoSpec) of true -> T = get_cerl_type(NewAST), @@ -61,7 +60,7 @@ annotate_types_helper_pass(FunctionASTS, TSM, [Mfa|Mfas], NoSpec, OpenSet1) -> update_from_detected([], TSM, OpenSet) -> {TSM, OpenSet}; update_from_detected([{Mfa, Spec}|Rest], TSM, OpenSet) -> - OpenSet1 = sets:add_element(Mfa, OpenSet), + OpenSet1 = [Mfa|OpenSet], case dict:find(Mfa, TSM) of {ok, [Cur]} -> TSM1 = dict:store(Mfa, [erl_types:t_sup(Cur, Spec)], TSM); @@ -81,7 +80,7 @@ make_open_set(FSet, Sigs) -> false -> false end end, - sets:filter(Fn, FSet). + sets:to_list(sets:filter(Fn, FSet)). %% ========================== %% single function annotation From 8ef136003f5f5d3bc70afbc59cd20377ccf57b03 Mon Sep 17 00:00:00 2001 From: Dspil Date: Thu, 27 Jan 2022 19:49:04 +0200 Subject: [PATCH 10/85] updated unification algorithm to try to catch unions --- src/cuter_codeserver.erl | 2 +- src/cuter_spec_checker.erl | 61 ++++++++++++++++++++++++++++---------- 2 files changed, 46 insertions(+), 17 deletions(-) diff --git a/src/cuter_codeserver.erl b/src/cuter_codeserver.erl index c1abdc5c..0afb005f 100644 --- a/src/cuter_codeserver.erl +++ b/src/cuter_codeserver.erl @@ -253,7 +253,7 @@ handle_call(annotate_for_possible_errors, _From, State=#st{db = Db}) -> {ok, EntryPoint} = cuter_config:fetch(?ENTRY_POINT), MfasToKfuns = ets:foldl(Fn, dict:new(), Db), %io:format("Before Specs~n"), - %io:format("ast: ~p~n", [cuter_cerl:kfun_code(dict:fetch({lists, unzip, 3}, MfasToKfuns))]), + %io:format("ast: ~p~n", [cuter_cerl:kfun_code(dict:fetch(EntryPoint, MfasToKfuns))]), MfasToSpecs = cuter_types:parse_specs(Kmodules), %io:format("Before Preprocess~n"), UpdatedKfuns = cuter_maybe_error_annotation:preprocess(EntryPoint, MfasToKfuns, MfasToSpecs, true), diff --git a/src/cuter_spec_checker.erl b/src/cuter_spec_checker.erl index 3e44078f..ba0e6832 100644 --- a/src/cuter_spec_checker.erl +++ b/src/cuter_spec_checker.erl @@ -227,7 +227,7 @@ t_union(Types) -> t_union([], T) -> T; t_union([Type|Types], T) -> t_union(Types, erl_types:t_sup(Type, T)). -unify_pattern(Tree, TSM, Type) -> +unify_pattern(Tree, TSM, TSM2, Type) -> case cerl:type(Tree) of literal -> {ok, TSM}; @@ -237,54 +237,76 @@ unify_pattern(Tree, TSM, Type) -> try erl_types:t_unify(VarType, Type) of _ -> {ok, TSM} catch - _ -> {error, mismatch} + _ -> + {error, mismatch} end; error -> - {ok, dict:store(cerl:var_name(Tree), Type, TSM)} + case dict:find(cerl:var_name(Tree), TSM2) of + {ok, VarGuardType} -> + case erl_types:t_is_subtype(VarGuardType, Type) of + true -> {ok, dict:store(cerl:var_name(Tree), VarGuardType, TSM)}; + false -> {error, mismatch} + end; + error -> + {ok, dict:store(cerl:var_name(Tree), Type, TSM)} + end end; cons -> case erl_types:t_is_list(Type) of true -> NewType = erl_types:t_nonempty_list(erl_types:t_list_elements(Type)), - Hdt = unify_pattern(cerl:cons_hd(Tree), TSM, erl_types:t_cons_hd(NewType)), + Hdt = unify_pattern(cerl:cons_hd(Tree), TSM, TSM2, erl_types:t_cons_hd(NewType)), case Hdt of {ok, TSM1} -> - Tlt = unify_pattern(cerl:cons_tl(Tree), TSM1, erl_types:t_cons_tl(NewType)), + Tlt = unify_pattern(cerl:cons_tl(Tree), TSM1, TSM2, erl_types:t_cons_tl(NewType)), case Tlt of - {ok, TSM2} -> {ok, TSM2}; - _ ->{error, mismatch} + {ok, TSMnew} -> {ok, TSMnew}; + _ -> {error, mismatch} end; _ -> {error, mismatch} end; false -> - {error, mismatch} + try_to_handle_union(Tree, TSM, TSM2, Type, erl_types:t_list()) end; tuple -> case erl_types:t_is_tuple(Type) of true -> - case length(cerl:tuple_es(Tree)) == erl_types:t_tuple_size(Type) of + Type1 = + try erl_types:t_tuple_size(Type) of + _ -> Type + catch + _:_ -> erl_types:t_tuple(length(cerl:tuple_es(Tree))) + end, + case length(cerl:tuple_es(Tree)) == erl_types:t_tuple_size(Type1) of true -> lists:foldl( fun({E, Et}, V) -> case V of {ok, V1} -> - unify_pattern(E, V1, Et); + unify_pattern(E, V1, TSM2, Et); {error, _} -> {error, mismatch} end end, {ok, TSM}, - lists:zip(cerl:tuple_es(Tree), erl_types:t_tuple_args(Type)) + lists:zip(cerl:tuple_es(Tree), erl_types:t_tuple_args(Type1)) ); false -> {error, mismatch} end; - false -> {error, mismatch} + false -> + try_to_handle_union(Tree, TSM, TSM2, Type, erl_types:t_tuple()) end; _ -> {ok, TSM} end. +try_to_handle_union(Tree, TSM, TSM2, Type, T) -> + H = erl_types:t_subtract(Type, (erl_types:t_subtract(Type, T))), + case erl_types:t_is_none(H) of + true -> {error, mismatch}; + false -> unify_pattern(Tree, TSM, TSM2, H) + end. %% ================== %% passing down types @@ -409,7 +431,13 @@ pass_down_types(Tree, TSM, Mod, ArgType, NoSpec) -> Fn = fun({Pat, AType}, V) -> case V of {ok, V1} -> - unify_pattern(Pat, V1, AType); + {A, TSMorT} = update_tsm_from_guard(Tree, V1, []), + case A of + tsm -> + unify_pattern(Pat, V1, TSMorT, AType); + _ -> + unify_pattern(Pat, V1, dict:new(), AType) + end; {error, mismatch} -> {error, mismatch} end end, @@ -641,7 +669,8 @@ valid_guard(Clause, TSM, ArgList) -> Guard = cerl:clause_guard(Clause), case cerl:type(Guard) of literal when element(3, Guard) =:= true -> true; - call -> Args = cerl:call_args(Guard), + call -> + Args = cerl:call_args(Guard), case get_call_mfa(Guard) of {erlang, is_integer, 1} -> is_unknown_var(hd(Args), TSM, ArgList); {erlang, is_atom, 1} -> is_unknown_var(hd(Args), TSM, ArgList); @@ -721,13 +750,13 @@ update_tsm_from_guard(Clause, TSM, ArgList) -> true -> Guard = cerl:clause_guard(Clause), case cerl:type(Guard) of - literal when element(3, Guard) =:= true -> {tsm, TSM}; + literal when element(3, Guard) =:= true -> {tsm, dict:new()}; call -> Args = cerl:call_args(Guard), case get_call_mfa(Guard) of {erlang, is_integer, 1} -> update_tsm_from_guard_helper(Args, ArgList, erl_types:t_integer()); - {erlang, is_atom, 1} -> + {erlang, is_atom, 1} -> update_tsm_from_guard_helper(Args, ArgList, erl_types:t_atom()); {erlang, is_function, 1} -> update_tsm_from_guard_helper(Args, ArgList, erl_types:t_fun()); From e3666b1ca7184ff075ce97ed874209808b9c2288 Mon Sep 17 00:00:00 2001 From: Dspil Date: Fri, 28 Jan 2022 19:50:40 +0200 Subject: [PATCH 11/85] deconstructed pass_down_types --- src/cuter_spec_checker.erl | 461 ++++++++++++++++++++----------------- 1 file changed, 250 insertions(+), 211 deletions(-) diff --git a/src/cuter_spec_checker.erl b/src/cuter_spec_checker.erl index ba0e6832..1a40aed8 100644 --- a/src/cuter_spec_checker.erl +++ b/src/cuter_spec_checker.erl @@ -317,176 +317,40 @@ pass_down_fun_types({M, _F, _A}, AST, Spec, TSM, NoSpec) -> pass_down_types_helper(Fun, Spec, TSM, Mod, NoSpec) -> TSM2 = put_vars(cerl:fun_vars(Fun), erl_types:t_fun_args(hd(Spec)), TSM), - {Body, D, C} = pass_down_types(cerl:fun_body(Fun), TSM2, Mod, notype, NoSpec), + {Body, D, C, _DC} = pass_down_types(cerl:fun_body(Fun), TSM2, Mod, notype, NoSpec, sets:new()), {cerl:update_c_fun(Fun, cerl:fun_vars(Fun), Body), D, C}. -pass_down_types(Tree, TSM, Mod, ArgType, NoSpec) -> +pass_down_types(Tree, TSM, Mod, ArgType, NoSpec, Closures) -> CurType = get_cerl_type(Tree), case cerl:type(Tree) of alias -> - {Pat, D1, C1} = pass_down_types(cerl:alias_pat(Tree), TSM, Mod, ArgType, NoSpec), + {Pat, D1, C1, CD1} = pass_down_types(cerl:alias_pat(Tree), TSM, Mod, ArgType, NoSpec, Closures), Var = cerl:alias_var(Tree), T = get_cerl_type(Pat), Var1 = update_type(Var, T), Change = C1 or (CurType =/= T), Tree1 = update_type(Tree, T), - {cerl:update_c_alias(Tree1, Var1, Pat), D1, Change}; + {cerl:update_c_alias(Tree1, Var1, Pat), D1, Change, CD1}; 'apply' -> - {Args, D1, C1} = pass_down_types_all(cerl:apply_args(Tree), TSM, Mod, ArgType, NoSpec), - Op = cerl:apply_op(Tree), - {Tree1, D2, C2} = - case lists:all(fun has_type/1, Args) of - true -> - case cerl:type(Op) of - var -> - OpN = case cerl:var_name(Op) of {F, A} -> {Mod, F, A}; Name -> Name end, - case dict:find(OpN, TSM) of - {ok, Specs} -> - case application_type(Specs, arg_types(Args)) of - {ok, Type} -> - {update_type(Tree, Type), D1, false}; - error -> - case sets:is_element(OpN, NoSpec) of - true -> - NewSpec = rewrite_spec(arg_types(Args), Specs), - {Tree, [{OpN, NewSpec} | D1], true}; - false -> - {Tree, D1, false} - end - end; - error -> - case sets:is_element(OpN, NoSpec) of - true -> - {Tree, [{OpN, erl_types:t_fun(arg_types(Args), erl_types:t_any())} | D1], true}; - false -> - {Tree, D1, false} - end - end; - _ -> - error("unhandled op") - end; - _ -> {Tree, D1, false} - end, - Change = C1 or C2 or (CurType =/= get_cerl_type(Tree1)), - {cerl:update_c_apply(Tree1, Op, Args), D2, Change}; - %%binary -> meta - %%bitstr -> meta + pass_down_types_apply(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType); call -> - {Args, D1, C1} = pass_down_types_all(cerl:call_args(Tree), TSM, Mod, ArgType, NoSpec), - ModName = cerl:call_module(Tree), - Name = cerl:call_name(Tree), - Arity = length(cerl:call_args(Tree)), - {Tree1, D2, C2} = - case lists:all(fun has_type/1, Args) of - true -> - case cerl:is_literal(ModName) andalso cerl:is_literal(Name) of - true -> - OpN = {element(3, ModName), element(3, Name), Arity}, - case dict:find(OpN, TSM) of - {ok, Specs} -> - case application_type(Specs, arg_types(Args)) of - {ok, Type} -> - {update_type(Tree, Type), D1, false}; - _ -> - case sets:is_element(OpN, NoSpec) of - true -> - NewSpec = rewrite_spec(arg_types(Args), Specs), - {Tree, [{OpN, NewSpec} | D1], true}; - false -> {Tree, D1, false} - end - end; - error -> - case sets:is_element(OpN, NoSpec) of - true -> - {Tree, [{OpN, erl_types:t_fun(arg_types(Args), erl_types:t_any())} | D1], true}; - false -> - {Tree, D1, false} - end - end; - _ -> throw("Unsupported call") - end; - _ -> {Tree, D1, false} - end, - Change = C1 or C2 or (CurType =/= get_cerl_type(Tree1)), - {cerl:update_c_call(Tree1, ModName, Name, Args), D2, Change}; + pass_down_types_call(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType); 'case' -> - {Arg, D1, C1} = pass_down_types(cerl:case_arg(Tree), TSM, Mod, ArgType, NoSpec), - {Clauses1, D2, C2} = pass_down_types_all(cerl:case_clauses(Tree), TSM, Mod, get_cerl_type(Arg), NoSpec), - Clauses = mark_unreachable_clauses(Clauses1, get_cerl_type(Arg), TSM, Arg), - Clauses2 = [Clause || Clause <- Clauses, not get_type_dependent_unreachable(Clause)], - Type = - case lists:all(fun has_type/1, Clauses2) of - true -> - T = arg_types(Clauses2), - case listcontains(notype, T) of - true -> notype; - false -> t_union(T) - end; - false -> - notype - end, - Change = C1 or C2 or (CurType =/= Type), - {cerl:update_c_case(update_type(Tree, Type), Arg, Clauses), lists:append(D1, D2), Change}; + pass_down_types_case(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType); clause -> - Fn = fun({Pat, AType}, V) -> - case V of - {ok, V1} -> - {A, TSMorT} = update_tsm_from_guard(Tree, V1, []), - case A of - tsm -> - unify_pattern(Pat, V1, TSMorT, AType); - _ -> - unify_pattern(Pat, V1, dict:new(), AType) - end; - {error, mismatch} -> {error, mismatch} - end - end, - case length(cerl:clause_pats(Tree)) > 1 of - true -> - case erl_types:t_is_tuple(ArgType) of - true -> - ATypes = erl_types:t_tuple_args(ArgType), - case length(ATypes) =:= length(cerl:clause_pats(Tree)) of - true -> - ArgTypes = ATypes; - false -> - ArgTypes = [notype || _ <- cerl:clause_pats(Tree)] - end; - false -> ArgTypes = [notype || _ <- cerl:clause_pats(Tree)] - end; - false -> ArgTypes = [ArgType] - end, - case length(ArgTypes) =/= length(cerl:clause_pats(Tree)) of - true -> - TSMt = {error, arglen}; - false -> - TSMt = lists:foldl(Fn, {ok, TSM}, lists:zip(cerl:clause_pats(Tree), ArgTypes)) - end, - case TSMt of - {ok, TSMU} -> - TSM1 = TSMU; - {error, _} -> - TSM1 = TSM - end, - {Pats, D1, C1} = pass_down_types_all(cerl:clause_pats(Tree), TSM1, Mod, ArgType, NoSpec), - {Guard, D2, C2} = pass_down_types(cerl:clause_guard(Tree), TSM1, Mod, ArgType, NoSpec), - {Body, D3, C3} = pass_down_types(cerl:clause_body(Tree), TSM1, Mod, ArgType, NoSpec), - Change = C1 or C2 or C3 or (CurType =/= get_cerl_type(Body)), - D = lists:append([D1, D2, D3]), - {cerl:update_c_clause(update_type(Tree, get_cerl_type(Body)), Pats, Guard, Body), D, Change}; + pass_down_types_clause(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType); cons -> - {Hd, D1, C1} = pass_down_types(cerl:cons_hd(Tree), TSM, Mod, ArgType, NoSpec), - {Tl, D2, C2} = pass_down_types(cerl:cons_tl(Tree), TSM, Mod, ArgType, NoSpec), + {Hd, D1, C1, CD1} = pass_down_types(cerl:cons_hd(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Tl, D2, C2, CD2} = pass_down_types(cerl:cons_tl(Tree), TSM, Mod, ArgType, NoSpec, Closures), Tree1 = case {get_cerl_type(Hd), get_cerl_type(Tl)} of {X, Y} when X =:= notype orelse Y =:= notype -> update_type(Tree, notype); _ -> update_type(Tree, erl_types:t_cons(get_cerl_type(Hd), get_cerl_type(Tl))) end, Change = C1 or C2 or (CurType =/= get_cerl_type(Tree1)), - D = lists:append([D1, D2]), - {cerl:update_c_cons(Tree1, Hd, Tl), D, Change}; + {cerl:update_c_cons(Tree1, Hd, Tl), D1 ++ D2, Change, CD1 ++ CD2}; tuple -> - {Es, D, C} = pass_down_types_all(cerl:tuple_es(Tree), TSM, Mod, ArgType, NoSpec), + {Es, D, C, CD} = pass_down_types_all(cerl:tuple_es(Tree), TSM, Mod, ArgType, NoSpec, Closures), Tree1 = case lists:foldl(fun(X, Y) -> Y orelse (get_cerl_type(X) =:= notype) end, false, Es) of true -> @@ -494,89 +358,264 @@ pass_down_types(Tree, TSM, Mod, ArgType, NoSpec) -> false -> update_type(Tree, erl_types:t_tuple(lists:map(fun get_cerl_type/1, Es))) end, Change = C or (CurType =/= get_cerl_type(Tree1)), - {cerl:update_c_tuple(Tree1, Es), D, Change}; + {cerl:update_c_tuple(Tree1, Es), D, Change, CD}; 'fun' -> - TSM1 = put_vars(cerl:fun_vars(Tree), [erl_types:t_any() || _ <- cerl:fun_vars(Tree)], TSM), - {Vars, _D1, _C1} = pass_down_types_all(cerl:fun_vars(Tree), TSM1, Mod, ArgType, NoSpec), - {Body, D1, C1} = pass_down_types(cerl:fun_body(Tree), TSM1, Mod, ArgType, NoSpec), - Tree1 = - case has_type(Body) of - true -> - case get_cerl_type(Body) of - notype -> update_type(Tree, notype); - _ -> - Type = erl_types:t_fun([erl_types:t_any() || _ <- cerl:fun_vars(Tree)], get_cerl_type(Body)), - update_type(Tree, Type) - end; - _ -> update_type(Tree, notype) - end, - Change = C1 or (CurType =/= get_cerl_type(Tree1)), - {cerl:update_c_fun(Tree1, Vars, Body), D1, Change}; + pass_down_types_fun(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType); 'let' -> - {Arg, D1, C1} = pass_down_types(cerl:let_arg(Tree), TSM, Mod, ArgType, NoSpec), - TSM1 = put_vars(cerl:let_vars(Tree), let_arg_types(Arg), TSM), - {Vars, D2, C2} = pass_down_types_all(cerl:let_vars(Tree), TSM1, Mod, ArgType, NoSpec), - {Body, D3, C3} = pass_down_types(cerl:let_body(Tree), TSM1, Mod, ArgType, NoSpec), - Tree1 = - case has_type(Body) of - true -> - update_type(Tree, get_cerl_type(Body)); - false -> - update_type(Tree, notype) - end, - Change = C1 or C2 or C3 or (CurType =/= get_cerl_type(Tree1)), - D = lists:append([D1, D2, D3]), - {cerl:update_c_let(Tree1, Vars, Arg, Body), D, Change}; + pass_down_types_let(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType); letrec -> - {Names, Funsb} = lists:unzip(cerl:letrec_defs(Tree)), - {Funs, D1, C1} = pass_down_types_all(Funsb, TSM, Mod, ArgType, NoSpec), - TSM1 = put_vars(Names, [[get_cerl_type(F)] || F <- Funs], TSM), - {Body, D2, C2} = pass_down_types(cerl:letrec_body(Tree), TSM1, Mod, ArgType, NoSpec), - Change = C1 or C2 or (CurType =/= get_cerl_type(Body)), - D = lists:append(D1, D2), - {cerl:update_c_letrec(update_type(Tree, get_cerl_type(Body)), lists:zip(Names, Funs), Body), D, Change}; + pass_down_types_letrec(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType); literal -> - {update_type(Tree, erl_types:t_from_term(element(3, Tree))), [], false}; + {update_type(Tree, erl_types:t_from_term(element(3, Tree))), [], false, []}; seq -> - {Arg, D1, C1} = pass_down_types(cerl:seq_arg(Tree), TSM, Mod, ArgType, NoSpec), - {Body, D2, C2} = pass_down_types(cerl:seq_body(Tree), TSM, Mod, ArgType, NoSpec), + {Arg, D1, C1, CD1} = pass_down_types(cerl:seq_arg(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Body, D2, C2, CD2} = pass_down_types(cerl:seq_body(Tree), TSM, Mod, ArgType, NoSpec, Closures), Change = C1 or C2 or (CurType =/= get_cerl_type(Body)), - D = lists:append(D1, D2), - {cerl:update_c_seq(update_type(Tree, get_cerl_type(Body)), Arg, Body), D, Change}; + {cerl:update_c_seq(update_type(Tree, get_cerl_type(Body)), Arg, Body), D1 ++ D2, Change, CD1 ++ CD2}; 'try' -> - {Arg, D1, C1} = pass_down_types(cerl:try_arg(Tree), TSM, Mod, ArgType, NoSpec), - {Vars, D2, C2} = pass_down_types_all(cerl:try_vars(Tree), TSM, Mod, ArgType, NoSpec), - {Body, D3, C3} = pass_down_types(cerl:try_body(Tree), TSM, Mod, ArgType, NoSpec), - {Evars, D4, C4} = pass_down_types_all(cerl:try_evars(Tree), TSM, Mod, ArgType, NoSpec), - {Handler, D5, C5} = pass_down_types(cerl:try_handler(Tree), TSM, Mod, ArgType, NoSpec), + {Arg, D1, C1, CD1} = pass_down_types(cerl:try_arg(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Vars, D2, C2, CD2} = pass_down_types_all(cerl:try_vars(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Body, D3, C3, CD3} = pass_down_types(cerl:try_body(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Evars, D4, C4, CD4} = pass_down_types_all(cerl:try_evars(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Handler, D5, C5, CD5} = pass_down_types(cerl:try_handler(Tree), TSM, Mod, ArgType, NoSpec, Closures), Change = C1 or C2 or C3 or C4 or C5 or (CurType =/= get_cerl_type(Body)), D = lists:append([D1, D2, D3, D4, D5]), - {cerl:update_c_try(update_type(Tree, get_cerl_type(Body)), Arg, Vars, Body, Evars, Handler), D, Change}; - %% 'catch' -> + CD = lists:append([CD1, CD2, CD3, CD4, CD5]), + {cerl:update_c_try(update_type(Tree, get_cerl_type(Body)), Arg, Vars, Body, Evars, Handler), D, Change, CD}; primop -> - {update_type(Tree, notype), [], false}; + {update_type(Tree, notype), [], false, []}; values -> - {Es, D1, C1} = pass_down_types_all(cerl:values_es(Tree), TSM, Mod, ArgType, NoSpec), + {Es, D1, C1, CD1} = pass_down_types_all(cerl:values_es(Tree), TSM, Mod, ArgType, NoSpec, Closures), case lists:all(fun has_type/1, Es) of true -> - {cerl:update_c_values(update_type(Tree, erl_types:t_tuple([get_cerl_type(T) || T <- Es])), Es), D1, C1}; + {cerl:update_c_values(update_type(Tree, erl_types:t_tuple([get_cerl_type(T) || T <- Es])), Es), D1, C1, CD1}; false -> - {cerl:update_c_values(update_type(Tree, notype), Es), D1, C1 or (CurType =/= notype)} + {cerl:update_c_values(update_type(Tree, notype), Es), D1, C1 or (CurType =/= notype), CD1} end; var -> case dict:find(cerl:var_name(Tree), TSM) of {ok, Type} -> - {update_type(Tree, Type), [], false}; - _ -> {update_type(Tree, notype), [], false} + {update_type(Tree, Type), [], false, []}; + _ -> {update_type(Tree, notype), [], false, []} end; _ -> - Tree + {Tree, [], false, []} end. -pass_down_types_all(Trees, TSM, Mod, ArgType, NoSpec) -> - R = lists:map(fun(A) -> pass_down_types(A, TSM, Mod, ArgType, NoSpec) end, Trees), - {NewTrees, AllDetected, Changes} = lists:unzip3(R), - {NewTrees, lists:append(AllDetected), lists:foldl(fun erlang:'or'/2, false, Changes)}. +pass_down_types_apply(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> + {Args, D1, C1, CD1} = pass_down_types_all(cerl:apply_args(Tree), TSM, Mod, ArgType, NoSpec, Closures), + Op = cerl:apply_op(Tree), + {Tree1, D2, C2, CD2} = + case lists:all(fun has_type/1, Args) of + true -> + case cerl:type(Op) of + var -> + OpN = case cerl:var_name(Op) of {F, A} -> {Mod, F, A}; Name -> Name end, + case dict:find(OpN, TSM) of + {ok, Specs} -> + case application_type(Specs, arg_types(Args)) of + {ok, Type} -> + {update_type(Tree, Type), D1, false, CD1}; + error -> + case sets:is_element(OpN, NoSpec) of + true -> + NewSpec = rewrite_spec(arg_types(Args), Specs), + {Tree, [{OpN, NewSpec} | D1], true, CD1}; + false -> + case sets:is_element(OpN, Closures) of + true -> + NewSpec = rewrite_spec(arg_types(Args), Specs), + {Tree, D1, true, [{OpN, NewSpec} | CD1]}; + false -> + {Tree, D1, false, CD1} + end + end + end; + error -> + case sets:is_element(OpN, NoSpec) of + true -> + {Tree, [{OpN, erl_types:t_fun(arg_types(Args), erl_types:t_any())} | D1], true, CD1}; + false -> + case sets:is_element(OpN, Closures) of + true -> + {Tree, D1, true, [{OpN, erl_types:t_fun(arg_types(Args), erl_types:t_any())} | CD1]}; + false-> + {Tree, D1, false, CD1} + end + end + end; + _ -> + error("unhandled op") + end; + _ -> {Tree, D1, false, CD1} + end, + Change = C1 or C2 or (CurType =/= get_cerl_type(Tree1)), + {cerl:update_c_apply(Tree1, Op, Args), D2, Change, CD2}. + +pass_down_types_call(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> + {Args, D1, C1, CD1} = pass_down_types_all(cerl:call_args(Tree), TSM, Mod, ArgType, NoSpec, Closures), + ModName = cerl:call_module(Tree), + Name = cerl:call_name(Tree), + Arity = length(cerl:call_args(Tree)), + {Tree1, D2, C2} = + case lists:all(fun has_type/1, Args) of + true -> + case cerl:is_literal(ModName) andalso cerl:is_literal(Name) of + true -> + OpN = {element(3, ModName), element(3, Name), Arity}, + case dict:find(OpN, TSM) of + {ok, Specs} -> + case application_type(Specs, arg_types(Args)) of + {ok, Type} -> + {update_type(Tree, Type), D1, false}; + _ -> + case sets:is_element(OpN, NoSpec) of + true -> + NewSpec = rewrite_spec(arg_types(Args), Specs), + {Tree, [{OpN, NewSpec} | D1], true}; + false -> {Tree, D1, false} + end + end; + error -> + case sets:is_element(OpN, NoSpec) of + true -> + {Tree, [{OpN, erl_types:t_fun(arg_types(Args), erl_types:t_any())} | D1], true}; + false -> + {Tree, D1, false} + end + end; + _ -> throw("Unsupported call") + end; + _ -> {Tree, D1, false} + end, + Change = C1 or C2 or (CurType =/= get_cerl_type(Tree1)), + {cerl:update_c_call(Tree1, ModName, Name, Args), D2, Change, CD1}. + +pass_down_types_case(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> + {Arg, D1, C1, CD1} = pass_down_types(cerl:case_arg(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Clauses1, D2, C2, CD2} = pass_down_types_all(cerl:case_clauses(Tree), TSM, Mod, get_cerl_type(Arg), NoSpec, Closures), + Clauses = mark_unreachable_clauses(Clauses1, get_cerl_type(Arg), TSM, Arg), + Clauses2 = [Clause || Clause <- Clauses, not get_type_dependent_unreachable(Clause)], + Type = + case lists:all(fun has_type/1, Clauses2) of + true -> + T = arg_types(Clauses2), + case listcontains(notype, T) of + true -> notype; + false -> t_union(T) + end; + false -> + notype + end, + Change = C1 or C2 or (CurType =/= Type), + {cerl:update_c_case(update_type(Tree, Type), Arg, Clauses), D1 ++ D2, Change, CD1 ++ CD2}. + +pass_down_types_clause(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> + Fn = fun({Pat, AType}, V) -> + case V of + {ok, V1} -> + {A, TSMorT} = update_tsm_from_guard(Tree, V1, []), + case A of + tsm -> + unify_pattern(Pat, V1, TSMorT, AType); + _ -> + unify_pattern(Pat, V1, dict:new(), AType) + end; + {error, mismatch} -> {error, mismatch} + end + end, + case length(cerl:clause_pats(Tree)) > 1 of + true -> + case erl_types:t_is_tuple(ArgType) of + true -> + ATypes = erl_types:t_tuple_args(ArgType), + case length(ATypes) =:= length(cerl:clause_pats(Tree)) of + true -> + ArgTypes = ATypes; + false -> + ArgTypes = [notype || _ <- cerl:clause_pats(Tree)] + end; + false -> ArgTypes = [notype || _ <- cerl:clause_pats(Tree)] + end; + false -> ArgTypes = [ArgType] + end, + case length(ArgTypes) =/= length(cerl:clause_pats(Tree)) of + true -> + TSMt = {error, arglen}; + false -> + TSMt = lists:foldl(Fn, {ok, TSM}, lists:zip(cerl:clause_pats(Tree), ArgTypes)) + end, + case TSMt of + {ok, TSMU} -> + TSM1 = TSMU; + {error, _} -> + TSM1 = TSM + end, + {Pats, D1, C1, CD1} = pass_down_types_all(cerl:clause_pats(Tree), TSM1, Mod, ArgType, NoSpec, Closures), + {Guard, D2, C2, CD2} = pass_down_types(cerl:clause_guard(Tree), TSM1, Mod, ArgType, NoSpec, Closures), + {Body, D3, C3, CD3} = pass_down_types(cerl:clause_body(Tree), TSM1, Mod, ArgType, NoSpec, Closures), + Change = C1 or C2 or C3 or (CurType =/= get_cerl_type(Body)), + D = lists:append([D1, D2, D3]), + CD = lists:append([CD1, CD2, CD3]), + {cerl:update_c_clause(update_type(Tree, get_cerl_type(Body)), Pats, Guard, Body), D, Change, CD}. + +pass_down_types_fun(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> + TSM1 = put_vars(cerl:fun_vars(Tree), [erl_types:t_any() || _ <- cerl:fun_vars(Tree)], TSM), + {Vars, _D1, _C1, _CD1} = pass_down_types_all(cerl:fun_vars(Tree), TSM1, Mod, ArgType, NoSpec, Closures), + {Body, D1, C1, CD1} = pass_down_types(cerl:fun_body(Tree), TSM1, Mod, ArgType, NoSpec, Closures), + Tree1 = + case has_type(Body) of + true -> + case get_cerl_type(Body) of + notype -> update_type(Tree, notype); + _ -> + Type = erl_types:t_fun([erl_types:t_any() || _ <- cerl:fun_vars(Tree)], get_cerl_type(Body)), + update_type(Tree, Type) + end; + _ -> update_type(Tree, notype) + end, + Change = C1 or (CurType =/= get_cerl_type(Tree1)), + {cerl:update_c_fun(Tree1, Vars, Body), D1, Change, CD1}. + +pass_down_types_let(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> + {Arg, D1, C1, CD1} = pass_down_types(cerl:let_arg(Tree), TSM, Mod, ArgType, NoSpec, Closures), + TSM1 = put_vars(cerl:let_vars(Tree), let_arg_types(Arg), TSM), + {Vars, D2, C2, CD2} = pass_down_types_all(cerl:let_vars(Tree), TSM1, Mod, ArgType, NoSpec, Closures), + {Body, D3, C3, CD3} = pass_down_types(cerl:let_body(Tree), TSM1, Mod, ArgType, NoSpec, Closures), + Tree1 = + case has_type(Body) of + true -> + update_type(Tree, get_cerl_type(Body)); + false -> + update_type(Tree, notype) + end, + Change = C1 or C2 or C3 or (CurType =/= get_cerl_type(Tree1)), + D = lists:append([D1, D2, D3]), + CD = lists:append([CD1, CD2, CD3]), + {cerl:update_c_let(Tree1, Vars, Arg, Body), D, Change, CD}. + +pass_down_types_letrec(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> + {Names, Funsb} = lists:unzip(cerl:letrec_defs(Tree)), + {Funs, D1, C1, CD1} = pass_down_types_all(Funsb, TSM, Mod, ArgType, NoSpec, Closures), + TSM1 = put_vars(Names, [[get_cerl_type(F)] || F <- Funs], TSM), + {Body, D2, C2, CD2} = pass_down_types(cerl:letrec_body(Tree), TSM1, Mod, ArgType, NoSpec, Closures), + Change = C1 or C2 or (CurType =/= get_cerl_type(Body)), + {cerl:update_c_letrec(update_type(Tree, get_cerl_type(Body)), lists:zip(Names, Funs), Body), D1 ++ D2, Change, CD1 ++ CD2}. + +pass_down_types_all(Trees, TSM, Mod, ArgType, NoSpec, Closures) -> + R = lists:map(fun(A) -> pass_down_types(A, TSM, Mod, ArgType, NoSpec, Closures) end, Trees), + {NewTrees, AllDetected, Changes, ClosuresDetected} = unzip4(R), + {NewTrees, lists:append(AllDetected), lists:foldl(fun erlang:'or'/2, false, Changes), lists:append(ClosuresDetected)}. + +unzip4(L) -> unzip4(L, [], [], [], []). + +unzip4([], Acc1, Acc2, Acc3, Acc4) -> + {lists:reverse(Acc1), + lists:reverse(Acc2), + lists:reverse(Acc3), + lists:reverse(Acc4)}; +unzip4([{A, B, C, D}|Rest], Acc1, Acc2, Acc3, Acc4) -> + unzip4(Rest, [A|Acc1], [B|Acc2], [C|Acc3], [D|Acc4]). rewrite_spec(ArgTypes, [Spec]) -> erl_types:t_fun(ArgTypes, erl_types:t_fun_range(Spec)). @@ -664,7 +703,7 @@ replace_guard_type([Arg|Args], ArgName, [PatType|PatTypes], TSMorT) -> false -> [PatType|replace_guard_type(Args, ArgName, PatTypes, TSMorT)] end. - + valid_guard(Clause, TSM, ArgList) -> Guard = cerl:clause_guard(Clause), case cerl:type(Guard) of @@ -702,7 +741,7 @@ valid_guard(Clause, TSM, ArgList) -> false -> false end; _ -> false - end; + end; _ -> false end; _ -> false From 9cc6871d6799368a0698183ab74812a57baf877b Mon Sep 17 00:00:00 2001 From: Dspil Date: Sat, 29 Jan 2022 11:04:18 +0200 Subject: [PATCH 12/85] type inference for nested functions --- src/cuter_maybe_error_annotation.erl | 228 ++++++++++++++------------- src/cuter_spec_checker.erl | 207 +++++++++++++++--------- 2 files changed, 254 insertions(+), 181 deletions(-) diff --git a/src/cuter_maybe_error_annotation.erl b/src/cuter_maybe_error_annotation.erl index 2c09f72d..0becfa19 100644 --- a/src/cuter_maybe_error_annotation.erl +++ b/src/cuter_maybe_error_annotation.erl @@ -117,112 +117,12 @@ annotate_maybe_error(AST, ST, Ignored, Mod, CheckTypes) -> annotate_maybe_error(Tree, SM, Force, Ignored, Mod, CheckTypes) -> CurMaybe_Error = get_maybe_error(Tree), case cerl:type(Tree) of -% alias -> 'apply' -> - Op = cerl:apply_op(Tree), - {Op1, C1, IgnoreFound1} = - case cerl:type(Op) of - var -> - case cerl:var_name(Op) of - {F, A} -> - case dict:find({Mod, F, A}, SM) of - {ok, {Value, 'fun'}} -> - case Value of - type_dependent when CheckTypes -> - case cuter_spec_checker:get_cerl_type(Tree) of - notype -> {update_ann(Op, true), true =/= CurMaybe_Error, false}; - _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false} - end; - _ -> {update_ann(Op, Value), Value =/= CurMaybe_Error, false} - end; - _ -> - case dict:find({F, A}, SM) of - {ok, {Value, FunType}} when FunType =:= 'fun' orelse FunType =:= letvar -> - case Value of - type_dependent when CheckTypes -> - case cuter_spec_checker:get_cerl_type(Tree) of - notype -> {update_ann(Op, true), true =/= CurMaybe_Error, false}; - _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false} - end; - _ -> - {update_ann(Op, Value), Value =/= CurMaybe_Error, false} - end; - _ -> - case sets:is_element({Mod, F, A}, Ignored) of - false -> - {update_ann(Op, true), true =/= CurMaybe_Error, false}; - true -> - {update_ann(Op, false), true =/= CurMaybe_Error, true} - end - end - end; - Name -> - case dict:find(Name, SM) of - {ok, {Value, _FunType}} -> %when FunType =:= 'fun' orelse FunType =:= letvar -> - case Value of - type_dependent when CheckTypes -> - case cuter_spec_checker:get_cerl_type(Tree) of - notype -> {update_ann(Op, true), true =/= CurMaybe_Error, false}; - _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false} - end; - _ -> - {update_ann(Op, Value), Value =/= CurMaybe_Error, false} - end; - _ -> - {update_ann(Op, true), true =/= CurMaybe_Error, false} - end - end; - _ -> - error("unhandled op") - end, - {Args, C2, Found, IgnoreFound2} = annotate_maybe_error_all(cerl:apply_args(Tree), SM, Force, Ignored, Mod, CheckTypes), - NewMaybe_Error = maybe_error_or([get_maybe_error(Op1), get_all_maybe_error(Args)]), - case get_all_maybe_error(Args) of - true -> - Tree1 = add_distrust_type_dependent(Tree); - _ -> - Tree1 = Tree - end, - {cerl:update_c_apply(update_ann(Tree1, NewMaybe_Error), Op1, Args), C1 or C2, Found, IgnoreFound1 or IgnoreFound2}; + annotate_maybe_error_apply(Tree, SM, Force, Ignored, Mod, CheckTypes, CurMaybe_Error); % binary -> meta % bitstr -> meta call -> - ModName = cerl:call_module(Tree), - Name = cerl:call_name(Tree), - Arity = length(cerl:call_args(Tree)), - {NewAnn, IgnoreFound1} = - case cerl:is_literal(ModName) andalso cerl:is_literal(Name) of - true -> - case dict:find({element(3, ModName), element(3, Name), Arity}, SM) of - {ok, {Value, 'fun'}} -> - case Value of - type_dependent when CheckTypes -> - case cuter_spec_checker:get_cerl_type(Tree) of - notype -> {true, false}; - _ -> {type_dependent, false} - end; - _ -> {Value, false} - end; - _ -> - case sets:is_element({element(3, ModName), element(3, Name), Arity}, Ignored) of - false -> - {true, false}; - true -> - {true, true} - end - end; - _ -> throw("Unsupported call") - end, - {Args, C1, Found, IgnoreFound2} = annotate_maybe_error_all(cerl:call_args(Tree), SM, Force, Ignored, Mod, CheckTypes), - NewMaybe_Error = maybe_error_or([NewAnn, get_all_maybe_error(Args)]), - C2 = NewMaybe_Error =/= CurMaybe_Error, - case get_all_maybe_error(Args) of - true -> - Tree1 = add_distrust_type_dependent(Tree); - _ -> - Tree1 = Tree - end, - {cerl:update_c_call(update_ann(Tree1, NewMaybe_Error), ModName, Name, Args), C1 or C2, Found, IgnoreFound1 or IgnoreFound2}; + annotate_maybe_error_call(Tree, SM, Force, Ignored, Mod, CheckTypes, CurMaybe_Error); 'case' -> {Clauses, C1, Found1, IgnoreFound1} = annotate_maybe_error_all(cerl:case_clauses(Tree), SM, Force, Ignored, Mod, CheckTypes), ClausesError1 = get_all_maybe_error(Clauses), @@ -276,12 +176,7 @@ annotate_maybe_error(Tree, SM, Force, Ignored, Mod, CheckTypes) -> NewIgnoreFound = IgnoreFound1 or IgnoreFound2 or IgnoreFound3, {cerl:update_c_let(update_ann(Tree1, NewMaybe_Error), Vars, Arg, Body), C1 or C2 or C3, sets:union([Found1, Found2, Found3]), NewIgnoreFound}; letrec -> - {Names, Funsb} = lists:unzip(cerl:letrec_defs(Tree)), - {Funs, C1, Found1, IgnoreFound1} = annotate_maybe_error_all(Funsb, SM, Force, Ignored, Mod, CheckTypes), - SM1 = put_vars(Names, [{get_maybe_error_pessimistic(A), letvar} || A <- Funs], SM), - {Body, C2, Found2, IgnoreFound2} = annotate_maybe_error(cerl:letrec_body(Tree), SM1, Force, Ignored, Mod, CheckTypes), - NewMaybe_Error = get_maybe_error(Body), - {cerl:update_c_letrec(update_ann(Tree, NewMaybe_Error), lists:zip(Names, Funs), Body), C1 or C2, sets:union([Found1, Found2]), IgnoreFound1 or IgnoreFound2}; + annotate_maybe_error_letrec(Tree, SM, Force, Ignored, Mod, CheckTypes, CurMaybe_Error); literal -> {update_ann(Tree, false), true == CurMaybe_Error, sets:new(), false}; primop -> @@ -327,6 +222,123 @@ annotate_maybe_error(Tree, SM, Force, Ignored, Mod, CheckTypes) -> {update_ann(Tree, true), true =/= CurMaybe_Error, sets:new(), false} end. +annotate_maybe_error_apply(Tree, SM, Force, Ignored, Mod, CheckTypes, CurMaybe_Error) -> + Op = cerl:apply_op(Tree), + {Op1, C1, IgnoreFound1} = + case cerl:type(Op) of + var -> + case cerl:var_name(Op) of + {F, A} -> + case dict:find({Mod, F, A}, SM) of + {ok, {Value, 'fun'}} -> + case Value of + type_dependent when CheckTypes -> + case cuter_spec_checker:get_cerl_type(Tree) of + notype -> {update_ann(Op, true), true =/= CurMaybe_Error, false}; + _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false} + end; + _ -> {update_ann(Op, Value), Value =/= CurMaybe_Error, false} + end; + _ -> + case dict:find({F, A}, SM) of + {ok, {Value, FunType}} when FunType =:= 'fun' orelse FunType =:= letvar -> + case Value of + type_dependent when CheckTypes -> + case cuter_spec_checker:get_cerl_type(Tree) of + notype -> {update_ann(Op, true), true =/= CurMaybe_Error, false}; + _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false} + end; + _ -> + {update_ann(Op, Value), Value =/= CurMaybe_Error, false} + end; + _ -> + case sets:is_element({Mod, F, A}, Ignored) of + false -> + {update_ann(Op, true), true =/= CurMaybe_Error, false}; + true -> + {update_ann(Op, false), true =/= CurMaybe_Error, true} + end + end + end; + Name -> + case dict:find(Name, SM) of + {ok, {Value, _FunType}} -> %when FunType =:= 'fun' orelse FunType =:= letvar -> + case Value of + type_dependent when CheckTypes -> + case cuter_spec_checker:get_cerl_type(Tree) of + notype -> {update_ann(Op, true), true =/= CurMaybe_Error, false}; + _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false} + end; + _ -> + {update_ann(Op, Value), Value =/= CurMaybe_Error, false} + end; + _ -> + {update_ann(Op, true), true =/= CurMaybe_Error, false} + end + end; + _ -> + error("unhandled op") + end, + {Args, C2, Found, IgnoreFound2} = annotate_maybe_error_all(cerl:apply_args(Tree), SM, Force, Ignored, Mod, CheckTypes), + NewMaybe_Error = maybe_error_or([get_maybe_error(Op1), get_all_maybe_error(Args)]), + case get_all_maybe_error(Args) of + true -> + Tree1 = add_distrust_type_dependent(Tree); + _ -> + Tree1 = Tree + end, + {cerl:update_c_apply(update_ann(Tree1, NewMaybe_Error), Op1, Args), C1 or C2, Found, IgnoreFound1 or IgnoreFound2}. + +annotate_maybe_error_call(Tree, SM, Force, Ignored, Mod, CheckTypes, CurMaybe_Error) -> + ModName = cerl:call_module(Tree), + Name = cerl:call_name(Tree), + Arity = length(cerl:call_args(Tree)), + {NewAnn, IgnoreFound1} = + case cerl:is_literal(ModName) andalso cerl:is_literal(Name) of + true -> + case dict:find({element(3, ModName), element(3, Name), Arity}, SM) of + {ok, {Value, 'fun'}} -> + case Value of + type_dependent when CheckTypes -> + case cuter_spec_checker:get_cerl_type(Tree) of + notype -> {true, false}; + _ -> {type_dependent, false} + end; + _ -> {Value, false} + end; + _ -> + case sets:is_element({element(3, ModName), element(3, Name), Arity}, Ignored) of + false -> + {true, false}; + true -> + {true, true} + end + end; + _ -> throw("Unsupported call") + end, + {Args, C1, Found, IgnoreFound2} = annotate_maybe_error_all(cerl:call_args(Tree), SM, Force, Ignored, Mod, CheckTypes), + NewMaybe_Error = maybe_error_or([NewAnn, get_all_maybe_error(Args)]), + C2 = NewMaybe_Error =/= CurMaybe_Error, + case get_all_maybe_error(Args) of + true -> + Tree1 = add_distrust_type_dependent(Tree); + _ -> + Tree1 = Tree + end, + {cerl:update_c_call(update_ann(Tree1, NewMaybe_Error), ModName, Name, Args), C1 or C2, Found, IgnoreFound1 or IgnoreFound2}. + +annotate_maybe_error_letrec(Tree, SM, Force, Ignored, Mod, CheckTypes, CurMaybe_Error) -> + {Names, Funsb} = lists:unzip(cerl:letrec_defs(Tree)), + %FunNames = [cerl:var_name(Name) || Name <- Names], + %FunNames1 = sets:from_list([{Mod, F, A} || {F, A} <- FunNames]), + %NewIgnored = sets:union(Ignored, FunNames1), + {Funs, C1, Found1, IgnoreFound1} = annotate_maybe_error_all(Funsb, SM, Force, Ignored, Mod, CheckTypes), + SM1 = put_vars(Names, [{get_maybe_error_pessimistic(A), letvar} || A <- Funs], SM), + {Body, C2, Found2, IgnoreFound2} = annotate_maybe_error(cerl:letrec_body(Tree), SM1, Force, Ignored, Mod, CheckTypes), + NewMaybe_Error = get_maybe_error(Body), + Change = C1 or C2 or (CurMaybe_Error =/= NewMaybe_Error), + {cerl:update_c_letrec(update_ann(Tree, NewMaybe_Error), lists:zip(Names, Funs), Body), Change, sets:union([Found1, Found2]), IgnoreFound1 or IgnoreFound2}. + annotate_maybe_error_pattern(Tree, SM, Force) -> CurMaybe_Error = get_maybe_error(Tree), case cerl:type(Tree) of diff --git a/src/cuter_spec_checker.erl b/src/cuter_spec_checker.erl index 1a40aed8..4050fb06 100644 --- a/src/cuter_spec_checker.erl +++ b/src/cuter_spec_checker.erl @@ -31,14 +31,15 @@ annotate_types_helper_pass(FunctionASTS, TSM, OpenSet, NoSpec) -> annotate_types_helper_pass(FunctionASTS, TSM, OpenSet, NoSpec, []). annotate_types_helper_pass(FunctionASTS, TSM, [], _NoSpec, OpenSet1) -> {FunctionASTS, TSM, lists:reverse(OpenSet1)}; -annotate_types_helper_pass(FunctionASTS, TSM, [Mfa|Mfas], NoSpec, OpenSet1) -> +annotate_types_helper_pass(FunctionASTS, TSM, [{Mfa, Persistence}|Mfas], NoSpec, OpenSet1) -> AST = dict:fetch(Mfa, FunctionASTS), Spec = dict:fetch(Mfa, TSM), - {NewAST, D, C} = pass_down_fun_types(Mfa, AST, Spec, TSM, NoSpec), + TSMP = merge_all_dicts([TSM, Persistence]), + {NewAST, D, C, P} = pass_down_fun_types(Mfa, AST, Spec, TSMP, NoSpec), {TSM1, OpenSet2} = update_from_detected(D, TSM, OpenSet1), case C or (length(D) > 0) of true -> - OpenSet3 = [Mfa|OpenSet2]; + OpenSet3 = update_open_set(Mfa, P, OpenSet2); false -> OpenSet3 = OpenSet2 end, @@ -58,9 +59,18 @@ annotate_types_helper_pass(FunctionASTS, TSM, [Mfa|Mfas], NoSpec, OpenSet1) -> NewASTS = dict:store(Mfa, NewAST, FunctionASTS), annotate_types_helper_pass(NewASTS, TSM2, Mfas, NoSpec, OpenSet3). +update_open_set(Mfa, P, OpenSet) -> + lists:reverse([{Mfa, P}|update_open_set1(Mfa, OpenSet, [])]). + +update_open_set1(_Mfa, [], Acc) -> Acc; +update_open_set1(Mfa, [{Mfa, _P}|Rest], Acc) -> + update_open_set1(Mfa, Rest, Acc); +update_open_set1(Mfa, [A|R], Acc) -> + update_open_set1(Mfa, R, [A|Acc]). + update_from_detected([], TSM, OpenSet) -> {TSM, OpenSet}; update_from_detected([{Mfa, Spec}|Rest], TSM, OpenSet) -> - OpenSet1 = [Mfa|OpenSet], + OpenSet1 = [{Mfa, dict:new()}|OpenSet], case dict:find(Mfa, TSM) of {ok, [Cur]} -> TSM1 = dict:store(Mfa, [erl_types:t_sup(Cur, Spec)], TSM); @@ -80,7 +90,8 @@ make_open_set(FSet, Sigs) -> false -> false end end, - sets:to_list(sets:filter(Fn, FSet)). + O1 = sets:to_list(sets:filter(Fn, FSet)), + [{X, dict:new()} || X <- O1]. %% ========================== %% single function annotation @@ -302,10 +313,15 @@ unify_pattern(Tree, TSM, TSM2, Type) -> end. try_to_handle_union(Tree, TSM, TSM2, Type, T) -> - H = erl_types:t_subtract(Type, (erl_types:t_subtract(Type, T))), - case erl_types:t_is_none(H) of - true -> {error, mismatch}; - false -> unify_pattern(Tree, TSM, TSM2, H) + case erl_types:is_erl_type(Type) andalso erl_types:is_erl_type(T) of + true -> + H = erl_types:t_subtract(Type, (erl_types:t_subtract(Type, T))), + case erl_types:t_is_none(H) of + true -> {error, mismatch}; + false -> unify_pattern(Tree, TSM, TSM2, H) + end; + false -> + {error, mismatch} end. %% ================== @@ -317,20 +333,20 @@ pass_down_fun_types({M, _F, _A}, AST, Spec, TSM, NoSpec) -> pass_down_types_helper(Fun, Spec, TSM, Mod, NoSpec) -> TSM2 = put_vars(cerl:fun_vars(Fun), erl_types:t_fun_args(hd(Spec)), TSM), - {Body, D, C, _DC} = pass_down_types(cerl:fun_body(Fun), TSM2, Mod, notype, NoSpec, sets:new()), - {cerl:update_c_fun(Fun, cerl:fun_vars(Fun), Body), D, C}. + {Body, D, C, _DC, P} = pass_down_types(cerl:fun_body(Fun), TSM2, Mod, notype, NoSpec, sets:new()), + {cerl:update_c_fun(Fun, cerl:fun_vars(Fun), Body), D, C, P}. pass_down_types(Tree, TSM, Mod, ArgType, NoSpec, Closures) -> CurType = get_cerl_type(Tree), case cerl:type(Tree) of alias -> - {Pat, D1, C1, CD1} = pass_down_types(cerl:alias_pat(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Pat, D1, C1, CD1, P1} = pass_down_types(cerl:alias_pat(Tree), TSM, Mod, ArgType, NoSpec, Closures), Var = cerl:alias_var(Tree), T = get_cerl_type(Pat), Var1 = update_type(Var, T), Change = C1 or (CurType =/= T), Tree1 = update_type(Tree, T), - {cerl:update_c_alias(Tree1, Var1, Pat), D1, Change, CD1}; + {cerl:update_c_alias(Tree1, Var1, Pat), D1, Change, CD1, P1}; 'apply' -> pass_down_types_apply(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType); call -> @@ -340,17 +356,18 @@ pass_down_types(Tree, TSM, Mod, ArgType, NoSpec, Closures) -> clause -> pass_down_types_clause(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType); cons -> - {Hd, D1, C1, CD1} = pass_down_types(cerl:cons_hd(Tree), TSM, Mod, ArgType, NoSpec, Closures), - {Tl, D2, C2, CD2} = pass_down_types(cerl:cons_tl(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Hd, D1, C1, CD1, P1} = pass_down_types(cerl:cons_hd(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Tl, D2, C2, CD2, P2} = pass_down_types(cerl:cons_tl(Tree), TSM, Mod, ArgType, NoSpec, Closures), Tree1 = case {get_cerl_type(Hd), get_cerl_type(Tl)} of {X, Y} when X =:= notype orelse Y =:= notype -> update_type(Tree, notype); _ -> update_type(Tree, erl_types:t_cons(get_cerl_type(Hd), get_cerl_type(Tl))) end, Change = C1 or C2 or (CurType =/= get_cerl_type(Tree1)), - {cerl:update_c_cons(Tree1, Hd, Tl), D1 ++ D2, Change, CD1 ++ CD2}; + P = merge_all_dicts([P1, P2]), + {cerl:update_c_cons(Tree1, Hd, Tl), D1 ++ D2, Change, CD1 ++ CD2, P}; tuple -> - {Es, D, C, CD} = pass_down_types_all(cerl:tuple_es(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Es, D, C, CD, P} = pass_down_types_all(cerl:tuple_es(Tree), TSM, Mod, ArgType, NoSpec, Closures), Tree1 = case lists:foldl(fun(X, Y) -> Y orelse (get_cerl_type(X) =:= notype) end, false, Es) of true -> @@ -358,7 +375,7 @@ pass_down_types(Tree, TSM, Mod, ArgType, NoSpec, Closures) -> false -> update_type(Tree, erl_types:t_tuple(lists:map(fun get_cerl_type/1, Es))) end, Change = C or (CurType =/= get_cerl_type(Tree1)), - {cerl:update_c_tuple(Tree1, Es), D, Change, CD}; + {cerl:update_c_tuple(Tree1, Es), D, Change, CD, P}; 'fun' -> pass_down_types_fun(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType); 'let' -> @@ -366,44 +383,46 @@ pass_down_types(Tree, TSM, Mod, ArgType, NoSpec, Closures) -> letrec -> pass_down_types_letrec(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType); literal -> - {update_type(Tree, erl_types:t_from_term(element(3, Tree))), [], false, []}; + {update_type(Tree, erl_types:t_from_term(element(3, Tree))), [], false, [], dict:new()}; seq -> - {Arg, D1, C1, CD1} = pass_down_types(cerl:seq_arg(Tree), TSM, Mod, ArgType, NoSpec, Closures), - {Body, D2, C2, CD2} = pass_down_types(cerl:seq_body(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Arg, D1, C1, CD1, P1} = pass_down_types(cerl:seq_arg(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Body, D2, C2, CD2, P2} = pass_down_types(cerl:seq_body(Tree), TSM, Mod, ArgType, NoSpec, Closures), Change = C1 or C2 or (CurType =/= get_cerl_type(Body)), - {cerl:update_c_seq(update_type(Tree, get_cerl_type(Body)), Arg, Body), D1 ++ D2, Change, CD1 ++ CD2}; + P = merge_all_dicts([P1, P2]), + {cerl:update_c_seq(update_type(Tree, get_cerl_type(Body)), Arg, Body), D1 ++ D2, Change, CD1 ++ CD2, P}; 'try' -> - {Arg, D1, C1, CD1} = pass_down_types(cerl:try_arg(Tree), TSM, Mod, ArgType, NoSpec, Closures), - {Vars, D2, C2, CD2} = pass_down_types_all(cerl:try_vars(Tree), TSM, Mod, ArgType, NoSpec, Closures), - {Body, D3, C3, CD3} = pass_down_types(cerl:try_body(Tree), TSM, Mod, ArgType, NoSpec, Closures), - {Evars, D4, C4, CD4} = pass_down_types_all(cerl:try_evars(Tree), TSM, Mod, ArgType, NoSpec, Closures), - {Handler, D5, C5, CD5} = pass_down_types(cerl:try_handler(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Arg, D1, C1, CD1, P1} = pass_down_types(cerl:try_arg(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Vars, D2, C2, CD2, P2} = pass_down_types_all(cerl:try_vars(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Body, D3, C3, CD3, P3} = pass_down_types(cerl:try_body(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Evars, D4, C4, CD4, P4} = pass_down_types_all(cerl:try_evars(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Handler, D5, C5, CD5, P5} = pass_down_types(cerl:try_handler(Tree), TSM, Mod, ArgType, NoSpec, Closures), Change = C1 or C2 or C3 or C4 or C5 or (CurType =/= get_cerl_type(Body)), D = lists:append([D1, D2, D3, D4, D5]), CD = lists:append([CD1, CD2, CD3, CD4, CD5]), - {cerl:update_c_try(update_type(Tree, get_cerl_type(Body)), Arg, Vars, Body, Evars, Handler), D, Change, CD}; + P = merge_all_dicts([P1, P2, P3, P4, P5]), + {cerl:update_c_try(update_type(Tree, get_cerl_type(Body)), Arg, Vars, Body, Evars, Handler), D, Change, CD, P}; primop -> - {update_type(Tree, notype), [], false, []}; + {update_type(Tree, notype), [], false, [], dict:new()}; values -> - {Es, D1, C1, CD1} = pass_down_types_all(cerl:values_es(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Es, D1, C1, CD1, P1} = pass_down_types_all(cerl:values_es(Tree), TSM, Mod, ArgType, NoSpec, Closures), case lists:all(fun has_type/1, Es) of true -> - {cerl:update_c_values(update_type(Tree, erl_types:t_tuple([get_cerl_type(T) || T <- Es])), Es), D1, C1, CD1}; + {cerl:update_c_values(update_type(Tree, erl_types:t_tuple([get_cerl_type(T) || T <- Es])), Es), D1, C1, CD1, P1}; false -> - {cerl:update_c_values(update_type(Tree, notype), Es), D1, C1 or (CurType =/= notype), CD1} + {cerl:update_c_values(update_type(Tree, notype), Es), D1, C1 or (CurType =/= notype), CD1, P1} end; var -> case dict:find(cerl:var_name(Tree), TSM) of {ok, Type} -> - {update_type(Tree, Type), [], false, []}; - _ -> {update_type(Tree, notype), [], false, []} + {update_type(Tree, Type), [], false, [], dict:new()}; + _ -> {update_type(Tree, notype), [], false, [], dict:new()} end; _ -> - {Tree, [], false, []} + {Tree, [], false, [], dict:new()} end. pass_down_types_apply(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> - {Args, D1, C1, CD1} = pass_down_types_all(cerl:apply_args(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Args, D1, C1, CD1, P1} = pass_down_types_all(cerl:apply_args(Tree), TSM, Mod, ArgType, NoSpec, Closures), Op = cerl:apply_op(Tree), {Tree1, D2, C2, CD2} = case lists:all(fun has_type/1, Args) of @@ -450,10 +469,10 @@ pass_down_types_apply(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> _ -> {Tree, D1, false, CD1} end, Change = C1 or C2 or (CurType =/= get_cerl_type(Tree1)), - {cerl:update_c_apply(Tree1, Op, Args), D2, Change, CD2}. + {cerl:update_c_apply(Tree1, Op, Args), D2, Change, CD2, P1}. pass_down_types_call(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> - {Args, D1, C1, CD1} = pass_down_types_all(cerl:call_args(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Args, D1, C1, CD1, P1} = pass_down_types_all(cerl:call_args(Tree), TSM, Mod, ArgType, NoSpec, Closures), ModName = cerl:call_module(Tree), Name = cerl:call_name(Tree), Arity = length(cerl:call_args(Tree)), @@ -489,18 +508,18 @@ pass_down_types_call(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> _ -> {Tree, D1, false} end, Change = C1 or C2 or (CurType =/= get_cerl_type(Tree1)), - {cerl:update_c_call(Tree1, ModName, Name, Args), D2, Change, CD1}. + {cerl:update_c_call(Tree1, ModName, Name, Args), D2, Change, CD1, P1}. pass_down_types_case(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> - {Arg, D1, C1, CD1} = pass_down_types(cerl:case_arg(Tree), TSM, Mod, ArgType, NoSpec, Closures), - {Clauses1, D2, C2, CD2} = pass_down_types_all(cerl:case_clauses(Tree), TSM, Mod, get_cerl_type(Arg), NoSpec, Closures), + {Arg, D1, C1, CD1, P1} = pass_down_types(cerl:case_arg(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Clauses1, D2, C2, CD2, P2} = pass_down_types_all(cerl:case_clauses(Tree), TSM, Mod, get_cerl_type(Arg), NoSpec, Closures), Clauses = mark_unreachable_clauses(Clauses1, get_cerl_type(Arg), TSM, Arg), Clauses2 = [Clause || Clause <- Clauses, not get_type_dependent_unreachable(Clause)], Type = case lists:all(fun has_type/1, Clauses2) of true -> T = arg_types(Clauses2), - case listcontains(notype, T) of + case cuter_graphs:list_contains(notype, T) of true -> notype; false -> t_union(T) end; @@ -508,7 +527,8 @@ pass_down_types_case(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> notype end, Change = C1 or C2 or (CurType =/= Type), - {cerl:update_c_case(update_type(Tree, Type), Arg, Clauses), D1 ++ D2, Change, CD1 ++ CD2}. + P = merge_all_dicts([P1, P2]), + {cerl:update_c_case(update_type(Tree, Type), Arg, Clauses), D1 ++ D2, Change, CD1 ++ CD2, P}. pass_down_types_clause(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> Fn = fun({Pat, AType}, V) -> @@ -551,18 +571,19 @@ pass_down_types_clause(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> {error, _} -> TSM1 = TSM end, - {Pats, D1, C1, CD1} = pass_down_types_all(cerl:clause_pats(Tree), TSM1, Mod, ArgType, NoSpec, Closures), - {Guard, D2, C2, CD2} = pass_down_types(cerl:clause_guard(Tree), TSM1, Mod, ArgType, NoSpec, Closures), - {Body, D3, C3, CD3} = pass_down_types(cerl:clause_body(Tree), TSM1, Mod, ArgType, NoSpec, Closures), + {Pats, D1, C1, CD1, P1} = pass_down_types_all(cerl:clause_pats(Tree), TSM1, Mod, ArgType, NoSpec, Closures), + {Guard, D2, C2, CD2, P2} = pass_down_types(cerl:clause_guard(Tree), TSM1, Mod, ArgType, NoSpec, Closures), + {Body, D3, C3, CD3, P3} = pass_down_types(cerl:clause_body(Tree), TSM1, Mod, ArgType, NoSpec, Closures), Change = C1 or C2 or C3 or (CurType =/= get_cerl_type(Body)), D = lists:append([D1, D2, D3]), CD = lists:append([CD1, CD2, CD3]), - {cerl:update_c_clause(update_type(Tree, get_cerl_type(Body)), Pats, Guard, Body), D, Change, CD}. + P = merge_all_dicts([P1, P2, P3]), + {cerl:update_c_clause(update_type(Tree, get_cerl_type(Body)), Pats, Guard, Body), D, Change, CD, P}. pass_down_types_fun(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> TSM1 = put_vars(cerl:fun_vars(Tree), [erl_types:t_any() || _ <- cerl:fun_vars(Tree)], TSM), - {Vars, _D1, _C1, _CD1} = pass_down_types_all(cerl:fun_vars(Tree), TSM1, Mod, ArgType, NoSpec, Closures), - {Body, D1, C1, CD1} = pass_down_types(cerl:fun_body(Tree), TSM1, Mod, ArgType, NoSpec, Closures), + {Vars, _D1, _C1, _CD1, _P1} = pass_down_types_all(cerl:fun_vars(Tree), TSM1, Mod, ArgType, NoSpec, Closures), + {Body, D1, C1, CD1, P1} = pass_down_types(cerl:fun_body(Tree), TSM1, Mod, ArgType, NoSpec, Closures), Tree1 = case has_type(Body) of true -> @@ -575,13 +596,13 @@ pass_down_types_fun(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> _ -> update_type(Tree, notype) end, Change = C1 or (CurType =/= get_cerl_type(Tree1)), - {cerl:update_c_fun(Tree1, Vars, Body), D1, Change, CD1}. + {cerl:update_c_fun(Tree1, Vars, Body), D1, Change, CD1, P1}. pass_down_types_let(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> - {Arg, D1, C1, CD1} = pass_down_types(cerl:let_arg(Tree), TSM, Mod, ArgType, NoSpec, Closures), + {Arg, D1, C1, CD1, P1} = pass_down_types(cerl:let_arg(Tree), TSM, Mod, ArgType, NoSpec, Closures), TSM1 = put_vars(cerl:let_vars(Tree), let_arg_types(Arg), TSM), - {Vars, D2, C2, CD2} = pass_down_types_all(cerl:let_vars(Tree), TSM1, Mod, ArgType, NoSpec, Closures), - {Body, D3, C3, CD3} = pass_down_types(cerl:let_body(Tree), TSM1, Mod, ArgType, NoSpec, Closures), + {Vars, D2, C2, CD2, P2} = pass_down_types_all(cerl:let_vars(Tree), TSM1, Mod, ArgType, NoSpec, Closures), + {Body, D3, C3, CD3, P3} = pass_down_types(cerl:let_body(Tree), TSM1, Mod, ArgType, NoSpec, Closures), Tree1 = case has_type(Body) of true -> @@ -592,33 +613,72 @@ pass_down_types_let(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> Change = C1 or C2 or C3 or (CurType =/= get_cerl_type(Tree1)), D = lists:append([D1, D2, D3]), CD = lists:append([CD1, CD2, CD3]), - {cerl:update_c_let(Tree1, Vars, Arg, Body), D, Change, CD}. + P = merge_all_dicts([P1, P2, P3]), + {cerl:update_c_let(Tree1, Vars, Arg, Body), D, Change, CD, P}. pass_down_types_letrec(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> {Names, Funsb} = lists:unzip(cerl:letrec_defs(Tree)), - {Funs, D1, C1, CD1} = pass_down_types_all(Funsb, TSM, Mod, ArgType, NoSpec, Closures), - TSM1 = put_vars(Names, [[get_cerl_type(F)] || F <- Funs], TSM), - {Body, D2, C2, CD2} = pass_down_types(cerl:letrec_body(Tree), TSM1, Mod, ArgType, NoSpec, Closures), - Change = C1 or C2 or (CurType =/= get_cerl_type(Body)), - {cerl:update_c_letrec(update_type(Tree, get_cerl_type(Body)), lists:zip(Names, Funs), Body), D1 ++ D2, Change, CD1 ++ CD2}. + FunNames = [cerl:var_name(Name) || Name <- Names], + FunNames1 = sets:from_list([{Mod, F, A} || {F, A} <- FunNames]), + NewClosures = sets:union(Closures, FunNames1), + {Funs, Body, D, C, CD, TSM1} = pass_down_types_letrec_fix(Names, Funsb, cerl:letrec_body(Tree), TSM, Mod, ArgType, NoSpec, NewClosures), + FilterFun = fun(Key, _Value) -> sets:is_element(Key, FunNames1) end, + Persistence = dict:filter(FilterFun, TSM1), + Change = C or (CurType =/= get_cerl_type(Body)), + {cerl:update_c_letrec(update_type(Tree, get_cerl_type(Body)), lists:zip(Names, Funs), Body), D, Change, CD, Persistence}. + +pass_down_types_letrec_fix(Names, Funsb, Body, TSM, Mod, ArgType, NoSpec, Closures) -> + FunNames1 = [cerl:var_name(Name) || Name <- Names], + FunNames2 = [{Mod, F, A} || {F, A} <- FunNames1], + FunNames = sets:from_list(FunNames2), + {Funs, D1, C1, CD1} = pass_down_types_letrec_fix_pass(FunNames2, Funsb, TSM, Mod, ArgType, NoSpec, Closures, []), + {Body1, D2, C2, CD2, _P2} = pass_down_types(Body, TSM, Mod, ArgType, NoSpec, Closures), + CD = CD1 ++ CD2, + RelevantCD = [D || {OpN, _NewSpec}=D <- CD, sets:is_element(OpN, FunNames)], + case length(RelevantCD) of + 0 -> + RestCD = [D || {OpN, _NewSpec}=D <- CD, not sets:is_element(OpN, FunNames)], + {Funs, Body1, D1 ++ D2, C1 or C2, RestCD, TSM}; + _ -> + {TSM1, _} = update_from_detected(RelevantCD, TSM, []), + pass_down_types_letrec_fix(Names, Funs, Body1, TSM1, Mod, ArgType, NoSpec, Closures) + end. + +pass_down_types_letrec_fix_pass([], _Funsb, _TSM, _Mod, _ArgType, _NoSpec, _Closures, Acc) -> + {Funs, D, C, CD, _P} = unzip5(Acc), + {lists:reverse(Funs), lists:append(D), lists:foldl(fun erlang:'or'/2, false, C), lists:append(CD)}; +pass_down_types_letrec_fix_pass([Name|Names], [Funb|Funsb], TSM, Mod, ArgType, NoSpec, Closures, Acc) -> + case dict:find(Name, TSM) of + {ok, [Spec]} -> + TSM1 = put_vars(cerl:fun_vars(Funb), erl_types:t_fun_args(Spec), TSM); + error -> + TSM1 = TSM + end, + {Args, _, _, _, _} = pass_down_types_all(cerl:fun_vars(Funb), TSM1, Mod, ArgType, NoSpec, Closures), + {Body, D, C, CD, P} = pass_down_types(cerl:fun_body(Funb), TSM1, Mod, ArgType, NoSpec, Closures), + Fun = cerl:update_c_fun(Funb, Args, Body), + pass_down_types_letrec_fix_pass(Names, Funsb, TSM, Mod, ArgType, NoSpec, Closures, [{Fun, D, C, CD, P}|Acc]). pass_down_types_all(Trees, TSM, Mod, ArgType, NoSpec, Closures) -> R = lists:map(fun(A) -> pass_down_types(A, TSM, Mod, ArgType, NoSpec, Closures) end, Trees), - {NewTrees, AllDetected, Changes, ClosuresDetected} = unzip4(R), - {NewTrees, lists:append(AllDetected), lists:foldl(fun erlang:'or'/2, false, Changes), lists:append(ClosuresDetected)}. + {NewTrees, AllDetected, Changes, ClosuresDetected, Persistence} = unzip5(R), + {NewTrees, lists:append(AllDetected), lists:foldl(fun erlang:'or'/2, false, Changes), lists:append(ClosuresDetected), merge_all_dicts(Persistence)}. -unzip4(L) -> unzip4(L, [], [], [], []). +unzip5(L) -> unzip5(L, [], [], [], [], []). -unzip4([], Acc1, Acc2, Acc3, Acc4) -> +unzip5([], Acc1, Acc2, Acc3, Acc4, Acc5) -> {lists:reverse(Acc1), lists:reverse(Acc2), lists:reverse(Acc3), - lists:reverse(Acc4)}; -unzip4([{A, B, C, D}|Rest], Acc1, Acc2, Acc3, Acc4) -> - unzip4(Rest, [A|Acc1], [B|Acc2], [C|Acc3], [D|Acc4]). + lists:reverse(Acc4), + lists:reverse(Acc5)}; +unzip5([{A, B, C, D, E}|Rest], Acc1, Acc2, Acc3, Acc4, Acc5) -> + unzip5(Rest, [A|Acc1], [B|Acc2], [C|Acc3], [D|Acc4], [E|Acc5]). rewrite_spec(ArgTypes, [Spec]) -> - erl_types:t_fun(ArgTypes, erl_types:t_fun_range(Spec)). + SupArgs = fun({A, B}) -> erl_types:t_sup(A, B) end, + ArgTypes1 = lists:map(SupArgs, lists:zip(ArgTypes, erl_types:t_fun_args(Spec))), + erl_types:t_fun(ArgTypes1, erl_types:t_fun_range(Spec)). mark_unreachable_clauses(Clauses, ArgType, TSM, Arg) -> case cerl:type(Arg) =:= values of @@ -767,7 +827,7 @@ is_unknown_var(X, TSM, ArgList) -> var -> ArgVarNames = [cerl:var_name(Var) || Var <- ArgList, cerl:type(Var) =:= var], case dict:find(cerl:var_name(X), TSM) of - {ok, _} -> listcontains(cerl:var_name(X), ArgVarNames); + {ok, _} -> cuter_graphs:list_contains(cerl:var_name(X), ArgVarNames); error ->true end; _ -> false @@ -820,7 +880,7 @@ update_tsm_from_guard(Clause, TSM, ArgList) -> update_tsm_from_guard_helper(Args, ArgList, Type) -> FunArgName = cerl:var_name(hd(Args)), ArgVarNames = [cerl:var_name(Var) || Var <- ArgList, cerl:type(Var) =:= var], - case listcontains(FunArgName, ArgVarNames) of + case cuter_graphs:list_contains(FunArgName, ArgVarNames) of true -> {{argtype, FunArgName}, Type}; _ -> {tsm, dict:store(FunArgName, Type, dict:new())} end. @@ -835,8 +895,9 @@ get_ann_type_dependent_unreachable([Hd|Tl]) -> end. -spec get_type_dependent_unreachable(cerl:cerl()) -> boolean(). -get_type_dependent_unreachable(T) -> get_ann_type_dependent_unreachable(cerl:get_ann(T)). +get_type_dependent_unreachable(T) -> get_ann_type_dependent_unreachable(cerl:get_ann(T)). -listcontains(_, []) -> false; -listcontains(X, [H|_]) when X =:= H -> true; -listcontains(X, [H|T]) when X =/= H -> listcontains(X, T). +merge_all_dicts(D) -> + F = fun(_Key, Value1, _Value2) -> Value1 end, + F1 = fun(D1, D2) -> dict:merge(F, D1, D2) end, + lists:foldl(F1, dict:new(), D). From 11fe091021b079f51fd754112cdcddd33387cd9d Mon Sep 17 00:00:00 2001 From: Dspil Date: Sat, 29 Jan 2022 12:52:41 +0200 Subject: [PATCH 13/85] nested functions supported in maybe_error annotation --- src/cuter_maybe_error_annotation.erl | 174 +++++++++++++++------------ 1 file changed, 99 insertions(+), 75 deletions(-) diff --git a/src/cuter_maybe_error_annotation.erl b/src/cuter_maybe_error_annotation.erl index 0becfa19..a0ed659a 100644 --- a/src/cuter_maybe_error_annotation.erl +++ b/src/cuter_maybe_error_annotation.erl @@ -109,62 +109,64 @@ add_distrust_type_dependent(Tree) -> put_vars(Vars, Flags, SM) -> lists:foldl(fun({Var, Flag}, B) -> dict:store(cerl:var_name(Var), Flag, B) end, SM, lists:zip(Vars, Flags)). +put_vars_by_name(Vars, Flags, SM) -> + lists:foldl(fun({Var, Flag}, B) -> dict:store(Var, Flag, B) end, SM, lists:zip(Vars, Flags)). + annotate_maybe_error(AST, ST, Ignored, Mod, CheckTypes) -> - {NewAST, C, _, IgnoredCall} = annotate_maybe_error(AST, ST, false, Ignored, Mod, CheckTypes), + {NewAST, C, _, IgnoredCall, _} = annotate_maybe_error(AST, ST, false, Ignored, sets:new(), Mod, CheckTypes), {NewAST, C, IgnoredCall}. --spec annotate_maybe_error(cerl:cerl(), symbol_table(), boolean(), sets:set(), module(), boolean()) -> {cerl:cerl(), boolean(), sets:set(), boolean()}. -annotate_maybe_error(Tree, SM, Force, Ignored, Mod, CheckTypes) -> +annotate_maybe_error(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes) -> CurMaybe_Error = get_maybe_error(Tree), case cerl:type(Tree) of 'apply' -> - annotate_maybe_error_apply(Tree, SM, Force, Ignored, Mod, CheckTypes, CurMaybe_Error); -% binary -> meta -% bitstr -> meta + annotate_maybe_error_apply(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes, CurMaybe_Error); call -> - annotate_maybe_error_call(Tree, SM, Force, Ignored, Mod, CheckTypes, CurMaybe_Error); + annotate_maybe_error_call(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes, CurMaybe_Error); 'case' -> - {Clauses, C1, Found1, IgnoreFound1} = annotate_maybe_error_all(cerl:case_clauses(Tree), SM, Force, Ignored, Mod, CheckTypes), + {Clauses, C1, Found1, IgnoreFound1, LetrecFound1} = annotate_maybe_error_all(cerl:case_clauses(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), ClausesError1 = get_all_maybe_error(Clauses), ClausesError = case unreachable_clauses(Clauses) of true -> maybe_error_or([ClausesError1, type_dependent]); false -> ClausesError1 end, - {Arg, C2, Found2, IgnoreFound2} = + {Arg, C2, Found2, IgnoreFound2, LetrecFound2} = case ClausesError of - true -> annotate_maybe_error(cerl:case_arg(Tree), SM, true, Ignored, Mod, CheckTypes); - type_dependent -> annotate_maybe_error(cerl:case_arg(Tree), SM, Force, Ignored, Mod, CheckTypes); - false -> annotate_maybe_error(cerl:case_arg(Tree), SM, Force, Ignored, Mod, CheckTypes) + true -> annotate_maybe_error(cerl:case_arg(Tree), SM, true, Ignored, LetrecIgnored, Mod, CheckTypes); + type_dependent -> annotate_maybe_error(cerl:case_arg(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes); + false -> annotate_maybe_error(cerl:case_arg(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes) end, NewMaybe_Error = maybe_error_or([get_maybe_error(Arg), ClausesError]), - {cerl:update_c_case(update_ann(Tree, NewMaybe_Error), Arg, Clauses), C1 or C2, sets:union([Found1, Found2]), IgnoreFound1 or IgnoreFound2}; + {cerl:update_c_case(update_ann(Tree, NewMaybe_Error), Arg, Clauses), C1 or C2, sets:union([Found1, Found2]), IgnoreFound1 or IgnoreFound2, sets:union([LetrecFound1, LetrecFound2])}; clause -> {Pats, C1, Found1, SM1} = annotate_maybe_error_pattern_all(cerl:clause_pats(Tree), SM, Force), IgnoreFound1 = false, - {Guard, C2, Found2, IgnoreFound2} = annotate_maybe_error(cerl:clause_guard(Tree), SM1, Force, Ignored, Mod, CheckTypes), - {Body, C3, Found3, IgnoreFound3} = annotate_maybe_error(cerl:clause_body(Tree), SM1, Force, Ignored, Mod, CheckTypes), + {Guard, C2, Found2, IgnoreFound2, LetrecFound2} = annotate_maybe_error(cerl:clause_guard(Tree), SM1, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + {Body, C3, Found3, IgnoreFound3, LetrecFound3} = annotate_maybe_error(cerl:clause_body(Tree), SM1, Force, Ignored, LetrecIgnored, Mod, CheckTypes), NewIgnoreFound = IgnoreFound1 or IgnoreFound2 or IgnoreFound3, + NewLetrecFound = sets:union([LetrecFound2, LetrecFound3]), NewMaybe_Error = maybe_error_or([get_maybe_error(Body), get_all_maybe_error(Pats), get_maybe_error(Guard)]), - {cerl:update_c_clause(update_ann(Tree, NewMaybe_Error), Pats, Guard, Body), C1 or C2 or C3, sets:union([Found1, Found2, Found3]), NewIgnoreFound}; + {cerl:update_c_clause(update_ann(Tree, NewMaybe_Error), Pats, Guard, Body), C1 or C2 or C3, sets:union([Found1, Found2, Found3]), NewIgnoreFound, NewLetrecFound}; cons -> - {Hd, C1, Found1, IgnoreFound1} = annotate_maybe_error(cerl:cons_hd(Tree), SM, Force, Ignored, Mod, CheckTypes), - {Tl, C2, Found2, IgnoreFound2} = annotate_maybe_error(cerl:cons_tl(Tree), SM, Force, Ignored, Mod, CheckTypes), + {Hd, C1, Found1, IgnoreFound1, LetrecFound1} = annotate_maybe_error(cerl:cons_hd(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + {Tl, C2, Found2, IgnoreFound2, LetrecFound2} = annotate_maybe_error(cerl:cons_tl(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), NewIgnoreFound = IgnoreFound1 or IgnoreFound2, + NewLetrecFound = sets:union([LetrecFound1, LetrecFound2]), NewMaybe_Error = maybe_error_or([get_maybe_error(Hd), get_maybe_error(Tl)]), - {cerl:update_c_cons_skel(update_ann(Tree, NewMaybe_Error), Hd, Tl), C1 or C2, sets:union([Found1, Found2]), NewIgnoreFound}; + {cerl:update_c_cons_skel(update_ann(Tree, NewMaybe_Error), Hd, Tl), C1 or C2, sets:union([Found1, Found2]), NewIgnoreFound, NewLetrecFound}; 'fun' -> Flags = make_fun_flags(cerl:fun_vars(Tree)), SM1 = put_vars(cerl:fun_vars(Tree), Flags, SM), - {Vars, C1, Found1, IgnoreFound1} = annotate_maybe_error_all(cerl:fun_vars(Tree), SM1, Force, Ignored, Mod, CheckTypes), - {Body, C2, Found2, IgnoreFound2} = annotate_maybe_error(cerl:fun_body(Tree), SM1, Force, Ignored, Mod, CheckTypes), + {Vars, C1, Found1, IgnoreFound1, LetrecFound1} = annotate_maybe_error_all(cerl:fun_vars(Tree), SM1, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + {Body, C2, Found2, IgnoreFound2, LetrecFound2} = annotate_maybe_error(cerl:fun_body(Tree), SM1, Force, Ignored, LetrecIgnored, Mod, CheckTypes), NewMaybe_Error = maybe_error_or([get_maybe_error(Body), get_all_maybe_error(Vars)]), - {cerl:update_c_fun(update_ann(Tree, NewMaybe_Error), Vars, Body), C1 or C2, sets:union([Found1, Found2]), IgnoreFound1 or IgnoreFound2}; + {cerl:update_c_fun(update_ann(Tree, NewMaybe_Error), Vars, Body), C1 or C2, sets:union([Found1, Found2]), IgnoreFound1 or IgnoreFound2, sets:union([LetrecFound1, LetrecFound2])}; 'let' -> - {Arg, C2, Found1, IgnoreFound1} = annotate_maybe_error(cerl:let_arg(Tree), SM, Force, Ignored, Mod, CheckTypes), + {Arg, C2, Found1, IgnoreFound1, LetrecFound1} = annotate_maybe_error(cerl:let_arg(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), SM1 = put_vars(cerl:let_vars(Tree), get_arg_maybe_errors(Arg), SM), - {Vars, C1, Found2, IgnoreFound2} = annotate_maybe_error_all(cerl:let_vars(Tree), SM1, Force, Ignored, Mod, CheckTypes), - {Body, C3, Found3, IgnoreFound3} = annotate_maybe_error(cerl:let_body(Tree), SM1, Force, Ignored, Mod, CheckTypes), + {Vars, C1, Found2, IgnoreFound2, LetrecFound2} = annotate_maybe_error_all(cerl:let_vars(Tree), SM1, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + {Body, C3, Found3, IgnoreFound3, LetrecFound3} = annotate_maybe_error(cerl:let_body(Tree), SM1, Force, Ignored, LetrecIgnored, Mod, CheckTypes), Tree1 = case vars_in_set(cerl:let_vars(Tree), Found3) of true -> @@ -174,38 +176,39 @@ annotate_maybe_error(Tree, SM, Force, Ignored, Mod, CheckTypes) -> end, NewMaybe_Error = maybe_error_or([get_all_maybe_error(Vars), get_maybe_error(Arg), get_maybe_error(Body)]), NewIgnoreFound = IgnoreFound1 or IgnoreFound2 or IgnoreFound3, - {cerl:update_c_let(update_ann(Tree1, NewMaybe_Error), Vars, Arg, Body), C1 or C2 or C3, sets:union([Found1, Found2, Found3]), NewIgnoreFound}; + NewLetrecFound = sets:union([LetrecFound1, LetrecFound2, LetrecFound3]), + {cerl:update_c_let(update_ann(Tree1, NewMaybe_Error), Vars, Arg, Body), C1 or C2 or C3, sets:union([Found1, Found2, Found3]), NewIgnoreFound, NewLetrecFound}; letrec -> - annotate_maybe_error_letrec(Tree, SM, Force, Ignored, Mod, CheckTypes, CurMaybe_Error); + annotate_maybe_error_letrec(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes, CurMaybe_Error); literal -> - {update_ann(Tree, false), true == CurMaybe_Error, sets:new(), false}; + {update_ann(Tree, false), true == CurMaybe_Error, sets:new(), false, sets:new()}; primop -> - {update_ann(Tree, true), false == CurMaybe_Error, sets:new(), false}; - 'receive' -> throw("Error annotation not supporting receive at the moment"); + {update_ann(Tree, true), false == CurMaybe_Error, sets:new(), false, sets:new()}; seq -> - {Arg, C1, Found1, IgnoreFound1} = annotate_maybe_error(cerl:seq_arg(Tree), SM, Force, Ignored, Mod, CheckTypes), - {Body, C2, Found2, IgnoreFound2} = annotate_maybe_error(cerl:seq_body(Tree), SM, Force, Ignored, Mod, CheckTypes), + {Arg, C1, Found1, IgnoreFound1, LetrecFound1} = annotate_maybe_error(cerl:seq_arg(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + {Body, C2, Found2, IgnoreFound2, LetrecFound2} = annotate_maybe_error(cerl:seq_body(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), NewIgnoreFound = IgnoreFound1 or IgnoreFound2, + NewLetrecFound = sets:union([LetrecFound1, LetrecFound2]), NewMaybe_Error = maybe_error_or([get_maybe_error(Arg), get_maybe_error(Body)]), - {cerl:update_c_seq(update_ann(Tree, NewMaybe_Error), Arg, Body), C1 or C2, sets:union([Found1, Found2]), NewIgnoreFound}; + {cerl:update_c_seq(update_ann(Tree, NewMaybe_Error), Arg, Body), C1 or C2, sets:union([Found1, Found2]), NewIgnoreFound, NewLetrecFound}; 'try' -> - {Arg, C1, Found1, IgnoreFound1} = annotate_maybe_error(cerl:try_arg(Tree), SM, Force, Ignored, Mod, CheckTypes), - {Vars, C2, Found2, IgnoreFound2} = annotate_maybe_error_all(cerl:try_vars(Tree), SM, Force, Ignored, Mod, CheckTypes), - {Body, C3, Found3, IgnoreFound3} = annotate_maybe_error(cerl:try_body(Tree), SM, Force, Ignored, Mod, CheckTypes), - {Evars, C4, Found4, IgnoreFound4} = annotate_maybe_error_all(cerl:try_evars(Tree), SM, Force, Ignored, Mod, CheckTypes), - {Handler, C5, Found5, IgnoreFound5} = annotate_maybe_error(cerl:try_handler(Tree), SM, Force, Ignored, Mod, CheckTypes), + {Arg, C1, Found1, IgnoreFound1, LetrecFound1} = annotate_maybe_error(cerl:try_arg(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + {Vars, C2, Found2, IgnoreFound2, LetrecFound2} = annotate_maybe_error_all(cerl:try_vars(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + {Body, C3, Found3, IgnoreFound3, LetrecFound3} = annotate_maybe_error(cerl:try_body(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + {Evars, C4, Found4, IgnoreFound4, LetrecFound4} = annotate_maybe_error_all(cerl:try_evars(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + {Handler, C5, Found5, IgnoreFound5, LetrecFound5} = annotate_maybe_error(cerl:try_handler(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), NewIgnoreFound = IgnoreFound1 or IgnoreFound2 or IgnoreFound3 or IgnoreFound4 or IgnoreFound5, + NewLetrecFound = sets:union([LetrecFound1, LetrecFound2, LetrecFound3, LetrecFound4, LetrecFound5]), NewMaybe_Error = get_maybe_error(Arg), - {cerl:update_c_try(update_ann(Tree, NewMaybe_Error), Arg, Vars, Body, Evars, Handler), C1 or C2 or C3 or C4 or C5, sets:union([Found1, Found2, Found3, Found4, Found5]), NewIgnoreFound}; -% 'catch' -> + {cerl:update_c_try(update_ann(Tree, NewMaybe_Error), Arg, Vars, Body, Evars, Handler), C1 or C2 or C3 or C4 or C5, sets:union([Found1, Found2, Found3, Found4, Found5]), NewIgnoreFound, NewLetrecFound}; tuple -> - {Es, C, Found, IgnoreFound} = annotate_maybe_error_all(cerl:tuple_es(Tree), SM, Force, Ignored, Mod, CheckTypes), + {Es, C, Found, IgnoreFound, LetrecFound} = annotate_maybe_error_all(cerl:tuple_es(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), NewMaybe_Error = get_all_maybe_error(Es), - {cerl:update_c_tuple(update_ann(Tree, NewMaybe_Error), Es), C, Found, IgnoreFound}; + {cerl:update_c_tuple(update_ann(Tree, NewMaybe_Error), Es), C, Found, IgnoreFound, LetrecFound}; values -> - {Es, C, Found, IgnoreFound} = annotate_maybe_error_all(cerl:values_es(Tree), SM, Force, Ignored, Mod, CheckTypes), + {Es, C, Found, IgnoreFound, LetrecFound} = annotate_maybe_error_all(cerl:values_es(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), NewMaybe_Error = get_all_maybe_error(Es), - {cerl:update_c_values(update_ann(Tree, NewMaybe_Error), Es), C, Found, IgnoreFound}; + {cerl:update_c_values(update_ann(Tree, NewMaybe_Error), Es), C, Found, IgnoreFound, LetrecFound}; var -> Found = case Force of @@ -214,17 +217,17 @@ annotate_maybe_error(Tree, SM, Force, Ignored, Mod, CheckTypes) -> end, case dict:find(cerl:var_name(Tree), SM) of {ok, {Value, _}} -> - {update_ann(Tree, Value), Value =/= CurMaybe_Error, Found, false}; + {update_ann(Tree, Value), Value =/= CurMaybe_Error, Found, false, sets:new()}; error -> - {update_ann(Tree, true), true =/= CurMaybe_Error, Found, false} + {update_ann(Tree, true), true =/= CurMaybe_Error, Found, false, sets:new()} end; _ -> - {update_ann(Tree, true), true =/= CurMaybe_Error, sets:new(), false} + {update_ann(Tree, true), true =/= CurMaybe_Error, sets:new(), false, sets:new()} end. -annotate_maybe_error_apply(Tree, SM, Force, Ignored, Mod, CheckTypes, CurMaybe_Error) -> +annotate_maybe_error_apply(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes, CurMaybe_Error) -> Op = cerl:apply_op(Tree), - {Op1, C1, IgnoreFound1} = + {Op1, C1, IgnoreFound1, LetrecFound1} = case cerl:type(Op) of var -> case cerl:var_name(Op) of @@ -234,29 +237,34 @@ annotate_maybe_error_apply(Tree, SM, Force, Ignored, Mod, CheckTypes, CurMaybe_E case Value of type_dependent when CheckTypes -> case cuter_spec_checker:get_cerl_type(Tree) of - notype -> {update_ann(Op, true), true =/= CurMaybe_Error, false}; - _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false} + notype -> {update_ann(Op, true), true =/= CurMaybe_Error, false, sets:new()}; + _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false, sets:new()} end; - _ -> {update_ann(Op, Value), Value =/= CurMaybe_Error, false} + _ -> {update_ann(Op, Value), Value =/= CurMaybe_Error, false, sets:new()} end; - _ -> + error -> case dict:find({F, A}, SM) of {ok, {Value, FunType}} when FunType =:= 'fun' orelse FunType =:= letvar -> case Value of type_dependent when CheckTypes -> case cuter_spec_checker:get_cerl_type(Tree) of - notype -> {update_ann(Op, true), true =/= CurMaybe_Error, false}; - _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false} + notype -> {update_ann(Op, true), true =/= CurMaybe_Error, false, sets:new()}; + _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false, sets:new()} end; _ -> - {update_ann(Op, Value), Value =/= CurMaybe_Error, false} + {update_ann(Op, Value), Value =/= CurMaybe_Error, false, sets:new()} end; - _ -> + error -> case sets:is_element({Mod, F, A}, Ignored) of false -> - {update_ann(Op, true), true =/= CurMaybe_Error, false}; + case sets:is_element({F, A}, LetrecIgnored) of + true -> + {Op, false, false, sets:from_list([{F, A}])}; + false -> + {update_ann(Op, true), true =/= CurMaybe_Error, false, sets:new()} + end; true -> - {update_ann(Op, false), true =/= CurMaybe_Error, true} + {update_ann(Op, false), true =/= CurMaybe_Error, true, sets:new()} end end end; @@ -279,7 +287,7 @@ annotate_maybe_error_apply(Tree, SM, Force, Ignored, Mod, CheckTypes, CurMaybe_E _ -> error("unhandled op") end, - {Args, C2, Found, IgnoreFound2} = annotate_maybe_error_all(cerl:apply_args(Tree), SM, Force, Ignored, Mod, CheckTypes), + {Args, C2, Found, IgnoreFound2, LetrecFound2} = annotate_maybe_error_all(cerl:apply_args(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), NewMaybe_Error = maybe_error_or([get_maybe_error(Op1), get_all_maybe_error(Args)]), case get_all_maybe_error(Args) of true -> @@ -287,9 +295,9 @@ annotate_maybe_error_apply(Tree, SM, Force, Ignored, Mod, CheckTypes, CurMaybe_E _ -> Tree1 = Tree end, - {cerl:update_c_apply(update_ann(Tree1, NewMaybe_Error), Op1, Args), C1 or C2, Found, IgnoreFound1 or IgnoreFound2}. + {cerl:update_c_apply(update_ann(Tree1, NewMaybe_Error), Op1, Args), C1 or C2, Found, IgnoreFound1 or IgnoreFound2, sets:union([LetrecFound1, LetrecFound2])}. -annotate_maybe_error_call(Tree, SM, Force, Ignored, Mod, CheckTypes, CurMaybe_Error) -> +annotate_maybe_error_call(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes, CurMaybe_Error) -> ModName = cerl:call_module(Tree), Name = cerl:call_name(Tree), Arity = length(cerl:call_args(Tree)), @@ -316,7 +324,7 @@ annotate_maybe_error_call(Tree, SM, Force, Ignored, Mod, CheckTypes, CurMaybe_Er end; _ -> throw("Unsupported call") end, - {Args, C1, Found, IgnoreFound2} = annotate_maybe_error_all(cerl:call_args(Tree), SM, Force, Ignored, Mod, CheckTypes), + {Args, C1, Found, IgnoreFound2, LetrecFound} = annotate_maybe_error_all(cerl:call_args(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), NewMaybe_Error = maybe_error_or([NewAnn, get_all_maybe_error(Args)]), C2 = NewMaybe_Error =/= CurMaybe_Error, case get_all_maybe_error(Args) of @@ -325,19 +333,35 @@ annotate_maybe_error_call(Tree, SM, Force, Ignored, Mod, CheckTypes, CurMaybe_Er _ -> Tree1 = Tree end, - {cerl:update_c_call(update_ann(Tree1, NewMaybe_Error), ModName, Name, Args), C1 or C2, Found, IgnoreFound1 or IgnoreFound2}. + {cerl:update_c_call(update_ann(Tree1, NewMaybe_Error), ModName, Name, Args), C1 or C2, Found, IgnoreFound1 or IgnoreFound2, LetrecFound}. -annotate_maybe_error_letrec(Tree, SM, Force, Ignored, Mod, CheckTypes, CurMaybe_Error) -> +annotate_maybe_error_letrec(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes, CurMaybe_Error) -> {Names, Funsb} = lists:unzip(cerl:letrec_defs(Tree)), - %FunNames = [cerl:var_name(Name) || Name <- Names], - %FunNames1 = sets:from_list([{Mod, F, A} || {F, A} <- FunNames]), - %NewIgnored = sets:union(Ignored, FunNames1), - {Funs, C1, Found1, IgnoreFound1} = annotate_maybe_error_all(Funsb, SM, Force, Ignored, Mod, CheckTypes), + FunNames = [cerl:var_name(Name) || Name <- Names], + FunNames1 = sets:from_list(FunNames), + NewIgnored = sets:union(LetrecIgnored, FunNames1), + {Funs, C1, Found1, IgnoreFound1, LetrecFound1} = annotate_maybe_error_letrec_fix(FunNames, Funsb, SM, Force, Ignored, NewIgnored, Mod, CheckTypes), SM1 = put_vars(Names, [{get_maybe_error_pessimistic(A), letvar} || A <- Funs], SM), - {Body, C2, Found2, IgnoreFound2} = annotate_maybe_error(cerl:letrec_body(Tree), SM1, Force, Ignored, Mod, CheckTypes), + {Body, C2, Found2, IgnoreFound2, LetrecFound2} = annotate_maybe_error(cerl:letrec_body(Tree), SM1, Force, Ignored, LetrecIgnored, Mod, CheckTypes), NewMaybe_Error = get_maybe_error(Body), Change = C1 or C2 or (CurMaybe_Error =/= NewMaybe_Error), - {cerl:update_c_letrec(update_ann(Tree, NewMaybe_Error), lists:zip(Names, Funs), Body), Change, sets:union([Found1, Found2]), IgnoreFound1 or IgnoreFound2}. + {cerl:update_c_letrec(update_ann(Tree, NewMaybe_Error), lists:zip(Names, Funs), Body), Change, sets:union([Found1, Found2]), IgnoreFound1 or IgnoreFound2, sets:union([LetrecFound1, LetrecFound2])}. + +annotate_maybe_error_letrec_fix(Names, Funsb, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes) -> + annotate_maybe_error_letrec_fix(Names, Funsb, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes, false). + + +annotate_maybe_error_letrec_fix(Names, Funsb, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes, Acc) -> + {Funs, C, Found, IgnoreFound, LetrecFound} = annotate_maybe_error_all(Funsb, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + ThisLetrecFound = sets:filter(fun(X) -> cuter_graphs:list_contains(X, Names) end, LetrecFound), + case C or (sets:size(ThisLetrecFound) > 0) of + true -> + SM1 = put_vars_by_name(Names, [{get_maybe_error_pessimistic(A), letvar} || A <- Funs], SM), + annotate_maybe_error_letrec_fix(Names, Funs, SM1, Force, Ignored, LetrecIgnored, Mod, CheckTypes, C or Acc); + false -> + RestLetrecFound = sets:filter(fun(X) -> not cuter_graphs:list_contains(X, Names) end, LetrecFound), + {Funs, Acc, Found, IgnoreFound, RestLetrecFound} + end. annotate_maybe_error_pattern(Tree, SM, Force) -> CurMaybe_Error = get_maybe_error(Tree), @@ -379,10 +403,10 @@ annotate_maybe_error_pattern(Tree, SM, Force) -> get_arg_maybe_errors(Arg) -> [{get_maybe_error_pessimistic(Arg), letvar}]. -annotate_maybe_error_all(Trees, SM, Force, Ignored, Mod, CheckTypes) -> - X = [annotate_maybe_error(T, SM, Force, Ignored, Mod, CheckTypes) || T <- Trees], - MyOr = fun(E) -> fun(A, B) -> B or element(E, A) end end, - {[element(1, Y) || Y <- X], lists:foldl(MyOr(2), false, X), sets:union([element(3, Z) || Z <- X]), lists:foldl(MyOr(4), false, X)}. +annotate_maybe_error_all(Trees, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes) -> + X = [annotate_maybe_error(T, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes) || T <- Trees], + Or = fun(E) -> fun(A, B) -> B or element(E, A) end end, + {[element(1, Y) || Y <- X], lists:foldl(Or(2), false, X), sets:union([element(3, Z) || Z <- X]), lists:foldl(Or(4), false, X), sets:union([element(5, Z) || Z <- X])}. annotate_maybe_error_pattern_all(Trees, SM, Force) -> annotate_maybe_error_pattern_all(Trees, SM, Force, [], false, sets:new()). From 1f393b95070bb727c800485b36be1bf4157c3dc7 Mon Sep 17 00:00:00 2001 From: Dspil Date: Thu, 10 Feb 2022 21:37:20 +0200 Subject: [PATCH 14/85] added function spec conversion to erl_types --- cuter | 3 + include/cuter_macros.hrl | 2 + src/cuter.erl | 28 ++-- src/cuter_codeserver.erl | 17 ++- src/cuter_types.erl | 292 +++++++++++++++++++++++++++++++++++++++ 5 files changed, 331 insertions(+), 11 deletions(-) diff --git a/cuter b/cuter index 9a72d699..d369aa64 100755 --- a/cuter +++ b/cuter @@ -38,6 +38,7 @@ def main(): parser.add_argument("-m", "--metrics", action='store_true', help="report collected metrics") parser.add_argument("--debug-keep-traces", action='store_true', help="keep execution traces for debugging") parser.add_argument("--debug-solver-fsm", action='store_true', help="output debug logs for the solver FSM") + parser.add_argument("-ps", "--prune-safe", action='store_true', help="prune safe paths and stop the execution early") # Parse the arguments args = parser.parse_args() @@ -109,6 +110,8 @@ def main(): opts.append("debug_keep_traces") if args.debug_solver_fsm: opts.append("debug_solver_fsm") + if args.prune_safe: + opts.append("prune_safe") strOpts = ",".join(opts) # Run CutEr diff --git a/include/cuter_macros.hrl b/include/cuter_macros.hrl index 8572c4cd..ae5b13cd 100644 --- a/include/cuter_macros.hrl +++ b/include/cuter_macros.hrl @@ -89,6 +89,8 @@ -define(NUM_SOLVERS, number_of_solvers). %% Sets the number of concurrent concolic execution processes. -define(NUM_POLLERS, number_of_pollers). +%% Prune safe paths. +-define(PRUNE_SAFE, prune_safe). -type runtime_options() :: {?Z3_TIMEOUT, pos_integer()} | ?REPORT_METRICS diff --git a/src/cuter.erl b/src/cuter.erl index 62bdc126..d54e0828 100644 --- a/src/cuter.erl +++ b/src/cuter.erl @@ -48,7 +48,7 @@ run(M, F, As, Depth, Options) -> Seeds = [{M, F, As, Depth}], run(Seeds, Options). --spec run([seed()], options()) -> erroneous_inputs(). +-spec run([seed(),...], options()) -> erroneous_inputs(). %% Runs CutEr on multiple units. run(Seeds, Options) -> State = state_from_options_and_seeds(Options, Seeds), @@ -87,7 +87,8 @@ run_from_file(File, Options) -> %% The tasks to run during the app initialization. init_tasks() -> [fun ensure_exported_entry_points/1, - fun compute_callgraph/1]. + fun compute_callgraph/1, + fun annotate_for_possible_errors/1]. -spec init(state()) -> ok | error. init(State) -> @@ -128,10 +129,17 @@ compute_callgraph(State) -> Mfas = mfas_from_state(State), cuter_codeserver:calculate_callgraph(State#st.codeServer, Mfas). - mfas_from_state(State) -> [{M, F, length(As)} || {M, F, As, _} <- State#st.seeds]. +annotate_for_possible_errors(State) -> + case cuter_config:fetch(?PRUNE_SAFE) of + {ok, true} -> + cuter_codeserver:annotate_for_possible_errors(State#st.codeServer); + _ -> + ok + end. + %% ---------------------------------------------------------------------------- %% Manage the concolic executions %% ---------------------------------------------------------------------------- @@ -143,8 +151,7 @@ start(State) -> -spec start([seed()], state()) -> state(). start([], State) -> State; -start([{M, F, As, Depth}|Seeds], State) -> - CodeServer = State#st.codeServer, +start([{M, F, As, Depth}|Seeds], State) -> CodeServer = State#st.codeServer, Scheduler = State#st.scheduler, Errors = start_one(M, F, As, Depth, CodeServer, Scheduler), NewErrors = [{{M, F, length(As)}, Errors}|State#st.errors], @@ -239,7 +246,7 @@ stop(State) -> %% Generate the system state %% ---------------------------------------------------------------------------- --spec state_from_options_and_seeds(options(), [seed()]) -> state(). +-spec state_from_options_and_seeds(options(), [seed(),...]) -> state(). state_from_options_and_seeds(Options, Seeds) -> process_flag(trap_exit, true), error_logger:tty(false), %% disable error_logger @@ -247,7 +254,7 @@ state_from_options_and_seeds(Options, Seeds) -> ok = cuter_metrics:start(), ok = define_metrics(), enable_debug_config(Options), - enable_runtime_config(Options), + enable_runtime_config(Options, Seeds), ok = cuter_pp:start(), CodeServer = cuter_codeserver:start(), SchedPid = cuter_scheduler:start(?DEFAULT_DEPTH, CodeServer), @@ -265,8 +272,8 @@ enable_debug_config(Options) -> cuter_config:store(?DEBUG_SMT, proplists:get_bool(?DEBUG_SMT, Options)), cuter_config:store(?DEBUG_SOLVER_FSM, proplists:get_bool(?DEBUG_SOLVER_FSM, Options)). --spec enable_runtime_config(options()) -> ok. -enable_runtime_config(Options) -> +-spec enable_runtime_config(options(), [seed(),...]) -> ok. +enable_runtime_config(Options, [{_M, _F, _I, _D}|_]) -> {ok, CWD} = file:get_cwd(), cuter_config:store(?WORKING_DIR, cuter_lib:get_tmp_dir(proplists:get_value(?WORKING_DIR, Options, CWD))), @@ -284,7 +291,8 @@ enable_runtime_config(Options) -> cuter_config:store(?SORTED_ERRORS, proplists:get_bool(?SORTED_ERRORS, Options)), cuter_config:store(?WHITELISTED_MFAS, whitelisted_mfas(Options)), cuter_config:store(?NUM_SOLVERS, proplists:get_value(?NUM_SOLVERS, Options, ?ONE)), - cuter_config:store(?NUM_POLLERS, proplists:get_value(?NUM_POLLERS, Options, ?ONE)). + cuter_config:store(?NUM_POLLERS, proplists:get_value(?NUM_POLLERS, Options, ?ONE)), + cuter_config:store(?PRUNE_SAFE, proplists:get_bool(?PRUNE_SAFE, Options)). verbosity_level(Options) -> Default = cuter_pp:default_reporting_level(), diff --git a/src/cuter_codeserver.erl b/src/cuter_codeserver.erl index d4962a51..00808723 100644 --- a/src/cuter_codeserver.erl +++ b/src/cuter_codeserver.erl @@ -10,6 +10,8 @@ visit_tag/2, calculate_callgraph/2, %% Work with module cache merge_dumped_cached_modules/2, modules_of_dumped_cache/1, + %% Code annotations + annotate_for_possible_errors/1, %% Access logs cachedMods_of_logs/1, visitedTags_of_logs/1, tagsAddedNo_of_logs/1, unsupportedMfas_of_logs/1, loadedMods_of_logs/1]). @@ -142,6 +144,11 @@ calculate_callgraph(CodeServer, Mfas) -> get_feasible_tags(CodeServer, NodeTypes) -> gen_server:call(CodeServer, {get_feasible_tags, NodeTypes}). +%% Annotates the code for possible errors. +-spec annotate_for_possible_errors(codeserver()) -> ok. +annotate_for_possible_errors(CodeServer) -> + gen_server:call(CodeServer, annotate_for_possible_errors). + %% ---------------------------------------------------------------------------- %% gen_server callbacks (Server Implementation) %% ---------------------------------------------------------------------------- @@ -182,6 +189,7 @@ handle_info(_Msg, State) -> ; (get_whitelist, from(), state()) -> {reply, cuter_mock:whitelist(), state()} ; ({get_feasible_tags, cuter_cerl:node_types()}, from(), state()) -> {reply, cuter_cerl:visited_tags(), state()} ; ({calculate_callgraph, [mfa()]}, from(), state()) -> {reply, ok, state()} + ; (annotate_for_possible_errors, from(), state()) -> {reply, ok, state()} . handle_call({load, M}, _From, State) -> {reply, try_load(M, State), State}; @@ -231,7 +239,14 @@ handle_call({calculate_callgraph, Mfas}, _From, State=#st{whitelist = Whitelist} end, cuter_callgraph:foreachModule(LoadFn, Callgraph), {reply, ok, State#st{callgraph = Callgraph}} - end. + end; +handle_call(annotate_for_possible_errors, _From, State=#st{db = Db}) -> + Fn2 = fun({_M, Kmodule}, Acc) -> + [Kmodule|Acc] + end, + Kmodules = ets:foldl(Fn2, [], Db), + _MfasToSpecs = cuter_types:parse_specs(Kmodules), + {reply, ok, State}. %% gen_server callback : handle_cast/2 -spec handle_cast(stop, state()) -> {stop, normal, state()} | {noreply, state()} diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 6eb96199..032204f1 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -23,6 +23,8 @@ -export([erl_type_deps_map/2, get_type_name_from_type_dep/1, get_type_from_type_dep/1, unique_type_name/3]). +-export([parse_specs/1]). + -export_type([erl_type/0, erl_spec_clause/0, erl_spec/0, stored_specs/0, stored_types/0, stored_spec_value/0, t_range_limit/0]). -export_type([erl_type_dep/0, erl_type_deps/0]). @@ -1213,3 +1215,293 @@ get_type_name_from_type_dep({Name, _Type}) -> -spec get_type_from_type_dep(erl_type_dep()) -> erl_type(). get_type_from_type_dep({_Name, Type}) -> Type. + +%% ---------------------------------------------------------------------------- +%% API for erl_types:erl_type(). +%% Here a fix point computation is defined which converts all specs in a list +%% of modules to their erl_type representation +%% ---------------------------------------------------------------------------- + +-define(CUTER_RECORD_TYPE_PREFIX, "__cuter_record_type__"). + +var_name({var, _, X}) -> + X. + +%% Find the erl type representation of all signatures in a list of kmodules +-spec parse_specs([cuter_cerl:kmodule()]) -> dict:dict(). +parse_specs(Kmodules) -> + RecDict = ets:new(recdict, []), %% Needed for erl_types:t_from_form/6 + ExpTypes = sets:union([cuter_cerl:kmodule_exported_types(M) || M <- Kmodules]), %% Needed for erl_types:t_from_form/6 + Fn = fun (Kmodule, Acc) -> + Mod = cuter_cerl:kmodule_name(Kmodule), + TypesLines = all_types_from_cerl(Kmodule), + U = sets:from_list([{TName, length(Vars)} || {{TName, _T, Vars}, _L} <- TypesLines]), + dict:store(Mod, U, Acc) + end, + %% Unhandled holds all non converted types from a form to an erl_type for each module. + %% It is a dict with the module name as the key and all the types defined in it initially. + Unhandled = lists:foldl(Fn, dict:new(), Kmodules), + %% Find all signatures + Ret = parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, dict:new()), + ets:delete(RecDict), + Ret. + +%% Convert all signatures in all modules until none can be converted +parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, GatheredSpecs) -> + %% Pass all modules + {Unhandled1, Change, GatheredSpecs1} = parse_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, false, GatheredSpecs), + case Change of %% If Unhandled has changed in this pass + %% Pass again + true -> + parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled1, GatheredSpecs1); + %% Else return the gathered signatures + false -> + GatheredSpecs1 + end. + +%% Pass through all modules and gather signatures +parse_specs_fix_pass([], _ExpTypes, _RecDict, Unhandled, Change, GatheredSpecs) -> {Unhandled, Change, GatheredSpecs}; +parse_specs_fix_pass([Kmodule|Kmodules], ExpTypes, RecDict, Unhandled, Change, GatheredSpecs) -> + Mod = cuter_cerl:kmodule_name(Kmodule), + PrevUnhandled = dict:fetch(Mod, Unhandled), + %% Get the signatures converted and the unhandled types of this module + {Specs, NewUnhandled} = parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled), + Fn = fun ({MFA, Spec}, G) -> + dict:store(MFA, Spec, G) + end, + %% Store the new signatures found in GatheredSpecs + GatheredSpecs1 = lists:foldl(Fn, GatheredSpecs, Specs), + %% If the unhandled types for this module have not changed + case equal_sets(NewUnhandled, PrevUnhandled) of + %% Maintain the Change so far in the recursive call + true -> parse_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, Change, GatheredSpecs1); + %% A change has occured, make the recursive call with Change: true and an updated Unhandled dict + false -> parse_specs_fix_pass(Kmodules, ExpTypes, RecDict, dict:store(Mod, NewUnhandled, Unhandled), true, GatheredSpecs1) + end. + +%% Gather all signatures defined in a module. +%% Return all signatures that can be converted to erl_types +%% and all the types that couldn't +parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled) -> + %% Fetch type forms from the kmodule along with the lines where they were defined. + %% The lines are needed for the erl_types:t_from_form/6 call + TypesLines = all_types_from_cerl(Kmodule), + Mod = cuter_cerl:kmodule_name(Kmodule), + %% Only Unhandled is returned because types will be stored in RecDict ets table + Unhandled = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled), + Fn = fun ({{F, A}, S1}) -> %% For a function F with arity A and signature S1 which is a list + %% Replace records with temp record types in the signature + S = spec_replace_records(spec_replace_bounded(S1)), + %% Convert each element of the list into an erl_type + ErlSpecs = convert_list_to_erl(S, {Mod, F, A}, ExpTypes, RecDict), + {{Mod, F, A}, ErlSpecs} + end, + Specs = lists:map(Fn, cuter_cerl:kmodule_spec_forms(Kmodule)), + {Specs, Unhandled}. + +%% Convert as many types in Mod as possible to erl_types. +%% For every succesful conversion add it to RecDict and finally +%% return the types that couldn't be converted. +%% If there are more succesful conversions as before try again. +%% This is done to handle types depending on later defined types +%% or mutually recursive types immediately +fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled) -> + F = fun ({{Tname, T, Vars}, L}, Acc) -> %% Get a type and a set of unhandled types + A = length(Vars), + %% Try to convert the type to erl_type using erl_types:t_from_form/6 + {{T1, _C}, D1} = + try erl_types:t_from_form(T, ExpTypes, {'type', {Mod, Tname, A}}, RecDict, erl_types:var_table__new(), erl_types:cache__new()) of + Ret -> {Ret, false} + catch + _:_ -> + {{none, none}, true} + end, + %% Check if the conversion was successful + case D1 of + %% If it was, add the new erl_type in RecDict + false -> + case ets:lookup(RecDict, Mod) of + [{Mod, VT}] -> + ets:insert(RecDict, {Mod, maps:put({'type', Tname, A}, {{Mod, {lists:append(atom_to_list(Mod), ".erl"), L}, T, [var_name(Var) || Var <- Vars]}, T1}, VT)}), + Acc; + _ -> + ets:insert(RecDict, {Mod, maps:put({'type', Tname, A}, {{Mod, {lists:append(atom_to_list(Mod), ".erl"), L}, T, [var_name(Var) || Var <- Vars]}, T1}, maps:new())}), + Acc + end; + %% Else, add the type to the Unhandled set + true -> + sets:add_element({Tname, A}, Acc) + end + end, + %% Apply F to all Types in the module + Unhandled = lists:foldl(F, sets:new(), TypesLines), + %% Check if the unhandled types are different than before + case equal_sets(PrevUnhandled, Unhandled) of + %% If they are, run the module again + false -> + fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, Unhandled); + %% Else return the unhandled types + true -> + Unhandled + end. + +%% Convert a list of forms to a list of erl_types +convert_list_to_erl(S, MFA, ExpTypes, RecDict) -> + convert_list_to_erl(S, MFA, ExpTypes, RecDict, []). + +convert_list_to_erl([], _MFA, _ExpTypes, _RecDict, Acc) -> lists:reverse(Acc); +convert_list_to_erl([Spec|Specs], MFA, ExpTypes, RecDict, Acc) -> + ErlSpec = + try erl_types:t_from_form(Spec, ExpTypes, {'spec', MFA}, RecDict, erl_types:var_table__new(), erl_types:cache__new()) of + {S, _C} -> S + catch + _:_ -> nospec + end, + case ErlSpec of + nospec -> + convert_list_to_erl(Specs, MFA, ExpTypes, RecDict, Acc); + _ -> + convert_list_to_erl(Specs, MFA, ExpTypes, RecDict, [ErlSpec|Acc]) + end. + +equal_sets(A, B) -> + sets:size(A) == sets:size(B) andalso sets:size(sets:union(A, B)) == sets:size(B). + +%% Return all types defined in a kmodule +all_types_from_cerl(Kmodule) -> + %% Types and Opaque types + TypesOpaques = [{type_replace_records(Type), Line} || {Line, Type} <- cuter_cerl:kmodule_type_forms(Kmodule)], + %% Make the temp types representing records + Records = records_as_types(Kmodule), + lists:append(TypesOpaques, Records). + +%% Replace all record references with their respective temporary type in a type form +type_replace_records({Name, Type, Args}) -> + {Name, replace_records(Type), Args}. + +%% Replace all record references with their respective temporary type in a spec form list +spec_replace_records(FunSpecs) -> + Fn = fun({type, Line, F, L}) -> + {type, Line, F, lists:map(fun replace_records/1, L)} + end, + lists:map(Fn, FunSpecs). + +%% Replace all record references with their respective temporary type in a form +replace_records({type, L, record, [{atom, _, Name}]}) -> + {user_type, L, record_name(Name), []}; +replace_records({T, L, Type, Args}) when T =:= type orelse T =:= user_type -> + case is_list(Args) of + true -> + {T, L, Type, lists:map(fun replace_records/1, Args)}; + false -> + {T, L, Type, Args} + end; +replace_records(Rest) -> Rest. + +%% Return temporary types representing the records in a kmodule +%% For each record rec with fields es make a temporary tuple type with +%% first item rec and es as the rest items +records_as_types(Kmodule) -> + R = [{RecName, Line, RecFields} || {Line, {RecName, RecFields}} <- cuter_cerl:kmodule_record_forms(Kmodule)], + lists:map(fun type_from_record/1, R). + +%% Create the temporary type from a record form +type_from_record({Name, Line, Fields}) -> + Fn = fun ({typed_record_field, _, T}) -> + replace_records(T) + end, + %% Replace record references in fields + NewFields = lists:map(Fn, Fields), + NewName = record_name(Name), + RecType = {type, Line, tuple, [{atom, Line, Name} | NewFields]}, + {{NewName, RecType, []}, Line}. + +%% Return the name of a temporary type corresponding to a record with name Name +record_name(Name) -> + list_to_atom(?CUTER_RECORD_TYPE_PREFIX ++ atom_to_list(Name)). + +%% Replace all bounded signatures with equivalent normal ones +spec_replace_bounded(Specs) -> lists:map(fun handle_bounded_fun/1, Specs). + +%% If a the signature is not bounded, return it intact +handle_bounded_fun({type, _L, 'fun', _Rest} = S) -> S; +%% If it is bounded, replace all variables with type forms +handle_bounded_fun({type, _, 'bounded_fun', [Spec, Constraints]} = S) -> + Fn = fun({type, _, constraint, [{atom, _, is_subtype}, [Key, Value]]}, D) -> + dict:store(element(3, Key), Value, D) + end, + %% Find the forms of the variables used in the constraints + D = lists:foldl(Fn, dict:new(), Constraints), + {D1, Rec} = fix_update_vars(D), + case Rec of %% If the conversion succeeds + %% Return an equivalent Spec without constraints + true -> + make_normal_spec(Spec, D1); + %% Else return S as is + false -> + S + end. + +%% Replace variables in a bounded fun with their produced type forms +replace_vars({type, L, record, R}, _D) -> {{type, L, record, R}, false}; +replace_vars({T, L, Type, Args}, D) when is_list(Args) -> + Fn = fun(Arg) -> replace_vars(Arg, D) end, + {NewArgs, Changes} = lists:unzip(lists:map(Fn, Args)), + Change = lists:foldl(fun erlang:'or'/2, false, Changes), + {{T, L, Type, NewArgs}, Change}; +replace_vars({var, _L, Name}, D) -> + case dict:find(Name, D) of + {ok, T} -> + {T, true}; + error -> + {any, true} + end; +replace_vars({ann_type, _L, [_T, T1]}, D) -> + {T2, _C} = replace_vars(T1, D), + {T2, true}; +replace_vars(Rest, _D) -> {Rest, false}. + +%% Find the types of constraint variables for non recursive declarations. +%% Return a dictionary with the variables as keys and their type forms as values +fix_update_vars(D) -> + %% If no recursive variables exist, the computation will end in steps at most equal to the + %% count of the variables + fix_update_vars(D, dict:size(D) + 1, 0). + +fix_update_vars(D, Lim, Depth) -> + Keys = dict:fetch_keys(D), + Fn = fun(Key, {Acc1, Acc2}) -> + T = dict:fetch(Key, D), + {NewT, C} = replace_vars(T, D), + case C of + true -> + {dict:store(Key, NewT, Acc1), true}; + false -> + {Acc1, Acc2} + end + end, + %% Replace variables in all type forms + {NewD, Change} = lists:foldl(Fn, {D, false}, Keys), + %% If something changed + case Change of + true -> + %% If we have reached the limit + case Depth > Lim of + %% The transformation failed + true -> + {rec, false}; + %% Else call self + false -> + fix_update_vars(NewD, Lim, Depth + 1) + end; + %% Else return the dictionary of the variables + false -> + {NewD, true} + end. + +%% Create a non bounded fun from a bounded fun given the type forms of the variables +%% in the bounded fun +make_normal_spec({type, L, 'fun', [Args, Range]}, D) -> + {NewArgs, _C1} = replace_vars(Args, D), + {NewRange, _C2} = replace_vars(Range, D), + {type, L, 'fun', [NewArgs, NewRange]}. From 691b2b4f523767976f904925f4c754f058295eed Mon Sep 17 00:00:00 2001 From: Dspil Date: Fri, 11 Feb 2022 14:31:08 +0200 Subject: [PATCH 15/85] refactored cuter_types.erl --- src/cuter_types.erl | 147 +++++++++++++++++++++++++++++++++----------- 1 file changed, 110 insertions(+), 37 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index fcfd64e8..032204f1 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1222,59 +1222,93 @@ get_type_from_type_dep({_Name, Type}) -> %% of modules to their erl_type representation %% ---------------------------------------------------------------------------- +-define(CUTER_RECORD_TYPE_PREFIX, "__cuter_record_type__"). + var_name({var, _, X}) -> X. +%% Find the erl type representation of all signatures in a list of kmodules -spec parse_specs([cuter_cerl:kmodule()]) -> dict:dict(). parse_specs(Kmodules) -> - RecDict = ets:new(recdict, []), - ExpTypes = sets:union([cuter_cerl:kmodule_exported_types(M) || M <- Kmodules]), - Unhandled = lists:foldl( - fun (Kmodule, Acc) -> - Mod = cuter_cerl:kmodule_name(Kmodule), - TypesLines = all_types_from_cerl(Kmodule), - U = sets:from_list([{TName, length(Vars)} || {{TName, _T, Vars}, _L} <- TypesLines]), - dict:store(Mod, U, Acc) - end, - dict:new(), - Kmodules), - Ret = parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, Kmodules, false, dict:new()), + RecDict = ets:new(recdict, []), %% Needed for erl_types:t_from_form/6 + ExpTypes = sets:union([cuter_cerl:kmodule_exported_types(M) || M <- Kmodules]), %% Needed for erl_types:t_from_form/6 + Fn = fun (Kmodule, Acc) -> + Mod = cuter_cerl:kmodule_name(Kmodule), + TypesLines = all_types_from_cerl(Kmodule), + U = sets:from_list([{TName, length(Vars)} || {{TName, _T, Vars}, _L} <- TypesLines]), + dict:store(Mod, U, Acc) + end, + %% Unhandled holds all non converted types from a form to an erl_type for each module. + %% It is a dict with the module name as the key and all the types defined in it initially. + Unhandled = lists:foldl(Fn, dict:new(), Kmodules), + %% Find all signatures + Ret = parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, dict:new()), ets:delete(RecDict), Ret. -parse_specs_fix([], ExpTypes, RecDict, Unhandled, All, true, GatheredSpecs) -> parse_specs_fix(All, ExpTypes, RecDict, Unhandled, All, false, GatheredSpecs); -parse_specs_fix([], _ExpTypes, _RecDict, _Unhandled, _All, false, GatheredSpecs) -> GatheredSpecs; -parse_specs_fix([Kmodule|Kmodules], ExpTypes, RecDict, Unhandled, All, Acc, GatheredSpecs) -> +%% Convert all signatures in all modules until none can be converted +parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, GatheredSpecs) -> + %% Pass all modules + {Unhandled1, Change, GatheredSpecs1} = parse_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, false, GatheredSpecs), + case Change of %% If Unhandled has changed in this pass + %% Pass again + true -> + parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled1, GatheredSpecs1); + %% Else return the gathered signatures + false -> + GatheredSpecs1 + end. + +%% Pass through all modules and gather signatures +parse_specs_fix_pass([], _ExpTypes, _RecDict, Unhandled, Change, GatheredSpecs) -> {Unhandled, Change, GatheredSpecs}; +parse_specs_fix_pass([Kmodule|Kmodules], ExpTypes, RecDict, Unhandled, Change, GatheredSpecs) -> Mod = cuter_cerl:kmodule_name(Kmodule), PrevUnhandled = dict:fetch(Mod, Unhandled), + %% Get the signatures converted and the unhandled types of this module {Specs, NewUnhandled} = parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled), - GatheredSpecs1 = lists:foldl( - fun ({MFA, Spec}, G) -> - dict:store(MFA, Spec, G) - end, - GatheredSpecs, - Specs), + Fn = fun ({MFA, Spec}, G) -> + dict:store(MFA, Spec, G) + end, + %% Store the new signatures found in GatheredSpecs + GatheredSpecs1 = lists:foldl(Fn, GatheredSpecs, Specs), + %% If the unhandled types for this module have not changed case equal_sets(NewUnhandled, PrevUnhandled) of - true -> parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, All, Acc, GatheredSpecs1); - false -> parse_specs_fix(Kmodules, ExpTypes, RecDict, dict:store(Mod, NewUnhandled, Unhandled), All, true, GatheredSpecs1) + %% Maintain the Change so far in the recursive call + true -> parse_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, Change, GatheredSpecs1); + %% A change has occured, make the recursive call with Change: true and an updated Unhandled dict + false -> parse_specs_fix_pass(Kmodules, ExpTypes, RecDict, dict:store(Mod, NewUnhandled, Unhandled), true, GatheredSpecs1) end. +%% Gather all signatures defined in a module. +%% Return all signatures that can be converted to erl_types +%% and all the types that couldn't parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled) -> + %% Fetch type forms from the kmodule along with the lines where they were defined. + %% The lines are needed for the erl_types:t_from_form/6 call TypesLines = all_types_from_cerl(Kmodule), Mod = cuter_cerl:kmodule_name(Kmodule), + %% Only Unhandled is returned because types will be stored in RecDict ets table Unhandled = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled), - Specs = lists:map( - fun ({{F, A}, S1}) -> - S = spec_replace_records(spec_replace_bounded(S1)), - ErlSpecs = convert_list_to_erl(S, {Mod, F, A}, ExpTypes, RecDict), - {{Mod, F, A}, ErlSpecs} - end, - cuter_cerl:kmodule_spec_forms(Kmodule)), + Fn = fun ({{F, A}, S1}) -> %% For a function F with arity A and signature S1 which is a list + %% Replace records with temp record types in the signature + S = spec_replace_records(spec_replace_bounded(S1)), + %% Convert each element of the list into an erl_type + ErlSpecs = convert_list_to_erl(S, {Mod, F, A}, ExpTypes, RecDict), + {{Mod, F, A}, ErlSpecs} + end, + Specs = lists:map(Fn, cuter_cerl:kmodule_spec_forms(Kmodule)), {Specs, Unhandled}. +%% Convert as many types in Mod as possible to erl_types. +%% For every succesful conversion add it to RecDict and finally +%% return the types that couldn't be converted. +%% If there are more succesful conversions as before try again. +%% This is done to handle types depending on later defined types +%% or mutually recursive types immediately fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled) -> - F = fun ({{Tname, T, Vars}, L}, Acc) -> + F = fun ({{Tname, T, Vars}, L}, Acc) -> %% Get a type and a set of unhandled types A = length(Vars), + %% Try to convert the type to erl_type using erl_types:t_from_form/6 {{T1, _C}, D1} = try erl_types:t_from_form(T, ExpTypes, {'type', {Mod, Tname, A}}, RecDict, erl_types:var_table__new(), erl_types:cache__new()) of Ret -> {Ret, false} @@ -1282,7 +1316,9 @@ fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled) -> _:_ -> {{none, none}, true} end, + %% Check if the conversion was successful case D1 of + %% If it was, add the new erl_type in RecDict false -> case ets:lookup(RecDict, Mod) of [{Mod, VT}] -> @@ -1292,18 +1328,24 @@ fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled) -> ets:insert(RecDict, {Mod, maps:put({'type', Tname, A}, {{Mod, {lists:append(atom_to_list(Mod), ".erl"), L}, T, [var_name(Var) || Var <- Vars]}, T1}, maps:new())}), Acc end; + %% Else, add the type to the Unhandled set true -> sets:add_element({Tname, A}, Acc) end end, - D = lists:foldl(F, sets:new(), TypesLines), - case equal_sets(PrevUnhandled, D) of + %% Apply F to all Types in the module + Unhandled = lists:foldl(F, sets:new(), TypesLines), + %% Check if the unhandled types are different than before + case equal_sets(PrevUnhandled, Unhandled) of + %% If they are, run the module again false -> - fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, D); + fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, Unhandled); + %% Else return the unhandled types true -> - D + Unhandled end. +%% Convert a list of forms to a list of erl_types convert_list_to_erl(S, MFA, ExpTypes, RecDict) -> convert_list_to_erl(S, MFA, ExpTypes, RecDict, []). @@ -1325,20 +1367,26 @@ convert_list_to_erl([Spec|Specs], MFA, ExpTypes, RecDict, Acc) -> equal_sets(A, B) -> sets:size(A) == sets:size(B) andalso sets:size(sets:union(A, B)) == sets:size(B). +%% Return all types defined in a kmodule all_types_from_cerl(Kmodule) -> + %% Types and Opaque types TypesOpaques = [{type_replace_records(Type), Line} || {Line, Type} <- cuter_cerl:kmodule_type_forms(Kmodule)], + %% Make the temp types representing records Records = records_as_types(Kmodule), lists:append(TypesOpaques, Records). +%% Replace all record references with their respective temporary type in a type form type_replace_records({Name, Type, Args}) -> {Name, replace_records(Type), Args}. +%% Replace all record references with their respective temporary type in a spec form list spec_replace_records(FunSpecs) -> Fn = fun({type, Line, F, L}) -> {type, Line, F, lists:map(fun replace_records/1, L)} end, lists:map(Fn, FunSpecs). +%% Replace all record references with their respective temporary type in a form replace_records({type, L, record, [{atom, _, Name}]}) -> {user_type, L, record_name(Name), []}; replace_records({T, L, Type, Args}) when T =:= type orelse T =:= user_type -> @@ -1350,38 +1398,51 @@ replace_records({T, L, Type, Args}) when T =:= type orelse T =:= user_type -> end; replace_records(Rest) -> Rest. +%% Return temporary types representing the records in a kmodule +%% For each record rec with fields es make a temporary tuple type with +%% first item rec and es as the rest items records_as_types(Kmodule) -> R = [{RecName, Line, RecFields} || {Line, {RecName, RecFields}} <- cuter_cerl:kmodule_record_forms(Kmodule)], lists:map(fun type_from_record/1, R). +%% Create the temporary type from a record form type_from_record({Name, Line, Fields}) -> Fn = fun ({typed_record_field, _, T}) -> replace_records(T) end, + %% Replace record references in fields NewFields = lists:map(Fn, Fields), NewName = record_name(Name), RecType = {type, Line, tuple, [{atom, Line, Name} | NewFields]}, {{NewName, RecType, []}, Line}. +%% Return the name of a temporary type corresponding to a record with name Name record_name(Name) -> - list_to_atom(atom_to_list(Name) ++ "RECORDTYPE"). + list_to_atom(?CUTER_RECORD_TYPE_PREFIX ++ atom_to_list(Name)). +%% Replace all bounded signatures with equivalent normal ones spec_replace_bounded(Specs) -> lists:map(fun handle_bounded_fun/1, Specs). +%% If a the signature is not bounded, return it intact handle_bounded_fun({type, _L, 'fun', _Rest} = S) -> S; +%% If it is bounded, replace all variables with type forms handle_bounded_fun({type, _, 'bounded_fun', [Spec, Constraints]} = S) -> Fn = fun({type, _, constraint, [{atom, _, is_subtype}, [Key, Value]]}, D) -> dict:store(element(3, Key), Value, D) end, + %% Find the forms of the variables used in the constraints D = lists:foldl(Fn, dict:new(), Constraints), {D1, Rec} = fix_update_vars(D), - case Rec of + case Rec of %% If the conversion succeeds + %% Return an equivalent Spec without constraints true -> make_normal_spec(Spec, D1); + %% Else return S as is false -> S end. +%% Replace variables in a bounded fun with their produced type forms replace_vars({type, L, record, R}, _D) -> {{type, L, record, R}, false}; replace_vars({T, L, Type, Args}, D) when is_list(Args) -> Fn = fun(Arg) -> replace_vars(Arg, D) end, @@ -1400,7 +1461,11 @@ replace_vars({ann_type, _L, [_T, T1]}, D) -> {T2, true}; replace_vars(Rest, _D) -> {Rest, false}. +%% Find the types of constraint variables for non recursive declarations. +%% Return a dictionary with the variables as keys and their type forms as values fix_update_vars(D) -> + %% If no recursive variables exist, the computation will end in steps at most equal to the + %% count of the variables fix_update_vars(D, dict:size(D) + 1, 0). fix_update_vars(D, Lim, Depth) -> @@ -1415,19 +1480,27 @@ fix_update_vars(D, Lim, Depth) -> {Acc1, Acc2} end end, + %% Replace variables in all type forms {NewD, Change} = lists:foldl(Fn, {D, false}, Keys), + %% If something changed case Change of true -> + %% If we have reached the limit case Depth > Lim of + %% The transformation failed true -> {rec, false}; + %% Else call self false -> fix_update_vars(NewD, Lim, Depth + 1) end; + %% Else return the dictionary of the variables false -> {NewD, true} end. +%% Create a non bounded fun from a bounded fun given the type forms of the variables +%% in the bounded fun make_normal_spec({type, L, 'fun', [Args, Range]}, D) -> {NewArgs, _C1} = replace_vars(Args, D), {NewRange, _C2} = replace_vars(Range, D), From 57b0cb52c7799cca72a69428b257fb8e1fc1526b Mon Sep 17 00:00:00 2001 From: Dspil Date: Fri, 11 Feb 2022 14:33:22 +0200 Subject: [PATCH 16/85] name change to parse_specs --- src/cuter_codeserver.erl | 2 +- src/cuter_types.erl | 22 +++++++++++----------- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/cuter_codeserver.erl b/src/cuter_codeserver.erl index 0afb005f..c0b6d136 100644 --- a/src/cuter_codeserver.erl +++ b/src/cuter_codeserver.erl @@ -254,7 +254,7 @@ handle_call(annotate_for_possible_errors, _From, State=#st{db = Db}) -> MfasToKfuns = ets:foldl(Fn, dict:new(), Db), %io:format("Before Specs~n"), %io:format("ast: ~p~n", [cuter_cerl:kfun_code(dict:fetch(EntryPoint, MfasToKfuns))]), - MfasToSpecs = cuter_types:parse_specs(Kmodules), + MfasToSpecs = cuter_types:convert_specs(Kmodules), %io:format("Before Preprocess~n"), UpdatedKfuns = cuter_maybe_error_annotation:preprocess(EntryPoint, MfasToKfuns, MfasToSpecs, true), RFn = fun({M, F, A}, Kfun, _Acc) -> diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 032204f1..639c0b17 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -23,7 +23,7 @@ -export([erl_type_deps_map/2, get_type_name_from_type_dep/1, get_type_from_type_dep/1, unique_type_name/3]). --export([parse_specs/1]). +-export([convert_specs/1]). -export_type([erl_type/0, erl_spec_clause/0, erl_spec/0, stored_specs/0, stored_types/0, stored_spec_value/0, t_range_limit/0]). @@ -1228,8 +1228,8 @@ var_name({var, _, X}) -> X. %% Find the erl type representation of all signatures in a list of kmodules --spec parse_specs([cuter_cerl:kmodule()]) -> dict:dict(). -parse_specs(Kmodules) -> +-spec convert_specs([cuter_cerl:kmodule()]) -> dict:dict(). +convert_specs(Kmodules) -> RecDict = ets:new(recdict, []), %% Needed for erl_types:t_from_form/6 ExpTypes = sets:union([cuter_cerl:kmodule_exported_types(M) || M <- Kmodules]), %% Needed for erl_types:t_from_form/6 Fn = fun (Kmodule, Acc) -> @@ -1242,26 +1242,26 @@ parse_specs(Kmodules) -> %% It is a dict with the module name as the key and all the types defined in it initially. Unhandled = lists:foldl(Fn, dict:new(), Kmodules), %% Find all signatures - Ret = parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, dict:new()), + Ret = convert_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, dict:new()), ets:delete(RecDict), Ret. %% Convert all signatures in all modules until none can be converted -parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, GatheredSpecs) -> +convert_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, GatheredSpecs) -> %% Pass all modules - {Unhandled1, Change, GatheredSpecs1} = parse_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, false, GatheredSpecs), + {Unhandled1, Change, GatheredSpecs1} = convert_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, false, GatheredSpecs), case Change of %% If Unhandled has changed in this pass %% Pass again true -> - parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled1, GatheredSpecs1); + convert_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled1, GatheredSpecs1); %% Else return the gathered signatures false -> GatheredSpecs1 end. %% Pass through all modules and gather signatures -parse_specs_fix_pass([], _ExpTypes, _RecDict, Unhandled, Change, GatheredSpecs) -> {Unhandled, Change, GatheredSpecs}; -parse_specs_fix_pass([Kmodule|Kmodules], ExpTypes, RecDict, Unhandled, Change, GatheredSpecs) -> +convert_specs_fix_pass([], _ExpTypes, _RecDict, Unhandled, Change, GatheredSpecs) -> {Unhandled, Change, GatheredSpecs}; +convert_specs_fix_pass([Kmodule|Kmodules], ExpTypes, RecDict, Unhandled, Change, GatheredSpecs) -> Mod = cuter_cerl:kmodule_name(Kmodule), PrevUnhandled = dict:fetch(Mod, Unhandled), %% Get the signatures converted and the unhandled types of this module @@ -1274,9 +1274,9 @@ parse_specs_fix_pass([Kmodule|Kmodules], ExpTypes, RecDict, Unhandled, Change, G %% If the unhandled types for this module have not changed case equal_sets(NewUnhandled, PrevUnhandled) of %% Maintain the Change so far in the recursive call - true -> parse_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, Change, GatheredSpecs1); + true -> convert_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, Change, GatheredSpecs1); %% A change has occured, make the recursive call with Change: true and an updated Unhandled dict - false -> parse_specs_fix_pass(Kmodules, ExpTypes, RecDict, dict:store(Mod, NewUnhandled, Unhandled), true, GatheredSpecs1) + false -> convert_specs_fix_pass(Kmodules, ExpTypes, RecDict, dict:store(Mod, NewUnhandled, Unhandled), true, GatheredSpecs1) end. %% Gather all signatures defined in a module. From 45e84aef39bb577027c42be569702e7ef2b869a8 Mon Sep 17 00:00:00 2001 From: Dspil Date: Fri, 11 Feb 2022 14:41:11 +0200 Subject: [PATCH 17/85] Remove unnecessary changes --- cuter | 3 --- include/cuter_macros.hrl | 2 -- src/cuter.erl | 28 ++++++++++------------------ src/cuter_codeserver.erl | 17 +---------------- src/cuter_types.erl | 22 +++++++++++----------- 5 files changed, 22 insertions(+), 50 deletions(-) diff --git a/cuter b/cuter index d369aa64..9a72d699 100755 --- a/cuter +++ b/cuter @@ -38,7 +38,6 @@ def main(): parser.add_argument("-m", "--metrics", action='store_true', help="report collected metrics") parser.add_argument("--debug-keep-traces", action='store_true', help="keep execution traces for debugging") parser.add_argument("--debug-solver-fsm", action='store_true', help="output debug logs for the solver FSM") - parser.add_argument("-ps", "--prune-safe", action='store_true', help="prune safe paths and stop the execution early") # Parse the arguments args = parser.parse_args() @@ -110,8 +109,6 @@ def main(): opts.append("debug_keep_traces") if args.debug_solver_fsm: opts.append("debug_solver_fsm") - if args.prune_safe: - opts.append("prune_safe") strOpts = ",".join(opts) # Run CutEr diff --git a/include/cuter_macros.hrl b/include/cuter_macros.hrl index ae5b13cd..8572c4cd 100644 --- a/include/cuter_macros.hrl +++ b/include/cuter_macros.hrl @@ -89,8 +89,6 @@ -define(NUM_SOLVERS, number_of_solvers). %% Sets the number of concurrent concolic execution processes. -define(NUM_POLLERS, number_of_pollers). -%% Prune safe paths. --define(PRUNE_SAFE, prune_safe). -type runtime_options() :: {?Z3_TIMEOUT, pos_integer()} | ?REPORT_METRICS diff --git a/src/cuter.erl b/src/cuter.erl index d54e0828..62bdc126 100644 --- a/src/cuter.erl +++ b/src/cuter.erl @@ -48,7 +48,7 @@ run(M, F, As, Depth, Options) -> Seeds = [{M, F, As, Depth}], run(Seeds, Options). --spec run([seed(),...], options()) -> erroneous_inputs(). +-spec run([seed()], options()) -> erroneous_inputs(). %% Runs CutEr on multiple units. run(Seeds, Options) -> State = state_from_options_and_seeds(Options, Seeds), @@ -87,8 +87,7 @@ run_from_file(File, Options) -> %% The tasks to run during the app initialization. init_tasks() -> [fun ensure_exported_entry_points/1, - fun compute_callgraph/1, - fun annotate_for_possible_errors/1]. + fun compute_callgraph/1]. -spec init(state()) -> ok | error. init(State) -> @@ -129,17 +128,10 @@ compute_callgraph(State) -> Mfas = mfas_from_state(State), cuter_codeserver:calculate_callgraph(State#st.codeServer, Mfas). + mfas_from_state(State) -> [{M, F, length(As)} || {M, F, As, _} <- State#st.seeds]. -annotate_for_possible_errors(State) -> - case cuter_config:fetch(?PRUNE_SAFE) of - {ok, true} -> - cuter_codeserver:annotate_for_possible_errors(State#st.codeServer); - _ -> - ok - end. - %% ---------------------------------------------------------------------------- %% Manage the concolic executions %% ---------------------------------------------------------------------------- @@ -151,7 +143,8 @@ start(State) -> -spec start([seed()], state()) -> state(). start([], State) -> State; -start([{M, F, As, Depth}|Seeds], State) -> CodeServer = State#st.codeServer, +start([{M, F, As, Depth}|Seeds], State) -> + CodeServer = State#st.codeServer, Scheduler = State#st.scheduler, Errors = start_one(M, F, As, Depth, CodeServer, Scheduler), NewErrors = [{{M, F, length(As)}, Errors}|State#st.errors], @@ -246,7 +239,7 @@ stop(State) -> %% Generate the system state %% ---------------------------------------------------------------------------- --spec state_from_options_and_seeds(options(), [seed(),...]) -> state(). +-spec state_from_options_and_seeds(options(), [seed()]) -> state(). state_from_options_and_seeds(Options, Seeds) -> process_flag(trap_exit, true), error_logger:tty(false), %% disable error_logger @@ -254,7 +247,7 @@ state_from_options_and_seeds(Options, Seeds) -> ok = cuter_metrics:start(), ok = define_metrics(), enable_debug_config(Options), - enable_runtime_config(Options, Seeds), + enable_runtime_config(Options), ok = cuter_pp:start(), CodeServer = cuter_codeserver:start(), SchedPid = cuter_scheduler:start(?DEFAULT_DEPTH, CodeServer), @@ -272,8 +265,8 @@ enable_debug_config(Options) -> cuter_config:store(?DEBUG_SMT, proplists:get_bool(?DEBUG_SMT, Options)), cuter_config:store(?DEBUG_SOLVER_FSM, proplists:get_bool(?DEBUG_SOLVER_FSM, Options)). --spec enable_runtime_config(options(), [seed(),...]) -> ok. -enable_runtime_config(Options, [{_M, _F, _I, _D}|_]) -> +-spec enable_runtime_config(options()) -> ok. +enable_runtime_config(Options) -> {ok, CWD} = file:get_cwd(), cuter_config:store(?WORKING_DIR, cuter_lib:get_tmp_dir(proplists:get_value(?WORKING_DIR, Options, CWD))), @@ -291,8 +284,7 @@ enable_runtime_config(Options, [{_M, _F, _I, _D}|_]) -> cuter_config:store(?SORTED_ERRORS, proplists:get_bool(?SORTED_ERRORS, Options)), cuter_config:store(?WHITELISTED_MFAS, whitelisted_mfas(Options)), cuter_config:store(?NUM_SOLVERS, proplists:get_value(?NUM_SOLVERS, Options, ?ONE)), - cuter_config:store(?NUM_POLLERS, proplists:get_value(?NUM_POLLERS, Options, ?ONE)), - cuter_config:store(?PRUNE_SAFE, proplists:get_bool(?PRUNE_SAFE, Options)). + cuter_config:store(?NUM_POLLERS, proplists:get_value(?NUM_POLLERS, Options, ?ONE)). verbosity_level(Options) -> Default = cuter_pp:default_reporting_level(), diff --git a/src/cuter_codeserver.erl b/src/cuter_codeserver.erl index 00808723..d4962a51 100644 --- a/src/cuter_codeserver.erl +++ b/src/cuter_codeserver.erl @@ -10,8 +10,6 @@ visit_tag/2, calculate_callgraph/2, %% Work with module cache merge_dumped_cached_modules/2, modules_of_dumped_cache/1, - %% Code annotations - annotate_for_possible_errors/1, %% Access logs cachedMods_of_logs/1, visitedTags_of_logs/1, tagsAddedNo_of_logs/1, unsupportedMfas_of_logs/1, loadedMods_of_logs/1]). @@ -144,11 +142,6 @@ calculate_callgraph(CodeServer, Mfas) -> get_feasible_tags(CodeServer, NodeTypes) -> gen_server:call(CodeServer, {get_feasible_tags, NodeTypes}). -%% Annotates the code for possible errors. --spec annotate_for_possible_errors(codeserver()) -> ok. -annotate_for_possible_errors(CodeServer) -> - gen_server:call(CodeServer, annotate_for_possible_errors). - %% ---------------------------------------------------------------------------- %% gen_server callbacks (Server Implementation) %% ---------------------------------------------------------------------------- @@ -189,7 +182,6 @@ handle_info(_Msg, State) -> ; (get_whitelist, from(), state()) -> {reply, cuter_mock:whitelist(), state()} ; ({get_feasible_tags, cuter_cerl:node_types()}, from(), state()) -> {reply, cuter_cerl:visited_tags(), state()} ; ({calculate_callgraph, [mfa()]}, from(), state()) -> {reply, ok, state()} - ; (annotate_for_possible_errors, from(), state()) -> {reply, ok, state()} . handle_call({load, M}, _From, State) -> {reply, try_load(M, State), State}; @@ -239,14 +231,7 @@ handle_call({calculate_callgraph, Mfas}, _From, State=#st{whitelist = Whitelist} end, cuter_callgraph:foreachModule(LoadFn, Callgraph), {reply, ok, State#st{callgraph = Callgraph}} - end; -handle_call(annotate_for_possible_errors, _From, State=#st{db = Db}) -> - Fn2 = fun({_M, Kmodule}, Acc) -> - [Kmodule|Acc] - end, - Kmodules = ets:foldl(Fn2, [], Db), - _MfasToSpecs = cuter_types:parse_specs(Kmodules), - {reply, ok, State}. + end. %% gen_server callback : handle_cast/2 -spec handle_cast(stop, state()) -> {stop, normal, state()} | {noreply, state()} diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 032204f1..639c0b17 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -23,7 +23,7 @@ -export([erl_type_deps_map/2, get_type_name_from_type_dep/1, get_type_from_type_dep/1, unique_type_name/3]). --export([parse_specs/1]). +-export([convert_specs/1]). -export_type([erl_type/0, erl_spec_clause/0, erl_spec/0, stored_specs/0, stored_types/0, stored_spec_value/0, t_range_limit/0]). @@ -1228,8 +1228,8 @@ var_name({var, _, X}) -> X. %% Find the erl type representation of all signatures in a list of kmodules --spec parse_specs([cuter_cerl:kmodule()]) -> dict:dict(). -parse_specs(Kmodules) -> +-spec convert_specs([cuter_cerl:kmodule()]) -> dict:dict(). +convert_specs(Kmodules) -> RecDict = ets:new(recdict, []), %% Needed for erl_types:t_from_form/6 ExpTypes = sets:union([cuter_cerl:kmodule_exported_types(M) || M <- Kmodules]), %% Needed for erl_types:t_from_form/6 Fn = fun (Kmodule, Acc) -> @@ -1242,26 +1242,26 @@ parse_specs(Kmodules) -> %% It is a dict with the module name as the key and all the types defined in it initially. Unhandled = lists:foldl(Fn, dict:new(), Kmodules), %% Find all signatures - Ret = parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, dict:new()), + Ret = convert_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, dict:new()), ets:delete(RecDict), Ret. %% Convert all signatures in all modules until none can be converted -parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, GatheredSpecs) -> +convert_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, GatheredSpecs) -> %% Pass all modules - {Unhandled1, Change, GatheredSpecs1} = parse_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, false, GatheredSpecs), + {Unhandled1, Change, GatheredSpecs1} = convert_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, false, GatheredSpecs), case Change of %% If Unhandled has changed in this pass %% Pass again true -> - parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled1, GatheredSpecs1); + convert_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled1, GatheredSpecs1); %% Else return the gathered signatures false -> GatheredSpecs1 end. %% Pass through all modules and gather signatures -parse_specs_fix_pass([], _ExpTypes, _RecDict, Unhandled, Change, GatheredSpecs) -> {Unhandled, Change, GatheredSpecs}; -parse_specs_fix_pass([Kmodule|Kmodules], ExpTypes, RecDict, Unhandled, Change, GatheredSpecs) -> +convert_specs_fix_pass([], _ExpTypes, _RecDict, Unhandled, Change, GatheredSpecs) -> {Unhandled, Change, GatheredSpecs}; +convert_specs_fix_pass([Kmodule|Kmodules], ExpTypes, RecDict, Unhandled, Change, GatheredSpecs) -> Mod = cuter_cerl:kmodule_name(Kmodule), PrevUnhandled = dict:fetch(Mod, Unhandled), %% Get the signatures converted and the unhandled types of this module @@ -1274,9 +1274,9 @@ parse_specs_fix_pass([Kmodule|Kmodules], ExpTypes, RecDict, Unhandled, Change, G %% If the unhandled types for this module have not changed case equal_sets(NewUnhandled, PrevUnhandled) of %% Maintain the Change so far in the recursive call - true -> parse_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, Change, GatheredSpecs1); + true -> convert_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, Change, GatheredSpecs1); %% A change has occured, make the recursive call with Change: true and an updated Unhandled dict - false -> parse_specs_fix_pass(Kmodules, ExpTypes, RecDict, dict:store(Mod, NewUnhandled, Unhandled), true, GatheredSpecs1) + false -> convert_specs_fix_pass(Kmodules, ExpTypes, RecDict, dict:store(Mod, NewUnhandled, Unhandled), true, GatheredSpecs1) end. %% Gather all signatures defined in a module. From 364d844366fafc2c2516d52528e2f292b38b65f5 Mon Sep 17 00:00:00 2001 From: Dspil Date: Fri, 11 Feb 2022 23:33:22 +0200 Subject: [PATCH 18/85] Added unit test file for convert_specs --- Makefile.in | 3 +- src/cuter_debug.erl | 12 ++++++- test/utest/src/cuter_types_tests.erl | 12 +++++++ test/utest/src/examples_for_type_analysis.erl | 35 +++++++++++++++++++ 4 files changed, 60 insertions(+), 2 deletions(-) create mode 100644 test/utest/src/examples_for_type_analysis.erl diff --git a/Makefile.in b/Makefile.in index f011d5f1..e74c74d0 100644 --- a/Makefile.in +++ b/Makefile.in @@ -100,7 +100,8 @@ UTEST_MODULES = \ types_and_specs \ types_and_specs2 \ cuter_metrics_tests \ - cuter_config_tests + cuter_config_tests \ + examples_for_type_analysis FTEST_MODULES = \ bitstr \ diff --git a/src/cuter_debug.erl b/src/cuter_debug.erl index f6ce493c..e3cb7856 100644 --- a/src/cuter_debug.erl +++ b/src/cuter_debug.erl @@ -1,7 +1,7 @@ %% -*- erlang-indent-level: 2 -*- %%------------------------------------------------------------------------------ -module(cuter_debug). --export([parse_module/2]). +-export([parse_module/2, convert_types/1]). %% Prints the AST of a module. %% Run as: @@ -14,3 +14,13 @@ parse_module(M, WithPmatch) -> {ok, AST} -> io:format("~p~n", [AST]) end. + +-spec convert_types([module()]) -> ok. +convert_types(Modules) -> + Fn = fun(M) -> + {ok, AST} = cuter_cerl:get_core(M, false), + AST + end, + ASTs = [{M, Fn(M)} || M <- Modules], + Kmodules = [cuter_cerl:kmodule(M, AST, fun() -> ok end) || {M, AST} <- ASTs], + io:format("~p~n", [dict:to_list(cuter_types:convert_specs(Kmodules))]). diff --git a/test/utest/src/cuter_types_tests.erl b/test/utest/src/cuter_types_tests.erl index 54ff7744..a4a8b879 100644 --- a/test/utest/src/cuter_types_tests.erl +++ b/test/utest/src/cuter_types_tests.erl @@ -81,3 +81,15 @@ setup(Mod) -> {Mod, Attrs}. cleanup(_) -> ok. + +-spec convert_types_test() -> any(). +convert_types_test() -> + Modules = [examples_for_type_analysis], + Fn = fun(M) -> + {ok, AST} = cuter_cerl:get_core(M, false), + AST + end, + ASTs = [{M, Fn(M)} || M <- Modules], + Kmodules = [cuter_cerl:kmodule(M, AST, fun() -> ok end) || {M, AST} <- ASTs], + Specs = cuter_types:convert_specs(Kmodules), + [?assertEqual([{examples_for_type_analysis,f,1}], dict:fetch_keys(Specs))]. diff --git a/test/utest/src/examples_for_type_analysis.erl b/test/utest/src/examples_for_type_analysis.erl new file mode 100644 index 00000000..83e095e9 --- /dev/null +++ b/test/utest/src/examples_for_type_analysis.erl @@ -0,0 +1,35 @@ +-module(examples_for_type_analysis). +-export([f/1, f1/1, f2/1, f3/1, f4/1, f5/1]). + +-type t2() :: t1() | atom(). +-type t1() :: integer(). + +-record(rec, {x :: integer(), y :: number()}). + +-type tree() :: {integer(), tree(), tree()} | nil. + +-type t3(X) :: [X]. + +%% erl_types:t_fun([erl_types:t_any()], erl_types:t_any()) +-spec f(any()) -> any(). +f(X) -> X. + +%% erl_types:t_fun([erl_types:t_integer()], erl_types:t_atom(ok)) +-spec f1(t1()) -> ok. +f1(_X) -> ok. + +%% erl_types:t_fun([erl_types:t_sup(erl_types:t_integer(), erl_types:t_atom())], erl_types:t_atom(ok)) +-spec f2(t2()) -> ok. +f2(_X) -> ok. + +%% erl_types:t_fun([erl_types:t_tuple([erl_types:t_from_term(rec), erl_types:t_integer(), erl_types:t_number()])], erl_types:t_atom(ok)). +-spec f3(#rec{}) -> ok. +f3(_X) -> ok. + +%% ?? +-spec f4(tree()) -> ok. +f4(_X) -> ok. + +%% erl_types:t_fun([erl_types:t_list(erl_types:t_tuple([erl_types:t_from_term(rec), erl_types:t_integer(), erl_types:t_number()]))], erl_types:t_atom(ok)). +-spec f5(t3(#rec{})) -> ok. +f5(_X) -> ok. From 1cb83efff9c4452c6459857934b903a14b55e0f6 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 10:07:54 +0100 Subject: [PATCH 19/85] Verbose printing of the MFA specs --- src/cuter_debug.erl | 30 +++++++++++++++++++----------- 1 file changed, 19 insertions(+), 11 deletions(-) diff --git a/src/cuter_debug.erl b/src/cuter_debug.erl index e3cb7856..56d376a1 100644 --- a/src/cuter_debug.erl +++ b/src/cuter_debug.erl @@ -1,11 +1,13 @@ %% -*- erlang-indent-level: 2 -*- %%------------------------------------------------------------------------------ -module(cuter_debug). --export([parse_module/2, convert_types/1]). + +-export([parse_module/2, to_erl_types_specs/1]). + +%% This modules contains convenience MFAs for debugging purposes during the +%% development of the tool. %% Prints the AST of a module. -%% Run as: -%% erl -noshell -pa ebin/ -eval "cuter_debug:parse_module(lists, true)" -s init stop -spec parse_module(module(), boolean()) -> ok. parse_module(M, WithPmatch) -> case cuter_cerl:get_core(M, WithPmatch) of @@ -15,12 +17,18 @@ parse_module(M, WithPmatch) -> io:format("~p~n", [AST]) end. --spec convert_types([module()]) -> ok. -convert_types(Modules) -> +%% Returns the specs of a list of modules as erl_types representation. +-spec to_erl_types_specs([module()]) -> ok. +to_erl_types_specs(Modules) -> Fn = fun(M) -> - {ok, AST} = cuter_cerl:get_core(M, false), - AST - end, - ASTs = [{M, Fn(M)} || M <- Modules], - Kmodules = [cuter_cerl:kmodule(M, AST, fun() -> ok end) || {M, AST} <- ASTs], - io:format("~p~n", [dict:to_list(cuter_types:convert_specs(Kmodules))]). + {ok, AST} = cuter_cerl:get_core(M, false), + AST + end, + Xs = [{M, Fn(M)} || M <- Modules], + TagGen = fun() -> ok end, + Kmodules = [cuter_cerl:kmodule(M, AST, TagGen) || {M, AST} <- Xs], + Specs = cuter_types:convert_specs(Kmodules), + lists:foreach(fun print_mfa_and_spec/1, dict:to_list(Specs)). + +print_mfa_and_spec({MFA, Spec}) -> + io:format("~p~n ~p~n", [MFA, Spec]). From c08e7b0872f8ca1c3b9792a05fb21c97c6a557c1 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 12:17:33 +0100 Subject: [PATCH 20/85] Add spec assertions --- test/utest/src/cuter_tests_lib.erl | 10 +++ test/utest/src/cuter_types_tests.erl | 61 +++++++++++++++++-- test/utest/src/examples_for_type_analysis.erl | 44 +++++++------ 3 files changed, 86 insertions(+), 29 deletions(-) diff --git a/test/utest/src/cuter_tests_lib.erl b/test/utest/src/cuter_tests_lib.erl index da52a95a..0c4427d9 100644 --- a/test/utest/src/cuter_tests_lib.erl +++ b/test/utest/src/cuter_tests_lib.erl @@ -5,6 +5,7 @@ -include("include/eunit_config.hrl"). -export([setup_dir/0, get_python_command/0, get_module_attrs/2, sample_trace_file/1]). +-export([mfa_to_list/1, mfa_to_list/3]). %% Create a directory for temporary use -spec setup_dir() -> file:filename_all(). @@ -45,3 +46,12 @@ sample_trace_file(Fname) -> cuter_log:log_equal(Fd, false, X, 45, cuter_cerl:empty_tag()), %% Close the logfile cuter_log:close_file(Fd). + +%% Returns the string representation of an MFA. +-spec mfa_to_list(mfa()) -> string(). +mfa_to_list({M, F, A}) -> mfa_to_list(M, F, A). + +%% Returns the string representation of an MFA. +-spec mfa_to_list(module(), atom(), byte()) -> string(). +mfa_to_list(M, F, A) -> + atom_to_list(M) ++ ":" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A). diff --git a/test/utest/src/cuter_types_tests.erl b/test/utest/src/cuter_types_tests.erl index a4a8b879..b778fd02 100644 --- a/test/utest/src/cuter_types_tests.erl +++ b/test/utest/src/cuter_types_tests.erl @@ -86,10 +86,59 @@ cleanup(_) -> ok. convert_types_test() -> Modules = [examples_for_type_analysis], Fn = fun(M) -> - {ok, AST} = cuter_cerl:get_core(M, false), - AST - end, - ASTs = [{M, Fn(M)} || M <- Modules], - Kmodules = [cuter_cerl:kmodule(M, AST, fun() -> ok end) || {M, AST} <- ASTs], + {ok, AST} = cuter_cerl:get_core(M, false), + AST + end, + Xs = [{M, Fn(M)} || M <- Modules], + TagGen = fun() -> ok end, + Kmodules = [cuter_cerl:kmodule(M, AST, TagGen) || {M, AST} <- Xs], Specs = cuter_types:convert_specs(Kmodules), - [?assertEqual([{examples_for_type_analysis,f,1}], dict:fetch_keys(Specs))]. + Expect = mfas_and_specs(), + ExpectMfas = [Mfa || {Mfa, _Spec} <- Expect], + As = lists:flatten([spec_assertions(E, Specs) || E <- Expect]), + [?assertEqual(lists:sort(ExpectMfas), lists:sort(dict:fetch_keys(Specs)))] ++ As. + + +mfas_and_specs() -> + [ + { + {examples_for_type_analysis, id, 1}, + [erl_types:t_fun([erl_types:t_any()], erl_types:t_any())] + }, + { + {examples_for_type_analysis, inc, 1}, + [erl_types:t_fun([erl_types:t_integer()], erl_types:t_integer())] + }, + { + {examples_for_type_analysis, to_atom, 1}, + [erl_types:t_fun([erl_types:t_sup(erl_types:t_integer(), erl_types:t_atom())], erl_types:t_atom())] + }, + { + {examples_for_type_analysis, translate, 3}, + [erl_types:t_fun( + [erl_types:t_tuple([erl_types:t_from_term(point), erl_types:t_number(), erl_types:t_number()]), + erl_types:t_number(), + erl_types:t_number()], + erl_types:t_tuple([erl_types:t_from_term(point), erl_types:t_number(), erl_types:t_number()]))] + }, + { + {examples_for_type_analysis, root, 1}, + [] %% We do not support recursive types. + }, + { + {examples_for_type_analysis, max_x, 1}, + [erl_types:t_fun( + [erl_types:t_list( + erl_types:t_tuple([erl_types:t_from_term(point), erl_types:t_number(), erl_types:t_number()]))], + erl_types:t_number())] + } + ]. + +spec_assertions({Mfa, Expect}, R) -> + As = [?assert(dict:is_key(Mfa, R))], + case dict:find(Mfa, R) of + error -> As; + {ok, Got} -> + Comment = "Spec of " ++ cuter_tests_lib:mfa_to_list(Mfa), + As ++ [?assertEqual(Expect, Got, Comment)] + end. diff --git a/test/utest/src/examples_for_type_analysis.erl b/test/utest/src/examples_for_type_analysis.erl index 83e095e9..954599c7 100644 --- a/test/utest/src/examples_for_type_analysis.erl +++ b/test/utest/src/examples_for_type_analysis.erl @@ -1,35 +1,33 @@ -module(examples_for_type_analysis). --export([f/1, f1/1, f2/1, f3/1, f4/1, f5/1]). +-export([id/1, inc/1, to_atom/1, translate/3, root/1, max_x/1]). --type t2() :: t1() | atom(). --type t1() :: integer(). +-type t_int_or_atom() :: t_int() | atom(). +-type t_int() :: integer(). --record(rec, {x :: integer(), y :: number()}). +-record(point, {x :: number(), y :: number()}). -type tree() :: {integer(), tree(), tree()} | nil. --type t3(X) :: [X]. +-type list_of(X) :: [X]. -%% erl_types:t_fun([erl_types:t_any()], erl_types:t_any()) --spec f(any()) -> any(). -f(X) -> X. +-type point() :: #point{}. -%% erl_types:t_fun([erl_types:t_integer()], erl_types:t_atom(ok)) --spec f1(t1()) -> ok. -f1(_X) -> ok. +-spec id(any()) -> any(). +id(X) -> X. -%% erl_types:t_fun([erl_types:t_sup(erl_types:t_integer(), erl_types:t_atom())], erl_types:t_atom(ok)) --spec f2(t2()) -> ok. -f2(_X) -> ok. +-spec inc(t_int()) -> t_int(). +inc(X) -> X + 1. -%% erl_types:t_fun([erl_types:t_tuple([erl_types:t_from_term(rec), erl_types:t_integer(), erl_types:t_number()])], erl_types:t_atom(ok)). --spec f3(#rec{}) -> ok. -f3(_X) -> ok. +-spec to_atom(t_int_or_atom()) -> atom(). +to_atom(X) when is_atom(X) -> X; +to_atom(X) when is_integer(X) -> list_to_atom([$0 + X]). -%% ?? --spec f4(tree()) -> ok. -f4(_X) -> ok. +-spec translate(#point{}, number(), number()) -> point(). +translate(#point{x=X, y=Y}, DX, DY) -> #point{x = X + DX, y = Y + DY}. -%% erl_types:t_fun([erl_types:t_list(erl_types:t_tuple([erl_types:t_from_term(rec), erl_types:t_integer(), erl_types:t_number()]))], erl_types:t_atom(ok)). --spec f5(t3(#rec{})) -> ok. -f5(_X) -> ok. +-spec root(tree()) -> integer() | nil. +root({X, _L, _R}) -> X; +root(nil) -> nil. + +-spec max_x(list_of(#point{})) -> number(). +max_x(Ps) -> lists:max([P#point.x || P <- Ps]). From 6e6b8cef565ba47f167a804c83596253f99e4ab5 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 13:42:19 +0100 Subject: [PATCH 21/85] Rename conver_specs to specs_as_erl_types --- src/cuter_debug.erl | 2 +- src/cuter_types.erl | 6 +++--- test/utest/src/cuter_types_tests.erl | 7 ++++--- 3 files changed, 8 insertions(+), 7 deletions(-) diff --git a/src/cuter_debug.erl b/src/cuter_debug.erl index 56d376a1..ce71d9da 100644 --- a/src/cuter_debug.erl +++ b/src/cuter_debug.erl @@ -27,7 +27,7 @@ to_erl_types_specs(Modules) -> Xs = [{M, Fn(M)} || M <- Modules], TagGen = fun() -> ok end, Kmodules = [cuter_cerl:kmodule(M, AST, TagGen) || {M, AST} <- Xs], - Specs = cuter_types:convert_specs(Kmodules), + Specs = cuter_types:specs_as_erl_types(Kmodules), lists:foreach(fun print_mfa_and_spec/1, dict:to_list(Specs)). print_mfa_and_spec({MFA, Spec}) -> diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 639c0b17..8a241fd6 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -23,7 +23,7 @@ -export([erl_type_deps_map/2, get_type_name_from_type_dep/1, get_type_from_type_dep/1, unique_type_name/3]). --export([convert_specs/1]). +-export([specs_as_erl_types/1]). -export_type([erl_type/0, erl_spec_clause/0, erl_spec/0, stored_specs/0, stored_types/0, stored_spec_value/0, t_range_limit/0]). @@ -1228,8 +1228,8 @@ var_name({var, _, X}) -> X. %% Find the erl type representation of all signatures in a list of kmodules --spec convert_specs([cuter_cerl:kmodule()]) -> dict:dict(). -convert_specs(Kmodules) -> +-spec specs_as_erl_types([cuter_cerl:kmodule()]) -> dict:dict(). +specs_as_erl_types(Kmodules) -> RecDict = ets:new(recdict, []), %% Needed for erl_types:t_from_form/6 ExpTypes = sets:union([cuter_cerl:kmodule_exported_types(M) || M <- Kmodules]), %% Needed for erl_types:t_from_form/6 Fn = fun (Kmodule, Acc) -> diff --git a/test/utest/src/cuter_types_tests.erl b/test/utest/src/cuter_types_tests.erl index b778fd02..d361492e 100644 --- a/test/utest/src/cuter_types_tests.erl +++ b/test/utest/src/cuter_types_tests.erl @@ -92,11 +92,12 @@ convert_types_test() -> Xs = [{M, Fn(M)} || M <- Modules], TagGen = fun() -> ok end, Kmodules = [cuter_cerl:kmodule(M, AST, TagGen) || {M, AST} <- Xs], - Specs = cuter_types:convert_specs(Kmodules), + Specs = cuter_types:specs_as_erl_types(Kmodules), Expect = mfas_and_specs(), - ExpectMfas = [Mfa || {Mfa, _Spec} <- Expect], As = lists:flatten([spec_assertions(E, Specs) || E <- Expect]), - [?assertEqual(lists:sort(ExpectMfas), lists:sort(dict:fetch_keys(Specs)))] ++ As. + ExpectMfas = lists:sort([Mfa || {Mfa, _Spec} <- Expect]), + GotMfas = lists:sort(dict:fetch_keys(Specs)), + [?assertEqual(ExpectMfas, GotMfas)] ++ As. mfas_and_specs() -> From 1a419994993bf2403d188a127825d1946ea55769 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 14:01:35 +0100 Subject: [PATCH 22/85] Reverse the Line-Type tuples for consistency --- src/cuter_types.erl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 8a241fd6..d3c9b3d9 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1235,7 +1235,7 @@ specs_as_erl_types(Kmodules) -> Fn = fun (Kmodule, Acc) -> Mod = cuter_cerl:kmodule_name(Kmodule), TypesLines = all_types_from_cerl(Kmodule), - U = sets:from_list([{TName, length(Vars)} || {{TName, _T, Vars}, _L} <- TypesLines]), + U = sets:from_list([{TName, length(Vars)} || {_L, {TName, _T, Vars}} <- TypesLines]), dict:store(Mod, U, Acc) end, %% Unhandled holds all non converted types from a form to an erl_type for each module. @@ -1306,7 +1306,7 @@ parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled) -> %% This is done to handle types depending on later defined types %% or mutually recursive types immediately fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled) -> - F = fun ({{Tname, T, Vars}, L}, Acc) -> %% Get a type and a set of unhandled types + F = fun ({L, {Tname, T, Vars}}, Acc) -> %% Get a type and a set of unhandled types A = length(Vars), %% Try to convert the type to erl_type using erl_types:t_from_form/6 {{T1, _C}, D1} = @@ -1370,7 +1370,7 @@ equal_sets(A, B) -> %% Return all types defined in a kmodule all_types_from_cerl(Kmodule) -> %% Types and Opaque types - TypesOpaques = [{type_replace_records(Type), Line} || {Line, Type} <- cuter_cerl:kmodule_type_forms(Kmodule)], + TypesOpaques = [{Line, type_replace_records(Type)} || {Line, Type} <- cuter_cerl:kmodule_type_forms(Kmodule)], %% Make the temp types representing records Records = records_as_types(Kmodule), lists:append(TypesOpaques, Records). @@ -1414,7 +1414,7 @@ type_from_record({Name, Line, Fields}) -> NewFields = lists:map(Fn, Fields), NewName = record_name(Name), RecType = {type, Line, tuple, [{atom, Line, Name} | NewFields]}, - {{NewName, RecType, []}, Line}. + {Line, {NewName, RecType, []}}. %% Return the name of a temporary type corresponding to a record with name Name record_name(Name) -> From 1bbf420436c970396d8a159ccdc39e51a6cb5f8c Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 15:12:19 +0100 Subject: [PATCH 23/85] Refactor the extraction of type definitions from a kmodule. --- src/cuter_types.erl | 72 +++++++++++++++++++++------------------------ 1 file changed, 33 insertions(+), 39 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index d3c9b3d9..4e90abbd 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1234,7 +1234,7 @@ specs_as_erl_types(Kmodules) -> ExpTypes = sets:union([cuter_cerl:kmodule_exported_types(M) || M <- Kmodules]), %% Needed for erl_types:t_from_form/6 Fn = fun (Kmodule, Acc) -> Mod = cuter_cerl:kmodule_name(Kmodule), - TypesLines = all_types_from_cerl(Kmodule), + TypesLines = extract_type_definitions(Kmodule), U = sets:from_list([{TName, length(Vars)} || {_L, {TName, _T, Vars}} <- TypesLines]), dict:store(Mod, U, Acc) end, @@ -1285,7 +1285,7 @@ convert_specs_fix_pass([Kmodule|Kmodules], ExpTypes, RecDict, Unhandled, Change, parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled) -> %% Fetch type forms from the kmodule along with the lines where they were defined. %% The lines are needed for the erl_types:t_from_form/6 call - TypesLines = all_types_from_cerl(Kmodule), + TypesLines = extract_type_definitions(Kmodule), Mod = cuter_cerl:kmodule_name(Kmodule), %% Only Unhandled is returned because types will be stored in RecDict ets table Unhandled = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled), @@ -1367,58 +1367,52 @@ convert_list_to_erl([Spec|Specs], MFA, ExpTypes, RecDict, Acc) -> equal_sets(A, B) -> sets:size(A) == sets:size(B) andalso sets:size(sets:union(A, B)) == sets:size(B). -%% Return all types defined in a kmodule -all_types_from_cerl(Kmodule) -> - %% Types and Opaque types - TypesOpaques = [{Line, type_replace_records(Type)} || {Line, Type} <- cuter_cerl:kmodule_type_forms(Kmodule)], - %% Make the temp types representing records - Records = records_as_types(Kmodule), - lists:append(TypesOpaques, Records). +%% Returns the type and record definitions in a kmodule. +%% Records are replaced by equivalent types. +extract_type_definitions(Kmodule) -> + %% Replaces the record references in the type forms. + TypeForms = cuter_cerl:kmodule_type_forms(Kmodule), + Types = [replace_record_references_in_type_form(TF) || TF <- TypeForms], + %% Generate equivalent type for the records. + RecordForms = cuter_cerl:kmodule_record_forms(Kmodule), + Records = [generate_type_form_for_record_form(RF) || RF <- RecordForms], + Types ++ Records. %% Replace all record references with their respective temporary type in a type form -type_replace_records({Name, Type, Args}) -> - {Name, replace_records(Type), Args}. +replace_record_references_in_type_form({Line, {Name, Type, Args}}) -> + {Line, {Name, replace_record_references(Type), Args}}. %% Replace all record references with their respective temporary type in a spec form list spec_replace_records(FunSpecs) -> Fn = fun({type, Line, F, L}) -> - {type, Line, F, lists:map(fun replace_records/1, L)} + {type, Line, F, lists:map(fun replace_record_references/1, L)} end, lists:map(Fn, FunSpecs). %% Replace all record references with their respective temporary type in a form -replace_records({type, L, record, [{atom, _, Name}]}) -> - {user_type, L, record_name(Name), []}; -replace_records({T, L, Type, Args}) when T =:= type orelse T =:= user_type -> +%% Replaces all the references to records inside a type form. +replace_record_references({type, L, record, [{atom, _, Name}]}) -> + {user_type, L, type_name_for_record(Name), []}; +replace_record_references({T, L, Type, Args}) when T =:= type orelse T =:= user_type -> case is_list(Args) of true -> - {T, L, Type, lists:map(fun replace_records/1, Args)}; + {T, L, Type, [replace_record_references(A) || A <- Args]}; false -> {T, L, Type, Args} end; -replace_records(Rest) -> Rest. - -%% Return temporary types representing the records in a kmodule -%% For each record rec with fields es make a temporary tuple type with -%% first item rec and es as the rest items -records_as_types(Kmodule) -> - R = [{RecName, Line, RecFields} || {Line, {RecName, RecFields}} <- cuter_cerl:kmodule_record_forms(Kmodule)], - lists:map(fun type_from_record/1, R). - -%% Create the temporary type from a record form -type_from_record({Name, Line, Fields}) -> - Fn = fun ({typed_record_field, _, T}) -> - replace_records(T) - end, - %% Replace record references in fields - NewFields = lists:map(Fn, Fields), - NewName = record_name(Name), - RecType = {type, Line, tuple, [{atom, Line, Name} | NewFields]}, - {Line, {NewName, RecType, []}}. - -%% Return the name of a temporary type corresponding to a record with name Name -record_name(Name) -> - list_to_atom(?CUTER_RECORD_TYPE_PREFIX ++ atom_to_list(Name)). +replace_record_references(F) -> F. + +%% Generates a type definition for a record. +%% A record is represented as a tuple where the first element is the name of the record. +%% The rest of the elements are the types of the record fields. +generate_type_form_for_record_form({Line, {Name, Fields}}) -> + Fs = [replace_record_references(T) || {typed_record_field, _, T} <- Fields], + RecType = {type, Line, tuple, [{atom, Line, Name} | Fs]}, + {Line, {type_name_for_record(Name), RecType, []}}. + +%% Returns the name of a generated type that represents the record RecordName. +type_name_for_record(RecordName) -> + list_to_atom(?CUTER_RECORD_TYPE_PREFIX ++ atom_to_list(RecordName)). %% Replace all bounded signatures with equivalent normal ones spec_replace_bounded(Specs) -> lists:map(fun handle_bounded_fun/1, Specs). From deaa7c3b2cc371f51097a3635931f8eb2be3ffeb Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 16:42:09 +0100 Subject: [PATCH 24/85] Rename the names for the fix computation --- src/cuter_types.erl | 68 +++++++++++++++++++++++++-------------------- 1 file changed, 38 insertions(+), 30 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 4e90abbd..fcb8de0e 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1230,53 +1230,60 @@ var_name({var, _, X}) -> %% Find the erl type representation of all signatures in a list of kmodules -spec specs_as_erl_types([cuter_cerl:kmodule()]) -> dict:dict(). specs_as_erl_types(Kmodules) -> - RecDict = ets:new(recdict, []), %% Needed for erl_types:t_from_form/6 - ExpTypes = sets:union([cuter_cerl:kmodule_exported_types(M) || M <- Kmodules]), %% Needed for erl_types:t_from_form/6 - Fn = fun (Kmodule, Acc) -> - Mod = cuter_cerl:kmodule_name(Kmodule), - TypesLines = extract_type_definitions(Kmodule), - U = sets:from_list([{TName, length(Vars)} || {_L, {TName, _T, Vars}} <- TypesLines]), - dict:store(Mod, U, Acc) - end, - %% Unhandled holds all non converted types from a form to an erl_type for each module. - %% It is a dict with the module name as the key and all the types defined in it initially. - Unhandled = lists:foldl(Fn, dict:new(), Kmodules), - %% Find all signatures - Ret = convert_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, dict:new()), + %% Initialise an openset with all the types that have not yet been converted from a form + %% to its erl_types representation. + Openset = initial_openset_of_types(Kmodules), + specs_as_erl_types_fix(Kmodules, Openset). + +initial_openset_of_types(Kmodules) -> + initial_openset_of_types(Kmodules, dict:new()). + +initial_openset_of_types([], Openset) -> + Openset; +initial_openset_of_types([KM|KMs], Openset) -> + TypeForms = extract_type_definitions(KM), + Ts = sets:from_list([{TName, length(Vars)} || {_L, {TName, _T, Vars}} <- TypeForms]), + Openset1 = dict:store(cuter_cerl:kmodule_name(KM), Ts, Openset), + initial_openset_of_types(KMs, Openset1). + +%% Converts all the function specifications of the kmodules using a fixpoint computation. +%% We run consecutive passes of substitutions, until there are not changes between +%% two consecutive passes. +specs_as_erl_types_fix(Kmodules, Openset) -> + RecDict = ets:new(recdict, []), %% Needed for erl_types:t_from_form/6. + R = specs_as_erl_types_fix(Kmodules, RecDict, Openset, dict:new()), ets:delete(RecDict), - Ret. + R. -%% Convert all signatures in all modules until none can be converted -convert_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, GatheredSpecs) -> +specs_as_erl_types_fix(Kmodules, RecDict, Openset, GatheredSpecs) -> %% Pass all modules - {Unhandled1, Change, GatheredSpecs1} = convert_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, false, GatheredSpecs), + {Openset1, Change, GatheredSpecs1} = specs_as_erl_types_fix_pass(Kmodules, RecDict, Openset, false, GatheredSpecs), case Change of %% If Unhandled has changed in this pass %% Pass again true -> - convert_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled1, GatheredSpecs1); + specs_as_erl_types_fix(Kmodules, RecDict, Openset1, GatheredSpecs1); %% Else return the gathered signatures false -> GatheredSpecs1 end. %% Pass through all modules and gather signatures -convert_specs_fix_pass([], _ExpTypes, _RecDict, Unhandled, Change, GatheredSpecs) -> {Unhandled, Change, GatheredSpecs}; -convert_specs_fix_pass([Kmodule|Kmodules], ExpTypes, RecDict, Unhandled, Change, GatheredSpecs) -> +specs_as_erl_types_fix_pass([], _RecDict, Unhandled, Change, GatheredSpecs) -> {Unhandled, Change, GatheredSpecs}; +specs_as_erl_types_fix_pass([Kmodule|Kmodules], RecDict, Unhandled, Change, GatheredSpecs) -> Mod = cuter_cerl:kmodule_name(Kmodule), PrevUnhandled = dict:fetch(Mod, Unhandled), %% Get the signatures converted and the unhandled types of this module - {Specs, NewUnhandled} = parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled), - Fn = fun ({MFA, Spec}, G) -> - dict:store(MFA, Spec, G) - end, + Exported = sets:union([cuter_cerl:kmodule_exported_types(KM) || KM <- Kmodules]), + {Specs, NewUnhandled} = parse_mod_specs(Kmodule, Exported, RecDict, PrevUnhandled), + Fn = fun ({MFA, Spec}, G) -> dict:store(MFA, Spec, G) end, %% Store the new signatures found in GatheredSpecs GatheredSpecs1 = lists:foldl(Fn, GatheredSpecs, Specs), %% If the unhandled types for this module have not changed - case equal_sets(NewUnhandled, PrevUnhandled) of + case are_sets_equal(NewUnhandled, PrevUnhandled) of %% Maintain the Change so far in the recursive call - true -> convert_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, Change, GatheredSpecs1); + true -> specs_as_erl_types_fix_pass(Kmodules, RecDict, Unhandled, Change, GatheredSpecs1); %% A change has occured, make the recursive call with Change: true and an updated Unhandled dict - false -> convert_specs_fix_pass(Kmodules, ExpTypes, RecDict, dict:store(Mod, NewUnhandled, Unhandled), true, GatheredSpecs1) + false -> specs_as_erl_types_fix_pass(Kmodules, RecDict, dict:store(Mod, NewUnhandled, Unhandled), true, GatheredSpecs1) end. %% Gather all signatures defined in a module. @@ -1336,7 +1343,7 @@ fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled) -> %% Apply F to all Types in the module Unhandled = lists:foldl(F, sets:new(), TypesLines), %% Check if the unhandled types are different than before - case equal_sets(PrevUnhandled, Unhandled) of + case are_sets_equal(PrevUnhandled, Unhandled) of %% If they are, run the module again false -> fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, Unhandled); @@ -1364,8 +1371,9 @@ convert_list_to_erl([Spec|Specs], MFA, ExpTypes, RecDict, Acc) -> convert_list_to_erl(Specs, MFA, ExpTypes, RecDict, [ErlSpec|Acc]) end. -equal_sets(A, B) -> - sets:size(A) == sets:size(B) andalso sets:size(sets:union(A, B)) == sets:size(B). +are_sets_equal(A, B) -> + %% A = B, iff A ⊆ B and B ⊆ A. + sets:is_subset(A, B) andalso sets:is_subset(B, A). %% Returns the type and record definitions in a kmodule. %% Records are replaced by equivalent types. From ba8b6c39906a2b0e82fbdcb2bf1142f326299be7 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 17:20:00 +0100 Subject: [PATCH 25/85] Add examples with remote types --- Makefile.in | 3 ++- test/utest/src/cuter_types_tests.erl | 13 +++++++++++-- test/utest/src/examples_for_type_analysis.erl | 8 +++++++- test/utest/src/examples_for_type_analysis_pair.erl | 11 +++++++++++ 4 files changed, 31 insertions(+), 4 deletions(-) create mode 100644 test/utest/src/examples_for_type_analysis_pair.erl diff --git a/Makefile.in b/Makefile.in index e74c74d0..514f9d90 100644 --- a/Makefile.in +++ b/Makefile.in @@ -101,7 +101,8 @@ UTEST_MODULES = \ types_and_specs2 \ cuter_metrics_tests \ cuter_config_tests \ - examples_for_type_analysis + examples_for_type_analysis \ + examples_for_type_analysis_pair FTEST_MODULES = \ bitstr \ diff --git a/test/utest/src/cuter_types_tests.erl b/test/utest/src/cuter_types_tests.erl index d361492e..810c2ffb 100644 --- a/test/utest/src/cuter_types_tests.erl +++ b/test/utest/src/cuter_types_tests.erl @@ -84,7 +84,7 @@ cleanup(_) -> ok. -spec convert_types_test() -> any(). convert_types_test() -> - Modules = [examples_for_type_analysis], + Modules = [examples_for_type_analysis, examples_for_type_analysis_pair], Fn = fun(M) -> {ok, AST} = cuter_cerl:get_core(M, false), AST @@ -132,11 +132,20 @@ mfas_and_specs() -> [erl_types:t_list( erl_types:t_tuple([erl_types:t_from_term(point), erl_types:t_number(), erl_types:t_number()]))], erl_types:t_number())] + }, + { + {examples_for_type_analysis, is_dog, 1}, + [erl_types:t_fun([erl_types:t_any()], erl_types:t_boolean())] %% Remote types not working?? + }, + { + {examples_for_type_analysis_pair, to_int, 1}, + [erl_types:t_fun([erl_types:t_any()], erl_types:t_integer())] %% Remote types not working?? } ]. spec_assertions({Mfa, Expect}, R) -> - As = [?assert(dict:is_key(Mfa, R))], + CommentExists = cuter_tests_lib:mfa_to_list(Mfa) ++ " should exist", + As = [?assert(dict:is_key(Mfa, R), CommentExists)], case dict:find(Mfa, R) of error -> As; {ok, Got} -> diff --git a/test/utest/src/examples_for_type_analysis.erl b/test/utest/src/examples_for_type_analysis.erl index 954599c7..0ae9cdf5 100644 --- a/test/utest/src/examples_for_type_analysis.erl +++ b/test/utest/src/examples_for_type_analysis.erl @@ -1,5 +1,8 @@ -module(examples_for_type_analysis). --export([id/1, inc/1, to_atom/1, translate/3, root/1, max_x/1]). + +-export([id/1, inc/1, to_atom/1, translate/3, root/1, max_x/1, is_dog/1]). + +-export_type([t_int_or_atom/0]). -type t_int_or_atom() :: t_int() | atom(). -type t_int() :: integer(). @@ -31,3 +34,6 @@ root(nil) -> nil. -spec max_x(list_of(#point{})) -> number(). max_x(Ps) -> lists:max([P#point.x || P <- Ps]). + +-spec is_dog(examples_for_type_analysis_pair:t_dog_or_cat()) -> boolean(). +is_dog(X) -> X =:= dog. diff --git a/test/utest/src/examples_for_type_analysis_pair.erl b/test/utest/src/examples_for_type_analysis_pair.erl new file mode 100644 index 00000000..6f27c3c5 --- /dev/null +++ b/test/utest/src/examples_for_type_analysis_pair.erl @@ -0,0 +1,11 @@ +-module(examples_for_type_analysis_pair). + +-export([to_int/1]). + +-export_type([t_dog_or_cat/0]). + +-type t_dog_or_cat() :: dog | cat. + +-spec to_int(examples_for_type_analysis:t_int_or_atom()) -> integer(). +to_int(X) when is_integer(X) -> X; +to_int(X) when is_atom(X) -> lists:max(atom_to_list(X)). From f12a2d6a99e4cf739c50dc160821bd23c368c2a3 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 17:26:47 +0100 Subject: [PATCH 26/85] Rename unhandled to openset --- src/cuter_types.erl | 35 ++++++++++++++++------------------- 1 file changed, 16 insertions(+), 19 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index fcb8de0e..4610d3b0 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1256,46 +1256,43 @@ specs_as_erl_types_fix(Kmodules, Openset) -> R. specs_as_erl_types_fix(Kmodules, RecDict, Openset, GatheredSpecs) -> - %% Pass all modules {Openset1, Change, GatheredSpecs1} = specs_as_erl_types_fix_pass(Kmodules, RecDict, Openset, false, GatheredSpecs), - case Change of %% If Unhandled has changed in this pass - %% Pass again + case Change of true -> specs_as_erl_types_fix(Kmodules, RecDict, Openset1, GatheredSpecs1); - %% Else return the gathered signatures false -> GatheredSpecs1 end. %% Pass through all modules and gather signatures -specs_as_erl_types_fix_pass([], _RecDict, Unhandled, Change, GatheredSpecs) -> {Unhandled, Change, GatheredSpecs}; -specs_as_erl_types_fix_pass([Kmodule|Kmodules], RecDict, Unhandled, Change, GatheredSpecs) -> +specs_as_erl_types_fix_pass([], _RecDict, Openset, Change, GatheredSpecs) -> {Openset, Change, GatheredSpecs}; +specs_as_erl_types_fix_pass([Kmodule|Kmodules], RecDict, Openset, Change, GatheredSpecs) -> Mod = cuter_cerl:kmodule_name(Kmodule), - PrevUnhandled = dict:fetch(Mod, Unhandled), + PrevOpenset = dict:fetch(Mod, Openset), %% Get the signatures converted and the unhandled types of this module Exported = sets:union([cuter_cerl:kmodule_exported_types(KM) || KM <- Kmodules]), - {Specs, NewUnhandled} = parse_mod_specs(Kmodule, Exported, RecDict, PrevUnhandled), + {Specs, NewOpenset} = parse_mod_specs(Kmodule, Exported, RecDict, PrevOpenset), Fn = fun ({MFA, Spec}, G) -> dict:store(MFA, Spec, G) end, %% Store the new signatures found in GatheredSpecs GatheredSpecs1 = lists:foldl(Fn, GatheredSpecs, Specs), %% If the unhandled types for this module have not changed - case are_sets_equal(NewUnhandled, PrevUnhandled) of + case are_sets_equal(NewOpenset, PrevOpenset) of %% Maintain the Change so far in the recursive call - true -> specs_as_erl_types_fix_pass(Kmodules, RecDict, Unhandled, Change, GatheredSpecs1); + true -> specs_as_erl_types_fix_pass(Kmodules, RecDict, Openset, Change, GatheredSpecs1); %% A change has occured, make the recursive call with Change: true and an updated Unhandled dict - false -> specs_as_erl_types_fix_pass(Kmodules, RecDict, dict:store(Mod, NewUnhandled, Unhandled), true, GatheredSpecs1) + false -> specs_as_erl_types_fix_pass(Kmodules, RecDict, dict:store(Mod, NewOpenset, Openset), true, GatheredSpecs1) end. %% Gather all signatures defined in a module. %% Return all signatures that can be converted to erl_types %% and all the types that couldn't -parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled) -> +parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevOpenset) -> %% Fetch type forms from the kmodule along with the lines where they were defined. %% The lines are needed for the erl_types:t_from_form/6 call TypesLines = extract_type_definitions(Kmodule), Mod = cuter_cerl:kmodule_name(Kmodule), %% Only Unhandled is returned because types will be stored in RecDict ets table - Unhandled = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled), + Openset = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevOpenset), Fn = fun ({{F, A}, S1}) -> %% For a function F with arity A and signature S1 which is a list %% Replace records with temp record types in the signature S = spec_replace_records(spec_replace_bounded(S1)), @@ -1304,7 +1301,7 @@ parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled) -> {{Mod, F, A}, ErlSpecs} end, Specs = lists:map(Fn, cuter_cerl:kmodule_spec_forms(Kmodule)), - {Specs, Unhandled}. + {Specs, Openset}. %% Convert as many types in Mod as possible to erl_types. %% For every succesful conversion add it to RecDict and finally @@ -1312,7 +1309,7 @@ parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled) -> %% If there are more succesful conversions as before try again. %% This is done to handle types depending on later defined types %% or mutually recursive types immediately -fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled) -> +fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevOpenset) -> F = fun ({L, {Tname, T, Vars}}, Acc) -> %% Get a type and a set of unhandled types A = length(Vars), %% Try to convert the type to erl_type using erl_types:t_from_form/6 @@ -1341,15 +1338,15 @@ fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled) -> end end, %% Apply F to all Types in the module - Unhandled = lists:foldl(F, sets:new(), TypesLines), + Openset = lists:foldl(F, sets:new(), TypesLines), %% Check if the unhandled types are different than before - case are_sets_equal(PrevUnhandled, Unhandled) of + case are_sets_equal(PrevOpenset, Openset) of %% If they are, run the module again false -> - fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, Unhandled); + fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, Openset); %% Else return the unhandled types true -> - Unhandled + Openset end. %% Convert a list of forms to a list of erl_types From 1a1cf7db73ffb091ca228411ee1035c0ec3a531a Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 17:54:37 +0100 Subject: [PATCH 27/85] Remove the Change variable --- src/cuter_types.erl | 72 +++++++++++++++++++++++---------------------- 1 file changed, 37 insertions(+), 35 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 4610d3b0..fcd38c8d 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1233,75 +1233,77 @@ specs_as_erl_types(Kmodules) -> %% Initialise an openset with all the types that have not yet been converted from a form %% to its erl_types representation. Openset = initial_openset_of_types(Kmodules), - specs_as_erl_types_fix(Kmodules, Openset). + Exported = sets:union([cuter_cerl:kmodule_exported_types(KM) || KM <- Kmodules]), + specs_as_erl_types_fix(Kmodules, Exported, Openset). initial_openset_of_types(Kmodules) -> - initial_openset_of_types(Kmodules, dict:new()). + initial_openset_of_types(Kmodules, sets:new()). initial_openset_of_types([], Openset) -> Openset; initial_openset_of_types([KM|KMs], Openset) -> TypeForms = extract_type_definitions(KM), - Ts = sets:from_list([{TName, length(Vars)} || {_L, {TName, _T, Vars}} <- TypeForms]), - Openset1 = dict:store(cuter_cerl:kmodule_name(KM), Ts, Openset), - initial_openset_of_types(KMs, Openset1). + M = cuter_cerl:kmodule_name(KM), + Ts = sets:from_list([{M, TName, length(Vars)} || {_L, {TName, _T, Vars}} <- TypeForms]), + initial_openset_of_types(KMs, sets:union(Openset, Ts)). %% Converts all the function specifications of the kmodules using a fixpoint computation. %% We run consecutive passes of substitutions, until there are not changes between %% two consecutive passes. -specs_as_erl_types_fix(Kmodules, Openset) -> +specs_as_erl_types_fix(Kmodules, Exported, Openset) -> RecDict = ets:new(recdict, []), %% Needed for erl_types:t_from_form/6. - R = specs_as_erl_types_fix(Kmodules, RecDict, Openset, dict:new()), + R = specs_as_erl_types_fix(Kmodules, Exported, RecDict, Openset, dict:new()), ets:delete(RecDict), R. -specs_as_erl_types_fix(Kmodules, RecDict, Openset, GatheredSpecs) -> - {Openset1, Change, GatheredSpecs1} = specs_as_erl_types_fix_pass(Kmodules, RecDict, Openset, false, GatheredSpecs), - case Change of - true -> - specs_as_erl_types_fix(Kmodules, RecDict, Openset1, GatheredSpecs1); - false -> - GatheredSpecs1 +specs_as_erl_types_fix(Kmodules, Exported, RecDict, Openset, GatheredSpecs) -> + {Openset1, GatheredSpecs1} = specs_as_erl_types_fix_pass(Kmodules, Exported, RecDict, Openset, GatheredSpecs), + case are_sets_equal(Openset, Openset1) of + true -> GatheredSpecs1; + false -> specs_as_erl_types_fix(Kmodules, Exported, RecDict, Openset1, GatheredSpecs1) end. %% Pass through all modules and gather signatures -specs_as_erl_types_fix_pass([], _RecDict, Openset, Change, GatheredSpecs) -> {Openset, Change, GatheredSpecs}; -specs_as_erl_types_fix_pass([Kmodule|Kmodules], RecDict, Openset, Change, GatheredSpecs) -> - Mod = cuter_cerl:kmodule_name(Kmodule), - PrevOpenset = dict:fetch(Mod, Openset), +specs_as_erl_types_fix_pass([], _Exported, _RecDict, Openset, GatheredSpecs) -> + {Openset, GatheredSpecs}; +specs_as_erl_types_fix_pass([KM|KMs], Exported, RecDict, Openset, GatheredSpecs) -> + Mod = cuter_cerl:kmodule_name(KM), + ModOpenset = sets:filter(fun({M, _T, _A}) -> M =:= Mod end, Openset), %% Get the signatures converted and the unhandled types of this module - Exported = sets:union([cuter_cerl:kmodule_exported_types(KM) || KM <- Kmodules]), - {Specs, NewOpenset} = parse_mod_specs(Kmodule, Exported, RecDict, PrevOpenset), + {Specs, NewModOpenset} = parse_mod_specs(KM, Exported, RecDict, ModOpenset), Fn = fun ({MFA, Spec}, G) -> dict:store(MFA, Spec, G) end, %% Store the new signatures found in GatheredSpecs GatheredSpecs1 = lists:foldl(Fn, GatheredSpecs, Specs), %% If the unhandled types for this module have not changed - case are_sets_equal(NewOpenset, PrevOpenset) of + case are_sets_equal(NewModOpenset, ModOpenset) of %% Maintain the Change so far in the recursive call - true -> specs_as_erl_types_fix_pass(Kmodules, RecDict, Openset, Change, GatheredSpecs1); + true -> + specs_as_erl_types_fix_pass(KMs, Exported, RecDict, Openset, GatheredSpecs1); %% A change has occured, make the recursive call with Change: true and an updated Unhandled dict - false -> specs_as_erl_types_fix_pass(Kmodules, RecDict, dict:store(Mod, NewOpenset, Openset), true, GatheredSpecs1) + false -> + OtherModsOpenset = sets:subtract(Openset, ModOpenset), + specs_as_erl_types_fix_pass(KMs, Exported, RecDict, sets:union(NewModOpenset, OtherModsOpenset), GatheredSpecs1) end. %% Gather all signatures defined in a module. %% Return all signatures that can be converted to erl_types %% and all the types that couldn't -parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevOpenset) -> +parse_mod_specs(Kmodule, ExpTypes, RecDict, ModOpenSet) -> %% Fetch type forms from the kmodule along with the lines where they were defined. %% The lines are needed for the erl_types:t_from_form/6 call TypesLines = extract_type_definitions(Kmodule), Mod = cuter_cerl:kmodule_name(Kmodule), %% Only Unhandled is returned because types will be stored in RecDict ets table - Openset = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevOpenset), + NewModOpenset = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, ModOpenSet), Fn = fun ({{F, A}, S1}) -> %% For a function F with arity A and signature S1 which is a list - %% Replace records with temp record types in the signature - S = spec_replace_records(spec_replace_bounded(S1)), - %% Convert each element of the list into an erl_type - ErlSpecs = convert_list_to_erl(S, {Mod, F, A}, ExpTypes, RecDict), - {{Mod, F, A}, ErlSpecs} - end, + %% Replace records with temp record types in the signature + S = spec_replace_records(spec_replace_bounded(S1)), + %% Convert each element of the list into an erl_type + ErlSpecs = convert_list_to_erl(S, {Mod, F, A}, ExpTypes, RecDict), + {{Mod, F, A}, ErlSpecs} + end, Specs = lists:map(Fn, cuter_cerl:kmodule_spec_forms(Kmodule)), - {Specs, Openset}. + {Specs, NewModOpenset}. %% Convert as many types in Mod as possible to erl_types. %% For every succesful conversion add it to RecDict and finally @@ -1309,7 +1311,7 @@ parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevOpenset) -> %% If there are more succesful conversions as before try again. %% This is done to handle types depending on later defined types %% or mutually recursive types immediately -fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevOpenset) -> +fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, ModOpenSet) -> F = fun ({L, {Tname, T, Vars}}, Acc) -> %% Get a type and a set of unhandled types A = length(Vars), %% Try to convert the type to erl_type using erl_types:t_from_form/6 @@ -1334,13 +1336,13 @@ fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevOpenset) -> end; %% Else, add the type to the Unhandled set true -> - sets:add_element({Tname, A}, Acc) + sets:add_element({Mod, Tname, A}, Acc) end end, %% Apply F to all Types in the module Openset = lists:foldl(F, sets:new(), TypesLines), %% Check if the unhandled types are different than before - case are_sets_equal(PrevOpenset, Openset) of + case are_sets_equal(ModOpenSet, Openset) of %% If they are, run the module again false -> fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, Openset); From c49ded6ec2d00fe92e7536f86891089b89e49a2c Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 18:08:37 +0100 Subject: [PATCH 28/85] Refactor specs_as_erl_types_fix --- src/cuter_types.erl | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index fcd38c8d..5b53c1b4 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1256,35 +1256,37 @@ specs_as_erl_types_fix(Kmodules, Exported, Openset) -> ets:delete(RecDict), R. -specs_as_erl_types_fix(Kmodules, Exported, RecDict, Openset, GatheredSpecs) -> - {Openset1, GatheredSpecs1} = specs_as_erl_types_fix_pass(Kmodules, Exported, RecDict, Openset, GatheredSpecs), +specs_as_erl_types_fix(KMs, Exported, RecDict, Openset, GatheredSpecs) -> + {Openset1, GatheredSpecs1} = specs_as_erl_types_fix_pass(KMs, Exported, RecDict, Openset, GatheredSpecs), case are_sets_equal(Openset, Openset1) of true -> GatheredSpecs1; - false -> specs_as_erl_types_fix(Kmodules, Exported, RecDict, Openset1, GatheredSpecs1) + false -> specs_as_erl_types_fix(KMs, Exported, RecDict, Openset1, GatheredSpecs1) end. -%% Pass through all modules and gather signatures +%% Iterates through each kmodule and converts function specifications into their +%% erl_types representation. specs_as_erl_types_fix_pass([], _Exported, _RecDict, Openset, GatheredSpecs) -> {Openset, GatheredSpecs}; specs_as_erl_types_fix_pass([KM|KMs], Exported, RecDict, Openset, GatheredSpecs) -> Mod = cuter_cerl:kmodule_name(KM), ModOpenset = sets:filter(fun({M, _T, _A}) -> M =:= Mod end, Openset), - %% Get the signatures converted and the unhandled types of this module - {Specs, NewModOpenset} = parse_mod_specs(KM, Exported, RecDict, ModOpenset), - Fn = fun ({MFA, Spec}, G) -> dict:store(MFA, Spec, G) end, - %% Store the new signatures found in GatheredSpecs - GatheredSpecs1 = lists:foldl(Fn, GatheredSpecs, Specs), - %% If the unhandled types for this module have not changed + {ComputedSpecs, NewModOpenset} = parse_mod_specs(KM, Exported, RecDict, ModOpenset), + GatheredSpecs1 = update_gathered_specs(ComputedSpecs, GatheredSpecs), case are_sets_equal(NewModOpenset, ModOpenset) of - %% Maintain the Change so far in the recursive call + %% The openset of the module has reached a fixpoint. true -> specs_as_erl_types_fix_pass(KMs, Exported, RecDict, Openset, GatheredSpecs1); - %% A change has occured, make the recursive call with Change: true and an updated Unhandled dict + %% If the openset of the module has changed, we want to re-run the computation. false -> OtherModsOpenset = sets:subtract(Openset, ModOpenset), specs_as_erl_types_fix_pass(KMs, Exported, RecDict, sets:union(NewModOpenset, OtherModsOpenset), GatheredSpecs1) end. +update_gathered_specs([], GatheredSpecs) -> GatheredSpecs; +update_gathered_specs([{Mfa, Spec}|More], GatheredSpecs) -> + GatheredSpecs1 = dict:store(Mfa, Spec, GatheredSpecs), + update_gathered_specs(More, GatheredSpecs1). + %% Gather all signatures defined in a module. %% Return all signatures that can be converted to erl_types %% and all the types that couldn't From 33feb425d26874d1a87b8b5e1fb169acc5bdfc6d Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 18:20:43 +0100 Subject: [PATCH 29/85] Rerun the module again --- src/cuter_types.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 5b53c1b4..1b2953ad 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1279,7 +1279,7 @@ specs_as_erl_types_fix_pass([KM|KMs], Exported, RecDict, Openset, GatheredSpecs) %% If the openset of the module has changed, we want to re-run the computation. false -> OtherModsOpenset = sets:subtract(Openset, ModOpenset), - specs_as_erl_types_fix_pass(KMs, Exported, RecDict, sets:union(NewModOpenset, OtherModsOpenset), GatheredSpecs1) + specs_as_erl_types_fix_pass([KM|KMs], Exported, RecDict, sets:union(NewModOpenset, OtherModsOpenset), GatheredSpecs1) end. update_gathered_specs([], GatheredSpecs) -> GatheredSpecs; From cedbfeed56a2410a628949ba59c08d7cfbb01d1e Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 19:00:13 +0100 Subject: [PATCH 30/85] Remove the inner fixpoint --- src/cuter_types.erl | 21 ++++++--------------- 1 file changed, 6 insertions(+), 15 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 1b2953ad..6e6ea296 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1270,7 +1270,7 @@ specs_as_erl_types_fix_pass([], _Exported, _RecDict, Openset, GatheredSpecs) -> specs_as_erl_types_fix_pass([KM|KMs], Exported, RecDict, Openset, GatheredSpecs) -> Mod = cuter_cerl:kmodule_name(KM), ModOpenset = sets:filter(fun({M, _T, _A}) -> M =:= Mod end, Openset), - {ComputedSpecs, NewModOpenset} = parse_mod_specs(KM, Exported, RecDict, ModOpenset), + {ComputedSpecs, NewModOpenset} = parse_mod_specs(KM, Exported, RecDict), GatheredSpecs1 = update_gathered_specs(ComputedSpecs, GatheredSpecs), case are_sets_equal(NewModOpenset, ModOpenset) of %% The openset of the module has reached a fixpoint. @@ -1290,13 +1290,13 @@ update_gathered_specs([{Mfa, Spec}|More], GatheredSpecs) -> %% Gather all signatures defined in a module. %% Return all signatures that can be converted to erl_types %% and all the types that couldn't -parse_mod_specs(Kmodule, ExpTypes, RecDict, ModOpenSet) -> +parse_mod_specs(Kmodule, ExpTypes, RecDict) -> %% Fetch type forms from the kmodule along with the lines where they were defined. %% The lines are needed for the erl_types:t_from_form/6 call TypesLines = extract_type_definitions(Kmodule), Mod = cuter_cerl:kmodule_name(Kmodule), %% Only Unhandled is returned because types will be stored in RecDict ets table - NewModOpenset = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, ModOpenSet), + ModOpenset = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines), Fn = fun ({{F, A}, S1}) -> %% For a function F with arity A and signature S1 which is a list %% Replace records with temp record types in the signature S = spec_replace_records(spec_replace_bounded(S1)), @@ -1305,7 +1305,7 @@ parse_mod_specs(Kmodule, ExpTypes, RecDict, ModOpenSet) -> {{Mod, F, A}, ErlSpecs} end, Specs = lists:map(Fn, cuter_cerl:kmodule_spec_forms(Kmodule)), - {Specs, NewModOpenset}. + {Specs, ModOpenset}. %% Convert as many types in Mod as possible to erl_types. %% For every succesful conversion add it to RecDict and finally @@ -1313,7 +1313,7 @@ parse_mod_specs(Kmodule, ExpTypes, RecDict, ModOpenSet) -> %% If there are more succesful conversions as before try again. %% This is done to handle types depending on later defined types %% or mutually recursive types immediately -fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, ModOpenSet) -> +fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines) -> F = fun ({L, {Tname, T, Vars}}, Acc) -> %% Get a type and a set of unhandled types A = length(Vars), %% Try to convert the type to erl_type using erl_types:t_from_form/6 @@ -1342,16 +1342,7 @@ fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, ModOpenSet) -> end end, %% Apply F to all Types in the module - Openset = lists:foldl(F, sets:new(), TypesLines), - %% Check if the unhandled types are different than before - case are_sets_equal(ModOpenSet, Openset) of - %% If they are, run the module again - false -> - fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, Openset); - %% Else return the unhandled types - true -> - Openset - end. + lists:foldl(F, sets:new(), TypesLines). %% Convert a list of forms to a list of erl_types convert_list_to_erl(S, MFA, ExpTypes, RecDict) -> From 60e417c211dadc6ed41e8a937c1f9f93cbb56291 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 19:30:41 +0100 Subject: [PATCH 31/85] Fix remote types --- src/cuter_cerl.erl | 4 ++-- test/utest/src/cuter_types_tests.erl | 8 ++++++-- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/src/cuter_cerl.erl b/src/cuter_cerl.erl index d8f742ec..10953adb 100644 --- a/src/cuter_cerl.erl +++ b/src/cuter_cerl.erl @@ -320,8 +320,8 @@ extract_exports(M, AST) -> [mfa_from_var(M, E) || E <- Exports]. extract_exported_types(Mod, Attrs) -> - Filtered = [T || {#c_literal{val = export_type}, #c_literal{val = T}} <- Attrs], - sets:from_list(lists:append([{Mod, Tname, Tarity} || {Tname, Tarity} <- Filtered])). + Filtered = lists:append([Ts || {#c_literal{val = export_type}, #c_literal{val = Ts}} <- Attrs]), + sets:from_list([{Mod, Tname, Tarity} || {Tname, Tarity} <- Filtered]). -spec process_fundef({cerl:c_var(), code()}, [mfa()], module(), tag_generator()) -> {mfa(), kfun()}. process_fundef({FunVar, Def}, Exports, M, TagGen) -> diff --git a/test/utest/src/cuter_types_tests.erl b/test/utest/src/cuter_types_tests.erl index 810c2ffb..f2ad1e0b 100644 --- a/test/utest/src/cuter_types_tests.erl +++ b/test/utest/src/cuter_types_tests.erl @@ -135,11 +135,15 @@ mfas_and_specs() -> }, { {examples_for_type_analysis, is_dog, 1}, - [erl_types:t_fun([erl_types:t_any()], erl_types:t_boolean())] %% Remote types not working?? + [erl_types:t_fun( + [erl_types:t_sup(erl_types:t_atom(dog), erl_types:t_atom(cat))], + erl_types:t_boolean())] }, { {examples_for_type_analysis_pair, to_int, 1}, - [erl_types:t_fun([erl_types:t_any()], erl_types:t_integer())] %% Remote types not working?? + [erl_types:t_fun( + [erl_types:t_sup(erl_types:t_integer(), erl_types:t_atom())], + erl_types:t_integer())] } ]. From 5e20572cce64b9e8c8ce2f9f3ef0599b9732605a Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 20:28:50 +0100 Subject: [PATCH 32/85] Compute the specs of a module --- src/cuter_cerl.erl | 6 ++-- src/cuter_types.erl | 69 +++++++++++++++++++++++---------------------- 2 files changed, 39 insertions(+), 36 deletions(-) diff --git a/src/cuter_cerl.erl b/src/cuter_cerl.erl index 10953adb..7d50d664 100644 --- a/src/cuter_cerl.erl +++ b/src/cuter_cerl.erl @@ -70,7 +70,7 @@ -type name() :: atom(). -type fa() :: {name(), arity()}. -type cerl_attr_type() :: cerl_recdef() | cerl_typedef(). --type cerl_attr_spec() :: cerl_specdef(). +-type cerl_attr_spec() :: cerl_spec_form(). -type cerl_recdef() :: {name(), [cerl_record_field()]} % for OTP 19.x | {{'record', name()}, [cerl_record_field()], []}. % for OTP 18.x or earlier @@ -80,7 +80,7 @@ -type cerl_typed_record_field() :: {'typed_record_field', cerl_untyped_record_field(), cerl_type()}. -type cerl_typedef() :: {name(), cerl_type(), [cerl_type_var()]}. --type cerl_specdef() :: {fa(), cerl_spec()}. +-type cerl_spec_form() :: {fa(), cerl_spec()}. -type cerl_spec() :: [cerl_spec_func(), ...]. -type cerl_spec_func() :: cerl_func() | cerl_bounded_func(). @@ -273,7 +273,7 @@ is_mfa({M, F, A}) when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> true; is_mfa(_Mfa) -> false. %% Returns the unprocessed specs of a kmodule (as forms). --spec kmodule_spec_forms(kmodule()) -> [cerl:cerl()]. +-spec kmodule_spec_forms(kmodule()) -> [cerl_spec_form()]. kmodule_spec_forms(Kmodule) -> [{spec_forms, SpecsForms}] = ets:lookup(Kmodule, spec_forms), SpecsForms. diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 6e6ea296..939f1477 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1267,19 +1267,19 @@ specs_as_erl_types_fix(KMs, Exported, RecDict, Openset, GatheredSpecs) -> %% erl_types representation. specs_as_erl_types_fix_pass([], _Exported, _RecDict, Openset, GatheredSpecs) -> {Openset, GatheredSpecs}; -specs_as_erl_types_fix_pass([KM|KMs], Exported, RecDict, Openset, GatheredSpecs) -> +specs_as_erl_types_fix_pass([KM|Rest]=KMs, Exported, RecDict, Openset, GatheredSpecs) -> Mod = cuter_cerl:kmodule_name(KM), ModOpenset = sets:filter(fun({M, _T, _A}) -> M =:= Mod end, Openset), - {ComputedSpecs, NewModOpenset} = parse_mod_specs(KM, Exported, RecDict), + {NewModOpenset, ComputedSpecs} = module_specs_as_erl_types(KM, Exported, RecDict), GatheredSpecs1 = update_gathered_specs(ComputedSpecs, GatheredSpecs), case are_sets_equal(NewModOpenset, ModOpenset) of %% The openset of the module has reached a fixpoint. true -> - specs_as_erl_types_fix_pass(KMs, Exported, RecDict, Openset, GatheredSpecs1); + specs_as_erl_types_fix_pass(Rest, Exported, RecDict, Openset, GatheredSpecs1); %% If the openset of the module has changed, we want to re-run the computation. false -> OtherModsOpenset = sets:subtract(Openset, ModOpenset), - specs_as_erl_types_fix_pass([KM|KMs], Exported, RecDict, sets:union(NewModOpenset, OtherModsOpenset), GatheredSpecs1) + specs_as_erl_types_fix_pass(KMs, Exported, RecDict, sets:union(NewModOpenset, OtherModsOpenset), GatheredSpecs1) end. update_gathered_specs([], GatheredSpecs) -> GatheredSpecs; @@ -1287,25 +1287,28 @@ update_gathered_specs([{Mfa, Spec}|More], GatheredSpecs) -> GatheredSpecs1 = dict:store(Mfa, Spec, GatheredSpecs), update_gathered_specs(More, GatheredSpecs1). -%% Gather all signatures defined in a module. -%% Return all signatures that can be converted to erl_types -%% and all the types that couldn't -parse_mod_specs(Kmodule, ExpTypes, RecDict) -> - %% Fetch type forms from the kmodule along with the lines where they were defined. - %% The lines are needed for the erl_types:t_from_form/6 call - TypesLines = extract_type_definitions(Kmodule), - Mod = cuter_cerl:kmodule_name(Kmodule), - %% Only Unhandled is returned because types will be stored in RecDict ets table - ModOpenset = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines), - Fn = fun ({{F, A}, S1}) -> %% For a function F with arity A and signature S1 which is a list - %% Replace records with temp record types in the signature - S = spec_replace_records(spec_replace_bounded(S1)), - %% Convert each element of the list into an erl_type - ErlSpecs = convert_list_to_erl(S, {Mod, F, A}, ExpTypes, RecDict), - {{Mod, F, A}, ErlSpecs} - end, - Specs = lists:map(Fn, cuter_cerl:kmodule_spec_forms(Kmodule)), - {Specs, ModOpenset}. +%% Computes the specs of a kmodule as erl_types. +%% Returns the computes specs, and the types that were not computed yet. +module_specs_as_erl_types(Kmodule, Exported, RecDict) -> + %% Run one pass that computes the types in the module. + ModOpenset = update_recdict_for_module_types(Kmodule, Exported, RecDict), + %% Compute the specs based on the potentially updated types. + SpecForms = cuter_cerl:kmodule_spec_forms(Kmodule), + Specs = [spec_form_as_erl_types(SF, Kmodule, Exported, RecDict) || SF <- SpecForms], + {ModOpenset, Specs}. + +update_recdict_for_module_types(Kmodule, Exported, RecDict) -> + TypeForms = extract_type_definitions(Kmodule), + M = cuter_cerl:kmodule_name(Kmodule), + fix_point_type_parse(M, RecDict, Exported, TypeForms). + +spec_form_as_erl_types({{F, A}, Spec}, Kmodule, Exported, RecDict) -> + %% Replace records with temp record types in the signature + Normalized = spec_replace_records(spec_replace_bounded(Spec)), + %% Convert each element of the list into an erl_type + Mfa = {cuter_cerl:kmodule_name(Kmodule), F, A}, + Converted = convert_list_to_erl(Normalized, Mfa, Exported, RecDict), + {Mfa, Converted}. %% Convert as many types in Mod as possible to erl_types. %% For every succesful conversion add it to RecDict and finally @@ -1313,12 +1316,12 @@ parse_mod_specs(Kmodule, ExpTypes, RecDict) -> %% If there are more succesful conversions as before try again. %% This is done to handle types depending on later defined types %% or mutually recursive types immediately -fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines) -> +fix_point_type_parse(Mod, RecDict, Exported, TypeForms) -> F = fun ({L, {Tname, T, Vars}}, Acc) -> %% Get a type and a set of unhandled types A = length(Vars), %% Try to convert the type to erl_type using erl_types:t_from_form/6 {{T1, _C}, D1} = - try erl_types:t_from_form(T, ExpTypes, {'type', {Mod, Tname, A}}, RecDict, erl_types:var_table__new(), erl_types:cache__new()) of + try erl_types:t_from_form(T, Exported, {'type', {Mod, Tname, A}}, RecDict, erl_types:var_table__new(), erl_types:cache__new()) of Ret -> {Ret, false} catch _:_ -> @@ -1342,25 +1345,25 @@ fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines) -> end end, %% Apply F to all Types in the module - lists:foldl(F, sets:new(), TypesLines). + lists:foldl(F, sets:new(), TypeForms). %% Convert a list of forms to a list of erl_types -convert_list_to_erl(S, MFA, ExpTypes, RecDict) -> - convert_list_to_erl(S, MFA, ExpTypes, RecDict, []). +convert_list_to_erl(S, MFA, TypeForms, RecDict) -> + convert_list_to_erl(S, MFA, TypeForms, RecDict, []). -convert_list_to_erl([], _MFA, _ExpTypes, _RecDict, Acc) -> lists:reverse(Acc); -convert_list_to_erl([Spec|Specs], MFA, ExpTypes, RecDict, Acc) -> +convert_list_to_erl([], _MFA, _TypeForms, _RecDict, Acc) -> lists:reverse(Acc); +convert_list_to_erl([Spec|Specs], MFA, TypeForms, RecDict, Acc) -> ErlSpec = - try erl_types:t_from_form(Spec, ExpTypes, {'spec', MFA}, RecDict, erl_types:var_table__new(), erl_types:cache__new()) of + try erl_types:t_from_form(Spec, TypeForms, {'spec', MFA}, RecDict, erl_types:var_table__new(), erl_types:cache__new()) of {S, _C} -> S catch _:_ -> nospec end, case ErlSpec of nospec -> - convert_list_to_erl(Specs, MFA, ExpTypes, RecDict, Acc); + convert_list_to_erl(Specs, MFA, TypeForms, RecDict, Acc); _ -> - convert_list_to_erl(Specs, MFA, ExpTypes, RecDict, [ErlSpec|Acc]) + convert_list_to_erl(Specs, MFA, TypeForms, RecDict, [ErlSpec|Acc]) end. are_sets_equal(A, B) -> From bdde60c75f2046f96fe0972cc8d4ec8e8d3be22e Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 21:09:41 +0100 Subject: [PATCH 33/85] Refactor the update of RecDict --- src/cuter_types.erl | 69 ++++++++++++++++++++++----------------------- 1 file changed, 33 insertions(+), 36 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 939f1477..452a992a 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1277,6 +1277,8 @@ specs_as_erl_types_fix_pass([KM|Rest]=KMs, Exported, RecDict, Openset, GatheredS true -> specs_as_erl_types_fix_pass(Rest, Exported, RecDict, Openset, GatheredSpecs1); %% If the openset of the module has changed, we want to re-run the computation. + %% This can happend when a type depends on a type that is defined later in the code, + %% or for mutually recursive types. false -> OtherModsOpenset = sets:subtract(Openset, ModOpenset), specs_as_erl_types_fix_pass(KMs, Exported, RecDict, sets:union(NewModOpenset, OtherModsOpenset), GatheredSpecs1) @@ -1300,7 +1302,7 @@ module_specs_as_erl_types(Kmodule, Exported, RecDict) -> update_recdict_for_module_types(Kmodule, Exported, RecDict) -> TypeForms = extract_type_definitions(Kmodule), M = cuter_cerl:kmodule_name(Kmodule), - fix_point_type_parse(M, RecDict, Exported, TypeForms). + update_recdict_from_type_forms(M, RecDict, Exported, TypeForms). spec_form_as_erl_types({{F, A}, Spec}, Kmodule, Exported, RecDict) -> %% Replace records with temp record types in the signature @@ -1310,42 +1312,37 @@ spec_form_as_erl_types({{F, A}, Spec}, Kmodule, Exported, RecDict) -> Converted = convert_list_to_erl(Normalized, Mfa, Exported, RecDict), {Mfa, Converted}. -%% Convert as many types in Mod as possible to erl_types. -%% For every succesful conversion add it to RecDict and finally -%% return the types that couldn't be converted. -%% If there are more succesful conversions as before try again. -%% This is done to handle types depending on later defined types -%% or mutually recursive types immediately -fix_point_type_parse(Mod, RecDict, Exported, TypeForms) -> - F = fun ({L, {Tname, T, Vars}}, Acc) -> %% Get a type and a set of unhandled types - A = length(Vars), - %% Try to convert the type to erl_type using erl_types:t_from_form/6 - {{T1, _C}, D1} = - try erl_types:t_from_form(T, Exported, {'type', {Mod, Tname, A}}, RecDict, erl_types:var_table__new(), erl_types:cache__new()) of - Ret -> {Ret, false} - catch - _:_ -> - {{none, none}, true} - end, - %% Check if the conversion was successful - case D1 of - %% If it was, add the new erl_type in RecDict - false -> - case ets:lookup(RecDict, Mod) of - [{Mod, VT}] -> - ets:insert(RecDict, {Mod, maps:put({'type', Tname, A}, {{Mod, {lists:append(atom_to_list(Mod), ".erl"), L}, T, [var_name(Var) || Var <- Vars]}, T1}, VT)}), - Acc; - _ -> - ets:insert(RecDict, {Mod, maps:put({'type', Tname, A}, {{Mod, {lists:append(atom_to_list(Mod), ".erl"), L}, T, [var_name(Var) || Var <- Vars]}, T1}, maps:new())}), - Acc - end; - %% Else, add the type to the Unhandled set - true -> - sets:add_element({Mod, Tname, A}, Acc) +%% Converts as many types in M as possible to their erl_types representation. +%% Every succesful conversion is added to RecDict. +%% We return the types that could not be converted, i.e. the openset. +update_recdict_from_type_forms(M, RecDict, Exported, TypeForms) -> + Fn = fun ({L, {TName, T, TVars}}, Acc) -> + A = length(TVars), + Mta = {M, TName, A}, + Vs = [var_name(Var) || Var <- TVars], + case try_convert_type_to_erl_types(Mta, T, Exported, RecDict) of + error -> sets:add_element(Mta, Acc); + {ok, T1} -> + VT = + case ets:lookup(RecDict, M) of + [{M, OVT}] -> OVT; + [] -> maps:new() + end, + NVT = maps:put({'type', TName, A}, {{M, {atom_to_list(M) ++ ".erl", L}, T, Vs}, T1}, VT), + ets:insert(RecDict, {M, NVT}), + Acc end - end, - %% Apply F to all Types in the module - lists:foldl(F, sets:new(), TypeForms). + end, + lists:foldl(Fn, sets:new(), TypeForms). + +try_convert_type_to_erl_types(Mta, T, Exported, RecDict) -> + VT = erl_types:var_table__new(), + Cache = erl_types:cache__new(), + try erl_types:t_from_form(T, Exported, {'type', Mta}, RecDict, VT, Cache) of + {T1, _C} -> {ok, T1} + catch + _:_ -> error + end. %% Convert a list of forms to a list of erl_types convert_list_to_erl(S, MFA, TypeForms, RecDict) -> From 00fbab6e55206edbd9273eee91ddff0222fd484b Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 21:18:38 +0100 Subject: [PATCH 34/85] Add an example with a bounded fun --- src/cuter_types.erl | 5 +++-- test/utest/src/cuter_types_tests.erl | 6 ++++++ test/utest/src/examples_for_type_analysis_pair.erl | 5 ++++- 3 files changed, 13 insertions(+), 3 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 452a992a..a62ab160 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1414,8 +1414,9 @@ generate_type_form_for_record_form({Line, {Name, Fields}}) -> type_name_for_record(RecordName) -> list_to_atom(?CUTER_RECORD_TYPE_PREFIX ++ atom_to_list(RecordName)). -%% Replace all bounded signatures with equivalent normal ones -spec_replace_bounded(Specs) -> lists:map(fun handle_bounded_fun/1, Specs). +%% Replaces all the specs that are expressed as bounded functions, to their equivalent +%% unbounded ones. +spec_replace_bounded(Spec) -> [handle_bounded_fun(S) || S <- Spec]. %% If a the signature is not bounded, return it intact handle_bounded_fun({type, _L, 'fun', _Rest} = S) -> S; diff --git a/test/utest/src/cuter_types_tests.erl b/test/utest/src/cuter_types_tests.erl index f2ad1e0b..683c5033 100644 --- a/test/utest/src/cuter_types_tests.erl +++ b/test/utest/src/cuter_types_tests.erl @@ -144,6 +144,12 @@ mfas_and_specs() -> [erl_types:t_fun( [erl_types:t_sup(erl_types:t_integer(), erl_types:t_atom())], erl_types:t_integer())] + }, + { + {examples_for_type_analysis_pair, can_bark, 1}, + [erl_types:t_fun( + [erl_types:t_sup(erl_types:t_atom(dog), erl_types:t_atom(cat))], + erl_types:t_boolean())] } ]. diff --git a/test/utest/src/examples_for_type_analysis_pair.erl b/test/utest/src/examples_for_type_analysis_pair.erl index 6f27c3c5..36a6f42b 100644 --- a/test/utest/src/examples_for_type_analysis_pair.erl +++ b/test/utest/src/examples_for_type_analysis_pair.erl @@ -1,6 +1,6 @@ -module(examples_for_type_analysis_pair). --export([to_int/1]). +-export([to_int/1, can_bark/1]). -export_type([t_dog_or_cat/0]). @@ -9,3 +9,6 @@ -spec to_int(examples_for_type_analysis:t_int_or_atom()) -> integer(). to_int(X) when is_integer(X) -> X; to_int(X) when is_atom(X) -> lists:max(atom_to_list(X)). + +-spec can_bark(Animal) -> boolean() when Animal :: t_dog_or_cat(). +can_bark(Animal) -> Animal =:= dog. From b1a21f4391157074e788e5ead0b90ba54d468324 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 23:15:00 +0100 Subject: [PATCH 35/85] Refactor removal of bounded funs --- src/cuter_types.erl | 135 +++++++----------- test/utest/src/cuter_types_tests.erl | 10 +- .../src/examples_for_type_analysis_pair.erl | 32 ++++- 3 files changed, 93 insertions(+), 84 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index a62ab160..a8820d2f 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1306,7 +1306,7 @@ update_recdict_for_module_types(Kmodule, Exported, RecDict) -> spec_form_as_erl_types({{F, A}, Spec}, Kmodule, Exported, RecDict) -> %% Replace records with temp record types in the signature - Normalized = spec_replace_records(spec_replace_bounded(Spec)), + Normalized = spec_replace_records(transform_bounded_funs_in_spec(Spec)), %% Convert each element of the list into an erl_type Mfa = {cuter_cerl:kmodule_name(Kmodule), F, A}, Converted = convert_list_to_erl(Normalized, Mfa, Exported, RecDict), @@ -1414,89 +1414,64 @@ generate_type_form_for_record_form({Line, {Name, Fields}}) -> type_name_for_record(RecordName) -> list_to_atom(?CUTER_RECORD_TYPE_PREFIX ++ atom_to_list(RecordName)). -%% Replaces all the specs that are expressed as bounded functions, to their equivalent -%% unbounded ones. -spec_replace_bounded(Spec) -> [handle_bounded_fun(S) || S <- Spec]. - -%% If a the signature is not bounded, return it intact -handle_bounded_fun({type, _L, 'fun', _Rest} = S) -> S; -%% If it is bounded, replace all variables with type forms -handle_bounded_fun({type, _, 'bounded_fun', [Spec, Constraints]} = S) -> - Fn = fun({type, _, constraint, [{atom, _, is_subtype}, [Key, Value]]}, D) -> - dict:store(element(3, Key), Value, D) - end, - %% Find the forms of the variables used in the constraints - D = lists:foldl(Fn, dict:new(), Constraints), - {D1, Rec} = fix_update_vars(D), - case Rec of %% If the conversion succeeds - %% Return an equivalent Spec without constraints - true -> - make_normal_spec(Spec, D1); - %% Else return S as is - false -> - S +%% Transforms the spec and replaces all the clauses that are expressed as bounded +%% functions, to their equivalent unbounded ones. +transform_bounded_funs_in_spec(Spec) -> + [transform_bounded_fun(C) || C <- Spec]. + +transform_bounded_fun({type, _L, 'fun', _Sig} = FC) -> FC; +transform_bounded_fun({type, _L, 'bounded_fun', [Func, Constraints]} = FC) -> + Ms = dict:from_list([extract_var_type_from_constraint(C) || C <- Constraints]), + case simplify_var_mappings(Ms) of + error -> FC; + {ok, NMs} -> generate_nonbounded_fun(Func, NMs) end. -%% Replace variables in a bounded fun with their produced type forms -replace_vars({type, L, record, R}, _D) -> {{type, L, record, R}, false}; -replace_vars({T, L, Type, Args}, D) when is_list(Args) -> - Fn = fun(Arg) -> replace_vars(Arg, D) end, - {NewArgs, Changes} = lists:unzip(lists:map(Fn, Args)), - Change = lists:foldl(fun erlang:'or'/2, false, Changes), - {{T, L, Type, NewArgs}, Change}; -replace_vars({var, _L, Name}, D) -> - case dict:find(Name, D) of - {ok, T} -> - {T, true}; - error -> - {any, true} - end; -replace_vars({ann_type, _L, [_T, T1]}, D) -> - {T2, _C} = replace_vars(T1, D), - {T2, true}; -replace_vars(Rest, _D) -> {Rest, false}. - -%% Find the types of constraint variables for non recursive declarations. -%% Return a dictionary with the variables as keys and their type forms as values -fix_update_vars(D) -> - %% If no recursive variables exist, the computation will end in steps at most equal to the - %% count of the variables - fix_update_vars(D, dict:size(D) + 1, 0). - -fix_update_vars(D, Lim, Depth) -> - Keys = dict:fetch_keys(D), - Fn = fun(Key, {Acc1, Acc2}) -> +extract_var_type_from_constraint({type, _, constraint, [{atom, _, is_subtype}, [{var, _, V}, T]]}) -> + {V, T}. + +%% Simplifies the types of constraint variables. +%% The input is a dictionary of variables mapped to their types. +%% Note that it supports only non-recursive declarations. +simplify_var_mappings(Ms) -> + %% If there are no recursive variables, the computation will end in + %% steps at most equal to the number of variables. + simplify_var_mappings_pass(Ms, dict:size(Ms), 0). + +simplify_var_mappings_pass(_Ms, Lim, N) when N > Lim -> error; +simplify_var_mappings_pass(Ms, Lim, N) -> + Vars = dict:fetch_keys(Ms), + Fn = fun(Key, D) -> T = dict:fetch(Key, D), - {NewT, C} = replace_vars(T, D), - case C of - true -> - {dict:store(Key, NewT, Acc1), true}; - false -> - {Acc1, Acc2} + case substitute_vars_in_type(T, Ms) of + T -> D; + NewT -> dict:store(Key, NewT, D) end - end, - %% Replace variables in all type forms - {NewD, Change} = lists:foldl(Fn, {D, false}, Keys), - %% If something changed - case Change of - true -> - %% If we have reached the limit - case Depth > Lim of - %% The transformation failed - true -> - {rec, false}; - %% Else call self - false -> - fix_update_vars(NewD, Lim, Depth + 1) - end; - %% Else return the dictionary of the variables - false -> - {NewD, true} + end, + NMs = lists:foldl(Fn, Ms, Vars), + case are_dicts_equal_on_keys(Vars, Ms, NMs) of + true -> {ok, NMs}; + false -> simplify_var_mappings_pass(NMs, Lim, N + 1) end. -%% Create a non bounded fun from a bounded fun given the type forms of the variables -%% in the bounded fun -make_normal_spec({type, L, 'fun', [Args, Range]}, D) -> - {NewArgs, _C1} = replace_vars(Args, D), - {NewRange, _C2} = replace_vars(Range, D), +%% Replace variables in a bounded fun with their produced type forms +substitute_vars_in_type({type, _, record, _R} = T, _Ms) -> T; +substitute_vars_in_type({_, _, _, Args}=T, Ms) when is_list(Args) -> + NewArgs = [substitute_vars_in_type(A, Ms) || A <- Args], + setelement(4, T, NewArgs); +substitute_vars_in_type({var, _, Var}, Ms) -> + dict:fetch(Var, Ms); +substitute_vars_in_type({ann_type, _, [_Var, T]}, Ms) -> + substitute_vars_in_type(T, Ms); +substitute_vars_in_type(T, _Ms) -> T. + +are_dicts_equal_on_keys([], _D1, _D2) -> true; +are_dicts_equal_on_keys([K|Ks], D1, D2) -> + dict:fetch(K, D1) =:= dict:fetch(K, D2) andalso are_dicts_equal_on_keys(Ks, D1, D2). + +%% Generates a non bounded fun from a bounded fun given the type substitutions for +%% constraints on the variables. +generate_nonbounded_fun({type, L, 'fun', [Args, Range]}, Ms) -> + NewArgs = substitute_vars_in_type(Args, Ms), + NewRange = substitute_vars_in_type(Range, Ms), {type, L, 'fun', [NewArgs, NewRange]}. diff --git a/test/utest/src/cuter_types_tests.erl b/test/utest/src/cuter_types_tests.erl index 683c5033..84ce96a8 100644 --- a/test/utest/src/cuter_types_tests.erl +++ b/test/utest/src/cuter_types_tests.erl @@ -148,8 +148,16 @@ mfas_and_specs() -> { {examples_for_type_analysis_pair, can_bark, 1}, [erl_types:t_fun( - [erl_types:t_sup(erl_types:t_atom(dog), erl_types:t_atom(cat))], + [erl_types:t_list(erl_types:t_sup(erl_types:t_atom(dog), erl_types:t_atom(cat)))], erl_types:t_boolean())] + }, + { + {examples_for_type_analysis_pair, count_trees, 1}, + [] %% We do not support mutually recursive declarations in bounded funs. + }, + { + {examples_for_type_analysis_pair, tree_height, 1}, + [] %% We do not support recursive declarations in bounded funs. } ]. diff --git a/test/utest/src/examples_for_type_analysis_pair.erl b/test/utest/src/examples_for_type_analysis_pair.erl index 36a6f42b..97a4209a 100644 --- a/test/utest/src/examples_for_type_analysis_pair.erl +++ b/test/utest/src/examples_for_type_analysis_pair.erl @@ -1,6 +1,6 @@ -module(examples_for_type_analysis_pair). --export([to_int/1, can_bark/1]). +-export([to_int/1, can_bark/1, count_trees/1, tree_height/1]). -export_type([t_dog_or_cat/0]). @@ -10,5 +10,31 @@ to_int(X) when is_integer(X) -> X; to_int(X) when is_atom(X) -> lists:max(atom_to_list(X)). --spec can_bark(Animal) -> boolean() when Animal :: t_dog_or_cat(). -can_bark(Animal) -> Animal =:= dog. +-spec can_bark(Animals) -> boolean() when + Animals :: [Animal], + Animal :: t_dog_or_cat(). +can_bark(Animals) -> lists:any(fun (A) -> A =:= dog end, Animals). + +-spec count_trees(Forest) -> integer() when + Forest :: {Tree, Forest} | nil, + Tree :: {atom(), Forest} | empty. +count_trees(F) -> + count_trees([F], 0). + +count_trees([], N) -> N; +count_trees([nil|Forests], N) -> + count_trees(Forests, N); +count_trees([{empty, Forest}|Forests], N) -> + count_trees([Forest|Forests], N + 1); +count_trees([{{_Name, InnerForest}, Forest}|Forests], N) -> + count_trees([InnerForest, Forest|Forests], N + 1). + +-spec tree_height(Tree) -> integer() when + Tree :: Node | Leaf, + Node :: {Tree, Tree}, + Leaf :: nil. +tree_height(nil) -> 0; +tree_height({Left, Right}) -> + H1 = tree_height(Left), + H2 = tree_height(Right), + 1 + max(H1, H2). From c8cfc8e1c3852972252a380de5a4f578ddbea198 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 23:23:50 +0100 Subject: [PATCH 36/85] Refactor record substitution in specs. --- src/cuter_types.erl | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index a8820d2f..10c3eb39 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1306,7 +1306,7 @@ update_recdict_for_module_types(Kmodule, Exported, RecDict) -> spec_form_as_erl_types({{F, A}, Spec}, Kmodule, Exported, RecDict) -> %% Replace records with temp record types in the signature - Normalized = spec_replace_records(transform_bounded_funs_in_spec(Spec)), + Normalized = replace_records_in_spec(transform_bounded_funs_in_spec(Spec)), %% Convert each element of the list into an erl_type Mfa = {cuter_cerl:kmodule_name(Kmodule), F, A}, Converted = convert_list_to_erl(Normalized, Mfa, Exported, RecDict), @@ -1382,12 +1382,15 @@ extract_type_definitions(Kmodule) -> replace_record_references_in_type_form({Line, {Name, Type, Args}}) -> {Line, {Name, replace_record_references(Type), Args}}. -%% Replace all record references with their respective temporary type in a spec form list -spec_replace_records(FunSpecs) -> - Fn = fun({type, Line, F, L}) -> - {type, Line, F, lists:map(fun replace_record_references/1, L)} - end, - lists:map(Fn, FunSpecs). +%% Replaces all the record within specs, with the respective generated types. +replace_records_in_spec(Spec) -> + replace_records_in_spec(Spec, []). + +replace_records_in_spec([], Clauses) -> + lists:reverse(Clauses); +replace_records_in_spec([{type, _, _, Ts}=Cl|Cls], Clauses) -> + NTs = [replace_record_references(T) || T <- Ts], + replace_records_in_spec(Cls, [setelement(4, Cl, NTs)|Clauses]). %% Replace all record references with their respective temporary type in a form %% Replaces all the references to records inside a type form. From 057eb9c82f5d0e1fac8b56d132e672096b572fff Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 23:31:03 +0100 Subject: [PATCH 37/85] Update comments --- src/cuter_types.erl | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 10c3eb39..af0fb59e 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1217,20 +1217,15 @@ get_type_from_type_dep({_Name, Type}) -> Type. %% ---------------------------------------------------------------------------- -%% API for erl_types:erl_type(). -%% Here a fix point computation is defined which converts all specs in a list -%% of modules to their erl_type representation +%% Compute the erl_types:erl_type() representation of type specifications. %% ---------------------------------------------------------------------------- -define(CUTER_RECORD_TYPE_PREFIX, "__cuter_record_type__"). -var_name({var, _, X}) -> - X. - -%% Find the erl type representation of all signatures in a list of kmodules --spec specs_as_erl_types([cuter_cerl:kmodule()]) -> dict:dict(). +%% Returns the specs of the given kmodules in their erl_types representation. +-spec specs_as_erl_types([cuter_cerl:kmodule()]) -> dict:dict(mfa(), [erl_types:erl_type()]). specs_as_erl_types(Kmodules) -> - %% Initialise an openset with all the types that have not yet been converted from a form + %% Initialize an openset with all the types that have not yet been converted from a form %% to its erl_types representation. Openset = initial_openset_of_types(Kmodules), Exported = sets:union([cuter_cerl:kmodule_exported_types(KM) || KM <- Kmodules]), @@ -1319,7 +1314,7 @@ update_recdict_from_type_forms(M, RecDict, Exported, TypeForms) -> Fn = fun ({L, {TName, T, TVars}}, Acc) -> A = length(TVars), Mta = {M, TName, A}, - Vs = [var_name(Var) || Var <- TVars], + Vs = [V || {var, _, V} <- TVars], case try_convert_type_to_erl_types(Mta, T, Exported, RecDict) of error -> sets:add_element(Mta, Acc); {ok, T1} -> From 60d8d8846908ca051c35044ddb62d0e1d77dd07a Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 23:39:30 +0100 Subject: [PATCH 38/85] Refactor function clause conversion to erl_types --- src/cuter_types.erl | 47 ++++++++++++++++++++------------------------- 1 file changed, 21 insertions(+), 26 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index af0fb59e..a684189d 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1272,7 +1272,7 @@ specs_as_erl_types_fix_pass([KM|Rest]=KMs, Exported, RecDict, Openset, GatheredS true -> specs_as_erl_types_fix_pass(Rest, Exported, RecDict, Openset, GatheredSpecs1); %% If the openset of the module has changed, we want to re-run the computation. - %% This can happend when a type depends on a type that is defined later in the code, + %% This can happen when a type depends on a type that is defined later in the code, %% or for mutually recursive types. false -> OtherModsOpenset = sets:subtract(Openset, ModOpenset), @@ -1300,11 +1300,9 @@ update_recdict_for_module_types(Kmodule, Exported, RecDict) -> update_recdict_from_type_forms(M, RecDict, Exported, TypeForms). spec_form_as_erl_types({{F, A}, Spec}, Kmodule, Exported, RecDict) -> - %% Replace records with temp record types in the signature - Normalized = replace_records_in_spec(transform_bounded_funs_in_spec(Spec)), - %% Convert each element of the list into an erl_type + NormalizedSpec = replace_records_in_spec(transform_bounded_funs_in_spec(Spec)), Mfa = {cuter_cerl:kmodule_name(Kmodule), F, A}, - Converted = convert_list_to_erl(Normalized, Mfa, Exported, RecDict), + Converted = normalized_spec_form_as_erl_types(NormalizedSpec, Mfa, Exported, RecDict), {Mfa, Converted}. %% Converts as many types in M as possible to their erl_types representation. @@ -1339,23 +1337,20 @@ try_convert_type_to_erl_types(Mta, T, Exported, RecDict) -> _:_ -> error end. -%% Convert a list of forms to a list of erl_types -convert_list_to_erl(S, MFA, TypeForms, RecDict) -> - convert_list_to_erl(S, MFA, TypeForms, RecDict, []). - -convert_list_to_erl([], _MFA, _TypeForms, _RecDict, Acc) -> lists:reverse(Acc); -convert_list_to_erl([Spec|Specs], MFA, TypeForms, RecDict, Acc) -> - ErlSpec = - try erl_types:t_from_form(Spec, TypeForms, {'spec', MFA}, RecDict, erl_types:var_table__new(), erl_types:cache__new()) of - {S, _C} -> S - catch - _:_ -> nospec - end, - case ErlSpec of - nospec -> - convert_list_to_erl(Specs, MFA, TypeForms, RecDict, Acc); - _ -> - convert_list_to_erl(Specs, MFA, TypeForms, RecDict, [ErlSpec|Acc]) +%% Converts a spec without bounded funs and record to its erl_types representation. +normalized_spec_form_as_erl_types(Spec, Mfa, TypeForms, RecDict) -> + normalized_spec_form_as_erl_types(Spec, Mfa, TypeForms, RecDict, []). + +normalized_spec_form_as_erl_types([], _Mfa, _TypeForms, _RecDict, Acc) -> lists:reverse(Acc); +normalized_spec_form_as_erl_types([FC|FCs], Mfa, TypeForms, RecDict, Acc) -> + VT = erl_types:var_table__new(), + Cache = erl_types:cache__new(), + try erl_types:t_from_form(FC, TypeForms, {'spec', Mfa}, RecDict, VT, Cache) of + {S, _C} -> + normalized_spec_form_as_erl_types(FCs, Mfa, TypeForms, RecDict, [S|Acc]) + catch + _:_ -> + normalized_spec_form_as_erl_types(FCs, Mfa, TypeForms, RecDict, Acc) end. are_sets_equal(A, B) -> @@ -1381,11 +1376,11 @@ replace_record_references_in_type_form({Line, {Name, Type, Args}}) -> replace_records_in_spec(Spec) -> replace_records_in_spec(Spec, []). -replace_records_in_spec([], Clauses) -> - lists:reverse(Clauses); -replace_records_in_spec([{type, _, _, Ts}=Cl|Cls], Clauses) -> +replace_records_in_spec([], FClauses) -> + lists:reverse(FClauses); +replace_records_in_spec([{type, _, _, Ts}=FC|FCs], FClauses) -> NTs = [replace_record_references(T) || T <- Ts], - replace_records_in_spec(Cls, [setelement(4, Cl, NTs)|Clauses]). + replace_records_in_spec(FCs, [setelement(4, FC, NTs)|FClauses]). %% Replace all record references with their respective temporary type in a form %% Replaces all the references to records inside a type form. From dc2a57aab37adb5a7e6778075ce53873aee6e194 Mon Sep 17 00:00:00 2001 From: Dspil Date: Mon, 14 Feb 2022 16:13:45 +0200 Subject: [PATCH 39/85] Filtered variable renamed to ExpTypes --- src/cuter_cerl.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cuter_cerl.erl b/src/cuter_cerl.erl index 7d50d664..55929ee7 100644 --- a/src/cuter_cerl.erl +++ b/src/cuter_cerl.erl @@ -320,8 +320,8 @@ extract_exports(M, AST) -> [mfa_from_var(M, E) || E <- Exports]. extract_exported_types(Mod, Attrs) -> - Filtered = lists:append([Ts || {#c_literal{val = export_type}, #c_literal{val = Ts}} <- Attrs]), - sets:from_list([{Mod, Tname, Tarity} || {Tname, Tarity} <- Filtered]). + ExpTypes = lists:append([Ts || {#c_literal{val = export_type}, #c_literal{val = Ts}} <- Attrs]), + sets:from_list([{Mod, Tname, Tarity} || {Tname, Tarity} <- ExpTypes]). -spec process_fundef({cerl:c_var(), code()}, [mfa()], module(), tag_generator()) -> {mfa(), kfun()}. process_fundef({FunVar, Def}, Exports, M, TagGen) -> From 6c3913144510a24d461dbb64e7e6ec245e6e5431 Mon Sep 17 00:00:00 2001 From: Dspil Date: Mon, 14 Feb 2022 16:16:36 +0200 Subject: [PATCH 40/85] better use of erl_types api in cuter_types_test --- test/utest/src/cuter_types_tests.erl | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/test/utest/src/cuter_types_tests.erl b/test/utest/src/cuter_types_tests.erl index 84ce96a8..611b2c41 100644 --- a/test/utest/src/cuter_types_tests.erl +++ b/test/utest/src/cuter_types_tests.erl @@ -117,10 +117,10 @@ mfas_and_specs() -> { {examples_for_type_analysis, translate, 3}, [erl_types:t_fun( - [erl_types:t_tuple([erl_types:t_from_term(point), erl_types:t_number(), erl_types:t_number()]), + [erl_types:t_tuple([erl_types:t_atom(point), erl_types:t_number(), erl_types:t_number()]), erl_types:t_number(), erl_types:t_number()], - erl_types:t_tuple([erl_types:t_from_term(point), erl_types:t_number(), erl_types:t_number()]))] + erl_types:t_tuple([erl_types:t_atom(point), erl_types:t_number(), erl_types:t_number()]))] }, { {examples_for_type_analysis, root, 1}, @@ -130,13 +130,13 @@ mfas_and_specs() -> {examples_for_type_analysis, max_x, 1}, [erl_types:t_fun( [erl_types:t_list( - erl_types:t_tuple([erl_types:t_from_term(point), erl_types:t_number(), erl_types:t_number()]))], + erl_types:t_tuple([erl_types:t_atom(point), erl_types:t_number(), erl_types:t_number()]))], erl_types:t_number())] }, { {examples_for_type_analysis, is_dog, 1}, [erl_types:t_fun( - [erl_types:t_sup(erl_types:t_atom(dog), erl_types:t_atom(cat))], + [erl_types:t_atoms([dog, cat])], erl_types:t_boolean())] }, { @@ -148,7 +148,7 @@ mfas_and_specs() -> { {examples_for_type_analysis_pair, can_bark, 1}, [erl_types:t_fun( - [erl_types:t_list(erl_types:t_sup(erl_types:t_atom(dog), erl_types:t_atom(cat)))], + [erl_types:t_list(erl_types:t_atoms([dog, cat]))], erl_types:t_boolean())] }, { From 82a12c30c16c5619ccb0c80351f4216435da5f51 Mon Sep 17 00:00:00 2001 From: Dspil Date: Mon, 14 Feb 2022 16:34:25 +0200 Subject: [PATCH 41/85] Renamed examples_for_type_analysis* to examples_for_spec_conversion* --- Makefile.in | 4 +-- src/cuter_types.erl | 32 +++++++++---------- test/utest/src/cuter_types_tests.erl | 24 +++++++------- ...s.erl => examples_for_spec_conversion.erl} | 4 +-- ... => examples_for_spec_conversion_pair.erl} | 4 +-- 5 files changed, 34 insertions(+), 34 deletions(-) rename test/utest/src/{examples_for_type_analysis.erl => examples_for_spec_conversion.erl} (88%) rename test/utest/src/{examples_for_type_analysis_pair.erl => examples_for_spec_conversion_pair.erl} (90%) diff --git a/Makefile.in b/Makefile.in index 514f9d90..51defb3b 100644 --- a/Makefile.in +++ b/Makefile.in @@ -101,8 +101,8 @@ UTEST_MODULES = \ types_and_specs2 \ cuter_metrics_tests \ cuter_config_tests \ - examples_for_type_analysis \ - examples_for_type_analysis_pair + examples_for_spec_conversion \ + examples_for_spec_conversion_pair FTEST_MODULES = \ bitstr \ diff --git a/src/cuter_types.erl b/src/cuter_types.erl index a684189d..ce3f3f47 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1310,22 +1310,22 @@ spec_form_as_erl_types({{F, A}, Spec}, Kmodule, Exported, RecDict) -> %% We return the types that could not be converted, i.e. the openset. update_recdict_from_type_forms(M, RecDict, Exported, TypeForms) -> Fn = fun ({L, {TName, T, TVars}}, Acc) -> - A = length(TVars), - Mta = {M, TName, A}, - Vs = [V || {var, _, V} <- TVars], - case try_convert_type_to_erl_types(Mta, T, Exported, RecDict) of - error -> sets:add_element(Mta, Acc); - {ok, T1} -> - VT = - case ets:lookup(RecDict, M) of - [{M, OVT}] -> OVT; - [] -> maps:new() - end, - NVT = maps:put({'type', TName, A}, {{M, {atom_to_list(M) ++ ".erl", L}, T, Vs}, T1}, VT), - ets:insert(RecDict, {M, NVT}), - Acc - end - end, + A = length(TVars), + Mta = {M, TName, A}, + Vs = [V || {var, _, V} <- TVars], + case try_convert_type_to_erl_types(Mta, T, Exported, RecDict) of + error -> sets:add_element(Mta, Acc); + {ok, T1} -> + VT = + case ets:lookup(RecDict, M) of + [{M, OVT}] -> OVT; + [] -> maps:new() + end, + NVT = maps:put({'type', TName, A}, {{M, {atom_to_list(M) ++ ".erl", L}, T, Vs}, T1}, VT), + ets:insert(RecDict, {M, NVT}), + Acc + end + end, lists:foldl(Fn, sets:new(), TypeForms). try_convert_type_to_erl_types(Mta, T, Exported, RecDict) -> diff --git a/test/utest/src/cuter_types_tests.erl b/test/utest/src/cuter_types_tests.erl index 611b2c41..d11ed3cc 100644 --- a/test/utest/src/cuter_types_tests.erl +++ b/test/utest/src/cuter_types_tests.erl @@ -84,7 +84,7 @@ cleanup(_) -> ok. -spec convert_types_test() -> any(). convert_types_test() -> - Modules = [examples_for_type_analysis, examples_for_type_analysis_pair], + Modules = [examples_for_spec_conversion, examples_for_spec_conversion_pair], Fn = fun(M) -> {ok, AST} = cuter_cerl:get_core(M, false), AST @@ -103,19 +103,19 @@ convert_types_test() -> mfas_and_specs() -> [ { - {examples_for_type_analysis, id, 1}, + {examples_for_spec_conversion, id, 1}, [erl_types:t_fun([erl_types:t_any()], erl_types:t_any())] }, { - {examples_for_type_analysis, inc, 1}, + {examples_for_spec_conversion, inc, 1}, [erl_types:t_fun([erl_types:t_integer()], erl_types:t_integer())] }, { - {examples_for_type_analysis, to_atom, 1}, + {examples_for_spec_conversion, to_atom, 1}, [erl_types:t_fun([erl_types:t_sup(erl_types:t_integer(), erl_types:t_atom())], erl_types:t_atom())] }, { - {examples_for_type_analysis, translate, 3}, + {examples_for_spec_conversion, translate, 3}, [erl_types:t_fun( [erl_types:t_tuple([erl_types:t_atom(point), erl_types:t_number(), erl_types:t_number()]), erl_types:t_number(), @@ -123,40 +123,40 @@ mfas_and_specs() -> erl_types:t_tuple([erl_types:t_atom(point), erl_types:t_number(), erl_types:t_number()]))] }, { - {examples_for_type_analysis, root, 1}, + {examples_for_spec_conversion, root, 1}, [] %% We do not support recursive types. }, { - {examples_for_type_analysis, max_x, 1}, + {examples_for_spec_conversion, max_x, 1}, [erl_types:t_fun( [erl_types:t_list( erl_types:t_tuple([erl_types:t_atom(point), erl_types:t_number(), erl_types:t_number()]))], erl_types:t_number())] }, { - {examples_for_type_analysis, is_dog, 1}, + {examples_for_spec_conversion, is_dog, 1}, [erl_types:t_fun( [erl_types:t_atoms([dog, cat])], erl_types:t_boolean())] }, { - {examples_for_type_analysis_pair, to_int, 1}, + {examples_for_spec_conversion_pair, to_int, 1}, [erl_types:t_fun( [erl_types:t_sup(erl_types:t_integer(), erl_types:t_atom())], erl_types:t_integer())] }, { - {examples_for_type_analysis_pair, can_bark, 1}, + {examples_for_spec_conversion_pair, can_bark, 1}, [erl_types:t_fun( [erl_types:t_list(erl_types:t_atoms([dog, cat]))], erl_types:t_boolean())] }, { - {examples_for_type_analysis_pair, count_trees, 1}, + {examples_for_spec_conversion_pair, count_trees, 1}, [] %% We do not support mutually recursive declarations in bounded funs. }, { - {examples_for_type_analysis_pair, tree_height, 1}, + {examples_for_spec_conversion_pair, tree_height, 1}, [] %% We do not support recursive declarations in bounded funs. } ]. diff --git a/test/utest/src/examples_for_type_analysis.erl b/test/utest/src/examples_for_spec_conversion.erl similarity index 88% rename from test/utest/src/examples_for_type_analysis.erl rename to test/utest/src/examples_for_spec_conversion.erl index 0ae9cdf5..62c0b1ad 100644 --- a/test/utest/src/examples_for_type_analysis.erl +++ b/test/utest/src/examples_for_spec_conversion.erl @@ -1,4 +1,4 @@ --module(examples_for_type_analysis). +-module(examples_for_spec_conversion). -export([id/1, inc/1, to_atom/1, translate/3, root/1, max_x/1, is_dog/1]). @@ -35,5 +35,5 @@ root(nil) -> nil. -spec max_x(list_of(#point{})) -> number(). max_x(Ps) -> lists:max([P#point.x || P <- Ps]). --spec is_dog(examples_for_type_analysis_pair:t_dog_or_cat()) -> boolean(). +-spec is_dog(examples_for_spec_conversion_pair:t_dog_or_cat()) -> boolean(). is_dog(X) -> X =:= dog. diff --git a/test/utest/src/examples_for_type_analysis_pair.erl b/test/utest/src/examples_for_spec_conversion_pair.erl similarity index 90% rename from test/utest/src/examples_for_type_analysis_pair.erl rename to test/utest/src/examples_for_spec_conversion_pair.erl index 97a4209a..31c739dc 100644 --- a/test/utest/src/examples_for_type_analysis_pair.erl +++ b/test/utest/src/examples_for_spec_conversion_pair.erl @@ -1,4 +1,4 @@ --module(examples_for_type_analysis_pair). +-module(examples_for_spec_conversion_pair). -export([to_int/1, can_bark/1, count_trees/1, tree_height/1]). @@ -6,7 +6,7 @@ -type t_dog_or_cat() :: dog | cat. --spec to_int(examples_for_type_analysis:t_int_or_atom()) -> integer(). +-spec to_int(examples_for_spec_conversion:t_int_or_atom()) -> integer(). to_int(X) when is_integer(X) -> X; to_int(X) when is_atom(X) -> lists:max(atom_to_list(X)). From 53f7631ff4245ddf0aef7df8c3d12da086971009 Mon Sep 17 00:00:00 2001 From: Dspil Date: Thu, 10 Feb 2022 21:37:20 +0200 Subject: [PATCH 42/85] added function spec conversion to erl_types --- cuter | 3 + include/cuter_macros.hrl | 2 + src/cuter.erl | 28 ++-- src/cuter_codeserver.erl | 17 ++- src/cuter_types.erl | 292 +++++++++++++++++++++++++++++++++++++++ 5 files changed, 331 insertions(+), 11 deletions(-) diff --git a/cuter b/cuter index 9a72d699..d369aa64 100755 --- a/cuter +++ b/cuter @@ -38,6 +38,7 @@ def main(): parser.add_argument("-m", "--metrics", action='store_true', help="report collected metrics") parser.add_argument("--debug-keep-traces", action='store_true', help="keep execution traces for debugging") parser.add_argument("--debug-solver-fsm", action='store_true', help="output debug logs for the solver FSM") + parser.add_argument("-ps", "--prune-safe", action='store_true', help="prune safe paths and stop the execution early") # Parse the arguments args = parser.parse_args() @@ -109,6 +110,8 @@ def main(): opts.append("debug_keep_traces") if args.debug_solver_fsm: opts.append("debug_solver_fsm") + if args.prune_safe: + opts.append("prune_safe") strOpts = ",".join(opts) # Run CutEr diff --git a/include/cuter_macros.hrl b/include/cuter_macros.hrl index 8572c4cd..ae5b13cd 100644 --- a/include/cuter_macros.hrl +++ b/include/cuter_macros.hrl @@ -89,6 +89,8 @@ -define(NUM_SOLVERS, number_of_solvers). %% Sets the number of concurrent concolic execution processes. -define(NUM_POLLERS, number_of_pollers). +%% Prune safe paths. +-define(PRUNE_SAFE, prune_safe). -type runtime_options() :: {?Z3_TIMEOUT, pos_integer()} | ?REPORT_METRICS diff --git a/src/cuter.erl b/src/cuter.erl index 62bdc126..d54e0828 100644 --- a/src/cuter.erl +++ b/src/cuter.erl @@ -48,7 +48,7 @@ run(M, F, As, Depth, Options) -> Seeds = [{M, F, As, Depth}], run(Seeds, Options). --spec run([seed()], options()) -> erroneous_inputs(). +-spec run([seed(),...], options()) -> erroneous_inputs(). %% Runs CutEr on multiple units. run(Seeds, Options) -> State = state_from_options_and_seeds(Options, Seeds), @@ -87,7 +87,8 @@ run_from_file(File, Options) -> %% The tasks to run during the app initialization. init_tasks() -> [fun ensure_exported_entry_points/1, - fun compute_callgraph/1]. + fun compute_callgraph/1, + fun annotate_for_possible_errors/1]. -spec init(state()) -> ok | error. init(State) -> @@ -128,10 +129,17 @@ compute_callgraph(State) -> Mfas = mfas_from_state(State), cuter_codeserver:calculate_callgraph(State#st.codeServer, Mfas). - mfas_from_state(State) -> [{M, F, length(As)} || {M, F, As, _} <- State#st.seeds]. +annotate_for_possible_errors(State) -> + case cuter_config:fetch(?PRUNE_SAFE) of + {ok, true} -> + cuter_codeserver:annotate_for_possible_errors(State#st.codeServer); + _ -> + ok + end. + %% ---------------------------------------------------------------------------- %% Manage the concolic executions %% ---------------------------------------------------------------------------- @@ -143,8 +151,7 @@ start(State) -> -spec start([seed()], state()) -> state(). start([], State) -> State; -start([{M, F, As, Depth}|Seeds], State) -> - CodeServer = State#st.codeServer, +start([{M, F, As, Depth}|Seeds], State) -> CodeServer = State#st.codeServer, Scheduler = State#st.scheduler, Errors = start_one(M, F, As, Depth, CodeServer, Scheduler), NewErrors = [{{M, F, length(As)}, Errors}|State#st.errors], @@ -239,7 +246,7 @@ stop(State) -> %% Generate the system state %% ---------------------------------------------------------------------------- --spec state_from_options_and_seeds(options(), [seed()]) -> state(). +-spec state_from_options_and_seeds(options(), [seed(),...]) -> state(). state_from_options_and_seeds(Options, Seeds) -> process_flag(trap_exit, true), error_logger:tty(false), %% disable error_logger @@ -247,7 +254,7 @@ state_from_options_and_seeds(Options, Seeds) -> ok = cuter_metrics:start(), ok = define_metrics(), enable_debug_config(Options), - enable_runtime_config(Options), + enable_runtime_config(Options, Seeds), ok = cuter_pp:start(), CodeServer = cuter_codeserver:start(), SchedPid = cuter_scheduler:start(?DEFAULT_DEPTH, CodeServer), @@ -265,8 +272,8 @@ enable_debug_config(Options) -> cuter_config:store(?DEBUG_SMT, proplists:get_bool(?DEBUG_SMT, Options)), cuter_config:store(?DEBUG_SOLVER_FSM, proplists:get_bool(?DEBUG_SOLVER_FSM, Options)). --spec enable_runtime_config(options()) -> ok. -enable_runtime_config(Options) -> +-spec enable_runtime_config(options(), [seed(),...]) -> ok. +enable_runtime_config(Options, [{_M, _F, _I, _D}|_]) -> {ok, CWD} = file:get_cwd(), cuter_config:store(?WORKING_DIR, cuter_lib:get_tmp_dir(proplists:get_value(?WORKING_DIR, Options, CWD))), @@ -284,7 +291,8 @@ enable_runtime_config(Options) -> cuter_config:store(?SORTED_ERRORS, proplists:get_bool(?SORTED_ERRORS, Options)), cuter_config:store(?WHITELISTED_MFAS, whitelisted_mfas(Options)), cuter_config:store(?NUM_SOLVERS, proplists:get_value(?NUM_SOLVERS, Options, ?ONE)), - cuter_config:store(?NUM_POLLERS, proplists:get_value(?NUM_POLLERS, Options, ?ONE)). + cuter_config:store(?NUM_POLLERS, proplists:get_value(?NUM_POLLERS, Options, ?ONE)), + cuter_config:store(?PRUNE_SAFE, proplists:get_bool(?PRUNE_SAFE, Options)). verbosity_level(Options) -> Default = cuter_pp:default_reporting_level(), diff --git a/src/cuter_codeserver.erl b/src/cuter_codeserver.erl index d4962a51..00808723 100644 --- a/src/cuter_codeserver.erl +++ b/src/cuter_codeserver.erl @@ -10,6 +10,8 @@ visit_tag/2, calculate_callgraph/2, %% Work with module cache merge_dumped_cached_modules/2, modules_of_dumped_cache/1, + %% Code annotations + annotate_for_possible_errors/1, %% Access logs cachedMods_of_logs/1, visitedTags_of_logs/1, tagsAddedNo_of_logs/1, unsupportedMfas_of_logs/1, loadedMods_of_logs/1]). @@ -142,6 +144,11 @@ calculate_callgraph(CodeServer, Mfas) -> get_feasible_tags(CodeServer, NodeTypes) -> gen_server:call(CodeServer, {get_feasible_tags, NodeTypes}). +%% Annotates the code for possible errors. +-spec annotate_for_possible_errors(codeserver()) -> ok. +annotate_for_possible_errors(CodeServer) -> + gen_server:call(CodeServer, annotate_for_possible_errors). + %% ---------------------------------------------------------------------------- %% gen_server callbacks (Server Implementation) %% ---------------------------------------------------------------------------- @@ -182,6 +189,7 @@ handle_info(_Msg, State) -> ; (get_whitelist, from(), state()) -> {reply, cuter_mock:whitelist(), state()} ; ({get_feasible_tags, cuter_cerl:node_types()}, from(), state()) -> {reply, cuter_cerl:visited_tags(), state()} ; ({calculate_callgraph, [mfa()]}, from(), state()) -> {reply, ok, state()} + ; (annotate_for_possible_errors, from(), state()) -> {reply, ok, state()} . handle_call({load, M}, _From, State) -> {reply, try_load(M, State), State}; @@ -231,7 +239,14 @@ handle_call({calculate_callgraph, Mfas}, _From, State=#st{whitelist = Whitelist} end, cuter_callgraph:foreachModule(LoadFn, Callgraph), {reply, ok, State#st{callgraph = Callgraph}} - end. + end; +handle_call(annotate_for_possible_errors, _From, State=#st{db = Db}) -> + Fn2 = fun({_M, Kmodule}, Acc) -> + [Kmodule|Acc] + end, + Kmodules = ets:foldl(Fn2, [], Db), + _MfasToSpecs = cuter_types:parse_specs(Kmodules), + {reply, ok, State}. %% gen_server callback : handle_cast/2 -spec handle_cast(stop, state()) -> {stop, normal, state()} | {noreply, state()} diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 6eb96199..032204f1 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -23,6 +23,8 @@ -export([erl_type_deps_map/2, get_type_name_from_type_dep/1, get_type_from_type_dep/1, unique_type_name/3]). +-export([parse_specs/1]). + -export_type([erl_type/0, erl_spec_clause/0, erl_spec/0, stored_specs/0, stored_types/0, stored_spec_value/0, t_range_limit/0]). -export_type([erl_type_dep/0, erl_type_deps/0]). @@ -1213,3 +1215,293 @@ get_type_name_from_type_dep({Name, _Type}) -> -spec get_type_from_type_dep(erl_type_dep()) -> erl_type(). get_type_from_type_dep({_Name, Type}) -> Type. + +%% ---------------------------------------------------------------------------- +%% API for erl_types:erl_type(). +%% Here a fix point computation is defined which converts all specs in a list +%% of modules to their erl_type representation +%% ---------------------------------------------------------------------------- + +-define(CUTER_RECORD_TYPE_PREFIX, "__cuter_record_type__"). + +var_name({var, _, X}) -> + X. + +%% Find the erl type representation of all signatures in a list of kmodules +-spec parse_specs([cuter_cerl:kmodule()]) -> dict:dict(). +parse_specs(Kmodules) -> + RecDict = ets:new(recdict, []), %% Needed for erl_types:t_from_form/6 + ExpTypes = sets:union([cuter_cerl:kmodule_exported_types(M) || M <- Kmodules]), %% Needed for erl_types:t_from_form/6 + Fn = fun (Kmodule, Acc) -> + Mod = cuter_cerl:kmodule_name(Kmodule), + TypesLines = all_types_from_cerl(Kmodule), + U = sets:from_list([{TName, length(Vars)} || {{TName, _T, Vars}, _L} <- TypesLines]), + dict:store(Mod, U, Acc) + end, + %% Unhandled holds all non converted types from a form to an erl_type for each module. + %% It is a dict with the module name as the key and all the types defined in it initially. + Unhandled = lists:foldl(Fn, dict:new(), Kmodules), + %% Find all signatures + Ret = parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, dict:new()), + ets:delete(RecDict), + Ret. + +%% Convert all signatures in all modules until none can be converted +parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, GatheredSpecs) -> + %% Pass all modules + {Unhandled1, Change, GatheredSpecs1} = parse_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, false, GatheredSpecs), + case Change of %% If Unhandled has changed in this pass + %% Pass again + true -> + parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled1, GatheredSpecs1); + %% Else return the gathered signatures + false -> + GatheredSpecs1 + end. + +%% Pass through all modules and gather signatures +parse_specs_fix_pass([], _ExpTypes, _RecDict, Unhandled, Change, GatheredSpecs) -> {Unhandled, Change, GatheredSpecs}; +parse_specs_fix_pass([Kmodule|Kmodules], ExpTypes, RecDict, Unhandled, Change, GatheredSpecs) -> + Mod = cuter_cerl:kmodule_name(Kmodule), + PrevUnhandled = dict:fetch(Mod, Unhandled), + %% Get the signatures converted and the unhandled types of this module + {Specs, NewUnhandled} = parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled), + Fn = fun ({MFA, Spec}, G) -> + dict:store(MFA, Spec, G) + end, + %% Store the new signatures found in GatheredSpecs + GatheredSpecs1 = lists:foldl(Fn, GatheredSpecs, Specs), + %% If the unhandled types for this module have not changed + case equal_sets(NewUnhandled, PrevUnhandled) of + %% Maintain the Change so far in the recursive call + true -> parse_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, Change, GatheredSpecs1); + %% A change has occured, make the recursive call with Change: true and an updated Unhandled dict + false -> parse_specs_fix_pass(Kmodules, ExpTypes, RecDict, dict:store(Mod, NewUnhandled, Unhandled), true, GatheredSpecs1) + end. + +%% Gather all signatures defined in a module. +%% Return all signatures that can be converted to erl_types +%% and all the types that couldn't +parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled) -> + %% Fetch type forms from the kmodule along with the lines where they were defined. + %% The lines are needed for the erl_types:t_from_form/6 call + TypesLines = all_types_from_cerl(Kmodule), + Mod = cuter_cerl:kmodule_name(Kmodule), + %% Only Unhandled is returned because types will be stored in RecDict ets table + Unhandled = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled), + Fn = fun ({{F, A}, S1}) -> %% For a function F with arity A and signature S1 which is a list + %% Replace records with temp record types in the signature + S = spec_replace_records(spec_replace_bounded(S1)), + %% Convert each element of the list into an erl_type + ErlSpecs = convert_list_to_erl(S, {Mod, F, A}, ExpTypes, RecDict), + {{Mod, F, A}, ErlSpecs} + end, + Specs = lists:map(Fn, cuter_cerl:kmodule_spec_forms(Kmodule)), + {Specs, Unhandled}. + +%% Convert as many types in Mod as possible to erl_types. +%% For every succesful conversion add it to RecDict and finally +%% return the types that couldn't be converted. +%% If there are more succesful conversions as before try again. +%% This is done to handle types depending on later defined types +%% or mutually recursive types immediately +fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled) -> + F = fun ({{Tname, T, Vars}, L}, Acc) -> %% Get a type and a set of unhandled types + A = length(Vars), + %% Try to convert the type to erl_type using erl_types:t_from_form/6 + {{T1, _C}, D1} = + try erl_types:t_from_form(T, ExpTypes, {'type', {Mod, Tname, A}}, RecDict, erl_types:var_table__new(), erl_types:cache__new()) of + Ret -> {Ret, false} + catch + _:_ -> + {{none, none}, true} + end, + %% Check if the conversion was successful + case D1 of + %% If it was, add the new erl_type in RecDict + false -> + case ets:lookup(RecDict, Mod) of + [{Mod, VT}] -> + ets:insert(RecDict, {Mod, maps:put({'type', Tname, A}, {{Mod, {lists:append(atom_to_list(Mod), ".erl"), L}, T, [var_name(Var) || Var <- Vars]}, T1}, VT)}), + Acc; + _ -> + ets:insert(RecDict, {Mod, maps:put({'type', Tname, A}, {{Mod, {lists:append(atom_to_list(Mod), ".erl"), L}, T, [var_name(Var) || Var <- Vars]}, T1}, maps:new())}), + Acc + end; + %% Else, add the type to the Unhandled set + true -> + sets:add_element({Tname, A}, Acc) + end + end, + %% Apply F to all Types in the module + Unhandled = lists:foldl(F, sets:new(), TypesLines), + %% Check if the unhandled types are different than before + case equal_sets(PrevUnhandled, Unhandled) of + %% If they are, run the module again + false -> + fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, Unhandled); + %% Else return the unhandled types + true -> + Unhandled + end. + +%% Convert a list of forms to a list of erl_types +convert_list_to_erl(S, MFA, ExpTypes, RecDict) -> + convert_list_to_erl(S, MFA, ExpTypes, RecDict, []). + +convert_list_to_erl([], _MFA, _ExpTypes, _RecDict, Acc) -> lists:reverse(Acc); +convert_list_to_erl([Spec|Specs], MFA, ExpTypes, RecDict, Acc) -> + ErlSpec = + try erl_types:t_from_form(Spec, ExpTypes, {'spec', MFA}, RecDict, erl_types:var_table__new(), erl_types:cache__new()) of + {S, _C} -> S + catch + _:_ -> nospec + end, + case ErlSpec of + nospec -> + convert_list_to_erl(Specs, MFA, ExpTypes, RecDict, Acc); + _ -> + convert_list_to_erl(Specs, MFA, ExpTypes, RecDict, [ErlSpec|Acc]) + end. + +equal_sets(A, B) -> + sets:size(A) == sets:size(B) andalso sets:size(sets:union(A, B)) == sets:size(B). + +%% Return all types defined in a kmodule +all_types_from_cerl(Kmodule) -> + %% Types and Opaque types + TypesOpaques = [{type_replace_records(Type), Line} || {Line, Type} <- cuter_cerl:kmodule_type_forms(Kmodule)], + %% Make the temp types representing records + Records = records_as_types(Kmodule), + lists:append(TypesOpaques, Records). + +%% Replace all record references with their respective temporary type in a type form +type_replace_records({Name, Type, Args}) -> + {Name, replace_records(Type), Args}. + +%% Replace all record references with their respective temporary type in a spec form list +spec_replace_records(FunSpecs) -> + Fn = fun({type, Line, F, L}) -> + {type, Line, F, lists:map(fun replace_records/1, L)} + end, + lists:map(Fn, FunSpecs). + +%% Replace all record references with their respective temporary type in a form +replace_records({type, L, record, [{atom, _, Name}]}) -> + {user_type, L, record_name(Name), []}; +replace_records({T, L, Type, Args}) when T =:= type orelse T =:= user_type -> + case is_list(Args) of + true -> + {T, L, Type, lists:map(fun replace_records/1, Args)}; + false -> + {T, L, Type, Args} + end; +replace_records(Rest) -> Rest. + +%% Return temporary types representing the records in a kmodule +%% For each record rec with fields es make a temporary tuple type with +%% first item rec and es as the rest items +records_as_types(Kmodule) -> + R = [{RecName, Line, RecFields} || {Line, {RecName, RecFields}} <- cuter_cerl:kmodule_record_forms(Kmodule)], + lists:map(fun type_from_record/1, R). + +%% Create the temporary type from a record form +type_from_record({Name, Line, Fields}) -> + Fn = fun ({typed_record_field, _, T}) -> + replace_records(T) + end, + %% Replace record references in fields + NewFields = lists:map(Fn, Fields), + NewName = record_name(Name), + RecType = {type, Line, tuple, [{atom, Line, Name} | NewFields]}, + {{NewName, RecType, []}, Line}. + +%% Return the name of a temporary type corresponding to a record with name Name +record_name(Name) -> + list_to_atom(?CUTER_RECORD_TYPE_PREFIX ++ atom_to_list(Name)). + +%% Replace all bounded signatures with equivalent normal ones +spec_replace_bounded(Specs) -> lists:map(fun handle_bounded_fun/1, Specs). + +%% If a the signature is not bounded, return it intact +handle_bounded_fun({type, _L, 'fun', _Rest} = S) -> S; +%% If it is bounded, replace all variables with type forms +handle_bounded_fun({type, _, 'bounded_fun', [Spec, Constraints]} = S) -> + Fn = fun({type, _, constraint, [{atom, _, is_subtype}, [Key, Value]]}, D) -> + dict:store(element(3, Key), Value, D) + end, + %% Find the forms of the variables used in the constraints + D = lists:foldl(Fn, dict:new(), Constraints), + {D1, Rec} = fix_update_vars(D), + case Rec of %% If the conversion succeeds + %% Return an equivalent Spec without constraints + true -> + make_normal_spec(Spec, D1); + %% Else return S as is + false -> + S + end. + +%% Replace variables in a bounded fun with their produced type forms +replace_vars({type, L, record, R}, _D) -> {{type, L, record, R}, false}; +replace_vars({T, L, Type, Args}, D) when is_list(Args) -> + Fn = fun(Arg) -> replace_vars(Arg, D) end, + {NewArgs, Changes} = lists:unzip(lists:map(Fn, Args)), + Change = lists:foldl(fun erlang:'or'/2, false, Changes), + {{T, L, Type, NewArgs}, Change}; +replace_vars({var, _L, Name}, D) -> + case dict:find(Name, D) of + {ok, T} -> + {T, true}; + error -> + {any, true} + end; +replace_vars({ann_type, _L, [_T, T1]}, D) -> + {T2, _C} = replace_vars(T1, D), + {T2, true}; +replace_vars(Rest, _D) -> {Rest, false}. + +%% Find the types of constraint variables for non recursive declarations. +%% Return a dictionary with the variables as keys and their type forms as values +fix_update_vars(D) -> + %% If no recursive variables exist, the computation will end in steps at most equal to the + %% count of the variables + fix_update_vars(D, dict:size(D) + 1, 0). + +fix_update_vars(D, Lim, Depth) -> + Keys = dict:fetch_keys(D), + Fn = fun(Key, {Acc1, Acc2}) -> + T = dict:fetch(Key, D), + {NewT, C} = replace_vars(T, D), + case C of + true -> + {dict:store(Key, NewT, Acc1), true}; + false -> + {Acc1, Acc2} + end + end, + %% Replace variables in all type forms + {NewD, Change} = lists:foldl(Fn, {D, false}, Keys), + %% If something changed + case Change of + true -> + %% If we have reached the limit + case Depth > Lim of + %% The transformation failed + true -> + {rec, false}; + %% Else call self + false -> + fix_update_vars(NewD, Lim, Depth + 1) + end; + %% Else return the dictionary of the variables + false -> + {NewD, true} + end. + +%% Create a non bounded fun from a bounded fun given the type forms of the variables +%% in the bounded fun +make_normal_spec({type, L, 'fun', [Args, Range]}, D) -> + {NewArgs, _C1} = replace_vars(Args, D), + {NewRange, _C2} = replace_vars(Range, D), + {type, L, 'fun', [NewArgs, NewRange]}. From 188a30b123cdbd45fd6a599bf2c177ce52fcfb40 Mon Sep 17 00:00:00 2001 From: Dspil Date: Fri, 11 Feb 2022 14:41:11 +0200 Subject: [PATCH 43/85] Remove unnecessary changes --- cuter | 3 --- include/cuter_macros.hrl | 2 -- src/cuter.erl | 28 ++++++++++------------------ src/cuter_codeserver.erl | 17 +---------------- src/cuter_types.erl | 22 +++++++++++----------- 5 files changed, 22 insertions(+), 50 deletions(-) diff --git a/cuter b/cuter index d369aa64..9a72d699 100755 --- a/cuter +++ b/cuter @@ -38,7 +38,6 @@ def main(): parser.add_argument("-m", "--metrics", action='store_true', help="report collected metrics") parser.add_argument("--debug-keep-traces", action='store_true', help="keep execution traces for debugging") parser.add_argument("--debug-solver-fsm", action='store_true', help="output debug logs for the solver FSM") - parser.add_argument("-ps", "--prune-safe", action='store_true', help="prune safe paths and stop the execution early") # Parse the arguments args = parser.parse_args() @@ -110,8 +109,6 @@ def main(): opts.append("debug_keep_traces") if args.debug_solver_fsm: opts.append("debug_solver_fsm") - if args.prune_safe: - opts.append("prune_safe") strOpts = ",".join(opts) # Run CutEr diff --git a/include/cuter_macros.hrl b/include/cuter_macros.hrl index ae5b13cd..8572c4cd 100644 --- a/include/cuter_macros.hrl +++ b/include/cuter_macros.hrl @@ -89,8 +89,6 @@ -define(NUM_SOLVERS, number_of_solvers). %% Sets the number of concurrent concolic execution processes. -define(NUM_POLLERS, number_of_pollers). -%% Prune safe paths. --define(PRUNE_SAFE, prune_safe). -type runtime_options() :: {?Z3_TIMEOUT, pos_integer()} | ?REPORT_METRICS diff --git a/src/cuter.erl b/src/cuter.erl index d54e0828..62bdc126 100644 --- a/src/cuter.erl +++ b/src/cuter.erl @@ -48,7 +48,7 @@ run(M, F, As, Depth, Options) -> Seeds = [{M, F, As, Depth}], run(Seeds, Options). --spec run([seed(),...], options()) -> erroneous_inputs(). +-spec run([seed()], options()) -> erroneous_inputs(). %% Runs CutEr on multiple units. run(Seeds, Options) -> State = state_from_options_and_seeds(Options, Seeds), @@ -87,8 +87,7 @@ run_from_file(File, Options) -> %% The tasks to run during the app initialization. init_tasks() -> [fun ensure_exported_entry_points/1, - fun compute_callgraph/1, - fun annotate_for_possible_errors/1]. + fun compute_callgraph/1]. -spec init(state()) -> ok | error. init(State) -> @@ -129,17 +128,10 @@ compute_callgraph(State) -> Mfas = mfas_from_state(State), cuter_codeserver:calculate_callgraph(State#st.codeServer, Mfas). + mfas_from_state(State) -> [{M, F, length(As)} || {M, F, As, _} <- State#st.seeds]. -annotate_for_possible_errors(State) -> - case cuter_config:fetch(?PRUNE_SAFE) of - {ok, true} -> - cuter_codeserver:annotate_for_possible_errors(State#st.codeServer); - _ -> - ok - end. - %% ---------------------------------------------------------------------------- %% Manage the concolic executions %% ---------------------------------------------------------------------------- @@ -151,7 +143,8 @@ start(State) -> -spec start([seed()], state()) -> state(). start([], State) -> State; -start([{M, F, As, Depth}|Seeds], State) -> CodeServer = State#st.codeServer, +start([{M, F, As, Depth}|Seeds], State) -> + CodeServer = State#st.codeServer, Scheduler = State#st.scheduler, Errors = start_one(M, F, As, Depth, CodeServer, Scheduler), NewErrors = [{{M, F, length(As)}, Errors}|State#st.errors], @@ -246,7 +239,7 @@ stop(State) -> %% Generate the system state %% ---------------------------------------------------------------------------- --spec state_from_options_and_seeds(options(), [seed(),...]) -> state(). +-spec state_from_options_and_seeds(options(), [seed()]) -> state(). state_from_options_and_seeds(Options, Seeds) -> process_flag(trap_exit, true), error_logger:tty(false), %% disable error_logger @@ -254,7 +247,7 @@ state_from_options_and_seeds(Options, Seeds) -> ok = cuter_metrics:start(), ok = define_metrics(), enable_debug_config(Options), - enable_runtime_config(Options, Seeds), + enable_runtime_config(Options), ok = cuter_pp:start(), CodeServer = cuter_codeserver:start(), SchedPid = cuter_scheduler:start(?DEFAULT_DEPTH, CodeServer), @@ -272,8 +265,8 @@ enable_debug_config(Options) -> cuter_config:store(?DEBUG_SMT, proplists:get_bool(?DEBUG_SMT, Options)), cuter_config:store(?DEBUG_SOLVER_FSM, proplists:get_bool(?DEBUG_SOLVER_FSM, Options)). --spec enable_runtime_config(options(), [seed(),...]) -> ok. -enable_runtime_config(Options, [{_M, _F, _I, _D}|_]) -> +-spec enable_runtime_config(options()) -> ok. +enable_runtime_config(Options) -> {ok, CWD} = file:get_cwd(), cuter_config:store(?WORKING_DIR, cuter_lib:get_tmp_dir(proplists:get_value(?WORKING_DIR, Options, CWD))), @@ -291,8 +284,7 @@ enable_runtime_config(Options, [{_M, _F, _I, _D}|_]) -> cuter_config:store(?SORTED_ERRORS, proplists:get_bool(?SORTED_ERRORS, Options)), cuter_config:store(?WHITELISTED_MFAS, whitelisted_mfas(Options)), cuter_config:store(?NUM_SOLVERS, proplists:get_value(?NUM_SOLVERS, Options, ?ONE)), - cuter_config:store(?NUM_POLLERS, proplists:get_value(?NUM_POLLERS, Options, ?ONE)), - cuter_config:store(?PRUNE_SAFE, proplists:get_bool(?PRUNE_SAFE, Options)). + cuter_config:store(?NUM_POLLERS, proplists:get_value(?NUM_POLLERS, Options, ?ONE)). verbosity_level(Options) -> Default = cuter_pp:default_reporting_level(), diff --git a/src/cuter_codeserver.erl b/src/cuter_codeserver.erl index 00808723..d4962a51 100644 --- a/src/cuter_codeserver.erl +++ b/src/cuter_codeserver.erl @@ -10,8 +10,6 @@ visit_tag/2, calculate_callgraph/2, %% Work with module cache merge_dumped_cached_modules/2, modules_of_dumped_cache/1, - %% Code annotations - annotate_for_possible_errors/1, %% Access logs cachedMods_of_logs/1, visitedTags_of_logs/1, tagsAddedNo_of_logs/1, unsupportedMfas_of_logs/1, loadedMods_of_logs/1]). @@ -144,11 +142,6 @@ calculate_callgraph(CodeServer, Mfas) -> get_feasible_tags(CodeServer, NodeTypes) -> gen_server:call(CodeServer, {get_feasible_tags, NodeTypes}). -%% Annotates the code for possible errors. --spec annotate_for_possible_errors(codeserver()) -> ok. -annotate_for_possible_errors(CodeServer) -> - gen_server:call(CodeServer, annotate_for_possible_errors). - %% ---------------------------------------------------------------------------- %% gen_server callbacks (Server Implementation) %% ---------------------------------------------------------------------------- @@ -189,7 +182,6 @@ handle_info(_Msg, State) -> ; (get_whitelist, from(), state()) -> {reply, cuter_mock:whitelist(), state()} ; ({get_feasible_tags, cuter_cerl:node_types()}, from(), state()) -> {reply, cuter_cerl:visited_tags(), state()} ; ({calculate_callgraph, [mfa()]}, from(), state()) -> {reply, ok, state()} - ; (annotate_for_possible_errors, from(), state()) -> {reply, ok, state()} . handle_call({load, M}, _From, State) -> {reply, try_load(M, State), State}; @@ -239,14 +231,7 @@ handle_call({calculate_callgraph, Mfas}, _From, State=#st{whitelist = Whitelist} end, cuter_callgraph:foreachModule(LoadFn, Callgraph), {reply, ok, State#st{callgraph = Callgraph}} - end; -handle_call(annotate_for_possible_errors, _From, State=#st{db = Db}) -> - Fn2 = fun({_M, Kmodule}, Acc) -> - [Kmodule|Acc] - end, - Kmodules = ets:foldl(Fn2, [], Db), - _MfasToSpecs = cuter_types:parse_specs(Kmodules), - {reply, ok, State}. + end. %% gen_server callback : handle_cast/2 -spec handle_cast(stop, state()) -> {stop, normal, state()} | {noreply, state()} diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 032204f1..639c0b17 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -23,7 +23,7 @@ -export([erl_type_deps_map/2, get_type_name_from_type_dep/1, get_type_from_type_dep/1, unique_type_name/3]). --export([parse_specs/1]). +-export([convert_specs/1]). -export_type([erl_type/0, erl_spec_clause/0, erl_spec/0, stored_specs/0, stored_types/0, stored_spec_value/0, t_range_limit/0]). @@ -1228,8 +1228,8 @@ var_name({var, _, X}) -> X. %% Find the erl type representation of all signatures in a list of kmodules --spec parse_specs([cuter_cerl:kmodule()]) -> dict:dict(). -parse_specs(Kmodules) -> +-spec convert_specs([cuter_cerl:kmodule()]) -> dict:dict(). +convert_specs(Kmodules) -> RecDict = ets:new(recdict, []), %% Needed for erl_types:t_from_form/6 ExpTypes = sets:union([cuter_cerl:kmodule_exported_types(M) || M <- Kmodules]), %% Needed for erl_types:t_from_form/6 Fn = fun (Kmodule, Acc) -> @@ -1242,26 +1242,26 @@ parse_specs(Kmodules) -> %% It is a dict with the module name as the key and all the types defined in it initially. Unhandled = lists:foldl(Fn, dict:new(), Kmodules), %% Find all signatures - Ret = parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, dict:new()), + Ret = convert_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, dict:new()), ets:delete(RecDict), Ret. %% Convert all signatures in all modules until none can be converted -parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, GatheredSpecs) -> +convert_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, GatheredSpecs) -> %% Pass all modules - {Unhandled1, Change, GatheredSpecs1} = parse_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, false, GatheredSpecs), + {Unhandled1, Change, GatheredSpecs1} = convert_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, false, GatheredSpecs), case Change of %% If Unhandled has changed in this pass %% Pass again true -> - parse_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled1, GatheredSpecs1); + convert_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled1, GatheredSpecs1); %% Else return the gathered signatures false -> GatheredSpecs1 end. %% Pass through all modules and gather signatures -parse_specs_fix_pass([], _ExpTypes, _RecDict, Unhandled, Change, GatheredSpecs) -> {Unhandled, Change, GatheredSpecs}; -parse_specs_fix_pass([Kmodule|Kmodules], ExpTypes, RecDict, Unhandled, Change, GatheredSpecs) -> +convert_specs_fix_pass([], _ExpTypes, _RecDict, Unhandled, Change, GatheredSpecs) -> {Unhandled, Change, GatheredSpecs}; +convert_specs_fix_pass([Kmodule|Kmodules], ExpTypes, RecDict, Unhandled, Change, GatheredSpecs) -> Mod = cuter_cerl:kmodule_name(Kmodule), PrevUnhandled = dict:fetch(Mod, Unhandled), %% Get the signatures converted and the unhandled types of this module @@ -1274,9 +1274,9 @@ parse_specs_fix_pass([Kmodule|Kmodules], ExpTypes, RecDict, Unhandled, Change, G %% If the unhandled types for this module have not changed case equal_sets(NewUnhandled, PrevUnhandled) of %% Maintain the Change so far in the recursive call - true -> parse_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, Change, GatheredSpecs1); + true -> convert_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, Change, GatheredSpecs1); %% A change has occured, make the recursive call with Change: true and an updated Unhandled dict - false -> parse_specs_fix_pass(Kmodules, ExpTypes, RecDict, dict:store(Mod, NewUnhandled, Unhandled), true, GatheredSpecs1) + false -> convert_specs_fix_pass(Kmodules, ExpTypes, RecDict, dict:store(Mod, NewUnhandled, Unhandled), true, GatheredSpecs1) end. %% Gather all signatures defined in a module. From 111cb5d314b254fc10bf36fdf0e4ee0c2807fdee Mon Sep 17 00:00:00 2001 From: Dspil Date: Fri, 11 Feb 2022 23:33:22 +0200 Subject: [PATCH 44/85] Added unit test file for convert_specs --- Makefile.in | 3 +- src/cuter_debug.erl | 12 ++++++- test/utest/src/cuter_types_tests.erl | 12 +++++++ test/utest/src/examples_for_type_analysis.erl | 35 +++++++++++++++++++ 4 files changed, 60 insertions(+), 2 deletions(-) create mode 100644 test/utest/src/examples_for_type_analysis.erl diff --git a/Makefile.in b/Makefile.in index f011d5f1..e74c74d0 100644 --- a/Makefile.in +++ b/Makefile.in @@ -100,7 +100,8 @@ UTEST_MODULES = \ types_and_specs \ types_and_specs2 \ cuter_metrics_tests \ - cuter_config_tests + cuter_config_tests \ + examples_for_type_analysis FTEST_MODULES = \ bitstr \ diff --git a/src/cuter_debug.erl b/src/cuter_debug.erl index f6ce493c..e3cb7856 100644 --- a/src/cuter_debug.erl +++ b/src/cuter_debug.erl @@ -1,7 +1,7 @@ %% -*- erlang-indent-level: 2 -*- %%------------------------------------------------------------------------------ -module(cuter_debug). --export([parse_module/2]). +-export([parse_module/2, convert_types/1]). %% Prints the AST of a module. %% Run as: @@ -14,3 +14,13 @@ parse_module(M, WithPmatch) -> {ok, AST} -> io:format("~p~n", [AST]) end. + +-spec convert_types([module()]) -> ok. +convert_types(Modules) -> + Fn = fun(M) -> + {ok, AST} = cuter_cerl:get_core(M, false), + AST + end, + ASTs = [{M, Fn(M)} || M <- Modules], + Kmodules = [cuter_cerl:kmodule(M, AST, fun() -> ok end) || {M, AST} <- ASTs], + io:format("~p~n", [dict:to_list(cuter_types:convert_specs(Kmodules))]). diff --git a/test/utest/src/cuter_types_tests.erl b/test/utest/src/cuter_types_tests.erl index 54ff7744..a4a8b879 100644 --- a/test/utest/src/cuter_types_tests.erl +++ b/test/utest/src/cuter_types_tests.erl @@ -81,3 +81,15 @@ setup(Mod) -> {Mod, Attrs}. cleanup(_) -> ok. + +-spec convert_types_test() -> any(). +convert_types_test() -> + Modules = [examples_for_type_analysis], + Fn = fun(M) -> + {ok, AST} = cuter_cerl:get_core(M, false), + AST + end, + ASTs = [{M, Fn(M)} || M <- Modules], + Kmodules = [cuter_cerl:kmodule(M, AST, fun() -> ok end) || {M, AST} <- ASTs], + Specs = cuter_types:convert_specs(Kmodules), + [?assertEqual([{examples_for_type_analysis,f,1}], dict:fetch_keys(Specs))]. diff --git a/test/utest/src/examples_for_type_analysis.erl b/test/utest/src/examples_for_type_analysis.erl new file mode 100644 index 00000000..83e095e9 --- /dev/null +++ b/test/utest/src/examples_for_type_analysis.erl @@ -0,0 +1,35 @@ +-module(examples_for_type_analysis). +-export([f/1, f1/1, f2/1, f3/1, f4/1, f5/1]). + +-type t2() :: t1() | atom(). +-type t1() :: integer(). + +-record(rec, {x :: integer(), y :: number()}). + +-type tree() :: {integer(), tree(), tree()} | nil. + +-type t3(X) :: [X]. + +%% erl_types:t_fun([erl_types:t_any()], erl_types:t_any()) +-spec f(any()) -> any(). +f(X) -> X. + +%% erl_types:t_fun([erl_types:t_integer()], erl_types:t_atom(ok)) +-spec f1(t1()) -> ok. +f1(_X) -> ok. + +%% erl_types:t_fun([erl_types:t_sup(erl_types:t_integer(), erl_types:t_atom())], erl_types:t_atom(ok)) +-spec f2(t2()) -> ok. +f2(_X) -> ok. + +%% erl_types:t_fun([erl_types:t_tuple([erl_types:t_from_term(rec), erl_types:t_integer(), erl_types:t_number()])], erl_types:t_atom(ok)). +-spec f3(#rec{}) -> ok. +f3(_X) -> ok. + +%% ?? +-spec f4(tree()) -> ok. +f4(_X) -> ok. + +%% erl_types:t_fun([erl_types:t_list(erl_types:t_tuple([erl_types:t_from_term(rec), erl_types:t_integer(), erl_types:t_number()]))], erl_types:t_atom(ok)). +-spec f5(t3(#rec{})) -> ok. +f5(_X) -> ok. From f2c64ec34a83963aa92ac0f0228f0452e2b354d5 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 10:07:54 +0100 Subject: [PATCH 45/85] Verbose printing of the MFA specs --- src/cuter_debug.erl | 30 +++++++++++++++++++----------- 1 file changed, 19 insertions(+), 11 deletions(-) diff --git a/src/cuter_debug.erl b/src/cuter_debug.erl index e3cb7856..56d376a1 100644 --- a/src/cuter_debug.erl +++ b/src/cuter_debug.erl @@ -1,11 +1,13 @@ %% -*- erlang-indent-level: 2 -*- %%------------------------------------------------------------------------------ -module(cuter_debug). --export([parse_module/2, convert_types/1]). + +-export([parse_module/2, to_erl_types_specs/1]). + +%% This modules contains convenience MFAs for debugging purposes during the +%% development of the tool. %% Prints the AST of a module. -%% Run as: -%% erl -noshell -pa ebin/ -eval "cuter_debug:parse_module(lists, true)" -s init stop -spec parse_module(module(), boolean()) -> ok. parse_module(M, WithPmatch) -> case cuter_cerl:get_core(M, WithPmatch) of @@ -15,12 +17,18 @@ parse_module(M, WithPmatch) -> io:format("~p~n", [AST]) end. --spec convert_types([module()]) -> ok. -convert_types(Modules) -> +%% Returns the specs of a list of modules as erl_types representation. +-spec to_erl_types_specs([module()]) -> ok. +to_erl_types_specs(Modules) -> Fn = fun(M) -> - {ok, AST} = cuter_cerl:get_core(M, false), - AST - end, - ASTs = [{M, Fn(M)} || M <- Modules], - Kmodules = [cuter_cerl:kmodule(M, AST, fun() -> ok end) || {M, AST} <- ASTs], - io:format("~p~n", [dict:to_list(cuter_types:convert_specs(Kmodules))]). + {ok, AST} = cuter_cerl:get_core(M, false), + AST + end, + Xs = [{M, Fn(M)} || M <- Modules], + TagGen = fun() -> ok end, + Kmodules = [cuter_cerl:kmodule(M, AST, TagGen) || {M, AST} <- Xs], + Specs = cuter_types:convert_specs(Kmodules), + lists:foreach(fun print_mfa_and_spec/1, dict:to_list(Specs)). + +print_mfa_and_spec({MFA, Spec}) -> + io:format("~p~n ~p~n", [MFA, Spec]). From daa490c9a19e04b60fd7db5d7f3c4f5fcb14e424 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 12:17:33 +0100 Subject: [PATCH 46/85] Add spec assertions --- test/utest/src/cuter_tests_lib.erl | 10 +++ test/utest/src/cuter_types_tests.erl | 61 +++++++++++++++++-- test/utest/src/examples_for_type_analysis.erl | 44 +++++++------ 3 files changed, 86 insertions(+), 29 deletions(-) diff --git a/test/utest/src/cuter_tests_lib.erl b/test/utest/src/cuter_tests_lib.erl index da52a95a..0c4427d9 100644 --- a/test/utest/src/cuter_tests_lib.erl +++ b/test/utest/src/cuter_tests_lib.erl @@ -5,6 +5,7 @@ -include("include/eunit_config.hrl"). -export([setup_dir/0, get_python_command/0, get_module_attrs/2, sample_trace_file/1]). +-export([mfa_to_list/1, mfa_to_list/3]). %% Create a directory for temporary use -spec setup_dir() -> file:filename_all(). @@ -45,3 +46,12 @@ sample_trace_file(Fname) -> cuter_log:log_equal(Fd, false, X, 45, cuter_cerl:empty_tag()), %% Close the logfile cuter_log:close_file(Fd). + +%% Returns the string representation of an MFA. +-spec mfa_to_list(mfa()) -> string(). +mfa_to_list({M, F, A}) -> mfa_to_list(M, F, A). + +%% Returns the string representation of an MFA. +-spec mfa_to_list(module(), atom(), byte()) -> string(). +mfa_to_list(M, F, A) -> + atom_to_list(M) ++ ":" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A). diff --git a/test/utest/src/cuter_types_tests.erl b/test/utest/src/cuter_types_tests.erl index a4a8b879..b778fd02 100644 --- a/test/utest/src/cuter_types_tests.erl +++ b/test/utest/src/cuter_types_tests.erl @@ -86,10 +86,59 @@ cleanup(_) -> ok. convert_types_test() -> Modules = [examples_for_type_analysis], Fn = fun(M) -> - {ok, AST} = cuter_cerl:get_core(M, false), - AST - end, - ASTs = [{M, Fn(M)} || M <- Modules], - Kmodules = [cuter_cerl:kmodule(M, AST, fun() -> ok end) || {M, AST} <- ASTs], + {ok, AST} = cuter_cerl:get_core(M, false), + AST + end, + Xs = [{M, Fn(M)} || M <- Modules], + TagGen = fun() -> ok end, + Kmodules = [cuter_cerl:kmodule(M, AST, TagGen) || {M, AST} <- Xs], Specs = cuter_types:convert_specs(Kmodules), - [?assertEqual([{examples_for_type_analysis,f,1}], dict:fetch_keys(Specs))]. + Expect = mfas_and_specs(), + ExpectMfas = [Mfa || {Mfa, _Spec} <- Expect], + As = lists:flatten([spec_assertions(E, Specs) || E <- Expect]), + [?assertEqual(lists:sort(ExpectMfas), lists:sort(dict:fetch_keys(Specs)))] ++ As. + + +mfas_and_specs() -> + [ + { + {examples_for_type_analysis, id, 1}, + [erl_types:t_fun([erl_types:t_any()], erl_types:t_any())] + }, + { + {examples_for_type_analysis, inc, 1}, + [erl_types:t_fun([erl_types:t_integer()], erl_types:t_integer())] + }, + { + {examples_for_type_analysis, to_atom, 1}, + [erl_types:t_fun([erl_types:t_sup(erl_types:t_integer(), erl_types:t_atom())], erl_types:t_atom())] + }, + { + {examples_for_type_analysis, translate, 3}, + [erl_types:t_fun( + [erl_types:t_tuple([erl_types:t_from_term(point), erl_types:t_number(), erl_types:t_number()]), + erl_types:t_number(), + erl_types:t_number()], + erl_types:t_tuple([erl_types:t_from_term(point), erl_types:t_number(), erl_types:t_number()]))] + }, + { + {examples_for_type_analysis, root, 1}, + [] %% We do not support recursive types. + }, + { + {examples_for_type_analysis, max_x, 1}, + [erl_types:t_fun( + [erl_types:t_list( + erl_types:t_tuple([erl_types:t_from_term(point), erl_types:t_number(), erl_types:t_number()]))], + erl_types:t_number())] + } + ]. + +spec_assertions({Mfa, Expect}, R) -> + As = [?assert(dict:is_key(Mfa, R))], + case dict:find(Mfa, R) of + error -> As; + {ok, Got} -> + Comment = "Spec of " ++ cuter_tests_lib:mfa_to_list(Mfa), + As ++ [?assertEqual(Expect, Got, Comment)] + end. diff --git a/test/utest/src/examples_for_type_analysis.erl b/test/utest/src/examples_for_type_analysis.erl index 83e095e9..954599c7 100644 --- a/test/utest/src/examples_for_type_analysis.erl +++ b/test/utest/src/examples_for_type_analysis.erl @@ -1,35 +1,33 @@ -module(examples_for_type_analysis). --export([f/1, f1/1, f2/1, f3/1, f4/1, f5/1]). +-export([id/1, inc/1, to_atom/1, translate/3, root/1, max_x/1]). --type t2() :: t1() | atom(). --type t1() :: integer(). +-type t_int_or_atom() :: t_int() | atom(). +-type t_int() :: integer(). --record(rec, {x :: integer(), y :: number()}). +-record(point, {x :: number(), y :: number()}). -type tree() :: {integer(), tree(), tree()} | nil. --type t3(X) :: [X]. +-type list_of(X) :: [X]. -%% erl_types:t_fun([erl_types:t_any()], erl_types:t_any()) --spec f(any()) -> any(). -f(X) -> X. +-type point() :: #point{}. -%% erl_types:t_fun([erl_types:t_integer()], erl_types:t_atom(ok)) --spec f1(t1()) -> ok. -f1(_X) -> ok. +-spec id(any()) -> any(). +id(X) -> X. -%% erl_types:t_fun([erl_types:t_sup(erl_types:t_integer(), erl_types:t_atom())], erl_types:t_atom(ok)) --spec f2(t2()) -> ok. -f2(_X) -> ok. +-spec inc(t_int()) -> t_int(). +inc(X) -> X + 1. -%% erl_types:t_fun([erl_types:t_tuple([erl_types:t_from_term(rec), erl_types:t_integer(), erl_types:t_number()])], erl_types:t_atom(ok)). --spec f3(#rec{}) -> ok. -f3(_X) -> ok. +-spec to_atom(t_int_or_atom()) -> atom(). +to_atom(X) when is_atom(X) -> X; +to_atom(X) when is_integer(X) -> list_to_atom([$0 + X]). -%% ?? --spec f4(tree()) -> ok. -f4(_X) -> ok. +-spec translate(#point{}, number(), number()) -> point(). +translate(#point{x=X, y=Y}, DX, DY) -> #point{x = X + DX, y = Y + DY}. -%% erl_types:t_fun([erl_types:t_list(erl_types:t_tuple([erl_types:t_from_term(rec), erl_types:t_integer(), erl_types:t_number()]))], erl_types:t_atom(ok)). --spec f5(t3(#rec{})) -> ok. -f5(_X) -> ok. +-spec root(tree()) -> integer() | nil. +root({X, _L, _R}) -> X; +root(nil) -> nil. + +-spec max_x(list_of(#point{})) -> number(). +max_x(Ps) -> lists:max([P#point.x || P <- Ps]). From 13ae42c4c7e8c26bbf54ef41287aea89aa44b137 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 13:42:19 +0100 Subject: [PATCH 47/85] Rename conver_specs to specs_as_erl_types --- src/cuter_debug.erl | 2 +- src/cuter_types.erl | 6 +++--- test/utest/src/cuter_types_tests.erl | 7 ++++--- 3 files changed, 8 insertions(+), 7 deletions(-) diff --git a/src/cuter_debug.erl b/src/cuter_debug.erl index 56d376a1..ce71d9da 100644 --- a/src/cuter_debug.erl +++ b/src/cuter_debug.erl @@ -27,7 +27,7 @@ to_erl_types_specs(Modules) -> Xs = [{M, Fn(M)} || M <- Modules], TagGen = fun() -> ok end, Kmodules = [cuter_cerl:kmodule(M, AST, TagGen) || {M, AST} <- Xs], - Specs = cuter_types:convert_specs(Kmodules), + Specs = cuter_types:specs_as_erl_types(Kmodules), lists:foreach(fun print_mfa_and_spec/1, dict:to_list(Specs)). print_mfa_and_spec({MFA, Spec}) -> diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 639c0b17..8a241fd6 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -23,7 +23,7 @@ -export([erl_type_deps_map/2, get_type_name_from_type_dep/1, get_type_from_type_dep/1, unique_type_name/3]). --export([convert_specs/1]). +-export([specs_as_erl_types/1]). -export_type([erl_type/0, erl_spec_clause/0, erl_spec/0, stored_specs/0, stored_types/0, stored_spec_value/0, t_range_limit/0]). @@ -1228,8 +1228,8 @@ var_name({var, _, X}) -> X. %% Find the erl type representation of all signatures in a list of kmodules --spec convert_specs([cuter_cerl:kmodule()]) -> dict:dict(). -convert_specs(Kmodules) -> +-spec specs_as_erl_types([cuter_cerl:kmodule()]) -> dict:dict(). +specs_as_erl_types(Kmodules) -> RecDict = ets:new(recdict, []), %% Needed for erl_types:t_from_form/6 ExpTypes = sets:union([cuter_cerl:kmodule_exported_types(M) || M <- Kmodules]), %% Needed for erl_types:t_from_form/6 Fn = fun (Kmodule, Acc) -> diff --git a/test/utest/src/cuter_types_tests.erl b/test/utest/src/cuter_types_tests.erl index b778fd02..d361492e 100644 --- a/test/utest/src/cuter_types_tests.erl +++ b/test/utest/src/cuter_types_tests.erl @@ -92,11 +92,12 @@ convert_types_test() -> Xs = [{M, Fn(M)} || M <- Modules], TagGen = fun() -> ok end, Kmodules = [cuter_cerl:kmodule(M, AST, TagGen) || {M, AST} <- Xs], - Specs = cuter_types:convert_specs(Kmodules), + Specs = cuter_types:specs_as_erl_types(Kmodules), Expect = mfas_and_specs(), - ExpectMfas = [Mfa || {Mfa, _Spec} <- Expect], As = lists:flatten([spec_assertions(E, Specs) || E <- Expect]), - [?assertEqual(lists:sort(ExpectMfas), lists:sort(dict:fetch_keys(Specs)))] ++ As. + ExpectMfas = lists:sort([Mfa || {Mfa, _Spec} <- Expect]), + GotMfas = lists:sort(dict:fetch_keys(Specs)), + [?assertEqual(ExpectMfas, GotMfas)] ++ As. mfas_and_specs() -> From 21a922dd12d6a236f84051bc287ffb7d90c9fc4c Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 14:01:35 +0100 Subject: [PATCH 48/85] Reverse the Line-Type tuples for consistency --- src/cuter_types.erl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 8a241fd6..d3c9b3d9 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1235,7 +1235,7 @@ specs_as_erl_types(Kmodules) -> Fn = fun (Kmodule, Acc) -> Mod = cuter_cerl:kmodule_name(Kmodule), TypesLines = all_types_from_cerl(Kmodule), - U = sets:from_list([{TName, length(Vars)} || {{TName, _T, Vars}, _L} <- TypesLines]), + U = sets:from_list([{TName, length(Vars)} || {_L, {TName, _T, Vars}} <- TypesLines]), dict:store(Mod, U, Acc) end, %% Unhandled holds all non converted types from a form to an erl_type for each module. @@ -1306,7 +1306,7 @@ parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled) -> %% This is done to handle types depending on later defined types %% or mutually recursive types immediately fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled) -> - F = fun ({{Tname, T, Vars}, L}, Acc) -> %% Get a type and a set of unhandled types + F = fun ({L, {Tname, T, Vars}}, Acc) -> %% Get a type and a set of unhandled types A = length(Vars), %% Try to convert the type to erl_type using erl_types:t_from_form/6 {{T1, _C}, D1} = @@ -1370,7 +1370,7 @@ equal_sets(A, B) -> %% Return all types defined in a kmodule all_types_from_cerl(Kmodule) -> %% Types and Opaque types - TypesOpaques = [{type_replace_records(Type), Line} || {Line, Type} <- cuter_cerl:kmodule_type_forms(Kmodule)], + TypesOpaques = [{Line, type_replace_records(Type)} || {Line, Type} <- cuter_cerl:kmodule_type_forms(Kmodule)], %% Make the temp types representing records Records = records_as_types(Kmodule), lists:append(TypesOpaques, Records). @@ -1414,7 +1414,7 @@ type_from_record({Name, Line, Fields}) -> NewFields = lists:map(Fn, Fields), NewName = record_name(Name), RecType = {type, Line, tuple, [{atom, Line, Name} | NewFields]}, - {{NewName, RecType, []}, Line}. + {Line, {NewName, RecType, []}}. %% Return the name of a temporary type corresponding to a record with name Name record_name(Name) -> From eb8194fa8be5ed09ad86eb7d90e1c3048f028100 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 15:12:19 +0100 Subject: [PATCH 49/85] Refactor the extraction of type definitions from a kmodule. --- src/cuter_types.erl | 72 +++++++++++++++++++++------------------------ 1 file changed, 33 insertions(+), 39 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index d3c9b3d9..4e90abbd 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1234,7 +1234,7 @@ specs_as_erl_types(Kmodules) -> ExpTypes = sets:union([cuter_cerl:kmodule_exported_types(M) || M <- Kmodules]), %% Needed for erl_types:t_from_form/6 Fn = fun (Kmodule, Acc) -> Mod = cuter_cerl:kmodule_name(Kmodule), - TypesLines = all_types_from_cerl(Kmodule), + TypesLines = extract_type_definitions(Kmodule), U = sets:from_list([{TName, length(Vars)} || {_L, {TName, _T, Vars}} <- TypesLines]), dict:store(Mod, U, Acc) end, @@ -1285,7 +1285,7 @@ convert_specs_fix_pass([Kmodule|Kmodules], ExpTypes, RecDict, Unhandled, Change, parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled) -> %% Fetch type forms from the kmodule along with the lines where they were defined. %% The lines are needed for the erl_types:t_from_form/6 call - TypesLines = all_types_from_cerl(Kmodule), + TypesLines = extract_type_definitions(Kmodule), Mod = cuter_cerl:kmodule_name(Kmodule), %% Only Unhandled is returned because types will be stored in RecDict ets table Unhandled = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled), @@ -1367,58 +1367,52 @@ convert_list_to_erl([Spec|Specs], MFA, ExpTypes, RecDict, Acc) -> equal_sets(A, B) -> sets:size(A) == sets:size(B) andalso sets:size(sets:union(A, B)) == sets:size(B). -%% Return all types defined in a kmodule -all_types_from_cerl(Kmodule) -> - %% Types and Opaque types - TypesOpaques = [{Line, type_replace_records(Type)} || {Line, Type} <- cuter_cerl:kmodule_type_forms(Kmodule)], - %% Make the temp types representing records - Records = records_as_types(Kmodule), - lists:append(TypesOpaques, Records). +%% Returns the type and record definitions in a kmodule. +%% Records are replaced by equivalent types. +extract_type_definitions(Kmodule) -> + %% Replaces the record references in the type forms. + TypeForms = cuter_cerl:kmodule_type_forms(Kmodule), + Types = [replace_record_references_in_type_form(TF) || TF <- TypeForms], + %% Generate equivalent type for the records. + RecordForms = cuter_cerl:kmodule_record_forms(Kmodule), + Records = [generate_type_form_for_record_form(RF) || RF <- RecordForms], + Types ++ Records. %% Replace all record references with their respective temporary type in a type form -type_replace_records({Name, Type, Args}) -> - {Name, replace_records(Type), Args}. +replace_record_references_in_type_form({Line, {Name, Type, Args}}) -> + {Line, {Name, replace_record_references(Type), Args}}. %% Replace all record references with their respective temporary type in a spec form list spec_replace_records(FunSpecs) -> Fn = fun({type, Line, F, L}) -> - {type, Line, F, lists:map(fun replace_records/1, L)} + {type, Line, F, lists:map(fun replace_record_references/1, L)} end, lists:map(Fn, FunSpecs). %% Replace all record references with their respective temporary type in a form -replace_records({type, L, record, [{atom, _, Name}]}) -> - {user_type, L, record_name(Name), []}; -replace_records({T, L, Type, Args}) when T =:= type orelse T =:= user_type -> +%% Replaces all the references to records inside a type form. +replace_record_references({type, L, record, [{atom, _, Name}]}) -> + {user_type, L, type_name_for_record(Name), []}; +replace_record_references({T, L, Type, Args}) when T =:= type orelse T =:= user_type -> case is_list(Args) of true -> - {T, L, Type, lists:map(fun replace_records/1, Args)}; + {T, L, Type, [replace_record_references(A) || A <- Args]}; false -> {T, L, Type, Args} end; -replace_records(Rest) -> Rest. - -%% Return temporary types representing the records in a kmodule -%% For each record rec with fields es make a temporary tuple type with -%% first item rec and es as the rest items -records_as_types(Kmodule) -> - R = [{RecName, Line, RecFields} || {Line, {RecName, RecFields}} <- cuter_cerl:kmodule_record_forms(Kmodule)], - lists:map(fun type_from_record/1, R). - -%% Create the temporary type from a record form -type_from_record({Name, Line, Fields}) -> - Fn = fun ({typed_record_field, _, T}) -> - replace_records(T) - end, - %% Replace record references in fields - NewFields = lists:map(Fn, Fields), - NewName = record_name(Name), - RecType = {type, Line, tuple, [{atom, Line, Name} | NewFields]}, - {Line, {NewName, RecType, []}}. - -%% Return the name of a temporary type corresponding to a record with name Name -record_name(Name) -> - list_to_atom(?CUTER_RECORD_TYPE_PREFIX ++ atom_to_list(Name)). +replace_record_references(F) -> F. + +%% Generates a type definition for a record. +%% A record is represented as a tuple where the first element is the name of the record. +%% The rest of the elements are the types of the record fields. +generate_type_form_for_record_form({Line, {Name, Fields}}) -> + Fs = [replace_record_references(T) || {typed_record_field, _, T} <- Fields], + RecType = {type, Line, tuple, [{atom, Line, Name} | Fs]}, + {Line, {type_name_for_record(Name), RecType, []}}. + +%% Returns the name of a generated type that represents the record RecordName. +type_name_for_record(RecordName) -> + list_to_atom(?CUTER_RECORD_TYPE_PREFIX ++ atom_to_list(RecordName)). %% Replace all bounded signatures with equivalent normal ones spec_replace_bounded(Specs) -> lists:map(fun handle_bounded_fun/1, Specs). From 4afdaacada08638ea066afa89d6183bf119f76fc Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 16:42:09 +0100 Subject: [PATCH 50/85] Rename the names for the fix computation --- src/cuter_types.erl | 68 +++++++++++++++++++++++++-------------------- 1 file changed, 38 insertions(+), 30 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 4e90abbd..fcb8de0e 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1230,53 +1230,60 @@ var_name({var, _, X}) -> %% Find the erl type representation of all signatures in a list of kmodules -spec specs_as_erl_types([cuter_cerl:kmodule()]) -> dict:dict(). specs_as_erl_types(Kmodules) -> - RecDict = ets:new(recdict, []), %% Needed for erl_types:t_from_form/6 - ExpTypes = sets:union([cuter_cerl:kmodule_exported_types(M) || M <- Kmodules]), %% Needed for erl_types:t_from_form/6 - Fn = fun (Kmodule, Acc) -> - Mod = cuter_cerl:kmodule_name(Kmodule), - TypesLines = extract_type_definitions(Kmodule), - U = sets:from_list([{TName, length(Vars)} || {_L, {TName, _T, Vars}} <- TypesLines]), - dict:store(Mod, U, Acc) - end, - %% Unhandled holds all non converted types from a form to an erl_type for each module. - %% It is a dict with the module name as the key and all the types defined in it initially. - Unhandled = lists:foldl(Fn, dict:new(), Kmodules), - %% Find all signatures - Ret = convert_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, dict:new()), + %% Initialise an openset with all the types that have not yet been converted from a form + %% to its erl_types representation. + Openset = initial_openset_of_types(Kmodules), + specs_as_erl_types_fix(Kmodules, Openset). + +initial_openset_of_types(Kmodules) -> + initial_openset_of_types(Kmodules, dict:new()). + +initial_openset_of_types([], Openset) -> + Openset; +initial_openset_of_types([KM|KMs], Openset) -> + TypeForms = extract_type_definitions(KM), + Ts = sets:from_list([{TName, length(Vars)} || {_L, {TName, _T, Vars}} <- TypeForms]), + Openset1 = dict:store(cuter_cerl:kmodule_name(KM), Ts, Openset), + initial_openset_of_types(KMs, Openset1). + +%% Converts all the function specifications of the kmodules using a fixpoint computation. +%% We run consecutive passes of substitutions, until there are not changes between +%% two consecutive passes. +specs_as_erl_types_fix(Kmodules, Openset) -> + RecDict = ets:new(recdict, []), %% Needed for erl_types:t_from_form/6. + R = specs_as_erl_types_fix(Kmodules, RecDict, Openset, dict:new()), ets:delete(RecDict), - Ret. + R. -%% Convert all signatures in all modules until none can be converted -convert_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled, GatheredSpecs) -> +specs_as_erl_types_fix(Kmodules, RecDict, Openset, GatheredSpecs) -> %% Pass all modules - {Unhandled1, Change, GatheredSpecs1} = convert_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, false, GatheredSpecs), + {Openset1, Change, GatheredSpecs1} = specs_as_erl_types_fix_pass(Kmodules, RecDict, Openset, false, GatheredSpecs), case Change of %% If Unhandled has changed in this pass %% Pass again true -> - convert_specs_fix(Kmodules, ExpTypes, RecDict, Unhandled1, GatheredSpecs1); + specs_as_erl_types_fix(Kmodules, RecDict, Openset1, GatheredSpecs1); %% Else return the gathered signatures false -> GatheredSpecs1 end. %% Pass through all modules and gather signatures -convert_specs_fix_pass([], _ExpTypes, _RecDict, Unhandled, Change, GatheredSpecs) -> {Unhandled, Change, GatheredSpecs}; -convert_specs_fix_pass([Kmodule|Kmodules], ExpTypes, RecDict, Unhandled, Change, GatheredSpecs) -> +specs_as_erl_types_fix_pass([], _RecDict, Unhandled, Change, GatheredSpecs) -> {Unhandled, Change, GatheredSpecs}; +specs_as_erl_types_fix_pass([Kmodule|Kmodules], RecDict, Unhandled, Change, GatheredSpecs) -> Mod = cuter_cerl:kmodule_name(Kmodule), PrevUnhandled = dict:fetch(Mod, Unhandled), %% Get the signatures converted and the unhandled types of this module - {Specs, NewUnhandled} = parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled), - Fn = fun ({MFA, Spec}, G) -> - dict:store(MFA, Spec, G) - end, + Exported = sets:union([cuter_cerl:kmodule_exported_types(KM) || KM <- Kmodules]), + {Specs, NewUnhandled} = parse_mod_specs(Kmodule, Exported, RecDict, PrevUnhandled), + Fn = fun ({MFA, Spec}, G) -> dict:store(MFA, Spec, G) end, %% Store the new signatures found in GatheredSpecs GatheredSpecs1 = lists:foldl(Fn, GatheredSpecs, Specs), %% If the unhandled types for this module have not changed - case equal_sets(NewUnhandled, PrevUnhandled) of + case are_sets_equal(NewUnhandled, PrevUnhandled) of %% Maintain the Change so far in the recursive call - true -> convert_specs_fix_pass(Kmodules, ExpTypes, RecDict, Unhandled, Change, GatheredSpecs1); + true -> specs_as_erl_types_fix_pass(Kmodules, RecDict, Unhandled, Change, GatheredSpecs1); %% A change has occured, make the recursive call with Change: true and an updated Unhandled dict - false -> convert_specs_fix_pass(Kmodules, ExpTypes, RecDict, dict:store(Mod, NewUnhandled, Unhandled), true, GatheredSpecs1) + false -> specs_as_erl_types_fix_pass(Kmodules, RecDict, dict:store(Mod, NewUnhandled, Unhandled), true, GatheredSpecs1) end. %% Gather all signatures defined in a module. @@ -1336,7 +1343,7 @@ fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled) -> %% Apply F to all Types in the module Unhandled = lists:foldl(F, sets:new(), TypesLines), %% Check if the unhandled types are different than before - case equal_sets(PrevUnhandled, Unhandled) of + case are_sets_equal(PrevUnhandled, Unhandled) of %% If they are, run the module again false -> fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, Unhandled); @@ -1364,8 +1371,9 @@ convert_list_to_erl([Spec|Specs], MFA, ExpTypes, RecDict, Acc) -> convert_list_to_erl(Specs, MFA, ExpTypes, RecDict, [ErlSpec|Acc]) end. -equal_sets(A, B) -> - sets:size(A) == sets:size(B) andalso sets:size(sets:union(A, B)) == sets:size(B). +are_sets_equal(A, B) -> + %% A = B, iff A ⊆ B and B ⊆ A. + sets:is_subset(A, B) andalso sets:is_subset(B, A). %% Returns the type and record definitions in a kmodule. %% Records are replaced by equivalent types. From 91a20039a1701d0f5a7d34d655e8bfa7b82c39ac Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 17:20:00 +0100 Subject: [PATCH 51/85] Add examples with remote types --- Makefile.in | 3 ++- test/utest/src/cuter_types_tests.erl | 13 +++++++++++-- test/utest/src/examples_for_type_analysis.erl | 8 +++++++- test/utest/src/examples_for_type_analysis_pair.erl | 11 +++++++++++ 4 files changed, 31 insertions(+), 4 deletions(-) create mode 100644 test/utest/src/examples_for_type_analysis_pair.erl diff --git a/Makefile.in b/Makefile.in index e74c74d0..514f9d90 100644 --- a/Makefile.in +++ b/Makefile.in @@ -101,7 +101,8 @@ UTEST_MODULES = \ types_and_specs2 \ cuter_metrics_tests \ cuter_config_tests \ - examples_for_type_analysis + examples_for_type_analysis \ + examples_for_type_analysis_pair FTEST_MODULES = \ bitstr \ diff --git a/test/utest/src/cuter_types_tests.erl b/test/utest/src/cuter_types_tests.erl index d361492e..810c2ffb 100644 --- a/test/utest/src/cuter_types_tests.erl +++ b/test/utest/src/cuter_types_tests.erl @@ -84,7 +84,7 @@ cleanup(_) -> ok. -spec convert_types_test() -> any(). convert_types_test() -> - Modules = [examples_for_type_analysis], + Modules = [examples_for_type_analysis, examples_for_type_analysis_pair], Fn = fun(M) -> {ok, AST} = cuter_cerl:get_core(M, false), AST @@ -132,11 +132,20 @@ mfas_and_specs() -> [erl_types:t_list( erl_types:t_tuple([erl_types:t_from_term(point), erl_types:t_number(), erl_types:t_number()]))], erl_types:t_number())] + }, + { + {examples_for_type_analysis, is_dog, 1}, + [erl_types:t_fun([erl_types:t_any()], erl_types:t_boolean())] %% Remote types not working?? + }, + { + {examples_for_type_analysis_pair, to_int, 1}, + [erl_types:t_fun([erl_types:t_any()], erl_types:t_integer())] %% Remote types not working?? } ]. spec_assertions({Mfa, Expect}, R) -> - As = [?assert(dict:is_key(Mfa, R))], + CommentExists = cuter_tests_lib:mfa_to_list(Mfa) ++ " should exist", + As = [?assert(dict:is_key(Mfa, R), CommentExists)], case dict:find(Mfa, R) of error -> As; {ok, Got} -> diff --git a/test/utest/src/examples_for_type_analysis.erl b/test/utest/src/examples_for_type_analysis.erl index 954599c7..0ae9cdf5 100644 --- a/test/utest/src/examples_for_type_analysis.erl +++ b/test/utest/src/examples_for_type_analysis.erl @@ -1,5 +1,8 @@ -module(examples_for_type_analysis). --export([id/1, inc/1, to_atom/1, translate/3, root/1, max_x/1]). + +-export([id/1, inc/1, to_atom/1, translate/3, root/1, max_x/1, is_dog/1]). + +-export_type([t_int_or_atom/0]). -type t_int_or_atom() :: t_int() | atom(). -type t_int() :: integer(). @@ -31,3 +34,6 @@ root(nil) -> nil. -spec max_x(list_of(#point{})) -> number(). max_x(Ps) -> lists:max([P#point.x || P <- Ps]). + +-spec is_dog(examples_for_type_analysis_pair:t_dog_or_cat()) -> boolean(). +is_dog(X) -> X =:= dog. diff --git a/test/utest/src/examples_for_type_analysis_pair.erl b/test/utest/src/examples_for_type_analysis_pair.erl new file mode 100644 index 00000000..6f27c3c5 --- /dev/null +++ b/test/utest/src/examples_for_type_analysis_pair.erl @@ -0,0 +1,11 @@ +-module(examples_for_type_analysis_pair). + +-export([to_int/1]). + +-export_type([t_dog_or_cat/0]). + +-type t_dog_or_cat() :: dog | cat. + +-spec to_int(examples_for_type_analysis:t_int_or_atom()) -> integer(). +to_int(X) when is_integer(X) -> X; +to_int(X) when is_atom(X) -> lists:max(atom_to_list(X)). From 613253df683eb64eba86eebff4e08e20de31bf17 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 17:26:47 +0100 Subject: [PATCH 52/85] Rename unhandled to openset --- src/cuter_types.erl | 35 ++++++++++++++++------------------- 1 file changed, 16 insertions(+), 19 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index fcb8de0e..4610d3b0 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1256,46 +1256,43 @@ specs_as_erl_types_fix(Kmodules, Openset) -> R. specs_as_erl_types_fix(Kmodules, RecDict, Openset, GatheredSpecs) -> - %% Pass all modules {Openset1, Change, GatheredSpecs1} = specs_as_erl_types_fix_pass(Kmodules, RecDict, Openset, false, GatheredSpecs), - case Change of %% If Unhandled has changed in this pass - %% Pass again + case Change of true -> specs_as_erl_types_fix(Kmodules, RecDict, Openset1, GatheredSpecs1); - %% Else return the gathered signatures false -> GatheredSpecs1 end. %% Pass through all modules and gather signatures -specs_as_erl_types_fix_pass([], _RecDict, Unhandled, Change, GatheredSpecs) -> {Unhandled, Change, GatheredSpecs}; -specs_as_erl_types_fix_pass([Kmodule|Kmodules], RecDict, Unhandled, Change, GatheredSpecs) -> +specs_as_erl_types_fix_pass([], _RecDict, Openset, Change, GatheredSpecs) -> {Openset, Change, GatheredSpecs}; +specs_as_erl_types_fix_pass([Kmodule|Kmodules], RecDict, Openset, Change, GatheredSpecs) -> Mod = cuter_cerl:kmodule_name(Kmodule), - PrevUnhandled = dict:fetch(Mod, Unhandled), + PrevOpenset = dict:fetch(Mod, Openset), %% Get the signatures converted and the unhandled types of this module Exported = sets:union([cuter_cerl:kmodule_exported_types(KM) || KM <- Kmodules]), - {Specs, NewUnhandled} = parse_mod_specs(Kmodule, Exported, RecDict, PrevUnhandled), + {Specs, NewOpenset} = parse_mod_specs(Kmodule, Exported, RecDict, PrevOpenset), Fn = fun ({MFA, Spec}, G) -> dict:store(MFA, Spec, G) end, %% Store the new signatures found in GatheredSpecs GatheredSpecs1 = lists:foldl(Fn, GatheredSpecs, Specs), %% If the unhandled types for this module have not changed - case are_sets_equal(NewUnhandled, PrevUnhandled) of + case are_sets_equal(NewOpenset, PrevOpenset) of %% Maintain the Change so far in the recursive call - true -> specs_as_erl_types_fix_pass(Kmodules, RecDict, Unhandled, Change, GatheredSpecs1); + true -> specs_as_erl_types_fix_pass(Kmodules, RecDict, Openset, Change, GatheredSpecs1); %% A change has occured, make the recursive call with Change: true and an updated Unhandled dict - false -> specs_as_erl_types_fix_pass(Kmodules, RecDict, dict:store(Mod, NewUnhandled, Unhandled), true, GatheredSpecs1) + false -> specs_as_erl_types_fix_pass(Kmodules, RecDict, dict:store(Mod, NewOpenset, Openset), true, GatheredSpecs1) end. %% Gather all signatures defined in a module. %% Return all signatures that can be converted to erl_types %% and all the types that couldn't -parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled) -> +parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevOpenset) -> %% Fetch type forms from the kmodule along with the lines where they were defined. %% The lines are needed for the erl_types:t_from_form/6 call TypesLines = extract_type_definitions(Kmodule), Mod = cuter_cerl:kmodule_name(Kmodule), %% Only Unhandled is returned because types will be stored in RecDict ets table - Unhandled = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled), + Openset = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevOpenset), Fn = fun ({{F, A}, S1}) -> %% For a function F with arity A and signature S1 which is a list %% Replace records with temp record types in the signature S = spec_replace_records(spec_replace_bounded(S1)), @@ -1304,7 +1301,7 @@ parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled) -> {{Mod, F, A}, ErlSpecs} end, Specs = lists:map(Fn, cuter_cerl:kmodule_spec_forms(Kmodule)), - {Specs, Unhandled}. + {Specs, Openset}. %% Convert as many types in Mod as possible to erl_types. %% For every succesful conversion add it to RecDict and finally @@ -1312,7 +1309,7 @@ parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevUnhandled) -> %% If there are more succesful conversions as before try again. %% This is done to handle types depending on later defined types %% or mutually recursive types immediately -fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled) -> +fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevOpenset) -> F = fun ({L, {Tname, T, Vars}}, Acc) -> %% Get a type and a set of unhandled types A = length(Vars), %% Try to convert the type to erl_type using erl_types:t_from_form/6 @@ -1341,15 +1338,15 @@ fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevUnhandled) -> end end, %% Apply F to all Types in the module - Unhandled = lists:foldl(F, sets:new(), TypesLines), + Openset = lists:foldl(F, sets:new(), TypesLines), %% Check if the unhandled types are different than before - case are_sets_equal(PrevUnhandled, Unhandled) of + case are_sets_equal(PrevOpenset, Openset) of %% If they are, run the module again false -> - fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, Unhandled); + fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, Openset); %% Else return the unhandled types true -> - Unhandled + Openset end. %% Convert a list of forms to a list of erl_types From 5047114c1bcdc0fa61724886e6e88485c9bb2e69 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 17:54:37 +0100 Subject: [PATCH 53/85] Remove the Change variable --- src/cuter_types.erl | 72 +++++++++++++++++++++++---------------------- 1 file changed, 37 insertions(+), 35 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 4610d3b0..fcd38c8d 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1233,75 +1233,77 @@ specs_as_erl_types(Kmodules) -> %% Initialise an openset with all the types that have not yet been converted from a form %% to its erl_types representation. Openset = initial_openset_of_types(Kmodules), - specs_as_erl_types_fix(Kmodules, Openset). + Exported = sets:union([cuter_cerl:kmodule_exported_types(KM) || KM <- Kmodules]), + specs_as_erl_types_fix(Kmodules, Exported, Openset). initial_openset_of_types(Kmodules) -> - initial_openset_of_types(Kmodules, dict:new()). + initial_openset_of_types(Kmodules, sets:new()). initial_openset_of_types([], Openset) -> Openset; initial_openset_of_types([KM|KMs], Openset) -> TypeForms = extract_type_definitions(KM), - Ts = sets:from_list([{TName, length(Vars)} || {_L, {TName, _T, Vars}} <- TypeForms]), - Openset1 = dict:store(cuter_cerl:kmodule_name(KM), Ts, Openset), - initial_openset_of_types(KMs, Openset1). + M = cuter_cerl:kmodule_name(KM), + Ts = sets:from_list([{M, TName, length(Vars)} || {_L, {TName, _T, Vars}} <- TypeForms]), + initial_openset_of_types(KMs, sets:union(Openset, Ts)). %% Converts all the function specifications of the kmodules using a fixpoint computation. %% We run consecutive passes of substitutions, until there are not changes between %% two consecutive passes. -specs_as_erl_types_fix(Kmodules, Openset) -> +specs_as_erl_types_fix(Kmodules, Exported, Openset) -> RecDict = ets:new(recdict, []), %% Needed for erl_types:t_from_form/6. - R = specs_as_erl_types_fix(Kmodules, RecDict, Openset, dict:new()), + R = specs_as_erl_types_fix(Kmodules, Exported, RecDict, Openset, dict:new()), ets:delete(RecDict), R. -specs_as_erl_types_fix(Kmodules, RecDict, Openset, GatheredSpecs) -> - {Openset1, Change, GatheredSpecs1} = specs_as_erl_types_fix_pass(Kmodules, RecDict, Openset, false, GatheredSpecs), - case Change of - true -> - specs_as_erl_types_fix(Kmodules, RecDict, Openset1, GatheredSpecs1); - false -> - GatheredSpecs1 +specs_as_erl_types_fix(Kmodules, Exported, RecDict, Openset, GatheredSpecs) -> + {Openset1, GatheredSpecs1} = specs_as_erl_types_fix_pass(Kmodules, Exported, RecDict, Openset, GatheredSpecs), + case are_sets_equal(Openset, Openset1) of + true -> GatheredSpecs1; + false -> specs_as_erl_types_fix(Kmodules, Exported, RecDict, Openset1, GatheredSpecs1) end. %% Pass through all modules and gather signatures -specs_as_erl_types_fix_pass([], _RecDict, Openset, Change, GatheredSpecs) -> {Openset, Change, GatheredSpecs}; -specs_as_erl_types_fix_pass([Kmodule|Kmodules], RecDict, Openset, Change, GatheredSpecs) -> - Mod = cuter_cerl:kmodule_name(Kmodule), - PrevOpenset = dict:fetch(Mod, Openset), +specs_as_erl_types_fix_pass([], _Exported, _RecDict, Openset, GatheredSpecs) -> + {Openset, GatheredSpecs}; +specs_as_erl_types_fix_pass([KM|KMs], Exported, RecDict, Openset, GatheredSpecs) -> + Mod = cuter_cerl:kmodule_name(KM), + ModOpenset = sets:filter(fun({M, _T, _A}) -> M =:= Mod end, Openset), %% Get the signatures converted and the unhandled types of this module - Exported = sets:union([cuter_cerl:kmodule_exported_types(KM) || KM <- Kmodules]), - {Specs, NewOpenset} = parse_mod_specs(Kmodule, Exported, RecDict, PrevOpenset), + {Specs, NewModOpenset} = parse_mod_specs(KM, Exported, RecDict, ModOpenset), Fn = fun ({MFA, Spec}, G) -> dict:store(MFA, Spec, G) end, %% Store the new signatures found in GatheredSpecs GatheredSpecs1 = lists:foldl(Fn, GatheredSpecs, Specs), %% If the unhandled types for this module have not changed - case are_sets_equal(NewOpenset, PrevOpenset) of + case are_sets_equal(NewModOpenset, ModOpenset) of %% Maintain the Change so far in the recursive call - true -> specs_as_erl_types_fix_pass(Kmodules, RecDict, Openset, Change, GatheredSpecs1); + true -> + specs_as_erl_types_fix_pass(KMs, Exported, RecDict, Openset, GatheredSpecs1); %% A change has occured, make the recursive call with Change: true and an updated Unhandled dict - false -> specs_as_erl_types_fix_pass(Kmodules, RecDict, dict:store(Mod, NewOpenset, Openset), true, GatheredSpecs1) + false -> + OtherModsOpenset = sets:subtract(Openset, ModOpenset), + specs_as_erl_types_fix_pass(KMs, Exported, RecDict, sets:union(NewModOpenset, OtherModsOpenset), GatheredSpecs1) end. %% Gather all signatures defined in a module. %% Return all signatures that can be converted to erl_types %% and all the types that couldn't -parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevOpenset) -> +parse_mod_specs(Kmodule, ExpTypes, RecDict, ModOpenSet) -> %% Fetch type forms from the kmodule along with the lines where they were defined. %% The lines are needed for the erl_types:t_from_form/6 call TypesLines = extract_type_definitions(Kmodule), Mod = cuter_cerl:kmodule_name(Kmodule), %% Only Unhandled is returned because types will be stored in RecDict ets table - Openset = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevOpenset), + NewModOpenset = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, ModOpenSet), Fn = fun ({{F, A}, S1}) -> %% For a function F with arity A and signature S1 which is a list - %% Replace records with temp record types in the signature - S = spec_replace_records(spec_replace_bounded(S1)), - %% Convert each element of the list into an erl_type - ErlSpecs = convert_list_to_erl(S, {Mod, F, A}, ExpTypes, RecDict), - {{Mod, F, A}, ErlSpecs} - end, + %% Replace records with temp record types in the signature + S = spec_replace_records(spec_replace_bounded(S1)), + %% Convert each element of the list into an erl_type + ErlSpecs = convert_list_to_erl(S, {Mod, F, A}, ExpTypes, RecDict), + {{Mod, F, A}, ErlSpecs} + end, Specs = lists:map(Fn, cuter_cerl:kmodule_spec_forms(Kmodule)), - {Specs, Openset}. + {Specs, NewModOpenset}. %% Convert as many types in Mod as possible to erl_types. %% For every succesful conversion add it to RecDict and finally @@ -1309,7 +1311,7 @@ parse_mod_specs(Kmodule, ExpTypes, RecDict, PrevOpenset) -> %% If there are more succesful conversions as before try again. %% This is done to handle types depending on later defined types %% or mutually recursive types immediately -fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevOpenset) -> +fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, ModOpenSet) -> F = fun ({L, {Tname, T, Vars}}, Acc) -> %% Get a type and a set of unhandled types A = length(Vars), %% Try to convert the type to erl_type using erl_types:t_from_form/6 @@ -1334,13 +1336,13 @@ fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, PrevOpenset) -> end; %% Else, add the type to the Unhandled set true -> - sets:add_element({Tname, A}, Acc) + sets:add_element({Mod, Tname, A}, Acc) end end, %% Apply F to all Types in the module Openset = lists:foldl(F, sets:new(), TypesLines), %% Check if the unhandled types are different than before - case are_sets_equal(PrevOpenset, Openset) of + case are_sets_equal(ModOpenSet, Openset) of %% If they are, run the module again false -> fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, Openset); From 358e0755b1e8253343ff88aa86fe8dbaa2178dd2 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 18:08:37 +0100 Subject: [PATCH 54/85] Refactor specs_as_erl_types_fix --- src/cuter_types.erl | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index fcd38c8d..5b53c1b4 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1256,35 +1256,37 @@ specs_as_erl_types_fix(Kmodules, Exported, Openset) -> ets:delete(RecDict), R. -specs_as_erl_types_fix(Kmodules, Exported, RecDict, Openset, GatheredSpecs) -> - {Openset1, GatheredSpecs1} = specs_as_erl_types_fix_pass(Kmodules, Exported, RecDict, Openset, GatheredSpecs), +specs_as_erl_types_fix(KMs, Exported, RecDict, Openset, GatheredSpecs) -> + {Openset1, GatheredSpecs1} = specs_as_erl_types_fix_pass(KMs, Exported, RecDict, Openset, GatheredSpecs), case are_sets_equal(Openset, Openset1) of true -> GatheredSpecs1; - false -> specs_as_erl_types_fix(Kmodules, Exported, RecDict, Openset1, GatheredSpecs1) + false -> specs_as_erl_types_fix(KMs, Exported, RecDict, Openset1, GatheredSpecs1) end. -%% Pass through all modules and gather signatures +%% Iterates through each kmodule and converts function specifications into their +%% erl_types representation. specs_as_erl_types_fix_pass([], _Exported, _RecDict, Openset, GatheredSpecs) -> {Openset, GatheredSpecs}; specs_as_erl_types_fix_pass([KM|KMs], Exported, RecDict, Openset, GatheredSpecs) -> Mod = cuter_cerl:kmodule_name(KM), ModOpenset = sets:filter(fun({M, _T, _A}) -> M =:= Mod end, Openset), - %% Get the signatures converted and the unhandled types of this module - {Specs, NewModOpenset} = parse_mod_specs(KM, Exported, RecDict, ModOpenset), - Fn = fun ({MFA, Spec}, G) -> dict:store(MFA, Spec, G) end, - %% Store the new signatures found in GatheredSpecs - GatheredSpecs1 = lists:foldl(Fn, GatheredSpecs, Specs), - %% If the unhandled types for this module have not changed + {ComputedSpecs, NewModOpenset} = parse_mod_specs(KM, Exported, RecDict, ModOpenset), + GatheredSpecs1 = update_gathered_specs(ComputedSpecs, GatheredSpecs), case are_sets_equal(NewModOpenset, ModOpenset) of - %% Maintain the Change so far in the recursive call + %% The openset of the module has reached a fixpoint. true -> specs_as_erl_types_fix_pass(KMs, Exported, RecDict, Openset, GatheredSpecs1); - %% A change has occured, make the recursive call with Change: true and an updated Unhandled dict + %% If the openset of the module has changed, we want to re-run the computation. false -> OtherModsOpenset = sets:subtract(Openset, ModOpenset), specs_as_erl_types_fix_pass(KMs, Exported, RecDict, sets:union(NewModOpenset, OtherModsOpenset), GatheredSpecs1) end. +update_gathered_specs([], GatheredSpecs) -> GatheredSpecs; +update_gathered_specs([{Mfa, Spec}|More], GatheredSpecs) -> + GatheredSpecs1 = dict:store(Mfa, Spec, GatheredSpecs), + update_gathered_specs(More, GatheredSpecs1). + %% Gather all signatures defined in a module. %% Return all signatures that can be converted to erl_types %% and all the types that couldn't From 10f76c0e3ce452c663c38320c47acd82b864fa42 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 18:20:43 +0100 Subject: [PATCH 55/85] Rerun the module again --- src/cuter_types.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 5b53c1b4..1b2953ad 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1279,7 +1279,7 @@ specs_as_erl_types_fix_pass([KM|KMs], Exported, RecDict, Openset, GatheredSpecs) %% If the openset of the module has changed, we want to re-run the computation. false -> OtherModsOpenset = sets:subtract(Openset, ModOpenset), - specs_as_erl_types_fix_pass(KMs, Exported, RecDict, sets:union(NewModOpenset, OtherModsOpenset), GatheredSpecs1) + specs_as_erl_types_fix_pass([KM|KMs], Exported, RecDict, sets:union(NewModOpenset, OtherModsOpenset), GatheredSpecs1) end. update_gathered_specs([], GatheredSpecs) -> GatheredSpecs; From a378ab3316e75304f6ab518a05fffd31093648a0 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 19:00:13 +0100 Subject: [PATCH 56/85] Remove the inner fixpoint --- src/cuter_types.erl | 21 ++++++--------------- 1 file changed, 6 insertions(+), 15 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 1b2953ad..6e6ea296 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1270,7 +1270,7 @@ specs_as_erl_types_fix_pass([], _Exported, _RecDict, Openset, GatheredSpecs) -> specs_as_erl_types_fix_pass([KM|KMs], Exported, RecDict, Openset, GatheredSpecs) -> Mod = cuter_cerl:kmodule_name(KM), ModOpenset = sets:filter(fun({M, _T, _A}) -> M =:= Mod end, Openset), - {ComputedSpecs, NewModOpenset} = parse_mod_specs(KM, Exported, RecDict, ModOpenset), + {ComputedSpecs, NewModOpenset} = parse_mod_specs(KM, Exported, RecDict), GatheredSpecs1 = update_gathered_specs(ComputedSpecs, GatheredSpecs), case are_sets_equal(NewModOpenset, ModOpenset) of %% The openset of the module has reached a fixpoint. @@ -1290,13 +1290,13 @@ update_gathered_specs([{Mfa, Spec}|More], GatheredSpecs) -> %% Gather all signatures defined in a module. %% Return all signatures that can be converted to erl_types %% and all the types that couldn't -parse_mod_specs(Kmodule, ExpTypes, RecDict, ModOpenSet) -> +parse_mod_specs(Kmodule, ExpTypes, RecDict) -> %% Fetch type forms from the kmodule along with the lines where they were defined. %% The lines are needed for the erl_types:t_from_form/6 call TypesLines = extract_type_definitions(Kmodule), Mod = cuter_cerl:kmodule_name(Kmodule), %% Only Unhandled is returned because types will be stored in RecDict ets table - NewModOpenset = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, ModOpenSet), + ModOpenset = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines), Fn = fun ({{F, A}, S1}) -> %% For a function F with arity A and signature S1 which is a list %% Replace records with temp record types in the signature S = spec_replace_records(spec_replace_bounded(S1)), @@ -1305,7 +1305,7 @@ parse_mod_specs(Kmodule, ExpTypes, RecDict, ModOpenSet) -> {{Mod, F, A}, ErlSpecs} end, Specs = lists:map(Fn, cuter_cerl:kmodule_spec_forms(Kmodule)), - {Specs, NewModOpenset}. + {Specs, ModOpenset}. %% Convert as many types in Mod as possible to erl_types. %% For every succesful conversion add it to RecDict and finally @@ -1313,7 +1313,7 @@ parse_mod_specs(Kmodule, ExpTypes, RecDict, ModOpenSet) -> %% If there are more succesful conversions as before try again. %% This is done to handle types depending on later defined types %% or mutually recursive types immediately -fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, ModOpenSet) -> +fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines) -> F = fun ({L, {Tname, T, Vars}}, Acc) -> %% Get a type and a set of unhandled types A = length(Vars), %% Try to convert the type to erl_type using erl_types:t_from_form/6 @@ -1342,16 +1342,7 @@ fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, ModOpenSet) -> end end, %% Apply F to all Types in the module - Openset = lists:foldl(F, sets:new(), TypesLines), - %% Check if the unhandled types are different than before - case are_sets_equal(ModOpenSet, Openset) of - %% If they are, run the module again - false -> - fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines, Openset); - %% Else return the unhandled types - true -> - Openset - end. + lists:foldl(F, sets:new(), TypesLines). %% Convert a list of forms to a list of erl_types convert_list_to_erl(S, MFA, ExpTypes, RecDict) -> From 55a136b8ea7808f52f2a08b4bb020c6005227de9 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 19:30:41 +0100 Subject: [PATCH 57/85] Fix remote types --- src/cuter_cerl.erl | 4 ++-- test/utest/src/cuter_types_tests.erl | 8 ++++++-- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/src/cuter_cerl.erl b/src/cuter_cerl.erl index d8f742ec..10953adb 100644 --- a/src/cuter_cerl.erl +++ b/src/cuter_cerl.erl @@ -320,8 +320,8 @@ extract_exports(M, AST) -> [mfa_from_var(M, E) || E <- Exports]. extract_exported_types(Mod, Attrs) -> - Filtered = [T || {#c_literal{val = export_type}, #c_literal{val = T}} <- Attrs], - sets:from_list(lists:append([{Mod, Tname, Tarity} || {Tname, Tarity} <- Filtered])). + Filtered = lists:append([Ts || {#c_literal{val = export_type}, #c_literal{val = Ts}} <- Attrs]), + sets:from_list([{Mod, Tname, Tarity} || {Tname, Tarity} <- Filtered]). -spec process_fundef({cerl:c_var(), code()}, [mfa()], module(), tag_generator()) -> {mfa(), kfun()}. process_fundef({FunVar, Def}, Exports, M, TagGen) -> diff --git a/test/utest/src/cuter_types_tests.erl b/test/utest/src/cuter_types_tests.erl index 810c2ffb..f2ad1e0b 100644 --- a/test/utest/src/cuter_types_tests.erl +++ b/test/utest/src/cuter_types_tests.erl @@ -135,11 +135,15 @@ mfas_and_specs() -> }, { {examples_for_type_analysis, is_dog, 1}, - [erl_types:t_fun([erl_types:t_any()], erl_types:t_boolean())] %% Remote types not working?? + [erl_types:t_fun( + [erl_types:t_sup(erl_types:t_atom(dog), erl_types:t_atom(cat))], + erl_types:t_boolean())] }, { {examples_for_type_analysis_pair, to_int, 1}, - [erl_types:t_fun([erl_types:t_any()], erl_types:t_integer())] %% Remote types not working?? + [erl_types:t_fun( + [erl_types:t_sup(erl_types:t_integer(), erl_types:t_atom())], + erl_types:t_integer())] } ]. From 3478003c8c1c8409f5cea6b146e63160a3e4bf55 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 20:28:50 +0100 Subject: [PATCH 58/85] Compute the specs of a module --- src/cuter_cerl.erl | 6 ++-- src/cuter_types.erl | 69 +++++++++++++++++++++++---------------------- 2 files changed, 39 insertions(+), 36 deletions(-) diff --git a/src/cuter_cerl.erl b/src/cuter_cerl.erl index 10953adb..7d50d664 100644 --- a/src/cuter_cerl.erl +++ b/src/cuter_cerl.erl @@ -70,7 +70,7 @@ -type name() :: atom(). -type fa() :: {name(), arity()}. -type cerl_attr_type() :: cerl_recdef() | cerl_typedef(). --type cerl_attr_spec() :: cerl_specdef(). +-type cerl_attr_spec() :: cerl_spec_form(). -type cerl_recdef() :: {name(), [cerl_record_field()]} % for OTP 19.x | {{'record', name()}, [cerl_record_field()], []}. % for OTP 18.x or earlier @@ -80,7 +80,7 @@ -type cerl_typed_record_field() :: {'typed_record_field', cerl_untyped_record_field(), cerl_type()}. -type cerl_typedef() :: {name(), cerl_type(), [cerl_type_var()]}. --type cerl_specdef() :: {fa(), cerl_spec()}. +-type cerl_spec_form() :: {fa(), cerl_spec()}. -type cerl_spec() :: [cerl_spec_func(), ...]. -type cerl_spec_func() :: cerl_func() | cerl_bounded_func(). @@ -273,7 +273,7 @@ is_mfa({M, F, A}) when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> true; is_mfa(_Mfa) -> false. %% Returns the unprocessed specs of a kmodule (as forms). --spec kmodule_spec_forms(kmodule()) -> [cerl:cerl()]. +-spec kmodule_spec_forms(kmodule()) -> [cerl_spec_form()]. kmodule_spec_forms(Kmodule) -> [{spec_forms, SpecsForms}] = ets:lookup(Kmodule, spec_forms), SpecsForms. diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 6e6ea296..939f1477 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1267,19 +1267,19 @@ specs_as_erl_types_fix(KMs, Exported, RecDict, Openset, GatheredSpecs) -> %% erl_types representation. specs_as_erl_types_fix_pass([], _Exported, _RecDict, Openset, GatheredSpecs) -> {Openset, GatheredSpecs}; -specs_as_erl_types_fix_pass([KM|KMs], Exported, RecDict, Openset, GatheredSpecs) -> +specs_as_erl_types_fix_pass([KM|Rest]=KMs, Exported, RecDict, Openset, GatheredSpecs) -> Mod = cuter_cerl:kmodule_name(KM), ModOpenset = sets:filter(fun({M, _T, _A}) -> M =:= Mod end, Openset), - {ComputedSpecs, NewModOpenset} = parse_mod_specs(KM, Exported, RecDict), + {NewModOpenset, ComputedSpecs} = module_specs_as_erl_types(KM, Exported, RecDict), GatheredSpecs1 = update_gathered_specs(ComputedSpecs, GatheredSpecs), case are_sets_equal(NewModOpenset, ModOpenset) of %% The openset of the module has reached a fixpoint. true -> - specs_as_erl_types_fix_pass(KMs, Exported, RecDict, Openset, GatheredSpecs1); + specs_as_erl_types_fix_pass(Rest, Exported, RecDict, Openset, GatheredSpecs1); %% If the openset of the module has changed, we want to re-run the computation. false -> OtherModsOpenset = sets:subtract(Openset, ModOpenset), - specs_as_erl_types_fix_pass([KM|KMs], Exported, RecDict, sets:union(NewModOpenset, OtherModsOpenset), GatheredSpecs1) + specs_as_erl_types_fix_pass(KMs, Exported, RecDict, sets:union(NewModOpenset, OtherModsOpenset), GatheredSpecs1) end. update_gathered_specs([], GatheredSpecs) -> GatheredSpecs; @@ -1287,25 +1287,28 @@ update_gathered_specs([{Mfa, Spec}|More], GatheredSpecs) -> GatheredSpecs1 = dict:store(Mfa, Spec, GatheredSpecs), update_gathered_specs(More, GatheredSpecs1). -%% Gather all signatures defined in a module. -%% Return all signatures that can be converted to erl_types -%% and all the types that couldn't -parse_mod_specs(Kmodule, ExpTypes, RecDict) -> - %% Fetch type forms from the kmodule along with the lines where they were defined. - %% The lines are needed for the erl_types:t_from_form/6 call - TypesLines = extract_type_definitions(Kmodule), - Mod = cuter_cerl:kmodule_name(Kmodule), - %% Only Unhandled is returned because types will be stored in RecDict ets table - ModOpenset = fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines), - Fn = fun ({{F, A}, S1}) -> %% For a function F with arity A and signature S1 which is a list - %% Replace records with temp record types in the signature - S = spec_replace_records(spec_replace_bounded(S1)), - %% Convert each element of the list into an erl_type - ErlSpecs = convert_list_to_erl(S, {Mod, F, A}, ExpTypes, RecDict), - {{Mod, F, A}, ErlSpecs} - end, - Specs = lists:map(Fn, cuter_cerl:kmodule_spec_forms(Kmodule)), - {Specs, ModOpenset}. +%% Computes the specs of a kmodule as erl_types. +%% Returns the computes specs, and the types that were not computed yet. +module_specs_as_erl_types(Kmodule, Exported, RecDict) -> + %% Run one pass that computes the types in the module. + ModOpenset = update_recdict_for_module_types(Kmodule, Exported, RecDict), + %% Compute the specs based on the potentially updated types. + SpecForms = cuter_cerl:kmodule_spec_forms(Kmodule), + Specs = [spec_form_as_erl_types(SF, Kmodule, Exported, RecDict) || SF <- SpecForms], + {ModOpenset, Specs}. + +update_recdict_for_module_types(Kmodule, Exported, RecDict) -> + TypeForms = extract_type_definitions(Kmodule), + M = cuter_cerl:kmodule_name(Kmodule), + fix_point_type_parse(M, RecDict, Exported, TypeForms). + +spec_form_as_erl_types({{F, A}, Spec}, Kmodule, Exported, RecDict) -> + %% Replace records with temp record types in the signature + Normalized = spec_replace_records(spec_replace_bounded(Spec)), + %% Convert each element of the list into an erl_type + Mfa = {cuter_cerl:kmodule_name(Kmodule), F, A}, + Converted = convert_list_to_erl(Normalized, Mfa, Exported, RecDict), + {Mfa, Converted}. %% Convert as many types in Mod as possible to erl_types. %% For every succesful conversion add it to RecDict and finally @@ -1313,12 +1316,12 @@ parse_mod_specs(Kmodule, ExpTypes, RecDict) -> %% If there are more succesful conversions as before try again. %% This is done to handle types depending on later defined types %% or mutually recursive types immediately -fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines) -> +fix_point_type_parse(Mod, RecDict, Exported, TypeForms) -> F = fun ({L, {Tname, T, Vars}}, Acc) -> %% Get a type and a set of unhandled types A = length(Vars), %% Try to convert the type to erl_type using erl_types:t_from_form/6 {{T1, _C}, D1} = - try erl_types:t_from_form(T, ExpTypes, {'type', {Mod, Tname, A}}, RecDict, erl_types:var_table__new(), erl_types:cache__new()) of + try erl_types:t_from_form(T, Exported, {'type', {Mod, Tname, A}}, RecDict, erl_types:var_table__new(), erl_types:cache__new()) of Ret -> {Ret, false} catch _:_ -> @@ -1342,25 +1345,25 @@ fix_point_type_parse(Mod, RecDict, ExpTypes, TypesLines) -> end end, %% Apply F to all Types in the module - lists:foldl(F, sets:new(), TypesLines). + lists:foldl(F, sets:new(), TypeForms). %% Convert a list of forms to a list of erl_types -convert_list_to_erl(S, MFA, ExpTypes, RecDict) -> - convert_list_to_erl(S, MFA, ExpTypes, RecDict, []). +convert_list_to_erl(S, MFA, TypeForms, RecDict) -> + convert_list_to_erl(S, MFA, TypeForms, RecDict, []). -convert_list_to_erl([], _MFA, _ExpTypes, _RecDict, Acc) -> lists:reverse(Acc); -convert_list_to_erl([Spec|Specs], MFA, ExpTypes, RecDict, Acc) -> +convert_list_to_erl([], _MFA, _TypeForms, _RecDict, Acc) -> lists:reverse(Acc); +convert_list_to_erl([Spec|Specs], MFA, TypeForms, RecDict, Acc) -> ErlSpec = - try erl_types:t_from_form(Spec, ExpTypes, {'spec', MFA}, RecDict, erl_types:var_table__new(), erl_types:cache__new()) of + try erl_types:t_from_form(Spec, TypeForms, {'spec', MFA}, RecDict, erl_types:var_table__new(), erl_types:cache__new()) of {S, _C} -> S catch _:_ -> nospec end, case ErlSpec of nospec -> - convert_list_to_erl(Specs, MFA, ExpTypes, RecDict, Acc); + convert_list_to_erl(Specs, MFA, TypeForms, RecDict, Acc); _ -> - convert_list_to_erl(Specs, MFA, ExpTypes, RecDict, [ErlSpec|Acc]) + convert_list_to_erl(Specs, MFA, TypeForms, RecDict, [ErlSpec|Acc]) end. are_sets_equal(A, B) -> From 51b2fbb8a48263a51137a2dc5391a75c7a568430 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 21:09:41 +0100 Subject: [PATCH 59/85] Refactor the update of RecDict --- src/cuter_types.erl | 69 ++++++++++++++++++++++----------------------- 1 file changed, 33 insertions(+), 36 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 939f1477..452a992a 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1277,6 +1277,8 @@ specs_as_erl_types_fix_pass([KM|Rest]=KMs, Exported, RecDict, Openset, GatheredS true -> specs_as_erl_types_fix_pass(Rest, Exported, RecDict, Openset, GatheredSpecs1); %% If the openset of the module has changed, we want to re-run the computation. + %% This can happend when a type depends on a type that is defined later in the code, + %% or for mutually recursive types. false -> OtherModsOpenset = sets:subtract(Openset, ModOpenset), specs_as_erl_types_fix_pass(KMs, Exported, RecDict, sets:union(NewModOpenset, OtherModsOpenset), GatheredSpecs1) @@ -1300,7 +1302,7 @@ module_specs_as_erl_types(Kmodule, Exported, RecDict) -> update_recdict_for_module_types(Kmodule, Exported, RecDict) -> TypeForms = extract_type_definitions(Kmodule), M = cuter_cerl:kmodule_name(Kmodule), - fix_point_type_parse(M, RecDict, Exported, TypeForms). + update_recdict_from_type_forms(M, RecDict, Exported, TypeForms). spec_form_as_erl_types({{F, A}, Spec}, Kmodule, Exported, RecDict) -> %% Replace records with temp record types in the signature @@ -1310,42 +1312,37 @@ spec_form_as_erl_types({{F, A}, Spec}, Kmodule, Exported, RecDict) -> Converted = convert_list_to_erl(Normalized, Mfa, Exported, RecDict), {Mfa, Converted}. -%% Convert as many types in Mod as possible to erl_types. -%% For every succesful conversion add it to RecDict and finally -%% return the types that couldn't be converted. -%% If there are more succesful conversions as before try again. -%% This is done to handle types depending on later defined types -%% or mutually recursive types immediately -fix_point_type_parse(Mod, RecDict, Exported, TypeForms) -> - F = fun ({L, {Tname, T, Vars}}, Acc) -> %% Get a type and a set of unhandled types - A = length(Vars), - %% Try to convert the type to erl_type using erl_types:t_from_form/6 - {{T1, _C}, D1} = - try erl_types:t_from_form(T, Exported, {'type', {Mod, Tname, A}}, RecDict, erl_types:var_table__new(), erl_types:cache__new()) of - Ret -> {Ret, false} - catch - _:_ -> - {{none, none}, true} - end, - %% Check if the conversion was successful - case D1 of - %% If it was, add the new erl_type in RecDict - false -> - case ets:lookup(RecDict, Mod) of - [{Mod, VT}] -> - ets:insert(RecDict, {Mod, maps:put({'type', Tname, A}, {{Mod, {lists:append(atom_to_list(Mod), ".erl"), L}, T, [var_name(Var) || Var <- Vars]}, T1}, VT)}), - Acc; - _ -> - ets:insert(RecDict, {Mod, maps:put({'type', Tname, A}, {{Mod, {lists:append(atom_to_list(Mod), ".erl"), L}, T, [var_name(Var) || Var <- Vars]}, T1}, maps:new())}), - Acc - end; - %% Else, add the type to the Unhandled set - true -> - sets:add_element({Mod, Tname, A}, Acc) +%% Converts as many types in M as possible to their erl_types representation. +%% Every succesful conversion is added to RecDict. +%% We return the types that could not be converted, i.e. the openset. +update_recdict_from_type_forms(M, RecDict, Exported, TypeForms) -> + Fn = fun ({L, {TName, T, TVars}}, Acc) -> + A = length(TVars), + Mta = {M, TName, A}, + Vs = [var_name(Var) || Var <- TVars], + case try_convert_type_to_erl_types(Mta, T, Exported, RecDict) of + error -> sets:add_element(Mta, Acc); + {ok, T1} -> + VT = + case ets:lookup(RecDict, M) of + [{M, OVT}] -> OVT; + [] -> maps:new() + end, + NVT = maps:put({'type', TName, A}, {{M, {atom_to_list(M) ++ ".erl", L}, T, Vs}, T1}, VT), + ets:insert(RecDict, {M, NVT}), + Acc end - end, - %% Apply F to all Types in the module - lists:foldl(F, sets:new(), TypeForms). + end, + lists:foldl(Fn, sets:new(), TypeForms). + +try_convert_type_to_erl_types(Mta, T, Exported, RecDict) -> + VT = erl_types:var_table__new(), + Cache = erl_types:cache__new(), + try erl_types:t_from_form(T, Exported, {'type', Mta}, RecDict, VT, Cache) of + {T1, _C} -> {ok, T1} + catch + _:_ -> error + end. %% Convert a list of forms to a list of erl_types convert_list_to_erl(S, MFA, TypeForms, RecDict) -> From 728884d59dff53e628526b55feea535c5a2c0ff2 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 21:18:38 +0100 Subject: [PATCH 60/85] Add an example with a bounded fun --- src/cuter_types.erl | 5 +++-- test/utest/src/cuter_types_tests.erl | 6 ++++++ test/utest/src/examples_for_type_analysis_pair.erl | 5 ++++- 3 files changed, 13 insertions(+), 3 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 452a992a..a62ab160 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1414,8 +1414,9 @@ generate_type_form_for_record_form({Line, {Name, Fields}}) -> type_name_for_record(RecordName) -> list_to_atom(?CUTER_RECORD_TYPE_PREFIX ++ atom_to_list(RecordName)). -%% Replace all bounded signatures with equivalent normal ones -spec_replace_bounded(Specs) -> lists:map(fun handle_bounded_fun/1, Specs). +%% Replaces all the specs that are expressed as bounded functions, to their equivalent +%% unbounded ones. +spec_replace_bounded(Spec) -> [handle_bounded_fun(S) || S <- Spec]. %% If a the signature is not bounded, return it intact handle_bounded_fun({type, _L, 'fun', _Rest} = S) -> S; diff --git a/test/utest/src/cuter_types_tests.erl b/test/utest/src/cuter_types_tests.erl index f2ad1e0b..683c5033 100644 --- a/test/utest/src/cuter_types_tests.erl +++ b/test/utest/src/cuter_types_tests.erl @@ -144,6 +144,12 @@ mfas_and_specs() -> [erl_types:t_fun( [erl_types:t_sup(erl_types:t_integer(), erl_types:t_atom())], erl_types:t_integer())] + }, + { + {examples_for_type_analysis_pair, can_bark, 1}, + [erl_types:t_fun( + [erl_types:t_sup(erl_types:t_atom(dog), erl_types:t_atom(cat))], + erl_types:t_boolean())] } ]. diff --git a/test/utest/src/examples_for_type_analysis_pair.erl b/test/utest/src/examples_for_type_analysis_pair.erl index 6f27c3c5..36a6f42b 100644 --- a/test/utest/src/examples_for_type_analysis_pair.erl +++ b/test/utest/src/examples_for_type_analysis_pair.erl @@ -1,6 +1,6 @@ -module(examples_for_type_analysis_pair). --export([to_int/1]). +-export([to_int/1, can_bark/1]). -export_type([t_dog_or_cat/0]). @@ -9,3 +9,6 @@ -spec to_int(examples_for_type_analysis:t_int_or_atom()) -> integer(). to_int(X) when is_integer(X) -> X; to_int(X) when is_atom(X) -> lists:max(atom_to_list(X)). + +-spec can_bark(Animal) -> boolean() when Animal :: t_dog_or_cat(). +can_bark(Animal) -> Animal =:= dog. From 035bc06dff666b77db09bfb265ca4f9c29f74851 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 23:15:00 +0100 Subject: [PATCH 61/85] Refactor removal of bounded funs --- src/cuter_types.erl | 135 +++++++----------- test/utest/src/cuter_types_tests.erl | 10 +- .../src/examples_for_type_analysis_pair.erl | 32 ++++- 3 files changed, 93 insertions(+), 84 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index a62ab160..a8820d2f 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1306,7 +1306,7 @@ update_recdict_for_module_types(Kmodule, Exported, RecDict) -> spec_form_as_erl_types({{F, A}, Spec}, Kmodule, Exported, RecDict) -> %% Replace records with temp record types in the signature - Normalized = spec_replace_records(spec_replace_bounded(Spec)), + Normalized = spec_replace_records(transform_bounded_funs_in_spec(Spec)), %% Convert each element of the list into an erl_type Mfa = {cuter_cerl:kmodule_name(Kmodule), F, A}, Converted = convert_list_to_erl(Normalized, Mfa, Exported, RecDict), @@ -1414,89 +1414,64 @@ generate_type_form_for_record_form({Line, {Name, Fields}}) -> type_name_for_record(RecordName) -> list_to_atom(?CUTER_RECORD_TYPE_PREFIX ++ atom_to_list(RecordName)). -%% Replaces all the specs that are expressed as bounded functions, to their equivalent -%% unbounded ones. -spec_replace_bounded(Spec) -> [handle_bounded_fun(S) || S <- Spec]. - -%% If a the signature is not bounded, return it intact -handle_bounded_fun({type, _L, 'fun', _Rest} = S) -> S; -%% If it is bounded, replace all variables with type forms -handle_bounded_fun({type, _, 'bounded_fun', [Spec, Constraints]} = S) -> - Fn = fun({type, _, constraint, [{atom, _, is_subtype}, [Key, Value]]}, D) -> - dict:store(element(3, Key), Value, D) - end, - %% Find the forms of the variables used in the constraints - D = lists:foldl(Fn, dict:new(), Constraints), - {D1, Rec} = fix_update_vars(D), - case Rec of %% If the conversion succeeds - %% Return an equivalent Spec without constraints - true -> - make_normal_spec(Spec, D1); - %% Else return S as is - false -> - S +%% Transforms the spec and replaces all the clauses that are expressed as bounded +%% functions, to their equivalent unbounded ones. +transform_bounded_funs_in_spec(Spec) -> + [transform_bounded_fun(C) || C <- Spec]. + +transform_bounded_fun({type, _L, 'fun', _Sig} = FC) -> FC; +transform_bounded_fun({type, _L, 'bounded_fun', [Func, Constraints]} = FC) -> + Ms = dict:from_list([extract_var_type_from_constraint(C) || C <- Constraints]), + case simplify_var_mappings(Ms) of + error -> FC; + {ok, NMs} -> generate_nonbounded_fun(Func, NMs) end. -%% Replace variables in a bounded fun with their produced type forms -replace_vars({type, L, record, R}, _D) -> {{type, L, record, R}, false}; -replace_vars({T, L, Type, Args}, D) when is_list(Args) -> - Fn = fun(Arg) -> replace_vars(Arg, D) end, - {NewArgs, Changes} = lists:unzip(lists:map(Fn, Args)), - Change = lists:foldl(fun erlang:'or'/2, false, Changes), - {{T, L, Type, NewArgs}, Change}; -replace_vars({var, _L, Name}, D) -> - case dict:find(Name, D) of - {ok, T} -> - {T, true}; - error -> - {any, true} - end; -replace_vars({ann_type, _L, [_T, T1]}, D) -> - {T2, _C} = replace_vars(T1, D), - {T2, true}; -replace_vars(Rest, _D) -> {Rest, false}. - -%% Find the types of constraint variables for non recursive declarations. -%% Return a dictionary with the variables as keys and their type forms as values -fix_update_vars(D) -> - %% If no recursive variables exist, the computation will end in steps at most equal to the - %% count of the variables - fix_update_vars(D, dict:size(D) + 1, 0). - -fix_update_vars(D, Lim, Depth) -> - Keys = dict:fetch_keys(D), - Fn = fun(Key, {Acc1, Acc2}) -> +extract_var_type_from_constraint({type, _, constraint, [{atom, _, is_subtype}, [{var, _, V}, T]]}) -> + {V, T}. + +%% Simplifies the types of constraint variables. +%% The input is a dictionary of variables mapped to their types. +%% Note that it supports only non-recursive declarations. +simplify_var_mappings(Ms) -> + %% If there are no recursive variables, the computation will end in + %% steps at most equal to the number of variables. + simplify_var_mappings_pass(Ms, dict:size(Ms), 0). + +simplify_var_mappings_pass(_Ms, Lim, N) when N > Lim -> error; +simplify_var_mappings_pass(Ms, Lim, N) -> + Vars = dict:fetch_keys(Ms), + Fn = fun(Key, D) -> T = dict:fetch(Key, D), - {NewT, C} = replace_vars(T, D), - case C of - true -> - {dict:store(Key, NewT, Acc1), true}; - false -> - {Acc1, Acc2} + case substitute_vars_in_type(T, Ms) of + T -> D; + NewT -> dict:store(Key, NewT, D) end - end, - %% Replace variables in all type forms - {NewD, Change} = lists:foldl(Fn, {D, false}, Keys), - %% If something changed - case Change of - true -> - %% If we have reached the limit - case Depth > Lim of - %% The transformation failed - true -> - {rec, false}; - %% Else call self - false -> - fix_update_vars(NewD, Lim, Depth + 1) - end; - %% Else return the dictionary of the variables - false -> - {NewD, true} + end, + NMs = lists:foldl(Fn, Ms, Vars), + case are_dicts_equal_on_keys(Vars, Ms, NMs) of + true -> {ok, NMs}; + false -> simplify_var_mappings_pass(NMs, Lim, N + 1) end. -%% Create a non bounded fun from a bounded fun given the type forms of the variables -%% in the bounded fun -make_normal_spec({type, L, 'fun', [Args, Range]}, D) -> - {NewArgs, _C1} = replace_vars(Args, D), - {NewRange, _C2} = replace_vars(Range, D), +%% Replace variables in a bounded fun with their produced type forms +substitute_vars_in_type({type, _, record, _R} = T, _Ms) -> T; +substitute_vars_in_type({_, _, _, Args}=T, Ms) when is_list(Args) -> + NewArgs = [substitute_vars_in_type(A, Ms) || A <- Args], + setelement(4, T, NewArgs); +substitute_vars_in_type({var, _, Var}, Ms) -> + dict:fetch(Var, Ms); +substitute_vars_in_type({ann_type, _, [_Var, T]}, Ms) -> + substitute_vars_in_type(T, Ms); +substitute_vars_in_type(T, _Ms) -> T. + +are_dicts_equal_on_keys([], _D1, _D2) -> true; +are_dicts_equal_on_keys([K|Ks], D1, D2) -> + dict:fetch(K, D1) =:= dict:fetch(K, D2) andalso are_dicts_equal_on_keys(Ks, D1, D2). + +%% Generates a non bounded fun from a bounded fun given the type substitutions for +%% constraints on the variables. +generate_nonbounded_fun({type, L, 'fun', [Args, Range]}, Ms) -> + NewArgs = substitute_vars_in_type(Args, Ms), + NewRange = substitute_vars_in_type(Range, Ms), {type, L, 'fun', [NewArgs, NewRange]}. diff --git a/test/utest/src/cuter_types_tests.erl b/test/utest/src/cuter_types_tests.erl index 683c5033..84ce96a8 100644 --- a/test/utest/src/cuter_types_tests.erl +++ b/test/utest/src/cuter_types_tests.erl @@ -148,8 +148,16 @@ mfas_and_specs() -> { {examples_for_type_analysis_pair, can_bark, 1}, [erl_types:t_fun( - [erl_types:t_sup(erl_types:t_atom(dog), erl_types:t_atom(cat))], + [erl_types:t_list(erl_types:t_sup(erl_types:t_atom(dog), erl_types:t_atom(cat)))], erl_types:t_boolean())] + }, + { + {examples_for_type_analysis_pair, count_trees, 1}, + [] %% We do not support mutually recursive declarations in bounded funs. + }, + { + {examples_for_type_analysis_pair, tree_height, 1}, + [] %% We do not support recursive declarations in bounded funs. } ]. diff --git a/test/utest/src/examples_for_type_analysis_pair.erl b/test/utest/src/examples_for_type_analysis_pair.erl index 36a6f42b..97a4209a 100644 --- a/test/utest/src/examples_for_type_analysis_pair.erl +++ b/test/utest/src/examples_for_type_analysis_pair.erl @@ -1,6 +1,6 @@ -module(examples_for_type_analysis_pair). --export([to_int/1, can_bark/1]). +-export([to_int/1, can_bark/1, count_trees/1, tree_height/1]). -export_type([t_dog_or_cat/0]). @@ -10,5 +10,31 @@ to_int(X) when is_integer(X) -> X; to_int(X) when is_atom(X) -> lists:max(atom_to_list(X)). --spec can_bark(Animal) -> boolean() when Animal :: t_dog_or_cat(). -can_bark(Animal) -> Animal =:= dog. +-spec can_bark(Animals) -> boolean() when + Animals :: [Animal], + Animal :: t_dog_or_cat(). +can_bark(Animals) -> lists:any(fun (A) -> A =:= dog end, Animals). + +-spec count_trees(Forest) -> integer() when + Forest :: {Tree, Forest} | nil, + Tree :: {atom(), Forest} | empty. +count_trees(F) -> + count_trees([F], 0). + +count_trees([], N) -> N; +count_trees([nil|Forests], N) -> + count_trees(Forests, N); +count_trees([{empty, Forest}|Forests], N) -> + count_trees([Forest|Forests], N + 1); +count_trees([{{_Name, InnerForest}, Forest}|Forests], N) -> + count_trees([InnerForest, Forest|Forests], N + 1). + +-spec tree_height(Tree) -> integer() when + Tree :: Node | Leaf, + Node :: {Tree, Tree}, + Leaf :: nil. +tree_height(nil) -> 0; +tree_height({Left, Right}) -> + H1 = tree_height(Left), + H2 = tree_height(Right), + 1 + max(H1, H2). From 82f881013a566250bb4ae73a969adeadd08ed779 Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 23:23:50 +0100 Subject: [PATCH 62/85] Refactor record substitution in specs. --- src/cuter_types.erl | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index a8820d2f..10c3eb39 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1306,7 +1306,7 @@ update_recdict_for_module_types(Kmodule, Exported, RecDict) -> spec_form_as_erl_types({{F, A}, Spec}, Kmodule, Exported, RecDict) -> %% Replace records with temp record types in the signature - Normalized = spec_replace_records(transform_bounded_funs_in_spec(Spec)), + Normalized = replace_records_in_spec(transform_bounded_funs_in_spec(Spec)), %% Convert each element of the list into an erl_type Mfa = {cuter_cerl:kmodule_name(Kmodule), F, A}, Converted = convert_list_to_erl(Normalized, Mfa, Exported, RecDict), @@ -1382,12 +1382,15 @@ extract_type_definitions(Kmodule) -> replace_record_references_in_type_form({Line, {Name, Type, Args}}) -> {Line, {Name, replace_record_references(Type), Args}}. -%% Replace all record references with their respective temporary type in a spec form list -spec_replace_records(FunSpecs) -> - Fn = fun({type, Line, F, L}) -> - {type, Line, F, lists:map(fun replace_record_references/1, L)} - end, - lists:map(Fn, FunSpecs). +%% Replaces all the record within specs, with the respective generated types. +replace_records_in_spec(Spec) -> + replace_records_in_spec(Spec, []). + +replace_records_in_spec([], Clauses) -> + lists:reverse(Clauses); +replace_records_in_spec([{type, _, _, Ts}=Cl|Cls], Clauses) -> + NTs = [replace_record_references(T) || T <- Ts], + replace_records_in_spec(Cls, [setelement(4, Cl, NTs)|Clauses]). %% Replace all record references with their respective temporary type in a form %% Replaces all the references to records inside a type form. From e04b2ed0f43fc25bc56d3424637c00c47355fc4f Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 23:31:03 +0100 Subject: [PATCH 63/85] Update comments --- src/cuter_types.erl | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 10c3eb39..af0fb59e 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1217,20 +1217,15 @@ get_type_from_type_dep({_Name, Type}) -> Type. %% ---------------------------------------------------------------------------- -%% API for erl_types:erl_type(). -%% Here a fix point computation is defined which converts all specs in a list -%% of modules to their erl_type representation +%% Compute the erl_types:erl_type() representation of type specifications. %% ---------------------------------------------------------------------------- -define(CUTER_RECORD_TYPE_PREFIX, "__cuter_record_type__"). -var_name({var, _, X}) -> - X. - -%% Find the erl type representation of all signatures in a list of kmodules --spec specs_as_erl_types([cuter_cerl:kmodule()]) -> dict:dict(). +%% Returns the specs of the given kmodules in their erl_types representation. +-spec specs_as_erl_types([cuter_cerl:kmodule()]) -> dict:dict(mfa(), [erl_types:erl_type()]). specs_as_erl_types(Kmodules) -> - %% Initialise an openset with all the types that have not yet been converted from a form + %% Initialize an openset with all the types that have not yet been converted from a form %% to its erl_types representation. Openset = initial_openset_of_types(Kmodules), Exported = sets:union([cuter_cerl:kmodule_exported_types(KM) || KM <- Kmodules]), @@ -1319,7 +1314,7 @@ update_recdict_from_type_forms(M, RecDict, Exported, TypeForms) -> Fn = fun ({L, {TName, T, TVars}}, Acc) -> A = length(TVars), Mta = {M, TName, A}, - Vs = [var_name(Var) || Var <- TVars], + Vs = [V || {var, _, V} <- TVars], case try_convert_type_to_erl_types(Mta, T, Exported, RecDict) of error -> sets:add_element(Mta, Acc); {ok, T1} -> From 7e398243e98eb3224a9cd5964628f2729e19214d Mon Sep 17 00:00:00 2001 From: Aggelos Giantsios Date: Sat, 12 Feb 2022 23:39:30 +0100 Subject: [PATCH 64/85] Refactor function clause conversion to erl_types --- src/cuter_types.erl | 47 ++++++++++++++++++++------------------------- 1 file changed, 21 insertions(+), 26 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index af0fb59e..a684189d 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1272,7 +1272,7 @@ specs_as_erl_types_fix_pass([KM|Rest]=KMs, Exported, RecDict, Openset, GatheredS true -> specs_as_erl_types_fix_pass(Rest, Exported, RecDict, Openset, GatheredSpecs1); %% If the openset of the module has changed, we want to re-run the computation. - %% This can happend when a type depends on a type that is defined later in the code, + %% This can happen when a type depends on a type that is defined later in the code, %% or for mutually recursive types. false -> OtherModsOpenset = sets:subtract(Openset, ModOpenset), @@ -1300,11 +1300,9 @@ update_recdict_for_module_types(Kmodule, Exported, RecDict) -> update_recdict_from_type_forms(M, RecDict, Exported, TypeForms). spec_form_as_erl_types({{F, A}, Spec}, Kmodule, Exported, RecDict) -> - %% Replace records with temp record types in the signature - Normalized = replace_records_in_spec(transform_bounded_funs_in_spec(Spec)), - %% Convert each element of the list into an erl_type + NormalizedSpec = replace_records_in_spec(transform_bounded_funs_in_spec(Spec)), Mfa = {cuter_cerl:kmodule_name(Kmodule), F, A}, - Converted = convert_list_to_erl(Normalized, Mfa, Exported, RecDict), + Converted = normalized_spec_form_as_erl_types(NormalizedSpec, Mfa, Exported, RecDict), {Mfa, Converted}. %% Converts as many types in M as possible to their erl_types representation. @@ -1339,23 +1337,20 @@ try_convert_type_to_erl_types(Mta, T, Exported, RecDict) -> _:_ -> error end. -%% Convert a list of forms to a list of erl_types -convert_list_to_erl(S, MFA, TypeForms, RecDict) -> - convert_list_to_erl(S, MFA, TypeForms, RecDict, []). - -convert_list_to_erl([], _MFA, _TypeForms, _RecDict, Acc) -> lists:reverse(Acc); -convert_list_to_erl([Spec|Specs], MFA, TypeForms, RecDict, Acc) -> - ErlSpec = - try erl_types:t_from_form(Spec, TypeForms, {'spec', MFA}, RecDict, erl_types:var_table__new(), erl_types:cache__new()) of - {S, _C} -> S - catch - _:_ -> nospec - end, - case ErlSpec of - nospec -> - convert_list_to_erl(Specs, MFA, TypeForms, RecDict, Acc); - _ -> - convert_list_to_erl(Specs, MFA, TypeForms, RecDict, [ErlSpec|Acc]) +%% Converts a spec without bounded funs and record to its erl_types representation. +normalized_spec_form_as_erl_types(Spec, Mfa, TypeForms, RecDict) -> + normalized_spec_form_as_erl_types(Spec, Mfa, TypeForms, RecDict, []). + +normalized_spec_form_as_erl_types([], _Mfa, _TypeForms, _RecDict, Acc) -> lists:reverse(Acc); +normalized_spec_form_as_erl_types([FC|FCs], Mfa, TypeForms, RecDict, Acc) -> + VT = erl_types:var_table__new(), + Cache = erl_types:cache__new(), + try erl_types:t_from_form(FC, TypeForms, {'spec', Mfa}, RecDict, VT, Cache) of + {S, _C} -> + normalized_spec_form_as_erl_types(FCs, Mfa, TypeForms, RecDict, [S|Acc]) + catch + _:_ -> + normalized_spec_form_as_erl_types(FCs, Mfa, TypeForms, RecDict, Acc) end. are_sets_equal(A, B) -> @@ -1381,11 +1376,11 @@ replace_record_references_in_type_form({Line, {Name, Type, Args}}) -> replace_records_in_spec(Spec) -> replace_records_in_spec(Spec, []). -replace_records_in_spec([], Clauses) -> - lists:reverse(Clauses); -replace_records_in_spec([{type, _, _, Ts}=Cl|Cls], Clauses) -> +replace_records_in_spec([], FClauses) -> + lists:reverse(FClauses); +replace_records_in_spec([{type, _, _, Ts}=FC|FCs], FClauses) -> NTs = [replace_record_references(T) || T <- Ts], - replace_records_in_spec(Cls, [setelement(4, Cl, NTs)|Clauses]). + replace_records_in_spec(FCs, [setelement(4, FC, NTs)|FClauses]). %% Replace all record references with their respective temporary type in a form %% Replaces all the references to records inside a type form. From b637f9c94233dfeda1fa2024da59ddb8b99677d5 Mon Sep 17 00:00:00 2001 From: Dspil Date: Mon, 14 Feb 2022 16:13:45 +0200 Subject: [PATCH 65/85] Filtered variable renamed to ExpTypes --- src/cuter_cerl.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cuter_cerl.erl b/src/cuter_cerl.erl index 7d50d664..55929ee7 100644 --- a/src/cuter_cerl.erl +++ b/src/cuter_cerl.erl @@ -320,8 +320,8 @@ extract_exports(M, AST) -> [mfa_from_var(M, E) || E <- Exports]. extract_exported_types(Mod, Attrs) -> - Filtered = lists:append([Ts || {#c_literal{val = export_type}, #c_literal{val = Ts}} <- Attrs]), - sets:from_list([{Mod, Tname, Tarity} || {Tname, Tarity} <- Filtered]). + ExpTypes = lists:append([Ts || {#c_literal{val = export_type}, #c_literal{val = Ts}} <- Attrs]), + sets:from_list([{Mod, Tname, Tarity} || {Tname, Tarity} <- ExpTypes]). -spec process_fundef({cerl:c_var(), code()}, [mfa()], module(), tag_generator()) -> {mfa(), kfun()}. process_fundef({FunVar, Def}, Exports, M, TagGen) -> From 5baca75b16d6c09fd3ecfd7892ba336e4a93ca1f Mon Sep 17 00:00:00 2001 From: Dspil Date: Mon, 14 Feb 2022 16:16:36 +0200 Subject: [PATCH 66/85] better use of erl_types api in cuter_types_test --- test/utest/src/cuter_types_tests.erl | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/test/utest/src/cuter_types_tests.erl b/test/utest/src/cuter_types_tests.erl index 84ce96a8..611b2c41 100644 --- a/test/utest/src/cuter_types_tests.erl +++ b/test/utest/src/cuter_types_tests.erl @@ -117,10 +117,10 @@ mfas_and_specs() -> { {examples_for_type_analysis, translate, 3}, [erl_types:t_fun( - [erl_types:t_tuple([erl_types:t_from_term(point), erl_types:t_number(), erl_types:t_number()]), + [erl_types:t_tuple([erl_types:t_atom(point), erl_types:t_number(), erl_types:t_number()]), erl_types:t_number(), erl_types:t_number()], - erl_types:t_tuple([erl_types:t_from_term(point), erl_types:t_number(), erl_types:t_number()]))] + erl_types:t_tuple([erl_types:t_atom(point), erl_types:t_number(), erl_types:t_number()]))] }, { {examples_for_type_analysis, root, 1}, @@ -130,13 +130,13 @@ mfas_and_specs() -> {examples_for_type_analysis, max_x, 1}, [erl_types:t_fun( [erl_types:t_list( - erl_types:t_tuple([erl_types:t_from_term(point), erl_types:t_number(), erl_types:t_number()]))], + erl_types:t_tuple([erl_types:t_atom(point), erl_types:t_number(), erl_types:t_number()]))], erl_types:t_number())] }, { {examples_for_type_analysis, is_dog, 1}, [erl_types:t_fun( - [erl_types:t_sup(erl_types:t_atom(dog), erl_types:t_atom(cat))], + [erl_types:t_atoms([dog, cat])], erl_types:t_boolean())] }, { @@ -148,7 +148,7 @@ mfas_and_specs() -> { {examples_for_type_analysis_pair, can_bark, 1}, [erl_types:t_fun( - [erl_types:t_list(erl_types:t_sup(erl_types:t_atom(dog), erl_types:t_atom(cat)))], + [erl_types:t_list(erl_types:t_atoms([dog, cat]))], erl_types:t_boolean())] }, { From 9818b2e1bc517d51807a24decb268088cc5f22ac Mon Sep 17 00:00:00 2001 From: Dspil Date: Mon, 14 Feb 2022 16:34:25 +0200 Subject: [PATCH 67/85] Renamed examples_for_type_analysis* to examples_for_spec_conversion* --- Makefile.in | 4 +-- src/cuter_types.erl | 32 +++++++++---------- test/utest/src/cuter_types_tests.erl | 24 +++++++------- ...s.erl => examples_for_spec_conversion.erl} | 4 +-- ... => examples_for_spec_conversion_pair.erl} | 4 +-- 5 files changed, 34 insertions(+), 34 deletions(-) rename test/utest/src/{examples_for_type_analysis.erl => examples_for_spec_conversion.erl} (88%) rename test/utest/src/{examples_for_type_analysis_pair.erl => examples_for_spec_conversion_pair.erl} (90%) diff --git a/Makefile.in b/Makefile.in index 514f9d90..51defb3b 100644 --- a/Makefile.in +++ b/Makefile.in @@ -101,8 +101,8 @@ UTEST_MODULES = \ types_and_specs2 \ cuter_metrics_tests \ cuter_config_tests \ - examples_for_type_analysis \ - examples_for_type_analysis_pair + examples_for_spec_conversion \ + examples_for_spec_conversion_pair FTEST_MODULES = \ bitstr \ diff --git a/src/cuter_types.erl b/src/cuter_types.erl index a684189d..ce3f3f47 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1310,22 +1310,22 @@ spec_form_as_erl_types({{F, A}, Spec}, Kmodule, Exported, RecDict) -> %% We return the types that could not be converted, i.e. the openset. update_recdict_from_type_forms(M, RecDict, Exported, TypeForms) -> Fn = fun ({L, {TName, T, TVars}}, Acc) -> - A = length(TVars), - Mta = {M, TName, A}, - Vs = [V || {var, _, V} <- TVars], - case try_convert_type_to_erl_types(Mta, T, Exported, RecDict) of - error -> sets:add_element(Mta, Acc); - {ok, T1} -> - VT = - case ets:lookup(RecDict, M) of - [{M, OVT}] -> OVT; - [] -> maps:new() - end, - NVT = maps:put({'type', TName, A}, {{M, {atom_to_list(M) ++ ".erl", L}, T, Vs}, T1}, VT), - ets:insert(RecDict, {M, NVT}), - Acc - end - end, + A = length(TVars), + Mta = {M, TName, A}, + Vs = [V || {var, _, V} <- TVars], + case try_convert_type_to_erl_types(Mta, T, Exported, RecDict) of + error -> sets:add_element(Mta, Acc); + {ok, T1} -> + VT = + case ets:lookup(RecDict, M) of + [{M, OVT}] -> OVT; + [] -> maps:new() + end, + NVT = maps:put({'type', TName, A}, {{M, {atom_to_list(M) ++ ".erl", L}, T, Vs}, T1}, VT), + ets:insert(RecDict, {M, NVT}), + Acc + end + end, lists:foldl(Fn, sets:new(), TypeForms). try_convert_type_to_erl_types(Mta, T, Exported, RecDict) -> diff --git a/test/utest/src/cuter_types_tests.erl b/test/utest/src/cuter_types_tests.erl index 611b2c41..d11ed3cc 100644 --- a/test/utest/src/cuter_types_tests.erl +++ b/test/utest/src/cuter_types_tests.erl @@ -84,7 +84,7 @@ cleanup(_) -> ok. -spec convert_types_test() -> any(). convert_types_test() -> - Modules = [examples_for_type_analysis, examples_for_type_analysis_pair], + Modules = [examples_for_spec_conversion, examples_for_spec_conversion_pair], Fn = fun(M) -> {ok, AST} = cuter_cerl:get_core(M, false), AST @@ -103,19 +103,19 @@ convert_types_test() -> mfas_and_specs() -> [ { - {examples_for_type_analysis, id, 1}, + {examples_for_spec_conversion, id, 1}, [erl_types:t_fun([erl_types:t_any()], erl_types:t_any())] }, { - {examples_for_type_analysis, inc, 1}, + {examples_for_spec_conversion, inc, 1}, [erl_types:t_fun([erl_types:t_integer()], erl_types:t_integer())] }, { - {examples_for_type_analysis, to_atom, 1}, + {examples_for_spec_conversion, to_atom, 1}, [erl_types:t_fun([erl_types:t_sup(erl_types:t_integer(), erl_types:t_atom())], erl_types:t_atom())] }, { - {examples_for_type_analysis, translate, 3}, + {examples_for_spec_conversion, translate, 3}, [erl_types:t_fun( [erl_types:t_tuple([erl_types:t_atom(point), erl_types:t_number(), erl_types:t_number()]), erl_types:t_number(), @@ -123,40 +123,40 @@ mfas_and_specs() -> erl_types:t_tuple([erl_types:t_atom(point), erl_types:t_number(), erl_types:t_number()]))] }, { - {examples_for_type_analysis, root, 1}, + {examples_for_spec_conversion, root, 1}, [] %% We do not support recursive types. }, { - {examples_for_type_analysis, max_x, 1}, + {examples_for_spec_conversion, max_x, 1}, [erl_types:t_fun( [erl_types:t_list( erl_types:t_tuple([erl_types:t_atom(point), erl_types:t_number(), erl_types:t_number()]))], erl_types:t_number())] }, { - {examples_for_type_analysis, is_dog, 1}, + {examples_for_spec_conversion, is_dog, 1}, [erl_types:t_fun( [erl_types:t_atoms([dog, cat])], erl_types:t_boolean())] }, { - {examples_for_type_analysis_pair, to_int, 1}, + {examples_for_spec_conversion_pair, to_int, 1}, [erl_types:t_fun( [erl_types:t_sup(erl_types:t_integer(), erl_types:t_atom())], erl_types:t_integer())] }, { - {examples_for_type_analysis_pair, can_bark, 1}, + {examples_for_spec_conversion_pair, can_bark, 1}, [erl_types:t_fun( [erl_types:t_list(erl_types:t_atoms([dog, cat]))], erl_types:t_boolean())] }, { - {examples_for_type_analysis_pair, count_trees, 1}, + {examples_for_spec_conversion_pair, count_trees, 1}, [] %% We do not support mutually recursive declarations in bounded funs. }, { - {examples_for_type_analysis_pair, tree_height, 1}, + {examples_for_spec_conversion_pair, tree_height, 1}, [] %% We do not support recursive declarations in bounded funs. } ]. diff --git a/test/utest/src/examples_for_type_analysis.erl b/test/utest/src/examples_for_spec_conversion.erl similarity index 88% rename from test/utest/src/examples_for_type_analysis.erl rename to test/utest/src/examples_for_spec_conversion.erl index 0ae9cdf5..62c0b1ad 100644 --- a/test/utest/src/examples_for_type_analysis.erl +++ b/test/utest/src/examples_for_spec_conversion.erl @@ -1,4 +1,4 @@ --module(examples_for_type_analysis). +-module(examples_for_spec_conversion). -export([id/1, inc/1, to_atom/1, translate/3, root/1, max_x/1, is_dog/1]). @@ -35,5 +35,5 @@ root(nil) -> nil. -spec max_x(list_of(#point{})) -> number(). max_x(Ps) -> lists:max([P#point.x || P <- Ps]). --spec is_dog(examples_for_type_analysis_pair:t_dog_or_cat()) -> boolean(). +-spec is_dog(examples_for_spec_conversion_pair:t_dog_or_cat()) -> boolean(). is_dog(X) -> X =:= dog. diff --git a/test/utest/src/examples_for_type_analysis_pair.erl b/test/utest/src/examples_for_spec_conversion_pair.erl similarity index 90% rename from test/utest/src/examples_for_type_analysis_pair.erl rename to test/utest/src/examples_for_spec_conversion_pair.erl index 97a4209a..31c739dc 100644 --- a/test/utest/src/examples_for_type_analysis_pair.erl +++ b/test/utest/src/examples_for_spec_conversion_pair.erl @@ -1,4 +1,4 @@ --module(examples_for_type_analysis_pair). +-module(examples_for_spec_conversion_pair). -export([to_int/1, can_bark/1, count_trees/1, tree_height/1]). @@ -6,7 +6,7 @@ -type t_dog_or_cat() :: dog | cat. --spec to_int(examples_for_type_analysis:t_int_or_atom()) -> integer(). +-spec to_int(examples_for_spec_conversion:t_int_or_atom()) -> integer(). to_int(X) when is_integer(X) -> X; to_int(X) when is_atom(X) -> lists:max(atom_to_list(X)). From d19d0fa196d85e0e0539388c2150f64fe3a8c89b Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Tue, 15 Feb 2022 09:57:17 +0100 Subject: [PATCH 68/85] Cleanup tests and simplify assertions --- test/utest/src/cuter_tests_lib.erl | 10 +- test/utest/src/cuter_types_tests.erl | 97 +++++++++---------- .../src/examples_for_spec_conversion.erl | 7 +- .../src/examples_for_spec_conversion_pair.erl | 6 +- 4 files changed, 53 insertions(+), 67 deletions(-) diff --git a/test/utest/src/cuter_tests_lib.erl b/test/utest/src/cuter_tests_lib.erl index 0c4427d9..7e663570 100644 --- a/test/utest/src/cuter_tests_lib.erl +++ b/test/utest/src/cuter_tests_lib.erl @@ -5,7 +5,7 @@ -include("include/eunit_config.hrl"). -export([setup_dir/0, get_python_command/0, get_module_attrs/2, sample_trace_file/1]). --export([mfa_to_list/1, mfa_to_list/3]). +-export([mfa_to_string/1]). %% Create a directory for temporary use -spec setup_dir() -> file:filename_all(). @@ -48,10 +48,6 @@ sample_trace_file(Fname) -> cuter_log:close_file(Fd). %% Returns the string representation of an MFA. --spec mfa_to_list(mfa()) -> string(). -mfa_to_list({M, F, A}) -> mfa_to_list(M, F, A). - -%% Returns the string representation of an MFA. --spec mfa_to_list(module(), atom(), byte()) -> string(). -mfa_to_list(M, F, A) -> +-spec mfa_to_string(mfa()) -> string(). +mfa_to_string({M, F, A}) -> atom_to_list(M) ++ ":" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A). diff --git a/test/utest/src/cuter_types_tests.erl b/test/utest/src/cuter_types_tests.erl index d11ed3cc..a60c921b 100644 --- a/test/utest/src/cuter_types_tests.erl +++ b/test/utest/src/cuter_types_tests.erl @@ -21,54 +21,52 @@ parse_types({types_and_specs, Attrs}) -> Ts = [ {"t1()" , {type, t1, 0} - , { cuter_types:t_atom() - , [] - } + , {cuter_types:t_atom(), []} }, {"t2()" , {type, t2, 0} - , { cuter_types:t_tuple([cuter_types:t_integer(), cuter_types:t_float(), cuter_types:t_tuple()]) + , {cuter_types:t_tuple([cuter_types:t_integer(), cuter_types:t_float(), cuter_types:t_tuple()]) , [] } }, {"t3()" , {type, t3, 0} - , { cuter_types:t_union([cuter_types:t_any(), cuter_types:t_nil()]) + , {cuter_types:t_union([cuter_types:t_any(), cuter_types:t_nil()]) , [] } }, {"t4()" , {type, t4, 0} - , { cuter_types:t_list(cuter_types:t_union([cuter_types:t_list(), cuter_types:t_bitstring()])) + , {cuter_types:t_list(cuter_types:t_union([cuter_types:t_list(), cuter_types:t_bitstring()])) , [] } }, {"t5()" , {type, t5, 0} - , { cuter_types:t_tuple([ - cuter_types:t_binary(), cuter_types:t_nonempty_list(cuter_types:t_number()), - cuter_types:t_string(), cuter_types:t_char() - ]) + , {cuter_types:t_tuple([ + cuter_types:t_binary(), cuter_types:t_nonempty_list(cuter_types:t_number()), + cuter_types:t_string(), cuter_types:t_char() + ]) , [] } }, {"t7()" , {type, t7, 0} - , { cuter_types:t_union([ - cuter_types:t_bitstring(64, 0), cuter_types:t_bitstring(0, 3), cuter_types:t_bitstring(128, 12) + , {cuter_types:t_union([ + cuter_types:t_bitstring(64, 0), cuter_types:t_bitstring(0, 3), cuter_types:t_bitstring(128, 12) ]) , [] } }, {"t8()" , {type, t8, 0} - , { cuter_types:t_map(), [] } + , {cuter_types:t_map(), []} }, {"t9()" , {type, t9, 0} - , { cuter_types:t_map([ - { map_field_assoc, cuter_types:t_atom(), cuter_types:t_list(cuter_types:t_integer()) }, - { map_field_exact, cuter_types:t_float(), cuter_types:t_float() } + , {cuter_types:t_map([ + {map_field_assoc, cuter_types:t_atom(), cuter_types:t_list(cuter_types:t_integer())}, + {map_field_exact, cuter_types:t_float(), cuter_types:t_float()} ]) , [] } @@ -82,25 +80,35 @@ setup(Mod) -> cleanup(_) -> ok. --spec convert_types_test() -> any(). +-spec convert_types_test() -> 'ok'. convert_types_test() -> Modules = [examples_for_spec_conversion, examples_for_spec_conversion_pair], - Fn = fun(M) -> - {ok, AST} = cuter_cerl:get_core(M, false), - AST - end, + Fn = fun(M) -> {ok, AST} = cuter_cerl:get_core(M, false), AST end, Xs = [{M, Fn(M)} || M <- Modules], TagGen = fun() -> ok end, Kmodules = [cuter_cerl:kmodule(M, AST, TagGen) || {M, AST} <- Xs], Specs = cuter_types:specs_as_erl_types(Kmodules), - Expect = mfas_and_specs(), - As = lists:flatten([spec_assertions(E, Specs) || E <- Expect]), + Expect = spec_conversion_tests(), + lists:foreach(fun (E) -> spec_assertions(E, Specs) end, Expect), ExpectMfas = lists:sort([Mfa || {Mfa, _Spec} <- Expect]), GotMfas = lists:sort(dict:fetch_keys(Specs)), - [?assertEqual(ExpectMfas, GotMfas)] ++ As. + ?assertEqual(ExpectMfas, GotMfas), + ok. +spec_assertions({Mfa, Expect}, R) -> + case dict:find(Mfa, R) of + error -> + Comment = cuter_tests_lib:mfa_to_string(Mfa) ++ " should exist", + ?assert(dict:is_key(Mfa, R), Comment); + {ok, Got} -> + Comment = "Spec of " ++ cuter_tests_lib:mfa_to_string(Mfa), + ?assertEqual(Expect, Got, Comment) + end. -mfas_and_specs() -> +spec_conversion_tests() -> + T_Animal = erl_types:t_atoms([cat, dog]), + T_Point = erl_types:t_tuple([erl_types:t_atom(point), + erl_types:t_number(), erl_types:t_number()]), [ { {examples_for_spec_conversion, id, 1}, @@ -112,32 +120,27 @@ mfas_and_specs() -> }, { {examples_for_spec_conversion, to_atom, 1}, - [erl_types:t_fun([erl_types:t_sup(erl_types:t_integer(), erl_types:t_atom())], erl_types:t_atom())] + [erl_types:t_fun( + [erl_types:t_sup(erl_types:t_integer(), erl_types:t_atom())], + erl_types:t_atom())] }, { {examples_for_spec_conversion, translate, 3}, [erl_types:t_fun( - [erl_types:t_tuple([erl_types:t_atom(point), erl_types:t_number(), erl_types:t_number()]), - erl_types:t_number(), - erl_types:t_number()], - erl_types:t_tuple([erl_types:t_atom(point), erl_types:t_number(), erl_types:t_number()]))] + [T_Point, erl_types:t_number(), erl_types:t_number()], + T_Point)] }, { {examples_for_spec_conversion, root, 1}, - [] %% We do not support recursive types. + [] %% FIX: We do not support recursive types. }, { {examples_for_spec_conversion, max_x, 1}, - [erl_types:t_fun( - [erl_types:t_list( - erl_types:t_tuple([erl_types:t_atom(point), erl_types:t_number(), erl_types:t_number()]))], - erl_types:t_number())] + [erl_types:t_fun([erl_types:t_list(T_Point)], erl_types:t_number())] }, { {examples_for_spec_conversion, is_dog, 1}, - [erl_types:t_fun( - [erl_types:t_atoms([dog, cat])], - erl_types:t_boolean())] + [erl_types:t_fun([T_Animal], erl_types:t_boolean())] }, { {examples_for_spec_conversion_pair, to_int, 1}, @@ -147,26 +150,14 @@ mfas_and_specs() -> }, { {examples_for_spec_conversion_pair, can_bark, 1}, - [erl_types:t_fun( - [erl_types:t_list(erl_types:t_atoms([dog, cat]))], - erl_types:t_boolean())] + [erl_types:t_fun([erl_types:t_list(T_Animal)], erl_types:t_boolean())] }, { {examples_for_spec_conversion_pair, count_trees, 1}, - [] %% We do not support mutually recursive declarations in bounded funs. + [] %% FIX: We do not support mutually recursive declarations in bounded funs. }, { {examples_for_spec_conversion_pair, tree_height, 1}, - [] %% We do not support recursive declarations in bounded funs. + [] %% FIX: We do not support recursive declarations in bounded funs. } ]. - -spec_assertions({Mfa, Expect}, R) -> - CommentExists = cuter_tests_lib:mfa_to_list(Mfa) ++ " should exist", - As = [?assert(dict:is_key(Mfa, R), CommentExists)], - case dict:find(Mfa, R) of - error -> As; - {ok, Got} -> - Comment = "Spec of " ++ cuter_tests_lib:mfa_to_list(Mfa), - As ++ [?assertEqual(Expect, Got, Comment)] - end. diff --git a/test/utest/src/examples_for_spec_conversion.erl b/test/utest/src/examples_for_spec_conversion.erl index 62c0b1ad..02a2a6f4 100644 --- a/test/utest/src/examples_for_spec_conversion.erl +++ b/test/utest/src/examples_for_spec_conversion.erl @@ -8,14 +8,13 @@ -type t_int() :: integer(). -record(point, {x :: number(), y :: number()}). +-type point() :: #point{}. -type tree() :: {integer(), tree(), tree()} | nil. -type list_of(X) :: [X]. --type point() :: #point{}. - --spec id(any()) -> any(). +-spec id(X) -> X when X :: term(). id(X) -> X. -spec inc(t_int()) -> t_int(). @@ -35,5 +34,5 @@ root(nil) -> nil. -spec max_x(list_of(#point{})) -> number(). max_x(Ps) -> lists:max([P#point.x || P <- Ps]). --spec is_dog(examples_for_spec_conversion_pair:t_dog_or_cat()) -> boolean(). +-spec is_dog(examples_for_spec_conversion_pair:t_animal()) -> boolean(). is_dog(X) -> X =:= dog. diff --git a/test/utest/src/examples_for_spec_conversion_pair.erl b/test/utest/src/examples_for_spec_conversion_pair.erl index 31c739dc..80e22037 100644 --- a/test/utest/src/examples_for_spec_conversion_pair.erl +++ b/test/utest/src/examples_for_spec_conversion_pair.erl @@ -2,9 +2,9 @@ -export([to_int/1, can_bark/1, count_trees/1, tree_height/1]). --export_type([t_dog_or_cat/0]). +-export_type([t_animal/0]). --type t_dog_or_cat() :: dog | cat. +-type t_animal() :: dog | cat. -spec to_int(examples_for_spec_conversion:t_int_or_atom()) -> integer(). to_int(X) when is_integer(X) -> X; @@ -12,7 +12,7 @@ to_int(X) when is_atom(X) -> lists:max(atom_to_list(X)). -spec can_bark(Animals) -> boolean() when Animals :: [Animal], - Animal :: t_dog_or_cat(). + Animal :: t_animal(). can_bark(Animals) -> lists:any(fun (A) -> A =:= dog end, Animals). -spec count_trees(Forest) -> integer() when From 03cbaf26c0eb6304b2b6d6c85487beaa84909d0d Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Tue, 15 Feb 2022 15:43:35 +0100 Subject: [PATCH 69/85] Avoid multiple type names for the same type --- src/cuter_cerl.erl | 8 ++------ src/cuter_types.erl | 4 ++-- 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/src/cuter_cerl.erl b/src/cuter_cerl.erl index 55929ee7..d908b6d1 100644 --- a/src/cuter_cerl.erl +++ b/src/cuter_cerl.erl @@ -25,13 +25,12 @@ -include("include/cuter_macros.hrl"). --export_type([compile_error/0, cerl_attr_spec/0, cerl_attr_type/0, +-export_type([compile_error/0, cerl_spec_form/0, cerl_attr_type/0, cerl_bounded_func/0, cerl_constraint/0, cerl_func/0, cerl_recdef/0, cerl_record_field/0, cerl_spec/0, cerl_spec_func/0, cerl_type/0, cerl_typedef/0, cerl_type_record_field/0, node_types/0, - tagID/0, tag/0, tag_generator/0, visited_tags/0, - spec_info/0]). + tagID/0, tag/0, tag_generator/0, visited_tags/0]). -export_type([extracted_record_form/0, extracted_type_form/0]). @@ -70,7 +69,6 @@ -type name() :: atom(). -type fa() :: {name(), arity()}. -type cerl_attr_type() :: cerl_recdef() | cerl_typedef(). --type cerl_attr_spec() :: cerl_spec_form(). -type cerl_recdef() :: {name(), [cerl_record_field()]} % for OTP 19.x | {{'record', name()}, [cerl_record_field()], []}. % for OTP 18.x or earlier @@ -375,8 +373,6 @@ get_abstract_code(Mod, Beam) -> _ -> throw(cuter_pp:abstract_code_missing(Mod)) end. --type spec_info() :: cerl_attr_spec(). - %% Extracts the record definitions (as forms) from the annotations of a module. %% The relevant annotations have the following structure in OTP 19.x and newer: %% {#c_atom{val=record}, #c_literal{val=[{Name, Fields}]}} diff --git a/src/cuter_types.erl b/src/cuter_types.erl index ce3f3f47..0cb555bf 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -739,11 +739,11 @@ unify_deps(Types) -> %% define an intermediate representation solely for specs. %% ============================================================================ --spec retrieve_specs([cuter_cerl:spec_info()]) -> stored_specs(). +-spec retrieve_specs([cuter_cerl:cerl_spec_form()]) -> stored_specs(). retrieve_specs(SpecAttrs) -> lists:foldl(fun process_spec_attr/2, dict:new(), SpecAttrs). --spec process_spec_attr(cuter_cerl:spec_info(), stored_specs()) -> stored_specs(). +-spec process_spec_attr(cuter_cerl:cerl_spec_form(), stored_specs()) -> stored_specs(). process_spec_attr({FA, Specs}, Processed) -> Xs = [t_spec_from_form(Spec) || Spec <- Specs], dict:store(FA, Xs, Processed). From 6926f9b9f285a8536d4e0b2888dd1bef26e29da1 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Tue, 15 Feb 2022 15:59:52 +0100 Subject: [PATCH 70/85] Avoid unnecessary type export and simplification --- src/cuter_cerl.erl | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/cuter_cerl.erl b/src/cuter_cerl.erl index d908b6d1..a84ad6bd 100644 --- a/src/cuter_cerl.erl +++ b/src/cuter_cerl.erl @@ -27,7 +27,7 @@ -export_type([compile_error/0, cerl_spec_form/0, cerl_attr_type/0, cerl_bounded_func/0, cerl_constraint/0, cerl_func/0, - cerl_recdef/0, cerl_record_field/0, cerl_spec/0, + cerl_record_field/0, cerl_spec/0, cerl_spec_func/0, cerl_type/0, cerl_typedef/0, cerl_type_record_field/0, node_types/0, tagID/0, tag/0, tag_generator/0, visited_tags/0]). @@ -70,8 +70,7 @@ -type fa() :: {name(), arity()}. -type cerl_attr_type() :: cerl_recdef() | cerl_typedef(). --type cerl_recdef() :: {name(), [cerl_record_field()]} % for OTP 19.x - | {{'record', name()}, [cerl_record_field()], []}. % for OTP 18.x or earlier +-type cerl_recdef() :: {name(), [cerl_record_field()]}. -type cerl_record_field() :: cerl_untyped_record_field() | cerl_typed_record_field(). -type cerl_untyped_record_field() :: {'record_field', lineno(), {'atom', lineno(), name()}} | {'record_field', lineno(), {'atom', lineno(), name()}, any()}. From 48c19af9687dc3b691f4242b35947fbd118210e8 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Tue, 15 Feb 2022 16:38:28 +0100 Subject: [PATCH 71/85] Cleanup and simplify cuter_debug --- src/cuter_debug.erl | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/src/cuter_debug.erl b/src/cuter_debug.erl index ce71d9da..3e2d3810 100644 --- a/src/cuter_debug.erl +++ b/src/cuter_debug.erl @@ -4,29 +4,24 @@ -export([parse_module/2, to_erl_types_specs/1]). -%% This modules contains convenience MFAs for debugging purposes during the +%% This module contains utilities for debugging purposes during the %% development of the tool. %% Prints the AST of a module. -spec parse_module(module(), boolean()) -> ok. parse_module(M, WithPmatch) -> - case cuter_cerl:get_core(M, WithPmatch) of + case cuter_cerl:get_core(M, WithPmatch) of {error, E} -> io:format("ERROR: ~p~n", [E]); {ok, AST} -> io:format("~p~n", [AST]) end. -%% Returns the specs of a list of modules as erl_types representation. +%% Prints the erl_types representation of all specs in a list of modules. -spec to_erl_types_specs([module()]) -> ok. to_erl_types_specs(Modules) -> - Fn = fun(M) -> - {ok, AST} = cuter_cerl:get_core(M, false), - AST - end, - Xs = [{M, Fn(M)} || M <- Modules], - TagGen = fun() -> ok end, - Kmodules = [cuter_cerl:kmodule(M, AST, TagGen) || {M, AST} <- Xs], + Fn = fun(M) -> {ok, AST} = cuter_cerl:get_core(M, false), AST end, + Kmodules = [cuter_cerl:kmodule(M, Fn(M), fun () -> ok end) || M <- Modules], Specs = cuter_types:specs_as_erl_types(Kmodules), lists:foreach(fun print_mfa_and_spec/1, dict:to_list(Specs)). From 1f8b33bdf6c9e49e99401c84b957a5466c692044 Mon Sep 17 00:00:00 2001 From: Dspil Date: Tue, 15 Feb 2022 18:57:31 +0200 Subject: [PATCH 72/85] report specs that couldn't be converted to an erl_type --- src/cuter_types.erl | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 0cb555bf..381e4e1c 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1222,6 +1222,9 @@ get_type_from_type_dep({_Name, Type}) -> -define(CUTER_RECORD_TYPE_PREFIX, "__cuter_record_type__"). +mfa_to_string({M, F, A}) -> + atom_to_list(M) ++ ":" ++ atom_to_list(F) ++ integer_to_list(A). + %% Returns the specs of the given kmodules in their erl_types representation. -spec specs_as_erl_types([cuter_cerl:kmodule()]) -> dict:dict(mfa(), [erl_types:erl_type()]). specs_as_erl_types(Kmodules) -> @@ -1229,7 +1232,23 @@ specs_as_erl_types(Kmodules) -> %% to its erl_types representation. Openset = initial_openset_of_types(Kmodules), Exported = sets:union([cuter_cerl:kmodule_exported_types(KM) || KM <- Kmodules]), - specs_as_erl_types_fix(Kmodules, Exported, Openset). + Specs = specs_as_erl_types_fix(Kmodules, Exported, Openset), + %% Gather all specs available in the modules. + AllFunSpecs = lists:append([[{{cuter_cerl:kmodule_name(Kmodule), F, A}, S} || {{F, A}, S} <- cuter_cerl:kmodule_spec_forms(Kmodule)] || Kmodule <- Kmodules]), + ReportUnhandled = fun({MFA, Form}) -> + case dict:find(MFA, Specs) of + {ok, ErlType} -> + case length(ErlType) =:= length(Form) of + false -> + report_unhandled_spec("Couldn't convert signature of function: ~p~n", [mfa_to_string(MFA)]); + true -> + ok + end + end + end, + %% Report which specs couldn't be succesfully converted to an erl_type. + lists:foreach(ReportUnhandled, AllFunSpecs), + Specs. initial_openset_of_types(Kmodules) -> initial_openset_of_types(Kmodules, sets:new()). @@ -1468,3 +1487,6 @@ generate_nonbounded_fun({type, L, 'fun', [Args, Range]}, Ms) -> NewArgs = substitute_vars_in_type(Args, Ms), NewRange = substitute_vars_in_type(Range, Ms), {type, L, 'fun', [NewArgs, NewRange]}. + +report_unhandled_spec(F, Args) -> + io:format(standard_error, F, Args). From 0d4de217bedc5275f0619966f9c57942d33db97c Mon Sep 17 00:00:00 2001 From: Dspil Date: Tue, 15 Feb 2022 19:16:30 +0200 Subject: [PATCH 73/85] removed unnecessary function mfa_to_string from cuter_types.erl --- src/cuter_types.erl | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 381e4e1c..68e15274 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1222,9 +1222,6 @@ get_type_from_type_dep({_Name, Type}) -> -define(CUTER_RECORD_TYPE_PREFIX, "__cuter_record_type__"). -mfa_to_string({M, F, A}) -> - atom_to_list(M) ++ ":" ++ atom_to_list(F) ++ integer_to_list(A). - %% Returns the specs of the given kmodules in their erl_types representation. -spec specs_as_erl_types([cuter_cerl:kmodule()]) -> dict:dict(mfa(), [erl_types:erl_type()]). specs_as_erl_types(Kmodules) -> @@ -1240,7 +1237,7 @@ specs_as_erl_types(Kmodules) -> {ok, ErlType} -> case length(ErlType) =:= length(Form) of false -> - report_unhandled_spec("Couldn't convert signature of function: ~p~n", [mfa_to_string(MFA)]); + report_unhandled_spec("Couldn't convert signature of function: ~p~n", [cuter_tests_lib:mfa_to_string(MFA)]); true -> ok end From 6eff159ca653cfba75c1ee318737ec9b98f9eb29 Mon Sep 17 00:00:00 2001 From: Dspil Date: Tue, 15 Feb 2022 19:31:26 +0200 Subject: [PATCH 74/85] moved mfa_to_string/1 from cuter_tests_lib.erl to cuter_types.erl --- src/cuter_types.erl | 14 +++++++++++++- test/utest/src/cuter_cerl_tests.erl | 5 +---- test/utest/src/cuter_tests_lib.erl | 6 ------ test/utest/src/cuter_types_tests.erl | 4 ++-- 4 files changed, 16 insertions(+), 13 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 68e15274..ba11bd21 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -25,6 +25,8 @@ -export([specs_as_erl_types/1]). +-export([mfa_to_string/1]). + -export_type([erl_type/0, erl_spec_clause/0, erl_spec/0, stored_specs/0, stored_types/0, stored_spec_value/0, t_range_limit/0]). -export_type([erl_type_dep/0, erl_type_deps/0]). @@ -206,6 +208,16 @@ -type erl_spec_clause() :: t_function_det(). -type erl_spec() :: {[erl_spec_clause()], erl_type_deps()}. +%% ============================================================================ +%% Utilities +%% ============================================================================ + +%% Returns the string representation of an MFA. +-spec mfa_to_string(mfa()) -> string(). +mfa_to_string({M, F, A}) -> + atom_to_list(M) ++ ":" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A). + + %% ============================================================================ %% Pre-process the type & record declarations and generate their intermediate %% representation from abstract forms. @@ -1237,7 +1249,7 @@ specs_as_erl_types(Kmodules) -> {ok, ErlType} -> case length(ErlType) =:= length(Form) of false -> - report_unhandled_spec("Couldn't convert signature of function: ~p~n", [cuter_tests_lib:mfa_to_string(MFA)]); + report_unhandled_spec("Couldn't convert signature of function: ~p~n", [mfa_to_string(MFA)]); true -> ok end diff --git a/test/utest/src/cuter_cerl_tests.erl b/test/utest/src/cuter_cerl_tests.erl index 8ebcd600..e346e7e1 100644 --- a/test/utest/src/cuter_cerl_tests.erl +++ b/test/utest/src/cuter_cerl_tests.erl @@ -20,13 +20,10 @@ exported_mfas_in_lists_module_test_() -> TagGen = fun() -> {?BRANCH_TAG_PREFIX, 42} end, {ok, Klists} = cuter_cerl:load(lists, TagGen, false), MfaKfuns = kfuns_from_exports(lists, Klists), - Assertions = [{mfa_to_string(Mfa), assert_is_exported(Kfun)} || {Mfa, Kfun} <- MfaKfuns], + Assertions = [{cuter_types:mfa_to_string(Mfa), assert_is_exported(Kfun)} || {Mfa, Kfun} <- MfaKfuns], R = cuter_cerl:destroy_kmodule(Klists), Assertions ++ [?_assertEqual(ok, R)]. -mfa_to_string({M, F, A}) -> - atom_to_list(M) ++ ":" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A). - kfuns_from_exports(M, Kmodule) -> Mfas = [{M, F, A} || {F, A} <- M:module_info(exports)], Fn = fun(Mfa) -> diff --git a/test/utest/src/cuter_tests_lib.erl b/test/utest/src/cuter_tests_lib.erl index 7e663570..da52a95a 100644 --- a/test/utest/src/cuter_tests_lib.erl +++ b/test/utest/src/cuter_tests_lib.erl @@ -5,7 +5,6 @@ -include("include/eunit_config.hrl"). -export([setup_dir/0, get_python_command/0, get_module_attrs/2, sample_trace_file/1]). --export([mfa_to_string/1]). %% Create a directory for temporary use -spec setup_dir() -> file:filename_all(). @@ -46,8 +45,3 @@ sample_trace_file(Fname) -> cuter_log:log_equal(Fd, false, X, 45, cuter_cerl:empty_tag()), %% Close the logfile cuter_log:close_file(Fd). - -%% Returns the string representation of an MFA. --spec mfa_to_string(mfa()) -> string(). -mfa_to_string({M, F, A}) -> - atom_to_list(M) ++ ":" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A). diff --git a/test/utest/src/cuter_types_tests.erl b/test/utest/src/cuter_types_tests.erl index a60c921b..f6f2806b 100644 --- a/test/utest/src/cuter_types_tests.erl +++ b/test/utest/src/cuter_types_tests.erl @@ -98,10 +98,10 @@ convert_types_test() -> spec_assertions({Mfa, Expect}, R) -> case dict:find(Mfa, R) of error -> - Comment = cuter_tests_lib:mfa_to_string(Mfa) ++ " should exist", + Comment = cuter_types:mfa_to_string(Mfa) ++ " should exist", ?assert(dict:is_key(Mfa, R), Comment); {ok, Got} -> - Comment = "Spec of " ++ cuter_tests_lib:mfa_to_string(Mfa), + Comment = "Spec of " ++ cuter_types:mfa_to_string(Mfa), ?assertEqual(Expect, Got, Comment) end. From e95f6b147f1bcb96f57a71d36367b542992989f9 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Wed, 16 Feb 2022 11:34:41 +0100 Subject: [PATCH 75/85] Code cleanups (and better warning slogan) --- src/cuter.erl | 3 +- src/cuter_codeserver.erl | 14 +++--- src/cuter_types.erl | 96 ++++++++++++++++++++-------------------- 3 files changed, 56 insertions(+), 57 deletions(-) diff --git a/src/cuter.erl b/src/cuter.erl index 62bdc126..34a47f07 100644 --- a/src/cuter.erl +++ b/src/cuter.erl @@ -128,7 +128,6 @@ compute_callgraph(State) -> Mfas = mfas_from_state(State), cuter_codeserver:calculate_callgraph(State#st.codeServer, Mfas). - mfas_from_state(State) -> [{M, F, length(As)} || {M, F, As, _} <- State#st.seeds]. @@ -251,7 +250,7 @@ state_from_options_and_seeds(Options, Seeds) -> ok = cuter_pp:start(), CodeServer = cuter_codeserver:start(), SchedPid = cuter_scheduler:start(?DEFAULT_DEPTH, CodeServer), - #st{ codeServer = CodeServer, scheduler = SchedPid, seeds = Seeds }. + #st{codeServer = CodeServer, scheduler = SchedPid, seeds = Seeds}. define_metrics() -> define_distribution_metrics(). diff --git a/src/cuter_codeserver.erl b/src/cuter_codeserver.erl index d4962a51..2c28e30a 100644 --- a/src/cuter_codeserver.erl +++ b/src/cuter_codeserver.erl @@ -27,7 +27,7 @@ -define(BRANCH_COUNTER_PREFIX, '__branch_count'). -type counter() :: non_neg_integer(). --type cached_module_data() :: any(). +-type cached_module_data() :: any(). % XXX: refine -type cached_modules() :: dict:dict(module(), cached_module_data()). -type cache() :: ets:tid(). @@ -46,12 +46,12 @@ }). -type logs() :: #logs{}. -%% Internal type declarations +%% Internal type declarations. -type load_reply() :: {ok, cuter_cerl:kmodule()} | cuter_cerl:compile_error() | {error, (preloaded | cover_compiled | non_existing)}. -type spec_reply() :: {ok, cuter_types:erl_spec()} | error. -type from() :: {pid(), reference()}. -%% Finding the remote dependencies of a spec. +%% Remote dependencies of a spec. -type remote_type() :: {cuter:mod(), atom(), byte()}. -type module_deps() :: ordsets:ordset(cuter:mod()). -type visited_remotes() :: ordsets:ordset(remote_type()). @@ -59,7 +59,7 @@ -type codeserver() :: pid(). -type codeserver_args() :: #{}. -%% Server's state +%% Server's state. -record(st, { %% Acts as a reference table for looking up the ETS table that holds a module's extracted code. %% It stores tuples {Module :: module(), ModuleDb :: ets:tid()}. @@ -254,10 +254,10 @@ handle_cast({visit_tag, Tag}, State=#st{tags = Tags}) -> -spec load_all_deps_of_spec(cuter_types:stored_spec_value(), module(), cuter_cerl:kmodule(), state()) -> [cuter:mod()]. load_all_deps_of_spec(CerlSpec, Module, Kmodule, State) -> LocalTypesCache = cuter_cerl:kmodule_types(Kmodule), - % Get the remote dependencies of the spec. + %% Get the remote dependencies of the spec. ToBeVisited = cuter_types:find_remote_deps_of_spec(CerlSpec, LocalTypesCache), InitDepMods = ordsets:add_element(Module, ordsets:new()), - % Find iteratively the dependencies of the found dependencies. + %% Find iteratively the dependencies of the found dependencies. case load_all_deps(ToBeVisited, State, ordsets:new(), InitDepMods) of error -> []; {ok, DepMods} -> DepMods @@ -285,7 +285,7 @@ load_all_deps([Remote={M, TypeName, Arity}|Rest], State, VisitedRemotes, DepMods Deps = cuter_types:find_remote_deps_of_type(Type, LocalTypesCache), %% Queue the ones that we haven't encountered yet. NewRemotes = [R || R <- Deps, - not ordsets:is_element(R, VisitedRemotes1)], + not ordsets:is_element(R, VisitedRemotes1)], load_all_deps(NewRemotes ++ Rest, State, VisitedRemotes1, DepMods1) end; _Msg -> diff --git a/src/cuter_types.erl b/src/cuter_types.erl index ba11bd21..95f8fcb0 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -8,7 +8,7 @@ -export([params_of_t_function_det/1, ret_of_t_function/1, atom_of_t_atom_lit/1, integer_of_t_integer_lit/1, elements_type_of_t_list/1, elements_type_of_t_nonempty_list/1, elements_types_of_t_tuple/1, - assocs_of_t_map/1, elements_types_of_t_union/1, bounds_of_t_range/1, + assocs_of_t_map/1, elements_types_of_t_union/1, bounds_of_t_range/1, segment_size_of_bitstring/1, is_generic_function/1, name_of_t_userdef/1]). @@ -208,16 +208,6 @@ -type erl_spec_clause() :: t_function_det(). -type erl_spec() :: {[erl_spec_clause()], erl_type_deps()}. -%% ============================================================================ -%% Utilities -%% ============================================================================ - -%% Returns the string representation of an MFA. --spec mfa_to_string(mfa()) -> string(). -mfa_to_string({M, F, A}) -> - atom_to_list(M) ++ ":" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A). - - %% ============================================================================ %% Pre-process the type & record declarations and generate their intermediate %% representation from abstract forms. @@ -1005,7 +995,7 @@ simplify_constraints(Constraints, CurrModule, Env, Visited, Conf) -> end, lists:foldl(F, Env, Constraints). --spec simplify(raw_type(), atom(), type_var_env(), ordsets:ordset(stored_spec_key()), parse_conf()) -> raw_type(). +-spec simplify(raw_type(), module(), type_var_env(), ordsets:ordset(stored_spec_key()), parse_conf()) -> raw_type(). %% fun simplify(#t{kind = ?function_tag, rep = {Params, Ret, Constraints}}=Raw, CurrModule, Env, Visited, Conf) -> Env1 = simplify_constraints(Constraints, CurrModule, Env, Visited, Conf), @@ -1129,8 +1119,8 @@ lookup_in_env(Key, Env) -> end. %% ============================================================================ -%% Traverse a pre-processed spec or type and find its remote dependencies, aka -%% the remote types that it contains. +%% Traverses a pre-processed spec or type and finds its remote dependencies, +%% i.e., the remote types that it contains. %% ============================================================================ %% Finds the remote dependencies of a spec. @@ -1146,7 +1136,7 @@ find_remote_deps_of_type(Type, LocalTypesCache) -> ordsets:to_list(Deps). %% ---------------------------------------------------------------------------- -%% Traverse a type and collect its remote dependencies. +%% Traverses a type and collects its remote dependencies. %% Performing case analysis on the type of the type node. %% ---------------------------------------------------------------------------- @@ -1237,24 +1227,23 @@ get_type_from_type_dep({_Name, Type}) -> %% Returns the specs of the given kmodules in their erl_types representation. -spec specs_as_erl_types([cuter_cerl:kmodule()]) -> dict:dict(mfa(), [erl_types:erl_type()]). specs_as_erl_types(Kmodules) -> - %% Initialize an openset with all the types that have not yet been converted from a form - %% to its erl_types representation. + %% Initialize an openset with all the types that have not yet been + %% converted from a form to its erl_types representation. Openset = initial_openset_of_types(Kmodules), Exported = sets:union([cuter_cerl:kmodule_exported_types(KM) || KM <- Kmodules]), Specs = specs_as_erl_types_fix(Kmodules, Exported, Openset), %% Gather all specs available in the modules. AllFunSpecs = lists:append([[{{cuter_cerl:kmodule_name(Kmodule), F, A}, S} || {{F, A}, S} <- cuter_cerl:kmodule_spec_forms(Kmodule)] || Kmodule <- Kmodules]), - ReportUnhandled = fun({MFA, Form}) -> - case dict:find(MFA, Specs) of - {ok, ErlType} -> - case length(ErlType) =:= length(Form) of - false -> - report_unhandled_spec("Couldn't convert signature of function: ~p~n", [mfa_to_string(MFA)]); - true -> - ok - end - end - end, + ReportUnhandled = + fun({MFA, Form}) -> + case dict:find(MFA, Specs) of + {ok, ErlType} -> + case length(ErlType) =:= length(Form) of + false -> warn_unhandled_spec(MFA); + true -> ok + end + end + end, %% Report which specs couldn't be succesfully converted to an erl_type. lists:foreach(ReportUnhandled, AllFunSpecs), Specs. @@ -1270,9 +1259,7 @@ initial_openset_of_types([KM|KMs], Openset) -> Ts = sets:from_list([{M, TName, length(Vars)} || {_L, {TName, _T, Vars}} <- TypeForms]), initial_openset_of_types(KMs, sets:union(Openset, Ts)). -%% Converts all the function specifications of the kmodules using a fixpoint computation. -%% We run consecutive passes of substitutions, until there are not changes between -%% two consecutive passes. +%% Converts all the function specifications of the kmodules until fixpoint. specs_as_erl_types_fix(Kmodules, Exported, Openset) -> RecDict = ets:new(recdict, []), %% Needed for erl_types:t_from_form/6. R = specs_as_erl_types_fix(Kmodules, Exported, RecDict, Openset, dict:new()), @@ -1299,9 +1286,9 @@ specs_as_erl_types_fix_pass([KM|Rest]=KMs, Exported, RecDict, Openset, GatheredS %% The openset of the module has reached a fixpoint. true -> specs_as_erl_types_fix_pass(Rest, Exported, RecDict, Openset, GatheredSpecs1); - %% If the openset of the module has changed, we want to re-run the computation. - %% This can happen when a type depends on a type that is defined later in the code, - %% or for mutually recursive types. + %% If the openset of the module has changed, we want to re-run the + %% computation. This can happen when a type depends on a type + %% that is defined later in the code, or for mutually recursive types. false -> OtherModsOpenset = sets:subtract(Openset, ModOpenset), specs_as_erl_types_fix_pass(KMs, Exported, RecDict, sets:union(NewModOpenset, OtherModsOpenset), GatheredSpecs1) @@ -1365,11 +1352,13 @@ try_convert_type_to_erl_types(Mta, T, Exported, RecDict) -> _:_ -> error end. -%% Converts a spec without bounded funs and record to its erl_types representation. +%% Converts a spec without bounded funs and records to its erl_types +%% representation. normalized_spec_form_as_erl_types(Spec, Mfa, TypeForms, RecDict) -> normalized_spec_form_as_erl_types(Spec, Mfa, TypeForms, RecDict, []). -normalized_spec_form_as_erl_types([], _Mfa, _TypeForms, _RecDict, Acc) -> lists:reverse(Acc); +normalized_spec_form_as_erl_types([], _Mfa, _TypeForms, _RecDict, Acc) -> + lists:reverse(Acc); normalized_spec_form_as_erl_types([FC|FCs], Mfa, TypeForms, RecDict, Acc) -> VT = erl_types:var_table__new(), Cache = erl_types:cache__new(), @@ -1396,7 +1385,8 @@ extract_type_definitions(Kmodule) -> Records = [generate_type_form_for_record_form(RF) || RF <- RecordForms], Types ++ Records. -%% Replace all record references with their respective temporary type in a type form +%% Replaces all record references with their respective temporary type +%% in a type form. replace_record_references_in_type_form({Line, {Name, Type, Args}}) -> {Line, {Name, replace_record_references(Type), Args}}. @@ -1410,8 +1400,7 @@ replace_records_in_spec([{type, _, _, Ts}=FC|FCs], FClauses) -> NTs = [replace_record_references(T) || T <- Ts], replace_records_in_spec(FCs, [setelement(4, FC, NTs)|FClauses]). -%% Replace all record references with their respective temporary type in a form -%% Replaces all the references to records inside a type form. +%% Replaces all record references with their respective temporary type. replace_record_references({type, L, record, [{atom, _, Name}]}) -> {user_type, L, type_name_for_record(Name), []}; replace_record_references({T, L, Type, Args}) when T =:= type orelse T =:= user_type -> @@ -1424,8 +1413,8 @@ replace_record_references({T, L, Type, Args}) when T =:= type orelse T =:= user_ replace_record_references(F) -> F. %% Generates a type definition for a record. -%% A record is represented as a tuple where the first element is the name of the record. -%% The rest of the elements are the types of the record fields. +%% A record is represented as a tuple where the first element is the name of +%% the record. The remaining elements are the types of the record fields. generate_type_form_for_record_form({Line, {Name, Fields}}) -> Fs = [replace_record_references(T) || {typed_record_field, _, T} <- Fields], RecType = {type, Line, tuple, [{atom, Line, Name} | Fs]}, @@ -1435,8 +1424,8 @@ generate_type_form_for_record_form({Line, {Name, Fields}}) -> type_name_for_record(RecordName) -> list_to_atom(?CUTER_RECORD_TYPE_PREFIX ++ atom_to_list(RecordName)). -%% Transforms the spec and replaces all the clauses that are expressed as bounded -%% functions, to their equivalent unbounded ones. +%% Transforms the spec and replaces all the clauses that are expressed +%% as bounded functions, to their equivalent unbounded ones. transform_bounded_funs_in_spec(Spec) -> [transform_bounded_fun(C) || C <- Spec]. @@ -1475,7 +1464,7 @@ simplify_var_mappings_pass(Ms, Lim, N) -> false -> simplify_var_mappings_pass(NMs, Lim, N + 1) end. -%% Replace variables in a bounded fun with their produced type forms +%% Replace variables in a bounded fun with their produced type forms. substitute_vars_in_type({type, _, record, _R} = T, _Ms) -> T; substitute_vars_in_type({_, _, _, Args}=T, Ms) when is_list(Args) -> NewArgs = [substitute_vars_in_type(A, Ms) || A <- Args], @@ -1490,12 +1479,23 @@ are_dicts_equal_on_keys([], _D1, _D2) -> true; are_dicts_equal_on_keys([K|Ks], D1, D2) -> dict:fetch(K, D1) =:= dict:fetch(K, D2) andalso are_dicts_equal_on_keys(Ks, D1, D2). -%% Generates a non bounded fun from a bounded fun given the type substitutions for -%% constraints on the variables. +%% Generates a non-bounded fun from a bounded fun given the type substitutions +%% for constraints on the variables. generate_nonbounded_fun({type, L, 'fun', [Args, Range]}, Ms) -> NewArgs = substitute_vars_in_type(Args, Ms), NewRange = substitute_vars_in_type(Range, Ms), {type, L, 'fun', [NewArgs, NewRange]}. -report_unhandled_spec(F, Args) -> - io:format(standard_error, F, Args). + +warn_unhandled_spec(MFA) -> + Slogan = "\033[00;33mWarning: Cannot convert spec of ~s~n\033[00m", + io:format(standard_error, Slogan, [mfa_to_string(MFA)]). + +%% ============================================================================ +%% Utilities +%% ============================================================================ + +%% Returns the string representation of an MFA. +-spec mfa_to_string(mfa()) -> string(). +mfa_to_string({M, F, A}) -> + atom_to_list(M) ++ ":" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A). From 5bd01b8d8b54682aaac68ece2142c0e8c9a085e1 Mon Sep 17 00:00:00 2001 From: Dspil Date: Wed, 16 Feb 2022 13:46:20 +0200 Subject: [PATCH 76/85] added temporary call to cuter_types:specs_as_erl_types/1 --- src/cuter.erl | 6 +++++- src/cuter_codeserver.erl | 17 ++++++++++++++++- 2 files changed, 21 insertions(+), 2 deletions(-) diff --git a/src/cuter.erl b/src/cuter.erl index 34a47f07..bc3ddf2b 100644 --- a/src/cuter.erl +++ b/src/cuter.erl @@ -87,7 +87,8 @@ run_from_file(File, Options) -> %% The tasks to run during the app initialization. init_tasks() -> [fun ensure_exported_entry_points/1, - fun compute_callgraph/1]. + fun compute_callgraph/1, + fun convert_specs/1]. -spec init(state()) -> ok | error. init(State) -> @@ -128,6 +129,9 @@ compute_callgraph(State) -> Mfas = mfas_from_state(State), cuter_codeserver:calculate_callgraph(State#st.codeServer, Mfas). +convert_specs(State) -> + cuter_codeserver:convert_specs(State#st.codeServer). + mfas_from_state(State) -> [{M, F, length(As)} || {M, F, As, _} <- State#st.seeds]. diff --git a/src/cuter_codeserver.erl b/src/cuter_codeserver.erl index 2c28e30a..5776d36f 100644 --- a/src/cuter_codeserver.erl +++ b/src/cuter_codeserver.erl @@ -19,6 +19,8 @@ %% Counter of branches & Tag generator. -export([get_branch_counter/0, init_branch_counter/0, generate_tag/0]). +-export([convert_specs/1]). + -include("include/cuter_macros.hrl"). -export_type([cached_modules/0, codeserver/0, counter/0, logs/0]). @@ -137,6 +139,10 @@ get_whitelist(CodeServer) -> calculate_callgraph(CodeServer, Mfas) -> gen_server:call(CodeServer, {calculate_callgraph, Mfas}). +-spec convert_specs(codeserver()) -> ok. +convert_specs(CodeServer) -> + gen_server:call(CodeServer, convert_specs). + %% Gets the feasible tags. -spec get_feasible_tags(codeserver(), cuter_cerl:node_types()) -> cuter_cerl:visited_tags(). get_feasible_tags(CodeServer, NodeTypes) -> @@ -182,6 +188,7 @@ handle_info(_Msg, State) -> ; (get_whitelist, from(), state()) -> {reply, cuter_mock:whitelist(), state()} ; ({get_feasible_tags, cuter_cerl:node_types()}, from(), state()) -> {reply, cuter_cerl:visited_tags(), state()} ; ({calculate_callgraph, [mfa()]}, from(), state()) -> {reply, ok, state()} + ; (convert_specs, from(), state()) -> {reply, ok, state()} . handle_call({load, M}, _From, State) -> {reply, try_load(M, State), State}; @@ -231,7 +238,15 @@ handle_call({calculate_callgraph, Mfas}, _From, State=#st{whitelist = Whitelist} end, cuter_callgraph:foreachModule(LoadFn, Callgraph), {reply, ok, State#st{callgraph = Callgraph}} - end. + end; +handle_call(convert_specs, _From, State=#st{db = Db}) -> + Fn2 = fun({_M, Kmodule}, Acc) -> + [Kmodule|Acc] + end, + Kmodules = ets:foldl(Fn2, [], Db), + _MfasToSpecs = cuter_types:specs_as_erl_types(Kmodules), + {reply, ok, State}. + %% gen_server callback : handle_cast/2 -spec handle_cast(stop, state()) -> {stop, normal, state()} | {noreply, state()} From 96aa8db5b58c49088220e6e42c992ba106f2e61c Mon Sep 17 00:00:00 2001 From: Dspil Date: Wed, 16 Feb 2022 17:44:48 +0200 Subject: [PATCH 77/85] Graceful shutdown during exceptions in initialization --- src/cuter.erl | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/cuter.erl b/src/cuter.erl index bc3ddf2b..df396ce0 100644 --- a/src/cuter.erl +++ b/src/cuter.erl @@ -52,7 +52,7 @@ run(M, F, As, Depth, Options) -> %% Runs CutEr on multiple units. run(Seeds, Options) -> State = state_from_options_and_seeds(Options, Seeds), - case init(State) of + try init(State) of error -> stop(State), []; @@ -61,6 +61,10 @@ run(Seeds, Options) -> ErroneousInputs = process_results(EndState), stop(State), ErroneousInputs + catch + _:_ -> + stop(State), + [] end. -spec run_from_file(file:name(), options()) -> erroneous_inputs(). From 0d85883d4ee036a174ddb4df9b805abca919d240 Mon Sep 17 00:00:00 2001 From: Dspil Date: Wed, 16 Feb 2022 17:48:43 +0200 Subject: [PATCH 78/85] Print the error message --- src/cuter.erl | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/cuter.erl b/src/cuter.erl index df396ce0..66f62ac6 100644 --- a/src/cuter.erl +++ b/src/cuter.erl @@ -62,7 +62,9 @@ run(Seeds, Options) -> stop(State), ErroneousInputs catch - _:_ -> + ExceptionType:Why -> + io:format("Proccess exited with exception:~n~p:~p~n", [ExceptionType, Why]), + io:format("Shutting down the execution...~n"), stop(State), [] end. From 5d7911d9fcfd29841bedb6dc739fdec039449ed0 Mon Sep 17 00:00:00 2001 From: Dspil Date: Wed, 16 Feb 2022 18:12:24 +0200 Subject: [PATCH 79/85] Generalize free variables in bounded funs --- src/cuter_types.erl | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 95f8fcb0..47a0e991 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -1469,12 +1469,18 @@ substitute_vars_in_type({type, _, record, _R} = T, _Ms) -> T; substitute_vars_in_type({_, _, _, Args}=T, Ms) when is_list(Args) -> NewArgs = [substitute_vars_in_type(A, Ms) || A <- Args], setelement(4, T, NewArgs); -substitute_vars_in_type({var, _, Var}, Ms) -> - dict:fetch(Var, Ms); +substitute_vars_in_type({var, L, Var}, Ms) -> + case dict:find(Var, Ms) of + error -> form_any(L); + {ok, T} -> T + end; substitute_vars_in_type({ann_type, _, [_Var, T]}, Ms) -> substitute_vars_in_type(T, Ms); substitute_vars_in_type(T, _Ms) -> T. +form_any(L) -> + {type, L, any, []}. + are_dicts_equal_on_keys([], _D1, _D2) -> true; are_dicts_equal_on_keys([K|Ks], D1, D2) -> dict:fetch(K, D1) =:= dict:fetch(K, D2) andalso are_dicts_equal_on_keys(Ks, D1, D2). @@ -1486,7 +1492,6 @@ generate_nonbounded_fun({type, L, 'fun', [Args, Range]}, Ms) -> NewRange = substitute_vars_in_type(Range, Ms), {type, L, 'fun', [NewArgs, NewRange]}. - warn_unhandled_spec(MFA) -> Slogan = "\033[00;33mWarning: Cannot convert spec of ~s~n\033[00m", io:format(standard_error, Slogan, [mfa_to_string(MFA)]). From 5be600f227ae56e1d9fe7da2d0804f1ea97dde6f Mon Sep 17 00:00:00 2001 From: Dspil Date: Thu, 17 Feb 2022 20:43:49 +0200 Subject: [PATCH 80/85] added unit tests for cuter_graphs.erl --- Makefile.in | 4 +- src/cuter_graphs.erl | 161 ++++++++++++++++++-------- src/cuter_types.erl | 3 + test/utest/src/callgraph_examples.erl | 60 ++++++++++ test/utest/src/cuter_graphs_tests.erl | 128 ++++++++++++++++++++ 5 files changed, 304 insertions(+), 52 deletions(-) create mode 100644 test/utest/src/callgraph_examples.erl create mode 100644 test/utest/src/cuter_graphs_tests.erl diff --git a/Makefile.in b/Makefile.in index 175ce18a..a69c90d6 100644 --- a/Makefile.in +++ b/Makefile.in @@ -104,7 +104,9 @@ UTEST_MODULES = \ types_and_specs \ types_and_specs2 \ cuter_metrics_tests \ - cuter_config_tests + cuter_config_tests \ + cuter_graphs_tests \ + callgraph_examples FTEST_MODULES = \ bitstr \ diff --git a/src/cuter_graphs.erl b/src/cuter_graphs.erl index 1a20e28c..3ccbd2fc 100644 --- a/src/cuter_graphs.erl +++ b/src/cuter_graphs.erl @@ -1,5 +1,5 @@ -module(cuter_graphs). --export([children/2, list_contains/2, calculate_dag_callgraph/1]). +-export([make_graph_from_children/2, children/2, list_contains/2, calculate_dag_callgraph/1]). -export_type([graph/0, graph_node/0]). %debugging -export([print_graph/1, report_callgraphs/1]). @@ -15,54 +15,66 @@ | {cycle, [mfa()]}. -% ========================= -% graph implementation -% ========================= +%% ===================================================== +%% Graph implementation. Each graph is a dictionary with +%% nodes as keys and their list of neighbours as values +%% ===================================================== +%% Creates an empty dict representing a graph. new_graph() -> dict:new(). +%% Adds a new node with no neighbours to a graph. add_node(Node, Graph) -> dict:store(Node, [], Graph). +%% Adds an edge to a graph. add_edge({Node1, Node2}, Graph) -> + %% Add Node2 into the list of neighbours of Node1 dict:store(Node1, [Node2|element(2, dict:find(Node1, Graph))], Graph). +%% Adds a node along with its neighbours in a graph. add_node_with_children(Node, Children, Graph) -> NewGraph = add_node(Node, Graph), lists:foldl(fun(A, B) -> add_edge({Node, A}, B) end, NewGraph, Children). +%% Given a list of nodes and a list of neighbours per node, it returns a graph. +-spec make_graph_from_children([node()], [[node()]]) -> graph(). make_graph_from_children(Nodes, Children) -> G = lists:foldl(fun add_node/2, new_graph(), Nodes), lists:foldl(fun({Node, Ch}, B) -> dict:store(Node, Ch, B) end, G, lists:zip(Nodes, Children)). +%% Returns the neighbour list of a node in a graph. -spec children(graph_node(), graph()) -> [graph_node()]. children(Node, Graph) -> {ok, C} = dict:find(Node, Graph), C. +%% Returns all the nodes of a graph. get_nodes(Graph) -> dict:fetch_keys(Graph). +%% Checks if a node is contained in a graph. has_node(Node, Graph) -> dict:is_key(Node, Graph). -% =========== -% find cycles -% =========== +%% ===================================================== +%% Logic for finding cycles. Implemented as a DFS search +%% with a visited set. +%% ===================================================== --spec cycle_nodes(graph_node(), graph()) -> [[graph_node()]]. +%% Returns a list of cycles in a graph. cycle_nodes(EntryPoint, Graph) -> {Cycled, _, _} = cycle_nodes(EntryPoint, Graph, sets:new(), sets:new()), Cycled. cycle_nodes(Node, Graph, Visited, Ignored) -> + %% Get the children of the node. C = children(Node, Graph), - TC = lists:filter( - fun(Y) -> not (sets:is_element(Y, Visited) or sets:is_element(Node, Ignored)) end, - C - ), + %% Filter out the ones that have been visited or are ignored. + TC = [Y || Y <- C, not (sets:is_element(Y, Visited) or sets:is_element(Node, Ignored))], + %% Call self for every child. {ChildrenCycled, ChildrenActiveCycled, VisitedBelow} = cycle_nodes_children(TC, Graph, sets:add_element(Node, Visited), Ignored), ActiveCycled = lists:filter(fun(X) -> sets:is_element(X, Visited) end, C), {Cycles, ActiveCycles} = update_active_cycles(Node, ActiveCycled, ChildrenCycled, ChildrenActiveCycled), @@ -77,23 +89,19 @@ cycle_nodes_children([Ch|C], G, V, I, CycleAcc, ActiveCycleAcc, VisitedAcc) -> {Cycle, ActiveCycle, VisitedBelow} = cycle_nodes(Ch, G, V, I), cycle_nodes_children(C, G, V, sets:union([I, VisitedBelow]), lists:append([CycleAcc, Cycle]), lists:append([ActiveCycleAcc, ActiveCycle]), sets:union([VisitedAcc, VisitedBelow])). --spec update_active_cycles(graph_node(), [{graph_node(), [graph_node()]}], [[graph_node()]], [{graph_node(), [graph_node()]}]) -> {[[graph_node()]], [{graph_node(), [graph_node()]}]}. update_active_cycles(Node, ActiveCycled, ChildrenCycled, ChildrenActiveCycled) -> ActiveCycled1 = create_new_cycles(ActiveCycled, ChildrenActiveCycled), {Cycles1, ActiveCycled2} = update_all_cycles(Node, ActiveCycled1), {lists:append([Cycles1, ChildrenCycled]), ActiveCycled2}. --spec create_new_cycles([graph_node()], [{graph_node(), [graph_node()]}]) -> [{graph_node(), [graph_node()]}]. create_new_cycles([], Acc) -> Acc; create_new_cycles([H|T], Acc) -> [{H,[]}|create_new_cycles(T, Acc)]. --spec update_all_cycles(graph_node(), [{graph_node(), [graph_node()]}]) -> {[[graph_node()]], [{graph_node(), [graph_node()]}]}. update_all_cycles(Node, ActiveCycled) -> update_all_cycles(Node, ActiveCycled, [], []). --spec update_all_cycles(graph_node(), [{graph_node(), [graph_node()]}], [{graph_node(), [graph_node()]}], [[graph_node()]]) -> {[[graph_node()]], [{graph_node(), [graph_node()]}]}. update_all_cycles(_, [], ActiveAcc, CyclesAcc) -> {CyclesAcc, ActiveAcc}; update_all_cycles(Node, [{First, List}|T], ActiveAcc, CyclesAcc) -> @@ -108,32 +116,44 @@ update_all_cycles(Node, [{First, List}|T], ActiveAcc, CyclesAcc) -> update_all_cycles(Node, T, ActiveAcc1, CyclesAcc1). -% ========================= -% merge overlapping cycles -% ========================= +%% ================================================================= +%% Logic for merging overlapping cycles. +%% Overlapping cycles are cycles that have at least one common node. +%% Each cycle is a list of nodes, so we have to find all lists with +%% common elements and merge them. +%% ================================================================= +%% Cycles are lists of nodes. +%% If two cycles contain at least one commone element are merged into one list. merge_cycles(Cycles) -> + %% Make a helper graph. G = make_help_graph(Cycles), + %% Merged cycles are the connected components of the helper graph. connected_components(G). +%% Creates the helper graph for merging the cycles. -spec make_help_graph([[graph_node()]]) -> dict:dict(). make_help_graph(Cycles) -> + %% Initialize a graph. G = dict:new(), + %% Add each cycle to the graph. lists:foldl(fun put_cycle/2, G, Cycles). +%% Adds a cycle to a helper graph. -spec put_cycle([graph_node()], dict:dict()) -> dict:dict(). -put_cycle(Cycle, Graph) -> - put_cycle(nonode, Cycle, Graph). +put_cycle(Cycle, Graph) -> put_cycle(nonode, Cycle, Graph). -put_cycle(_, [], Graph) -> - Graph; +%% If we don't have other nodes to add, return the graph. +put_cycle(_, [], Graph) -> Graph; put_cycle(Prev, [N|Ns], Graph) -> + %% If the node is not already in the graph, add it. Graph1 = case dict:is_key(N, Graph) of true -> Graph; false -> dict:store(N, [], Graph) end, + %% Connect the previous node with the current one bidirectionally. Graph2 = case Prev of nonode -> Graph1; @@ -143,50 +163,64 @@ put_cycle(Prev, [N|Ns], Graph) -> end, put_cycle(N, Ns, Graph2). --spec connected_components(dict:dict()) -> [sets:set()]. +%% Returns the connected components of a graph. connected_components(G) -> connected_components(G, []). --spec connected_components(dict:dict(), [sets:set()]) -> [sets:set()]. connected_components(G, Acc) -> + %% If the graph is empty, we have found all connected components. case dict:is_empty(G) of true -> Acc; false -> + %% Else, get one connected component. C = connected_component(G), - G1 = remove_keys(C, G), + %% Remove the whole component from G. + G1 = remove_nodes(C, G), + %% Find the rest connected components. connected_components(G1, [C|Acc]) end. --spec connected_component(dict:dict()) -> sets:set(). connected_component(G) -> + %% To find one connected component, fetch a random node from the graph + %% and find everything that can be reached from that node. connected_component(hd(dict:fetch_keys(G)), sets:new(), G). --spec connected_component(graph_node(), sets:set(), dict:dict()) -> sets:set(). +%% Finds the connected component of Graph +%% which contains the node Node given that we have +%% visited Visited nodes of this component already connected_component(Node, Visited, Graph) -> + %% Get the neighbours of this Node. {ok, Children} = dict:find(Node, Graph), + %% Add them to the visited set. Visited1 = sets:add_element(Node, Visited), + %% Call self for each child through connected_component_children/3. connected_component_children(Children, Visited1, Graph). --spec connected_component_children([graph_node()], sets:set(), dict:dict()) -> sets:set(). +%% Calls connected_component/3 for each of the nodes +%% in a list if they haven't alreadybeen visited. +%% Returns all the nodes that have been visited by +%% this procedure. connected_component_children([], Visited, _) -> Visited; connected_component_children([C|Cs], Visited, Graph) -> + %% If node C has not been visited. case sets:is_element(C, Visited) of false -> + %% Find the connected component containing this node. Visited1 = connected_component(C, Visited, Graph); true -> Visited1 = Visited end, connected_component_children(Cs, Visited1, Graph). --spec remove_keys(sets:set(), dict:dict()) -> dict:dict(). -remove_keys(C, G) -> +%% Removes all nodes in list C from graph G. +remove_nodes(C, G) -> lists:foldl(fun dict:erase/2, G, sets:to_list(C)). -% =================================== -% make new graph merging cycled nodes -% =================================== +%% ================================================== +%% Logic for making a new graph merging cycled nodes. +%% ================================================== remake_graph(EntryPoint, Graph) -> Cycles = merge_cycles(cycle_nodes(EntryPoint, Graph)), @@ -201,20 +235,16 @@ remake_graph(EntryPoint, Graph) -> ChildrenPerNode = [try_remove(B, C) || {B, C} <- lists:zip(Nodes, ChildrenPerNodeTemp)], make_graph_from_children(Nodes, ChildrenPerNode). --spec find_children([sets:set()], graph()) -> [[graph_node()]]. find_children(Cycles, Graph) -> find_children(Cycles, Graph, []). --spec find_children([sets:set()], graph(), [[graph_node()]]) -> [[graph_node()]]. find_children([], _, Acc) -> lists:reverse(Acc); find_children([C|Cs], Graph, Acc) -> find_children(Cs, Graph, [lists:append([children(X, Graph) || X <- C])|Acc]). --spec update_children([[graph_node()]], sets:set(), [sets:set()], [{atom(), [graph_node()]}]) -> [{atom(), [graph_node()]}]. update_children(Children, AllCycledNodes, Cycles, CyclesAsLists) -> update_children(Children, AllCycledNodes, Cycles, CyclesAsLists, []). --spec update_children([[graph_node()]], sets:set(), [sets:set()], [{atom(), [graph_node()]}], [{atom(), [graph_node()]}]) -> [{atom(), [graph_node()] | graph_node()}]. update_children([], _, _, _, Acc) -> Acc; update_children([C|Cs], AllCycles, Cycles, CyclesAsLists, Acc) -> case sets:is_element(C, AllCycles) of @@ -246,38 +276,63 @@ try_remove(Node, [C|Cs], Acc) -> end. -% =================== -% Calculate callgraph -% =================== +%% =========================================================== +%% Logic for calculating a callgraph and merging all functions +%% having a cyclic dependency onto a new node. +%% =========================================================== +%% First calculates the callgraph. +%% Then it replaces all cycles with single nodes, +%% merging cycles with common functions. +%% Last it finds the new entry point which may be part of a cycle. +%% Returns the processed callgraph, all functions belonging to the callgraph in a set +%% and the new entry point. -spec calculate_dag_callgraph(mfa()) -> {graph(), sets:set(), graph_node()}. calculate_dag_callgraph(EntryPoint) -> Original = calculate_callgraph(EntryPoint), CallGraph = remake_graph(EntryPoint, Original), - NewEntryPoint = find_node(EntryPoint, CallGraph), + NewEntryPoint = find_entry_point(EntryPoint, CallGraph), {CallGraph, sets:from_list(dict:fetch_keys(Original)), NewEntryPoint}. -find_node(EntryPoint, Graph) -> +%% Finds the new entry point of the graph +find_entry_point(EntryPoint, Graph) -> case has_node({node, EntryPoint}, Graph) of true -> + %% If entry point is just a node, return it. {node, EntryPoint}; false -> + %% Else return the first cycle that contains the entry point. + %% Only one cycle will contain it, since if it belonge to many, + %% they would have been merged. {cycle, hd([C || {cycle, C} <- get_nodes(Graph), list_contains(EntryPoint, C)])} end. --spec calculate_callgraph(mfa()) -> graph(). +%% Calculates the callgraph produced by the +%% visibly reachable mfas from an entry point. calculate_callgraph(EntryPoint) -> + %% Start the xref server. xref:start(s), + %% Add all modules reachable by the entry point + %% in the xref server. _FoundModules = add_modules_rec(EntryPoint), + %% Make the callgraph from the gathered modules. CallGraph = make_callgraph(EntryPoint, new_graph()), + %% Stop the xref server. xref:stop(s), CallGraph. +%% Adds to the xref server the module of the argument mfa. +%% Then it recursively adds the modules of the functions called by the mfa. add_modules_rec(MFA) -> add_modules_rec(MFA, sets:new(), sets:new()). -add_modules_rec({M, F, A}, Found, FoundNodes) -> - Valid = fun({_, {M1, F1, _A}}) -> hd(atom_to_list(M1)) =/= 36 andalso hd(atom_to_list(F1)) =/= 36 end, +add_modules_rec({M, _F, _A}=MFA, Found, FoundNodes) -> + %% Function used to filter edges pointing to compiler generated functions (eg. from list comprehensions). + Valid = fun({_, {M1, F1, _A1}}) -> + %% The compiler generated function name starts with char '$'. + hd(atom_to_list(M1)) =/= 36 andalso hd(atom_to_list(F1)) =/= 36 + end, + %% If we haven't seen the mfa's module yet, add it to the xref server and the Found set. NewFound = case sets:is_element(M, Found) of false -> xref:add_module(s, code:which(M)), @@ -285,12 +340,16 @@ add_modules_rec({M, F, A}, Found, FoundNodes) -> true -> Found end, - {ok, Edges1} = xref:q(s, lists:concat(["E | ", mfa_to_str({M, F, A})])), + %% Get the outward edges from our mfa to other functions. + %% To do this, we make a query to the xref server starting with + %% 'E' to fetch edges and use | to specify those that start with our mfa. + {ok, Edges1} = xref:q(s, lists:concat(["E | ", mfa_to_str(MFA)])), + %% Filter the edges to compiler generated functions. Edges = lists:filter(Valid, Edges1), - NewFoundNodes = sets:add_element({M, F, A}, FoundNodes), - lists:foldl(fun(X, Y) -> add_modules_rec(X, Y, NewFoundNodes) end, NewFound, [B || {_A, B} <- Edges, not sets:is_element(B, FoundNodes)]). + %% Add the current mfa to FoundNodes set. + NewFoundNodes = sets:add_element(MFA, FoundNodes), + lists:foldl(fun(X, Y) -> add_modules_rec(X, Y, NewFoundNodes) end, NewFound, [N2 || {_N1, N2} <- Edges, not sets:is_element(N2, FoundNodes)]). --spec make_callgraph(mfa(), graph()) -> graph(). make_callgraph(MFA, Graph) -> case has_node(MFA, Graph) of true -> Graph; @@ -327,7 +386,7 @@ report_callgraphs(EntryPoint) -> io:format("Original callgraph:~n"), graphs:print_graph(Original), CallGraph = remake_graph(EntryPoint, Original), - NewEntryPoint = find_node(EntryPoint, CallGraph), + NewEntryPoint = find_entry_point(EntryPoint, CallGraph), io:format("Final callgraph:~n"), graphs:print_graph(CallGraph), io:format("New Entry Point: ~p ~n", [NewEntryPoint]). diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 639c0b17..37b14c1f 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -25,6 +25,8 @@ -export([convert_specs/1]). +-export([equal_sets/2]). + -export_type([erl_type/0, erl_spec_clause/0, erl_spec/0, stored_specs/0, stored_types/0, stored_spec_value/0, t_range_limit/0]). -export_type([erl_type_dep/0, erl_type_deps/0]). @@ -1364,6 +1366,7 @@ convert_list_to_erl([Spec|Specs], MFA, ExpTypes, RecDict, Acc) -> convert_list_to_erl(Specs, MFA, ExpTypes, RecDict, [ErlSpec|Acc]) end. +-spec equal_sets(sets:set(), sets:set()) -> boolean(). equal_sets(A, B) -> sets:size(A) == sets:size(B) andalso sets:size(sets:union(A, B)) == sets:size(B). diff --git a/test/utest/src/callgraph_examples.erl b/test/utest/src/callgraph_examples.erl new file mode 100644 index 00000000..01f29c60 --- /dev/null +++ b/test/utest/src/callgraph_examples.erl @@ -0,0 +1,60 @@ +-module(callgraph_examples). +-export([f1/1, f2/1, f3/1, f4/1]). + +-spec f1(integer()) -> integer(). +f1(X) -> + f11(X). + +f11(_X) -> ok. + +%% ===================================== + +-spec f2(integer()) -> integer(). +f2(X) -> + case X of + 1 -> 1; + _ -> f21(X - 1) + end. + +f21(X) -> + case X of + 2 -> 2; + _ -> f2(X) + end. + +%% ===================================== + +-spec f3([any()]) -> any(). +f3(X) -> + [f31(Y) || Y <- X]. + +f31(X) -> + Y = f32(X-1), + Y + 1. + +f32(X) -> + case X of + 1 -> 1 + f33(4); + _ -> f31(X - 1) + end. + +f33(X) -> + X + 1. + +%% ===================================== + +-spec f4(any()) -> any(). +f4(X) -> + F = fun(Y) -> f41(Y) end, + F(X). + +f41(X) -> + f42(X + 1). + +f42(X) -> + f4(X + 1) + f43(X). + +f43(X) -> + f41(X + 1) + f44(X). + +f44(X) -> X. diff --git a/test/utest/src/cuter_graphs_tests.erl b/test/utest/src/cuter_graphs_tests.erl new file mode 100644 index 00000000..8162169a --- /dev/null +++ b/test/utest/src/cuter_graphs_tests.erl @@ -0,0 +1,128 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------------ +-module(cuter_graphs_tests). + +-include_lib("eunit/include/eunit.hrl"). +%-include("include/eunit_config.hrl"). +%-include("include/cuter_macros.hrl"). + +-spec test() -> ok | {error, any()}. + +-spec calculate_dag_callgraph_test_() -> [{string(), {'setup', fun(), fun(), fun()}}]. +calculate_dag_callgraph_test_() -> + EntryPoints = [ + {callgraph_examples, f1, 1}, + {callgraph_examples, f2, 1}, + {callgraph_examples, f3, 1}, + {callgraph_examples, f4, 1} + ], + Setup = fun(E) -> fun() -> setup(E) end end, + Inst = fun validate_callgraph/1, + Cleanup = fun cleanup/1, + [{"Calculate callgraphs", {setup, Setup(E), Cleanup, Inst}} || E <- EntryPoints]. + +setup(EntryPoint) -> + {G, _, NewEntryPoint} = cuter_graphs:calculate_dag_callgraph(EntryPoint), + {EntryPoint, NewEntryPoint, G}. + +validate_callgraph({EntryPoint, NewEntryPoint, G}) -> + E = fun(F, A) -> {callgraph_examples, F, A} end, + N = fun(X) -> {node, X} end, + C = fun(X) -> {cycle, X} end, + case EntryPoint of + {callgraph_examples, f1, 1} -> + Nodes = [N(E(f1, 1)), N(E(f11, 1))], + Children = [[N(E(f11, 1))], []], + NewEntryPoint1 = N(E(f1, 1)); + {callgraph_examples, f2, 1} -> + Nodes = [C([E(f2, 1), E(f21, 1)])], + Children = [[]], + NewEntryPoint1 = C([E(f2, 1), E(f21, 1)]); + {callgraph_examples, f3, 1} -> + Nodes = [ + N(E(f3, 1)), + C([E(f31, 1), E(f32, 1)]), + N(E(f33, 1)) + ], + Children = [ + [C([E(f31, 1), E(f32, 1)])], + [N(E(f33, 1))], + [] + ], + NewEntryPoint1 = N(E(f3, 1)); + {callgraph_examples, f4, 1} -> + Nodes = [ + C([E(f4, 1), E(f41, 1), E(f42, 1), E(f43, 1)]), + N(E(f44, 1)) + ], + Children = [ + [N(E(f44, 1))], + [] + ], + NewEntryPoint1 = C([E(f4, 1), E(f41, 1), E(f42, 1), E(f43, 1)]) + end, + G1 = cuter_graphs:make_graph_from_children(Nodes, Children), + [?_assertEqual(equal_graphs(G, G1), true), ?_assertEqual(equal_entry_points(NewEntryPoint, NewEntryPoint1), true)]. + +cleanup(_) -> ok. + +equal_graphs(G1, G2) -> + G1Keys = dict:fetch_keys(G1), + G2Keys = dict:fetch_keys(G2), + case equal_keys(G1Keys, G2Keys) of + false -> false; + C -> + G2New = change_keys(G2, C), + equal_graphs_helper(G1, G2New) + end. + +equal_keys(Keys1, Keys2) -> + case length(Keys1) =:= length(Keys2) of + true -> equal_keys(Keys1, Keys2, dict:new()); + false -> false + end. + +equal_keys([], _, Acc) -> Acc; +equal_keys([{KeyType, K1}=Key1|Keys1], Keys2, Acc) -> + case KeyType of + node -> + case [K || K <- Keys2, K =:= Key1] of + [] -> false; + [_] -> equal_keys(Keys1, Keys2, Acc) + end; + cycle -> + case [K2 || {cycle, K2} <- Keys2, cuter_types:equal_sets(sets:from_list(K1), sets:from_list(K2))] of + [] -> false; + [K2] -> + equal_keys(Keys1, Keys2, dict:store(K2, K1, Acc)) + end + end. + +change_keys(G, C) -> + H = change_keys_helper(dict:to_list(G), C, []), + dict:from_list(H). + +change_keys_helper([], _, Acc) -> lists:reverse(Acc); +change_keys_helper([{{node, _}, _N}=K|Ks], C, Acc)-> + change_keys_helper(Ks, C, [K|Acc]); +change_keys_helper([{{cycle, Cycle}, N}|Ks], C, Acc) -> + change_keys_helper(Ks, C, [{{cycle, dict:fetch(Cycle, C)}, N}|Acc]). + +equal_graphs_helper(G1, G2) -> + F = fun(Node, N1, Acc) -> + N2 = dict:fetch(Node, G2), + case equal_keys(N1, N2) of + false -> Acc; + _ -> true + end + end, + dict:fold(F, false, G1). + +equal_entry_points({T, E1}, {T, E2}) -> + case T of + node -> E1 =:= E2; + cycle -> cuter_types:equal_sets(sets:from_list(E1), sets:from_list(E2)) + end; +equal_entry_points(_, _) -> false. + + From b7d8038bd907a3bffda02a909152966fa10bc743 Mon Sep 17 00:00:00 2001 From: Dspil Date: Thu, 17 Mar 2022 11:01:52 +0100 Subject: [PATCH 81/85] cuter graphs update --- src/cuter_graphs.erl | 2 + src/cuter_maybe_error_annotation.erl | 79 ++++++++++++++-------------- src/cuter_spec_checker.erl | 2 +- 3 files changed, 43 insertions(+), 40 deletions(-) diff --git a/src/cuter_graphs.erl b/src/cuter_graphs.erl index 3ccbd2fc..07f26ba0 100644 --- a/src/cuter_graphs.erl +++ b/src/cuter_graphs.erl @@ -76,6 +76,8 @@ cycle_nodes(Node, Graph, Visited, Ignored) -> TC = [Y || Y <- C, not (sets:is_element(Y, Visited) or sets:is_element(Node, Ignored))], %% Call self for every child. {ChildrenCycled, ChildrenActiveCycled, VisitedBelow} = cycle_nodes_children(TC, Graph, sets:add_element(Node, Visited), Ignored), + %% An active cycle is a detected cycle that hasn't been + %% completed yet when backtracking ActiveCycled = lists:filter(fun(X) -> sets:is_element(X, Visited) end, C), {Cycles, ActiveCycles} = update_active_cycles(Node, ActiveCycled, ChildrenCycled, ChildrenActiveCycled), {Cycles, ActiveCycles, sets:add_element(Node, VisitedBelow)}. diff --git a/src/cuter_maybe_error_annotation.erl b/src/cuter_maybe_error_annotation.erl index a0ed659a..734b1e23 100644 --- a/src/cuter_maybe_error_annotation.erl +++ b/src/cuter_maybe_error_annotation.erl @@ -240,7 +240,8 @@ annotate_maybe_error_apply(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTy notype -> {update_ann(Op, true), true =/= CurMaybe_Error, false, sets:new()}; _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false, sets:new()} end; - _ -> {update_ann(Op, Value), Value =/= CurMaybe_Error, false, sets:new()} + _ -> + {update_ann(Op, Value), Value =/= CurMaybe_Error, false, sets:new()} end; error -> case dict:find({F, A}, SM) of @@ -264,7 +265,7 @@ annotate_maybe_error_apply(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTy {update_ann(Op, true), true =/= CurMaybe_Error, false, sets:new()} end; true -> - {update_ann(Op, false), true =/= CurMaybe_Error, true, sets:new()} + {update_ann(Op, false), false =/= CurMaybe_Error, true, sets:new()} end end end; @@ -275,13 +276,13 @@ annotate_maybe_error_apply(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTy type_dependent when CheckTypes -> case cuter_spec_checker:get_cerl_type(Tree) of notype -> {update_ann(Op, true), true =/= CurMaybe_Error, false}; - _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false} + _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false, sets:new()} end; _ -> - {update_ann(Op, Value), Value =/= CurMaybe_Error, false} + {update_ann(Op, Value), Value =/= CurMaybe_Error, false, sets:new()} end; _ -> - {update_ann(Op, true), true =/= CurMaybe_Error, false} + {update_ann(Op, true), true =/= CurMaybe_Error, false, sets:new()} end end; _ -> @@ -298,42 +299,42 @@ annotate_maybe_error_apply(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTy {cerl:update_c_apply(update_ann(Tree1, NewMaybe_Error), Op1, Args), C1 or C2, Found, IgnoreFound1 or IgnoreFound2, sets:union([LetrecFound1, LetrecFound2])}. annotate_maybe_error_call(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes, CurMaybe_Error) -> - ModName = cerl:call_module(Tree), - Name = cerl:call_name(Tree), - Arity = length(cerl:call_args(Tree)), - {NewAnn, IgnoreFound1} = - case cerl:is_literal(ModName) andalso cerl:is_literal(Name) of - true -> - case dict:find({element(3, ModName), element(3, Name), Arity}, SM) of - {ok, {Value, 'fun'}} -> - case Value of - type_dependent when CheckTypes -> - case cuter_spec_checker:get_cerl_type(Tree) of - notype -> {true, false}; - _ -> {type_dependent, false} - end; - _ -> {Value, false} + ModName = cerl:call_module(Tree), + Name = cerl:call_name(Tree), + Arity = length(cerl:call_args(Tree)), + {NewAnn, IgnoreFound1} = + case cerl:is_literal(ModName) andalso cerl:is_literal(Name) of + true -> + case dict:find({element(3, ModName), element(3, Name), Arity}, SM) of + {ok, {Value, 'fun'}} -> + case Value of + type_dependent when CheckTypes -> + case cuter_spec_checker:get_cerl_type(Tree) of + notype -> {true, false}; + _ -> {type_dependent, false} end; - _ -> - case sets:is_element({element(3, ModName), element(3, Name), Arity}, Ignored) of - false -> - {true, false}; - true -> - {true, true} - end + _ -> {Value, false} end; - _ -> throw("Unsupported call") - end, - {Args, C1, Found, IgnoreFound2, LetrecFound} = annotate_maybe_error_all(cerl:call_args(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), - NewMaybe_Error = maybe_error_or([NewAnn, get_all_maybe_error(Args)]), - C2 = NewMaybe_Error =/= CurMaybe_Error, - case get_all_maybe_error(Args) of - true -> - Tree1 = add_distrust_type_dependent(Tree); - _ -> - Tree1 = Tree - end, - {cerl:update_c_call(update_ann(Tree1, NewMaybe_Error), ModName, Name, Args), C1 or C2, Found, IgnoreFound1 or IgnoreFound2, LetrecFound}. + _ -> + case sets:is_element({element(3, ModName), element(3, Name), Arity}, Ignored) of + false -> + {true, false}; + true -> + {true, true} + end + end; + _ -> throw("Unsupported call") + end, + {Args, C1, Found, IgnoreFound2, LetrecFound} = annotate_maybe_error_all(cerl:call_args(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + NewMaybe_Error = maybe_error_or([NewAnn, get_all_maybe_error(Args)]), + C2 = NewMaybe_Error =/= CurMaybe_Error, + case get_all_maybe_error(Args) of + true -> + Tree1 = add_distrust_type_dependent(Tree); + _ -> + Tree1 = Tree + end, + {cerl:update_c_call(update_ann(Tree1, NewMaybe_Error), ModName, Name, Args), C1 or C2, Found, IgnoreFound1 or IgnoreFound2, LetrecFound}. annotate_maybe_error_letrec(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes, CurMaybe_Error) -> {Names, Funsb} = lists:unzip(cerl:letrec_defs(Tree)), diff --git a/src/cuter_spec_checker.erl b/src/cuter_spec_checker.erl index 4050fb06..c92af83b 100644 --- a/src/cuter_spec_checker.erl +++ b/src/cuter_spec_checker.erl @@ -254,7 +254,7 @@ unify_pattern(Tree, TSM, TSM2, Type) -> error -> case dict:find(cerl:var_name(Tree), TSM2) of {ok, VarGuardType} -> - case erl_types:t_is_subtype(VarGuardType, Type) of + case erl_types:t_is_subtype(Type, VarGuardType) of true -> {ok, dict:store(cerl:var_name(Tree), VarGuardType, TSM)}; false -> {error, mismatch} end; From 15d6a8e4f1242146074c148cf82c82a8f23d8409 Mon Sep 17 00:00:00 2001 From: Dspil Date: Thu, 7 Apr 2022 12:41:52 +0200 Subject: [PATCH 82/85] bugfix --- Makefile.in | 2 +- src/cuter_types.erl | 11 ++++++----- test/utest/src/cuter_graphs_tests.erl | 4 ++-- 3 files changed, 9 insertions(+), 8 deletions(-) diff --git a/Makefile.in b/Makefile.in index f84cd82b..b0e3454d 100644 --- a/Makefile.in +++ b/Makefile.in @@ -106,7 +106,7 @@ UTEST_MODULES = \ cuter_metrics_tests \ cuter_config_tests \ cuter_graphs_tests \ - callgraph_examples + callgraph_examples \ examples_for_spec_conversion \ examples_for_spec_conversion_pair diff --git a/src/cuter_types.erl b/src/cuter_types.erl index 47a0e991..74d41d24 100644 --- a/src/cuter_types.erl +++ b/src/cuter_types.erl @@ -25,7 +25,7 @@ -export([specs_as_erl_types/1]). --export([mfa_to_string/1]). +-export([mfa_to_string/1, are_sets_equal/2]). -export_type([erl_type/0, erl_spec_clause/0, erl_spec/0, stored_specs/0, stored_types/0, stored_spec_value/0, t_range_limit/0]). @@ -1370,10 +1370,6 @@ normalized_spec_form_as_erl_types([FC|FCs], Mfa, TypeForms, RecDict, Acc) -> normalized_spec_form_as_erl_types(FCs, Mfa, TypeForms, RecDict, Acc) end. -are_sets_equal(A, B) -> - %% A = B, iff A ⊆ B and B ⊆ A. - sets:is_subset(A, B) andalso sets:is_subset(B, A). - %% Returns the type and record definitions in a kmodule. %% Records are replaced by equivalent types. extract_type_definitions(Kmodule) -> @@ -1504,3 +1500,8 @@ warn_unhandled_spec(MFA) -> -spec mfa_to_string(mfa()) -> string(). mfa_to_string({M, F, A}) -> atom_to_list(M) ++ ":" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A). + +-spec are_sets_equal(sets:set(), sets:set()) -> boolean(). +are_sets_equal(A, B) -> + %% A = B, iff A ⊆ B and B ⊆ A. + sets:is_subset(A, B) andalso sets:is_subset(B, A). diff --git a/test/utest/src/cuter_graphs_tests.erl b/test/utest/src/cuter_graphs_tests.erl index 8162169a..a2e0ebc4 100644 --- a/test/utest/src/cuter_graphs_tests.erl +++ b/test/utest/src/cuter_graphs_tests.erl @@ -91,7 +91,7 @@ equal_keys([{KeyType, K1}=Key1|Keys1], Keys2, Acc) -> [_] -> equal_keys(Keys1, Keys2, Acc) end; cycle -> - case [K2 || {cycle, K2} <- Keys2, cuter_types:equal_sets(sets:from_list(K1), sets:from_list(K2))] of + case [K2 || {cycle, K2} <- Keys2, cuter_types:are_sets_equal(sets:from_list(K1), sets:from_list(K2))] of [] -> false; [K2] -> equal_keys(Keys1, Keys2, dict:store(K2, K1, Acc)) @@ -121,7 +121,7 @@ equal_graphs_helper(G1, G2) -> equal_entry_points({T, E1}, {T, E2}) -> case T of node -> E1 =:= E2; - cycle -> cuter_types:equal_sets(sets:from_list(E1), sets:from_list(E2)) + cycle -> cuter_types:are_sets_equal(sets:from_list(E1), sets:from_list(E2)) end; equal_entry_points(_, _) -> false. From 9e2c56ad7148dc0f7334e03bced0b5963ae01261 Mon Sep 17 00:00:00 2001 From: Dspil Date: Thu, 7 Apr 2022 19:29:42 +0200 Subject: [PATCH 83/85] changes from eval options pr --- src/cuter_eval.erl | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/cuter_eval.erl b/src/cuter_eval.erl index c4e2a32e..a754b8ac 100644 --- a/src/cuter_eval.erl +++ b/src/cuter_eval.erl @@ -36,6 +36,11 @@ }). -type valuelist() :: #valuelist{}. +%% Runtime options for the evaluator function of the interpreter. +-type eval_opts() :: #{constraintLogging := boolean(), + isForced := boolean(), + distrustTypeDependent := boolean()}. + %% ---------------------------------------------------------------------------- %% Types and macros used for storing the information of applying a lambda %% that has a symbolic value. @@ -146,7 +151,7 @@ eval(A, CAs, SAs, CallType, Servers, Fd) -> %% and not directly executed %% spawn/{1,2,3,4} & spawn_link/{1,2,3,4} --spec eval(eval(), [any()], [any()], calltype(), servers(), file:io_device(), maps:map()) -> result(). +-spec eval(eval(), [any()], [any()], calltype(), servers(), file:io_device(), eval_opts()) -> result(). eval({named, erlang, F}, CAs, SAs, _CallType, Servers, Fd, Options) when F =:= spawn; F =:= spawn_link -> Arity = length(CAs), SAs_e = cuter_symbolic:ensure_list(SAs, Arity, Fd), @@ -509,7 +514,7 @@ eval({letrec_func, {M, _F, Def, E}}, CAs, SAs, _CallType, Servers, Fd, Options) %% %% Evaluates a Core Erlang expression %% -------------------------------------------------------- --spec eval_expr(cerl:cerl(), module(), cuter_env:environment(), cuter_env:environment(), servers(), file:io_device(), maps:map()) -> result(). +-spec eval_expr(cerl:cerl(), module(), cuter_env:environment(), cuter_env:environment(), servers(), file:io_device(), eval_opts()) -> result(). %% c_apply eval_expr({c_apply, Anno, Op, Args}, M, Cenv, Senv, Servers, Fd, Options) -> From 45b5061c976cb0b9c749c5fa8a5b09e24104825c Mon Sep 17 00:00:00 2001 From: Dspil Date: Sun, 8 May 2022 23:36:18 +0200 Subject: [PATCH 84/85] comment and refactor cuter_spec_checker --- src/cuter_spec_checker.erl | 936 +++++++++++++++++++++++-------------- 1 file changed, 597 insertions(+), 339 deletions(-) diff --git a/src/cuter_spec_checker.erl b/src/cuter_spec_checker.erl index c92af83b..8b1abf0d 100644 --- a/src/cuter_spec_checker.erl +++ b/src/cuter_spec_checker.erl @@ -1,24 +1,50 @@ -module(cuter_spec_checker). -export([get_cerl_type/1, get_type_dependent_unreachable/1, annotate_types/3]). +%% ========== +%% Used types +%% ========== + +-type function_ast_dict() :: dict:dict(mfa(), cerl:cerl()). +-type function_sig_dict() :: dict:dict(mfa(), [erl_types:erl_type()]). +-type function_set() :: sets:set(mfa()). + %% ========================= -%% multi function annotation +%% Multi function annotation %% ========================= --spec annotate_types(dict:dict(), dict:dict(), sets:set()) -> dict:dict(). +%% Entry point for the type annotation of the function ASTs. +%% Arguments: +%% FunctionASTS: dictionary with Mfas as keys and ASTs as values. +%% Sigs: dictionary with Mfas as keys and lists of erl_types as values. +%% FSet: Set of all functions in the callgraph. +%% Returns: +%% The annotated function ASTs in a dictionary with their Mfas as keys. +-spec annotate_types(function_ast_dict(), function_sig_dict(), function_set()) -> function_ast_dict(). annotate_types(FunctionASTS, Sigs, FSet) -> + %% Initialize the symbol table using the original_tsm defined in cuter_type_dependent_functions + %% adding the signatures of the functions we want to annotate too. TSM = lists:foldl( fun ({MFA, Sig}, T) -> - dict:store(MFA, Sig, T) + dict:store(MFA, Sig, T) end, cuter_type_dependent_functions:original_tsm(), dict:to_list(Sigs) ), + %% NoSpec will hold the funtions with no signatures. + %% We need to know which of them do not originally have signatures + %% to allow altering their signature when we find calls to them. NoSpec = find_nospec(FSet, Sigs), + %% OpenSet will hold the Mfas of functions we want to traverse. + %% It also contains a persistence dictionary for each function to avoid + %% infinite loops in recursive letrec. OpenSet = make_open_set(FSet, Sigs), annotate_types_helper(FunctionASTS, TSM, OpenSet, NoSpec). +%% Performs the fix point computation over the functions in OpenSet. +%% While OpenSet has elements, the annotation algorithm is ran upon the +%% whole OpenSet. annotate_types_helper(FunctionASTS, TSM, OpenSet, NoSpec) -> case length(OpenSet) of 0 -> FunctionASTS; @@ -27,38 +53,56 @@ annotate_types_helper(FunctionASTS, TSM, OpenSet, NoSpec) -> annotate_types_helper(FASTS1, TSM1, OpenSet1, NoSpec) end. +%% Calls the annotation on each function in the OpenSet. annotate_types_helper_pass(FunctionASTS, TSM, OpenSet, NoSpec) -> + %% Do it with a tail recursive function. annotate_types_helper_pass(FunctionASTS, TSM, OpenSet, NoSpec, []). annotate_types_helper_pass(FunctionASTS, TSM, [], _NoSpec, OpenSet1) -> {FunctionASTS, TSM, lists:reverse(OpenSet1)}; -annotate_types_helper_pass(FunctionASTS, TSM, [{Mfa, Persistence}|Mfas], NoSpec, OpenSet1) -> +annotate_types_helper_pass(FunctionASTS, TSM, [{Mfa, Persistence}|Mfas], NoSpec, OpenSet1) -> + %% Fetch the function AST. AST = dict:fetch(Mfa, FunctionASTS), + %% Fetch the function Spec. Spec = dict:fetch(Mfa, TSM), + %% Add the persistene to the symbol table TSMP = merge_all_dicts([TSM, Persistence]), + %% Run the annotation on the AST. {NewAST, D, C, P} = pass_down_fun_types(Mfa, AST, Spec, TSMP, NoSpec), + %% Update the symbol table and the open set. {TSM1, OpenSet2} = update_from_detected(D, TSM, OpenSet1), + %% If there has been some change in the annotations of the funtion or + %% calls to functions that do not much the current signature have been detected: case C or (length(D) > 0) of - true -> + true -> %% Add the functions that should be traversed again in OpenSet. OpenSet3 = update_open_set(Mfa, P, OpenSet2); - false -> + false -> %% Else do not update the OpenSet. OpenSet3 = OpenSet2 end, + %% Check if the current function is part of the NoSpec set. case sets:is_element(Mfa, NoSpec) of - true -> + true -> %% If it is then + %% fetch its type from its AST. T = get_cerl_type(NewAST), + %% Check if it has been typed succesfully. case erl_types:is_erl_type(T) of - true -> - [S] = dict:fetch(Mfa, TSM1), - NewS = erl_types:t_fun(erl_types:t_fun_args(S), T), - TSM2 = dict:store(Mfa, [NewS], TSM1); - false -> TSM2 = TSM1 + true -> %% If it has then + %% update its signature in the symbol table. + [S] = dict:fetch(Mfa, TSM1), + NewS = erl_types:t_fun(erl_types:t_fun_args(S), T), + TSM2 = dict:store(Mfa, [NewS], TSM1); + false -> TSM2 = TSM1 end; false -> TSM2 = TSM1 end, + %% Update its AST in the dictionary. NewASTS = dict:store(Mfa, NewAST, FunctionASTS), annotate_types_helper_pass(NewASTS, TSM2, Mfas, NoSpec, OpenSet3). +%% Updates the open set for a specific Mfa. +%% If this Mfa is already in the open set, +%% puts it in the end of the open set, else +%% just append it. update_open_set(Mfa, P, OpenSet) -> lists:reverse([{Mfa, P}|update_open_set1(Mfa, OpenSet, [])]). @@ -68,6 +112,9 @@ update_open_set1(Mfa, [{Mfa, _P}|Rest], Acc) -> update_open_set1(Mfa, [A|R], Acc) -> update_open_set1(Mfa, R, [A|Acc]). +%% Updates the open set and symbol table +%% from detected function calls +%% to functions that are in the NoSpec set. update_from_detected([], TSM, OpenSet) -> {TSM, OpenSet}; update_from_detected([{Mfa, Spec}|Rest], TSM, OpenSet) -> OpenSet1 = [{Mfa, dict:new()}|OpenSet], @@ -79,24 +126,30 @@ update_from_detected([{Mfa, Spec}|Rest], TSM, OpenSet) -> end, update_from_detected(Rest, TSM1, OpenSet1). +%% Finds which functions don't have a signature from the Fset. find_nospec(FSet, Sigs) -> Fn = fun(F) -> not dict:is_key(F, Sigs) end, sets:filter(Fn, FSet). +%% Creates the initial open set. +%% The open set is just a queue containing tuples of the form: +%% {Mfa, Persistence} make_open_set(FSet, Sigs) -> Fn = fun(F) -> - case dict:is_key(F, Sigs) of - true -> length(dict:fetch(F, Sigs)) =:= 1; - false -> false - end + case dict:is_key(F, Sigs) of + true -> length(dict:fetch(F, Sigs)) =:= 1; + false -> false + end end, O1 = sets:to_list(sets:filter(Fn, FSet)), [{X, dict:new()} || X <- O1]. %% ========================== -%% single function annotation +%% Single function annotation %% ========================== +%% Returns the type type of a node given its list of annotations. +%% The type could be an erl_type or 'notype'. get_type([]) -> notype; get_type([Hd|Tl]) -> case Hd of @@ -106,9 +159,11 @@ get_type([Hd|Tl]) -> get_type(Tl) end. +%% Same as get_type but it is given the actual cerl node. -spec get_cerl_type(cerl:cerl()) -> erl_types:erl_type() | notype. get_cerl_type(T) -> get_type(cerl:get_ann(T)). +%% Updates the type of a cerl node to the given one altering its annotation list. update_type(Tree, Type) -> Anno = cerl:get_ann(Tree), cerl:set_ann(Tree, update_type(Anno, Type, [], false)). @@ -118,6 +173,8 @@ update_type([], _, Acc, true) -> Acc; update_type([{node_type, _}|T], Type, Acc, _) -> update_type(T, Type, [{node_type, Type}|Acc], true); update_type([H|T], Type, Acc, Found) -> update_type(T, Type, [H|Acc], Found). +%% Adds the annotation 'type_dependent_unreachable' to the list of annotations +%% of the given cerl node representing a case clause. mark_as_unreachable(Clause) -> Anno = cerl:get_ann(Clause), case cuter_graphs:list_contains(type_dependent_unreachable, Anno) of @@ -127,10 +184,14 @@ mark_as_unreachable(Clause) -> Clause end. +%% Removes the 'type_dependent_unreachable' annotation from the list of annotations +%% of a case clause. mark_as_reachable(Clause) -> Anno = [T || T <- cerl:get_ann(Clause), T =/= type_dependent_unreachable], cerl:set_ann(Clause, Anno). +%% Returns whether the tree node has a type in its annotations. +%% If the tree node has the type 'notype' then it is considered as not having a type. has_type(Tree) -> Anno = cerl:get_ann(Tree), lists:foldl( @@ -138,18 +199,23 @@ has_type(Tree) -> false, lists:map( fun(A) -> - case A of - {node_type, T} when T =/= notype -> true; - _ -> false - end + case A of + {node_type, T} when T =/= notype -> true; + _ -> false + end end, Anno ) ). +%% Returns a list of types given a list of cerl nodes. arg_types(Args) -> lists:map(fun get_cerl_type/1, Args). +%% Returns a list of argument types of a 'let' node. +%% If the 'let' node is just on one term, it returns a list containint +%% just the type of this term. If it is a 'values' node, it returns a list +%% containing all of the types inside the 'values' node. let_arg_types(Arg) -> case cerl:type(Arg) of values -> @@ -157,46 +223,55 @@ let_arg_types(Arg) -> _ -> [get_cerl_type(Arg)] end. +%% Introduces variables Vars in the symbol table TSM with types Types. put_vars(Vars, Types, TSM) -> F = fun({Var, Type}, B) -> - case Type of - notype -> B; - [notype] -> B; - _ -> dict:store(cerl:var_name(Var), Type, B) - end + case Type of + notype -> B; + [notype] -> B; + _ -> dict:store(cerl:var_name(Var), Type, B) + end end, lists:foldl(F, TSM, lists:zip(Vars, Types)). %% ===================== -%% helper type functions +%% Helper type functions %% ===================== +%% Takes a cerl node representing a pattern in a case clause and +%% creates an equivalent erl_type. It takes TSM2 as an argument, +%% which holds all the variables contained in the guard of the specific +%% clause. If these variables are encountered, they get replaced by the +%% erl_type they are forced to have by the guard. If any other variables +%% are encountered, they are either replaced with erl_types:t_any() if they +%% are not in the symbol table or erl_types:t_none() if they exist in the +%% symbol table. t_from_pattern(Tree, TSM, TSM2) -> case cerl:type(Tree) of literal -> erl_types:t_from_term(element(3, Tree)); var -> case dict:find(cerl:var_name(Tree), TSM2) of - {ok, Type} -> - Type; - error -> - case dict:find(cerl:var_name(Tree), TSM) of - {ok, _} -> erl_types:t_none(); - error -> - erl_types:t_any() - end + {ok, Type} -> + Type; + error -> + case dict:find(cerl:var_name(Tree), TSM) of + {ok, _} -> erl_types:t_none(); + error -> + erl_types:t_any() + end end; cons -> Hd = t_from_pattern(cerl:cons_hd(Tree), TSM, TSM2), Tl = t_from_pattern(cerl:cons_tl(Tree), TSM, TSM2), case erl_types:t_is_nil(Tl) of - true -> erl_types:t_none(); - false -> - case erl_types:t_is_none(Tl) of - true -> erl_types:t_none(); - false -> erl_types:t_cons(Hd, Tl) - end + true -> erl_types:t_none(); + false -> + case erl_types:t_is_none(Tl) of + true -> erl_types:t_none(); + false -> erl_types:t_cons(Hd, Tl) + end end; tuple -> Es = lists:map(fun(E) -> t_from_pattern(E, TSM, TSM2) end, cerl:tuple_es(Tree)), @@ -207,127 +282,161 @@ t_from_pattern(Tree, TSM, TSM2) -> _ -> erl_types:t_none() end. +%% Returns the type of the result of a function call +%% given the types of its arguments. application_type(Spec, ArgTypes) when not is_list(Spec) -> application_type([Spec], ArgTypes); application_type([], _) -> error; application_type([Spec|Specs], ArgTypes) -> SpecArgs = erl_types:t_fun_args(Spec), case lists:foldl( - fun erlang:'and'/2, - true, - lists:zipwith( - fun erl_types:t_is_subtype/2, - lists:map( - fun(A) -> - case A of - notype -> erl_types:t_any(); - B -> B - end - end, - ArgTypes), - SpecArgs)) of + fun erlang:'and'/2, + true, + lists:zipwith( + fun erl_types:t_is_subtype/2, + lists:map( + fun(A) -> + case A of + notype -> erl_types:t_any(); + B -> B + end + end, + ArgTypes), + SpecArgs)) of true -> {ok, erl_types:t_fun_range(Spec)}; false -> application_type(Specs, ArgTypes) end. +%% Just a wrapper of erl_types:t_sup/1 to create a union. t_union(Types) -> - t_union(Types, erl_types:t_none()). - -t_union([], T) -> T; -t_union([Type|Types], T) -> t_union(Types, erl_types:t_sup(Type, T)). + erl_types:t_sup(Types). +%% The term unify is not exact in this case. +%% This function takes a cerl node of a clause pattern +%% and an erl_type. Its purpose is to find the values of +%% all variables in the cerl tree, such that if this cerl +%% tree was an erl_type, it would be a valid subtype of +%% Type. Again, TSM is the symbol table and TSM2 holds all the +%% variables encountered in the guard of the clause with their +%% constrained types. unify_pattern(Tree, TSM, TSM2, Type) -> + %% We distinguish cases depending on the type of the cerl node Tree. case cerl:type(Tree) of literal -> + %% If it is a literal, then we have no variables left to assign types. {ok, TSM}; var -> + %% If it is a var, we check whether it is in the symbol table. case dict:find(cerl:var_name(Tree), TSM) of - {ok, VarType} -> - try erl_types:t_unify(VarType, Type) of - _ -> {ok, TSM} - catch - _ -> - {error, mismatch} - end; - error -> - case dict:find(cerl:var_name(Tree), TSM2) of - {ok, VarGuardType} -> - case erl_types:t_is_subtype(Type, VarGuardType) of - true -> {ok, dict:store(cerl:var_name(Tree), VarGuardType, TSM)}; - false -> {error, mismatch} - end; - error -> - {ok, dict:store(cerl:var_name(Tree), Type, TSM)} - end + {ok, VarType} -> + %% If it is, then we check whether its type can be unified + %% with Type. + try erl_types:t_unify(VarType, Type) of + _ -> {ok, TSM} + catch + _ -> {error, mismatch} + end; + error -> + %% If it is not, then we check if it is a part of TSM2. + case dict:find(cerl:var_name(Tree), TSM2) of + {ok, VarGuardType} -> + %% If it is, then if it is a supertype of Type, we store it in the symbol table + case erl_types:t_is_subtype(Type, VarGuardType) of + true -> {ok, dict:store(cerl:var_name(Tree), VarGuardType, TSM)}; + false -> {error, mismatch} + end; + error -> + %% If it is a new variable, it has to have the type Type. + {ok, dict:store(cerl:var_name(Tree), Type, TSM)} + end end; cons -> + %% If it is a cons, we check if Type is a list. case erl_types:t_is_list(Type) of - true -> - NewType = erl_types:t_nonempty_list(erl_types:t_list_elements(Type)), - Hdt = unify_pattern(cerl:cons_hd(Tree), TSM, TSM2, erl_types:t_cons_hd(NewType)), - case Hdt of - {ok, TSM1} -> - Tlt = unify_pattern(cerl:cons_tl(Tree), TSM1, TSM2, erl_types:t_cons_tl(NewType)), - case Tlt of - {ok, TSMnew} -> {ok, TSMnew}; - _ -> {error, mismatch} - end; - _ -> - {error, mismatch} - end; - false -> - try_to_handle_union(Tree, TSM, TSM2, Type, erl_types:t_list()) + true -> + %% If it is, we recursively do the same for its values. + NewType = erl_types:t_nonempty_list(erl_types:t_list_elements(Type)), + Hdt = unify_pattern(cerl:cons_hd(Tree), TSM, TSM2, erl_types:t_cons_hd(NewType)), + case Hdt of + {ok, TSM1} -> + Tlt = unify_pattern(cerl:cons_tl(Tree), TSM1, TSM2, erl_types:t_cons_tl(NewType)), + case Tlt of + {ok, TSMnew} -> {ok, TSMnew}; + _ -> {error, mismatch} + end; + _ -> + {error, mismatch} + end; + false -> + %% If Type is not a list, it might be a union of a list and something else. + %% In this case, we want to do this procedure for the list part of the union, + %% which is done with the function below. + try_to_handle_union(Tree, TSM, TSM2, Type, erl_types:t_list()) end; tuple -> + %% Tuple is similar to list. We check if Type is also a tuple. case erl_types:t_is_tuple(Type) of - true -> - Type1 = - try erl_types:t_tuple_size(Type) of - _ -> Type - catch - _:_ -> erl_types:t_tuple(length(cerl:tuple_es(Tree))) - end, - case length(cerl:tuple_es(Tree)) == erl_types:t_tuple_size(Type1) of - true -> - lists:foldl( - fun({E, Et}, V) -> - case V of - {ok, V1} -> - unify_pattern(E, V1, TSM2, Et); - {error, _} -> - {error, mismatch} - end - end, - {ok, TSM}, - lists:zip(cerl:tuple_es(Tree), erl_types:t_tuple_args(Type1)) - ); - false -> {error, mismatch} - end; - false -> - try_to_handle_union(Tree, TSM, TSM2, Type, erl_types:t_tuple()) + true -> + %% If it is, we recursively do this procedure for its values. + Type1 = + try erl_types:t_tuple_size(Type) of + _ -> Type + catch + _:_ -> erl_types:t_tuple(length(cerl:tuple_es(Tree))) + end, + case length(cerl:tuple_es(Tree)) == erl_types:t_tuple_size(Type1) of + true -> + lists:foldl( + fun({E, Et}, V) -> + case V of + {ok, V1} -> + unify_pattern(E, V1, TSM2, Et); + {error, _} -> + {error, mismatch} + end + end, + {ok, TSM}, + lists:zip(cerl:tuple_es(Tree), erl_types:t_tuple_args(Type1)) + ); + false -> {error, mismatch} + end; + false -> + %% If it is not, it might be a union of a tuple and something else. + %% Again, we would want to do this procedure for the tuple part of the list. + try_to_handle_union(Tree, TSM, TSM2, Type, erl_types:t_tuple()) end; _ -> + %% TODO: maps, bistrings. For now we just return TSM as is. If we don't + %% add the variables in the symbol table, they won't be constrained, so + %% we will overaproximate any subsequent types. This might result in + %% some nodes being annotated with 'maybe_error' equal to true, which + %% is pessimistic and leaves our analysis sound. {ok, TSM} end. +%% Checks whether Type is a union. If it is, then it tries +%% to call unify_pattern/4 with the part of the union we +%% are interested in. try_to_handle_union(Tree, TSM, TSM2, Type, T) -> case erl_types:is_erl_type(Type) andalso erl_types:is_erl_type(T) of true -> H = erl_types:t_subtract(Type, (erl_types:t_subtract(Type, T))), case erl_types:t_is_none(H) of - true -> {error, mismatch}; - false -> unify_pattern(Tree, TSM, TSM2, H) + true -> {error, mismatch}; + false -> unify_pattern(Tree, TSM, TSM2, H) end; false -> {error, mismatch} end. %% ================== -%% passing down types +%% Passing down types %% ================== +%% This is the entry point for annotating the AST +%% of a function with type information in each node. pass_down_fun_types({M, _F, _A}, AST, Spec, TSM, NoSpec) -> pass_down_types_helper(AST, Spec, TSM, M, NoSpec). @@ -336,6 +445,26 @@ pass_down_types_helper(Fun, Spec, TSM, Mod, NoSpec) -> {Body, D, C, _DC, P} = pass_down_types(cerl:fun_body(Fun), TSM2, Mod, notype, NoSpec, sets:new()), {cerl:update_c_fun(Fun, cerl:fun_vars(Fun), Body), D, C, P}. +%% Core of the analysis. +%% Arguments: +%% - Tree: The AST node under consideration. +%% - TSM: Symbol table. It is a dictionary containint types of functiosn and variables. +%% - Mod: The module in which the function is defined. +%% - ArgType: Holds the type of the argument of the case construct this node is enclosed in (if there is one). +%% - NoSpec: The set containing all the functions that originally had no specification. +%% - Closures: A symbol table-like dictionary for closures defined in the function we are annotating. +%% Returns: +%% 1. The same tree node annotated with type information. +%% 2. A list of tuples of the form {Mfa, erl_type} corresponding to calls to functions encountered +%% belonging to NoSpec with their newly calculated types. +%% 3. A boolean value representing whether annotations have changed in the current node or its children. +%% This is used for the fix-point computation. +%% 4. Similar to 2 but for closures because let_rec nodes do their own fix-point computation. +%% 5. Persistence table. It contains all the variables encountered inside closures so they are appended +%% to the symbol table if a function is annotated again. This way no infinite loops happen. +%% Most node types don't perform any serious calculation. They just call this function recursively +%% on their children and use combine the results to assign a type on themselves and return the +%% desired values. Some nodes need more logic so they have their own functions. pass_down_types(Tree, TSM, Mod, ArgType, NoSpec, Closures) -> CurType = get_cerl_type(Tree), case cerl:type(Tree) of @@ -358,22 +487,26 @@ pass_down_types(Tree, TSM, Mod, ArgType, NoSpec, Closures) -> cons -> {Hd, D1, C1, CD1, P1} = pass_down_types(cerl:cons_hd(Tree), TSM, Mod, ArgType, NoSpec, Closures), {Tl, D2, C2, CD2, P2} = pass_down_types(cerl:cons_tl(Tree), TSM, Mod, ArgType, NoSpec, Closures), + %% Annotate types for head and tail. If at least one of them does not have a type, then + %% the whole list does not have a type either. Tree1 = - case {get_cerl_type(Hd), get_cerl_type(Tl)} of - {X, Y} when X =:= notype orelse Y =:= notype -> update_type(Tree, notype); - _ -> update_type(Tree, erl_types:t_cons(get_cerl_type(Hd), get_cerl_type(Tl))) - end, + case {get_cerl_type(Hd), get_cerl_type(Tl)} of + {X, Y} when X =:= notype orelse Y =:= notype -> update_type(Tree, notype); + _ -> update_type(Tree, erl_types:t_cons(get_cerl_type(Hd), get_cerl_type(Tl))) + end, Change = C1 or C2 or (CurType =/= get_cerl_type(Tree1)), P = merge_all_dicts([P1, P2]), {cerl:update_c_cons(Tree1, Hd, Tl), D1 ++ D2, Change, CD1 ++ CD2, P}; tuple -> + %% Annotate types for all members of the tuple. If at least one does not have a type, + %% mark the tuple as having no type as well. {Es, D, C, CD, P} = pass_down_types_all(cerl:tuple_es(Tree), TSM, Mod, ArgType, NoSpec, Closures), Tree1 = - case lists:foldl(fun(X, Y) -> Y orelse (get_cerl_type(X) =:= notype) end, false, Es) of - true -> - update_type(Tree, notype); - false -> update_type(Tree, erl_types:t_tuple(lists:map(fun get_cerl_type/1, Es))) - end, + case lists:foldl(fun(X, Y) -> Y orelse (get_cerl_type(X) =:= notype) end, false, Es) of + true -> + update_type(Tree, notype); + false -> update_type(Tree, erl_types:t_tuple(lists:map(fun get_cerl_type/1, Es))) + end, Change = C or (CurType =/= get_cerl_type(Tree1)), {cerl:update_c_tuple(Tree1, Es), D, Change, CD, P}; 'fun' -> @@ -385,6 +518,7 @@ pass_down_types(Tree, TSM, Mod, ArgType, NoSpec, Closures) -> literal -> {update_type(Tree, erl_types:t_from_term(element(3, Tree))), [], false, [], dict:new()}; seq -> + %% The type of a seq node is the type of its body. {Arg, D1, C1, CD1, P1} = pass_down_types(cerl:seq_arg(Tree), TSM, Mod, ArgType, NoSpec, Closures), {Body, D2, C2, CD2, P2} = pass_down_types(cerl:seq_body(Tree), TSM, Mod, ArgType, NoSpec, Closures), Change = C1 or C2 or (CurType =/= get_cerl_type(Body)), @@ -402,75 +536,112 @@ pass_down_types(Tree, TSM, Mod, ArgType, NoSpec, Closures) -> P = merge_all_dicts([P1, P2, P3, P4, P5]), {cerl:update_c_try(update_type(Tree, get_cerl_type(Body)), Arg, Vars, Body, Evars, Handler), D, Change, CD, P}; primop -> + %% We do not assign a type to a primop because it is considered to produce + %% errors by the subsequent analysis. {update_type(Tree, notype), [], false, [], dict:new()}; values -> + %% The type of a values node is a tuple type with elements the types of the children of the values node. + %% This holds if all of them have a valid type. {Es, D1, C1, CD1, P1} = pass_down_types_all(cerl:values_es(Tree), TSM, Mod, ArgType, NoSpec, Closures), case lists:all(fun has_type/1, Es) of - true -> - {cerl:update_c_values(update_type(Tree, erl_types:t_tuple([get_cerl_type(T) || T <- Es])), Es), D1, C1, CD1, P1}; - false -> - {cerl:update_c_values(update_type(Tree, notype), Es), D1, C1 or (CurType =/= notype), CD1, P1} + true -> + {cerl:update_c_values(update_type(Tree, erl_types:t_tuple([get_cerl_type(T) || T <- Es])), Es), D1, C1, CD1, P1}; + false -> + {cerl:update_c_values(update_type(Tree, notype), Es), D1, C1 or (CurType =/= notype), CD1, P1} end; var -> + %% The type of a variable is the type it has been found to have in the symbol table. + %% If it is not in the symbol table then it has no type. case dict:find(cerl:var_name(Tree), TSM) of - {ok, Type} -> - {update_type(Tree, Type), [], false, [], dict:new()}; - _ -> {update_type(Tree, notype), [], false, [], dict:new()} + {ok, Type} -> + {update_type(Tree, Type), [], false, [], dict:new()}; + _ -> {update_type(Tree, notype), [], false, [], dict:new()} end; - _ -> + _ -> + %% Catches rest not supported nodes. It annotates them with no type. This + %% might make nodes that are safe seem unsafe by the subsequent analysis + %% but not the other way around so we are sound. {Tree, [], false, [], dict:new()} end. +%% Logic for when the tree is an apply node. +%% Arguments and rerurn values are the same as pass_down_types/6 +%% with the current type additionally passed as an argument. pass_down_types_apply(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> + %% Annotate types for arguments of the apply. {Args, D1, C1, CD1, P1} = pass_down_types_all(cerl:apply_args(Tree), TSM, Mod, ArgType, NoSpec, Closures), + %% Fetch the apply operation. Op = cerl:apply_op(Tree), {Tree1, D2, C2, CD2} = + %% Check if all arguments have types. case lists:all(fun has_type/1, Args) of true -> - case cerl:type(Op) of - var -> - OpN = case cerl:var_name(Op) of {F, A} -> {Mod, F, A}; Name -> Name end, - case dict:find(OpN, TSM) of - {ok, Specs} -> - case application_type(Specs, arg_types(Args)) of - {ok, Type} -> - {update_type(Tree, Type), D1, false, CD1}; - error -> - case sets:is_element(OpN, NoSpec) of - true -> - NewSpec = rewrite_spec(arg_types(Args), Specs), - {Tree, [{OpN, NewSpec} | D1], true, CD1}; - false -> - case sets:is_element(OpN, Closures) of - true -> - NewSpec = rewrite_spec(arg_types(Args), Specs), - {Tree, D1, true, [{OpN, NewSpec} | CD1]}; - false -> - {Tree, D1, false, CD1} - end - end - end; - error -> - case sets:is_element(OpN, NoSpec) of - true -> - {Tree, [{OpN, erl_types:t_fun(arg_types(Args), erl_types:t_any())} | D1], true, CD1}; - false -> - case sets:is_element(OpN, Closures) of - true -> - {Tree, D1, true, [{OpN, erl_types:t_fun(arg_types(Args), erl_types:t_any())} | CD1]}; - false-> - {Tree, D1, false, CD1} - end - end - end; - _ -> - error("unhandled op") - end; + %% If they do then distinguish between the possible forms of Op. + case cerl:type(Op) of + var -> + %% If Op is a variable, create the Mfa using the module we are currently in. + OpN = case cerl:var_name(Op) of {F, A} -> {Mod, F, A}; Name -> Name end, + %% Search for the function in the symbol table. + case dict:find(OpN, TSM) of + {ok, Specs} -> + %% If it is in the symbol table, fetch the type of the application. + case application_type(Specs, arg_types(Args)) of + {ok, Type} -> + %% If it is a valid type, we use this as the type of the apply node. + {update_type(Tree, Type), D1, false, CD1}; + error -> + %% Else the function may be in the NoSpec set and we have to update its signature + %% to satisfy this call. + case sets:is_element(OpN, NoSpec) of + true -> + %% If it is find its new type. + NewSpec = rewrite_spec(arg_types(Args), Specs), + {Tree, [{OpN, NewSpec} | D1], true, CD1}; + false -> + %% If it is not, it might be a closure. + case sets:is_element(OpN, Closures) of + true -> + %% If it is, update its spec. + NewSpec = rewrite_spec(arg_types(Args), Specs), + {Tree, D1, true, [{OpN, NewSpec} | CD1]}; + false -> + %% If it is not, don't update the tree node. + {Tree, D1, false, CD1} + end + end + end; + error -> + %% If it is not in the symbol table, then it might not have a spec. + case sets:is_element(OpN, NoSpec) of + true -> + %% If it is in the NoSpec set then compute its new spec. + {Tree, [{OpN, erl_types:t_fun(arg_types(Args), erl_types:t_any())} | D1], true, CD1}; + false -> + %% If it is not, it may be a closure. + case sets:is_element(OpN, Closures) of + true -> + %% If it is, calculate its new spec. + {Tree, D1, true, [{OpN, erl_types:t_fun(arg_types(Args), erl_types:t_any())} | CD1]}; + false-> + %% If it isn't leave the apply node as is. + {Tree, D1, false, CD1} + end + end + end; + _ -> + %% This shouldn't be reachable. + %% If we reach here it means that an apply was made to a variable, + %% that is not of the form {F, A}. + error("unhandled op") + end; _ -> {Tree, D1, false, CD1} end, Change = C1 or C2 or (CurType =/= get_cerl_type(Tree1)), {cerl:update_c_apply(Tree1, Op, Args), D2, Change, CD2, P1}. +%% Similar to the logic of the apply node. +%% It follows the same checks but disregards closures +%% since they would be called through an apply node. pass_down_types_call(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> {Args, D1, C1, CD1, P1} = pass_down_types_all(cerl:call_args(Tree), TSM, Mod, ArgType, NoSpec, Closures), ModName = cerl:call_module(Tree), @@ -479,86 +650,102 @@ pass_down_types_call(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> {Tree1, D2, C2} = case lists:all(fun has_type/1, Args) of true -> - case cerl:is_literal(ModName) andalso cerl:is_literal(Name) of - true -> - OpN = {element(3, ModName), element(3, Name), Arity}, - case dict:find(OpN, TSM) of - {ok, Specs} -> - case application_type(Specs, arg_types(Args)) of - {ok, Type} -> - {update_type(Tree, Type), D1, false}; - _ -> - case sets:is_element(OpN, NoSpec) of - true -> - NewSpec = rewrite_spec(arg_types(Args), Specs), - {Tree, [{OpN, NewSpec} | D1], true}; - false -> {Tree, D1, false} - end - end; - error -> - case sets:is_element(OpN, NoSpec) of - true -> - {Tree, [{OpN, erl_types:t_fun(arg_types(Args), erl_types:t_any())} | D1], true}; - false -> - {Tree, D1, false} - end - end; - _ -> throw("Unsupported call") - end; + case cerl:is_literal(ModName) andalso cerl:is_literal(Name) of + true -> + OpN = {element(3, ModName), element(3, Name), Arity}, + case dict:find(OpN, TSM) of + {ok, Specs} -> + case application_type(Specs, arg_types(Args)) of + {ok, Type} -> + {update_type(Tree, Type), D1, false}; + _ -> + case sets:is_element(OpN, NoSpec) of + true -> + NewSpec = rewrite_spec(arg_types(Args), Specs), + {Tree, [{OpN, NewSpec} | D1], true}; + false -> {Tree, D1, false} + end + end; + error -> + case sets:is_element(OpN, NoSpec) of + true -> + {Tree, [{OpN, erl_types:t_fun(arg_types(Args), erl_types:t_any())} | D1], true}; + false -> + {Tree, D1, false} + end + end; + _ -> throw("Unsupported call") + end; _ -> {Tree, D1, false} end, Change = C1 or C2 or (CurType =/= get_cerl_type(Tree1)), {cerl:update_c_call(Tree1, ModName, Name, Args), D2, Change, CD1, P1}. +%% Handles case nodes. In case nodes we also have to annotate clauses that +%% are unreachable using the type data with the annotation 'type_dependent_unreachable'. pass_down_types_case(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> + %% Call recursively for argument and clauses. {Arg, D1, C1, CD1, P1} = pass_down_types(cerl:case_arg(Tree), TSM, Mod, ArgType, NoSpec, Closures), {Clauses1, D2, C2, CD2, P2} = pass_down_types_all(cerl:case_clauses(Tree), TSM, Mod, get_cerl_type(Arg), NoSpec, Closures), + %% Then mark unreachable clauses. Clauses = mark_unreachable_clauses(Clauses1, get_cerl_type(Arg), TSM, Arg), Clauses2 = [Clause || Clause <- Clauses, not get_type_dependent_unreachable(Clause)], + %% The type of the case node is the union of all types of reachable clauses. Type = case lists:all(fun has_type/1, Clauses2) of true -> - T = arg_types(Clauses2), - case cuter_graphs:list_contains(notype, T) of - true -> notype; - false -> t_union(T) - end; + T = arg_types(Clauses2), + case cuter_graphs:list_contains(notype, T) of + true -> notype; + false -> t_union(T) + end; false -> - notype + notype end, Change = C1 or C2 or (CurType =/= Type), P = merge_all_dicts([P1, P2]), {cerl:update_c_case(update_type(Tree, Type), Arg, Clauses), D1 ++ D2, Change, CD1 ++ CD2, P}. +%% Handles clause nodes. pass_down_types_clause(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> + %% Define a closure to map to all patterns of the clause. + %% This closure creates the symbol table containing all the variables + %% constrained by the guard, and calls unify_pattern/4 to create + %% the updated symbol table for the clause. Fn = fun({Pat, AType}, V) -> - case V of - {ok, V1} -> - {A, TSMorT} = update_tsm_from_guard(Tree, V1, []), - case A of - tsm -> - unify_pattern(Pat, V1, TSMorT, AType); - _ -> - unify_pattern(Pat, V1, dict:new(), AType) - end; - {error, mismatch} -> {error, mismatch} - end + case V of + {ok, V1} -> + {A, TSMorT} = update_tsm_from_guard(Tree, V1, []), + case A of + tsm -> + unify_pattern(Pat, V1, TSMorT, AType); + _ -> + unify_pattern(Pat, V1, dict:new(), AType) + end; + {error, mismatch} -> {error, mismatch} + end end, + %% Check if there are more than one pattern. case length(cerl:clause_pats(Tree)) > 1 of true -> + %% If there are, check if ArgType is a tuple. case erl_types:t_is_tuple(ArgType) of - true -> - ATypes = erl_types:t_tuple_args(ArgType), - case length(ATypes) =:= length(cerl:clause_pats(Tree)) of - true -> - ArgTypes = ATypes; - false -> - ArgTypes = [notype || _ <- cerl:clause_pats(Tree)] - end; - false -> ArgTypes = [notype || _ <- cerl:clause_pats(Tree)] + true -> + %% If it is, get the types of the elements of ArgType. + ATypes = erl_types:t_tuple_args(ArgType), + %% These should be as many as the patterns. + case length(ATypes) =:= length(cerl:clause_pats(Tree)) of + true -> + ArgTypes = ATypes; + false -> + ArgTypes = [notype || _ <- cerl:clause_pats(Tree)] + end; + false -> ArgTypes = [notype || _ <- cerl:clause_pats(Tree)] end; false -> ArgTypes = [ArgType] end, + %% Check if ArgTypes have the same length as the patterns (check for just one pattern). + %% Then use Fn to create the new symbol table. case length(ArgTypes) =/= length(cerl:clause_pats(Tree)) of true -> TSMt = {error, arglen}; @@ -571,6 +758,7 @@ pass_down_types_clause(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> {error, _} -> TSM1 = TSM end, + %% Use the new symbol table to pass down the types to all children and return normally. {Pats, D1, C1, CD1, P1} = pass_down_types_all(cerl:clause_pats(Tree), TSM1, Mod, ArgType, NoSpec, Closures), {Guard, D2, C2, CD2, P2} = pass_down_types(cerl:clause_guard(Tree), TSM1, Mod, ArgType, NoSpec, Closures), {Body, D3, C3, CD3, P3} = pass_down_types(cerl:clause_body(Tree), TSM1, Mod, ArgType, NoSpec, Closures), @@ -580,35 +768,44 @@ pass_down_types_clause(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> P = merge_all_dicts([P1, P2, P3]), {cerl:update_c_clause(update_type(Tree, get_cerl_type(Body)), Pats, Guard, Body), D, Change, CD, P}. +%% Handles a fun node. pass_down_types_fun(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> + %% Add the function variables to the symbol table. TSM1 = put_vars(cerl:fun_vars(Tree), [erl_types:t_any() || _ <- cerl:fun_vars(Tree)], TSM), + %% Annotate them, we can since they are in the symbol table. {Vars, _D1, _C1, _CD1, _P1} = pass_down_types_all(cerl:fun_vars(Tree), TSM1, Mod, ArgType, NoSpec, Closures), + %% Annotate the body. {Body, D1, C1, CD1, P1} = pass_down_types(cerl:fun_body(Tree), TSM1, Mod, ArgType, NoSpec, Closures), + %% Create the new function type of the node. Tree1 = case has_type(Body) of true -> - case get_cerl_type(Body) of - notype -> update_type(Tree, notype); - _ -> - Type = erl_types:t_fun([erl_types:t_any() || _ <- cerl:fun_vars(Tree)], get_cerl_type(Body)), - update_type(Tree, Type) - end; + case get_cerl_type(Body) of + notype -> update_type(Tree, notype); + _ -> + Type = erl_types:t_fun([erl_types:t_any() || _ <- cerl:fun_vars(Tree)], get_cerl_type(Body)), + update_type(Tree, Type) + end; _ -> update_type(Tree, notype) end, Change = C1 or (CurType =/= get_cerl_type(Tree1)), {cerl:update_c_fun(Tree1, Vars, Body), D1, Change, CD1, P1}. +%% Handles a let node. pass_down_types_let(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> + %% Find the types of the assigned values to variables. {Arg, D1, C1, CD1, P1} = pass_down_types(cerl:let_arg(Tree), TSM, Mod, ArgType, NoSpec, Closures), + %% Put the variables to the symbol table. TSM1 = put_vars(cerl:let_vars(Tree), let_arg_types(Arg), TSM), {Vars, D2, C2, CD2, P2} = pass_down_types_all(cerl:let_vars(Tree), TSM1, Mod, ArgType, NoSpec, Closures), {Body, D3, C3, CD3, P3} = pass_down_types(cerl:let_body(Tree), TSM1, Mod, ArgType, NoSpec, Closures), + %% The type of a let node is the type of its body. Tree1 = case has_type(Body) of true -> - update_type(Tree, get_cerl_type(Body)); + update_type(Tree, get_cerl_type(Body)); false -> - update_type(Tree, notype) + update_type(Tree, notype) end, Change = C1 or C2 or C3 or (CurType =/= get_cerl_type(Tree1)), D = lists:append([D1, D2, D3]), @@ -616,25 +813,41 @@ pass_down_types_let(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> P = merge_all_dicts([P1, P2, P3]), {cerl:update_c_let(Tree1, Vars, Arg, Body), D, Change, CD, P}. +%% Handles a letrec node. +%% Since this node introduces closures, we need to do a fix-point computation +%% Similar to the top one for all functions. That is because closures initially +%% don't have a signature since the programmer does not provide one. They also +%% can be recursive in case they are compiler generated for list comprehensions. pass_down_types_letrec(Tree, TSM, Mod, ArgType, NoSpec, Closures, CurType) -> {Names, Funsb} = lists:unzip(cerl:letrec_defs(Tree)), FunNames = [cerl:var_name(Name) || Name <- Names], FunNames1 = sets:from_list([{Mod, F, A} || {F, A} <- FunNames]), + %% Add the new closures to the set of closures. NewClosures = sets:union(Closures, FunNames1), + %% Do the fix-point computation. {Funs, Body, D, C, CD, TSM1} = pass_down_types_letrec_fix(Names, Funsb, cerl:letrec_body(Tree), TSM, Mod, ArgType, NoSpec, NewClosures), + %% Filter out all functions that are introduced in other letrec ndoes to create FilterFun = fun(Key, _Value) -> sets:is_element(Key, FunNames1) end, + %% The peristence of the closures in this letrec node. Persistence = dict:filter(FilterFun, TSM1), - Change = C or (CurType =/= get_cerl_type(Body)), + Change = C or (CurType =/= get_cerl_type(Body)), + %% The type of the letrec node is the type of its body. {cerl:update_c_letrec(update_type(Tree, get_cerl_type(Body)), lists:zip(Names, Funs), Body), D, Change, CD, Persistence}. +%% Fix point computation for letrec nodes. pass_down_types_letrec_fix(Names, Funsb, Body, TSM, Mod, ArgType, NoSpec, Closures) -> FunNames1 = [cerl:var_name(Name) || Name <- Names], FunNames2 = [{Mod, F, A} || {F, A} <- FunNames1], FunNames = sets:from_list(FunNames2), + %% Do a pass through the functions. {Funs, D1, C1, CD1} = pass_down_types_letrec_fix_pass(FunNames2, Funsb, TSM, Mod, ArgType, NoSpec, Closures, []), + %% Do a pass through the body. {Body1, D2, C2, CD2, _P2} = pass_down_types(Body, TSM, Mod, ArgType, NoSpec, Closures), CD = CD1 ++ CD2, + %% Find all detected closure calls to closures that do not have yet a signature + %% or need their signature updated that belong to this letrec node. RelevantCD = [D || {OpN, _NewSpec}=D <- CD, sets:is_element(OpN, FunNames)], + %% If there are none, we are done, else we continue the fix-point. case length(RelevantCD) of 0 -> RestCD = [D || {OpN, _NewSpec}=D <- CD, not sets:is_element(OpN, FunNames)], @@ -644,6 +857,7 @@ pass_down_types_letrec_fix(Names, Funsb, Body, TSM, Mod, ArgType, NoSpec, Closur pass_down_types_letrec_fix(Names, Funs, Body1, TSM1, Mod, ArgType, NoSpec, Closures) end. +%% Performs a pass through the functions introduced in a letrec node. pass_down_types_letrec_fix_pass([], _Funsb, _TSM, _Mod, _ArgType, _NoSpec, _Closures, Acc) -> {Funs, D, C, CD, _P} = unzip5(Acc), {lists:reverse(Funs), lists:append(D), lists:foldl(fun erlang:'or'/2, false, C), lists:append(CD)}; @@ -659,11 +873,13 @@ pass_down_types_letrec_fix_pass([Name|Names], [Funb|Funsb], TSM, Mod, ArgType, N Fun = cerl:update_c_fun(Funb, Args, Body), pass_down_types_letrec_fix_pass(Names, Funsb, TSM, Mod, ArgType, NoSpec, Closures, [{Fun, D, C, CD, P}|Acc]). +%% Wrapper to call pass_down_types/6 to a list of nodes. pass_down_types_all(Trees, TSM, Mod, ArgType, NoSpec, Closures) -> R = lists:map(fun(A) -> pass_down_types(A, TSM, Mod, ArgType, NoSpec, Closures) end, Trees), {NewTrees, AllDetected, Changes, ClosuresDetected, Persistence} = unzip5(R), {NewTrees, lists:append(AllDetected), lists:foldl(fun erlang:'or'/2, false, Changes), lists:append(ClosuresDetected), merge_all_dicts(Persistence)}. +%% Unzips a list of tuples of length 5. unzip5(L) -> unzip5(L, [], [], [], [], []). unzip5([], Acc1, Acc2, Acc3, Acc4, Acc5) -> @@ -675,95 +891,124 @@ unzip5([], Acc1, Acc2, Acc3, Acc4, Acc5) -> unzip5([{A, B, C, D, E}|Rest], Acc1, Acc2, Acc3, Acc4, Acc5) -> unzip5(Rest, [A|Acc1], [B|Acc2], [C|Acc3], [D|Acc4], [E|Acc5]). +%% Rewrites a function signature with updated argument types. rewrite_spec(ArgTypes, [Spec]) -> SupArgs = fun({A, B}) -> erl_types:t_sup(A, B) end, ArgTypes1 = lists:map(SupArgs, lists:zip(ArgTypes, erl_types:t_fun_args(Spec))), erl_types:t_fun(ArgTypes1, erl_types:t_fun_range(Spec)). +%% =========================== +%% Marking unreachable clauses +%% =========================== + +%% This is the entry point to the logic that marks the unreachable clauses of a case. +%% Arguments: +%% - Clauses: List of cerl nodes of type clause. +%% - ArgType: The type of the case argument these clauses belong to. +%% - TSM: Symbol table. +%% - Arg: Case argument. +%% Returns: +%% The list of clauses annotated with 'type_dependent_unreachable' if they can't be reached. mark_unreachable_clauses(Clauses, ArgType, TSM, Arg) -> + %% Check if Arg is a values node to create the Argument list correctly. case cerl:type(Arg) =:= values of - true -> - ArgList = cerl:values_es(Arg); - false -> - ArgList = [Arg] + true -> ArgList = cerl:values_es(Arg); + false -> ArgList = [Arg] end, + %% If we haven't computed a type for the argument, + %% we can not know if a clause is unreachable, so + %% just return clauses as they are. case ArgType =:= notype of - false -> - mark_unreachable_clauses(Clauses, ArgType, TSM, ArgList, []); + false -> mark_unreachable_clauses(Clauses, ArgType, TSM, ArgList, []); true -> Clauses end. +%% Tail-recursive so reverse the clauses when returning to maintain their order. mark_unreachable_clauses([], _, _, _, NewClauses) -> lists:reverse(NewClauses); mark_unreachable_clauses([Clause|Clauses], ArgType, TSM, Arg, NewClauses) -> Pats = cerl:clause_pats(Clause), + %% If the ArgType is None, we have subtracted everything from the original argument type. + %% This means that no further clauses can be reached, including this one. NewClause = case erl_types:t_is_none(ArgType) of - true -> - mark_as_unreachable(Clause); - false -> - mark_as_reachable(Clause) + true -> mark_as_unreachable(Clause); + false -> mark_as_reachable(Clause) end, + %% Closure to try to subtract two types, and just return the first one + %% intact in the case of failure. SafeSub = fun(A, B) -> - try erl_types:t_subtract(A, B) of - T -> T - catch - _:_ -> A - end - end, + try erl_types:t_subtract(A, B) of + T -> T + catch + _:_ -> A + end + end, + %% Update the symbol table from the clause guard. {A, TSMorT} = update_tsm_from_guard(Clause, TSM, Arg), + %% Distinguish between the return values of update_tsm_from_guard/3. case A of {argtype, ArgName} -> + %% We only have a constraint for an argument PatTypes1 = lists:map(fun (X) -> t_from_pattern(X, TSM, dict:new()) end, Pats), + %% Gather the patterns that have a type and convert them to erl_types. PatTypes = [PatType || PatType <- PatTypes1, PatType =/= notype], + %% Check if we could do that for all of them. case length(PatTypes) =:= length(Arg) of - true -> - PatTypes2 = replace_guard_type(Arg, ArgName, PatTypes, TSMorT), - case length(PatTypes) > 1 of - true -> - PatTypes3 = erl_types:t_tuple(PatTypes2), - T = SafeSub(ArgType, PatTypes3); - false -> - PatTypes3 = hd(PatTypes2), - T = SafeSub(ArgType, PatTypes3) - end; - false -> - T = ArgType + true -> + %% We could, so replace the variable with its constraint in the patterns. + %% And then make the new type by subtracting to the current ArgType. + PatTypes2 = replace_guard_type(Arg, ArgName, PatTypes, TSMorT), + case length(PatTypes) > 1 of + true -> + PatTypes3 = erl_types:t_tuple(PatTypes2), + T = SafeSub(ArgType, PatTypes3); + false -> + PatTypes3 = hd(PatTypes2), + T = SafeSub(ArgType, PatTypes3) + end; + false -> + T = ArgType end; tsm -> + %% We have an updated symbol table. + %% Do the same as the previous case using the new symbol table. PatTypes1 = lists:map(fun (X) -> t_from_pattern(X, TSM, TSMorT) end, Pats), PatTypes = [PatType || PatType <- PatTypes1, PatType =/= notype], case length(PatTypes) =:= length(Arg) of - true -> - case length(PatTypes) > 1 of - true -> - PatTypes3 = erl_types:t_tuple(PatTypes), - T = SafeSub(ArgType, PatTypes3); - false -> - PatTypes3 = hd(PatTypes), - T = SafeSub(ArgType, PatTypes3) - end; - false -> - T = ArgType + true -> + case length(PatTypes) > 1 of + true -> + PatTypes3 = erl_types:t_tuple(PatTypes), + T = SafeSub(ArgType, PatTypes3); + false -> + PatTypes3 = hd(PatTypes), + T = SafeSub(ArgType, PatTypes3) + end; + false -> + T = ArgType end; invalid -> T = ArgType end, mark_unreachable_clauses(Clauses, T, TSM, Arg, [NewClause|NewClauses]). +%% Replaces an argument with the type it is constrained to in the patterns. replace_guard_type([], _ArgName, [], _TSMorT) -> []; replace_guard_type([Arg|Args], ArgName, [PatType|PatTypes], TSMorT) -> case cerl:type(Arg) =:= var of true -> case cerl:var_name(Arg) =:= ArgName of - true -> - [TSMorT|PatTypes]; - false -> - [PatType|replace_guard_type(Args, ArgName, PatTypes, TSMorT)] + true -> + [TSMorT|PatTypes]; + false -> + [PatType|replace_guard_type(Args, ArgName, PatTypes, TSMorT)] end; false -> [PatType|replace_guard_type(Args, ArgName, PatTypes, TSMorT)] end. +%% A valid guard is a guard we can currently parse to extract useful information +%% that helps us locate the unreachable clauses in a case construct. valid_guard(Clause, TSM, ArgList) -> Guard = cerl:clause_guard(Clause), case cerl:type(Guard) of @@ -771,48 +1016,49 @@ valid_guard(Clause, TSM, ArgList) -> call -> Args = cerl:call_args(Guard), case get_call_mfa(Guard) of - {erlang, is_integer, 1} -> is_unknown_var(hd(Args), TSM, ArgList); - {erlang, is_atom, 1} -> is_unknown_var(hd(Args), TSM, ArgList); - {erlang, is_function, 1} -> is_unknown_var(hd(Args), TSM, ArgList); - {erlang, is_function, 2} -> - C1 = is_unknown_var(hd(Args), TSM, ArgList), - C2 = cerl:type(lists:nth(2, Args)) =:= literal, - C1 or C2; - _ -> false + {erlang, is_integer, 1} -> is_unknown_var(hd(Args), TSM, ArgList); + {erlang, is_atom, 1} -> is_unknown_var(hd(Args), TSM, ArgList); + {erlang, is_function, 1} -> is_unknown_var(hd(Args), TSM, ArgList); + {erlang, is_function, 2} -> + C1 = is_unknown_var(hd(Args), TSM, ArgList), + C2 = cerl:type(lists:nth(2, Args)) =:= literal, + C1 or C2; + _ -> false end; 'try' -> TryArg = cerl:try_arg(Guard), case cerl:type(TryArg) of - 'let' -> - case length(cerl:let_vars(TryArg)) =:= 1 of - true -> - LetVar = hd(cerl:let_vars(TryArg)), - LetBody = cerl:let_body(TryArg), - LetArg = cerl:let_arg(TryArg), - case cerl:type(LetArg) of - 'call' -> - case get_call_mfa(LetArg) of - {erlang, is_function, 2} -> - case cerl:type(LetBody) of - 'call' -> - case is_right_call(LetBody, LetVar) of - true -> - is_unknown_var(hd(cerl:call_args(LetArg)), TSM, ArgList); - false -> false - end; - _ -> false - end; - _ -> false - end; - _ -> false - end; - false -> false - end; - _ -> false + 'let' -> + case length(cerl:let_vars(TryArg)) =:= 1 of + true -> + LetVar = hd(cerl:let_vars(TryArg)), + LetBody = cerl:let_body(TryArg), + LetArg = cerl:let_arg(TryArg), + case cerl:type(LetArg) of + 'call' -> + case get_call_mfa(LetArg) of + {erlang, is_function, 2} -> + case cerl:type(LetBody) of + 'call' -> + case is_right_call(LetBody, LetVar) of + true -> + is_unknown_var(hd(cerl:call_args(LetArg)), TSM, ArgList); + false -> false + end; + _ -> false + end; + _ -> false + end; + _ -> false + end; + false -> false + end; + _ -> false end; _ -> false end. +%% Returns the Mfa called from a guard. get_call_mfa(Guard) -> ModName = cerl:call_module(Guard), Name = cerl:call_name(Guard), @@ -822,61 +1068,69 @@ get_call_mfa(Guard) -> false -> unmatched end. +%% Returns whether X is a variable that is not in the symbol table or +%% in the arguent list of a case construct. is_unknown_var(X, TSM, ArgList) -> case cerl:type(X) of var -> ArgVarNames = [cerl:var_name(Var) || Var <- ArgList, cerl:type(Var) =:= var], case dict:find(cerl:var_name(X), TSM) of - {ok, _} -> cuter_graphs:list_contains(cerl:var_name(X), ArgVarNames); - error ->true + {ok, _} -> cuter_graphs:list_contains(cerl:var_name(X), ArgVarNames); + error -> true end; _ -> false end. +%% A 'right' call is a call we support for guards. is_right_call(Call, LetVar) -> case get_call_mfa(Call) =:= {erlang, '=:=', 2} of true -> [Arg1, Arg2] = cerl:call_args(Call), case cerl:type(Arg1) =:= var andalso cerl:type(Arg2) =:= literal of - true -> cerl:var_name(LetVar) =:= cerl:var_name(Arg1) andalso element(3, Arg2) =:= true; - false -> false + true -> cerl:var_name(LetVar) =:= cerl:var_name(Arg1) andalso element(3, Arg2) =:= true; + false -> false end; false -> false end. +%% This function looks at the guard of a clause. +%% If the guard is of the form is_'type'(X), it returns the constraint +%% that variable X has the type 'type'. update_tsm_from_guard(Clause, TSM, ArgList) -> case valid_guard(Clause, TSM, ArgList) of true -> Guard = cerl:clause_guard(Clause), case cerl:type(Guard) of - literal when element(3, Guard) =:= true -> {tsm, dict:new()}; - call -> - Args = cerl:call_args(Guard), - case get_call_mfa(Guard) of - {erlang, is_integer, 1} -> - update_tsm_from_guard_helper(Args, ArgList, erl_types:t_integer()); - {erlang, is_atom, 1} -> - update_tsm_from_guard_helper(Args, ArgList, erl_types:t_atom()); - {erlang, is_function, 1} -> - update_tsm_from_guard_helper(Args, ArgList, erl_types:t_fun()); - {erlang, is_function, 2}-> - Arity = element(3, lists:nth(2, Args)), - update_tsm_from_guard_helper(Args, ArgList, erl_types:t_fun(Arity, erl_types:t_any())) - end; - 'try' -> - TryArg = cerl:try_arg(Guard), - LetArg = cerl:let_arg(TryArg), - Args = cerl:call_args(LetArg), - case get_call_mfa(LetArg) of - {erlang, is_function, 2} -> - Arity = element(3, lists:nth(2, Args)), - update_tsm_from_guard_helper(Args, ArgList, erl_types:t_fun(Arity, erl_types:t_any())) - end + literal when element(3, Guard) =:= true -> {tsm, dict:new()}; + call -> + Args = cerl:call_args(Guard), + case get_call_mfa(Guard) of + {erlang, is_integer, 1} -> + update_tsm_from_guard_helper(Args, ArgList, erl_types:t_integer()); + {erlang, is_atom, 1} -> + update_tsm_from_guard_helper(Args, ArgList, erl_types:t_atom()); + {erlang, is_function, 1} -> + update_tsm_from_guard_helper(Args, ArgList, erl_types:t_fun()); + {erlang, is_function, 2}-> + Arity = element(3, lists:nth(2, Args)), + update_tsm_from_guard_helper(Args, ArgList, erl_types:t_fun(Arity, erl_types:t_any())) + end; + 'try' -> + TryArg = cerl:try_arg(Guard), + LetArg = cerl:let_arg(TryArg), + Args = cerl:call_args(LetArg), + case get_call_mfa(LetArg) of + {erlang, is_function, 2} -> + Arity = element(3, lists:nth(2, Args)), + update_tsm_from_guard_helper(Args, ArgList, erl_types:t_fun(Arity, erl_types:t_any())) + end end; false -> {invalid, none} end. +%% Decides whether to return a new symbol table, +%% or just a variable constraint. update_tsm_from_guard_helper(Args, ArgList, Type) -> FunArgName = cerl:var_name(hd(Args)), ArgVarNames = [cerl:var_name(Var) || Var <- ArgList, cerl:type(Var) =:= var], @@ -885,6 +1139,7 @@ update_tsm_from_guard_helper(Args, ArgList, Type) -> _ -> {tsm, dict:store(FunArgName, Type, dict:new())} end. +%% Fetches the 'type_dependent_unreachable' annotation out of an annotation list. get_ann_type_dependent_unreachable([]) -> false; get_ann_type_dependent_unreachable([Hd|Tl]) -> case Hd of @@ -894,9 +1149,12 @@ get_ann_type_dependent_unreachable([Hd|Tl]) -> get_ann_type_dependent_unreachable(Tl) end. +%% Fetches the 'type_dependent_unreachable' annotation of a cerl node. -spec get_type_dependent_unreachable(cerl:cerl()) -> boolean(). get_type_dependent_unreachable(T) -> get_ann_type_dependent_unreachable(cerl:get_ann(T)). +%% Merges all dictionaries in a list. +%% It hypothesizes that no two keys are the same. merge_all_dicts(D) -> F = fun(_Key, Value1, _Value2) -> Value1 end, F1 = fun(D1, D2) -> dict:merge(F, D1, D2) end, From a0a21bb7eaec5800f04878fd3ad7a97169705d1a Mon Sep 17 00:00:00 2001 From: Dspil Date: Mon, 9 May 2022 01:01:09 +0200 Subject: [PATCH 85/85] more refactoring and comments --- src/cuter_codeserver.erl | 7 +- src/cuter_graphs.erl | 158 ++++---- src/cuter_maybe_error_annotation.erl | 529 ++++++++++++++----------- src/cuter_type_dependent_functions.erl | 3 + 4 files changed, 377 insertions(+), 320 deletions(-) diff --git a/src/cuter_codeserver.erl b/src/cuter_codeserver.erl index a0901d07..17777915 100644 --- a/src/cuter_codeserver.erl +++ b/src/cuter_codeserver.erl @@ -258,18 +258,13 @@ handle_call(annotate_for_possible_errors, _From, State=#st{db = Db}) -> Kmodules = ets:foldl(Fn2, [], Db), {ok, EntryPoint} = cuter_config:fetch(?ENTRY_POINT), MfasToKfuns = ets:foldl(Fn, dict:new(), Db), - %io:format("Before Specs~n"), - %io:format("ast: ~p~n", [cuter_cerl:kfun_code(dict:fetch(EntryPoint, MfasToKfuns))]), MfasToSpecs = cuter_types:specs_as_erl_types(Kmodules), - %io:format("Before Preprocess~n"), - UpdatedKfuns = cuter_maybe_error_annotation:preprocess(EntryPoint, MfasToKfuns, MfasToSpecs, true), + UpdatedKfuns = cuter_maybe_error_annotation:preprocess(EntryPoint, MfasToKfuns, MfasToSpecs), RFn = fun({M, F, A}, Kfun, _Acc) -> [{_M, Kmodule}] = ets:lookup(Db, M), cuter_cerl:kmodule_update_kfun(Kmodule, {M, F, A}, Kfun) end, dict:fold(RFn, ok, UpdatedKfuns), - %io:format("spec: ~p~n", [dict:find(EntryPoint, MfasToSpecs)]), - %io:format("ast: ~p~n", [cuter_cerl:kfun_code(dict:fetch(EntryPoint, UpdatedKfuns))]), {reply, ok, State}. diff --git a/src/cuter_graphs.erl b/src/cuter_graphs.erl index 07f26ba0..ace02d66 100644 --- a/src/cuter_graphs.erl +++ b/src/cuter_graphs.erl @@ -12,7 +12,7 @@ -type graph() :: dict:dict(). -type graph_node() :: mfa() | {node, mfa()} - | {cycle, [mfa()]}. + | {scc, [mfa()]}. %% ===================================================== @@ -60,94 +60,94 @@ has_node(Node, Graph) -> %% ===================================================== -%% Logic for finding cycles. Implemented as a DFS search +%% Logic for finding sccs. Implemented as a DFS search %% with a visited set. %% ===================================================== -%% Returns a list of cycles in a graph. -cycle_nodes(EntryPoint, Graph) -> - {Cycled, _, _} = cycle_nodes(EntryPoint, Graph, sets:new(), sets:new()), - Cycled. +%% Returns a list of sccs in a graph. +scc_nodes(EntryPoint, Graph) -> + {Sccd, _, _} = scc_nodes(EntryPoint, Graph, sets:new(), sets:new()), + Sccd. -cycle_nodes(Node, Graph, Visited, Ignored) -> +scc_nodes(Node, Graph, Visited, Ignored) -> %% Get the children of the node. C = children(Node, Graph), %% Filter out the ones that have been visited or are ignored. TC = [Y || Y <- C, not (sets:is_element(Y, Visited) or sets:is_element(Node, Ignored))], %% Call self for every child. - {ChildrenCycled, ChildrenActiveCycled, VisitedBelow} = cycle_nodes_children(TC, Graph, sets:add_element(Node, Visited), Ignored), - %% An active cycle is a detected cycle that hasn't been + {ChildrenSccd, ChildrenActiveSccd, VisitedBelow} = scc_nodes_children(TC, Graph, sets:add_element(Node, Visited), Ignored), + %% An active scc is a detected scc that hasn't been %% completed yet when backtracking - ActiveCycled = lists:filter(fun(X) -> sets:is_element(X, Visited) end, C), - {Cycles, ActiveCycles} = update_active_cycles(Node, ActiveCycled, ChildrenCycled, ChildrenActiveCycled), - {Cycles, ActiveCycles, sets:add_element(Node, VisitedBelow)}. + ActiveSccd = lists:filter(fun(X) -> sets:is_element(X, Visited) end, C), + {Sccs, ActiveSccs} = update_active_sccs(Node, ActiveSccd, ChildrenSccd, ChildrenActiveSccd), + {Sccs, ActiveSccs, sets:add_element(Node, VisitedBelow)}. -cycle_nodes_children(C, G, V, I) -> - cycle_nodes_children(C, G, V, I, [], [], sets:new()). +scc_nodes_children(C, G, V, I) -> + scc_nodes_children(C, G, V, I, [], [], sets:new()). -cycle_nodes_children([], _, _, _, CycleAcc, ActiveCycleAcc, VisitedAcc) -> - {CycleAcc, ActiveCycleAcc, VisitedAcc}; -cycle_nodes_children([Ch|C], G, V, I, CycleAcc, ActiveCycleAcc, VisitedAcc) -> - {Cycle, ActiveCycle, VisitedBelow} = cycle_nodes(Ch, G, V, I), - cycle_nodes_children(C, G, V, sets:union([I, VisitedBelow]), lists:append([CycleAcc, Cycle]), lists:append([ActiveCycleAcc, ActiveCycle]), sets:union([VisitedAcc, VisitedBelow])). +scc_nodes_children([], _, _, _, SccAcc, ActiveSccAcc, VisitedAcc) -> + {SccAcc, ActiveSccAcc, VisitedAcc}; +scc_nodes_children([Ch|C], G, V, I, SccAcc, ActiveSccAcc, VisitedAcc) -> + {Scc, ActiveScc, VisitedBelow} = scc_nodes(Ch, G, V, I), + scc_nodes_children(C, G, V, sets:union([I, VisitedBelow]), lists:append([SccAcc, Scc]), lists:append([ActiveSccAcc, ActiveScc]), sets:union([VisitedAcc, VisitedBelow])). -update_active_cycles(Node, ActiveCycled, ChildrenCycled, ChildrenActiveCycled) -> - ActiveCycled1 = create_new_cycles(ActiveCycled, ChildrenActiveCycled), - {Cycles1, ActiveCycled2} = update_all_cycles(Node, ActiveCycled1), - {lists:append([Cycles1, ChildrenCycled]), ActiveCycled2}. +update_active_sccs(Node, ActiveSccd, ChildrenSccd, ChildrenActiveSccd) -> + ActiveSccd1 = create_new_sccs(ActiveSccd, ChildrenActiveSccd), + {Sccs1, ActiveSccd2} = update_all_sccs(Node, ActiveSccd1), + {lists:append([Sccs1, ChildrenSccd]), ActiveSccd2}. -create_new_cycles([], Acc) -> +create_new_sccs([], Acc) -> Acc; -create_new_cycles([H|T], Acc) -> - [{H,[]}|create_new_cycles(T, Acc)]. +create_new_sccs([H|T], Acc) -> + [{H,[]}|create_new_sccs(T, Acc)]. -update_all_cycles(Node, ActiveCycled) -> - update_all_cycles(Node, ActiveCycled, [], []). +update_all_sccs(Node, ActiveSccd) -> + update_all_sccs(Node, ActiveSccd, [], []). -update_all_cycles(_, [], ActiveAcc, CyclesAcc) -> - {CyclesAcc, ActiveAcc}; -update_all_cycles(Node, [{First, List}|T], ActiveAcc, CyclesAcc) -> +update_all_sccs(_, [], ActiveAcc, SccsAcc) -> + {SccsAcc, ActiveAcc}; +update_all_sccs(Node, [{First, List}|T], ActiveAcc, SccsAcc) -> case First of Node -> - CyclesAcc1 = [[Node|List]|CyclesAcc], + SccsAcc1 = [[Node|List]|SccsAcc], ActiveAcc1 = ActiveAcc; _ -> - CyclesAcc1 = CyclesAcc, + SccsAcc1 = SccsAcc, ActiveAcc1 = [{First, [Node|List]}|ActiveAcc] end, - update_all_cycles(Node, T, ActiveAcc1, CyclesAcc1). + update_all_sccs(Node, T, ActiveAcc1, SccsAcc1). %% ================================================================= -%% Logic for merging overlapping cycles. -%% Overlapping cycles are cycles that have at least one common node. -%% Each cycle is a list of nodes, so we have to find all lists with +%% Logic for merging overlapping sccs. +%% Overlapping sccs are sccs that have at least one common node. +%% Each scc is a list of nodes, so we have to find all lists with %% common elements and merge them. %% ================================================================= -%% Cycles are lists of nodes. -%% If two cycles contain at least one commone element are merged into one list. -merge_cycles(Cycles) -> +%% Sccs are lists of nodes. +%% If two sccs contain at least one commone element are merged into one list. +merge_sccs(Sccs) -> %% Make a helper graph. - G = make_help_graph(Cycles), - %% Merged cycles are the connected components of the helper graph. + G = make_help_graph(Sccs), + %% Merged sccs are the connected components of the helper graph. connected_components(G). -%% Creates the helper graph for merging the cycles. +%% Creates the helper graph for merging the sccs. -spec make_help_graph([[graph_node()]]) -> dict:dict(). -make_help_graph(Cycles) -> +make_help_graph(Sccs) -> %% Initialize a graph. G = dict:new(), - %% Add each cycle to the graph. - lists:foldl(fun put_cycle/2, G, Cycles). + %% Add each scc to the graph. + lists:foldl(fun put_scc/2, G, Sccs). -%% Adds a cycle to a helper graph. --spec put_cycle([graph_node()], dict:dict()) -> dict:dict(). -put_cycle(Cycle, Graph) -> put_cycle(nonode, Cycle, Graph). +%% Adds a scc to a helper graph. +-spec put_scc([graph_node()], dict:dict()) -> dict:dict(). +put_scc(Scc, Graph) -> put_scc(nonode, Scc, Graph). %% If we don't have other nodes to add, return the graph. -put_cycle(_, [], Graph) -> Graph; -put_cycle(Prev, [N|Ns], Graph) -> +put_scc(_, [], Graph) -> Graph; +put_scc(Prev, [N|Ns], Graph) -> %% If the node is not already in the graph, add it. Graph1 = case dict:is_key(N, Graph) of true -> @@ -163,7 +163,7 @@ put_cycle(Prev, [N|Ns], Graph) -> G = dict:append_list(Prev, [N], Graph1), dict:append_list(N, [Prev], G) end, - put_cycle(N, Ns, Graph2). + put_scc(N, Ns, Graph2). %% Returns the connected components of a graph. connected_components(G) -> @@ -221,48 +221,48 @@ remove_nodes(C, G) -> %% ================================================== -%% Logic for making a new graph merging cycled nodes. +%% Logic for making a new graph merging sccd nodes. %% ================================================== remake_graph(EntryPoint, Graph) -> - Cycles = merge_cycles(cycle_nodes(EntryPoint, Graph)), - CycleNodes = [{cycle, sets:to_list(X)} || X <- Cycles], - AllCycledNodes = sets:union(Cycles), - Children = find_children([A || {cycle, A} <- CycleNodes], Graph), - NewNodes = [{node, X} || X <- get_nodes(Graph), not sets:is_element(X, AllCycledNodes)], - NewChildren = [update_children(children(Y, Graph), AllCycledNodes, Cycles, CycleNodes) || {node, Y} <- NewNodes], - CycleChildren = [update_children(Z, AllCycledNodes, Cycles, CycleNodes) || Z <- Children], - Nodes = lists:append(NewNodes, CycleNodes), - ChildrenPerNodeTemp = [sets:to_list(sets:from_list(W)) || W <- lists:append(NewChildren, CycleChildren)], + Sccs = merge_sccs(scc_nodes(EntryPoint, Graph)), + SccNodes = [{scc, sets:to_list(X)} || X <- Sccs], + AllSccdNodes = sets:union(Sccs), + Children = find_children([A || {scc, A} <- SccNodes], Graph), + NewNodes = [{node, X} || X <- get_nodes(Graph), not sets:is_element(X, AllSccdNodes)], + NewChildren = [update_children(children(Y, Graph), AllSccdNodes, Sccs, SccNodes) || {node, Y} <- NewNodes], + SccChildren = [update_children(Z, AllSccdNodes, Sccs, SccNodes) || Z <- Children], + Nodes = lists:append(NewNodes, SccNodes), + ChildrenPerNodeTemp = [sets:to_list(sets:from_list(W)) || W <- lists:append(NewChildren, SccChildren)], ChildrenPerNode = [try_remove(B, C) || {B, C} <- lists:zip(Nodes, ChildrenPerNodeTemp)], make_graph_from_children(Nodes, ChildrenPerNode). -find_children(Cycles, Graph) -> - find_children(Cycles, Graph, []). +find_children(Sccs, Graph) -> + find_children(Sccs, Graph, []). find_children([], _, Acc) -> lists:reverse(Acc); find_children([C|Cs], Graph, Acc) -> find_children(Cs, Graph, [lists:append([children(X, Graph) || X <- C])|Acc]). -update_children(Children, AllCycledNodes, Cycles, CyclesAsLists) -> - update_children(Children, AllCycledNodes, Cycles, CyclesAsLists, []). +update_children(Children, AllSccdNodes, Sccs, SccsAsLists) -> + update_children(Children, AllSccdNodes, Sccs, SccsAsLists, []). update_children([], _, _, _, Acc) -> Acc; -update_children([C|Cs], AllCycles, Cycles, CyclesAsLists, Acc) -> - case sets:is_element(C, AllCycles) of +update_children([C|Cs], AllSccs, Sccs, SccsAsLists, Acc) -> + case sets:is_element(C, AllSccs) of true -> - update_children(Cs, AllCycles, Cycles, CyclesAsLists, [which_cycle(C, Cycles, CyclesAsLists)|Acc]); + update_children(Cs, AllSccs, Sccs, SccsAsLists, [which_scc(C, Sccs, SccsAsLists)|Acc]); false -> - update_children(Cs, AllCycles, Cycles, CyclesAsLists, [{node, C}|Acc]) + update_children(Cs, AllSccs, Sccs, SccsAsLists, [{node, C}|Acc]) end. -which_cycle(_, [], _) -> error('cycle not found'); -which_cycle(Node, [C|Cs], [CL|CLs]) -> +which_scc(_, [], _) -> error('scc not found'); +which_scc(Node, [C|Cs], [CL|CLs]) -> case sets:is_element(Node, C) of true -> CL; false -> - which_cycle(Node, Cs, CLs) + which_scc(Node, Cs, CLs) end. try_remove(Node, Children) -> @@ -284,9 +284,9 @@ try_remove(Node, [C|Cs], Acc) -> %% =========================================================== %% First calculates the callgraph. -%% Then it replaces all cycles with single nodes, -%% merging cycles with common functions. -%% Last it finds the new entry point which may be part of a cycle. +%% Then it replaces all sccs with single nodes, +%% merging sccs with common functions. +%% Last it finds the new entry point which may be part of a scc. %% Returns the processed callgraph, all functions belonging to the callgraph in a set %% and the new entry point. -spec calculate_dag_callgraph(mfa()) -> {graph(), sets:set(), graph_node()}. @@ -303,10 +303,10 @@ find_entry_point(EntryPoint, Graph) -> %% If entry point is just a node, return it. {node, EntryPoint}; false -> - %% Else return the first cycle that contains the entry point. - %% Only one cycle will contain it, since if it belonge to many, + %% Else return the first scc that contains the entry point. + %% Only one scc will contain it, since if it belonge to many, %% they would have been merged. - {cycle, hd([C || {cycle, C} <- get_nodes(Graph), list_contains(EntryPoint, C)])} + {scc, hd([C || {scc, C} <- get_nodes(Graph), list_contains(EntryPoint, C)])} end. %% Calculates the callgraph produced by the diff --git a/src/cuter_maybe_error_annotation.erl b/src/cuter_maybe_error_annotation.erl index 734b1e23..c675f0e3 100644 --- a/src/cuter_maybe_error_annotation.erl +++ b/src/cuter_maybe_error_annotation.erl @@ -1,97 +1,112 @@ -module(cuter_maybe_error_annotation). --export([preprocess/3, preprocess/4, get_force_constraint_logging/1, get_maybe_error_bin/2, get_maybe_error_bin_anno/2, get_distrust_type_dependent/1]). +-export([preprocess/3, get_force_constraint_logging/1, get_maybe_error_bin/2, get_maybe_error_bin_anno/2, get_distrust_type_dependent/1]). -export_type([maybe_error/0, symbol_table/0]). -%% ===== -%% types -%% ===== +%% ========== +%% Used types +%% ========== -type maybe_error() :: false | type_dependent | true. -type symbol_table() :: dict:dict(). %% ============================ -%% annotating a callgraph logic +%% Annotating a callgraph logic %% ============================ --spec st_from_tsm() -> dict:dict(). +%% Creates a symbol table from a type symbol table. +%% The symbol table we need here is a dictionary with +%% variables or functions as keys and whether they are safe +%% or not as values. The type symbol table just has type information +%% for various symbols. st_from_tsm() -> + %% Using the original_tsm() we will store each of those functions + %% as 'type_dependent' in the symbol table. lists:foldl( fun({Fun, _}, ST) -> - dict:store(Fun, {type_dependent, 'fun'}, ST) + dict:store(Fun, {type_dependent, 'fun'}, ST) end, dict:new(), dict:to_list(cuter_type_dependent_functions:original_tsm()) ). --spec annotate_callgraph(cuter_graphs:graph_node(), dict:dict(), cuter_graphs:graph(), boolean()) -> dict:dict(). -annotate_callgraph(EntryPoint, FunctionAsts, Graph, CheckTypes) -> - {Annotated, _} = - case CheckTypes of - false -> annotate_callgraph(EntryPoint, FunctionAsts, Graph, dict:new(), CheckTypes); - true -> annotate_callgraph(EntryPoint, FunctionAsts, Graph, st_from_tsm(), CheckTypes) - end, +%% Main entry point of the analysis. +%% Arguments: +%% - EntryPoint: The entry point of CutEr analysis +%% - FunctionAsts: Dictionary from Mfas to ASTs. +%% - Graph: The updated from cuter_graphs callgraph. +annotate_callgraph(EntryPoint, FunctionAsts, Graph) -> + {Annotated, _} = annotate_callgraph(EntryPoint, FunctionAsts, Graph, st_from_tsm()), Annotated. --spec annotate_callgraph(cuter_graphs:graph_node(), dict:dict(), cuter_graphs:graph(), symbol_table(), boolean()) -> {dict:dict(), symbol_table()}. -annotate_callgraph(Node, FunctionAsts, Graph, ST, CheckTypes) -> - {FunctionAsts1, ST1} = lists:foldl(fun(A, {Funs, SmT}) -> annotate_callgraph(A, Funs, Graph, SmT, CheckTypes) end, {FunctionAsts, ST}, cuter_graphs:children(Node, Graph)), +%% Annotates a node in the callgraph. +annotate_callgraph(Node, FunctionAsts, Graph, ST) -> + %% First annotate its children. + {FunctionAsts1, ST1} = lists:foldl(fun(A, {Funs, SmT}) -> annotate_callgraph(A, Funs, Graph, SmT) end, {FunctionAsts, ST}, cuter_graphs:children(Node, Graph)), + %% Distinguish between just functions and SCCs. case Node of {node, Name} -> + %% If it is just a function, annotate it. {ok, PrevAST} = dict:find(Name, FunctionAsts1), - {NewAST, _C, _SelfReffed} = annotate_maybe_error(PrevAST, ST1, sets:new(), element(1, Name), CheckTypes), + {NewAST, _C, _SelfReffed} = annotate_maybe_error(PrevAST, ST1, sets:new(), element(1, Name)), {dict:store(Name, NewAST, FunctionAsts1), dict:store(Name, {get_maybe_error(NewAST), 'fun'}, ST1)}; - {cycle, Cycle} -> - cycle_annotation(Cycle, FunctionAsts1, ST1, CheckTypes) + {scc, Scc} -> + %% If it is an SCC, do a fix-point on it. + scc_annotation(Scc, FunctionAsts1, ST1) end. -cycle_annotation(Cycle, FunctionAsts, ST, CheckTypes) -> - ASTS = [element(2, dict:find(A, FunctionAsts)) || A <- Cycle], - CycleSet = sets:from_list(Cycle), - {NewASTS, NewST} = cycle_annotation_helper(Cycle, ASTS, ST, CycleSet, CheckTypes), +%% SCC annotation fix-point. +scc_annotation(Scc, FunctionAsts, ST) -> + %% Gather the ASTs of the functions in the SCC. + ASTS = [element(2, dict:find(A, FunctionAsts)) || A <- Scc], + SccSet = sets:from_list(Scc), + %% Do the actual fix-point and return the ASTs and the updated symbol table. + {NewASTS, NewST} = scc_annotation_helper(Scc, ASTS, ST, SccSet), { lists:foldl( fun({Name, AST}, Y) -> dict:store(Name, AST, Y) end, FunctionAsts, - lists:zip(Cycle, NewASTS) + lists:zip(Scc, NewASTS) ), NewST }. -cycle_annotation_helper(Cycle, ASTS, ST, CycleSet, CheckTypes) -> - {NewASTS, ST1, C} = cycle_pass(Cycle, ASTS, ST, CycleSet, CheckTypes), +%% Performs the fix-point computation for an SCC. +scc_annotation_helper(Scc, ASTS, ST, SccSet) -> + %% Do a pass to all functions in the SCC. + {NewASTS, ST1, C} = scc_pass(Scc, ASTS, ST, SccSet), + %% Check if some annotation has changed. If not, we are done, else, continue passing. case C of - false -> - {NewASTS, ST1}; - true -> - cycle_annotation_helper(Cycle, NewASTS, ST1, CycleSet, CheckTypes) + false -> {NewASTS, ST1}; + true -> scc_annotation_helper(Scc, NewASTS, ST1, SccSet) end. -cycle_pass(Cycle, ASTS, ST, CycleSet, CheckTypes) -> - cycle_pass_helper(CycleSet, Cycle, ASTS, ST, [], false, CheckTypes). +%% Does a pass on the SCC functions. +scc_pass(Scc, ASTS, ST, SccSet) -> + scc_pass_helper(SccSet, Scc, ASTS, ST, [], false). -cycle_pass_helper(_, [], _, ST, AccAST, AccC, _) -> {lists:reverse(AccAST), ST, AccC}; -cycle_pass_helper(CycleSet, [Name|Names], [AST|ASTS], ST, AccAST, AccC, CheckTypes) -> - {NewAST, C, IgnoredFound} = annotate_maybe_error(AST, ST, CycleSet, element(1, Name), CheckTypes), +scc_pass_helper(_, [], _, ST, AccAST, AccC) -> {lists:reverse(AccAST), ST, AccC}; +scc_pass_helper(SccSet, [Name|Names], [AST|ASTS], ST, AccAST, AccC) -> + {NewAST, C, IgnoredFound} = annotate_maybe_error(AST, ST, SccSet, element(1, Name)), ST1 = dict:store(Name, {get_maybe_error(NewAST), 'fun'}, ST), - cycle_pass_helper(CycleSet, Names, ASTS, ST1, [NewAST|AccAST], AccC or C or IgnoredFound, CheckTypes). + scc_pass_helper(SccSet, Names, ASTS, ST1, [NewAST|AccAST], AccC or C or IgnoredFound). %% =========================== -%% annotating a function logic +%% Annotating a function logic %% =========================== --spec update_ann(cerl:cerl(), maybe_error()) -> cerl:cerl(). +%% Updates the 'maybe_error' annotation of a node T. update_ann(T, Maybe_Error) -> Anno = cerl:get_ann(T), cerl:set_ann(T, update_ann(Anno, Maybe_Error, [], false)). --spec update_ann([any()], maybe_error(), [any()], atom()) -> [any()]. +%% Updates the 'maybe_error' annotation in a list of annotations. update_ann([], Maybe_Error, Acc, false) -> [{maybe_error, Maybe_Error}|Acc]; update_ann([], _, Acc, true) -> Acc; update_ann([{maybe_error, _}|T], Maybe_Error, Acc, _) -> update_ann(T, Maybe_Error, [{maybe_error, Maybe_Error}|Acc], true); update_ann([H|T], Maybe_Error, Acc, Found) -> update_ann(T, Maybe_Error, [H|Acc], Found). --spec add_force_constraint_logging(cerl:cerl()) -> cerl:cerl(). +%% Adds the 'force_constraint_logging' annotation in node Tree. add_force_constraint_logging(Tree) -> Anno = cerl:get_ann(Tree), case cuter_graphs:list_contains({force_constraint_logging, true}, Anno) of @@ -99,6 +114,7 @@ add_force_constraint_logging(Tree) -> false -> cerl:add_ann([{force_constraint_logging, true}], Tree) end. +%% Adds the 'distrust_type_dependent' annotation in a node Tree. add_distrust_type_dependent(Tree) -> Anno = cerl:get_ann(Tree), case cuter_graphs:list_contains({distrust_type_dependent, true}, Anno) of @@ -106,189 +122,231 @@ add_distrust_type_dependent(Tree) -> false -> cerl:add_ann([{distrust_type_dependent, true}], Tree) end. +%% Adds variables Vars with annotations Flags to the symbol table SM. put_vars(Vars, Flags, SM) -> lists:foldl(fun({Var, Flag}, B) -> dict:store(cerl:var_name(Var), Flag, B) end, SM, lists:zip(Vars, Flags)). +%% Add variables to the symbol table given their names directly and not var cerl nodes. put_vars_by_name(Vars, Flags, SM) -> lists:foldl(fun({Var, Flag}, B) -> dict:store(Var, Flag, B) end, SM, lists:zip(Vars, Flags)). -annotate_maybe_error(AST, ST, Ignored, Mod, CheckTypes) -> - {NewAST, C, _, IgnoredCall, _} = annotate_maybe_error(AST, ST, false, Ignored, sets:new(), Mod, CheckTypes), +%% ================ +%% Annotation logic +%% ================ + +%% Entrypoint of the annotation of a single function. +%% Arguments: +%% - AST: The AST of the function. +%% - ST: The symbol table with symbols as keys and 'maybe_error' annotations as values. +%% - Ignored: Funtions belonging to the same SCC. +%% - Mod: The module that the current function is defined in. +%% This function is just a wrapper for annotate_maybe_error/6 +annotate_maybe_error(AST, ST, Ignored, Mod) -> + {NewAST, C, _, IgnoredCall, _} = annotate_maybe_error(AST, ST, false, Ignored, sets:new(), Mod), {NewAST, C, IgnoredCall}. -annotate_maybe_error(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes) -> +%% Performs the AST annotation. +%% It has the same arguments as annotate_maybe_error/4 with 2 additional ones: +%% - Force: Whether we are in a state that evaluation should be forced. +%% - LetrecIgnored: letrec nodes introduce closures which can define their own SCCs. +%% In the simple case where we have a list comprehension, a recursive closure is defined +%% which is trivially an SCC. Thus we need to do an inner fix-point computation +%% same as the cross function one handling the SCCs in the callgraph. +%% This argument contains the rest closures under the same letrec node that +%% belong to the same SCC. +annotate_maybe_error(Tree, SM, Force, Ignored, LetrecIgnored, Mod) -> CurMaybe_Error = get_maybe_error(Tree), + %% We distinguish the type of the node we are annotating. + %% Most nodes just call this function recursively in their children + %% and combine their results to return. case cerl:type(Tree) of 'apply' -> - annotate_maybe_error_apply(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes, CurMaybe_Error); + annotate_maybe_error_apply(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CurMaybe_Error); call -> - annotate_maybe_error_call(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes, CurMaybe_Error); + annotate_maybe_error_call(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CurMaybe_Error); 'case' -> - {Clauses, C1, Found1, IgnoreFound1, LetrecFound1} = annotate_maybe_error_all(cerl:case_clauses(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + %% We have a case node to annotate. First, annotate the clauses. + {Clauses, C1, Found1, IgnoreFound1, LetrecFound1} = annotate_maybe_error_all(cerl:case_clauses(Tree), SM, Force, Ignored, LetrecIgnored, Mod), ClausesError1 = get_all_maybe_error(Clauses), + %% Maybe error annotation should disregard unreachable clauses. ClausesError = - case unreachable_clauses(Clauses) of - true -> maybe_error_or([ClausesError1, type_dependent]); - false -> ClausesError1 - end, + case unreachable_clauses(Clauses) of + true -> maybe_error_or([ClausesError1, type_dependent]); + false -> ClausesError1 + end, + %% Annotate the argument. {Arg, C2, Found2, IgnoreFound2, LetrecFound2} = - case ClausesError of - true -> annotate_maybe_error(cerl:case_arg(Tree), SM, true, Ignored, LetrecIgnored, Mod, CheckTypes); - type_dependent -> annotate_maybe_error(cerl:case_arg(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes); - false -> annotate_maybe_error(cerl:case_arg(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes) - end, + case ClausesError of + true -> annotate_maybe_error(cerl:case_arg(Tree), SM, true, Ignored, LetrecIgnored, Mod); + type_dependent -> annotate_maybe_error(cerl:case_arg(Tree), SM, Force, Ignored, LetrecIgnored, Mod); + false -> annotate_maybe_error(cerl:case_arg(Tree), SM, Force, Ignored, LetrecIgnored, Mod) + end, + %% Combine everything to produce the maybe_error annotation of this node. NewMaybe_Error = maybe_error_or([get_maybe_error(Arg), ClausesError]), {cerl:update_c_case(update_ann(Tree, NewMaybe_Error), Arg, Clauses), C1 or C2, sets:union([Found1, Found2]), IgnoreFound1 or IgnoreFound2, sets:union([LetrecFound1, LetrecFound2])}; clause -> {Pats, C1, Found1, SM1} = annotate_maybe_error_pattern_all(cerl:clause_pats(Tree), SM, Force), IgnoreFound1 = false, - {Guard, C2, Found2, IgnoreFound2, LetrecFound2} = annotate_maybe_error(cerl:clause_guard(Tree), SM1, Force, Ignored, LetrecIgnored, Mod, CheckTypes), - {Body, C3, Found3, IgnoreFound3, LetrecFound3} = annotate_maybe_error(cerl:clause_body(Tree), SM1, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + {Guard, C2, Found2, IgnoreFound2, LetrecFound2} = annotate_maybe_error(cerl:clause_guard(Tree), SM1, Force, Ignored, LetrecIgnored, Mod), + {Body, C3, Found3, IgnoreFound3, LetrecFound3} = annotate_maybe_error(cerl:clause_body(Tree), SM1, Force, Ignored, LetrecIgnored, Mod), NewIgnoreFound = IgnoreFound1 or IgnoreFound2 or IgnoreFound3, NewLetrecFound = sets:union([LetrecFound2, LetrecFound3]), NewMaybe_Error = maybe_error_or([get_maybe_error(Body), get_all_maybe_error(Pats), get_maybe_error(Guard)]), {cerl:update_c_clause(update_ann(Tree, NewMaybe_Error), Pats, Guard, Body), C1 or C2 or C3, sets:union([Found1, Found2, Found3]), NewIgnoreFound, NewLetrecFound}; cons -> - {Hd, C1, Found1, IgnoreFound1, LetrecFound1} = annotate_maybe_error(cerl:cons_hd(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), - {Tl, C2, Found2, IgnoreFound2, LetrecFound2} = annotate_maybe_error(cerl:cons_tl(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + {Hd, C1, Found1, IgnoreFound1, LetrecFound1} = annotate_maybe_error(cerl:cons_hd(Tree), SM, Force, Ignored, LetrecIgnored, Mod), + {Tl, C2, Found2, IgnoreFound2, LetrecFound2} = annotate_maybe_error(cerl:cons_tl(Tree), SM, Force, Ignored, LetrecIgnored, Mod), NewIgnoreFound = IgnoreFound1 or IgnoreFound2, NewLetrecFound = sets:union([LetrecFound1, LetrecFound2]), NewMaybe_Error = maybe_error_or([get_maybe_error(Hd), get_maybe_error(Tl)]), {cerl:update_c_cons_skel(update_ann(Tree, NewMaybe_Error), Hd, Tl), C1 or C2, sets:union([Found1, Found2]), NewIgnoreFound, NewLetrecFound}; 'fun' -> + %% For function nodes we also have to add their arguments to the symbol table. Flags = make_fun_flags(cerl:fun_vars(Tree)), SM1 = put_vars(cerl:fun_vars(Tree), Flags, SM), - {Vars, C1, Found1, IgnoreFound1, LetrecFound1} = annotate_maybe_error_all(cerl:fun_vars(Tree), SM1, Force, Ignored, LetrecIgnored, Mod, CheckTypes), - {Body, C2, Found2, IgnoreFound2, LetrecFound2} = annotate_maybe_error(cerl:fun_body(Tree), SM1, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + {Vars, C1, Found1, IgnoreFound1, LetrecFound1} = annotate_maybe_error_all(cerl:fun_vars(Tree), SM1, Force, Ignored, LetrecIgnored, Mod), + {Body, C2, Found2, IgnoreFound2, LetrecFound2} = annotate_maybe_error(cerl:fun_body(Tree), SM1, Force, Ignored, LetrecIgnored, Mod), NewMaybe_Error = maybe_error_or([get_maybe_error(Body), get_all_maybe_error(Vars)]), {cerl:update_c_fun(update_ann(Tree, NewMaybe_Error), Vars, Body), C1 or C2, sets:union([Found1, Found2]), IgnoreFound1 or IgnoreFound2, sets:union([LetrecFound1, LetrecFound2])}; 'let' -> - {Arg, C2, Found1, IgnoreFound1, LetrecFound1} = annotate_maybe_error(cerl:let_arg(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + %% For let nodes we also have to add the newly created variables to the symbol table. + {Arg, C2, Found1, IgnoreFound1, LetrecFound1} = annotate_maybe_error(cerl:let_arg(Tree), SM, Force, Ignored, LetrecIgnored, Mod), SM1 = put_vars(cerl:let_vars(Tree), get_arg_maybe_errors(Arg), SM), - {Vars, C1, Found2, IgnoreFound2, LetrecFound2} = annotate_maybe_error_all(cerl:let_vars(Tree), SM1, Force, Ignored, LetrecIgnored, Mod, CheckTypes), - {Body, C3, Found3, IgnoreFound3, LetrecFound3} = annotate_maybe_error(cerl:let_body(Tree), SM1, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + {Vars, C1, Found2, IgnoreFound2, LetrecFound2} = annotate_maybe_error_all(cerl:let_vars(Tree), SM1, Force, Ignored, LetrecIgnored, Mod), + {Body, C3, Found3, IgnoreFound3, LetrecFound3} = annotate_maybe_error(cerl:let_body(Tree), SM1, Force, Ignored, LetrecIgnored, Mod), Tree1 = - case vars_in_set(cerl:let_vars(Tree), Found3) of - true -> - add_force_constraint_logging(Tree); - false -> - Tree - end, + case vars_in_set(cerl:let_vars(Tree), Found3) of + true -> + add_force_constraint_logging(Tree); + false -> + Tree + end, NewMaybe_Error = maybe_error_or([get_all_maybe_error(Vars), get_maybe_error(Arg), get_maybe_error(Body)]), NewIgnoreFound = IgnoreFound1 or IgnoreFound2 or IgnoreFound3, NewLetrecFound = sets:union([LetrecFound1, LetrecFound2, LetrecFound3]), {cerl:update_c_let(update_ann(Tree1, NewMaybe_Error), Vars, Arg, Body), C1 or C2 or C3, sets:union([Found1, Found2, Found3]), NewIgnoreFound, NewLetrecFound}; letrec -> - annotate_maybe_error_letrec(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes, CurMaybe_Error); + annotate_maybe_error_letrec(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CurMaybe_Error); literal -> {update_ann(Tree, false), true == CurMaybe_Error, sets:new(), false, sets:new()}; primop -> + %% Primops are unsafe by default. {update_ann(Tree, true), false == CurMaybe_Error, sets:new(), false, sets:new()}; seq -> - {Arg, C1, Found1, IgnoreFound1, LetrecFound1} = annotate_maybe_error(cerl:seq_arg(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), - {Body, C2, Found2, IgnoreFound2, LetrecFound2} = annotate_maybe_error(cerl:seq_body(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + {Arg, C1, Found1, IgnoreFound1, LetrecFound1} = annotate_maybe_error(cerl:seq_arg(Tree), SM, Force, Ignored, LetrecIgnored, Mod), + {Body, C2, Found2, IgnoreFound2, LetrecFound2} = annotate_maybe_error(cerl:seq_body(Tree), SM, Force, Ignored, LetrecIgnored, Mod), NewIgnoreFound = IgnoreFound1 or IgnoreFound2, NewLetrecFound = sets:union([LetrecFound1, LetrecFound2]), NewMaybe_Error = maybe_error_or([get_maybe_error(Arg), get_maybe_error(Body)]), {cerl:update_c_seq(update_ann(Tree, NewMaybe_Error), Arg, Body), C1 or C2, sets:union([Found1, Found2]), NewIgnoreFound, NewLetrecFound}; 'try' -> - {Arg, C1, Found1, IgnoreFound1, LetrecFound1} = annotate_maybe_error(cerl:try_arg(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), - {Vars, C2, Found2, IgnoreFound2, LetrecFound2} = annotate_maybe_error_all(cerl:try_vars(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), - {Body, C3, Found3, IgnoreFound3, LetrecFound3} = annotate_maybe_error(cerl:try_body(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), - {Evars, C4, Found4, IgnoreFound4, LetrecFound4} = annotate_maybe_error_all(cerl:try_evars(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), - {Handler, C5, Found5, IgnoreFound5, LetrecFound5} = annotate_maybe_error(cerl:try_handler(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + %% Since we don't categorize the errors produced, we don't let them exist + %% even in a try construct. If something is unsafe, the whole try is unsafe. + {Arg, C1, Found1, IgnoreFound1, LetrecFound1} = annotate_maybe_error(cerl:try_arg(Tree), SM, Force, Ignored, LetrecIgnored, Mod), + {Vars, C2, Found2, IgnoreFound2, LetrecFound2} = annotate_maybe_error_all(cerl:try_vars(Tree), SM, Force, Ignored, LetrecIgnored, Mod), + {Body, C3, Found3, IgnoreFound3, LetrecFound3} = annotate_maybe_error(cerl:try_body(Tree), SM, Force, Ignored, LetrecIgnored, Mod), + {Evars, C4, Found4, IgnoreFound4, LetrecFound4} = annotate_maybe_error_all(cerl:try_evars(Tree), SM, Force, Ignored, LetrecIgnored, Mod), + {Handler, C5, Found5, IgnoreFound5, LetrecFound5} = annotate_maybe_error(cerl:try_handler(Tree), SM, Force, Ignored, LetrecIgnored, Mod), NewIgnoreFound = IgnoreFound1 or IgnoreFound2 or IgnoreFound3 or IgnoreFound4 or IgnoreFound5, NewLetrecFound = sets:union([LetrecFound1, LetrecFound2, LetrecFound3, LetrecFound4, LetrecFound5]), NewMaybe_Error = get_maybe_error(Arg), {cerl:update_c_try(update_ann(Tree, NewMaybe_Error), Arg, Vars, Body, Evars, Handler), C1 or C2 or C3 or C4 or C5, sets:union([Found1, Found2, Found3, Found4, Found5]), NewIgnoreFound, NewLetrecFound}; tuple -> - {Es, C, Found, IgnoreFound, LetrecFound} = annotate_maybe_error_all(cerl:tuple_es(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + {Es, C, Found, IgnoreFound, LetrecFound} = annotate_maybe_error_all(cerl:tuple_es(Tree), SM, Force, Ignored, LetrecIgnored, Mod), NewMaybe_Error = get_all_maybe_error(Es), {cerl:update_c_tuple(update_ann(Tree, NewMaybe_Error), Es), C, Found, IgnoreFound, LetrecFound}; values -> - {Es, C, Found, IgnoreFound, LetrecFound} = annotate_maybe_error_all(cerl:values_es(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + {Es, C, Found, IgnoreFound, LetrecFound} = annotate_maybe_error_all(cerl:values_es(Tree), SM, Force, Ignored, LetrecIgnored, Mod), NewMaybe_Error = get_all_maybe_error(Es), {cerl:update_c_values(update_ann(Tree, NewMaybe_Error), Es), C, Found, IgnoreFound, LetrecFound}; var -> + %% If Force is true, we have to add the variable + %% To the Found return value, in order for parent lets + %% to know where their variables were used to. Found = - case Force of - true -> sets:add_element(cerl:var_name(Tree), sets:new()); - false -> sets:new() - end, + case Force of + true -> sets:add_element(cerl:var_name(Tree), sets:new()); + false -> sets:new() + end, case dict:find(cerl:var_name(Tree), SM) of - {ok, {Value, _}} -> - {update_ann(Tree, Value), Value =/= CurMaybe_Error, Found, false, sets:new()}; - error -> - {update_ann(Tree, true), true =/= CurMaybe_Error, Found, false, sets:new()} + {ok, {Value, _}} -> + {update_ann(Tree, Value), Value =/= CurMaybe_Error, Found, false, sets:new()}; + error -> + {update_ann(Tree, true), true =/= CurMaybe_Error, Found, false, sets:new()} end; _ -> {update_ann(Tree, true), true =/= CurMaybe_Error, sets:new(), false, sets:new()} end. -annotate_maybe_error_apply(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes, CurMaybe_Error) -> +%% Handles apply nodes. +annotate_maybe_error_apply(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CurMaybe_Error) -> Op = cerl:apply_op(Tree), - {Op1, C1, IgnoreFound1, LetrecFound1} = + {Op1, C1, IgnoreFound1, LetrecFound1} = case cerl:type(Op) of var -> - case cerl:var_name(Op) of - {F, A} -> - case dict:find({Mod, F, A}, SM) of - {ok, {Value, 'fun'}} -> - case Value of - type_dependent when CheckTypes -> - case cuter_spec_checker:get_cerl_type(Tree) of - notype -> {update_ann(Op, true), true =/= CurMaybe_Error, false, sets:new()}; - _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false, sets:new()} - end; - _ -> - {update_ann(Op, Value), Value =/= CurMaybe_Error, false, sets:new()} - end; - error -> - case dict:find({F, A}, SM) of - {ok, {Value, FunType}} when FunType =:= 'fun' orelse FunType =:= letvar -> - case Value of - type_dependent when CheckTypes -> - case cuter_spec_checker:get_cerl_type(Tree) of - notype -> {update_ann(Op, true), true =/= CurMaybe_Error, false, sets:new()}; - _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false, sets:new()} - end; - _ -> - {update_ann(Op, Value), Value =/= CurMaybe_Error, false, sets:new()} - end; - error -> - case sets:is_element({Mod, F, A}, Ignored) of - false -> - case sets:is_element({F, A}, LetrecIgnored) of - true -> - {Op, false, false, sets:from_list([{F, A}])}; - false -> - {update_ann(Op, true), true =/= CurMaybe_Error, false, sets:new()} - end; - true -> - {update_ann(Op, false), false =/= CurMaybe_Error, true, sets:new()} - end - end - end; - Name -> - case dict:find(Name, SM) of - {ok, {Value, _FunType}} -> %when FunType =:= 'fun' orelse FunType =:= letvar -> - case Value of - type_dependent when CheckTypes -> - case cuter_spec_checker:get_cerl_type(Tree) of - notype -> {update_ann(Op, true), true =/= CurMaybe_Error, false}; - _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false, sets:new()} - end; - _ -> - {update_ann(Op, Value), Value =/= CurMaybe_Error, false, sets:new()} - end; - _ -> - {update_ann(Op, true), true =/= CurMaybe_Error, false, sets:new()} - end - end; + %% We are applying a var. + case cerl:var_name(Op) of + {F, A} -> + %% It is of the form {F, A} so we search for the corresponding Mfa to the symbol table. + case dict:find({Mod, F, A}, SM) of + {ok, {Value, 'fun'}} -> + %% If it is in the symbol table we check its 'maybe_error' annotation. + case Value of + type_dependent -> + %% It is type_dependent so we have to check whether the application + %% node has been typed succesfully. If it has, it is a safe application. + case cuter_spec_checker:get_cerl_type(Tree) of + notype -> {update_ann(Op, true), true =/= CurMaybe_Error, false, sets:new()}; + _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false, sets:new()} + end; + _ -> {update_ann(Op, Value), Value =/= CurMaybe_Error, false, sets:new()} + end; + error -> + case dict:find({F, A}, SM) of + {ok, {Value, FunType}} when FunType =:= 'fun' orelse FunType =:= letvar -> + case Value of + type_dependent -> + case cuter_spec_checker:get_cerl_type(Tree) of + notype -> {update_ann(Op, true), true =/= CurMaybe_Error, false, sets:new()}; + _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false, sets:new()} + end; + _ -> + {update_ann(Op, Value), Value =/= CurMaybe_Error, false, sets:new()} + end; + error -> + case sets:is_element({Mod, F, A}, Ignored) of + false -> + case sets:is_element({F, A}, LetrecIgnored) of + true -> + {Op, false, false, sets:from_list([{F, A}])}; + false -> + {update_ann(Op, true), true =/= CurMaybe_Error, false, sets:new()} + end; + true -> + {update_ann(Op, false), false =/= CurMaybe_Error, true, sets:new()} + end + end + end; + Name -> + case dict:find(Name, SM) of + {ok, {Value, _FunType}} -> + case Value of + type_dependent -> + case cuter_spec_checker:get_cerl_type(Tree) of + notype -> {update_ann(Op, true), true =/= CurMaybe_Error, false}; + _ -> {update_ann(Op, type_dependent), type_dependent =/= CurMaybe_Error, false, sets:new()} + end; + _ -> + {update_ann(Op, Value), Value =/= CurMaybe_Error, false, sets:new()} + end; + _ -> + {update_ann(Op, true), true =/= CurMaybe_Error, false, sets:new()} + end + end; _ -> - error("unhandled op") + error("unhandled op") end, - {Args, C2, Found, IgnoreFound2, LetrecFound2} = annotate_maybe_error_all(cerl:apply_args(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + {Args, C2, Found, IgnoreFound2, LetrecFound2} = annotate_maybe_error_all(cerl:apply_args(Tree), SM, Force, Ignored, LetrecIgnored, Mod), NewMaybe_Error = maybe_error_or([get_maybe_error(Op1), get_all_maybe_error(Args)]), case get_all_maybe_error(Args) of true -> @@ -298,34 +356,35 @@ annotate_maybe_error_apply(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTy end, {cerl:update_c_apply(update_ann(Tree1, NewMaybe_Error), Op1, Args), C1 or C2, Found, IgnoreFound1 or IgnoreFound2, sets:union([LetrecFound1, LetrecFound2])}. -annotate_maybe_error_call(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes, CurMaybe_Error) -> +%% Same as apply but we don't check for closures. +annotate_maybe_error_call(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CurMaybe_Error) -> ModName = cerl:call_module(Tree), Name = cerl:call_name(Tree), Arity = length(cerl:call_args(Tree)), {NewAnn, IgnoreFound1} = case cerl:is_literal(ModName) andalso cerl:is_literal(Name) of true -> - case dict:find({element(3, ModName), element(3, Name), Arity}, SM) of - {ok, {Value, 'fun'}} -> - case Value of - type_dependent when CheckTypes -> - case cuter_spec_checker:get_cerl_type(Tree) of - notype -> {true, false}; - _ -> {type_dependent, false} - end; - _ -> {Value, false} - end; - _ -> - case sets:is_element({element(3, ModName), element(3, Name), Arity}, Ignored) of - false -> - {true, false}; - true -> - {true, true} - end - end; + case dict:find({element(3, ModName), element(3, Name), Arity}, SM) of + {ok, {Value, 'fun'}} -> + case Value of + type_dependent -> + case cuter_spec_checker:get_cerl_type(Tree) of + notype -> {true, false}; + _ -> {type_dependent, false} + end; + _ -> {Value, false} + end; + _ -> + case sets:is_element({element(3, ModName), element(3, Name), Arity}, Ignored) of + false -> + {true, false}; + true -> + {true, true} + end + end; _ -> throw("Unsupported call") end, - {Args, C1, Found, IgnoreFound2, LetrecFound} = annotate_maybe_error_all(cerl:call_args(Tree), SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + {Args, C1, Found, IgnoreFound2, LetrecFound} = annotate_maybe_error_all(cerl:call_args(Tree), SM, Force, Ignored, LetrecIgnored, Mod), NewMaybe_Error = maybe_error_or([NewAnn, get_all_maybe_error(Args)]), C2 = NewMaybe_Error =/= CurMaybe_Error, case get_all_maybe_error(Args) of @@ -336,34 +395,37 @@ annotate_maybe_error_call(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTyp end, {cerl:update_c_call(update_ann(Tree1, NewMaybe_Error), ModName, Name, Args), C1 or C2, Found, IgnoreFound1 or IgnoreFound2, LetrecFound}. -annotate_maybe_error_letrec(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes, CurMaybe_Error) -> +%% Letrec nodes do a fixpoint on their functiosn that they introduce. +annotate_maybe_error_letrec(Tree, SM, Force, Ignored, LetrecIgnored, Mod, CurMaybe_Error) -> {Names, Funsb} = lists:unzip(cerl:letrec_defs(Tree)), FunNames = [cerl:var_name(Name) || Name <- Names], FunNames1 = sets:from_list(FunNames), NewIgnored = sets:union(LetrecIgnored, FunNames1), - {Funs, C1, Found1, IgnoreFound1, LetrecFound1} = annotate_maybe_error_letrec_fix(FunNames, Funsb, SM, Force, Ignored, NewIgnored, Mod, CheckTypes), + {Funs, C1, Found1, IgnoreFound1, LetrecFound1} = annotate_maybe_error_letrec_fix(FunNames, Funsb, SM, Force, Ignored, NewIgnored, Mod, false), SM1 = put_vars(Names, [{get_maybe_error_pessimistic(A), letvar} || A <- Funs], SM), - {Body, C2, Found2, IgnoreFound2, LetrecFound2} = annotate_maybe_error(cerl:letrec_body(Tree), SM1, Force, Ignored, LetrecIgnored, Mod, CheckTypes), + {Body, C2, Found2, IgnoreFound2, LetrecFound2} = annotate_maybe_error(cerl:letrec_body(Tree), SM1, Force, Ignored, LetrecIgnored, Mod), NewMaybe_Error = get_maybe_error(Body), Change = C1 or C2 or (CurMaybe_Error =/= NewMaybe_Error), {cerl:update_c_letrec(update_ann(Tree, NewMaybe_Error), lists:zip(Names, Funs), Body), Change, sets:union([Found1, Found2]), IgnoreFound1 or IgnoreFound2, sets:union([LetrecFound1, LetrecFound2])}. -annotate_maybe_error_letrec_fix(Names, Funsb, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes) -> - annotate_maybe_error_letrec_fix(Names, Funsb, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes, false). - - -annotate_maybe_error_letrec_fix(Names, Funsb, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes, Acc) -> - {Funs, C, Found, IgnoreFound, LetrecFound} = annotate_maybe_error_all(Funsb, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes), +%% The fix-point computation for letrec nodes. +annotate_maybe_error_letrec_fix(Names, Funsb, SM, Force, Ignored, LetrecIgnored, Mod, Acc) -> + %% Annotate everything. + {Funs, C, Found, IgnoreFound, LetrecFound} = annotate_maybe_error_all(Funsb, SM, Force, Ignored, LetrecIgnored, Mod), + %% Filter Found applications belonging to this letrec node. ThisLetrecFound = sets:filter(fun(X) -> cuter_graphs:list_contains(X, Names) end, LetrecFound), + %% If something changed or we found functions called from this SCC, run again. case C or (sets:size(ThisLetrecFound) > 0) of true -> SM1 = put_vars_by_name(Names, [{get_maybe_error_pessimistic(A), letvar} || A <- Funs], SM), - annotate_maybe_error_letrec_fix(Names, Funs, SM1, Force, Ignored, LetrecIgnored, Mod, CheckTypes, C or Acc); + annotate_maybe_error_letrec_fix(Names, Funs, SM1, Force, Ignored, LetrecIgnored, Mod, C or Acc); false -> RestLetrecFound = sets:filter(fun(X) -> not cuter_graphs:list_contains(X, Names) end, LetrecFound), {Funs, Acc, Found, IgnoreFound, RestLetrecFound} end. +%% Annotates a pattern tree. This is considerably different since patterns +%% have only specific nodes. annotate_maybe_error_pattern(Tree, SM, Force) -> CurMaybe_Error = get_maybe_error(Tree), case cerl:type(Tree) of @@ -371,15 +433,15 @@ annotate_maybe_error_pattern(Tree, SM, Force) -> {update_ann(Tree, false), true == CurMaybe_Error, sets:new(), SM}; var -> Found = - case Force of - true -> sets:add_element(cerl:var_name(Tree), sets:new()); - false -> sets:new() - end, + case Force of + true -> sets:add_element(cerl:var_name(Tree), sets:new()); + false -> sets:new() + end, case dict:find(cerl:var_name(Tree), SM) of - {ok, {Value, _}} -> - {update_ann(Tree, Value), Value =/= CurMaybe_Error, Found, SM}; - error -> - {update_ann(Tree, false), false =/= CurMaybe_Error, Found, put_vars([Tree], [{type_dependent, 'var'}], SM)} + {ok, {Value, _}} -> + {update_ann(Tree, Value), Value =/= CurMaybe_Error, Found, SM}; + error -> + {update_ann(Tree, false), false =/= CurMaybe_Error, Found, put_vars([Tree], [{type_dependent, 'var'}], SM)} end; cons -> {Hd, C1, Found1, SM1} = annotate_maybe_error_pattern(cerl:cons_hd(Tree), SM, Force), @@ -399,16 +461,17 @@ annotate_maybe_error_pattern(Tree, SM, Force) -> C2 = CurMaybe_Error =/= type_dependent, {cerl:update_c_alias(Tree1, Var1, Pat), C1 or C2, Found, SM2} end. - --spec get_arg_maybe_errors(cerl:cerl()) -> [{maybe_error(), atom()}]. + get_arg_maybe_errors(Arg) -> [{get_maybe_error_pessimistic(Arg), letvar}]. -annotate_maybe_error_all(Trees, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes) -> - X = [annotate_maybe_error(T, SM, Force, Ignored, LetrecIgnored, Mod, CheckTypes) || T <- Trees], +%% Wrapper for annotate_maybe_error/6 for a list of nodes. +annotate_maybe_error_all(Trees, SM, Force, Ignored, LetrecIgnored, Mod) -> + X = [annotate_maybe_error(T, SM, Force, Ignored, LetrecIgnored, Mod) || T <- Trees], Or = fun(E) -> fun(A, B) -> B or element(E, A) end end, {[element(1, Y) || Y <- X], lists:foldl(Or(2), false, X), sets:union([element(3, Z) || Z <- X]), lists:foldl(Or(4), false, X), sets:union([element(5, Z) || Z <- X])}. +%% Wrapper for annotate_maybe_error_pattern/3 for a list of patterns. annotate_maybe_error_pattern_all(Trees, SM, Force) -> annotate_maybe_error_pattern_all(Trees, SM, Force, [], false, sets:new()). @@ -417,21 +480,27 @@ annotate_maybe_error_pattern_all([Tree|Trees], SM, Force, AccTrees, AccC, AccFou {NewTree, C, Found, SM1} = annotate_maybe_error_pattern(Tree, SM, Force), annotate_maybe_error_pattern_all(Trees, SM1, Force, [NewTree|AccTrees], C or AccC, sets:union([AccFound, Found])). --spec get_maybe_error(cerl:cerl()) -> maybe_error(). +%% Fetches the maybe_error annotation of a cerl node. get_maybe_error(Tree) -> Anno = cerl:get_ann(Tree), get_maybe_error_anno(Anno). --spec get_maybe_error_anno([any()]) -> maybe_error(). +%% Fetches the maybe_error annotation in a list of annotations. get_maybe_error_anno([]) -> false; get_maybe_error_anno([{maybe_error, V}|_]) -> V; get_maybe_error_anno([_|Tl]) -> get_maybe_error_anno(Tl). +%% Fetches the 'maybe_error_annotation' of a node as true false +%% depending on the value of DT. +%% DT == true ==> type_dependent == true +%% DT == false ==> type_dependent == false -spec get_maybe_error_bin(cerl:cerl(), boolean()) -> boolean(). get_maybe_error_bin(Tree, DT) -> Anno = cerl:get_ann(Tree), get_maybe_error_bin_anno(Anno, DT). +%% Fetches the 'maybe_error_annotation' like get_maybe_error_bin/2 but +%% given the list of annotations directly. -spec get_maybe_error_bin_anno([any()], boolean()) -> boolean(). get_maybe_error_bin_anno([], _DT) -> true; get_maybe_error_bin_anno([{maybe_error, V}|_], DT) -> @@ -441,17 +510,21 @@ get_maybe_error_bin_anno([{maybe_error, V}|_], DT) -> end; get_maybe_error_bin_anno([_|Tl], DT) -> get_maybe_error_bin_anno(Tl, DT). +%% Fetches the maybe_error annotation considering non +%% annotated notes as having a true annotation get_maybe_error_pessimistic(Tree) -> get_maybe_error_pessimistic_anno(cerl:get_ann(Tree)). get_maybe_error_pessimistic_anno([]) -> true; get_maybe_error_pessimistic_anno([{maybe_error, V}|_]) -> V; get_maybe_error_pessimistic_anno([_|Tl]) -> get_maybe_error_pessimistic_anno(Tl). - --spec get_all_maybe_error([cerl:cerl()]) -> maybe_error(). + +%% Returns a list of 'maybe_error' annotations given a list of nodes. get_all_maybe_error(Trees) -> maybe_error_or([get_maybe_error(T) || T <- Trees, not cuter_spec_checker:get_type_dependent_unreachable(T)]). +%% Returns true if at least one variable in a list given +%% as the first argument is part of a set given as the second argument. vars_in_set([], _) -> false; vars_in_set([Hd|Tl], Set) -> case sets:is_element(cerl:var_name(Hd), Set) of @@ -461,6 +534,7 @@ vars_in_set([Hd|Tl], Set) -> vars_in_set(Tl, Set) end. +%% Fetches the 'force_constraint_logging' annotation. -spec get_force_constraint_logging([any()]) -> boolean(). get_force_constraint_logging([]) -> false; get_force_constraint_logging([Hd|Tl]) -> @@ -471,6 +545,7 @@ get_force_constraint_logging([Hd|Tl]) -> get_force_constraint_logging(Tl) end. +%% Fetches the 'distrust_type_dependent' annotation. -spec get_distrust_type_dependent([any()]) -> boolean(). get_distrust_type_dependent([]) -> false; get_distrust_type_dependent([Hd|Tl]) -> @@ -481,37 +556,39 @@ get_distrust_type_dependent([Hd|Tl]) -> get_distrust_type_dependent(Tl) end. --spec maybe_error_or([maybe_error()]) -> maybe_error(). +%% Binary operator between two 'maybe_error' annotations. maybe_error_or(E) -> lists:foldl( fun(A, B) -> - case A of - true -> true; - false -> B; - type_dependent -> - case B of - true -> true; - _ -> type_dependent - end - end + case A of + true -> true; + false -> B; + type_dependent -> + case B of + true -> true; + _ -> type_dependent + end + end end, false, E ). +%% Returns whether there is an unreachable clause in a set of clauses. unreachable_clauses(Clauses) -> lists:foldl(fun(Clause, Acc) -> Acc orelse cuter_spec_checker:get_type_dependent_unreachable(Clause) end, false, Clauses). +%% Creates the flags needed to input to put_vars/3. make_fun_flags(Vars) -> Fn = fun(Var) -> - case cuter_spec_checker:get_cerl_type(Var) of - notype -> {false, var}; - T -> - case erl_types:t_is_fun(T) of - true -> {type_dependent, var}; - false -> {false, var} - end - end + case cuter_spec_checker:get_cerl_type(Var) of + notype -> {false, var}; + T -> + case erl_types:t_is_fun(T) of + true -> {type_dependent, var}; + false -> {false, var} + end + end end, lists:map(Fn, Vars). @@ -522,39 +599,21 @@ make_fun_flags(Vars) -> %% then annotates it from the leaves to the root, in a DFS order %% ================================================================================ --spec preprocess(mfa(), dict:dict(), boolean()) -> dict:dict(). -preprocess(EntryPoint, KFunctionASTS, CheckTypes) -> - FunctionASTS = - dict:map( - fun(_, Value) -> - cuter_cerl:kfun_code(Value) - end, - KFunctionASTS - ), - {CallGraph, _Funs, NewEntryPoint} = cuter_graphs:calculate_dag_callgraph(EntryPoint), - AnnotatedASTS = annotate_callgraph(NewEntryPoint, FunctionASTS, CallGraph, CheckTypes), - dict:map( - fun(Key, Value) -> - cuter_cerl:kfun_update_code(Value, dict:fetch(Key, AnnotatedASTS)) - end, - KFunctionASTS - ). - --spec preprocess(mfa(), dict:dict(), dict:dict(), boolean()) -> dict:dict(). -preprocess(EntryPoint, KFunctionASTS, MfasToSpecs, CheckTypes) -> +-spec preprocess(mfa(), dict:dict(), dict:dict()) -> dict:dict(). +preprocess(EntryPoint, KFunctionASTS, MfasToSpecs) -> FunctionASTS = dict:map( fun(_, Value) -> - cuter_cerl:kfun_code(Value) + cuter_cerl:kfun_code(Value) end, KFunctionASTS ), {CallGraph, Funs, NewEntryPoint} = cuter_graphs:calculate_dag_callgraph(EntryPoint), TypedASTS = cuter_spec_checker:annotate_types(FunctionASTS, MfasToSpecs, Funs), - AnnotatedASTS = annotate_callgraph(NewEntryPoint, TypedASTS, CallGraph, CheckTypes), + AnnotatedASTS = annotate_callgraph(NewEntryPoint, TypedASTS, CallGraph), dict:map( fun(Key, Value) -> - cuter_cerl:kfun_update_code(Value, dict:fetch(Key, AnnotatedASTS)) + cuter_cerl:kfun_update_code(Value, dict:fetch(Key, AnnotatedASTS)) end, KFunctionASTS ). diff --git a/src/cuter_type_dependent_functions.erl b/src/cuter_type_dependent_functions.erl index b58299d5..2df74067 100644 --- a/src/cuter_type_dependent_functions.erl +++ b/src/cuter_type_dependent_functions.erl @@ -1,6 +1,9 @@ -module(cuter_type_dependent_functions). -export([original_tsm/0]). +%% Returns a dictionary with: +%% Keys: Mfas of built-in functions +%% Values: List of signatures of these functions. -spec original_tsm() -> dict:dict(). original_tsm() -> TSM = dict:from_list(