diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/dialyzer/src/dialyzer_contracts.erl | 161 | ||||
| -rw-r--r-- | lib/dialyzer/src/dialyzer_utils.erl | 110 | ||||
| -rw-r--r-- | lib/hipe/cerl/erl_types.erl | 408 |
3 files changed, 391 insertions, 288 deletions
diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 272ad10e90..976a2b8955 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -53,7 +53,9 @@ %% to expand records and/or remote types that they might contain. %%----------------------------------------------------------------------- --type tmp_contract_fun() :: fun((sets:set(mfa()), types()) -> contract_pair()). +-type cache() :: ets:tid(). +-type tmp_contract_fun() :: + fun((sets:set(mfa()), types(), cache()) -> contract_pair()). -record(tmp_contract, {contract_funs = [] :: [tmp_contract_fun()], forms = [] :: [{_, _}]}). @@ -153,19 +155,30 @@ process_contract_remote_types(CodeServer) -> ExpTypes = dialyzer_codeserver:get_exported_types(CodeServer), RecordDict = dialyzer_codeserver:get_records(CodeServer), ContractFun = - fun({_M, _F, _A}, {File, #tmp_contract{contract_funs = CFuns, forms = Forms}, Xtra}) -> - NewCs = [CFun(ExpTypes, RecordDict) || CFun <- CFuns], - Args = general_domain(NewCs), - {File, #contract{contracts = NewCs, args = Args, forms = Forms}, Xtra} + fun({{_M, _F, _A}=MFA, {File, TmpContract, Xtra}}, C0) -> + #tmp_contract{contract_funs = CFuns, forms = Forms} = TmpContract, + {NewCs, C2} = lists:mapfoldl(fun(CFun, C1) -> + CFun(ExpTypes, RecordDict, C1) + end, C0, CFuns), + Args = general_domain(NewCs), + Contract = #contract{contracts = NewCs, args = Args, forms = Forms}, + {{MFA, {File, Contract, Xtra}}, C2} end, ModuleFun = - fun(_ModuleName, ContractDict) -> - dict:map(ContractFun, ContractDict) + fun({ModuleName, ContractDict}, C3) -> + {NewContractList, C4} = + lists:mapfoldl(ContractFun, C3, dict:to_list(ContractDict)), + {{ModuleName, dict:from_list(NewContractList)}, C4} end, - NewContractDict = dict:map(ModuleFun, TmpContractDict), - NewCallbackDict = dict:map(ModuleFun, TmpCallbackDict), + Cache = erl_types:cache__new(), + {NewContractList, C5} = + lists:mapfoldl(ModuleFun, Cache, dict:to_list(TmpContractDict)), + {NewCallbackList, _C6} = + lists:mapfoldl(ModuleFun, C5, dict:to_list(TmpCallbackDict)), + NewContractDict = dict:from_list(NewContractList), + NewCallbackDict = dict:from_list(NewCallbackList), dialyzer_codeserver:finalize_contracts(NewContractDict, NewCallbackDict, - CodeServer). + CodeServer). -type opaques_fun() :: fun((module()) -> [erl_types:erl_type()]). @@ -431,19 +444,19 @@ contract_from_form(Forms, MFA, RecDict, FileLine) -> contract_from_form([{type, _, 'fun', [_, _]} = Form | Left], MFA, RecDict, FileLine, TypeAcc, FormAcc) -> TypeFun = - fun(ExpTypes, AllRecords) -> - NewType = + fun(ExpTypes, AllRecords, Cache) -> + {NewType, NewCache} = try - from_form_with_check(Form, ExpTypes, MFA, AllRecords) + from_form_with_check(Form, ExpTypes, MFA, AllRecords, Cache) catch throw:{error, Msg} -> {File, Line} = FileLine, NewMsg = io_lib:format("~s:~p: ~s", [filename:basename(File), - Line, Msg]), + Line, Msg]), throw({error, NewMsg}) end, NewTypeNoVars = erl_types:subst_all_vars_to_any(NewType), - {NewTypeNoVars, []} + {{NewTypeNoVars, []}, NewCache} end, NewTypeAcc = [TypeFun | TypeAcc], NewFormAcc = [{Form, []} | FormAcc], @@ -452,13 +465,15 @@ contract_from_form([{type, _L1, bounded_fun, [{type, _L2, 'fun', [_, _]} = Form, Constr]}| Left], MFA, RecDict, FileLine, TypeAcc, FormAcc) -> TypeFun = - fun(ExpTypes, AllRecords) -> - {Constr1, VarDict} = - process_constraints(Constr, MFA, RecDict, ExpTypes, AllRecords), - NewType = from_form_with_check(Form, ExpTypes, MFA, AllRecords, - VarDict), + fun(ExpTypes, AllRecords, Cache) -> + {Constr1, VarTable, Cache1} = + process_constraints(Constr, MFA, RecDict, ExpTypes, AllRecords, + Cache), + {NewType, NewCache} = + from_form_with_check(Form, ExpTypes, MFA, AllRecords, + VarTable, Cache1), NewTypeNoVars = erl_types:subst_all_vars_to_any(NewType), - {NewTypeNoVars, Constr1} + {{NewTypeNoVars, Constr1}, NewCache} end, NewTypeAcc = [TypeFun | TypeAcc], NewFormAcc = [{Form, Constr} | FormAcc], @@ -466,74 +481,91 @@ contract_from_form([{type, _L1, bounded_fun, contract_from_form([], _MFA, _RecDict, _FileLine, TypeAcc, FormAcc) -> {lists:reverse(TypeAcc), lists:reverse(FormAcc)}. -process_constraints(Constrs, MFA, RecDict, ExpTypes, AllRecords) -> - Init0 = initialize_constraints(Constrs, MFA, RecDict, ExpTypes, AllRecords), +process_constraints(Constrs, MFA, RecDict, ExpTypes, AllRecords, Cache) -> + {Init0, NewCache} = initialize_constraints(Constrs, MFA, RecDict, ExpTypes, + AllRecords, Cache), Init = remove_cycles(Init0), - constraints_fixpoint(Init, MFA, RecDict, ExpTypes, AllRecords). + constraints_fixpoint(Init, MFA, RecDict, ExpTypes, AllRecords, NewCache). -initialize_constraints(Constrs, MFA, RecDict, ExpTypes, AllRecords) -> - initialize_constraints(Constrs, MFA, RecDict, ExpTypes, AllRecords, []). +initialize_constraints(Constrs, MFA, RecDict, ExpTypes, AllRecords, Cache) -> + initialize_constraints(Constrs, MFA, RecDict, ExpTypes, AllRecords, + Cache, []). -initialize_constraints([], _MFA, _RecDict, _ExpTypes, _AllRecords, Acc) -> - Acc; -initialize_constraints([Constr|Rest], MFA, RecDict, ExpTypes, AllRecords, Acc) -> +initialize_constraints([], _MFA, _RecDict, _ExpTypes, _AllRecords, + Cache, Acc) -> + {Acc, Cache}; +initialize_constraints([Constr|Rest], MFA, RecDict, ExpTypes, AllRecords, + Cache, Acc) -> case Constr of {type, _, constraint, [{atom, _, is_subtype}, [Type1, Type2]]} -> VarTable = erl_types:var_table__new(), - T1 = final_form(Type1, ExpTypes, MFA, AllRecords, VarTable), + {T1, NewCache} = + final_form(Type1, ExpTypes, MFA, AllRecords, VarTable, Cache), Entry = {T1, Type2}, - initialize_constraints(Rest, MFA, RecDict, ExpTypes, AllRecords, [Entry|Acc]); + initialize_constraints(Rest, MFA, RecDict, ExpTypes, AllRecords, + NewCache, [Entry|Acc]); {type, _, constraint, [{atom,_,Name}, List]} -> N = length(List), throw({error, io_lib:format("Unsupported type guard ~w/~w\n", [Name, N])}) end. -constraints_fixpoint(Constrs, MFA, RecDict, ExpTypes, AllRecords) -> +constraints_fixpoint(Constrs, MFA, RecDict, ExpTypes, AllRecords, Cache) -> VarTable = erl_types:var_table__new(), - VarDict = - constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, AllRecords, VarTable), - constraints_fixpoint(VarDict, MFA, Constrs, RecDict, ExpTypes, AllRecords). - -constraints_fixpoint(OldVarDict, MFA, Constrs, RecDict, ExpTypes, AllRecords) -> - NewVarDict = - constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, AllRecords, OldVarDict), - case NewVarDict of - OldVarDict -> + {VarTab, NewCache} = + constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, AllRecords, + VarTable, Cache), + constraints_fixpoint(VarTab, MFA, Constrs, RecDict, ExpTypes, + AllRecords, NewCache). + +constraints_fixpoint(OldVarTab, MFA, Constrs, RecDict, ExpTypes, + AllRecords, Cache) -> + {NewVarTab, NewCache} = + constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, AllRecords, + OldVarTab, Cache), + case NewVarTab of + OldVarTab -> Fun = fun(Key, Value, Acc) -> [{subtype, erl_types:t_var(Key), Value}|Acc] end, - FinalConstrs = maps:fold(Fun, [], NewVarDict), - {FinalConstrs, NewVarDict}; + FinalConstrs = maps:fold(Fun, [], NewVarTab), + {FinalConstrs, NewVarTab, NewCache}; _Other -> - constraints_fixpoint(NewVarDict, MFA, Constrs, RecDict, ExpTypes, AllRecords) + constraints_fixpoint(NewVarTab, MFA, Constrs, RecDict, ExpTypes, + AllRecords, NewCache) end. -final_form(Form, ExpTypes, MFA, AllRecords, VarDict) -> - from_form_with_check(Form, ExpTypes, MFA, AllRecords, VarDict). +final_form(Form, ExpTypes, MFA, AllRecords, VarTable, Cache) -> + from_form_with_check(Form, ExpTypes, MFA, AllRecords, VarTable, Cache). -from_form_with_check(Form, ExpTypes, MFA, AllRecords) -> +from_form_with_check(Form, ExpTypes, MFA, AllRecords, Cache) -> VarTable = erl_types:var_table__new(), - from_form_with_check(Form, ExpTypes, MFA, AllRecords, VarTable). + from_form_with_check(Form, ExpTypes, MFA, AllRecords, VarTable, Cache). -from_form_with_check(Form, ExpTypes, MFA, AllRecords, VarDict) -> +from_form_with_check(Form, ExpTypes, MFA, AllRecords, VarTable, Cache) -> Site = {spec, MFA}, - erl_types:t_check_record_fields(Form, ExpTypes, Site, AllRecords, VarDict), - erl_types:t_from_form(Form, ExpTypes, Site, AllRecords, VarDict). - -constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, AllRecords, VarDict) -> - Subtypes = - constraints_to_subs(Constrs, MFA, RecDict, ExpTypes, AllRecords, VarDict, []), - insert_constraints(Subtypes). - -constraints_to_subs([], _MFA, _RecDict, _ExpTypes, _AllRecords, _VarDict, Acc) -> - Acc; -constraints_to_subs([C|Rest], MFA, RecDict, ExpTypes, AllRecords, VarDict, Acc) -> - {T1, Form2} = C, - T2 = final_form(Form2, ExpTypes, MFA, AllRecords, VarDict), + C1 = erl_types:t_check_record_fields(Form, ExpTypes, Site, AllRecords, + VarTable, Cache), + erl_types:t_from_form(Form, ExpTypes, Site, AllRecords, VarTable, C1). + +constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, AllRecords, + VarTab, Cache) -> + {Subtypes, NewCache} = + constraints_to_subs(Constrs, MFA, RecDict, ExpTypes, AllRecords, + VarTab, Cache, []), + {insert_constraints(Subtypes), NewCache}. + +constraints_to_subs([], _MFA, _RecDict, _ExpTypes, _AllRecords, + _VarTab, Cache, Acc) -> + {Acc, Cache}; +constraints_to_subs([{T1, Form2}|Rest], MFA, RecDict, ExpTypes, AllRecords, + VarTab, Cache, Acc) -> + {T2, NewCache} = + final_form(Form2, ExpTypes, MFA, AllRecords, VarTab, Cache), NewAcc = [{subtype, T1, T2}|Acc], - constraints_to_subs(Rest, MFA, RecDict, ExpTypes, AllRecords, VarDict, NewAcc). + constraints_to_subs(Rest, MFA, RecDict, ExpTypes, AllRecords, + VarTab, NewCache, NewAcc). %% Replaces variables with '_' when necessary to break up cycles among %% the constraints. @@ -647,6 +679,7 @@ get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract, _Xtra}}|Left], {value, {Ret, Args}} -> Sig = erl_types:t_fun(Args, Ret), {M, _F, _A} = MFA, + %% io:format("MFA ~p~n", [MFA]), Opaques = FindOpaques(M), {File, Line} = FileLine, WarningInfo = {File, Line, MFA}, @@ -795,7 +828,7 @@ is_remote_types_related(Contract, CSig, Sig, MFA, RecDict) -> t_from_forms_without_remote([{FType, []}], MFA, RecDict) -> Site = {spec, MFA}, - Type1 = erl_types:t_from_form_without_remote(FType, Site, RecDict), + {Type1, _} = erl_types:t_from_form_without_remote(FType, Site, RecDict), {ok, erl_types:subst_all_vars_to_any(Type1)}; t_from_forms_without_remote([{_FType, _Constrs}], _MFA, _RecDict) -> %% 'When' constraints diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 42a83e8af6..76a5cf3d0b 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -195,6 +195,7 @@ get_core_from_abstract_code(AbstrCode, Opts) -> %% ============================================================================ -type type_table() :: erl_types:type_table(). +-type mod_records() :: dict:dict(module(), type_table()). -spec get_record_and_type_info(abstract_code()) -> {'ok', type_table()} | {'error', string()}. @@ -301,92 +302,117 @@ get_record_fields([], _RecDict, Acc) -> process_record_remote_types(CServer) -> TempRecords = dialyzer_codeserver:get_temp_records(CServer), ExpTypes = dialyzer_codeserver:get_exported_types(CServer), - TempRecords1 = process_opaque_types0(TempRecords, ExpTypes), + Cache = erl_types:cache__new(), + {TempRecords1, Cache1} = + process_opaque_types0(TempRecords, ExpTypes, Cache), + %% A cache (not the field type cache) is used for speeding things up a bit. + VarTable = erl_types:var_table__new(), ModuleFun = - fun(Module, Record) -> + fun({Module, Record}, C0) -> RecordFun = - fun(Key, Value) -> + fun({Key, Value}, C2) -> case Key of {record, Name} -> FieldFun = - fun(Arity, Fields) -> + fun({Arity, Fields}, C4) -> Site = {record, {Module, Name, Arity}}, - [{FieldName, Field, - erl_types:t_from_form(Field, - ExpTypes, - Site, - TempRecords1)} - || {FieldName, Field, _} <- Fields] + {Fields1, C7} = + lists:mapfoldl(fun({FieldName, Field, _}, C5) -> + {FieldT, C6} = + erl_types:t_from_form + (Field, ExpTypes, Site, + TempRecords1, VarTable, + C5), + {{FieldName, Field, FieldT}, C6} + end, C4, Fields), + {{Arity, Fields1}, C7} end, {FileLine, Fields} = Value, - {FileLine, orddict:map(FieldFun, Fields)}; - _Other -> Value + {FieldsList, C3} = + lists:mapfoldl(FieldFun, C2, orddict:to_list(Fields)), + {{Key, {FileLine, orddict:from_list(FieldsList)}}, C3}; + _Other -> {{Key, Value}, C2} end end, - dict:map(RecordFun, Record) + {RecordList, C1} = + lists:mapfoldl(RecordFun, C0, dict:to_list(Record)), + {{Module, dict:from_list(RecordList)}, C1} end, - NewRecords = dict:map(ModuleFun, TempRecords1), - ok = check_record_fields(NewRecords, ExpTypes), + {NewRecordsList, C1} = + lists:mapfoldl(ModuleFun, Cache1, dict:to_list(TempRecords1)), + NewRecords = dict:from_list(NewRecordsList), + _C8 = check_record_fields(NewRecords, ExpTypes, C1), dialyzer_codeserver:finalize_records(NewRecords, CServer). %% erl_types:t_from_form() substitutes the declaration of opaque types %% for the expanded type in some cases. To make sure the initial type, %% any(), is not used, the expansion is done twice. %% XXX: Recursive opaque types are not handled well. -process_opaque_types0(TempRecords0, TempExpTypes) -> - TempRecords1 = process_opaque_types(TempRecords0, TempExpTypes), - process_opaque_types(TempRecords1, TempExpTypes). +process_opaque_types0(TempRecords0, TempExpTypes, Cache) -> + {TempRecords1, NewCache} = + process_opaque_types(TempRecords0, TempExpTypes, Cache), + process_opaque_types(TempRecords1, TempExpTypes, NewCache). -process_opaque_types(TempRecords, TempExpTypes) -> +process_opaque_types(TempRecords, TempExpTypes, Cache) -> + VarTable = erl_types:var_table__new(), ModuleFun = - fun(Module, Record) -> + fun({Module, Record}, C0) -> RecordFun = - fun(Key, Value) -> + fun({Key, Value}, C2) -> case Key of {opaque, Name, NArgs} -> {{_Module, _FileLine, Form, _ArgNames}=F, _Type} = Value, Site = {type, {Module, Name, NArgs}}, - Type = erl_types:t_from_form(Form, TempExpTypes, Site, - TempRecords), - {F, Type}; - _Other -> Value + {Type, C3} = + erl_types:t_from_form(Form, TempExpTypes, Site, + TempRecords, VarTable, C2), + {{Key, {F, Type}}, C3}; + _Other -> {{Key, Value}, C2} end end, - dict:map(RecordFun, Record) + {RecordList, C1} = + lists:mapfoldl(RecordFun, C0, dict:to_list(Record)), + {{Module, dict:from_list(RecordList)}, C1} + %% dict:map(RecordFun, Record) end, - dict:map(ModuleFun, TempRecords). + {TempRecordList, NewCache} = + lists:mapfoldl(ModuleFun, Cache, dict:to_list(TempRecords)), + {dict:from_list(TempRecordList), NewCache}. + %% dict:map(ModuleFun, TempRecords). -check_record_fields(Records, TempExpTypes) -> +check_record_fields(Records, TempExpTypes, Cache) -> + VarTable = erl_types:var_table__new(), CheckFun = - fun({Module, Element}) -> - CheckForm = fun(Form, Site) -> - erl_types:t_check_record_fields(Form, TempExpTypes, - Site, Records) + fun({Module, Element}, C0) -> + CheckForm = fun(Form, Site, C1) -> + erl_types:t_check_record_fields(Form, TempExpTypes, + Site, Records, + VarTable, C1) end, ElemFun = - fun({Key, Value}) -> + fun({Key, Value}, C2) -> case Key of {record, Name} -> FieldFun = - fun({Arity, Fields}) -> + fun({Arity, Fields}, C3) -> Site = {record, {Module, Name, Arity}}, - _ = [ok = CheckForm(Field, Site) || - {_, Field, _} <- Fields], - ok + lists:foldl(fun({_, Field, _}, C4) -> + CheckForm(Field, Site, C4) + end, C3, Fields) end, {FileLine, Fields} = Value, - Fun = fun() -> lists:foreach(FieldFun, Fields) end, + Fun = fun() -> lists:foldl(FieldFun, C2, Fields) end, msg_with_position(Fun, FileLine); {_OpaqueOrType, Name, NArgs} -> Site = {type, {Module, Name, NArgs}}, {{_Module, FileLine, Form, _ArgNames}, _Type} = Value, - Fun = fun() -> ok = CheckForm(Form, Site) end, + Fun = fun() -> CheckForm(Form, Site, C2) end, msg_with_position(Fun, FileLine) end end, - lists:foreach(ElemFun, dict:to_list(Element)) + lists:foldl(ElemFun, C0, dict:to_list(Element)) end, - lists:foreach(CheckFun, dict:to_list(Records)). + lists:foldl(CheckFun, Cache, dict:to_list(Records)). msg_with_position(Fun, FileLine) -> try Fun() @@ -398,7 +424,7 @@ msg_with_position(Fun, FileLine) -> throw({error, NewMsg}) end. --spec merge_records(type_table(), type_table()) -> type_table(). +-spec merge_records(mod_records(), mod_records()) -> mod_records(). merge_records(NewRecords, OldRecords) -> dict:merge(fun(_Key, NewVal, _OldVal) -> NewVal end, NewRecords, OldRecords). diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 208f439388..9a94132b4c 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -80,11 +80,9 @@ t_float/0, t_var_names/1, t_form_to_string/1, - t_from_form/4, - t_from_form/5, + t_from_form/6, t_from_form_without_remote/3, - t_check_record_fields/4, - t_check_record_fields/5, + t_check_record_fields/6, t_from_range/2, t_from_range_unsafe/2, t_from_term/1, @@ -221,6 +219,7 @@ is_erl_type/1, atom_to_string/1, var_table__new/0, + cache__new/0, map_pairwise_merge/3 ]). @@ -237,7 +236,7 @@ -export([t_is_identifier/1]). -endif. --export_type([erl_type/0, opaques/0, type_table/0, var_table/0]). +-export_type([erl_type/0, opaques/0, type_table/0, var_table/0, cache/0]). %%-define(DEBUG, true). @@ -375,10 +374,10 @@ -type opaques() :: [erl_type()] | 'universe'. -type record_key() :: {'record', atom()}. --type type_key() :: {'type' | 'opaque', atom(), arity()}. +-type type_key() :: {'type' | 'opaque', mfa()}. -type record_value() :: [{atom(), erl_parse:abstract_expr(), erl_type()}]. -type type_value() :: {{module(), {file:name(), erl_anno:line()}, - erl_parse:abstr_type(), ArgNames :: [atom()]}, + erl_parse:abstract_type(), ArgNames :: [atom()]}, erl_type()}. -type type_table() :: dict:dict(record_key() | type_key(), record_value() | type_value()). @@ -759,8 +758,8 @@ t_opaque_from_records(RecDict) -> {{Module, _FileLine, _Form, ArgNames}, _Type}) -> %% Args = args_to_types(ArgNames), %% List = lists:zip(ArgNames, Args), - %% TmpVarDict = dict:from_list(List), - %% Rep = t_from_form(Type, RecDict, TmpVarDict), + %% TmpVarTab = maps:to_list(List), + %% Rep = t_from_form(Type, RecDict, TmpVarTab), Rep = t_any(), % not used for anything right now Args = [t_any() || _ <- ArgNames], t_opaque(Module, Name, Args, Rep) @@ -1771,7 +1770,8 @@ mapdict_insert(E={_,_,_}, T) -> [E|T]. t_map_mandatoriness(), erl_type()) -> t_map_pair() | false), erl_type(), erl_type()) -> t_map_dict(). -map_pairwise_merge(F, ?map(APairs, ADefK, ADefV), ?map(BPairs, BDefK, BDefV)) -> +map_pairwise_merge(F, ?map(APairs, ADefK, ADefV), + ?map(BPairs, BDefK, BDefV)) -> map_pairwise_merge(F, APairs, ADefK, ADefV, BPairs, BDefK, BDefV). map_pairwise_merge(_, [], _, _, [], _, _) -> []; @@ -4416,32 +4416,30 @@ mod_name(Mod, Name) -> -type type_names() :: [type_key() | record_key()]. --type mta() :: {module(), atom(), arity()}. --type mra() :: {module(), atom(), arity()}. --type site() :: {'type', mta()} | {'spec', mfa()} | {'record', mra()}. --type cache() :: #{{module(), parse_form()} => erl_type()}. +-type mta() :: {module(), atom(), arity()}. +-type mra() :: {module(), atom(), arity()}. +-type site() :: {'type', mta()} | {'spec', mfa()} | {'record', mra()}. +-type cache_key() :: {module(), atom(), expand_depth(), + [erl_type()], type_names()}. +-opaque cache() :: #{cache_key() => {erl_type(), expand_limit()}}. --spec t_from_form(parse_form(), sets:set(mfa()), - site(), mod_records()) -> erl_type(). +-spec t_from_form(parse_form(), sets:set(mfa()), site(), mod_records(), + var_table(), cache()) -> {erl_type(), cache()}. -t_from_form(Form, ExpTypes, Site, RecDict) -> - t_from_form(Form, ExpTypes, Site, RecDict, var_table__new()). - --spec t_from_form(parse_form(), sets:set(mfa()), - site(), mod_records(), var_table()) -> erl_type(). - -t_from_form(Form, ExpTypes, Site, RecDict, VarDict) -> - t_from_form1(Form, ExpTypes, Site, RecDict, VarDict). +t_from_form(Form, ExpTypes, Site, RecDict, VarTab, Cache) -> + t_from_form1(Form, ExpTypes, Site, RecDict, VarTab, Cache). %% Replace external types with with none(). -spec t_from_form_without_remote(parse_form(), site(), type_table()) -> - erl_type(). + {erl_type(), cache()}. t_from_form_without_remote(Form, Site, TypeTable) -> Module = site_module(Site), RecDict = dict:from_list([{Module, TypeTable}]), ExpTypes = replace_by_none, - t_from_form1(Form, ExpTypes, Site, RecDict, maps:new()). + VarTab = var_table__new(), + Cache = cache__new(), + t_from_form1(Form, ExpTypes, Site, RecDict, VarTab, Cache). %% REC_TYPE_LIMIT is used for limiting the depth of recursive types. %% EXPAND_LIMIT is used for limiting the size of types by @@ -4454,52 +4452,48 @@ t_from_form_without_remote(Form, Site, TypeTable) -> -type expand_depth() :: integer(). +-record(from_form, {site :: site(), + xtypes :: sets:set(mfa()) | 'replace_by_none', + mrecs :: mod_records(), + vtab :: var_table(), + tnames :: type_names()}). + -spec t_from_form1(parse_form(), sets:set(mfa()) | 'replace_by_none', - site(), mod_records(), var_table()) -> - erl_type(). + site(), mod_records(), var_table(), cache()) -> + {erl_type(), cache()}. -t_from_form1(Form, ET, Site, MR, V) -> +t_from_form1(Form, ET, Site, MR, V, C) -> TypeNames = initial_typenames(Site), - D0 = ?EXPAND_DEPTH, - {T1, L1} = t_from_form2(Form, TypeNames, ET, Site, MR, V, D0), + State = #from_form{site = Site, + xtypes = ET, + mrecs = MR, + vtab = V, + tnames = TypeNames}, + L = ?EXPAND_LIMIT, + {T1, L1, C1} = from_form(Form, State, ?EXPAND_DEPTH, L, C), if L1 =< 0 -> - t_from_form_loop(Form, TypeNames, ET, Site, MR, V, 1, ?EXPAND_LIMIT); - true -> T1 + from_form_loop(Form, State, 1, L, C1); + true -> + {T1, C1} end. initial_typenames({type, _MTA}=Site) -> [Site]; initial_typenames({spec, _MFA}) -> []; initial_typenames({record, _MRA}) -> []. -t_from_form_loop(Form, TypeNames, ET, Site, MR, V, D, L0) -> - {T1, L1} = t_from_form2(Form, TypeNames, ET, Site, MR, V, D), - Delta = L0 - L1, +from_form_loop(Form, State, D, Limit, C) -> + {T1, L1, C1} = from_form(Form, State, D, Limit, C), + Delta = Limit - L1, if %% Save some time by assuming next depth will exceed the limit. - Delta * 8 > L0 -> T1; + Delta * 8 > Limit -> + {T1, C1}; true -> D1 = D + 1, - t_from_form_loop(Form, TypeNames, ET, Site, MR, V, D1, L1) + from_form_loop(Form, State, D1, Limit, C1) end. --record(from_form, {site :: site(), - xtypes :: sets:set(mfa()) | 'replace_by_none', - mrecs :: mod_records(), - vtab :: var_table(), - tnames :: type_names()}). - -t_from_form2(Form, TypeNames, ET, Site, MR, V, D) -> - L = ?EXPAND_LIMIT, - State = #from_form{site = Site, - xtypes = ET, - mrecs = MR, - vtab = V, - tnames = TypeNames}, - C = #{}, - {T, L1, _C1} = from_form(Form, State, D, L, C), - {T, L1}. - -spec from_form(parse_form(), #from_form{}, expand_depth(), @@ -4578,8 +4572,8 @@ from_form({type, _L, function, []}, _S, _D, L, C) -> from_form({type, _L, 'fun', []}, _S, _D, L, C) -> {t_fun(), L, C}; from_form({type, _L, 'fun', [{type, _, any}, Range]}, S, D, L, C) -> - {T, L1} = from_form(Range, S, D - 1, L - 1, C), - {t_fun(T), L1, C}; + {T, L1, C1} = from_form(Range, S, D - 1, L - 1, C), + {t_fun(T), L1, C1}; from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]}, S, D, L, C) -> {Dom1, L1, C1} = list_from_form(Domain, S, D, L, C), @@ -4720,48 +4714,54 @@ builtin_type(Name, Type, S, D, L, C) -> end. type_from_form(Name, Args, S, D, L, C) -> - #from_form{site = Site0, mrecs = MR, tnames = TypeNames} = S, + #from_form{site = Site, mrecs = MR, tnames = TypeNames} = S, ArgsLen = length(Args), - Module = site_module(Site0), - {ok, R} = dict:find(Module, MR), + Module = site_module(Site), TypeName = {type, {Module, Name, ArgsLen}}, + case can_unfold_more(TypeName, TypeNames) of + true -> + {ok, R} = dict:find(Module, MR), + type_from_form1(Name, Args, ArgsLen, R, TypeName, TypeNames, + S, D, L, C); + false -> + {t_any(), L, C} + end. + +type_from_form1(Name, Args, ArgsLen, R, TypeName, TypeNames, S, D, L, C) -> case lookup_type(Name, ArgsLen, R) of - {type, {{Module, _FileName, Form, ArgNames}, _Type}} -> - case can_unfold_more(TypeName, TypeNames) of - true -> - NewTypeNames = [TypeName|TypeNames], - {ArgTypes, L1, C1} = list_from_form(Args, S, D, L, C), - List = lists:zip(ArgNames, ArgTypes), - TmpV = maps:from_list(List), - S1 = S#from_form{site = TypeName, - tnames = NewTypeNames, - vtab = TmpV}, - from_form(Form, S1, D, L1, C1); - false -> - {t_any(), L, C} - end; - {opaque, {{Module, _FileName, Form, ArgNames}, Type}} -> - case can_unfold_more(TypeName, TypeNames) of - true -> - NewTypeNames = [TypeName|TypeNames], - S1 = S#from_form{tnames = NewTypeNames}, - {ArgTypes, L1, C1} = list_from_form(Args, S1, D, L, C), + {Tag, {{Module, _FileName, Form, ArgNames}, Type}} -> + NewTypeNames = [TypeName|TypeNames], + S1 = S#from_form{tnames = NewTypeNames}, + {ArgTypes, L1, C1} = list_from_form(Args, S1, D, L, C), + CKey = cache_key(Module, Name, ArgTypes, TypeNames, D), + case cache_find(CKey, C) of + {CachedType, DeltaL} -> + {CachedType, L1 - DeltaL, C}; + error -> List = lists:zip(ArgNames, ArgTypes), TmpV = maps:from_list(List), S2 = S1#from_form{site = TypeName, vtab = TmpV}, - {Rep, L2, C2} = from_form(Form, S2, D, L1, C1), - Rep1 = choose_opaque_type(Rep, Type), - Rep2 = case cannot_have_opaque(Rep1, TypeName, TypeNames) of - true -> Rep1; - false -> - ArgTypes2 = subst_all_vars_to_any_list(ArgTypes), - t_opaque(Module, Name, ArgTypes2, Rep1) - end, - {Rep2, L2, C2}; - false -> {t_any(), L, C} + {NewType, L3, C3} = + case Tag of + type -> + from_form(Form, S2, D, L1, C1); + opaque -> + {Rep, L2, C2} = from_form(Form, S2, D, L1, C1), + Rep1 = choose_opaque_type(Rep, Type), + Rep2 = case cannot_have_opaque(Rep1, TypeName, TypeNames) of + true -> Rep1; + false -> + ArgTypes2 = subst_all_vars_to_any_list(ArgTypes), + t_opaque(Module, Name, ArgTypes2, Rep1) + end, + {Rep2, L2, C2} + end, + C4 = cache_put(CKey, NewType, L1 - L3, C3), + {NewType, L3, C4} end; error -> - Msg = io_lib:format("Unable to find type ~w/~w\n", [Name, ArgsLen]), + Msg = io_lib:format("Unable to find type ~w/~w\n", + [Name, ArgsLen]), throw({error, Msg}) end. @@ -4778,51 +4778,15 @@ remote_from_form(RemMod, Name, Args, S, D, L, C) -> self() ! {self(), ext_types, MFA}, {t_any(), L, C}; {ok, RemDict} -> - RemType = {type, MFA}, case sets:is_element(MFA, ET) of true -> - case lookup_type(Name, ArgsLen, RemDict) of - {type, {{_Mod, _FileLine, Form, ArgNames}, _Type}} -> - case can_unfold_more(RemType, TypeNames) of - true -> - NewTypeNames = [RemType|TypeNames], - S1 = S#from_form{tnames = NewTypeNames}, - {ArgTypes, L1, C1} = list_from_form(Args, S1, D, L, C), - List = lists:zip(ArgNames, ArgTypes), - TmpVarTab = maps:from_list(List), - S2 = S1#from_form{site = RemType, vtab = TmpVarTab}, - from_form(Form, S2, D, L1, C1); - false -> - {t_any(), L, C} - end; - {opaque, {{Mod, _FileLine, Form, ArgNames}, Type}} -> - case can_unfold_more(RemType, TypeNames) of - true -> - NewTypeNames = [RemType|TypeNames], - S1 = S#from_form{tnames = NewTypeNames}, - {ArgTypes, L1, C1} = list_from_form(Args, S1, D, L, C), - List = lists:zip(ArgNames, ArgTypes), - TmpVarTab = maps:from_list(List), - S2 = S1#from_form{site = RemType, vtab = TmpVarTab}, - {NewRep, L2, C2} = from_form(Form, S2, D, L1, C1), - NewRep1 = choose_opaque_type(NewRep, Type), - NewRep2 = - case - cannot_have_opaque(NewRep1, RemType, TypeNames) - of - true -> NewRep1; - false -> - ArgTypes2 = subst_all_vars_to_any_list(ArgTypes), - t_opaque(Mod, Name, ArgTypes2, NewRep1) - end, - {NewRep2, L2, C2}; - false -> - {t_any(), L, C} - end; - error -> - Msg = io_lib:format("Unable to find remote type ~w:~w()\n", - [RemMod, Name]), - throw({error, Msg}) + RemType = {type, MFA}, + case can_unfold_more(RemType, TypeNames) of + true -> + remote_from_form1(RemMod, Name, Args, ArgsLen, RemDict, + RemType, TypeNames, S, D, L, C); + false -> + {t_any(), L, C} end; false -> self() ! {self(), ext_types, {RemMod, Name, ArgsLen}}, @@ -4831,6 +4795,47 @@ remote_from_form(RemMod, Name, Args, S, D, L, C) -> end end. +remote_from_form1(RemMod, Name, Args, ArgsLen, RemDict, RemType, TypeNames, + S, D, L, C) -> + case lookup_type(Name, ArgsLen, RemDict) of + {Tag, {{Mod, _FileLine, Form, ArgNames}, Type}} -> + NewTypeNames = [RemType|TypeNames], + S1 = S#from_form{tnames = NewTypeNames}, + {ArgTypes, L1, C1} = list_from_form(Args, S1, D, L, C), + CKey = cache_key(RemMod, Name, ArgTypes, TypeNames, D), + %% case error of + case cache_find(CKey, C) of + {CachedType, DeltaL} -> + {CachedType, L - DeltaL, C}; + error -> + List = lists:zip(ArgNames, ArgTypes), + TmpVarTab = maps:from_list(List), + S2 = S1#from_form{site = RemType, vtab = TmpVarTab}, + {NewType, L3, C3} = + case Tag of + type -> + from_form(Form, S2, D, L1, C1); + opaque -> + {NewRep, L2, C2} = from_form(Form, S2, D, L1, C1), + NewRep1 = choose_opaque_type(NewRep, Type), + NewRep2 = + case cannot_have_opaque(NewRep1, RemType, TypeNames) of + true -> NewRep1; + false -> + ArgTypes2 = subst_all_vars_to_any_list(ArgTypes), + t_opaque(Mod, Name, ArgTypes2, NewRep1) + end, + {NewRep2, L2, C2} + end, + C4 = cache_put(CKey, NewType, L1 - L3, C3), + {NewType, L3, C4} + end; + error -> + Msg = io_lib:format("Unable to find remote type ~w:~w()\n", + [RemMod, Name]), + throw({error, Msg}) + end. + subst_all_vars_to_any_list(Types) -> [subst_all_vars_to_any(Type) || Type <- Types]. @@ -4985,79 +4990,118 @@ promote_to_mand(MKs, [E={K,_,V}|T]) -> end|promote_to_mand(MKs, T)]. -spec t_check_record_fields(parse_form(), sets:set(mfa()), site(), - mod_records()) -> ok. + mod_records(), var_table(), cache()) -> cache(). -t_check_record_fields(Form, ExpTypes, Site, RecDict) -> - t_check_record_fields(Form, ExpTypes, Site, RecDict, var_table__new()). +t_check_record_fields(Form, ExpTypes, Site, RecDict, VarTable, Cache) -> + State = #from_form{site = Site, + xtypes = ExpTypes, + mrecs = RecDict, + vtab = VarTable, + tnames = []}, + check_record_fields(Form, State, Cache). --spec t_check_record_fields(parse_form(), sets:set(mfa()), site(), - mod_records(), var_table()) -> ok. +-spec check_record_fields(parse_form(), #from_form{}, cache()) -> cache(). %% If there is something wrong with parse_form() %% throw({error, io_lib:chars()} is called. -t_check_record_fields({var, _L, _}, _ET, _S, _MR, _V) -> ok; -t_check_record_fields({ann_type, _L, [_Var, Type]}, ET, S, MR, V) -> - t_check_record_fields(Type, ET, S, MR, V); -t_check_record_fields({paren_type, _L, [Type]}, ET, S, MR, V) -> - t_check_record_fields(Type, ET, S, MR, V); -t_check_record_fields({remote_type, _L, [{atom, _, _}, {atom, _, _}, Args]}, - ET, S, MR, V) -> - list_check_record_fields(Args, ET, S, MR, V); -t_check_record_fields({atom, _L, _}, _ET, _S, _MR, _V) -> ok; -t_check_record_fields({integer, _L, _}, _ET, _S, _MR, _V) -> ok; -t_check_record_fields({op, _L, _Op, _Arg}, _ET, _S, _MR, _V) -> ok; -t_check_record_fields({op, _L, _Op, _Arg1, _Arg2}, _ET, _S, _MR, _V) -> ok; -t_check_record_fields({type, _L, tuple, any}, _ET, _S, _MR, _V) -> ok; -t_check_record_fields({type, _L, map, any}, _ET, _S, _MR, _V) -> ok; -t_check_record_fields({type, _L, binary, [_Base, _Unit]}, _ET, _S, _MR, _V) -> - ok; -t_check_record_fields({type, _L, 'fun', [{type, _, any}, Range]}, - ET, S, MR, V) -> - t_check_record_fields(Range, ET, S, MR, V); -t_check_record_fields({type, _L, range, [_From, _To]}, _ET, _S, _MR, _V) -> - ok; -t_check_record_fields({type, _L, record, [Name|Fields]}, ET, S, MR, V) -> - check_record(Name, Fields, ET, S, MR, V); -t_check_record_fields({type, _L, _, Args}, ET, S, MR, V) -> - list_check_record_fields(Args, ET, S, MR, V); -t_check_record_fields({user_type, _L, _Name, Args}, ET, S, MR, V) -> - list_check_record_fields(Args, ET, S, MR, V). - -check_record({atom, _, Name}, ModFields, ET, Site, MR, V) -> +check_record_fields({var, _L, _}, _S, C) -> C; +check_record_fields({ann_type, _L, [_Var, Type]}, S, C) -> + check_record_fields(Type, S, C); +check_record_fields({paren_type, _L, [Type]}, S, C) -> + check_record_fields(Type, S, C); +check_record_fields({remote_type, _L, [{atom, _, _}, {atom, _, _}, Args]}, + S, C) -> + list_check_record_fields(Args, S, C); +check_record_fields({atom, _L, _}, _S, C) -> C; +check_record_fields({integer, _L, _}, _S, C) -> C; +check_record_fields({op, _L, _Op, _Arg}, _S, C) -> C; +check_record_fields({op, _L, _Op, _Arg1, _Arg2}, _S, C) -> C; +check_record_fields({type, _L, tuple, any}, _S, C) -> C; +check_record_fields({type, _L, map, any}, _S, C) -> C; +check_record_fields({type, _L, binary, [_Base, _Unit]}, _S, C) -> C; +check_record_fields({type, _L, 'fun', [{type, _, any}, Range]}, S, C) -> + check_record_fields(Range, S, C); +check_record_fields({type, _L, range, [_From, _To]}, _S, C) -> C; +check_record_fields({type, _L, record, [Name|Fields]}, S, C) -> + check_record(Name, Fields, S, C); +check_record_fields({type, _L, _, Args}, S, C) -> + list_check_record_fields(Args, S, C); +check_record_fields({user_type, _L, _Name, Args}, S, C) -> + list_check_record_fields(Args, S, C). + +check_record({atom, _, Name}, ModFields, S, C) -> + #from_form{site = Site, mrecs = MR} = S, M = site_module(Site), {ok, R} = dict:find(M, MR), {ok, DeclFields} = lookup_record(Name, R), - case check_fields(Name, ModFields, DeclFields, ET, Site, MR, V) of + case check_fields(Name, ModFields, DeclFields, S, C) of {error, FieldName} -> throw({error, io_lib:format("Illegal declaration of #~w{~w}\n", [Name, FieldName])}); - ok -> ok + C1 -> C1 end. check_fields(RecName, [{type, _, field_type, [{atom, _, Name}, Abstr]}|Left], - DeclFields, ET, Site0, MR, V) -> + DeclFields, S, C) -> + #from_form{site = Site0, xtypes = ET, mrecs = MR, vtab = V} = S, M = site_module(Site0), Site = {record, {M, RecName, length(DeclFields)}}, - Type = t_from_form(Abstr, ET, Site, MR, V), + {Type, C1} = t_from_form(Abstr, ET, Site, MR, V, C), {Name, _, DeclType} = lists:keyfind(Name, 1, DeclFields), TypeNoVars = subst_all_vars_to_any(Type), case t_is_subtype(TypeNoVars, DeclType) of false -> {error, Name}; - true -> check_fields(RecName, Left, DeclFields, ET, Site0, MR, V) + true -> check_fields(RecName, Left, DeclFields, S, C1) end; -check_fields(_RecName, [], _Decl, _ET, _Site, _MR, _V) -> - ok. +check_fields(_RecName, [], _Decl, _S, C) -> + C. -list_check_record_fields([], _ET, _S, _MR, _V) -> - ok; -list_check_record_fields([H|Tail], ET, S, MR, V) -> - ok = t_check_record_fields(H, ET, S, MR, V), - list_check_record_fields(Tail, ET, S, MR, V). +list_check_record_fields([], _S, C) -> + C; +list_check_record_fields([H|Tail], S, C) -> + C1 = check_record_fields(H, S, C), + list_check_record_fields(Tail, S, C1). site_module({_, {Module, _, _}}) -> Module. +-spec cache__new() -> cache(). + +cache__new() -> + maps:new(). + +-spec cache_key(module(), atom(), [erl_type()], + type_names(), expand_depth()) -> cache_key(). + +%% If TypeNames is left out from the key, the cache is smaller, and +%% the form-to-type translation is faster. But it would be a shame if, +%% for example, any() is used, where a more complex type should be +%% used. There is also a slight risk of creating unnecessarily big +%% types. + +cache_key(Module, Name, ArgTypes, TypeNames, D) -> + {Module, Name, D, ArgTypes, TypeNames}. + +-spec cache_find(cache_key(), cache()) -> + {erl_type(), expand_limit()} | 'error'. + +cache_find(Key, Cache) -> + case maps:find(Key, Cache) of + {ok, Value} -> + Value; + error -> + error + end. + +-spec cache_put(cache_key(), erl_type(), expand_limit(), cache()) -> cache(). + +cache_put(_Key, _Type, DeltaL, Cache) when DeltaL < 0 -> + %% The type is truncated; do not reuse it. + Cache; +cache_put(Key, Type, DeltaL, Cache) -> + maps:put(Key, {Type, DeltaL}, Cache). + -spec t_var_names([erl_type()]) -> [atom()]. t_var_names([{var, _, Name}|L]) when L =/= '_' -> @@ -5157,8 +5201,8 @@ t_form_to_string({type, _L, Name, []} = T) -> D0 = dict:new(), MR = dict:from_list([{M, D0}]), Site = {type, {M,Name,0}}, - V = #{}, - C = #{}, + V = var_table__new(), + C = cache__new(), State = #from_form{site = Site, xtypes = sets:new(), mrecs = MR, |