diff options
| -rw-r--r-- | lib/dialyzer/src/dialyzer_contracts.erl | 80 | ||||
| -rw-r--r-- | lib/dialyzer/src/dialyzer_dataflow.erl | 8 | ||||
| -rw-r--r-- | lib/dialyzer/src/dialyzer_typesig.erl | 4 | ||||
| -rw-r--r-- | lib/dialyzer/src/dialyzer_utils.erl | 128 | ||||
| -rw-r--r-- | lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes | 36 | ||||
| -rw-r--r-- | lib/dialyzer/test/small_SUITE_data/src/big_external_type.erl | 528 | ||||
| -rw-r--r-- | lib/dialyzer/test/small_SUITE_data/src/big_local_type.erl | 525 | ||||
| -rw-r--r-- | lib/dialyzer/test/small_SUITE_data/src/contracts_with_subtypes.erl | 12 | ||||
| -rw-r--r-- | lib/dialyzer/test/small_SUITE_data/src/ditrap.erl | 47 | ||||
| -rw-r--r-- | lib/hipe/cerl/erl_types.erl | 847 |
10 files changed, 1671 insertions, 544 deletions
diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 39a178cb7d..4a1ba9c539 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -394,21 +394,22 @@ insert_constraints([], Dict) -> Dict. store_tmp_contract(MFA, FileLine, {TypeSpec, Xtra}, SpecDict, RecordsDict) -> %% io:format("contract from form: ~p\n", [TypeSpec]), - TmpContract = contract_from_form(TypeSpec, RecordsDict, FileLine), + {Module, _, _} = MFA, + TmpContract = contract_from_form(TypeSpec, Module, RecordsDict, FileLine), %% io:format("contract: ~p\n", [TmpContract]), dict:store(MFA, {FileLine, TmpContract, Xtra}, SpecDict). -contract_from_form(Forms, RecDict, FileLine) -> - {CFuns, Forms1} = contract_from_form(Forms, RecDict, FileLine, [], []), +contract_from_form(Forms, Module, RecDict, FileLine) -> + {CFuns, Forms1} = contract_from_form(Forms, Module, RecDict, FileLine, [], []), #tmp_contract{contract_funs = CFuns, forms = Forms1}. -contract_from_form([{type, _, 'fun', [_, _]} = Form | Left], RecDict, +contract_from_form([{type, _, 'fun', [_, _]} = Form | Left], Module, RecDict, FileLine, TypeAcc, FormAcc) -> TypeFun = fun(ExpTypes, AllRecords) -> - Type = + NewType = try - erl_types:t_from_form(Form, RecDict) + erl_types:t_from_form(Form, ExpTypes, Module, AllRecords) catch throw:{error, Msg} -> {File, Line} = FileLine, @@ -416,61 +417,60 @@ contract_from_form([{type, _, 'fun', [_, _]} = Form | Left], RecDict, Line, Msg]), throw({error, NewMsg}) end, - NewType = erl_types:t_solve_remote(Type, ExpTypes, AllRecords), NewTypeNoVars = erl_types:subst_all_vars_to_any(NewType), {NewTypeNoVars, []} end, NewTypeAcc = [TypeFun | TypeAcc], NewFormAcc = [{Form, []} | FormAcc], - contract_from_form(Left, RecDict, FileLine, NewTypeAcc, NewFormAcc); + contract_from_form(Left, Module, RecDict, FileLine, NewTypeAcc, NewFormAcc); contract_from_form([{type, _L1, bounded_fun, [{type, _L2, 'fun', [_, _]} = Form, Constr]}| Left], - RecDict, FileLine, TypeAcc, FormAcc) -> + Module, RecDict, FileLine, TypeAcc, FormAcc) -> TypeFun = fun(ExpTypes, AllRecords) -> {Constr1, VarDict} = - process_constraints(Constr, RecDict, ExpTypes, AllRecords), - Type = erl_types:t_from_form(Form, RecDict, VarDict), - NewType = erl_types:t_solve_remote(Type, ExpTypes, AllRecords), + process_constraints(Constr, Module, RecDict, ExpTypes, AllRecords), + NewType = erl_types:t_from_form(Form, ExpTypes, Module, AllRecords, + VarDict), NewTypeNoVars = erl_types:subst_all_vars_to_any(NewType), {NewTypeNoVars, Constr1} end, NewTypeAcc = [TypeFun | TypeAcc], NewFormAcc = [{Form, Constr} | FormAcc], - contract_from_form(Left, RecDict, FileLine, NewTypeAcc, NewFormAcc); -contract_from_form([], _RecDict, _FileLine, TypeAcc, FormAcc) -> + contract_from_form(Left, Module, RecDict, FileLine, NewTypeAcc, NewFormAcc); +contract_from_form([], _Module, _RecDict, _FileLine, TypeAcc, FormAcc) -> {lists:reverse(TypeAcc), lists:reverse(FormAcc)}. -process_constraints(Constrs, RecDict, ExpTypes, AllRecords) -> - Init0 = initialize_constraints(Constrs, RecDict, ExpTypes, AllRecords), +process_constraints(Constrs, Module, RecDict, ExpTypes, AllRecords) -> + Init0 = initialize_constraints(Constrs, Module, RecDict, ExpTypes, AllRecords), Init = remove_cycles(Init0), - constraints_fixpoint(Init, RecDict, ExpTypes, AllRecords). + constraints_fixpoint(Init, Module, RecDict, ExpTypes, AllRecords). -initialize_constraints(Constrs, RecDict, ExpTypes, AllRecords) -> - initialize_constraints(Constrs, RecDict, ExpTypes, AllRecords, []). +initialize_constraints(Constrs, Module, RecDict, ExpTypes, AllRecords) -> + initialize_constraints(Constrs, Module, RecDict, ExpTypes, AllRecords, []). -initialize_constraints([], _RecDict, _ExpTypes, _AllRecords, Acc) -> +initialize_constraints([], _Module, _RecDict, _ExpTypes, _AllRecords, Acc) -> Acc; -initialize_constraints([Constr|Rest], RecDict, ExpTypes, AllRecords, Acc) -> +initialize_constraints([Constr|Rest], Module, RecDict, ExpTypes, AllRecords, Acc) -> case Constr of {type, _, constraint, [{atom, _, is_subtype}, [Type1, Type2]]} -> - T1 = final_form(Type1, RecDict, ExpTypes, AllRecords, dict:new()), + T1 = final_form(Type1, Module, ExpTypes, AllRecords, dict:new()), Entry = {T1, Type2}, - initialize_constraints(Rest, RecDict, ExpTypes, AllRecords, [Entry|Acc]); + initialize_constraints(Rest, Module, RecDict, ExpTypes, AllRecords, [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, RecDict, ExpTypes, AllRecords) -> +constraints_fixpoint(Constrs, Module, RecDict, ExpTypes, AllRecords) -> VarDict = - constraints_to_dict(Constrs, RecDict, ExpTypes, AllRecords, dict:new()), - constraints_fixpoint(VarDict, Constrs, RecDict, ExpTypes, AllRecords). + constraints_to_dict(Constrs, Module, RecDict, ExpTypes, AllRecords, dict:new()), + constraints_fixpoint(VarDict, Module, Constrs, RecDict, ExpTypes, AllRecords). -constraints_fixpoint(OldVarDict, Constrs, RecDict, ExpTypes, AllRecords) -> +constraints_fixpoint(OldVarDict, Module, Constrs, RecDict, ExpTypes, AllRecords) -> NewVarDict = - constraints_to_dict(Constrs, RecDict, ExpTypes, AllRecords, OldVarDict), + constraints_to_dict(Constrs, Module, RecDict, ExpTypes, AllRecords, OldVarDict), case NewVarDict of OldVarDict -> DictFold = @@ -480,25 +480,24 @@ constraints_fixpoint(OldVarDict, Constrs, RecDict, ExpTypes, AllRecords) -> FinalConstrs = dict:fold(DictFold, [], NewVarDict), {FinalConstrs, NewVarDict}; _Other -> - constraints_fixpoint(NewVarDict, Constrs, RecDict, ExpTypes, AllRecords) + constraints_fixpoint(NewVarDict, Module, Constrs, RecDict, ExpTypes, AllRecords) end. -final_form(Form, RecDict, ExpTypes, AllRecords, VarDict) -> - T1 = erl_types:t_from_form(Form, RecDict, VarDict), - erl_types:t_solve_remote(T1, ExpTypes, AllRecords). +final_form(Form, Module, ExpTypes, AllRecords, VarDict) -> + erl_types:t_from_form(Form, ExpTypes, Module, AllRecords, VarDict). -constraints_to_dict(Constrs, RecDict, ExpTypes, AllRecords, VarDict) -> +constraints_to_dict(Constrs, Module, RecDict, ExpTypes, AllRecords, VarDict) -> Subtypes = - constraints_to_subs(Constrs, RecDict, ExpTypes, AllRecords, VarDict, []), + constraints_to_subs(Constrs, Module, RecDict, ExpTypes, AllRecords, VarDict, []), insert_constraints(Subtypes, dict:new()). -constraints_to_subs([], _RecDict, _ExpTypes, _AllRecords, _VarDict, Acc) -> +constraints_to_subs([], _Module, _RecDict, _ExpTypes, _AllRecords, _VarDict, Acc) -> Acc; -constraints_to_subs([C|Rest], RecDict, ExpTypes, AllRecords, VarDict, Acc) -> +constraints_to_subs([C|Rest], Module, RecDict, ExpTypes, AllRecords, VarDict, Acc) -> {T1, Form2} = C, - T2 = final_form(Form2, RecDict, ExpTypes, AllRecords, VarDict), + T2 = final_form(Form2, Module, ExpTypes, AllRecords, VarDict), NewAcc = [{subtype, T1, T2}|Acc], - constraints_to_subs(Rest, RecDict, ExpTypes, AllRecords, VarDict, NewAcc). + constraints_to_subs(Rest, Module, RecDict, ExpTypes, AllRecords, VarDict, NewAcc). %% Replaces variables with '_' when necessary to break up cycles among %% the constraints. @@ -754,8 +753,7 @@ is_remote_types_related(Contract, CSig, Sig, RecDict) -> end. t_from_forms_without_remote([{FType, []}], RecDict) -> - Type0 = erl_types:t_from_form(FType, RecDict), - Type1 = erl_types:subst_all_remote(Type0, erl_types:t_none()), + Type1 = erl_types:t_from_form_without_remote(FType, RecDict), {ok, erl_types:subst_all_vars_to_any(Type1)}; t_from_forms_without_remote([{_FType, _Constrs}], _RecDict) -> %% 'When' constraints diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index ea1b09fcdd..336b4641d4 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -2,7 +2,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2014. All Rights Reserved. +%% Copyright Ericsson AB 2006-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -2977,8 +2977,10 @@ state__lookup_name(Fun, #state{callgraph = Callgraph}) -> state__lookup_record(Tag, Arity, #state{records = Records}) -> case erl_types:lookup_record(Tag, Arity, Records) of {ok, Fields} -> - {ok, t_tuple([t_atom(Tag)| - [FieldType || {_FieldName, FieldType} <- Fields]])}; + RecType = + t_tuple([t_atom(Tag)| + [FieldType || {_FieldName, _Abstr, FieldType} <- Fields]]), + {ok, RecType}; error -> error end. diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 217d238712..1737bfd3a9 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2014. All Rights Reserved. +%% Copyright Ericsson AB 2006-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -3264,7 +3264,7 @@ lookup_record(Records, Tag, Arity) -> {ok, Fields} -> RecType = t_tuple([t_from_term(Tag)| - [FieldType || {_FieldName, FieldType} <- Fields]]), + [FieldType || {_FieldName, _Abstr, FieldType} <- Fields]]), {ok, RecType}; error -> error diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 01ade00664..1cc9528fed 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2014. All Rights Reserved. +%% Copyright Ericsson AB 2006-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -63,13 +63,13 @@ print_types(RecDict) -> print_types1([], _) -> ok; -print_types1([{type, _Name} = Key|T], RecDict) -> - {ok, {_Mod, Form, _Args}} = dict:find(Key, RecDict), - io:format("\n~w: ~w\n", [Key, erl_types:t_from_form(Form, RecDict)]), +print_types1([{type, _Name, _NArgs} = Key|T], RecDict) -> + {ok, {{_Mod, _Form, _Args}, Type}} = dict:find(Key, RecDict), + io:format("\n~w: ~w\n", [Key, Type]), print_types1(T, RecDict); -print_types1([{opaque, _Name} = Key|T], RecDict) -> - {ok, {_Mod, Form, _Args}} = dict:find(Key, RecDict), - io:format("\n~w: ~w\n", [Key, erl_types:t_from_form(Form, RecDict)]), +print_types1([{opaque, _Name, _NArgs} = Key|T], RecDict) -> + {ok, {{_Mod, _Form, _Args}, Type}} = dict:find(Key, RecDict), + io:format("\n~w: ~w\n", [Key, Type]), print_types1(T, RecDict); print_types1([{record, _Name} = Key|T], RecDict) -> {ok, [{_Arity, _Fields} = AF]} = dict:find(Key, RecDict), @@ -221,28 +221,29 @@ get_record_and_type_info([{attribute, _, type, {{record, Name}, Fields0, []}} get_record_and_type_info([{attribute, _, Attr, {Name, TypeForm}}|Left], Module, Records, RecDict) when Attr =:= 'type'; Attr =:= 'opaque' -> - try - NewRecDict = add_new_type(Attr, Name, TypeForm, [], Module, RecDict), - get_record_and_type_info(Left, Module, Records, NewRecDict) + try add_new_type(Attr, Name, TypeForm, [], Module, RecDict) of + NewRecDict -> + get_record_and_type_info(Left, Module, Records, NewRecDict) catch throw:{error, _} = Error -> Error end; get_record_and_type_info([{attribute, _, Attr, {Name, TypeForm, Args}}|Left], Module, Records, RecDict) when Attr =:= 'type'; Attr =:= 'opaque' -> - try - NewRecDict = add_new_type(Attr, Name, TypeForm, Args, Module, RecDict), - get_record_and_type_info(Left, Module, Records, NewRecDict) + try add_new_type(Attr, Name, TypeForm, Args, Module, RecDict) of + NewRecDict -> + get_record_and_type_info(Left, Module, Records, NewRecDict) catch throw:{error, _} = Error -> Error end; get_record_and_type_info([_Other|Left], Module, Records, RecDict) -> get_record_and_type_info(Left, Module, Records, RecDict); get_record_and_type_info([], _Module, Records, RecDict) -> - case type_record_fields(lists:reverse(Records), RecDict) of - {ok, _NewRecDict} = Ok -> - ?debug(_NewRecDict), - Ok; + case + check_type_of_record_fields(lists:reverse(Records), RecDict) + of + ok -> + {ok, RecDict}; {error, Name, Error} -> {error, flat_format(" Error while parsing #~w{}: ~s\n", [Name, Error])} end. @@ -254,20 +255,21 @@ add_new_type(TypeOrOpaque, Name, TypeForm, ArgForms, Module, RecDict) -> Msg = flat_format("Type ~s/~w already defined\n", [Name, Arity]), throw({error, Msg}); false -> - ArgTypes = [erl_types:t_from_form(X) || X <- ArgForms], - case lists:all(fun erl_types:t_is_var/1, ArgTypes) of - true -> - ArgNames = [erl_types:t_var_name(X) || X <- ArgTypes], + try erl_types:t_var_names(ArgForms) of + ArgNames -> dict:store({TypeOrOpaque, Name, Arity}, - {Module, TypeForm, ArgNames}, RecDict); - false -> + {{Module, TypeForm, ArgNames}, + erl_types:t_any()}, RecDict) + catch + _:_ -> throw({error, flat_format("Type declaration for ~w does not " "have variables as parameters", [Name])}) end end. get_record_fields(Fields, RecDict) -> - get_record_fields(Fields, RecDict, []). + Fs = get_record_fields(Fields, RecDict, []), + {ok, [{Name, Form, erl_types:t_any()} || {Name, Form} <- Fs]}. get_record_fields([{typed_record_field, OrdRecField, TypeForm}|Left], RecDict, Acc) -> @@ -276,7 +278,7 @@ get_record_fields([{typed_record_field, OrdRecField, TypeForm}|Left], {record_field, _Line, Name0} -> erl_parse:normalise(Name0); {record_field, _Line, Name0, _Init} -> erl_parse:normalise(Name0) end, - get_record_fields(Left, RecDict, [{Name, TypeForm}|Acc]); + get_record_fields(Left, RecDict, [{Name, TypeForm}|Acc]); get_record_fields([{record_field, _Line, Name}|Left], RecDict, Acc) -> NewAcc = [{erl_parse:normalise(Name), {var, -1, '_'}}|Acc], get_record_fields(Left, RecDict, NewAcc); @@ -284,22 +286,20 @@ get_record_fields([{record_field, _Line, Name, _Init}|Left], RecDict, Acc) -> NewAcc = [{erl_parse:normalise(Name), {var, -1, '_'}}|Acc], get_record_fields(Left, RecDict, NewAcc); get_record_fields([], _RecDict, Acc) -> - {ok, lists:reverse(Acc)}. + lists:reverse(Acc). -type_record_fields([], RecDict) -> - {ok, RecDict}; -type_record_fields([RecKey|Recs], RecDict) -> - {ok, [{Arity, Fields}]} = dict:find(RecKey, RecDict), +%% Just check the local types. process_record_remote_types will add +%% the types later. +check_type_of_record_fields([], _RecDict) -> + ok; +check_type_of_record_fields([RecKey|Recs], RecDict) -> + {ok, [{_Arity, Fields}]} = dict:find(RecKey, RecDict), try - TypedFields = - [{FieldName, erl_types:t_from_form(FieldTypeForm, RecDict)} - || {FieldName, FieldTypeForm} <- Fields], - RecDict1 = dict:store(RecKey, [{Arity, TypedFields}], RecDict), - Fun = fun(OldOrdDict) -> - orddict:store(Arity, TypedFields, OldOrdDict) - end, - RecDict2 = dict:update(RecKey, Fun, RecDict1), - type_record_fields(Recs, RecDict2) + [erl_types:t_from_form_without_remote(FieldTypeForm, RecDict) + || {_FieldName, FieldTypeForm, _} <- Fields] + of + L when is_list(L) -> + check_type_of_record_fields(Recs, RecDict) catch throw:{error, Error} -> {record, Name} = RecKey, @@ -308,30 +308,44 @@ type_record_fields([RecKey|Recs], RecDict) -> -spec process_record_remote_types(codeserver()) -> codeserver(). +%% The field types are cached. Used during analysis when handling records. process_record_remote_types(CServer) -> TempRecords = dialyzer_codeserver:get_temp_records(CServer), TempExpTypes = dialyzer_codeserver:get_temp_exported_types(CServer), - RecordFun = - fun(Key, Value) -> - case Key of - {record, _Name} -> - FieldFun = - fun(_Arity, Fields) -> - [{Name, erl_types:t_solve_remote(Field, TempExpTypes, - TempRecords)} - || {Name, Field} <- Fields] - end, - orddict:map(FieldFun, Value); - _Other -> Value - end - end, ModuleFun = - fun(_Module, Record) -> + fun(Module, Record) -> + RecordFun = + fun(Key, Value) -> + case Key of + {record, _Name} -> + FieldFun = + fun(_Arity, Fields) -> + [{Name, Field, + erl_types:t_from_form(Field, + TempExpTypes, + Module, + TempRecords)} + || {Name, Field, _} <- Fields] + end, + orddict:map(FieldFun, Value); + {opaque, _, _} -> + {{_Module, Form, _ArgNames}=F, _Type} = Value, + Type = erl_types:t_from_form(Form, TempExpTypes, Module, + TempRecords), + {F, Type}; + _Other -> Value + end + end, dict:map(RecordFun, Record) end, - NewRecords = dict:map(ModuleFun, TempRecords), - CServer1 = dialyzer_codeserver:finalize_records(NewRecords, CServer), - dialyzer_codeserver:finalize_exported_types(TempExpTypes, CServer1). + try dict:map(ModuleFun, TempRecords) of + NewRecords -> + CServer1 = dialyzer_codeserver:finalize_records(NewRecords, CServer), + dialyzer_codeserver:finalize_exported_types(TempExpTypes, CServer1) + catch + throw:{error, _RecName, _Error} = Error-> + Error + end. -spec merge_records(dict:dict(), dict:dict()) -> dict:dict(). diff --git a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes index fbdd182358..a9fbfb6068 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes +++ b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes @@ -6,23 +6,27 @@ contracts_with_subtypes.erl:135: The call contracts_with_subtypes:rec2({'a','b'} contracts_with_subtypes.erl:136: The call contracts_with_subtypes:rec2({'b','a'}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) contracts_with_subtypes.erl:137: The call contracts_with_subtypes:rec2({'a',{'b','a'}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) contracts_with_subtypes.erl:138: The call contracts_with_subtypes:rec2({'b',{'a','b'}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) -contracts_with_subtypes.erl:171: The pattern 1 can never match the type string() -contracts_with_subtypes.erl:174: The pattern 'alpha' can never match the type {'ok',_} | {'ok',_,string()} -contracts_with_subtypes.erl:176: The pattern 42 can never match the type {'ok',_} | {'ok',_,string()} -contracts_with_subtypes.erl:192: The pattern 'alpha' can never match the type {'ok',_} -contracts_with_subtypes.erl:194: The pattern 42 can never match the type {'ok',_} -contracts_with_subtypes.erl:212: The pattern 'alpha' can never match the type {'ok',_} -contracts_with_subtypes.erl:214: The pattern 42 can never match the type {'ok',_} -contracts_with_subtypes.erl:231: The pattern 1 can never match the type string() -contracts_with_subtypes.erl:234: The pattern {'ok', _} can never match the type {'ok',_,string()} -contracts_with_subtypes.erl:235: The pattern 'alpha' can never match the type {'ok',_,string()} -contracts_with_subtypes.erl:236: The pattern {'ok', 42} can never match the type {'ok',_,string()} -contracts_with_subtypes.erl:237: The pattern 42 can never match the type {'ok',_,string()} +contracts_with_subtypes.erl:139: The call contracts_with_subtypes:rec2({'a',{'b',{'a','b'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) +contracts_with_subtypes.erl:140: The call contracts_with_subtypes:rec2({'b',{'a',{'b','a'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) +contracts_with_subtypes.erl:141: The call contracts_with_subtypes:rec2({'a',{'b',{'a',{'b','a'}}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) +contracts_with_subtypes.erl:142: The call contracts_with_subtypes:rec2({'b',{'a',{'b',{'a','b'}}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) +contracts_with_subtypes.erl:175: The pattern 1 can never match the type string() +contracts_with_subtypes.erl:178: The pattern 'alpha' can never match the type {'ok',_} | {'ok',_,string()} +contracts_with_subtypes.erl:180: The pattern 42 can never match the type {'ok',_} | {'ok',_,string()} +contracts_with_subtypes.erl:196: The pattern 'alpha' can never match the type {'ok',_} +contracts_with_subtypes.erl:198: The pattern 42 can never match the type {'ok',_} +contracts_with_subtypes.erl:216: The pattern 'alpha' can never match the type {'ok',_} +contracts_with_subtypes.erl:218: The pattern 42 can never match the type {'ok',_} +contracts_with_subtypes.erl:235: The pattern 1 can never match the type string() +contracts_with_subtypes.erl:238: The pattern {'ok', _} can never match the type {'ok',_,string()} +contracts_with_subtypes.erl:239: The pattern 'alpha' can never match the type {'ok',_,string()} contracts_with_subtypes.erl:23: Invalid type specification for function contracts_with_subtypes:extract2/0. The success typing is () -> 'something' -contracts_with_subtypes.erl:263: Function flat_ets_new_t/0 has no local return -contracts_with_subtypes.erl:264: The call contracts_with_subtypes:flat_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when is_subtype(Name,atom()), is_subtype(Options,[Option]), is_subtype(Option,'set' | 'ordered_set' | 'bag' | 'duplicate_bag' | 'public' | 'protected' | 'private' | 'named_table' | {'keypos',integer()} | {'heir',pid(),term()} | {'heir','none'} | {'write_concurrency',boolean()} | {'read_concurrency',boolean()} | 'compressed') -contracts_with_subtypes.erl:290: Function factored_ets_new_t/0 has no local return -contracts_with_subtypes.erl:291: The call contracts_with_subtypes:factored_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when is_subtype(Name,atom()), is_subtype(Options,[Option]), is_subtype(Option,Type | Access | 'named_table' | {'keypos',Pos} | {'heir',Pid::pid(),HeirData} | {'heir','none'} | Tweaks), is_subtype(Type,type()), is_subtype(Access,access()), is_subtype(Tweaks,{'write_concurrency',boolean()} | {'read_concurrency',boolean()} | 'compressed'), is_subtype(Pos,pos_integer()), is_subtype(HeirData,term()) +contracts_with_subtypes.erl:240: The pattern {'ok', 42} can never match the type {'ok',_,string()} +contracts_with_subtypes.erl:241: The pattern 42 can never match the type {'ok',_,string()} +contracts_with_subtypes.erl:267: Function flat_ets_new_t/0 has no local return +contracts_with_subtypes.erl:268: The call contracts_with_subtypes:flat_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when is_subtype(Name,atom()), is_subtype(Options,[Option]), is_subtype(Option,'set' | 'ordered_set' | 'bag' | 'duplicate_bag' | 'public' | 'protected' | 'private' | 'named_table' | {'keypos',integer()} | {'heir',pid(),term()} | {'heir','none'} | {'write_concurrency',boolean()} | {'read_concurrency',boolean()} | 'compressed') +contracts_with_subtypes.erl:294: Function factored_ets_new_t/0 has no local return +contracts_with_subtypes.erl:295: The call contracts_with_subtypes:factored_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when is_subtype(Name,atom()), is_subtype(Options,[Option]), is_subtype(Option,Type | Access | 'named_table' | {'keypos',Pos} | {'heir',Pid::pid(),HeirData} | {'heir','none'} | Tweaks), is_subtype(Type,type()), is_subtype(Access,access()), is_subtype(Tweaks,{'write_concurrency',boolean()} | {'read_concurrency',boolean()} | 'compressed'), is_subtype(Pos,pos_integer()), is_subtype(HeirData,term()) contracts_with_subtypes.erl:77: The call contracts_with_subtypes:foo1(5) breaks the contract (Arg1) -> Res when is_subtype(Arg1,atom()), is_subtype(Res,atom()) contracts_with_subtypes.erl:78: The call contracts_with_subtypes:foo2(5) breaks the contract (Arg1) -> Res when is_subtype(Arg1,Arg2), is_subtype(Arg2,atom()), is_subtype(Res,atom()) contracts_with_subtypes.erl:79: The call contracts_with_subtypes:foo3(5) breaks the contract (Arg1) -> Res when is_subtype(Arg2,atom()), is_subtype(Arg1,Arg2), is_subtype(Res,atom()) diff --git a/lib/dialyzer/test/small_SUITE_data/src/big_external_type.erl b/lib/dialyzer/test/small_SUITE_data/src/big_external_type.erl new file mode 100644 index 0000000000..91a157b17f --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/big_external_type.erl @@ -0,0 +1,528 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%% A stripped version of erl_parse.yrl. +%%% +%%% A type for the abstract format with *external* types has been added. +%%% The type of the abstract format is not up-to-date, but it does not +%%% matter since the purpose of the type is to stress the conversion +%%% of type forms to erl_type(). + +-module(big_external_type). + +-export([parse_form/1,parse_exprs/1,parse_term/1]). +-export([normalise/1,tokens/1,tokens/2]). +-export([inop_prec/1,preop_prec/1,func_prec/0,max_prec/0]). + +-export_type([abstract_clause/0, abstract_expr/0, abstract_form/0, + error_info/0]). + +%% Start of Abstract Format + +-type line() :: erl_scan:line(). + +-export_type([af_record_index/0, af_record_field/1, af_record_name/0, + af_field_name/0, af_function_decl/0]). + +-export_type([af_module/0, af_export/0, af_import/0, af_fa_list/0, + af_compile/0, af_file/0, af_record_decl/0, + af_field_decl/0, af_wild_attribute/0, + af_record_update/1, af_catch/0, af_local_call/0, + af_remote_call/0, af_args/0, af_local_function/0, + af_remote_function/0, af_list_comprehension/0, + af_binary_comprehension/0, af_template/0, + af_qualifier_seq/0, af_qualifier/0, af_generator/0, + af_filter/0, af_block/0, af_if/0, af_case/0, af_try/0, + af_clause_seq/0, af_catch_clause_seq/0, af_receive/0, + af_local_fun/0, af_remote_fun/0, af_fun/0, af_query/0, + af_query_access/0, af_clause/0, + af_catch_clause/0, af_catch_pattern/0, af_catch_class/0, + af_body/0, af_guard_seq/0, af_guard/0, af_guard_test/0, + af_record_access/1, af_guard_call/0, + af_remote_guard_call/0, af_pattern/0, af_literal/0, + af_atom/0, af_lit_atom/1, af_integer/0, af_float/0, + af_string/0, af_match/1, af_variable/0, + af_anon_variable/0, af_tuple/1, af_nil/0, af_cons/1, + af_bin/1, af_binelement/1, af_binelement_size/0, + af_binary_op/1, af_binop/0, af_unary_op/1, af_unop/0]). + +-type abstract_form() :: ?MODULE:af_module() + | ?MODULE:af_export() + | ?MODULE:af_import() + | ?MODULE:af_compile() + | ?MODULE:af_file() + | ?MODULE:af_record_decl() + | ?MODULE:af_wild_attribute() + | ?MODULE:af_function_decl(). + +-type af_module() :: {attribute, line(), module, module()}. + +-type af_export() :: {attribute, line(), export, ?MODULE:af_fa_list()}. + +-type af_import() :: {attribute, line(), import, ?MODULE:af_fa_list()}. + +-type af_fa_list() :: [{function(), arity()}]. + +-type af_compile() :: {attribute, line(), compile, any()}. + +-type af_file() :: {attribute, line(), file, {string(), line()}}. + +-type af_record_decl() :: + {attribute, line(), record, ?MODULE:af_record_name(), [?MODULE:af_field_decl()]}. + +-type af_field_decl() :: {record_field, line(), ?MODULE:af_atom()} + | {record_field, line(), ?MODULE:af_atom(), ?MODULE:abstract_expr()}. + +%% Types and specs, among other things... +-type af_wild_attribute() :: {attribute, line(), ?MODULE:af_atom(), any()}. + +-type af_function_decl() :: + {function, line(), function(), arity(), ?MODULE:af_clause_seq()}. + +-type abstract_expr() :: ?MODULE:af_literal() + | ?MODULE:af_match(?MODULE:abstract_expr()) + | ?MODULE:af_variable() + | ?MODULE:af_tuple(?MODULE:abstract_expr()) + | ?MODULE:af_nil() + | ?MODULE:af_cons(?MODULE:abstract_expr()) + | ?MODULE:af_bin(?MODULE:abstract_expr()) + | ?MODULE:af_binary_op(?MODULE:abstract_expr()) + | ?MODULE:af_unary_op(?MODULE:abstract_expr()) + | ?MODULE:af_record_access(?MODULE:abstract_expr()) + | ?MODULE:af_record_update(?MODULE:abstract_expr()) + | ?MODULE:af_record_index() + | ?MODULE:af_record_field(?MODULE:abstract_expr()) + | ?MODULE:af_catch() + | ?MODULE:af_local_call() + | ?MODULE:af_remote_call() + | ?MODULE:af_list_comprehension() + | ?MODULE:af_binary_comprehension() + | ?MODULE:af_block() + | ?MODULE:af_if() + | ?MODULE:af_case() + | ?MODULE:af_try() + | ?MODULE:af_receive() + | ?MODULE:af_local_fun() + | ?MODULE:af_remote_fun() + | ?MODULE:af_fun() + | ?MODULE:af_query() + | ?MODULE:af_query_access(). + +-type af_record_update(T) :: {record, + line(), + ?MODULE:abstract_expr(), + ?MODULE:af_record_name(), + [?MODULE:af_record_field(T)]}. + +-type af_catch() :: {'catch', line(), ?MODULE:abstract_expr()}. + +-type af_local_call() :: {call, line(), ?MODULE:af_local_function(), ?MODULE:af_args()}. + +-type af_remote_call() :: {call, line(), ?MODULE:af_remote_function(), ?MODULE:af_args()}. + +-type af_args() :: [?MODULE:abstract_expr()]. + +-type af_local_function() :: ?MODULE:abstract_expr(). + +-type af_remote_function() :: + {remote, line(), ?MODULE:abstract_expr(), ?MODULE:abstract_expr()}. + +-type af_list_comprehension() :: + {lc, line(), ?MODULE:af_template(), ?MODULE:af_qualifier_seq()}. + +-type af_binary_comprehension() :: + {bc, line(), ?MODULE:af_template(), ?MODULE:af_qualifier_seq()}. + +-type af_template() :: ?MODULE:abstract_expr(). + +-type af_qualifier_seq() :: [?MODULE:af_qualifier()]. + +-type af_qualifier() :: ?MODULE:af_generator() | ?MODULE:af_filter(). + +-type af_generator() :: {generate, line(), ?MODULE:af_pattern(), ?MODULE:abstract_expr()} + | {b_generate, line(), ?MODULE:af_pattern(), ?MODULE:abstract_expr()}. + +-type af_filter() :: ?MODULE:abstract_expr(). + +-type af_block() :: {block, line(), ?MODULE:af_body()}. + +-type af_if() :: {'if', line(), ?MODULE:af_clause_seq()}. + +-type af_case() :: {'case', line(), ?MODULE:abstract_expr(), ?MODULE:af_clause_seq()}. + +-type af_try() :: {'try', + line(), + ?MODULE:af_body(), + ?MODULE:af_clause_seq(), + ?MODULE:af_catch_clause_seq(), + ?MODULE:af_body()}. + +-type af_clause_seq() :: [?MODULE:af_clause(), ...]. + +-type af_catch_clause_seq() :: [?MODULE:af_clause(), ...]. + +-type af_receive() :: + {'receive', line(), ?MODULE:af_clause_seq()} + | {'receive', line(), ?MODULE:af_clause_seq(), ?MODULE:abstract_expr(), ?MODULE:af_body()}. + +-type af_local_fun() :: {'fun', line(), {function, function(), arity()}}. + +-type af_remote_fun() :: + {'fun', line(), {function, module(), function(), arity()}} + | {'fun', line(), {function, ?MODULE:af_atom(), ?MODULE:af_atom(), ?MODULE:af_integer()}}. + +-type af_fun() :: {'fun', line(), {clauses, ?MODULE:af_clause_seq()}}. + +-type af_query() :: {'query', line(), ?MODULE:af_list_comprehension()}. + +-type af_query_access() :: + {record_field, line(), ?MODULE:abstract_expr(), ?MODULE:af_field_name()}. + +-type abstract_clause() :: ?MODULE:af_clause() | ?MODULE:af_catch_clause(). + +-type af_clause() :: + {clause, line(), [?MODULE:af_pattern()], ?MODULE:af_guard_seq(), ?MODULE:af_body()}. + +-type af_catch_clause() :: + {clause, line(), [?MODULE:af_catch_pattern()], ?MODULE:af_guard_seq(), ?MODULE:af_body()}. + +-type af_catch_pattern() :: + {?MODULE:af_catch_class(), ?MODULE:af_pattern(), ?MODULE:af_anon_variable()}. + +-type af_catch_class() :: + ?MODULE:af_variable() + | ?MODULE:af_lit_atom(throw) | ?MODULE:af_lit_atom(error) | ?MODULE:af_lit_atom(exit). + +-type af_body() :: [?MODULE:abstract_expr(), ...]. + +-type af_guard_seq() :: [?MODULE:af_guard()]. + +-type af_guard() :: [?MODULE:af_guard_test(), ...]. + +-type af_guard_test() :: ?MODULE:af_literal() + | ?MODULE:af_variable() + | ?MODULE:af_tuple(?MODULE:af_guard_test()) + | ?MODULE:af_nil() + | ?MODULE:af_cons(?MODULE:af_guard_test()) + | ?MODULE:af_bin(?MODULE:af_guard_test()) + | ?MODULE:af_binary_op(?MODULE:af_guard_test()) + | ?MODULE:af_unary_op(?MODULE:af_guard_test()) + | ?MODULE:af_record_access(?MODULE:af_guard_test()) + | ?MODULE:af_record_index() + | ?MODULE:af_record_field(?MODULE:af_guard_test()) + | ?MODULE:af_guard_call() + | ?MODULE:af_remote_guard_call(). + +-type af_record_access(T) :: + {record, line(), ?MODULE:af_record_name(), [?MODULE:af_record_field(T)]}. + +-type af_guard_call() :: {call, line(), function(), [?MODULE:af_guard_test()]}. + +-type af_remote_guard_call() :: + {call, line(), atom(), ?MODULE:af_lit_atom(erlang), [?MODULE:af_guard_test()]}. + +-type af_pattern() :: ?MODULE:af_literal() + | ?MODULE:af_match(?MODULE:af_pattern()) + | ?MODULE:af_variable() + | ?MODULE:af_anon_variable() + | ?MODULE:af_tuple(?MODULE:af_pattern()) + | ?MODULE:af_nil() + | ?MODULE:af_cons(?MODULE:af_pattern()) + | ?MODULE:af_bin(?MODULE:af_pattern()) + | ?MODULE:af_binary_op(?MODULE:af_pattern()) + | ?MODULE:af_unary_op(?MODULE:af_pattern()) + | ?MODULE:af_record_index() + | ?MODULE:af_record_field(?MODULE:af_pattern()). + +-type af_literal() :: ?MODULE:af_atom() | ?MODULE:af_integer() | ?MODULE:af_float() | ?MODULE:af_string(). + +-type af_atom() :: ?MODULE:af_lit_atom(atom()). + +-type af_lit_atom(A) :: {atom, line(), A}. + +-type af_integer() :: {integer, line(), non_neg_integer()}. + +-type af_float() :: {float, line(), float()}. + +-type af_string() :: {string, line(), [byte()]}. + +-type af_match(T) :: {match, line(), T, T}. + +-type af_variable() :: {var, line(), atom()}. + +-type af_anon_variable() :: {var, line(), '_'}. + +-type af_tuple(T) :: {tuple, line(), [T]}. + +-type af_nil() :: {nil, line()}. + +-type af_cons(T) :: {cons, line, T, T}. + +-type af_bin(T) :: {bin, line(), [?MODULE:af_binelement(T)]}. + +-type af_binelement(T) :: {bin_element, + line(), + T, + ?MODULE:af_binelement_size(), + type_specifier_list()}. + +-type af_binelement_size() :: default | ?MODULE:abstract_expr(). + +-type af_binary_op(T) :: {op, line(), T, ?MODULE:af_binop(), T}. + +-type af_binop() :: '/' | '*' | 'div' | 'rem' | 'band' | 'and' | '+' | '-' + | 'bor' | 'bxor' | 'bsl' | 'bsr' | 'or' | 'xor' | '++' + | '--' | '==' | '/=' | '=<' | '<' | '>=' | '>' | '=:=' + | '=/='. + +-type af_unary_op(T) :: {op, line(), ?MODULE:af_unop(), T}. + +-type af_unop() :: '+' | '*' | 'bnot' | 'not'. + +%% See also lib/stdlib/{src/erl_bits.erl,include/erl_bits.hrl}. +-type type_specifier_list() :: default | [type_specifier(), ...]. + +-type type_specifier() :: af_type() + | af_signedness() + | af_endianness() + | af_unit(). + +-type af_type() :: integer + | float + | binary + | bytes + | bitstring + | bits + | utf8 + | utf16 + | utf32. + +-type af_signedness() :: signed | unsigned. + +-type af_endianness() :: big | little | native. + +-type af_unit() :: {unit, 1..256}. + +-type af_record_index() :: + {record_index, line(), af_record_name(), af_field_name()}. + +-type af_record_field(T) :: {record_field, line(), af_field_name(), T}. + +-type af_record_name() :: atom(). + +-type af_field_name() :: atom(). + +%% End of Abstract Format + +-type error_description() :: term(). +-type error_info() :: {erl_scan:line(), module(), error_description()}. +-type token() :: {Tag :: atom(), Line :: erl_scan:line()}. + +%% mkop(Op, Arg) -> {op,Line,Op,Arg}. +%% mkop(Left, Op, Right) -> {op,Line,Op,Left,Right}. + +-define(mkop2(L, OpPos, R), + begin + {Op,Pos} = OpPos, + {op,Pos,Op,L,R} + end). + +-define(mkop1(OpPos, A), + begin + {Op,Pos} = OpPos, + {op,Pos,Op,A} + end). + +%% keep track of line info in tokens +-define(line(Tup), element(2, Tup)). + +%% Entry points compatible to old erl_parse. +%% These really suck and are only here until Calle gets multiple +%% entry points working. + +-spec parse_form(Tokens) -> {ok, AbsForm} | {error, ErrorInfo} when + Tokens :: [token()], + AbsForm :: abstract_form(), + ErrorInfo :: error_info(). +parse_form([{'-',L1},{atom,L2,spec}|Tokens]) -> + parse([{'-',L1},{'spec',L2}|Tokens]); +parse_form([{'-',L1},{atom,L2,callback}|Tokens]) -> + parse([{'-',L1},{'callback',L2}|Tokens]); +parse_form(Tokens) -> + parse(Tokens). + +-spec parse_exprs(Tokens) -> {ok, ExprList} | {error, ErrorInfo} when + Tokens :: [token()], + ExprList :: [abstract_expr()], + ErrorInfo :: error_info(). +parse_exprs(Tokens) -> + case parse([{atom,0,f},{'(',0},{')',0},{'->',0}|Tokens]) of + {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],Exprs}]}} -> + {ok,Exprs}; + {error,_} = Err -> Err + end. + +-spec parse_term(Tokens) -> {ok, Term} | {error, ErrorInfo} when + Tokens :: [token()], + Term :: term(), + ErrorInfo :: error_info(). +parse_term(Tokens) -> + case parse([{atom,0,f},{'(',0},{')',0},{'->',0}|Tokens]) of + {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],[Expr]}]}} -> + try normalise(Expr) of + Term -> {ok,Term} + catch + _:_R -> {error,{?line(Expr),?MODULE,"bad term"}} + end; + {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],[_E1,E2|_Es]}]}} -> + {error,{?line(E2),?MODULE,"bad term"}}; + {error,_} = Err -> Err + end. + +%% Convert between the abstract form of a term and a term. + +-spec normalise(AbsTerm) -> Data when + AbsTerm :: abstract_expr(), + Data :: term(). +normalise({char,_,C}) -> C; +normalise({integer,_,I}) -> I; +normalise({float,_,F}) -> F; +normalise({atom,_,A}) -> A; +normalise({string,_,S}) -> S; +normalise({nil,_}) -> []; +normalise({bin,_,Fs}) -> + {value, B, _} = + eval_bits:expr_grp(Fs, [], + fun(E, _) -> + {value, normalise(E), []} + end, [], true), + B; +normalise({cons,_,Head,Tail}) -> + [normalise(Head)|normalise(Tail)]; +normalise({tuple,_,Args}) -> + list_to_tuple(normalise_list(Args)); +%% Atom dot-notation, as in 'foo.bar.baz' +%% Special case for unary +/-. +normalise({op,_,'+',{char,_,I}}) -> I; +normalise({op,_,'+',{integer,_,I}}) -> I; +normalise({op,_,'+',{float,_,F}}) -> F; +normalise({op,_,'-',{char,_,I}}) -> -I; %Weird, but compatible! +normalise({op,_,'-',{integer,_,I}}) -> -I; +normalise({op,_,'-',{float,_,F}}) -> -F; +normalise(X) -> erlang:error({badarg, X}). + +normalise_list([H|T]) -> + [normalise(H)|normalise_list(T)]; +normalise_list([]) -> + []. + +%% Generate a list of tokens representing the abstract term. + +-spec tokens(AbsTerm) -> Tokens when + AbsTerm :: abstract_expr(), + Tokens :: [token()]. +tokens(Abs) -> + tokens(Abs, []). + +-spec tokens(AbsTerm, MoreTokens) -> Tokens when + AbsTerm :: abstract_expr(), + MoreTokens :: [token()], + Tokens :: [token()]. +tokens({char,L,C}, More) -> [{char,L,C}|More]; +tokens({integer,L,N}, More) -> [{integer,L,N}|More]; +tokens({float,L,F}, More) -> [{float,L,F}|More]; +tokens({atom,L,A}, More) -> [{atom,L,A}|More]; +tokens({var,L,V}, More) -> [{var,L,V}|More]; +tokens({string,L,S}, More) -> [{string,L,S}|More]; +tokens({nil,L}, More) -> [{'[',L},{']',L}|More]; +tokens({cons,L,Head,Tail}, More) -> + [{'[',L}|tokens(Head, tokens_tail(Tail, More))]; +tokens({tuple,L,[]}, More) -> + [{'{',L},{'}',L}|More]; +tokens({tuple,L,[E|Es]}, More) -> + [{'{',L}|tokens(E, tokens_tuple(Es, ?line(E), More))]. + +tokens_tail({cons,L,Head,Tail}, More) -> + [{',',L}|tokens(Head, tokens_tail(Tail, More))]; +tokens_tail({nil,L}, More) -> + [{']',L}|More]; +tokens_tail(Other, More) -> + L = ?line(Other), + [{'|',L}|tokens(Other, [{']',L}|More])]. + +tokens_tuple([E|Es], Line, More) -> + [{',',Line}|tokens(E, tokens_tuple(Es, ?line(E), More))]; +tokens_tuple([], Line, More) -> + [{'}',Line}|More]. + +%% Give the relative precedences of operators. + +inop_prec('=') -> {150,100,100}; +inop_prec('!') -> {150,100,100}; +inop_prec('orelse') -> {160,150,150}; +inop_prec('andalso') -> {200,160,160}; +inop_prec('==') -> {300,200,300}; +inop_prec('/=') -> {300,200,300}; +inop_prec('=<') -> {300,200,300}; +inop_prec('<') -> {300,200,300}; +inop_prec('>=') -> {300,200,300}; +inop_prec('>') -> {300,200,300}; +inop_prec('=:=') -> {300,200,300}; +inop_prec('=/=') -> {300,200,300}; +inop_prec('++') -> {400,300,300}; +inop_prec('--') -> {400,300,300}; +inop_prec('+') -> {400,400,500}; +inop_prec('-') -> {400,400,500}; +inop_prec('bor') -> {400,400,500}; +inop_prec('bxor') -> {400,400,500}; +inop_prec('bsl') -> {400,400,500}; +inop_prec('bsr') -> {400,400,500}; +inop_prec('or') -> {400,400,500}; +inop_prec('xor') -> {400,400,500}; +inop_prec('*') -> {500,500,600}; +inop_prec('/') -> {500,500,600}; +inop_prec('div') -> {500,500,600}; +inop_prec('rem') -> {500,500,600}; +inop_prec('band') -> {500,500,600}; +inop_prec('and') -> {500,500,600}; +inop_prec('#') -> {800,700,800}; +inop_prec(':') -> {900,800,900}; +inop_prec('.') -> {900,900,1000}. + +-type pre_op() :: 'catch' | '+' | '-' | 'bnot' | 'not' | '#'. + +-spec preop_prec(pre_op()) -> {0 | 600 | 700, 100 | 700 | 800}. + +preop_prec('catch') -> {0,100}; +preop_prec('+') -> {600,700}; +preop_prec('-') -> {600,700}; +preop_prec('bnot') -> {600,700}; +preop_prec('not') -> {600,700}; +preop_prec('#') -> {700,800}. + +-spec func_prec() -> {800,700}. + +func_prec() -> {800,700}. + +-spec max_prec() -> 1000. + +max_prec() -> 1000. + +parse(T) -> + bar:foo(T). diff --git a/lib/dialyzer/test/small_SUITE_data/src/big_local_type.erl b/lib/dialyzer/test/small_SUITE_data/src/big_local_type.erl new file mode 100644 index 0000000000..6de263eda1 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/big_local_type.erl @@ -0,0 +1,525 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%% A stripped version of erl_parse.yrl. +%%% +%%% A type for the abstract format with *local* types has been added. +%%% The type of the abstract format is not up-to-date, but it does not +%%% matter since the purpose of the type is to stress the conversion +%%% of type forms to erl_type(). + +-module(big_local_type). + +-export([parse_form/1,parse_exprs/1,parse_term/1]). +-export([normalise/1,tokens/1,tokens/2]). +-export([inop_prec/1,preop_prec/1,func_prec/0,max_prec/0]). + +-export_type([abstract_clause/0, abstract_expr/0, abstract_form/0, + error_info/0]). + +%% Start of Abstract Format + +-type line() :: erl_scan:line(). + +-export_type([af_module/0, af_export/0, af_import/0, af_fa_list/0, + af_compile/0, af_file/0, af_record_decl/0, + af_field_decl/0, af_wild_attribute/0, + af_record_update/1, af_catch/0, af_local_call/0, + af_remote_call/0, af_args/0, af_local_function/0, + af_remote_function/0, af_list_comprehension/0, + af_binary_comprehension/0, af_template/0, + af_qualifier_seq/0, af_qualifier/0, af_generator/0, + af_filter/0, af_block/0, af_if/0, af_case/0, af_try/0, + af_clause_seq/0, af_catch_clause_seq/0, af_receive/0, + af_local_fun/0, af_remote_fun/0, af_fun/0, af_query/0, + af_query_access/0, af_clause/0, + af_catch_clause/0, af_catch_pattern/0, af_catch_class/0, + af_body/0, af_guard_seq/0, af_guard/0, af_guard_test/0, + af_record_access/1, af_guard_call/0, + af_remote_guard_call/0, af_pattern/0, af_literal/0, + af_atom/0, af_lit_atom/1, af_integer/0, af_float/0, + af_string/0, af_match/1, af_variable/0, + af_anon_variable/0, af_tuple/1, af_nil/0, af_cons/1, + af_bin/1, af_binelement/1, af_binelement_size/0, + af_binary_op/1, af_binop/0, af_unary_op/1, af_unop/0]). + +-type abstract_form() :: af_module() + | af_export() + | af_import() + | af_compile() + | af_file() + | af_record_decl() + | af_wild_attribute() + | af_function_decl(). + +-type af_module() :: {attribute, line(), module, module()}. + +-type af_export() :: {attribute, line(), export, af_fa_list()}. + +-type af_import() :: {attribute, line(), import, af_fa_list()}. + +-type af_fa_list() :: [{function(), arity()}]. + +-type af_compile() :: {attribute, line(), compile, any()}. + +-type af_file() :: {attribute, line(), file, {string(), line()}}. + +-type af_record_decl() :: + {attribute, line(), record, af_record_name(), [af_field_decl()]}. + +-type af_field_decl() :: {record_field, line(), af_atom()} + | {record_field, line(), af_atom(), abstract_expr()}. + +%% Types and specs, among other things... +-type af_wild_attribute() :: {attribute, line(), af_atom(), any()}. + +-type af_function_decl() :: + {function, line(), function(), arity(), af_clause_seq()}. + +-type abstract_expr() :: af_literal() + | af_match(abstract_expr()) + | af_variable() + | af_tuple(abstract_expr()) + | af_nil() + | af_cons(abstract_expr()) + | af_bin(abstract_expr()) + | af_binary_op(abstract_expr()) + | af_unary_op(abstract_expr()) + | af_record_access(abstract_expr()) + | af_record_update(abstract_expr()) + | af_record_index() + | af_record_field(abstract_expr()) + | af_catch() + | af_local_call() + | af_remote_call() + | af_list_comprehension() + | af_binary_comprehension() + | af_block() + | af_if() + | af_case() + | af_try() + | af_receive() + | af_local_fun() + | af_remote_fun() + | af_fun() + | af_query() + | af_query_access(). + +-type af_record_update(T) :: {record, + line(), + abstract_expr(), + af_record_name(), + [af_record_field(T)]}. + +-type af_catch() :: {'catch', line(), abstract_expr()}. + +-type af_local_call() :: {call, line(), af_local_function(), af_args()}. + +-type af_remote_call() :: {call, line(), af_remote_function(), af_args()}. + +-type af_args() :: [abstract_expr()]. + +-type af_local_function() :: abstract_expr(). + +-type af_remote_function() :: + {remote, line(), abstract_expr(), abstract_expr()}. + +-type af_list_comprehension() :: + {lc, line(), af_template(), af_qualifier_seq()}. + +-type af_binary_comprehension() :: + {bc, line(), af_template(), af_qualifier_seq()}. + +-type af_template() :: abstract_expr(). + +-type af_qualifier_seq() :: [af_qualifier()]. + +-type af_qualifier() :: af_generator() | af_filter(). + +-type af_generator() :: {generate, line(), af_pattern(), abstract_expr()} + | {b_generate, line(), af_pattern(), abstract_expr()}. + +-type af_filter() :: abstract_expr(). + +-type af_block() :: {block, line(), af_body()}. + +-type af_if() :: {'if', line(), af_clause_seq()}. + +-type af_case() :: {'case', line(), abstract_expr(), af_clause_seq()}. + +-type af_try() :: {'try', + line(), + af_body(), + af_clause_seq(), + af_catch_clause_seq(), + af_body()}. + +-type af_clause_seq() :: [af_clause(), ...]. + +-type af_catch_clause_seq() :: [af_clause(), ...]. + +-type af_receive() :: + {'receive', line(), af_clause_seq()} + | {'receive', line(), af_clause_seq(), abstract_expr(), af_body()}. + +-type af_local_fun() :: {'fun', line(), {function, function(), arity()}}. + +-type af_remote_fun() :: + {'fun', line(), {function, module(), function(), arity()}} + | {'fun', line(), {function, af_atom(), af_atom(), af_integer()}}. + +-type af_fun() :: {'fun', line(), {clauses, af_clause_seq()}}. + +-type af_query() :: {'query', line(), af_list_comprehension()}. + +-type af_query_access() :: + {record_field, line(), abstract_expr(), af_field_name()}. + +-type abstract_clause() :: af_clause() | af_catch_clause(). + +-type af_clause() :: + {clause, line(), [af_pattern()], af_guard_seq(), af_body()}. + +-type af_catch_clause() :: + {clause, line(), [af_catch_pattern()], af_guard_seq(), af_body()}. + +-type af_catch_pattern() :: + {af_catch_class(), af_pattern(), af_anon_variable()}. + +-type af_catch_class() :: + af_variable() + | af_lit_atom(throw) | af_lit_atom(error) | af_lit_atom(exit). + +-type af_body() :: [abstract_expr(), ...]. + +-type af_guard_seq() :: [af_guard()]. + +-type af_guard() :: [af_guard_test(), ...]. + +-type af_guard_test() :: af_literal() + | af_variable() + | af_tuple(af_guard_test()) + | af_nil() + | af_cons(af_guard_test()) + | af_bin(af_guard_test()) + | af_binary_op(af_guard_test()) + | af_unary_op(af_guard_test()) + | af_record_access(af_guard_test()) + | af_record_index() + | af_record_field(af_guard_test()) + | af_guard_call() + | af_remote_guard_call(). + +-type af_record_access(T) :: + {record, line(), af_record_name(), [af_record_field(T)]}. + +-type af_guard_call() :: {call, line(), function(), [af_guard_test()]}. + +-type af_remote_guard_call() :: + {call, line(), atom(), af_lit_atom(erlang), [af_guard_test()]}. + +-type af_pattern() :: af_literal() + | af_match(af_pattern()) + | af_variable() + | af_anon_variable() + | af_tuple(af_pattern()) + | af_nil() + | af_cons(af_pattern()) + | af_bin(af_pattern()) + | af_binary_op(af_pattern()) + | af_unary_op(af_pattern()) + | af_record_index() + | af_record_field(af_pattern()). + +-type af_literal() :: af_atom() | af_integer() | af_float() | af_string(). + +-type af_atom() :: af_lit_atom(atom()). + +-type af_lit_atom(A) :: {atom, line(), A}. + +-type af_integer() :: {integer, line(), non_neg_integer()}. + +-type af_float() :: {float, line(), float()}. + +-type af_string() :: {string, line(), [byte()]}. + +-type af_match(T) :: {match, line(), T, T}. + +-type af_variable() :: {var, line(), atom()}. + +-type af_anon_variable() :: {var, line(), '_'}. + +-type af_tuple(T) :: {tuple, line(), [T]}. + +-type af_nil() :: {nil, line()}. + +-type af_cons(T) :: {cons, line, T, T}. + +-type af_bin(T) :: {bin, line(), [af_binelement(T)]}. + +-type af_binelement(T) :: {bin_element, + line(), + T, + af_binelement_size(), + type_specifier_list()}. + +-type af_binelement_size() :: default | abstract_expr(). + +-type af_binary_op(T) :: {op, line(), T, af_binop(), T}. + +-type af_binop() :: '/' | '*' | 'div' | 'rem' | 'band' | 'and' | '+' | '-' + | 'bor' | 'bxor' | 'bsl' | 'bsr' | 'or' | 'xor' | '++' + | '--' | '==' | '/=' | '=<' | '<' | '>=' | '>' | '=:=' + | '=/='. + +-type af_unary_op(T) :: {op, line(), af_unop(), T}. + +-type af_unop() :: '+' | '*' | 'bnot' | 'not'. + +%% See also lib/stdlib/{src/erl_bits.erl,include/erl_bits.hrl}. +-type type_specifier_list() :: default | [type_specifier(), ...]. + +-type type_specifier() :: af_type() + | af_signedness() + | af_endianness() + | af_unit(). + +-type af_type() :: integer + | float + | binary + | bytes + | bitstring + | bits + | utf8 + | utf16 + | utf32. + +-type af_signedness() :: signed | unsigned. + +-type af_endianness() :: big | little | native. + +-type af_unit() :: {unit, 1..256}. + +-type af_record_index() :: + {record_index, line(), af_record_name(), af_field_name()}. + +-type af_record_field(T) :: {record_field, line(), af_field_name(), T}. + +-type af_record_name() :: atom(). + +-type af_field_name() :: atom(). + +%% End of Abstract Format + +-type error_description() :: term(). +-type error_info() :: {erl_scan:line(), module(), error_description()}. +-type token() :: {Tag :: atom(), Line :: erl_scan:line()}. + +%% mkop(Op, Arg) -> {op,Line,Op,Arg}. +%% mkop(Left, Op, Right) -> {op,Line,Op,Left,Right}. + +-define(mkop2(L, OpPos, R), + begin + {Op,Pos} = OpPos, + {op,Pos,Op,L,R} + end). + +-define(mkop1(OpPos, A), + begin + {Op,Pos} = OpPos, + {op,Pos,Op,A} + end). + +%% keep track of line info in tokens +-define(line(Tup), element(2, Tup)). + +%% Entry points compatible to old erl_parse. +%% These really suck and are only here until Calle gets multiple +%% entry points working. + +-spec parse_form(Tokens) -> {ok, AbsForm} | {error, ErrorInfo} when + Tokens :: [token()], + AbsForm :: abstract_form(), + ErrorInfo :: error_info(). +parse_form([{'-',L1},{atom,L2,spec}|Tokens]) -> + parse([{'-',L1},{'spec',L2}|Tokens]); +parse_form([{'-',L1},{atom,L2,callback}|Tokens]) -> + parse([{'-',L1},{'callback',L2}|Tokens]); +parse_form(Tokens) -> + parse(Tokens). + +-spec parse_exprs(Tokens) -> {ok, ExprList} | {error, ErrorInfo} when + Tokens :: [token()], + ExprList :: [abstract_expr()], + ErrorInfo :: error_info(). +parse_exprs(Tokens) -> + case parse([{atom,0,f},{'(',0},{')',0},{'->',0}|Tokens]) of + {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],Exprs}]}} -> + {ok,Exprs}; + {error,_} = Err -> Err + end. + +-spec parse_term(Tokens) -> {ok, Term} | {error, ErrorInfo} when + Tokens :: [token()], + Term :: term(), + ErrorInfo :: error_info(). +parse_term(Tokens) -> + case parse([{atom,0,f},{'(',0},{')',0},{'->',0}|Tokens]) of + {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],[Expr]}]}} -> + try normalise(Expr) of + Term -> {ok,Term} + catch + _:_R -> {error,{?line(Expr),?MODULE,"bad term"}} + end; + {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],[_E1,E2|_Es]}]}} -> + {error,{?line(E2),?MODULE,"bad term"}}; + {error,_} = Err -> Err + end. + +%% Convert between the abstract form of a term and a term. + +-spec normalise(AbsTerm) -> Data when + AbsTerm :: abstract_expr(), + Data :: term(). +normalise({char,_,C}) -> C; +normalise({integer,_,I}) -> I; +normalise({float,_,F}) -> F; +normalise({atom,_,A}) -> A; +normalise({string,_,S}) -> S; +normalise({nil,_}) -> []; +normalise({bin,_,Fs}) -> + {value, B, _} = + eval_bits:expr_grp(Fs, [], + fun(E, _) -> + {value, normalise(E), []} + end, [], true), + B; +normalise({cons,_,Head,Tail}) -> + [normalise(Head)|normalise(Tail)]; +normalise({tuple,_,Args}) -> + list_to_tuple(normalise_list(Args)); +%% Atom dot-notation, as in 'foo.bar.baz' +%% Special case for unary +/-. +normalise({op,_,'+',{char,_,I}}) -> I; +normalise({op,_,'+',{integer,_,I}}) -> I; +normalise({op,_,'+',{float,_,F}}) -> F; +normalise({op,_,'-',{char,_,I}}) -> -I; %Weird, but compatible! +normalise({op,_,'-',{integer,_,I}}) -> -I; +normalise({op,_,'-',{float,_,F}}) -> -F; +normalise(X) -> erlang:error({badarg, X}). + +normalise_list([H|T]) -> + [normalise(H)|normalise_list(T)]; +normalise_list([]) -> + []. + +%% Generate a list of tokens representing the abstract term. + +-spec tokens(AbsTerm) -> Tokens when + AbsTerm :: abstract_expr(), + Tokens :: [token()]. +tokens(Abs) -> + tokens(Abs, []). + +-spec tokens(AbsTerm, MoreTokens) -> Tokens when + AbsTerm :: abstract_expr(), + MoreTokens :: [token()], + Tokens :: [token()]. +tokens({char,L,C}, More) -> [{char,L,C}|More]; +tokens({integer,L,N}, More) -> [{integer,L,N}|More]; +tokens({float,L,F}, More) -> [{float,L,F}|More]; +tokens({atom,L,A}, More) -> [{atom,L,A}|More]; +tokens({var,L,V}, More) -> [{var,L,V}|More]; +tokens({string,L,S}, More) -> [{string,L,S}|More]; +tokens({nil,L}, More) -> [{'[',L},{']',L}|More]; +tokens({cons,L,Head,Tail}, More) -> + [{'[',L}|tokens(Head, tokens_tail(Tail, More))]; +tokens({tuple,L,[]}, More) -> + [{'{',L},{'}',L}|More]; +tokens({tuple,L,[E|Es]}, More) -> + [{'{',L}|tokens(E, tokens_tuple(Es, ?line(E), More))]. + +tokens_tail({cons,L,Head,Tail}, More) -> + [{',',L}|tokens(Head, tokens_tail(Tail, More))]; +tokens_tail({nil,L}, More) -> + [{']',L}|More]; +tokens_tail(Other, More) -> + L = ?line(Other), + [{'|',L}|tokens(Other, [{']',L}|More])]. + +tokens_tuple([E|Es], Line, More) -> + [{',',Line}|tokens(E, tokens_tuple(Es, ?line(E), More))]; +tokens_tuple([], Line, More) -> + [{'}',Line}|More]. + +%% Give the relative precedences of operators. + +inop_prec('=') -> {150,100,100}; +inop_prec('!') -> {150,100,100}; +inop_prec('orelse') -> {160,150,150}; +inop_prec('andalso') -> {200,160,160}; +inop_prec('==') -> {300,200,300}; +inop_prec('/=') -> {300,200,300}; +inop_prec('=<') -> {300,200,300}; +inop_prec('<') -> {300,200,300}; +inop_prec('>=') -> {300,200,300}; +inop_prec('>') -> {300,200,300}; +inop_prec('=:=') -> {300,200,300}; +inop_prec('=/=') -> {300,200,300}; +inop_prec('++') -> {400,300,300}; +inop_prec('--') -> {400,300,300}; +inop_prec('+') -> {400,400,500}; +inop_prec('-') -> {400,400,500}; +inop_prec('bor') -> {400,400,500}; +inop_prec('bxor') -> {400,400,500}; +inop_prec('bsl') -> {400,400,500}; +inop_prec('bsr') -> {400,400,500}; +inop_prec('or') -> {400,400,500}; +inop_prec('xor') -> {400,400,500}; +inop_prec('*') -> {500,500,600}; +inop_prec('/') -> {500,500,600}; +inop_prec('div') -> {500,500,600}; +inop_prec('rem') -> {500,500,600}; +inop_prec('band') -> {500,500,600}; +inop_prec('and') -> {500,500,600}; +inop_prec('#') -> {800,700,800}; +inop_prec(':') -> {900,800,900}; +inop_prec('.') -> {900,900,1000}. + +-type pre_op() :: 'catch' | '+' | '-' | 'bnot' | 'not' | '#'. + +-spec preop_prec(pre_op()) -> {0 | 600 | 700, 100 | 700 | 800}. + +preop_prec('catch') -> {0,100}; +preop_prec('+') -> {600,700}; +preop_prec('-') -> {600,700}; +preop_prec('bnot') -> {600,700}; +preop_prec('not') -> {600,700}; +preop_prec('#') -> {700,800}. + +-spec func_prec() -> {800,700}. + +func_prec() -> {800,700}. + +-spec max_prec() -> 1000. + +max_prec() -> 1000. + +parse(T) -> + bar:foo(T). diff --git a/lib/dialyzer/test/small_SUITE_data/src/contracts_with_subtypes.erl b/lib/dialyzer/test/small_SUITE_data/src/contracts_with_subtypes.erl index d7dfd9752e..dbabd904c2 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/contracts_with_subtypes.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/contracts_with_subtypes.erl @@ -136,10 +136,14 @@ q(ab) -> rec2({a, b}); % breaks the contract q(ba) -> rec2({b, a}); % breaks the contract q(aba) -> rec2({a, {b, a}}); % breaks the contract q(bab) -> rec2({b, {a, b}}); % breaks the contract -q(abab) -> rec2({a, {b, {a, b}}}); -q(baba) -> rec2({b, {a, {b, a}}}); -q(ababa) -> rec2({a, {b, {a, {b, a}}}}); -q(babab) -> rec2({b, {a, {b, {a, b}}}}). +q(abab) -> rec2({a, {b, {a, b}}}); % breaks the contract +q(baba) -> rec2({b, {a, {b, a}}}); % breaks the contract +q(ababa) -> rec2({a, {b, {a, {b, a}}}}); % breaks the contract +q(babab) -> rec2({b, {a, {b, {a, b}}}}); % breaks the contract +q(ababab) -> rec2({a, {b, {a, {b, {a, b}}}}}); +q(bababa) -> rec2({b, {a, {b, {a, {b, a}}}}}); +q(abababa) -> rec2({a, {b, {a, {b, {a, {b, a}}}}}}); +q(bababab) -> rec2({b, {a, {b, {a, {b, {a, b}}}}}}). %=============================================================================== diff --git a/lib/dialyzer/test/small_SUITE_data/src/ditrap.erl b/lib/dialyzer/test/small_SUITE_data/src/ditrap.erl new file mode 100644 index 0000000000..2d75f25bd5 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/ditrap.erl @@ -0,0 +1,47 @@ +%% A bug reported by Tail-f Systems. The problem is that record types +%% are included without properly limiting their depth. + +-module(ditrap). + +-define(tref(T), ?MODULE:T). +-define(fref(T), ?MODULE:T). + +-export_type([ module_rec/0 + , typedef_rec/0 + , type_spec_fun/0 + ]). + +-record(type, { + base :: 'builtin' | external:random_type() | ?tref(typedef_rec()), + type_spec_fun :: ?fref(type_spec_fun()) + }). + +-record(typedef, {type :: #type{}}). + +-record(typedefs, { + map :: ?tref(typedef_rec()), + parent :: 'undefined' | #typedefs{} + }). + +-record(sn, { + module :: ?tref(module_rec()), + typedefs :: #typedefs{}, + type :: 'undefined' | #type{}, + keys :: 'undefined' | [#sn{}], + children = [] :: [#sn{}] + }). + +-record(augment, {children = [] :: [#sn{}]}). + +-record(module, { + submodules = [] :: [{#module{}, external:pos()}], + typedefs = #typedefs{} :: #typedefs{}, + children = [] :: [#sn{}], + remote_augments = [] :: [{ModuleName :: atom(), [#augment{}]}], + local_augments = [] :: [#augment{}] + }). + +-type typedef_rec() :: #typedef{}. +-type module_rec() :: #module{}. + +-type type_spec_fun() :: undefined | fun((#type{}, #module{}) -> any()). diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 5124e7238a..09dffe1280 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2014. All Rights Reserved. +%% Copyright Ericsson AB 2003-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -78,10 +78,11 @@ t_non_neg_fixnum/0, t_pos_fixnum/0, t_float/0, + t_var_names/1, t_form_to_string/1, - t_from_form/1, - t_from_form/2, - t_from_form/3, + t_from_form/4, + t_from_form/5, + t_from_form_without_remote/2, t_from_range/2, t_from_range_unsafe/2, t_from_term/1, @@ -181,7 +182,6 @@ t_remote/3, t_string/0, t_struct_from_opaque/2, - t_solve_remote/3, t_subst/2, t_subtract/2, t_subtract_list/2, @@ -248,6 +248,8 @@ %% -define(REC_TYPE_LIMIT, 2). +-define(EXPAND_DEPTH, 16). +-define(EXPAND_LIMIT, 10000). -define(TUPLE_TAG_LIMIT, 5). -define(TUPLE_ARITY_LIMIT, 8). @@ -366,7 +368,7 @@ -type record_key() :: {'record', atom()}. -type type_key() :: {'type' | 'opaque', atom(), arity()}. --type record_value() :: orddict:orddict(). % XXX. To be refined +-type record_value() :: [{atom(), erl_parse:abstract_expr(), erl_type()}]. -type type_value() :: {module(), erl_type(), atom()}. -type type_table() :: dict:dict(record_key(), record_value()) | dict:dict(type_key(), type_value()). @@ -747,7 +749,7 @@ t_opaque_from_records(RecDict) -> end end, RecDict), OpaqueTypeDict = - dict:map(fun({opaque, Name, _Arity}, {Module, _Type, ArgNames}) -> + dict:map(fun({opaque, Name, _Arity}, {{Module, _Form, ArgNames}, _Type}) -> %% Args = args_to_types(ArgNames), %% List = lists:zip(ArgNames, Args), %% TmpVarDict = dict:from_list(List), @@ -808,134 +810,6 @@ is_remote(_) -> false. -type mod_records() :: dict:dict(module(), type_table()). --spec t_solve_remote(erl_type(), sets:set(mfa()), mod_records()) -> erl_type(). - -t_solve_remote(Type, ExpTypes, Records) -> - {RT, _RR} = t_solve_remote(Type, ExpTypes, Records, []), - RT. - -t_solve_remote(?function(Domain, Range), ET, R, C) -> - {RT1, RR1} = t_solve_remote(Domain, ET, R, C), - {RT2, RR2} = t_solve_remote(Range, ET, R, C), - {?function(RT1, RT2), RR1 ++ RR2}; -t_solve_remote(?list(Types, Term, Size), ET, R, C) -> - {RT1, RR1} = t_solve_remote(Types, ET, R, C), - {RT2, RR2} = t_solve_remote(Term, ET, R, C), - {?list(RT1, RT2, Size), RR1 ++ RR2}; -t_solve_remote(?product(Types), ET, R, C) -> - {RL, RR} = list_solve_remote(Types, ET, R, C), - {?product(RL), RR}; -t_solve_remote(?opaque(Set), ET, R, C) -> - List = ordsets:to_list(Set), - {NewList, RR} = opaques_solve_remote(List, ET, R, C), - {?opaque(ordsets:from_list(NewList)), RR}; -t_solve_remote(?tuple(?any, _, _) = T, _ET, _R, _C) -> {T, []}; -t_solve_remote(?tuple(Types, _Arity, _Tag), ET, R, C) -> - {RL, RR} = list_solve_remote(Types, ET, R, C), - {t_tuple(RL), RR}; -t_solve_remote(?tuple_set(Set), ET, R, C) -> - {NewTuples, RR} = tuples_solve_remote(Set, ET, R, C), - {t_sup(NewTuples), RR}; -t_solve_remote(?remote(Set), ET, R, C) -> - RemoteList = ordsets:to_list(Set), - {RL, RR} = list_solve_remote_type(RemoteList, ET, R, C), - {t_sup(RL), RR}; -t_solve_remote(?union(List), ET, R, C) -> - {RL, RR} = list_solve_remote(List, ET, R, C), - {t_sup(RL), RR}; -t_solve_remote(T, _ET, _R, _C) -> {T, []}. - -t_solve_remote_type(#remote{mod = RemMod, name = Name, args = Args0} = RemType, - ET, R, C) -> - Args = lists:map(fun(A) -> - {Arg, _} = t_solve_remote(A, ET, R, C), - Arg - end, Args0), - ArgsLen = length(Args), - case dict:find(RemMod, R) of - error -> - self() ! {self(), ext_types, {RemMod, Name, ArgsLen}}, - {t_any(), []}; - {ok, RemDict} -> - MFA = {RemMod, Name, ArgsLen}, - case sets:is_element(MFA, ET) of - true -> - case lookup_type(Name, ArgsLen, RemDict) of - {type, {_Mod, Type, ArgNames}} -> - {NewType, NewCycle, NewRR} = - case can_unfold_more(RemType, C) of - true -> - List = lists:zip(ArgNames, Args), - TmpVarDict = dict:from_list(List), - {t_from_form(Type, RemDict, TmpVarDict), [RemType|C], []}; - false -> - {t_any(), C, [RemType]} - end, - {RT, RR} = t_solve_remote(NewType, ET, R, NewCycle), - RetRR = NewRR ++ RR, - RT1 = - case lists:member(RemType, RetRR) of - true -> t_limit(RT, ?REC_TYPE_LIMIT); - false -> RT - end, - {RT1, RetRR}; - {opaque, {Mod, Type, ArgNames}} -> - List = lists:zip(ArgNames, Args), - TmpVarDict = dict:from_list(List), - {Rep, NewCycle, NewRR} = - case can_unfold_more(RemType, C) of - true -> - {t_from_form(Type, RemDict, TmpVarDict), [RemType|C], []}; - false -> - {t_any(), C, [RemType]} - end, - {NewRep, RR} = t_solve_remote(Rep, ET, R, NewCycle), - RetRR = NewRR ++ RR, - RT1 = - case lists:member(RemType, RetRR) of - true -> t_limit(NewRep, ?REC_TYPE_LIMIT); - false -> NewRep - end, - {skip_opaque_alias(RT1, Mod, Name, Args), RetRR}; - error -> - Msg = io_lib:format("Unable to find remote type ~w:~w()\n", - [RemMod, Name]), - throw({error, Msg}) - end; - false -> - self() ! {self(), ext_types, {RemMod, Name, ArgsLen}}, - {t_any(), []} - end - end. - -list_solve_remote([], _ET, _R, _C) -> - {[], []}; -list_solve_remote([Type|Types], ET, R, C) -> - {RT, RR1} = t_solve_remote(Type, ET, R, C), - {RL, RR2} = list_solve_remote(Types, ET, R, C), - {[RT|RL], RR1 ++ RR2}. - -list_solve_remote_type([], _ET, _R, _C) -> - {[], []}; -list_solve_remote_type([Type|Types], ET, R, C) -> - {RT, RR1} = t_solve_remote_type(Type, ET, R, C), - {RL, RR2} = list_solve_remote_type(Types, ET, R, C), - {[RT|RL], RR1 ++ RR2}. - -opaques_solve_remote([], _ET, _R, _C) -> - {[], []}; -opaques_solve_remote([#opaque{struct = Struct} = Remote|Tail], ET, R, C) -> - {RT, RR1} = t_solve_remote(Struct, ET, R, C), - {LOp, RR2} = opaques_solve_remote(Tail, ET, R, C), - {[Remote#opaque{struct = RT}|LOp], RR1 ++ RR2}. - -tuples_solve_remote([], _ET, _R, _C) -> - {[], []}; -tuples_solve_remote([{_Sz, Tuples}|Tail], ET, R, C) -> - {RL, RR1} = list_solve_remote(Tuples, ET, R, C), - {LSzTpls, RR2} = tuples_solve_remote(Tail, ET, R, C), - {RL ++ LSzTpls, RR1 ++ RR2}. - %%----------------------------------------------------------------------------- %% Unit type. Signals non termination. %% @@ -2264,14 +2138,19 @@ expand_range_from_set(Range = ?int_range(From, To), Set) -> -spec t_sup([erl_type()]) -> erl_type(). -t_sup([?any|_]) -> - ?any; -t_sup([H1, H2|T]) -> - t_sup([t_sup(H1, H2)|T]); -t_sup([H]) -> - subst_all_vars_to_any(H); -t_sup([]) -> - ?none. +t_sup([]) -> ?none; +t_sup(Ts) -> + case lists:any(fun is_any/1, Ts) of + true -> ?any; + false -> + t_sup1(Ts, []) + end. + +t_sup1([H1, H2|T], L) -> + t_sup1(T, [t_sup(H1, H2)|L]); +t_sup1([T], []) -> subst_all_vars_to_any(T); +t_sup1(Ts, L) -> + t_sup1(Ts++L, []). -spec t_sup(erl_type(), erl_type()) -> erl_type(). @@ -3089,12 +2968,12 @@ t_subst_aux(T, _VarMap) -> subst_all_remote(Type0, Substitute) -> Map = fun(Type) -> - case erl_types:t_is_remote(Type) of + case t_is_remote(Type) of true -> Substitute; false -> Type end end, - erl_types:t_map(Map, Type0). + t_map(Map, Type0). %%----------------------------------------------------------------------------- %% Unification @@ -3776,7 +3655,7 @@ t_abstract_records(?tuple(Elements, Arity, ?atom(_) = Tag), RecDict) -> [TagAtom] = atom_vals(Tag), case lookup_record(TagAtom, Arity - 1, RecDict) of error -> t_tuple([t_abstract_records(E, RecDict) || E <- Elements]); - {ok, Fields} -> t_tuple([Tag|[T || {_Name, T} <- Fields]]) + {ok, Fields} -> t_tuple([Tag|[T || {_Name, _Abstr, T} <- Fields]]) end; t_abstract_records(?tuple(Elements, _Arity, _Tag), RecDict) -> t_tuple([t_abstract_records(E, RecDict) || E <- Elements]); @@ -3997,7 +3876,8 @@ record_to_string(Tag, [_|Fields], FieldNames, RecDict) -> FieldStrings = record_fields_to_string(Fields, FieldNames, RecDict, []), "#" ++ atom_to_string(Tag) ++ "{" ++ string:join(FieldStrings, ",") ++ "}". -record_fields_to_string([F|Fs], [{FName, _DefType}|FDefs], RecDict, Acc) -> +record_fields_to_string([F|Fs], [{FName, _Abstr, _DefType}|FDefs], + RecDict, Acc) -> NewAcc = case t_is_equal(F, t_any()) orelse t_is_any_atom('undefined', F) of true -> Acc; @@ -4023,7 +3903,7 @@ record_field_diffs_to_string(?tuple([_|Fs], Arity, Tag), RecDict) -> FieldDiffs = field_diffs(Fs, FieldNames, RecDict, []), string:join(FieldDiffs, " and "). -field_diffs([F|Fs], [{FName, DefType}|FDefs], RecDict, Acc) -> +field_diffs([F|Fs], [{FName, _Abstr, DefType}|FDefs], RecDict, Acc) -> %% Don't care about opaqueness for now. NewAcc = case not t_is_none(t_inf(F, DefType)) of @@ -4071,357 +3951,476 @@ mod_name(Mod, Name) -> %% %%============================================================================= --spec t_from_form(parse_form()) -> erl_type(). +-type type_names() :: [type_key() | record_key()]. -t_from_form(Form) -> - t_from_form(Form, dict:new()). +-spec t_from_form(parse_form(), sets:set(mfa()), + module(), mod_records()) -> erl_type(). --spec t_from_form(parse_form(), type_table()) -> erl_type(). +t_from_form(Form, ExpTypes, Module, RecDict) -> + t_from_form(Form, ExpTypes, Module, RecDict, dict:new()). -t_from_form(Form, RecDict) -> - t_from_form(Form, RecDict, dict:new()). +-spec t_from_form(parse_form(), sets:set(mfa()), + module(), mod_records(), var_table()) -> erl_type(). --spec t_from_form(parse_form(), type_table(), var_table()) -> erl_type(). +t_from_form(Form, ExpTypes, Module, RecDict, VarDict) -> + {T, _} = t_from_form1(Form, [], ExpTypes, Module, RecDict, VarDict), + T. -t_from_form(Form, RecDict, VarDict) -> - {T, _R} = t_from_form(Form, [], RecDict, VarDict), +%% Replace external types with with none(). +-spec t_from_form_without_remote(parse_form(), type_table()) -> erl_type(). + +t_from_form_without_remote(Form, TypeTable) -> + Module = mod, + RecDict = dict:from_list([{Module, TypeTable}]), + ExpTypes = replace_by_none, + {T, _} = t_from_form1(Form, [], ExpTypes, Module, RecDict, dict:new()), T. --type type_names() :: [type_key() | record_key()]. +%% REC_TYPE_LIMIT is used for limiting the depth of recursive types. +%% EXPAND_LIMIT is used for limiting the size of types by +%% limiting the number of elements of lists within one type form. +%% EXPAND_DEPTH is used in conjunction with EXPAND_LIMIT to make the +%% types balanced (unions will otherwise collapse to any()) by limiting +%% the depth the same way as t_limit/2 does. + +-type expand_limit() :: integer(). --spec t_from_form(parse_form(), type_names(), type_table(), var_table()) -> - {erl_type(), type_names()}. +-type expand_depth() :: integer(). -t_from_form({var, _L, '_'}, _TypeNames, _RecDict, _VarDict) -> - {t_any(), []}; -t_from_form({var, _L, Name}, _TypeNames, _RecDict, VarDict) -> - case dict:find(Name, VarDict) of - error -> {t_var(Name), []}; - {ok, Val} -> {Val, []} +t_from_form1(Form, TypeNames, ET, M, MR, V) -> + t_from_form1(Form, TypeNames, ET, M, MR, V, ?EXPAND_DEPTH). + +t_from_form1(Form, TypeNames, ET, M, MR, V, D) -> + L = ?EXPAND_LIMIT, + {T, L1} = t_from_form(Form, TypeNames, ET, M, MR, V, D, L), + if + L1 =< 0, D > 1 -> + D1 = D div 2, + t_from_form1(Form, TypeNames, ET, M, MR, V, D1); + true -> + {T, L1} + end. + +-spec t_from_form(parse_form(), type_names(), + sets:set(mfa()) | 'replace_by_none', + module(), mod_records(), var_table(), + expand_depth(), expand_limit()) + -> {erl_type(), expand_limit()}. + +%% If there is something wrong with parse_form() +%% throw({error, io_lib:chars()} is called; +%% for unknown remote types +%% self() ! {self(), ext_types, {RemMod, Name, ArgsLen}} +%% is called, unless 'replace_by_none' is given. +%% +%% It is assumed that M can be found in MR. + +t_from_form(_, _TypeNames, _ET, _M, _MR, _V, D, L) when D =< 0 ; L =< 0 -> + {t_any(), L}; +t_from_form({var, _L, '_'}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_any(), L}; +t_from_form({var, _L, Name}, _TypeNames, _ET, _M, _MR, V, _D, L) -> + case dict:find(Name, V) of + error -> {t_var(Name), L}; + {ok, Val} -> {Val, L} end; -t_from_form({ann_type, _L, [_Var, Type]}, TypeNames, RecDict, VarDict) -> - t_from_form(Type, TypeNames, RecDict, VarDict); -t_from_form({paren_type, _L, [Type]}, TypeNames, RecDict, VarDict) -> - t_from_form(Type, TypeNames, RecDict, VarDict); +t_from_form({ann_type, _L, [_Var, Type]}, TypeNames, ET, M, MR, V, D, L) -> + t_from_form(Type, TypeNames, ET, M, MR, V, D, L); +t_from_form({paren_type, _L, [Type]}, TypeNames, ET, M, MR, V, D, L) -> + t_from_form(Type, TypeNames, ET, M, MR, V, D, L); t_from_form({remote_type, _L, [{atom, _, Module}, {atom, _, Type}, Args]}, - TypeNames, RecDict, VarDict) -> - {L, R} = list_from_form(Args, TypeNames, RecDict, VarDict), - {t_remote(Module, Type, L), R}; -t_from_form({atom, _L, Atom}, _TypeNames, _RecDict, _VarDict) -> - {t_atom(Atom), []}; -t_from_form({integer, _L, Int}, _TypeNames, _RecDict, _VarDict) -> - {t_integer(Int), []}; -t_from_form({op, _L, _Op, _Arg} = Op, _TypeNames, _RecDict, _VarDict) -> + TypeNames, ET, M, MR, V, D, L) -> + remote_from_form(Module, Type, Args, TypeNames, ET, M, MR, V, D, L); +t_from_form({atom, _L, Atom}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_atom(Atom), L}; +t_from_form({integer, _L, Int}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_integer(Int), L}; +t_from_form({op, _L, _Op, _Arg} = Op, _TypeNames, _ET, _M, _MR, _V, _D, L) -> case erl_eval:partial_eval(Op) of {integer, _, Val} -> - {t_integer(Val), []}; + {t_integer(Val), L}; _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Op])}) end; t_from_form({op, _L, _Op, _Arg1, _Arg2} = Op, _TypeNames, - _RecDict, _VarDict) -> + _ET, _M, _MR, _V, _D, L) -> case erl_eval:partial_eval(Op) of {integer, _, Val} -> - {t_integer(Val), []}; + {t_integer(Val), L}; _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Op])}) end; -t_from_form({type, _L, any, []}, _TypeNames, _RecDict, _VarDict) -> - {t_any(), []}; -t_from_form({type, _L, arity, []}, _TypeNames, _RecDict, _VarDict) -> - {t_arity(), []}; -t_from_form({type, _L, atom, []}, _TypeNames, _RecDict, _VarDict) -> - {t_atom(), []}; -t_from_form({type, _L, binary, []}, _TypeNames, _RecDict, _VarDict) -> - {t_binary(), []}; +t_from_form({type, _L, any, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_any(), L}; +t_from_form({type, _L, arity, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_arity(), L}; +t_from_form({type, _L, atom, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_atom(), L}; +t_from_form({type, _L, binary, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_binary(), L}; t_from_form({type, _L, binary, [Base, Unit]} = Type, - _TypeNames, _RecDict, _VarDict) -> + _TypeNames, _ET, _M, _MR, _V, _D, L) -> case {erl_eval:partial_eval(Base), erl_eval:partial_eval(Unit)} of {{integer, _, B}, {integer, _, U}} when B >= 0, U >= 0 -> - {t_bitstr(U, B), []}; + {t_bitstr(U, B), L}; _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Type])}) end; -t_from_form({type, _L, bitstring, []}, _TypeNames, _RecDict, _VarDict) -> - {t_bitstr(), []}; -t_from_form({type, _L, bool, []}, _TypeNames, _RecDict, _VarDict) -> - {t_boolean(), []}; % XXX: Temporarily -t_from_form({type, _L, boolean, []}, _TypeNames, _RecDict, _VarDict) -> - {t_boolean(), []}; -t_from_form({type, _L, byte, []}, _TypeNames, _RecDict, _VarDict) -> - {t_byte(), []}; -t_from_form({type, _L, char, []}, _TypeNames, _RecDict, _VarDict) -> - {t_char(), []}; -t_from_form({type, _L, float, []}, _TypeNames, _RecDict, _VarDict) -> - {t_float(), []}; -t_from_form({type, _L, function, []}, _TypeNames, _RecDict, _VarDict) -> - {t_fun(), []}; -t_from_form({type, _L, 'fun', []}, _TypeNames, _RecDict, _VarDict) -> - {t_fun(), []}; +t_from_form({type, _L, bitstring, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_bitstr(), L}; +t_from_form({type, _L, bool, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_boolean(), L}; % XXX: Temporarily +t_from_form({type, _L, boolean, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_boolean(), L}; +t_from_form({type, _L, byte, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_byte(), L}; +t_from_form({type, _L, char, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_char(), L}; +t_from_form({type, _L, float, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_float(), L}; +t_from_form({type, _L, function, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_fun(), L}; +t_from_form({type, _L, 'fun', []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_fun(), L}; t_from_form({type, _L, 'fun', [{type, _, any}, Range]}, TypeNames, - RecDict, VarDict) -> - {T, R} = t_from_form(Range, TypeNames, RecDict, VarDict), - {t_fun(T), R}; + ET, M, MR, V, D, L) -> + {T, L1} = t_from_form(Range, TypeNames, ET, M, MR, V, D - 1, L - 1), + {t_fun(T), L1}; t_from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]}, - TypeNames, RecDict, VarDict) -> - {L, R1} = list_from_form(Domain, TypeNames, RecDict, VarDict), - {T, R2} = t_from_form(Range, TypeNames, RecDict, VarDict), - {t_fun(L, T), R1 ++ R2}; -t_from_form({type, _L, identifier, []}, _TypeNames, _RecDict, _VarDict) -> - {t_identifier(), []}; -t_from_form({type, _L, integer, []}, _TypeNames, _RecDict, _VarDict) -> - {t_integer(), []}; -t_from_form({type, _L, iodata, []}, _TypeNames, _RecDict, _VarDict) -> - {t_iodata(), []}; -t_from_form({type, _L, iolist, []}, _TypeNames, _RecDict, _VarDict) -> - {t_iolist(), []}; -t_from_form({type, _L, list, []}, _TypeNames, _RecDict, _VarDict) -> - {t_list(), []}; -t_from_form({type, _L, list, [Type]}, TypeNames, RecDict, VarDict) -> - {T, R} = t_from_form(Type, TypeNames, RecDict, VarDict), - {t_list(T), R}; -t_from_form({type, _L, map, _}, TypeNames, RecDict, VarDict) -> - builtin_type(map, t_map([]), TypeNames, RecDict, VarDict); -t_from_form({type, _L, mfa, []}, _TypeNames, _RecDict, _VarDict) -> - {t_mfa(), []}; -t_from_form({type, _L, module, []}, _TypeNames, _RecDict, _VarDict) -> - {t_module(), []}; -t_from_form({type, _L, nil, []}, _TypeNames, _RecDict, _VarDict) -> - {t_nil(), []}; -t_from_form({type, _L, neg_integer, []}, _TypeNames, _RecDict, _VarDict) -> - {t_neg_integer(), []}; -t_from_form({type, _L, non_neg_integer, []}, _TypeNames, _RecDict, - _VarDict) -> - {t_non_neg_integer(), []}; -t_from_form({type, _L, no_return, []}, _TypeNames, _RecDict, _VarDict) -> - {t_unit(), []}; -t_from_form({type, _L, node, []}, _TypeNames, _RecDict, _VarDict) -> - {t_node(), []}; -t_from_form({type, _L, none, []}, _TypeNames, _RecDict, _VarDict) -> - {t_none(), []}; -t_from_form({type, _L, nonempty_list, []}, _TypeNames, _RecDict, _VarDict) -> - {t_nonempty_list(), []}; -t_from_form({type, _L, nonempty_list, [Type]}, TypeNames, RecDict, VarDict) -> - {T, R} = t_from_form(Type, TypeNames, RecDict, VarDict), - {t_nonempty_list(T), R}; + TypeNames, ET, M, MR, V, D, L) -> + {Dom1, L1} = list_from_form(Domain, TypeNames, ET, M, MR, V, D, L), + {Ran1, L2} = t_from_form(Range, TypeNames, ET, M, MR, V, D - 1, L1), + {t_fun(Dom1, Ran1), L2}; +t_from_form({type, _L, identifier, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_identifier(), L}; +t_from_form({type, _L, integer, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_integer(), L}; +t_from_form({type, _L, iodata, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_iodata(), L}; +t_from_form({type, _L, iolist, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_iolist(), L}; +t_from_form({type, _L, list, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_list(), L}; +t_from_form({type, _L, list, [Type]}, TypeNames, ET, M, MR, V, D, L) -> + {T, L1} = t_from_form(Type, TypeNames, ET, M, MR, V, D - 1, L - 1), + {t_list(T), L1}; +t_from_form({type, _L, map, _}, TypeNames, ET, M, MR, V, D, L) -> + builtin_type(map, t_map([]), TypeNames, ET, M, MR, V, D, L); +t_from_form({type, _L, mfa, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_mfa(), L}; +t_from_form({type, _L, module, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_module(), L}; +t_from_form({type, _L, nil, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_nil(), L}; +t_from_form({type, _L, neg_integer, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_neg_integer(), L}; +t_from_form({type, _L, non_neg_integer, []}, _TypeNames, _ET, _M, _MR, + _V, _D, L) -> + {t_non_neg_integer(), L}; +t_from_form({type, _L, no_return, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_unit(), L}; +t_from_form({type, _L, node, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_node(), L}; +t_from_form({type, _L, none, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_none(), L}; +t_from_form({type, _L, nonempty_list, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_nonempty_list(), L}; +t_from_form({type, _L, nonempty_list, [Type]}, TypeNames, ET, M, MR, V, D, L) -> + {T, L1} = t_from_form(Type, TypeNames, ET, M, MR, V, D, L - 1), + {t_nonempty_list(T), L1}; t_from_form({type, _L, nonempty_improper_list, [Cont, Term]}, TypeNames, - RecDict, VarDict) -> - {T1, R1} = t_from_form(Cont, TypeNames, RecDict, VarDict), - {T2, R2} = t_from_form(Term, TypeNames, RecDict, VarDict), - {t_cons(T1, T2), R1 ++ R2}; + ET, M, MR, V, D, L) -> + {T1, L1} = t_from_form(Cont, TypeNames, ET, M, MR, V, D, L - 1), + {T2, L2} = t_from_form(Term, TypeNames, ET, M, MR, V, D, L1), + {t_cons(T1, T2), L2}; t_from_form({type, _L, nonempty_maybe_improper_list, []}, _TypeNames, - _RecDict, _VarDict) -> - {t_cons(?any, ?any), []}; + _ET, _M, _MR, _V, _D, L) -> + {t_cons(?any, ?any), L}; t_from_form({type, _L, nonempty_maybe_improper_list, [Cont, Term]}, - TypeNames, RecDict, VarDict) -> - {T1, R1} = t_from_form(Cont, TypeNames, RecDict, VarDict), - {T2, R2} = t_from_form(Term, TypeNames, RecDict, VarDict), - {t_cons(T1, T2), R1 ++ R2}; -t_from_form({type, _L, nonempty_string, []}, _TypeNames, _RecDict, - _VarDict) -> - {t_nonempty_string(), []}; -t_from_form({type, _L, number, []}, _TypeNames, _RecDict, _VarDict) -> - {t_number(), []}; -t_from_form({type, _L, pid, []}, _TypeNames, _RecDict, _VarDict) -> - {t_pid(), []}; -t_from_form({type, _L, port, []}, _TypeNames, _RecDict, _VarDict) -> - {t_port(), []}; -t_from_form({type, _L, pos_integer, []}, _TypeNames, _RecDict, _VarDict) -> - {t_pos_integer(), []}; + TypeNames, ET, M, MR, V, D, L) -> + {T1, L1} = t_from_form(Cont, TypeNames, ET, M, MR, V, D, L - 1), + {T2, L2} = t_from_form(Term, TypeNames, ET, M, MR, V, D, L1), + {t_cons(T1, T2), L2}; +t_from_form({type, _L, nonempty_string, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_nonempty_string(), L}; +t_from_form({type, _L, number, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_number(), L}; +t_from_form({type, _L, pid, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_pid(), L}; +t_from_form({type, _L, port, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_port(), L}; +t_from_form({type, _L, pos_integer, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_pos_integer(), L}; t_from_form({type, _L, maybe_improper_list, []}, _TypeNames, - _RecDict, _VarDict) -> - {t_maybe_improper_list(), []}; + _ET, _M, _MR, _V, _D, L) -> + {t_maybe_improper_list(), L}; t_from_form({type, _L, maybe_improper_list, [Content, Termination]}, - TypeNames, RecDict, VarDict) -> - {T1, R1} = t_from_form(Content, TypeNames, RecDict, VarDict), - {T2, R2} = t_from_form(Termination, TypeNames, RecDict, VarDict), - {t_maybe_improper_list(T1, T2), R1 ++ R2}; -t_from_form({type, _L, product, Elements}, TypeNames, RecDict, VarDict) -> - {L, R} = list_from_form(Elements, TypeNames, RecDict, VarDict), - {t_product(L), R}; + TypeNames, ET, M, MR, V, D, L) -> + {T1, L1} = t_from_form(Content, TypeNames, ET, M, MR, V, D, L - 1), + {T2, L2} = t_from_form(Termination, TypeNames, ET, M, MR, V, D, L1), + {t_maybe_improper_list(T1, T2), L2}; +t_from_form({type, _L, product, Elements}, TypeNames, ET, M, MR, V, D, L) -> + {Lst, L1} = list_from_form(Elements, TypeNames, ET, M, MR, V, D - 1, L), + {t_product(Lst), L1}; t_from_form({type, _L, range, [From, To]} = Type, - _TypeNames, _RecDict, _VarDict) -> + _TypeNames, _ET, _M, _MR, _V, _D, L) -> case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of {{integer, _, FromVal}, {integer, _, ToVal}} -> - {t_from_range(FromVal, ToVal), []}; + {t_from_range(FromVal, ToVal), L}; _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Type])}) end; -t_from_form({type, _L, record, [Name|Fields]}, TypeNames, RecDict, VarDict) -> - record_from_form(Name, Fields, TypeNames, RecDict, VarDict); -t_from_form({type, _L, reference, []}, _TypeNames, _RecDict, _VarDict) -> - {t_reference(), []}; -t_from_form({type, _L, string, []}, _TypeNames, _RecDict, _VarDict) -> - {t_string(), []}; -t_from_form({type, _L, term, []}, _TypeNames, _RecDict, _VarDict) -> - {t_any(), []}; -t_from_form({type, _L, timeout, []}, _TypeNames, _RecDict, _VarDict) -> - {t_timeout(), []}; -t_from_form({type, _L, tuple, any}, _TypeNames, _RecDict, _VarDict) -> - {t_tuple(), []}; -t_from_form({type, _L, tuple, Args}, TypeNames, RecDict, VarDict) -> - {L, R} = list_from_form(Args, TypeNames, RecDict, VarDict), - {t_tuple(L), R}; -t_from_form({type, _L, union, Args}, TypeNames, RecDict, VarDict) -> - {L, R} = list_from_form(Args, TypeNames, RecDict, VarDict), - {t_sup(L), R}; -t_from_form({user_type, _L, Name, Args}, TypeNames, RecDict, VarDict) -> - type_from_form(Name, Args, TypeNames, RecDict, VarDict); -t_from_form({type, _L, Name, Args}, TypeNames, RecDict, VarDict) -> +t_from_form({type, _L, record, [Name|Fields]}, TypeNames, ET, M, MR, V, D, L) -> + record_from_form(Name, Fields, TypeNames, ET, M, MR, V, D, L); +t_from_form({type, _L, reference, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_reference(), L}; +t_from_form({type, _L, string, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_string(), L}; +t_from_form({type, _L, term, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_any(), L}; +t_from_form({type, _L, timeout, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_timeout(), L}; +t_from_form({type, _L, tuple, any}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {t_tuple(), L}; +t_from_form({type, _L, tuple, Args}, TypeNames, ET, M, MR, V, D, L) -> + {Lst, L1} = list_from_form(Args, TypeNames, ET, M, MR, V, D - 1, L), + {t_tuple(Lst), L1}; +t_from_form({type, _L, union, Args}, TypeNames, ET, M, MR, V, D, L) -> + {Lst, L1} = list_from_form(Args, TypeNames, ET, M, MR, V, D, L), + {t_sup(Lst), L1}; +t_from_form({user_type, _L, Name, Args}, TypeNames, ET, M, MR, V, D, L) -> + type_from_form(Name, Args, TypeNames, ET, M, MR, V, D, L); +t_from_form({type, _L, Name, Args}, TypeNames, ET, M, MR, V, D, L) -> %% Compatibility: modules compiled before Erlang/OTP 18.0. - type_from_form(Name, Args, TypeNames, RecDict, VarDict); + type_from_form(Name, Args, TypeNames, ET, M, MR, V, D, L); t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _TypeNames, - _RecDict, _VarDict) -> - {t_opaque(Mod, Name, Args, Rep), []}. - -builtin_type(Name, Type, TypeNames, RecDict, VarDict) -> - case lookup_type(Name, 0, RecDict) of - {_, {_M, _T, _A}} -> - type_from_form(Name, [], TypeNames, RecDict, VarDict); + _ET, _M, _MR, _V, _D, L) -> + %% XXX. To be removed. + {t_opaque(Mod, Name, Args, Rep), L}. + +builtin_type(Name, Type, TypeNames, ET, M, MR, V, D, L) -> + case dict:find(M, MR) of + {ok, R} -> + case lookup_type(Name, 0, R) of + {_, {{_M, _F, _A}, _T}} -> + type_from_form(Name, [], TypeNames, ET, M, MR, V, D, L); + error -> + {Type, L} + end; error -> - {Type, []} + {Type, L} end. -type_from_form(Name, Args, TypeNames, RecDict, VarDict) -> +type_from_form(Name, Args, TypeNames, ET, M, MR, V, D, L) -> ArgsLen = length(Args), - ArgTypes = forms_to_types(Args, TypeNames, RecDict, VarDict), - case lookup_type(Name, ArgsLen, RecDict) of - {type, {_Module, Type, ArgNames}} -> - TypeName = {type, Name, ArgsLen}, + {ArgTypes, L1} = list_from_form(Args, TypeNames, ET, M, MR, V, D, L), + {ok, R} = dict:find(M, MR), + case lookup_type(Name, ArgsLen, R) of + {type, {{Module, Form, ArgNames}, _Type}} -> + TypeName = {type, Module, Name, ArgsLen}, case can_unfold_more(TypeName, TypeNames) of true -> List = lists:zip(ArgNames, ArgTypes), - TmpVarDict = dict:from_list(List), - {T, R} = t_from_form(Type, [TypeName|TypeNames], - RecDict, TmpVarDict), - case lists:member(TypeName, R) of - true -> {t_limit(T, ?REC_TYPE_LIMIT), R}; - false -> {T, R} - end; - false -> {t_any(), [TypeName]} + TmpV = dict:from_list(List), + t_from_form(Form, [TypeName|TypeNames], ET, M, MR, TmpV, D, L1); + false -> + {t_any(), L1} end; - {opaque, {Module, Type, ArgNames}} -> - TypeName = {opaque, Name, ArgsLen}, - {Rep, Rret} = + {opaque, {{Module, Form, ArgNames}, Type}} -> + TypeName = {opaque, Module, Name, ArgsLen}, + {Rep, L2} = case can_unfold_more(TypeName, TypeNames) of true -> List = lists:zip(ArgNames, ArgTypes), - TmpVarDict = dict:from_list(List), - {T, R} = t_from_form(Type, [TypeName|TypeNames], - RecDict, TmpVarDict), - case lists:member(TypeName, R) of - true -> {t_limit(T, ?REC_TYPE_LIMIT), R}; - false -> {T, R} - end; - false -> {t_any(), [TypeName]} + TmpV = dict:from_list(List), + t_from_form(Form, [TypeName|TypeNames], ET, M, MR, TmpV, D, L1); + false -> {t_any(), L1} end, + Rep1 = choose_opaque_type(Rep, Type), Args2 = [subst_all_vars_to_any(ArgType) || ArgType <- ArgTypes], - {skip_opaque_alias(Rep, Module, Name, Args2), Rret}; + {skip_opaque_alias(Rep1, Module, Name, Args2), L2}; error -> Msg = io_lib:format("Unable to find type ~w/~w\n", [Name, ArgsLen]), throw({error, Msg}) end. -forms_to_types(Forms, TypeNames, RecDict, VarDict) -> - {Types, _} = list_from_form(Forms, TypeNames, RecDict, VarDict), - Types. - skip_opaque_alias(?opaque(_) = T, _Mod, _Name, _Args) -> T; skip_opaque_alias(T, Module, Name, Args) -> t_opaque(Module, Name, Args, T). -record_from_form({atom, _, Name}, ModFields, TypeNames, RecDict, VarDict) -> +remote_from_form(RemMod, Name, Args, TypeNames, ET, M, MR, V, D, L) -> + {ArgTypes, L1} = list_from_form(Args, TypeNames, ET, M, MR, V, D, L), + if + ET =:= replace_by_none -> + {t_none(), L1}; + true -> + ArgsLen = length(Args), + case dict:find(RemMod, MR) of + error -> + self() ! {self(), ext_types, {RemMod, Name, ArgsLen}}, + {t_any(), L1}; + {ok, RemDict} -> + MFA = {RemMod, Name, ArgsLen}, + case sets:is_element(MFA, ET) of + true -> + case lookup_type(Name, ArgsLen, RemDict) of + {type, {{_Mod, Form, ArgNames}, _Type}} -> + RemType = {type, RemMod, Name, ArgsLen}, + case can_unfold_more(RemType, TypeNames) of + true -> + List = lists:zip(ArgNames, ArgTypes), + TmpVarDict = dict:from_list(List), + NewTypeNames = [RemType|TypeNames], + t_from_form(Form, NewTypeNames, ET, + RemMod, MR, TmpVarDict, D, L1); + false -> + {t_any(), L1} + end; + {opaque, {{Mod, Form, ArgNames}, Type}} -> + RemType = {opaque, RemMod, Name, ArgsLen}, + List = lists:zip(ArgNames, ArgTypes), + TmpVarDict = dict:from_list(List), + {NewRep, L2} = + case can_unfold_more(RemType, TypeNames) of + true -> + NewTypeNames = [RemType|TypeNames], + t_from_form(Form, NewTypeNames, ET, RemMod, MR, + TmpVarDict, D, L1); + false -> + {t_any(), L1} + end, + NewRep1 = choose_opaque_type(NewRep, Type), + {skip_opaque_alias(NewRep1, Mod, Name, ArgTypes), L2}; + error -> + Msg = io_lib:format("Unable to find remote type ~w:~w()\n", + [RemMod, Name]), + throw({error, Msg}) + end; + false -> + self() ! {self(), ext_types, {RemMod, Name, ArgsLen}}, + {t_any(), L1} + end + end + end. + +%% Opaque types (both local and remote) are problematic when it comes +%% to the limits (TypeNames, D, and L). The reason is that if any() is +%% substituted for a more specialized subtype of an opaque type, the +%% property stated along with decorate_with_opaque() (the type has to +%% be a subtype of the declared type) no longer holds. +%% +%% The less than perfect remedy: if the opaque type created from a +%% form is not a subset of the declared type, the declared type is +%% used instead, effectively bypassing the limits, and potentially +%% resulting in huge types. +choose_opaque_type(Type, DeclType) -> + case + t_is_subtype(subst_all_vars_to_any(Type), + subst_all_vars_to_any(DeclType)) + of + true -> Type; + false -> DeclType + end. + +record_from_form({atom, _, Name}, ModFields, TypeNames, ET, M, MR, V, D, L) -> case can_unfold_more({record, Name}, TypeNames) of true -> - case lookup_record(Name, RecDict) of + {ok, R} = dict:find(M, MR), + case lookup_record(Name, R) of {ok, DeclFields} -> - TypeNames1 = [{record, Name}|TypeNames], - AreTyped = [is_erl_type(FieldType) - || {_FieldName, FieldType} <- DeclFields], - {DeclFields1, R1} = - case lists:all(fun(Elem) -> Elem end, AreTyped) of - true -> {DeclFields, []}; - false -> fields_from_form(DeclFields, TypeNames1, - RecDict, dict:new()) - end, - {GetModRec, R2} = get_mod_record(ModFields, DeclFields1, - TypeNames1, - RecDict, VarDict), + NewTypeNames = [{record, Name}|TypeNames], + {GetModRec, L1} = get_mod_record(ModFields, DeclFields, + NewTypeNames, ET, M, MR, V, D, L), case GetModRec of {error, FieldName} -> throw({error, io_lib:format("Illegal declaration of #~w{~w}\n", [Name, FieldName])}); {ok, NewFields} -> - {t_tuple( - [t_atom(Name)|[Type || {_FieldName, Type} <- NewFields]]), - R1 ++ R2} + {NewFields1, L2} = + fields_from_form(NewFields, NewTypeNames, ET, M, MR, + dict:new(), D, L1), + Rec = t_tuple( + [t_atom(Name)|[Type + || {_FieldName, Type} <- NewFields1]]), + {Rec, L2} end; error -> throw({error, io_lib:format("Unknown record #~w{}\n", [Name])}) end; - false -> {t_any(), []} + false -> + {t_any(), L} end. -get_mod_record([], DeclFields, _TypeNames, _RecDict, _VarDict) -> - {{ok, DeclFields}, []}; -get_mod_record(ModFields, DeclFields, TypeNames, RecDict, VarDict) -> - DeclFieldsDict = orddict:from_list(DeclFields), - {ModFieldsDict, R} = build_field_dict(ModFields, TypeNames, - RecDict, VarDict), - case get_mod_record(DeclFieldsDict, ModFieldsDict, []) of - {error, _FieldName} = Error -> {Error, R}; - {ok, FinalOrdDict} -> - {{ok, [{FieldName, orddict:fetch(FieldName, FinalOrdDict)} - || {FieldName, _} <- DeclFields]}, - R} +get_mod_record([], DeclFields, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {{ok, DeclFields}, L}; +get_mod_record(ModFields, DeclFields, TypeNames, ET, M, MR, V, D, L) -> + DeclFieldsDict = lists:keysort(1, DeclFields), + {ModFieldsDict, L1} = + build_field_dict(ModFields, TypeNames, ET, M, MR, V, D, L), + case get_mod_record_types(DeclFieldsDict, ModFieldsDict, []) of + {error, _FieldName} = Error -> {Error, L1}; + {ok, FinalKeyDict} -> + Fields = [lists:keyfind(FieldName, 1, FinalKeyDict) + || {FieldName, _, _} <- DeclFields], + {{ok, Fields}, L1} end. -build_field_dict(FieldTypes, TypeNames, RecDict, VarDict) -> - build_field_dict(FieldTypes, TypeNames, RecDict, VarDict, []). - -build_field_dict([{type, _, field_type, [{atom, _, Name}, Type]}|Left], - TypeNames, RecDict, VarDict, Acc) -> - {T, R1} = t_from_form(Type, TypeNames, RecDict, VarDict), - NewAcc = [{Name, T}|Acc], - {D, R2} = build_field_dict(Left, TypeNames, RecDict, VarDict, NewAcc), - {D, R1 ++ R2}; -build_field_dict([], _TypeNames, _RecDict, _VarDict, Acc) -> - {orddict:from_list(Acc), []}. - -get_mod_record([{FieldName, DeclType}|Left1], - [{FieldName, ModType}|Left2], Acc) -> - ModTypeNoVars = subst_all_vars_to_any(ModType), - case - contains_remote(ModTypeNoVars) - orelse contains_remote(DeclType) - orelse t_is_subtype(ModTypeNoVars, DeclType) - of +build_field_dict(FieldTypes, TypeNames, ET, M, MR, V, D, L) -> + build_field_dict(FieldTypes, TypeNames, ET, M, MR, V, D, L, []). + +build_field_dict([{type, _, field_type, [{atom, _, Name}, Type]}|Left], + TypeNames, ET, M, MR, V, D, L, Acc) -> + {T, L1} = t_from_form(Type, TypeNames, ET, M, MR, V, D, L - 1), + %% The cached record field type (DeclType) in + %% get_mod_record_types()), was created with a similar call as TT. + %% Using T for the subtype test does not work since any() is not + %% always a subset of the field type. + TT = t_from_form(Type, ET, M, MR, V), + NewAcc = [{Name, Type, T, TT}|Acc], + {Dict, L2} = + build_field_dict(Left, TypeNames, ET, M, MR, V, D, L1, NewAcc), + {Dict, L2}; +build_field_dict([], _TypeNames, _ET, _M, _MR, _V, _D, L, Acc) -> + {lists:keysort(1, Acc), L}. + +get_mod_record_types([{FieldName, _Abstr, DeclType}|Left1], + [{FieldName, TypeForm, ModType, ModTypeTest}|Left2], + Acc) -> + ModTypeNoVars = subst_all_vars_to_any(ModTypeTest), + case t_is_subtype(ModTypeNoVars, DeclType) of false -> {error, FieldName}; - true -> get_mod_record(Left1, Left2, [{FieldName, ModType}|Acc]) + true -> get_mod_record_types(Left1, Left2, + [{FieldName, TypeForm, ModType}|Acc]) end; -get_mod_record([{FieldName1, _DeclType} = DT|Left1], - [{FieldName2, _ModType}|_] = List2, - Acc) when FieldName1 < FieldName2 -> - get_mod_record(Left1, List2, [DT|Acc]); -get_mod_record(DeclFields, [], Acc) -> - {ok, orddict:from_list(Acc ++ DeclFields)}; -get_mod_record(_, [{FieldName2, _ModType}|_], _Acc) -> +get_mod_record_types([{FieldName1, _Abstr, _DeclType} = DT|Left1], + [{FieldName2, _FormType, _ModType, _TT}|_] = List2, + Acc) when FieldName1 < FieldName2 -> + get_mod_record_types(Left1, List2, [DT|Acc]); +get_mod_record_types(Left1, [], Acc) -> + {ok, lists:keysort(1, Left1++Acc)}; +get_mod_record_types(_, [{FieldName2, _FormType, _ModType, _TT}|_], _Acc) -> {error, FieldName2}. -contains_remote(Type) -> - TypeNoRemote = subst_all_remote(Type, t_none()), - not t_is_equal(Type, TypeNoRemote). - -fields_from_form([], _TypeNames, _RecDict, _VarDict) -> - {[], []}; -fields_from_form([{Name, Type}|Tail], TypeNames, RecDict, - VarDict) -> - {T, R1} = t_from_form(Type, TypeNames, RecDict, VarDict), - {F, R2} = fields_from_form(Tail, TypeNames, RecDict, VarDict), - {[{Name, T}|F], R1 ++ R2}. - -list_from_form([], _TypeNames, _RecDict, _VarDict) -> - {[], []}; -list_from_form([H|Tail], TypeNames, RecDict, VarDict) -> - {T, R1} = t_from_form(H, TypeNames, RecDict, VarDict), - {L, R2} = list_from_form(Tail, TypeNames, RecDict, VarDict), - {[T|L], R1 ++ R2}. +%% It is important to create a limited version of the record type +%% since nested record types can otherwise easily result in huge +%% terms. +fields_from_form([], _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {[], L}; +fields_from_form([{Name, Abstr, _Type}|Tail], TypeNames, ET, M, MR, + V, D, L) -> + {T, L1} = t_from_form(Abstr, TypeNames, ET, M, MR, V, D, L), + {F, L2} = fields_from_form(Tail, TypeNames, ET, M, MR, V, D, L1), + {[{Name, T}|F], L2}. + +list_from_form([], _TypeNames, _ET, _M, _MR, _V, _D, L) -> + {[], L}; +list_from_form([H|Tail], TypeNames, ET, M, MR, V, D, L) -> + {H1, L1} = t_from_form(H, TypeNames, ET, M, MR, V, D, L - 1), + {T1, L2} = list_from_form(Tail, TypeNames, ET, M, MR, V, D, L1), + {[H1|T1], L2}. + +-spec t_var_names([erl_type()]) -> [atom()]. + +t_var_names([{var, _, Name}|L]) when L =/= '_' -> + [Name|t_var_names(L)]; +t_var_names([]) -> + []. -spec t_form_to_string(parse_form()) -> string(). @@ -4505,7 +4504,13 @@ t_form_to_string({type, _L, tuple, Args}) -> t_form_to_string({type, _L, union, Args}) -> string:join(t_form_to_string_list(Args), " | "); t_form_to_string({type, _L, Name, []} = T) -> - try t_to_string(t_from_form(T)) + try + M = mod, + D0 = dict:new(), + MR = dict:from_list([{M, D0}]), + {T1, _} = + t_from_form(T, [], sets:new(), M, MR, D0, _Deep=1000, _ALot=100000), + t_to_string(T1) catch throw:{error, _} -> atom_to_string(Name) ++ "()" end; t_form_to_string({user_type, _L, Name, List}) -> @@ -4556,7 +4561,7 @@ is_erl_type(#c{}) -> true; is_erl_type(_) -> false. -spec lookup_record(atom(), type_table()) -> - 'error' | {'ok', [{atom(), parse_form() | erl_type()}]}. + 'error' | {'ok', [{atom(), parse_form(), erl_type()}]}. lookup_record(Tag, RecDict) when is_atom(Tag) -> case dict:find({record, Tag}, RecDict) of @@ -4571,7 +4576,7 @@ lookup_record(Tag, RecDict) when is_atom(Tag) -> end. -spec lookup_record(atom(), arity(), type_table()) -> - 'error' | {'ok', [{atom(), erl_type()}]}. + 'error' | {'ok', [{atom(), parse_form(), erl_type()}]}. lookup_record(Tag, Arity, RecDict) when is_atom(Tag) -> case dict:find({record, Tag}, RecDict) of |