diff options
Diffstat (limited to 'lib/stdlib/src')
86 files changed, 14776 insertions, 7500 deletions
diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index 14304824d3..302834f9d0 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2012. All Rights Reserved. +# Copyright Ericsson AB 1996-2016. 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/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# 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. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -58,6 +59,7 @@ MODULES= \ edlin \ edlin_expand \ epp \ + erl_anno \ erl_bits \ erl_compile \ erl_eval \ @@ -83,6 +85,7 @@ MODULES= \ gen_event \ gen_fsm \ gen_server \ + gen_statem \ io \ io_lib \ io_lib_format \ @@ -91,12 +94,12 @@ MODULES= \ lib \ lists \ log_mf_h \ + maps \ math \ ms_transform \ otp_internal \ orddict \ ordsets \ - pg \ re \ pool \ proc_lib \ @@ -104,6 +107,7 @@ MODULES= \ qlc \ qlc_pt \ queue \ + rand \ random \ sets \ shell \ @@ -120,6 +124,7 @@ MODULES= \ zip HRL_FILES= \ + ../include/assert.hrl \ ../include/erl_compile.hrl \ ../include/erl_bits.hrl \ ../include/ms_transform.hrl \ @@ -149,7 +154,7 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE) ifeq ($(NATIVE_LIBS_ENABLED),yes) ERL_COMPILE_FLAGS += +native endif -ERL_COMPILE_FLAGS += -I../include -I../../kernel/include +ERL_COMPILE_FLAGS += -I../include -I../../kernel/include -Werror # ---------------------------------------------------- # Targets @@ -168,30 +173,33 @@ docs: # specifications. primary_bootstrap_compiler: \ $(BOOTSTRAP_COMPILER)/ebin/epp.beam \ + $(BOOTSTRAP_COMPILER)/ebin/erl_anno.beam \ $(BOOTSTRAP_COMPILER)/ebin/erl_scan.beam \ $(BOOTSTRAP_COMPILER)/ebin/erl_parse.beam \ $(BOOTSTRAP_COMPILER)/ebin/erl_lint.beam \ + $(BOOTSTRAP_COMPILER)/ebin/io.beam \ $(BOOTSTRAP_COMPILER)/ebin/otp_internal.beam $(BOOTSTRAP_COMPILER)/ebin/erl_parse.beam: erl_parse.yrl - $(ERLC) -o $(BOOTSTRAP_COMPILER)/egen erl_parse.yrl - $(ERLC) -o $(BOOTSTRAP_COMPILER)/ebin $(BOOTSTRAP_COMPILER)/egen/erl_parse.erl + $(gen_verbose) + $(V_at)$(ERLC) -o $(BOOTSTRAP_COMPILER)/egen erl_parse.yrl + $(V_at)$(ERLC) -o $(BOOTSTRAP_COMPILER)/ebin $(BOOTSTRAP_COMPILER)/egen/erl_parse.erl $(BOOTSTRAP_TOP)/lib/stdlib/egen/erl_parse.erl: erl_parse.yrl - $(ERLC) $(YRL_FLAGS) -o$(BOOTSTRAP_TOP)/lib/stdlib/egen erl_parse.yrl + $(yecc_verbose)$(ERLC) $(YRL_FLAGS) -o$(BOOTSTRAP_TOP)/lib/stdlib/egen erl_parse.yrl $(BOOTSTRAP_COMPILER)/ebin/%.beam: %.erl - $(ERLC) -o $(BOOTSTRAP_COMPILER)/ebin $< + $(V_ERLC) -o $(BOOTSTRAP_COMPILER)/ebin $< # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- $(APP_TARGET): $(APP_SRC) ../vsn.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ + $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ $(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ + $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ # ---------------------------------------------------- # Release Target diff --git a/lib/stdlib/src/array.erl b/lib/stdlib/src/array.erl index 2f69e2b0a4..d5757dda5b 100644 --- a/lib/stdlib/src/array.erl +++ b/lib/stdlib/src/array.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2011. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -86,6 +87,8 @@ foldr/3, sparse_foldl/3, sparse_foldr/3, fix/1, relax/1, is_fix/1, resize/1, resize/2]). +-export_type([array/0, array/1]). + %%-define(TEST,1). -ifdef(TEST). -include_lib("eunit/include/eunit.hrl"). @@ -144,18 +147,28 @@ %%-------------------------------------------------------------------------- +-type element_tuple(T) :: + {T, T, T, T, T, T, T, T, T, T} + | {element_tuple(T), element_tuple(T), element_tuple(T), + element_tuple(T), element_tuple(T), element_tuple(T), + element_tuple(T), element_tuple(T), element_tuple(T), + element_tuple(T), non_neg_integer()}. + +-type elements(T) :: non_neg_integer() + | element_tuple(T) + | nil(). % kill reference, for GC + -record(array, {size :: non_neg_integer(), %% number of defined entries max :: non_neg_integer(), %% maximum number of entries %% in current tree default, %% the default value (usually 'undefined') - elements %% the tuple tree + elements :: elements(_) %% the tuple tree }). -%% A declaration equivalent to the following one is hard-coded in erl_types. -%% That declaration contains hard-coded information about the #array{} -%% structure and the types of its fields. So, please make sure that any -%% changes to its structure are also propagated to erl_types.erl. -%% -%% -opaque array() :: #array{}. + +-type array() :: array(term()). + +-opaque array(Type) :: + #array{default :: Type, elements :: elements(Type)}. %% %% Types @@ -164,13 +177,13 @@ -type array_indx() :: non_neg_integer(). -type array_opt() :: {'fixed', boolean()} | 'fixed' - | {'default', Value :: term()} + | {'default', Type :: term()} | {'size', N :: non_neg_integer()} | (N :: non_neg_integer()). -type array_opts() :: array_opt() | [array_opt()]. --type indx_pair() :: {Index :: array_indx(), Value :: term()}. --type indx_pairs() :: [indx_pair()]. +-type indx_pair(Type) :: {Index :: array_indx(), Type}. +-type indx_pairs(Type) :: [indx_pair(Type)]. %%-------------------------------------------------------------------------- @@ -321,7 +334,7 @@ size(_) -> erlang:error(badarg). %% %% @see new/2 --spec default(Array :: array()) -> term(). +-spec default(Array :: array(Type)) -> Value :: Type. default(#array{default = D}) -> D; default(_) -> erlang:error(badarg). @@ -404,7 +417,7 @@ new_test_() -> %% automatically upon insertion; see also {@link set/3}. %% @see relax/1 --spec fix(Array :: array()) -> array(). +-spec fix(Array :: array(Type)) -> array(Type). fix(#array{}=A) -> A#array{max = 0}. @@ -452,7 +465,7 @@ fix_test_() -> %% fix/1}.) %% @see fix/1 --spec relax(Array :: array()) -> array(). +-spec relax(Array :: array(Type)) -> array(Type). relax(#array{size = N}=A) -> A#array{max = find_max(N-1, ?LEAFSIZE)}. @@ -477,7 +490,8 @@ relax_test_() -> %% integer, the call fails with reason `badarg'. If the given array has %% fixed size, the resulting array will also have fixed size. --spec resize(Size :: non_neg_integer(), Array :: array()) -> array(). +-spec resize(Size :: non_neg_integer(), Array :: array(Type)) -> + array(Type). resize(Size, #array{size = N, max = M, elements = E}=A) when is_integer(Size), Size >= 0 -> @@ -508,7 +522,7 @@ resize(_Size, _) -> %% @see resize/2 %% @see sparse_size/1 --spec resize(Array :: array()) -> array(). +-spec resize(Array :: array(Type)) -> array(Type). resize(Array) -> resize(sparse_size(Array), Array). @@ -558,7 +572,7 @@ resize_test_() -> %% @see get/2 %% @see reset/2 --spec set(I :: array_indx(), Value :: term(), Array :: array()) -> array(). +-spec set(I :: array_indx(), Value :: Type, Array :: array(Type)) -> array(Type). set(I, Value, #array{size = N, max = M, default = D, elements = E}=A) when is_integer(I), I >= 0 -> @@ -621,7 +635,7 @@ expand(I, _S, X, D) -> %% @see set/3 --spec get(I :: array_indx(), Array :: array()) -> term(). +-spec get(I :: array_indx(), Array :: array(Type)) -> Value :: Type. get(I, #array{size = N, max = M, elements = E, default = D}) when is_integer(I), I >= 0 -> @@ -661,7 +675,7 @@ get_1(I, E, _D) -> %% TODO: a reset_range function --spec reset(I :: array_indx(), Array :: array()) -> array(). +-spec reset(I :: array_indx(), Array :: array(Type)) -> array(Type). reset(I, #array{size = N, max = M, default = D, elements = E}=A) when is_integer(I), I >= 0 -> @@ -747,7 +761,7 @@ set_get_test_() -> %% @see from_list/2 %% @see sparse_to_list/1 --spec to_list(Array :: array()) -> list(). +-spec to_list(Array :: array(Type)) -> list(Value :: Type). to_list(#array{size = 0}) -> []; @@ -820,7 +834,7 @@ to_list_test_() -> %% %% @see to_list/1 --spec sparse_to_list(Array :: array()) -> list(). +-spec sparse_to_list(Array :: array(Type)) -> list(Value :: Type). sparse_to_list(#array{size = 0}) -> []; @@ -887,7 +901,7 @@ sparse_to_list_test_() -> %% @equiv from_list(List, undefined) --spec from_list(List :: list()) -> array(). +-spec from_list(List :: list(Value :: Type)) -> array(Type). from_list(List) -> from_list(List, undefined). @@ -899,7 +913,7 @@ from_list(List) -> %% @see new/2 %% @see to_list/1 --spec from_list(List :: list(), Default :: term()) -> array(). +-spec from_list(List :: list(Value :: Type), Default :: term()) -> array(Type). from_list([], Default) -> new({default,Default}); @@ -998,7 +1012,7 @@ from_list_test_() -> %% @see from_orddict/2 %% @see sparse_to_orddict/1 --spec to_orddict(Array :: array()) -> indx_pairs(). +-spec to_orddict(Array :: array(Type)) -> indx_pairs(Value :: Type). to_orddict(#array{size = 0}) -> []; @@ -1035,16 +1049,16 @@ to_orddict_3(N, R, D, L, E, S) -> to_orddict_2(element(N, E), R, D, L), E, S). --spec push_pairs(non_neg_integer(), array_indx(), term(), indx_pairs()) -> - indx_pairs(). +-spec push_pairs(non_neg_integer(), array_indx(), term(), indx_pairs(Type)) -> + indx_pairs(Type). push_pairs(0, _I, _E, L) -> L; push_pairs(N, I, E, L) -> push_pairs(N-1, I-1, E, [{I, E} | L]). --spec push_tuple_pairs(non_neg_integer(), array_indx(), term(), indx_pairs()) -> - indx_pairs(). +-spec push_tuple_pairs(non_neg_integer(), array_indx(), term(), indx_pairs(Type)) -> + indx_pairs(Type). push_tuple_pairs(0, _I, _T, L) -> L; @@ -1090,7 +1104,7 @@ to_orddict_test_() -> %% %% @see to_orddict/1 --spec sparse_to_orddict(Array :: array()) -> indx_pairs(). +-spec sparse_to_orddict(Array :: array(Type)) -> indx_pairs(Value :: Type). sparse_to_orddict(#array{size = 0}) -> []; @@ -1128,7 +1142,7 @@ sparse_to_orddict_3(N, R, D, L, E, S) -> E, S). -spec sparse_push_tuple_pairs(non_neg_integer(), array_indx(), - _, _, indx_pairs()) -> indx_pairs(). + _, _, indx_pairs(Type)) -> indx_pairs(Type). sparse_push_tuple_pairs(0, _I, _D, _T, L) -> L; @@ -1170,7 +1184,7 @@ sparse_to_orddict_test_() -> %% @equiv from_orddict(Orddict, undefined) --spec from_orddict(Orddict :: indx_pairs()) -> array(). +-spec from_orddict(Orddict :: indx_pairs(Value :: Type)) -> array(Type). from_orddict(Orddict) -> from_orddict(Orddict, undefined). @@ -1184,7 +1198,8 @@ from_orddict(Orddict) -> %% @see new/2 %% @see to_orddict/1 --spec from_orddict(Orddict :: indx_pairs(), Default :: term()) -> array(). +-spec from_orddict(Orddict :: indx_pairs(Value :: Type), Default :: Type) -> + array(Type). from_orddict([], Default) -> new({default,Default}); @@ -1379,8 +1394,8 @@ from_orddict_test_() -> %% @see foldr/3 %% @see sparse_map/2 --spec map(Function, Array :: array()) -> array() when - Function :: fun((Index :: array_indx(), Value :: _) -> _). +-spec map(Function, Array :: array(Type1)) -> array(Type2) when + Function :: fun((Index :: array_indx(), Type1) -> Type2). map(Function, Array=#array{size = N, elements = E, default = D}) when is_function(Function, 2) -> @@ -1471,8 +1486,8 @@ map_test_() -> %% %% @see map/2 --spec sparse_map(Function, Array :: array()) -> array() when - Function :: fun((Index :: array_indx(), Value :: _) -> _). +-spec sparse_map(Function, Array :: array(Type1)) -> array(Type2) when + Function :: fun((Index :: array_indx(), Type1) -> Type2). sparse_map(Function, Array=#array{size = N, elements = E, default = D}) when is_function(Function, 2) -> @@ -1567,8 +1582,8 @@ sparse_map_test_() -> %% @see map/2 %% @see sparse_foldl/3 --spec foldl(Function, InitialAcc :: A, Array :: array()) -> B when - Function :: fun((Index :: array_indx(), Value :: _, Acc :: A) -> B). +-spec foldl(Function, InitialAcc :: A, Array :: array(Type)) -> B when + Function :: fun((Index :: array_indx(), Value :: Type, Acc :: A) -> B). foldl(Function, A, #array{size = N, elements = E, default = D}) when is_function(Function, 3) -> @@ -1640,8 +1655,8 @@ foldl_test_() -> %% @see foldl/3 %% @see sparse_foldr/3 --spec sparse_foldl(Function, InitialAcc :: A, Array :: array()) -> B when - Function :: fun((Index :: array_indx(), Value :: _, Acc :: A) -> B). +-spec sparse_foldl(Function, InitialAcc :: A, Array :: array(Type)) -> B when + Function :: fun((Index :: array_indx(), Value :: Type, Acc :: A) -> B). sparse_foldl(Function, A, #array{size = N, elements = E, default = D}) when is_function(Function, 3) -> @@ -1717,8 +1732,8 @@ sparse_foldl_test_() -> %% @see foldl/3 %% @see map/2 --spec foldr(Function, InitialAcc :: A, Array :: array()) -> B when - Function :: fun((Index :: array_indx(), Value :: _, Acc :: A) -> B). +-spec foldr(Function, InitialAcc :: A, Array :: array(Type)) -> B when + Function :: fun((Index :: array_indx(), Value :: Type, Acc :: A) -> B). foldr(Function, A, #array{size = N, elements = E, default = D}) when is_function(Function, 3) -> @@ -1796,8 +1811,8 @@ foldr_test_() -> %% @see foldr/3 %% @see sparse_foldl/3 --spec sparse_foldr(Function, InitialAcc :: A, Array :: array()) -> B when - Function :: fun((Index :: array_indx(), Value :: _, Acc :: A) -> B). +-spec sparse_foldr(Function, InitialAcc :: A, Array :: array(Type)) -> B when + Function :: fun((Index :: array_indx(), Value :: Type, Acc :: A) -> B). sparse_foldr(Function, A, #array{size = N, elements = E, default = D}) when is_function(Function, 3) -> diff --git a/lib/stdlib/src/base64.erl b/lib/stdlib/src/base64.erl index 5d800e87b8..bf259e6691 100644 --- a/lib/stdlib/src/base64.erl +++ b/lib/stdlib/src/base64.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2011. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -29,6 +30,7 @@ %%------------------------------------------------------------------------- -type ascii_string() :: [1..255]. +-type ascii_binary() :: binary(). %%------------------------------------------------------------------------- %% encode_to_string(ASCII) -> Base64String @@ -39,7 +41,7 @@ %%------------------------------------------------------------------------- -spec encode_to_string(Data) -> Base64String when - Data :: string() | binary(), + Data :: ascii_string() | ascii_binary(), Base64String :: ascii_string(). encode_to_string(Bin) when is_binary(Bin) -> @@ -56,15 +58,15 @@ encode_to_string(List) when is_list(List) -> %%------------------------------------------------------------------------- -spec encode(Data) -> Base64 when - Data :: string() | binary(), - Base64 :: binary(). + Data :: ascii_string() | ascii_binary(), + Base64 :: ascii_binary(). encode(Bin) when is_binary(Bin) -> encode_binary(Bin); encode(List) when is_list(List) -> list_to_binary(encode_l(List)). --spec encode_l(string()) -> ascii_string(). +-spec encode_l(ascii_string()) -> ascii_string(). encode_l([]) -> []; @@ -107,8 +109,8 @@ encode_binary(Bin) -> %%------------------------------------------------------------------------- -spec decode(Base64) -> Data when - Base64 :: string() | binary(), - Data :: binary(). + Base64 :: ascii_string() | ascii_binary(), + Data :: ascii_binary(). decode(Bin) when is_binary(Bin) -> decode_binary(<<>>, Bin); @@ -116,21 +118,21 @@ decode(List) when is_list(List) -> list_to_binary(decode_l(List)). -spec mime_decode(Base64) -> Data when - Base64 :: string() | binary(), - Data :: binary(). + Base64 :: ascii_string() | ascii_binary(), + Data :: ascii_binary(). mime_decode(Bin) when is_binary(Bin) -> mime_decode_binary(<<>>, Bin); mime_decode(List) when is_list(List) -> mime_decode(list_to_binary(List)). --spec decode_l(string()) -> string(). +-spec decode_l(ascii_string()) -> ascii_string(). decode_l(List) -> L = strip_spaces(List, []), decode(L, []). --spec mime_decode_l(string()) -> string(). +-spec mime_decode_l(ascii_string()) -> ascii_string(). mime_decode_l(List) -> L = strip_illegal(List, [], 0), @@ -148,8 +150,8 @@ mime_decode_l(List) -> %%------------------------------------------------------------------------- -spec decode_to_string(Base64) -> DataString when - Base64 :: string() | binary(), - DataString :: string(). + Base64 :: ascii_string() | ascii_binary(), + DataString :: ascii_string(). decode_to_string(Bin) when is_binary(Bin) -> decode_to_string(binary_to_list(Bin)); @@ -157,8 +159,8 @@ decode_to_string(List) when is_list(List) -> decode_l(List). -spec mime_decode_to_string(Base64) -> DataString when - Base64 :: string() | binary(), - DataString :: string(). + Base64 :: ascii_string() | ascii_binary(), + DataString :: ascii_string(). mime_decode_to_string(Bin) when is_binary(Bin) -> mime_decode_to_string(binary_to_list(Bin)); diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index e9a5e6831e..d7ee5c1f5d 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2011. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -45,7 +46,7 @@ terminate/2,code_change/3]). -export([make_crypto_key/2, get_crypto_key/1]). %Utilities used by compiler --export_type([attrib_entry/0, compinfo_entry/0, labeled_entry/0]). +-export_type([attrib_entry/0, compinfo_entry/0, labeled_entry/0, label/0]). -import(lists, [append/1, delete/2, foreach/2, keysort/2, member/2, reverse/1, sort/1, splitwith/2]). @@ -54,7 +55,7 @@ -type beam() :: module() | file:filename() | binary(). --type forms() :: [erl_parse:abstract_form()]. +-type forms() :: [erl_parse:abstract_form() | erl_parse:form_info()]. -type abst_code() :: {AbstVersion :: atom(), forms()} | 'no_abstract_code'. -type dataB() :: binary(). @@ -240,21 +241,21 @@ format_error({error, Error}) -> format_error({error, Module, Error}) -> Module:format_error(Error); format_error({unknown_chunk, File, ChunkName}) -> - io_lib:format("~p: Cannot find chunk ~p~n", [File, ChunkName]); + io_lib:format("~tp: Cannot find chunk ~p~n", [File, ChunkName]); format_error({invalid_chunk, File, ChunkId}) -> - io_lib:format("~p: Invalid contents of chunk ~p~n", [File, ChunkId]); + io_lib:format("~tp: Invalid contents of chunk ~p~n", [File, ChunkId]); format_error({not_a_beam_file, File}) -> - io_lib:format("~p: Not a BEAM file~n", [File]); + io_lib:format("~tp: Not a BEAM file~n", [File]); format_error({file_error, File, Reason}) -> - io_lib:format("~p: ~p~n", [File, file:format_error(Reason)]); + io_lib:format("~tp: ~tp~n", [File, file:format_error(Reason)]); format_error({missing_chunk, File, ChunkId}) -> - io_lib:format("~p: Not a BEAM file: no IFF \"~s\" chunk~n", + io_lib:format("~tp: Not a BEAM file: no IFF \"~s\" chunk~n", [File, ChunkId]); format_error({invalid_beam_file, File, Pos}) -> - io_lib:format("~p: Invalid format of BEAM file near byte number ~p~n", + io_lib:format("~tp: Invalid format of BEAM file near byte number ~p~n", [File, Pos]); format_error({chunk_too_big, File, ChunkId, Size, Len}) -> - io_lib:format("~p: Size of chunk \"~s\" is ~p bytes, " + io_lib:format("~tp: Size of chunk \"~s\" is ~p bytes, " "but only ~p bytes could be read~n", [File, ChunkId, Size, Len]); format_error({chunks_different, Id}) -> @@ -265,16 +266,16 @@ format_error({modules_different, Module1, Module2}) -> io_lib:format("Module names ~p and ~p differ in the two files~n", [Module1, Module2]); format_error({not_a_directory, Name}) -> - io_lib:format("~p: Not a directory~n", [Name]); + io_lib:format("~tp: Not a directory~n", [Name]); format_error({key_missing_or_invalid, File, abstract_code}) -> - io_lib:format("~p: Cannot decrypt abstract code because key is missing or invalid", + io_lib:format("~tp: Cannot decrypt abstract code because key is missing or invalid", [File]); format_error(badfun) -> "not a fun or the fun has the wrong arity"; format_error(exists) -> "a fun has already been installed"; format_error(E) -> - io_lib:format("~p~n", [E]). + io_lib:format("~tp~n", [E]). %% %% Exported functions for encrypted debug info. @@ -300,12 +301,23 @@ clear_crypto_key_fun() -> call_crypto_server(clear_crypto_key_fun). -spec make_crypto_key(mode(), string()) -> - {binary(), binary(), binary(), binary()}. + {mode(), [binary()], binary(), integer()}. -make_crypto_key(des3_cbc, String) -> +make_crypto_key(des3_cbc=Type, String) -> <<K1:8/binary,K2:8/binary>> = First = erlang:md5(String), <<K3:8/binary,IVec:8/binary>> = erlang:md5([First|reverse(String)]), - {K1,K2,K3,IVec}. + {Type,[K1,K2,K3],IVec,8}. + +-spec build_module(Chunks) -> {'ok', Binary} when + Chunks :: [{chunkid(), dataB()}], + Binary :: binary(). + +build_module(Chunks0) -> + Chunks = list_to_binary(build_chunks(Chunks0)), + Size = byte_size(Chunks), + 0 = Size rem 4, % Assertion: correct padding? + {ok, <<"FOR1", (Size+4):32, "BEAM", Chunks/binary>>}. + %% %% Local functions @@ -324,13 +336,13 @@ diff_directories(Dir1, Dir2) -> {OnlyDir1, OnlyDir2, Diff} = compare_dirs(Dir1, Dir2), diff_only(Dir1, OnlyDir1), diff_only(Dir2, OnlyDir2), - foreach(fun(D) -> io:format("** different: ~p~n", [D]) end, Diff), + foreach(fun(D) -> io:format("** different: ~tp~n", [D]) end, Diff), ok. diff_only(_Dir, []) -> ok; diff_only(Dir, Only) -> - io:format("Only in ~p: ~p~n", [Dir, Only]). + io:format("Only in ~tp: ~tp~n", [Dir, Only]). %% -> {OnlyInDir1, OnlyInDir2, Different} | throw(Error) compare_dirs(Dir1, Dir2) -> @@ -418,12 +430,6 @@ strip_file(File) -> end end. -build_module(Chunks0) -> - Chunks = list_to_binary(build_chunks(Chunks0)), - Size = byte_size(Chunks), - 0 = Size rem 4, % Assertion: correct padding? - {ok, <<"FOR1", (Size+4):32, "BEAM", Chunks/binary>>}. - build_chunks([{Id, Data} | Chunks]) -> BId = list_to_binary(Id), Size = byte_size(Data), @@ -652,7 +658,13 @@ chunk_to_data(abstract_code=Id, Chunk, File, _Cs, AtomTable, Mod) -> {'EXIT', _} -> error({invalid_chunk, File, chunk_name_to_id(Id, File)}); Term -> - {AtomTable, {Id, Term}} + try + {AtomTable, {Id, anno_from_term(Term)}} + catch + _:_ -> + error({invalid_chunk, File, + chunk_name_to_id(Id, File)}) + end end end; chunk_to_data(atoms=Id, _Chunk, _File, Cs, AtomTable0, _Mod) -> @@ -860,25 +872,44 @@ mandatory_chunks() -> %%% can use it. %%% ==================================================================== --record(state, {crypto_key_f :: crypto_fun()}). +-record(state, {crypto_key_f :: crypto_fun() | 'undefined'}). -define(CRYPTO_KEY_SERVER, beam_lib__crypto_key_server). -decrypt_abst(Mode, Module, File, Id, AtomTable, Bin) -> +decrypt_abst(Type, Module, File, Id, AtomTable, Bin) -> try - KeyString = get_crypto_key({debug_info, Mode, Module, File}), - Key = make_crypto_key(des3_cbc, KeyString), - Term = decrypt_abst_1(Mode, Key, Bin), + KeyString = get_crypto_key({debug_info, Type, Module, File}), + Key = make_crypto_key(Type, KeyString), + Term = decrypt_abst_1(Key, Bin), {AtomTable, {Id, Term}} catch _:_ -> error({key_missing_or_invalid, File, Id}) end. -decrypt_abst_1(des3_cbc, {K1, K2, K3, IVec}, Bin) -> +decrypt_abst_1({Type,Key,IVec,_BlockSize}, Bin) -> ok = start_crypto(), - NewBin = crypto:des3_cbc_decrypt(K1, K2, K3, IVec, Bin), - binary_to_term(NewBin). + NewBin = crypto:block_decrypt(Type, Key, IVec, Bin), + Term = binary_to_term(NewBin), + anno_from_term(Term). + +anno_from_term({raw_abstract_v1, Forms}) -> + {raw_abstract_v1, anno_from_forms(Forms)}; +anno_from_term({Tag, Forms}) when Tag =:= abstract_v1; Tag =:= abstract_v2 -> + try {Tag, anno_from_forms(Forms)} + catch + _:_ -> + {Tag, Forms} + end; +anno_from_term(T) -> + T. + +anno_from_forms(Forms0) -> + %% Forms with record field types created before OTP 19.0 are + %% replaced by well-formed record forms holding the type + %% information. + Forms = epp:restore_typed_record_fields(Forms0), + [erl_parse:anno_from_term(Form) || Form <- Forms]. start_crypto() -> case crypto:start() of @@ -904,7 +935,10 @@ call_crypto_server(Req) -> end. call_crypto_server_1(Req) -> - gen_server:start({local,?CRYPTO_KEY_SERVER}, ?MODULE, [], []), + case gen_server:start({local,?CRYPTO_KEY_SERVER}, ?MODULE, [], []) of + {ok, _} -> ok; + {error, {already_started, _}} -> ok + end, erlang:yield(), call_crypto_server(Req). @@ -945,9 +979,7 @@ handle_call({get_crypto_key, What}, From, #state{crypto_key_f=F}=S) -> handle_call({crypto_key_fun, F}, {_,_} = From, S) -> case S#state.crypto_key_f of undefined -> - %% Don't allow tuple funs here. (They weren't allowed before, - %% so there is no reason to allow them now.) - if is_function(F), is_function(F, 1) -> + if is_function(F, 1) -> {Result, Fun, Reply} = case catch F(init) of ok -> @@ -1030,11 +1062,11 @@ f_p_s(P, F) -> {error, enoent} -> {error, enoent}; {error, {Line, _Mod, _Term}=E} -> - error("file:path_script(~p,~p): error on line ~p: ~s~n", + error("file:path_script(~tp,~tp): error on line ~p: ~ts~n", [P, F, Line, file:format_error(E)]), ok; {error, E} when is_atom(E) -> - error("file:path_script(~p,~p): ~s~n", + error("file:path_script(~tp,~tp): ~ts~n", [P, F, file:format_error(E)]), ok; Other -> diff --git a/lib/stdlib/src/binary.erl b/lib/stdlib/src/binary.erl index cb1e12ae46..ccc827ca2d 100644 --- a/lib/stdlib/src/binary.erl +++ b/lib/stdlib/src/binary.erl @@ -1,107 +1,223 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(binary). %% -%% The following functions implemented as BIF's -%% binary:compile_pattern/1 -%% binary:match/{2,3} -%% binary:matches/{2,3} -%% binary:longest_common_prefix/1 -%% binary:longest_common_suffix/1 -%% binary:first/1 -%% binary:last/1 -%% binary:at/2 -%% binary:part/{2,3} -%% binary:bin_to_list/{1,2,3} -%% binary:list_to_bin/1 -%% binary:copy/{1,2} -%% binary:referenced_byte_size/1 -%% binary:decode_unsigned/{1,2} -%% - Not yet: -%% %% Implemented in this module: --export([split/2,split/3,replace/3,replace/4]). +-export([replace/3,replace/4]). + +-export_type([cp/0]). --opaque cp() :: tuple(). +-opaque cp() :: {'am' | 'bm', binary()}. -type part() :: {Start :: non_neg_integer(), Length :: integer()}. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% split -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% BIFs. + +-export([at/2, bin_to_list/1, bin_to_list/2, bin_to_list/3, + compile_pattern/1, copy/1, copy/2, decode_unsigned/1, + decode_unsigned/2, encode_unsigned/1, encode_unsigned/2, + first/1, last/1, list_to_bin/1, longest_common_prefix/1, + longest_common_suffix/1, match/2, match/3, matches/2, + matches/3, part/2, part/3, referenced_byte_size/1, + split/2, split/3]). + +-spec at(Subject, Pos) -> byte() when + Subject :: binary(), + Pos :: non_neg_integer(). + +at(_, _) -> + erlang:nif_error(undef). + +-spec bin_to_list(Subject) -> [byte()] when + Subject :: binary(). + +bin_to_list(_) -> + erlang:nif_error(undef). + +-spec bin_to_list(Subject, PosLen) -> [byte()] when + Subject :: binary(), + PosLen :: part(). + +bin_to_list(_, _) -> + erlang:nif_error(undef). + +-spec bin_to_list(Subject, Pos, Len) -> [byte()] when + Subject :: binary(), + Pos :: non_neg_integer(), + Len :: integer(). + +bin_to_list(_, _, _) -> + erlang:nif_error(undef). + +-spec compile_pattern(Pattern) -> cp() when + Pattern :: binary() | [binary()]. + +compile_pattern(_) -> + erlang:nif_error(undef). + +-spec copy(Subject) -> binary() when + Subject :: binary(). + +copy(_) -> + erlang:nif_error(undef). + +-spec copy(Subject, N) -> binary() when + Subject :: binary(), + N :: non_neg_integer(). + +copy(_, _) -> + erlang:nif_error(undef). + +-spec decode_unsigned(Subject) -> Unsigned when + Subject :: binary(), + Unsigned :: non_neg_integer(). + +decode_unsigned(_) -> + erlang:nif_error(undef). + +-spec decode_unsigned(Subject, Endianness) -> Unsigned when + Subject :: binary(), + Endianness :: big | little, + Unsigned :: non_neg_integer(). + +decode_unsigned(_, _) -> + erlang:nif_error(undef). + +-spec encode_unsigned(Unsigned) -> binary() when + Unsigned :: non_neg_integer(). + +encode_unsigned(_) -> + erlang:nif_error(undef). + +-spec encode_unsigned(Unsigned, Endianness) -> binary() when + Unsigned :: non_neg_integer(), + Endianness :: big | little. + +encode_unsigned(_, _) -> + erlang:nif_error(undef). + +-spec first(Subject) -> byte() when + Subject :: binary(). + +first(_) -> + erlang:nif_error(undef). + +-spec last(Subject) -> byte() when + Subject :: binary(). + +last(_) -> + erlang:nif_error(undef). + +-spec list_to_bin(ByteList) -> binary() when + ByteList :: iodata(). + +list_to_bin(_) -> + erlang:nif_error(undef). + +-spec longest_common_prefix(Binaries) -> non_neg_integer() when + Binaries :: [binary()]. + +longest_common_prefix(_) -> + erlang:nif_error(undef). + +-spec longest_common_suffix(Binaries) -> non_neg_integer() when + Binaries :: [binary()]. + +longest_common_suffix(_) -> + erlang:nif_error(undef). + +-spec match(Subject, Pattern) -> Found | nomatch when + Subject :: binary(), + Pattern :: binary() | [binary()] | cp(), + Found :: part(). + +match(_, _) -> + erlang:nif_error(undef). + +-spec match(Subject, Pattern, Options) -> Found | nomatch when + Subject :: binary(), + Pattern :: binary() | [binary()] | cp(), + Found :: part(), + Options :: [Option], + Option :: {scope, part()}. + +match(_, _, _) -> + erlang:nif_error(undef). + +-spec matches(Subject, Pattern) -> Found when + Subject :: binary(), + Pattern :: binary() | [binary()] | cp(), + Found :: [part()]. + +matches(_, _) -> + erlang:nif_error(undef). + +-spec matches(Subject, Pattern, Options) -> Found when + Subject :: binary(), + Pattern :: binary() | [binary()] | cp(), + Found :: [part()], + Options :: [Option], + Option :: {scope, part()}. + +matches(_, _, _) -> + erlang:nif_error(undef). + +-spec part(Subject, PosLen) -> binary() when + Subject :: binary(), + PosLen :: part(). + +part(_, _) -> + erlang:nif_error(undef). + +-spec part(Subject, Pos, Len) -> binary() when + Subject :: binary(), + Pos :: non_neg_integer(), + Len :: integer(). + +part(_, _, _) -> + erlang:nif_error(undef). + +-spec referenced_byte_size(Binary) -> non_neg_integer() when + Binary :: binary(). + +referenced_byte_size(_) -> + erlang:nif_error(undef). -spec split(Subject, Pattern) -> Parts when Subject :: binary(), Pattern :: binary() | [binary()] | cp(), Parts :: [binary()]. -split(H,N) -> - split(H,N,[]). +split(_, _) -> + erlang:nif_error(undef). -spec split(Subject, Pattern, Options) -> Parts when Subject :: binary(), Pattern :: binary() | [binary()] | cp(), Options :: [Option], - Option :: {scope, part()} | trim | global, + Option :: {scope, part()} | trim | global | trim_all, Parts :: [binary()]. -split(Haystack,Needles,Options) -> - try - {Part,Global,Trim} = get_opts_split(Options,{no,false,false}), - Moptlist = case Part of - no -> - []; - {A,B} -> - [{scope,{A,B}}] - end, - MList = if - Global -> - binary:matches(Haystack,Needles,Moptlist); - true -> - case binary:match(Haystack,Needles,Moptlist) of - nomatch -> []; - Match -> [Match] - end - end, - do_split(Haystack,MList,0,Trim) - catch - _:_ -> - erlang:error(badarg) - end. - -do_split(H,[],N,true) when N >= byte_size(H) -> - []; -do_split(H,[],N,_) -> - [binary:part(H,{N,byte_size(H)-N})]; -do_split(H,[{A,B}|T],N,Trim) -> - case binary:part(H,{N,A-N}) of - <<>> -> - Rest = do_split(H,T,A+B,Trim), - case {Trim, Rest} of - {true,[]} -> - []; - _ -> - [<<>> | Rest] - end; - Oth -> - [Oth | do_split(H,T,A+B,Trim)] - end. +split(_, _, _) -> + erlang:nif_error(undef). +%%% End of BIFs. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% replace @@ -188,17 +304,6 @@ splitat(H,N,[I|T]) -> %% Simple helper functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -get_opts_split([],{Part,Global,Trim}) -> - {Part,Global,Trim}; -get_opts_split([{scope,{A,B}} | T],{_Part,Global,Trim}) -> - get_opts_split(T,{{A,B},Global,Trim}); -get_opts_split([global | T],{Part,_Global,Trim}) -> - get_opts_split(T,{Part,true,Trim}); -get_opts_split([trim | T],{Part,Global,_Trim}) -> - get_opts_split(T,{Part,Global,true}); -get_opts_split(_,_) -> - throw(badopt). - get_opts_replace([],{Part,Global,Insert}) -> {Part,Global,Insert}; get_opts_replace([{scope,{A,B}} | T],{_Part,Global,Insert}) -> diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl index a920921a5e..ad4915eabe 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -27,7 +28,7 @@ lc_batch/0, lc_batch/1, i/3,pid/3,m/0,m/1, bt/1, q/0, - erlangrc/0,erlangrc/1,bi/1, flush/0, regs/0, + erlangrc/0,erlangrc/1,bi/1, flush/0, regs/0, uptime/0, nregs/0,pwd/0,ls/0,ls/1,cd/1,memory/1,memory/0, xm/1]). -export([display_info/1]). @@ -65,6 +66,7 @@ help() -> "q() -- quit - shorthand for init:stop()\n" "regs() -- information about registered processes\n" "nregs() -- information about all registered processes\n" + "uptime() -- print node uptime\n" "xm(M) -- cross reference check a module\n" "y(File) -- generate a Yecc parser\n">>). @@ -116,13 +118,13 @@ machine_load(Mod, File, Opts) -> File2 = filename:join(Dir, filename:basename(File, ".erl")), case compile:output_generated(Opts) of true -> - Base = packages:last(Mod), + Base = atom_to_list(Mod), case filename:basename(File, ".erl") of Base -> code:purge(Mod), check_load(code:load_abs(File2,Mod), Mod); _OtherMod -> - format("** Module name '~p' does not match file name '~p' **~n", + format("** Module name '~p' does not match file name '~tp' **~n", [Mod,File]), {error, badfile} end; @@ -203,11 +205,11 @@ make_term(Str) -> case erl_parse:parse_term(Tokens ++ [{dot, 1}]) of {ok, Term} -> Term; {error, {_,_,Reason}} -> - io:format("~s: ~s~n", [Reason, Str]), + io:format("~ts: ~ts~n", [Reason, Str]), throw(error) end; {error, {_,_,Reason}, _} -> - io:format("~s: ~s~n", [Reason, Str]), + io:format("~ts: ~ts~n", [Reason, Str]), throw(error) end. @@ -330,13 +332,18 @@ choice(F) -> end. get_line(P, Default) -> - case io:get_line(P) of + case line_string(io:get_line(P)) of "\n" -> Default; L -> L end. +%% If the standard input is set to binary mode +%% convert it to a list so we can properly match. +line_string(Binary) when is_binary(Binary) -> unicode:characters_to_list(Binary); +line_string(Other) -> Other. + mfa_string(Fun) when is_function(Fun) -> {module,M} = erlang:fun_info(Fun, module), {name,F} = erlang:fun_info(Fun, name), @@ -450,7 +457,7 @@ m() -> foreach(fun ({Mod,File}) -> mformat(Mod, File) end, sort(code:all_loaded())). mformat(A1, A2) -> - format("~-20s ~s\n", [A1,A2]). + format("~-20s ~ts\n", [A1,A2]). %% erlangrc(Home) %% Try to run a ".erlang" file, first in the current directory @@ -475,11 +482,11 @@ f_p_e(P, F) -> {error, enoent} = Enoent -> Enoent; {error, E={Line, _Mod, _Term}} -> - error("file:path_eval(~p,~p): error on line ~p: ~s~n", + error("file:path_eval(~tp,~tp): error on line ~p: ~ts~n", [P, F, Line, file:format_error(E)]), ok; {error, E} -> - error("file:path_eval(~p,~p): ~s~n", + error("file:path_eval(~tp,~tp): ~ts~n", [P, F, file:format_error(E)]), ok; Other -> @@ -504,19 +511,28 @@ m(M) -> {exports,E} = lists:keyfind(exports, 1, L), Time = get_compile_time(L), COpts = get_compile_options(L), - format("Module ~w compiled: ",[M]), print_time(Time), - format("Compiler options: ~p~n", [COpts]), + format("Module: ~w~n", [M]), + print_md5(L), + format("Compiled: "), + print_time(Time), print_object_file(M), + format("Compiler options: ~p~n", [COpts]), format("Exports: ~n",[]), print_exports(keysort(1, E)). print_object_file(Mod) -> case code:is_loaded(Mod) of {file,File} -> - format("Object file: ~s\n", [File]); + format("Object file: ~ts\n", [File]); _ -> ignore end. +print_md5(L) -> + case lists:keyfind(md5, 1, L) of + {md5,<<MD5:128>>} -> io:format("MD5: ~.16b~n",[MD5]); + _ -> ok + end. + get_compile_time(L) -> case get_compile_info(L, time) of {ok,Val} -> Val; @@ -564,8 +580,8 @@ split_print_exports([{F1, A1}|T1], [{F2, A2} | T2]) -> split_print_exports([], []) -> ok. print_time({Year,Month,Day,Hour,Min,_Secs}) -> - format("Date: ~s ~w ~w, ", [month(Month),Day,Year]), - format("Time: ~.2.0w.~.2.0w~n", [Hour,Min]); + format("~s ~w ~w, ", [month(Month),Day,Year]), + format("~.2.0w:~.2.0w~n", [Hour,Min]); print_time(notime) -> format("No compile time info available~n",[]). @@ -588,7 +604,12 @@ month(12) -> "December". flush() -> receive X -> - format("Shell got ~p~n",[X]), + case lists:keyfind(encoding, 1, io:getopts()) of + {encoding,unicode} -> + format("Shell got ~tp~n",[X]); + _ -> + format("Shell got ~p~n",[X]) + end, flush() after 0 -> ok @@ -680,7 +701,7 @@ portformat(Name, Id, Cmd) -> pwd() -> case file:get_cwd() of {ok, Str} -> - ok = io:format("~ts\n", [fixup_one_bin(Str)]); + ok = io:format("~ts\n", [Str]); {error, _} -> ok = io:format("Cannot determine current directory\n") end. @@ -689,7 +710,7 @@ pwd() -> Dir :: file:name(). cd(Dir) -> - file:set_cwd(Dir), + _ = file:set_cwd(Dir), pwd(). %% ls() @@ -707,27 +728,13 @@ ls() -> ls(Dir) -> case file:list_dir(Dir) of {ok, Entries} -> - ls_print(sort(fixup_bin(Entries))); - {error,_E} -> - format("Invalid directory\n") + ls_print(sort(Entries)); + {error, enotdir} -> + ls_print([Dir]); + {error, Error} -> + format("~ts\n", [file:format_error(Error)]) end. -fixup_one_bin(X) when is_binary(X) -> - L = binary_to_list(X), - [ if - El > 127 -> - $?; - true -> - El - end || El <- L]; -fixup_one_bin(X) -> - X. -fixup_bin([H|T]) -> - [fixup_one_bin(H) | fixup_bin(T)]; -fixup_bin([]) -> - []. - - ls_print([]) -> ok; ls_print(L) -> Width = min([max(lengths(L, [])), 40]) + 5, @@ -769,6 +776,26 @@ memory() -> erlang:memory(). memory(TypeSpec) -> erlang:memory(TypeSpec). %% +%% uptime/0 +%% + +-spec uptime() -> 'ok'. + +uptime() -> + io:format("~s~n", [uptime(get_uptime())]). + +uptime({D, {H, M, S}}) -> + lists:flatten( + [[ io_lib:format("~p days, ", [D]) || D > 0 ], + [ io_lib:format("~p hours, ", [H]) || D+H > 0 ], + [ io_lib:format("~p minutes and ", [M]) || D+H+M > 0 ], + io_lib:format("~p seconds", [S])]). + +get_uptime() -> + {UpTime, _} = erlang:statistics(wall_clock), + calendar:seconds_to_daystime(UpTime div 1000). + +%% %% Cross Reference Check %% %%-spec xm(module() | file:filename()) -> xref:m/1 return diff --git a/lib/stdlib/src/calendar.erl b/lib/stdlib/src/calendar.erl index 0320e0cd0e..55a0cfc9a1 100644 --- a/lib/stdlib/src/calendar.erl +++ b/lib/stdlib/src/calendar.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -299,7 +300,7 @@ local_time_to_universal_time_dst(DateTime) -> %% now_to_universal_time(Now) %% now_to_datetime(Now) %% -%% Convert from now() to UTC. +%% Convert from erlang:timestamp() to UTC. %% %% Args: Now = now(); now() = {MegaSec, Sec, MilliSec}, MegaSec = Sec %% = MilliSec = integer() diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index c0f9ce34b0..bf22949870 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -88,7 +89,8 @@ %% Not documented, or not ready for publication. -export([lookup_keys/2]). --export_type([tab_name/0]). +-export_type([bindings_cont/0, cont/0, object_cont/0, select_cont/0, + tab_name/0]). -compile({inline, [{einval,2},{badarg,2},{undefined,1}, {badarg_exit,2},{lookup_reply,2}]}). @@ -319,7 +321,7 @@ foldr(Fun, Acc, Tab) -> foldl(Fun, Acc, Tab) -> Ref = make_ref(), - do_traverse(Fun, Acc, Tab, Ref). + badarg(do_traverse(Fun, Acc, Tab, Ref), [Fun, Acc, Tab]). -spec from_ets(Name, EtsTab) -> 'ok' | {'error', Reason} when Name :: tab_name(), @@ -370,7 +372,7 @@ info(Tab) -> Item :: 'access' | 'auto_save' | 'bchunk_format' | 'hash' | 'file_size' | 'filename' | 'keypos' | 'memory' | 'no_keys' | 'no_objects' | 'no_slots' | 'owner' | 'ram_file' - | 'safe_fixed' | 'size' | 'type' | 'version', + | 'safe_fixed' | 'safe_fixed_monotonic_time' | 'size' | 'type' | 'version', Value :: term(). info(Tab, owner) -> @@ -439,9 +441,10 @@ insert(Tab, Objs) when is_list(Objs) -> insert(Tab, Obj) -> badarg(treq(Tab, {insert, [Obj]}), [Tab, Obj]). --spec insert_new(Name, Objects) -> boolean() when +-spec insert_new(Name, Objects) -> boolean() | {'error', Reason} when Name :: tab_name(), - Objects :: object() | [object()]. + Objects :: object() | [object()], + Reason :: term(). insert_new(Tab, Objs) when is_list(Objs) -> badarg(treq(Tab, {insert_new, Objs}), [Tab, Objs]); @@ -468,7 +471,7 @@ is_compatible_bchunk_format(Tab, Term) -> is_dets_file(FileName) -> case catch read_file_header(FileName, read, false) of {ok, Fd, FH} -> - file:close(Fd), + _ = file:close(Fd), FH#fileheader.cookie =:= ?MAGIC; {error, {tooshort, _}} -> false; @@ -515,7 +518,7 @@ match(Tab, Pat) -> Reason :: term(). match(Tab, Pat, N) -> - badarg(init_chunk_match(Tab, Pat, bindings, N), [Tab, Pat, N]). + badarg(init_chunk_match(Tab, Pat, bindings, N, no_safe), [Tab, Pat, N]). -spec match(Continuation) -> {[Match], Continuation2} | '$end_of_table' | {'error', Reason} when @@ -525,7 +528,7 @@ match(Tab, Pat, N) -> Reason :: term(). match(State) when State#dets_cont.what =:= bindings -> - badarg(chunk_match(State), [State]); + badarg(chunk_match(State, no_safe), [State]); match(Term) -> erlang:error(badarg, [Term]). @@ -538,26 +541,26 @@ match_delete(Tab, Pat) -> badarg(match_delete(Tab, Pat, delete), [Tab, Pat]). match_delete(Tab, Pat, What) -> - safe_fixtable(Tab, true), case compile_match_spec(What, Pat) of {Spec, MP} -> - Proc = dets_server:get_pid(Tab), - R = req(Proc, {match_delete_init, MP, Spec}), - do_match_delete(Tab, Proc, R, What, 0); + case catch dets_server:get_pid(Tab) of + {'EXIT', _Reason} -> + badarg; + Proc -> + R = req(Proc, {match_delete_init, MP, Spec}), + do_match_delete(Proc, R, What, 0) + end; badarg -> badarg end. -do_match_delete(Tab, _Proc, {done, N1}, select, N) -> - safe_fixtable(Tab, false), +do_match_delete(_Proc, {done, N1}, select, N) -> N + N1; -do_match_delete(Tab, _Proc, {done, _N1}, _What, _N) -> - safe_fixtable(Tab, false), +do_match_delete(_Proc, {done, _N1}, _What, _N) -> ok; -do_match_delete(Tab, Proc, {cont, State, N1}, What, N) -> - do_match_delete(Tab, Proc, req(Proc, {match_delete, State}), What, N+N1); -do_match_delete(Tab, _Proc, Error, _What, _N) -> - safe_fixtable(Tab, false), +do_match_delete(Proc, {cont, State, N1}, What, N) -> + do_match_delete(Proc, req(Proc, {match_delete, State}), What, N+N1); +do_match_delete(_Proc, Error, _What, _N) -> Error. -spec match_object(Name, Pattern) -> Objects | {'error', Reason} when @@ -579,7 +582,7 @@ match_object(Tab, Pat) -> Reason :: term(). match_object(Tab, Pat, N) -> - badarg(init_chunk_match(Tab, Pat, object, N), [Tab, Pat, N]). + badarg(init_chunk_match(Tab, Pat, object, N, no_safe), [Tab, Pat, N]). -spec match_object(Continuation) -> {Objects, Continuation2} | '$end_of_table' | {'error', Reason} when @@ -589,7 +592,7 @@ match_object(Tab, Pat, N) -> Reason :: term(). match_object(State) when State#dets_cont.what =:= object -> - badarg(chunk_match(State), [State]); + badarg(chunk_match(State, no_safe), [State]); match_object(Term) -> erlang:error(badarg, [Term]). @@ -712,7 +715,7 @@ select(Tab, Pat) -> Reason :: term(). select(Tab, Pat, N) -> - badarg(init_chunk_match(Tab, Pat, select, N), [Tab, Pat, N]). + badarg(init_chunk_match(Tab, Pat, select, N, no_safe), [Tab, Pat, N]). -spec select(Continuation) -> {Selection, Continuation2} | '$end_of_table' | {'error', Reason} when @@ -722,7 +725,7 @@ select(Tab, Pat, N) -> Reason :: term(). select(State) when State#dets_cont.what =:= select -> - badarg(chunk_match(State), [State]); + badarg(chunk_match(State, no_safe), [State]); select(Term) -> erlang:error(badarg, [Term]). @@ -898,7 +901,7 @@ traverse(Tab, Fun) -> throw({Ref, Other}) end end, - do_traverse(TFun, [], Tab, Ref). + badarg(do_traverse(TFun, [], Tab, Ref), [Tab, Fun]). -spec update_counter(Name, Key, Increment) -> Result when Name :: tab_name(), @@ -929,30 +932,31 @@ where(Tab, Object) -> badarg(treq(Tab, {where, Object}), [Tab, Object]). do_traverse(Fun, Acc, Tab, Ref) -> - safe_fixtable(Tab, true), - Proc = dets_server:get_pid(Tab), - try - do_trav(Proc, Acc, Fun) - catch {Ref, Result} -> - Result - after - safe_fixtable(Tab, false) + case catch dets_server:get_pid(Tab) of + {'EXIT', _Reason} -> + badarg; + Proc -> + try + do_trav(Proc, Acc, Fun) + catch {Ref, Result} -> + Result + end end. do_trav(Proc, Acc, Fun) -> {Spec, MP} = compile_match_spec(object, '_'), %% MP not used - case req(Proc, {match, MP, Spec, default}) of + case req(Proc, {match, MP, Spec, default, safe}) of {cont, State} -> do_trav(State, Proc, Acc, Fun); Error -> Error end. -do_trav(#dets_cont{bin = eof}, _Proc, Acc, _Fun) -> - Acc; do_trav(State, Proc, Acc, Fun) -> - case req(Proc, {match_init, State}) of + case req(Proc, {match_init, State, safe}) of + '$end_of_table'-> + Acc; {cont, {Bins, NewState}} -> do_trav_bins(NewState, Proc, Acc, Fun, lists:reverse(Bins)); Error -> @@ -972,44 +976,47 @@ do_trav_bins(State, Proc, Acc, Fun, [Bin | Bins]) -> end. safe_match(Tab, Pat, What) -> - safe_fixtable(Tab, true), - R = do_safe_match(init_chunk_match(Tab, Pat, What, default), []), - safe_fixtable(Tab, false), - R. + do_safe_match(init_chunk_match(Tab, Pat, What, default, safe), []). do_safe_match({error, Error}, _L) -> {error, Error}; do_safe_match({L, C}, LL) -> - do_safe_match(chunk_match(C), L++LL); + do_safe_match(chunk_match(C, safe), L++LL); do_safe_match('$end_of_table', L) -> L; do_safe_match(badarg, _L) -> badarg. %% What = object | bindings | select -init_chunk_match(Tab, Pat, What, N) when is_integer(N), N >= 0; - N =:= default -> +init_chunk_match(Tab, Pat, What, N, Safe) when is_integer(N), N >= 0; + N =:= default -> case compile_match_spec(What, Pat) of {Spec, MP} -> - Proc = dets_server:get_pid(Tab), - case req(Proc, {match, MP, Spec, N}) of - {done, L} -> - {L, #dets_cont{tab = Tab, proc = Proc, what = What, - bin = eof}}; - {cont, State} -> - chunk_match(State#dets_cont{what = What, tab = Tab, - proc = Proc}); - Error -> - Error + case catch dets_server:get_pid(Tab) of + {'EXIT', _Reason} -> + badarg; + Proc -> + case req(Proc, {match, MP, Spec, N, Safe}) of + {done, L} -> + {L, #dets_cont{tab = Tab, proc = Proc, + what = What, bin = eof}}; + {cont, State} -> + chunk_match(State#dets_cont{what = What, + tab = Tab, + proc = Proc}, + Safe); + Error -> + Error + end end; badarg -> badarg end; -init_chunk_match(_Tab, _Pat, _What, _) -> +init_chunk_match(_Tab, _Pat, _What, _N, _Safe) -> badarg. -chunk_match(#dets_cont{proc = Proc}=State) -> - case req(Proc, {match_init, State}) of +chunk_match(#dets_cont{proc = Proc}=State, Safe) -> + case req(Proc, {match_init, State, Safe}) of '$end_of_table'=Reply -> Reply; {cont, {Bins, NewState}} -> @@ -1024,7 +1031,7 @@ chunk_match(#dets_cont{proc = Proc}=State) -> badarg end; [] -> - chunk_match(NewState); + chunk_match(NewState, Safe); Terms -> {Terms, NewState} end; @@ -1117,7 +1124,9 @@ repl({delayed_write, {Delay,Size} = C}, Defs) Defs#open_args{delayed_write = C}; repl({estimated_no_objects, I}, Defs) -> repl({min_no_slots, I}, Defs); -repl({file, File}, Defs) -> +repl({file, File}, Defs) when is_list(File) -> + Defs#open_args{file = File}; +repl({file, File}, Defs) when is_atom(File) -> Defs#open_args{file = to_list(File)}; repl({keypos, P}, Defs) when is_integer(P), P > 0 -> Defs#open_args{keypos =P}; @@ -1241,13 +1250,8 @@ req(Proc, R) -> {'DOWN', Ref, process, Proc, _Info} -> badarg; {Proc, Reply} -> - erlang:demonitor(Ref), - receive - {'DOWN', Ref, process, Proc, _Reason} -> - Reply - after 0 -> - Reply - end + erlang:demonitor(Ref, [flush]), + Reply end. %% Inlined. @@ -1287,7 +1291,15 @@ init(Parent, Server) -> open_file_loop(#head{parent = Parent, server = Server}). open_file_loop(Head) -> - open_file_loop(Head, 0). + %% The Dets server pretends the file is open before + %% internal_open() has been called, which means that unless the + %% internal_open message is applied first, other processes can + %% find the pid by calling dets_server:get_pid() and do things + %% before Head has been initialized properly. + receive + ?DETS_CALL(From, {internal_open, _Ref, _Args}=Op) -> + do_apply_op(Op, From, Head, 0) + end. open_file_loop(Head, N) when element(1, Head#head.update_mode) =:= error -> open_file_loop2(Head, N); @@ -1301,7 +1313,7 @@ open_file_loop(Head, N) -> %% - wait 1 ms after each update. %% next is normally followed by lookup, but since lookup is also %% used when not traversing the table, it is not prioritized. - ?DETS_CALL(From, {match_init, _State} = Op) -> + ?DETS_CALL(From, {match_init, _State, _Safe} = Op) -> do_apply_op(Op, From, Head, N); ?DETS_CALL(From, {bchunk, _State} = Op) -> do_apply_op(Op, From, Head, N); @@ -1384,7 +1396,8 @@ do_apply_op(Op, From, Head, N) -> end, if From =/= self() -> - From ! {self(), {error, {dets_bug, Name, Op, Bad}}}; + From ! {self(), {error, {dets_bug, Name, Op, Bad}}}, + ok; true -> % auto_save | may_grow | {delayed_write, _} ok end, @@ -1558,12 +1571,17 @@ apply_op(Op, From, Head, N) -> H2; {lookup_keys, _Keys} -> stream_op(Op, From, [], Head, N); - {match_init, State} -> - {H2, Res} = fmatch_init(Head, State), + {match_init, State, Safe} -> + {H1, Res} = fmatch_init(Head, State), + H2 = case Res of + {cont,_} -> H1; + _ when Safe =:= no_safe-> H1; + _ when Safe =:= safe -> do_safe_fixtable(H1, From, false) + end, From ! {self(), Res}, H2; - {match, MP, Spec, NObjs} -> - {H2, Res} = fmatch(Head, MP, Spec, NObjs), + {match, MP, Spec, NObjs, Safe} -> + {H2, Res} = fmatch(Head, MP, Spec, NObjs, Safe, From), From ! {self(), Res}, H2; {member, Key} when Head#head.version =:= 8 -> @@ -1577,11 +1595,15 @@ apply_op(Op, From, Head, N) -> From ! {self(), Res}, H2; {match_delete, State} when Head#head.update_mode =:= dirty -> - {H2, Res} = fmatch_delete(Head, State), + {H1, Res} = fmatch_delete(Head, State), + H2 = case Res of + {cont,_S,_N} -> H1; + _ -> do_safe_fixtable(H1, From, false) + end, From ! {self(), Res}, {N + 1, H2}; {match_delete_init, MP, Spec} when Head#head.update_mode =:= dirty -> - {H2, Res} = fmatch_delete_init(Head, MP, Spec), + {H2, Res} = fmatch_delete_init(Head, MP, Spec, From), From ! {self(), Res}, {N + 1, H2}; {safe_fixtable, Bool} -> @@ -1625,7 +1647,8 @@ start_auto_save_timer(Head) when Head#head.auto_save =:= infinity -> ok; start_auto_save_timer(Head) -> Millis = Head#head.auto_save, - erlang:send_after(Millis, self(), ?DETS_CALL(self(), auto_save)). + _Ref = erlang:send_after(Millis, self(), ?DETS_CALL(self(), auto_save)), + ok. %% Version 9: Peek the message queue and try to evaluate several %% lookup requests in parallel. Evalute delete_object, delete and @@ -1674,7 +1697,7 @@ stream_end(Head, Pids0, C, N, Next) -> %% replies to delete and insert requests even if the %% latter requests were made before the lookup requests, %% which can be confusing.) - lookup_replies(Found), + _ = lookup_replies(Found), stream_end1(Pids0, Next, N, C, Head1, PwriteList); Head1 when is_record(Head1, head) -> stream_end2(Pids0, Pids0, Next, N, C, Head1, ok); @@ -1724,7 +1747,7 @@ lookup_replies(Q) -> lookup_replies(P, O, []) -> lookup_reply(P, O); lookup_replies(P, O, [{P2,O2} | L]) -> - lookup_reply(P, O), + _ = lookup_reply(P, O), lookup_replies(P2, lists:append(O2), L). %% If a list of Pid then op was {member, Key}. Inlined. @@ -1774,6 +1797,7 @@ read_file_header(FileName, Access, RamFile) -> Version =:= 9 -> dets_v9:read_file_header(Fd, FileName); true -> + _ = file:close(Fd), throw({error, {not_a_dets_file, FileName}}) end. @@ -1781,12 +1805,15 @@ fclose(Head) -> {Head1, Res} = perform_save(Head, false), case Head1#head.ram_file of true -> - ignore; + Res; false -> dets_utils:stop_disk_map(), - file:close(Head1#head.fptr) - end, - Res. + Res2 = file:close(Head1#head.fptr), + if + Res2 =:= ok -> Res; + true -> Res2 + end + end. %% -> {NewHead, Res} perform_save(Head, DoSync) when Head#head.update_mode =:= dirty; @@ -1947,7 +1974,9 @@ do_safe_fixtable(Head, Pid, true) -> case Head#head.fixed of false -> link(Pid), - Fixed = {erlang:now(), [{Pid, 1}]}, + MonTime = erlang:monotonic_time(), + TimeOffset = erlang:time_offset(), + Fixed = {{MonTime, TimeOffset}, [{Pid, 1}]}, Ftab = dets_utils:get_freelists(Head), Head#head{fixed = Fixed, freelists = {Ftab, Ftab}}; {TimeStamp, Counters} -> @@ -1993,7 +2022,7 @@ remove_fix(Head, Pid, How) -> end. do_stop(Head) -> - unlink_fixing_procs(Head), + _NewHead = unlink_fixing_procs(Head), fclose(Head). unlink_fixing_procs(Head) -> @@ -2001,7 +2030,7 @@ unlink_fixing_procs(Head) -> false -> Head; {_, Counters} -> - lists:map(fun({Pid, _Counter}) -> unlink(Pid) end, Counters), + lists:foreach(fun({Pid, _Counter}) -> unlink(Pid) end, Counters), Head#head{fixed = false, freelists = dets_utils:get_freelists(Head)} end. @@ -2012,8 +2041,9 @@ check_growth(Head) -> NoThings = no_things(Head), if NoThings > Head#head.next -> - erlang:send_after(200, self(), - ?DETS_CALL(self(), may_grow)); % Catch up. + _Ref = erlang:send_after + (200, self(), ?DETS_CALL(self(), may_grow)), % Catch up. + ok; true -> ok end. @@ -2073,7 +2103,22 @@ finfo(H, no_keys) -> finfo(H, no_slots) -> {H, (H#head.mod):no_slots(H)}; finfo(H, pid) -> {H, self()}; finfo(H, ram_file) -> {H, H#head.ram_file}; -finfo(H, safe_fixed) -> {H, H#head.fixed}; +finfo(H, safe_fixed) -> + {H, + case H#head.fixed of + false -> + false; + {{FixMonTime, TimeOffset}, RefList} -> + {make_timestamp(FixMonTime, TimeOffset), RefList} + end}; +finfo(H, safe_fixed_monotonic_time) -> + {H, + case H#head.fixed of + false -> + false; + {{FixMonTime, _TimeOffset}, RefList} -> + {FixMonTime, RefList} + end}; finfo(H, size) -> case catch write_cache(H) of {H2, []} -> @@ -2098,6 +2143,8 @@ test_bchunk_format(Head, Term) -> do_open_file([Fname, Verbose], Parent, Server, Ref) -> case catch fopen2(Fname, Ref) of + {error, {tooshort, _}} -> + err({error, {not_a_dets_file, Fname}}); {error, _Reason} = Error -> err(Error); {ok, Head} -> @@ -2111,11 +2158,10 @@ do_open_file([Fname, Verbose], Parent, Server, Ref) -> [Bad]), {error, {dets_bug, Fname, Bad}} end; -do_open_file([Tab, OpenArgs, Verb], Parent, Server, Ref) -> +do_open_file([Tab, OpenArgs, Verb], Parent, Server, _Ref) -> case catch fopen3(Tab, OpenArgs) of {error, {tooshort, _}} -> - file:delete(OpenArgs#open_args.file), - do_open_file([Tab, OpenArgs, Verb], Parent, Server, Ref); + err({error, {not_a_dets_file, OpenArgs#open_args.file}}); {error, _Reason} = Error -> err(Error); {ok, Head} -> @@ -2229,13 +2275,18 @@ fmatch_init(Head, C) -> end. %% -> {NewHead, Result} -fmatch(Head, MP, Spec, N) -> +fmatch(Head, MP, Spec, N, Safe, From) -> KeyPos = Head#head.keypos, case find_all_keys(Spec, KeyPos, []) of [] -> %% Complete match case catch write_cache(Head) of - {NewHead, []} -> + {Head1, []} -> + NewHead = + case Safe of + safe -> do_safe_fixtable(Head1, From, true); + no_safe -> Head1 + end, C0 = init_scan(NewHead, N), {NewHead, {cont, C0#dets_cont{match_program = MP}}}; {NewHead, _} = HeadError when is_record(NewHead, head) -> @@ -2300,12 +2351,12 @@ contains_variable(_) -> false. %% -> {NewHead, Res} -fmatch_delete_init(Head, MP, Spec) -> +fmatch_delete_init(Head, MP, Spec, From) -> KeyPos = Head#head.keypos, case catch case find_all_keys(Spec, KeyPos, []) of [] -> - do_fmatch_delete_var_keys(Head, MP, Spec); + do_fmatch_delete_var_keys(Head, MP, Spec, From); List -> Keys = lists:usort(List), do_fmatch_constant_keys(Head, Keys, MP) @@ -2336,7 +2387,7 @@ fmatch_delete(Head, C) -> end end. -do_fmatch_delete_var_keys(Head, _MP, ?PATTERN_TO_TRUE_MATCH_SPEC('_')) +do_fmatch_delete_var_keys(Head, _MP, ?PATTERN_TO_TRUE_MATCH_SPEC('_'), _From) when Head#head.fixed =:= false -> %% Handle the case where the file is emptied efficiently. %% Empty the cache just to get the number of objects right. @@ -2348,8 +2399,9 @@ do_fmatch_delete_var_keys(Head, _MP, ?PATTERN_TO_TRUE_MATCH_SPEC('_')) Reply -> Reply end; -do_fmatch_delete_var_keys(Head, MP, _Spec) -> - {NewHead, []} = write_cache(Head), +do_fmatch_delete_var_keys(Head, MP, _Spec, From) -> + Head1 = do_safe_fixtable(Head, From, true), + {NewHead, []} = write_cache(Head1), C0 = init_scan(NewHead, default), {NewHead, {cont, C0#dets_cont{match_program = MP}, 0}}. @@ -2465,7 +2517,6 @@ fopen2(Fname, Tab) -> {ok, _} -> Acc = read_write, Ram = false, - %% Fd is not always closed upon error, but exit is soon called. {ok, Fd, FH} = read_file_header(Fname, Acc, Ram), Mod = FH#fileheader.mod, Do = case Mod:check_file_header(FH, Fd) of @@ -2484,7 +2535,7 @@ fopen2(Fname, Tab) -> end, case Do of {repair, Mess} -> - io:format(user, "dets: file ~p~s~n", [Fname, Mess]), + io:format(user, "dets: file ~tp~s~n", [Fname, Mess]), Version = default, case fsck(Fd, Tab, Fname, FH, default, default, Version) of ok -> @@ -2521,7 +2572,6 @@ fopen_existing_file(Tab, OpenArgs) -> ram_file = Ram, delayed_write = CacheSz, auto_save = Auto, access = Acc, version = Version, debug = Debug} = OpenArgs, - %% Fd is not always closed upon error, but exit is soon called. {ok, Fd, FH} = read_file_header(Fname, Acc, Ram), V9 = (Version =:= 9) or (Version =:= default), MinF = (MinSlots =:= default) or (MinSlots =:= FH#fileheader.min_no_slots), @@ -2579,7 +2629,7 @@ fopen_existing_file(Tab, OpenArgs) -> _ when FH#fileheader.keypos =/= Kp -> throw({error, {keypos_mismatch, Fname}}); {compact, SourceHead} -> - io:format(user, "dets: file ~p is now compacted ...~n", [Fname]), + io:format(user, "dets: file ~tp is now compacted ...~n", [Fname]), {ok, NewSourceHead} = open_final(SourceHead, Fname, read, false, ?DEFAULT_CACHE, Tab, Debug), case catch compact(NewSourceHead) of @@ -2589,14 +2639,14 @@ fopen_existing_file(Tab, OpenArgs) -> _Err -> _ = file:close(Fd), dets_utils:stop_disk_map(), - io:format(user, "dets: compaction of file ~p failed, " + io:format(user, "dets: compaction of file ~tp failed, " "now repairing ...~n", [Fname]), {ok, Fd2, _FH} = read_file_header(Fname, Acc, Ram), do_repair(Fd2, Tab, Fname, FH, MinSlots, MaxSlots, Version, OpenArgs) end; {repair, Mess} -> - io:format(user, "dets: file ~p~s~n", [Fname, Mess]), + io:format(user, "dets: file ~tp~s~n", [Fname, Mess]), do_repair(Fd, Tab, Fname, FH, MinSlots, MaxSlots, Version, OpenArgs); _ when FH#fileheader.version =/= Version, Version =/= default -> @@ -2656,11 +2706,11 @@ fopen_init_file(Tab, OpenArgs) -> case catch Mod:initiate_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, Ram, CacheSz, Auto, true) of {error, Reason} when Ram -> - file:close(Fd), + _ = file:close(Fd), throw({error, Reason}); {error, Reason} -> - file:close(Fd), - file:delete(Fname), + _ = file:close(Fd), + _ = file:delete(Fname), throw({error, Reason}); {ok, Head} -> start_auto_save_timer(Head), @@ -2715,8 +2765,8 @@ compact(SourceHead) -> {ok, H} -> H; Error -> - file:close(Fd), - file:delete(Tmp), + _ = file:close(Fd), + _ = file:delete(Tmp), throw(Error) end, @@ -2733,12 +2783,12 @@ compact(SourceHead) -> if R =:= ok -> ok; true -> - file:delete(Tmp), + _ = file:delete(Tmp), throw(R) end; Err -> - file:close(Fd), - file:delete(Tmp), + _ = file:close(Fd), + _ = file:delete(Tmp), throw(Err) end. @@ -2762,7 +2812,7 @@ fsck(Fd, Tab, Fname, FH, MinSlotsArg, MaxSlotsArg, Version) -> BetterSlotNumbers = {MinSlots, BetterNoSlots, MaxSlots}, case fsck_try(Fd, Tab, FH, Fname, BetterSlotNumbers, Version) of {try_again, _} -> - file:close(Fd), + _ = file:close(Fd), {error, {cannot_repair, Fname}}; Else -> Else @@ -2803,29 +2853,38 @@ fsck_try(Fd, Tab, FH, Fname, SlotNumbers, Version) -> if R =:= ok -> ok; true -> - file:delete(Tmp), + _ = file:delete(Tmp), R end; TryAgainOrError -> - file:delete(Tmp), + _ = file:delete(Tmp), TryAgainOrError end; Error -> - file:close(Fd), + _ = file:close(Fd), Error end. tempfile(Fname) -> Tmp = lists:concat([Fname, ".TMP"]), case file:delete(Tmp) of - {error, eacces} -> % 'dets_process_died' happened anyway... (W-nd-ws) - timer:sleep(5000), - file:delete(Tmp); - _ -> - ok + {error, _Reason} -> % typically enoent + ok; + ok -> + assure_no_file(Tmp) end, Tmp. +assure_no_file(File) -> + case file:read_file_info(File) of + {ok, _FileInfo} -> + %% Wait for some other process to close the file: + timer:sleep(100), + assure_no_file(File); + {error, _} -> + ok + end. + %% -> {ok, NewHead} | {try_again, integer()} | Error fsck_try_est(Head, Fd, Fname, SlotNumbers, FH) -> %% Mod is the module to use for reading input when repairing. @@ -2836,13 +2895,13 @@ fsck_try_est(Head, Fd, Fname, SlotNumbers, FH) -> Bulk = false, case Reply of {ok, NoDups, H1} -> - file:close(Fd), + _ = file:close(Fd), fsck_copy(SizeData, H1, Bulk, NoDups); {try_again, _} = Return -> close_files(Bulk, SizeData, Head), Return; Else -> - file:close(Fd), + _ = file:close(Fd), close_files(Bulk, SizeData, Head), Else end. @@ -2877,14 +2936,20 @@ fsck_copy1([SzData | L], Head, Bulk, NoDups) -> {LogSz, Pos, {FileName, Fd}, NoObjects} = SzData, Size = if NoObjects =:= 0 -> 0; true -> ?POW(LogSz-1) end, ExpectedSize = Size * NoObjects, - close_tmp(Fd), - case file:position(Out, Pos) of - {ok, Pos} -> ok; - PError -> dets_utils:file_error(FileName, PError) + case close_tmp(Fd) of + ok -> ok; + Err -> + close_files(Bulk, L, Head), + dets_utils:file_error(FileName, Err) end, - {ok, Pos} = file:position(Out, Pos), + case file:position(Out, Pos) of + {ok, Pos} -> ok; + Err2 -> + close_files(Bulk, L, Head), + dets_utils:file_error(Head#head.filename, Err2) + end, CR = file:copy({FileName, [raw,binary]}, Out), - file:delete(FileName), + _ = file:delete(FileName), case CR of {ok, Copied} when Copied =:= ExpectedSize; NoObjects =:= 0 -> % the segments @@ -2918,11 +2983,11 @@ free_n_objects(Head, Addr, Size, N) -> free_n_objects(NewHead, NewAddr, Size, N-1). close_files(false, SizeData, Head) -> - file:close(Head#head.fptr), + _ = file:close(Head#head.fptr), close_files(true, SizeData, Head); close_files(true, SizeData, _Head) -> Fun = fun({_Size, _Pos, {FileName, Fd}, _No}) -> - close_tmp(Fd), + _ = close_tmp(Fd), file:delete(FileName); (_) -> ok @@ -3051,14 +3116,14 @@ update_cache(Head, ToAdd) -> {Head1, Found, []}; Cache#cache.wrtime =:= undefined -> %% Empty cache. Schedule a delayed write. - Now = now(), Me = self(), + Now = time_now(), Me = self(), Call = ?DETS_CALL(Me, {delayed_write, Now}), erlang:send_after(Cache#cache.delay, Me, Call), {Head1#head{cache = NewCache#cache{wrtime = Now}}, Found, []}; Size0 =:= 0 -> %% Empty cache that has been written after the %% currently scheduled delayed write. - {Head1#head{cache = NewCache#cache{wrtime = now()}}, Found, []}; + {Head1#head{cache = NewCache#cache{wrtime = time_now()}}, Found, []}; true -> %% Cache is not empty, delayed write has been scheduled. {Head1, Found, []} @@ -3121,11 +3186,7 @@ delayed_write(Head, WrTime) -> Head#head{cache = NewCache}; true -> %% Yes, schedule a new delayed write. - {MS1,S1,M1} = WrTime, - {MS2,S2,M2} = LastWrTime, - WrT = M1+1000000*(S1+1000000*MS1), - LastWrT = M2+1000000*(S2+1000000*MS2), - When = round((LastWrT - WrT)/1000), Me = self(), + When = round((LastWrTime - WrTime)/1000), Me = self(), Call = ?DETS_CALL(Me, {delayed_write, LastWrTime}), erlang:send_after(When, Me, Call), Head @@ -3237,12 +3298,25 @@ err(Error) -> Error end. +-compile({inline, [time_now/0]}). +time_now() -> + erlang:monotonic_time(1000000). + +make_timestamp(MonTime, TimeOffset) -> + ErlangSystemTime = erlang:convert_time_unit(MonTime+TimeOffset, + native, + micro_seconds), + MegaSecs = ErlangSystemTime div 1000000000000, + Secs = ErlangSystemTime div 1000000 - MegaSecs*1000000, + MicroSecs = ErlangSystemTime rem 1000000, + {MegaSecs, Secs, MicroSecs}. + %%%%%%%%%%%%%%%%% DEBUG functions %%%%%%%%%%%%%%%% file_info(FileName) -> case catch read_file_header(FileName, read, false) of {ok, Fd, FH} -> - file:close(Fd), + _ = file:close(Fd), (FH#fileheader.mod):file_info(FH); Other -> Other @@ -3271,7 +3345,7 @@ view(FileName) -> X -> X end - after file:close(Fd) + after _ = file:close(Fd) end; X -> X diff --git a/lib/stdlib/src/dets.hrl b/lib/stdlib/src/dets.hrl index a3f99357a2..6ebeb96156 100644 --- a/lib/stdlib/src/dets.hrl +++ b/lib/stdlib/src/dets.hrl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/stdlib/src/dets_server.erl b/lib/stdlib/src/dets_server.erl index 931112088e..b02d6ae159 100644 --- a/lib/stdlib/src/dets_server.erl +++ b/lib/stdlib/src/dets_server.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -171,9 +172,15 @@ handle_info({pending_reply, {Ref, Result0}}, State) -> link(Pid), do_link(Store, FromPid), true = ets:insert(Store, {FromPid, Tab}), - true = ets:insert(?REGISTRY, {Tab, 1, Pid}), - true = ets:insert(?OWNERS, {Pid, Tab}), + %% do_internal_open() has already done the following: + %% true = ets:insert(?REGISTRY, {Tab, 1, Pid}), + %% true = ets:insert(?OWNERS, {Pid, Tab}), {ok, Tab}; + {Reply, internal_open} -> + %% Clean up what do_internal_open() did: + true = ets:delete(?REGISTRY, Tab), + true = ets:delete(?OWNERS, Pid), + Reply; {Reply, _} -> % ok or Error Reply end, @@ -241,8 +248,8 @@ ensure_started() -> init() -> set_verbose(verbose_flag()), process_flag(trap_exit, true), - ets:new(?REGISTRY, [set, named_table]), - ets:new(?OWNERS, [set, named_table]), + ?REGISTRY = ets:new(?REGISTRY, [set, named_table]), + ?OWNERS = ets:new(?OWNERS, [set, named_table]), ets:new(?STORE, [duplicate_bag]). verbose_flag() -> @@ -309,6 +316,12 @@ do_internal_open(State, From, Args) -> [T, _, _] -> T; [_, _] -> Ref end, + %% Pretend the table is open. If someone else tries to + %% open the file it will always become a pending + %% 'add_user' request. If someone tries to use the table + %% there will be a delay, but that is OK. + true = ets:insert(?REGISTRY, {Tab, 1, Pid}), + true = ets:insert(?OWNERS, {Pid, Tab}), pending_call(Tab, Pid, Ref, From, Args, internal_open, State); Error -> {Error, State} @@ -338,7 +351,7 @@ handle_close(State, Req, {FromPid,_Tag}=From, Tab) -> [{Tab, _Counter, Pid}] -> do_unlink(Store, FromPid), true = ets:match_delete(Store, {FromPid, Tab}), - [true = ets:insert(Store, K) || K <- Keep], + true = ets:insert(Store, Keep), ets:update_counter(?REGISTRY, Tab, -1), pending_call(Tab, Pid, make_ref(), From, [], remove_user, State) diff --git a/lib/stdlib/src/dets_sup.erl b/lib/stdlib/src/dets_sup.erl index 8ea2ba9b3f..43609cb8a1 100644 --- a/lib/stdlib/src/dets_sup.erl +++ b/lib/stdlib/src/dets_sup.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/stdlib/src/dets_utils.erl b/lib/stdlib/src/dets_utils.erl index 5db2ad3049..34a8ddddaa 100644 --- a/lib/stdlib/src/dets_utils.erl +++ b/lib/stdlib/src/dets_utils.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -230,8 +231,12 @@ write_file(Head, Bin) -> {ok, Fd} -> R1 = file:write(Fd, Bin), R2 = file:sync(Fd), - file:close(Fd), - if R1 =:= ok -> R2; true -> R1 end; + R3 = file:close(Fd), + case {R1, R2, R3} of + {ok, ok, R3} -> R3; + {ok, R2, _} -> R2; + {R1, _, _} -> R1 + end; Else -> Else end, @@ -277,12 +282,7 @@ open(FileSpec, Args) -> end. truncate(Fd, FileName, Pos) -> - if - Pos =:= cur -> - ok; - true -> - position(Fd, FileName, Pos) - end, + _ = [position(Fd, FileName, Pos) || Pos =/= cur], case file:truncate(Fd) of ok -> ok; @@ -327,10 +327,10 @@ pread_close(Fd, FileName, Pos, Size) -> {error, Error} -> file_error_close(Fd, FileName, {error, Error}); {ok, Bin} when byte_size(Bin) < Size -> - file:close(Fd), + _ = file:close(Fd), throw({error, {tooshort, FileName}}); eof -> - file:close(Fd), + _ = file:close(Fd), throw({error, {tooshort, FileName}}); OK -> OK end. @@ -339,7 +339,7 @@ file_error(FileName, {error, Reason}) -> throw({error, {file_error, FileName, Reason}}). file_error_close(Fd, FileName, {error, Reason}) -> - file:close(Fd), + _ = file:close(Fd), throw({error, {file_error, FileName, Reason}}). debug_mode() -> @@ -395,7 +395,7 @@ corrupt_reason(Head, Reason0) -> corrupt(Head, Error) -> case get(verbose) of yes -> - error_logger:format("** dets: Corrupt table ~p: ~p\n", + error_logger:format("** dets: Corrupt table ~p: ~tp\n", [Head#head.name, Error]); _ -> ok end, @@ -448,7 +448,7 @@ reset_cache(C) -> WrTime =:= undefined -> WrTime; true -> - now() + erlang:monotonic_time(1000000) end, PK = family(C#cache.cache), NewC = C#cache{cache = [], csize = 0, inserts = 0, wrtime = NewWrTime}, @@ -747,6 +747,8 @@ all_allocated([{X,Y} | L], _X0, Y0, A) when Y0 < X -> all_allocated_as_list(Head) -> all_allocated_as_list(all(get_freelists(Head)), 0, Head#head.base, []). +-dialyzer({no_improper_lists, all_allocated_as_list/4}). + all_allocated_as_list([], _X0, _Y0, []) -> []; all_allocated_as_list([], _X0, _Y0, A) -> @@ -977,7 +979,8 @@ dm([{P,<<Sz:32,X:32>>} | Bs], T) -> true = ets:insert(T, {P,{pointer,X,Sz}}), if Sz =:= 0 -> - X = 0; + X = 0, + true; true -> true = ets:insert(T, {{pointer,X}, P}) end, diff --git a/lib/stdlib/src/dets_v8.erl b/lib/stdlib/src/dets_v8.erl index 3e962a1c8b..1bf53d91b1 100644 --- a/lib/stdlib/src/dets_v8.erl +++ b/lib/stdlib/src/dets_v8.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -35,6 +36,8 @@ %% For backward compatibility. -export([sz2pos/1]). +-dialyzer(no_improper_lists). + -compile({inline, [{sz2pos,1},{scan_skip,7}]}). -compile({inline, [{skip_bytes,5}, {get_segp,1}]}). -compile({inline, [{wl_lookup,5}]}). @@ -199,10 +202,10 @@ %% -> ok | throw({NewHead,Error}) mark_dirty(Head) -> Dirty = [{?CLOSED_PROPERLY_POS, <<?NOT_PROPERLY_CLOSED:32>>}], - dets_utils:pwrite(Head, Dirty), - dets_utils:sync(Head), - dets_utils:position(Head, Head#head.freelists_p), - dets_utils:truncate(Head, cur). + {_NewHead, ok} = dets_utils:pwrite(Head, Dirty), + ok = dets_utils:sync(Head), + {ok, _Pos} = dets_utils:position(Head, Head#head.freelists_p), + ok = dets_utils:truncate(Head, cur). %% -> {ok, head()} | throw(Error) initiate_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, @@ -1492,7 +1495,7 @@ scan_next_allocated(Bin, From0, _To, <<From:32, To:32, L/binary>>, Ts, R) -> %% Read term from file at position Pos prterm(Head, Pos, ReadAhead) -> Res = dets_utils:pread(Head, Pos, ?OHDSZ, ReadAhead), - ?DEBUGF("file:pread(~p, ~p, ?) -> ~p~n", [Head#head.filename, Pos, Res]), + ?DEBUGF("file:pread(~tp, ~p, ?) -> ~p~n", [Head#head.filename, Pos, Res]), {ok, <<Next:32, Sz:32, _Status:32, Bin0/binary>>} = Res, ?DEBUGF("{Next, Sz} = ~p~n", [{Next, Sz}]), Bin = case byte_size(Bin0) of diff --git a/lib/stdlib/src/dets_v9.erl b/lib/stdlib/src/dets_v9.erl index f577b4410f..6c406fc03a 100644 --- a/lib/stdlib/src/dets_v9.erl +++ b/lib/stdlib/src/dets_v9.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -33,6 +34,8 @@ -export([cache_segps/3]). +-dialyzer(no_improper_lists). + -compile({inline, [{max_objsize,1},{maxobjsize,1}]}). -compile({inline, [{write_segment_file,6}]}). -compile({inline, [{sz2pos,1},{adjsz,1}]}). @@ -284,9 +287,9 @@ %% -> ok | throw({NewHead,Error}) mark_dirty(Head) -> Dirty = [{?CLOSED_PROPERLY_POS, <<?NOT_PROPERLY_CLOSED:32>>}], - dets_utils:pwrite(Head, Dirty), - dets_utils:sync(Head), - dets_utils:position(Head, Head#head.freelists_p), + {_H, ok} = dets_utils:pwrite(Head, Dirty), + ok = dets_utils:sync(Head), + {ok, _Pos} = dets_utils:position(Head, Head#head.freelists_p), dets_utils:truncate(Head, cur). %% -> {ok, head()} | throw(Error) | throw(badarg) @@ -1385,13 +1388,13 @@ segment_file(SizeT, Head, FileData, SegEnd) -> case Data of {InFile,In0} -> {OutFile, Out} = temp_file(Head, SizeT, I), - file:close(In0), + _ = file:close(In0), {ok, In} = dets_utils:open(InFile, [raw,binary,read]), {ok, 0} = dets_utils:position(In, InFile, bof), seg_file(SegAddr, SegAddr, In, InFile, Out, OutFile, SizeT, SegEnd), - file:close(In), - file:delete(InFile), + _ = file:close(In), + _ = file:delete(InFile), {OutFile,Out}; Objects -> {LastAddr, B} = seg_file(Objects, SegAddr, SegAddr, SizeT, []), @@ -1702,7 +1705,7 @@ free_list_to_file(Ftab, H, Pos, Sz, Ws, WsSz) -> free_list_to_file(Ftab, H, Pos+1, Sz, NWs, NWsSz). free_lists_from_file(H, Pos) -> - dets_utils:position(H#head.fptr, H#head.filename, Pos), + {ok, Pos} = dets_utils:position(H#head.fptr, H#head.filename, Pos), FL = dets_utils:empty_free_lists(), case catch bin_to_tree([], H, start, FL, -1, []) of {'EXIT', _} -> @@ -2662,7 +2665,7 @@ v_segment(H, SegNo, SegPos, SegSlot) -> {'EXIT', Reason} -> dets_utils:vformat("** dets: Corrupt or truncated dets file~n", []), - io:format("~nERROR ~p~n", [Reason]); + io:format("~nERROR ~tp~n", [Reason]); [] -> %% don't print empty buckets true; {Size, CollP, Objects} -> diff --git a/lib/stdlib/src/dict.erl b/lib/stdlib/src/dict.erl index 2e9eba4bfa..f921e28ef6 100644 --- a/lib/stdlib/src/dict.erl +++ b/lib/stdlib/src/dict.erl @@ -1,23 +1,24 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2011. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -%% We use the dynamic hashing techniques by Per-�ke Larsson as +%% We use the dynamic hashing techniques by Per-Åke Larsson as %% described in "The Design and Implementation of Dynamic Hashing for %% Sets and Tables in Icon" by Griswold and Townsend. Much of the %% terminology comes from that paper as well. @@ -36,11 +37,13 @@ -module(dict). %% Standard interface. --export([new/0,is_key/2,to_list/1,from_list/1,size/1]). +-export([new/0,is_key/2,to_list/1,from_list/1,size/1,is_empty/1]). -export([fetch/2,find/2,fetch_keys/1,erase/2]). -export([store/3,append/3,append_list/3,update/3,update/4,update_counter/3]). -export([fold/3,map/2,filter/2,merge/3]). +-export_type([dict/0, dict/2]). + %% Low-level interface. %%-export([get_slot/2,get_bucket/2,on_bucket/3,fold_dict/3, %% maybe_expand/2,maybe_contract/2]). @@ -53,6 +56,8 @@ -define(exp_size, (?seg_size * ?expand_load)). -define(con_size, (?seg_size * ?contract_load)). +-type segs(_Key, _Value) :: tuple(). + %% Define a hashtable. The default values are the standard ones. -record(dict, {size=0 :: non_neg_integer(), % Number of elements @@ -62,14 +67,13 @@ exp_size=?exp_size :: non_neg_integer(), % Size to expand at con_size=?con_size :: non_neg_integer(), % Size to contract at empty :: tuple(), % Empty segment - segs :: tuple() % Segments + segs :: segs(_, _) % Segments }). -%% A declaration equivalent to the following one is hard-coded in erl_types. -%% That declaration contains hard-coded information about the #dict{} -%% structure and the types of its fields. So, please make sure that any -%% changes to its structure are also propagated to erl_types.erl. -%% -%% -opaque dict() :: #dict{}. + + +-type dict() :: dict(_, _). + +-opaque dict(Key, Value) :: #dict{segs :: segs(Key, Value)}. -define(kv(K,V), [K|V]). % Key-Value pair format %%-define(kv(K,V), {K,V}). % Key-Value pair format @@ -81,8 +85,7 @@ new() -> #dict{empty=Empty,segs={Empty}}. -spec is_key(Key, Dict) -> boolean() when - Key :: term(), - Dict :: dict(). + Dict :: dict(Key, Value :: term()). is_key(Key, D) -> Slot = get_slot(D, Key), @@ -94,15 +97,15 @@ find_key(K, [_|Bkt]) -> find_key(K, Bkt); find_key(_, []) -> false. -spec to_list(Dict) -> List when - Dict :: dict(), - List :: [{Key :: term(), Value :: term()}]. + Dict :: dict(Key, Value), + List :: [{Key, Value}]. to_list(D) -> fold(fun (Key, Val, List) -> [{Key,Val}|List] end, [], D). -spec from_list(List) -> Dict when - List :: [{Key :: term(), Value :: term()}], - Dict :: dict(). + Dict :: dict(Key, Value), + List :: [{Key, Value}]. from_list(L) -> lists:foldl(fun ({K,V}, D) -> store(K, V, D) end, new(), L). @@ -112,10 +115,13 @@ from_list(L) -> size(#dict{size=N}) when is_integer(N), N >= 0 -> N. +-spec is_empty(Dict) -> boolean() when + Dict :: dict(). + +is_empty(#dict{size=N}) -> N =:= 0. + -spec fetch(Key, Dict) -> Value when - Key :: term(), - Dict :: dict(), - Value :: term(). + Dict :: dict(Key, Value). fetch(Key, D) -> Slot = get_slot(D, Key), @@ -130,9 +136,7 @@ fetch_val(K, [_|Bkt]) -> fetch_val(K, Bkt); fetch_val(_, []) -> throw(badarg). -spec find(Key, Dict) -> {'ok', Value} | 'error' when - Key :: term(), - Dict :: dict(), - Value :: term(). + Dict :: dict(Key, Value). find(Key, D) -> Slot = get_slot(D, Key), @@ -144,16 +148,16 @@ find_val(K, [_|Bkt]) -> find_val(K, Bkt); find_val(_, []) -> error. -spec fetch_keys(Dict) -> Keys when - Dict :: dict(), - Keys :: [term()]. + Dict :: dict(Key, Value :: term()), + Keys :: [Key]. fetch_keys(D) -> fold(fun (Key, _Val, Keys) -> [Key|Keys] end, [], D). -spec erase(Key, Dict1) -> Dict2 when - Key :: term(), - Dict1 :: dict(), - Dict2 :: dict(). + Dict1 :: dict(Key, Value), + Dict2 :: dict(Key, Value). + %% Erase all elements with key Key. erase(Key, D0) -> @@ -169,10 +173,8 @@ erase_key(Key, [E|Bkt0]) -> erase_key(_, []) -> {[],0}. -spec store(Key, Value, Dict1) -> Dict2 when - Key :: term(), - Value :: term(), - Dict1 :: dict(), - Dict2 :: dict(). + Dict1 :: dict(Key, Value), + Dict2 :: dict(Key, Value). store(Key, Val, D0) -> Slot = get_slot(D0, Key), @@ -189,10 +191,8 @@ store_bkt_val(Key, New, [Other|Bkt0]) -> store_bkt_val(Key, New, []) -> {[?kv(Key,New)],1}. -spec append(Key, Value, Dict1) -> Dict2 when - Key :: term(), - Value :: term(), - Dict1 :: dict(), - Dict2 :: dict(). + Dict1 :: dict(Key, Value), + Dict2 :: dict(Key, Value). append(Key, Val, D0) -> Slot = get_slot(D0, Key), @@ -209,10 +209,9 @@ append_bkt(Key, Val, [Other|Bkt0]) -> append_bkt(Key, Val, []) -> {[?kv(Key,[Val])],1}. -spec append_list(Key, ValList, Dict1) -> Dict2 when - Key :: term(), - ValList :: [Value :: term()], - Dict1 :: dict(), - Dict2 :: dict(). + Dict1 :: dict(Key, Value), + Dict2 :: dict(Key, Value), + ValList :: [Value]. append_list(Key, L, D0) -> Slot = get_slot(D0, Key), @@ -283,10 +282,9 @@ app_list_bkt(Key, L, []) -> {[?kv(Key,L)],1}. %% {[Other|Bkt1],Dc}. -spec update(Key, Fun, Dict1) -> Dict2 when - Key :: term(), - Fun :: fun((Value1 :: term()) -> Value2 :: term()), - Dict1 :: dict(), - Dict2 :: dict(). + Dict1 :: dict(Key, Value), + Dict2 :: dict(Key, Value), + Fun :: fun((Value1 :: Value) -> Value2 :: Value). update(Key, F, D0) -> Slot = get_slot(D0, Key), @@ -306,11 +304,10 @@ update_bkt(_Key, _F, []) -> throw(badarg). -spec update(Key, Fun, Initial, Dict1) -> Dict2 when - Key :: term(), - Initial :: term(), - Fun :: fun((Value1 :: term()) -> Value2 :: term()), - Dict1 :: dict(), - Dict2 :: dict(). + Dict1 :: dict(Key, Value), + Dict2 :: dict(Key, Value), + Fun :: fun((Value1 :: Value) -> Value2 :: Value), + Initial :: Value. update(Key, F, Init, D0) -> Slot = get_slot(D0, Key), @@ -326,10 +323,9 @@ update_bkt(Key, F, I, [Other|Bkt0]) -> update_bkt(Key, F, I, []) when is_function(F, 1) -> {[?kv(Key,I)],1}. -spec update_counter(Key, Increment, Dict1) -> Dict2 when - Key :: term(), - Increment :: number(), - Dict1 :: dict(), - Dict2 :: dict(). + Dict1 :: dict(Key, Value), + Dict2 :: dict(Key, Value), + Increment :: number(). update_counter(Key, Incr, D0) when is_number(Incr) -> Slot = get_slot(D0, Key), @@ -337,6 +333,8 @@ update_counter(Key, Incr, D0) when is_number(Incr) -> D0, Slot), maybe_expand(D1, Ic). +-dialyzer({no_improper_lists, counter_bkt/3}). + counter_bkt(Key, I, [?kv(Key,Val)|Bkt]) -> {[?kv(Key,Val+I)|Bkt],0}; counter_bkt(Key, I, [Other|Bkt0]) -> @@ -346,36 +344,35 @@ counter_bkt(Key, I, []) -> {[?kv(Key,I)],1}. -spec fold(Fun, Acc0, Dict) -> Acc1 when Fun :: fun((Key, Value, AccIn) -> AccOut), - Key :: term(), - Value :: term(), - Acc0 :: term(), - Acc1 :: term(), - AccIn :: term(), - AccOut :: term(), - Dict :: dict(). + Dict :: dict(Key, Value), + Acc0 :: Acc, + Acc1 :: Acc, + AccIn :: Acc, + AccOut :: Acc. + %% Fold function Fun over all "bags" in Table and return Accumulator. fold(F, Acc, D) -> fold_dict(F, Acc, D). -spec map(Fun, Dict1) -> Dict2 when - Fun :: fun((Key :: term(), Value1 :: term()) -> Value2 :: term()), - Dict1 :: dict(), - Dict2 :: dict(). + Fun :: fun((Key, Value1) -> Value2), + Dict1 :: dict(Key, Value1), + Dict2 :: dict(Key, Value2). map(F, D) -> map_dict(F, D). -spec filter(Pred, Dict1) -> Dict2 when - Pred :: fun((Key :: term(), Value :: term()) -> boolean()), - Dict1 :: dict(), - Dict2 :: dict(). + Pred :: fun((Key , Value) -> boolean()), + Dict1 :: dict(Key, Value), + Dict2 :: dict(Key, Value). filter(F, D) -> filter_dict(F, D). -spec merge(Fun, Dict1, Dict2) -> Dict3 when - Fun :: fun((Key :: term(), Value1 :: term(), Value2 :: term()) -> Value :: term()), - Dict1 :: dict(), - Dict2 :: dict(), - Dict3 :: dict(). + Fun :: fun((Key, Value1, Value2) -> Value), + Dict1 :: dict(Key, Value1), + Dict2 :: dict(Key, Value2), + Dict3 :: dict(Key, Value). merge(F, D1, D2) when D1#dict.size < D2#dict.size -> fold_dict(fun (K, V1, D) -> @@ -386,7 +383,7 @@ merge(F, D1, D2) -> update(K, fun (V1) -> F(K, V1, V2) end, V2, D) end, D1, D2). - + %% get_slot(Hashdb, Key) -> Slot. %% Get the slot. First hash on the new range, if we hit a bucket %% which has not been split use the unsplit buddy bucket. @@ -423,6 +420,8 @@ on_bucket(F, T, Slot) -> %% could have implemented map and filter using fold but these are %% faster. We hope! +fold_dict(F, Acc, #dict{size=0}) when is_function(F, 3) -> + Acc; fold_dict(F, Acc, D) -> Segs = D#dict.segs, fold_segs(F, Acc, Segs, tuple_size(Segs)). @@ -440,6 +439,8 @@ fold_bucket(F, Acc, [?kv(Key,Val)|Bkt]) -> fold_bucket(F, F(Key, Val, Acc), Bkt); fold_bucket(F, Acc, []) when is_function(F, 3) -> Acc. +map_dict(F, #dict{size=0} = Dict) when is_function(F, 2) -> + Dict; map_dict(F, D) -> Segs0 = tuple_to_list(D#dict.segs), Segs1 = map_seg_list(F, Segs0), @@ -459,6 +460,8 @@ map_bucket(F, [?kv(Key,Val)|Bkt]) -> [?kv(Key,F(Key, Val))|map_bucket(F, Bkt)]; map_bucket(F, []) when is_function(F, 2) -> []. +filter_dict(F, #dict{size=0} = Dict) when is_function(F, 2) -> + Dict; filter_dict(F, D) -> Segs0 = tuple_to_list(D#dict.segs), {Segs1,Fc} = filter_seg_list(F, Segs0, [], 0), diff --git a/lib/stdlib/src/digraph.erl b/lib/stdlib/src/digraph.erl index e3f87d2c57..8a4df95027 100644 --- a/lib/stdlib/src/digraph.erl +++ b/lib/stdlib/src/digraph.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -36,18 +37,14 @@ -export([get_short_path/3, get_short_cycle/2]). --export_type([digraph/0, d_type/0, vertex/0]). +-export_type([graph/0, d_type/0, vertex/0, edge/0, label/0]). -record(digraph, {vtab = notable :: ets:tab(), etab = notable :: ets:tab(), ntab = notable :: ets:tab(), cyclic = true :: boolean()}). -%% A declaration equivalent to the following one is hard-coded in erl_types. -%% That declaration contains hard-coded information about the #digraph{} -%% record and the types of its fields. So, please make sure that any -%% changes to its structure are also propagated to erl_types.erl. -%% -%% -opaque digraph() :: #digraph{}. + +-opaque graph() :: #digraph{}. -type edge() :: term(). -type label() :: term(). @@ -67,11 +64,11 @@ -type d_cyclicity() :: 'acyclic' | 'cyclic'. -type d_type() :: d_cyclicity() | d_protection(). --spec new() -> digraph(). +-spec new() -> graph(). new() -> new([]). --spec new(Type) -> digraph() when +-spec new(Type) -> graph() when Type :: [d_type()]. new(Type) -> @@ -106,7 +103,7 @@ check_type(_, _, _) -> error. %% %% Set graph type %% --spec set_type([{'cyclic', boolean()}], digraph()) -> digraph(). +-spec set_type([{'cyclic', boolean()}], graph()) -> graph(). set_type([{cyclic,V} | Ks], G) -> set_type(Ks, G#digraph{cyclic = V}); @@ -116,7 +113,7 @@ set_type([], G) -> G. %% Data access functions -spec delete(G) -> 'true' when - G :: digraph(). + G :: graph(). delete(G) -> ets:delete(G#digraph.vtab), @@ -124,7 +121,7 @@ delete(G) -> ets:delete(G#digraph.ntab). -spec info(G) -> InfoList when - G :: digraph(), + G :: graph(), InfoList :: [{'cyclicity', Cyclicity :: d_cyclicity()} | {'memory', NoWords :: non_neg_integer()} | {'protection', Protection :: d_protection()}]. @@ -142,20 +139,20 @@ info(G) -> [{cyclicity, Cyclicity}, {memory, Memory}, {protection, Protection}]. -spec add_vertex(G) -> vertex() when - G :: digraph(). + G :: graph(). add_vertex(G) -> do_add_vertex({new_vertex_id(G), []}, G). -spec add_vertex(G, V) -> vertex() when - G :: digraph(), + G :: graph(), V :: vertex(). add_vertex(G, V) -> do_add_vertex({V, []}, G). -spec add_vertex(G, V, Label) -> vertex() when - G :: digraph(), + G :: graph(), V :: vertex(), Label :: label(). @@ -163,21 +160,21 @@ add_vertex(G, V, D) -> do_add_vertex({V, D}, G). -spec del_vertex(G, V) -> 'true' when - G :: digraph(), + G :: graph(), V :: vertex(). del_vertex(G, V) -> do_del_vertex(V, G). -spec del_vertices(G, Vertices) -> 'true' when - G :: digraph(), + G :: graph(), Vertices :: [vertex()]. del_vertices(G, Vs) -> do_del_vertices(Vs, G). -spec vertex(G, V) -> {V, Label} | 'false' when - G :: digraph(), + G :: graph(), V :: vertex(), Label :: label(). @@ -188,37 +185,37 @@ vertex(G, V) -> end. -spec no_vertices(G) -> non_neg_integer() when - G :: digraph(). + G :: graph(). no_vertices(G) -> ets:info(G#digraph.vtab, size). -spec vertices(G) -> Vertices when - G :: digraph(), + G :: graph(), Vertices :: [vertex()]. vertices(G) -> ets:select(G#digraph.vtab, [{{'$1', '_'}, [], ['$1']}]). --spec source_vertices(digraph()) -> [vertex()]. +-spec source_vertices(graph()) -> [vertex()]. source_vertices(G) -> collect_vertices(G, in). --spec sink_vertices(digraph()) -> [vertex()]. +-spec sink_vertices(graph()) -> [vertex()]. sink_vertices(G) -> collect_vertices(G, out). -spec in_degree(G, V) -> non_neg_integer() when - G :: digraph(), + G :: graph(), V :: vertex(). in_degree(G, V) -> length(ets:lookup(G#digraph.ntab, {in, V})). -spec in_neighbours(G, V) -> Vertex when - G :: digraph(), + G :: graph(), V :: vertex(), Vertex :: [vertex()]. @@ -228,7 +225,7 @@ in_neighbours(G, V) -> collect_elems(ets:lookup(NT, {in, V}), ET, 2). -spec in_edges(G, V) -> Edges when - G :: digraph(), + G :: graph(), V :: vertex(), Edges :: [edge()]. @@ -236,14 +233,14 @@ in_edges(G, V) -> ets:select(G#digraph.ntab, [{{{in, V}, '$1'}, [], ['$1']}]). -spec out_degree(G, V) -> non_neg_integer() when - G :: digraph(), + G :: graph(), V :: vertex(). out_degree(G, V) -> length(ets:lookup(G#digraph.ntab, {out, V})). -spec out_neighbours(G, V) -> Vertices when - G :: digraph(), + G :: graph(), V :: vertex(), Vertices :: [vertex()]. @@ -253,7 +250,7 @@ out_neighbours(G, V) -> collect_elems(ets:lookup(NT, {out, V}), ET, 3). -spec out_edges(G, V) -> Edges when - G :: digraph(), + G :: graph(), V :: vertex(), Edges :: [edge()]. @@ -261,7 +258,7 @@ out_edges(G, V) -> ets:select(G#digraph.ntab, [{{{out, V}, '$1'}, [], ['$1']}]). -spec add_edge(G, V1, V2) -> edge() | {'error', add_edge_err_rsn()} when - G :: digraph(), + G :: graph(), V1 :: vertex(), V2 :: vertex(). @@ -269,7 +266,7 @@ add_edge(G, V1, V2) -> do_add_edge({new_edge_id(G), V1, V2, []}, G). -spec add_edge(G, V1, V2, Label) -> edge() | {'error', add_edge_err_rsn()} when - G :: digraph(), + G :: graph(), V1 :: vertex(), V2 :: vertex(), Label :: label(). @@ -278,7 +275,7 @@ add_edge(G, V1, V2, D) -> do_add_edge({new_edge_id(G), V1, V2, D}, G). -spec add_edge(G, E, V1, V2, Label) -> edge() | {'error', add_edge_err_rsn()} when - G :: digraph(), + G :: graph(), E :: edge(), V1 :: vertex(), V2 :: vertex(), @@ -288,34 +285,34 @@ add_edge(G, E, V1, V2, D) -> do_add_edge({E, V1, V2, D}, G). -spec del_edge(G, E) -> 'true' when - G :: digraph(), + G :: graph(), E :: edge(). del_edge(G, E) -> do_del_edges([E], G). -spec del_edges(G, Edges) -> 'true' when - G :: digraph(), + G :: graph(), Edges :: [edge()]. del_edges(G, Es) -> do_del_edges(Es, G). -spec no_edges(G) -> non_neg_integer() when - G :: digraph(). + G :: graph(). no_edges(G) -> ets:info(G#digraph.etab, size). -spec edges(G) -> Edges when - G :: digraph(), + G :: graph(), Edges :: [edge()]. edges(G) -> ets:select(G#digraph.etab, [{{'$1', '_', '_', '_'}, [], ['$1']}]). -spec edges(G, V) -> Edges when - G :: digraph(), + G :: graph(), V :: vertex(), Edges :: [edge()]. @@ -324,7 +321,7 @@ edges(G, V) -> {{{in, V}, '$1'}, [], ['$1']}]). -spec edge(G, E) -> {E, V1, V2, Label} | 'false' when - G :: digraph(), + G :: graph(), E :: edge(), V1 :: vertex(), V2 :: vertex(), @@ -339,7 +336,9 @@ edge(G, E) -> %% %% Generate a "unique" edge identifier (relative to this graph) %% --spec new_edge_id(digraph()) -> edge(). +-spec new_edge_id(graph()) -> edge(). + +-dialyzer({no_improper_lists, new_edge_id/1}). new_edge_id(G) -> NT = G#digraph.ntab, @@ -351,7 +350,9 @@ new_edge_id(G) -> %% %% Generate a "unique" vertex identifier (relative to this graph) %% --spec new_vertex_id(digraph()) -> vertex(). +-spec new_vertex_id(graph()) -> vertex(). + +-dialyzer({no_improper_lists, new_vertex_id/1}). new_vertex_id(G) -> NT = G#digraph.ntab, @@ -371,7 +372,7 @@ collect_elems([{_,Key}|Keys], Table, Index, Acc) -> [ets:lookup_element(Table, Key, Index)|Acc]); collect_elems([], _, _, Acc) -> Acc. --spec do_add_vertex({vertex(), label()}, digraph()) -> vertex(). +-spec do_add_vertex({vertex(), label()}, graph()) -> vertex(). do_add_vertex({V, _Label} = VL, G) -> ets:insert(G#digraph.vtab, VL), @@ -430,14 +431,14 @@ do_del_edge(E, V1, V2, G) -> {{{out,V1}, E}, [], [true]}]), ets:delete(G#digraph.etab, E). --spec rm_edges([vertex(),...], digraph()) -> 'true'. +-spec rm_edges([vertex(),...], graph()) -> 'true'. rm_edges([V1, V2|Vs], G) -> rm_edge(V1, V2, G), rm_edges([V2|Vs], G); rm_edges(_, _) -> true. --spec rm_edge(vertex(), vertex(), digraph()) -> 'ok'. +-spec rm_edge(vertex(), vertex(), graph()) -> 'ok'. rm_edge(V1, V2, G) -> Es = out_edges(G, V1), @@ -456,7 +457,7 @@ rm_edge_0([], _, _, #digraph{}) -> ok. %% %% Check that endpoints exist %% --spec do_add_edge({edge(), vertex(), vertex(), label()}, digraph()) -> +-spec do_add_edge({edge(), vertex(), vertex(), label()}, graph()) -> edge() | {'error', add_edge_err_rsn()}. do_add_edge({E, V1, V2, Label}, G) -> @@ -484,14 +485,14 @@ other_edge_exists(#digraph{etab = ET}, E, V1, V2) -> false end. --spec do_insert_edge(edge(), vertex(), vertex(), label(), digraph()) -> edge(). +-spec do_insert_edge(edge(), vertex(), vertex(), label(), graph()) -> edge(). do_insert_edge(E, V1, V2, Label, #digraph{ntab=NT, etab=ET}) -> ets:insert(NT, [{{out, V1}, E}, {{in, V2}, E}]), ets:insert(ET, {E, V1, V2, Label}), E. --spec acyclic_add_edge(edge(), vertex(), vertex(), label(), digraph()) -> +-spec acyclic_add_edge(edge(), vertex(), vertex(), label(), graph()) -> edge() | {'error', {'bad_edge', [vertex()]}}. acyclic_add_edge(_E, V1, V2, _L, _G) when V1 =:= V2 -> @@ -507,7 +508,7 @@ acyclic_add_edge(E, V1, V2, Label, G) -> %% -spec del_path(G, V1, V2) -> 'true' when - G :: digraph(), + G :: graph(), V1 :: vertex(), V2 :: vertex(). @@ -529,7 +530,7 @@ del_path(G, V1, V2) -> %% -spec get_cycle(G, V) -> Vertices | 'false' when - G :: digraph(), + G :: graph(), V :: vertex(), Vertices :: [vertex(),...]. @@ -550,7 +551,7 @@ get_cycle(G, V) -> %% -spec get_path(G, V1, V2) -> Vertices | 'false' when - G :: digraph(), + G :: graph(), V1 :: vertex(), V2 :: vertex(), Vertices :: [vertex(),...]. @@ -589,7 +590,7 @@ one_path([], _, [], _, _, _, _, _Counter) -> false. %% -spec get_short_cycle(G, V) -> Vertices | 'false' when - G :: digraph(), + G :: graph(), V :: vertex(), Vertices :: [vertex(),...]. @@ -602,7 +603,7 @@ get_short_cycle(G, V) -> %% -spec get_short_path(G, V1, V2) -> Vertices | 'false' when - G :: digraph(), + G :: graph(), V1 :: vertex(), V2 :: vertex(), Vertices :: [vertex(),...]. diff --git a/lib/stdlib/src/digraph_utils.erl b/lib/stdlib/src/digraph_utils.erl index 807b5c12a1..4aa9ae810d 100644 --- a/lib/stdlib/src/digraph_utils.erl +++ b/lib/stdlib/src/digraph_utils.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -43,28 +44,28 @@ %% -spec components(Digraph) -> [Component] when - Digraph :: digraph(), + Digraph :: digraph:graph(), Component :: [digraph:vertex()]. components(G) -> forest(G, fun inout/3). -spec strong_components(Digraph) -> [StrongComponent] when - Digraph :: digraph(), + Digraph :: digraph:graph(), StrongComponent :: [digraph:vertex()]. strong_components(G) -> forest(G, fun in/3, revpostorder(G)). -spec cyclic_strong_components(Digraph) -> [StrongComponent] when - Digraph :: digraph(), + Digraph :: digraph:graph(), StrongComponent :: [digraph:vertex()]. cyclic_strong_components(G) -> remove_singletons(strong_components(G), G, []). -spec reachable(Vertices, Digraph) -> Reachable when - Digraph :: digraph(), + Digraph :: digraph:graph(), Vertices :: [digraph:vertex()], Reachable :: [digraph:vertex()]. @@ -72,7 +73,7 @@ reachable(Vs, G) when is_list(Vs) -> lists:append(forest(G, fun out/3, Vs, first)). -spec reachable_neighbours(Vertices, Digraph) -> Reachable when - Digraph :: digraph(), + Digraph :: digraph:graph(), Vertices :: [digraph:vertex()], Reachable :: [digraph:vertex()]. @@ -80,7 +81,7 @@ reachable_neighbours(Vs, G) when is_list(Vs) -> lists:append(forest(G, fun out/3, Vs, not_first)). -spec reaching(Vertices, Digraph) -> Reaching when - Digraph :: digraph(), + Digraph :: digraph:graph(), Vertices :: [digraph:vertex()], Reaching :: [digraph:vertex()]. @@ -88,7 +89,7 @@ reaching(Vs, G) when is_list(Vs) -> lists:append(forest(G, fun in/3, Vs, first)). -spec reaching_neighbours(Vertices, Digraph) -> Reaching when - Digraph :: digraph(), + Digraph :: digraph:graph(), Vertices :: [digraph:vertex()], Reaching :: [digraph:vertex()]. @@ -96,7 +97,7 @@ reaching_neighbours(Vs, G) when is_list(Vs) -> lists:append(forest(G, fun in/3, Vs, not_first)). -spec topsort(Digraph) -> Vertices | 'false' when - Digraph :: digraph(), + Digraph :: digraph:graph(), Vertices :: [digraph:vertex()]. topsort(G) -> @@ -107,13 +108,13 @@ topsort(G) -> end. -spec is_acyclic(Digraph) -> boolean() when - Digraph :: digraph(). + Digraph :: digraph:graph(). is_acyclic(G) -> loop_vertices(G) =:= [] andalso topsort(G) =/= false. -spec arborescence_root(Digraph) -> 'no' | {'yes', Root} when - Digraph :: digraph(), + Digraph :: digraph:graph(), Root :: digraph:vertex(). arborescence_root(G) -> @@ -136,29 +137,29 @@ arborescence_root(G) -> end. -spec is_arborescence(Digraph) -> boolean() when - Digraph :: digraph(). + Digraph :: digraph:graph(). is_arborescence(G) -> arborescence_root(G) =/= no. -spec is_tree(Digraph) -> boolean() when - Digraph :: digraph(). + Digraph :: digraph:graph(). is_tree(G) -> (digraph:no_edges(G) =:= digraph:no_vertices(G) - 1) andalso (length(components(G)) =:= 1). -spec loop_vertices(Digraph) -> Vertices when - Digraph :: digraph(), + Digraph :: digraph:graph(), Vertices :: [digraph:vertex()]. loop_vertices(G) -> [V || V <- digraph:vertices(G), is_reflexive_vertex(V, G)]. -spec subgraph(Digraph, Vertices) -> SubGraph when - Digraph :: digraph(), + Digraph :: digraph:graph(), Vertices :: [digraph:vertex()], - SubGraph :: digraph(). + SubGraph :: digraph:graph(). subgraph(G, Vs) -> try @@ -169,8 +170,8 @@ subgraph(G, Vs) -> end. -spec subgraph(Digraph, Vertices, Options) -> SubGraph when - Digraph :: digraph(), - SubGraph :: digraph(), + Digraph :: digraph:graph(), + SubGraph :: digraph:graph(), Vertices :: [digraph:vertex()], Options :: [{'type', SubgraphType} | {'keep_labels', boolean()}], SubgraphType :: 'inherit' | [digraph:d_type()]. @@ -184,8 +185,8 @@ subgraph(G, Vs, Opts) -> end. -spec condensation(Digraph) -> CondensedDigraph when - Digraph :: digraph(), - CondensedDigraph :: digraph(). + Digraph :: digraph:graph(), + CondensedDigraph :: digraph:graph(). condensation(G) -> SCs = strong_components(G), @@ -209,14 +210,14 @@ condensation(G) -> SCG. -spec preorder(Digraph) -> Vertices when - Digraph :: digraph(), + Digraph :: digraph:graph(), Vertices :: [digraph:vertex()]. preorder(G) -> lists:reverse(revpreorder(G)). -spec postorder(Digraph) -> Vertices when - Digraph :: digraph(), + Digraph :: digraph:graph(), Vertices :: [digraph:vertex()]. postorder(G) -> @@ -370,5 +371,5 @@ condense('$end_of_table', _T, _SC, _G, _SCG, _I2C) -> condense(I, T, SC, G, SCG, I2C) -> [{_,C}] = ets:lookup(I2C, I), digraph:add_vertex(SCG, C), - [digraph:add_edge(SCG, SC, C) || C =/= SC], + _ = [digraph:add_edge(SCG, SC, C) || C =/= SC], condense(ets:next(T, I), T, SC, G, SCG, I2C). diff --git a/lib/stdlib/src/edlin.erl b/lib/stdlib/src/edlin.erl index 026bd9038f..71e8471c45 100644 --- a/lib/stdlib/src/edlin.erl +++ b/lib/stdlib/src/edlin.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -21,10 +22,10 @@ %% A simple Emacs-like line editor. %% About Latin-1 characters: see the beginning of erl_scan.erl. --export([init/0,start/1,edit_line/2,prefix_arg/1]). +-export([init/0,init/1,start/1,start/2,edit_line/2,prefix_arg/1]). -export([erase_line/1,erase_inp/1,redraw_line/1]). -export([length_before/1,length_after/1,prompt/1]). --export([current_line/1]). +-export([current_line/1, current_chars/1]). %%-export([expand/1]). -export([edit_line1/2]). @@ -44,6 +45,20 @@ init() -> put(kill_buffer, []). +init(Pid) -> + %% copy the kill_buffer from the process Pid + CopiedKillBuf = + case erlang:process_info(Pid, dictionary) of + {dictionary,Dict} -> + case proplists:get_value(kill_buffer, Dict) of + undefined -> []; + Buf -> Buf + end; + undefined -> + [] + end, + put(kill_buffer, CopiedKillBuf). + %% start(Prompt) %% edit(Characters, Continuation) %% Return @@ -53,7 +68,12 @@ init() -> %% {undefined,Char,Rest,Cont,Requests} start(Pbs) -> - {more_chars,{line,Pbs,{[],[]},none},[{put_chars,unicode,Pbs}]}. + start(Pbs, none). + +%% Only two modes used: 'none' and 'search'. Other modes can be +%% handled inline through specific character handling. +start(Pbs, Mode) -> + {more_chars,{line,Pbs,{[],[]},Mode},[{put_chars,unicode,Pbs}]}. edit_line(Cs, {line,P,L,{blink,N}}) -> edit(Cs, P, L, none, [{move_rel,N}]); @@ -73,8 +93,20 @@ edit([C|Cs], P, {Bef,Aft}, Prefix, Rs0) -> case key_map(C, Prefix) of meta -> edit(Cs, P, {Bef,Aft}, meta, Rs0); + meta_o -> + edit(Cs, P, {Bef,Aft}, meta_o, Rs0); + meta_csi -> + edit(Cs, P, {Bef,Aft}, meta_csi, Rs0); + meta_meta -> + edit(Cs, P, {Bef,Aft}, meta_meta, Rs0); + {csi, _} = Csi -> + edit(Cs, P, {Bef,Aft}, Csi, Rs0); meta_left_sq_bracket -> edit(Cs, P, {Bef,Aft}, meta_left_sq_bracket, Rs0); + search_meta -> + edit(Cs, P, {Bef,Aft}, search_meta, Rs0); + search_meta_left_sq_bracket -> + edit(Cs, P, {Bef,Aft}, search_meta_left_sq_bracket, Rs0); ctlx -> edit(Cs, P, {Bef,Aft}, ctlx, Rs0); new_line -> @@ -114,6 +146,8 @@ edit([C|Cs], P, {Bef,Aft}, Prefix, Rs0) -> case do_op(Op, Bef, Aft, Rs0) of {blink,N,Line,Rs} -> edit(Cs, P, Line, {blink,N}, Rs); + {Line, Rs, Mode} -> % allow custom modes from do_op + edit(Cs, P, Line, Mode, Rs); {Line,Rs} -> edit(Cs, P, Line, none, Rs) end @@ -166,10 +200,17 @@ key_map($\^U, none) -> ctlu; key_map($\^], none) -> auto_blink; key_map($\^X, none) -> ctlx; key_map($\^Y, none) -> yank; +key_map($\^W, none) -> backward_kill_word; key_map($\e, none) -> meta; -key_map($), Prefix) when Prefix =/= meta -> {blink,$),$(}; -key_map($}, Prefix) when Prefix =/= meta -> {blink,$},${}; -key_map($], Prefix) when Prefix =/= meta -> {blink,$],$[}; +key_map($), Prefix) when Prefix =/= meta, + Prefix =/= search, + Prefix =/= search_meta -> {blink,$),$(}; +key_map($}, Prefix) when Prefix =/= meta, + Prefix =/= search, + Prefix =/= search_meta -> {blink,$},${}; +key_map($], Prefix) when Prefix =/= meta, + Prefix =/= search, + Prefix =/= search_meta -> {blink,$],$[}; key_map($B, meta) -> backward_word; key_map($D, meta) -> kill_word; key_map($F, meta) -> forward_word; @@ -180,13 +221,61 @@ key_map($d, meta) -> kill_word; key_map($f, meta) -> forward_word; key_map($t, meta) -> transpose_word; key_map($y, meta) -> yank_pop; +key_map($O, meta) -> meta_o; +key_map($H, meta_o) -> beginning_of_line; +key_map($F, meta_o) -> end_of_line; key_map($\177, none) -> backward_delete_char; key_map($\177, meta) -> backward_kill_word; key_map($[, meta) -> meta_left_sq_bracket; +key_map($H, meta_left_sq_bracket) -> beginning_of_line; +key_map($F, meta_left_sq_bracket) -> end_of_line; key_map($D, meta_left_sq_bracket) -> backward_char; key_map($C, meta_left_sq_bracket) -> forward_char; +% support a few <CTRL>+<CURSOR LEFT|RIGHT> combinations... +% - forward: \e\e[C, \e[5C, \e[1;5C +% - backward: \e\e[D, \e[5D, \e[1;5D +key_map($\e, meta) -> meta_meta; +key_map($[, meta_meta) -> meta_csi; +key_map($C, meta_csi) -> forward_word; +key_map($D, meta_csi) -> backward_word; +key_map($1, meta_left_sq_bracket) -> {csi, "1"}; +key_map($3, meta_left_sq_bracket) -> {csi, "3"}; +key_map($5, meta_left_sq_bracket) -> {csi, "5"}; +key_map($5, {csi, "1;"}) -> {csi, "1;5"}; +key_map($~, {csi, "3"}) -> forward_delete_char; +key_map($C, {csi, "5"}) -> forward_word; +key_map($C, {csi, "1;5"}) -> forward_word; +key_map($D, {csi, "5"}) -> backward_word; +key_map($D, {csi, "1;5"}) -> backward_word; +key_map($;, {csi, "1"}) -> {csi, "1;"}; key_map(C, none) when C >= $\s -> {insert,C}; +%% for search, we need smarter line handling and so +%% we cheat a bit on the dispatching, and allow to +%% return a mode. +key_map($\^H, search) -> {search, backward_delete_char}; +key_map($\177, search) -> {search, backward_delete_char}; +key_map($\^R, search) -> {search, skip_up}; +key_map($\^S, search) -> {search, skip_down}; +key_map($\n, search) -> {search, search_found}; +key_map($\r, search) -> {search, search_found}; +key_map($\^A, search) -> {search, search_quit}; +key_map($\^B, search) -> {search, search_quit}; +key_map($\^D, search) -> {search, search_quit}; +key_map($\^E, search) -> {search, search_quit}; +key_map($\^F, search) -> {search, search_quit}; +key_map($\t, search) -> {search, search_quit}; +key_map($\^L, search) -> {search, search_quit}; +key_map($\^T, search) -> {search, search_quit}; +key_map($\^U, search) -> {search, search_quit}; +key_map($\^], search) -> {search, search_quit}; +key_map($\^X, search) -> {search, search_quit}; +key_map($\^Y, search) -> {search, search_quit}; +key_map($\e, search) -> search_meta; +key_map($[, search_meta) -> search_meta_left_sq_bracket; +key_map(_, search_meta) -> {search, search_quit}; +key_map(_C, search_meta_left_sq_bracket) -> {search, search_quit}; +key_map(C, search) -> {insert_search,C}; key_map(C, _) -> {undefined,C}. %% do_op(Action, Before, After, Requests) @@ -195,6 +284,57 @@ do_op({insert,C}, Bef, [], Rs) -> {{[C|Bef],[]},[{put_chars, unicode,[C]}|Rs]}; do_op({insert,C}, Bef, Aft, Rs) -> {{[C|Bef],Aft},[{insert_chars, unicode, [C]}|Rs]}; +%% Search mode prompt always looks like (search)`$TERMS': $RESULT. +%% the {insert_search, _} handlings allow to share this implementation +%% correctly with group.erl. This module provides $TERMS, and group.erl +%% is in charge of providing $RESULT. +%% This require a bit of trickery. Because search disables moving around +%% on the line (left/right arrow keys and other shortcuts that just exit +%% search mode), we can use the Bef and Aft variables to hold each +%% part of the line. Bef takes charge of "(search)`$TERMS" and Aft +%% takes charge of "': $RESULT". +do_op({insert_search, C}, Bef, [], Rs) -> + Aft="': ", + {{[C|Bef],Aft}, + [{insert_chars, unicode, [C]++Aft}, {delete_chars,-3} | Rs], + search}; +do_op({insert_search, C}, Bef, Aft, Rs) -> + Offset= length(Aft), + NAft = "': ", + {{[C|Bef],NAft}, + [{insert_chars, unicode, [C]++NAft}, {delete_chars,-Offset} | Rs], + search}; +do_op({search, backward_delete_char}, [_|Bef], Aft, Rs) -> + Offset= length(Aft)+1, + NAft = "': ", + {{Bef,NAft}, + [{insert_chars, unicode, NAft}, {delete_chars,-Offset}|Rs], + search}; +do_op({search, backward_delete_char}, [], _Aft, Rs) -> + Aft="': ", + {{[],Aft}, Rs, search}; +do_op({search, skip_up}, Bef, Aft, Rs) -> + Offset= length(Aft), + NAft = "': ", + {{[$\^R|Bef],NAft}, % we insert ^R as a flag to whoever called us + [{insert_chars, unicode, NAft}, {delete_chars,-Offset}|Rs], + search}; +do_op({search, skip_down}, Bef, Aft, Rs) -> + Offset= length(Aft), + NAft = "': ", + {{[$\^S|Bef],NAft}, % we insert ^S as a flag to whoever called us + [{insert_chars, unicode, NAft}, {delete_chars,-Offset}|Rs], + search}; +do_op({search, search_found}, _Bef, Aft, Rs) -> + "': "++NAft = Aft, + {{[],NAft}, + [{put_chars, unicode, "\n"}, {move_rel,-length(Aft)} | Rs], + search_found}; +do_op({search, search_quit}, _Bef, Aft, Rs) -> + "': "++NAft = Aft, + {{[],NAft}, + [{put_chars, unicode, "\n"}, {move_rel,-length(Aft)} | Rs], + search_quit}; %% do blink after $$ do_op({blink,C,M}, Bef=[$$,$$|_], Aft, Rs) -> N = over_paren(Bef, C, M), @@ -268,6 +408,9 @@ do_op(end_of_line, Bef, [C|Aft], Rs) -> {{reverse(Aft, [C|Bef]),[]},[{move_rel,length(Aft)+1}|Rs]}; do_op(end_of_line, Bef, [], Rs) -> {{Bef,[]},Rs}; +do_op(ctlu, Bef, Aft, Rs) -> + put(kill_buffer, reverse(Bef)), + {{[], Aft}, [{delete_chars, -length(Bef)} | Rs]}; do_op(beep, Bef, Aft, Rs) -> {{Bef,Aft},[beep|Rs]}; do_op(_, Bef, Aft, Rs) -> @@ -317,12 +460,11 @@ over_non_word([], Stack, N) -> {[],Stack,N}. word_char(C) when C >= $A, C =< $Z -> true; -word_char(C) when C >= $�, C =< $�, C =/= $� -> true; +word_char(C) when C >= $À, C =< $Þ, C =/= $× -> true; word_char(C) when C >= $a, C =< $z -> true; -word_char(C) when C >= $�, C =< $�, C =/= $� -> true; +word_char(C) when C >= $ß, C =< $ÿ, C =/= $÷ -> true; word_char(C) when C >= $0, C =< $9 -> true; word_char(C) when C =:= $_ -> true; -word_char(C) when C =:= $. -> true; % accept dot-separated names word_char(_) -> false. %% over_white(Chars, InitialStack, InitialCount) -> @@ -452,6 +594,9 @@ prompt({line,Pbs,_,_}) -> current_line({line,_,{Bef, Aft},_}) -> reverse(Bef, Aft ++ "\n"). +current_chars({line,_,{Bef,Aft},_}) -> + reverse(Bef, Aft). + %% %% expand(CurrentBefore) -> %% %% {yes,Expansion} | no %% %% Try to expand the word before as either a module name or a function diff --git a/lib/stdlib/src/edlin_expand.erl b/lib/stdlib/src/edlin_expand.erl index 516c0aa30b..5f821caef0 100644 --- a/lib/stdlib/src/edlin_expand.erl +++ b/lib/stdlib/src/edlin_expand.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -73,7 +74,7 @@ to_atom(Str) -> error end. -match(Prefix, Alts, Extra) -> +match(Prefix, Alts, Extra0) -> Len = length(Prefix), Matches = lists:sort( [{S, A} || {H, A} <- Alts, @@ -89,7 +90,11 @@ match(Prefix, Alts, Extra) -> {yes, Remain, []} end; {complete, Str} -> - {yes, nthtail(Len, Str) ++ Extra, []}; + Extra = case {Extra0,Matches} of + {"(",[{Str,0}]} -> "()"; + {_,_} -> Extra0 + end, + {yes, nthtail(Len, Str) ++ Extra, []}; no -> {no, [], []} end. @@ -113,7 +118,7 @@ format_col([A|T], Width, Len, Acc0) -> {H1, _} -> H1; H2 -> H2 end, - Acc = [io_lib:format("~-*s", [Width,H]) | Acc0], + Acc = [io_lib:format("~-*ts", [Width,H]) | Acc0], format_col(T, Width, Len+Width, Acc); format_col([], _, _, Acc) -> lists:reverse(Acc, "\n"). diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 2c8d84a9e1..40eba4ad67 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% @@ -20,38 +21,62 @@ %% An Erlang code preprocessor. --export([open/2,open/3,open/5,close/1,format_error/1]). +-export([open/1, open/2,open/3,open/5,close/1,format_error/1]). -export([scan_erl_form/1,parse_erl_form/1,macro_defs/1]). --export([parse_file/1, parse_file/3]). +-export([parse_file/1, parse_file/2, parse_file/3]). +-export([default_encoding/0, encoding_to_string/1, + read_encoding_from_binary/1, read_encoding_from_binary/2, + set_encoding/1, set_encoding/2, read_encoding/1, read_encoding/2]). -export([interpret_file_attribute/1]). -export([normalize_typed_record_fields/1,restore_typed_record_fields/1]). %%------------------------------------------------------------------------ --type macros() :: [{atom(), term()}]. +-export_type([source_encoding/0]). + +-type macros() :: [atom() | {atom(), term()}]. -type epp_handle() :: pid(). +-type source_encoding() :: latin1 | utf8. + +-type ifdef() :: 'ifdef' | 'ifndef' | 'else'. + +-type name() :: atom(). +-type argspec() :: 'none' %No arguments + | non_neg_integer(). %Number of arguments +-type argnames() :: [atom()]. +-type tokens() :: [erl_scan:token()]. +-type predef() :: 'undefined' | {'none', tokens()}. +-type userdef() :: {argspec(), {argnames(), tokens()}}. +-type used() :: {name(), argspec()}. + +-type function_name_type() :: 'undefined' + | {atom(),non_neg_integer()} + | tokens(). + +-type warning_info() :: {erl_anno:location(), module(), term()}. + +-define(DEFAULT_ENCODING, utf8). %% Epp state record. --record(epp, {file, %Current file - location, %Current location - delta, %Offset from Location (-file) - name="", %Current file name - name2="", %-"-, modified by -file - istk=[], %Ifdef stack - sstk=[], %State stack - path=[], %Include-path - macs = dict:new() :: dict(), %Macros (don't care locations) - uses = dict:new() :: dict(), %Macro use structure - pre_opened = false :: boolean() +-record(epp, {file :: file:io_device() + | 'undefined', %Current file + location=1, %Current location + delta=0 :: non_neg_integer(), %Offset from Location (-file) + name="" :: file:name(), %Current file name + name2="" :: file:name(), %-"-, modified by -file + istk=[] :: [ifdef()], %Ifdef stack + sstk=[] :: [#epp{}], %State stack + path=[] :: [file:name()], %Include-path + macs = #{} %Macros (don't care locations) + :: #{name() => predef() | [userdef()]}, + uses = #{} %Macro use structure + :: #{name() => [{argspec(), [used()]}]}, + default_encoding = ?DEFAULT_ENCODING :: source_encoding(), + pre_opened = false :: boolean(), + fname = [] :: function_name_type() }). -%%% Note on representation: as tokens, both {var, Location, Name} and -%%% {atom, Location, Name} can occur as macro identifiers. However, keeping -%%% this distinction here is done for historical reasons only: previously, -%%% ?FOO and ?'FOO' were not the same, but now they are. Removing the -%%% distinction in the internal representation would simplify the code -%%% a little. - +%% open(Options) %% open(FileName, IncludePath) %% open(FileName, IncludePath, PreDefMacros) %% open(FileName, IoDevice, StartLocation, IncludePath, PreDefMacros) @@ -59,6 +84,7 @@ %% scan_erl_form(Epp) %% parse_erl_form(Epp) %% parse_file(Epp) +%% parse_file(FileName, Options) %% parse_file(FileName, IncludePath, PreDefMacros) %% macro_defs(Epp) @@ -81,14 +107,43 @@ open(Name, Path) -> ErrorDescriptor :: term(). open(Name, Path, Pdm) -> - Self = self(), - Epp = spawn(fun() -> server(Self, Name, Path, Pdm) end), - epp_request(Epp). + internal_open([{name, Name}, {includes, Path}, {macros, Pdm}], #epp{}). open(Name, File, StartLocation, Path, Pdm) -> - Self = self(), - Epp = spawn(fun() -> server(Self, Name, File, StartLocation,Path,Pdm) end), - epp_request(Epp). + internal_open([{name, Name}, {includes, Path}, {macros, Pdm}], + #epp{file=File, pre_opened=true, location=StartLocation}). + +-spec open(Options) -> + {'ok', Epp} | {'ok', Epp, Extra} | {'error', ErrorDescriptor} when + Options :: [{'default_encoding', DefEncoding :: source_encoding()} | + {'includes', IncludePath :: [DirectoryName :: file:name()]} | + {'macros', PredefMacros :: macros()} | + {'name',FileName :: file:name()} | + 'extra'], + Epp :: epp_handle(), + Extra :: [{'encoding', source_encoding() | 'none'}], + ErrorDescriptor :: term(). + +open(Options) -> + internal_open(Options, #epp{}). + +internal_open(Options, St) -> + case proplists:get_value(name, Options) of + undefined -> + erlang:error(badarg); + Name -> + Self = self(), + Epp = spawn(fun() -> server(Self, Name, Options, St) end), + case epp_request(Epp) of + {ok, Pid, Encoding} -> + case proplists:get_bool(extra, Options) of + true -> {ok, Pid, [{encoding, Encoding}]}; + false -> {ok, Pid} + end; + Other -> + Other + end + end. -spec close(Epp) -> 'ok' when Epp :: epp_handle(). @@ -105,11 +160,13 @@ scan_erl_form(Epp) -> epp_request(Epp, scan_erl_form). -spec parse_erl_form(Epp) -> - {'ok', AbsForm} | {'eof', Line} | {error, ErrorInfo} when + {'ok', AbsForm} | {error, ErrorInfo} | + {'warning',WarningInfo} | {'eof',Line} when Epp :: epp_handle(), AbsForm :: erl_parse:abstract_form(), - Line :: erl_scan:line(), - ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(). + Line :: erl_anno:line(), + ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(), + WarningInfo :: warning_info(). parse_erl_form(Epp) -> case epp_request(Epp, scan_erl_form) of @@ -160,59 +217,278 @@ format_error({include,W,F}) -> io_lib:format("can't find include ~s \"~s\"", [W,F]); format_error({illegal,How,What}) -> io_lib:format("~s '-~s'", [How,What]); +format_error({illegal_function,Macro}) -> + io_lib:format("?~s can only be used within a function", [Macro]); +format_error({illegal_function_usage,Macro}) -> + io_lib:format("?~s must not begin a form", [Macro]); format_error({'NYI',What}) -> io_lib:format("not yet implemented '~s'", [What]); +format_error({error,Term}) -> + io_lib:format("-error(~p).", [Term]); +format_error({warning,Term}) -> + io_lib:format("-warning(~p).", [Term]); format_error(E) -> file:format_error(E). -%% parse_file(FileName, IncludePath, [PreDefMacro]) -> -%% {ok,[Form]} | {error,OpenError} - -spec parse_file(FileName, IncludePath, PredefMacros) -> {'ok', [Form]} | {error, OpenError} when FileName :: file:name(), IncludePath :: [DirectoryName :: file:name()], Form :: erl_parse:abstract_form() | {'error', ErrorInfo} | {'eof',Line}, PredefMacros :: macros(), - Line :: erl_scan:line(), + Line :: erl_anno:line(), ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(), OpenError :: file:posix() | badarg | system_limit. parse_file(Ifile, Path, Predefs) -> - case open(Ifile, Path, Predefs) of + parse_file(Ifile, [{includes, Path}, {macros, Predefs}]). + +-spec parse_file(FileName, Options) -> + {'ok', [Form]} | {'ok', [Form], Extra} | {error, OpenError} when + FileName :: file:name(), + Options :: [{'includes', IncludePath :: [DirectoryName :: file:name()]} | + {'macros', PredefMacros :: macros()} | + {'default_encoding', DefEncoding :: source_encoding()} | + 'extra'], + Form :: erl_parse:abstract_form() | {'error', ErrorInfo} | {'eof',Line}, + Line :: erl_anno:line(), + ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(), + Extra :: [{'encoding', source_encoding() | 'none'}], + OpenError :: file:posix() | badarg | system_limit. + +parse_file(Ifile, Options) -> + case internal_open([{name, Ifile} | Options], #epp{}) of {ok,Epp} -> Forms = parse_file(Epp), close(Epp), {ok,Forms}; + {ok,Epp,Extra} -> + Forms = parse_file(Epp), + close(Epp), + {ok,Forms,Extra}; {error,E} -> {error,E} end. -%% parse_file(Epp) -> -%% [Form] +-spec parse_file(Epp) -> [Form] when + Epp :: epp_handle(), + Form :: erl_parse:abstract_form() | {'error', ErrorInfo} | + {'warning',WarningInfo} | {'eof',Line}, + Line :: erl_anno:line(), + ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(), + WarningInfo :: warning_info(). parse_file(Epp) -> case parse_erl_form(Epp) of {ok,Form} -> - case Form of - {attribute,La,record,{Record, Fields}} -> - case normalize_typed_record_fields(Fields) of - {typed, NewFields} -> - [{attribute, La, record, {Record, NewFields}}, - {attribute, La, type, - {{record, Record}, Fields, []}} - |parse_file(Epp)]; - not_typed -> - [Form|parse_file(Epp)] - end; - _ -> - [Form|parse_file(Epp)] - end; + [Form|parse_file(Epp)]; {error,E} -> [{error,E}|parse_file(Epp)]; + {warning,W} -> + [{warning,W}|parse_file(Epp)]; {eof,Location} -> - [{eof,Location}] + [{eof,erl_anno:new(Location)}] end. +-spec default_encoding() -> source_encoding(). + +default_encoding() -> + ?DEFAULT_ENCODING. + +-spec encoding_to_string(Encoding) -> string() when + Encoding :: source_encoding(). + +encoding_to_string(latin1) -> "coding: latin-1"; +encoding_to_string(utf8) -> "coding: utf-8". + +-spec read_encoding(FileName) -> source_encoding() | none when + FileName :: file:name(). + +read_encoding(Name) -> + read_encoding(Name, []). + +-spec read_encoding(FileName, Options) -> source_encoding() | none when + FileName :: file:name(), + Options :: [Option], + Option :: {in_comment_only, boolean()}. + +read_encoding(Name, Options) -> + InComment = proplists:get_value(in_comment_only, Options, true), + case file:open(Name, [read]) of + {ok,File} -> + try read_encoding_from_file(File, InComment) + after ok = file:close(File) + end; + _Error -> + none + end. + +-spec set_encoding(File) -> source_encoding() | none when + File :: io:device(). % pid(); raw files don't work + +set_encoding(File) -> + set_encoding(File, ?DEFAULT_ENCODING). + +-spec set_encoding(File, Default) -> source_encoding() | none when + Default :: source_encoding(), + File :: io:device(). % pid(); raw files don't work + +set_encoding(File, Default) -> + Encoding = read_encoding_from_file(File, true), + Enc = case Encoding of + none -> Default; + Encoding -> Encoding + end, + ok = io:setopts(File, [{encoding, Enc}]), + Encoding. + +-spec read_encoding_from_binary(Binary) -> source_encoding() | none when + Binary :: binary(). + +-define(ENC_CHUNK, 32). +-define(N_ENC_CHUNK, 16). % a total of 512 bytes + +read_encoding_from_binary(Binary) -> + read_encoding_from_binary(Binary, []). + +-spec read_encoding_from_binary(Binary, Options) -> + source_encoding() | none when + Binary :: binary(), + Options :: [Option], + Option :: {in_comment_only, boolean()}. + +read_encoding_from_binary(Binary, Options) -> + InComment = proplists:get_value(in_comment_only, Options, true), + try + com_nl(Binary, fake_reader(0), 0, InComment) + catch + throw:no -> + none + end. + +fake_reader(N) -> + fun() when N =:= ?N_ENC_CHUNK -> + throw(no); + () -> + {<<>>, fake_reader(N+1)} + end. + +-spec read_encoding_from_file(File, InComment) -> source_encoding() | none when + File :: io:device(), + InComment :: boolean(). + +read_encoding_from_file(File, InComment) -> + {ok, Pos0} = file:position(File, cur), + Opts = io:getopts(File), + Encoding0 = lists:keyfind(encoding, 1, Opts), + Binary0 = lists:keyfind(binary, 1, Opts), + ok = io:setopts(File, [binary, {encoding, latin1}]), + try + {B, Fun} = (reader(File, 0))(), + com_nl(B, Fun, 0, InComment) + catch + throw:no -> + none + after + {ok, Pos0} = file:position(File, Pos0), + ok = io:setopts(File, [Binary0, Encoding0]) + end. + +reader(Fd, N) -> + fun() when N =:= ?N_ENC_CHUNK -> + throw(no); + () -> + case file:read(Fd, ?ENC_CHUNK) of + eof -> + {<<>>, reader(Fd, N+1)}; + {ok, Bin} -> + {Bin, reader(Fd, N+1)}; + {error, _} -> + throw(no) % ignore errors + end + end. + +com_nl(_, _, 2, _) -> + throw(no); +com_nl(B, Fun, N, false=Com) -> + com_c(B, Fun, N, Com); +com_nl(B, Fun, N, true=Com) -> + com(B, Fun, N, Com). + +com(<<"\n",B/binary>>, Fun, N, Com) -> + com_nl(B, Fun, N+1, Com); +com(<<"%", B/binary>>, Fun, N, Com) -> + com_c(B, Fun, N, Com); +com(<<_:1/unit:8,B/binary>>, Fun, N, Com) -> + com(B, Fun, N, Com); +com(<<>>, Fun, N, Com) -> + {B, Fun1} = Fun(), + com(B, Fun1, N, Com). + +com_c(<<"c",B/binary>>, Fun, N, Com) -> + com_oding(B, Fun, N, Com); +com_c(<<"\n",B/binary>>, Fun, N, Com) -> + com_nl(B, Fun, N+1, Com); +com_c(<<_:1/unit:8,B/binary>>, Fun, N, Com) -> + com_c(B, Fun, N, Com); +com_c(<<>>, Fun, N, Com) -> + {B, Fun1} = Fun(), + com_c(B, Fun1, N, Com). + +com_oding(<<"oding",B/binary>>, Fun, N, Com) -> + com_sep(B, Fun, N, Com); +com_oding(B, Fun, N, Com) when byte_size(B) >= length("oding") -> + com_c(B, Fun, N, Com); +com_oding(B, Fun, N, Com) -> + {B1, Fun1} = Fun(), + com_oding(list_to_binary([B, B1]), Fun1, N, Com). + +com_sep(<<":",B/binary>>, Fun, N, Com) -> + com_space(B, Fun, N, Com); +com_sep(<<"=",B/binary>>, Fun, N, Com) -> + com_space(B, Fun, N, Com); +com_sep(<<"\s",B/binary>>, Fun, N, Com) -> + com_sep(B, Fun, N, Com); +com_sep(<<>>, Fun, N, Com) -> + {B, Fun1} = Fun(), + com_sep(B, Fun1, N, Com); +com_sep(B, Fun, N, Com) -> + com_c(B, Fun, N, Com). + +com_space(<<"\s",B/binary>>, Fun, N, Com) -> + com_space(B, Fun, N, Com); +com_space(<<>>, Fun, N, Com) -> + {B, Fun1} = Fun(), + com_space(B, Fun1, N, Com); +com_space(B, Fun, N, _Com) -> + com_enc(B, Fun, N, [], []). + +com_enc(<<C:1/unit:8,B/binary>>, Fun, N, L, Ps) when C >= $a, C =< $z; + C >= $A, C =< $Z; + C >= $0, C =< $9 -> + com_enc(B, Fun, N, [C | L], Ps); +com_enc(<<>>, Fun, N, L, Ps) -> + case Fun() of + {<<>>, _} -> + com_enc_end([L | Ps]); + {B, Fun1} -> + com_enc(B, Fun1, N, L, Ps) + end; +com_enc(<<"-",B/binary>>, Fun, N, L, Ps) -> + com_enc(B, Fun, N, [], [L | Ps]); +com_enc(_B, _Fun, _N, L, Ps) -> + com_enc_end([L | Ps]). + +com_enc_end(Ps0) -> + Ps = lists:reverse([lists:reverse(string:to_lower(P)) || P <- Ps0]), + com_encoding(Ps). + +com_encoding(["latin","1"|_]) -> + latin1; +com_encoding(["utf","8"|_]) -> + utf8; +com_encoding(_) -> + throw(no). % Don't try any further + normalize_typed_record_fields([]) -> {typed, []}; normalize_typed_record_fields(Fields) -> @@ -245,35 +521,42 @@ restore_typed_record_fields([{attribute,La,type,{{record,Record},Fields,[]}}| restore_typed_record_fields([Form|Forms]) -> [Form|restore_typed_record_fields(Forms)]. -%% server(StarterPid, FileName, Path, PreDefMacros) - -server(Pid, Name, Path, Pdm) -> +server(Pid, Name, Options, #epp{pre_opened=PreOpened}=St) -> process_flag(trap_exit, true), - case file:open(Name, [read]) of - {ok,File} -> - Location = 1, - init_server(Pid, Name, File, Location, Path, Pdm, false); - {error,E} -> - epp_reply(Pid, {error,E}) + case PreOpened of + false -> + case file:open(Name, [read]) of + {ok,File} -> + init_server(Pid, Name, Options, St#epp{file = File}); + {error,E} -> + epp_reply(Pid, {error,E}) + end; + true -> + init_server(Pid, Name, Options, St) end. -%% server(StarterPid, FileName, IoDevice, Location, Path, PreDefMacros) -server(Pid, Name, File, AtLocation, Path, Pdm) -> - process_flag(trap_exit, true), - init_server(Pid, Name, File, AtLocation, Path, Pdm, true). - -init_server(Pid, Name, File, AtLocation, Path, Pdm, Pre) -> +init_server(Pid, Name, Options, St0) -> + Pdm = proplists:get_value(macros, Options, []), Ms0 = predef_macros(Name), case user_predef(Pdm, Ms0) of {ok,Ms1} -> - epp_reply(Pid, {ok,self()}), - %% ensure directory of current source file is first in path - Path1 = [filename:dirname(Name) | Path], - St = #epp{file=File, location=AtLocation, delta=0, name=Name, - name2=Name, path=Path1, macs=Ms1, pre_opened = Pre}, - From = wait_request(St), - enter_file_reply(From, Name, AtLocation, AtLocation), - wait_req_scan(St); + #epp{file = File, location = AtLocation} = St0, + DefEncoding = proplists:get_value(default_encoding, Options, + ?DEFAULT_ENCODING), + Encoding = set_encoding(File, DefEncoding), + epp_reply(Pid, {ok,self(),Encoding}), + %% ensure directory of current source file is + %% first in path + Path = [filename:dirname(Name) | + proplists:get_value(includes, Options, [])], + St = St0#epp{delta=0, name=Name, name2=Name, + path=Path, macs=Ms1, + default_encoding=DefEncoding}, + From = wait_request(St), + Anno = erl_anno:new(AtLocation), + enter_file_reply(From, file_name(Name), Anno, + AtLocation, code), + wait_req_scan(St); {error,E} -> epp_reply(Pid, {error,E}) end. @@ -283,17 +566,20 @@ init_server(Pid, Name, File, AtLocation, Path, Pdm, Pre) -> %% FILE, LINE, MODULE as undefined, MACHINE and MACHINE value. predef_macros(File) -> - Machine = list_to_atom(erlang:system_info(machine)), - dict:from_list([ - {{atom,'FILE'}, {none,[{string,1,File}]}}, - {{atom,'LINE'}, {none,[{integer,1,1}]}}, - {{atom,'MODULE'}, undefined}, - {{atom,'MODULE_STRING'}, undefined}, - {{atom,'BASE_MODULE'}, undefined}, - {{atom,'BASE_MODULE_STRING'}, undefined}, - {{atom,'MACHINE'}, {none,[{atom,1,Machine}]}}, - {{atom,Machine}, {none,[{atom,1,true}]}} - ]). + Machine = list_to_atom(erlang:system_info(machine)), + Anno = line1(), + Defs = [{'FILE', {none,[{string,Anno,File}]}}, + {'FUNCTION_NAME', undefined}, + {'FUNCTION_ARITY', undefined}, + {'LINE', {none,[{integer,Anno,1}]}}, + {'MODULE', undefined}, + {'MODULE_STRING', undefined}, + {'BASE_MODULE', undefined}, + {'BASE_MODULE_STRING', undefined}, + {'MACHINE', {none,[{atom,Anno,Machine}]}}, + {Machine, {none,[{atom,Anno,true}]}} + ], + maps:from_list(Defs). %% user_predef(PreDefMacros, Macros) -> %% {ok,MacroDict} | {error,E} @@ -302,27 +588,21 @@ predef_macros(File) -> user_predef([{M,Val,redefine}|Pdm], Ms) when is_atom(M) -> Exp = erl_parse:tokens(erl_parse:abstract(Val)), - user_predef(Pdm, dict:store({atom,M}, {none,Exp}, Ms)); + user_predef(Pdm, Ms#{M=>{none,Exp}}); user_predef([{M,Val}|Pdm], Ms) when is_atom(M) -> - case dict:find({atom,M}, Ms) of - {ok,_Defs} when is_list(_Defs) -> %% User defined macros + case Ms of + #{M:=Defs} when is_list(Defs) -> + %% User defined macros. {error,{redefine,M}}; - {ok,_Def} -> %% Predefined macros + #{M:=_Defs} -> + %% Predefined macros. {error,{redefine_predef,M}}; - error -> + _ -> Exp = erl_parse:tokens(erl_parse:abstract(Val)), - user_predef(Pdm, dict:store({atom,M}, [{none, {none,Exp}}], Ms)) + user_predef(Pdm, Ms#{M=>[{none,{none,Exp}}]}) end; user_predef([M|Pdm], Ms) when is_atom(M) -> - case dict:find({atom,M}, Ms) of - {ok,_Defs} when is_list(_Defs) -> %% User defined macros - {error,{redefine,M}}; - {ok,_Def} -> %% Predefined macros - {error,{redefine_predef,M}}; - error -> - user_predef(Pdm, - dict:store({atom,M}, [{none, {none,[{atom,1,true}]}}], Ms)) - end; + user_predef([{M,true}|Pdm], Ms); user_predef([Md|_Pdm], _Ms) -> {error,{bad,Md}}; user_predef([], Ms) -> {ok,Ms}. @@ -336,7 +616,9 @@ wait_request(St) -> receive {epp_request,From,scan_erl_form} -> From; {epp_request,From,macro_defs} -> - epp_reply(From, dict:to_list(St#epp.macs)), + %% Return the old format to avoid any incompability issues. + Defs = [{{atom,K},V} || {K,V} <- maps:to_list(St#epp.macs)], + epp_reply(From, Defs), wait_request(St); {epp_request,From,close} -> close_file(St), @@ -370,7 +652,7 @@ wait_req_skip(St, Sis) -> enter_file(_NewName, Inc, From, St) when length(St#epp.sstk) >= 8 -> - epp_reply(From, {error,{abs_loc(Inc),epp,{depth,"include"}}}), + epp_reply(From, {error,{loc(Inc),epp,{depth,"include"}}}), wait_req_scan(St); enter_file(NewName, Inc, From, St) -> case file:path_open(St#epp.path, NewName, [read]) of @@ -378,38 +660,46 @@ enter_file(NewName, Inc, From, St) -> Loc = start_loc(St#epp.location), wait_req_scan(enter_file2(NewF, Pname, From, St, Loc)); {error,_E} -> - epp_reply(From, {error,{abs_loc(Inc),epp,{include,file,NewName}}}), + epp_reply(From, {error,{loc(Inc),epp,{include,file,NewName}}}), wait_req_scan(St) end. %% enter_file2(File, FullName, From, EppState, AtLocation) -> EppState. %% Set epp to use this file and "enter" it. -enter_file2(NewF, Pname, From, St, AtLocation) -> - Loc = start_loc(AtLocation), - enter_file_reply(From, Pname, Loc, AtLocation), - Ms = dict:store({atom,'FILE'}, {none,[{string,Loc,Pname}]}, St#epp.macs), +enter_file2(NewF, Pname, From, St0, AtLocation) -> + Anno = erl_anno:new(AtLocation), + enter_file_reply(From, Pname, Anno, AtLocation, code), + Ms0 = St0#epp.macs, + Ms = Ms0#{'FILE':={none,[{string,Anno,Pname}]}}, %% update the head of the include path to be the directory of the new %% source file, so that an included file can always include other files %% relative to its current location (this is also how C does it); note %% that the directory of the parent source file (the previous head of %% the path) must be dropped, otherwise the path used within the current %% file will depend on the order of file inclusions in the parent files - Path = [filename:dirname(Pname) | tl(St#epp.path)], - #epp{file=NewF,location=Loc,name=Pname,delta=0, - sstk=[St|St#epp.sstk],path=Path,macs=Ms}. - -enter_file_reply(From, Name, Location, AtLocation) -> - Attr = loc_attr(AtLocation), - Rep = {ok, [{'-',Attr},{atom,Attr,file},{'(',Attr}, - {string,Attr,file_name(Name)},{',',Attr}, - {integer,Attr,get_line(Location)},{')',Location}, - {dot,Attr}]}, + Path = [filename:dirname(Pname) | tl(St0#epp.path)], + DefEncoding = St0#epp.default_encoding, + _ = set_encoding(NewF, DefEncoding), + #epp{file=NewF,location=AtLocation,name=Pname,name2=Pname,delta=0, + sstk=[St0|St0#epp.sstk],path=Path,macs=Ms, + default_encoding=DefEncoding}. + +enter_file_reply(From, Name, LocationAnno, AtLocation, Where) -> + Anno0 = loc_anno(AtLocation), + Anno = case Where of + code -> Anno0; + generated -> erl_anno:set_generated(true, Anno0) + end, + Rep = {ok, [{'-',Anno},{atom,Anno,file},{'(',Anno}, + {string,Anno,Name},{',',Anno}, + {integer,Anno,get_line(LocationAnno)},{')',LocationAnno}, + {dot,Anno}]}, epp_reply(From, Rep). %% Flatten filename to a string. Must be a valid filename. -file_name([C | T]) when is_integer(C), C > 0, C =< 255 -> +file_name([C | T]) when is_integer(C), C > 0 -> [C | file_name(T)]; file_name([H|T]) -> file_name(H) ++ file_name(T); @@ -432,18 +722,19 @@ leave_file(From, St) -> #epp{location=OldLoc, delta=Delta, name=OldName, name2=OldName2} = OldSt, CurrLoc = add_line(OldLoc, Delta), - Ms = dict:store({atom,'FILE'}, - {none,[{string,CurrLoc,OldName2}]}, - St#epp.macs), - NextSt = OldSt#epp{sstk=Sts,macs=Ms}, - enter_file_reply(From, OldName, CurrLoc, CurrLoc), + Anno = erl_anno:new(CurrLoc), + Ms0 = St#epp.macs, + Ms = Ms0#{'FILE':={none,[{string,Anno,OldName2}]}}, + NextSt = OldSt#epp{sstk=Sts,macs=Ms,uses=St#epp.uses}, + enter_file_reply(From, OldName, Anno, CurrLoc, code), case OldName2 =:= OldName of true -> - From; + ok; false -> NFrom = wait_request(NextSt), - enter_file_reply(NFrom, OldName2, OldLoc, - neg_line(CurrLoc)) + OldAnno = erl_anno:new(OldLoc), + enter_file_reply(NFrom, OldName2, OldAnno, + CurrLoc, generated) end, wait_req_scan(NextSt); [] -> @@ -473,6 +764,10 @@ scan_toks([{'-',_Lh},{atom,_Ld,define}=Define|Toks], From, St) -> scan_define(Toks, Define, From, St); scan_toks([{'-',_Lh},{atom,_Ld,undef}=Undef|Toks], From, St) -> scan_undef(Toks, Undef, From, St); +scan_toks([{'-',_Lh},{atom,_Ld,error}=Error|Toks], From, St) -> + scan_err_warn(Toks, Error, From, St); +scan_toks([{'-',_Lh},{atom,_Ld,warning}=Warn|Toks], From, St) -> + scan_err_warn(Toks, Warn, From, St); scan_toks([{'-',_Lh},{atom,_Li,include}=Inc|Toks], From, St) -> scan_include(Toks, Inc, From, St); scan_toks([{'-',_Lh},{atom,_Li,include_lib}=IncLib|Toks], From, St) -> @@ -490,7 +785,7 @@ scan_toks([{'-',_Lh},{atom,_Le,elif}=Elif|Toks], From, St) -> scan_toks([{'-',_Lh},{atom,_Le,endif}=Endif|Toks], From, St) -> scan_endif(Toks, Endif, From, St); scan_toks([{'-',_Lh},{atom,_Lf,file}=FileToken|Toks0], From, St) -> - case catch expand_macros(Toks0, {St#epp.macs, St#epp.uses}) of + case catch expand_macros(Toks0, St) of Toks1 when is_list(Toks1) -> scan_file(Toks1, FileToken, From, St); {error,ErrL,What} -> @@ -498,7 +793,7 @@ scan_toks([{'-',_Lh},{atom,_Lf,file}=FileToken|Toks0], From, St) -> wait_req_scan(St) end; scan_toks(Toks0, From, St) -> - case catch expand_macros(Toks0, {St#epp.macs, St#epp.uses}) of + case catch expand_macros(Toks0, St#epp{fname=Toks0}) of Toks1 when is_list(Toks1) -> epp_reply(From, {ok,Toks1}), wait_req_scan(St#epp{macs=scan_module(Toks1, St#epp.macs)}); @@ -508,91 +803,66 @@ scan_toks(Toks0, From, St) -> end. scan_module([{'-',_Lh},{atom,_Lm,module},{'(',_Ll}|Ts], Ms) -> - scan_module_1(Ts, [], Ms); + scan_module_1(Ts, Ms); scan_module([{'-',_Lh},{atom,_Lm,extends},{'(',_Ll}|Ts], Ms) -> - scan_extends(Ts, [], Ms); + scan_extends(Ts, Ms); scan_module(_Ts, Ms) -> Ms. -scan_module_1([{atom,_,_}=A,{',',L}|Ts], As, Ms) -> +scan_module_1([{atom,_,_}=A,{',',L}|Ts], Ms) -> %% Parameterized modules. - scan_module_1([A,{')',L}|Ts], As, Ms); -scan_module_1([{atom,Ln,A},{')',_Lr}|_Ts], As, Ms0) -> - Mod = lists:concat(lists:reverse([A|As])), - Ms = dict:store({atom,'MODULE'}, - {none,[{atom,Ln,list_to_atom(Mod)}]}, Ms0), - dict:store({atom,'MODULE_STRING'}, {none,[{string,Ln,Mod}]}, Ms); -scan_module_1([{atom,_Ln,A},{'.',_Lr}|Ts], As, Ms) -> - scan_module_1(Ts, [".",A|As], Ms); -scan_module_1([{'.',_Lr}|Ts], As, Ms) -> - scan_module_1(Ts, As, Ms); -scan_module_1(_Ts, _As, Ms) -> Ms. - -scan_extends([{atom,Ln,A},{')',_Lr}|_Ts], As, Ms0) -> - Mod = lists:concat(lists:reverse([A|As])), - Ms = dict:store({atom,'BASE_MODULE'}, - {none,[{atom,Ln,list_to_atom(Mod)}]}, Ms0), - dict:store({atom,'BASE_MODULE_STRING'}, {none,[{string,Ln,Mod}]}, Ms); -scan_extends([{atom,_Ln,A},{'.',_Lr}|Ts], As, Ms) -> - scan_extends(Ts, [".",A|As], Ms); -scan_extends([{'.',_Lr}|Ts], As, Ms) -> - scan_extends(Ts, As, Ms); -scan_extends(_Ts, _As, Ms) -> Ms. + scan_module_1([A,{')',L}|Ts], Ms); +scan_module_1([{atom,Ln,A}=ModAtom,{')',_Lr}|_Ts], Ms0) -> + ModString = atom_to_list(A), + Ms = Ms0#{'MODULE':={none,[ModAtom]}}, + Ms#{'MODULE_STRING':={none,[{string,Ln,ModString}]}}; +scan_module_1(_Ts, Ms) -> Ms. + +scan_extends([{atom,Ln,A}=ModAtom,{')',_Lr}|_Ts], Ms0) -> + ModString = atom_to_list(A), + Ms = Ms0#{'BASE_MODULE':={none,[ModAtom]}}, + Ms#{'BASE_MODULE_STRING':={none,[{string,Ln,ModString}]}}; +scan_extends(_Ts, Ms) -> Ms. + +scan_err_warn([{'(',_}|_]=Toks0, {atom,_,Tag}=Token, From, St) -> + try expand_macros(Toks0, St) of + Toks when is_list(Toks) -> + case erl_parse:parse_term(Toks) of + {ok,Term} -> + epp_reply(From, {Tag,{loc(Token),epp,{Tag,Term}}}); + {error,_} -> + epp_reply(From, {error,{loc(Token),epp,{bad,Tag}}}) + end + catch + _:_ -> + epp_reply(From, {error,{loc(Token),epp,{bad,Tag}}}) + end, + wait_req_scan(St); +scan_err_warn(_Toks, {atom,_,Tag}=Token, From, St) -> + epp_reply(From, {error,{loc(Token),epp,{bad,Tag}}}), + wait_req_scan(St). %% scan_define(Tokens, DefineToken, From, EppState) -scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{',',Lc}|Toks], _Def, From, St) +scan_define([{'(',_Lp},{Type,_Lm,_}=Mac|Toks], Def, From, St) when Type =:= atom; Type =:= var -> - case catch macro_expansion(Toks, Lc) of + scan_define_1(Toks, Mac, Def, From, St); +scan_define(_Toks, Def, From, St) -> + epp_reply(From, {error,{loc(Def),epp,{bad,define}}}), + wait_req_scan(St). + +scan_define_1([{',',_}=Comma|Toks], Mac,_Def, From, St) -> + case catch macro_expansion(Toks, Comma) of Expansion when is_list(Expansion) -> - case dict:find({atom,M}, St#epp.macs) of - {ok, Defs} when is_list(Defs) -> - %% User defined macros: can be overloaded - case proplists:is_defined(none, Defs) of - true -> - epp_reply(From, {error,{loc(Mac),epp,{redefine,M}}}), - wait_req_scan(St); - false -> - scan_define_cont(From, St, - {atom, M}, - {none, {none,Expansion}}) - end; - {ok, _PreDef} -> - %% Predefined macros: cannot be overloaded - epp_reply(From, {error,{loc(Mac),epp,{redefine_predef,M}}}), - wait_req_scan(St); - error -> - scan_define_cont(From, St, - {atom, M}, - {none, {none,Expansion}}) - end; + scan_define_2(none, {none,Expansion}, Mac, From, St); {error,ErrL,What} -> epp_reply(From, {error,{ErrL,epp,What}}), wait_req_scan(St) end; -scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{'(',_Lc}|Toks], Def, From, St) - when Type =:= atom; Type =:= var -> +scan_define_1([{'(',_Lc}|Toks], Mac, Def, From, St) -> case catch macro_pars(Toks, []) of - {ok, {As,Me}} -> + {ok,{As,_}=MacroDef} -> Len = length(As), - case dict:find({atom,M}, St#epp.macs) of - {ok, Defs} when is_list(Defs) -> - %% User defined macros: can be overloaded - case proplists:is_defined(Len, Defs) of - true -> - epp_reply(From,{error,{loc(Mac),epp,{redefine,M}}}), - wait_req_scan(St); - false -> - scan_define_cont(From, St, {atom, M}, - {Len, {As, Me}}) - end; - {ok, _PreDef} -> - %% Predefined macros: cannot be overloaded - %% (There are currently no predefined F(...) macros.) - epp_reply(From, {error,{loc(Mac),epp,{redefine_predef,M}}}), - wait_req_scan(St); - error -> - scan_define_cont(From, St, {atom, M}, {Len, {As, Me}}) - end; + scan_define_2(Len, MacroDef, Mac, From, St); {error,ErrL,What} -> epp_reply(From, {error,{ErrL,epp,What}}), wait_req_scan(St); @@ -600,10 +870,29 @@ scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{'(',_Lc}|Toks], Def, From, St) epp_reply(From, {error,{loc(Def),epp,{bad,define}}}), wait_req_scan(St) end; -scan_define(_Toks, Def, From, St) -> +scan_define_1(_Toks, _Mac, Def, From, St) -> epp_reply(From, {error,{loc(Def),epp,{bad,define}}}), wait_req_scan(St). +scan_define_2(Arity, Def, {_,_,Key}=Mac, From, #epp{macs=Ms}=St) -> + case Ms of + #{Key:=Defs} when is_list(Defs) -> + %% User defined macros: can be overloaded + case proplists:is_defined(Arity, Defs) of + true -> + epp_reply(From, {error,{loc(Mac),epp,{redefine,Key}}}), + wait_req_scan(St); + false -> + scan_define_cont(From, St, Key, Defs, Arity, Def) + end; + #{Key:=_} -> + %% Predefined macros: cannot be overloaded + epp_reply(From, {error,{loc(Mac),epp,{redefine_predef,Key}}}), + wait_req_scan(St); + _ -> + scan_define_cont(From, St, Key, [], Arity, Def) + end. + %%% Detection of circular macro expansions (which would either keep %%% the compiler looping forever, or run out of memory): %%% When a macro is defined, we store the names of other macros it @@ -613,11 +902,17 @@ scan_define(_Toks, Def, From, St) -> %%% the information from St#epp.uses is traversed, and if a circularity %%% is detected, an error message is thrown. -scan_define_cont(F, St, M, {Arity, Def}) -> - Ms = dict:append_list(M, [{Arity, Def}], St#epp.macs), - try dict:append_list(M, [{Arity, macro_uses(Def)}], St#epp.uses) of +scan_define_cont(F, #epp{macs=Ms0}=St, M, Defs, Arity, Def) -> + Ms = Ms0#{M=>[{Arity,Def}|Defs]}, + try macro_uses(Def) of U -> - scan_toks(F, St#epp{uses=U, macs=Ms}) + Uses0 = St#epp.uses, + Val = [{Arity,U}|case Uses0 of + #{M:=UseList} -> UseList; + _ -> [] + end], + Uses = Uses0#{M=>Val}, + scan_toks(F, St#epp{uses=Uses,macs=Ms}) catch {error, Line, Reason} -> epp_reply(F, {error,{Line,epp,Reason}}), @@ -632,24 +927,26 @@ macro_ref([]) -> []; macro_ref([{'?', _}, {'?', _} | Rest]) -> macro_ref(Rest); -macro_ref([{'?', _}, {atom, Lm, A} | Rest]) -> +macro_ref([{'?', _}, {atom, _, A}=Atom | Rest]) -> + Lm = loc(Atom), Arity = count_args(Rest, Lm, A), - [{{atom, A}, Arity} | macro_ref(Rest)]; -macro_ref([{'?', _}, {var, Lm, A} | Rest]) -> + [{A,Arity} | macro_ref(Rest)]; +macro_ref([{'?', _}, {var, _, A}=Var | Rest]) -> + Lm = loc(Var), Arity = count_args(Rest, Lm, A), - [{{atom, A}, Arity} | macro_ref(Rest)]; + [{A,Arity} | macro_ref(Rest)]; macro_ref([_Token | Rest]) -> macro_ref(Rest). %% scan_undef(Tokens, UndefToken, From, EppState) scan_undef([{'(',_Llp},{atom,_Lm,M},{')',_Lrp},{dot,_Ld}], _Undef, From, St) -> - Macs = dict:erase({atom,M}, St#epp.macs), - Uses = dict:erase({atom,M}, St#epp.uses), + Macs = maps:remove(M, St#epp.macs), + Uses = maps:remove(M, St#epp.uses), scan_toks(From, St#epp{macs=Macs, uses=Uses}); scan_undef([{'(',_Llp},{var,_Lm,M},{')',_Lrp},{dot,_Ld}], _Undef, From,St) -> - Macs = dict:erase({atom,M}, St#epp.macs), - Uses = dict:erase({atom,M}, St#epp.uses), + Macs = maps:remove(M, St#epp.macs), + Uses = maps:remove(M, St#epp.uses), scan_toks(From, St#epp{macs=Macs, uses=Uses}); scan_undef(_Toks, Undef, From, St) -> epp_reply(From, {error,{loc(Undef),epp,{bad,undef}}}), @@ -657,12 +954,16 @@ scan_undef(_Toks, Undef, From, St) -> %% scan_include(Tokens, IncludeToken, From, St) -scan_include([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], Inc, - From, St) -> +scan_include(Tokens0, Inc, From, St) -> + Tokens = coalesce_strings(Tokens0), + scan_include1(Tokens, Inc, From, St). + +scan_include1([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], Inc, + From, St) -> NewName = expand_var(NewName0), enter_file(NewName, Inc, From, St); -scan_include(_Toks, Inc, From, St) -> - epp_reply(From, {error,{abs_loc(Inc),epp,{bad,include}}}), +scan_include1(_Toks, Inc, From, St) -> + epp_reply(From, {error,{loc(Inc),epp,{bad,include}}}), wait_req_scan(St). %% scan_include_lib(Tokens, IncludeToken, From, EppState) @@ -670,44 +971,53 @@ scan_include(_Toks, Inc, From, St) -> %% normal search path, if not we assume that the first directory name %% is a library name, find its true directory and try with that. -find_lib_dir(NewName) -> - [Lib | Rest] = filename:split(NewName), - {code:lib_dir(list_to_atom(Lib)), Rest}. +expand_lib_dir(Name) -> + try + [App|Path] = filename:split(Name), + LibDir = code:lib_dir(list_to_atom(App)), + {ok,fname_join([LibDir|Path])} + catch + _:_ -> + error + end. + +scan_include_lib(Tokens0, Inc, From, St) -> + Tokens = coalesce_strings(Tokens0), + scan_include_lib1(Tokens, Inc, From, St). -scan_include_lib([{'(',_Llp},{string,_Lf,_NewName0},{')',_Lrp},{dot,_Ld}], - Inc, From, St) +scan_include_lib1([{'(',_Llp},{string,_Lf,_NewName0},{')',_Lrp},{dot,_Ld}], + Inc, From, St) when length(St#epp.sstk) >= 8 -> - epp_reply(From, {error,{abs_loc(Inc),epp,{depth,"include_lib"}}}), + epp_reply(From, {error,{loc(Inc),epp,{depth,"include_lib"}}}), wait_req_scan(St); -scan_include_lib([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], - Inc, From, St) -> +scan_include_lib1([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], + Inc, From, St) -> NewName = expand_var(NewName0), Loc = start_loc(St#epp.location), case file:path_open(St#epp.path, NewName, [read]) of {ok,NewF,Pname} -> wait_req_scan(enter_file2(NewF, Pname, From, St, Loc)); {error,_E1} -> - case catch find_lib_dir(NewName) of - {LibDir, Rest} when is_list(LibDir) -> - LibName = fname_join([LibDir | Rest]), - case file:open(LibName, [read]) of + case expand_lib_dir(NewName) of + {ok,Header} -> + case file:open(Header, [read]) of {ok,NewF} -> - wait_req_scan(enter_file2(NewF, LibName, From, + wait_req_scan(enter_file2(NewF, Header, From, St, Loc)); {error,_E2} -> epp_reply(From, - {error,{abs_loc(Inc),epp, + {error,{loc(Inc),epp, {include,lib,NewName}}}), wait_req_scan(St) end; - _Error -> - epp_reply(From, {error,{abs_loc(Inc),epp, + error -> + epp_reply(From, {error,{loc(Inc),epp, {include,lib,NewName}}}), wait_req_scan(St) end end; -scan_include_lib(_Toks, Inc, From, St) -> - epp_reply(From, {error,{abs_loc(Inc),epp,{bad,include_lib}}}), +scan_include_lib1(_Toks, Inc, From, St) -> + epp_reply(From, {error,{loc(Inc),epp,{bad,include_lib}}}), wait_req_scan(St). %% scan_ifdef(Tokens, IfdefToken, From, EppState) @@ -716,17 +1026,17 @@ scan_include_lib(_Toks, Inc, From, St) -> %% Report a badly formed if[n]def test and then treat as undefined macro. scan_ifdef([{'(',_Llp},{atom,_Lm,M},{')',_Lrp},{dot,_Ld}], _IfD, From, St) -> - case dict:find({atom,M}, St#epp.macs) of - {ok,_Def} -> + case St#epp.macs of + #{M:=_Def} -> scan_toks(From, St#epp{istk=[ifdef|St#epp.istk]}); - error -> + _ -> skip_toks(From, St, [ifdef]) end; scan_ifdef([{'(',_Llp},{var,_Lm,M},{')',_Lrp},{dot,_Ld}], _IfD, From, St) -> - case dict:find({atom,M}, St#epp.macs) of - {ok,_Def} -> + case St#epp.macs of + #{M:=_Def} -> scan_toks(From, St#epp{istk=[ifdef|St#epp.istk]}); - error -> + _ -> skip_toks(From, St, [ifdef]) end; scan_ifdef(_Toks, IfDef, From, St) -> @@ -734,17 +1044,17 @@ scan_ifdef(_Toks, IfDef, From, St) -> wait_req_skip(St, [ifdef]). scan_ifndef([{'(',_Llp},{atom,_Lm,M},{')',_Lrp},{dot,_Ld}], _IfnD, From, St) -> - case dict:find({atom,M}, St#epp.macs) of - {ok,_Def} -> + case St#epp.macs of + #{M:=_Def} -> skip_toks(From, St, [ifndef]); - error -> + _ -> scan_toks(From, St#epp{istk=[ifndef|St#epp.istk]}) end; scan_ifndef([{'(',_Llp},{var,_Lm,M},{')',_Lrp},{dot,_Ld}], _IfnD, From, St) -> - case dict:find({atom,M}, St#epp.macs) of - {ok,_Def} -> + case St#epp.macs of + #{M:=_Def} -> skip_toks(From, St, [ifndef]); - error -> + _ -> scan_toks(From, St#epp{istk=[ifndef|St#epp.istk]}) end; scan_ifndef(_Toks, IfnDef, From, St) -> @@ -808,15 +1118,21 @@ scan_endif(_Toks, Endif, From, St) -> %% Set the current file and line to the given file and line. %% Note that the line of the attribute itself is kept. -scan_file([{'(',_Llp},{string,_Ls,Name},{',',_Lc},{integer,_Li,Ln},{')',_Lrp}, - {dot,_Ld}], Tf, From, St) -> - enter_file_reply(From, Name, Ln, neg_line(abs_loc(Tf))), - Ms = dict:store({atom,'FILE'}, {none,[{string,1,Name}]}, St#epp.macs), +scan_file(Tokens0, Tf, From, St) -> + Tokens = coalesce_strings(Tokens0), + scan_file1(Tokens, Tf, From, St). + +scan_file1([{'(',_Llp},{string,_Ls,Name},{',',_Lc},{integer,_Li,Ln},{')',_Lrp}, + {dot,_Ld}], Tf, From, St) -> + Anno = erl_anno:new(Ln), + enter_file_reply(From, Name, Anno, loc(Tf), generated), + Ms0 = St#epp.macs, + Ms = Ms0#{'FILE':={none,[{string,line1(),Name}]}}, Locf = loc(Tf), NewLoc = new_location(Ln, St#epp.location, Locf), - Delta = abs(get_line(element(2, Tf)))-Ln + St#epp.delta, + Delta = get_line(element(2, Tf))-Ln + St#epp.delta, wait_req_scan(St#epp{name2=Name,location=NewLoc,delta=Delta,macs=Ms}); -scan_file(_Toks, Tf, From, St) -> +scan_file1(_Toks, Tf, From, St) -> epp_reply(From, {error,{loc(Tf),epp,{bad,file}}}), wait_req_scan(St). @@ -843,8 +1159,20 @@ skip_toks(From, St, [I|Sis]) -> skip_toks(From, St#epp{location=Cl}, Sis); {ok,_Toks,Cl} -> skip_toks(From, St#epp{location=Cl}, [I|Sis]); - {error,_E,Cl} -> - skip_toks(From, St#epp{location=Cl}, [I|Sis]); + {error,E,Cl} -> + case E of + {_,file_io_server,invalid_unicode} -> + %% The compiler needs to know that there was + %% invalid unicode characters in the file + %% (and there is no point in continuing anyway + %% since io server process has terminated). + epp_reply(From, {error,E}), + leave_file(wait_request(St), St); + _ -> + %% Some other invalid token, such as a bad floating + %% point number. Just ignore it. + skip_toks(From, St#epp{location=Cl}, [I|Sis]) + end; {eof,Cl} -> leave_file(From, St#epp{location=Cl,istk=[I|Sis]}); {error,_E} -> @@ -863,7 +1191,7 @@ skip_else(_Else, From, St, Sis) -> skip_toks(From, St, Sis). %% macro_pars(Tokens, ArgStack) -%% macro_expansion(Tokens, Line) +%% macro_expansion(Tokens, Anno) %% Extract the macro parameters and the expansion from a macro definition. macro_pars([{')',_Lp}, {',',Ld}|Ex], Args) -> @@ -875,51 +1203,54 @@ macro_pars([{var,_L,Name}, {',',_}|Ts], Args) -> false = lists:member(Name, Args), macro_pars(Ts, [Name|Args]). -macro_expansion([{')',_Lp},{dot,_Ld}], _L0) -> []; -macro_expansion([{dot,Ld}], _L0) -> throw({error,Ld,missing_parenthesis}); -macro_expansion([T|Ts], _L0) -> - [T|macro_expansion(Ts, element(2, T))]; -macro_expansion([], L0) -> throw({error,L0,premature_end}). +macro_expansion([{')',_Lp},{dot,_Ld}], _Anno0) -> []; +macro_expansion([{dot,_}=Dot], _Anno0) -> + throw({error,loc(Dot),missing_parenthesis}); +macro_expansion([T|Ts], _Anno0) -> + [T|macro_expansion(Ts, T)]; +macro_expansion([], Anno0) -> throw({error,loc(Anno0),premature_end}). -%% expand_macros(Tokens, Macros) +%% expand_macros(Tokens, St) %% expand_macro(Tokens, MacroToken, RestTokens) %% Expand the macros in a list of tokens, making sure that an expansion %% gets the same location as the macro call. -expand_macros(Type, MacT, M, Toks, Ms0) -> - %% (Type will always be 'atom') - {Ms, U} = Ms0, +expand_macros(MacT, M, Toks, St) -> + #epp{macs=Ms,uses=U} = St, Lm = loc(MacT), Tinfo = element(2, MacT), - case expand_macro1(Type, Lm, M, Toks, Ms) of + case expand_macro1(Lm, M, Toks, Ms) of {ok,{none,Exp}} -> - check_uses([{{Type,M}, none}], [], U, Lm), - Toks1 = expand_macros(expand_macro(Exp, Tinfo, [], dict:new()), Ms0), - expand_macros(Toks1++Toks, Ms0); + check_uses([{M,none}], [], U, Lm), + Toks1 = expand_macros(expand_macro(Exp, Tinfo, [], #{}), St), + expand_macros(Toks1++Toks, St); {ok,{As,Exp}} -> - check_uses([{{Type,M}, length(As)}], [], U, Lm), - {Bs,Toks1} = bind_args(Toks, Lm, M, As, dict:new()), - expand_macros(expand_macro(Exp, Tinfo, Toks1, Bs), Ms0) + check_uses([{M,length(As)}], [], U, Lm), + {Bs,Toks1} = bind_args(Toks, Lm, M, As, #{}), + expand_macros(expand_macro(Exp, Tinfo, Toks1, Bs), St) end. -expand_macro1(Type, Lm, M, Toks, Ms) -> +expand_macro1(Lm, M, Toks, Ms) -> Arity = count_args(Toks, Lm, M), - case dict:find({Type,M}, Ms) of - error -> %% macro not found + case Ms of + #{M:=undefined} -> + %% Predefined macro without definition. throw({error,Lm,{undefined,M,Arity}}); - {ok, undefined} -> %% Predefined macro without definition - throw({error,Lm,{undefined,M,Arity}}); - {ok, [{none, Def}]} -> - {ok, Def}; - {ok, Defs} when is_list(Defs) -> - case proplists:get_value(Arity, Defs) of + #{M:=[{none,Def}]} -> + {ok,Def}; + #{M:=Defs} when is_list(Defs) -> + case proplists:get_value(Arity, Defs) of undefined -> throw({error,Lm,{mismatch,M}}); Def -> - {ok, Def} + {ok,Def} end; - {ok, PreDef} -> %% Predefined macro - {ok, PreDef} + #{M:=PreDef} -> + %% Predefined macro. + {ok,PreDef}; + _ -> + %% Macro not found. + throw({error,Lm,{undefined,M,Arity}}) end. check_uses([], _Anc, _U, _Lm) -> @@ -927,7 +1258,7 @@ check_uses([], _Anc, _U, _Lm) -> check_uses([M|Rest], Anc, U, Lm) -> case lists:member(M, Anc) of true -> - {{_, Name},Arity} = M, + {Name,Arity} = M, throw({error,Lm,{circular,Name,Arity}}); false -> L = get_macro_uses(M, U), @@ -936,36 +1267,52 @@ check_uses([M|Rest], Anc, U, Lm) -> end. get_macro_uses({M,Arity}, U) -> - case dict:find(M, U) of - error -> - []; - {ok, L} -> - proplists:get_value(Arity, L, proplists:get_value(none, L, [])) + case U of + #{M:=L} -> + proplists:get_value(Arity, L, proplists:get_value(none, L, [])); + _ -> + [] end. %% Macro expansion %% Note: io:scan_erl_form() does not return comments or white spaces. -expand_macros([{'?',_Lq},{atom,_Lm,M}=MacT|Toks], Ms) -> - expand_macros(atom, MacT, M, Toks, Ms); +expand_macros([{'?',_Lq},{atom,_Lm,M}=MacT|Toks], St) -> + expand_macros(MacT, M, Toks, St); %% Special macros -expand_macros([{'?',_Lq},{var,Lm,'LINE'}=Tok|Toks], Ms) -> - {line,Line} = erl_scan:token_info(Tok, line), - [{integer,Lm,Line}|expand_macros(Toks, Ms)]; -expand_macros([{'?',_Lq},{var,_Lm,M}=MacT|Toks], Ms) -> - expand_macros(atom, MacT, M, Toks, Ms); +expand_macros([{'?',_Lq},{var,Lm,'FUNCTION_NAME'}=Token|Toks], St0) -> + St = update_fun_name(Token, St0), + case St#epp.fname of + undefined -> + [{'?',_Lq},Token]; + {Name,_} -> + [{atom,Lm,Name}] + end ++ expand_macros(Toks, St); +expand_macros([{'?',_Lq},{var,Lm,'FUNCTION_ARITY'}=Token|Toks], St0) -> + St = update_fun_name(Token, St0), + case St#epp.fname of + undefined -> + [{'?',_Lq},Token]; + {_,Arity} -> + [{integer,Lm,Arity}] + end ++ expand_macros(Toks, St); +expand_macros([{'?',_Lq},{var,Lm,'LINE'}=Tok|Toks], St) -> + Line = erl_scan:line(Tok), + [{integer,Lm,Line}|expand_macros(Toks, St)]; +expand_macros([{'?',_Lq},{var,_Lm,M}=MacT|Toks], St) -> + expand_macros(MacT, M, Toks, St); %% Illegal macros -expand_macros([{'?',_Lq},Token|_Toks], _Ms) -> - T = case erl_scan:token_info(Token, text) of - {text,Text} -> +expand_macros([{'?',_Lq},Token|_Toks], _St) -> + T = case erl_scan:text(Token) of + Text when is_list(Text) -> Text; undefined -> - {symbol,Symbol} = erl_scan:token_info(Token, symbol), + Symbol = erl_scan:symbol(Token), io_lib:write(Symbol) end, throw({error,loc(Token),{call,[$?|T]}}); -expand_macros([T|Ts], Ms) -> - [T|expand_macros(Ts, Ms)]; -expand_macros([], _Ms) -> []. +expand_macros([T|Ts], St) -> + [T|expand_macros(Ts, St)]; +expand_macros([], _St) -> []. %% bind_args(Tokens, MacroLocation, MacroName, ArgumentVars, Bindings) %% Collect the arguments to a macro call. @@ -991,7 +1338,7 @@ macro_args(_Toks, Lm, M, _As, _Bs) -> store_arg(L, M, _A, [], _Bs) -> throw({error,L,{mismatch,M}}); store_arg(_L, _M, A, Arg, Bs) -> - dict:store(A, Arg, Bs). + Bs#{A=>Arg}. %% count_args(Tokens, MacroLine, MacroName) %% Count the number of arguments in a macro call. @@ -1042,14 +1389,14 @@ macro_arg([{'case',Lc}|Toks], E, Arg) -> macro_arg(Toks, ['end'|E], [{'case',Lc}|Arg]); macro_arg([{'fun',Lc}|[{'(',_}|_]=Toks], E, Arg) -> macro_arg(Toks, ['end'|E], [{'fun',Lc}|Arg]); +macro_arg([{'fun',_}=Fun,{var,_,_}=Name|[{'(',_}|_]=Toks], E, Arg) -> + macro_arg(Toks, ['end'|E], [Name,Fun|Arg]); macro_arg([{'receive',Lr}|Toks], E, Arg) -> macro_arg(Toks, ['end'|E], [{'receive',Lr}|Arg]); macro_arg([{'try',Lr}|Toks], E, Arg) -> macro_arg(Toks, ['end'|E], [{'try',Lr}|Arg]); macro_arg([{'cond',Lr}|Toks], E, Arg) -> macro_arg(Toks, ['end'|E], [{'cond',Lr}|Arg]); -macro_arg([{'query',Lr}|Toks], E, Arg) -> - macro_arg(Toks, ['end'|E], [{'query',Lr}|Arg]); macro_arg([{Rb,Lrb}|Toks], [Rb|E], Arg) -> %Found matching close macro_arg(Toks, E, [{Rb,Lrb}|Arg]); macro_arg([T|Toks], E, Arg) -> @@ -1064,19 +1411,17 @@ macro_arg([], _E, Arg) -> %% and then the macro arguments, i.e. simulate textual expansion. expand_macro([{var,_Lv,V}|Ts], L, Rest, Bs) -> - case dict:find(V, Bs) of - {ok,Val} -> - %% lists:append(Val, expand_macro(Ts, L, Rest, Bs)); + case Bs of + #{V:=Val} -> expand_arg(Val, Ts, L, Rest, Bs); - error -> + _ -> [{var,L,V}|expand_macro(Ts, L, Rest, Bs)] end; expand_macro([{'?', _}, {'?', _}, {var,_Lv,V}|Ts], L, Rest, Bs) -> - case dict:find(V, Bs) of - {ok,Val} -> - %% lists:append(Val, expand_macro(Ts, L, Rest, Bs)); + case Bs of + #{V:=Val} -> expand_arg(stringify(Val, L), Ts, L, Rest, Bs); - error -> + _ -> [{var,L,V}|expand_macro(Ts, L, Rest, Bs)] end; expand_macro([T|Ts], L, Rest, Bs) -> @@ -1090,10 +1435,98 @@ expand_arg([A|As], Ts, _L, Rest, Bs) -> expand_arg([], Ts, L, Rest, Bs) -> expand_macro(Ts, L, Rest, Bs). +%%% +%%% Here follows support for the ?FUNCTION_NAME and ?FUNCTION_ARITY +%%% macros. Since the parser has not been run yet, we don't know the +%%% name and arity of the current function. Therefore, we will need to +%%% scan the beginning of the current form to extract the name and +%%% arity of the function. +%%% + +update_fun_name(Token, #epp{fname=Toks0}=St) when is_list(Toks0) -> + %% ?FUNCTION_NAME or ?FUNCTION_ARITY is used for the first time in + %% a function. First expand macros (except ?FUNCTION_NAME and + %% ?FUNCTION_ARITY) in the form. + + Toks1 = (catch expand_macros(Toks0, St#epp{fname=undefined})), + + %% Now extract the name and arity from the stream of tokens, and store + %% the result in the #epp{} record so we don't have to do it + %% again. + + case Toks1 of + [{atom,_,Name},{'(',_}|Toks] -> + %% This is the beginning of a function definition. + %% Scan the token stream up to the matching right + %% parenthesis and count the number of arguments. + FA = update_fun_name_1(Toks, 1, {Name,0}, St), + St#epp{fname=FA}; + [{'?',_}|_] -> + %% ?FUNCTION_NAME/?FUNCTION_ARITY used at the beginning + %% of a form. Does not make sense. + {var,_,Macro} = Token, + throw({error,loc(Token),{illegal_function_usage,Macro}}); + _ when is_list(Toks1) -> + %% Not the beginning of a function (an attribute or a + %% syntax error). + {var,_,Macro} = Token, + throw({error,loc(Token),{illegal_function,Macro}}); + _ -> + %% A macro expansion error. Return a dummy value and + %% let the caller notice and handle the error. + St#epp{fname={'_',0}} + end; +update_fun_name(_Token, St) -> + St. + +update_fun_name_1([Tok|Toks], L, FA, St) -> + case classify_token(Tok) of + comma -> + if + L =:= 1 -> + {Name,Arity} = FA, + update_fun_name_1(Toks, L, {Name,Arity+1}, St); + true -> + update_fun_name_1(Toks, L, FA, St) + end; + left -> + update_fun_name_1(Toks, L+1, FA, St); + right when L =:= 1 -> + FA; + right -> + update_fun_name_1(Toks, L-1, FA, St); + other -> + case FA of + {Name,0} -> + update_fun_name_1(Toks, L, {Name,1}, St); + {_,_} -> + update_fun_name_1(Toks, L, FA, St) + end + end; +update_fun_name_1([], _, FA, _) -> + %% Syntax error, but never mind. + FA. + +classify_token({C,_}) -> classify_token_1(C); +classify_token(_) -> other. + +classify_token_1(',') -> comma; +classify_token_1('(') -> left; +classify_token_1('{') -> left; +classify_token_1('[') -> left; +classify_token_1('<<') -> left; +classify_token_1(')') -> right; +classify_token_1('}') -> right; +classify_token_1(']') -> right; +classify_token_1('>>') -> right; +classify_token_1(_) -> other. + + %%% stringify(Ts, L) returns a list of one token: a string which when %%% tokenized would yield the token list Ts. -%% erl_scan:token_info(T, text) is not backward compatible with this. +%% erl_scan:text(T) is not backward compatible with this. +%% Note that escaped characters will be replaced by themselves. token_src({dot, _}) -> "."; token_src({X, _}) when is_atom(X) -> @@ -1103,19 +1536,31 @@ token_src({var, _, X}) -> token_src({char,_,C}) -> io_lib:write_char(C); token_src({string, _, X}) -> - lists:flatten(io_lib:format("~p", [X])); + io_lib:write_string(X); token_src({_, _, X}) -> - lists:flatten(io_lib:format("~w", [X])). + io_lib:format("~w", [X]). stringify1([]) -> []; stringify1([T | Tokens]) -> - [io_lib:format(" ~s", [token_src(T)]) | stringify1(Tokens)]. + [io_lib:format(" ~ts", [token_src(T)]) | stringify1(Tokens)]. stringify(Ts, L) -> [$\s | S] = lists:flatten(stringify1(Ts)), [{string, L, S}]. +coalesce_strings([{string,A,S} | Tokens]) -> + coalesce_strings(Tokens, A, [S]); +coalesce_strings([T | Tokens]) -> + [T | coalesce_strings(Tokens)]; +coalesce_strings([]) -> + []. + +coalesce_strings([{string,_,S}|Tokens], A, S0) -> + coalesce_strings(Tokens, A, [S | S0]); +coalesce_strings(Tokens, A, S) -> + [{string,A,lists:append(lists:reverse(S))} | coalesce_strings(Tokens)]. + %% epp_request(Epp) %% epp_request(Epp, Request) %% epp_reply(From, Reply) @@ -1135,8 +1580,7 @@ epp_reply(From, Rep) -> wait_epp_reply(Epp, Mref) -> receive {epp_reply,Epp,Rep} -> - erlang:demonitor(Mref), - receive {'DOWN',Mref,_,_,_} -> ok after 0 -> ok end, + erlang:demonitor(Mref, [flush]), Rep; {'DOWN',Mref,_,_,E} -> receive {epp_reply,Epp,Rep} -> Rep @@ -1166,36 +1610,29 @@ fname_join(Components) -> filename:join(Components). %% The line only. (Other tokens may have the column and text as well...) -loc_attr(Line) when is_integer(Line) -> - Line; -loc_attr({Line,_Column}) -> - Line. +loc_anno(Line) when is_integer(Line) -> + erl_anno:new(Line); +loc_anno({Line,_Column}) -> + erl_anno:new(Line). loc(Token) -> - {location,Location} = erl_scan:token_info(Token, location), - Location. - -abs_loc(Token) -> - loc(setelement(2, Token, abs_line(element(2, Token)))). + erl_scan:location(Token). -neg_line(L) -> - erl_scan:set_attribute(line, L, fun(Line) -> -abs(Line) end). - -abs_line(L) -> - erl_scan:set_attribute(line, L, fun(Line) -> abs(Line) end). - -add_line(L, Offset) -> - erl_scan:set_attribute(line, L, fun(Line) -> Line+Offset end). +add_line(Line, Offset) when is_integer(Line) -> + Line+Offset; +add_line({Line, Column}, Offset) -> + {Line+Offset, Column}. start_loc(Line) when is_integer(Line) -> 1; start_loc({_Line, _Column}) -> - {1,1}. + {1, 1}. -get_line(Line) when is_integer(Line) -> - Line; -get_line({Line,_Column}) -> - Line. +line1() -> + erl_anno:new(1). + +get_line(Anno) -> + erl_anno:line(Anno). %% epp has always output -file attributes when entering and leaving %% included files (-include, -include_lib). Starting with R11B the @@ -1235,14 +1672,15 @@ get_line({Line,_Column}) -> interpret_file_attribute(Forms) -> interpret_file_attr(Forms, 0, []). -interpret_file_attr([{attribute,Loc,file,{File,Line}}=Form | Forms], +interpret_file_attr([{attribute,Anno,file,{File,Line}}=Form | Forms], Delta, Fs) -> - {line, L} = erl_scan:attributes_info(Loc, line), + L = get_line(Anno), + Generated = erl_anno:generated(Anno), if - L < 0 -> + Generated -> %% -file attribute - interpret_file_attr(Forms, (abs(L) + Delta) - Line, Fs); - true -> + interpret_file_attr(Forms, (L + Delta) - Line, Fs); + not Generated -> %% -include or -include_lib % true = L =:= Line, case Fs of @@ -1253,11 +1691,11 @@ interpret_file_attr([{attribute,Loc,file,{File,Line}}=Form | Forms], end end; interpret_file_attr([Form0 | Forms], Delta, Fs) -> - F = fun(Attrs) -> - F2 = fun(L) -> abs(L) + Delta end, - erl_scan:set_attribute(line, Attrs, F2) + F = fun(Anno) -> + Line = erl_anno:line(Anno), + erl_anno:set_line(Line + Delta, Anno) end, - Form = erl_lint:modify_line(Form0, F), + Form = erl_parse:map_anno(F, Form0), [Form | interpret_file_attr(Forms, Delta, Fs)]; interpret_file_attr([], _Delta, _Fs) -> []. diff --git a/lib/stdlib/src/erl_anno.erl b/lib/stdlib/src/erl_anno.erl new file mode 100644 index 0000000000..d32c34dabd --- /dev/null +++ b/lib/stdlib/src/erl_anno.erl @@ -0,0 +1,405 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(erl_anno). + +-export([new/1, is_anno/1]). +-export([column/1, end_location/1, file/1, generated/1, + line/1, location/1, record/1, text/1]). +-export([set_file/2, set_generated/2, set_line/2, set_location/2, + set_record/2, set_text/2]). + +%% To be used when necessary to avoid Dialyzer warnings. +-export([to_term/1, from_term/1]). + +-export_type([anno/0, line/0, column/0, location/0, text/0]). + +-export_type([anno_term/0]). + +-define(LN(L), is_integer(L), L >= 0). +-define(COL(C), (is_integer(C) andalso C >= 1)). + +%% Location. +-define(LCOLUMN(C), ?COL(C)). +-define(LLINE(L), ?LN(L)). + +%% Debug: define DEBUG to make sure that annotations are handled as an +%% opaque type. Note that all abstract code need to be compiled with +%% DEBUG=true. See also ./erl_pp.erl. + +%-define(DEBUG, true). + +-type annotation() :: {'file', filename()} + | {'generated', generated()} + | {'location', location()} + | {'record', record()} + | {'text', string()}. + +-opaque anno() :: location() | [annotation(), ...]. +-type anno_term() :: term(). + +-type column() :: pos_integer(). +-type generated() :: boolean(). +-type filename() :: file:filename_all(). +-type line() :: non_neg_integer(). +-type location() :: line() | {line(), column()}. +-type record() :: boolean(). +-type text() :: string(). + +-ifdef(DEBUG). +%% Anything 'false' accepted by the compiler. +-define(ALINE(A), is_reference(A)). +-define(ACOLUMN(A), is_reference(A)). +-else. +-define(ALINE(L), ?LN(L)). +-define(ACOLUMN(C), ?COL(C)). +-endif. + +-spec to_term(Anno) -> anno_term() when + Anno :: anno(). + +-ifdef(DEBUG). +to_term(Anno) -> + simplify(Anno). +-else. +to_term(Anno) -> + Anno. +-endif. + +-spec from_term(Term) -> Anno when + Term :: anno_term(), + Anno :: anno(). + +-ifdef(DEBUG). +from_term(Term) when is_list(Term) -> + Term; +from_term(Line) when is_integer(Line), Line < 0 -> % Before OTP 19 + set_generated(true, new(-Line)); +from_term(Term) -> + [{location, Term}]. +-else. +from_term(Line) when is_integer(Line), Line < 0 -> % Before OTP 19 + set_generated(true, new(-Line)); +from_term(Term) -> + Term. +-endif. + +-spec new(Location) -> anno() when + Location :: location(). + +new(Line) when ?LLINE(Line) -> + new_location(Line); +new({Line, Column}=Loc) when ?LLINE(Line), ?LCOLUMN(Column) -> + new_location(Loc); +new(Term) -> + erlang:error(badarg, [Term]). + +-ifdef(DEBUG). +new_location(Location) -> + [{location, Location}]. +-else. +new_location(Location) -> + Location. +-endif. + +-spec is_anno(Term) -> boolean() when + Term :: any(). + +is_anno(Line) when ?ALINE(Line) -> + true; +is_anno({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> + true; +is_anno(Anno) -> + (Anno =/= [] andalso + is_anno1(Anno) andalso + lists:keymember(location, 1, Anno)). + +is_anno1([{Item, Value}|Anno]) -> + is_anno2(Item, Value) andalso is_anno1(Anno); +is_anno1(A) -> + A =:= []. + +is_anno2(location, Line) when ?LN(Line) -> + true; +is_anno2(location, {Line, Column}) when ?LN(Line), ?COL(Column) -> + true; +is_anno2(generated, true) -> + true; +is_anno2(file, Filename) -> + is_filename(Filename); +is_anno2(record, true) -> + true; +is_anno2(text, Text) -> + is_string(Text); +is_anno2(_, _) -> + false. + +is_filename(T) -> + is_list(T) orelse is_binary(T). + +is_string(T) -> + is_list(T). + +-spec column(Anno) -> column() | 'undefined' when + Anno :: anno(). + +column({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> + Column; +column(Line) when ?ALINE(Line) -> + undefined; +column(Anno) -> + case location(Anno) of + {_Line, Column} -> + Column; + _Line -> + undefined + end. + +-spec end_location(Anno) -> location() | 'undefined' when + Anno :: anno(). + +end_location(Anno) -> + case text(Anno) of + undefined -> + undefined; + Text -> + case location(Anno) of + {Line, Column} -> + end_location(Text, Line, Column); + Line -> + end_location(Text, Line) + end + end. + +-spec file(Anno) -> filename() | 'undefined' when + Anno :: anno(). + +file(Line) when ?ALINE(Line) -> + undefined; +file({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> + undefined; +file(Anno) -> + anno_info(Anno, file). + +-spec generated(Anno) -> generated() when + Anno :: anno(). + +generated(Line) when ?ALINE(Line) -> + false; +generated({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> + false; +generated(Anno) -> + anno_info(Anno, generated, false). + +-spec line(Anno) -> line() when + Anno :: anno(). + +line(Anno) -> + case location(Anno) of + {Line, _Column} -> + Line; + Line -> + Line + end. + +-spec location(Anno) -> location() when + Anno :: anno(). + +location(Line) when ?ALINE(Line) -> + Line; +location({Line, Column}=Location) when ?ALINE(Line), ?ACOLUMN(Column) -> + Location; +location(Anno) -> + anno_info(Anno, location). + +-spec record(Anno) -> record() when + Anno :: anno(). + +record(Line) when ?ALINE(Line) -> + false; +record({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> + false; +record(Anno) -> + anno_info(Anno, record, false). + +-spec text(Anno) -> text() | 'undefined' when + Anno :: anno(). + +text(Line) when ?ALINE(Line) -> + undefined; +text({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> + undefined; +text(Anno) -> + anno_info(Anno, text). + +-spec set_file(File, Anno) -> Anno when + File :: filename(), + Anno :: anno(). + +set_file(File, Anno) -> + set(file, File, Anno). + +-spec set_generated(Generated, Anno) -> Anno when + Generated :: generated(), + Anno :: anno(). + +set_generated(Generated, Anno) -> + set(generated, Generated, Anno). + +-spec set_line(Line, Anno) -> Anno when + Line :: line(), + Anno :: anno(). + +set_line(Line, Anno) -> + case location(Anno) of + {_Line, Column} -> + set_location({Line, Column}, Anno); + _Line -> + set_location(Line, Anno) + end. + +-spec set_location(Location, Anno) -> Anno when + Location :: location(), + Anno :: anno(). + +set_location(Line, L) when ?ALINE(L), ?LLINE(Line) -> + new_location(Line); +set_location(Line, {L, Column}) when ?ALINE(L), ?ACOLUMN(Column), + ?LLINE(Line) -> + new_location(Line); +set_location({L, C}=Loc, Line) when ?ALINE(Line), ?LLINE(L), ?LCOLUMN(C) -> + new_location(Loc); +set_location({L, C}=Loc, {Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column), + ?LLINE(L), ?LCOLUMN(C) -> + new_location(Loc); +set_location(Location, Anno) -> + set(location, Location, Anno). + +-spec set_record(Record, Anno) -> Anno when + Record :: record(), + Anno :: anno(). + +set_record(Record, Anno) -> + set(record, Record, Anno). + +-spec set_text(Text, Anno) -> Anno when + Text :: text(), + Anno :: anno(). + +set_text(Text, Anno) -> + set(text, Text, Anno). + +set(Item, Value, Anno) -> + case {is_settable(Item, Value), Anno} of + {true, Line} when ?ALINE(Line) -> + set_anno(Item, Value, [{location, Line}]); + {true, {L, C}=Location} when ?ALINE(L), ?ACOLUMN(C) -> + set_anno(Item, Value, [{location, Location}]); + {true, A} when is_list(A), A =/= [] -> + set_anno(Item, Value, Anno); + _ -> + erlang:error(badarg, [Item, Value, Anno]) + end. + +set_anno(Item, Value, Anno) -> + case default(Item, Value) of + true -> + reset(Anno, Item); + false -> + R = case anno_info(Anno, Item) of + undefined -> + [{Item, Value}|Anno]; + _ -> + lists:keyreplace(Item, 1, Anno, {Item, Value}) + end, + reset_simplify(R) + end. + +reset(Anno, Item) -> + A = lists:keydelete(Item, 1, Anno), + reset_simplify(A). + +-ifdef(DEBUG). +reset_simplify(A) -> + A. +-else. +reset_simplify(A) -> + simplify(A). +-endif. + +simplify([{location, Location}]) -> + Location; +simplify(Anno) -> + Anno. + +anno_info(Anno, Item, Default) -> + try lists:keyfind(Item, 1, Anno) of + false -> + Default; + {Item, Value} -> + Value + catch + _:_ -> + erlang:error(badarg, [Anno]) + end. + +anno_info(Anno, Item) -> + try lists:keyfind(Item, 1, Anno) of + {Item, Value} -> + Value; + false -> + undefined + catch + _:_ -> + erlang:error(badarg, [Anno]) + end. + +end_location("", Line, Column) -> + {Line, Column}; +end_location([$\n|String], Line, _Column) -> + end_location(String, Line+1, 1); +end_location([_|String], Line, Column) -> + end_location(String, Line, Column+1). + +end_location("", Line) -> + Line; +end_location([$\n|String], Line) -> + end_location(String, Line+1); +end_location([_|String], Line) -> + end_location(String, Line). + +is_settable(file, File) -> + is_filename(File); +is_settable(generated, Boolean) when Boolean; not Boolean -> + true; +is_settable(location, Line) when ?LLINE(Line) -> + true; +is_settable(location, {Line, Column}) when ?LLINE(Line), ?LCOLUMN(Column) -> + true; +is_settable(record, Boolean) when Boolean; not Boolean -> + true; +is_settable(text, Text) -> + is_string(Text); +is_settable(_, _) -> + false. + +default(generated, false) -> true; +default(record, false) -> true; +default(_, _) -> false. diff --git a/lib/stdlib/src/erl_bits.erl b/lib/stdlib/src/erl_bits.erl index 62f6d00fae..5851401026 100644 --- a/lib/stdlib/src/erl_bits.erl +++ b/lib/stdlib/src/erl_bits.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/stdlib/src/erl_compile.erl b/lib/stdlib/src/erl_compile.erl index 81bec21a3f..a6ae398d03 100644 --- a/lib/stdlib/src/erl_compile.erl +++ b/lib/stdlib/src/erl_compile.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -21,10 +22,12 @@ -include("erl_compile.hrl"). -include("file.hrl"). --export([compile_cmdline/1]). +-export([compile_cmdline/0]). -export_type([cmd_line_arg/0]). +-define(STDERR, standard_error). %Macro to avoid misspellings. + %% Mapping from extension to {M,F} to run the correct compiler. compiler(".erl") -> {compile, compile}; @@ -47,15 +50,17 @@ compiler(_) -> no. -type cmd_line_arg() :: atom() | string(). --spec compile_cmdline([cmd_line_arg()]) -> no_return(). +-spec compile_cmdline() -> no_return(). -compile_cmdline(List) -> +compile_cmdline() -> + List = init:get_plain_arguments(), case compile(List) of ok -> my_halt(0); error -> my_halt(1); _ -> my_halt(2) end. +-spec my_halt(_) -> no_return(). my_halt(Reason) -> erlang:halt(Reason). @@ -63,86 +68,204 @@ my_halt(Reason) -> compile(List) -> process_flag(trap_exit, true), - Pid = spawn_link(fun() -> compiler_runner(List) end), + Pid = spawn_link(compiler_runner(List)), receive {'EXIT', Pid, {compiler_result, Result}} -> Result; + {'EXIT', Pid, {compiler_error, Error}} -> + io:put_chars(?STDERR, Error), + io:nl(?STDERR), + error; {'EXIT', Pid, Reason} -> - io:format("Runtime error: ~p~n", [Reason]), + io:format(?STDERR, "Runtime error: ~tp~n", [Reason]), error end. --spec compiler_runner([cmd_line_arg()]) -> no_return(). +-spec compiler_runner([cmd_line_arg()]) -> fun(() -> no_return()). compiler_runner(List) -> - %% We don't want the current directory in the code path. - %% Remove it. - Path = [D || D <- code:get_path(), D =/= "."], - true = code:set_path(Path), - exit({compiler_result, compile1(List)}). + fun() -> + %% We don't want the current directory in the code path. + %% Remove it. + Path = [D || D <- code:get_path(), D =/= "."], + true = code:set_path(Path), + exit({compiler_result, compile1(List)}) + end. %% Parses the first part of the option list. -compile1(['@cwd', Cwd|Rest]) -> - CwdL = atom_to_list(Cwd), - compile1(Rest, CwdL, #options{outdir=CwdL, cwd=CwdL}); compile1(Args) -> - %% From R13B02, the @cwd argument is optional. {ok, Cwd} = file:get_cwd(), - compile1(Args, Cwd, #options{outdir=Cwd, cwd=Cwd}). + compile1(Args, #options{outdir=Cwd,cwd=Cwd}). %% Parses all options. -compile1(['@i', Dir|Rest], Cwd, Opts) -> +compile1(["--"|Files], Opts) -> + compile2(Files, Opts); +compile1(["-"++Option|T], Opts) -> + parse_generic_option(Option, T, Opts); +compile1(["+"++Option|Rest], Opts) -> + Term = make_term(Option), + Specific = Opts#options.specific, + compile1(Rest, Opts#options{specific=[Term|Specific]}); +compile1(Files, Opts) -> + compile2(Files, Opts). + +parse_generic_option("b"++Opt, T0, Opts) -> + {OutputType,T} = get_option("b", Opt, T0), + compile1(T, Opts#options{output_type=list_to_atom(OutputType)}); +parse_generic_option("D"++Opt, T0, #options{defines=Defs}=Opts) -> + {Val0,T} = get_option("D", Opt, T0), + {Key0,Val1} = split_at_equals(Val0, []), + Key = list_to_atom(Key0), + case Val1 of + [] -> + compile1(T, Opts#options{defines=[Key|Defs]}); + Val2 -> + Val = make_term(Val2), + compile1(T, Opts#options{defines=[{Key,Val}|Defs]}) + end; +parse_generic_option("help", _, _Opts) -> + usage(); +parse_generic_option("I"++Opt, T0, #options{cwd=Cwd}=Opts) -> + {Dir,T} = get_option("I", Opt, T0), AbsDir = filename:absname(Dir, Cwd), - compile1(Rest, Cwd, Opts#options{includes=[AbsDir|Opts#options.includes]}); -compile1(['@outdir', Dir|Rest], Cwd, Opts) -> + compile1(T, Opts#options{includes=[AbsDir|Opts#options.includes]}); +parse_generic_option("M"++Opt, T0, #options{specific=Spec}=Opts) -> + case parse_dep_option(Opt, T0) of + error -> + error; + {SpecOpts,T} -> + compile1(T, Opts#options{specific=SpecOpts++Spec}) + end; +parse_generic_option("o"++Opt, T0, #options{cwd=Cwd}=Opts) -> + {Dir,T} = get_option("o", Opt, T0), AbsName = filename:absname(Dir, Cwd), case file_or_directory(AbsName) of file -> - compile1(Rest, Cwd, Opts#options{outfile=AbsName}); + compile1(T, Opts#options{outfile=AbsName}); directory -> - compile1(Rest, Cwd, Opts#options{outdir=AbsName}) + compile1(T, Opts#options{outdir=AbsName}) end; -compile1(['@d', Name|Rest], Cwd, Opts) -> - Defines = Opts#options.defines, - compile1(Rest, Cwd, Opts#options{defines=[Name|Defines]}); -compile1(['@dv', Name, Term|Rest], Cwd, Opts) -> - Defines = Opts#options.defines, - Value = make_term(atom_to_list(Term)), - compile1(Rest, Cwd, Opts#options{defines=[{Name, Value}|Defines]}); -compile1(['@warn', Level0|Rest], Cwd, Opts) -> - case catch list_to_integer(atom_to_list(Level0)) of - Level when is_integer(Level) -> - compile1(Rest, Cwd, Opts#options{warning=Level}); +parse_generic_option("O"++Opt, T, Opts) -> + case Opt of + "" -> + compile1(T, Opts#options{optimize=1}); _ -> - compile1(Rest, Cwd, Opts) + Term = make_term(Opt), + compile1(T, Opts#options{optimize=Term}) end; -compile1(['@verbose', false|Rest], Cwd, Opts) -> - compile1(Rest, Cwd, Opts#options{verbose=false}); -compile1(['@verbose', true|Rest], Cwd, Opts) -> - compile1(Rest, Cwd, Opts#options{verbose=true}); -compile1(['@optimize', Atom|Rest], Cwd, Opts) -> - Term = make_term(atom_to_list(Atom)), - compile1(Rest, Cwd, Opts#options{optimize=Term}); -compile1(['@option', Atom|Rest], Cwd, Opts) -> - Term = make_term(atom_to_list(Atom)), - Specific = Opts#options.specific, - compile1(Rest, Cwd, Opts#options{specific=[Term|Specific]}); -compile1(['@output_type', OutputType|Rest], Cwd, Opts) -> - compile1(Rest, Cwd, Opts#options{output_type=OutputType}); -compile1(['@files'|Rest], Cwd, Opts) -> - Includes = lists:reverse(Opts#options.includes), - compile2(Rest, Cwd, Opts#options{includes=Includes}). - -compile2(Files, Cwd, Opts) -> - case {Opts#options.outfile, length(Files)} of +parse_generic_option("v", T, Opts) -> + compile1(T, Opts#options{verbose=true}); +parse_generic_option("W"++Warn, T, #options{specific=Spec}=Opts) -> + case Warn of + "all" -> + compile1(T, Opts#options{warning=999}); + "error" -> + compile1(T, Opts#options{specific=[warnings_as_errors|Spec]}); + "" -> + compile1(T, Opts#options{warning=1}); + _ -> + try list_to_integer(Warn) of + Level -> + compile1(T, Opts#options{warning=Level}) + catch + error:badarg -> + usage() + end + end; +parse_generic_option("E", T, #options{specific=Spec}=Opts) -> + compile1(T, Opts#options{specific=['E'|Spec]}); +parse_generic_option("P", T, #options{specific=Spec}=Opts) -> + compile1(T, Opts#options{specific=['P'|Spec]}); +parse_generic_option("S", T, #options{specific=Spec}=Opts) -> + compile1(T, Opts#options{specific=['S'|Spec]}); +parse_generic_option(Option, _T, _Opts) -> + io:format(?STDERR, "Unknown option: -~s\n", [Option]), + usage(). + +parse_dep_option("", T) -> + {[makedep,{makedep_output,standard_io}],T}; +parse_dep_option("D", T) -> + {[makedep],T}; +parse_dep_option("F"++Opt, T0) -> + {File,T} = get_option("MF", Opt, T0), + {[makedep,{makedep_output,File}],T}; +parse_dep_option("G", T) -> + {[makedep_add_missing],T}; +parse_dep_option("P", T) -> + {[makedep_phony],T}; +parse_dep_option("Q"++Opt, T0) -> + {Target,T} = get_option("MT", Opt, T0), + {[makedep_quote_target,{makedep_target,Target}],T}; +parse_dep_option("T"++Opt, T0) -> + {Target,T} = get_option("MT", Opt, T0), + {[{makedep_target,Target}],T}; +parse_dep_option(Opt, _T) -> + io:format(?STDERR, "Unknown option: -M~s\n", [Opt]), + usage(). + +usage() -> + H = [{"-b type","type of output file (e.g. beam)"}, + {"-d","turn on debugging of erlc itself"}, + {"-Dname","define name"}, + {"-Dname=value","define name to have value"}, + {"-help","shows this help text"}, + {"-I path","where to search for include files"}, + {"-M","generate a rule for make(1) describing the dependencies"}, + {"-MF file","write the dependencies to 'file'"}, + {"-MT target","change the target of the rule emitted by dependency " + "generation"}, + {"-MQ target","same as -MT but quote characters special to make(1)"}, + {"-MG","consider missing headers as generated files and add them to " + "the dependencies"}, + {"-MP","add a phony target for each dependency"}, + {"-MD","same as -M -MT file (with default 'file')"}, + {"-o name","name output directory or file"}, + {"-pa path","add path to the front of Erlang's code path"}, + {"-pz path","add path to the end of Erlang's code path"}, + {"-smp","compile using SMP emulator"}, + {"-v","verbose compiler output"}, + {"-Werror","make all warnings into errors"}, + {"-W0","disable warnings"}, + {"-Wnumber","set warning level to number"}, + {"-Wall","enable all warnings"}, + {"-W","enable warnings (default; same as -W1)"}, + {"-E","generate listing of expanded code (Erlang compiler)"}, + {"-S","generate assembly listing (Erlang compiler)"}, + {"-P","generate listing of preprocessed code (Erlang compiler)"}, + {"+term","pass the Erlang term unchanged to the compiler"}], + io:put_chars(?STDERR, + ["Usage: erlc [Options] file.ext ...\n", + "Options:\n", + [io_lib:format("~-14s ~s\n", [K,D]) || {K,D} <- H]]), + error. + +get_option(_Name, [], [[C|_]=Option|T]) when C =/= $- -> + {Option,T}; +get_option(_Name, [_|_]=Option, T) -> + {Option,T}; +get_option(Name, _, _) -> + exit({compiler_error,"No value given to -"++Name++" option"}). + +split_at_equals([$=|T], Acc) -> + {lists:reverse(Acc),T}; +split_at_equals([H|T], Acc) -> + split_at_equals(T, [H|Acc]); +split_at_equals([], Acc) -> + {lists:reverse(Acc),[]}. + +compile2(Files, #options{cwd=Cwd,includes=Incl,outfile=Outfile}=Opts0) -> + Opts = Opts0#options{includes=lists:reverse(Incl)}, + case {Outfile,length(Files)} of {"", _} -> compile3(Files, Cwd, Opts); {[_|_], 1} -> compile3(Files, Cwd, Opts); {[_|_], _N} -> - io:format("Output file name given, but more than one input file.~n"), + io:put_chars(?STDERR, + "Output file name given, " + "but more than one input file.\n"), error end. @@ -170,23 +293,25 @@ compile3([], _Cwd, _Options) -> ok. %% Invokes the appropriate compiler, depending on the file extension. compile_file("", Input, _Output, _Options) -> - io:format("File has no extension: ~s~n", [Input]), + io:format(?STDERR, "File has no extension: ~ts~n", [Input]), error; compile_file(Ext, Input, Output, Options) -> case compiler(Ext) of no -> - io:format("Unknown extension: '~s'\n", [Ext]), + io:format(?STDERR, "Unknown extension: '~ts'\n", [Ext]), error; {M, F} -> case catch M:F(Input, Output, Options) of ok -> ok; error -> error; {'EXIT',Reason} -> - io:format("Compiler function ~w:~w/3 failed:\n~p~n", + io:format(?STDERR, + "Compiler function ~w:~w/3 failed:\n~p~n", [M,F,Reason]), error; Other -> - io:format("Compiler function ~w:~w/3 returned:\n~p~n", + io:format(?STDERR, + "Compiler function ~w:~w/3 returned:\n~p~n", [M,F,Other]), error end @@ -215,10 +340,10 @@ make_term(Str) -> case erl_parse:parse_term(Tokens ++ [{dot, 1}]) of {ok, Term} -> Term; {error, {_,_,Reason}} -> - io:format("~s: ~s~n", [Reason, Str]), + io:format(?STDERR, "~ts: ~ts~n", [Reason, Str]), throw(error) end; {error, {_,_,Reason}, _} -> - io:format("~s: ~s~n", [Reason, Str]), + io:format(?STDERR, "~ts: ~ts~n", [Reason, Str]), throw(error) end. diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 95ba6b1096..eafee346eb 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -1,23 +1,27 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(erl_eval). +%% Guard is_map/1 is not yet supported in HiPE. +-compile(no_native). + %% An evaluator for Erlang abstract syntax. -export([exprs/2,exprs/3,exprs/4,expr/2,expr/3,expr/4,expr/5, @@ -74,7 +78,7 @@ %% Only exprs/2 checks the command by calling erl_lint. The reason is %% that if there is a function handler present, then it is possible %% that there are valid constructs in Expression to be taken care of -%% by a function handler but considerad errors by erl_lint. +%% by a function handler but considered errors by erl_lint. -spec(exprs(Expressions, Bindings) -> {value, Value, NewBindings} when Expressions :: expressions(), @@ -179,8 +183,12 @@ check_command(Es, Bs) -> fun_data(F) when is_function(F) -> case erlang:fun_info(F, module) of {module,erl_eval} -> - {env, [FBs,_FEf,_FLf,FCs]} = erlang:fun_info(F, env), - {fun_data,FBs,FCs}; + case erlang:fun_info(F, env) of + {env,[{FBs,_FLf,_FEf,FCs}]} -> + {fun_data,FBs,FCs}; + {env,[{FBs,_FLf,_FEf,FCs,FName}]} -> + {named_fun_data,FBs,FName,FCs} + end; _ -> false end; @@ -227,13 +235,6 @@ expr({bc,_,E,Qs}, Bs, Lf, Ef, RBs) -> expr({tuple,_,Es}, Bs0, Lf, Ef, RBs) -> {Vs,Bs} = expr_list(Es, Bs0, Lf, Ef), ret_expr(list_to_tuple(Vs), Bs, RBs); -expr({record_field,_,_,_}=Mod, Bs, _Lf, _Ef, RBs) -> - case expand_module_name(Mod, Bs) of - {atom,_,A} -> - ret_expr(A, Bs, RBs); %% This is the "x.y" syntax - _ -> - erlang:raise(error, {badexpr, '.'}, stacktrace()) - end; expr({record_field,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> erlang:raise(error, {undef_record,Name}, stacktrace()); expr({record_index,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> @@ -242,6 +243,24 @@ expr({record,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> erlang:raise(error, {undef_record,Name}, stacktrace()); expr({record,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> erlang:raise(error, {undef_record,Name}, stacktrace()); + +%% map +expr({map,_,Binding,Es}, Bs0, Lf, Ef, RBs) -> + {value, Map0, Bs1} = expr(Binding, Bs0, Lf, Ef, none), + {Vs,Bs2} = eval_map_fields(Es, Bs0, Lf, Ef), + _ = maps:put(k, v, Map0), %Validate map. + Map1 = lists:foldl(fun ({map_assoc,K,V}, Mi) -> + maps:put(K, V, Mi); + ({map_exact,K,V}, Mi) -> + maps:update(K, V, Mi) + end, Map0, Vs), + ret_expr(Map1, merge_bindings(Bs2, Bs1), RBs); +expr({map,_,Es}, Bs0, Lf, Ef, RBs) -> + {Vs,Bs} = eval_map_fields(Es, Bs0, Lf, Ef), + ret_expr(lists:foldl(fun + ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi) + end, maps:new(), Vs), Bs, RBs); + expr({block,_,Es}, Bs, Lf, Ef, RBs) -> exprs(Es, Bs, Lf, Ef, RBs); expr({'if',_,Cs}, Bs, Lf, Ef, RBs) -> @@ -252,10 +271,10 @@ expr({'case',_,E,Cs}, Bs0, Lf, Ef, RBs) -> expr({'try',_,B,Cases,Catches,AB}, Bs, Lf, Ef, RBs) -> try_clauses(B, Cases, Catches, AB, Bs, Lf, Ef, RBs); expr({'receive',_,Cs}, Bs, Lf, Ef, RBs) -> - receive_clauses(Cs, Bs, Lf, Ef, [], RBs); + receive_clauses(Cs, Bs, Lf, Ef, RBs); expr({'receive',_, Cs, E, TB}, Bs0, Lf, Ef, RBs) -> {value,T,Bs} = expr(E, Bs0, Lf, Ef, none), - receive_clauses(T, Cs, {TB,Bs}, Bs0, Lf, Ef, [], RBs); + receive_clauses(T, Cs, {TB,Bs}, Bs0, Lf, Ef, RBs); expr({'fun',_Line,{function,Mod0,Name0,Arity0}}, Bs0, Lf, Ef, RBs) -> {[Mod,Name,Arity],Bs} = expr_list([Mod0,Name0,Arity0], Bs0, Lf, Ef), F = erlang:make_fun(Mod, Name, Arity), @@ -269,51 +288,99 @@ expr({'fun',Line,{clauses,Cs}} = Ex, Bs, Lf, Ef, RBs) -> {Ex1, _} = hide_calls(Ex, 0), {ok,Used} = erl_lint:used_vars([Ex1], Bs), En = orddict:filter(fun(K,_V) -> member(K,Used) end, Bs), + Info = {En,Lf,Ef,Cs}, %% This is a really ugly hack! F = case length(element(3,hd(Cs))) of - 0 -> fun () -> eval_fun(Cs, [], En, Lf, Ef) end; - 1 -> fun (A) -> eval_fun(Cs, [A], En, Lf, Ef) end; - 2 -> fun (A,B) -> eval_fun(Cs, [A,B], En, Lf, Ef) end; - 3 -> fun (A,B,C) -> eval_fun(Cs, [A,B,C], En, Lf, Ef) end; - 4 -> fun (A,B,C,D) -> eval_fun(Cs, [A,B,C,D], En, Lf, Ef) end; - 5 -> fun (A,B,C,D,E) -> eval_fun(Cs, [A,B,C,D,E], En, Lf, Ef) end; - 6 -> fun (A,B,C,D,E,F) -> eval_fun(Cs, [A,B,C,D,E,F], En, Lf, Ef) end; - 7 -> fun (A,B,C,D,E,F,G) -> - eval_fun(Cs, [A,B,C,D,E,F,G], En, Lf, Ef) end; - 8 -> fun (A,B,C,D,E,F,G,H) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H], En, Lf, Ef) end; - 9 -> fun (A,B,C,D,E,F,G,H,I) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I], En, Lf, Ef) end; - 10 -> fun (A,B,C,D,E,F,G,H,I,J) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J], En, Lf, Ef) end; - 11 -> fun (A,B,C,D,E,F,G,H,I,J,K) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K], En, Lf, Ef) end; - 12 -> fun (A,B,C,D,E,F,G,H,I,J,K,L) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L], En, Lf, Ef) end; - 13 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M], En, Lf, Ef) end; - 14 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N], En, Lf, Ef) end; - 15 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O], En, Lf, Ef) end; - 16 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P], En, Lf, Ef) end; - 17 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q], En, Lf, Ef) end; - 18 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R], En, Lf, Ef) end; - 19 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S], - En, Lf, Ef) end; - 20 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T], - En, Lf, Ef) end; + 0 -> fun () -> eval_fun([], Info) end; + 1 -> fun (A) -> eval_fun([A], Info) end; + 2 -> fun (A,B) -> eval_fun([A,B], Info) end; + 3 -> fun (A,B,C) -> eval_fun([A,B,C], Info) end; + 4 -> fun (A,B,C,D) -> eval_fun([A,B,C,D], Info) end; + 5 -> fun (A,B,C,D,E) -> eval_fun([A,B,C,D,E], Info) end; + 6 -> fun (A,B,C,D,E,F) -> eval_fun([A,B,C,D,E,F], Info) end; + 7 -> fun (A,B,C,D,E,F,G) -> eval_fun([A,B,C,D,E,F,G], Info) end; + 8 -> fun (A,B,C,D,E,F,G,H) -> eval_fun([A,B,C,D,E,F,G,H], Info) end; + 9 -> fun (A,B,C,D,E,F,G,H,I) -> eval_fun([A,B,C,D,E,F,G,H,I], Info) end; + 10 -> fun (A,B,C,D,E,F,G,H,I,J) -> + eval_fun([A,B,C,D,E,F,G,H,I,J], Info) end; + 11 -> fun (A,B,C,D,E,F,G,H,I,J,K) -> + eval_fun([A,B,C,D,E,F,G,H,I,J,K], Info) end; + 12 -> fun (A,B,C,D,E,F,G,H,I,J,K,L) -> + eval_fun([A,B,C,D,E,F,G,H,I,J,K,L], Info) end; + 13 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M) -> + eval_fun([A,B,C,D,E,F,G,H,I,J,K,L,M], Info) end; + 14 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N) -> + eval_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N], Info) end; + 15 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O) -> + eval_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O], Info) end; + 16 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P) -> + eval_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P], Info) end; + 17 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q) -> + eval_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q], Info) end; + 18 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R) -> + eval_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R], Info) end; + 19 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S) -> + eval_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S], Info) end; + 20 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T) -> + eval_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T], Info) end; _Other -> erlang:raise(error, {'argument_limit',{'fun',Line,Cs}}, stacktrace()) end, ret_expr(F, Bs, RBs); +expr({named_fun,Line,Name,Cs} = Ex, Bs, Lf, Ef, RBs) -> + %% Save only used variables in the function environment. + %% {value,L,V} are hidden while lint finds used variables. + {Ex1, _} = hide_calls(Ex, 0), + {ok,Used} = erl_lint:used_vars([Ex1], Bs), + En = orddict:filter(fun(K,_V) -> member(K,Used) end, Bs), + Info = {En,Lf,Ef,Cs,Name}, + %% This is a really ugly hack! + F = + case length(element(3,hd(Cs))) of + 0 -> fun RF() -> eval_named_fun([], RF, Info) end; + 1 -> fun RF(A) -> eval_named_fun([A], RF, Info) end; + 2 -> fun RF(A,B) -> eval_named_fun([A,B], RF, Info) end; + 3 -> fun RF(A,B,C) -> eval_named_fun([A,B,C], RF, Info) end; + 4 -> fun RF(A,B,C,D) -> eval_named_fun([A,B,C,D], RF, Info) end; + 5 -> fun RF(A,B,C,D,E) -> eval_named_fun([A,B,C,D,E], RF, Info) end; + 6 -> fun RF(A,B,C,D,E,F) -> eval_named_fun([A,B,C,D,E,F], RF, Info) end; + 7 -> fun RF(A,B,C,D,E,F,G) -> + eval_named_fun([A,B,C,D,E,F,G], RF, Info) end; + 8 -> fun RF(A,B,C,D,E,F,G,H) -> + eval_named_fun([A,B,C,D,E,F,G,H], RF, Info) end; + 9 -> fun RF(A,B,C,D,E,F,G,H,I) -> + eval_named_fun([A,B,C,D,E,F,G,H,I], RF, Info) end; + 10 -> fun RF(A,B,C,D,E,F,G,H,I,J) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J], RF, Info) end; + 11 -> fun RF(A,B,C,D,E,F,G,H,I,J,K) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K], RF, Info) end; + 12 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L], RF, Info) end; + 13 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M], RF, Info) end; + 14 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M,N) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N], RF, Info) end; + 15 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O], RF, Info) end; + 16 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P], RF, Info) end; + 17 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q], RF, Info) end; + 18 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R], RF, Info) end; + 19 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S], + RF, Info) end; + 20 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T], + RF, Info) end; + _Other -> + erlang:raise(error, {'argument_limit',{named_fun,Line,Name,Cs}}, + stacktrace()) + end, + ret_expr(F, Bs, RBs); expr({call,_,{remote,_,{atom,_,qlc},{atom,_,q}},[{lc,_,_E,_Qs}=LC | As0]}, Bs0, Lf, Ef, RBs) when length(As0) =< 1 -> %% No expansion or evaluation of module name or function name. @@ -332,8 +399,7 @@ expr({call,L1,{remote,L2,{record_field,_,{atom,_,''},{atom,_,qlc}=Mod}, Bs, Lf, Ef, RBs) when length(As0) =< 1 -> expr({call,L1,{remote,L2,Mod,Func},As}, Bs, Lf, Ef, RBs); expr({call,_,{remote,_,Mod,Func},As0}, Bs0, Lf, Ef, RBs) -> - Mod1 = expand_module_name(Mod, Bs0), - {value,M,Bs1} = expr(Mod1, Bs0, Lf, Ef, none), + {value,M,Bs1} = expr(Mod, Bs0, Lf, Ef, none), {value,F,Bs2} = expr(Func, Bs0, Lf, Ef, none), {As,Bs3} = expr_list(As0, merge_bindings(Bs1, Bs2), Lf, Ef), %% M could be a parameterized module (not an atom). @@ -349,12 +415,17 @@ expr({call,_,{atom,_,Func},As0}, Bs0, Lf, Ef, RBs) -> {As,Bs} = expr_list(As0, Bs0, Lf, Ef), bif(Func, As, Bs, Ef, RBs); false -> - local_func(Func, As0, Bs0, Lf, RBs) + local_func(Func, As0, Bs0, Lf, Ef, RBs) end; expr({call,_,Func0,As0}, Bs0, Lf, Ef, RBs) -> % function or {Mod,Fun} {value,Func,Bs1} = expr(Func0, Bs0, Lf, Ef, none), {As,Bs2} = expr_list(As0, Bs1, Lf, Ef), - do_apply(Func, As, Bs2, Ef, RBs); + case Func of + {M,F} when is_atom(M), is_atom(F) -> + erlang:raise(error, {badfun,Func}, stacktrace()); + _ -> + do_apply(Func, As, Bs2, Ef, RBs) + end; expr({'catch',_,Expr}, Bs0, Lf, Ef, RBs) -> Ref = make_ref(), case catch {Ref,expr(Expr, Bs0, Lf, Ef, none)} of @@ -409,12 +480,13 @@ expr({value,_,Val}, Bs, _Lf, _Ef, RBs) -> % Special case straight values. find_maxline(LC) -> put('$erl_eval_max_line', 0), - F = fun(L) -> + F = fun(A) -> + L = erl_anno:line(A), case is_integer(L) and (L > get('$erl_eval_max_line')) of true -> put('$erl_eval_max_line', L); false -> ok end end, - _ = erl_lint:modify_line(LC, F), + _ = erl_parse:map_anno(F, LC), erase('$erl_eval_max_line'). hide_calls(LC, MaxLine) -> @@ -424,14 +496,16 @@ hide_calls(LC, MaxLine) -> %% v/1 and local calls are hidden. hide({value,L,V}, Id, D) -> - {{atom,Id,ok}, Id+1, dict:store(Id, {value,L,V}, D)}; + A = erl_anno:new(Id), + {{atom,A,ok}, Id+1, dict:store(Id, {value,L,V}, D)}; hide({call,L,{atom,_,N}=Atom,Args}, Id0, D0) -> {NArgs, Id, D} = hide(Args, Id0, D0), C = case erl_internal:bif(N, length(Args)) of true -> {call,L,Atom,NArgs}; false -> - {call,Id,{remote,L,{atom,L,m},{atom,L,f}},NArgs} + A = erl_anno:new(Id), + {call,A,{remote,L,{atom,L,m},{atom,L,f}},NArgs} end, {C, Id+1, dict:store(Id, {call,Atom}, D)}; hide(T0, Id0, D0) when is_tuple(T0) -> @@ -444,11 +518,23 @@ hide([E0 | Es0], Id0, D0) -> hide(E, Id, D) -> {E, Id, D}. -unhide_calls({atom,Id,ok}, MaxLine, D) when Id > MaxLine -> - dict:fetch(Id, D); -unhide_calls({call,Id,{remote,L,_M,_F},Args}, MaxLine, D) when Id > MaxLine -> - {call,Atom} = dict:fetch(Id, D), - {call,L,Atom,unhide_calls(Args, MaxLine, D)}; +unhide_calls({atom,A,ok}=E, MaxLine, D) -> + L = erl_anno:line(A), + if + L > MaxLine -> + dict:fetch(L, D); + true -> + E + end; +unhide_calls({call,A,{remote,L,{atom,L,m},{atom,L,f}}=F,Args}, MaxLine, D) -> + Line = erl_anno:line(A), + if + Line > MaxLine -> + {call,Atom} = dict:fetch(Line, D), + {call,L,Atom,unhide_calls(Args, MaxLine, D)}; + true -> + {call,A,F,unhide_calls(Args, MaxLine, D)} + end; unhide_calls(T, MaxLine, D) when is_tuple(T) -> list_to_tuple(unhide_calls(tuple_to_list(T), MaxLine, D)); unhide_calls([E | Es], MaxLine, D) -> @@ -456,33 +542,34 @@ unhide_calls([E | Es], MaxLine, D) -> unhide_calls(E, _MaxLine, _D) -> E. -%% local_func(Function, Arguments, Bindings, LocalFuncHandler, RBs) -> +%% local_func(Function, Arguments, Bindings, LocalFuncHandler, +%% ExternalFuncHandler, RBs) -> %% {value,Value,Bindings} | Value when %% LocalFuncHandler = {value,F} | {value,F,Eas} | %% {eval,F} | {eval,F,Eas} | none. -local_func(Func, As0, Bs0, {value,F}, value) -> - {As1,_Bs1} = expr_list(As0, Bs0, {value,F}), +local_func(Func, As0, Bs0, {value,F}, Ef, value) -> + {As1,_Bs1} = expr_list(As0, Bs0, {value,F}, Ef), %% Make tail recursive calls when possible. F(Func, As1); -local_func(Func, As0, Bs0, {value,F}, RBs) -> - {As1,Bs1} = expr_list(As0, Bs0, {value,F}), +local_func(Func, As0, Bs0, {value,F}, Ef, RBs) -> + {As1,Bs1} = expr_list(As0, Bs0, {value,F}, Ef), ret_expr(F(Func, As1), Bs1, RBs); -local_func(Func, As0, Bs0, {value,F,Eas}, RBs) -> +local_func(Func, As0, Bs0, {value,F,Eas}, Ef, RBs) -> Fun = fun(Name, Args) -> apply(F, [Name,Args|Eas]) end, - local_func(Func, As0, Bs0, {value, Fun}, RBs); -local_func(Func, As, Bs, {eval,F}, RBs) -> + local_func(Func, As0, Bs0, {value, Fun}, Ef, RBs); +local_func(Func, As, Bs, {eval,F}, _Ef, RBs) -> local_func2(F(Func, As, Bs), RBs); -local_func(Func, As, Bs, {eval,F,Eas}, RBs) -> +local_func(Func, As, Bs, {eval,F,Eas}, _Ef, RBs) -> local_func2(apply(F, [Func,As,Bs|Eas]), RBs); %% These two clauses are for backwards compatibility. -local_func(Func, As0, Bs0, {M,F}, RBs) -> - {As1,Bs1} = expr_list(As0, Bs0, {M,F}), +local_func(Func, As0, Bs0, {M,F}, Ef, RBs) -> + {As1,Bs1} = expr_list(As0, Bs0, {M,F}, Ef), ret_expr(M:F(Func,As1), Bs1, RBs); -local_func(Func, As, _Bs, {M,F,Eas}, RBs) -> +local_func(Func, As, _Bs, {M,F,Eas}, _Ef, RBs) -> local_func2(apply(M, F, [Func,As|Eas]), RBs); %% Default unknown function handler to undefined function. -local_func(Func, As0, _Bs0, none, _RBs) -> +local_func(Func, As0, _Bs0, none, _Ef, _RBs) -> erlang:raise(error, undef, [{erl_eval,Func,length(As0)}|stacktrace()]). local_func2({value,V,Bs}, RBs) -> @@ -537,7 +624,7 @@ do_apply(Func, As, Bs0, Ef, RBs) -> no_env end, case {Env,Ef} of - {{env,[FBs, FEf, FLf, FCs]},_} -> + {{env,[{FBs,FLf,FEf,FCs}]},_} -> %% If we are evaluting within another function body %% (RBs =/= none), we return RBs when this function body %% has been evalutated, otherwise we return Bs0, the @@ -552,6 +639,17 @@ do_apply(Func, As, Bs0, Ef, RBs) -> _ -> erlang:raise(error, {badarity,{Func,As}},stacktrace()) end; + {{env,[{FBs,FLf,FEf,FCs,FName}]},_} -> + NRBs = if + RBs =:= none -> Bs0; + true -> RBs + end, + case {erlang:fun_info(Func, arity), length(As)} of + {{arity, Arity}, Arity} -> + eval_named_fun(FCs, As, FBs, FLf, FEf, FName, Func, NRBs); + _ -> + erlang:raise(error, {badarity,{Func,As}},stacktrace()) + end; {no_env,none} when RBs =:= value -> %% Make tail recursive calls when possible. apply(Func, As); @@ -666,6 +764,24 @@ eval_filter(F, Bs0, Lf, Ef, CompFun, Acc) -> end end. +%% eval_map_fields([Field], Bindings, LocalFunctionHandler, +%% ExternalFuncHandler) -> +%% {[{map_assoc | map_exact,Key,Value}],Bindings} + +eval_map_fields(Fs, Bs, Lf, Ef) -> + eval_map_fields(Fs, Bs, Lf, Ef, []). + +eval_map_fields([{map_field_assoc,_,K0,V0}|Fs], Bs0, Lf, Ef, Acc) -> + {value,K1,Bs1} = expr(K0, Bs0, Lf, Ef, none), + {value,V1,Bs2} = expr(V0, Bs1, Lf, Ef, none), + eval_map_fields(Fs, Bs2, Lf, Ef, [{map_assoc,K1,V1}|Acc]); +eval_map_fields([{map_field_exact,_,K0,V0}|Fs], Bs0, Lf, Ef, Acc) -> + {value,K1,Bs1} = expr(K0, Bs0, Lf, Ef, none), + {value,V1,Bs2} = expr(V0, Bs1, Lf, Ef, none), + eval_map_fields(Fs, Bs2, Lf, Ef, [{map_exact,K1,V1}|Acc]); +eval_map_fields([], Bs, _Lf, _Ef, Acc) -> + {lists:reverse(Acc),Bs}. + %% RBs is the bindings to return when the evalution of a function %% (fun) has finished. If RBs =:= none, then the evalution took place @@ -679,12 +795,12 @@ ret_expr(V, Bs, none) -> ret_expr(V, _Bs, RBs) when is_list(RBs) -> {value,V,RBs}. -%% eval_fun(Clauses, Arguments, Bindings, LocalFunctionHandler, -%% ExternalFunctionHandler) -> Value +%% eval_fun(Arguments, {Bindings,LocalFunctionHandler, +%% ExternalFunctionHandler,Clauses}) -> Value %% This function is called when the fun is called from compiled code %% or from apply. -eval_fun(Cs, As, Bs0, Lf, Ef) -> +eval_fun(As, {Bs0,Lf,Ef,Cs}) -> eval_fun(Cs, As, Bs0, Lf, Ef, value). eval_fun([{clause,_,H,G,B}|Cs], As, Bs0, Lf, Ef, RBs) -> @@ -702,6 +818,27 @@ eval_fun([], As, _Bs, _Lf, _Ef, _RBs) -> erlang:raise(error, function_clause, [{?MODULE,'-inside-an-interpreted-fun-',As}|stacktrace()]). + +eval_named_fun(As, Fun, {Bs0,Lf,Ef,Cs,Name}) -> + eval_named_fun(Cs, As, Bs0, Lf, Ef, Name, Fun, value). + +eval_named_fun([{clause,_,H,G,B}|Cs], As, Bs0, Lf, Ef, Name, Fun, RBs) -> + Bs1 = add_binding(Name, Fun, Bs0), + case match_list(H, As, new_bindings(), Bs1) of + {match,Bsn} -> % The new bindings for the head + Bs2 = add_bindings(Bsn, Bs1), % which then shadow! + case guard(G, Bs2, Lf, Ef) of + true -> exprs(B, Bs2, Lf, Ef, RBs); + false -> eval_named_fun(Cs, As, Bs0, Lf, Ef, Name, Fun, RBs) + end; + nomatch -> + eval_named_fun(Cs, As, Bs0, Lf, Ef, Name, Fun, RBs) + end; +eval_named_fun([], As, _Bs, _Lf, _Ef, _Name, _Fun, _RBs) -> + erlang:raise(error, function_clause, + [{?MODULE,'-inside-an-interpreted-fun-',As}|stacktrace()]). + + %% expr_list(ExpressionList, Bindings) %% expr_list(ExpressionList, Bindings, LocalFuncHandler) %% expr_list(ExpressionList, Bindings, LocalFuncHandler, ExternalFuncHandler) @@ -810,66 +947,24 @@ case_clauses(Val, Cs, Bs, Lf, Ef, RBs) -> end. %% -%% receive_clauses(Clauses, Bindings, LocalFuncHnd,ExtFuncHnd, Messages, RBs) +%% receive_clauses(Clauses, Bindings, LocalFuncHnd,ExtFuncHnd, RBs) %% -receive_clauses(Cs, Bs, Lf, Ef, Ms, RBs) -> - receive - Val -> - case match_clause(Cs, [Val], Bs, Lf, Ef) of - {B, Bs1} -> - merge_queue(Ms), - exprs(B, Bs1, Lf, Ef, RBs); - nomatch -> - receive_clauses(Cs, Bs, Lf, Ef, [Val|Ms], RBs) - end - end. +receive_clauses(Cs, Bs, Lf, Ef, RBs) -> + receive_clauses(infinity, Cs, unused, Bs, Lf, Ef, RBs). %% %% receive_clauses(TimeOut, Clauses, TimeoutBody, Bindings, %% ExternalFuncHandler, LocalFuncHandler, RBs) %% -receive_clauses(T, Cs, TB, Bs, Lf, Ef, Ms, RBs) -> - {_,_} = statistics(runtime), - receive - Val -> - case match_clause(Cs, [Val], Bs, Lf, Ef) of - {B, Bs1} -> - merge_queue(Ms), - exprs(B, Bs1, Lf, Ef, RBs); - nomatch -> - {_,T1} = statistics(runtime), - if - T =:= infinity -> - receive_clauses(T, Cs, TB,Bs,Lf,Ef,[Val|Ms],RBs); - T-T1 =< 0 -> - receive_clauses(0, Cs, TB,Bs,Lf,Ef,[Val|Ms],RBs); - true -> - receive_clauses(T-T1, Cs,TB,Bs,Lf,Ef,[Val|Ms],RBs) - end - end - after T -> - merge_queue(Ms), +receive_clauses(T, Cs, TB, Bs, Lf, Ef, RBs) -> + F = fun (M) -> match_clause(Cs, [M], Bs, Lf, Ef) end, + case prim_eval:'receive'(F, T) of + {B, Bs1} -> + exprs(B, Bs1, Lf, Ef, RBs); + timeout -> {B, Bs1} = TB, exprs(B, Bs1, Lf, Ef, RBs) end. -merge_queue([]) -> - true; -merge_queue(Ms) -> - send_all(recv_all(Ms), self()). - -recv_all(Xs) -> - receive - X -> recv_all([X|Xs]) - after 0 -> - reverse(Xs) - end. - -send_all([X|Xs], Self) -> - Self ! X, - send_all(Xs, Self); -send_all([], _) -> true. - - %% match_clause -> {Body, Bindings} or nomatch -spec(match_clause(Clauses, ValueList, Bindings, LocalFunctionHandler) -> @@ -934,12 +1029,16 @@ guard0([], _Bs, _Lf, _Ef) -> true. guard_test({call,L,{atom,Ln,F},As0}, Bs0, Lf, Ef) -> TT = type_test(F), G = {call,L,{atom,Ln,TT},As0}, - try {value,true,_} = expr(G, Bs0, Lf, Ef, none) - catch error:_ -> {value,false,Bs0} end; -guard_test({call,L,{remote,_Lr,{atom,_Lm,erlang},{atom,_Lf,_F}=T},As0}, + expr_guard_test(G, Bs0, Lf, Ef); +guard_test({call,L,{remote,Lr,{atom,Lm,erlang},{atom,Lf,F}},As0}, Bs0, Lf, Ef) -> - guard_test({call,L,T,As0}, Bs0, Lf, Ef); + TT = type_test(F), + G = {call,L,{remote,Lr,{atom,Lm,erlang},{atom,Lf,TT}},As0}, + expr_guard_test(G, Bs0, Lf, Ef); guard_test(G, Bs0, Lf, Ef) -> + expr_guard_test(G, Bs0, Lf, Ef). + +expr_guard_test(G, Bs0, Lf, Ef) -> try {value,true,_} = expr(G, Bs0, Lf, Ef, none) catch error:_ -> {value,false,Bs0} end. @@ -955,9 +1054,10 @@ type_test(port) -> is_port; type_test(function) -> is_function; type_test(binary) -> is_binary; type_test(record) -> is_record; +type_test(map) -> is_map; type_test(Test) -> Test. - + %% match(Pattern, Term, Bindings) -> %% {match,NewBindings} | nomatch %% or erlang:error({illegal_pattern, Pattern}). @@ -1036,6 +1136,10 @@ match1({tuple,_,Elts}, Tuple, Bs, BBs) match_tuple(Elts, Tuple, 1, Bs, BBs); match1({tuple,_,_}, _, _Bs, _BBs) -> throw(nomatch); +match1({map,_,Fs}, #{}=Map, Bs, BBs) -> + match_map(Fs, Map, Bs, BBs); +match1({map,_,_}, _, _Bs, _BBs) -> + throw(nomatch); match1({bin, _, Fs}, <<_/bitstring>>=B, Bs0, BBs) -> eval_bits:match_bits(Fs, B, Bs0, BBs, match_fun(BBs), @@ -1079,6 +1183,18 @@ match_tuple([E|Es], Tuple, I, Bs0, BBs) -> match_tuple([], _, _, Bs, _BBs) -> {match,Bs}. +match_map([{map_field_exact, _, K, V}|Fs], Map, Bs0, BBs) -> + Vm = try + {value, Ke, _} = expr(K, BBs), + maps:get(Ke,Map) + catch error:_ -> + throw(nomatch) + end, + {match, Bs} = match1(V, Vm, Bs0, BBs), + match_map(Fs, Map, Bs, BBs); +match_map([], _, Bs, _) -> + {match, Bs}. + %% match_list(PatternList, TermList, Bindings) -> %% {match,NewBindings} | nomatch %% Try to match a list of patterns against a list of terms with the @@ -1096,7 +1212,7 @@ match_list([], [], Bs, _BBs) -> {match,Bs}; match_list(_, _, _Bs, _BBs) -> nomatch. - + %% new_bindings() %% bindings(Bindings) %% binding(Name, Bindings) @@ -1190,6 +1306,7 @@ partial_eval(Expr) -> ev_expr({op,_,Op,L,R}) -> erlang:Op(ev_expr(L), ev_expr(R)); ev_expr({op,_,Op,A}) -> erlang:Op(ev_expr(A)); ev_expr({integer,_,X}) -> X; +ev_expr({char,_,X}) -> X; ev_expr({float,_,X}) -> X; ev_expr({atom,_,X}) -> X; ev_expr({tuple,_,Es}) -> @@ -1210,41 +1327,6 @@ ret_expr(_Old, New) -> line(Expr) -> element(2, Expr). -%% In syntax trees, module/package names are atoms or lists of atoms. - -expand_module_name({atom,L,A} = M, Bs) -> - case binding({module,A}, Bs) of - {value, A1} -> - {atom,L,A1}; - unbound -> - case packages:is_segmented(A) of - true -> - M; - false -> -%%% P = case binding({module,'$package'}, Bs) of -%%% {value, P1} -> P1; -%%% unbound -> "" -%%% end, -%%% A1 = list_to_atom(packages:concat(P, A)), -%%% {atom,L,list_to_atom(A1)} - {atom,L,A} - end - end; -expand_module_name(M, _) -> - case erl_parse:package_segments(M) of - error -> - M; - M1 -> - L = element(2,M), - Mod = packages:concat(M1), - case packages:is_valid(Mod) of - true -> - {atom,L,list_to_atom(Mod)}; - false -> - erlang:raise(error, {bad_module_name, Mod}, stacktrace()) - end - end. - %% {?MODULE,expr,3} is still the stacktrace, despite the %% fact that expr() now takes two, three or four arguments... stacktrace() -> [{?MODULE,expr,3}]. diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index 9759a8f001..ebcbc54ab1 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -32,59 +33,31 @@ vcount=0, % Variable counter imports=[], % Imports records=dict:new(), % Record definitions - trecords=sets:new(), % Typed records - uses_types=false, % Are there -spec or -type in the module strict_ra=[], % strict record accesses checked_ra=[] % successfully accessed records }). --spec(module(AbsForms, CompileOptions) -> AbsForms when +-spec(module(AbsForms, CompileOptions) -> AbsForms2 when AbsForms :: [erl_parse:abstract_form()], + AbsForms2 :: [erl_parse:abstract_form()], CompileOptions :: [compile:option()]). %% Is is assumed that Fs is a valid list of forms. It should pass %% erl_lint without errors. module(Fs0, Opts0) -> Opts = compiler_options(Fs0) ++ Opts0, - TRecs = typed_records(Fs0), - UsesTypes = uses_types(Fs0), - St0 = #exprec{compile = Opts, trecords = TRecs, uses_types = UsesTypes}, + St0 = #exprec{compile = Opts}, {Fs,_St} = forms(Fs0, St0), Fs. compiler_options(Forms) -> lists:flatten([C || {attribute,_,compile,C} <- Forms]). -typed_records(Fs) -> - typed_records(Fs, sets:new()). - -typed_records([{attribute,_L,type,{{record, Name},_Defs,[]}} | Fs], Trecs) -> - typed_records(Fs, sets:add_element(Name, Trecs)); -typed_records([_|Fs], Trecs) -> - typed_records(Fs, Trecs); -typed_records([], Trecs) -> - Trecs. - -uses_types([{attribute,_L,spec,_}|_]) -> true; -uses_types([{attribute,_L,type,_}|_]) -> true; -uses_types([{attribute,_L,opaque,_}|_]) -> true; -uses_types([_|Fs]) -> uses_types(Fs); -uses_types([]) -> false. - -forms([{attribute,L,record,{Name,Defs}} | Fs], St0) -> +forms([{attribute,_,record,{Name,Defs}}=Attr | Fs], St0) -> NDefs = normalise_fields(Defs), St = St0#exprec{records=dict:store(Name, NDefs, St0#exprec.records)}, {Fs1, St1} = forms(Fs, St), - %% Check if we need to keep the record information for usage in types. - case St#exprec.uses_types of - true -> - case sets:is_element(Name, St#exprec.trecords) of - true -> {Fs1, St1}; - false -> {[{attribute,L,type,{{record,Name},Defs,[]}}|Fs1], St1} - end; - false -> - {Fs1, St1} - end; + {[Attr | Fs1], St1}; forms([{attribute,L,import,Is} | Fs0], St0) -> St1 = import(Is, St0), {Fs,St2} = forms(Fs0, St1), @@ -132,17 +105,23 @@ pattern({cons,Line,H,T}, St0) -> pattern({tuple,Line,Ps}, St0) -> {TPs,St1} = pattern_list(Ps, St0), {{tuple,Line,TPs},St1}; +pattern({map,Line,Ps}, St0) -> + {TPs,St1} = pattern_list(Ps, St0), + {{map,Line,TPs},St1}; +pattern({map_field_exact,Line,K0,V0}, St0) -> + {K,St1} = expr(K0, St0), + {V,St2} = pattern(V0, St1), + {{map_field_exact,Line,K,V},St2}; %%pattern({struct,Line,Tag,Ps}, St0) -> %% {TPs,TPsvs,St1} = pattern_list(Ps, St0), %% {{struct,Line,Tag,TPs},TPsvs,St1}; -pattern({record_field,_,_,_}=M, St) -> - {M,St}; % must be a package name pattern({record_index,Line,Name,Field}, St) -> {index_expr(Line, Field, Name, record_fields(Name, St)),St}; -pattern({record,Line,Name,Pfs}, St0) -> +pattern({record,Line0,Name,Pfs}, St0) -> Fs = record_fields(Name, St0), {TMs,St1} = pattern_list(pattern_fields(Fs, Pfs), St0), - {{tuple,Line,[{atom,Line,Name} | TMs]},St1}; + Line = mark_record(Line0, St1), + {{tuple,Line,[{atom,Line0,Name} | TMs]},St1}; pattern({bin,Line,Es0}, St0) -> {Es1,St1} = pattern_bin(Es0, St0), {{bin,Line,Es1},St1}; @@ -235,7 +214,7 @@ record_test_in_guard(Line, Term, Name, St) -> expr({atom,Line,false}, St); false -> Fs = record_fields(Name, St), - NLine = neg_line(Line), + NLine = no_compiler_warning(Line), expr({call,NLine,{remote,NLine,{atom,NLine,erlang},{atom,NLine,is_record}}, [Term,{atom,Line,Name},{integer,Line,length(Fs)+1}]}, St) @@ -261,7 +240,7 @@ record_test_in_body(Line, Expr, Name, St0) -> %% evaluate to a tuple properly. Fs = record_fields(Name, St0), {Var,St} = new_var(Line, St0), - NLine = neg_line(Line), + NLine = no_compiler_warning(Line), expr({block,Line, [{match,Line,Var,Expr}, {call,NLine,{remote,NLine,{atom,NLine,erlang}, @@ -303,16 +282,30 @@ expr({bc,Line,E0,Qs0}, St0) -> expr({tuple,Line,Es0}, St0) -> {Es1,St1} = expr_list(Es0, St0), {{tuple,Line,Es1},St1}; +expr({map,Line,Es0}, St0) -> + {Es1,St1} = expr_list(Es0, St0), + {{map,Line,Es1},St1}; +expr({map,Line,Arg0,Es0}, St0) -> + {Arg1,St1} = expr(Arg0, St0), + {Es1,St2} = expr_list(Es0, St1), + {{map,Line,Arg1,Es1},St2}; +expr({map_field_assoc,Line,K0,V0}, St0) -> + {K,St1} = expr(K0, St0), + {V,St2} = expr(V0, St1), + {{map_field_assoc,Line,K,V},St2}; +expr({map_field_exact,Line,K0,V0}, St0) -> + {K,St1} = expr(K0, St0), + {V,St2} = expr(V0, St1), + {{map_field_exact,Line,K,V},St2}; %%expr({struct,Line,Tag,Es0}, Vs, St0) -> %% {Es1,Esvs,Esus,St1} = expr_list(Es0, Vs, St0), %% {{struct,Line,Tag,Es1},Esvs,Esus,St1}; -expr({record_field,_,_,_}=M, St) -> - {M,St}; % must be a package name expr({record_index,Line,Name,F}, St) -> I = index_expr(Line, F, Name, record_fields(Name, St)), expr(I, St); -expr({record,Line,Name,Is}, St) -> - expr({tuple,Line,[{atom,Line,Name} | +expr({record,Line0,Name,Is}, St) -> + Line = mark_record(Line0, St), + expr({tuple,Line,[{atom,Line0,Name} | record_inits(record_fields(Name, St), Is)]}, St); expr({record_field,Line,R,Name,F}, St) -> @@ -348,6 +341,9 @@ expr({'fun',_,{function,_M,_F,_A}}=Fun, St) -> expr({'fun',Line,{clauses,Cs0}}, St0) -> {Cs,St1} = clauses(Cs0, St0), {{'fun',Line,{clauses,Cs}},St1}; +expr({named_fun,Line,Name,Cs0}, St0) -> + {Cs,St1} = clauses(Cs0, St0), + {{named_fun,Line,Name,Cs},St1}; expr({call,Line,{atom,_,is_record},[A,{atom,_,Name}]}, St) -> record_test(Line, A, Name, St); expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,is_record}}, @@ -359,31 +355,15 @@ expr({call,Line,{tuple,_,[{atom,_,erlang},{atom,_,is_record}]}, expr({call,Line,{atom,_La,N}=Atom,As0}, St0) -> {As,St1} = expr_list(As0, St0), Ar = length(As), - case erl_internal:bif(N, Ar) of - true -> - {{call,Line,Atom,As},St1}; - false -> - case imported(N, Ar, St1) of - {yes,_Mod} -> - {{call,Line,Atom,As},St1}; - no -> - case {N,Ar} of - {record_info,2} -> - record_info_call(Line, As, St1); - _ -> - {{call,Line,Atom,As},St1} - end - end + case {N,Ar} =:= {record_info,2} andalso not imported(N, Ar, St1) of + true -> + record_info_call(Line, As, St1); + false -> + {{call,Line,Atom,As},St1} end; -expr({call,Line,{record_field,_,_,_}=M,As0}, St0) -> - {As,St1} = expr_list(As0, St0), - {{call,Line,M,As},St1}; expr({call,Line,{remote,Lr,M,F},As0}, St0) -> {[M1,F1 | As1],St1} = expr_list([M,F | As0], St0), {{call,Line,{remote,Lr,M1,F1},As1},St1}; -expr({call,Line,{tuple,Lt,[{atom,_,_}=M,{atom,_,_}=F]},As0}, St0) -> - {As,St1} = expr_list(As0, St0), - {{call,Line,{tuple,Lt,[M,F]},As},St1}; expr({call,Line,F,As0}, St0) -> {[Fun1 | As1],St1} = expr_list([F | As0], St0), {{call,Line,Fun1,As1},St1}; @@ -450,7 +430,7 @@ strict_record_access(E0, St0) -> conj([], _E) -> empty; conj([{{Name,_Rp},L,R,Sz} | AL], E) -> - NL = neg_line(L), + NL = no_compiler_warning(L), T1 = {op,NL,'orelse', {call,NL, {remote,NL,{atom,NL,erlang},{atom,NL,is_record}}, @@ -505,7 +485,6 @@ lc_tq(Line, [F0 | Qs0], St0) -> lc_tq(_Line, [], St0) -> {[],St0#exprec{checked_ra = []}}. - %% normalise_fields([RecDef]) -> [Field]. %% Normalise the field definitions to always have a default value. If %% none has been given then use 'undefined'. @@ -566,9 +545,10 @@ strict_get_record_field(Line, R, {atom,_,F}=Index, Name, St0) -> Fs = record_fields(Name, St), I = index_expr(F, Fs, 2), P = record_pattern(2, I, Var, length(Fs)+1, Line, [{atom,Line,Name}]), - NLine = neg_line(Line), + NLine = no_compiler_warning(Line), + RLine = mark_record(NLine, St), E = {'case',NLine,R, - [{clause,NLine,[{tuple,NLine,P}],[],[Var]}, + [{clause,NLine,[{tuple,RLine,P}],[],[Var]}, {clause,NLine,[{var,NLine,'_'}],[], [{call,NLine,{remote,NLine, {atom,NLine,erlang}, @@ -580,7 +560,8 @@ strict_get_record_field(Line, R, {atom,_,F}=Index, Name, St0) -> I = index_expr(Line, Index, Name, Fs), {ExpR,St1} = expr(R, St0), %% Just to make comparison simple: - ExpRp = erl_lint:modify_line(ExpR, fun(_L) -> 0 end), + A0 = erl_anno:new(0), + ExpRp = erl_parse:map_anno(fun(_A) -> A0 end, ExpR), RA = {{Name,ExpRp},Line,ExpR,length(Fs)+1}, St2 = St1#exprec{strict_ra = [RA | St1#exprec.strict_ra]}, {{call,Line, @@ -681,10 +662,11 @@ record_update(R, Name, Fs, Us0, St0) -> record_match(R, Name, Lr, Fs, Us, St0) -> {Ps,News,St1} = record_upd_fs(Fs, Us, St0), - NLr = neg_line(Lr), + NLr = no_compiler_warning(Lr), + RLine = mark_record(Lr, St1), {{'case',Lr,R, - [{clause,Lr,[{tuple,Lr,[{atom,Lr,Name} | Ps]}],[], - [{tuple,Lr,[{atom,Lr,Name} | News]}]}, + [{clause,Lr,[{tuple,RLine,[{atom,Lr,Name} | Ps]}],[], + [{tuple,RLine,[{atom,Lr,Name} | News]}]}, {clause,NLr,[{var,NLr,'_'}],[], [call_error(NLr, {tuple,NLr,[{atom,NLr,badrecord},{atom,NLr,Name}]})]} ]}, @@ -712,7 +694,11 @@ record_setel(R, Name, Fs, Us0) -> Us = [T || {_,T} <- Us2], Lr = element(2, hd(Us)), Wildcards = duplicate(length(Fs), {var,Lr,'_'}), - NLr = neg_line(Lr), + NLr = no_compiler_warning(Lr), + %% Note: calling mark_record() here is not necessary since it is + %% targeted at Dialyzer which always calls the compiler with + %% 'strict_record_updates' meaning that record_setel() will never + %% be called. {'case',Lr,R, [{clause,Lr,[{tuple,Lr,[{atom,Lr,Name} | Wildcards]}],[], [foldr(fun ({I,Lf,Val}, Acc) -> @@ -807,10 +793,7 @@ add_imports(Mod, [F | Fs], Is) -> add_imports(_, [], Is) -> Is. imported(F, A, St) -> - case orddict:find({F,A}, St#exprec.imports) of - {ok,Mod} -> {yes,Mod}; - error -> no - end. + orddict:is_key({F,A}, St#exprec.imports). %%% %%% Replace is_record/3 in guards with matching if possible. @@ -821,7 +804,7 @@ optimize_is_record(H0, G0, #exprec{compile=Opts}) -> [] -> {H0,G0}; Rs0 -> - case lists:member(no_is_record_optimization, Opts) of + case lists:member(dialyzer, Opts) of % no_is_record_optimization true -> {H0,G0}; false -> @@ -944,5 +927,11 @@ opt_remove_2({call,Line,{atom,_,is_record}, end; opt_remove_2(A, _) -> A. -neg_line(L) -> - erl_parse:set_line(L, fun(Line) -> -abs(Line) end). +no_compiler_warning(Anno) -> + erl_anno:set_generated(true, Anno). + +mark_record(Anno, St) -> + case lists:member(dialyzer, St#exprec.compile) of + true -> erl_anno:set_record(true, Anno); + false -> Anno + end. diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index 3063881890..c08328b4b7 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2012. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -51,6 +52,8 @@ type_test/2,new_type_test/2,old_type_test/2,old_bif/2]). -export([arith_op/2,bool_op/2,comp_op/2,list_op/2,send_op/2,op_type/2]). +-export([is_type/2]). + %%--------------------------------------------------------------------------- %% Erlang builtin functions allowed in guards. @@ -70,6 +73,7 @@ guard_bif(bit_size, 1) -> true; guard_bif(byte_size, 1) -> true; guard_bif(element, 2) -> true; guard_bif(self, 0) -> true; +guard_bif(map_size, 1) -> true; guard_bif(node, 0) -> true; guard_bif(node, 1) -> true; guard_bif(tuple_size, 1) -> true; @@ -82,6 +86,7 @@ guard_bif(is_function, 1) -> true; guard_bif(is_function, 2) -> true; guard_bif(is_integer, 1) -> true; guard_bif(is_list, 1) -> true; +guard_bif(is_map, 1) -> true; guard_bif(is_number, 1) -> true; guard_bif(is_pid, 1) -> true; guard_bif(is_port, 1) -> true; @@ -113,6 +118,7 @@ new_type_test(is_function, 1) -> true; new_type_test(is_function, 2) -> true; new_type_test(is_integer, 1) -> true; new_type_test(is_list, 1) -> true; +new_type_test(is_map, 1) -> true; new_type_test(is_number, 1) -> true; new_type_test(is_pid, 1) -> true; new_type_test(is_port, 1) -> true; @@ -254,6 +260,9 @@ bif(binary_part, 2) -> true; bif(binary_part, 3) -> true; bif(binary_to_atom, 2) -> true; bif(binary_to_existing_atom, 2) -> true; +bif(binary_to_integer, 1) -> true; +bif(binary_to_integer, 2) -> true; +bif(binary_to_float, 1) -> true; bif(binary_to_list, 1) -> true; bif(binary_to_list, 3) -> true; bif(binary_to_term, 1) -> true; @@ -264,6 +273,7 @@ bif(bitstring_to_list, 1) -> true; bif(byte_size, 1) -> true; bif(check_old_code, 1) -> true; bif(check_process_code, 2) -> true; +bif(check_process_code, 3) -> true; bif(date, 0) -> true; bif(delete_module, 1) -> true; bif(demonitor, 1) -> true; @@ -278,10 +288,15 @@ bif(exit, 1) -> true; bif(exit, 2) -> true; bif(float, 1) -> true; bif(float_to_list, 1) -> true; +bif(float_to_list, 2) -> true; +bif(float_to_binary, 1) -> true; +bif(float_to_binary, 2) -> true; bif(garbage_collect, 0) -> true; bif(garbage_collect, 1) -> true; +bif(garbage_collect, 2) -> true; bif(get, 0) -> true; bif(get, 1) -> true; +bif(get_keys, 0) -> true; bif(get_keys, 1) -> true; bif(group_leader, 0) -> true; bif(group_leader, 2) -> true; @@ -289,6 +304,8 @@ bif(halt, 0) -> true; bif(halt, 1) -> true; bif(halt, 2) -> true; bif(hd, 1) -> true; +bif(integer_to_binary, 1) -> true; +bif(integer_to_binary, 2) -> true; bif(integer_to_list, 1) -> true; bif(integer_to_list, 2) -> true; bif(iolist_size, 1) -> true; @@ -305,6 +322,7 @@ bif(is_function, 1) -> true; bif(is_function, 2) -> true; bif(is_integer, 1) -> true; bif(is_list, 1) -> true; +bif(is_map, 1) -> true; bif(is_number, 1) -> true; bif(is_pid, 1) -> true; bif(is_port, 1) -> true; @@ -325,6 +343,7 @@ bif(list_to_pid, 1) -> true; bif(list_to_tuple, 1) -> true; bif(load_module, 2) -> true; bif(make_ref, 0) -> true; +bif(map_size,1) -> true; bif(max,2) -> true; bif(min,2) -> true; bif(module_loaded, 1) -> true; @@ -515,3 +534,53 @@ old_bif(unlink, 1) -> true; old_bif(unregister, 1) -> true; old_bif(whereis, 1) -> true; old_bif(Name, A) when is_atom(Name), is_integer(A) -> false. + +-spec is_type(Name, NumberOfTypeVariables) -> boolean() when + Name :: atom(), + NumberOfTypeVariables :: non_neg_integer(). +%% Returns true if Name/NumberOfTypeVariables is a predefined type. + +is_type(any, 0) -> true; +is_type(arity, 0) -> true; +is_type(atom, 0) -> true; +is_type(binary, 0) -> true; +is_type(bitstring, 0) -> true; +is_type(bool, 0) -> true; +is_type(boolean, 0) -> true; +is_type(byte, 0) -> true; +is_type(char, 0) -> true; +is_type(float, 0) -> true; +is_type(function, 0) -> true; +is_type(identifier, 0) -> true; +is_type(integer, 0) -> true; +is_type(iodata, 0) -> true; +is_type(iolist, 0) -> true; +is_type(list, 0) -> true; +is_type(list, 1) -> true; +is_type(map, 0) -> true; +is_type(maybe_improper_list, 0) -> true; +is_type(maybe_improper_list, 2) -> true; +is_type(mfa, 0) -> true; +is_type(module, 0) -> true; +is_type(neg_integer, 0) -> true; +is_type(nil, 0) -> true; +is_type(no_return, 0) -> true; +is_type(node, 0) -> true; +is_type(non_neg_integer, 0) -> true; +is_type(none, 0) -> true; +is_type(nonempty_improper_list, 2) -> true; +is_type(nonempty_list, 0) -> true; +is_type(nonempty_list, 1) -> true; +is_type(nonempty_maybe_improper_list, 0) -> true; +is_type(nonempty_maybe_improper_list, 2) -> true; +is_type(nonempty_string, 0) -> true; +is_type(number, 0) -> true; +is_type(pid, 0) -> true; +is_type(port, 0) -> true; +is_type(pos_integer, 0) -> true; +is_type(reference, 0) -> true; +is_type(string, 0) -> true; +is_type(term, 0) -> true; +is_type(timeout, 0) -> true; +is_type(tuple, 0) -> true; +is_type(_, _) -> false. diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 648ff349a4..e9332ce069 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -30,8 +31,6 @@ -export([is_guard_expr/1]). -export([bool_option/4,value_option/3,value_option/7]). --export([modify_line/2]). - -import(lists, [member/2,map/2,foldl/3,foldr/3,mapfoldl/3,all/2,reverse/1]). %% bool_option(OnOpt, OffOpt, Default, Options) -> boolean(). @@ -76,61 +75,72 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> %%-define(DEBUGF(X,Y), io:format(X, Y)). -define(DEBUGF(X,Y), void). --type line() :: erl_scan:line(). % a convenient alias +-type line() :: erl_anno:anno(). % a convenient alias -type fa() :: {atom(), arity()}. % function+arity -type ta() :: {atom(), arity()}. % type+arity +-record(typeinfo, {attr, line}). + %% Usage of records, functions, and imports. The variable table, which %% is passed on as an argument, holds the usage of variables. -record(usage, { calls = dict:new(), %Who calls who imported = [], %Actually imported functions - used_records=sets:new() :: set(), %Used record definitions - used_types = dict:new() :: dict() %Used type definitions + used_records = sets:new() %Used record definitions + :: sets:set(atom()), + used_types = dict:new() %Used type definitions + :: dict:dict(ta(), line()) }). %% Define the lint state record. %% 'called' and 'exports' contain {Line, {Function, Arity}}, %% the other function collections contain {Function, Arity}. -record(lint, {state=start :: 'start' | 'attribute' | 'function', - module=[], %Module - package="", %Module package - extends=[], %Extends + module='', %Module behaviour=[], %Behaviour - exports=gb_sets:empty() :: gb_set(), %Exports - imports=[], %Imports - mod_imports=dict:new() :: dict(), %Module Imports + exports=gb_sets:empty() :: gb_sets:set(fa()),%Exports + imports=[] :: orddict:orddict(fa(), module()),%Imports compile=[], %Compile flags - records=dict:new() :: dict(), %Record definitions - locals=gb_sets:empty() :: gb_set(), %All defined functions (prescanned) - no_auto=gb_sets:empty() :: gb_set(), %Functions explicitly not autoimported - defined=gb_sets:empty() :: gb_set(), %Defined fuctions + records=dict:new() %Record definitions + :: dict:dict(atom(), {line(),Fields :: term()}), + locals=gb_sets:empty() %All defined functions (prescanned) + :: gb_sets:set(fa()), + no_auto=gb_sets:empty() %Functions explicitly not autoimported + :: gb_sets:set(fa()) | 'all', + defined=gb_sets:empty() %Defined fuctions + :: gb_sets:set(fa()), on_load=[] :: [fa()], %On-load function - on_load_line=0 :: line(), %Line for on_load + on_load_line=erl_anno:new(0) %Line for on_load + :: erl_anno:anno(), clashes=[], %Exported functions named as BIFs not_deprecated=[], %Not considered deprecated func=[], %Current function warn_format=0, %Warn format calls enabled_warnings=[], %All enabled warnings (ordset). + nowarn_bif_clash=[], %All no warn bif clashes (ordset). errors=[], %Current errors warnings=[], %Current warnings - global_vt=[], %The global VarTable file = "" :: string(), %From last file attribute recdef_top=false :: boolean(), %true in record initialisation %outside any fun or lc xqlc= false :: boolean(), %true if qlc.hrl included - new = false :: boolean(), %Has user-defined 'new/N' - called= [] :: [{fa(),line()}], %Called functions + called= [] :: [{fa(),line()}], %Called functions usage = #usage{} :: #usage{}, - specs = dict:new() :: dict(), %Type specifications - callbacks = dict:new() :: dict(), %Callback types - types = dict:new() :: dict(), %Type definitions - exp_types=gb_sets:empty():: gb_set() %Exported types + specs = dict:new() %Type specifications + :: dict:dict(mfa(), line()), + callbacks = dict:new() %Callback types + :: dict:dict(mfa(), line()), + optional_callbacks = dict:new() %Optional callbacks + :: dict:dict(mfa(), line()), + types = dict:new() %Type definitions + :: dict:dict(ta(), #typeinfo{}), + exp_types=gb_sets:empty() %Exported types + :: gb_sets:set(ta()) }). -type lint_state() :: #lint{}. -type error_description() :: term(). --type error_info() :: {erl_scan:line(), module(), error_description()}. +-type error_info() :: {erl_anno:line(), module(), error_description()}. %% format_error(Error) %% Return a string describing the error. @@ -140,14 +150,10 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> format_error(undefined_module) -> "no module definition"; -format_error({bad_module_name, M}) -> - io_lib:format("bad module name '~s'", [M]); format_error(redefine_module) -> "redefining module"; -format_error(redefine_extends) -> - "redefining extends attribute"; -format_error(extends_self) -> - "cannot extend from self"; +format_error(pmod_unsupported) -> + "parameterized modules are no longer supported"; %% format_error({redefine_mod_import, M, P}) -> %% io_lib:format("module '~s' already imported from package '~s'", [M, P]); @@ -160,18 +166,12 @@ format_error({attribute,A}) -> io_lib:format("attribute '~w' after function definitions", [A]); format_error({missing_qlc_hrl,A}) -> io_lib:format("qlc:q/~w called, but \"qlc.hrl\" not included", [A]); -format_error({redefine_import,{bif,{F,A},M}}) -> - io_lib:format("function ~w/~w already auto-imported from ~w", [F,A,M]); format_error({redefine_import,{{F,A},M}}) -> io_lib:format("function ~w/~w already imported from ~w", [F,A,M]); format_error({bad_inline,{F,A}}) -> io_lib:format("inlined function ~w/~w undefined", [F,A]); format_error({invalid_deprecated,D}) -> io_lib:format("badly formed deprecated attribute ~w", [D]); -format_error(invalid_extends) -> - "badly formed extends attribute"; -format_error(define_instance) -> - "defining instance function not allowed in abstract module"; format_error({bad_deprecated,{F,A}}) -> io_lib:format("deprecated function ~w/~w undefined or not exported", [F,A]); format_error({bad_nowarn_unused_function,{F,A}}) -> @@ -227,20 +227,24 @@ format_error({deprecated, MFA, ReplacementMFA, Rel}) -> [format_mfa(MFA), Rel, format_mfa(ReplacementMFA)]); format_error({deprecated, {M1, F1, A1}, String}) when is_list(String) -> io_lib:format("~p:~p/~p: ~s", [M1, F1, A1, String]); +format_error({deprecated_type, {M1, F1, A1}, String}) when is_list(String) -> + io_lib:format("~p:~p~s: ~s", [M1, F1, gen_type_paren(A1), String]); format_error({removed, MFA, ReplacementMFA, Rel}) -> io_lib:format("call to ~s will fail, since it was removed in ~s; " "use ~s", [format_mfa(MFA), Rel, format_mfa(ReplacementMFA)]); format_error({removed, MFA, String}) when is_list(String) -> io_lib:format("~s: ~s", [format_mfa(MFA), String]); +format_error({removed_type, MNA, ReplacementMNA, Rel}) -> + io_lib:format("the type ~s was removed in ~s; use ~s instead", + [format_mna(MNA), Rel, format_mna(ReplacementMNA)]); format_error({obsolete_guard, {F, A}}) -> io_lib:format("~p/~p obsolete", [F, A]); -format_error({reserved_for_future,K}) -> - io_lib:format("atom ~w: future reserved keyword - rename or quote", [K]); format_error({too_many_arguments,Arity}) -> io_lib:format("too many arguments (~w) - " "maximum allowed is ~w", [Arity,?MAX_ARGUMENTS]); %% --- patterns and guards --- format_error(illegal_pattern) -> "illegal pattern"; +format_error(illegal_map_key) -> "illegal map key in pattern"; format_error(illegal_bin_pattern) -> "binary patterns cannot be matched in parallel using '='"; format_error(illegal_expr) -> "illegal expression"; @@ -248,13 +252,9 @@ format_error({illegal_guard_local_call, {F,A}}) -> io_lib:format("call to local/imported function ~w/~w is illegal in guard", [F,A]); format_error(illegal_guard_expr) -> "illegal guard expression"; -format_error(deprecated_tuple_fun) -> - "tuple funs are deprecated and will be removed in R16"; -%% --- exports --- -format_error({explicit_export,F,A}) -> - io_lib:format("in this release, the call to ~w/~w must be written " - "like this: erlang:~w/~w", - [F,A,F,A]); +%% --- maps --- +format_error(illegal_map_construction) -> + "only association operators '=>' are allowed in map construction"; %% --- records --- format_error({undefined_record,T}) -> io_lib:format("record ~w undefined", [T]); @@ -292,8 +292,9 @@ format_error({variable_in_record_def,V}) -> %% --- binaries --- format_error({undefined_bittype,Type}) -> io_lib:format("bit type ~w undefined", [Type]); -format_error({bittype_mismatch,T1,T2,What}) -> - io_lib:format("bit type mismatch (~s) between ~p and ~p", [What,T1,T2]); +format_error({bittype_mismatch,Val1,Val2,What}) -> + io_lib:format("conflict in ~s specification for bit field: '~p' and '~p'", + [What,Val1,Val2]); format_error(bittype_unit) -> "a bit unit size must not be specified unless a size is specified too"; format_error(illegal_bitsize) -> @@ -306,6 +307,8 @@ format_error(utf_bittype_size_or_unit) -> "neither size nor unit must be given for segments of type utf8/utf16/utf32"; format_error({bad_bitsize,Type}) -> io_lib:format("bad ~s bit size", [Type]); +format_error(unsized_binary_in_bin_gen_pattern) -> + "binary fields without size are not allowed in patterns of bit string generators"; %% --- behaviours --- format_error({conflicting_behaviours,{Name,Arity},B,FirstL,FirstB}) -> io_lib:format("conflicting behaviours - callback ~w/~w required by both '~p' " @@ -317,13 +320,20 @@ format_error({undefined_behaviour,Behaviour}) -> io_lib:format("behaviour ~w undefined", [Behaviour]); format_error({undefined_behaviour_callbacks,Behaviour}) -> io_lib:format("behaviour ~w callback functions are undefined", - [Behaviour]); + [Behaviour]); format_error({ill_defined_behaviour_callbacks,Behaviour}) -> io_lib:format("behaviour ~w callback functions erroneously defined", [Behaviour]); +format_error({ill_defined_optional_callbacks,Behaviour}) -> + io_lib:format("behaviour ~w optional callback functions erroneously defined", + [Behaviour]); format_error({behaviour_info, {_M,F,A}}) -> io_lib:format("cannot define callback attibute for ~w/~w when " "behaviour_info is defined",[F,A]); +format_error({redefine_optional_callback, {F, A}}) -> + io_lib:format("optional callback ~w/~w duplicated", [F, A]); +format_error({undefined_callback, {_M, F, A}}) -> + io_lib:format("callback ~w/~w is undefined", [F, A]); %% --- types and specs --- format_error({singleton_typevar, Name}) -> io_lib:format("type variable ~w is only used once (is unbound)", [Name]); @@ -350,26 +360,47 @@ format_error({redefine_type, {TypeName, Arity}}) -> [TypeName, gen_type_paren(Arity)]); format_error({type_syntax, Constr}) -> io_lib:format("bad ~w type", [Constr]); +format_error(old_abstract_code) -> + io_lib:format("abstract code generated before Erlang/OTP 19.0 and " + "having typed record fields cannot be compiled", []); format_error({redefine_spec, {M, F, A}}) -> io_lib:format("spec for ~w:~w/~w already defined", [M, F, A]); -format_error({redefine_callback, {M, F, A}}) -> - io_lib:format("callback ~w:~w/~w already defined", [M, F, A]); -format_error({spec_fun_undefined, {M, F, A}}) -> - io_lib:format("spec for undefined function ~w:~w/~w", [M, F, A]); +format_error({redefine_spec, {F, A}}) -> + io_lib:format("spec for ~w/~w already defined", [F, A]); +format_error({redefine_callback, {F, A}}) -> + io_lib:format("callback ~w/~w already defined", [F, A]); +format_error({bad_callback, {M, F, A}}) -> + io_lib:format("explicit module not allowed for callback ~w:~w/~w ", [M, F, A]); +format_error({spec_fun_undefined, {F, A}}) -> + io_lib:format("spec for undefined function ~w/~w", [F, A]); format_error({missing_spec, {F,A}}) -> io_lib:format("missing specification for function ~w/~w", [F, A]); format_error(spec_wrong_arity) -> - "spec has the wrong arity"; + "spec has wrong arity"; format_error(callback_wrong_arity) -> - "callback has the wrong arity"; -format_error({imported_predefined_type, Name}) -> - io_lib:format("referring to built-in type ~w as a remote type; " - "please take out the module name", [Name]); + "callback has wrong arity"; +format_error({deprecated_builtin_type, {Name, Arity}, + Replacement, Rel}) -> + UseS = case Replacement of + {Mod, NewName} -> + io_lib:format("use ~w:~w/~w", [Mod, NewName, Arity]); + {Mod, NewName, NewArity} -> + io_lib:format("use ~w:~w/~w or preferably ~w:~w/~w", + [Mod, NewName, Arity, + Mod, NewName, NewArity]) + end, + io_lib:format("type ~w/~w is deprecated and will be " + "removed in ~s; use ~s", + [Name, Arity, Rel, UseS]); +format_error({not_exported_opaque, {TypeName, Arity}}) -> + io_lib:format("opaque type ~w~s is not exported", + [TypeName, gen_type_paren(Arity)]); +format_error({underspecified_opaque, {TypeName, Arity}}) -> + io_lib:format("opaque type ~w~s is underspecified and therefore meaningless", + [TypeName, gen_type_paren(Arity)]); %% --- obsolete? unused? --- format_error({format_error, {Fmt, Args}}) -> - io_lib:format(Fmt, Args); -format_error({mnemosyne, What}) -> - "mnemosyne " ++ What ++ ", missing transformation". + io_lib:format(Fmt, Args). gen_type_paren(Arity) when is_integer(Arity), Arity >= 0 -> gen_type_paren_1(Arity, ")"). @@ -387,6 +418,9 @@ format_mfa({M, F, A}) when is_integer(A) -> format_mf(M, F, ArityString) when is_atom(M), is_atom(F) -> atom_to_list(M) ++ ":" ++ atom_to_list(F) ++ "/" ++ ArityString. +format_mna({M, N, A}) when is_integer(A) -> + atom_to_list(M) ++ ":" ++ atom_to_list(N) ++ gen_type_paren(A). + format_where(L) when is_integer(L) -> io_lib:format("(line ~p)", [L]); format_where({L,C}) when is_integer(L), is_integer(C) -> @@ -405,13 +439,13 @@ exprs(Exprs, BindingsList) -> exprs_opt(Exprs, BindingsList, Opts) -> {St0,Vs} = foldl(fun({{record,_SequenceNumber,_Name},Attr0}, {St1,Vs1}) -> - Attr = zip_file_and_line(Attr0, "none"), + Attr = set_file(Attr0, "none"), {attribute_state(Attr, St1),Vs1}; ({V,_}, {St1,Vs1}) -> {St1,[{V,{bound,unused,[]}} | Vs1]} end, {start("nofile",Opts),[]}, BindingsList), Vt = orddict:from_list(Vs), - {_Evt,St} = exprs(zip_file_and_line(Exprs, "nofile"), Vt, St0), + {_Evt,St} = exprs(set_file(Exprs, "nofile"), Vt, St0), return_status(St). used_vars(Exprs, BindingsList) -> @@ -419,7 +453,7 @@ used_vars(Exprs, BindingsList) -> ({V,_Val}, Vs0) -> [{V,{bound,unused,[]}} | Vs0] end, [], BindingsList), Vt = orddict:from_list(Vs), - {Evt,_St} = exprs(zip_file_and_line(Exprs, "nofile"), Vt, start()), + {Evt,_St} = exprs(set_file(Exprs, "nofile"), Vt, start()), {ok, foldl(fun({V,{_,used,_}}, L) -> [V | L]; (_, L) -> L end, [], Evt)}. @@ -433,7 +467,7 @@ used_vars(Exprs, BindingsList) -> %% really all ordsets! -spec(module(AbsForms) -> {ok, Warnings} | {error, Errors, Warnings} when - AbsForms :: [erl_parse:abstract_form()], + AbsForms :: [erl_parse:abstract_form() | erl_parse:form_info()], Warnings :: [{file:filename(),[ErrorInfo]}], Errors :: [{FileName2 :: file:filename(),[ErrorInfo]}], ErrorInfo :: error_info()). @@ -445,7 +479,7 @@ module(Forms) -> -spec(module(AbsForms, FileName) -> {ok, Warnings} | {error, Errors, Warnings} when - AbsForms :: [erl_parse:abstract_form()], + AbsForms :: [erl_parse:abstract_form() | erl_parse:form_info()], FileName :: atom() | string(), Warnings :: [{file:filename(),[ErrorInfo]}], Errors :: [{FileName2 :: file:filename(),[ErrorInfo]}], @@ -458,7 +492,7 @@ module(Forms, FileName) -> -spec(module(AbsForms, FileName, CompileOptions) -> {ok, Warnings} | {error, Errors, Warnings} when - AbsForms :: [erl_parse:abstract_form()], + AbsForms :: [erl_parse:abstract_form() | erl_parse:form_info()], FileName :: atom() | string(), CompileOptions :: [compile:option()], Warnings :: [{file:filename(),[ErrorInfo]}], @@ -510,6 +544,9 @@ start(File, Opts) -> {deprecated_function, bool_option(warn_deprecated_function, nowarn_deprecated_function, true, Opts)}, + {deprecated_type, + bool_option(warn_deprecated_type, nowarn_deprecated_type, + true, Opts)}, {obsolete_guard, bool_option(warn_obsolete_guard, nowarn_obsolete_guard, true, Opts)}, @@ -533,7 +570,6 @@ start(File, Opts) -> end, #lint{state = start, exports = gb_sets:from_list([{module_info,0},{module_info,1}]), - mod_imports = dict:from_list([{erlang,erlang}]), compile = Opts, %% Internal pseudo-functions must appear as defined/reached. defined = gb_sets:from_list(pseudolocals()), @@ -542,8 +578,8 @@ start(File, Opts) -> warn_format = value_option(warn_format, 1, warn_format, 1, nowarn_format, 0, Opts), enabled_warnings = Enabled, - file = File, - types = default_types() + nowarn_bif_clash = nowarn_function(nowarn_bif_clash, Opts), + file = File }. %% is_warn_enabled(Category, St) -> boolean(). @@ -582,34 +618,39 @@ pack_warnings(Ws) -> %% add_warning(ErrorDescriptor, State) -> State' %% add_warning(Line, Error, State) -> State' -add_error(E, St) -> St#lint{errors=[{St#lint.file,E}|St#lint.errors]}. +add_error(E, St) -> add_lint_error(E, St#lint.file, St). + +add_error(Anno, E, St) -> + {File,Location} = loc(Anno, St), + add_lint_error({Location,erl_lint,E}, File, St). -add_error(FileLine, E, St) -> - {File,Location} = loc(FileLine), - add_error({Location,erl_lint,E}, St#lint{file = File}). +add_lint_error(E, File, St) -> + St#lint{errors=[{File,E}|St#lint.errors]}. -add_warning(W, St) -> St#lint{warnings=[{St#lint.file,W}|St#lint.warnings]}. +add_warning(W, St) -> add_lint_warning(W, St#lint.file, St). add_warning(FileLine, W, St) -> - {File,Location} = loc(FileLine), - add_warning({Location,erl_lint,W}, St#lint{file = File}). - -loc(L) -> - case erl_parse:get_attribute(L, location) of - {location,{{File,Line},Column}} -> - {File,{Line,Column}}; - {location,{File,Line}} -> - {File,Line} + {File,Location} = loc(FileLine, St), + add_lint_warning({Location,erl_lint,W}, File, St). + +add_lint_warning(W, File, St) -> + St#lint{warnings=[{File,W}|St#lint.warnings]}. + +loc(Anno, St) -> + Location = erl_anno:location(Anno), + case erl_anno:file(Anno) of + undefined -> {St#lint.file,Location}; + File -> {File,Location} end. %% forms([Form], State) -> State' forms(Forms0, St0) -> Forms = eval_file_attribute(Forms0, St0), + %% Annotations from now on include the 'file' item. Locals = local_functions(Forms), AutoImportSuppressed = auto_import_suppressed(St0#lint.compile), StDeprecated = disallowed_compile_flags(Forms,St0), - %% Line numbers are from now on pairs {File,Line}. St1 = includes_qlc_hrl(Forms, StDeprecated#lint{locals = Locals, no_auto = AutoImportSuppressed}), St2 = bif_clashes(Forms, St1), @@ -617,10 +658,6 @@ forms(Forms0, St0) -> St4 = foldl(fun form/2, pre_scan(Forms, St3), Forms), post_traversal_check(Forms, St4). -pre_scan([{function,_L,new,_A,_Cs} | Fs], St) -> - pre_scan(Fs, St#lint{new=true}); -pre_scan([{attribute,_L,extends,M} | Fs], St) when is_atom(M) -> - pre_scan(Fs, St#lint{extends=true}); pre_scan([{attribute,L,compile,C} | Fs], St) -> case is_warn_enabled(export_all, St) andalso member(export_all, lists:flatten([C])) of @@ -647,15 +684,29 @@ eval_file_attribute(Forms, St) -> eval_file_attr([{attribute,_L,file,{File,_Line}}=Form | Forms], _File) -> [Form | eval_file_attr(Forms, File)]; eval_file_attr([Form0 | Forms], File) -> - Form = zip_file_and_line(Form0, File), + Form = set_form_file(Form0, File), [Form | eval_file_attr(Forms, File)]; eval_file_attr([], _File) -> []. -zip_file_and_line(T, File) -> - F0 = fun(Line) -> {File,Line} end, - F = fun(L) -> erl_parse:set_line(L, F0) end, - modify_line(T, F). +%% Sets the file only on the form. This is used on post-traversal. +%% For the remaining of the AST we rely on #lint.file. + +set_form_file({attribute,L,K,V}, File) -> + {attribute,erl_anno:set_file(File, L),K,V}; +set_form_file({function,L,N,A,C}, File) -> + {function,erl_anno:set_file(File, L),N,A,C}; +set_form_file(Form, _File) -> + Form. + +set_file(Ts, File) when is_list(Ts) -> + [anno_set_file(T, File) || T <- Ts]; +set_file(T, File) -> + anno_set_file(T, File). + +anno_set_file(T, File) -> + F = fun(Anno) -> erl_anno:set_file(File, Anno) end, + erl_parse:map_anno(F, T). %% form(Form, State) -> State' %% Check a form returning the updated State. Handle generic cases here. @@ -675,68 +726,23 @@ form(Form, #lint{state=State}=St) -> %% start_state(Form, State) -> State' -start_state({attribute,L,module,{M,Ps}}, St) -> - St1 = set_module(M, L, St), - Arity = length(Ps), - Ps1 = if is_atom(St1#lint.extends) -> - ['BASE', 'THIS' | Ps]; - true -> - ['THIS' | Ps] - end, - Vt = orddict:from_list([{V, {bound, used, []}} || V <- Ps1]), - St2 = add_instance(Arity, St1), - St3 = ensure_new(Arity, St2), - St3#lint{state=attribute, extends=[], global_vt=Vt}; -start_state({attribute,L,module,M}, St) -> - St1 = set_module(M, L, St), - St1#lint{state=attribute, extends=[]}; +start_state({attribute,Line,module,{_,_}}=Form, St0) -> + St1 = add_error(Line, pmod_unsupported, St0), + attribute_state(Form, St1#lint{state=attribute}); +start_state({attribute,_,module,M}, St0) -> + St1 = St0#lint{module=M}, + St1#lint{state=attribute}; start_state(Form, St) -> St1 = add_error(element(2, Form), undefined_module, St), - attribute_state(Form, St1#lint{state=attribute, extends=[]}). - -set_module(M, L, St) -> - M1 = package_to_string(M), - case packages:is_valid(M1) of - true -> - St#lint{module=list_to_atom(M1), - package=packages:strip_last(M1)}; - false -> - add_error(L, {bad_module_name, M1}, St) - end. - -ensure_new(Arity, St) -> - case St#lint.new of - true -> - St; - false -> - add_func(new, Arity, St) - end. - -add_instance(Arity, St) -> - A = Arity + (if is_atom(St#lint.extends) -> 1; true -> 0 end), - add_func(instance, A, St). - -add_func(Name, Arity, St) -> - F = {Name, Arity}, - St#lint{exports = gb_sets:add_element(F, St#lint.exports), - defined = gb_sets:add_element(F, St#lint.defined)}. + attribute_state(Form, St1#lint{state=attribute}). %% attribute_state(Form, State) -> %% State' -attribute_state({attribute,_L,module,_M}, #lint{module=[]}=St) -> +attribute_state({attribute,_L,module,_M}, #lint{module=''}=St) -> St; attribute_state({attribute,L,module,_M}, St) -> add_error(L, redefine_module, St); -attribute_state({attribute,L,extends,M}, #lint{module=M}=St) when is_atom(M) -> - add_error(L, extends_self, St); -attribute_state({attribute,_L,extends,M}, #lint{extends=[]}=St) - when is_atom(M) -> - St#lint{extends=M}; -attribute_state({attribute,L,extends,M}, St) when is_atom(M) -> - add_error(L, redefine_extends, St); -attribute_state({attribute,L,extends,_M}, St) -> - add_error(L, invalid_extends, St); attribute_state({attribute,L,export,Es}, St) -> export(L, Es, St); attribute_state({attribute,L,export_type,Es}, St) -> @@ -757,6 +763,8 @@ attribute_state({attribute,L,spec,{Fun,Types}}, St) -> spec_decl(L, Fun, Types, St); attribute_state({attribute,L,callback,{Fun,Types}}, St) -> callback_decl(L, Fun, Types, St); +attribute_state({attribute,L,optional_callbacks,Es}, St) -> + optional_callbacks(L, Es, St); attribute_state({attribute,L,on_load,Val}, St) -> on_load(L, Val, St); attribute_state({attribute,_L,_Other,_Val}, St) -> % Ignore others @@ -768,6 +776,8 @@ attribute_state(Form, St) -> %% State' %% Allow for record, type and opaque type definitions and spec %% declarations to be intersperced within function definitions. +%% Dialyzer attributes are also allowed everywhere, but are not +%% checked at all. function_state({attribute,L,record,{Name,Fields}}, St) -> record_def(L, Name, Fields, St); @@ -777,12 +787,12 @@ function_state({attribute,L,opaque,{TypeName,TypeDef,Args}}, St) -> type_def(opaque, L, TypeName, TypeDef, Args, St); function_state({attribute,L,spec,{Fun,Types}}, St) -> spec_decl(L, Fun, Types, St); +function_state({attribute,_L,dialyzer,_Val}, St) -> + St; function_state({attribute,La,Attr,_Val}, St) -> add_error(La, {attribute,Attr}, St); function_state({function,L,N,A,Cs}, St) -> function(L, N, A, Cs, St); -function_state({rule,L,_N,_A,_Cs}, St) -> - add_error(L, {mnemosyne,"rule"}, St); function_state({eof,L}, St) -> eof(L, St). %% eof(LastLine, State) -> @@ -793,8 +803,7 @@ eof(_Line, St0) -> %% bif_clashes(Forms, State0) -> State. -bif_clashes(Forms, St) -> - Nowarn = nowarn_function(nowarn_bif_clash, St#lint.compile), +bif_clashes(Forms, #lint{nowarn_bif_clash=Nowarn} = St) -> Clashes0 = [{Name,Arity} || {function,_L,Name,Arity,_Cs} <- Forms, erl_internal:bif(Name, Arity)], Clashes = ordsets:subtract(ordsets:from_list(Clashes0), Nowarn), @@ -818,9 +827,11 @@ not_deprecated(Forms, St0) -> disallowed_compile_flags(Forms, St0) -> %% There are (still) no line numbers in St0#lint.compile. Errors0 = [ {St0#lint.file,{L,erl_lint,disallowed_nowarn_bif_clash}} || - {attribute,[{line,{_,L}}],compile,nowarn_bif_clash} <- Forms ], + {attribute,A,compile,nowarn_bif_clash} <- Forms, + {_,L} <- [loc(A, St0)] ], Errors1 = [ {St0#lint.file,{L,erl_lint,disallowed_nowarn_bif_clash}} || - {attribute,[{line,{_,L}}],compile,{nowarn_bif_clash, {_,_}}} <- Forms ], + {attribute,A,compile,{nowarn_bif_clash, {_,_}}} <- Forms, + {_,L} <- [loc(A, St0)] ], Disabled = (not is_warn_enabled(bif_clash, St0)), Errors = if Disabled andalso Errors0 =:= [] -> @@ -851,7 +862,8 @@ post_traversal_check(Forms, St0) -> StC = check_untyped_records(Forms, StB), StD = check_on_load(StC), StE = check_unused_records(Forms, StD), - check_callback_information(StE). + StF = check_local_opaque_types(StE), + check_callback_information(StF). %% check_behaviour(State0) -> State %% Check that the behaviour attribute is valid. @@ -863,56 +875,73 @@ check_behaviour(St0) -> %% Check behaviours for existence and defined functions. behaviour_check(Bs, St0) -> - {AllBfs,St1} = all_behaviour_callbacks(Bs, [], St0), - St = behaviour_missing_callbacks(AllBfs, St1), + {AllBfs0, St1} = all_behaviour_callbacks(Bs, [], St0), + St = behaviour_missing_callbacks(AllBfs0, St1), + Exports = exports(St0), + F = fun(Bfs, OBfs) -> + [B || B <- Bfs, + not lists:member(B, OBfs) + orelse gb_sets:is_member(B, Exports)] + end, + %% After fixing missing callbacks new warnings may be emitted. + AllBfs = [{Item,F(Bfs0, OBfs0)} || {Item,Bfs0,OBfs0} <- AllBfs0], behaviour_conflicting(AllBfs, St). all_behaviour_callbacks([{Line,B}|Bs], Acc, St0) -> - {Bfs0,St} = behaviour_callbacks(Line, B, St0), - all_behaviour_callbacks(Bs, [{{Line,B},Bfs0}|Acc], St); + {Bfs0,OBfs0,St} = behaviour_callbacks(Line, B, St0), + all_behaviour_callbacks(Bs, [{{Line,B},Bfs0,OBfs0}|Acc], St); all_behaviour_callbacks([], Acc, St) -> {reverse(Acc),St}. behaviour_callbacks(Line, B, St0) -> try B:behaviour_info(callbacks) of - Funcs when is_list(Funcs) -> - All = all(fun({FuncName, Arity}) -> - is_atom(FuncName) andalso is_integer(Arity); - ({FuncName, Arity, Spec}) -> - is_atom(FuncName) andalso is_integer(Arity) - andalso is_list(Spec); - (_Other) -> - false - end, - Funcs), - MaybeRemoveSpec = fun({_F,_A}=FA) -> FA; - ({F,A,_S}) -> {F,A}; - (Other) -> Other - end, - if - All =:= true -> - {[MaybeRemoveSpec(F) || F <- Funcs], St0}; + undefined -> + St1 = add_warning(Line, {undefined_behaviour_callbacks, B}, St0), + {[], [], St1}; + Funcs -> + case is_fa_list(Funcs) of true -> + try B:behaviour_info(optional_callbacks) of + undefined -> + {Funcs, [], St0}; + OptFuncs -> + %% OptFuncs should always be OK thanks to + %% sys_pre_expand. + case is_fa_list(OptFuncs) of + true -> + {Funcs, OptFuncs, St0}; + false -> + W = {ill_defined_optional_callbacks, B}, + St1 = add_warning(Line, W, St0), + {Funcs, [], St1} + end + catch + _:_ -> + {Funcs, [], St0} + end; + false -> St1 = add_warning(Line, - {ill_defined_behaviour_callbacks,B}, + {ill_defined_behaviour_callbacks, B}, St0), - {[], St1} - end; - undefined -> - St1 = add_warning(Line, {undefined_behaviour_callbacks,B}, St0), - {[], St1}; - _Other -> - St1 = add_warning(Line, {ill_defined_behaviour_callbacks,B}, St0), - {[], St1} + {[], [], St1} + end catch _:_ -> - St1 = add_warning(Line, {undefined_behaviour,B}, St0), - {[], St1} + St1 = add_warning(Line, {undefined_behaviour, B}, St0), + {[], [], St1} end. -behaviour_missing_callbacks([{{Line,B},Bfs}|T], #lint{exports=Exp}=St0) -> - Missing = ordsets:subtract(ordsets:from_list(Bfs), gb_sets:to_list(Exp)), +behaviour_missing_callbacks([{{Line,B},Bfs0,OBfs}|T], St0) -> + Bfs = ordsets:subtract(ordsets:from_list(Bfs0), ordsets:from_list(OBfs)), + Exports = gb_sets:to_list(exports(St0)), + Missing = ordsets:subtract(Bfs, Exports), St = foldl(fun (F, S0) -> - add_warning(Line, {undefined_behaviour_func,F,B}, S0) + case is_fa(F) of + true -> + M = {undefined_behaviour_func,F,B}, + add_warning(Line, M, S0); + false -> + S0 % ill_defined_behaviour_callbacks + end end, St0, Missing), behaviour_missing_callbacks(T, St); behaviour_missing_callbacks([], St) -> St. @@ -927,7 +956,7 @@ behaviour_conflicting(AllBfs, St) -> behaviour_add_conflicts(R, St). behaviour_add_conflicts([{Cb,[{FirstLoc,FirstB}|Cs]}|T], St0) -> - FirstL = element(2, loc(FirstLoc)), + FirstL = element(2, loc(FirstLoc, St0)), St = behaviour_add_conflict(Cs, Cb, FirstL, FirstB, St0), behaviour_add_conflicts(T, St); behaviour_add_conflicts([], St) -> St. @@ -1000,9 +1029,9 @@ check_imports(Forms, St0) -> true -> Usage = St0#lint.usage, Unused = ordsets:subtract(St0#lint.imports, Usage#usage.imported), - Imports = [{{FA,list_to_atom(package_to_string(Mod))},L} - || {attribute,L,import,{Mod,Fs}} <- Forms, - FA <- lists:usort(Fs)], + Imports = [{{FA,Mod},L} || + {attribute,L,import,{Mod,Fs}} <- Forms, + FA <- lists:usort(Fs)], Bad = [{FM,L} || FM <- Unused, {FM2,L} <- Imports, FM =:= FM2], func_line_warning(unused_import, Bad, St0) end. @@ -1073,7 +1102,10 @@ check_undefined_functions(#lint{called=Called0,defined=Def0}=St0) -> check_undefined_types(#lint{usage=Usage,types=Def}=St0) -> Used = Usage#usage.used_types, UTAs = dict:fetch_keys(Used), - Undef = [{TA,dict:fetch(TA, Used)} || TA <- UTAs, not dict:is_key(TA, Def)], + Undef = [{TA,dict:fetch(TA, Used)} || + TA <- UTAs, + not dict:is_key(TA, Def), + not is_default_type(TA)], foldl(fun ({TA,L}, St) -> add_error(L, {undefined_type,TA}, St) end, St0, Undef). @@ -1114,7 +1146,7 @@ check_untyped_records(Forms, St0) -> RecNames = dict:fetch_keys(St0#lint.records), %% these are the records with field(s) containing type info TRecNames = [Name || - {attribute,_,type,{{record,Name},Fields,_}} <- Forms, + {attribute,_,record,{Name,Fields}} <- Forms, lists:all(fun ({typed_record_field,_,_}) -> true; (_) -> false end, Fields)], @@ -1124,7 +1156,8 @@ check_untyped_records(Forms, St0) -> [] -> St; % exclude records with no fields [_|_] -> add_warning(L, {untyped_record, N}, St) end - end, St0, RecNames -- TRecNames); + end, St0, ordsets:subtract(ordsets:from_list(RecNames), + ordsets:from_list(TRecNames))); false -> St0 end. @@ -1142,7 +1175,7 @@ check_unused_records(Forms, St0) -> end, St0#lint.records, UsedRecords), Unused = [{Name,FileLine} || {Name,{FileLine,_Fields}} <- dict:to_list(URecs), - element(1, loc(FileLine)) =:= FirstFile], + element(1, loc(FileLine, St0)) =:= FirstFile], foldl(fun ({N,L}, St) -> add_warning(L, {unused_record, N}, St) end, St0, Unused); @@ -1151,19 +1184,29 @@ check_unused_records(Forms, St0) -> end. check_callback_information(#lint{callbacks = Callbacks, - defined = Defined} = State) -> - case gb_sets:is_member({behaviour_info,1}, Defined) of - false -> State; + optional_callbacks = OptionalCbs, + defined = Defined} = St0) -> + OptFun = fun({MFA, Line}, St) -> + case dict:is_key(MFA, Callbacks) of + true -> + St; + false -> + add_error(Line, {undefined_callback, MFA}, St) + end + end, + St1 = lists:foldl(OptFun, St0, dict:to_list(OptionalCbs)), + case gb_sets:is_member({behaviour_info, 1}, Defined) of + false -> St1; true -> case dict:size(Callbacks) of - 0 -> State; + 0 -> St1; _ -> CallbacksList = dict:to_list(Callbacks), FoldL = - fun({Fa,Line},St) -> + fun({Fa, Line}, St) -> add_error(Line, {behaviour_info, Fa}, St) end, - lists:foldl(FoldL, State, CallbacksList) + lists:foldl(FoldL, St1, CallbacksList) end end. @@ -1211,77 +1254,58 @@ export_type(Line, ETs, #lint{usage = Usage, exp_types = ETs0} = St0) -> add_error(Line, {bad_export_type, ETs}, St0) end. +-spec exports(lint_state()) -> gb_sets:set(fa()). + +exports(#lint{compile = Opts, defined = Defs, exports = Es}) -> + case lists:member(export_all, Opts) of + true -> Defs; + false -> Es + end. + -type import() :: {module(), [fa()]} | module(). -spec import(line(), import(), lint_state()) -> lint_state(). import(Line, {Mod,Fs}, St) -> - Mod1 = package_to_string(Mod), - case packages:is_valid(Mod1) of - true -> - Mfs = ordsets:from_list(Fs), - case check_imports(Line, Mfs, St#lint.imports) of - [] -> - St#lint{imports=add_imports(list_to_atom(Mod1), Mfs, - St#lint.imports)}; - Efs -> - {Err, St1} = - foldl(fun ({bif,{F,A},_}, {Err,St0}) -> - %% BifClash - import directive - Warn = is_warn_enabled(bif_clash, St0) - and (not bif_clash_specifically_disabled(St0,{F,A})), - AutoImpSup = is_autoimport_suppressed(St0#lint.no_auto,{F,A}), - OldBif = erl_internal:old_bif(F,A), - {Err,if - Warn and (not AutoImpSup) and OldBif -> - add_error - (Line, - {redefine_old_bif_import, {F,A}}, - St0); - Warn and (not AutoImpSup) -> - add_warning - (Line, - {redefine_bif_import, {F,A}}, - St0); - true -> - St0 - end}; - (Ef, {_Err,St0}) -> - {true,add_error(Line, - {redefine_import,Ef}, - St0)} - end, - {false,St}, Efs), - if - not Err -> - St1#lint{imports= - add_imports(list_to_atom(Mod1), Mfs, + Mfs = ordsets:from_list(Fs), + case check_imports(Line, Mfs, St#lint.imports) of + [] -> + St#lint{imports=add_imports(Mod, Mfs, + St#lint.imports)}; + Efs -> + {Err, St1} = + foldl(fun ({bif,{F,A},_}, {Err,St0}) -> + %% BifClash - import directive + Warn = is_warn_enabled(bif_clash, St0) andalso + (not bif_clash_specifically_disabled(St0,{F,A})), + AutoImpSup = is_autoimport_suppressed(St0#lint.no_auto,{F,A}), + OldBif = erl_internal:old_bif(F,A), + {Err,if + Warn and (not AutoImpSup) and OldBif -> + add_error + (Line, + {redefine_old_bif_import, {F,A}}, + St0); + Warn and (not AutoImpSup) -> + add_warning + (Line, + {redefine_bif_import, {F,A}}, + St0); + true -> + St0 + end}; + (Ef, {_Err,St0}) -> + {true,add_error(Line, + {redefine_import,Ef}, + St0)} + end, + {false,St}, Efs), + if + not Err -> + St1#lint{imports=add_imports(Mod, Mfs, St#lint.imports)}; - true -> - St1 - end - end; - false -> - add_error(Line, {bad_module_name, Mod1}, St) - end; -import(Line, Mod, St) -> - Mod1 = package_to_string(Mod), - case packages:is_valid(Mod1) of - true -> - Key = list_to_atom(packages:last(Mod1)), - Imps = St#lint.mod_imports, -%%% case dict:is_key(Key, Imps) of -%%% true -> -%%% M = packages:last(Mod1), -%%% P = packages:strip_last(Mod1), -%%% add_error(Line, {redefine_mod_import, M, P}, St); -%%% false -> -%%% St#lint{mod_imports = -%%% dict:store(Key, list_to_atom(Mod1), Imps)} -%%% end; - St#lint{mod_imports = dict:store(Key, list_to_atom(Mod1), - Imps)}; - false -> - add_error(Line, {bad_module_name, Mod1}, St) + true -> + St1 + end end. check_imports(_Line, Fs, Is) -> @@ -1309,7 +1333,7 @@ imported(F, A, St) -> error -> no end. --spec on_load(line(), fa(), lint_state()) -> lint_state(). +-spec on_load(erl_anno:anno(), fa(), lint_state()) -> lint_state(). %% Check an on_load directive and remember it. on_load(Line, {Name,Arity}=Fa, #lint{on_load=OnLoad0}=St0) @@ -1344,22 +1368,21 @@ check_on_load(St) -> St. -spec call_function(line(), atom(), arity(), lint_state()) -> lint_state(). %% Add to both called and calls. -call_function(Line, F, A, #lint{usage=Usage0,called=Cd,func=Func}=St) -> +call_function(Line, F, A, #lint{usage=Usage0,called=Cd,func=Func,file=File}=St) -> #usage{calls = Cs} = Usage0, NA = {F,A}, Usage = case Cs of undefined -> Usage0; _ -> Usage0#usage{calls=dict:append(Func, NA, Cs)} end, - St#lint{called=[{NA,Line}|Cd], usage=Usage}. + Anno = erl_anno:set_file(File, Line), + St#lint{called=[{NA,Anno}|Cd], usage=Usage}. %% function(Line, Name, Arity, Clauses, State) -> State. -function(Line, instance, _Arity, _Cs, St) when St#lint.global_vt =/= [] -> - add_error(Line, define_instance, St); function(Line, Name, Arity, Cs, St0) -> St1 = define_function(Line, Name, Arity, St0#lint{func={Name,Arity}}), - clauses(Cs, St1#lint.global_vt, St1). + clauses(Cs, St1). -spec define_function(line(), atom(), arity(), lint_state()) -> lint_state(). @@ -1382,15 +1405,16 @@ function_check_max_args(Line, Arity, St) when Arity > ?MAX_ARGUMENTS -> add_error(Line, {too_many_arguments,Arity}, St); function_check_max_args(_, _, St) -> St. -%% clauses([Clause], VarTable, State) -> {VarTable, State}. +%% clauses([Clause], State) -> {VarTable, State}. -clauses(Cs, Vt, St) -> +clauses(Cs, St) -> foldl(fun (C, St0) -> - {_,St1} = clause(C, Vt, St0), + {_,St1} = clause(C, St0), St1 end, St, Cs). -clause({clause,_Line,H,G,B}, Vt0, St0) -> +clause({clause,_Line,H,G,B}, St0) -> + Vt0 = [], {Hvt,Binvt,St1} = head(H, Vt0, St0), %% Cannot ignore BinVt since "binsize variables" may have been used. Vt1 = vtupdate(Hvt, vtupdate(Binvt, Vt0)), @@ -1447,6 +1471,8 @@ pattern({cons,_Line,H,T}, Vt, Old, Bvt, St0) -> {vtmerge_pat(Hvt, Tvt),vtmerge_pat(Bvt1,Bvt2),St2}; pattern({tuple,_Line,Ps}, Vt, Old, Bvt, St) -> pattern_list(Ps, Vt, Old, Bvt, St); +pattern({map,_Line,Ps}, Vt, Old, Bvt, St) -> + pattern_map(Ps, Vt, Old, Bvt, St); %%pattern({struct,_Line,_Tag,Ps}, Vt, Old, Bvt, St) -> %% pattern_list(Ps, Vt, Old, Bvt, St); pattern({record_index,Line,Name,Field}, _Vt, _Old, _Bvt, St) -> @@ -1456,13 +1482,6 @@ pattern({record_index,Line,Name,Field}, _Vt, _Old, _Bvt, St) -> pattern_field(Field, Name, Dfs, St1) end), {Vt1,[],St1}; -pattern({record_field,Line,_,_}=M, _Vt, _Old, _Bvt, St0) -> - case expand_package(M, St0) of - {error, St1} -> - {[],[],add_error(Line, illegal_expr, St1)}; - {_, St1} -> - {[],[],St1} - end; pattern({record,Line,Name,Pfs}, Vt, Old, Bvt, St) -> case dict:find(Name, St#lint.records) of {ok,{_Line,Fields}} -> @@ -1483,7 +1502,7 @@ pattern({op,_Line,'++',{string,_Li,_S},R}, Vt, Old, Bvt, St) -> pattern({match,_Line,Pat1,Pat2}, Vt, Old, Bvt, St0) -> {Lvt,Bvt1,St1} = pattern(Pat1, Vt, Old, Bvt, St0), {Rvt,Bvt2,St2} = pattern(Pat2, Vt, Old, Bvt, St1), - St3 = reject_bin_alias(Pat1, Pat2, St2), + St3 = reject_invalid_alias(Pat1, Pat2, Vt, St2), {vtmerge_pat(Lvt, Rvt),vtmerge_pat(Bvt1,Bvt2),St3}; %% Catch legal constant expressions, including unary +,-. pattern(Pat, _Vt, _Old, _Bvt, St) -> @@ -1498,56 +1517,77 @@ pattern_list(Ps, Vt, Old, Bvt0, St) -> {vtmerge_pat(Pvt, Psvt),vtmerge_pat(Bvt,Bvt1),St1} end, {[],[],St}, Ps). -%% reject_bin_alias(Pat, Expr, St) -> St' + + +%% reject_invalid_alias(Pat, Expr, Vt, St) -> St' %% Reject aliases for binary patterns at the top level. +%% Reject aliases for maps patterns at the top level. +%% The variables table (Vt) are for maps checkking. -reject_bin_alias_expr({bin,_,_}=P, {match,_,P0,E}, St0) -> - St = reject_bin_alias(P, P0, St0), - reject_bin_alias_expr(P, E, St); -reject_bin_alias_expr({match,_,_,_}=P, {match,_,P0,E}, St0) -> - St = reject_bin_alias(P, P0, St0), - reject_bin_alias_expr(P, E, St); -reject_bin_alias_expr(_, _, St) -> St. +reject_invalid_alias_expr({bin,_,_}=P, {match,_,P0,E}, Vt, St0) -> + St = reject_invalid_alias(P, P0, Vt, St0), + reject_invalid_alias_expr(P, E, Vt, St); +reject_invalid_alias_expr({map,_,_}=P, {match,_,P0,E}, Vt, St0) -> + St = reject_invalid_alias(P, P0, Vt, St0), + reject_invalid_alias_expr(P, E, Vt, St); +reject_invalid_alias_expr({match,_,_,_}=P, {match,_,P0,E}, Vt, St0) -> + St = reject_invalid_alias(P, P0, Vt, St0), + reject_invalid_alias_expr(P, E, Vt, St); +reject_invalid_alias_expr(_, _, _, St) -> St. -%% reject_bin_alias(Pat1, Pat2, St) -> St' + +%% reject_invalid_alias(Pat1, Pat2, St) -> St' %% Aliases of binary patterns, such as <<A:8>> = <<B:4,C:4>> or even %% <<A:8>> = <<A:8>>, are not allowed. Traverse the patterns in parallel %% and generate an error if any binary aliases are found. %% We generate an error even if is obvious that the overall pattern can't %% possibly match, for instance, {a,<<A:8>>,c}={x,<<A:8>>} WILL generate an %% error. +%% Maps should reject unbound variables here. -reject_bin_alias({bin,Line,_}, {bin,_,_}, St) -> +reject_invalid_alias({bin,Line,_}, {bin,_,_}, _, St) -> add_error(Line, illegal_bin_pattern, St); -reject_bin_alias({cons,_,H1,T1}, {cons,_,H2,T2}, St0) -> - St = reject_bin_alias(H1, H2, St0), - reject_bin_alias(T1, T2, St); -reject_bin_alias({tuple,_,Es1}, {tuple,_,Es2}, St) -> - reject_bin_alias_list(Es1, Es2, St); -reject_bin_alias({record,_,Name1,Pfs1}, {record,_,Name2,Pfs2}, +reject_invalid_alias({map,_Line,Ps1}, {map,_,Ps2}, Vt, St0) -> + Fun = fun ({map_field_exact,L,{var,_,K},_V}, Sti) -> + case is_var_bound(K,Vt) of + true -> + Sti; + false -> + add_error(L, {unbound_var,K}, Sti) + end; + ({map_field_exact,_L,_K,_V}, Sti) -> + Sti + end, + foldl(Fun, foldl(Fun, St0, Ps1), Ps2); +reject_invalid_alias({cons,_,H1,T1}, {cons,_,H2,T2}, Vt, St0) -> + St = reject_invalid_alias(H1, H2, Vt, St0), + reject_invalid_alias(T1, T2, Vt, St); +reject_invalid_alias({tuple,_,Es1}, {tuple,_,Es2}, Vt, St) -> + reject_invalid_alias_list(Es1, Es2, Vt, St); +reject_invalid_alias({record,_,Name1,Pfs1}, {record,_,Name2,Pfs2}, Vt, #lint{records=Recs}=St) -> case {dict:find(Name1, Recs),dict:find(Name2, Recs)} of {{ok,{_Line1,Fields1}},{ok,{_Line2,Fields2}}} -> - reject_bin_alias_rec(Pfs1, Pfs2, Fields1, Fields2, St); + reject_invalid_alias_rec(Pfs1, Pfs2, Fields1, Fields2, Vt, St); {_,_} -> %% One or more non-existing records. (An error messages has %% already been generated, so we are done here.) St end; -reject_bin_alias({match,_,P1,P2}, P, St0) -> - St = reject_bin_alias(P1, P, St0), - reject_bin_alias(P2, P, St); -reject_bin_alias(P, {match,_,_,_}=M, St) -> - reject_bin_alias(M, P, St); -reject_bin_alias(_P1, _P2, St) -> St. - -reject_bin_alias_list([E1|Es1], [E2|Es2], St0) -> - St = reject_bin_alias(E1, E2, St0), - reject_bin_alias_list(Es1, Es2, St); -reject_bin_alias_list(_, _, St) -> St. - -reject_bin_alias_rec(PfsA0, PfsB0, FieldsA0, FieldsB0, St) -> +reject_invalid_alias({match,_,P1,P2}, P, Vt, St0) -> + St = reject_invalid_alias(P1, P, Vt, St0), + reject_invalid_alias(P2, P, Vt, St); +reject_invalid_alias(P, {match,_,_,_}=M, Vt, St) -> + reject_invalid_alias(M, P, Vt, St); +reject_invalid_alias(_P1, _P2, _Vt, St) -> St. + +reject_invalid_alias_list([E1|Es1], [E2|Es2], Vt, St0) -> + St = reject_invalid_alias(E1, E2, Vt, St0), + reject_invalid_alias_list(Es1, Es2, Vt, St); +reject_invalid_alias_list(_, _, _, St) -> St. + +reject_invalid_alias_rec(PfsA0, PfsB0, FieldsA0, FieldsB0, Vt, St) -> %% We treat records as if they have been converted to tuples. PfsA1 = rbia_field_vars(PfsA0), PfsB1 = rbia_field_vars(PfsB0), @@ -1563,7 +1603,7 @@ reject_bin_alias_rec(PfsA0, PfsB0, FieldsA0, FieldsB0, St) -> D = sofs:projection({external,fun({_,_,P1,_,P2}) -> {P1,P2} end}, C), E = sofs:to_external(D), {Ps1,Ps2} = lists:unzip(E), - reject_bin_alias_list(Ps1, Ps2, St). + reject_invalid_alias_list(Ps1, Ps2, Vt, St). rbia_field_vars(Fs) -> [{Name,Pat} || {record_field,_,{atom,_,Name},Pat} <- Fs]. @@ -1607,6 +1647,21 @@ is_pattern_expr_1({op,_Line,Op,A1,A2}) -> erl_internal:arith_op(Op, 2) andalso all(fun is_pattern_expr/1, [A1,A2]); is_pattern_expr_1(_Other) -> false. +pattern_map(Ps, Vt, Old, Bvt, St) -> + foldl(fun + ({map_field_assoc,L,_,_}, {Psvt,Bvt0,St0}) -> + {Psvt,Bvt0,add_error(L, illegal_pattern, St0)}; + ({map_field_exact,L,K,V}, {Psvt,Bvt0,St0}) -> + case is_valid_map_key(K) of + true -> + {Kvt,St1} = expr(K, Vt, St0), + {Vvt,Bvt2,St2} = pattern(V, Vt, Old, Bvt, St1), + {vtmerge_pat(vtmerge_pat(Kvt, Vvt), Psvt), vtmerge_pat(Bvt0, Bvt2), St2}; + false -> + {Psvt,Bvt0,add_error(L, illegal_map_key, St0)} + end + end, {[],[],St}, Ps). + %% pattern_bin([Element], VarTable, Old, BinVarTable, State) -> %% {UpdVarTable,UpdBinVarTable,State}. %% Check a pattern group. BinVarTable are used binsize variables. @@ -1841,16 +1896,15 @@ gexpr({cons,_Line,H,T}, Vt, St) -> gexpr_list([H,T], Vt, St); gexpr({tuple,_Line,Es}, Vt, St) -> gexpr_list(Es, Vt, St); +gexpr({map,_Line,Es}, Vt, St) -> + map_fields(Es, Vt, check_assoc_fields(Es, St), fun gexpr_list/3); +gexpr({map,_Line,Src,Es}, Vt, St) -> + {Svt,St1} = gexpr(Src, Vt, St), + {Fvt,St2} = map_fields(Es, Vt, St1, fun gexpr_list/3), + {vtmerge(Svt, Fvt),St2}; gexpr({record_index,Line,Name,Field}, _Vt, St) -> check_record(Line, Name, St, fun (Dfs, St1) -> record_field(Field, Name, Dfs, St1) end ); -gexpr({record_field,Line,_,_}=M, _Vt, St0) -> - case expand_package(M, St0) of - {error, St1} -> - {[],add_error(Line, illegal_expr, St1)}; - {_, St1} -> - {[], St1} - end; gexpr({record_field,Line,Rec,Name,Field}, Vt, St0) -> {Rvt,St1} = gexpr(Rec, Vt, St0), {Fvt,St2} = check_record(Line, Name, St1, @@ -1895,11 +1949,9 @@ gexpr({call,Line,{atom,_La,F},As}, Vt, St0) -> %% BifClash - Function called in guard case erl_internal:guard_bif(F, A) andalso no_guard_bif_clash(St1,{F,A}) of true -> - %% Also check that it is auto-imported. - case erl_internal:bif(F, A) of - true -> {Asvt,St1}; - false -> {Asvt,add_error(Line, {explicit_export,F,A}, St1)} - end; + %% Assert that it is auto-imported. + true = erl_internal:bif(F, A), + {Asvt,St1}; false -> case is_local_function(St1#lint.locals,{F,A}) orelse is_imported_function(St1#lint.imports,{F,A}) of @@ -1916,15 +1968,16 @@ gexpr({call,Line,{remote,_Lr,{atom,_Lm,erlang},{atom,_Lf,F}},As}, Vt, St0) -> true -> {Asvt,St1}; false -> {Asvt,add_error(Line, illegal_guard_expr, St1)} end; -gexpr({call,L,{tuple,Lt,[{atom,Lm,erlang},{atom,Lf,F}]},As}, Vt, St0) -> - St = add_warning(L, deprecated_tuple_fun, St0), - gexpr({call,L,{remote,Lt,{atom,Lm,erlang},{atom,Lf,F}},As}, Vt, St); gexpr({op,Line,Op,A}, Vt, St0) -> {Avt,St1} = gexpr(A, Vt, St0), case is_gexpr_op(Op, 1) of true -> {Avt,St1}; false -> {Avt,add_error(Line, illegal_guard_expr, St1)} end; +gexpr({op,_,'andalso',L,R}, Vt, St) -> + gexpr_list([L,R], Vt, St); +gexpr({op,_,'orelse',L,R}, Vt, St) -> + gexpr_list([L,R], Vt, St); gexpr({op,Line,Op,L,R}, Vt, St0) -> {Avt,St1} = gexpr_list([L,R], Vt, St0), case is_gexpr_op(Op, 2) of @@ -1957,12 +2010,12 @@ is_guard_test(E) -> is_guard_test(Expression, Forms) -> RecordAttributes = [A || A = {attribute, _, record, _D} <- Forms], St0 = foldl(fun(Attr0, St1) -> - Attr = zip_file_and_line(Attr0, "none"), + Attr = set_file(Attr0, "none"), attribute_state(Attr, St1) end, start(), RecordAttributes), - is_guard_test2(zip_file_and_line(Expression, "nofile"), St0#lint.records). + is_guard_test2(set_file(Expression, "nofile"), St0#lint.records). -%% is_guard_test2(Expression, RecordDefs :: dict()) -> boolean(). +%% is_guard_test2(Expression, RecordDefs :: dict:dict()) -> boolean(). is_guard_test2({call,Line,{atom,Lr,record},[E,A]}, RDs) -> is_gexpr({call,Line,{atom,Lr,is_record},[E,A]}, RDs); is_guard_test2({call,_Line,{atom,_La,Test},As}=Call, RDs) -> @@ -1992,8 +2045,6 @@ is_gexpr({tuple,_L,Es}, RDs) -> is_gexpr_list(Es, RDs); %% is_gexpr_list(Es, RDs); is_gexpr({record_index,_L,_Name,Field}, RDs) -> is_gexpr(Field, RDs); -is_gexpr({record_field,_L,_,_}=M, _RDs) -> - erl_parse:package_segments(M) =/= error; is_gexpr({record_field,_L,Rec,_Name,Field}, RDs) -> is_gexpr_list([Rec,Field], RDs); is_gexpr({record,L,Name,Inits}, RDs) -> @@ -2013,12 +2064,14 @@ is_gexpr({call,L,{tuple,Lt,[{atom,Lm,erlang},{atom,Lf,F}]},As}, RDs) -> is_gexpr({call,L,{remote,Lt,{atom,Lm,erlang},{atom,Lf,F}},As}, RDs); is_gexpr({op,_L,Op,A}, RDs) -> is_gexpr_op(Op, 1) andalso is_gexpr(A, RDs); +is_gexpr({op,_L,'andalso',A1,A2}, RDs) -> + is_gexpr_list([A1,A2], RDs); +is_gexpr({op,_L,'orelse',A1,A2}, RDs) -> + is_gexpr_list([A1,A2], RDs); is_gexpr({op,_L,Op,A1,A2}, RDs) -> is_gexpr_op(Op, 2) andalso is_gexpr_list([A1,A2], RDs); is_gexpr(_Other, _RDs) -> false. -is_gexpr_op('andalso', 2) -> true; -is_gexpr_op('orelse', 2) -> true; is_gexpr_op(Op, A) -> try erl_internal:op_type(Op, A) of arith -> true; @@ -2066,14 +2119,18 @@ expr({string,_Line,_S}, _Vt, St) -> {[],St}; expr({nil,_Line}, _Vt, St) -> {[],St}; expr({cons,_Line,H,T}, Vt, St) -> expr_list([H,T], Vt, St); -expr({lc,_Line,E,Qs}, Vt0, St0) -> - {Vt,St} = handle_comprehension(E, Qs, Vt0, St0), - {vtold(Vt, Vt0),St}; %Don't export local variables -expr({bc,_Line,E,Qs}, Vt0, St0) -> - {Vt,St} = handle_comprehension(E, Qs, Vt0, St0), - {vtold(Vt,Vt0),St}; %Don't export local variables +expr({lc,_Line,E,Qs}, Vt, St) -> + handle_comprehension(E, Qs, Vt, St); +expr({bc,_Line,E,Qs}, Vt, St) -> + handle_comprehension(E, Qs, Vt, St); expr({tuple,_Line,Es}, Vt, St) -> expr_list(Es, Vt, St); +expr({map,_Line,Es}, Vt, St) -> + map_fields(Es, Vt, check_assoc_fields(Es, St), fun expr_list/3); +expr({map,_Line,Src,Es}, Vt, St) -> + {Svt,St1} = expr(Src, Vt, St), + {Fvt,St2} = map_fields(Es, Vt, St1, fun expr_list/3), + {vtupdate(Svt, Fvt),St2}; expr({record_index,Line,Name,Field}, _Vt, St) -> check_record(Line, Name, St, fun (Dfs, St1) -> record_field(Field, Name, Dfs, St1) end); @@ -2082,13 +2139,6 @@ expr({record,Line,Name,Inits}, Vt, St) -> fun (Dfs, St1) -> init_fields(Inits, Line, Name, Dfs, Vt, St1) end); -expr({record_field,Line,_,_}=M, _Vt, St0) -> - case expand_package(M, St0) of - {error, St1} -> - {[],add_error(Line, illegal_expr, St1)}; - {_, St1} -> - {[], St1} - end; expr({record_field,Line,Rec,Name,Field}, Vt, St0) -> {Rvt,St1} = record_expr(Line, Rec, Vt, St0), {Fvt,St2} = check_record(Line, Name, St1, @@ -2126,14 +2176,13 @@ expr({'receive',Line,Cs,To,ToEs}, Vt, St0) -> {Cvt,St3} = icrt_clauses(Cs, Vt, St2), %% Csvts = [vtnew(Tevt, Vt)|Cvt], %This is just NEW variables! Csvts = [Tevt|Cvt], - {Rvt,St4} = icrt_export(Csvts, Vt, {'receive',Line}, St3), - {vtmerge([Tvt,Tevt,Rvt]),St4}; + Rvt = icrt_export(Csvts, Vt, {'receive',Line}, St3), + {vtmerge([Tvt,Tevt,Rvt]),St3}; expr({'fun',Line,Body}, Vt, St) -> %%No one can think funs export! case Body of {clauses,Cs} -> - {Bvt, St1} = fun_clauses(Cs, Vt, St), - {vtupdate(Bvt, Vt), St1}; + fun_clauses(Cs, Vt, St); {function,F,A} -> %% BifClash - Fun expression %% N.B. Only allows BIFs here as well, NO IMPORTS!! @@ -2151,6 +2200,15 @@ expr({'fun',Line,Body}, Vt, St) -> {Bvt, St1} = expr_list([M,F,A], Vt, St), {vtupdate(Bvt, Vt),St1} end; +expr({named_fun,_,'_',Cs}, Vt, St) -> + fun_clauses(Cs, Vt, St); +expr({named_fun,Line,Name,Cs}, Vt, St0) -> + Nvt0 = [{Name,{bound,unused,[Line]}}], + St1 = shadow_vars(Nvt0, Vt, 'named fun', St0), + Nvt1 = vtupdate(vtsubtract(Vt, Nvt0), Nvt0), + {Csvt,St2} = fun_clauses(Cs, Nvt1, St1), + {_,St3} = check_unused_vars(vtupdate(Csvt, Nvt0), [], St2), + {vtold(Csvt, Vt),St3}; expr({call,_Line,{atom,_Lr,is_record},[E,{atom,Ln,Name}]}, Vt, St0) -> {Rvt,St1} = expr(E, Vt, St0), {Rvt,exist_record(Ln, Name, St1)}; @@ -2159,20 +2217,14 @@ expr({call,Line,{remote,_Lr,{atom,_Lm,erlang},{atom,Lf,is_record}},[E,A]}, expr({call,Line,{atom,Lf,is_record},[E,A]}, Vt, St0); expr({call,L,{tuple,Lt,[{atom,Lm,erlang},{atom,Lf,is_record}]},As}, Vt, St) -> expr({call,L,{remote,Lt,{atom,Lm,erlang},{atom,Lf,is_record}},As}, Vt, St); +expr({call,Line,{remote,_Lr,{atom,_Lm,M},{atom,Lf,F}},As}, Vt, St0) -> + St1 = keyword_warning(Lf, F, St0), + St2 = check_remote_function(Line, M, F, As, St1), + expr_list(As, Vt, St2); expr({call,Line,{remote,_Lr,M,F},As}, Vt, St0) -> - case expand_package(M, St0) of - {error, _} -> - expr_list([M,F|As], Vt, St0); - {{atom,_La,M1}, St1} -> - case F of - {atom,Lf,F1} -> - St2 = keyword_warning(Lf, F1, St1), - St3 = check_remote_function(Line, M1, F1, As, St2), - expr_list(As, Vt, St3); - _ -> - expr_list([F|As], Vt, St1) - end - end; + St1 = keyword_warning(Line, M, St0), + St2 = keyword_warning(Line, F, St1), + expr_list([M,F|As], Vt, St2); expr({call,Line,{atom,La,F},As}, Vt, St0) -> St1 = keyword_warning(La, F, St0), {Asvt,St2} = expr_list(As, Vt, St1), @@ -2228,13 +2280,6 @@ expr({call,Line,{atom,La,F},As}, Vt, St0) -> end end} end; -expr({call,Line,{record_field,_,_,_}=F,As}, Vt, St0) -> - case expand_package(F, St0) of - {error, _} -> - expr_list([F|As], Vt, St0); - {A, St1} -> - expr({call,Line,A,As}, Vt, St1) - end; expr({call,Line,F,As}, Vt, St0) -> St = warn_invalid_call(Line,F,St0), expr_list([F|As], Vt, St); %They see the same variables @@ -2243,25 +2288,24 @@ expr({'try',Line,Es,Scs,Ccs,As}, Vt, St0) -> %% passes cannot handle exports in combination with 'after'. {Evt0,St1} = exprs(Es, Vt, St0), TryLine = {'try',Line}, - Uvt = vtunsafe(vtnames(vtnew(Evt0, Vt)), TryLine, []), - Evt1 = vtupdate(Uvt, vtupdate(Evt0, Vt)), - {Sccs,St2} = icrt_clauses(Scs++Ccs, TryLine, Evt1, St1), + Uvt = vtunsafe(TryLine, Evt0, Vt), + Evt1 = vtupdate(Uvt, Evt0), + {Sccs,St2} = icrt_clauses(Scs++Ccs, TryLine, vtupdate(Evt1, Vt), St1), Rvt0 = Sccs, - Rvt1 = vtupdate(vtunsafe(vtnames(vtnew(Rvt0, Vt)), TryLine, []), Rvt0), + Rvt1 = vtupdate(vtunsafe(TryLine, Rvt0, Vt), Rvt0), Evt2 = vtmerge(Evt1, Rvt1), - {Avt0,St} = exprs(As, Evt2, St2), - Avt1 = vtupdate(vtunsafe(vtnames(vtnew(Avt0, Vt)), TryLine, []), Avt0), + {Avt0,St} = exprs(As, vtupdate(Evt2, Vt), St2), + Avt1 = vtupdate(vtunsafe(TryLine, Avt0, Vt), Avt0), Avt = vtmerge(Evt2, Avt1), {Avt,St}; expr({'catch',Line,E}, Vt, St0) -> %% No new variables added, flag new variables as unsafe. - {Evt,St1} = expr(E, Vt, St0), - Uvt = vtunsafe(vtnames(vtnew(Evt, Vt)), {'catch',Line}, []), - {vtupdate(Uvt,vtupdate(Evt, Vt)),St1}; + {Evt,St} = expr(E, Vt, St0), + {vtupdate(vtunsafe({'catch',Line}, Evt, Vt), Evt),St}; expr({match,_Line,P,E}, Vt, St0) -> {Evt,St1} = expr(E, Vt, St0), {Pvt,Bvt,St2} = pattern(P, vtupdate(Evt, Vt), St1), - St = reject_bin_alias_expr(P, E, St2), + St = reject_invalid_alias_expr(P, E, Vt, St2), {vtupdate(Bvt, vtmerge(Evt, Pvt)),St}; %% No comparison or boolean operators yet. expr({op,_Line,_Op,A}, Vt, St) -> @@ -2270,16 +2314,13 @@ expr({op,Line,Op,L,R}, Vt, St0) when Op =:= 'orelse'; Op =:= 'andalso' -> {Evt1,St1} = expr(L, Vt, St0), Vt1 = vtupdate(Evt1, Vt), {Evt2,St2} = expr(R, Vt1, St1), - Vt2 = vtmerge(Evt2, Vt1), - {Vt3,St3} = icrt_export([Vt1,Vt2], Vt1, {Op,Line}, St2), - {vtmerge(Evt1, Vt3),St3}; + Evt3 = vtupdate(vtunsafe({Op,Line}, Evt2, Vt1), Evt2), + {vtmerge(Evt1, Evt3),St2}; expr({op,_Line,_Op,L,R}, Vt, St) -> expr_list([L,R], Vt, St); %They see the same variables %% The following are not allowed to occur anywhere! expr({remote,Line,_M,_F}, _Vt, St) -> - {[],add_error(Line, illegal_expr, St)}; -expr({'query',Line,_Q}, _Vt, St) -> - {[],add_error(Line, {mnemosyne,"query"}, St)}. + {[],add_error(Line, illegal_expr, St)}. %% expr_list(Expressions, Variables, State) -> %% {UsedVarTable,State} @@ -2287,13 +2328,28 @@ expr({'query',Line,_Q}, _Vt, St) -> expr_list(Es, Vt, St) -> foldl(fun (E, {Esvt,St0}) -> {Evt,St1} = expr(E, Vt, St0), - {vtmerge(Evt, Esvt),St1} + {vtmerge_pat(Evt, Esvt),St1} end, {[],St}, Es). record_expr(Line, Rec, Vt, St0) -> St1 = warn_invalid_record(Line, Rec, St0), expr(Rec, Vt, St1). +check_assoc_fields([{map_field_exact,Line,_,_}|Fs], St) -> + check_assoc_fields(Fs, add_error(Line, illegal_map_construction, St)); +check_assoc_fields([{map_field_assoc,_,_,_}|Fs], St) -> + check_assoc_fields(Fs, St); +check_assoc_fields([], St) -> + St. + +map_fields([{Tag,_,K,V}|Fs], Vt, St, F) when Tag =:= map_field_assoc; + Tag =:= map_field_exact -> + {Pvt,St2} = F([K,V], Vt, St), + {Vts,St3} = map_fields(Fs, Vt, St2, F), + {vtupdate(Pvt, Vts),St3}; +map_fields([], _, St, _) -> + {[],St}. + %% warn_invalid_record(Line, Record, State0) -> State %% Adds warning if the record is invalid. @@ -2317,6 +2373,7 @@ is_valid_record(Rec) -> {lc, _, _, _} -> false; {record_index, _, _, _} -> false; {'fun', _, _} -> false; + {named_fun, _, _, _} -> false; _ -> true end. @@ -2345,6 +2402,63 @@ is_valid_call(Call) -> _ -> true end. +%% is_valid_map_key(K) -> true | false +%% variables are allowed for patterns only at the top of the tree + +is_valid_map_key({var,_,_}) -> true; +is_valid_map_key(K) -> is_valid_map_key_value(K). +is_valid_map_key_value(K) -> + case K of + {var,_,_} -> false; + {char,_,_} -> true; + {integer,_,_} -> true; + {float,_,_} -> true; + {string,_,_} -> true; + {nil,_} -> true; + {atom,_,_} -> true; + {cons,_,H,T} -> + is_valid_map_key_value(H) andalso + is_valid_map_key_value(T); + {tuple,_,Es} -> + foldl(fun(E,B) -> + B andalso is_valid_map_key_value(E) + end,true,Es); + {map,_,Arg,Ps} -> + % only check for value expressions to be valid + % invalid map expressions are later checked in + % core and kernel + is_valid_map_key_value(Arg) andalso foldl(fun + ({Tag,_,Ke,Ve},B) when Tag =:= map_field_assoc; + Tag =:= map_field_exact -> + B andalso is_valid_map_key_value(Ke) + andalso is_valid_map_key_value(Ve); + (_,_) -> false + end,true,Ps); + {map,_,Ps} -> + foldl(fun + ({Tag,_,Ke,Ve},B) when Tag =:= map_field_assoc; + Tag =:= map_field_exact -> + B andalso is_valid_map_key_value(Ke) + andalso is_valid_map_key_value(Ve); + (_,_) -> false + end, true, Ps); + {record,_,_,Fs} -> + foldl(fun + ({record_field,_,Ke,Ve},B) -> + B andalso is_valid_map_key_value(Ke) + andalso is_valid_map_key_value(Ve) + end,true,Fs); + {bin,_,Es} -> + % only check for value expressions to be valid + % invalid binary expressions are later checked in + % core and kernel + foldl(fun + ({bin_element,_,E,_,_},B) -> + B andalso is_valid_map_key_value(E) + end,true,Es); + Val -> is_pattern_expr(Val) + end. + %% record_def(Line, RecordName, [RecField], State) -> State. %% Add a record definition if it does not already exist. Normalise %% so that all fields have explicit initial value. @@ -2354,7 +2468,10 @@ record_def(Line, Name, Fs0, St0) -> true -> add_error(Line, {redefine_record,Name}, St0); false -> {Fs1,St1} = def_fields(normalise_fields(Fs0), Name, St0), - St1#lint{records=dict:store(Name, {Line,Fs1}, St1#lint.records)} + St2 = St1#lint{records=dict:store(Name, {Line,Fs1}, + St1#lint.records)}, + Types = [T || {typed_record_field, _, T} <- Fs0], + check_type({type, nowarn(), product, Types}, St2) end. %% def_fields([RecDef], RecordName, State) -> {[DefField],State}. @@ -2445,7 +2562,7 @@ check_fields(Fs, Name, Fields, Vt, St0, CheckFun) -> check_field({record_field,Lf,{atom,La,F},Val}, Name, Fields, Vt, St, Sfs, CheckFun) -> case member(F, Sfs) of - true -> {Sfs,{Vt,add_error(Lf, {redefine_field,Name,F}, St)}}; + true -> {Sfs,{[],add_error(Lf, {redefine_field,Name,F}, St)}}; false -> {[F|Sfs], case find_field(F, Fields) of @@ -2557,38 +2674,56 @@ find_field(_F, []) -> error. %% Attr :: 'type' | 'opaque' %% Checks that a type definition is valid. -type_def(_Attr, _Line, {record, _RecName}, Fields, [], St0) -> - %% The record field names and such are checked in the record format. - %% We only need to check the types. - Types = [T || {typed_record_field, _, T} <- Fields], - check_type({type, -1, product, Types}, St0); -type_def(_Attr, Line, TypeName, ProtoType, Args, St0) -> +-dialyzer({no_match, type_def/6}). + +type_def(Attr, Line, TypeName, ProtoType, Args, St0) -> TypeDefs = St0#lint.types, Arity = length(Args), TypePair = {TypeName, Arity}, - case (dict:is_key(TypePair, TypeDefs) orelse is_var_arity_type(TypeName)) of - true -> - case dict:is_key(TypePair, default_types()) of - true -> - case is_newly_introduced_builtin_type(TypePair) of - %% allow some types just for bootstrapping - true -> - Warn = {new_builtin_type, TypePair}, - St1 = add_warning(Line, Warn, St0), - NewDefs = dict:store(TypePair, Line, TypeDefs), - CheckType = {type, -1, product, [ProtoType|Args]}, - check_type(CheckType, St1#lint{types=NewDefs}); - false -> - add_error(Line, {builtin_type, TypePair}, St0) - end; - false -> add_error(Line, {redefine_type, TypePair}, St0) - end; - false -> - NewDefs = dict:store(TypePair, Line, TypeDefs), - CheckType = {type, -1, product, [ProtoType|Args]}, - check_type(CheckType, St0#lint{types=NewDefs}) + Info = #typeinfo{attr = Attr, line = Line}, + StoreType = + fun(St) -> + NewDefs = dict:store(TypePair, Info, TypeDefs), + CheckType = {type, nowarn(), product, [ProtoType|Args]}, + check_type(CheckType, St#lint{types=NewDefs}) + end, + case is_default_type(TypePair) of + true -> + case is_obsolete_builtin_type(TypePair) of + true -> StoreType(St0); + false -> + case is_newly_introduced_builtin_type(TypePair) of + %% allow some types just for bootstrapping + true -> + Warn = {new_builtin_type, TypePair}, + St1 = add_warning(Line, Warn, St0), + StoreType(St1); + false -> + add_error(Line, {builtin_type, TypePair}, St0) + end + end; + false -> + case dict:is_key(TypePair, TypeDefs) of + true -> + add_error(Line, {redefine_type, TypePair}, St0); + false -> + St1 = case + Attr =:= opaque andalso + is_underspecified(ProtoType, Arity) + of + true -> + Warn = {underspecified_opaque, TypePair}, + add_warning(Line, Warn, St0); + false -> St0 + end, + StoreType(St1) + end end. +is_underspecified({type,_,term,[]}, 0) -> true; +is_underspecified({type,_,any,[]}, 0) -> true; +is_underspecified(_ProtType, _Arity) -> false. + check_type(Types, St) -> {SeenVars, St1} = check_type(Types, dict:new(), St), dict:fold(fun(Var, {seen_once, Line}, AccSt) -> @@ -2602,22 +2737,16 @@ check_type(Types, St) -> check_type({ann_type, _L, [_Var, Type]}, SeenVars, St) -> check_type(Type, SeenVars, St); -check_type({paren_type, _L, [Type]}, SeenVars, St) -> - check_type(Type, SeenVars, St); check_type({remote_type, L, [{atom, _, Mod}, {atom, _, Name}, Args]}, - SeenVars, #lint{module=CurrentMod} = St) -> - St1 = - case (dict:is_key({Name, length(Args)}, default_types()) - orelse is_var_arity_type(Name)) of - true -> add_error(L, {imported_predefined_type, Name}, St); - false -> St - end, + SeenVars, St0) -> + St = deprecated_type(L, Mod, Name, Args, St0), + CurrentMod = St#lint.module, case Mod =:= CurrentMod of - true -> check_type({type, L, Name, Args}, SeenVars, St1); + true -> check_type({user_type, L, Name, Args}, SeenVars, St); false -> lists:foldl(fun(T, {AccSeenVars, AccSt}) -> check_type(T, AccSeenVars, AccSt) - end, {SeenVars, St1}, Args) + end, {SeenVars, St}, Args) end; check_type({integer, _L, _}, SeenVars, St) -> {SeenVars, St}; check_type({atom, _L, _}, SeenVars, St) -> {SeenVars, St}; @@ -2639,7 +2768,7 @@ check_type({type, L, 'fun', [Dom, Range]}, SeenVars, St) -> {type, _, any} -> St; _ -> add_error(L, {type_syntax, 'fun'}, St) end, - check_type({type, -1, product, [Dom, Range]}, SeenVars, St1); + check_type({type, nowarn(), product, [Dom, Range]}, SeenVars, St1); check_type({type, L, range, [From, To]}, SeenVars, St) -> St1 = case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of @@ -2647,6 +2776,14 @@ check_type({type, L, range, [From, To]}, SeenVars, St) -> _ -> add_error(L, {type_syntax, range}, St) end, {SeenVars, St1}; +check_type({type, _L, map, any}, SeenVars, St) -> + {SeenVars, St}; +check_type({type, _L, map, Pairs}, SeenVars, St) -> + lists:foldl(fun(Pair, {AccSeenVars, AccSt}) -> + check_type(Pair, AccSeenVars, AccSt) + end, {SeenVars, St}, Pairs); +check_type({type, _L, map_field_assoc, [Dom, Range]}, SeenVars, St) -> + check_type({type, nowarn(), product, [Dom, Range]}, SeenVars, St); check_type({type, _L, tuple, any}, SeenVars, St) -> {SeenVars, St}; check_type({type, _L, any}, SeenVars, St) -> {SeenVars, St}; check_type({type, L, binary, [Base, Unit]}, SeenVars, St) -> @@ -2664,20 +2801,41 @@ check_type({type, L, record, [Name|Fields]}, SeenVars, St) -> check_record_types(L, Atom, Fields, SeenVars, St1); _ -> {SeenVars, add_error(L, {type_syntax, record}, St)} end; -check_type({type, _L, product, Args}, SeenVars, St) -> +check_type({type, _L, Tag, Args}, SeenVars, St) when Tag =:= product; + Tag =:= union; + Tag =:= tuple -> lists:foldl(fun(T, {AccSeenVars, AccSt}) -> check_type(T, AccSeenVars, AccSt) end, {SeenVars, St}, Args); -check_type({type, La, TypeName, Args}, SeenVars, #lint{usage=Usage} = St) -> +check_type({type, La, TypeName, Args}, SeenVars, St) -> + #lint{module = Module, types=Types} = St, Arity = length(Args), - St1 = case is_var_arity_type(TypeName) of - true -> St; - false -> - OldUsed = Usage#usage.used_types, - UsedTypes = dict:store({TypeName, Arity}, La, OldUsed), - St#lint{usage=Usage#usage{used_types=UsedTypes}} - end, - check_type({type, -1, product, Args}, SeenVars, St1); + TypePair = {TypeName, Arity}, + Obsolete = (is_warn_enabled(deprecated_type, St) + andalso obsolete_builtin_type(TypePair)), + St1 = case Obsolete of + {deprecated, Repl, _} when element(1, Repl) =/= Module -> + case dict:find(TypePair, Types) of + {ok, _} -> + used_type(TypePair, La, St); + error -> + {deprecated, Replacement, Rel} = Obsolete, + Tag = deprecated_builtin_type, + W = {Tag, TypePair, Replacement, Rel}, + add_warning(La, W, St) + end; + _ -> St + end, + check_type({type, nowarn(), product, Args}, SeenVars, St1); +check_type({user_type, L, TypeName, Args}, SeenVars, St) -> + Arity = length(Args), + TypePair = {TypeName, Arity}, + St1 = used_type(TypePair, L, St), + lists:foldl(fun(T, {AccSeenVars, AccSt}) -> + check_type(T, AccSeenVars, AccSt) + end, {SeenVars, St1}, Args); +check_type([{typed_record_field,Field,_T}|_], SeenVars, St) -> + {SeenVars, add_error(element(2, Field), old_abstract_code, St)}; check_type(I, SeenVars, St) -> case erl_eval:partial_eval(I) of {integer,_ILn,_Integer} -> {SeenVars, St}; @@ -2719,85 +2877,24 @@ check_record_types([{type, _, field_type, [{atom, AL, FName}, Type]}|Left], check_record_types([], _Name, _DefFields, SeenVars, St, _SeenFields) -> {SeenVars, St}. -is_var_arity_type(tuple) -> true; -is_var_arity_type(product) -> true; -is_var_arity_type(union) -> true; -is_var_arity_type(record) -> true; -is_var_arity_type(_) -> false. - -default_types() -> - DefTypes = [{any, 0}, - {arity, 0}, - {array, 0}, - {atom, 0}, - {atom, 1}, - {binary, 0}, - {binary, 2}, - {bitstring, 0}, - {bool, 0}, - {boolean, 0}, - {byte, 0}, - {char, 0}, - {dict, 0}, - {digraph, 0}, - {float, 0}, - {'fun', 0}, - {'fun', 2}, - {function, 0}, - {gb_set, 0}, - {gb_tree, 0}, - {identifier, 0}, - {integer, 0}, - {integer, 1}, - {iodata, 0}, - {iolist, 0}, - {list, 0}, - {list, 1}, - {maybe_improper_list, 0}, - {maybe_improper_list, 2}, - {mfa, 0}, - {module, 0}, - {neg_integer, 0}, - {nil, 0}, - {no_return, 0}, - {node, 0}, - {non_neg_integer, 0}, - {none, 0}, - {nonempty_list, 0}, - {nonempty_list, 1}, - {nonempty_improper_list, 2}, - {nonempty_maybe_improper_list, 0}, - {nonempty_maybe_improper_list, 2}, - {nonempty_string, 0}, - {number, 0}, - {pid, 0}, - {port, 0}, - {pos_integer, 0}, - {queue, 0}, - {range, 2}, - {reference, 0}, - {set, 0}, - {string, 0}, - {term, 0}, - {timeout, 0}, - {var, 1}], - dict:from_list([{T, -1} || T <- DefTypes]). - -%% R13 -is_newly_introduced_builtin_type({arity, 0}) -> true; -is_newly_introduced_builtin_type({array, 0}) -> true; % opaque -is_newly_introduced_builtin_type({bitstring, 0}) -> true; -is_newly_introduced_builtin_type({dict, 0}) -> true; % opaque -is_newly_introduced_builtin_type({digraph, 0}) -> true; % opaque -is_newly_introduced_builtin_type({gb_set, 0}) -> true; % opaque -is_newly_introduced_builtin_type({gb_tree, 0}) -> true; % opaque -is_newly_introduced_builtin_type({iodata, 0}) -> true; -is_newly_introduced_builtin_type({queue, 0}) -> true; % opaque -is_newly_introduced_builtin_type({set, 0}) -> true; % opaque -%% R13B01 -is_newly_introduced_builtin_type({boolean, 0}) -> true; +used_type(TypePair, L, #lint{usage = Usage, file = File} = St) -> + OldUsed = Usage#usage.used_types, + UsedTypes = dict:store(TypePair, erl_anno:set_file(File, L), OldUsed), + St#lint{usage=Usage#usage{used_types=UsedTypes}}. + +is_default_type({Name, NumberOfTypeVariables}) -> + erl_internal:is_type(Name, NumberOfTypeVariables). + is_newly_introduced_builtin_type({Name, _}) when is_atom(Name) -> false. +is_obsolete_builtin_type(TypePair) -> + obsolete_builtin_type(TypePair) =/= no. + +%% To keep Dialyzer silent... +obsolete_builtin_type({1, 255}) -> + {deprecated, {2, 255}, ""}; +obsolete_builtin_type({Name, A}) when is_atom(Name), is_integer(A) -> no. + %% spec_decl(Line, Fun, Types, State) -> State. spec_decl(Line, MFA0, TypeSpecs, St0 = #lint{specs = Specs, module = Mod}) -> @@ -2807,25 +2904,60 @@ spec_decl(Line, MFA0, TypeSpecs, St0 = #lint{specs = Specs, module = Mod}) -> end, St1 = St0#lint{specs = dict:store(MFA, Line, Specs)}, case dict:is_key(MFA, Specs) of - true -> add_error(Line, {redefine_spec, MFA}, St1); - false -> check_specs(TypeSpecs, Arity, St1) + true -> add_error(Line, {redefine_spec, MFA0}, St1); + false -> check_specs(TypeSpecs, spec_wrong_arity, Arity, St1) end. %% callback_decl(Line, Fun, Types, State) -> State. callback_decl(Line, MFA0, TypeSpecs, St0 = #lint{callbacks = Callbacks, module = Mod}) -> - MFA = case MFA0 of - {F, Arity} -> {Mod, F, Arity}; - {_M, _F, Arity} -> MFA0 - end, - St1 = St0#lint{callbacks = dict:store(MFA, Line, Callbacks)}, - case dict:is_key(MFA, Callbacks) of - true -> add_error(Line, {redefine_callback, MFA}, St1); - false -> check_specs(TypeSpecs, Arity, St1) + case MFA0 of + {_M, _F, _A} -> add_error(Line, {bad_callback, MFA0}, St0); + {F, Arity} -> + MFA = {Mod, F, Arity}, + St1 = St0#lint{callbacks = dict:store(MFA, Line, Callbacks)}, + case dict:is_key(MFA, Callbacks) of + true -> add_error(Line, {redefine_callback, MFA0}, St1); + false -> check_specs(TypeSpecs, callback_wrong_arity, + Arity, St1) + end end. -check_specs([FunType|Left], Arity, St0) -> +%% optional_callbacks(Line, FAs, State) -> State. + +optional_callbacks(Line, Term, St0) -> + try true = is_fa_list(Term), Term of + FAs -> + optional_cbs(Line, FAs, St0) + catch + _:_ -> + St0 % ignore others + end. + +optional_cbs(_Line, [], St) -> + St; +optional_cbs(Line, [{F,A}|FAs], St0) -> + #lint{optional_callbacks = OptionalCbs, module = Mod} = St0, + MFA = {Mod, F, A}, + St1 = St0#lint{optional_callbacks = dict:store(MFA, Line, OptionalCbs)}, + St2 = case dict:is_key(MFA, OptionalCbs) of + true -> + add_error(Line, {redefine_optional_callback, {F,A}}, St1); + false -> + St1 + end, + optional_cbs(Line, FAs, St2). + +is_fa_list([E|L]) -> is_fa(E) andalso is_fa_list(L); +is_fa_list([]) -> true; +is_fa_list(_) -> false. + +is_fa({FuncName, Arity}) + when is_atom(FuncName), is_integer(Arity), Arity >= 0 -> true; +is_fa(_) -> false. + +check_specs([FunType|Left], ETag, Arity, St0) -> {FunType1, CTypes} = case FunType of {type, _, bounded_fun, [FT = {type, _, 'fun', _}, Cs]} -> @@ -2833,25 +2965,29 @@ check_specs([FunType|Left], Arity, St0) -> {FT, lists:append(Types0)}; {type, _, 'fun', _} = FT -> {FT, []} end, - SpecArity = - case FunType1 of - {type, L, 'fun', [any, _]} -> any; - {type, L, 'fun', [{type, _, product, D}, _]} -> length(D) - end, + {type, L, 'fun', [{type, _, product, D}, _]} = FunType1, + SpecArity = length(D), St1 = case Arity =:= SpecArity of true -> St0; - false -> add_error(L, spec_wrong_arity, St0) + false -> %% Cannot happen if called from the compiler. + add_error(L, ETag, St0) end, - St2 = check_type({type, -1, product, [FunType1|CTypes]}, St1), - check_specs(Left, Arity, St2); -check_specs([], _Arity, St) -> + St2 = check_type({type, nowarn(), product, [FunType1|CTypes]}, St1), + check_specs(Left, ETag, Arity, St2); +check_specs([], _ETag, _Arity, St) -> St. +nowarn() -> + A0 = erl_anno:new(0), + A1 = erl_anno:set_generated(true, A0), + erl_anno:set_file("", A1). + check_specs_without_function(#lint{module=Mod,defined=Funcs,specs=Specs}=St) -> - Fun = fun({M, F, A} = MFA, Line, AccSt) when M =:= Mod -> - case gb_sets:is_element({F, A}, Funcs) of + Fun = fun({M, F, A}, Line, AccSt) when M =:= Mod -> + FA = {F, A}, + case gb_sets:is_element(FA, Funcs) of true -> AccSt; - false -> add_error(Line, {spec_fun_undefined, MFA}, AccSt) + false -> add_error(Line, {spec_fun_undefined, FA}, AccSt) end; ({_M, _F, _A}, _Line, AccSt) -> AccSt end, @@ -2880,9 +3016,10 @@ add_missing_spec_warnings(Forms, St0, Type) -> [{FA,L} || {function,L,F,A,_} <- Forms, not lists:member(FA = {F,A}, Specs)]; exported -> - Exps = gb_sets:to_list(St0#lint.exports) -- pseudolocals(), + Exps0 = gb_sets:to_list(St0#lint.exports) -- pseudolocals(), + Exps = Exps0 -- Specs, [{FA,L} || {function,L,F,A,_} <- Forms, - member(FA = {F,A}, Exps -- Specs)] + member(FA = {F,A}, Exps)] end, foldl(fun ({FA,L}, St) -> add_warning(L, {missing_spec,FA}, St) @@ -2895,11 +3032,10 @@ check_unused_types(Forms, #lint{usage=Usage, types=Ts, exp_types=ExpTs}=St) -> L = gb_sets:to_list(ExpTs) ++ dict:fetch_keys(D), UsedTypes = gb_sets:from_list(L), FoldFun = - fun(_Type, -1, AccSt) -> - %% Default type - AccSt; - (Type, FileLine, AccSt) -> - case loc(FileLine) of + fun({{record, _}=_Type, 0}, _, AccSt) -> + AccSt; % Before Erlang/OTP 19.0 + (Type, #typeinfo{line = FileLine}, AccSt) -> + case loc(FileLine, AccSt) of {FirstFile, _} -> case gb_sets:is_member(Type, UsedTypes) of true -> AccSt; @@ -2917,12 +3053,28 @@ check_unused_types(Forms, #lint{usage=Usage, types=Ts, exp_types=ExpTs}=St) -> St end. +check_local_opaque_types(St) -> + #lint{types=Ts, exp_types=ExpTs} = St, + FoldFun = + fun(_Type, #typeinfo{attr = type}, AccSt) -> + AccSt; + (Type, #typeinfo{attr = opaque, line = FileLine}, AccSt) -> + case gb_sets:is_element(Type, ExpTs) of + true -> AccSt; + false -> + Warn = {not_exported_opaque,Type}, + add_warning(FileLine, Warn, AccSt) + end + end, + dict:fold(FoldFun, St, Ts). + %% icrt_clauses(Clauses, In, ImportVarTable, State) -> -%% {NewVts,State}. +%% {UpdVt,State}. icrt_clauses(Cs, In, Vt, St0) -> {Csvt,St1} = icrt_clauses(Cs, Vt, St0), - icrt_export(Csvt, Vt, In, St1). + UpdVt = icrt_export(Csvt, Vt, In, St1), + {UpdVt,St1}. %% icrt_clauses(Clauses, ImportVarTable, State) -> %% {NewVts,State}. @@ -2932,24 +3084,73 @@ icrt_clauses(Cs, Vt, St) -> icrt_clause({clause,_Line,H,G,B}, Vt0, St0) -> {Hvt,Binvt,St1} = head(H, Vt0, St0), - Vt1 = vtupdate(Hvt, vtupdate(Binvt, Vt0)), - {Gvt,St2} = guard(G, Vt1, St1), + Vt1 = vtupdate(Hvt, Binvt), + {Gvt,St2} = guard(G, vtupdate(Vt1, Vt0), St1), Vt2 = vtupdate(Gvt, Vt1), - {Bvt,St3} = exprs(B, Vt2, St2), + {Bvt,St3} = exprs(B, vtupdate(Vt2, Vt0), St2), {vtupdate(Bvt, Vt2),St3}. -icrt_export(Csvt, Vt, In, St) -> - Vt1 = vtmerge(Csvt), - All = ordsets:subtract(vintersection(Csvt), vtnames(Vt)), - Some = ordsets:subtract(vtnames(Vt1), vtnames(Vt)), - Xvt = vtexport(All, In, []), - Evt = vtunsafe(ordsets:subtract(Some, All), In, Xvt), - Unused = vtmerge([unused_vars(Vt0, Vt, St) || Vt0 <- Csvt]), - %% Exported and unsafe variables may be unused: - Uvt = vtmerge(Evt, Unused), - %% Make exported and unsafe unused variables unused in subsequent code: - Vt2 = vtmerge(Uvt, vtsubtract(Vt1, Uvt)), - {Vt2,St}. +icrt_export(Vts, Vt, {Tag,Attrs}, St) -> + {_File,Loc} = loc(Attrs, St), + icrt_export(lists:merge(Vts), Vt, {Tag,Loc}, length(Vts), []). + +icrt_export([{V,{{export,_},_,_}}|Vs0], [{V,{{export,_}=S0,_,Ls}}|Vt], + In, I, Acc) -> + %% V was an exported variable and has been used in an expression in at least + %% one clause. Its state needs to be merged from all clauses to silence any + %% exported var warning already emitted. + {VVs,Vs} = lists:partition(fun ({K,_}) -> K =:= V end, Vs0), + S = foldl(fun ({_,{S1,_,_}}, AccS) -> merge_state(AccS, S1) end, S0, VVs), + icrt_export(Vs, Vt, In, I, [{V,{S,used,Ls}}|Acc]); +icrt_export([{V,_}|Vs0], [{V,{_,_,Ls}}|Vt], In, I, Acc) -> + %% V was either unsafe or bound and has now been reused. It may also have + %% been an export but as it was not matched by the previous clause, it means + %% it has been changed to 'bound' in at least one clause because it was used + %% in a pattern. + Vs = lists:dropwhile(fun ({K,_}) -> K =:= V end, Vs0), + icrt_export(Vs, Vt, In, I, [{V,{bound,used,Ls}}|Acc]); +icrt_export([{V1,_}|_]=Vs, [{V2,_}|Vt], In, I, Acc) when V1 > V2 -> + %% V2 was already in scope and has not been reused in any clause. + icrt_export(Vs, Vt, In, I, Acc); +icrt_export([{V,_}|_]=Vs0, Vt, In, I, Acc) -> + %% V is a new variable. + {VVs,Vs} = lists:partition(fun ({K,_}) -> K =:= V end, Vs0), + F = fun ({_,{S,U,Ls}}, {AccI,AccS0,AccLs0}) -> + AccS = case {S,AccS0} of + {{unsafe,_},{unsafe,_}} -> + %% V was found unsafe in a previous clause, mark + %% it as unsafe for the whole parent expression. + {unsafe,In}; + {{unsafe,_},_} -> + %% V was unsafe in a clause, keep that state and + %% generalize it to the whole expression if it + %% is found unsafe in another one. + S; + _ -> + %% V is either bound or exported, keep original + %% state. + AccS0 + end, + AccLs = case U of + used -> AccLs0; + unused -> merge_lines(AccLs0, Ls) + end, + {AccI + 1,AccS,AccLs} + end, + %% Initial state is exported from the current expression. + {Count,S1,Ls} = foldl(F, {0,{export,In},[]}, VVs), + S = case Count of + I -> + %% V was found in all clauses, keep computed state. + S1; + _ -> + %% V was not bound in some clauses, mark as unsafe. + {unsafe,In} + end, + U = case Ls of [] -> used; _ -> unused end, + icrt_export(Vs, Vt, In, I, [{V,{S,U,Ls}}|Acc]); +icrt_export([], _, _, _, Acc) -> + reverse(Acc). handle_comprehension(E, Qs, Vt0, St0) -> {Vt1, Uvt, St1} = lc_quals(Qs, Vt0, St0), @@ -2962,7 +3163,11 @@ handle_comprehension(E, Qs, Vt0, St0) -> %% Local variables that have not been shadowed. {_,St} = check_unused_vars(Vt2, Vt0, St4), Vt3 = vtmerge(vtsubtract(Vt2, Uvt), Uvt), - {Vt3,St}. + %% Don't export local variables. + Vt4 = vtold(Vt3, Vt0), + %% Forget about old variables which were not used. + Vt5 = vt_no_unused(Vt4), + {Vt5,St}. %% lc_quals(Qualifiers, ImportVarTable, State) -> %% {VarTable,ShadowedVarTable,State} @@ -2984,7 +3189,8 @@ lc_quals([{generate,_Line,P,E} | Qs], Vt0, Uvt0, St0) -> {Vt,Uvt,St} = handle_generator(P,E,Vt0,Uvt0,St0), lc_quals(Qs, Vt, Uvt, St); lc_quals([{b_generate,_Line,P,E} | Qs], Vt0, Uvt0, St0) -> - {Vt,Uvt,St} = handle_generator(P,E,Vt0,Uvt0,St0), + St1 = handle_bitstring_gen_pat(P,St0), + {Vt,Uvt,St} = handle_generator(P,E,Vt0,Uvt0,St1), lc_quals(Qs, Vt, Uvt, St); lc_quals([F|Qs], Vt, Uvt, St0) -> {Fvt,St1} = case is_guard_test2(F, St0#lint.records) of @@ -3012,6 +3218,22 @@ handle_generator(P,E,Vt,Uvt,St0) -> Vt3 = vtupdate(vtsubtract(Vt2, Binvt), Binvt), {Vt3,NUvt,St5}. +handle_bitstring_gen_pat({bin,_,Segments=[_|_]},St) -> + case lists:last(Segments) of + {bin_element,Line,{var,_,_},default,Flags} when is_list(Flags) -> + case member(binary, Flags) orelse member(bytes, Flags) + orelse member(bits, Flags) orelse member(bitstring, Flags) of + true -> + add_error(Line, unsized_binary_in_bin_gen_pattern, St); + false -> + St + end; + _ -> + St + end; +handle_bitstring_gen_pat(_,St) -> + St. + %% fun_clauses(Clauses, ImportVarTable, State) -> %% {UsedVars, State}. %% Fun's cannot export any variables. @@ -3026,7 +3248,8 @@ fun_clauses(Cs, Vt, St) -> {Cvt,St1} = fun_clause(C, Vt, St0), {vtmerge(Cvt, Bvt0),St1} end, {[],St#lint{recdef_top = false}}, Cs), - {Bvt,St2#lint{recdef_top = OldRecDef}}. + Uvt = vt_no_unsafe(vt_no_unused(vtold(Bvt, Vt))), + {Uvt,St2#lint{recdef_top = OldRecDef}}. fun_clause({clause,_Line,H,G,B}, Vt0, St0) -> {Hvt,Binvt,St1} = head(H, Vt0, [], St0), % No imported pattern variables @@ -3140,19 +3363,24 @@ pat_binsize_var(V, Line, Vt, Bvt, St) -> %% exported vars are probably safe, warn only if warn_export_vars is %% set. -expr_var(V, Line, Vt, St0) -> +expr_var(V, Line, Vt, St) -> case orddict:find(V, Vt) of {ok,{bound,_Usage,Ls}} -> - {[{V,{bound,used,Ls}}],St0}; + {[{V,{bound,used,Ls}}],St}; {ok,{{unsafe,In},_Usage,Ls}} -> {[{V,{bound,used,Ls}}], - add_error(Line, {unsafe_var,V,In}, St0)}; + add_error(Line, {unsafe_var,V,In}, St)}; {ok,{{export,From},_Usage,Ls}} -> - {[{V,{bound,used,Ls}}], - exported_var(Line, V, From, St0)}; + case is_warn_enabled(export_vars, St) of + true -> + {[{V,{bound,used,Ls}}], + add_warning(Line, {exported_var,V,From}, St)}; + false -> + {[{V,{{export,From},used,Ls}}],St} + end; error -> {[{V,{bound,used,[Line]}}], - add_error(Line, {unbound_var,V}, St0)} + add_error(Line, {unbound_var,V}, St)} end. exported_var(Line, V, From, St) -> @@ -3206,6 +3434,14 @@ warn_unused_vars(U, Vt, St0) -> UVt = map(fun ({V,{State,_,Ls}}) -> {V,{State,used,Ls}} end, U), {vtmerge(Vt, UVt), St1}. + +is_var_bound(V, Vt) -> + case orddict:find(V, Vt) of + {ok,{bound,_Usage,_}} -> true; + _ -> false + end. + + %% vtupdate(UpdVarTable, VarTable) -> VarTable. %% Add the variables in the updated vartable to VarTable. The variables %% will be updated with their property in UpdVarTable. The state of @@ -3216,17 +3452,12 @@ vtupdate(Uvt, Vt0) -> {S, merge_used(U1, U2), merge_lines(L1, L2)} end, Uvt, Vt0). -%% vtexport([Variable], From, VarTable) -> VarTable. -%% vtunsafe([Variable], From, VarTable) -> VarTable. -%% Add the variables to VarTable either as exported from From or as unsafe. - -vtexport(Vs, {InTag,FileLine}, Vt0) -> - {_File,Line} = loc(FileLine), - vtupdate([{V,{{export,{InTag,Line}},unused,[]}} || V <- Vs], Vt0). +%% vtunsafe(From, UpdVarTable, VarTable) -> UnsafeVarTable. +%% Return all new variables in UpdVarTable as unsafe. -vtunsafe(Vs, {InTag,FileLine}, Vt0) -> - {_File,Line} = loc(FileLine), - vtupdate([{V,{{unsafe,{InTag,Line}},unused,[]}} || V <- Vs], Vt0). +vtunsafe({Tag,FileLine}, Uvt, Vt) -> + Line = erl_anno:location(FileLine), + [{V,{{unsafe,{Tag,Line}},U,Ls}} || {V,{_,U,Ls}} <- vtnew(Uvt, Vt)]. %% vtmerge(VarTable, VarTable) -> VarTable. %% Merge two variables tables generating a new vartable. Give priority to @@ -3279,91 +3510,19 @@ vtsubtract(New, Old) -> vtold(New, Old) -> orddict:filter(fun (V, _How) -> orddict:is_key(V, Old) end, New). -vtnames(Vt) -> [ V || {V,_How} <- Vt ]. - vt_no_unsafe(Vt) -> [V || {_,{S,_U,_L}}=V <- Vt, case S of {unsafe,_} -> false; _ -> true end]. -%% vunion(VarTable1, VarTable2) -> [VarName]. -%% vunion([VarTable]) -> [VarName]. -%% vintersection(VarTable1, VarTable2) -> [VarName]. -%% vintersection([VarTable]) -> [VarName]. -%% Union/intersection of names of vars in VarTable. - --ifdef(NOTUSED). -vunion(Vs1, Vs2) -> ordsets:union(vtnames(Vs1), vtnames(Vs2)). - -vunion(Vss) -> foldl(fun (Vs, Uvs) -> - ordsets:union(vtnames(Vs), Uvs) - end, [], Vss). - -vintersection(Vs1, Vs2) -> ordsets:intersection(vtnames(Vs1), vtnames(Vs2)). --endif. - -vintersection([Vs]) -> - vtnames(Vs); %Boundary conditions!!! -vintersection([Vs|Vss]) -> - ordsets:intersection(vtnames(Vs), vintersection(Vss)); -vintersection([]) -> - []. +vt_no_unused(Vt) -> [V || {_,{_,U,_L}}=V <- Vt, U =/= unused]. %% copy_expr(Expr, Line) -> Expr. %% Make a copy of Expr converting all line numbers to Line. -copy_expr(Expr, Line) -> - modify_line(Expr, fun(_L) -> Line end). - -%% modify_line(Form, Fun) -> Form -%% modify_line(Expression, Fun) -> Expression -%% Applies Fun to each line number occurrence. - -modify_line(T, F0) -> - modify_line1(T, F0). - -%% Forms. -modify_line1({function,F,A}, _Mf) -> {function,F,A}; -modify_line1({function,M,F,A}, _Mf) -> {function,M,F,A}; -modify_line1({attribute,L,record,{Name,Fields}}, Mf) -> - {attribute,Mf(L),record,{Name,modify_line1(Fields, Mf)}}; -modify_line1({attribute,L,spec,{Fun,Types}}, Mf) -> - {attribute,Mf(L),spec,{Fun,modify_line1(Types, Mf)}}; -modify_line1({attribute,L,callback,{Fun,Types}}, Mf) -> - {attribute,Mf(L),callback,{Fun,modify_line1(Types, Mf)}}; -modify_line1({attribute,L,type,{TypeName,TypeDef,Args}}, Mf) -> - {attribute,Mf(L),type,{TypeName,modify_line1(TypeDef, Mf), - modify_line1(Args, Mf)}}; -modify_line1({attribute,L,opaque,{TypeName,TypeDef,Args}}, Mf) -> - {attribute,Mf(L),opaque,{TypeName,modify_line1(TypeDef, Mf), - modify_line1(Args, Mf)}}; -modify_line1({attribute,L,Attr,Val}, Mf) -> {attribute,Mf(L),Attr,Val}; -modify_line1({warning,W}, _Mf) -> {warning,W}; -modify_line1({error,W}, _Mf) -> {error,W}; -%% Expressions. -modify_line1({clauses,Cs}, Mf) -> {clauses,modify_line1(Cs, Mf)}; -modify_line1({typed_record_field,Field,Type}, Mf) -> - {typed_record_field,modify_line1(Field, Mf),modify_line1(Type, Mf)}; -modify_line1({Tag,L}, Mf) -> {Tag,Mf(L)}; -modify_line1({Tag,L,E1}, Mf) -> - {Tag,Mf(L),modify_line1(E1, Mf)}; -modify_line1({Tag,L,E1,E2}, Mf) -> - {Tag,Mf(L),modify_line1(E1, Mf),modify_line1(E2, Mf)}; -modify_line1({bin_element,L,E1,E2,TSL}, Mf) -> - {bin_element,Mf(L),modify_line1(E1, Mf),modify_line1(E2, Mf), TSL}; -modify_line1({Tag,L,E1,E2,E3}, Mf) -> - {Tag,Mf(L),modify_line1(E1, Mf),modify_line1(E2, Mf),modify_line1(E3, Mf)}; -modify_line1({Tag,L,E1,E2,E3,E4}, Mf) -> - {Tag,Mf(L), - modify_line1(E1, Mf), - modify_line1(E2, Mf), - modify_line1(E3, Mf), - modify_line1(E4, Mf)}; -modify_line1([H|T], Mf) -> - [modify_line1(H, Mf)|modify_line1(T, Mf)]; -modify_line1([], _Mf) -> []; -modify_line1(E, _Mf) when not is_tuple(E), not is_list(E) -> E. +copy_expr(Expr, Anno) -> + erl_parse:map_anno(fun(_A) -> Anno end, Expr). %% Check a record_info call. We have already checked that it is not %% shadowed by an import. @@ -3405,6 +3564,8 @@ check_qlc_hrl(Line, M, F, As, St) -> %% deprecated_function(Line, ModName, FuncName, [Arg], State) -> State. %% Add warning for calls to deprecated functions. +-dialyzer({no_match, deprecated_function/5}). + deprecated_function(Line, M, F, As, St) -> Arity = length(As), MFA = {M, F, Arity}, @@ -3433,6 +3594,24 @@ deprecated_function(Line, M, F, As, St) -> St end. +-dialyzer({no_match, deprecated_type/5}). + +deprecated_type(L, M, N, As, St) -> + NAs = length(As), + case otp_internal:obsolete_type(M, N, NAs) of + {deprecated, String} when is_list(String) -> + case is_warn_enabled(deprecated_type, St) of + true -> + add_warning(L, {deprecated_type, {M,N,NAs}, String}, St); + false -> + St + end; + {removed, Replacement, Rel} -> + add_warning(L, {removed_type, {M,N,NAs}, Replacement, Rel}, St); + no -> + St + end. + obsolete_guard({call,Line,{atom,Lr,F},As}, St0) -> Arity = length(As), case erl_internal:old_type_test(F, Arity) of @@ -3520,7 +3699,7 @@ check_format_3(Fmt, As) -> _Len -> {warn,1,"wrong number of arguments in format call",[]} end; {error,S} -> - {warn,1,"format string invalid (~s)",[S]} + {warn,1,"format string invalid (~ts)",[S]} end. args_list({cons,_L,_H,T}) -> args_list(T); @@ -3578,8 +3757,18 @@ extract_sequence(4, [$t, $c | Fmt], Need) -> extract_sequence(5, [$c|Fmt], Need); extract_sequence(4, [$t, $s | Fmt], Need) -> extract_sequence(5, [$s|Fmt], Need); +extract_sequence(4, [$t, $p | Fmt], Need) -> + extract_sequence(5, [$p|Fmt], Need); +extract_sequence(4, [$t, $P | Fmt], Need) -> + extract_sequence(5, [$P|Fmt], Need); extract_sequence(4, [$t, C | _Fmt], _Need) -> {error,"invalid control ~t" ++ [C]}; +extract_sequence(4, [$l, $p | Fmt], Need) -> + extract_sequence(5, [$p|Fmt], Need); +extract_sequence(4, [$l, $P | Fmt], Need) -> + extract_sequence(5, [$P|Fmt], Need); +extract_sequence(4, [$l, C | _Fmt], _Need) -> + {error,"invalid control ~l" ++ [C]}; extract_sequence(4, Fmt, Need) -> extract_sequence(5, Fmt, Need); extract_sequence(5, [C|Fmt], Need0) -> @@ -3614,49 +3803,6 @@ control_type($n, Need) -> Need; control_type($i, Need) -> [term|Need]; control_type(_C, _Need) -> error. -%% In syntax trees, module/package names are atoms or lists of atoms. - -package_to_string(A) when is_atom(A) -> atom_to_list(A); -package_to_string(L) when is_list(L) -> packages:concat(L). - -expand_package({atom,L,A} = M, St0) -> - St1 = keyword_warning(L, A, St0), - case dict:find(A, St1#lint.mod_imports) of - {ok, A1} -> - {{atom,L,A1}, St1}; - error -> - Name = atom_to_list(A), - case packages:is_valid(Name) of - true -> - case packages:is_segmented(Name) of - true -> - {M, St1}; - false -> - M1 = packages:concat(St1#lint.package, - Name), - {{atom,L,list_to_atom(M1)}, St1} - end; - false -> - St2 = add_error(L, {bad_module_name, Name}, St1), - {error, St2} - end - end; -expand_package(M, St0) -> - L = element(2, M), - case erl_parse:package_segments(M) of - error -> - {error, St0}; - M1 -> - Name = package_to_string(M1), - case packages:is_valid(Name) of - true -> - {{atom,L,list_to_atom(Name)}, St0}; - false -> - St1 = add_error(L, {bad_module_name, Name}, St0), - {error, St1} - end - end. - %% Prebuild set of local functions (to override auto-import) local_functions(Forms) -> @@ -3676,18 +3822,24 @@ is_imported_from_erlang(ImportSet,{Func,Arity}) -> {ok,erlang} -> true; _ -> false end. -%% Build set of functions where auto-import is explicitly supressed +%% Build set of functions where auto-import is explicitly suppressed auto_import_suppressed(CompileFlags) -> - L0 = [ X || {no_auto_import,X} <- CompileFlags ], - L1 = [ {Y,Z} || {Y,Z} <- lists:flatten(L0), is_atom(Y), is_integer(Z) ], - gb_sets:from_list(L1). -%% Predicate to find out if autoimport is explicitly supressed for a function + case lists:member(no_auto_import, CompileFlags) of + true -> + all; + false -> + L0 = [ X || {no_auto_import,X} <- CompileFlags ], + L1 = [ {Y,Z} || {Y,Z} <- lists:flatten(L0), is_atom(Y), is_integer(Z) ], + gb_sets:from_list(L1) + end. +%% Predicate to find out if autoimport is explicitly suppressed for a function +is_autoimport_suppressed(all,{_Func,_Arity}) -> + true; is_autoimport_suppressed(NoAutoSet,{Func,Arity}) -> gb_sets:is_element({Func,Arity},NoAutoSet). -%% Predicate to find out if a function specific bif-clash supression (old deprecated) is present +%% Predicate to find out if a function specific bif-clash suppression (old deprecated) is present bif_clash_specifically_disabled(St,{F,A}) -> - Nowarn = nowarn_function(nowarn_bif_clash, St#lint.compile), - lists:member({F,A},Nowarn). + lists:member({F,A},St#lint.nowarn_bif_clash). %% Predicate to find out if an autoimported guard_bif is not overriden in some way %% Guard Bif without module name is disallowed if diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 928c10f7f2..d2dd2848b5 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -26,7 +27,7 @@ attribute attr_val function function_clauses function_clause clause_args clause_guard clause_body expr expr_100 expr_150 expr_160 expr_200 expr_300 expr_400 expr_500 -expr_600 expr_700 expr_800 expr_900 +expr_600 expr_700 expr_800 expr_max list tail list_comprehension lc_expr lc_exprs @@ -34,32 +35,33 @@ binary_comprehension tuple %struct record_expr record_tuple record_field record_fields +map_expr map_tuple map_field map_field_assoc map_field_exact map_fields map_key if_expr if_clause if_clauses case_expr cr_clause cr_clauses receive_expr fun_expr fun_clause fun_clauses atom_or_var integer_or_var -try_expr try_catch try_clause try_clauses query_expr +try_expr try_catch try_clause try_clauses function_call argument_list exprs guard atomic strings prefix_op mult_op add_op list_op comp_op -rule rule_clauses rule_clause rule_body binary bin_elements bin_element bit_expr opt_bit_size_expr bit_size_expr opt_bit_type_list bit_type_list bit_type top_type top_type_100 top_types type typed_expr typed_attr_val type_sig type_sigs type_guard type_guards fun_type fun_type_100 binary_type type_spec spec_fun typed_exprs typed_record_fields field_types field_type +map_pair_types map_pair_type bin_base_type bin_unit_type type_200 type_300 type_400 type_500. Terminals char integer float atom string var -'(' ')' ',' '->' ':-' '{' '}' '[' ']' '|' '||' '<-' ';' ':' '#' '.' +'(' ')' ',' '->' '{' '}' '[' ']' '|' '||' '<-' ';' ':' '#' '.' 'after' 'begin' 'case' 'try' 'catch' 'end' 'fun' 'if' 'of' 'receive' 'when' -'andalso' 'orelse' 'query' +'andalso' 'orelse' 'bnot' 'not' '*' '/' 'div' 'rem' 'band' 'and' '+' '-' 'bor' 'bxor' 'bsl' 'bsr' 'or' 'xor' '++' '--' -'==' '/=' '=<' '<' '>=' '>' '=:=' '=/=' '<=' +'==' '/=' '=<' '<' '>=' '>' '=:=' '=/=' '<=' '=>' ':=' '<<' '>>' '!' '=' '::' '..' '...' 'spec' 'callback' % helper @@ -71,7 +73,6 @@ Rootsymbol form. form -> attribute dot : '$1'. form -> function dot : '$1'. -form -> rule dot : '$1'. attribute -> '-' atom attr_val : build_attribute('$2', '$3'). attribute -> '-' atom typed_attr_val : build_typed_attribute('$2','$3'). @@ -84,15 +85,11 @@ type_spec -> '(' spec_fun type_sigs ')' : {'$2', '$3'}. spec_fun -> atom : '$1'. spec_fun -> atom ':' atom : {'$1', '$3'}. -%% The following two are retained only for backwards compatibility; -%% they are not part of the EEP syntax and should be removed. -spec_fun -> atom '/' integer '::' : {'$1', '$3'}. -spec_fun -> atom ':' atom '/' integer '::' : {'$1', '$3', '$5'}. typed_attr_val -> expr ',' typed_record_fields : {typed_record, '$1', '$3'}. typed_attr_val -> expr '::' top_type : {type_def, '$1', '$3'}. -typed_record_fields -> '{' typed_exprs '}' : {tuple, ?line('$1'), '$2'}. +typed_record_fields -> '{' typed_exprs '}' : {tuple, ?anno('$1'), '$2'}. typed_exprs -> typed_expr : ['$1']. typed_exprs -> typed_expr ',' typed_exprs : ['$1'|'$3']. @@ -105,91 +102,98 @@ type_sigs -> type_sig : ['$1']. type_sigs -> type_sig ';' type_sigs : ['$1'|'$3']. type_sig -> fun_type : '$1'. -type_sig -> fun_type 'when' type_guards : {type, ?line('$1'), bounded_fun, +type_sig -> fun_type 'when' type_guards : {type, ?anno('$1'), bounded_fun, ['$1','$3']}. type_guards -> type_guard : ['$1']. type_guards -> type_guard ',' type_guards : ['$1'|'$3']. -type_guard -> atom '(' top_types ')' : {type, ?line('$1'), constraint, +type_guard -> atom '(' top_types ')' : {type, ?anno('$1'), constraint, ['$1', '$3']}. type_guard -> var '::' top_type : build_def('$1', '$3'). top_types -> top_type : ['$1']. top_types -> top_type ',' top_types : ['$1'|'$3']. -top_type -> var '::' top_type_100 : {ann_type, ?line('$1'), ['$1','$3']}. +top_type -> var '::' top_type_100 : {ann_type, ?anno('$1'), ['$1','$3']}. top_type -> top_type_100 : '$1'. top_type_100 -> type_200 : '$1'. top_type_100 -> type_200 '|' top_type_100 : lift_unions('$1','$3'). -type_200 -> type_300 '..' type_300 : {type, ?line('$1'), range, - [skip_paren('$1'), - skip_paren('$3')]}. +type_200 -> type_300 '..' type_300 : {type, ?anno('$1'), range, + ['$1', '$3']}. type_200 -> type_300 : '$1'. -type_300 -> type_300 add_op type_400 : ?mkop2(skip_paren('$1'), - '$2', skip_paren('$3')). +type_300 -> type_300 add_op type_400 : ?mkop2('$1', '$2', '$3'). type_300 -> type_400 : '$1'. -type_400 -> type_400 mult_op type_500 : ?mkop2(skip_paren('$1'), - '$2', skip_paren('$3')). +type_400 -> type_400 mult_op type_500 : ?mkop2('$1', '$2', '$3'). type_400 -> type_500 : '$1'. -type_500 -> prefix_op type : ?mkop1('$1', skip_paren('$2')). +type_500 -> prefix_op type : ?mkop1('$1', '$2'). type_500 -> type : '$1'. -type -> '(' top_type ')' : {paren_type, ?line('$2'), ['$2']}. +type -> '(' top_type ')' : '$2'. type -> var : '$1'. type -> atom : '$1'. type -> atom '(' ')' : build_gen_type('$1'). -type -> atom '(' top_types ')' : {type, ?line('$1'), - normalise('$1'), '$3'}. -type -> atom ':' atom '(' ')' : {remote_type, ?line('$1'), +type -> atom '(' top_types ')' : build_type('$1', '$3'). +type -> atom ':' atom '(' ')' : {remote_type, ?anno('$1'), ['$1', '$3', []]}. -type -> atom ':' atom '(' top_types ')' : {remote_type, ?line('$1'), +type -> atom ':' atom '(' top_types ')' : {remote_type, ?anno('$1'), ['$1', '$3', '$5']}. -type -> '[' ']' : {type, ?line('$1'), nil, []}. -type -> '[' top_type ']' : {type, ?line('$1'), list, ['$2']}. -type -> '[' top_type ',' '...' ']' : {type, ?line('$1'), +type -> '[' ']' : {type, ?anno('$1'), nil, []}. +type -> '[' top_type ']' : {type, ?anno('$1'), list, ['$2']}. +type -> '[' top_type ',' '...' ']' : {type, ?anno('$1'), nonempty_list, ['$2']}. -type -> '{' '}' : {type, ?line('$1'), tuple, []}. -type -> '{' top_types '}' : {type, ?line('$1'), tuple, '$2'}. -type -> '#' atom '{' '}' : {type, ?line('$1'), record, ['$2']}. -type -> '#' atom '{' field_types '}' : {type, ?line('$1'), +type -> '#' '{' '}' : {type, ?anno('$1'), map, []}. +type -> '#' '{' map_pair_types '}' : {type, ?anno('$1'), map, '$3'}. +type -> '{' '}' : {type, ?anno('$1'), tuple, []}. +type -> '{' top_types '}' : {type, ?anno('$1'), tuple, '$2'}. +type -> '#' atom '{' '}' : {type, ?anno('$1'), record, ['$2']}. +type -> '#' atom '{' field_types '}' : {type, ?anno('$1'), record, ['$2'|'$4']}. type -> binary_type : '$1'. type -> integer : '$1'. -type -> 'fun' '(' ')' : {type, ?line('$1'), 'fun', []}. +type -> char : '$1'. +type -> 'fun' '(' ')' : {type, ?anno('$1'), 'fun', []}. type -> 'fun' '(' fun_type_100 ')' : '$3'. fun_type_100 -> '(' '...' ')' '->' top_type - : {type, ?line('$1'), 'fun', - [{type, ?line('$1'), any}, '$5']}. + : {type, ?anno('$1'), 'fun', + [{type, ?anno('$1'), any}, '$5']}. fun_type_100 -> fun_type : '$1'. -fun_type -> '(' ')' '->' top_type : {type, ?line('$1'), 'fun', - [{type, ?line('$1'), product, []}, '$4']}. +fun_type -> '(' ')' '->' top_type : {type, ?anno('$1'), 'fun', + [{type, ?anno('$1'), product, []}, '$4']}. fun_type -> '(' top_types ')' '->' top_type - : {type, ?line('$1'), 'fun', - [{type, ?line('$1'), product, '$2'},'$5']}. + : {type, ?anno('$1'), 'fun', + [{type, ?anno('$1'), product, '$2'},'$5']}. + +map_pair_types -> map_pair_type : ['$1']. +map_pair_types -> map_pair_type ',' map_pair_types : ['$1'|'$3']. + +map_pair_type -> top_type '=>' top_type : {type, ?anno('$2'), + map_field_assoc,['$1','$3']}. +map_pair_type -> top_type ':=' top_type : {type, ?anno('$2'), + map_field_exact,['$1','$3']}. field_types -> field_type : ['$1']. field_types -> field_type ',' field_types : ['$1'|'$3']. -field_type -> atom '::' top_type : {type, ?line('$1'), field_type, +field_type -> atom '::' top_type : {type, ?anno('$1'), field_type, ['$1', '$3']}. -binary_type -> '<<' '>>' : {type, ?line('$1'),binary, - [abstract(0, ?line('$1')), - abstract(0, ?line('$1'))]}. -binary_type -> '<<' bin_base_type '>>' : {type, ?line('$1'),binary, - ['$2', abstract(0, ?line('$1'))]}. -binary_type -> '<<' bin_unit_type '>>' : {type, ?line('$1'),binary, - [abstract(0, ?line('$1')), '$2']}. +binary_type -> '<<' '>>' : {type, ?anno('$1'),binary, + [abstract2(0, ?anno('$1')), + abstract2(0, ?anno('$1'))]}. +binary_type -> '<<' bin_base_type '>>' : {type, ?anno('$1'),binary, + ['$2', abstract2(0, ?anno('$1'))]}. +binary_type -> '<<' bin_unit_type '>>' : {type, ?anno('$1'),binary, + [abstract2(0, ?anno('$1')), '$2']}. binary_type -> '<<' bin_base_type ',' bin_unit_type '>>' - : {type, ?line('$1'), binary, ['$2', '$4']}. + : {type, ?anno('$1'), binary, ['$2', '$4']}. bin_base_type -> var ':' type : build_bin_type(['$1'], '$3'). @@ -205,7 +209,7 @@ function_clauses -> function_clause : ['$1']. function_clauses -> function_clause ';' function_clauses : ['$1'|'$3']. function_clause -> atom clause_args clause_guard clause_body : - {clause,?line('$1'),element(3, '$1'),'$2','$3','$4'}. + {clause,?anno('$1'),element(3, '$1'),'$2','$3','$4'}. clause_args -> argument_list : element(1, '$1'). @@ -216,10 +220,10 @@ clause_guard -> '$empty' : []. clause_body -> '->' exprs: '$2'. -expr -> 'catch' expr : {'catch',?line('$1'),'$2'}. +expr -> 'catch' expr : {'catch',?anno('$1'),'$2'}. expr -> expr_100 : '$1'. -expr_100 -> expr_150 '=' expr_100 : {match,?line('$2'),'$1','$3'}. +expr_100 -> expr_150 '=' expr_100 : {match,?anno('$2'),'$1','$3'}. expr_100 -> expr_150 '!' expr_100 : ?mkop2('$1', '$2', '$3'). expr_100 -> expr_150 : '$1'. @@ -247,21 +251,16 @@ expr_500 -> expr_600 : '$1'. expr_600 -> prefix_op expr_700 : ?mkop1('$1', '$2'). +expr_600 -> map_expr : '$1'. expr_600 -> expr_700 : '$1'. expr_700 -> function_call : '$1'. expr_700 -> record_expr : '$1'. expr_700 -> expr_800 : '$1'. -expr_800 -> expr_900 ':' expr_max : - {remote,?line('$2'),'$1','$3'}. -expr_800 -> expr_900 : '$1'. - -expr_900 -> '.' atom : - {record_field,?line('$1'),{atom,?line('$1'),''},'$2'}. -expr_900 -> expr_900 '.' atom : - {record_field,?line('$2'),'$1','$3'}. -expr_900 -> expr_max : '$1'. +expr_800 -> expr_max ':' expr_max : + {remote,?anno('$2'),'$1','$3'}. +expr_800 -> expr_max : '$1'. expr_max -> var : '$1'. expr_max -> atomic : '$1'. @@ -272,31 +271,30 @@ expr_max -> binary_comprehension : '$1'. expr_max -> tuple : '$1'. %%expr_max -> struct : '$1'. expr_max -> '(' expr ')' : '$2'. -expr_max -> 'begin' exprs 'end' : {block,?line('$1'),'$2'}. +expr_max -> 'begin' exprs 'end' : {block,?anno('$1'),'$2'}. expr_max -> if_expr : '$1'. expr_max -> case_expr : '$1'. expr_max -> receive_expr : '$1'. expr_max -> fun_expr : '$1'. expr_max -> try_expr : '$1'. -expr_max -> query_expr : '$1'. -list -> '[' ']' : {nil,?line('$1')}. -list -> '[' expr tail : {cons,?line('$1'),'$2','$3'}. +list -> '[' ']' : {nil,?anno('$1')}. +list -> '[' expr tail : {cons,?anno('$1'),'$2','$3'}. -tail -> ']' : {nil,?line('$1')}. +tail -> ']' : {nil,?anno('$1')}. tail -> '|' expr ']' : '$2'. -tail -> ',' expr tail : {cons,?line('$2'),'$2','$3'}. +tail -> ',' expr tail : {cons,?anno('$2'),'$2','$3'}. -binary -> '<<' '>>' : {bin,?line('$1'),[]}. -binary -> '<<' bin_elements '>>' : {bin,?line('$1'),'$2'}. +binary -> '<<' '>>' : {bin,?anno('$1'),[]}. +binary -> '<<' bin_elements '>>' : {bin,?anno('$1'),'$2'}. bin_elements -> bin_element : ['$1']. bin_elements -> bin_element ',' bin_elements : ['$1'|'$3']. bin_element -> bit_expr opt_bit_size_expr opt_bit_type_list : - {bin_element,?line('$1'),'$1','$2','$3'}. + {bin_element,?anno('$1'),'$1','$2','$3'}. bit_expr -> prefix_op expr_max : ?mkop1('$1', '$2'). bit_expr -> expr_max : '$1'. @@ -317,22 +315,46 @@ bit_size_expr -> expr_max : '$1'. list_comprehension -> '[' expr '||' lc_exprs ']' : - {lc,?line('$1'),'$2','$4'}. -binary_comprehension -> '<<' binary '||' lc_exprs '>>' : - {bc,?line('$1'),'$2','$4'}. + {lc,?anno('$1'),'$2','$4'}. +binary_comprehension -> '<<' expr_max '||' lc_exprs '>>' : + {bc,?anno('$1'),'$2','$4'}. lc_exprs -> lc_expr : ['$1']. lc_exprs -> lc_expr ',' lc_exprs : ['$1'|'$3']. lc_expr -> expr : '$1'. -lc_expr -> expr '<-' expr : {generate,?line('$2'),'$1','$3'}. -lc_expr -> binary '<=' expr : {b_generate,?line('$2'),'$1','$3'}. +lc_expr -> expr '<-' expr : {generate,?anno('$2'),'$1','$3'}. +lc_expr -> binary '<=' expr : {b_generate,?anno('$2'),'$1','$3'}. -tuple -> '{' '}' : {tuple,?line('$1'),[]}. -tuple -> '{' exprs '}' : {tuple,?line('$1'),'$2'}. +tuple -> '{' '}' : {tuple,?anno('$1'),[]}. +tuple -> '{' exprs '}' : {tuple,?anno('$1'),'$2'}. %%struct -> atom tuple : -%% {struct,?line('$1'),element(3, '$1'),element(3, '$2')}. +%% {struct,?anno('$1'),element(3, '$1'),element(3, '$2')}. + +map_expr -> '#' map_tuple : + {map, ?anno('$1'),'$2'}. +map_expr -> expr_max '#' map_tuple : + {map, ?anno('$2'),'$1','$3'}. +map_expr -> map_expr '#' map_tuple : + {map, ?anno('$2'),'$1','$3'}. + +map_tuple -> '{' '}' : []. +map_tuple -> '{' map_fields '}' : '$2'. + +map_fields -> map_field : ['$1']. +map_fields -> map_field ',' map_fields : ['$1' | '$3']. + +map_field -> map_field_assoc : '$1'. +map_field -> map_field_exact : '$1'. + +map_field_assoc -> map_key '=>' expr : + {map_field_assoc,?anno('$1'),'$1','$3'}. + +map_field_exact -> map_key ':=' expr : + {map_field_exact,?anno('$1'),'$1','$3'}. + +map_key -> expr : '$1'. %% N.B. This is called from expr_700. @@ -340,17 +362,17 @@ tuple -> '{' exprs '}' : {tuple,?line('$1'),'$2'}. %% always atoms for the moment, this might change in the future. record_expr -> '#' atom '.' atom : - {record_index,?line('$1'),element(3, '$2'),'$4'}. + {record_index,?anno('$1'),element(3, '$2'),'$4'}. record_expr -> '#' atom record_tuple : - {record,?line('$1'),element(3, '$2'),'$3'}. + {record,?anno('$1'),element(3, '$2'),'$3'}. record_expr -> expr_max '#' atom '.' atom : - {record_field,?line('$2'),'$1',element(3, '$3'),'$5'}. + {record_field,?anno('$2'),'$1',element(3, '$3'),'$5'}. record_expr -> expr_max '#' atom record_tuple : - {record,?line('$2'),'$1',element(3, '$3'),'$4'}. + {record,?anno('$2'),'$1',element(3, '$3'),'$4'}. record_expr -> record_expr '#' atom '.' atom : - {record_field,?line('$2'),'$1',element(3, '$3'),'$5'}. + {record_field,?anno('$2'),'$1',element(3, '$3'),'$5'}. record_expr -> record_expr '#' atom record_tuple : - {record,?line('$2'),'$1',element(3, '$3'),'$4'}. + {record,?anno('$2'),'$1',element(3, '$3'),'$4'}. record_tuple -> '{' '}' : []. record_tuple -> '{' record_fields '}' : '$2'. @@ -358,47 +380,47 @@ record_tuple -> '{' record_fields '}' : '$2'. record_fields -> record_field : ['$1']. record_fields -> record_field ',' record_fields : ['$1' | '$3']. -record_field -> var '=' expr : {record_field,?line('$1'),'$1','$3'}. -record_field -> atom '=' expr : {record_field,?line('$1'),'$1','$3'}. +record_field -> var '=' expr : {record_field,?anno('$1'),'$1','$3'}. +record_field -> atom '=' expr : {record_field,?anno('$1'),'$1','$3'}. %% N.B. This is called from expr_700. function_call -> expr_800 argument_list : - {call,?line('$1'),'$1',element(1, '$2')}. + {call,?anno('$1'),'$1',element(1, '$2')}. -if_expr -> 'if' if_clauses 'end' : {'if',?line('$1'),'$2'}. +if_expr -> 'if' if_clauses 'end' : {'if',?anno('$1'),'$2'}. if_clauses -> if_clause : ['$1']. if_clauses -> if_clause ';' if_clauses : ['$1' | '$3']. if_clause -> guard clause_body : - {clause,?line(hd(hd('$1'))),[],'$1','$2'}. + {clause,?anno(hd(hd('$1'))),[],'$1','$2'}. case_expr -> 'case' expr 'of' cr_clauses 'end' : - {'case',?line('$1'),'$2','$4'}. + {'case',?anno('$1'),'$2','$4'}. cr_clauses -> cr_clause : ['$1']. cr_clauses -> cr_clause ';' cr_clauses : ['$1' | '$3']. cr_clause -> expr clause_guard clause_body : - {clause,?line('$1'),['$1'],'$2','$3'}. + {clause,?anno('$1'),['$1'],'$2','$3'}. receive_expr -> 'receive' cr_clauses 'end' : - {'receive',?line('$1'),'$2'}. + {'receive',?anno('$1'),'$2'}. receive_expr -> 'receive' 'after' expr clause_body 'end' : - {'receive',?line('$1'),[],'$3','$4'}. + {'receive',?anno('$1'),[],'$3','$4'}. receive_expr -> 'receive' cr_clauses 'after' expr clause_body 'end' : - {'receive',?line('$1'),'$2','$4','$5'}. + {'receive',?anno('$1'),'$2','$4','$5'}. fun_expr -> 'fun' atom '/' integer : - {'fun',?line('$1'),{function,element(3, '$2'),element(3, '$4')}}. + {'fun',?anno('$1'),{function,element(3, '$2'),element(3, '$4')}}. fun_expr -> 'fun' atom_or_var ':' atom_or_var '/' integer_or_var : - {'fun',?line('$1'),{function,'$2','$4','$6'}}. + {'fun',?anno('$1'),{function,'$2','$4','$6'}}. fun_expr -> 'fun' fun_clauses 'end' : - build_fun(?line('$1'), '$2'). + build_fun(?anno('$1'), '$2'). atom_or_var -> atom : '$1'. atom_or_var -> var : '$1'. @@ -410,13 +432,16 @@ fun_clauses -> fun_clause : ['$1']. fun_clauses -> fun_clause ';' fun_clauses : ['$1' | '$3']. fun_clause -> argument_list clause_guard clause_body : - {Args,Pos} = '$1', - {clause,Pos,'fun',Args,'$2','$3'}. + {Args,Anno} = '$1', + {clause,Anno,'fun',Args,'$2','$3'}. + +fun_clause -> var argument_list clause_guard clause_body : + {clause,element(2, '$1'),element(3, '$1'),element(1, '$2'),'$3','$4'}. try_expr -> 'try' exprs 'of' cr_clauses try_catch : - build_try(?line('$1'),'$2','$4','$5'). + build_try(?anno('$1'),'$2','$4','$5'). try_expr -> 'try' exprs try_catch : - build_try(?line('$1'),'$2',[],'$3'). + build_try(?anno('$1'),'$2',[],'$3'). try_catch -> 'catch' try_clauses 'end' : {'$2',[]}. @@ -429,21 +454,18 @@ try_clauses -> try_clause : ['$1']. try_clauses -> try_clause ';' try_clauses : ['$1' | '$3']. try_clause -> expr clause_guard clause_body : - L = ?line('$1'), - {clause,L,[{tuple,L,[{atom,L,throw},'$1',{var,L,'_'}]}],'$2','$3'}. + A = ?anno('$1'), + {clause,A,[{tuple,A,[{atom,A,throw},'$1',{var,A,'_'}]}],'$2','$3'}. try_clause -> atom ':' expr clause_guard clause_body : - L = ?line('$1'), - {clause,L,[{tuple,L,['$1','$3',{var,L,'_'}]}],'$4','$5'}. + A = ?anno('$1'), + {clause,A,[{tuple,A,['$1','$3',{var,A,'_'}]}],'$4','$5'}. try_clause -> var ':' expr clause_guard clause_body : - L = ?line('$1'), - {clause,L,[{tuple,L,['$1','$3',{var,L,'_'}]}],'$4','$5'}. - -query_expr -> 'query' list_comprehension 'end' : - {'query',?line('$1'),'$2'}. + A = ?anno('$1'), + {clause,A,[{tuple,A,['$1','$3',{var,A,'_'}]}],'$4','$5'}. -argument_list -> '(' ')' : {[],?line('$1')}. -argument_list -> '(' exprs ')' : {'$2',?line('$1')}. +argument_list -> '(' ')' : {[],?anno('$1')}. +argument_list -> '(' exprs ')' : {'$2',?anno('$1')}. exprs -> expr : ['$1']. @@ -460,7 +482,7 @@ atomic -> strings : '$1'. strings -> string : '$1'. strings -> string strings : - {string,?line('$1'),element(3, '$1') ++ element(3, '$2')}. + {string,?anno('$1'),element(3, '$1') ++ element(3, '$2')}. prefix_op -> '+' : '$1'. prefix_op -> '-' : '$1'. @@ -495,56 +517,460 @@ comp_op -> '>' : '$1'. comp_op -> '=:=' : '$1'. comp_op -> '=/=' : '$1'. -rule -> rule_clauses : build_rule('$1'). - -rule_clauses -> rule_clause : ['$1']. -rule_clauses -> rule_clause ';' rule_clauses : ['$1'|'$3']. - -rule_clause -> atom clause_args clause_guard rule_body : - {clause,?line('$1'),element(3, '$1'),'$2','$3','$4'}. - -rule_body -> ':-' lc_exprs: '$2'. - - Erlang code. -export([parse_form/1,parse_exprs/1,parse_term/1]). -export([normalise/1,abstract/1,tokens/1,tokens/2]). --export([abstract/2, package_segments/1]). +-export([abstract/2]). -export([inop_prec/1,preop_prec/1,func_prec/0,max_prec/0]). --export([set_line/2,get_attribute/2,get_attributes/1]). +-export([type_inop_prec/1,type_preop_prec/1]). +-export([map_anno/2, fold_anno/3, mapfold_anno/3, + new_anno/1, anno_to_term/1, anno_from_term/1]). %% The following directive is needed for (significantly) faster compilation %% of the generated .erl file by the HiPE compiler. Please do not remove. -compile([{hipe,[{regalloc,linear_scan}]}]). -export_type([abstract_clause/0, abstract_expr/0, abstract_form/0, - error_info/0]). + abstract_type/0, form_info/0, error_info/0]). + +%% Start of Abstract Format + +-type anno() :: erl_anno:anno(). + +-type abstract_form() :: af_module() + | af_behavior() + | af_behaviour() + | af_export() + | af_import() + | af_export_type() + | af_compile() + | af_file() + | af_record_decl() + | af_type_decl() + | af_function_spec() + | af_wild_attribute() + | af_function_decl(). + +-type af_module() :: {'attribute', anno(), 'module', module()}. + +-type af_behavior() :: {'attribute', anno(), 'behavior', behaviour()}. + +-type af_behaviour() :: {'attribute', anno(), 'behaviour', behaviour()}. + +-type behaviour() :: atom(). + +-type af_export() :: {'attribute', anno(), 'export', af_fa_list()}. + +-type af_import() :: {'attribute', anno(), 'import', af_fa_list()}. + +-type af_fa_list() :: [{function_name(), arity()}]. + +-type af_export_type() :: {'attribute', anno(), 'export_type', af_ta_list()}. + +-type af_ta_list() :: [{type_name(), arity()}]. + +-type af_compile() :: {'attribute', anno(), 'compile', any()}. + +-type af_file() :: {'attribute', anno(), 'file', {string(), anno()}}. + +-type af_record_decl() :: + {'attribute', anno(), 'record', {record_name(), [af_field_decl()]}}. + +-type af_field_decl() :: af_typed_field() | af_field(). + +-type af_typed_field() :: + {'typed_record_field', af_field(), abstract_type()}. + +-type af_field() :: {'record_field', anno(), af_field_name()} + | {'record_field', anno(), af_field_name(), abstract_expr()}. + +-type af_type_decl() :: {'attribute', anno(), type_attr(), + {type_name(), abstract_type(), [af_variable()]}}. + +-type type_attr() :: 'opaque' | 'type'. + +-type af_function_spec() :: {'attribute', anno(), spec_attr(), + {{function_name(), arity()}, + af_function_type_list()}} + | {'attribute', anno(), 'spec', + {{module(), function_name(), arity()}, + af_function_type_list()}}. + +-type spec_attr() :: 'callback' | 'spec'. + +-type af_wild_attribute() :: {'attribute', anno(), atom(), any()}. + +-type af_function_decl() :: + {'function', anno(), function_name(), 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_creation(abstract_expr()) + | af_record_update(abstract_expr()) + | af_record_index() + | af_record_field_access(abstract_expr()) + | af_map_creation(abstract_expr()) + | af_map_update(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_named_fun(). + +-type af_record_update(T) :: {'record', + anno(), + abstract_expr(), + record_name(), + [af_record_field(T)]}. + +-type af_catch() :: {'catch', anno(), abstract_expr()}. + +-type af_local_call() :: {'call', anno(), af_local_function(), af_args()}. + +-type af_remote_call() :: {'call', anno(), af_remote_function(), af_args()}. + +-type af_args() :: [abstract_expr()]. + +-type af_local_function() :: abstract_expr(). + +-type af_remote_function() :: + {'remote', anno(), abstract_expr(), abstract_expr()}. + +-type af_list_comprehension() :: + {'lc', anno(), af_template(), af_qualifier_seq()}. + +-type af_binary_comprehension() :: + {'bc', anno(), 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', anno(), af_pattern(), abstract_expr()} + | {'b_generate', anno(), af_pattern(), abstract_expr()}. + +-type af_filter() :: abstract_expr(). + +-type af_block() :: {'block', anno(), af_body()}. + +-type af_if() :: {'if', anno(), af_clause_seq()}. + +-type af_case() :: {'case', anno(), abstract_expr(), af_clause_seq()}. + +-type af_try() :: {'try', + anno(), + af_body() | [], + af_clause_seq() | [], + af_clause_seq() | [], + af_body() | []}. + +-type af_clause_seq() :: [af_clause(), ...]. + +-type af_receive() :: + {'receive', anno(), af_clause_seq()} + | {'receive', anno(), af_clause_seq(), abstract_expr(), af_body()}. + +-type af_local_fun() :: + {'fun', anno(), {'function', function_name(), arity()}}. + +-type af_remote_fun() :: + {'fun', anno(), {'function', module(), function_name(), arity()}} + | {'fun', anno(), {'function', af_atom(), af_atom(), af_integer()}}. + +-type af_fun() :: {'fun', anno(), {'clauses', af_clause_seq()}}. + +-type af_named_fun() :: {'named_fun', anno(), fun_name(), af_clause_seq()}. + +-type fun_name() :: atom(). + +-type abstract_clause() :: af_clause(). + +-type af_clause() :: + {'clause', anno(), [af_pattern()], af_guard_seq(), af_body()}. + +-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_creation(af_guard_test()) + | af_record_index() + | af_record_field_access(af_guard_test()) + | af_map_creation(abstract_expr()) + | af_map_update(abstract_expr()) + | af_guard_call() + | af_remote_guard_call(). + +-type af_record_field_access(T) :: + {'record_field', anno(), T, record_name(), af_field_name()}. + +-type af_map_creation(T) :: {'map', anno(), [af_assoc(T)]}. + +-type af_map_update(T) :: {'map', anno(), T, [af_assoc(T)]}. + +-type af_assoc(T) :: {'map_field_assoc', anno(), T, T} + | af_assoc_exact(T). + +-type af_assoc_exact(T) :: {'map_field_exact', anno(), T, T}. + +-type af_guard_call() :: {'call', anno(), function_name(), [af_guard_test()]}. + +-type af_remote_guard_call() :: + {'call', anno(), + {'remote', anno(), af_lit_atom('erlang'), af_atom()}, + [af_guard_test()]}. + +-type af_pattern() :: af_literal() + | af_match(af_pattern()) + | af_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_creation(af_pattern()) + | af_record_index() + | af_map_pattern(). + +-type af_record_index() :: + {'record_index', anno(), record_name(), af_field_name()}. + +-type af_record_creation(T) :: + {'record', anno(), record_name(), [af_record_field(T)]}. + +-type af_record_field(T) :: {'record_field', anno(), af_field_name(), T}. + +-type af_map_pattern() :: + {'map', anno(), [af_assoc_exact(abstract_expr)]}. + +-type abstract_type() :: af_annotated_type() + | af_atom() + | af_bitstring_type() + | af_empty_list_type() + | af_fun_type() + | af_integer_range_type() + | af_map_type() + | af_predefined_type() + | af_record_type() + | af_remote_type() + | af_singleton_integer_type() + | af_tuple_type() + | af_type_union() + | af_type_variable() + | af_user_defined_type(). --type abstract_clause() :: term(). --type abstract_expr() :: term(). --type abstract_form() :: term(). +-type af_annotated_type() :: + {'ann_type', anno(), [af_anno() | abstract_type()]}. % [Var, Type] + +-type af_anno() :: af_variable(). + +-type af_bitstring_type() :: + {'type', anno(), 'binary', [af_singleton_integer_type()]}. + +-type af_empty_list_type() :: {'type', anno(), 'nil', []}. + +-type af_fun_type() :: {'type', anno(), 'fun', []} + | {'type', anno(), 'fun', [{'type', anno(), 'any'} | + abstract_type()]} + | {'type', anno(), 'fun', af_function_type()}. + +-type af_integer_range_type() :: + {'type', anno(), 'range', [af_singleton_integer_type()]}. + +-type af_map_type() :: {'type', anno(), 'map', 'any'} + | {'type', anno(), 'map', [af_assoc_type()]}. + +-type af_assoc_type() :: + {'type', anno(), 'map_field_assoc', [abstract_type()]} + | {'type', anno(), 'map_field_exact', [abstract_type()]}. + +-type af_predefined_type() :: + {'type', anno(), type_name(), [abstract_type()]}. + +-type af_record_type() :: + {'type', anno(), 'record', [(Name :: af_atom()) % [Name, T1, ... Tk] + | af_record_field_type()]}. + +-type af_record_field_type() :: + {'type', anno(), 'field_type', [(Name :: af_atom()) | + abstract_type()]}. % [Name, Type] + +-type af_remote_type() :: + {'remote_type', anno(), [(Module :: af_atom()) | + (TypeName :: af_atom()) | + [abstract_type()]]}. % [Module, Name, [T]] + +-type af_tuple_type() :: {'type', anno(), 'tuple', 'any'} + | {'type', anno(), 'tuple', [abstract_type()]}. + +-type af_type_union() :: {'type', anno(), 'union', [abstract_type()]}. + +-type af_type_variable() :: {'var', anno(), atom()}. % except '_' + +-type af_user_defined_type() :: + {'user_type', anno(), type_name(), [abstract_type()]}. + +-type af_function_type_list() :: [af_constrained_function_type() | + af_function_type()]. + +-type af_constrained_function_type() :: + {'type', anno(), 'bounded_fun', [af_function_type() | % [Ft, Fc] + af_function_constraint()]}. + +-type af_function_type() :: + {'type', anno(), 'fun', + [{'type', anno(), 'product', [abstract_type()]} | abstract_type()]}. + +-type af_function_constraint() :: [af_constraint()]. + +-type af_constraint() :: {'type', anno(), 'constraint', + af_lit_atom('is_subtype'), + [af_type_variable() | abstract_type()]}. % [V, T] + +-type af_singleton_integer_type() :: af_integer() + | af_unary_op(af_singleton_integer_type()) + | af_binary_op(af_singleton_integer_type()). + +-type af_literal() :: af_atom() + | af_character() + | af_float() + | af_integer() + | af_string(). + +-type af_atom() :: af_lit_atom(atom()). + +-type af_lit_atom(A) :: {'atom', anno(), A}. + +-type af_character() :: {'char', anno(), char()}. + +-type af_float() :: {'float', anno(), float()}. + +-type af_integer() :: {'integer', anno(), non_neg_integer()}. + +-type af_string() :: {'string', anno(), string()}. + +-type af_match(T) :: {'match', anno(), af_pattern(), T}. + +-type af_variable() :: {'var', anno(), atom()}. % | af_anon_variable() + +%-type af_anon_variable() :: {'var', anno(), '_'}. + +-type af_tuple(T) :: {'tuple', anno(), [T]}. + +-type af_nil() :: {'nil', anno()}. + +-type af_cons(T) :: {'cons', anno(), T, T}. + +-type af_bin(T) :: {'bin', anno(), [af_binelement(T)]}. + +-type af_binelement(T) :: {'bin_element', + anno(), + T, + af_binelement_size(), + type_specifier_list()}. + +-type af_binelement_size() :: 'default' | abstract_expr(). + +-type af_binary_op(T) :: {'op', anno(), binary_op(), T, T}. + +-type binary_op() :: '/' | '*' | 'div' | 'rem' | 'band' | 'and' | '+' | '-' + | 'bor' | 'bxor' | 'bsl' | 'bsr' | 'or' | 'xor' | '++' + | '--' | '==' | '/=' | '=<' | '<' | '>=' | '>' | '=:=' + | '=/='. + +-type af_unary_op(T) :: {'op', anno(), unary_op(), T}. + +-type unary_op() :: '+' | '*' | 'bnot' | 'not'. + +%% See also lib/stdlib/{src/erl_bits.erl,include/erl_bits.hrl}. +-type type_specifier_list() :: 'default' | [type_specifier(), ...]. + +-type type_specifier() :: type() + | signedness() + | endianness() + | unit(). + +-type type() :: 'integer' + | 'float' + | 'binary' + | 'bytes' + | 'bitstring' + | 'bits' + | 'utf8' + | 'utf16' + | 'utf32'. + +-type signedness() :: 'signed' | 'unsigned'. + +-type endianness() :: 'big' | 'little' | 'native'. + +-type unit() :: {'unit', 1..256}. + +-type record_name() :: atom(). + +-type af_field_name() :: af_atom(). + +-type function_name() :: atom(). + +-type type_name() :: atom(). + +-type form_info() :: {'eof', erl_anno:line()} + | {'error', erl_scan:error_info() | error_info()} + | {'warning', erl_scan:error_info() | error_info()}. + +%% End of Abstract Format + +%% XXX. To be refined. -type error_description() :: term(). --type error_info() :: {erl_scan:line(), module(), error_description()}. --type token() :: {Tag :: atom(), Line :: erl_scan:line()}. +-type error_info() :: {erl_anno:line(), module(), error_description()}. +-type token() :: erl_scan:token(). -%% mkop(Op, Arg) -> {op,Line,Op,Arg}. -%% mkop(Left, Op, Right) -> {op,Line,Op,Left,Right}. +%% mkop(Op, Arg) -> {op,Anno,Op,Arg}. +%% mkop(Left, Op, Right) -> {op,Anno,Op,Left,Right}. --define(mkop2(L, OpPos, R), +-define(mkop2(L, OpAnno, R), begin - {Op,Pos} = OpPos, - {op,Pos,Op,L,R} + {Op,Anno} = OpAnno, + {op,Anno,Op,L,R} end). --define(mkop1(OpPos, A), +-define(mkop1(OpAnno, A), begin - {Op,Pos} = OpPos, - {op,Pos,Op,A} + {Op,Anno} = OpAnno, + {op,Anno,Op,A} end). -%% keep track of line info in tokens --define(line(Tup), element(2, Tup)). +%% keep track of annotation info in tokens +-define(anno(Tup), element(2, Tup)). %% Entry points compatible to old erl_parse. %% These really suck and are only here until Calle gets multiple @@ -554,10 +980,10 @@ Erlang code. 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([{'-',A1},{atom,A2,spec}|Tokens]) -> + parse([{'-',A1},{'spec',A2}|Tokens]); +parse_form([{'-',A1},{atom,A2,callback}|Tokens]) -> + parse([{'-',A1},{'callback',A2}|Tokens]); parse_form(Tokens) -> parse(Tokens). @@ -566,7 +992,8 @@ parse_form(Tokens) -> ExprList :: [abstract_expr()], ErrorInfo :: error_info(). parse_exprs(Tokens) -> - case parse([{atom,0,f},{'(',0},{')',0},{'->',0}|Tokens]) of + A = erl_anno:new(0), + case parse([{atom,A,f},{'(',A},{')',A},{'->',A}|Tokens]) of {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],Exprs}]}} -> {ok,Exprs}; {error,_} = Err -> Err @@ -577,57 +1004,52 @@ parse_exprs(Tokens) -> 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]}]}} -> + A = erl_anno:new(0), + case parse([{atom,A,f},{'(',A},{')',A},{'->',A}|Tokens]) of + {ok,{function,_Af,f,0,[{clause,_Ac,[],[],[Expr]}]}} -> try normalise(Expr) of Term -> {ok,Term} catch - _:_R -> {error,{?line(Expr),?MODULE,"bad term"}} + _:_R -> {error,{location(?anno(Expr)),?MODULE,"bad term"}} end; - {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],[_E1,E2|_Es]}]}} -> - {error,{?line(E2),?MODULE,"bad term"}}; + {ok,{function,_Af,f,A,[{clause,_Ac,[],[],[_E1,E2|_Es]}]}} -> + {error,{location(?anno(E2)),?MODULE,"bad term"}}; {error,_} = Err -> Err end. -type attributes() :: 'export' | 'file' | 'import' | 'module' | 'opaque' | 'record' | 'type'. -build_typed_attribute({atom,La,record}, - {typed_record, {atom,_Ln,RecordName}, RecTuple}) -> - {attribute,La,record,{RecordName,record_tuple(RecTuple)}}; -build_typed_attribute({atom,La,Attr}, +build_typed_attribute({atom,Aa,record}, + {typed_record, {atom,_An,RecordName}, RecTuple}) -> + {attribute,Aa,record,{RecordName,record_tuple(RecTuple)}}; +build_typed_attribute({atom,Aa,Attr}, {type_def, {call,_,{atom,_,TypeName},Args}, Type}) when Attr =:= 'type' ; Attr =:= 'opaque' -> case lists:all(fun({var, _, _}) -> true; (_) -> false end, Args) of - true -> {attribute,La,Attr,{TypeName,Type,Args}}; - false -> error_bad_decl(La, Attr) + true -> {attribute,Aa,Attr,{TypeName,Type,Args}}; + false -> error_bad_decl(Aa, Attr) end; -build_typed_attribute({atom,La,Attr},_) -> +build_typed_attribute({atom,Aa,Attr},_) -> case Attr of - record -> error_bad_decl(La, record); - type -> error_bad_decl(La, type); - opaque -> error_bad_decl(La, opaque); - _ -> ret_err(La, "bad attribute") + record -> error_bad_decl(Aa, record); + type -> error_bad_decl(Aa, type); + opaque -> error_bad_decl(Aa, opaque); + _ -> ret_err(Aa, "bad attribute") end. -build_type_spec({Kind,La}, {SpecFun, TypeSpecs}) +build_type_spec({Kind,Aa}, {SpecFun, TypeSpecs}) when (Kind =:= spec) or (Kind =:= callback) -> NewSpecFun = case SpecFun of {atom, _, Fun} -> {Fun, find_arity_from_specs(TypeSpecs)}; {{atom,_, Mod}, {atom,_, Fun}} -> - {Mod,Fun,find_arity_from_specs(TypeSpecs)}; - {{atom, _, Fun}, {integer, _, Arity}} -> - %% Old style spec. Allow this for now. - {Fun,Arity}; - {{atom,_, Mod}, {atom, _, Fun}, {integer, _, Arity}} -> - %% Old style spec. Allow this for now. - {Mod,Fun,Arity} - end, - {attribute,La,Kind,{NewSpecFun, TypeSpecs}}. + {Mod,Fun,find_arity_from_specs(TypeSpecs)} + end, + {attribute,Aa,Kind,{NewSpecFun, TypeSpecs}}. find_arity_from_specs([Spec|_]) -> %% Use the first spec to find the arity. If all are not the same, @@ -639,244 +1061,189 @@ find_arity_from_specs([Spec|_]) -> {type, _, 'fun', [{type, _, product, Args},_]} = Fun, length(Args). +build_def({var, A, '_'}, _Types) -> + ret_err(A, "bad type variable"); build_def(LHS, Types) -> - IsSubType = {atom, ?line(LHS), is_subtype}, - {type, ?line(LHS), constraint, [IsSubType, [LHS, Types]]}. + IsSubType = {atom, ?anno(LHS), is_subtype}, + {type, ?anno(LHS), constraint, [IsSubType, [LHS, Types]]}. -lift_unions(T1, {type, _La, union, List}) -> - {type, ?line(T1), union, [T1|List]}; +lift_unions(T1, {type, _Aa, union, List}) -> + {type, ?anno(T1), union, [T1|List]}; lift_unions(T1, T2) -> - {type, ?line(T1), union, [T1, T2]}. - -skip_paren({paren_type,_L,[Type]}) -> - skip_paren(Type); -skip_paren(Type) -> - Type. + {type, ?anno(T1), union, [T1, T2]}. -build_gen_type({atom, La, tuple}) -> - {type, La, tuple, any}; -build_gen_type({atom, La, Name}) -> - {type, La, Name, []}. +build_gen_type({atom, Aa, tuple}) -> + {type, Aa, tuple, any}; +build_gen_type({atom, Aa, map}) -> + {type, Aa, map, any}; +build_gen_type({atom, Aa, Name}) -> + Tag = type_tag(Name, 0), + {Tag, Aa, Name, []}. build_bin_type([{var, _, '_'}|Left], Int) -> build_bin_type(Left, Int); build_bin_type([], Int) -> - skip_paren(Int); -build_bin_type([{var, La, _}|_], _) -> - ret_err(La, "Bad binary type"). + Int; +build_bin_type([{var, Aa, _}|_], _) -> + ret_err(Aa, "Bad binary type"). + +build_type({atom, A, Name}, Types) -> + Tag = type_tag(Name, length(Types)), + {Tag, A, Name, Types}. + +type_tag(TypeName, NumberOfTypeVariables) -> + case erl_internal:is_type(TypeName, NumberOfTypeVariables) of + true -> type; + false -> user_type + end. + +abstract2(Term, Anno) -> + Line = erl_anno:line(Anno), + abstract(Term, Line). %% build_attribute(AttrName, AttrValue) -> -%% {attribute,Line,module,Module} -%% {attribute,Line,export,Exports} -%% {attribute,Line,import,Imports} -%% {attribute,Line,record,{Name,Inits}} -%% {attribute,Line,file,{Name,Line}} -%% {attribute,Line,Name,Val} - -build_attribute({atom,La,module}, Val) -> +%% {attribute,Anno,module,Module} +%% {attribute,Anno,export,Exports} +%% {attribute,Anno,import,Imports} +%% {attribute,Anno,record,{Name,Inits}} +%% {attribute,Anno,file,{Name,Line}} +%% {attribute,Anno,Name,Val} + +build_attribute({atom,Aa,module}, Val) -> case Val of - [{atom,_Lm,Module}] -> - {attribute,La,module,Module}; - [{atom,_Lm,Module},ExpList] -> - {attribute,La,module,{Module,var_list(ExpList)}}; - [Name] -> - case package_segments(Name) of - error -> - error_bad_decl(La, module); - Module -> - {attribute,La,module,Module} - end; - [Name,ExpList] -> - case package_segments(Name) of - error -> - error_bad_decl(La, module); - Module -> - {attribute,La,module,{Module,var_list(ExpList)}} - end; + [{atom,_Am,Module}] -> + {attribute,Aa,module,Module}; + [{atom,_Am,Module},ExpList] -> + {attribute,Aa,module,{Module,var_list(ExpList)}}; _Other -> - error_bad_decl(La, module) + error_bad_decl(Aa, module) end; -build_attribute({atom,La,export}, Val) -> +build_attribute({atom,Aa,export}, Val) -> case Val of [ExpList] -> - {attribute,La,export,farity_list(ExpList)}; - _Other -> error_bad_decl(La, export) + {attribute,Aa,export,farity_list(ExpList)}; + _Other -> error_bad_decl(Aa, export) end; -build_attribute({atom,La,import}, Val) -> +build_attribute({atom,Aa,import}, Val) -> case Val of - [Name] -> - case package_segments(Name) of - error -> - error_bad_decl(La, import); - Module -> - {attribute,La,import,Module} - end; - [{atom,_Lm,Mod},ImpList] -> - {attribute,La,import,{Mod,farity_list(ImpList)}}; - [Name, ImpList] -> - case package_segments(Name) of - error -> - error_bad_decl(La, import); - Module -> - {attribute,La,import,{Module,farity_list(ImpList)}} - end; - _Other -> error_bad_decl(La, import) + [{atom,_Am,Mod},ImpList] -> + {attribute,Aa,import,{Mod,farity_list(ImpList)}}; + _Other -> error_bad_decl(Aa, import) end; -build_attribute({atom,La,record}, Val) -> +build_attribute({atom,Aa,record}, Val) -> case Val of - [{atom,_Ln,Record},RecTuple] -> - {attribute,La,record,{Record,record_tuple(RecTuple)}}; - _Other -> error_bad_decl(La, record) + [{atom,_An,Record},RecTuple] -> + {attribute,Aa,record,{Record,record_tuple(RecTuple)}}; + _Other -> error_bad_decl(Aa, record) end; -build_attribute({atom,La,file}, Val) -> +build_attribute({atom,Aa,file}, Val) -> case Val of - [{string,_Ln,Name},{integer,_Ll,Line}] -> - {attribute,La,file,{Name,Line}}; - _Other -> error_bad_decl(La, file) + [{string,_An,Name},{integer,_Al,Line}] -> + {attribute,Aa,file,{Name,Line}}; + _Other -> error_bad_decl(Aa, file) end; -build_attribute({atom,La,Attr}, Val) -> +build_attribute({atom,Aa,Attr}, Val) -> case Val of [Expr0] -> Expr = attribute_farity(Expr0), - {attribute,La,Attr,term(Expr)}; - _Other -> ret_err(La, "bad attribute") + {attribute,Aa,Attr,term(Expr)}; + _Other -> ret_err(Aa, "bad attribute") end. -var_list({cons,_Lc,{var,_,V},Tail}) -> +var_list({cons,_Ac,{var,_,V},Tail}) -> [V|var_list(Tail)]; -var_list({nil,_Ln}) -> []; +var_list({nil,_An}) -> []; var_list(Other) -> - ret_err(?line(Other), "bad variable list"). + ret_err(?anno(Other), "bad variable list"). -attribute_farity({cons,L,H,T}) -> - {cons,L,attribute_farity(H),attribute_farity(T)}; -attribute_farity({tuple,L,Args0}) -> +attribute_farity({cons,A,H,T}) -> + {cons,A,attribute_farity(H),attribute_farity(T)}; +attribute_farity({tuple,A,Args0}) -> Args = attribute_farity_list(Args0), - {tuple,L,Args}; -attribute_farity({op,L,'/',{atom,_,_}=Name,{integer,_,_}=Arity}) -> - {tuple,L,[Name,Arity]}; + {tuple,A,Args}; +attribute_farity({map,A,Args0}) -> + Args = attribute_farity_map(Args0), + {map,A,Args}; +attribute_farity({op,A,'/',{atom,_,_}=Name,{integer,_,_}=Arity}) -> + {tuple,A,[Name,Arity]}; attribute_farity(Other) -> Other. attribute_farity_list(Args) -> [attribute_farity(A) || A <- Args]. --spec error_bad_decl(integer(), attributes()) -> no_return(). +%% It is not meaningful to have farity keys. +attribute_farity_map(Args) -> + [{Op,A,K,attribute_farity(V)} || {Op,A,K,V} <- Args]. -error_bad_decl(L, S) -> - ret_err(L, io_lib:format("bad ~w declaration", [S])). +-spec error_bad_decl(erl_anno:anno(), attributes()) -> no_return(). -farity_list({cons,_Lc,{op,_Lo,'/',{atom,_La,A},{integer,_Li,I}},Tail}) -> +error_bad_decl(Anno, S) -> + ret_err(Anno, io_lib:format("bad ~w declaration", [S])). + +farity_list({cons,_Ac,{op,_Ao,'/',{atom,_Aa,A},{integer,_Ai,I}},Tail}) -> [{A,I}|farity_list(Tail)]; -farity_list({nil,_Ln}) -> []; +farity_list({nil,_An}) -> []; farity_list(Other) -> - ret_err(?line(Other), "bad function arity"). + ret_err(?anno(Other), "bad function arity"). -record_tuple({tuple,_Lt,Fields}) -> +record_tuple({tuple,_At,Fields}) -> record_fields(Fields); record_tuple(Other) -> - ret_err(?line(Other), "bad record declaration"). + ret_err(?anno(Other), "bad record declaration"). -record_fields([{atom,La,A}|Fields]) -> - [{record_field,La,{atom,La,A}}|record_fields(Fields)]; -record_fields([{match,_Lm,{atom,La,A},Expr}|Fields]) -> - [{record_field,La,{atom,La,A},Expr}|record_fields(Fields)]; +record_fields([{atom,Aa,A}|Fields]) -> + [{record_field,Aa,{atom,Aa,A}}|record_fields(Fields)]; +record_fields([{match,_Am,{atom,Aa,A},Expr}|Fields]) -> + [{record_field,Aa,{atom,Aa,A},Expr}|record_fields(Fields)]; record_fields([{typed,Expr,TypeInfo}|Fields]) -> [Field] = record_fields([Expr]), - TypeInfo1 = - case Expr of - {match, _, _, _} -> TypeInfo; %% If we have an initializer. - {atom, La, _} -> - case has_undefined(TypeInfo) of - false -> - TypeInfo2 = maybe_add_paren(TypeInfo), - lift_unions(abstract(undefined, La), TypeInfo2); - true -> - TypeInfo - end - end, - [{typed_record_field,Field,TypeInfo1}|record_fields(Fields)]; + [{typed_record_field,Field,TypeInfo}|record_fields(Fields)]; record_fields([Other|_Fields]) -> - ret_err(?line(Other), "bad record field"); + ret_err(?anno(Other), "bad record field"); record_fields([]) -> []. -has_undefined({atom,_,undefined}) -> - true; -has_undefined({ann_type,_,[_,T]}) -> - has_undefined(T); -has_undefined({paren_type,_,[T]}) -> - has_undefined(T); -has_undefined({type,_,union,Ts}) -> - lists:any(fun has_undefined/1, Ts); -has_undefined(_) -> - false. - -maybe_add_paren({ann_type,L,T}) -> - {paren_type,L,[{ann_type,L,T}]}; -maybe_add_paren(T) -> - T. - term(Expr) -> try normalise(Expr) - catch _:_R -> ret_err(?line(Expr), "bad attribute") + catch _:_R -> ret_err(?anno(Expr), "bad attribute") end. -package_segments(Name) -> - package_segments(Name, [], []). - -package_segments({record_field, _, F1, F2}, Fs, As) -> - package_segments(F1, [F2 | Fs], As); -package_segments({atom, _, A}, [F | Fs], As) -> - package_segments(F, Fs, [A | As]); -package_segments({atom, _, A}, [], As) -> - lists:reverse([A | As]); -package_segments(_, _, _) -> - error. - -%% build_function([Clause]) -> {function,Line,Name,Arity,[Clause]} +%% build_function([Clause]) -> {function,Anno,Name,Arity,[Clause]} build_function(Cs) -> Name = element(3, hd(Cs)), Arity = length(element(4, hd(Cs))), - {function,?line(hd(Cs)),Name,Arity,check_clauses(Cs, Name, Arity)}. + {function,?anno(hd(Cs)),Name,Arity,check_clauses(Cs, Name, Arity)}. -%% build_rule([Clause]) -> {rule,Line,Name,Arity,[Clause]'} +%% build_fun(Anno, [Clause]) -> {'fun',Anno,{clauses,[Clause]}}. -build_rule(Cs) -> +build_fun(Anno, Cs) -> Name = element(3, hd(Cs)), Arity = length(element(4, hd(Cs))), - {rule,?line(hd(Cs)),Name,Arity,check_clauses(Cs, Name, Arity)}. - -%% build_fun(Line, [Clause]) -> {'fun',Line,{clauses,[Clause]}}. - -build_fun(Line, Cs) -> - Arity = length(element(4, hd(Cs))), - {'fun',Line,{clauses,check_clauses(Cs, 'fun', Arity)}}. + CheckedCs = check_clauses(Cs, Name, Arity), + case Name of + 'fun' -> + {'fun',Anno,{clauses,CheckedCs}}; + Name -> + {named_fun,Anno,Name,CheckedCs} + end. check_clauses(Cs, Name, Arity) -> - mapl(fun ({clause,L,N,As,G,B}) when N =:= Name, length(As) =:= Arity -> - {clause,L,As,G,B}; - ({clause,L,_N,_As,_G,_B}) -> - ret_err(L, "head mismatch") end, Cs). + [case C of + {clause,A,N,As,G,B} when N =:= Name, length(As) =:= Arity -> + {clause,A,As,G,B}; + {clause,A,_N,_As,_G,_B} -> + ret_err(A, "head mismatch") + end || C <- Cs]. -build_try(L,Es,Scs,{Ccs,As}) -> - {'try',L,Es,Scs,Ccs,As}. +build_try(A,Es,Scs,{Ccs,As}) -> + {'try',A,Es,Scs,Ccs,As}. -spec ret_err(_, _) -> no_return(). -ret_err(L, S) -> - {location,Location} = get_attribute(L, location), - return_error(Location, S). - -%% mapl(F,List) -%% an alternative map which always maps from left to right -%% and makes it possible to interrupt the mapping with throw on -%% the first occurence from left as expected. -%% can be removed when the jam machine (and all other machines) -%% uses the standardized (Erlang 5.0) evaluation order (from left to right) -mapl(F, [H|T]) -> - V = F(H), - [V | mapl(F,T)]; -mapl(_, []) -> - []. +ret_err(Anno, S) -> + return_error(location(Anno), S). + +location(Anno) -> + erl_anno:location(Anno). %% Convert between the abstract form of a term and a term. @@ -900,12 +1267,12 @@ 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' -normalise({record_field,_,_,_}=A) -> - case package_segments(A) of - error -> erlang:error({badarg, A}); - As -> list_to_atom(packages:concat(As)) - end; +normalise({map,_,Pairs}=M) -> + maps:from_list(lists:map(fun + %% only allow '=>' + ({map_field_assoc,_,K,V}) -> {normalise(K),normalise(V)}; + (_) -> erlang:error({badarg,M}) + end, Pairs)); %% Special case for unary +/-. normalise({op,_,'+',{char,_,I}}) -> I; normalise({op,_,'+',{integer,_,I}}) -> I; @@ -923,73 +1290,90 @@ normalise_list([]) -> -spec abstract(Data) -> AbsTerm when Data :: term(), AbsTerm :: abstract_expr(). -abstract(T) when is_integer(T) -> {integer,0,T}; -abstract(T) when is_float(T) -> {float,0,T}; -abstract(T) when is_atom(T) -> {atom,0,T}; -abstract([]) -> {nil,0}; -abstract(B) when is_bitstring(B) -> - {bin, 0, [abstract_byte(Byte, 0) || Byte <- bitstring_to_list(B)]}; -abstract([C|T]) when is_integer(C), 0 =< C, C < 256 -> - abstract_string(T, [C]); -abstract([H|T]) -> - {cons,0,abstract(H),abstract(T)}; -abstract(Tuple) when is_tuple(Tuple) -> - {tuple,0,abstract_list(tuple_to_list(Tuple))}. - -abstract_string([C|T], String) when is_integer(C), 0 =< C, C < 256 -> - abstract_string(T, [C|String]); -abstract_string([], String) -> - {string, 0, lists:reverse(String)}; -abstract_string(T, String) -> - not_string(String, abstract(T)). - -not_string([C|T], Result) -> - not_string(T, {cons, 0, {integer, 0, C}, Result}); -not_string([], Result) -> +abstract(T) -> + Anno = erl_anno:new(0), + abstract(T, Anno, enc_func(epp:default_encoding())). + +-type encoding_func() :: fun((non_neg_integer()) -> boolean()). + +%%% abstract/2 takes line and encoding options +-spec abstract(Data, Options) -> AbsTerm when + Data :: term(), + Options :: Line | [Option], + Option :: {line, Line} | {encoding, Encoding}, + Encoding :: 'latin1' | 'unicode' | 'utf8' | 'none' | encoding_func(), + Line :: erl_anno:line(), + AbsTerm :: abstract_expr(). + +abstract(T, Line) when is_integer(Line) -> + Anno = erl_anno:new(Line), + abstract(T, Anno, enc_func(epp:default_encoding())); +abstract(T, Options) when is_list(Options) -> + Line = proplists:get_value(line, Options, 0), + Encoding = proplists:get_value(encoding, Options,epp:default_encoding()), + EncFunc = enc_func(Encoding), + Anno = erl_anno:new(Line), + abstract(T, Anno, EncFunc). + +-define(UNICODE(C), + (C < 16#D800 orelse + C > 16#DFFF andalso C < 16#FFFE orelse + C > 16#FFFF andalso C =< 16#10FFFF)). + +enc_func(latin1) -> fun(C) -> C < 256 end; +enc_func(unicode) -> fun(C) -> ?UNICODE(C) end; +enc_func(utf8) -> fun(C) -> ?UNICODE(C) end; +enc_func(none) -> none; +enc_func(Fun) when is_function(Fun, 1) -> Fun; +enc_func(Term) -> erlang:error({badarg, Term}). + +abstract(T, A, _E) when is_integer(T) -> {integer,A,T}; +abstract(T, A, _E) when is_float(T) -> {float,A,T}; +abstract(T, A, _E) when is_atom(T) -> {atom,A,T}; +abstract([], A, _E) -> {nil,A}; +abstract(B, A, _E) when is_bitstring(B) -> + {bin, A, [abstract_byte(Byte, A) || Byte <- bitstring_to_list(B)]}; +abstract([H|T], A, none=E) -> + {cons,A,abstract(H, A, E),abstract(T, A, E)}; +abstract(List, A, E) when is_list(List) -> + abstract_list(List, [], A, E); +abstract(Tuple, A, E) when is_tuple(Tuple) -> + {tuple,A,abstract_tuple_list(tuple_to_list(Tuple), A, E)}; +abstract(Map, A, E) when is_map(Map) -> + {map,A,abstract_map_fields(maps:to_list(Map),A,E)}. + +abstract_list([H|T], String, A, E) -> + case is_integer(H) andalso H >= 0 andalso E(H) of + true -> + abstract_list(T, [H|String], A, E); + false -> + AbstrList = {cons,A,abstract(H, A, E),abstract(T, A, E)}, + not_string(String, AbstrList, A, E) + end; +abstract_list([], String, A, _E) -> + {string, A, lists:reverse(String)}; +abstract_list(T, String, A, E) -> + not_string(String, abstract(T, A, E), A, E). + +not_string([C|T], Result, A, E) -> + not_string(T, {cons, A, {integer, A, C}, Result}, A, E); +not_string([], Result, _A, _E) -> Result. -abstract_list([H|T]) -> - [abstract(H)|abstract_list(T)]; -abstract_list([]) -> +abstract_tuple_list([H|T], A, E) -> + [abstract(H, A, E)|abstract_tuple_list(T, A, E)]; +abstract_tuple_list([], _A, _E) -> []. -abstract_byte(Byte, Line) when is_integer(Byte) -> - {bin_element, Line, {integer, Line, Byte}, default, default}; -abstract_byte(Bits, Line) -> +abstract_map_fields(Fs,A,E) -> + [{map_field_assoc,A,abstract(K,A,E),abstract(V,A,E)}||{K,V}<-Fs]. + +abstract_byte(Byte, A) when is_integer(Byte) -> + {bin_element, A, {integer, A, Byte}, default, default}; +abstract_byte(Bits, A) -> Sz = bit_size(Bits), <<Val:Sz>> = Bits, - {bin_element, Line, {integer, Line, Val}, {integer, Line, Sz}, default}. - -%%% abstract/2 keeps the line number -abstract(T, Line) when is_integer(T) -> {integer,Line,T}; -abstract(T, Line) when is_float(T) -> {float,Line,T}; -abstract(T, Line) when is_atom(T) -> {atom,Line,T}; -abstract([], Line) -> {nil,Line}; -abstract(B, Line) when is_bitstring(B) -> - {bin, Line, [abstract_byte(Byte, Line) || Byte <- bitstring_to_list(B)]}; -abstract([C|T], Line) when is_integer(C), 0 =< C, C < 256 -> - abstract_string(T, [C], Line); -abstract([H|T], Line) -> - {cons,Line,abstract(H, Line),abstract(T, Line)}; -abstract(Tuple, Line) when is_tuple(Tuple) -> - {tuple,Line,abstract_list(tuple_to_list(Tuple), Line)}. - -abstract_string([C|T], String, Line) when is_integer(C), 0 =< C, C < 256 -> - abstract_string(T, [C|String], Line); -abstract_string([], String, Line) -> - {string, Line, lists:reverse(String)}; -abstract_string(T, String, Line) -> - not_string(String, abstract(T, Line), Line). - -not_string([C|T], Result, Line) -> - not_string(T, {cons, Line, {integer, Line, C}, Result}, Line); -not_string([], Result, _Line) -> - Result. - -abstract_list([H|T], Line) -> - [abstract(H, Line)|abstract_list(T, Line)]; -abstract_list([], _Line) -> - []. + {bin_element, A, {integer, A, Val}, {integer, A, Sz}, default}. %% Generate a list of tokens representing the abstract term. @@ -1003,32 +1387,32 @@ tokens(Abs) -> 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({char,A,C}, More) -> [{char,A,C}|More]; +tokens({integer,A,N}, More) -> [{integer,A,N}|More]; +tokens({float,A,F}, More) -> [{float,A,F}|More]; +tokens({atom,Aa,A}, More) -> [{atom,Aa,A}|More]; +tokens({var,A,V}, More) -> [{var,A,V}|More]; +tokens({string,A,S}, More) -> [{string,A,S}|More]; +tokens({nil,A}, More) -> [{'[',A},{']',A}|More]; +tokens({cons,A,Head,Tail}, More) -> + [{'[',A}|tokens(Head, tokens_tail(Tail, More))]; +tokens({tuple,A,[]}, More) -> + [{'{',A},{'}',A}|More]; +tokens({tuple,A,[E|Es]}, More) -> + [{'{',A}|tokens(E, tokens_tuple(Es, ?anno(E), More))]. + +tokens_tail({cons,A,Head,Tail}, More) -> + [{',',A}|tokens(Head, tokens_tail(Tail, More))]; +tokens_tail({nil,A}, More) -> + [{']',A}|More]; tokens_tail(Other, More) -> - L = ?line(Other), - [{'|',L}|tokens(Other, [{']',L}|More])]. + A = ?anno(Other), + [{'|',A}|tokens(Other, [{']',A}|More])]. -tokens_tuple([E|Es], Line, More) -> - [{',',Line}|tokens(E, tokens_tuple(Es, ?line(E), More))]; -tokens_tuple([], Line, More) -> - [{'}',Line}|More]. +tokens_tuple([E|Es], Anno, More) -> + [{',',Anno}|tokens(E, tokens_tuple(Es, ?anno(E), More))]; +tokens_tuple([], Anno, More) -> + [{'}',Anno}|More]. %% Give the relative precedences of operators. @@ -1079,25 +1463,206 @@ preop_prec('#') -> {700,800}. func_prec() -> {800,700}. --spec max_prec() -> 1000. - -max_prec() -> 1000. - -%%% [Experimental]. The parser just copies the attributes of the -%%% scanner tokens to the abstract format. This design decision has -%%% been hidden to some extent: use set_line() and get_attribute() to -%%% access the second element of (almost all) of the abstract format -%%% tuples. A typical use is to negate line numbers to prevent the -%%% compiler from emitting warnings and errors. The second element can -%%% (of course) be set to any value, but then these functions no -%%% longer apply. To get all present attributes as a property list -%%% get_attributes() should be used. - -set_line(L, F) -> - erl_scan:set_attribute(line, L, F). - -get_attribute(L, Name) -> - erl_scan:attributes_info(L, Name). - -get_attributes(L) -> - erl_scan:attributes_info(L). +-spec max_prec() -> 900. + +max_prec() -> 900. + +-type prec() :: non_neg_integer(). + +-type type_inop() :: '::' | '|' | '..' | '+' | '-' | 'bor' | 'bxor' + | 'bsl' | 'bsr' | '*' | '/' | 'div' | 'rem' | 'band'. + +-type type_preop() :: '+' | '-' | 'bnot' | '#'. + +-spec type_inop_prec(type_inop()) -> {prec(), prec(), prec()}. + +type_inop_prec('=') -> {150,100,100}; +type_inop_prec('::') -> {160,150,150}; +type_inop_prec('|') -> {180,170,170}; +type_inop_prec('..') -> {300,200,300}; +type_inop_prec('+') -> {400,400,500}; +type_inop_prec('-') -> {400,400,500}; +type_inop_prec('bor') -> {400,400,500}; +type_inop_prec('bxor') -> {400,400,500}; +type_inop_prec('bsl') -> {400,400,500}; +type_inop_prec('bsr') -> {400,400,500}; +type_inop_prec('*') -> {500,500,600}; +type_inop_prec('/') -> {500,500,600}; +type_inop_prec('div') -> {500,500,600}; +type_inop_prec('rem') -> {500,500,600}; +type_inop_prec('band') -> {500,500,600}; +type_inop_prec('#') -> {800,700,800}. + +-spec type_preop_prec(type_preop()) -> {prec(), prec()}. + +type_preop_prec('+') -> {600,700}; +type_preop_prec('-') -> {600,700}; +type_preop_prec('bnot') -> {600,700}; +type_preop_prec('#') -> {700,800}. + +-type erl_parse_tree() :: abstract_clause() + | abstract_expr() + | abstract_form() + | abstract_type(). + +-spec map_anno(Fun, Abstr) -> NewAbstr when + Fun :: fun((Anno) -> NewAnno), + Anno :: erl_anno:anno(), + NewAnno :: erl_anno:anno(), + Abstr :: erl_parse_tree(), + NewAbstr :: erl_parse_tree(). + +map_anno(F0, Abstr) -> + F = fun(A, Acc) -> {F0(A), Acc} end, + {NewAbstr, []} = modify_anno1(Abstr, [], F), + NewAbstr. + +-spec fold_anno(Fun, Acc0, Abstr) -> Acc1 when + Fun :: fun((Anno, AccIn) -> AccOut), + Anno :: erl_anno:anno(), + Acc0 :: term(), + Acc1 :: term(), + AccIn :: term(), + AccOut :: term(), + Abstr :: erl_parse_tree(). + +fold_anno(F0, Acc0, Abstr) -> + F = fun(A, Acc) -> {A, F0(A, Acc)} end, + {_, NewAcc} = modify_anno1(Abstr, Acc0, F), + NewAcc. + +-spec mapfold_anno(Fun, Acc0, Abstr) -> {NewAbstr, Acc1} when + Fun :: fun((Anno, AccIn) -> {NewAnno, AccOut}), + Anno :: erl_anno:anno(), + NewAnno :: erl_anno:anno(), + Acc0 :: term(), + Acc1 :: term(), + AccIn :: term(), + AccOut :: term(), + Abstr :: erl_parse_tree(), + NewAbstr :: erl_parse_tree(). + +mapfold_anno(F, Acc0, Abstr) -> + modify_anno1(Abstr, Acc0, F). + +-spec new_anno(Term) -> Abstr when + Term :: term(), + Abstr :: erl_parse_tree(). + +new_anno(Term) -> + F = fun(L, Acc) -> {erl_anno:new(L), Acc} end, + {NewAbstr, []} = modify_anno1(Term, [], F), + NewAbstr. + +-spec anno_to_term(Abstr) -> term() when + Abstr :: erl_parse_tree(). + +anno_to_term(Abstract) -> + F = fun(Anno, Acc) -> {erl_anno:to_term(Anno), Acc} end, + {NewAbstract, []} = modify_anno1(Abstract, [], F), + NewAbstract. + +-spec anno_from_term(Term) -> erl_parse_tree() when + Term :: term(). + +anno_from_term(Term) -> + F = fun(T, Acc) -> {erl_anno:from_term(T), Acc} end, + {NewTerm, []} = modify_anno1(Term, [], F), + NewTerm. + +%% Forms. +%% Recognize what sys_pre_expand does: +modify_anno1({'fun',A,F,{_,_,_}=Id}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {F1,Ac2} = modify_anno1(F, Ac1, Mf), + {{'fun',A1,F1,Id},Ac2}; +modify_anno1({named_fun,A,N,F,{_,_,_}=Id}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {F1,Ac2} = modify_anno1(F, Ac1, Mf), + {{named_fun,A1,N,F1,Id},Ac2}; +modify_anno1({attribute,A,N,[V]}, Ac, Mf) -> + {{attribute,A1,N1,V1},Ac1} = modify_anno1({attribute,A,N,V}, Ac, Mf), + {{attribute,A1,N1,[V1]},Ac1}; +%% End of sys_pre_expand special forms. +modify_anno1({function,F,A}, Ac, _Mf) -> + {{function,F,A},Ac}; +modify_anno1({function,M,F,A}, Ac, Mf) -> + {M1,Ac1} = modify_anno1(M, Ac, Mf), + {F1,Ac2} = modify_anno1(F, Ac1, Mf), + {A1,Ac3} = modify_anno1(A, Ac2, Mf), + {{function,M1,F1,A1},Ac3}; +modify_anno1({attribute,A,record,{Name,Fields}}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {Fields1,Ac2} = modify_anno1(Fields, Ac1, Mf), + {{attribute,A1,record,{Name,Fields1}},Ac2}; +modify_anno1({attribute,A,spec,{Fun,Types}}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {Types1,Ac2} = modify_anno1(Types, Ac1, Mf), + {{attribute,A1,spec,{Fun,Types1}},Ac2}; +modify_anno1({attribute,A,callback,{Fun,Types}}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {Types1,Ac2} = modify_anno1(Types, Ac1, Mf), + {{attribute,A1,callback,{Fun,Types1}},Ac2}; +modify_anno1({attribute,A,type,{TypeName,TypeDef,Args}}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {TypeDef1,Ac2} = modify_anno1(TypeDef, Ac1, Mf), + {Args1,Ac3} = modify_anno1(Args, Ac2, Mf), + {{attribute,A1,type,{TypeName,TypeDef1,Args1}},Ac3}; +modify_anno1({attribute,A,opaque,{TypeName,TypeDef,Args}}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {TypeDef1,Ac2} = modify_anno1(TypeDef, Ac1, Mf), + {Args1,Ac3} = modify_anno1(Args, Ac2, Mf), + {{attribute,A1,opaque,{TypeName,TypeDef1,Args1}},Ac3}; +modify_anno1({attribute,A,Attr,Val}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {{attribute,A1,Attr,Val},Ac1}; +modify_anno1({warning,W}, Ac, _Mf) -> + {{warning,W},Ac}; +modify_anno1({error,W}, Ac, _Mf) -> + {{error,W},Ac}; +%% Expressions. +modify_anno1({clauses,Cs}, Ac, Mf) -> + {Cs1,Ac1} = modify_anno1(Cs, Ac, Mf), + {{clauses,Cs1},Ac1}; +modify_anno1({typed_record_field,Field,Type}, Ac, Mf) -> + {Field1,Ac1} = modify_anno1(Field, Ac, Mf), + {Type1,Ac2} = modify_anno1(Type, Ac1, Mf), + {{typed_record_field,Field1,Type1},Ac2}; +modify_anno1({Tag,A}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {{Tag,A1},Ac1}; +modify_anno1({Tag,A,E1}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {E11,Ac2} = modify_anno1(E1, Ac1, Mf), + {{Tag,A1,E11},Ac2}; +modify_anno1({Tag,A,E1,E2}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {E11,Ac2} = modify_anno1(E1, Ac1, Mf), + {E21,Ac3} = modify_anno1(E2, Ac2, Mf), + {{Tag,A1,E11,E21},Ac3}; +modify_anno1({bin_element,A,E1,E2,TSL}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {E11,Ac2} = modify_anno1(E1, Ac1, Mf), + {E21,Ac3} = modify_anno1(E2, Ac2, Mf), + {{bin_element,A1,E11,E21, TSL},Ac3}; +modify_anno1({Tag,A,E1,E2,E3}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {E11,Ac2} = modify_anno1(E1, Ac1, Mf), + {E21,Ac3} = modify_anno1(E2, Ac2, Mf), + {E31,Ac4} = modify_anno1(E3, Ac3, Mf), + {{Tag,A1,E11,E21,E31},Ac4}; +modify_anno1({Tag,A,E1,E2,E3,E4}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {E11,Ac2} = modify_anno1(E1, Ac1, Mf), + {E21,Ac3} = modify_anno1(E2, Ac2, Mf), + {E31,Ac4} = modify_anno1(E3, Ac3, Mf), + {E41,Ac5} = modify_anno1(E4, Ac4, Mf), + {{Tag,A1,E11,E21,E31,E41},Ac5}; +modify_anno1([H|T], Ac, Mf) -> + {H1,Ac1} = modify_anno1(H, Ac, Mf), + {T1,Ac2} = modify_anno1(T, Ac1, Mf), + {[H1|T1],Ac2}; +modify_anno1([], Ac, _Mf) -> {[],Ac}; +modify_anno1(E, Ac, _Mf) when not is_tuple(E), not is_list(E) -> {E,Ac}. + +%% vim: ft=erlang diff --git a/lib/stdlib/src/erl_posix_msg.erl b/lib/stdlib/src/erl_posix_msg.erl index 909cc1d102..bfafca1ff7 100644 --- a/lib/stdlib/src/erl_posix_msg.erl +++ b/lib/stdlib/src/erl_posix_msg.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 6b5aa951cf..d30cd508c1 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -22,12 +23,13 @@ %%% the parser. It does not always produce pretty code. -export([form/1,form/2, - attribute/1,attribute/2,function/1,function/2,rule/1,rule/2, + attribute/1,attribute/2,function/1,function/2, guard/1,guard/2,exprs/1,exprs/2,exprs/3,expr/1,expr/2,expr/3,expr/4]). -import(lists, [append/1,foldr/3,mapfoldl/3,reverse/1,reverse/2]). --import(io_lib, [write/1,format/2,write_char/1,write_string/1]). --import(erl_parse, [inop_prec/1,preop_prec/1,func_prec/0,max_prec/0]). +-import(io_lib, [write/1,format/2]). +-import(erl_parse, [inop_prec/1,preop_prec/1,func_prec/0,max_prec/0, + type_inop_prec/1, type_preop_prec/1]). -define(MAXLINE, 72). @@ -35,25 +37,52 @@ | fun((Expr :: erl_parse:abstract_expr(), CurrentIndentation :: integer(), CurrentPrecedence :: non_neg_integer(), - HookFunction :: hook_function()) -> - io_lib:chars())). + Options :: options()) -> + io_lib:chars())). + +-type(option() :: {hook, hook_function()} + | {encoding, latin1 | unicode | utf8}). +-type(options() :: hook_function() | [option()]). + +-record(pp, {string_fun, char_fun}). + +-record(options, {hook, encoding, opts}). + +%-define(DEBUG, true). + +-ifdef(DEBUG). +-define(TEST(T), + %% Assumes that erl_anno has been compiled with DEBUG=true. + %% erl_pp does not use the annoations, but test it anyway. + %% Note: hooks are not handled. + _ = try + erl_parse:map_anno(fun(A) when is_list(A) -> A end, T) + catch + _:_ -> + erlang:error(badarg, [T]) + end). +-else. +-define(TEST(T), ok). +-endif. %%% %%% Exported functions %%% -spec(form(Form) -> io_lib:chars() when - Form :: erl_parse:abstract_form()). + Form :: erl_parse:abstract_form() | erl_parse:form_info()). form(Thing) -> form(Thing, none). --spec(form(Form, HookFunction) -> io_lib:chars() when - Form :: erl_parse:abstract_form(), - HookFunction :: hook_function()). +-spec(form(Form, Options) -> io_lib:chars() when + Form :: erl_parse:abstract_form() | erl_parse:form_info(), + Options :: options()). -form(Thing, Hook) -> - frmt(lform(Thing, Hook)). +form(Thing, Options) -> + ?TEST(Thing), + State = state(Options), + frmt(lform(Thing, options(Options)), State). -spec(attribute(Attribute) -> io_lib:chars() when Attribute :: erl_parse:abstract_form()). @@ -61,12 +90,14 @@ form(Thing, Hook) -> attribute(Thing) -> attribute(Thing, none). --spec(attribute(Attribute, HookFunction) -> io_lib:chars() when +-spec(attribute(Attribute, Options) -> io_lib:chars() when Attribute :: erl_parse:abstract_form(), - HookFunction :: hook_function()). + Options :: options()). -attribute(Thing, Hook) -> - frmt(lattribute(Thing, Hook)). +attribute(Thing, Options) -> + ?TEST(Thing), + State = state(Options), + frmt(lattribute(Thing, options(Options)), State). -spec(function(Function) -> io_lib:chars() when Function :: erl_parse:abstract_form()). @@ -74,18 +105,13 @@ attribute(Thing, Hook) -> function(F) -> function(F, none). --spec(function(Function, HookFunction) -> io_lib:chars() when +-spec(function(Function, Options) -> io_lib:chars() when Function :: erl_parse:abstract_form(), - HookFunction :: hook_function()). - -function(F, Hook) -> - frmt(lfunction(F, Hook)). + Options :: options()). -rule(R) -> - rule(R, none). - -rule(R, Hook) -> - frmt(lrule(R, Hook)). +function(F, Options) -> + ?TEST(F), + frmt(lfunction(F, options(Options)), state(Options)). -spec(guard(Guard) -> io_lib:chars() when Guard :: [erl_parse:abstract_expr()]). @@ -93,12 +119,13 @@ rule(R, Hook) -> guard(Gs) -> guard(Gs, none). --spec(guard(Guard, HookFunction) -> io_lib:chars() when +-spec(guard(Guard, Options) -> io_lib:chars() when Guard :: [erl_parse:abstract_expr()], - HookFunction :: hook_function()). + Options :: options()). -guard(Gs, Hook) -> - frmt(lguard(Gs, Hook)). +guard(Gs, Options) -> + ?TEST(Gs), + frmt(lguard(Gs, options(Options)), state(Options)). -spec(exprs(Expressions) -> io_lib:chars() when Expressions :: [erl_parse:abstract_expr()]). @@ -106,179 +133,249 @@ guard(Gs, Hook) -> exprs(Es) -> exprs(Es, 0, none). --spec(exprs(Expressions, HookFunction) -> io_lib:chars() when +-spec(exprs(Expressions, Options) -> io_lib:chars() when Expressions :: [erl_parse:abstract_expr()], - HookFunction :: hook_function()). + Options :: options()). -exprs(Es, Hook) -> - exprs(Es, 0, Hook). +exprs(Es, Options) -> + exprs(Es, 0, Options). --spec(exprs(Expressions, Indent, HookFunction) -> io_lib:chars() when +-spec(exprs(Expressions, Indent, Options) -> io_lib:chars() when Expressions :: [erl_parse:abstract_expr()], Indent :: integer(), - HookFunction :: hook_function()). + Options :: options()). -exprs(Es, I, Hook) -> - frmt({seq,[],[],[$,],lexprs(Es, Hook)}, I). +exprs(Es, I, Options) -> + ?TEST(Es), + frmt({seq,[],[],[$,],lexprs(Es, options(Options))}, I, state(Options)). -spec(expr(Expression) -> io_lib:chars() when Expression :: erl_parse:abstract_expr()). expr(E) -> - frmt(lexpr(E, 0, none)). + ?TEST(E), + frmt(lexpr(E, 0, options(none)), state(none)). --spec(expr(Expression, HookFunction) -> io_lib:chars() when +-spec(expr(Expression, Options) -> io_lib:chars() when Expression :: erl_parse:abstract_expr(), - HookFunction :: hook_function()). + Options :: options()). -expr(E, Hook) -> - frmt(lexpr(E, 0, Hook)). +expr(E, Options) -> + ?TEST(E), + frmt(lexpr(E, 0, options(Options)), state(Options)). --spec(expr(Expression, Indent, HookFunction) -> io_lib:chars() when +-spec(expr(Expression, Indent, Options) -> io_lib:chars() when Expression :: erl_parse:abstract_expr(), Indent :: integer(), - HookFunction :: hook_function()). + Options :: options()). -expr(E, I, Hook) -> - frmt(lexpr(E, 0, Hook), I). +expr(E, I, Options) -> + ?TEST(E), + frmt(lexpr(E, 0, options(Options)), I, state(Options)). --spec(expr(Expression, Indent, Precedence, HookFunction) -> io_lib:chars() when +-spec(expr(Expression, Indent, Precedence, Options) -> io_lib:chars() when Expression :: erl_parse:abstract_expr(), Indent :: integer(), Precedence :: non_neg_integer(), - HookFunction :: hook_function()). + Options :: options()). -expr(E, I, P, Hook) -> - frmt(lexpr(E, P, Hook), I). +expr(E, I, P, Options) -> + ?TEST(E), + frmt(lexpr(E, P, options(Options)), I, state(Options)). %%% %%% Local functions %%% -lform({attribute,Line,Name,Arg}, Hook) -> - lattribute({attribute,Line,Name,Arg}, Hook); -lform({function,Line,Name,Arity,Clauses}, Hook) -> - lfunction({function,Line,Name,Arity,Clauses}, Hook); -lform({rule,Line,Name,Arity,Clauses}, Hook) -> - lrule({rule,Line,Name,Arity,Clauses}, Hook); +options(Options) when is_list(Options) -> + Hook = proplists:get_value(hook, Options, none), + Encoding = encoding(Options), + #options{hook = Hook, encoding = Encoding, opts = Options}; +options(Hook) -> + #options{hook = Hook, encoding = encoding([]), opts = Hook}. + +state(Options) when is_list(Options) -> + case encoding(Options) of + latin1 -> state(); + unicode -> unicode_state() + end; +state(_Hook) -> + state(). + +state() -> + #pp{string_fun = fun io_lib:write_string_as_latin1/1, + char_fun = fun io_lib:write_char_as_latin1/1}. + +unicode_state() -> + #pp{string_fun = fun io_lib:write_string/1, + char_fun = fun io_lib:write_char/1}. + +encoding(Options) -> + case proplists:get_value(encoding, Options, epp:default_encoding()) of + latin1 -> latin1; + utf8 -> unicode; + unicode -> unicode + end. + +lform({attribute,Line,Name,Arg}, Opts) -> + lattribute({attribute,Line,Name,Arg}, Opts); +lform({function,Line,Name,Arity,Clauses}, Opts) -> + lfunction({function,Line,Name,Arity,Clauses}, Opts); %% These are specials to make it easier for the compiler. -lform({error,E}, _Hook) -> +lform({error,E}, _Opts) -> leaf(format("~p\n", [{error,E}])); -lform({warning,W}, _Hook) -> +lform({warning,W}, _Opts) -> leaf(format("~p\n", [{warning,W}])); -lform({eof,_Line}, _Hook) -> +lform({eof,_Line}, _Opts) -> $\n. -lattribute({attribute,_Line,type,Type}, Hook) -> - [typeattr(type, Type, Hook),leaf(".\n")]; -lattribute({attribute,_Line,opaque,Type}, Hook) -> - [typeattr(opaque, Type, Hook),leaf(".\n")]; -lattribute({attribute,_Line,spec,Arg}, _Hook) -> - [specattr(Arg),leaf(".\n")]; -lattribute({attribute,_Line,Name,Arg}, Hook) -> - [lattribute(Name, Arg, Hook),leaf(".\n")]. - -lattribute(module, {M,Vs}, _Hook) -> - attr("module",[{var,0,pname(M)}, - foldr(fun(V, C) -> {cons,0,{var,0,V},C} - end, {nil,0}, Vs)]); -lattribute(module, M, _Hook) -> - attr("module", [{var,0,pname(M)}]); -lattribute(export, Falist, _Hook) -> - call({var,0,"-export"}, [falist(Falist)], 0, none); -lattribute(import, Name, _Hook) when is_list(Name) -> - attr("import", [{var,0,pname(Name)}]); -lattribute(import, {From,Falist}, _Hook) -> - attr("import",[{var,0,pname(From)},falist(Falist)]); -lattribute(file, {Name,Line}, _Hook) -> - attr("file", [{var,0,format("~p", [Name])},{integer,0,Line}]); -lattribute(record, {Name,Is}, Hook) -> +lattribute({attribute,_Line,type,Type}, Opts) -> + [typeattr(type, Type, Opts),leaf(".\n")]; +lattribute({attribute,_Line,opaque,Type}, Opts) -> + [typeattr(opaque, Type, Opts),leaf(".\n")]; +lattribute({attribute,_Line,spec,Arg}, _Opts) -> + [specattr(spec, Arg),leaf(".\n")]; +lattribute({attribute,_Line,callback,Arg}, _Opts) -> + [specattr(callback, Arg),leaf(".\n")]; +lattribute({attribute,_Line,Name,Arg}, Opts) -> + [lattribute(Name, Arg, Opts),leaf(".\n")]. + +lattribute(module, {M,Vs}, _Opts) -> + A = a0(), + attr("module",[{var,A,pname(M)}, + foldr(fun(V, C) -> {cons,A,{var,A,V},C} + end, {nil,A}, Vs)]); +lattribute(module, M, _Opts) -> + attr("module", [{var,a0(),pname(M)}]); +lattribute(export, Falist, _Opts) -> + call({var,a0(),"-export"}, [falist(Falist)], 0, options(none)); +lattribute(import, Name, _Opts) when is_list(Name) -> + attr("import", [{var,a0(),pname(Name)}]); +lattribute(import, {From,Falist}, _Opts) -> + attr("import",[{var,a0(),pname(From)},falist(Falist)]); +lattribute(export_type, Talist, _Opts) -> + call({var,a0(),"-export_type"}, [falist(Talist)], 0, options(none)); +lattribute(optional_callbacks, Falist, Opts) -> + ArgL = try falist(Falist) + catch _:_ -> abstract(Falist, Opts) + end, + call({var,a0(),"-optional_callbacks"}, [ArgL], 0, options(none)); +lattribute(file, {Name,Line}, _Opts) -> + attr("file", [{string,a0(),Name},{integer,a0(),Line}]); +lattribute(record, {Name,Is}, Opts) -> Nl = leaf(format("-record(~w,", [Name])), - [{first,Nl,record_fields(Is, Hook)},$)]; -lattribute(Name, Arg, _Hook) -> - attr(write(Name), [erl_parse:abstract(Arg)]). + [{first,Nl,record_fields(Is, Opts)},$)]; +lattribute(Name, Arg, Options) -> + attr(write(Name), [abstract(Arg, Options)]). + +abstract(Arg, #options{encoding = Encoding}) -> + erl_parse:abstract(Arg, [{encoding,Encoding}]). -typeattr(Tag, {TypeName,Type,Args}, _Hook) -> +typeattr(Tag, {TypeName,Type,Args}, _Opts) -> {first,leaf("-"++atom_to_list(Tag)++" "), - typed(call({atom,0,TypeName}, Args, 0, none), Type)}. - -ltype({ann_type,_Line,[V,T]}) -> - typed(lexpr(V, none), T); -ltype({paren_type,_Line,[T]}) -> - [$(,ltype(T),$)]; -ltype({type,_Line,union,Ts}) -> - {seq,[],[],[' |'],ltypes(Ts)}; -ltype({type,_Line,list,[T]}) -> + typed(call({atom,a0(),TypeName}, Args, 0, options(none)), Type)}. + +ltype(T) -> + ltype(T, 0). + +ltype({ann_type,_Line,[V,T]}, Prec) -> + {_L,P,_R} = type_inop_prec('::'), + E = typed(lexpr(V, options(none)), T), + maybe_paren(P, Prec, E); +ltype({paren_type,_Line,[T]}, P) -> + %% Generated before Erlang/OTP 18. + ltype(T, P); +ltype({type,_Line,union,Ts}, Prec) -> + {_L,P,R} = type_inop_prec('|'), + E = {seq,[],[],[' |'],ltypes(Ts, R)}, + maybe_paren(P, Prec, E); +ltype({type,_Line,list,[T]}, _) -> {seq,$[,$],$,,[ltype(T)]}; -ltype({type,_Line,nonempty_list,[T]}) -> +ltype({type,_Line,nonempty_list,[T]}, _) -> {seq,$[,$],[$,],[ltype(T),leaf("...")]}; -ltype({type,Line,nil,[]}) -> - lexpr({nil,Line}, 0, none); -ltype({type,Line,tuple,any}) -> +ltype({type,Line,nil,[]}, _) -> + lexpr({nil,Line}, options(none)); +ltype({type,Line,map,any}, _) -> + simple_type({atom,Line,map}, []); +ltype({type,_Line,map,Pairs}, Prec) -> + {P,_R} = type_preop_prec('#'), + E = map_type(Pairs), + maybe_paren(P, Prec, E); +ltype({type,Line,tuple,any}, _) -> simple_type({atom,Line,tuple}, []); -ltype({type,_Line,tuple,Ts}) -> - tuple_type(Ts, fun ltype/1); -ltype({type,_Line,record,[{atom,_,N}|Fs]}) -> - record_type(N, Fs); -ltype({type,_Line,range,[_I1,_I2]=Es}) -> - expr_list(Es, '..', fun lexpr/2, none); -ltype({type,_Line,binary,[I1,I2]}) -> +ltype({type,_Line,tuple,Ts}, _) -> + tuple_type(Ts, fun ltype/2); +ltype({type,_Line,record,[{atom,_,N}|Fs]}, Prec) -> + {P,_R} = type_preop_prec('#'), + E = record_type(N, Fs), + maybe_paren(P, Prec, E); +ltype({type,_Line,range,[_I1,_I2]=Es}, Prec) -> + {_L,P,R} = type_inop_prec('..'), + F = fun(E, Opts) -> lexpr(E, R, Opts) end, + E = expr_list(Es, '..', F, options(none)), + maybe_paren(P, Prec, E); +ltype({type,_Line,binary,[I1,I2]}, _) -> binary_type(I1, I2); % except binary() -ltype({type,_Line,'fun',[]}) -> +ltype({type,_Line,'fun',[]}, _) -> leaf("fun()"); -ltype({type,_,'fun',[{type,_,any},_]}=FunType) -> +ltype({type,_,'fun',[{type,_,any},_]}=FunType, _) -> [fun_type(['fun',$(], FunType),$)]; -ltype({type,_Line,'fun',[{type,_,product,_},_]}=FunType) -> +ltype({type,_Line,'fun',[{type,_,product,_},_]}=FunType, _) -> [fun_type(['fun',$(], FunType),$)]; -ltype({type,Line,T,Ts}) -> +ltype({type,Line,T,Ts}, _) -> simple_type({atom,Line,T}, Ts); -ltype({remote_type,Line,[M,F,Ts]}) -> +ltype({user_type,Line,T,Ts}, _) -> + simple_type({atom,Line,T}, Ts); +ltype({remote_type,Line,[M,F,Ts]}, _) -> simple_type({remote,Line,M,F}, Ts); -ltype({atom,_,T}) -> +ltype({atom,_,T}, _) -> leaf(write(T)); -ltype(E) -> - lexpr(E, 0, none). +ltype(E, P) -> + lexpr(E, P, options(none)). binary_type(I1, I2) -> B = [[] || {integer,_,0} <- [I1]] =:= [], U = [[] || {integer,_,0} <- [I2]] =:= [], P = max_prec(), - E1 = [[leaf("_:"),lexpr(I1, P, none)] || B], - E2 = [[leaf("_:_*"),lexpr(I2, P, none)] || U], + E1 = [[leaf("_:"),lexpr(I1, P, options(none))] || B], + E2 = [[leaf("_:_*"),lexpr(I2, P, options(none))] || U], {seq,'<<','>>',[$,],E1++E2}. +map_type(Fs) -> + {first,[$#],map_pair_types(Fs)}. + +map_pair_types(Fs) -> + tuple_type(Fs, fun map_pair_type/2). + +map_pair_type({type,_Line,map_field_assoc,[KType,VType]}, Prec) -> + {list,[{cstep,[ltype(KType, Prec),leaf(" =>")],ltype(VType, Prec)}]}; +map_pair_type({type,_Line,map_field_exact,[KType,VType]}, Prec) -> + {list,[{cstep,[ltype(KType, Prec),leaf(" :=")],ltype(VType, Prec)}]}. + record_type(Name, Fields) -> {first,[record_name(Name)],field_types(Fields)}. field_types(Fs) -> - tuple_type(Fs, fun field_type/1). + tuple_type(Fs, fun field_type/2). -field_type({type,_Line,field_type,[Name,Type]}) -> - typed(lexpr(Name, none), Type). +field_type({type,_Line,field_type,[Name,Type]}, _Prec) -> + typed(lexpr(Name, options(none)), Type). -typed(B, {type,_,union,Ts}) -> - %% Special layout for :: followed by union. - {first,[B,$\s],{seq,[],[],[],union_type(Ts)}}; typed(B, Type) -> - {list,[{cstep,[B,' ::'],ltype(Type)}]}. - -union_type([T|Ts]) -> - [[leaf(":: "),ltype(T)] | ltypes(Ts, fun union_elem/1)]. - -union_elem(T) -> - [leaf(" | "),ltype(T)]. + {_L,_P,R} = type_inop_prec('::'), + {list,[{cstep,[B,' ::'],ltype(Type, R)}]}. tuple_type(Ts, F) -> - {seq,${,$},[$,],ltypes(Ts, F)}. + {seq,${,$},[$,],ltypes(Ts, F, 0)}. -specattr({FuncSpec,TypeSpecs}) -> +specattr(SpecKind, {FuncSpec,TypeSpecs}) -> Func = case FuncSpec of {F,_A} -> format("~w", [F]); {M,F,_A} -> format("~w:~w", [M, F]) end, - {first,leaf("-spec "), + {first,leaf(lists:concat(["-", SpecKind, " "])), {list,[{first,leaf(Func),spec_clauses(TypeSpecs)}]}}. spec_clauses(TypeSpecs) -> @@ -290,10 +387,14 @@ sig_type(FunType) -> fun_type([], FunType). guard_type(Before, Gs) -> - Gl = {list,[{step,'when',expr_list(Gs, [$,], fun constraint/2, none)}]}, + Opts = options(none), + Gl = {list,[{step,'when',expr_list(Gs, [$,], fun constraint/2, Opts)}]}, {list,[{step,Before,Gl}]}. -constraint({type,_Line,constraint,[Tag,As]}, _Hook) -> +constraint({type,_Line,constraint,[{atom,_,is_subtype},[{var,_,_}=V,Type]]}, + _Opts) -> + typed(lexpr(V, options(none)), Type); +constraint({type,_Line,constraint,[Tag,As]}, _Opts) -> simple_type(Tag, As). fun_type(Before, {type,_,'fun',[FType,Ret]}) -> @@ -305,19 +406,19 @@ type_args({type,_line,product,Ts}) -> targs(Ts). simple_type(Tag, Types) -> - {first,lexpr(Tag, 0, none),targs(Types)}. + {first,lexpr(Tag, options(none)),targs(Types)}. targs(Ts) -> - {seq,$(,$),[$,],ltypes(Ts)}. + {seq,$(,$),[$,],ltypes(Ts, 0)}. -ltypes(Ts) -> - ltypes(Ts, fun ltype/1). +ltypes(Ts, Prec) -> + ltypes(Ts, fun ltype/2, Prec). -ltypes(Ts, F) -> - [F(T) || T <- Ts]. +ltypes(Ts, F, Prec) -> + [F(T, Prec) || T <- Ts]. attr(Name, Args) -> - call({var,0,format("-~s", [Name])}, Args, 0, none). + call({var,a0(),format("-~s", [Name])}, Args, 0, options(none)). pname(['' | As]) -> [$. | pname(As)]; @@ -329,235 +430,238 @@ pname(A) when is_atom(A) -> write(A). falist([]) -> - {nil,0}; + {nil,a0()}; falist([{Name,Arity}|Falist]) -> - {cons,0,{var,0,format("~w/~w", [Name,Arity])},falist(Falist)}. + A = a0(), + {cons,A,{var,A,format("~w/~w", [Name,Arity])},falist(Falist)}. -lfunction({function,_Line,Name,_Arity,Cs}, Hook) -> - Cll = nl_clauses(fun (C, H) -> func_clause(Name, C, H) end, $;, Hook, Cs), +lfunction({function,_Line,Name,_Arity,Cs}, Opts) -> + Cll = nl_clauses(fun (C, H) -> func_clause(Name, C, H) end, $;, Opts, Cs), [Cll,leaf(".\n")]. -func_clause(Name, {clause,Line,Head,Guard,Body}, Hook) -> - Hl = call({atom,Line,Name}, Head, 0, Hook), - Gl = guard_when(Hl, Guard, Hook), - Bl = body(Body, Hook), +func_clause(Name, {clause,Line,Head,Guard,Body}, Opts) -> + Hl = call({atom,Line,Name}, Head, 0, Opts), + Gl = guard_when(Hl, Guard, Opts), + Bl = body(Body, Opts), {step,Gl,Bl}. -lrule({rule,_Line,Name,_Arity,Cs}, Hook) -> - Cll = nl_clauses(fun (C, H) -> rule_clause(Name, C, H) end, $;, Hook, Cs), - [Cll,leaf(".\n")]. +guard_when(Before, Guard, Opts) -> + guard_when(Before, Guard, Opts, ' ->'). -rule_clause(Name, {clause,Line,Head,Guard,Body}, Hook) -> - Hl = call({atom,Line,Name}, Head, 0, Hook), - Gl = guard_when(Hl, Guard, Hook, leaf(" :-")), - Bl = rule_body(Body, Hook), - {step,Gl,Bl}. - -rule_body(Es, Hook) -> - lc_quals(Es, Hook). - -guard_when(Before, Guard, Hook) -> - guard_when(Before, Guard, Hook, ' ->'). - -guard_when(Before, Guard, Hook, After) -> - Gl = lguard(Guard, Hook), +guard_when(Before, Guard, Opts, After) -> + Gl = lguard(Guard, Opts), [{list,[{step,Before,Gl}]},After]. -lguard([E|Es], Hook) when is_list(E) -> - {list,[{step,'when',expr_list([E|Es], [$;], fun guard0/2, Hook)}]}; -lguard([E|Es], Hook) -> % before R6 - lguard([[E|Es]], Hook); +lguard([E|Es], Opts) when is_list(E) -> + {list,[{step,'when',expr_list([E|Es], [$;], fun guard0/2, Opts)}]}; +lguard([E|Es], Opts) -> % before R6 + lguard([[E|Es]], Opts); lguard([], _) -> []. -guard0(Es, Hook) -> - expr_list(Es, [$,], fun lexpr/2, Hook). +guard0(Es, Opts) -> + expr_list(Es, [$,], fun lexpr/2, Opts). -%% body(Before, Es, Hook) -> [Char]. +%% body(Before, Es, Opts) -> [Char]. -body([E], Hook) -> - lexpr(E, Hook); -body(Es, Hook) -> - {prefer_nl,[$,],lexprs(Es, Hook)}. +body([E], Opts) -> + lexpr(E, Opts); +body(Es, Opts) -> + {prefer_nl,[$,],lexprs(Es, Opts)}. -lexpr(E, Hook) -> - lexpr(E, 0, Hook). +lexpr(E, Opts) -> + lexpr(E, 0, Opts). lexpr({var,_,V}, _, _) when is_integer(V) -> %Special hack for Robert leaf(format("_~w", [V])); -lexpr({var,_,V}, _, _) -> leaf(format("~s", [V])); -lexpr({char,_,C}, _, _) -> leaf(write_char(C)); +lexpr({var,_,V}, _, _) -> leaf(format("~ts", [V])); +lexpr({char,_,C}, _, _) -> {char,C}; lexpr({integer,_,N}, _, _) -> leaf(write(N)); lexpr({float,_,F}, _, _) -> leaf(write(F)); lexpr({atom,_,A}, _, _) -> leaf(write(A)); lexpr({string,_,S}, _, _) -> {string,S}; lexpr({nil,_}, _, _) -> '[]'; -lexpr({cons,_,H,T}, _, Hook) -> - list(T, [H], Hook); -lexpr({lc,_,E,Qs}, _Prec, Hook) -> - Lcl = {list,[{step,[lexpr(E, Hook),leaf(" ||")],lc_quals(Qs, Hook)}]}, +lexpr({cons,_,H,T}, _, Opts) -> + list(T, [H], Opts); +lexpr({lc,_,E,Qs}, _Prec, Opts) -> + Lcl = {list,[{step,[lexpr(E, Opts),leaf(" ||")],lc_quals(Qs, Opts)}]}, {list,[{seq,$[,[],[[]],[{force_nl,leaf(" "),[Lcl]}]},$]]}; %% {list,[{step,$[,Lcl},$]]}; -lexpr({bc,_,E,Qs}, _Prec, Hook) -> - Lcl = {list,[{step,[lexpr(E, Hook),leaf(" ||")],lc_quals(Qs, Hook)}]}, +lexpr({bc,_,E,Qs}, _Prec, Opts) -> + Lcl = {list,[{step,[lexpr(E, Opts),leaf(" ||")],lc_quals(Qs, Opts)}]}, {list,[{seq,'<<',[],[[]],[{force_nl,leaf(" "),[Lcl]}]},'>>']}; %% {list,[{step,'<<',Lcl},'>>']}; -lexpr({tuple,_,Elts}, _, Hook) -> - tuple(Elts, Hook); -%%lexpr({struct,_,Tag,Elts}, _, Hook) -> -%% {first,format("~w", [Tag]),tuple(Elts, Hook)}; -lexpr({record_index, _, Name, F}, Prec, Hook) -> +lexpr({tuple,_,Elts}, _, Opts) -> + tuple(Elts, Opts); +%%lexpr({struct,_,Tag,Elts}, _, Opts) -> +%% {first,format("~w", [Tag]),tuple(Elts, Opts)}; +lexpr({record_index, _, Name, F}, Prec, Opts) -> {P,R} = preop_prec('#'), Nl = record_name(Name), - El = [Nl,$.,lexpr(F, R, Hook)], + El = [Nl,$.,lexpr(F, R, Opts)], maybe_paren(P, Prec, El); -lexpr({record, _, Name, Fs}, Prec, Hook) -> +lexpr({record, _, Name, Fs}, Prec, Opts) -> {P,_R} = preop_prec('#'), Nl = record_name(Name), - El = {first,Nl,record_fields(Fs, Hook)}, + El = {first,Nl,record_fields(Fs, Opts)}, maybe_paren(P, Prec, El); -lexpr({record_field, _, Rec, Name, F}, Prec, Hook) -> +lexpr({record_field, _, Rec, Name, F}, Prec, Opts) -> {L,P,R} = inop_prec('#'), - Rl = lexpr(Rec, L, Hook), + Rl = lexpr(Rec, L, Opts), Nl = leaf(format("#~w.", [Name])), - El = [Rl,Nl,lexpr(F, R, Hook)], + El = [Rl,Nl,lexpr(F, R, Opts)], maybe_paren(P, Prec, El); -lexpr({record, _, Rec, Name, Fs}, Prec, Hook) -> +lexpr({record, _, Rec, Name, Fs}, Prec, Opts) -> {L,P,_R} = inop_prec('#'), - Rl = lexpr(Rec, L, Hook), + Rl = lexpr(Rec, L, Opts), Nl = record_name(Name), - El = {first,[Rl,Nl],record_fields(Fs, Hook)}, + El = {first,[Rl,Nl],record_fields(Fs, Opts)}, maybe_paren(P, Prec, El); -lexpr({record_field, _, {atom,_,''}, F}, Prec, Hook) -> +lexpr({record_field, _, {atom,_,''}, F}, Prec, Opts) -> {_L,P,R} = inop_prec('.'), - El = [$.,lexpr(F, R, Hook)], + El = [$.,lexpr(F, R, Opts)], maybe_paren(P, Prec, El); -lexpr({record_field, _, Rec, F}, Prec, Hook) -> +lexpr({record_field, _, Rec, F}, Prec, Opts) -> {L,P,R} = inop_prec('.'), - El = [lexpr(Rec, L, Hook),$.,lexpr(F, R, Hook)], + El = [lexpr(Rec, L, Opts),$.,lexpr(F, R, Opts)], + maybe_paren(P, Prec, El); +lexpr({map, _, Fs}, Prec, Opts) -> + {P,_R} = preop_prec('#'), + El = {first,leaf("#"),map_fields(Fs, Opts)}, + maybe_paren(P, Prec, El); +lexpr({map, _, Map, Fs}, Prec, Opts) -> + {L,P,_R} = inop_prec('#'), + Rl = lexpr(Map, L, Opts), + El = {first,[Rl,leaf("#")],map_fields(Fs, Opts)}, maybe_paren(P, Prec, El); -lexpr({block,_,Es}, _, Hook) -> - {list,[{step,'begin',body(Es, Hook)},'end']}; -lexpr({'if',_,Cs}, _, Hook) -> - {list,[{step,'if',if_clauses(Cs, Hook)},'end']}; -lexpr({'case',_,Expr,Cs}, _, Hook) -> - {list,[{step,{list,[{step,'case',lexpr(Expr, Hook)},'of']}, - cr_clauses(Cs, Hook)}, +lexpr({block,_,Es}, _, Opts) -> + {list,[{step,'begin',body(Es, Opts)},'end']}; +lexpr({'if',_,Cs}, _, Opts) -> + {list,[{step,'if',if_clauses(Cs, Opts)},'end']}; +lexpr({'case',_,Expr,Cs}, _, Opts) -> + {list,[{step,{list,[{step,'case',lexpr(Expr, Opts)},'of']}, + cr_clauses(Cs, Opts)}, 'end']}; -lexpr({'cond',_,Cs}, _, Hook) -> - {list,[{step,leaf("cond"),cond_clauses(Cs, Hook)},'end']}; -lexpr({'receive',_,Cs}, _, Hook) -> - {list,[{step,'receive',cr_clauses(Cs, Hook)},'end']}; -lexpr({'receive',_,Cs,To,ToOpt}, _, Hook) -> - Al = {list,[{step,[lexpr(To, Hook),' ->'],body(ToOpt, Hook)}]}, - {list,[{step,'receive',cr_clauses(Cs, Hook)}, +lexpr({'cond',_,Cs}, _, Opts) -> + {list,[{step,leaf("cond"),cond_clauses(Cs, Opts)},'end']}; +lexpr({'receive',_,Cs}, _, Opts) -> + {list,[{step,'receive',cr_clauses(Cs, Opts)},'end']}; +lexpr({'receive',_,Cs,To,ToOpt}, _, Opts) -> + Al = {list,[{step,[lexpr(To, Opts),' ->'],body(ToOpt, Opts)}]}, + {list,[{step,'receive',cr_clauses(Cs, Opts)}, {step,'after',Al}, 'end']}; -lexpr({'fun',_,{function,F,A}}, _Prec, _Hook) -> +lexpr({'fun',_,{function,F,A}}, _Prec, _Opts) -> leaf(format("fun ~w/~w", [F,A])); -lexpr({'fun',_,{function,F,A},Extra}, _Prec, _Hook) -> +lexpr({'fun',_,{function,F,A},Extra}, _Prec, _Opts) -> {force_nl,fun_info(Extra),leaf(format("fun ~w/~w", [F,A]))}; -lexpr({'fun',_,{function,M,F,A}}, _Prec, _Hook) +lexpr({'fun',_,{function,M,F,A}}, _Prec, _Opts) when is_atom(M), is_atom(F), is_integer(A) -> %% For backward compatibility with pre-R15 abstract format. leaf(format("fun ~w:~w/~w", [M,F,A])); -lexpr({'fun',_,{function,M,F,A}}, _Prec, Hook) -> +lexpr({'fun',_,{function,M,F,A}}, _Prec, Opts) -> %% New format in R15. - NameItem = lexpr(M, Hook), - CallItem = lexpr(F, Hook), - ArityItem = lexpr(A, Hook), + NameItem = lexpr(M, Opts), + CallItem = lexpr(F, Opts), + ArityItem = lexpr(A, Opts), ["fun ",NameItem,$:,CallItem,$/,ArityItem]; -lexpr({'fun',_,{clauses,Cs}}, _Prec, Hook) -> - {list,[{first,'fun',fun_clauses(Cs, Hook)},'end']}; -lexpr({'fun',_,{clauses,Cs},Extra}, _Prec, Hook) -> +lexpr({'fun',_,{clauses,Cs}}, _Prec, Opts) -> + {list,[{first,'fun',fun_clauses(Cs, Opts, unnamed)},'end']}; +lexpr({named_fun,_,Name,Cs}, _Prec, Opts) -> + {list,[{first,['fun', " "],fun_clauses(Cs, Opts, {named, Name})},'end']}; +lexpr({'fun',_,{clauses,Cs},Extra}, _Prec, Opts) -> + {force_nl,fun_info(Extra), + {list,[{first,'fun',fun_clauses(Cs, Opts, unnamed)},'end']}}; +lexpr({named_fun,_,Name,Cs,Extra}, _Prec, Opts) -> {force_nl,fun_info(Extra), - {list,[{first,'fun',fun_clauses(Cs, Hook)},'end']}}; -lexpr({'query',_,Lc}, _Prec, Hook) -> - {list,[{step,leaf("query"),lexpr(Lc, 0, Hook)},'end']}; -lexpr({call,_,{remote,_,{atom,_,M},{atom,_,F}=N}=Name,Args}, Prec, Hook) -> + {list,[{first,['fun', " "],fun_clauses(Cs, Opts, {named, Name})},'end']}}; +lexpr({'query',_,Lc}, _Prec, Opts) -> + {list,[{step,leaf("query"),lexpr(Lc, 0, Opts)},'end']}; +lexpr({call,_,{remote,_,{atom,_,M},{atom,_,F}=N}=Name,Args}, Prec, Opts) -> case erl_internal:bif(M, F, length(Args)) of true -> - call(N, Args, Prec, Hook); + call(N, Args, Prec, Opts); false -> - call(Name, Args, Prec, Hook) + call(Name, Args, Prec, Opts) end; -lexpr({call,_,Name,Args}, Prec, Hook) -> - call(Name, Args, Prec, Hook); -lexpr({'try',_,Es,Scs,Ccs,As}, _, Hook) -> +lexpr({call,_,Name,Args}, Prec, Opts) -> + call(Name, Args, Prec, Opts); +lexpr({'try',_,Es,Scs,Ccs,As}, _, Opts) -> {list,[if Scs =:= [] -> - {step,'try',body(Es, Hook)}; + {step,'try',body(Es, Opts)}; true -> - {step,{list,[{step,'try',body(Es, Hook)},'of']}, - cr_clauses(Scs, Hook)} + {step,{list,[{step,'try',body(Es, Opts)},'of']}, + cr_clauses(Scs, Opts)} end, if Ccs =:= [] -> []; true -> - {step,'catch',try_clauses(Ccs, Hook)} + {step,'catch',try_clauses(Ccs, Opts)} end, if As =:= [] -> []; true -> - {step,'after',body(As, Hook)} + {step,'after',body(As, Opts)} end, 'end']}; -lexpr({'catch',_,Expr}, Prec, Hook) -> +lexpr({'catch',_,Expr}, Prec, Opts) -> {P,R} = preop_prec('catch'), - El = {list,[{step,'catch',lexpr(Expr, R, Hook)}]}, + El = {list,[{step,'catch',lexpr(Expr, R, Opts)}]}, maybe_paren(P, Prec, El); -lexpr({match,_,Lhs,Rhs}, Prec, Hook) -> +lexpr({match,_,Lhs,Rhs}, Prec, Opts) -> {L,P,R} = inop_prec('='), - Pl = lexpr(Lhs, L, Hook), - Rl = lexpr(Rhs, R, Hook), + Pl = lexpr(Lhs, L, Opts), + Rl = lexpr(Rhs, R, Opts), El = {list,[{cstep,[Pl,' ='],Rl}]}, maybe_paren(P, Prec, El); -lexpr({op,_,Op,Arg}, Prec, Hook) -> +lexpr({op,_,Op,Arg}, Prec, Opts) -> {P,R} = preop_prec(Op), Ol = leaf(format("~s ", [Op])), - El = [Ol,lexpr(Arg, R, Hook)], + El = [Ol,lexpr(Arg, R, Opts)], maybe_paren(P, Prec, El); -lexpr({op,_,Op,Larg,Rarg}, Prec, Hook) when Op =:= 'orelse'; +lexpr({op,_,Op,Larg,Rarg}, Prec, Opts) when Op =:= 'orelse'; Op =:= 'andalso' -> %% Breaks lines since R12B. {L,P,R} = inop_prec(Op), - Ll = lexpr(Larg, L, Hook), + Ll = lexpr(Larg, L, Opts), Ol = leaf(format("~s", [Op])), - Lr = lexpr(Rarg, R, Hook), + Lr = lexpr(Rarg, R, Opts), El = {prefer_nl,[[]],[Ll,Ol,Lr]}, maybe_paren(P, Prec, El); -lexpr({op,_,Op,Larg,Rarg}, Prec, Hook) -> +lexpr({op,_,Op,Larg,Rarg}, Prec, Opts) -> {L,P,R} = inop_prec(Op), - Ll = lexpr(Larg, L, Hook), + Ll = lexpr(Larg, L, Opts), Ol = leaf(format("~s", [Op])), - Lr = lexpr(Rarg, R, Hook), + Lr = lexpr(Rarg, R, Opts), El = {list,[Ll,Ol,Lr]}, maybe_paren(P, Prec, El); %% Special expressions which are not really legal everywhere. -lexpr({remote,_,M,F}, Prec, Hook) -> +lexpr({remote,_,M,F}, Prec, Opts) -> {L,P,R} = inop_prec(':'), - NameItem = lexpr(M, L, Hook), - CallItem = lexpr(F, R, Hook), + NameItem = lexpr(M, L, Opts), + CallItem = lexpr(F, R, Opts), maybe_paren(P, Prec, [NameItem,$:,CallItem]); %% BIT SYNTAX: -lexpr({bin,_,Fs}, _, Hook) -> - bit_grp(Fs, Hook); +lexpr({bin,_,Fs}, _, Opts) -> + bit_grp(Fs, Opts); %% Special case for straight values. lexpr({value,_,Val}, _,_) -> leaf(write(Val)); %% Now do the hook. -lexpr(Other, _Precedence, none) -> +lexpr(Other, _Precedence, #options{hook = none}) -> leaf(format("INVALID-FORM:~w:",[Other])); -lexpr(HookExpr, Precedence, {Mod,Func,Eas}) when Mod =/= 'fun' -> +lexpr(HookExpr, Precedence, #options{hook = {Mod,Func,Eas}}) + when Mod =/= 'fun' -> {ehook,HookExpr,Precedence,{Mod,Func,Eas}}; -lexpr(HookExpr, Precedence, Func) -> - {hook,HookExpr,Precedence,Func}. +lexpr(HookExpr, Precedence, #options{hook = Func, opts = Options}) -> + {hook,HookExpr,Precedence,Func,Options}. -call(Name, Args, Prec, Hook) -> +call(Name, Args, Prec, Opts) -> {F,P} = func_prec(), - Item = {first,lexpr(Name, F, Hook),args(Args, Hook)}, + Item = {first,lexpr(Name, F, Opts),args(Args, Opts)}, maybe_paren(P, Prec, Item). fun_info(Extra) -> @@ -565,32 +669,18 @@ fun_info(Extra) -> %% BITS: -bit_grp(Fs, Hook) -> - append([['<<'], - [try - true = Fs =/= [], - S = bin_string(Fs), - true = io_lib:printable_list(S), - {string,S} - catch _:_ -> - bit_elems(Fs, Hook) - end], - ['>>']]). - -bin_string([]) -> - []; -bin_string([{bin_element,_,{char,_,C},_,_}|Bin]) -> - [C | bin_string(Bin)]. +bit_grp(Fs, Opts) -> + append([['<<'], [bit_elems(Fs, Opts)], ['>>']]). -bit_elems(Es, Hook) -> - expr_list(Es, $,, fun bit_elem/2, Hook). +bit_elems(Es, Opts) -> + expr_list(Es, $,, fun bit_elem/2, Opts). -bit_elem({bin_element,_,Expr,Sz,Types}, Hook) -> +bit_elem({bin_element,_,Expr,Sz,Types}, Opts) -> P = max_prec(), - VChars = lexpr(Expr, P, Hook), + VChars = lexpr(Expr, P, Opts), SChars = if Sz =/= default -> - [VChars,$:,lexpr(Sz, P, Hook)]; + [VChars,$:,lexpr(Sz, P, Opts)]; true -> VChars end, @@ -607,168 +697,183 @@ bit_elem_types([T | Rest]) -> [bit_elem_type(T), $-|bit_elem_types(Rest)]. bit_elem_type({A,B}) -> - [lexpr(erl_parse:abstract(A), none), + [lexpr(erl_parse:abstract(A), options(none)), $:, - lexpr(erl_parse:abstract(B), none)]; + lexpr(erl_parse:abstract(B), options(none))]; bit_elem_type(T) -> - lexpr(erl_parse:abstract(T), none). + lexpr(erl_parse:abstract(T), options(none)). %% end of BITS record_name(Name) -> leaf(format("#~w", [Name])). -record_fields(Fs, Hook) -> - tuple(Fs, fun record_field/2, Hook). +record_fields(Fs, Opts) -> + tuple(Fs, fun record_field/2, Opts). -record_field({record_field,_,F,Val}, Hook) -> +record_field({record_field,_,F,Val}, Opts) -> {L,_P,R} = inop_prec('='), - Fl = lexpr(F, L, Hook), - Vl = lexpr(Val, R, Hook), + Fl = lexpr(F, L, Opts), + Vl = lexpr(Val, R, Opts), {list,[{cstep,[Fl,' ='],Vl}]}; -record_field({typed_record_field,{record_field,_,F,Val},Type}, Hook) -> +record_field({typed_record_field,{record_field,_,F,Val},Type}, Opts) -> {L,_P,R} = inop_prec('='), - Fl = lexpr(F, L, Hook), - Vl = typed(lexpr(Val, R, Hook), Type), + Fl = lexpr(F, L, Opts), + Vl = typed(lexpr(Val, R, Opts), Type), {list,[{cstep,[Fl,' ='],Vl}]}; -record_field({typed_record_field,Field,Type}, Hook) -> - typed(record_field(Field, Hook), Type); -record_field({record_field,_,F}, Hook) -> - lexpr(F, 0, Hook). - -list({cons,_,H,T}, Es, Hook) -> - list(T, [H|Es], Hook); -list({nil,_}, Es, Hook) -> - proper_list(reverse(Es), Hook); -list(Other, Es, Hook) -> - improper_list(reverse(Es, [Other]), Hook). - -%% if_clauses(Clauses, Hook) -> [Char]. +record_field({typed_record_field,Field,Type}, Opts) -> + typed(record_field(Field, Opts), Type); +record_field({record_field,_,F}, Opts) -> + lexpr(F, 0, Opts). + +map_fields(Fs, Opts) -> + tuple(Fs, fun map_field/2, Opts). + +map_field({map_field_assoc,_,K,V}, Opts) -> + Pl = lexpr(K, 0, Opts), + {list,[{step,[Pl,leaf(" =>")],lexpr(V, 0, Opts)}]}; +map_field({map_field_exact,_,K,V}, Opts) -> + Pl = lexpr(K, 0, Opts), + {list,[{step,[Pl,leaf(" :=")],lexpr(V, 0, Opts)}]}. + +list({cons,_,H,T}, Es, Opts) -> + list(T, [H|Es], Opts); +list({nil,_}, Es, Opts) -> + proper_list(reverse(Es), Opts); +list(Other, Es, Opts) -> + improper_list(reverse(Es, [Other]), Opts). + +%% if_clauses(Clauses, Opts) -> [Char]. %% Print 'if' clauses. -if_clauses(Cs, Hook) -> - clauses(fun if_clause/2, Hook, Cs). +if_clauses(Cs, Opts) -> + clauses(fun if_clause/2, Opts, Cs). -if_clause({clause,_,[],G,B}, Hook) -> - Gl = [guard_no_when(G, Hook),' ->'], - {step,Gl,body(B, Hook)}. +if_clause({clause,_,[],G,B}, Opts) -> + Gl = [guard_no_when(G, Opts),' ->'], + {step,Gl,body(B, Opts)}. -guard_no_when([E|Es], Hook) when is_list(E) -> - expr_list([E|Es], $;, fun guard0/2, Hook); -guard_no_when([E|Es], Hook) -> % before R6 - guard_no_when([[E|Es]], Hook); +guard_no_when([E|Es], Opts) when is_list(E) -> + expr_list([E|Es], $;, fun guard0/2, Opts); +guard_no_when([E|Es], Opts) -> % before R6 + guard_no_when([[E|Es]], Opts); guard_no_when([], _) -> % cannot happen leaf("true"). -%% cr_clauses(Clauses, Hook) -> [Char]. +%% cr_clauses(Clauses, Opts) -> [Char]. %% Print 'case'/'receive' clauses. -cr_clauses(Cs, Hook) -> - clauses(fun cr_clause/2, Hook, Cs). +cr_clauses(Cs, Opts) -> + clauses(fun cr_clause/2, Opts, Cs). -cr_clause({clause,_,[T],G,B}, Hook) -> - El = lexpr(T, 0, Hook), - Gl = guard_when(El, G, Hook), - Bl = body(B, Hook), +cr_clause({clause,_,[T],G,B}, Opts) -> + El = lexpr(T, 0, Opts), + Gl = guard_when(El, G, Opts), + Bl = body(B, Opts), {step,Gl,Bl}. -%% try_clauses(Clauses, Hook) -> [Char]. +%% try_clauses(Clauses, Opts) -> [Char]. %% Print 'try' clauses. -try_clauses(Cs, Hook) -> - clauses(fun try_clause/2, Hook, Cs). +try_clauses(Cs, Opts) -> + clauses(fun try_clause/2, Opts, Cs). -try_clause({clause,_,[{tuple,_,[{atom,_,throw},V,S]}],G,B}, Hook) -> - El = lexpr(V, 0, Hook), - Sl = stack_backtrace(S, [El], Hook), - Gl = guard_when(Sl, G, Hook), - Bl = body(B, Hook), +try_clause({clause,_,[{tuple,_,[{atom,_,throw},V,S]}],G,B}, Opts) -> + El = lexpr(V, 0, Opts), + Sl = stack_backtrace(S, [El], Opts), + Gl = guard_when(Sl, G, Opts), + Bl = body(B, Opts), {step,Gl,Bl}; -try_clause({clause,_,[{tuple,_,[C,V,S]}],G,B}, Hook) -> - Cs = lexpr(C, 0, Hook), - El = lexpr(V, 0, Hook), +try_clause({clause,_,[{tuple,_,[C,V,S]}],G,B}, Opts) -> + Cs = lexpr(C, 0, Opts), + El = lexpr(V, 0, Opts), CsEl = [Cs,$:,El], - Sl = stack_backtrace(S, CsEl, Hook), - Gl = guard_when(Sl, G, Hook), - Bl = body(B, Hook), + Sl = stack_backtrace(S, CsEl, Opts), + Gl = guard_when(Sl, G, Opts), + Bl = body(B, Opts), {step,Gl,Bl}. -stack_backtrace({var,_,'_'}, El, _Hook) -> +stack_backtrace({var,_,'_'}, El, _Opts) -> El; -stack_backtrace(S, El, Hook) -> - El++[$:,lexpr(S, 0, Hook)]. +stack_backtrace(S, El, Opts) -> + El++[$:,lexpr(S, 0, Opts)]. -%% fun_clauses(Clauses, Hook) -> [Char]. +%% fun_clauses(Clauses, Opts) -> [Char]. %% Print 'fun' clauses. -fun_clauses(Cs, Hook) -> - nl_clauses(fun fun_clause/2, [$;], Hook, Cs). - -fun_clause({clause,_,A,G,B}, Hook) -> - El = args(A, Hook), - Gl = guard_when(El, G, Hook), - Bl = body(B, Hook), +fun_clauses(Cs, Opts, unnamed) -> + nl_clauses(fun fun_clause/2, [$;], Opts, Cs); +fun_clauses(Cs, Opts, {named, Name}) -> + nl_clauses(fun (C, H) -> + {step,Gl,Bl} = fun_clause(C, H), + {step,[atom_to_list(Name),Gl],Bl} + end, [$;], Opts, Cs). + +fun_clause({clause,_,A,G,B}, Opts) -> + El = args(A, Opts), + Gl = guard_when(El, G, Opts), + Bl = body(B, Opts), {step,Gl,Bl}. -%% cond_clauses(Clauses, Hook) -> [Char]. +%% cond_clauses(Clauses, Opts) -> [Char]. %% Print 'cond' clauses. -cond_clauses(Cs, Hook) -> - clauses(fun cond_clause/2, Hook, Cs). +cond_clauses(Cs, Opts) -> + clauses(fun cond_clause/2, Opts, Cs). -cond_clause({clause,_,[],[[E]],B}, Hook) -> - {step,[lexpr(E, Hook),' ->'],body(B, Hook)}. +cond_clause({clause,_,[],[[E]],B}, Opts) -> + {step,[lexpr(E, Opts),' ->'],body(B, Opts)}. -%% nl_clauses(Type, Hook, Clauses) -> [Char]. +%% nl_clauses(Type, Opts, Clauses) -> [Char]. %% Generic clause printing function (always breaks lines). -nl_clauses(Type, Sep, Hook, Cs) -> - {prefer_nl,Sep,lexprs(Cs, Type, Hook)}. +nl_clauses(Type, Sep, Opts, Cs) -> + {prefer_nl,Sep,lexprs(Cs, Type, Opts)}. -%% clauses(Type, Hook, Clauses) -> [Char]. +%% clauses(Type, Opts, Clauses) -> [Char]. %% Generic clause printing function (breaks lines since R12B). -clauses(Type, Hook, Cs) -> - {prefer_nl,[$;],lexprs(Cs, Type, Hook)}. +clauses(Type, Opts, Cs) -> + {prefer_nl,[$;],lexprs(Cs, Type, Opts)}. -%% lc_quals(Qualifiers, After, Hook) +%% lc_quals(Qualifiers, After, Opts) %% List comprehension qualifiers (breaks lines since R12B). -lc_quals(Qs, Hook) -> - {prefer_nl,[$,],lexprs(Qs, fun lc_qual/2, Hook)}. +lc_quals(Qs, Opts) -> + {prefer_nl,[$,],lexprs(Qs, fun lc_qual/2, Opts)}. -lc_qual({b_generate,_,Pat,E}, Hook) -> - Pl = lexpr(Pat, 0, Hook), - {list,[{step,[Pl,leaf(" <=")],lexpr(E, 0, Hook)}]}; -lc_qual({generate,_,Pat,E}, Hook) -> - Pl = lexpr(Pat, 0, Hook), - {list,[{step,[Pl,leaf(" <-")],lexpr(E, 0, Hook)}]}; -lc_qual(Q, Hook) -> - lexpr(Q, 0, Hook). +lc_qual({b_generate,_,Pat,E}, Opts) -> + Pl = lexpr(Pat, 0, Opts), + {list,[{step,[Pl,leaf(" <=")],lexpr(E, 0, Opts)}]}; +lc_qual({generate,_,Pat,E}, Opts) -> + Pl = lexpr(Pat, 0, Opts), + {list,[{step,[Pl,leaf(" <-")],lexpr(E, 0, Opts)}]}; +lc_qual(Q, Opts) -> + lexpr(Q, 0, Opts). -proper_list(Es, Hook) -> - {seq,$[,$],$,,lexprs(Es, Hook)}. +proper_list(Es, Opts) -> + {seq,$[,$],$,,lexprs(Es, Opts)}. -improper_list(Es, Hook) -> - {seq,$[,$],{$,,$|},lexprs(Es, Hook)}. +improper_list(Es, Opts) -> + {seq,$[,$],{$,,$|},lexprs(Es, Opts)}. -tuple(L, Hook) -> - tuple(L, fun lexpr/2, Hook). +tuple(L, Opts) -> + tuple(L, fun lexpr/2, Opts). -tuple(Es, F, Hook) -> - {seq,${,$},$,,lexprs(Es, F, Hook)}. +tuple(Es, F, Opts) -> + {seq,${,$},$,,lexprs(Es, F, Opts)}. -args(As, Hook) -> - {seq,$(,$),[$,],lexprs(As, Hook)}. +args(As, Opts) -> + {seq,$(,$),[$,],lexprs(As, Opts)}. -expr_list(Es, Sep, F, Hook) -> - {seq,[],[],Sep,lexprs(Es, F, Hook)}. +expr_list(Es, Sep, F, Opts) -> + {seq,[],[],Sep,lexprs(Es, F, Opts)}. -lexprs(Es, Hook) -> - lexprs(Es, fun lexpr/2, Hook). +lexprs(Es, Opts) -> + lexprs(Es, fun lexpr/2, Opts). -lexprs(Es, F, Hook) -> - [F(E, Hook) || E <- Es]. +lexprs(Es, F, Opts) -> + [F(E, Opts) || E <- Es]. maybe_paren(P, Prec, Expr) when P < Prec -> [$(,Expr,$)]; @@ -776,18 +881,18 @@ maybe_paren(_P, _Prec, Expr) -> Expr. leaf(S) -> - {leaf,iolist_size(S),S}. + {leaf,chars_size(S),S}. %%% Do the formatting. Currently nothing fancy. Could probably have %%% done it in one single pass. -frmt(Item) -> - frmt(Item, 0). +frmt(Item, PP) -> + frmt(Item, 0, PP). -frmt(Item, I) -> +frmt(Item, I, PP) -> ST = spacetab(), WT = wordtable(), - {Chars,_Length} = f(Item, I, ST, WT), + {Chars,_Length} = f(Item, I, ST, WT, PP), [Chars]. %%% What the tags mean: @@ -803,6 +908,7 @@ frmt(Item, I) -> %%% - {force_nl,ExtraInfo,I}: fun-info (a comment) forces linebreak before I. %%% - {prefer_nl,Sep,IPs}: forces linebreak between Is unlesss negative %%% indentation. +%%% - {char,C}: a character %%% - {string,S}: a string. %%% - {hook,...}, {ehook,...}: hook expressions. %%% @@ -812,22 +918,22 @@ frmt(Item, I) -> %%% cstep works similarly, but no linebreak if the width of I1 is less %%% than the indentation (this is for "A = <expression over several lines>). -f([]=Nil, _I0, _ST, _WT) -> +f([]=Nil, _I0, _ST, _WT, _PP) -> {Nil,0}; -f(C, _I0, _ST, _WT) when is_integer(C) -> +f(C, _I0, _ST, _WT, _PP) when is_integer(C) -> {C,1}; -f({leaf,Length,Chars}, _I0, _ST, _WT) -> +f({leaf,Length,Chars}, _I0, _ST, _WT, _PP) -> {Chars,Length}; -f([Item|Items], I0, ST, WT) -> - consecutive(Items, f(Item, I0, ST, WT), I0, ST, WT); -f({list,Items}, I0, ST, WT) -> - f({seq,[],[],[[]],Items}, I0, ST, WT); -f({first,E,Item}, I0, ST, WT) -> - f({seq,E,[],[[]],[Item]}, I0, ST, WT); -f({seq,Before,After,Sep,LItems}, I0, ST, WT) -> - BCharsSize = f(Before, I0, ST, WT), +f([Item|Items], I0, ST, WT, PP) -> + consecutive(Items, f(Item, I0, ST, WT, PP), I0, ST, WT, PP); +f({list,Items}, I0, ST, WT, PP) -> + f({seq,[],[],[[]],Items}, I0, ST, WT, PP); +f({first,E,Item}, I0, ST, WT, PP) -> + f({seq,E,[],[[]],[Item]}, I0, ST, WT, PP); +f({seq,Before,After,Sep,LItems}, I0, ST, WT, PP) -> + BCharsSize = f(Before, I0, ST, WT, PP), I = indent(BCharsSize, I0), - CharsSizeL = fl(LItems, Sep, I, After, ST, WT), + CharsSizeL = fl(LItems, Sep, I, After, ST, WT, PP), {CharsL,SizeL} = unz(CharsSizeL), {BCharsL,BSizeL} = unz1([BCharsSize]), Sizes = BSizeL ++ SizeL, @@ -848,15 +954,15 @@ f({seq,Before,After,Sep,LItems}, I0, ST, WT) -> {BCharsL++insert_newlines(CharsSizeL, I, ST), nsz(lists:last(Sizes), I0)} end; -f({force_nl,_ExtraInfoItem,Item}, I, ST, WT) when I < 0 -> +f({force_nl,_ExtraInfoItem,Item}, I, ST, WT, PP) when I < 0 -> %% Extra info is a comment; cannot have that on the same line - f(Item, I, ST, WT); -f({force_nl,ExtraInfoItem,Item}, I, ST, WT) -> - f({prefer_nl,[],[ExtraInfoItem,Item]}, I, ST, WT); -f({prefer_nl,Sep,LItems}, I, ST, WT) when I < 0 -> - f({seq,[],[],Sep,LItems}, I, ST, WT); -f({prefer_nl,Sep,LItems}, I0, ST, WT) -> - CharsSize2L = fl(LItems, Sep, I0, [], ST, WT), + f(Item, I, ST, WT, PP); +f({force_nl,ExtraInfoItem,Item}, I, ST, WT, PP) -> + f({prefer_nl,[],[ExtraInfoItem,Item]}, I, ST, WT, PP); +f({prefer_nl,Sep,LItems}, I, ST, WT, PP) when I < 0 -> + f({seq,[],[],Sep,LItems}, I, ST, WT, PP); +f({prefer_nl,Sep,LItems}, I0, ST, WT, PP) -> + CharsSize2L = fl(LItems, Sep, I0, [], ST, WT, PP), {_CharsL,Sizes} = unz(CharsSize2L), if Sizes =:= [] -> @@ -864,37 +970,40 @@ f({prefer_nl,Sep,LItems}, I0, ST, WT) -> true -> {insert_newlines(CharsSize2L, I0, ST),nsz(lists:last(Sizes), I0)} end; -f({string,S}, I, ST, WT) -> - f(write_a_string(S, I), I, ST, WT); -f({hook,HookExpr,Precedence,Func}, I, _ST, _WT) -> - Chars = Func(HookExpr, I, Precedence, Func), +f({char,C}, I, ST, WT, PP) -> + f(write_a_char(C, PP), I, ST, WT, PP); +f({string,S}, I, ST, WT, PP) -> + f(write_a_string(S, I, PP), I, ST, WT, PP); +f({hook,HookExpr,Precedence,Func,Options}, I, _ST, _WT, _PP) -> + Chars = Func(HookExpr, I, Precedence, Options), {Chars,indentation(Chars, I)}; -f({ehook,HookExpr,Precedence,{Mod,Func,Eas}=ModFuncEas}, I, _ST, _WT) -> +f({ehook,HookExpr,Precedence,{Mod,Func,Eas}=ModFuncEas}, I, _ST, _WT, _PP) -> Chars = apply(Mod, Func, [HookExpr,I,Precedence,ModFuncEas|Eas]), {Chars,indentation(Chars, I)}; -f(WordName, _I, _ST, WT) -> % when is_atom(WordName) +f(WordName, _I, _ST, WT, _PP) -> % when is_atom(WordName) word(WordName, WT). -define(IND, 4). %% fl(ListItems, I0, ST, WT) -> [[CharsSize1,CharsSize2]] %% ListItems = [{Item,Items}|Item] -fl([], _Sep, I0, After, ST, WT) -> - [[f(After, I0, ST, WT),{[],0}]]; -fl(CItems, Sep0, I0, After, ST, WT) -> +fl([], _Sep, I0, After, ST, WT, PP) -> + [[f(After, I0, ST, WT, PP),{[],0}]]; +fl(CItems, Sep0, I0, After, ST, WT, PP) -> F = fun({step,Item1,Item2}, S) -> - [f(Item1, I0, ST, WT),f([Item2,S], incr(I0, ?IND), ST, WT)]; + [f(Item1, I0, ST, WT, PP), + f([Item2,S], incr(I0, ?IND), ST, WT, PP)]; ({cstep,Item1,Item2}, S) -> - {_,Sz1} = CharSize1 = f(Item1, I0, ST, WT), + {_,Sz1} = CharSize1 = f(Item1, I0, ST, WT, PP), if is_integer(Sz1), Sz1 < ?IND -> Item2p = [leaf("\s"),Item2,S], - [consecutive(Item2p, CharSize1, I0, ST, WT),{[],0}]; + [consecutive(Item2p, CharSize1, I0, ST, WT, PP),{[],0}]; true -> - [CharSize1,f([Item2,S], incr(I0, ?IND), ST, WT)] + [CharSize1,f([Item2,S], incr(I0, ?IND), ST, WT, PP)] end; (Item, S) -> - [f([Item,S], I0, ST, WT),{[],0}] + [f([Item,S], I0, ST, WT, PP),{[],0}] end, {Sep,LastSep} = case Sep0 of {_,_} -> Sep0; _ -> {Sep0,Sep0} end, fl1(CItems, F, Sep, LastSep, After). @@ -906,10 +1015,10 @@ fl1([CItem1,CItem2], F, _Sep, LastSep, After) -> fl1([CItem|CItems], F, Sep, LastSep, After) -> [F(CItem, Sep)|fl1(CItems, F, Sep, LastSep, After)]. -consecutive(Items, CharSize1, I0, ST, WT) -> +consecutive(Items, CharSize1, I0, ST, WT, PP) -> {CharsSizes,_Length} = mapfoldl(fun(Item, Len) -> - CharsSize = f(Item, Len, ST, WT), + CharsSize = f(Item, Len, ST, WT, PP), {CharsSize,indent(CharsSize, Len)} end, indent(CharSize1, I0), Items), {CharsL,SizeL} = unz1([CharSize1|CharsSizes]), @@ -982,7 +1091,7 @@ incr(I, Incr) -> I+Incr. indentation(E, I) when I < 0 -> - iolist_size(E); + chars_size(E); indentation(E, I0) -> I = io_lib_format:indentation(E, I0), case has_nl(E) of @@ -999,30 +1108,56 @@ has_nl([C|Cs]) -> has_nl([]) -> false. +write_a_char(C, PP) -> + flat_leaf(write_char(C, PP)). + -define(MIN_SUBSTRING, 5). -write_a_string(S, I) when I < 0; S =:= [] -> - leaf(write_string(S)); -write_a_string(S, I) -> +write_a_string(S, I, PP) when I < 0; S =:= [] -> + flat_leaf(write_string(S, PP)); +write_a_string(S, I, PP) -> Len = erlang:max(?MAXLINE-I, ?MIN_SUBSTRING), - {list,write_a_string(S, Len, Len)}. + {list,write_a_string(S, Len, Len, PP)}. -write_a_string([], _N, _Len) -> +write_a_string([], _N, _Len, _PP) -> []; -write_a_string(S, N, Len) -> +write_a_string(S, N, Len, PP) -> SS = string:sub_string(S, 1, N), - Sl = write_string(SS), - case (iolist_size(Sl) > Len) and (N > ?MIN_SUBSTRING) of + Sl = write_string(SS, PP), + case (length(Sl) > Len) and (N > ?MIN_SUBSTRING) of true -> - write_a_string(S, N-1, Len); + write_a_string(S, N-1, Len, PP); false -> - [leaf(Sl)|write_a_string(lists:nthtail(length(SS), S), Len, Len)] + [flat_leaf(Sl) | + write_a_string(lists:nthtail(length(SS), S), Len, Len, PP)] end. +flat_leaf(S) -> + L = lists:flatten(S), + {leaf,length(L),L}. + +write_string(S, PP) -> + lists:flatten((PP#pp.string_fun)(S)). + +write_char(C, PP) -> + lists:flatten((PP#pp.char_fun)(C)). + %% %% Utilities %% +a0() -> + erl_anno:new(0). + +chars_size([C | Es]) when is_integer(C) -> + 1 + chars_size(Es); +chars_size([E | Es]) -> + chars_size(E) + chars_size(Es); +chars_size([]) -> + 0; +chars_size(B) when is_binary(B) -> + byte_size(B). + -define(N_SPACES, 30). spacetab() -> diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index 8e59e01f48..47223b129c 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -32,30 +33,38 @@ %% 173 - 176 { - ~ punctuation %% 177 DEL control %% 200 - 237 control -%% 240 - 277 NBSP - � punctuation -%% 300 - 326 � - � uppercase -%% 327 � punctuation -%% 330 - 336 � - � uppercase -%% 337 - 366 � - � lowercase -%% 367 � punctuation -%% 370 - 377 � - � lowercase +%% 240 - 277 NBSP - ¿ punctuation +%% 300 - 326 À - Ö uppercase +%% 327 × punctuation +%% 330 - 336 Ø - Þ uppercase +%% 337 - 366 ß - ö lowercase +%% 367 ÷ punctuation +%% 370 - 377 ø - ÿ lowercase %% %% Many punctuation characters have special meaning: %% $\s, $_, $", $$, $%, $', $. %% DEL is a punctuation. %% -%% Must watch using � \327, very close to x \170. +%% Must watch using × \327, very close to x \170. -module(erl_scan). %%% External exports -export([string/1,string/2,string/3,tokens/3,tokens/4, - format_error/1,reserved_word/1, - token_info/1,token_info/2, - attributes_info/1,attributes_info/2,set_attribute/3]). + format_error/1,reserved_word/1]). + +-export([column/1,end_location/1,line/1,location/1,text/1, + category/1,symbol/1]). --export_type([error_info/0, line/0, tokens_result/0]). +%%% Private +-export([continuation_location/1]). + +-export_type([error_info/0, + options/0, + return_cont/0, + token/0, + tokens_result/0]). %%% %%% Defines and type definitions @@ -66,29 +75,18 @@ -define(ALINE(L), is_integer(L)). -define(STRING(S), is_list(S)). -define(RESWORDFUN(F), is_function(F, 1)). --define(SETATTRFUN(F), is_function(F, 1)). -type category() :: atom(). --type column() :: pos_integer(). --type line() :: integer(). --type location() :: line() | {line(),column()}. -type resword_fun() :: fun((atom()) -> boolean()). -type option() :: 'return' | 'return_white_spaces' | 'return_comments' | 'text' | {'reserved_word_fun', resword_fun()}. -type options() :: option() | [option()]. -type symbol() :: atom() | float() | integer() | string(). --type info_line() :: integer() | term(). --type attributes_data() - :: [{'column', column()} | {'line', info_line()} | {'text', string()}] - | {line(), column()}. -%% The fact that {line(),column()} is a possible attributes() type -%% is hidden. --type attributes() :: line() | attributes_data(). --type token() :: {category(), attributes(), symbol()} - | {category(), attributes()}. +-type token() :: {category(), Anno :: erl_anno:anno(), symbol()} + | {category(), Anno :: erl_anno:anno()}. -type tokens() :: [token()]. -type error_description() :: term(). --type error_info() :: {location(), module(), error_description()}. +-type error_info() :: {erl_anno:location(), module(), error_description()}. %%% Local record. -record(erl_scan, @@ -104,7 +102,7 @@ format_error({string,Quote,Head}) -> lists:flatten(["unterminated " ++ string_thing(Quote) ++ " starting with " ++ - io_lib:write_unicode_string(Head, Quote)]); + io_lib:write_string(Head, Quote)]); format_error({illegal,Type}) -> lists:flatten(io_lib:fwrite("illegal ~w", [Type])); format_error(char) -> "unterminated character"; @@ -117,8 +115,8 @@ format_error(Other) -> String :: string(), Return :: {'ok', Tokens :: tokens(), EndLocation} | {'error', ErrorInfo :: error_info(), ErrorLocation}, - EndLocation :: location(), - ErrorLocation :: location(). + EndLocation :: erl_anno:location(), + ErrorLocation :: erl_anno:location(). string(String) -> string(String, 1, []). @@ -126,9 +124,9 @@ string(String) -> String :: string(), Return :: {'ok', Tokens :: tokens(), EndLocation} | {'error', ErrorInfo :: error_info(), ErrorLocation}, - StartLocation :: location(), - EndLocation :: location(), - ErrorLocation :: location(). + StartLocation :: erl_anno:location(), + EndLocation :: erl_anno:location(), + ErrorLocation :: erl_anno:location(). string(String, StartLocation) -> string(String, StartLocation, []). @@ -137,9 +135,9 @@ string(String, StartLocation) -> Options :: options(), Return :: {'ok', Tokens :: tokens(), EndLocation} | {'error', ErrorInfo :: error_info(), ErrorLocation}, - StartLocation :: location(), - EndLocation :: location(), - ErrorLocation :: location(). + StartLocation :: erl_anno:location(), + EndLocation :: erl_anno:location(), + ErrorLocation :: erl_anno:location(). string(String, Line, Options) when ?STRING(String), ?ALINE(Line) -> string1(String, options(Options), Line, no_col, []); string(String, {Line,Column}, Options) when ?STRING(String), @@ -148,20 +146,23 @@ string(String, {Line,Column}, Options) when ?STRING(String), string1(String, options(Options), Line, Column, []). -type char_spec() :: string() | 'eof'. --type cont_fun() :: fun((char_spec(), #erl_scan{}, line(), column(), +-type cont_fun() :: fun((char_spec(), #erl_scan{}, + erl_anno:line(), erl_anno:column(), tokens(), any()) -> any()). -opaque return_cont() :: {erl_scan_continuation, - string(), column(), tokens(), line(), + string(), erl_anno:column(), tokens(), + erl_anno:line(), #erl_scan{}, any(), cont_fun()}. --type tokens_result() :: {'ok', Tokens :: tokens(), EndLocation :: location()} - | {'eof', EndLocation :: location()} +-type tokens_result() :: {'ok', Tokens :: tokens(), + EndLocation :: erl_anno:location()} + | {'eof', EndLocation :: erl_anno:location()} | {'error', ErrorInfo :: error_info(), - EndLocation :: location()}. + EndLocation :: erl_anno:location()}. -spec tokens(Continuation, CharSpec, StartLocation) -> Return when Continuation :: return_cont() | [], CharSpec :: char_spec(), - StartLocation :: location(), + StartLocation :: erl_anno:location(), Return :: {'done',Result :: tokens_result(),LeftOverChars :: char_spec()} | {'more', Continuation1 :: return_cont()}. tokens(Cont, CharSpec, StartLocation) -> @@ -170,7 +171,7 @@ tokens(Cont, CharSpec, StartLocation) -> -spec tokens(Continuation, CharSpec, StartLocation, Options) -> Return when Continuation :: return_cont() | [], CharSpec :: char_spec(), - StartLocation :: location(), + StartLocation :: erl_anno:location(), Options :: options(), Return :: {'done',Result :: tokens_result(),LeftOverChars :: char_spec()} | {'more', Continuation1 :: return_cont()}. @@ -183,134 +184,60 @@ tokens({erl_scan_continuation,Cs,Col,Toks,Line,St,Any,Fun}, CharSpec, _Loc, _Opts) -> tokens1(Cs++CharSpec, St, Line, Col, Toks, Fun, Any). --type attribute_item() :: 'column' | 'length' | 'line' - | 'location' | 'text'. --type info_location() :: location() | term(). --type attribute_info() :: {'column', column()}| {'length', pos_integer()} - | {'line', info_line()} - | {'location', info_location()} - | {'text', string()}. --type token_item() :: 'category' | 'symbol' | attribute_item(). --type token_info() :: {'category', category()} | {'symbol', symbol()} - | attribute_info(). - --spec token_info(Token) -> TokenInfo when - Token :: token(), - TokenInfo :: [TokenInfoTuple :: token_info()]. -token_info(Token) -> - Items = [category,column,length,line,symbol,text], % undefined order - token_info(Token, Items). - --spec token_info(Token, TokenItem) -> TokenInfo | 'undefined' when - Token :: token(), - TokenItem :: token_item(), - TokenInfo :: TokenInfoTuple :: token_info(); - (Token, TokenItems) -> [TokenInfo] when - Token :: token(), - TokenItems :: [TokenItem], - TokenItem :: token_item(), - TokenInfo :: [TokenInfoTuple :: token_info()]. -token_info(_Token, []) -> - []; -token_info(Token, [Item|Items]) when is_atom(Item) -> - case token_info(Token, Item) of - undefined -> - token_info(Token, Items); - TokenInfo when is_tuple(TokenInfo) -> - [TokenInfo|token_info(Token, Items)] - end; -token_info({Category,_Attrs}, category=Item) -> - {Item,Category}; -token_info({Category,_Attrs,_Symbol}, category=Item) -> - {Item,Category}; -token_info({Category,_Attrs}, symbol=Item) -> - {Item,Category}; -token_info({_Category,_Attrs,Symbol}, symbol=Item) -> - {Item,Symbol}; -token_info({_Category,Attrs}, Item) -> - attributes_info(Attrs, Item); -token_info({_Category,Attrs,_Symbol}, Item) -> - attributes_info(Attrs, Item). - --spec attributes_info(Attributes) -> AttributesInfo when - Attributes :: attributes(), - AttributesInfo :: [AttributeInfoTuple :: attribute_info()]. -attributes_info(Attributes) -> - Items = [column,length,line,text], % undefined order - attributes_info(Attributes, Items). - --spec attributes_info(Attributes, AttributeItem) -> - AttributeInfo | 'undefined' when - Attributes :: attributes(), - AttributeItem :: attribute_item(), - AttributeInfo :: AttributeInfoTuple :: attribute_info(); - (Attributes, AttributeItems) -> [AttributeInfo] when - Attributes :: attributes(), - AttributeItems :: [AttributeItem], - AttributeItem :: attribute_item(), - AttributeInfo :: [AttributeInfoTuple :: attribute_info()]. -attributes_info(_Attrs, []) -> - []; -attributes_info(Attrs, [A|As]) when is_atom(A) -> - case attributes_info(Attrs, A) of - undefined -> - attributes_info(Attrs, As); - AttributeInfo when is_tuple(AttributeInfo) -> - [AttributeInfo|attributes_info(Attrs, As)] - end; -attributes_info({Line,Column}, column=Item) when ?ALINE(Line), - ?COLUMN(Column) -> - {Item,Column}; -attributes_info(Line, column) when ?ALINE(Line) -> - undefined; -attributes_info(Attrs, column=Item) -> - attr_info(Attrs, Item); -attributes_info(Attrs, length=Item) -> - case attributes_info(Attrs, text) of - undefined -> - undefined; - {text,Text} -> - {Item,length(Text)} - end; -attributes_info(Line, line=Item) when ?ALINE(Line) -> - {Item,Line}; -attributes_info({Line,Column}, line=Item) when ?ALINE(Line), - ?COLUMN(Column) -> - {Item,Line}; -attributes_info(Attrs, line=Item) -> - attr_info(Attrs, Item); -attributes_info({Line,Column}=Location, location=Item) when ?ALINE(Line), - ?COLUMN(Column) -> - {Item,Location}; -attributes_info(Line, location=Item) when ?ALINE(Line) -> - {Item,Line}; -attributes_info(Attrs, location=Item) -> - {line,Line} = attributes_info(Attrs, line), % assume line is present - case attributes_info(Attrs, column) of - undefined -> - %% If set_attribute() has assigned a term such as {17,42} - %% to 'line', then Line will look like {Line,Column}. One - %% should not use 'location' but 'line' and 'column' in - %% such special cases. - {Item,Line}; - {column,Column} -> - {Item,{Line,Column}} - end; -attributes_info({Line,Column}, text) when ?ALINE(Line), ?COLUMN(Column) -> - undefined; -attributes_info(Line, text) when ?ALINE(Line) -> - undefined; -attributes_info(Attrs, text=Item) -> - attr_info(Attrs, Item); -attributes_info(T1, T2) -> - erlang:error(badarg, [T1,T2]). - --spec set_attribute(AttributeItem, Attributes, SetAttributeFun) -> Attributes when - AttributeItem :: 'line', - Attributes :: attributes(), - SetAttributeFun :: fun((info_line()) -> info_line()). -set_attribute(Tag, Attributes, Fun) when ?SETATTRFUN(Fun) -> - set_attr(Tag, Attributes, Fun). +continuation_location({erl_scan_continuation,_,no_col,_,Line,_,_,_}) -> + Line; +continuation_location({erl_scan_continuation,_,Col,_,Line,_,_,_}) -> + {Line,Col}. + +-spec column(Token) -> erl_anno:column() | 'undefined' when + Token :: token(). + +column(Token) -> + erl_anno:column(element(2, Token)). + +-spec end_location(Token) -> erl_anno:location() | 'undefined' when + Token :: token(). + +end_location(Token) -> + erl_anno:end_location(element(2, Token)). + +-spec line(Token) -> erl_anno:line() when + Token :: token(). + +line(Token) -> + erl_anno:line(element(2, Token)). + +-spec location(Token) -> erl_anno:location() when + Token :: token(). + +location(Token) -> + erl_anno:location(element(2, Token)). + +-spec text(Token) -> erl_anno:text() | 'undefined' when + Token :: token(). + +text(Token) -> + erl_anno:text(element(2, Token)). + +-spec category(Token) -> category() when + Token :: token(). + +category({Category,_Anno}) -> + Category; +category({Category,_Anno,_Symbol}) -> + Category; +category(T) -> + erlang:error(badarg, [T]). + +-spec symbol(Token) -> symbol() when + Token :: token(). + +symbol({Category,_Anno}) -> + Category; +symbol({_Category,_Anno,Symbol}) -> + Symbol; +symbol(T) -> + erlang:error(badarg, [T]). %%% %%% Local functions @@ -324,13 +251,13 @@ string_thing(_) -> "string". (C >= $\000 andalso C =< $\s orelse C >= $\200 andalso C =< $\240)). -define(DIGIT(C), C >= $0, C =< $9). -define(CHAR(C), is_integer(C), C >= 0). +-define(UNICODE(C), + is_integer(C) andalso + (C >= 0 andalso C < 16#D800 orelse + C > 16#DFFF andalso C < 16#FFFE orelse + C > 16#FFFF andalso C =< 16#10FFFF)). -%% A workaround: Unicode strings are not returned as strings, but as -%% lists of integers. For instance, "b\x{aaa}c" => [98,2730,99]. This -%% is to protect the system from character codes greater than 255. To -%% be removed. Search for UNI to find workaround code. --define(NO_UNICODE, 0). --define(UNI255(C), (C) =< 16#ff). +-define(UNI255(C), C >= 0, C =< 16#ff). options(Opts0) when is_list(Opts0) -> Opts = lists:foldr(fun expand_opt/2, [], Opts0), @@ -377,46 +304,6 @@ expand_opt(return, Os) -> expand_opt(O, Os) -> [O|Os]. -attr_info(Attrs, Item) -> - try lists:keyfind(Item, 1, Attrs) of - {_Item, _Value} = T -> - T; - false -> - undefined - catch - _:_ -> - erlang:error(badarg, [Attrs, Item]) - end. - --spec set_attr('line', attributes(), fun((line()) -> line())) -> attributes(). - -set_attr(line, Line, Fun) when ?ALINE(Line) -> - Ln = Fun(Line), - if - ?ALINE(Ln) -> - Ln; - true -> - [{line,Ln}] - end; -set_attr(line, {Line,Column}, Fun) when ?ALINE(Line), ?COLUMN(Column) -> - Ln = Fun(Line), - if - ?ALINE(Ln) -> - {Ln,Column}; - true -> - [{line,Ln},{column,Column}] - end; -set_attr(line=Tag, Attrs, Fun) when is_list(Attrs) -> - {line,Line} = lists:keyfind(Tag, 1, Attrs), - case lists:keyreplace(Tag, 1, Attrs, {line,Fun(Line)}) of - [{line,Ln}] when ?ALINE(Ln) -> - Ln; - As -> - As - end; -set_attr(T1, T2, T3) -> - erlang:error(badarg, [T1,T2,T3]). - tokens1(Cs, St, Line, Col, Toks, Fun, Any) when ?STRING(Cs); Cs =:= eof -> case Fun(Cs, St, Line, Col, Toks, Any) of {more,{Cs0,Ncol,Ntoks,Nline,Nany,Nfun}} -> @@ -504,18 +391,18 @@ scan1("."=Cs, _St, Line, Col, Toks) -> scan1([$.=C|Cs], St, Line, Col, Toks) -> scan_dot(Cs, St, Line, Col, Toks, [C]); scan1([$"|Cs], St, Line, Col, Toks) -> %" Emacs - State0 = {[],[],Line,Col,?NO_UNICODE}, + State0 = {[],[],Line,Col}, scan_string(Cs, St, Line, incr_column(Col, 1), Toks, State0); scan1([$'|Cs], St, Line, Col, Toks) -> %' Emacs - State0 = {[],[],Line,Col,?NO_UNICODE}, + State0 = {[],[],Line,Col}, scan_qatom(Cs, St, Line, incr_column(Col, 1), Toks, State0); scan1([$$|Cs], St, Line, Col, Toks) -> scan_char(Cs, St, Line, Col, Toks); scan1([$\r|Cs], St, Line, Col, Toks) when St#erl_scan.ws -> white_space_end(Cs, St, Line, Col, Toks, 1, "\r"); -scan1([C|Cs], St, Line, Col, Toks) when C >= $�, C =< $�, C =/= $� -> +scan1([C|Cs], St, Line, Col, Toks) when C >= $ß, C =< $ÿ, C =/= $÷ -> scan_atom(Cs, St, Line, Col, Toks, [C]); -scan1([C|Cs], St, Line, Col, Toks) when C >= $�, C =< $�, C /= $� -> +scan1([C|Cs], St, Line, Col, Toks) when C >= $À, C =< $Þ, C /= $× -> scan_variable(Cs, St, Line, Col, Toks, [C]); scan1([$\t|Cs], St, Line, Col, Toks) when St#erl_scan.ws -> scan_tabs(Cs, St, Line, Col, Toks, 1); @@ -557,7 +444,7 @@ scan1("++"++Cs, St, Line, Col, Toks) -> tok2(Cs, St, Line, Col, Toks, "++", '++', 2); scan1("+"=Cs, _St, Line, Col, Toks) -> {more,{Cs,Col,Toks,Line,[],fun scan/6}}; -%% =:= =/= =< == +%% =:= =/= =< == => scan1("=:="++Cs, St, Line, Col, Toks) -> tok2(Cs, St, Line, Col, Toks, "=:=", '=:=', 3); scan1("=:"=Cs, _St, Line, Col, Toks) -> @@ -568,6 +455,8 @@ scan1("=/"=Cs, _St, Line, Col, Toks) -> {more,{Cs,Col,Toks,Line,[],fun scan/6}}; scan1("=<"++Cs, St, Line, Col, Toks) -> tok2(Cs, St, Line, Col, Toks, "=<", '=<', 2); +scan1("=>"++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "=>", '=>', 2); scan1("=="++Cs, St, Line, Col, Toks) -> tok2(Cs, St, Line, Col, Toks, "==", '==', 2); scan1("="=Cs, _St, Line, Col, Toks) -> @@ -582,9 +471,9 @@ scan1("||"++Cs, St, Line, Col, Toks) -> tok2(Cs, St, Line, Col, Toks, "||", '||', 2); scan1("|"=Cs, _St, Line, Col, Toks) -> {more,{Cs,Col,Toks,Line,[],fun scan/6}}; -%% :- -scan1(":-"++Cs, St, Line, Col, Toks) -> - tok2(Cs, St, Line, Col, Toks, ":-", ':-', 2); +%% := +scan1(":="++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, ":=", ':=', 2); %% :: for typed records scan1("::"++Cs, St, Line, Col, Toks) -> tok2(Cs, St, Line, Col, Toks, "::", '::', 2); @@ -628,15 +517,12 @@ scan1([$~|Cs], St, Line, Col, Toks) -> scan1([$&|Cs], St, Line, Col, Toks) -> tok2(Cs, St, Line, Col, Toks, "&", '&', 1); %% End of optimization. -scan1([C|Cs], St, Line, Col, Toks) when ?CHAR(C) -> +scan1([C|Cs], St, Line, Col, Toks) when ?UNI255(C) -> Str = [C], - case catch list_to_atom(Str) of - Sym when is_atom(Sym) -> - tok2(Cs, St, Line, Col, Toks, Str, Sym, 1); - _ -> - Ncol = incr_column(Col, 1), - scan_error({illegal,character}, Line, Col, Line, Ncol, Cs) - end; + tok2(Cs, St, Line, Col, Toks, Str, list_to_atom(Str), 1); +scan1([C|Cs], _St, Line, Col, _Toks) when ?CHAR(C) -> + Ncol = incr_column(Col, 1), + scan_error({illegal,character}, Line, Col, Line, Ncol, Cs); scan1([]=Cs, _St, Line, Col, Toks) -> {more,{Cs,Col,Toks,Line,[],fun scan/6}}; scan1(eof=Cs, _St, Line, Col, Toks) -> @@ -685,27 +571,29 @@ scan_name([C|Cs], Ncs) when ?DIGIT(C) -> scan_name(Cs, [C|Ncs]); scan_name([$@=C|Cs], Ncs) -> scan_name(Cs, [C|Ncs]); -scan_name([C|Cs], Ncs) when C >= $�, C =< $�, C =/= $� -> +scan_name([C|Cs], Ncs) when C >= $ß, C =< $ÿ, C =/= $÷ -> scan_name(Cs, [C|Ncs]); -scan_name([C|Cs], Ncs) when C >= $�, C =< $�, C =/= $� -> +scan_name([C|Cs], Ncs) when C >= $À, C =< $Þ, C =/= $× -> scan_name(Cs, [C|Ncs]); scan_name([], Ncs) -> {more,Ncs}; scan_name(Cs, Ncs) -> {lists:reverse(Ncs),Cs}. +-define(STR(St, S), if St#erl_scan.text -> S; true -> [] end). + scan_dot([$%|_]=Cs, St, Line, Col, Toks, Ncs) -> - Attrs = attributes(Line, Col, St, Ncs), - {ok,[{dot,Attrs}|Toks],Cs,Line,incr_column(Col, 1)}; + Anno = anno(Line, Col, St, Ncs), + {ok,[{dot,Anno}|Toks],Cs,Line,incr_column(Col, 1)}; scan_dot([$\n=C|Cs], St, Line, Col, Toks, Ncs) -> - Attrs = attributes(Line, Col, St, Ncs++[C]), - {ok,[{dot,Attrs}|Toks],Cs,Line+1,new_column(Col, 1)}; + Anno = anno(Line, Col, St, ?STR(St, Ncs++[C])), + {ok,[{dot,Anno}|Toks],Cs,Line+1,new_column(Col, 1)}; scan_dot([C|Cs], St, Line, Col, Toks, Ncs) when ?WHITE_SPACE(C) -> - Attrs = attributes(Line, Col, St, Ncs++[C]), - {ok,[{dot,Attrs}|Toks],Cs,Line,incr_column(Col, 2)}; + Anno = anno(Line, Col, St, ?STR(St, Ncs++[C])), + {ok,[{dot,Anno}|Toks],Cs,Line,incr_column(Col, 2)}; scan_dot(eof=Cs, St, Line, Col, Toks, Ncs) -> - Attrs = attributes(Line, Col, St, Ncs), - {ok,[{dot,Attrs}|Toks],Cs,Line,incr_column(Col, 1)}; + Anno = anno(Line, Col, St, Ncs), + {ok,[{dot,Anno}|Toks],Cs,Line,incr_column(Col, 1)}; scan_dot(Cs, St, Line, Col, Toks, Ncs) -> tok2(Cs, St, Line, Col, Toks, Ncs, '.', 1). @@ -760,12 +648,12 @@ scan_nl_tabs(Cs, St, Line, Col, Toks, N) -> %% stop anyway, nothing is gained by not collecting all white spaces. scan_nl_white_space([$\n|Cs], #erl_scan{text = false}=St, Line, no_col=Col, Toks0, Ncs) -> - Toks = [{white_space,Line,lists:reverse(Ncs)}|Toks0], + Toks = [{white_space,anno(Line),lists:reverse(Ncs)}|Toks0], scan_newline(Cs, St, Line+1, Col, Toks); scan_nl_white_space([$\n|Cs], St, Line, Col, Toks, Ncs0) -> Ncs = lists:reverse(Ncs0), - Attrs = attributes(Line, Col, St, Ncs), - Token = {white_space,Attrs,Ncs}, + Anno = anno(Line, Col, St, Ncs), + Token = {white_space,Anno,Ncs}, scan_newline(Cs, St, Line+1, new_column(Col, length(Ncs)), [Token|Toks]); scan_nl_white_space([C|Cs], St, Line, Col, Toks, Ncs) when ?WHITE_SPACE(C) -> scan_nl_white_space(Cs, St, Line, Col, Toks, [C|Ncs]); @@ -773,19 +661,20 @@ scan_nl_white_space([]=Cs, _St, Line, Col, Toks, Ncs) -> {more,{Cs,Col,Toks,Line,Ncs,fun scan_nl_white_space/6}}; scan_nl_white_space(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, Ncs) -> - scan1(Cs, St, Line+1, Col, [{white_space,Line,lists:reverse(Ncs)}|Toks]); + Anno = anno(Line), + scan1(Cs, St, Line+1, Col, [{white_space,Anno,lists:reverse(Ncs)}|Toks]); scan_nl_white_space(Cs, St, Line, Col, Toks, Ncs0) -> Ncs = lists:reverse(Ncs0), - Attrs = attributes(Line, Col, St, Ncs), - Token = {white_space,Attrs,Ncs}, + Anno = anno(Line, Col, St, Ncs), + Token = {white_space,Anno,Ncs}, scan1(Cs, St, Line+1, new_column(Col, length(Ncs)), [Token|Toks]). newline_end(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, _N, Ncs) -> - scan1(Cs, St, Line+1, Col, [{white_space,Line,Ncs}|Toks]); + scan1(Cs, St, Line+1, Col, [{white_space,anno(Line),Ncs}|Toks]); newline_end(Cs, St, Line, Col, Toks, N, Ncs) -> - Attrs = attributes(Line, Col, St, Ncs), - scan1(Cs, St, Line+1, new_column(Col, N), [{white_space,Attrs,Ncs}|Toks]). + Anno = anno(Line, Col, St, Ncs), + scan1(Cs, St, Line+1, new_column(Col, N), [{white_space,Anno,Ncs}|Toks]). scan_spcs([$\s|Cs], St, Line, Col, Toks, N) when N < 16 -> scan_spcs(Cs, St, Line, Col, Toks, N+1); @@ -834,196 +723,131 @@ scan_char([$\\|Cs]=Cs0, St, Line, Col, Toks) -> {eof,Ncol} -> scan_error(char, Line, Col, Line, Ncol, eof); {nl,Val,Str,Ncs,Ncol} -> - Attrs = attributes(Line, Col, St, "$\\"++Str), - Ntoks = [{char,Attrs,Val}|Toks], + Anno = anno(Line, Col, St, ?STR(St, "$\\"++Str)), %" + Ntoks = [{char,Anno,Val}|Toks], scan1(Ncs, St, Line+1, Ncol, Ntoks); - {unicode,Val,Str,Ncs,Ncol} -> - Attrs = attributes(Line, Col, St, "$\\"++Str), - Ntoks = [{integer,Attrs,Val}|Toks], % UNI - scan1(Ncs, St, Line, Ncol, Ntoks); {Val,Str,Ncs,Ncol} -> - Attrs = attributes(Line, Col, St, "$\\"++Str), - Ntoks = [{char,Attrs,Val}|Toks], + Anno = anno(Line, Col, St, ?STR(St, "$\\"++Str)), %" + Ntoks = [{char,Anno,Val}|Toks], scan1(Ncs, St, Line, Ncol, Ntoks) end; scan_char([$\n=C|Cs], St, Line, Col, Toks) -> - Attrs = attributes(Line, Col, St, [$$,C]), - scan1(Cs, St, Line+1, new_column(Col, 1), [{char,Attrs,C}|Toks]); -scan_char([C|Cs], St, Line, Col, Toks) when ?CHAR(C) -> - Tag = if ?UNI255(C) -> char; true -> integer end, % UNI - Attrs = attributes(Line, Col, St, [$$,C]), - scan1(Cs, St, Line, incr_column(Col, 2), [{Tag,Attrs,C}|Toks]); + Anno = anno(Line, Col, St, ?STR(St, [$$,C])), + scan1(Cs, St, Line+1, new_column(Col, 1), [{char,Anno,C}|Toks]); +scan_char([C|Cs], St, Line, Col, Toks) when ?UNICODE(C) -> + Anno = anno(Line, Col, St, ?STR(St, [$$,C])), + scan1(Cs, St, Line, incr_column(Col, 2), [{char,Anno,C}|Toks]); +scan_char([C|_Cs], _St, Line, Col, _Toks) when ?CHAR(C) -> + scan_error({illegal,character}, Line, Col, Line, incr_column(Col, 1), eof); scan_char([], _St, Line, Col, Toks) -> {more,{[$$],Col,Toks,Line,[],fun scan/6}}; scan_char(eof, _St, Line, Col, _Toks) -> scan_error(char, Line, Col, Line, incr_column(Col, 1), eof). -scan_string(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0,Uni0}) -> - case scan_string0(Cs, St, Line, Col, $\", Str, Wcs, Uni0) of - {more,Ncs,Nline,Ncol,Nstr,Nwcs,Uni} -> - State = {Nwcs,Nstr,Line0,Col0,Uni}, +scan_string(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0}) -> + case scan_string0(Cs, St, Line, Col, $\", Str, Wcs) of %" + {more,Ncs,Nline,Ncol,Nstr,Nwcs} -> + State = {Nwcs,Nstr,Line0,Col0}, {more,{Ncs,Ncol,Toks,Nline,State,fun scan_string/6}}; {char_error,Ncs,Error,Nline,Ncol,EndCol} -> scan_error(Error, Nline, Ncol, Nline, EndCol, Ncs); {error,Nline,Ncol,Nwcs,Ncs} -> Estr = string:substr(Nwcs, 1, 16), % Expanded escape chars. - scan_error({string,$\",Estr}, Line0, Col0, Nline, Ncol, Ncs); - {Ncs,Nline,Ncol,Nstr,Nwcs,?NO_UNICODE} -> - Attrs = attributes(Line0, Col0, St, Nstr), - scan1(Ncs, St, Nline, Ncol, [{string,Attrs,Nwcs}|Toks]); - {Ncs,Nline,Ncol,Nstr,_Nwcs,_Uni} -> - Ntoks = unicode_string_to_list(Line0, Col0, St, Nstr, Toks), - scan1(Ncs, St, Nline, Ncol, Ntoks) + scan_error({string,$\",Estr}, Line0, Col0, Nline, Ncol, Ncs); %" + {Ncs,Nline,Ncol,Nstr,Nwcs} -> + Anno = anno(Line0, Col0, St, Nstr), + scan1(Ncs, St, Nline, Ncol, [{string,Anno,Nwcs}|Toks]) end. -%% UNI -unicode_string_to_list(Line, Col, St, [$"=C|Nstr], Toks) -> %" Emacs - Paren = {'[',attributes(Line, Col, St, [C])}, - u2l(Nstr, Line, incr_column(Col, 1), St, [Paren|Toks]). - -u2l([$"]=Cs, Line, Col, St, Toks) -> %" Emacs - [{']',attributes(Line, Col, St, Cs)}|Toks]; -u2l([$\n=C|Cs], Line, Col, St, Toks) -> - Ntoks = unicode_nl_tokens(Line, Col, [C], C, St, Toks, Cs), - u2l(Cs, Line+1, new_column(Col, 1), St, Ntoks); -u2l([$\\|Cs], Line, Col, St, Toks) -> - case scan_escape(Cs, Col) of - {nl,Val,ValStr,Ncs,Ncol} -> - Nstr = [$\\|ValStr], - Ntoks = unicode_nl_tokens(Line, Col, Nstr, Val, St, Toks, Ncs), - u2l(Ncs, Line+1, Ncol, St, Ntoks); - {unicode,Val,ValStr,Ncs,Ncol} -> - Nstr = [$\\|ValStr], - Ntoks = unicode_tokens(Line, Col, Nstr, Val, St, Toks, Ncs), - u2l(Ncs, Line, incr_column(Ncol, 1), St, Ntoks); - {Val,ValStr,Ncs,Ncol} -> - Nstr = [$\\|ValStr], - Ntoks = unicode_tokens(Line, Col, Nstr, Val, St, Toks, Ncs), - u2l(Ncs, Line, incr_column(Ncol, 1), St, Ntoks) - end; -u2l([C|Cs], Line, Col, St, Toks) -> - Ntoks = unicode_tokens(Line, Col, [C], C, St, Toks, Cs), - u2l(Cs, Line, incr_column(Col, 1), St, Ntoks). - -unicode_nl_tokens(Line, Col, Str, Val, St, Toks, Cs) -> - Ccol = new_column(Col, 1), - unicode_tokens(Line, Col, Str, Val, St, Toks, Cs, Line+1, Ccol). - -unicode_tokens(Line, Col, Str, Val, St, Toks, Cs) -> - Ccol = incr_column(Col, length(Str)), - unicode_tokens(Line, Col, Str, Val, St, Toks, Cs, Line, Ccol). - -unicode_tokens(Line, Col, Str, Val, St, Toks, Cs, Cline, Ccol) -> - Attrs = attributes(Line, Col, St, Str), - Tag = if ?UNI255(Val) -> char; true -> integer end, - Token = {Tag,Attrs,Val}, - [{',',attributes(Cline, Ccol, St, "")} || Cs =/= "\""] ++ [Token|Toks]. - -scan_qatom(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0,Uni0}) -> - case scan_string0(Cs, St, Line, Col, $\', Str, Wcs, Uni0) of - {more,Ncs,Nline,Ncol,Nstr,Nwcs,Uni} -> - State = {Nwcs,Nstr,Line0,Col0,Uni}, +scan_qatom(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0}) -> + case scan_string0(Cs, St, Line, Col, $\', Str, Wcs) of %' + {more,Ncs,Nline,Ncol,Nstr,Nwcs} -> + State = {Nwcs,Nstr,Line0,Col0}, {more,{Ncs,Ncol,Toks,Nline,State,fun scan_qatom/6}}; {char_error,Ncs,Error,Nline,Ncol,EndCol} -> scan_error(Error, Nline, Ncol, Nline, EndCol, Ncs); {error,Nline,Ncol,Nwcs,Ncs} -> Estr = string:substr(Nwcs, 1, 16), % Expanded escape chars. - scan_error({string,$\',Estr}, Line0, Col0, Nline, Ncol, Ncs); - {Ncs,Nline,Ncol,Nstr,Nwcs,?NO_UNICODE} -> + scan_error({string,$\',Estr}, Line0, Col0, Nline, Ncol, Ncs); %' + {Ncs,Nline,Ncol,Nstr,Nwcs} -> case catch list_to_atom(Nwcs) of A when is_atom(A) -> - Attrs = attributes(Line0, Col0, St, Nstr), - scan1(Ncs, St, Nline, Ncol, [{atom,Attrs,A}|Toks]); + Anno = anno(Line0, Col0, St, Nstr), + scan1(Ncs, St, Nline, Ncol, [{atom,Anno,A}|Toks]); _ -> scan_error({illegal,atom}, Line0, Col0, Nline, Ncol, Ncs) end end. -scan_string0(Cs, #erl_scan{text=false}, Line, no_col=Col, Q, [], Wcs, Uni) -> - scan_string_no_col(Cs, Line, Col, Q, Wcs, Uni); -scan_string0(Cs, #erl_scan{text=true}, Line, no_col=Col, Q, Str, Wcs, Uni) -> - scan_string1(Cs, Line, Col, Q, Str, Wcs, Uni); -scan_string0(Cs, _St, Line, Col, Q, [], Wcs, Uni) -> - scan_string_col(Cs, Line, Col, Q, Wcs, Uni); -scan_string0(Cs, _St, Line, Col, Q, Str, Wcs, Uni) -> - scan_string1(Cs, Line, Col, Q, Str, Wcs, Uni). +scan_string0(Cs, #erl_scan{text=false}, Line, no_col=Col, Q, [], Wcs) -> + scan_string_no_col(Cs, Line, Col, Q, Wcs); +scan_string0(Cs, #erl_scan{text=true}, Line, no_col=Col, Q, Str, Wcs) -> + scan_string1(Cs, Line, Col, Q, Str, Wcs); +scan_string0(Cs, St, Line, Col, Q, [], Wcs) -> + scan_string_col(Cs, St, Line, Col, Q, Wcs); +scan_string0(Cs, _St, Line, Col, Q, Str, Wcs) -> + scan_string1(Cs, Line, Col, Q, Str, Wcs). %% Optimization. Col =:= no_col. -scan_string_no_col([Q|Cs], Line, Col, Q, Wcs, Uni) -> - {Cs,Line,Col,_DontCare=[],lists:reverse(Wcs),Uni}; -scan_string_no_col([$\n=C|Cs], Line, Col, Q, Wcs, Uni) -> - scan_string_no_col(Cs, Line+1, Col, Q, [C|Wcs], Uni); -scan_string_no_col([C|Cs], Line, Col, Q, Wcs, Uni) when C =/= $\\, - ?CHAR(C), ?UNI255(C) -> - scan_string_no_col(Cs, Line, Col, Q, [C|Wcs], Uni); -scan_string_no_col(Cs, Line, Col, Q, Wcs, Uni) -> - scan_string1(Cs, Line, Col, Q, Wcs, Wcs, Uni). +scan_string_no_col([Q|Cs], Line, Col, Q, Wcs) -> + {Cs,Line,Col,_DontCare=[],lists:reverse(Wcs)}; +scan_string_no_col([$\n=C|Cs], Line, Col, Q, Wcs) -> + scan_string_no_col(Cs, Line+1, Col, Q, [C|Wcs]); +scan_string_no_col([C|Cs], Line, Col, Q, Wcs) when C =/= $\\, ?UNICODE(C) -> + scan_string_no_col(Cs, Line, Col, Q, [C|Wcs]); +scan_string_no_col(Cs, Line, Col, Q, Wcs) -> + scan_string1(Cs, Line, Col, Q, Wcs, Wcs). %% Optimization. Col =/= no_col. -scan_string_col([Q|Cs], Line, Col, Q, Wcs0, Uni) -> +scan_string_col([Q|Cs], St, Line, Col, Q, Wcs0) -> Wcs = lists:reverse(Wcs0), - Str = [Q|Wcs++[Q]], - {Cs,Line,Col+1,Str,Wcs,Uni}; -scan_string_col([$\n=C|Cs], Line, _xCol, Q, Wcs, Uni) -> - scan_string_col(Cs, Line+1, 1, Q, [C|Wcs], Uni); -scan_string_col([C|Cs], Line, Col, Q, Wcs, Uni) when C =/= $\\, - ?CHAR(C), ?UNI255(C) -> - scan_string_col(Cs, Line, Col+1, Q, [C|Wcs], Uni); -scan_string_col(Cs, Line, Col, Q, Wcs, Uni) -> - scan_string1(Cs, Line, Col, Q, Wcs, Wcs, Uni). - -%% UNI_STR is to be replaced by STR when the Unicode-string-to-list -%% workaround is eventually removed. --define(UNI_STR(Col, S), S). + Str = ?STR(St, [Q|Wcs++[Q]]), + {Cs,Line,Col+1,Str,Wcs}; +scan_string_col([$\n=C|Cs], St, Line, _xCol, Q, Wcs) -> + scan_string_col(Cs, St, Line+1, 1, Q, [C|Wcs]); +scan_string_col([C|Cs], St, Line, Col, Q, Wcs) when C =/= $\\, ?UNICODE(C) -> + scan_string_col(Cs, St, Line, Col+1, Q, [C|Wcs]); +scan_string_col(Cs, _St, Line, Col, Q, Wcs) -> + scan_string1(Cs, Line, Col, Q, Wcs, Wcs). %% Note: in those cases when a 'char_error' tuple is returned below it %% is tempting to skip over characters up to the first Q character, %% but then the end location of the error tuple would not correspond %% to the start location of the returned Rest string. (Maybe the end %% location could be modified, but that too is ugly.) -scan_string1([Q|Cs], Line, Col, Q, Str0, Wcs0, Uni) -> +scan_string1([Q|Cs], Line, Col, Q, Str0, Wcs0) -> Wcs = lists:reverse(Wcs0), - Str = ?UNI_STR(Col, [Q|lists:reverse(Str0, [Q])]), - {Cs,Line,incr_column(Col, 1),Str,Wcs,Uni}; -scan_string1([$\n=C|Cs], Line, Col, Q, Str, Wcs, Uni) -> + Str = [Q|lists:reverse(Str0, [Q])], + {Cs,Line,incr_column(Col, 1),Str,Wcs}; +scan_string1([$\n=C|Cs], Line, Col, Q, Str, Wcs) -> Ncol = new_column(Col, 1), - scan_string1(Cs, Line+1, Ncol, Q, ?UNI_STR(Col, [C|Str]), [C|Wcs], Uni); -scan_string1([$\\|Cs]=Cs0, Line, Col, Q, Str, Wcs, Uni) -> + scan_string1(Cs, Line+1, Ncol, Q, [C|Str], [C|Wcs]); +scan_string1([$\\|Cs]=Cs0, Line, Col, Q, Str, Wcs) -> case scan_escape(Cs, Col) of more -> - {more,Cs0,Line,Col,Str,Wcs,Uni}; + {more,Cs0,Line,Col,Str,Wcs}; {error,Ncs,Error,Ncol} -> {char_error,Ncs,Error,Line,Col,incr_column(Ncol, 1)}; {eof,Ncol} -> {error,Line,incr_column(Ncol, 1),lists:reverse(Wcs),eof}; {nl,Val,ValStr,Ncs,Ncol} -> - Nstr = ?UNI_STR(Ncol, lists:reverse(ValStr, [$\\|Str])), + Nstr = lists:reverse(ValStr, [$\\|Str]), Nwcs = [Val|Wcs], - scan_string1(Ncs, Line+1, Ncol, Q, Nstr, Nwcs, Uni); - {unicode,_Val,_ValStr,Ncs,Ncol} when Q =:= $' -> %' Emacs - {char_error,Ncs,{illegal,character},Line,Col,incr_column(Ncol, 1)}; - {unicode,Val,ValStr,Ncs,Ncol} -> % UNI. Uni is set to Val. - Nstr = ?UNI_STR(Ncol, lists:reverse(ValStr, [$\\|Str])), - Nwcs = [Val|Wcs], % not used - scan_string1(Ncs, Line, incr_column(Ncol, 1), Q, Nstr, Nwcs, Val); + scan_string1(Ncs, Line+1, Ncol, Q, Nstr, Nwcs); {Val,ValStr,Ncs,Ncol} -> - Nstr = ?UNI_STR(Ncol, lists:reverse(ValStr, [$\\|Str])), + Nstr = lists:reverse(ValStr, [$\\|Str]), Nwcs = [Val|Wcs], - scan_string1(Ncs, Line, incr_column(Ncol, 1), Q, Nstr, Nwcs, Uni) + scan_string1(Ncs, Line, incr_column(Ncol, 1), Q, Nstr, Nwcs) end; -scan_string1([C|Cs], Line, no_col=Col, Q, Str, Wcs, Uni) when ?CHAR(C), - ?UNI255(C) -> - %% scan_string1(Cs, Line, Col, Q, Str, [C|Wcs], Uni); - scan_string1(Cs, Line, Col, Q, [C|Str], [C|Wcs], Uni); % UNI -scan_string1([C|Cs], Line, Col, Q, Str, Wcs, Uni) when ?CHAR(C), ?UNI255(C) -> - scan_string1(Cs, Line, Col+1, Q, [C|Str], [C|Wcs], Uni); -scan_string1([C|Cs], Line, Col, $', _Str, _Wcs, _Uni) when ?CHAR(C) -> %' UNI +scan_string1([C|Cs], Line, no_col=Col, Q, Str, Wcs) when ?UNICODE(C) -> + scan_string1(Cs, Line, Col, Q, [C|Str], [C|Wcs]); +scan_string1([C|Cs], Line, Col, Q, Str, Wcs) when ?UNICODE(C) -> + scan_string1(Cs, Line, Col+1, Q, [C|Str], [C|Wcs]); +scan_string1([C|Cs], Line, Col, _Q, _Str, _Wcs) when ?CHAR(C) -> {char_error,Cs,{illegal,character},Line,Col,incr_column(Col, 1)}; -scan_string1([C|Cs], Line, Col, Q, Str, Wcs, _Uni) when ?CHAR(C) -> % UNI - scan_string1(Cs, Line, incr_column(Col, 1), Q, [C|Str], [C|Wcs], C); -scan_string1([]=Cs, Line, Col, _Q, Str, Wcs, Uni) -> - {more,Cs,Line,Col,Str,Wcs,Uni}; -scan_string1(eof, Line, Col, _Q, _Str, Wcs, _Uni) -> +scan_string1([]=Cs, Line, Col, _Q, Str, Wcs) -> + {more,Cs,Line,Col,Str,Wcs}; +scan_string1(eof, Line, Col, _Q, _Str, Wcs) -> {error,Line,Col,lists:reverse(Wcs),eof}. -define(OCT(C), C >= $0, C =< $7). @@ -1034,16 +858,16 @@ scan_string1(eof, Line, Col, _Q, _Str, Wcs, _Uni) -> %% \<1-3> octal digits scan_escape([O1,O2,O3|Cs], Col) when ?OCT(O1), ?OCT(O2), ?OCT(O3) -> Val = (O1*8 + O2)*8 + O3 - 73*$0, - {Val,?UNI_STR(Col, [O1,O2,O3]),Cs,incr_column(Col, 3)}; + {Val,[O1,O2,O3],Cs,incr_column(Col, 3)}; scan_escape([O1,O2], _Col) when ?OCT(O1), ?OCT(O2) -> more; scan_escape([O1,O2|Cs], Col) when ?OCT(O1), ?OCT(O2) -> Val = (O1*8 + O2) - 9*$0, - {Val,?UNI_STR(Col, [O1,O2]),Cs,incr_column(Col, 2)}; + {Val,[O1,O2],Cs,incr_column(Col, 2)}; scan_escape([O1], _Col) when ?OCT(O1) -> more; scan_escape([O1|Cs], Col) when ?OCT(O1) -> - {O1 - $0,?UNI_STR(Col, [O1]),Cs,incr_column(Col, 1)}; + {O1 - $0,[O1],Cs,incr_column(Col, 1)}; %% \x{<hex digits>} scan_escape([$x,${|Cs], Col) -> scan_hex(Cs, incr_column(Col, 2), []); @@ -1054,28 +878,28 @@ scan_escape([$x|eof], Col) -> %% \x<2> hexadecimal digits scan_escape([$x,H1,H2|Cs], Col) when ?HEX(H1), ?HEX(H2) -> Val = erlang:list_to_integer([H1,H2], 16), - {Val,?UNI_STR(Col, [$x,H1,H2]),Cs,incr_column(Col, 3)}; + {Val,[$x,H1,H2],Cs,incr_column(Col, 3)}; scan_escape([$x,H1], _Col) when ?HEX(H1) -> more; scan_escape([$x|Cs], Col) -> {error,Cs,{illegal,character},incr_column(Col, 1)}; %% \^X -> CTL-X scan_escape([$^=C0,$\n=C|Cs], Col) -> - {nl,C,?UNI_STR(Col, [C0,C]),Cs,new_column(Col, 1)}; + {nl,C,[C0,C],Cs,new_column(Col, 1)}; scan_escape([$^=C0,C|Cs], Col) when ?CHAR(C) -> Val = C band 31, - {Val,?UNI_STR(Col, [C0,C]),Cs,incr_column(Col, 2)}; + {Val,[C0,C],Cs,incr_column(Col, 2)}; scan_escape([$^], _Col) -> more; scan_escape([$^|eof], Col) -> {eof,incr_column(Col, 1)}; scan_escape([$\n=C|Cs], Col) -> - {nl,C,?UNI_STR(Col, [C]),Cs,new_column(Col, 1)}; -scan_escape([C0|Cs], Col) when ?CHAR(C0), ?UNI255(C0) -> + {nl,C,[C],Cs,new_column(Col, 1)}; +scan_escape([C0|Cs], Col) when ?UNICODE(C0) -> C = escape_char(C0), - {C,?UNI_STR(Col, [C0]),Cs,incr_column(Col, 1)}; -scan_escape([C|Cs], Col) when ?CHAR(C) -> % UNI - {unicode,C,?UNI_STR(Col, [C]),Cs,incr_column(Col, 1)}; + {C,[C0],Cs,incr_column(Col, 1)}; +scan_escape([C|Cs], Col) when ?CHAR(C) -> + {error,Cs,{illegal,character},incr_column(Col, 1)}; scan_escape([], _Col) -> more; scan_escape(eof, Col) -> @@ -1091,10 +915,8 @@ scan_hex(Cs, Col, Wcs) -> scan_esc_end([$}|Cs], Col, Wcs0, B, Str0) -> Wcs = lists:reverse(Wcs0), case catch erlang:list_to_integer(Wcs, B) of - Val when Val =< 16#FF -> - {Val,?UNI_STR(Col, Str0++Wcs++[$}]),Cs,incr_column(Col, 1)}; - Val when Val =< 16#10FFFF -> - {unicode,Val,?UNI_STR(Col, Str0++Wcs++[$}]),Cs,incr_column(Col,1)}; + Val when ?UNICODE(Val) -> + {Val,Str0++Wcs++[$}],Cs,incr_column(Col, 1)}; _ -> {error,Cs,{illegal,character},incr_column(Col, 1)} end; @@ -1200,14 +1022,26 @@ float_end(Cs, St, Line, Col, Toks, Ncs0) -> end. skip_comment([C|Cs], St, Line, Col, Toks, N) when C =/= $\n, ?CHAR(C) -> - skip_comment(Cs, St, Line, Col, Toks, N+1); + case ?UNICODE(C) of + true -> + skip_comment(Cs, St, Line, Col, Toks, N+1); + false -> + Ncol = incr_column(Col, N+1), + scan_error({illegal,character}, Line, Col, Line, Ncol, Cs) + end; skip_comment([]=Cs, _St, Line, Col, Toks, N) -> {more,{Cs,Col,Toks,Line,N,fun skip_comment/6}}; skip_comment(Cs, St, Line, Col, Toks, N) -> scan1(Cs, St, Line, incr_column(Col, N), Toks). scan_comment([C|Cs], St, Line, Col, Toks, Ncs) when C =/= $\n, ?CHAR(C) -> - scan_comment(Cs, St, Line, Col, Toks, [C|Ncs]); + case ?UNICODE(C) of + true -> + scan_comment(Cs, St, Line, Col, Toks, [C|Ncs]); + false -> + Ncol = incr_column(Col, length(Ncs)+1), + scan_error({illegal,character}, Line, Col, Line, Ncol, Cs) + end; scan_comment([]=Cs, _St, Line, Col, Toks, Ncs) -> {more,{Cs,Col,Toks,Line,Ncs,fun scan_comment/6}}; scan_comment(Cs, St, Line, Col, Toks, Ncs0) -> @@ -1215,28 +1049,28 @@ scan_comment(Cs, St, Line, Col, Toks, Ncs0) -> tok3(Cs, St, Line, Col, Toks, comment, Ncs, Ncs). tok2(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, _Wcs, P) -> - scan1(Cs, St, Line, Col, [{P,Line}|Toks]); + scan1(Cs, St, Line, Col, [{P,anno(Line)}|Toks]); tok2(Cs, St, Line, Col, Toks, Wcs, P) -> - Attrs = attributes(Line, Col, St, Wcs), - scan1(Cs, St, Line, incr_column(Col, length(Wcs)), [{P,Attrs}|Toks]). + Anno = anno(Line, Col, St, Wcs), + scan1(Cs, St, Line, incr_column(Col, length(Wcs)), [{P,Anno}|Toks]). tok2(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, _Wcs, P, _N) -> - scan1(Cs, St, Line, Col, [{P,Line}|Toks]); + scan1(Cs, St, Line, Col, [{P,anno(Line)}|Toks]); tok2(Cs, St, Line, Col, Toks, Wcs, P, N) -> - Attrs = attributes(Line, Col, St, Wcs), - scan1(Cs, St, Line, incr_column(Col, N), [{P,Attrs}|Toks]). + Anno = anno(Line, Col, St, Wcs), + scan1(Cs, St, Line, incr_column(Col, N), [{P,Anno}|Toks]). tok3(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, Item, _S, Sym) -> - scan1(Cs, St, Line, Col, [{Item,Line,Sym}|Toks]); + scan1(Cs, St, Line, Col, [{Item,anno(Line),Sym}|Toks]); tok3(Cs, St, Line, Col, Toks, Item, String, Sym) -> - Token = {Item,attributes(Line, Col, St, String),Sym}, + Token = {Item,anno(Line, Col, St, String),Sym}, scan1(Cs, St, Line, incr_column(Col, length(String)), [Token|Toks]). tok3(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, Item, _String, Sym, _Length) -> - scan1(Cs, St, Line, Col, [{Item,Line,Sym}|Toks]); + scan1(Cs, St, Line, Col, [{Item,anno(Line),Sym}|Toks]); tok3(Cs, St, Line, Col, Toks, Item, String, Sym, Length) -> - Token = {Item,attributes(Line, Col, St, String),Sym}, + Token = {Item,anno(Line, Col, St, String),Sym}, scan1(Cs, St, Line, incr_column(Col, Length), [Token|Toks]). scan_error(Error, Line, Col, EndLine, EndCol, Rest) -> @@ -1247,23 +1081,28 @@ scan_error(Error, Line, Col, EndLine, EndCol, Rest) -> scan_error(Error, ErrorLoc, EndLoc, Rest) -> {{error,{ErrorLoc,?MODULE,Error},EndLoc},Rest}. --compile({inline,[attributes/4]}). +-compile({inline,[anno/4]}). -attributes(Line, no_col, #erl_scan{text = false}, _String) -> - Line; -attributes(Line, no_col, #erl_scan{text = true}, String) -> - [{line,Line},{text,String}]; -attributes(Line, Col, #erl_scan{text = false}, _String) -> - {Line,Col}; -attributes(Line, Col, #erl_scan{text = true}, String) -> - [{line,Line},{column,Col},{text,String}]. +anno(Line, no_col, #erl_scan{text = false}, _String) -> + anno(Line); +anno(Line, no_col, #erl_scan{text = true}, String) -> + Anno = anno(Line), + erl_anno:set_text(String, Anno); +anno(Line, Col, #erl_scan{text = false}, _String) -> + anno({Line, Col}); +anno(Line, Col, #erl_scan{text = true}, String) -> + Anno = anno({Line, Col}), + erl_anno:set_text(String, Anno). location(Line, no_col) -> Line; location(Line, Col) when is_integer(Col) -> {Line,Col}. --compile({inline,[incr_column/2,new_column/2]}). +-compile({inline,[anno/1,incr_column/2,new_column/2]}). + +anno(Location) -> + erl_anno:new(Location). incr_column(no_col=Col, _N) -> Col; @@ -1345,7 +1184,6 @@ reserved_word('fun') -> true; reserved_word('if') -> true; reserved_word('let') -> true; reserved_word('of') -> true; -reserved_word('query') -> true; reserved_word('receive') -> true; reserved_word('when') -> true; reserved_word('bnot') -> true; diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl index 306834e845..a383a0fc67 100644 --- a/lib/stdlib/src/erl_tar.erl +++ b/lib/stdlib/src/erl_tar.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -22,7 +23,7 @@ %% Purpose: Unix tar (tape archive) utility. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([create/2, create/3, extract/1, extract/2, table/1, table/2, +-export([init/3, create/2, create/3, extract/1, extract/2, table/1, table/2, open/2, close/1, add/3, add/4, t/1, tt/1, format_error/1]). @@ -30,10 +31,16 @@ -record(add_opts, {read_info, % Fun to use for read file/link info. + chunk_size = 0, % For file reading when sending to sftp. 0=do not chunk verbose = false :: boolean()}). % Verbose on/off. %% Opens a tar archive. +init(UsrHandle, AccessMode, Fun) when is_function(Fun,2) -> + {ok, {AccessMode,{tar_descriptor,UsrHandle,Fun}}}. + +%%%================================================================ +%%% The open function with friends is to keep the file and binary api of this module open(Name, Mode) -> case open_mode(Mode) of {ok, Access, Raw, Opts} -> @@ -45,31 +52,38 @@ open(Name, Mode) -> open1({binary,Bin}, read, _Raw, Opts) -> case file:open(Bin, [ram,binary,read]) of {ok,File} -> - case Opts of - [compressed] -> ram_file:uncompress(File); - [] -> ok - end, - {ok,{read,File}}; + _ = [ram_file:uncompress(File) || Opts =:= [compressed]], + init(File,read,file_fun()); Error -> Error end; open1({file, Fd}, read, _Raw, _Opts) -> - {ok, {read, Fd}}; + init(Fd, read, file_fun()); open1(Name, Access, Raw, Opts) -> case file:open(Name, Raw ++ [binary, Access|Opts]) of {ok, File} -> - {ok, {Access, File}}; + init(File, Access, file_fun()); {error, Reason} -> {error, {Name, Reason}} end. +file_fun() -> + fun(write, {Fd,Data}) -> file:write(Fd, Data); + (position, {Fd,Pos}) -> file:position(Fd, Pos); + (read2, {Fd,Size}) -> file:read(Fd,Size); + (close, Fd) -> file:close(Fd) + end. + +%%% End of file and binary api (except for open_mode/1 downwards +%%%================================================================ + %% Closes a tar archive. close({read, File}) -> - ok = file:close(File); + ok = do_close(File); close({write, File}) -> PadResult = pad_file(File), - ok = file:close(File), + ok = do_close(File), PadResult; close(_) -> {error, einval}. @@ -78,7 +92,6 @@ close(_) -> add(File, Name, Options) -> add(File, Name, Name, Options). - add({write, File}, Name, NameInArchive, Options) -> Opts = #add_opts{read_info=fun(F) -> file:read_link_info(F) end}, add1(File, Name, NameInArchive, add_opts(Options, Opts)); @@ -91,6 +104,8 @@ add_opts([dereference|T], Opts) -> add_opts(T, Opts#add_opts{read_info=fun(F) -> file:read_file_info(F) end}); add_opts([verbose|T], Opts) -> add_opts(T, Opts#add_opts{verbose=true}); +add_opts([{chunks,N}|T], Opts) -> + add_opts(T, Opts#add_opts{chunk_size=N}); add_opts([_|T], Opts) -> add_opts(T, Opts); add_opts([], Opts) -> @@ -154,7 +169,7 @@ table(Name, Opts) -> t(Name) -> case table(Name) of {ok, List} -> - lists:foreach(fun(N) -> ok = io:format("~s\n", [N]) end, List); + lists:foreach(fun(N) -> ok = io:format("~ts\n", [N]) end, List); Error -> Error end. @@ -216,13 +231,13 @@ format_error(bad_header) -> "Bad directory header"; format_error(eof) -> "Unexpected end of file"; format_error(symbolic_link_too_long) -> "Symbolic link too long"; format_error({Name,Reason}) -> - lists:flatten(io_lib:format("~s: ~s", [Name,format_error(Reason)])); + lists:flatten(io_lib:format("~ts: ~ts", [Name,format_error(Reason)])); format_error(Atom) when is_atom(Atom) -> file:format_error(Atom); format_error(Term) -> - lists:flatten(io_lib:format("~p", [Term])). + lists:flatten(io_lib:format("~tp", [Term])). + - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% Useful definitions (also start of implementation). @@ -286,7 +301,7 @@ format_error(Term) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% add1(TarFile, Bin, NameInArchive, Opts) when is_binary(Bin) -> - Now = calendar:now_to_local_time(now()), + Now = calendar:now_to_local_time(erlang:timestamp()), Info = #file_info{size = byte_size(Bin), type = regular, access = read_write, @@ -324,16 +339,46 @@ add1(TarFile, Name, NameInArchive, Opts) -> {error, {Name, Reason}} end. +add1(Tar, Name, Header, chunked, Options) -> + add_verbose(Options, "a ~ts [chunked ", [Name]), + try + ok = do_write(Tar, Header), + {ok,D} = file:open(Name, [read,binary]), + {ok,NumBytes} = add_read_write_chunks(D, Tar, Options#add_opts.chunk_size, 0, Options), + _ = file:close(D), + ok = do_write(Tar, padding(NumBytes,?record_size)) + of + ok -> + add_verbose(Options, "~n", []), + ok + catch + error:{badmatch,{error,Error}} -> + add_verbose(Options, "~n", []), + {error,{Name,Error}} + end; add1(Tar, Name, Header, Bin, Options) -> - add_verbose(Options, "a ~s~n", [Name]), - file:write(Tar, [Header, Bin, padding(byte_size(Bin), ?record_size)]). + add_verbose(Options, "a ~ts~n", [Name]), + do_write(Tar, [Header, Bin, padding(byte_size(Bin), ?record_size)]). + +add_read_write_chunks(D, Tar, ChunkSize, SumNumBytes, Options) -> + case file:read(D, ChunkSize) of + {ok,Bin} -> + ok = do_write(Tar, Bin), + add_verbose(Options, ".", []), + add_read_write_chunks(D, Tar, ChunkSize, SumNumBytes+byte_size(Bin), Options); + eof -> + add_verbose(Options, "]", []), + {ok,SumNumBytes}; + Other -> + Other + end. add_directory(TarFile, DirName, NameInArchive, Info, Options) -> case file:list_dir(DirName) of {ok, []} -> - add_verbose(Options, "a ~s~n", [DirName]), + add_verbose(Options, "a ~ts~n", [DirName]), Header = create_header(NameInArchive, Info), - file:write(TarFile, Header); + do_write(TarFile, Header); {ok, Files} -> Add = fun (File) -> add1(TarFile, @@ -384,7 +429,12 @@ to_octal(Int, Count, Result) -> to_octal(Int div 8, Count-1, [Int rem 8 + $0|Result]). to_string(Str0, Count) -> - Str = list_to_binary(Str0), + Str = case file:native_name_encoding() of + utf8 -> + unicode:characters_to_binary(Str0); + latin1 -> + list_to_binary(Str0) + end, case byte_size(Str) of Size when Size < Count -> [Str|zeroes(Count-Size)]; @@ -394,10 +444,18 @@ to_string(Str0, Count) -> %% Pads out end of file. pad_file(File) -> - {ok,Position} = file:position(File, {cur,0}), - %% There must be at least one empty record at the end of the file. - Zeros = zeroes(?block_size - (Position rem ?block_size)), - file:write(File, Zeros). + {ok,Position} = do_position(File, {cur,0}), + %% There must be at least two zero records at the end. + Fill = case ?block_size - (Position rem ?block_size) of + Fill0 when Fill0 < 2*?record_size -> + %% We need to another block here to ensure that there + %% are at least two zero records at the end. + Fill0 + ?block_size; + Fill0 -> + %% Large enough. + Fill0 + end, + do_write(File, zeroes(Fill)). split_filename(Name) when length(Name) =< ?th_name_len -> {"", Name}; @@ -412,7 +470,7 @@ split_filename([Comp|Rest], Prefix, Suffix, Len) -> split_filename([], Prefix, Suffix, _) -> {filename:join(Prefix),filename:join(Suffix)}. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% Retrieving files from a tape archive. @@ -475,27 +533,36 @@ read_opts([_|Rest], Opts) -> read_opts([], Opts) -> Opts. +foldl_read({AccessMode,TD={tar_descriptor,_UsrHandle,_AccessFun}}, Fun, Accu, Opts) -> + case AccessMode of + read -> + foldl_read0(TD, Fun, Accu, Opts); + _ -> + {error,{read_mode_expected,AccessMode}} + end; foldl_read(TarName, Fun, Accu, Opts) -> case open(TarName, [read|Opts#read_opts.open_mode]) of {ok, {read, File}} -> - Result = - case catch foldl_read1(Fun, Accu, File, Opts) of - {'EXIT', Reason} -> - exit(Reason); - {error, {Reason, Format, Args}} -> - read_verbose(Opts, Format, Args), - {error, Reason}; - {error, Reason} -> - {error, Reason}; - Ok -> - Ok - end, - ok = file:close(File), + Result = foldl_read0(File, Fun, Accu, Opts), + ok = do_close(File), Result; Error -> Error end. +foldl_read0(File, Fun, Accu, Opts) -> + case catch foldl_read1(Fun, Accu, File, Opts) of + {'EXIT', Reason} -> + exit(Reason); + {error, {Reason, Format, Args}} -> + read_verbose(Opts, Format, Args), + {error, Reason}; + {error, Reason} -> + {error, Reason}; + Ok -> + Ok + end. + foldl_read1(Fun, Accu0, File, Opts) -> case get_header(File) of eof -> @@ -549,7 +616,7 @@ check_extract(Name, #read_opts{files=Files}) -> ordsets:is_element(Name, Files). get_header(File) -> - case file:read(File, ?record_size) of + case do_read(File, ?record_size) of eof -> throw({error,eof}); {ok, Bin} when is_binary(Bin) -> @@ -611,7 +678,22 @@ typeflag(Bin) -> %% Get the name of the file from the prefix and name fields of the %% tar header. -get_name(Bin) -> +get_name(Bin0) -> + List0 = get_name_raw(Bin0), + case file:native_name_encoding() of + utf8 -> + Bin = list_to_binary(List0), + case unicode:characters_to_list(Bin) of + {error,_,_} -> + List0; + List when is_list(List) -> + List + end; + latin1 -> + List0 + end. + +get_name_raw(Bin) -> Name = from_string(Bin, ?th_name, ?th_name_len), case binary_to_list(Bin, ?th_prefix+1, ?th_prefix+1) of [0] -> @@ -665,7 +747,7 @@ get_element(File, #tar_header{size = 0}) -> skip_to_next(File), {ok,<<>>}; get_element(File, #tar_header{size = Size}) -> - case file:read(File, Size) of + case do_read(File, Size) of {ok,Bin}=Res when byte_size(Bin) =:= Size -> skip_to_next(File), Res; @@ -731,7 +813,7 @@ write_extracted_element(Header, Bin, Opts) -> symlink -> create_symlink(Name, Header, Opts); Other -> % Ignore. - read_verbose(Opts, "x ~s - unsupported type ~p~n", + read_verbose(Opts, "x ~ts - unsupported type ~p~n", [Name, Other]), not_written end, @@ -757,7 +839,7 @@ create_symlink(Name, #tar_header{linkname=Linkname}=Header, Opts) -> create_symlink(Name, Header, Opts); {error,eexist} -> not_written; {error,enotsup} -> - read_verbose(Opts, "x ~s - symbolic links not supported~n", [Name]), + read_verbose(Opts, "x ~ts - symbolic links not supported~n", [Name]), not_written; {error,Reason} -> throw({error, Reason}) end. @@ -774,10 +856,10 @@ write_extracted_file(Name, Bin, Opts) -> end, case Write of true -> - read_verbose(Opts, "x ~s~n", [Name]), + read_verbose(Opts, "x ~ts~n", [Name]), write_file(Name, Bin); false -> - read_verbose(Opts, "x ~s - exists, not created~n", [Name]), + read_verbose(Opts, "x ~ts - exists, not created~n", [Name]), not_written end. @@ -855,7 +937,7 @@ skip(File, Size) -> %% Note: There is no point in handling failure to get the current position %% in the file. If it doesn't work, something serious is wrong. Amount = ((Size + ?record_size - 1) div ?record_size) * ?record_size, - {ok,_} = file:position(File, {cur, Amount}), + {ok,_} = do_position(File, {cur, Amount}), ok. %% Skips to the next record in the file. @@ -863,9 +945,9 @@ skip(File, Size) -> skip_to_next(File) -> %% Note: There is no point in handling failure to get the current position %% in the file. If it doesn't work, something serious is wrong. - {ok, Position} = file:position(File, {cur, 0}), + {ok, Position} = do_position(File, {cur, 0}), NewPosition = ((Position + ?record_size - 1) div ?record_size) * ?record_size, - {ok,NewPosition} = file:position(File, NewPosition), + {ok,NewPosition} = do_position(File, NewPosition), ok. %% Prints the message on if the verbose option is given. @@ -891,6 +973,9 @@ posix_to_erlang_time(Sec) -> read_file_and_info(Name, Opts) -> ReadInfo = Opts#add_opts.read_info, case ReadInfo(Name) of + {ok,Info} when Info#file_info.type =:= regular, + Opts#add_opts.chunk_size>0 -> + {ok,chunked,Info}; {ok,Info} when Info#file_info.type =:= regular -> case file:read_file(Name) of {ok,Bin} -> @@ -937,3 +1022,12 @@ open_mode([], Access, Raw, Opts) -> {ok, Access, Raw, Opts}; open_mode(_, _, _, _) -> {error, einval}. + +%%%================================================================ +do_write({tar_descriptor,UsrHandle,Fun}, Data) -> Fun(write,{UsrHandle,Data}). + +do_position({tar_descriptor,UsrHandle,Fun}, Pos) -> Fun(position,{UsrHandle,Pos}). + +do_read({tar_descriptor,UsrHandle,Fun}, Len) -> Fun(read2,{UsrHandle,Len}). + +do_close({tar_descriptor,UsrHandle,Fun}) -> Fun(close,UsrHandle). diff --git a/lib/stdlib/src/error_logger_file_h.erl b/lib/stdlib/src/error_logger_file_h.erl index e9364ed787..665685d3ee 100644 --- a/lib/stdlib/src/error_logger_file_h.erl +++ b/lib/stdlib/src/error_logger_file_h.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -23,24 +24,28 @@ %%% %%% A handler that can be connected to the error_logger -%%% event handler. -%%% Writes all events formatted to file. -%%% Handles events tagged error, emulator and info. +%%% event handler. Writes all events formatted to file. %%% %%% It can only be started from error_logger:swap_handler({logfile, File}) -%%% or error_logger:logfile(File) +%%% or error_logger:logfile(File). %%% -export([init/1, handle_event/2, handle_call/2, handle_info/2, terminate/2, code_change/3]). +-record(st, + {fd, + filename, + prev_handler, + depth=unlimited :: 'unlimited' | non_neg_integer()}). + %% This one is used when we takeover from the simple error_logger. init({File, {error_logger, Buf}}) -> case init(File, error_logger) of - {ok, {Fd, File, PrevHandler}} -> - write_events(Fd, Buf), - {ok, {Fd, File, PrevHandler}}; + {ok, State} -> + write_events(State, Buf), + {ok, State}; Error -> Error end; @@ -52,49 +57,45 @@ init(File, PrevHandler) -> process_flag(trap_exit, true), case file:open(File, [write]) of {ok,Fd} -> - {ok, {Fd, File, PrevHandler}}; + Depth = get_depth(), + State = #st{fd=Fd,filename=File,prev_handler=PrevHandler, + depth=Depth}, + {ok, State}; Error -> Error end. - + +get_depth() -> + case application:get_env(kernel, error_logger_format_depth) of + {ok, Depth} when is_integer(Depth) -> + max(10, Depth); + undefined -> + unlimited + end. + handle_event({_Type, GL, _Msg}, State) when node(GL) =/= node() -> {ok, State}; -handle_event(Event, {Fd, File, PrevHandler}) -> - write_event(Fd, tag_event(Event)), - {ok, {Fd, File, PrevHandler}}; -handle_event(_, State) -> +handle_event(Event, State) -> + write_event(State, Event), {ok, State}. -handle_info({'EXIT', Fd, _Reason}, {Fd, _File, PrevHandler}) -> +handle_info({'EXIT', Fd, _Reason}, #st{fd=Fd,prev_handler=PrevHandler}) -> case PrevHandler of [] -> remove_handler; _ -> {swap_handler, install_prev, [], PrevHandler, go_back} end; -handle_info({emulator, GL, Chars}, {Fd, File, PrevHandler}) - when node(GL) == node() -> - write_event(Fd, tag_event({emulator, GL, Chars})), - {ok, {Fd, File, PrevHandler}}; -handle_info({emulator, noproc, Chars}, {Fd, File, PrevHandler}) -> - write_event(Fd, tag_event({emulator, noproc, Chars})), - {ok, {Fd, File, PrevHandler}}; handle_info(_, State) -> {ok, State}. -handle_call(filename, {Fd, File, Prev}) -> - {ok, File, {Fd, File, Prev}}; +handle_call(filename, #st{filename=File}=State) -> + {ok, File, State}; handle_call(_Query, State) -> {ok, {error, bad_query}, State}. -terminate(_Reason, State) -> - case State of - {Fd, _File, _Prev} -> - ok = file:close(Fd); - _ -> - ok - end, - []. +terminate(_Reason, #st{fd=Fd}) -> + file:close(Fd). code_change(_OldVsn, State, _Extra) -> {ok, State}. @@ -103,69 +104,73 @@ code_change(_OldVsn, State, _Extra) -> %%% Misc. functions. %%% ------------------------------------------------------ -tag_event(Event) -> - {erlang:universaltime(), Event}. +write_events(State, [Ev|Es]) -> + %% Write the events in reversed order. + write_events(State, Es), + write_event(State, Ev); +write_events(_State, []) -> + ok. -write_events(Fd, Events) -> write_events1(Fd, lists:reverse(Events)). +write_event(#st{fd=Fd}=State, Event) -> + case parse_event(Event) of + ignore -> + ok; + {Head,Pid,FormatList} -> + Time = maybe_utc(erlang:universaltime()), + Header = write_time(Time, Head), + Body = format_body(State, FormatList), + AtNode = if + node(Pid) =/= node() -> + ["** at node ",atom_to_list(node(Pid))," **\n"]; + true -> + [] + end, + io:put_chars(Fd, [Header,Body,AtNode]) + end. -write_events1(Fd, [Event|Es]) -> - write_event(Fd, Event), - write_events1(Fd, Es); -write_events1(_, []) -> - ok. +format_body(State, [{Format,Args}|T]) -> + S = try format(State, Format, Args) of + S0 -> + S0 + catch + _:_ -> + format(State, "ERROR: ~p - ~p\n", [Format,Args]) + end, + [S|format_body(State, T)]; +format_body(_State, []) -> + []. -write_event(Fd, {Time, {error, _GL, {Pid, Format, Args}}}) -> - T = write_time(maybe_utc(Time)), - case catch io_lib:format(add_node(Format,Pid), Args) of - S when is_list(S) -> - io:format(Fd, T ++ S, []); - _ -> - F = add_node("ERROR: ~p - ~p~n", Pid), - io:format(Fd, T ++ F, [Format,Args]) - end; -write_event(Fd, {Time, {emulator, _GL, Chars}}) -> - T = write_time(maybe_utc(Time)), - case catch io_lib:format(Chars, []) of - S when is_list(S) -> - io:format(Fd, T ++ S, []); - _ -> - io:format(Fd, T ++ "ERROR: ~p ~n", [Chars]) - end; -write_event(Fd, {Time, {info, _GL, {Pid, Info, _}}}) -> - T = write_time(maybe_utc(Time)), - io:format(Fd, T ++ add_node("~p~n",Pid),[Info]); -write_event(Fd, {Time, {error_report, _GL, {Pid, std_error, Rep}}}) -> - T = write_time(maybe_utc(Time)), - S = format_report(Rep), - io:format(Fd, T ++ S ++ add_node("", Pid), []); -write_event(Fd, {Time, {info_report, _GL, {Pid, std_info, Rep}}}) -> - T = write_time(maybe_utc(Time), "INFO REPORT"), - S = format_report(Rep), - io:format(Fd, T ++ S ++ add_node("", Pid), []); -write_event(Fd, {Time, {info_msg, _GL, {Pid, Format, Args}}}) -> - T = write_time(maybe_utc(Time), "INFO REPORT"), - case catch io_lib:format(add_node(Format,Pid), Args) of - S when is_list(S) -> - io:format(Fd, T ++ S, []); - _ -> - F = add_node("ERROR: ~p - ~p~n", Pid), - io:format(Fd, T ++ F, [Format,Args]) - end; -write_event(Fd, {Time, {warning_report, _GL, {Pid, std_warning, Rep}}}) -> - T = write_time(maybe_utc(Time), "WARNING REPORT"), - S = format_report(Rep), - io:format(Fd, T ++ S ++ add_node("", Pid), []); -write_event(Fd, {Time, {warning_msg, _GL, {Pid, Format, Args}}}) -> - T = write_time(maybe_utc(Time), "WARNING REPORT"), - case catch io_lib:format(add_node(Format,Pid), Args) of - S when is_list(S) -> - io:format(Fd, T ++ S, []); - _ -> - F = add_node("ERROR: ~p - ~p~n", Pid), - io:format(Fd, T ++ F, [Format,Args]) - end; -write_event(_, _) -> - ok. +format(#st{depth=unlimited}, Format, Args) -> + io_lib:format(Format, Args); +format(#st{depth=Depth}, Format0, Args) -> + Format1 = io_lib:scan_format(Format0, Args), + Format = limit_format(Format1, Depth), + io_lib:build_text(Format). + +limit_format([#{control_char:=C0}=M0|T], Depth) when C0 =:= $p; + C0 =:= $w -> + C = C0 - ($a - $A), %To uppercase. + #{args:=Args} = M0, + M = M0#{control_char:=C,args:=Args++[Depth]}, + [M|limit_format(T, Depth)]; +limit_format([H|T], Depth) -> + [H|limit_format(T, Depth)]; +limit_format([], _) -> + []. + +parse_event({error, _GL, {Pid, Format, Args}}) -> + {"ERROR REPORT",Pid,[{Format,Args}]}; +parse_event({info_msg, _GL, {Pid, Format, Args}}) -> + {"INFO REPORT",Pid,[{Format, Args}]}; +parse_event({warning_msg, _GL, {Pid, Format, Args}}) -> + {"WARNING REPORT",Pid,[{Format,Args}]}; +parse_event({error_report, _GL, {Pid, std_error, Args}}) -> + {"ERROR REPORT",Pid,format_term(Args)}; +parse_event({info_report, _GL, {Pid, std_info, Args}}) -> + {"INFO REPORT",Pid,format_term(Args)}; +parse_event({warning_report, _GL, {Pid, std_warning, Args}}) -> + {"WARNING REPORT",Pid,format_term(Args)}; +parse_event(_) -> ignore. maybe_utc(Time) -> UTC = case application:get_env(sasl, utc_log) of @@ -182,30 +187,27 @@ maybe_utc(Time) -> maybe_utc(Time, true) -> {utc, Time}; maybe_utc(Time, _) -> {local, calendar:universal_time_to_local_time(Time)}. -format_report(Rep) when is_list(Rep) -> - case string_p(Rep) of +format_term(Term) when is_list(Term) -> + case string_p(Term) of true -> - io_lib:format("~s~n",[Rep]); - _ -> - format_rep(Rep) + [{"~s\n",[Term]}]; + false -> + format_term_list(Term) end; -format_report(Rep) -> - io_lib:format("~p~n",[Rep]). +format_term(Term) -> + [{"~p\n",[Term]}]. -format_rep([{Tag,Data}|Rep]) -> - io_lib:format(" ~p: ~p~n",[Tag,Data]) ++ format_rep(Rep); -format_rep([Other|Rep]) -> - io_lib:format(" ~p~n",[Other]) ++ format_rep(Rep); -format_rep(_) -> +format_term_list([{Tag,Data}|T]) -> + [{" ~p: ~p\n",[Tag,Data]}|format_term_list(T)]; +format_term_list([Data|T]) -> + [{" ~p\n",[Data]}|format_term_list(T)]; +format_term_list([]) -> + []; +format_term_list(_) -> + %% Continue to allow non-proper lists for now. + %% FIXME: Remove this clause in OTP 19. []. -add_node(X, Pid) when is_atom(X) -> - add_node(atom_to_list(X), Pid); -add_node(X, Pid) when node(Pid) =/= node() -> - lists:concat([X,"** at node ",node(Pid)," **~n"]); -add_node(X, _) -> - X. - string_p([]) -> false; string_p(Term) -> @@ -221,15 +223,10 @@ string_p1([$\b|T]) -> string_p1(T); string_p1([$\f|T]) -> string_p1(T); string_p1([$\e|T]) -> string_p1(T); string_p1([H|T]) when is_list(H) -> - case string_p1(H) of - true -> string_p1(T); - _ -> false - end; + string_p1(H) andalso string_p1(T); string_p1([]) -> true; string_p1(_) -> false. -write_time(Time) -> write_time(Time, "ERROR REPORT"). - write_time({utc,{{Y,Mo,D},{H,Mi,S}}}, Type) -> io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s UTC ===~n", [Type,D,month(Mo),Y,t(H),t(Mi),t(S)]); diff --git a/lib/stdlib/src/error_logger_tty_h.erl b/lib/stdlib/src/error_logger_tty_h.erl index ad5891f191..cb22a8c0b6 100644 --- a/lib/stdlib/src/error_logger_tty_h.erl +++ b/lib/stdlib/src/error_logger_tty_h.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -22,144 +23,180 @@ %%% %%% A handler that can be connected to the error_logger -%%% event handler. -%%% Writes all events formatted to stdout. -%%% Handles events tagged error, emulator and info. +%%% event handler. Writes all events formatted to stdout. %%% %%% It can only be started from error_logger:swap_handler(tty) -%%% or error_logger:tty(true) +%%% or error_logger:tty(true). %%% -export([init/1, handle_event/2, handle_call/2, handle_info/2, terminate/2, code_change/3]). --export([write_event/2]). +-export([write_event/2,write_event/3]). + +-record(st, + {user, + prev_handler, + io_mod=io, + depth=unlimited}). %% This one is used when we takeover from the simple error_logger. init({[], {error_logger, Buf}}) -> User = set_group_leader(), - write_events(Buf,io), - {ok, {User, error_logger}}; + Depth = get_depth(), + State = #st{user=User,prev_handler=error_logger,depth=Depth}, + write_events(State, Buf), + {ok, State}; %% This one is used if someone took over from us, and now wants to %% go back. init({[], {error_logger_tty_h, PrevHandler}}) -> User = set_group_leader(), - {ok, {User, PrevHandler}}; + {ok, #st{user=User,prev_handler=PrevHandler}}; %% This one is used when we are started directly. init([]) -> User = set_group_leader(), - {ok, {User, []}}. + Depth = get_depth(), + {ok, #st{user=User,prev_handler=[],depth=Depth}}. + +get_depth() -> + case application:get_env(kernel, error_logger_format_depth) of + {ok, Depth} when is_integer(Depth) -> + max(10, Depth); + undefined -> + unlimited + end. handle_event({_Type, GL, _Msg}, State) when node(GL) =/= node() -> {ok, State}; handle_event(Event, State) -> - write_event(tag_event(Event),io), + ok = do_write_event(State, tag_event(Event)), {ok, State}. -handle_info({'EXIT', User, _Reason}, {User, PrevHandler}) -> +handle_info({'EXIT', User, _Reason}, + #st{user=User,prev_handler=PrevHandler}=State) -> case PrevHandler of [] -> remove_handler; _ -> - {swap_handler, install_prev, {User, PrevHandler}, + {swap_handler, install_prev, State, PrevHandler, go_back} end; -handle_info({emulator, GL, Chars}, State) when node(GL) == node() -> - write_event(tag_event({emulator, GL, Chars}),io), - {ok, State}; -handle_info({emulator, noproc, Chars}, State) -> - write_event(tag_event({emulator, noproc, Chars}),io), - {ok, State}; handle_info(_, State) -> {ok, State}. handle_call(_Query, State) -> {ok, {error, bad_query}, State}. -% unfortunately, we can't unlink from User - links are not counted! -% if pid(User) -> unlink(User); true -> ok end, terminate(install_prev, _State) -> []; -terminate(_Reason, {_User, PrevHandler}) -> +terminate(_Reason, #st{prev_handler=PrevHandler}) -> {error_logger_tty_h, PrevHandler}. code_change(_OldVsn, State, _Extra) -> {ok, State}. +%% Exported (but unoffical) API. +write_event(Event, IoMod) -> + do_write_event(#st{io_mod=IoMod}, Event). + +write_event(Event, IoMod, Depth) -> + do_write_event(#st{io_mod=IoMod,depth=Depth}, Event). + + %%% ------------------------------------------------------ %%% Misc. functions. %%% ------------------------------------------------------ set_group_leader() -> case whereis(user) of - User when is_pid(User) -> link(User), group_leader(User,self()), User; - _ -> false + User when is_pid(User) -> + link(User), + group_leader(User,self()), + User; + _ -> + false end. tag_event(Event) -> {erlang:universaltime(), Event}. -write_events(Events,IOMod) -> write_events1(lists:reverse(Events),IOMod). - -write_events1([Event|Es],IOMod) -> - write_event(Event,IOMod), - write_events1(Es,IOMod); -write_events1([],_IOMod) -> +write_events(State, [Ev|Es]) -> + %% Write the events in reverse order. + _ = write_events(State, Es), + _ = do_write_event(State, Ev), + ok; +write_events(_State, []) -> ok. -write_event({Time, {error, _GL, {Pid, Format, Args}}},IOMod) -> - T = write_time(maybe_utc(Time)), - case catch io_lib:format(add_node(Format,Pid), Args) of - S when is_list(S) -> - format(IOMod, T ++ S); - _ -> - F = add_node("ERROR: ~p - ~p~n", Pid), - format(IOMod, T ++ F, [Format,Args]) - end; -write_event({Time, {emulator, _GL, Chars}},IOMod) -> - T = write_time(maybe_utc(Time)), - case catch io_lib:format(Chars, []) of - S when is_list(S) -> - format(IOMod, T ++ S); - _ -> - format(IOMod, T ++ "ERROR: ~p ~n", [Chars]) - end; -write_event({Time, {info, _GL, {Pid, Info, _}}},IOMod) -> - T = write_time(maybe_utc(Time)), - format(IOMod, T ++ add_node("~p~n",Pid),[Info]); -write_event({Time, {error_report, _GL, {Pid, std_error, Rep}}},IOMod) -> - T = write_time(maybe_utc(Time)), - S = format_report(Rep), - format(IOMod, T ++ S ++ add_node("", Pid)); -write_event({Time, {info_report, _GL, {Pid, std_info, Rep}}},IOMod) -> - T = write_time(maybe_utc(Time), "INFO REPORT"), - S = format_report(Rep), - format(IOMod, T ++ S ++ add_node("", Pid)); -write_event({Time, {info_msg, _GL, {Pid, Format, Args}}},IOMod) -> - T = write_time(maybe_utc(Time), "INFO REPORT"), - case catch io_lib:format(add_node(Format,Pid), Args) of - S when is_list(S) -> - format(IOMod, T ++ S); - _ -> - F = add_node("ERROR: ~p - ~p~n", Pid), - format(IOMod, T ++ F, [Format,Args]) - end; -write_event({Time, {warning_report, _GL, {Pid, std_warning, Rep}}},IOMod) -> - T = write_time(maybe_utc(Time), "WARNING REPORT"), - S = format_report(Rep), - format(IOMod, T ++ S ++ add_node("", Pid)); -write_event({Time, {warning_msg, _GL, {Pid, Format, Args}}},IOMod) -> - T = write_time(maybe_utc(Time), "WARNING REPORT"), - case catch io_lib:format(add_node(Format,Pid), Args) of - S when is_list(S) -> - format(IOMod, T ++ S); - _ -> - F = add_node("ERROR: ~p - ~p~n", Pid), - format(IOMod, T ++ F, [Format,Args]) +do_write_event(State, {Time0, Event}) -> + case parse_event(Event) of + ignore -> + ok; + {Head,Pid,FormatList} -> + Time = maybe_utc(Time0), + Header = write_time(Time, Head), + Body = format_body(State, FormatList), + AtNode = if + node(Pid) =/= node() -> + ["** at node ",atom_to_list(node(Pid))," **\n"]; + true -> + [] + end, + Str = [Header,Body,AtNode], + case State#st.io_mod of + io_lib -> + Str; + io -> + io:put_chars(user, Str) + end end; -write_event({_Time, _Error},_IOMod) -> +do_write_event(_, _) -> ok. +format_body(State, [{Format,Args}|T]) -> + S = try format(State, Format, Args) of + S0 -> + S0 + catch + _:_ -> + format(State, "ERROR: ~p - ~p\n", [Format,Args]) + end, + [S|format_body(State, T)]; +format_body(_State, []) -> + []. + +format(#st{depth=unlimited}, Format, Args) -> + io_lib:format(Format, Args); +format(#st{depth=Depth}, Format0, Args) -> + Format1 = io_lib:scan_format(Format0, Args), + Format = limit_format(Format1, Depth), + io_lib:build_text(Format). + +limit_format([#{control_char:=C0}=M0|T], Depth) when C0 =:= $p; + C0 =:= $w -> + C = C0 - ($a - $A), %To uppercase. + #{args:=Args} = M0, + M = M0#{control_char:=C,args:=Args++[Depth]}, + [M|limit_format(T, Depth)]; +limit_format([H|T], Depth) -> + [H|limit_format(T, Depth)]; +limit_format([], _) -> + []. + +parse_event({error, _GL, {Pid, Format, Args}}) -> + {"ERROR REPORT",Pid,[{Format,Args}]}; +parse_event({info_msg, _GL, {Pid, Format, Args}}) -> + {"INFO REPORT",Pid,[{Format, Args}]}; +parse_event({warning_msg, _GL, {Pid, Format, Args}}) -> + {"WARNING REPORT",Pid,[{Format,Args}]}; +parse_event({error_report, _GL, {Pid, std_error, Args}}) -> + {"ERROR REPORT",Pid,format_term(Args)}; +parse_event({info_report, _GL, {Pid, std_info, Args}}) -> + {"INFO REPORT",Pid,format_term(Args)}; +parse_event({warning_report, _GL, {Pid, std_warning, Args}}) -> + {"WARNING REPORT",Pid,format_term(Args)}; +parse_event(_) -> ignore. + maybe_utc(Time) -> UTC = case application:get_env(sasl, utc_log) of {ok, Val} -> Val; @@ -175,33 +212,26 @@ maybe_utc(Time) -> maybe_utc(Time, true) -> {utc, Time}; maybe_utc(Time, _) -> {local, calendar:universal_time_to_local_time(Time)}. -format(IOMod, String) -> format(IOMod, String, []). -format(io_lib, String, Args) -> io_lib:format(String, Args); -format(io, String, Args) -> io:format(user, String, Args). - -format_report(Rep) when is_list(Rep) -> - case string_p(Rep) of +format_term(Term) when is_list(Term) -> + case string_p(Term) of true -> - io_lib:format("~s~n",[Rep]); - _ -> - format_rep(Rep) + [{"~s\n",[Term]}]; + false -> + format_term_list(Term) end; -format_report(Rep) -> - io_lib:format("~p~n",[Rep]). - -format_rep([{Tag,Data}|Rep]) -> - io_lib:format(" ~p: ~p~n",[Tag,Data]) ++ format_rep(Rep); -format_rep([Other|Rep]) -> - io_lib:format(" ~p~n",[Other]) ++ format_rep(Rep); -format_rep(_) -> - []. +format_term(Term) -> + [{"~p\n",[Term]}]. -add_node(X, Pid) when is_atom(X) -> - add_node(atom_to_list(X), Pid); -add_node(X, Pid) when node(Pid) =/= node() -> - lists:concat([X,"** at node ",node(Pid)," **~n"]); -add_node(X, _) -> - X. +format_term_list([{Tag,Data}|T]) -> + [{" ~p: ~p\n",[Tag,Data]}|format_term_list(T)]; +format_term_list([Data|T]) -> + [{" ~p\n",[Data]}|format_term_list(T)]; +format_term_list([]) -> + []; +format_term_list(_) -> + %% Continue to allow non-proper lists for now. + %% FIXME: Remove this clause in OTP 19. + []. string_p([]) -> false; @@ -225,7 +255,6 @@ string_p1([H|T]) when is_list(H) -> string_p1([]) -> true; string_p1(_) -> false. -write_time(Time) -> write_time(Time, "ERROR REPORT"). write_time({utc,{{Y,Mo,D},{H,Mi,S}}},Type) -> io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s UTC ===~n", [Type,D,month(Mo),Y,t(H),t(Mi),t(S)]); diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index 498d850df3..c42ae981e7 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2012. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% @@ -37,7 +38,7 @@ -record(state, {file :: file:filename(), module :: module(), forms_or_bin, - source :: source(), + source :: source() | 'undefined', n_errors :: non_neg_integer(), mode :: mode(), exports_main :: boolean(), @@ -48,9 +49,9 @@ -type emu_args() :: string(). -record(sections, {type, - shebang :: shebang(), - comment :: comment(), - emu_args :: emu_args(), + shebang :: shebang() | 'undefined', + comment :: comment() | 'undefined', + emu_args :: emu_args() | 'undefined', body}). -record(extract_options, {compile_source}). @@ -59,7 +60,6 @@ file:filename() | {file:filename(), binary()} | {file:filename(), binary(), file:file_info()}. --type zip_create_option() :: term(). -type section() :: shebang | {shebang, shebang() | default | undefined} @@ -68,8 +68,8 @@ | {emu_args, emu_args() | undefined} | {source, file:filename() | binary()} | {beam, file:filename() | binary()} - | {archive, file:filename() | binary()} - | {archive, [zip_file()], [zip_create_option()]}. + | {archive, zip:filename() | binary()} + | {archive, [zip_file()], [zip:create_option()]}. %%----------------------------------------------------------------------- @@ -289,6 +289,8 @@ start(EscriptOptions) -> my_halt(127) end. +-spec parse_and_run(_, _, _) -> no_return(). + parse_and_run(File, Args, Options) -> CheckOnly = lists:member("s", Options), {Source, Module, FormsOrBin, HasRecs, Mode} = @@ -479,46 +481,49 @@ find_first_body_line(Fd, HeaderSz0, LineNo, KeepFirst, Sections) -> %% Look for special comment on second line Line2 = get_line(Fd), {ok, HeaderSz2} = file:position(Fd, cur), - case classify_line(Line2) of - emu_args -> - %% Skip special comment on second line - Line3 = get_line(Fd), - {HeaderSz2, LineNo + 2, Fd, - Sections#sections{type = guess_type(Line3), - comment = undefined, - emu_args = Line2}}; - Line2Type -> - %% Look for special comment on third line - Line3 = get_line(Fd), - {ok, HeaderSz3} = file:position(Fd, cur), - Line3Type = classify_line(Line3), - if - Line3Type =:= emu_args -> - %% Skip special comment on third line - Line4 = get_line(Fd), - {HeaderSz3, LineNo + 3, Fd, - Sections#sections{type = guess_type(Line4), - comment = Line2, - emu_args = Line3}}; - Sections#sections.shebang =:= undefined, - KeepFirst =:= true -> - %% No shebang. Use the entire file - {HeaderSz0, LineNo, Fd, - Sections#sections{type = guess_type(Line2)}}; - Sections#sections.shebang =:= undefined -> - %% No shebang. Skip the first line - {HeaderSz1, LineNo, Fd, - Sections#sections{type = guess_type(Line2)}}; - Line2Type =:= comment -> - %% Skip shebang on first line and comment on second - {HeaderSz2, LineNo + 2, Fd, - Sections#sections{type = guess_type(Line3), - comment = Line2}}; - true -> - %% Just skip shebang on first line - {HeaderSz1, LineNo + 1, Fd, - Sections#sections{type = guess_type(Line2)}} - end + if + Sections#sections.shebang =:= undefined, + KeepFirst =:= true -> + %% No shebang. Use the entire file + {HeaderSz0, LineNo, Fd, + Sections#sections{type = guess_type(Line2)}}; + Sections#sections.shebang =:= undefined -> + %% No shebang. Skip the first line + {HeaderSz1, LineNo, Fd, + Sections#sections{type = guess_type(Line2)}}; + true -> + case classify_line(Line2) of + emu_args -> + %% Skip special comment on second line + Line3 = get_line(Fd), + {HeaderSz2, LineNo + 2, Fd, + Sections#sections{type = guess_type(Line3), + comment = undefined, + emu_args = Line2}}; + comment -> + %% Look for special comment on third line + Line3 = get_line(Fd), + {ok, HeaderSz3} = file:position(Fd, cur), + Line3Type = classify_line(Line3), + if + Line3Type =:= emu_args -> + %% Skip special comment on third line + Line4 = get_line(Fd), + {HeaderSz3, LineNo + 3, Fd, + Sections#sections{type = guess_type(Line4), + comment = Line2, + emu_args = Line3}}; + true -> + %% Skip shebang on first line and comment on second + {HeaderSz2, LineNo + 2, Fd, + Sections#sections{type = guess_type(Line3), + comment = Line2}} + end; + _ -> + %% Just skip shebang on first line + {HeaderSz1, LineNo + 1, Fd, + Sections#sections{type = guess_type(Line2)}} + end end. classify_line(Line) -> @@ -602,9 +607,15 @@ parse_beam(S, File, HeaderSz, CheckOnly) -> parse_source(S, File, Fd, StartLine, HeaderSz, CheckOnly) -> {PreDefMacros, Module} = pre_def_macros(File), IncludePath = [], - {ok, _} = file:position(Fd, {bof, HeaderSz}), + %% Read the encoding on the second line, if there is any: + {ok, _} = file:position(Fd, 0), + _ = io:get_line(Fd, ''), + Encoding = epp:set_encoding(Fd), + {ok, _} = file:position(Fd, HeaderSz), case epp:open(File, Fd, StartLine, IncludePath, PreDefMacros) of {ok, Epp} -> + _ = [io:setopts(Fd, [{encoding,Encoding}]) || + Encoding =/= none], {ok, FileForm} = epp:parse_erl_form(Epp), OptModRes = epp:parse_erl_form(Epp), S2 = S#state{source = text, module = Module}, @@ -613,18 +624,19 @@ parse_source(S, File, Fd, StartLine, HeaderSz, CheckOnly) -> {ok, {attribute,_, module, M} = Form} -> epp_parse_file(Epp, S2#state{module = M}, [Form, FileForm]); {ok, _} -> - ModForm = {attribute,1,module, Module}, + ModForm = {attribute,a1(),module, Module}, epp_parse_file2(Epp, S2, [ModForm, FileForm], OptModRes); {error, _} -> epp_parse_file2(Epp, S2, [FileForm], OptModRes); - {eof, _LastLine} = Eof -> - S#state{forms_or_bin = [FileForm, Eof]} + {eof, LastLine} -> + Anno = anno(LastLine), + S#state{forms_or_bin = [FileForm, {eof, Anno}]} end, ok = epp:close(Epp), ok = file:close(Fd), check_source(S3, CheckOnly); {error, Reason} -> - io:format("escript: ~p\n", [Reason]), + io:format("escript: ~tp\n", [Reason]), fatal("Preprocessor error") end. @@ -637,7 +649,7 @@ check_source(S, CheckOnly) -> %% Optionally add export of main/1 Forms2 = case ExpMain of - false -> [{attribute,0,export, [{main,1}]} | Forms]; + false -> [{attribute, a0(), export, [{main,1}]} | Forms]; true -> Forms end, Forms3 = [FileForm2, ModForm2 | Forms2], @@ -656,7 +668,8 @@ check_source(S, CheckOnly) -> end. pre_def_macros(File) -> - {MegaSecs, Secs, MicroSecs} = erlang:now(), + {MegaSecs, Secs, MicroSecs} = erlang:timestamp(), + Unique = erlang:unique_integer([positive]), Replace = fun(Char) -> case Char of $\. -> $\_; @@ -668,8 +681,9 @@ pre_def_macros(File) -> CleanBase ++ "__" ++ "escript__" ++ integer_to_list(MegaSecs) ++ "__" ++ - integer_to_list(Secs) ++ "__" ++ - integer_to_list(MicroSecs), + integer_to_list(Secs) ++ "__" ++ + integer_to_list(MicroSecs) ++ "__" ++ + integer_to_list(Unique), Module = list_to_atom(ModuleStr), PreDefMacros = [{'MODULE', Module, redefine}, {'MODULE_STRING', ModuleStr, redefine}], @@ -694,7 +708,7 @@ epp_parse_file2(Epp, S, Forms, Parsed) -> epp_parse_file(Epp, S2, [Form | Forms]); true -> Args = lists:flatten(io_lib:format("illegal mode attribute: ~p", [NewMode])), - io:format("~s:~w ~s\n", [S#state.file,Ln,Args]), + io:format("~ts:~w ~s\n", [S#state.file,Ln,Args]), Error = {error,{Ln,erl_parse,Args}}, Nerrs= S#state.n_errors + 1, epp_parse_file(Epp, S2#state{n_errors = Nerrs}, [Error | Forms]) @@ -710,17 +724,20 @@ epp_parse_file2(Epp, S, Forms, Parsed) -> epp_parse_file(Epp, S, [Form | Forms]) end; {error,{Ln,Mod,Args}} = Form -> - io:format("~s:~w: ~s\n", + io:format("~ts:~w: ~ts\n", [S#state.file,Ln,Mod:format_error(Args)]), epp_parse_file(Epp, S#state{n_errors = S#state.n_errors + 1}, [Form | Forms]); - {eof, _LastLine} = Eof -> - S#state{forms_or_bin = lists:reverse([Eof | Forms])} + {eof, LastLine} -> + Anno = anno(LastLine), + S#state{forms_or_bin = lists:reverse([{eof, Anno} | Forms])} end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Evaluate script %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-spec debug(_, _, _) -> no_return(). + debug(Module, AbsMod, Args) -> case hidden_apply(debugger, debugger, start, []) of {ok, _} -> @@ -736,6 +753,8 @@ debug(Module, AbsMod, Args) -> fatal("Cannot start the debugger") end. +-spec run(_, _) -> no_return(). + run(Module, Args) -> try Module:main(Args), @@ -745,6 +764,8 @@ run(Module, Args) -> fatal(format_exception(Class, Reason)) end. +-spec interpret(_, _, _, _) -> no_return(). + interpret(Forms, HasRecs, File, Args) -> %% Basic validation before execution case erl_lint:module(Forms) of @@ -763,11 +784,14 @@ interpret(Forms, HasRecs, File, Args) -> end, Dict = parse_to_dict(Forms2), ArgsA = erl_parse:abstract(Args, 0), - Call = {call,0,{atom,0,main},[ArgsA]}, + Anno = a0(), + Call = {call,Anno,{atom,Anno,main},[ArgsA]}, try - erl_eval:expr(Call, - erl_eval:new_bindings(), - {value,fun(I, J) -> code_handler(I, J, Dict, File) end}), + _ = erl_eval:expr(Call, + erl_eval:new_bindings(), + {value,fun(I, J) -> + code_handler(I, J, Dict, File) + end}), my_halt(0) catch Class:Reason -> @@ -780,10 +804,10 @@ report_errors(Errors) -> Errors). list_errors(F, [{Line,Mod,E}|Es]) -> - io:fwrite("~s:~w: ~s\n", [F,Line,Mod:format_error(E)]), + io:fwrite("~ts:~w: ~ts\n", [F,Line,Mod:format_error(E)]), list_errors(F, Es); list_errors(F, [{Mod,E}|Es]) -> - io:fwrite("~s: ~s\n", [F,Mod:format_error(E)]), + io:fwrite("~ts: ~ts\n", [F,Mod:format_error(E)]), list_errors(F, Es); list_errors(_F, []) -> ok. @@ -795,10 +819,10 @@ report_warnings(Ws0) -> lists:foreach(fun({_,Str}) -> io:put_chars(Str) end, Ws). format_message(F, [{Line,Mod,E}|Es]) -> - M = {{F,Line},io_lib:format("~s:~w: Warning: ~s\n", [F,Line,Mod:format_error(E)])}, + M = {{F,Line},io_lib:format("~ts:~w: Warning: ~ts\n", [F,Line,Mod:format_error(E)])}, [M|format_message(F, Es)]; format_message(F, [{Mod,E}|Es]) -> - M = {none,io_lib:format("~s: Warning: ~s\n", [F,Mod:format_error(E)])}, + M = {none,io_lib:format("~ts: Warning: ~ts\n", [F,Mod:format_error(E)])}, [M|format_message(F, Es)]; format_message(_, []) -> []. @@ -851,16 +875,41 @@ eval_exprs([E|Es], Bs0, Lf, Ef, RBs) -> eval_exprs(Es, Bs, Lf, Ef, RBs). format_exception(Class, Reason) -> + Enc = encoding(), + P = case Enc of + latin1 -> "P"; + _ -> "tP" + end, PF = fun(Term, I) -> - io_lib:format("~." ++ integer_to_list(I) ++ "P", [Term, 50]) + io_lib:format("~." ++ integer_to_list(I) ++ P, [Term, 50]) end, StackTrace = erlang:get_stacktrace(), StackFun = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end, - lib:format_exception(1, Class, Reason, StackTrace, StackFun, PF). + lib:format_exception(1, Class, Reason, StackTrace, StackFun, PF, Enc). + +encoding() -> + [{encoding, Encoding}] = enc(), + Encoding. + +enc() -> + case lists:keyfind(encoding, 1, io:getopts()) of + false -> [{encoding,latin1}]; % should never happen + Enc -> [Enc] + end. + +a0() -> + anno(0). + +a1() -> + anno(1). + +anno(L) -> + erl_anno:new(L). fatal(Str) -> throw(Str). +-spec my_halt(_) -> no_return(). my_halt(Reason) -> erlang:halt(Reason). diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index afa914a456..20de06fd0b 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -42,74 +43,460 @@ -export([i/0, i/1, i/2, i/3]). --export_type([tab/0, tid/0, match_spec/0]). +-export_type([tab/0, tid/0, match_spec/0, comp_match_spec/0, match_pattern/0]). %%----------------------------------------------------------------------------- +-type access() :: public | protected | private. -type tab() :: atom() | tid(). +-type type() :: set | ordered_set | bag | duplicate_bag. +-type continuation() :: '$end_of_table' + | {tab(),integer(),integer(),binary(),list(),integer()} + | {tab(),_,_,integer(),binary(),list(),integer(),integer()}. -%% a similar definition is also in erl_types -opaque tid() :: integer(). -%% these ones are also defined in erl_bif_types -type match_pattern() :: atom() | tuple(). -type match_spec() :: [{match_pattern(), [_], [_]}]. %%----------------------------------------------------------------------------- -%% The following functions used to be found in this module, but -%% are now BIFs (i.e. implemented in C). -%% -%% all/0 -%% new/2 -%% delete/1 -%% delete/2 -%% first/1 -%% info/1 -%% info/2 -%% safe_fixtable/2 -%% lookup/2 -%% lookup_element/3 -%% insert/2 -%% is_compiled_ms/1 -%% last/1 -%% member/2 -%% next/2 -%% prev/2 -%% rename/2 -%% slot/2 -%% match/1 -%% match/2 -%% match/3 -%% match_object/1 -%% match_object/2 -%% match_object/3 -%% match_spec_compile/1 -%% match_spec_run_r/3 -%% select/1 -%% select/2 -%% select/3 -%% select_count/2 -%% select_reverse/1 -%% select_reverse/2 -%% select_reverse/3 -%% select_delete/2 -%% setopts/2 -%% update_counter/3 -%% update_element/3 -%% +%%% BIFs + +-export([all/0, delete/1, delete/2, delete_all_objects/1, + delete_object/2, first/1, give_away/3, info/1, info/2, + insert/2, insert_new/2, is_compiled_ms/1, last/1, lookup/2, + lookup_element/3, match/1, match/2, match/3, match_object/1, + match_object/2, match_object/3, match_spec_compile/1, + match_spec_run_r/3, member/2, new/2, next/2, prev/2, + rename/2, safe_fixtable/2, select/1, select/2, select/3, + select_count/2, select_delete/2, select_reverse/1, + select_reverse/2, select_reverse/3, setopts/2, slot/2, + take/2, + update_counter/3, update_counter/4, update_element/3]). + +-spec all() -> [Tab] when + Tab :: tab(). + +all() -> + erlang:nif_error(undef). + +-spec delete(Tab) -> true when + Tab :: tab(). + +delete(_) -> + erlang:nif_error(undef). + +-spec delete(Tab, Key) -> true when + Tab :: tab(), + Key :: term(). + +delete(_, _) -> + erlang:nif_error(undef). + +-spec delete_all_objects(Tab) -> true when + Tab :: tab(). + +delete_all_objects(_) -> + erlang:nif_error(undef). + +-spec delete_object(Tab, Object) -> true when + Tab :: tab(), + Object :: tuple(). + +delete_object(_, _) -> + erlang:nif_error(undef). + +-spec first(Tab) -> Key | '$end_of_table' when + Tab :: tab(), + Key :: term(). + +first(_) -> + erlang:nif_error(undef). + +-spec give_away(Tab, Pid, GiftData) -> true when + Tab :: tab(), + Pid :: pid(), + GiftData :: term(). + +give_away(_, _, _) -> + erlang:nif_error(undef). + +-spec info(Tab) -> InfoList | undefined when + Tab :: tab(), + InfoList :: [InfoTuple], + InfoTuple :: {compressed, boolean()} + | {heir, pid() | none} + | {keypos, pos_integer()} + | {memory, non_neg_integer()} + | {name, atom()} + | {named_table, boolean()} + | {node, node()} + | {owner, pid()} + | {protection, access()} + | {size, non_neg_integer()} + | {type, type()} + | {write_concurrency, boolean()} + | {read_concurrency, boolean()}. + +info(_) -> + erlang:nif_error(undef). + +-spec info(Tab, Item) -> Value | undefined when + Tab :: tab(), + Item :: compressed | fixed | heir | keypos | memory + | name | named_table | node | owner | protection + | safe_fixed | safe_fixed_monotonic_time | size | stats | type + | write_concurrency | read_concurrency, + Value :: term(). + +info(_, _) -> + erlang:nif_error(undef). + +-spec insert(Tab, ObjectOrObjects) -> true when + Tab :: tab(), + ObjectOrObjects :: tuple() | [tuple()]. + +insert(_, _) -> + erlang:nif_error(undef). + +-spec insert_new(Tab, ObjectOrObjects) -> boolean() when + Tab :: tab(), + ObjectOrObjects :: tuple() | [tuple()]. + +insert_new(_, _) -> + erlang:nif_error(undef). + +-spec is_compiled_ms(Term) -> boolean() when + Term :: term(). + +is_compiled_ms(_) -> + erlang:nif_error(undef). + +-spec last(Tab) -> Key | '$end_of_table' when + Tab :: tab(), + Key :: term(). + +last(_) -> + erlang:nif_error(undef). + +-spec lookup(Tab, Key) -> [Object] when + Tab :: tab(), + Key :: term(), + Object :: tuple(). + +lookup(_, _) -> + erlang:nif_error(undef). + +-spec lookup_element(Tab, Key, Pos) -> Elem when + Tab :: tab(), + Key :: term(), + Pos :: pos_integer(), + Elem :: term() | [term()]. + +lookup_element(_, _, _) -> + erlang:nif_error(undef). + +-spec match(Tab, Pattern) -> [Match] when + Tab :: tab(), + Pattern :: match_pattern(), + Match :: [term()]. + +match(_, _) -> + erlang:nif_error(undef). + +-spec match(Tab, Pattern, Limit) -> {[Match], Continuation} | + '$end_of_table' when + Tab :: tab(), + Pattern :: match_pattern(), + Limit :: pos_integer(), + Match :: [term()], + Continuation :: continuation(). + +match(_, _, _) -> + erlang:nif_error(undef). + +-spec match(Continuation) -> {[Match], Continuation} | + '$end_of_table' when + Match :: [term()], + Continuation :: continuation(). + +match(_) -> + erlang:nif_error(undef). + +-spec match_object(Tab, Pattern) -> [Object] when + Tab :: tab(), + Pattern :: match_pattern(), + Object :: tuple(). + +match_object(_, _) -> + erlang:nif_error(undef). + +-spec match_object(Tab, Pattern, Limit) -> {[Object], Continuation} | + '$end_of_table' when + Tab :: tab(), + Pattern :: match_pattern(), + Limit :: pos_integer(), + Object :: tuple(), + Continuation :: continuation(). + +match_object(_, _, _) -> + erlang:nif_error(undef). + +-spec match_object(Continuation) -> {[Object], Continuation} | + '$end_of_table' when + Object :: tuple(), + Continuation :: continuation(). + +match_object(_) -> + erlang:nif_error(undef). + +-spec match_spec_compile(MatchSpec) -> CompiledMatchSpec when + MatchSpec :: match_spec(), + CompiledMatchSpec :: comp_match_spec(). + +match_spec_compile(_) -> + erlang:nif_error(undef). + +-spec match_spec_run_r(List, CompiledMatchSpec, list()) -> list() when + List :: [tuple()], + CompiledMatchSpec :: comp_match_spec(). + +match_spec_run_r(_, _, _) -> + erlang:nif_error(undef). + +-spec member(Tab, Key) -> boolean() when + Tab :: tab(), + Key :: term(). + +member(_, _) -> + erlang:nif_error(undef). + +-spec new(Name, Options) -> tid() | atom() when + Name :: atom(), + Options :: [Option], + Option :: Type | Access | named_table | {keypos,Pos} + | {heir, Pid :: pid(), HeirData} | {heir, none} | Tweaks, + Type :: type(), + Access :: access(), + Tweaks :: {write_concurrency, boolean()} + | {read_concurrency, boolean()} + | compressed, + Pos :: pos_integer(), + HeirData :: term(). + +new(_, _) -> + erlang:nif_error(undef). + +-spec next(Tab, Key1) -> Key2 | '$end_of_table' when + Tab :: tab(), + Key1 :: term(), + Key2 :: term(). + +next(_, _) -> + erlang:nif_error(undef). + +-spec prev(Tab, Key1) -> Key2 | '$end_of_table' when + Tab :: tab(), + Key1 :: term(), + Key2 :: term(). + +prev(_, _) -> + erlang:nif_error(undef). + +%% Shadowed by erl_bif_types: ets:rename/2 +-spec rename(Tab, Name) -> Name when + Tab :: tab(), + Name :: atom(). + +rename(_, _) -> + erlang:nif_error(undef). + +-spec safe_fixtable(Tab, Fix) -> true when + Tab :: tab(), + Fix :: boolean(). + +safe_fixtable(_, _) -> + erlang:nif_error(undef). + +-spec select(Tab, MatchSpec) -> [Match] when + Tab :: tab(), + MatchSpec :: match_spec(), + Match :: term(). + +select(_, _) -> + erlang:nif_error(undef). + +-spec select(Tab, MatchSpec, Limit) -> {[Match],Continuation} | + '$end_of_table' when + Tab :: tab(), + MatchSpec :: match_spec(), + Limit :: pos_integer(), + Match :: term(), + Continuation :: continuation(). --opaque comp_match_spec() :: any(). %% this one is REALLY opaque +select(_, _, _) -> + erlang:nif_error(undef). --spec match_spec_run([tuple()], comp_match_spec()) -> [term()]. +-spec select(Continuation) -> {[Match],Continuation} | '$end_of_table' when + Match :: term(), + Continuation :: continuation(). + +select(_) -> + erlang:nif_error(undef). + +-spec select_count(Tab, MatchSpec) -> NumMatched when + Tab :: tab(), + MatchSpec :: match_spec(), + NumMatched :: non_neg_integer(). + +select_count(_, _) -> + erlang:nif_error(undef). + +-spec select_delete(Tab, MatchSpec) -> NumDeleted when + Tab :: tab(), + MatchSpec :: match_spec(), + NumDeleted :: non_neg_integer(). + +select_delete(_, _) -> + erlang:nif_error(undef). + +-spec select_reverse(Tab, MatchSpec) -> [Match] when + Tab :: tab(), + MatchSpec :: match_spec(), + Match :: term(). + +select_reverse(_, _) -> + erlang:nif_error(undef). + +-spec select_reverse(Tab, MatchSpec, Limit) -> {[Match],Continuation} | + '$end_of_table' when + Tab :: tab(), + MatchSpec :: match_spec(), + Limit :: pos_integer(), + Match :: term(), + Continuation :: continuation(). + +select_reverse(_, _, _) -> + erlang:nif_error(undef). + +-spec select_reverse(Continuation) -> {[Match],Continuation} | + '$end_of_table' when + Continuation :: continuation(), + Match :: term(). + +select_reverse(_) -> + erlang:nif_error(undef). + +-spec setopts(Tab, Opts) -> true when + Tab :: tab(), + Opts :: Opt | [Opt], + Opt :: {heir, pid(), HeirData} | {heir,none}, + HeirData :: term(). + +setopts(_, _) -> + erlang:nif_error(undef). + +-spec slot(Tab, I) -> [Object] | '$end_of_table' when + Tab :: tab(), + I :: non_neg_integer(), + Object :: tuple(). + +slot(_, _) -> + erlang:nif_error(undef). + +-spec take(Tab, Key) -> [Object] when + Tab :: tab(), + Key :: term(), + Object :: tuple(). + +take(_, _) -> + erlang:nif_error(undef). + +-spec update_counter(Tab, Key, UpdateOp) -> Result when + Tab :: tab(), + Key :: term(), + UpdateOp :: {Pos, Incr} | {Pos, Incr, Threshold, SetValue}, + Pos :: integer(), + Incr :: integer(), + Threshold :: integer(), + SetValue :: integer(), + Result :: integer(); + (Tab, Key, [UpdateOp]) -> [Result] when + Tab :: tab(), + Key :: term(), + UpdateOp :: {Pos, Incr} | {Pos, Incr, Threshold, SetValue}, + Pos :: integer(), + Incr :: integer(), + Threshold :: integer(), + SetValue :: integer(), + Result :: integer(); + (Tab, Key, Incr) -> Result when + Tab :: tab(), + Key :: term(), + Incr :: integer(), + Result :: integer(). + +update_counter(_, _, _) -> + erlang:nif_error(undef). + +-spec update_counter(Tab, Key, UpdateOp, Default) -> Result when + Tab :: tab(), + Key :: term(), + UpdateOp :: {Pos, Incr} + | {Pos, Incr, Threshold, SetValue}, + Pos :: integer(), + Incr :: integer(), + Threshold :: integer(), + SetValue :: integer(), + Result :: integer(), + Default :: tuple(); + (Tab, Key, [UpdateOp], Default) -> [Result] when + Tab :: tab(), + Key :: term(), + UpdateOp :: {Pos, Incr} + | {Pos, Incr, Threshold, SetValue}, + Pos :: integer(), + Incr :: integer(), + Threshold :: integer(), + SetValue :: integer(), + Result :: integer(), + Default :: tuple(); + (Tab, Key, Incr, Default) -> Result when + Tab :: tab(), + Key :: term(), + Incr :: integer(), + Result :: integer(), + Default :: tuple(). + +update_counter(_, _, _, _) -> + erlang:nif_error(undef). + +-spec update_element(Tab, Key, ElementSpec :: {Pos, Value}) -> boolean() when + Tab :: tab(), + Key :: term(), + Pos :: pos_integer(), + Value :: term(); + (Tab, Key, ElementSpec :: [{Pos, Value}]) -> boolean() when + Tab :: tab(), + Key :: term(), + Pos :: pos_integer(), + Value :: term(). + +update_element(_, _, _) -> + erlang:nif_error(undef). + +%%% End of BIFs + +-opaque comp_match_spec() :: binary(). %% this one is REALLY opaque + +-spec match_spec_run(List, CompiledMatchSpec) -> list() when + List :: [tuple()], + CompiledMatchSpec :: comp_match_spec(). match_spec_run(List, CompiledMS) -> lists:reverse(ets:match_spec_run_r(List, CompiledMS, [])). --type continuation() :: '$end_of_table' - | {tab(),integer(),integer(),binary(),list(),integer()} - | {tab(),_,_,integer(),binary(),list(),integer(),integer()}. - -spec repair_continuation(Continuation, MatchSpec) -> Continuation when Continuation :: continuation(), MatchSpec :: match_spec(). @@ -157,13 +544,13 @@ fun2ms(ShellFun) when is_function(ShellFun) -> case ms_transform:transform_from_shell( ?MODULE,Clauses,ImportList) of {error,[{_,[{_,_,Code}|_]}|_],_} -> - io:format("Error: ~s~n", + io:format("Error: ~ts~n", [ms_transform:format_error(Code)]), {error,transform_error}; Else -> Else end; - false -> + _ -> exit({badarg,{?MODULE,fun2ms, [function,called,with,real,'fun', should,be,transformed,with, @@ -353,7 +740,8 @@ do_filter(Tab, Key, F, A, Ack) -> -record(filetab_options, { object_count = false :: boolean(), - md5sum = false :: boolean() + md5sum = false :: boolean(), + sync = false :: boolean() }). -spec tab2file(Tab, Filename) -> 'ok' | {'error', Reason} when @@ -368,14 +756,14 @@ tab2file(Tab, File) -> Tab :: tab(), Filename :: file:name(), Options :: [Option], - Option :: {'extended_info', [ExtInfo]}, + Option :: {'extended_info', [ExtInfo]} | {'sync', boolean()}, ExtInfo :: 'md5sum' | 'object_count', Reason :: term(). tab2file(Tab, File, Options) -> try {ok, FtOptions} = parse_ft_options(Options), - file:delete(File), + _ = file:delete(File), case file:read_file_info(File) of {error, enoent} -> ok; _ -> throw(eaccess) @@ -406,14 +794,18 @@ tab2file(Tab, File, Options) -> {fun(Oldstate,Termlist) -> {NewState,BinList} = md5terms(Oldstate,Termlist), - disk_log:blog_terms(Name,BinList), - NewState + case disk_log:blog_terms(Name,BinList) of + ok -> NewState; + {error, Reason2} -> throw(Reason2) + end end, erlang:md5_init()}; false -> {fun(_,Termlist) -> - disk_log:log_terms(Name,Termlist), - true + case disk_log:log_terms(Name,Termlist) of + ok -> true; + {error, Reason2} -> throw(Reason2) + end end, true} end, @@ -445,19 +837,28 @@ tab2file(Tab, File, Options) -> List -> LogFun(NewState1,[['$end_of_table',List]]) end, + case FtOptions#filetab_options.sync of + true -> + case disk_log:sync(Name) of + ok -> ok; + {error, Reason2} -> throw(Reason2) + end; + false -> + ok + end, disk_log:close(Name) catch throw:TReason -> - disk_log:close(Name), - file:delete(File), + _ = disk_log:close(Name), + _ = file:delete(File), throw(TReason); exit:ExReason -> - disk_log:close(Name), - file:delete(File), + _ = disk_log:close(Name), + _ = file:delete(File), exit(ExReason); error:ErReason -> - disk_log:close(Name), - file:delete(File), + _ = disk_log:close(Name), + _ = file:delete(File), erlang:raise(error,ErReason,erlang:get_stacktrace()) end catch @@ -497,23 +898,24 @@ md5terms(State, [H|T]) -> {FinState, [B|TL]}. parse_ft_options(Options) when is_list(Options) -> - {Opt,Rest} = case (catch lists:keytake(extended_info,1,Options)) of - false -> - {[],Options}; - {value,{extended_info,L},R} when is_list(L) -> - {L,R} - end, - case Rest of - [] -> - parse_ft_info_options(#filetab_options{}, Opt); - Other -> - throw({unknown_option, Other}) - end; -parse_ft_options(Malformed) -> + {ok, parse_ft_options(Options, #filetab_options{}, false)}. + +parse_ft_options([], FtOpt, _) -> + FtOpt; +parse_ft_options([{sync,true} | Rest], FtOpt, EI) -> + parse_ft_options(Rest, FtOpt#filetab_options{sync = true}, EI); +parse_ft_options([{sync,false} | Rest], FtOpt, EI) -> + parse_ft_options(Rest, FtOpt, EI); +parse_ft_options([{extended_info,L} | Rest], FtOpt0, false) -> + FtOpt1 = parse_ft_info_options(FtOpt0, L), + parse_ft_options(Rest, FtOpt1, true); +parse_ft_options([Other | _], _, _) -> + throw({unknown_option, Other}); +parse_ft_options(Malformed, _, _) -> throw({malformed_option, Malformed}). parse_ft_info_options(FtOpt,[]) -> - {ok,FtOpt}; + FtOpt; parse_ft_info_options(FtOpt,[object_count | T]) -> parse_ft_info_options(FtOpt#filetab_options{object_count = true}, T); parse_ft_info_options(FtOpt,[md5sum | T]) -> @@ -548,25 +950,32 @@ file2tab(File, Opts) -> try {ok,Verify,TabArg} = parse_f2t_opts(Opts,false,[]), Name = make_ref(), - {ok, Major, Minor, FtOptions, MD5State, FullHeader, DLContext} = + {ok, Name} = case disk_log:open([{name, Name}, {file, File}, {mode, read_only}]) of {ok, Name} -> - get_header_data(Name,Verify); + {ok, Name}; {repaired, Name, _,_} -> %Uh? cannot happen? case Verify of true -> - disk_log:close(Name), + _ = disk_log:close(Name), throw(badfile); false -> - get_header_data(Name,Verify) + {ok, Name} end; {error, Other1} -> throw({read_error, Other1}); Other2 -> throw(Other2) end, + {ok, Major, Minor, FtOptions, MD5State, FullHeader, DLContext} = + try get_header_data(Name, Verify) + catch + badfile -> + _ = disk_log:close(Name), + throw(badfile) + end, try if Major > ?MAJOR_F2T_VERSION -> @@ -630,7 +1039,7 @@ file2tab(File, Opts) -> erlang:raise(error,ErReason,erlang:get_stacktrace()) end after - disk_log:close(Name) + _ = disk_log:close(Name) end catch throw:TReason2 -> @@ -900,18 +1309,30 @@ create_tab(I, TabArg) -> {name, Name} = lists:keyfind(name, 1, I), {type, Type} = lists:keyfind(type, 1, I), {protection, P} = lists:keyfind(protection, 1, I), - {named_table, Val} = lists:keyfind(named_table, 1, I), {keypos, _Kp} = Keypos = lists:keyfind(keypos, 1, I), {size, Sz} = lists:keyfind(size, 1, I), - Comp = case lists:keyfind(compressed, 1, I) of - {compressed, true} -> [compressed]; - {compressed, false} -> []; - false -> [] - end, + L1 = [Type, P, Keypos], + L2 = case lists:keyfind(named_table, 1, I) of + {named_table, true} -> [named_table | L1]; + {named_table, false} -> L1 + end, + L3 = case lists:keyfind(compressed, 1, I) of + {compressed, true} -> [compressed | L2]; + {compressed, false} -> L2; + false -> L2 + end, + L4 = case lists:keyfind(write_concurrency, 1, I) of + {write_concurrency, _}=Wcc -> [Wcc | L3]; + _ -> L3 + end, + L5 = case lists:keyfind(read_concurrency, 1, I) of + {read_concurrency, _}=Rcc -> [Rcc | L4]; + false -> L4 + end, case TabArg of [] -> try - Tab = ets:new(Name, [Type, P, Keypos] ++ named_table(Val) ++ Comp), + Tab = ets:new(Name, L5), {ok, Tab, Sz} catch _:_ -> throw(cannot_create_table) @@ -920,8 +1341,6 @@ create_tab(I, TabArg) -> {ok, TabArg, Sz} end. -named_table(true) -> [named_table]; -named_table(false) -> []. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% tabfile_info/1 reads the head information in an ets table dumped to @@ -949,20 +1368,30 @@ named_table(false) -> []. tabfile_info(File) when is_list(File) ; is_atom(File) -> try Name = make_ref(), - {ok, Major, Minor, _FtOptions, _MD5State, FullHeader, _DLContext} = + {ok, Name} = case disk_log:open([{name, Name}, {file, File}, {mode, read_only}]) of {ok, Name} -> - get_header_data(Name,false); + {ok, Name}; {repaired, Name, _,_} -> %Uh? cannot happen? - get_header_data(Name,false); + {ok, Name}; {error, Other1} -> throw({read_error, Other1}); Other2 -> throw(Other2) end, - disk_log:close(Name), + {ok, Major, Minor, _FtOptions, _MD5State, FullHeader, _DLContext} = + try get_header_data(Name, false) + catch + badfile -> + _ = disk_log:close(Name), + throw(badfile) + end, + case disk_log:close(Name) of + ok -> ok; + {error, Reason} -> throw(Reason) + end, {value, N} = lists:keysearch(name, 1, FullHeader), {value, Type} = lists:keysearch(type, 1, FullHeader), {value, P} = lists:keysearch(protection, 1, FullHeader), @@ -1242,7 +1671,7 @@ choice(Height, Width, P, Mode, Tab, Key, Turn, Opos) -> {ok,Re} -> re_search(Height, Width, Tab, ets:first(Tab), Re, 1, 1); {error,{ErrorString,_Pos}} -> - io:format("~s\n", [ErrorString]), + io:format("~ts\n", [ErrorString]), choice(Height, Width, P, Mode, Tab, Key, Turn, Opos) end; _ -> @@ -1250,13 +1679,18 @@ choice(Height, Width, P, Mode, Tab, Key, Turn, Opos) -> end. get_line(P, Default) -> - case io:get_line(P) of + case line_string(io:get_line(P)) of "\n" -> Default; L -> L end. +%% If the standard input is set to binary mode +%% convert it to a list so we can properly match. +line_string(Binary) when is_binary(Binary) -> unicode:characters_to_list(Binary); +line_string(Other) -> Other. + nonl(S) -> string:strip(S, right, $\n). print_number(Tab, Key, Num) -> diff --git a/lib/stdlib/src/eval_bits.erl b/lib/stdlib/src/eval_bits.erl index f40904df1c..80667023fb 100644 --- a/lib/stdlib/src/eval_bits.erl +++ b/lib/stdlib/src/eval_bits.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -67,7 +68,8 @@ expr_grp([], Bs0, _Lf, Acc) -> {value,Acc,Bs0}. eval_field({bin_element, _, {string, _, S}, default, default}, Bs0, _Fun) -> - {list_to_binary(S),Bs0}; + Latin1 = [C band 16#FF || C <- S], + {list_to_binary(Latin1),Bs0}; eval_field({bin_element, Line, {string, _, S}, Size0, Options0}, Bs, _Fun) -> {_Size,[Type,_Unit,_Sign,Endian]} = make_bit_type(Line, Size0, Options0), @@ -162,8 +164,10 @@ bin_gen([], Bin, _Bs0, _BBs0, _Mfun, _Efun, false) -> bin_gen_field({bin_element,_,{string,_,S},default,default}, Bin, Bs, BBs, _Mfun, _Efun) -> - Bits = list_to_binary(S), - Size = byte_size(Bits), + Bits = try list_to_binary(S) + catch _:_ -> <<>> + end, + Size = length(S), case Bin of <<Bits:Size/binary,Rest/bitstring>> -> {match,Bs,BBs,Rest}; @@ -172,16 +176,42 @@ bin_gen_field({bin_element,_,{string,_,S},default,default}, _ -> done end; +bin_gen_field({bin_element,Line,{string,SLine,S},Size0,Options0}, + Bin0, Bs0, BBs0, Mfun, Efun) -> + {Size1, [Type,{unit,Unit},Sign,Endian]} = + make_bit_type(Line, Size0, Options0), + match_check_size(Mfun, Size1, BBs0), + {value, Size, _BBs} = Efun(Size1, BBs0), + F = fun(C, Bin, Bs, BBs) -> + bin_gen_field1(Bin, Type, Size, Unit, Sign, Endian, + {integer,SLine,C}, Bs, BBs, Mfun) + end, + bin_gen_field_string(S, Bin0, Bs0, BBs0, F); bin_gen_field({bin_element,Line,VE,Size0,Options0}, Bin, Bs0, BBs0, Mfun, Efun) -> {Size1, [Type,{unit,Unit},Sign,Endian]} = make_bit_type(Line, Size0, Options0), V = erl_eval:partial_eval(VE), - match_check_size(Mfun, Size1, BBs0), + NewV = coerce_to_float(V, Type), + match_check_size(Mfun, Size1, BBs0, false), {value, Size, _BBs} = Efun(Size1, BBs0), + bin_gen_field1(Bin, Type, Size, Unit, Sign, Endian, NewV, Bs0, BBs0, Mfun). + +bin_gen_field_string([], Rest, Bs, BBs, _F) -> + {match,Bs,BBs,Rest}; +bin_gen_field_string([C|Cs], Bin0, Bs0, BBs0, Fun) -> + case Fun(C, Bin0, Bs0, BBs0) of + {match,Bs,BBs,Rest} -> + bin_gen_field_string(Cs, Rest, Bs, BBs, Fun); + {nomatch,Rest} -> + {nomatch,Rest}; + done -> + done + end. + +bin_gen_field1(Bin, Type, Size, Unit, Sign, Endian, NewV, Bs0, BBs0, Mfun) -> case catch get_value(Bin, Type, Size, Unit, Sign, Endian) of {Val,<<_/bitstring>>=Rest} -> - NewV = coerce_to_float(V, Type), case catch Mfun(match, {NewV,Val,Bs0}) of {match,Bs} -> BBs = add_bin_binding(Mfun, NewV, Bs, BBs0), @@ -223,20 +253,41 @@ match_bits_1([F|Fs], Bits0, Bs0, BBs0, Mfun, Efun) -> match_field_1({bin_element,_,{string,_,S},default,default}, Bin, Bs, BBs, _Mfun, _Efun) -> - Bits = list_to_binary(S), + Bits = list_to_binary(S), % fails if there are characters > 255 Size = byte_size(Bits), <<Bits:Size/binary,Rest/binary-unit:1>> = Bin, {Bs,BBs,Rest}; +match_field_1({bin_element,Line,{string,SLine,S},Size0,Options0}, + Bin0, Bs0, BBs0, Mfun, Efun) -> + {Size1, [Type,{unit,Unit},Sign,Endian]} = + make_bit_type(Line, Size0, Options0), + Size2 = erl_eval:partial_eval(Size1), + match_check_size(Mfun, Size2, BBs0), + {value, Size, _BBs} = Efun(Size2, BBs0), + F = fun(C, Bin, Bs, BBs) -> + match_field(Bin, Type, Size, Unit, Sign, Endian, + {integer,SLine,C}, Bs, BBs, Mfun) + end, + match_field_string(S, Bin0, Bs0, BBs0, F); match_field_1({bin_element,Line,VE,Size0,Options0}, Bin, Bs0, BBs0, Mfun, Efun) -> {Size1, [Type,{unit,Unit},Sign,Endian]} = make_bit_type(Line, Size0, Options0), V = erl_eval:partial_eval(VE), + NewV = coerce_to_float(V, Type), Size2 = erl_eval:partial_eval(Size1), match_check_size(Mfun, Size2, BBs0), {value, Size, _BBs} = Efun(Size2, BBs0), + match_field(Bin, Type, Size, Unit, Sign, Endian, NewV, Bs0, BBs0, Mfun). + +match_field_string([], Rest, Bs, BBs, _Fun) -> + {Bs,BBs,Rest}; +match_field_string([C|Cs], Bin0, Bs0, BBs0, Fun) -> + {Bs,BBs,Bin} = Fun(C, Bin0, Bs0, BBs0), + match_field_string(Cs, Bin, Bs, BBs, Fun). + +match_field(Bin, Type, Size, Unit, Sign, Endian, NewV, Bs0, BBs0, Mfun) -> {Val,Rest} = get_value(Bin, Type, Size, Unit, Sign, Endian), - NewV = coerce_to_float(V, Type), {match,Bs} = Mfun(match, {NewV,Val,Bs0}), BBs = add_bin_binding(Mfun, NewV, Bs, BBs0), {Bs,BBs,Rest}. @@ -330,20 +381,25 @@ make_bit_type(_Line, Size, Type0) -> %Size evaluates to an integer or 'all' {error,Reason} -> error(Reason) end. -match_check_size(Mfun, {var,_,V}, Bs) -> +match_check_size(Mfun, Size, Bs) -> + match_check_size(Mfun, Size, Bs, true). + +match_check_size(Mfun, {var,_,V}, Bs, _AllowAll) -> case Mfun(binding, {V,Bs}) of {value,_} -> ok; unbound -> throw(invalid) % or, rather, error({unbound,V}) end; -match_check_size(_, {atom,_,all}, _Bs) -> +match_check_size(_, {atom,_,all}, _Bs, true) -> ok; -match_check_size(_, {atom,_,undefined}, _Bs) -> +match_check_size(_, {atom,_,all}, _Bs, false) -> + throw(invalid); +match_check_size(_, {atom,_,undefined}, _Bs, _AllowAll) -> ok; -match_check_size(_, {integer,_,_}, _Bs) -> +match_check_size(_, {integer,_,_}, _Bs, _AllowAll) -> ok; -match_check_size(_, {value,_,_}, _Bs) -> +match_check_size(_, {value,_,_}, _Bs, _AllowAll) -> ok; %From the debugger. -match_check_size(_, _, _Bs) -> +match_check_size(_, _, _Bs, _AllowAll) -> throw(invalid). %% error(Reason) -> exception thrown diff --git a/lib/stdlib/src/file_sorter.erl b/lib/stdlib/src/file_sorter.erl index 3f31852afc..3aeaff8dc4 100644 --- a/lib/stdlib/src/file_sorter.erl +++ b/lib/stdlib/src/file_sorter.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -27,6 +28,8 @@ check/1, check/2, keycheck/2, keycheck/3]). +-dialyzer(no_improper_lists). + -include_lib("kernel/include/file.hrl"). -define(CHUNKSIZE, 16384). @@ -304,7 +307,6 @@ options(Option) -> options([{format, Format} | L], Opts) when Format =:= binary; Format =:= term; - is_function(Format), is_function(Format, 1) -> options(L, Opts#opts{format = Format}); options([{format, binary_term} | L], Opts) -> @@ -323,7 +325,7 @@ options([{tmpdir, Dir} | L], Opts) -> FileName -> options(L, Opts#opts{tmpdir = {dir, FileName}}) end; -options([{order, Fun} | L], Opts) when is_function(Fun), is_function(Fun, 2) -> +options([{order, Fun} | L], Opts) when is_function(Fun, 2) -> options(L, Opts#opts{order = Fun}); options([{order, Order} | L], Opts) when Order =:= ascending; Order =:= descending -> @@ -408,7 +410,7 @@ merge_terms_fun(RFun) -> case RFun(read) of end_of_input -> eof; - {Objs, NRFun} when is_function(NRFun), is_function(NRFun, 1) -> + {Objs, NRFun} when is_function(NRFun, 1) -> {_, [], Ts, _} = fun_objs(Objs, [], 0, ?MAXSIZE, I, W), {{I, Ts, ?CHUNKSIZE}, merge_terms_fun(NRFun)}; Error -> @@ -424,13 +426,12 @@ merge_bins_fun(FileName) -> Fun(A) end. -wrap_output_terms(term, OutFun, _Z) when is_function(OutFun), - is_function(OutFun, 1) -> +wrap_output_terms(term, OutFun, _Z) when is_function(OutFun, 1) -> {fun_wterms(OutFun), true}; wrap_output_terms(term, File, Z) when File =/= undefined -> {file_wterms(name, File, Z++[write]), false}; wrap_output_terms(_Format, Output, _Z) -> - {Output, is_function(Output) and is_function(Output, 1)}. + {Output, is_function(Output, 1)}. binary_term_fun() -> fun binary_to_term/1. @@ -547,7 +548,7 @@ files(_I, L, _LSz, #w{seq = 1, out = Out}=W, []) -> NW = close_input(W1), outfun(close, NW); Out -> - write_run(L, W, Out), + _ = write_run(L, W, Out), ok end; files(_I, L, _LSz, W, []) -> @@ -633,12 +634,12 @@ last_merge(R, W) when length(R) =< W#w.no_files -> case W#w.out of Fun when is_function(Fun) -> {Fs, W1} = init_merge(lists:reverse(R), 1, [], W), - ?DEBUG("merging ~p~n", [lists:reverse(R)]), + ?DEBUG("merging ~tp~n", [lists:reverse(R)]), W2 = merge_files(Fs, [], 0, nolast, W1), NW = close_input(W2), outfun(close, NW); Out -> - merge_files(R, W, Out), + _ = merge_files(R, W, Out), ok end; last_merge(R, W) -> @@ -659,7 +660,7 @@ merge_runs([R, R1 | Rs], NRs0, W) -> merge_files(R, W) -> {W1, Temp} = next_temp(W), - ?DEBUG("merging ~p~nto ~p~n", [lists:reverse(R), Temp]), + ?DEBUG("merging ~tp~nto ~tp~n", [lists:reverse(R), Temp]), {Temp, merge_files(R, W1, Temp)}. merge_files(R, W, FileName) -> @@ -1110,10 +1111,12 @@ read_fun2(Fd, Bin, Size, FileName, Owner) -> end. close_read_fun(Fd, _FileName, user) -> - file:close(Fd); + _ = file:close(Fd), + ok; close_read_fun(Fd, FileName, fsort) -> - file:close(Fd), - file:delete(FileName). + _ = file:close(Fd), + _ = file:delete(FileName), + ok. read_objs(Fd, FileName, I, L, Bin0, Size0, LSz, W) -> Max = erlang:max(Size0, ?CHUNKSIZE), @@ -1306,8 +1309,7 @@ infun(W) -> {end_of_input, W1}; {end_of_input, Value} -> {end_of_input, W1#w{inout_value = {value, Value}}}; - {Objs, NFun} when is_function(NFun), - is_function(NFun, 1), + {Objs, NFun} when is_function(NFun, 1), is_list(Objs) -> {cont, W#w{in = NFun}, Objs}; Error -> @@ -1330,7 +1332,7 @@ outfun(A, W) -> try (W#w.out)(A) of Reply when A =:= close -> Reply; - NF when is_function(NF), is_function(NF, 1) -> + NF when is_function(NF, 1) -> W#w{out = NF}; Error -> error(Error, W1) @@ -1355,7 +1357,7 @@ is_keyposs([Bad | _]) -> is_keyposs(Bad) -> {badarg, Bad}. -is_input(Fun) when is_function(Fun), is_function(Fun, 1) -> +is_input(Fun) when is_function(Fun, 1) -> {true, Fun}; is_input(Files) -> is_files(Files). @@ -1375,7 +1377,7 @@ is_files([], L) -> is_files(Bad, _L) -> {badarg, Bad}. -maybe_output(Fun) when is_function(Fun), is_function(Fun, 1) -> +maybe_output(Fun) when is_function(Fun, 1) -> {true, Fun}; maybe_output(File) -> case read_file_info(File) of @@ -1423,8 +1425,8 @@ tmp_prefix1(Dir, TmpDirOpt) -> U = "_", Node = node(), Pid = os:getpid(), - {MSecs,Secs,MySecs} = now(), - F = lists:concat(["fs_",Node,U,Pid,U,MSecs,U,Secs,U,MySecs,"."]), + Unique = erlang:unique_integer([positive]), + F = lists:concat(["fs_",Node,U,Pid,U,Unique,"."]), TmpDir = case TmpDirOpt of default -> Dir; @@ -1481,10 +1483,10 @@ cleanup(W) -> F = fun(IFun) when is_function(IFun) -> IFun(close); ({Fd,FileName}) -> - file:close(Fd), - file:delete(FileName); + _ = file:close(Fd), + _= file:delete(FileName); (FileName) -> - file:delete(FileName) + _= file:delete(FileName) end, lists:foreach(F, W1#w.temp). @@ -1501,9 +1503,13 @@ close_out(_) -> close_file(Fd, W) -> {Fd, FileName} = lists:keyfind(Fd, 1, W#w.temp), - ?DEBUG("closing ~p~n", [FileName]), - file:close(Fd), - W#w{temp = [FileName | lists:keydelete(Fd, 1, W#w.temp)]}. + ?DEBUG("closing ~tp~n", [FileName]), + case file:close(Fd) of + ok -> + W#w{temp = [FileName | lists:keydelete(Fd, 1, W#w.temp)]}; + Error -> + file_error(FileName, Error, W) + end. %%% %%% Format 'term'. @@ -1536,10 +1542,10 @@ file_rterms2(Fd, L, LSz, FileName, Files) when LSz < ?CHUNKSIZE -> B = term_to_binary(Term), file_rterms2(Fd, [B | L], LSz + byte_size(B), FileName, Files); eof -> - file:close(Fd), + _ = file:close(Fd), {lists:reverse(L), file_rterms(no_file, Files)}; _Error -> - file:close(Fd), + _ = file:close(Fd), {error, {bad_term, FileName}} end; file_rterms2(Fd, L, _LSz, FileName, Files) -> @@ -1568,7 +1574,7 @@ write_terms(Fd, F, [B | Bs], Args) -> ok -> write_terms(Fd, F, Bs, Args); {error, Reason} -> - file:close(Fd), + _ = file:close(Fd), {error, {file_error, F, Reason}} end; write_terms(Fd, F, [], Args) -> @@ -1580,7 +1586,6 @@ fun_rterms(InFun) -> (read) -> case InFun(read) of {Ts, NInFun} when is_list(Ts), - is_function(NInFun), is_function(NInFun, 1) -> {to_bin(Ts, []), fun_rterms(NInFun)}; Else -> @@ -1593,7 +1598,7 @@ fun_wterms(OutFun) -> OutFun(close); (L) -> case OutFun(wterms_arg(L)) of - NOutFun when is_function(NOutFun), is_function(NOutFun, 1) -> + NOutFun when is_function(NOutFun, 1) -> fun_wterms(NOutFun); Else -> Else diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl index fa4f92617c..7029389e2f 100644 --- a/lib/stdlib/src/filelib.erl +++ b/lib/stdlib/src/filelib.erl @@ -1,34 +1,33 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% -module(filelib). %% File utilities. - -%% Avoid warning for local function error/1 clashing with autoimported BIF. --compile({no_auto_import,[error/1]}). --export([wildcard/1, wildcard/2, is_dir/1, is_file/1, is_regular/1, - compile_wildcard/1]). +-export([wildcard/1, wildcard/2, is_dir/1, is_file/1, is_regular/1]). -export([fold_files/5, last_modified/1, file_size/1, ensure_dir/1]). - -export([wildcard/3, is_dir/2, is_file/2, is_regular/2]). -export([fold_files/6, last_modified/2, file_size/2]). +%% For debugging/testing. +-export([compile_wildcard/1]). + -include_lib("kernel/include/file.hrl"). -define(HANDLE_ERROR(Expr), @@ -37,56 +36,59 @@ catch error:{badpattern,_}=UnUsUalVaRiAbLeNaMe -> %% Get the stack backtrace correct. - erlang:error(UnUsUalVaRiAbLeNaMe) + error(UnUsUalVaRiAbLeNaMe) end). -type filename() :: file:name(). -type dirname() :: filename(). +-type filename_all() :: file:name_all(). +-type dirname_all() :: filename_all(). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -spec wildcard(Wildcard) -> [file:filename()] when Wildcard :: filename() | dirname(). wildcard(Pattern) when is_list(Pattern) -> - ?HANDLE_ERROR(do_wildcard(Pattern, file)). + ?HANDLE_ERROR(do_wildcard(Pattern, ".", file)). -spec wildcard(Wildcard, Cwd) -> [file:filename()] when Wildcard :: filename() | dirname(), Cwd :: dirname(). -wildcard(Pattern, Cwd) when is_list(Pattern), (is_list(Cwd) or is_binary(Cwd)) -> +wildcard(Pattern, Cwd) when is_list(Pattern), is_list(Cwd) -> ?HANDLE_ERROR(do_wildcard(Pattern, Cwd, file)); wildcard(Pattern, Mod) when is_list(Pattern), is_atom(Mod) -> - ?HANDLE_ERROR(do_wildcard(Pattern, Mod)). + ?HANDLE_ERROR(do_wildcard(Pattern, ".", Mod)). -spec wildcard(file:name(), file:name(), atom()) -> [file:filename()]. wildcard(Pattern, Cwd, Mod) - when is_list(Pattern), (is_list(Cwd) or is_binary(Cwd)), is_atom(Mod) -> + when is_list(Pattern), is_list(Cwd), is_atom(Mod) -> ?HANDLE_ERROR(do_wildcard(Pattern, Cwd, Mod)). -spec is_dir(Name) -> boolean() when - Name :: filename() | dirname(). + Name :: filename_all() | dirname_all(). is_dir(Dir) -> do_is_dir(Dir, file). --spec is_dir(file:name(), atom()) -> boolean(). +-spec is_dir(file:name_all(), atom()) -> boolean(). is_dir(Dir, Mod) when is_atom(Mod) -> do_is_dir(Dir, Mod). -spec is_file(Name) -> boolean() when - Name :: filename() | dirname(). + Name :: filename_all() | dirname_all(). is_file(File) -> do_is_file(File, file). --spec is_file(file:name(), atom()) -> boolean(). +-spec is_file(file:name_all(), atom()) -> boolean(). is_file(File, Mod) when is_atom(Mod) -> do_is_file(File, Mod). -spec is_regular(Name) -> boolean() when - Name :: filename(). + Name :: filename_all(). is_regular(File) -> do_is_regular(File, file). --spec is_regular(file:name(), atom()) -> boolean(). +-spec is_regular(file:name_all(), atom()) -> boolean(). is_regular(File, Mod) when is_atom(Mod) -> do_is_regular(File, Mod). @@ -105,16 +107,16 @@ fold_files(Dir, RegExp, Recursive, Fun, Acc, Mod) when is_atom(Mod) -> do_fold_files(Dir, RegExp, Recursive, Fun, Acc, Mod). -spec last_modified(Name) -> file:date_time() | 0 when - Name :: filename() | dirname(). + Name :: filename_all() | dirname_all(). last_modified(File) -> do_last_modified(File, file). --spec last_modified(file:name(), atom()) -> file:date_time() | 0. +-spec last_modified(file:name_all(), atom()) -> file:date_time() | 0. last_modified(File, Mod) when is_atom(Mod) -> do_last_modified(File, Mod). -spec file_size(Filename) -> non_neg_integer() when - Filename :: filename(). + Filename :: filename_all(). file_size(File) -> do_file_size(File, file). @@ -124,41 +126,6 @@ file_size(File, Mod) when is_atom(Mod) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -do_wildcard(Pattern, Mod) when is_list(Pattern) -> - do_wildcard_comp(do_compile_wildcard(Pattern), Mod). - -do_wildcard_comp({compiled_wildcard,{exists,File}}, Mod) -> - case eval_read_file_info(File, Mod) of - {ok,_} -> [File]; - _ -> [] - end; -do_wildcard_comp({compiled_wildcard,[Base|Rest]}, Mod) -> - do_wildcard_1([Base], Rest, Mod). - -do_wildcard(Pattern, Cwd, Mod) when is_list(Pattern), (is_list(Cwd) or is_binary(Cwd)) -> - do_wildcard_comp(do_compile_wildcard(Pattern), Cwd, Mod). - -do_wildcard_comp({compiled_wildcard,{exists,File}}, Cwd, Mod) -> - case eval_read_file_info(filename:absname(File, Cwd), Mod) of - {ok,_} -> [File]; - _ -> [] - end; -do_wildcard_comp({compiled_wildcard,[current|Rest]}, Cwd0, Mod) -> - {Cwd,PrefixLen} = case filename:join([Cwd0]) of - Bin when is_binary(Bin) -> {Bin,byte_size(Bin)+1}; - Other -> {Other,length(Other)+1} - end, %Slash away redundant slashes. - [ - if - is_binary(N) -> - <<_:PrefixLen/binary,Res/binary>> = N, - Res; - true -> - lists:nthtail(PrefixLen, N) - end || N <- do_wildcard_1([Cwd], Rest, Mod)]; -do_wildcard_comp({compiled_wildcard,[Base|Rest]}, _Cwd, Mod) -> - do_wildcard_1([Base], Rest, Mod). - do_is_dir(Dir, Mod) -> case eval_read_file_info(Dir, Mod) of {ok, #file_info{type=directory}} -> @@ -255,7 +222,7 @@ do_file_size(File, Mod) -> %% ensures that the directory name required to create D exists -spec ensure_dir(Name) -> 'ok' | {'error', Reason} when - Name :: filename() | dirname(), + Name :: filename_all() | dirname_all(), Reason :: file:posix(). ensure_dir("/") -> ok; @@ -268,7 +235,7 @@ ensure_dir(F) -> %% Protect against infinite loop {error,einval}; false -> - ensure_dir(Dir), + _ = ensure_dir(Dir), case file:make_dir(Dir) of {error,eexist}=EExist -> case do_is_dir(Dir, file) of @@ -282,24 +249,42 @@ ensure_dir(F) -> end end. - + %%% %%% Pattern matching using a compiled wildcard. %%% -do_wildcard_1(Files, Pattern, Mod) -> - do_wildcard_2(Files, Pattern, [], Mod). +do_wildcard(Pattern, Cwd, Mod) -> + {Compiled,PrefixLen} = compile_wildcard(Pattern, Cwd), + Files0 = do_wildcard_1(Compiled, Mod), + Files = if + PrefixLen =:= 0 -> + Files0; + true -> + [lists:nthtail(PrefixLen, File) || File <- Files0] + end, + lists:sort(Files). + +do_wildcard_1({exists,File}, Mod) -> + case eval_read_link_info(File, Mod) of + {ok,_} -> [File]; + _ -> [] + end; +do_wildcard_1([Base|Rest], Mod) -> + do_wildcard_2([Base], Rest, [], Mod). do_wildcard_2([File|Rest], Pattern, Result, Mod) -> do_wildcard_2(Rest, Pattern, do_wildcard_3(File, Pattern, Result, Mod), Mod); do_wildcard_2([], _, Result, _Mod) -> Result. -do_wildcard_3(Base, [Pattern|Rest], Result, Mod) -> - case do_list_dir(Base, Mod) of - {ok, Files0} -> - Files = lists:sort(Files0), - Matches = wildcard_4(Pattern, Files, Base, []), +do_wildcard_3(Base, [[double_star]|Rest], Result, Mod) -> + do_double_star(".", [Base], Rest, Result, Mod, true); +do_wildcard_3(Base0, [Pattern|Rest], Result, Mod) -> + case do_list_dir(Base0, Mod) of + {ok, Files} -> + Base = prepare_base(Base0), + Matches = do_wildcard_4(Pattern, Base, Files), do_wildcard_2(Matches, Rest, Result, Mod); _ -> Result @@ -307,100 +292,121 @@ do_wildcard_3(Base, [Pattern|Rest], Result, Mod) -> do_wildcard_3(Base, [], Result, _Mod) -> [Base|Result]. -wildcard_4(Pattern, [File|Rest], Base, Result) when is_binary(File) -> - case wildcard_5(Pattern, binary_to_list(File)) of - true -> - wildcard_4(Pattern, Rest, Base, [join(Base, File)|Result]); +do_wildcard_4(Pattern, Base, Files) -> + case will_always_match(Pattern) of false -> - wildcard_4(Pattern, Rest, Base, Result) - end; -wildcard_4(Pattern, [File|Rest], Base, Result) -> - case wildcard_5(Pattern, File) of + [Base++F || F <- Files, match_part(Pattern, F)]; true -> - wildcard_4(Pattern, Rest, Base, [join(Base, File)|Result]); - false -> - wildcard_4(Pattern, Rest, Base, Result) - end; -wildcard_4(_Patt, [], _Base, Result) -> - Result. + [Base++F || F <- Files] + end. -wildcard_5([question|Rest1], [_|Rest2]) -> - wildcard_5(Rest1, Rest2); -wildcard_5([accept], _) -> +match_part([question|Rest1], [_|Rest2]) -> + match_part(Rest1, Rest2); +match_part([accept], _) -> + true; +match_part([double_star], _) -> true; -wildcard_5([star|Rest], File) -> +match_part([star|Rest], File) -> do_star(Rest, File); -wildcard_5([{one_of, Ordset}|Rest], [C|File]) -> - case ordsets:is_element(C, Ordset) of - true -> wildcard_5(Rest, File); - false -> false - end; -wildcard_5([{alt, Alts}], File) -> +match_part([{one_of, Ordset}|Rest], [C|File]) -> + gb_sets:is_element(C, Ordset) andalso match_part(Rest, File); +match_part([{alt, Alts}], File) -> do_alt(Alts, File); -wildcard_5([C|Rest1], [C|Rest2]) when is_integer(C) -> - wildcard_5(Rest1, Rest2); -wildcard_5([X|_], [Y|_]) when is_integer(X), is_integer(Y) -> +match_part([C|Rest1], [C|Rest2]) when is_integer(C) -> + match_part(Rest1, Rest2); +match_part([X|_], [Y|_]) when is_integer(X), is_integer(Y) -> false; -wildcard_5([], []) -> +match_part([], []) -> true; -wildcard_5([], [_|_]) -> +match_part([], [_|_]) -> false; -wildcard_5([_|_], []) -> +match_part([_|_], []) -> false. -do_star(Pattern, [X|Rest]) -> - case wildcard_5(Pattern, [X|Rest]) of - true -> true; - false -> do_star(Pattern, Rest) - end; +will_always_match([accept]) -> true; +will_always_match(_) -> false. + +prepare_base(Base0) -> + Base1 = filename:join(Base0, "x"), + "x"++Base2 = lists:reverse(Base1), + lists:reverse(Base2). + +do_double_star(Base, [H|T], Rest, Result, Mod, Root) -> + Full = case Root of + false -> filename:join(Base, H); + true -> H + end, + Result1 = case do_list_dir(Full, Mod) of + {ok, Files} -> + do_double_star(Full, Files, Rest, Result, Mod, false); + _ -> Result + end, + Result2 = case Root andalso Rest == [] of + true -> Result1; + false -> do_wildcard_3(Full, Rest, Result1, Mod) + end, + do_double_star(Base, T, Rest, Result2, Mod, Root); +do_double_star(_Base, [], _Rest, Result, _Mod, _Root) -> + Result. + +do_star(Pattern, [_|Rest]=File) -> + match_part(Pattern, File) orelse do_star(Pattern, Rest); do_star(Pattern, []) -> - wildcard_5(Pattern, []). + match_part(Pattern, []). do_alt([Alt|Rest], File) -> - case wildcard_5(Alt, File) of - true -> true; - false -> do_alt(Rest, File) - end; + match_part(Alt, File) orelse do_alt(Rest, File); do_alt([], _File) -> false. -do_list_dir(current, Mod) -> eval_list_dir(".", Mod); do_list_dir(Dir, Mod) -> eval_list_dir(Dir, Mod). -join(current, File) -> File; -join(Base, File) -> filename:join(Base, File). - - + %%% Compiling a wildcard. -compile_wildcard(Pattern) -> - ?HANDLE_ERROR(do_compile_wildcard(Pattern)). +%% Only for debugging. +compile_wildcard(Pattern) when is_list(Pattern) -> + {compiled_wildcard,?HANDLE_ERROR(compile_wildcard(Pattern, "."))}. -do_compile_wildcard(Pattern) -> - {compiled_wildcard,compile_wildcard_1(Pattern)}. - -compile_wildcard_1(Pattern) -> +compile_wildcard(Pattern, Cwd0) -> [Root|Rest] = filename:split(Pattern), case filename:pathtype(Root) of relative -> - compile_wildcard_2([Root|Rest], current); + Cwd = prepare_base(Cwd0), + compile_wildcard_2([Root|Rest], {cwd,Cwd}); _ -> - compile_wildcard_2(Rest, [Root]) + compile_wildcard_2(Rest, {root,0,Root}) end. compile_wildcard_2([Part|Rest], Root) -> case compile_part(Part) of Part -> - compile_wildcard_2(Rest, join(Root, Part)); + compile_wildcard_2(Rest, compile_join(Root, Part)); Pattern -> compile_wildcard_3(Rest, [Pattern,Root]) end; -compile_wildcard_2([], Root) -> {exists,Root}. +compile_wildcard_2([], {root,PrefixLen,Root}) -> + {{exists,Root},PrefixLen}. compile_wildcard_3([Part|Rest], Result) -> compile_wildcard_3(Rest, [compile_part(Part)|Result]); compile_wildcard_3([], Result) -> - lists:reverse(Result). + case lists:reverse(Result) of + [{root,PrefixLen,Root}|Compiled] -> + {[Root|Compiled],PrefixLen}; + [{cwd,Root}|Compiled] -> + {[Root|Compiled],length(filename:join(Root, "x"))-1} + end. + +compile_join({cwd,"."}, File) -> + {root,0,File}; +compile_join({cwd,Cwd}, File0) -> + File = filename:join([File0]), + Root = filename:join(Cwd, File), + PrefixLen = length(Root) - length(File), + {root,PrefixLen,Root}; +compile_join({root,PrefixLen,Root}, File) -> + {root,PrefixLen,filename:join(Root, File)}. compile_part(Part) -> compile_part(Part, false, []). @@ -409,13 +415,17 @@ compile_part_to_sep(Part) -> compile_part(Part, true, []). compile_part([], true, _) -> - error(missing_delimiter); + badpattern(missing_delimiter); compile_part([$,|Rest], true, Result) -> {ok, $,, lists:reverse(Result), Rest}; compile_part([$}|Rest], true, Result) -> {ok, $}, lists:reverse(Result), Rest}; compile_part([$?|Rest], Upto, Result) -> compile_part(Rest, Upto, [question|Result]); +compile_part([$*,$*], Upto, Result) -> + compile_part([], Upto, [double_star|Result]); +compile_part([$*,$*|Rest], Upto, Result) -> + compile_part(Rest, Upto, [star|Result]); compile_part([$*], Upto, Result) -> compile_part([], Upto, [accept|Result]); compile_part([$*|Rest], Upto, Result) -> @@ -441,8 +451,6 @@ compile_part([], _Upto, Result) -> compile_charset([$]|Rest], Ordset) -> compile_charset1(Rest, ordsets:add_element($], Ordset)); -compile_charset([$-|Rest], Ordset) -> - compile_charset1(Rest, ordsets:add_element($-, Ordset)); compile_charset([], _Ordset) -> error; compile_charset(List, Ordset) -> @@ -451,7 +459,7 @@ compile_charset(List, Ordset) -> compile_charset1([Lower, $-, Upper|Rest], Ordset) when Lower =< Upper -> compile_charset1(Rest, compile_range(Lower, Upper, Ordset)); compile_charset1([$]|Rest], Ordset) -> - {ok, {one_of, Ordset}, Rest}; + {ok, {one_of, gb_sets:from_ordset(Ordset)}, Rest}; compile_charset1([X|Rest], Ordset) -> compile_charset1(Rest, ordsets:add_element(X, Ordset)); compile_charset1([], _Ordset) -> @@ -477,8 +485,8 @@ compile_alt(Pattern, Result) -> error end. -error(Reason) -> - erlang:error({badpattern,Reason}). +badpattern(Reason) -> + error({badpattern,Reason}). eval_read_file_info(File, file) -> file:read_file_info(File); @@ -490,6 +498,16 @@ eval_read_file_info(File, erl_prim_loader) -> eval_read_file_info(File, Mod) -> Mod:read_file_info(File). +eval_read_link_info(File, file) -> + file:read_link_info(File); +eval_read_link_info(File, erl_prim_loader) -> + case erl_prim_loader:read_link_info(File) of + error -> {error, erl_prim_loader}; + Res-> Res + end; +eval_read_link_info(File, Mod) -> + Mod:read_link_info(File). + eval_list_dir(Dir, file) -> file:list_dir(Dir); eval_list_dir(Dir, erl_prim_loader) -> diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index a6b42cc68c..c4586171ca 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -35,6 +36,7 @@ extension/1, join/1, join/2, pathtype/1, rootname/1, rootname/2, split/1, nativename/1]). -export([find_src/1, find_src/2, flatten/1]). +-export([basedir/2, basedir/3]). %% Undocumented and unsupported exports. -export([append/2]). @@ -61,15 +63,15 @@ %% (for WIN32): absname("/") -> "D:/" --spec absname(Filename) -> file:filename() when - Filename :: file:name(). +-spec absname(Filename) -> file:filename_all() when + Filename :: file:name_all(). absname(Name) -> {ok, Cwd} = file:get_cwd(), absname(Name, Cwd). --spec absname(Filename, Dir) -> file:filename() when - Filename :: file:name(), - Dir :: file:filename(). +-spec absname(Filename, Dir) -> file:filename_all() when + Filename :: file:name_all(), + Dir :: file:name_all(). absname(Name, AbsBase) when is_binary(Name), is_list(AbsBase) -> absname(Name,filename_string_to_binary(AbsBase)); absname(Name, AbsBase) when is_list(Name), is_binary(AbsBase) -> @@ -122,9 +124,9 @@ absname_vr([[X, $:]|Name], _, _AbsBase) -> %% This is just a join/2, but assumes that %% AbsBase must be absolute and Name must be relative. --spec absname_join(Dir, Filename) -> file:filename() when - Dir :: file:filename(), - Filename :: file:name(). +-spec absname_join(Dir, Filename) -> file:filename_all() when + Dir :: file:name_all(), + Filename :: file:name_all(). absname_join(AbsBase, Name) -> join(AbsBase, flatten(Name)). @@ -136,8 +138,9 @@ absname_join(AbsBase, Name) -> %% basename("/usr/foo/") -> "foo" (trailing slashes ignored) %% basename("/") -> [] --spec basename(Filename) -> file:filename() when - Filename :: file:name(). +-spec basename(Filename) -> file:filename_all() when + Filename :: file:name_all(). + basename(Name) when is_binary(Name) -> case os:type() of {win32,_} -> @@ -201,9 +204,9 @@ skip_prefix(Name, _) -> %% rootname(basename("xxx.jam")) -> "xxx" %% rootname(basename("xxx.erl")) -> "xxx" --spec basename(Filename, Ext) -> file:filename() when - Filename :: file:name(), - Ext :: file:name(). +-spec basename(Filename, Ext) -> file:filename_all() when + Filename :: file:name_all(), + Ext :: file:name_all(). basename(Name, Ext) when is_binary(Name), is_list(Ext) -> basename(Name,filename_string_to_binary(Ext)); basename(Name, Ext) when is_list(Name), is_binary(Ext) -> @@ -251,8 +254,8 @@ basename([], _Ext, Tail, _DrvSep2) -> %% Example: dirname("/usr/src/kalle.erl") -> "/usr/src", %% dirname("kalle.erl") -> "." --spec dirname(Filename) -> file:filename() when - Filename :: file:name(). +-spec dirname(Filename) -> file:filename_all() when + Filename :: file:name_all(). dirname(Name) when is_binary(Name) -> {Dsep,Drivesep} = separators(), SList = case Dsep of @@ -344,8 +347,8 @@ dirjoin1([H|T],Acc,Sep) -> %% %% On Windows: fn:dirname("\\usr\\src/kalle.erl") -> "/usr/src" --spec extension(Filename) -> file:filename() when - Filename :: file:name(). +-spec extension(Filename) -> file:filename_all() when + Filename :: file:name_all(). extension(Name) when is_binary(Name) -> {Dsep,_} = separators(), SList = case Dsep of @@ -387,8 +390,8 @@ extension([], Result, _OsType) -> %% Joins a list of filenames with directory separators. --spec join(Components) -> file:filename() when - Components :: [file:filename()]. +-spec join(Components) -> file:filename_all() when + Components :: [file:name_all()]. join([Name1, Name2|Rest]) -> join([join(Name1, Name2)|Rest]); join([Name]) when is_list(Name) -> @@ -400,9 +403,9 @@ join([Name]) when is_atom(Name) -> %% Joins two filenames with directory separators. --spec join(Name1, Name2) -> file:filename() when - Name1 :: file:filename(), - Name2 :: file:filename(). +-spec join(Name1, Name2) -> file:filename_all() when + Name1 :: file:name_all(), + Name2 :: file:name_all(). join(Name1, Name2) when is_list(Name1), is_list(Name2) -> OsType = major_os_type(), case pathtype(Name2) of @@ -444,6 +447,8 @@ join1([], RelativeName, [$:|Rest], win32) -> join1(RelativeName, [], [$:|Rest], win32); join1([], RelativeName, [$/|Result], OsType) -> join1(RelativeName, [], [$/|Result], OsType); +join1([], RelativeName, [$., $/|Result], OsType) -> + join1(RelativeName, [], [$/|Result], OsType); join1([], RelativeName, Result, OsType) -> join1(RelativeName, [], [$/|Result], OsType); join1([[_|_]=List|Rest], RelativeName, Result, OsType) -> @@ -470,6 +475,8 @@ join1b(<<>>, RelativeName, [$:|Rest], win32) -> join1b(RelativeName, <<>>, [$:|Rest], win32); join1b(<<>>, RelativeName, [$/|Result], OsType) -> join1b(RelativeName, <<>>, [$/|Result], OsType); +join1b(<<>>, RelativeName, [$., $/|Result], OsType) -> + join1b(RelativeName, <<>>, [$/|Result], OsType); join1b(<<>>, RelativeName, Result, OsType) -> join1b(RelativeName, <<>>, [$/|Result], OsType); join1b(<<Char,Rest/binary>>, RelativeName, Result, OsType) when is_integer(Char) -> @@ -488,7 +495,7 @@ maybe_remove_dirsep(Name, _) -> %% a given base directory, which is is assumed to be normalised %% by a previous call to join/{1,2}. --spec append(file:filename(), file:name()) -> file:filename(). +-spec append(file:filename_all(), file:name_all()) -> file:filename_all(). append(Dir, Name) when is_binary(Dir), is_binary(Name) -> <<Dir/binary,$/:8,Name/binary>>; append(Dir, Name) when is_binary(Dir) -> @@ -511,13 +518,15 @@ append(Dir, Name) -> %% Example: a:bar.erl, /temp/foo.erl -spec pathtype(Path) -> 'absolute' | 'relative' | 'volumerelative' when - Path :: file:name(). + Path :: file:name_all(). pathtype(Atom) when is_atom(Atom) -> pathtype(atom_to_list(Atom)); pathtype(Name) when is_list(Name) or is_binary(Name) -> case os:type() of - {unix, _} -> unix_pathtype(Name); - {win32, _} -> win32_pathtype(Name) + {win32, _} -> + win32_pathtype(Name); + {_, _} -> + unix_pathtype(Name) end. unix_pathtype(<<$/,_/binary>>) -> @@ -564,8 +573,8 @@ win32_pathtype(_) -> relative. %% Examples: rootname("/jam.src/kalle") -> "/jam.src/kalle" %% rootname("/jam.src/foo.erl") -> "/jam.src/foo" --spec rootname(Filename) -> file:filename() when - Filename :: file:name(). +-spec rootname(Filename) -> file:filename_all() when + Filename :: file:name_all(). rootname(Name) when is_binary(Name) -> list_to_binary(rootname(binary_to_list(Name))); % No need to handle unicode, . is < 128 rootname(Name0) -> @@ -594,9 +603,9 @@ rootname([], Root, _Ext, _OsType) -> %% Examples: rootname("/jam.src/kalle.jam", ".erl") -> "/jam.src/kalle.jam" %% rootname("/jam.src/foo.erl", ".erl") -> "/jam.src/foo" --spec rootname(Filename, Ext) -> file:filename() when - Filename :: file:name(), - Ext :: file:name(). +-spec rootname(Filename, Ext) -> file:filename_all() when + Filename :: file:name_all(), + Ext :: file:name_all(). rootname(Name, Ext) when is_binary(Name), is_binary(Ext) -> list_to_binary(rootname(binary_to_list(Name),binary_to_list(Ext))); rootname(Name, Ext) when is_binary(Name) -> @@ -623,8 +632,8 @@ rootname2([Char|Rest], Ext, Result) when is_integer(Char) -> %% split("a:\\msdev\\include") -> ["a:/", "msdev", "include"] -spec split(Filename) -> Components when - Filename :: file:name(), - Components :: [file:filename()]. + Filename :: file:name_all(), + Components :: [file:name_all()]. split(Name) when is_binary(Name) -> case os:type() of {win32, _} -> win32_splitb(Name); @@ -642,7 +651,7 @@ split(Name0) -> unix_splitb(Name) -> L = binary:split(Name,[<<"/">>],[global]), LL = case L of - [<<>>|Rest] -> + [<<>>|Rest] when Rest =/= [] -> [<<"/">>|Rest]; _ -> L @@ -717,8 +726,8 @@ split([], Comp, Components, OsType) -> %% will be converted to backslashes. On all platforms, the %% name will be normalized as done by join/1. --spec nativename(Path) -> file:filename() when - Path :: file:filename(). +-spec nativename(Path) -> file:filename_all() when + Path :: file:name_all(). nativename(Name0) -> Name = join([Name0]), %Normalize. case os:type() of @@ -878,7 +887,7 @@ filter_options(_Base, [], Result) -> %% Gets the source file given path of object code and module name. get_source_file(Obj, Mod, Rules) -> - source_by_rules(dirname(Obj), packages:last(Mod), Rules). + source_by_rules(dirname(Obj), atom_to_list(Mod), Rules). source_by_rules(Dir, Base, [{From, To}|Rest]) -> case try_rule(Dir, Base, From, To) of @@ -915,16 +924,14 @@ make_abs_path(BasePath, Path) -> join(BasePath, Path). major_os_type() -> - case os:type() of - {OsT, _} -> OsT; - OsT -> OsT - end. + {OsT, _} = os:type(), + OsT. %% flatten(List) %% Flatten a list, also accepting atoms. --spec flatten(Filename) -> file:filename() when - Filename :: file:name(). +-spec flatten(Filename) -> file:filename_all() when + Filename :: file:name_all(). flatten(Bin) when is_binary(Bin) -> Bin; flatten(List) -> @@ -949,3 +956,180 @@ filename_string_to_binary(List) -> Bin end. +%% Application Base Directories +%% basedir +%% http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html + +-type basedir_type() :: 'user_cache' | 'user_config' | 'user_data' + | 'user_log' + | 'site_config' | 'site_data'. + +-spec basedir(Type,Application) -> file:filename_all() when + Type :: basedir_type(), + Application :: string() | binary(). + +basedir(Type,Application) when is_atom(Type), is_list(Application) orelse + is_binary(Application) -> + basedir(Type, Application, #{}). + +-spec basedir(Type,Application,Opts) -> file:filename_all() when + Type :: basedir_type(), + Application :: string() | binary(), + Opts :: #{author => string() | binary(), + os => 'windows' | 'darwin' | 'linux', + version => string() | binary()}. + +basedir(Type,Application,Opts) when is_atom(Type), is_map(Opts), + is_list(Application) orelse + is_binary(Application) -> + Os = basedir_os_from_opts(Opts), + Name = basedir_name_from_opts(Os,Application,Opts), + Base = basedir_from_os(Type,Os), + case {Type,Os} of + {user_log,linux} -> + filename:join([Base,Name,"log"]); + {user_log,windows} -> + filename:join([Base,Name,"Logs"]); + {user_cache,windows} -> + filename:join([Base,Name,"Cache"]); + {Type,_} when Type =:= site_config orelse Type =:= site_data -> + [filename:join([B,Name]) || B <- Base]; + _ -> + filename:join([Base,Name]) + end. + +basedir_os_from_opts(#{os := linux}) -> linux; +basedir_os_from_opts(#{os := windows}) -> windows; +basedir_os_from_opts(#{os := darwin}) -> darwin; +basedir_os_from_opts(#{}) -> basedir_os_type(). + +basedir_name_from_opts(windows,App,#{author:=Author,version:=Vsn}) -> + filename:join([Author,App,Vsn]); +basedir_name_from_opts(windows,App,#{author:=Author}) -> + filename:join([Author,App]); +basedir_name_from_opts(_,App,#{version:=Vsn}) -> + filename:join([App,Vsn]); +basedir_name_from_opts(_,App,_) -> + App. + +basedir_from_os(Type,Os) -> + case Os of + linux -> basedir_linux(Type); + darwin -> basedir_darwin(Type); + windows -> basedir_windows(Type) + end. + +-define(basedir_linux_user_data, ".local/share"). +-define(basedir_linux_user_config, ".config"). +-define(basedir_linux_user_cache, ".cache"). +-define(basedir_linux_user_log, ".cache"). %% .cache/App/log +-define(basedir_linux_site_data, "/usr/local/share/:/usr/share/"). +-define(basedir_linux_site_config, "/etc/xdg"). + +basedir_linux(Type) -> + case Type of + user_data -> getenv("XDG_DATA_HOME", ?basedir_linux_user_data, true); + user_config -> getenv("XDG_CONFIG_HOME",?basedir_linux_user_config,true); + user_cache -> getenv("XDG_CACHE_HOME", ?basedir_linux_user_cache, true); + user_log -> getenv("XDG_CACHE_HOME", ?basedir_linux_user_log, true); + site_data -> + Base = getenv("XDG_DATA_DIRS",?basedir_linux_site_data,false), + string:tokens(Base,":"); + site_config -> + Base = getenv("XDG_CONFIG_DIRS",?basedir_linux_site_config,false), + string:tokens(Base,":") + end. + +-define(basedir_darwin_user_data, "Library/Application Support"). +-define(basedir_darwin_user_config, "Library/Application Support"). +-define(basedir_darwin_user_cache, "Library/Caches"). +-define(basedir_darwin_user_log, "Library/Logs"). +-define(basedir_darwin_site_data, "/Library/Application Support"). +-define(basedir_darwin_site_config, "/Library/Application Support"). + +basedir_darwin(Type) -> + case Type of + user_data -> basedir_join_home(?basedir_darwin_user_data); + user_config -> basedir_join_home(?basedir_darwin_user_config); + user_cache -> basedir_join_home(?basedir_darwin_user_cache); + user_log -> basedir_join_home(?basedir_darwin_user_log); + site_data -> [?basedir_darwin_site_data]; + site_config -> [?basedir_darwin_site_config] + end. + +%% On Windows: +%% ex. C:\Users\egil\AppData\Local\Ericsson\Erlang +%% %LOCALAPPDATA% is defined on Windows 7 and onwards +%% %APPDATA% is used instead of %LOCALAPPDATA% if it's not defined. +%% %APPDATA% is used for roaming, i.e. for user_config on Windows 7 and beyond. +%% +%% user_data %LOCALAPPDATA%[/$author]/$appname[/$version] +%% user_config %APPDATA%[/$author]/$appname[/$version] +%% user_cache %LOCALAPPDATA%[/$author]/$appname[/$version]/Cache +%% user_log %LOCALAPPDATA%[/$author]/$appname[/$version]/Logs + +-define(basedir_windows_user_data, "Local"). +-define(basedir_windows_user_config, "Roaming"). +-define(basedir_windows_user_cache, "Local"). %% Cache is added later +-define(basedir_windows_user_log, "Local"). %% Logs is added later + +basedir_windows(Type) -> + %% If LOCALAPPDATA is not defined we are likely on an + %% XP machine. Use APPDATA instead. + case basedir_windows_appdata() of + noappdata -> + %% No AppData is set + %% Probably running MSYS + case Type of + user_data -> basedir_join_home(?basedir_windows_user_data); + user_config -> basedir_join_home(?basedir_windows_user_config); + user_cache -> basedir_join_home(?basedir_windows_user_cache); + user_log -> basedir_join_home(?basedir_windows_user_log); + site_data -> []; + site_config -> [] + end; + {ok, AppData} -> + case Type of + user_data -> getenv("LOCALAPPDATA", AppData); + user_config -> AppData; + user_cache -> getenv("LOCALAPPDATA", AppData); + user_log -> getenv("LOCALAPPDATA", AppData); + site_data -> []; + site_config -> [] + end + end. + +basedir_windows_appdata() -> + case os:getenv("APPDATA") of + Invalid when Invalid =:= false orelse Invalid =:= [] -> + noappdata; + Val -> + {ok, Val} + end. + +%% basedir aux + +getenv(K,Def,false) -> getenv(K,Def); +getenv(K,Def,true) -> getenv(K,basedir_join_home(Def)). + +getenv(K,Def) -> + case os:getenv(K) of + [] -> Def; + false -> Def; + Val -> Val + end. + +basedir_join_home(Dir) -> + case os:getenv("HOME") of + false -> + {ok,[[Home]]} = init:get_argument(home), + filename:join(Home,Dir); + Home -> filename:join(Home,Dir) + end. + +basedir_os_type() -> + case os:type() of + {unix,darwin} -> darwin; + {win32,_} -> windows; + _ -> linux + end. diff --git a/lib/stdlib/src/gb_sets.erl b/lib/stdlib/src/gb_sets.erl index 91d21d869c..47a8fa6db0 100644 --- a/lib/stdlib/src/gb_sets.erl +++ b/lib/stdlib/src/gb_sets.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -137,6 +138,10 @@ %% approach is that it does not require the complete list of all %% elements to be built in memory at one time. %% +%% - iterator_from(X, S): returns an iterator that can be used for +%% traversing the elements of set S greater than or equal to X; +%% see `next'. +%% %% - next(T): returns {X, T1} where X is the smallest element referred %% to by the iterator T, and T1 is the new iterator to be used for %% traversing the remaining elements, or the atom `none' if no @@ -157,15 +162,15 @@ insert/2, add/2, delete/2, delete_any/2, balance/1, union/2, union/1, intersection/2, intersection/1, is_disjoint/2, difference/2, is_subset/2, to_list/1, from_list/1, from_ordset/1, smallest/1, - largest/1, take_smallest/1, take_largest/1, iterator/1, next/1, - filter/2, fold/3, is_set/1]). + largest/1, take_smallest/1, take_largest/1, iterator/1, + iterator_from/2, next/1, filter/2, fold/3, is_set/1]). %% `sets' compatibility aliases: -export([new/0, is_element/2, add_element/2, del_element/2, subtract/2]). -%% GB-trees adapted from Sven-Olof Nystr�m's implementation for +%% GB-trees adapted from Sven-Olof Nyström's implementation for %% representation of sets. %% %% Data structures: @@ -196,29 +201,29 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Some types. --type gb_set_node() :: 'nil' | {term(), _, _}. --opaque iter() :: [gb_set_node()]. +-export_type([set/0, set/1, iter/0, iter/1]). -%% A declaration equivalent to the following is currently hard-coded -%% in erl_types.erl -%% -%% -opaque gb_set() :: {non_neg_integer(), gb_set_node()}. +-type gb_set_node(Element) :: 'nil' | {Element, _, _}. +-opaque set(Element) :: {non_neg_integer(), gb_set_node(Element)}. +-type set() :: set(_). +-opaque iter(Element) :: [gb_set_node(Element)]. +-type iter() :: iter(_). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -spec empty() -> Set when - Set :: gb_set(). + Set :: set(). empty() -> {0, nil}. -spec new() -> Set when - Set :: gb_set(). + Set :: set(). new() -> empty(). -spec is_empty(Set) -> boolean() when - Set :: gb_set(). + Set :: set(). is_empty({0, nil}) -> true; @@ -226,27 +231,24 @@ is_empty(_) -> false. -spec size(Set) -> non_neg_integer() when - Set :: gb_set(). + Set :: set(). size({Size, _}) -> Size. --spec singleton(Element) -> gb_set() when - Element :: term(). +-spec singleton(Element) -> set(Element). singleton(Key) -> {1, {Key, nil, nil}}. -spec is_element(Element, Set) -> boolean() when - Element :: term(), - Set :: gb_set(). + Set :: set(Element). is_element(Key, S) -> is_member(Key, S). -spec is_member(Element, Set) -> boolean() when - Element :: term(), - Set :: gb_set(). + Set :: set(Element). is_member(Key, {_, T}) -> is_member_1(Key, T). @@ -261,9 +263,8 @@ is_member_1(_, nil) -> false. -spec insert(Element, Set1) -> Set2 when - Element :: term(), - Set1 :: gb_set(), - Set2 :: gb_set(). + Set1 :: set(Element), + Set2 :: set(Element). insert(Key, {S, T}) -> S1 = S + 1, @@ -320,8 +321,8 @@ count(nil) -> {1, 0}. -spec balance(Set1) -> Set2 when - Set1 :: gb_set(), - Set2 :: gb_set(). + Set1 :: set(Element), + Set2 :: set(Element). balance({S, T}) -> {S, balance(T, S)}. @@ -347,17 +348,15 @@ balance_list_1(L, 0) -> {nil, L}. -spec add_element(Element, Set1) -> Set2 when - Element :: term(), - Set1 :: gb_set(), - Set2 :: gb_set(). + Set1 :: set(Element), + Set2 :: set(Element). add_element(X, S) -> add(X, S). -spec add(Element, Set1) -> Set2 when - Element :: term(), - Set1 :: gb_set(), - Set2 :: gb_set(). + Set1 :: set(Element), + Set2 :: set(Element). add(X, S) -> case is_member(X, S) of @@ -368,32 +367,30 @@ add(X, S) -> end. -spec from_list(List) -> Set when - List :: [term()], - Set :: gb_set(). + List :: [Element], + Set :: set(Element). from_list(L) -> from_ordset(ordsets:from_list(L)). -spec from_ordset(List) -> Set when - List :: [term()], - Set :: gb_set(). + List :: [Element], + Set :: set(Element). from_ordset(L) -> S = length(L), {S, balance_list(L, S)}. -spec del_element(Element, Set1) -> Set2 when - Element :: term(), - Set1 :: gb_set(), - Set2 :: gb_set(). + Set1 :: set(Element), + Set2 :: set(Element). del_element(Key, S) -> delete_any(Key, S). -spec delete_any(Element, Set1) -> Set2 when - Element :: term(), - Set1 :: gb_set(), - Set2 :: gb_set(). + Set1 :: set(Element), + Set2 :: set(Element). delete_any(Key, S) -> case is_member(Key, S) of @@ -404,9 +401,8 @@ delete_any(Key, S) -> end. -spec delete(Element, Set1) -> Set2 when - Element :: term(), - Set1 :: gb_set(), - Set2 :: gb_set(). + Set1 :: set(Element), + Set2 :: set(Element). delete(Key, {S, T}) -> {S - 1, delete_1(Key, T)}. @@ -429,9 +425,8 @@ merge(Smaller, Larger) -> {Key, Smaller, Larger1}. -spec take_smallest(Set1) -> {Element, Set2} when - Set1 :: gb_set(), - Set2 :: gb_set(), - Element :: term(). + Set1 :: set(Element), + Set2 :: set(Element). take_smallest({S, T}) -> {Key, Larger} = take_smallest1(T), @@ -443,8 +438,8 @@ take_smallest1({Key, Smaller, Larger}) -> {Key1, Smaller1} = take_smallest1(Smaller), {Key1, {Key, Smaller1, Larger}}. --spec smallest(Set) -> term() when - Set :: gb_set(). +-spec smallest(Set) -> Element when + Set :: set(Element). smallest({_, T}) -> smallest_1(T). @@ -455,9 +450,8 @@ smallest_1({_Key, Smaller, _Larger}) -> smallest_1(Smaller). -spec take_largest(Set1) -> {Element, Set2} when - Set1 :: gb_set(), - Set2 :: gb_set(), - Element :: term(). + Set1 :: set(Element), + Set2 :: set(Element). take_largest({S, T}) -> {Key, Smaller} = take_largest1(T), @@ -469,8 +463,8 @@ take_largest1({Key, Smaller, Larger}) -> {Key1, Larger1} = take_largest1(Larger), {Key1, {Key, Smaller, Larger1}}. --spec largest(Set) -> term() when - Set :: gb_set(). +-spec largest(Set) -> Element when + Set :: set(Element). largest({_, T}) -> largest_1(T). @@ -481,8 +475,8 @@ largest_1({_Key, _Smaller, Larger}) -> largest_1(Larger). -spec to_list(Set) -> List when - Set :: gb_set(), - List :: [term()]. + Set :: set(Element), + List :: [Element]. to_list({_, T}) -> to_list(T, []). @@ -494,8 +488,8 @@ to_list({Key, Small, Big}, L) -> to_list(nil, L) -> L. -spec iterator(Set) -> Iter when - Set :: gb_set(), - Iter :: iter(). + Set :: set(Element), + Iter :: iter(Element). iterator({_, T}) -> iterator(T, []). @@ -510,10 +504,25 @@ iterator({_, L, _} = T, As) -> iterator(nil, As) -> As. +-spec iterator_from(Element, Set) -> Iter when + Set :: set(Element), + Iter :: iter(Element). + +iterator_from(S, {_, T}) -> + iterator_from(S, T, []). + +iterator_from(S, {K, _, T}, As) when K < S -> + iterator_from(S, T, As); +iterator_from(_, {_, nil, _} = T, As) -> + [T | As]; +iterator_from(S, {_, L, _} = T, As) -> + iterator_from(S, L, [T | As]); +iterator_from(_, nil, As) -> + As. + -spec next(Iter1) -> {Element, Iter2} | 'none' when - Iter1 :: iter(), - Iter2 :: iter(), - Element :: term(). + Iter1 :: iter(Element), + Iter2 :: iter(Element). next([{X, _, T} | As]) -> {X, iterator(T, As)}; @@ -544,9 +553,9 @@ next([]) -> %% overhead. -spec union(Set1, Set2) -> Set3 when - Set1 :: gb_set(), - Set2 :: gb_set(), - Set3 :: gb_set(). + Set1 :: set(Element), + Set2 :: set(Element), + Set3 :: set(Element). union({N1, T1}, {N2, T2}) when N2 < N1 -> union(to_list_1(T2), N2, T1, N1); @@ -568,7 +577,7 @@ union(L, N1, T2, N2) -> union_1(L, mk_set(N2, T2)) end. --spec mk_set(non_neg_integer(), gb_set_node()) -> gb_set(). +-spec mk_set(non_neg_integer(), gb_set_node(T)) -> set(T). mk_set(N, T) -> {N, T}. @@ -649,8 +658,8 @@ balance_revlist_1(L, 0) -> {nil, L}. -spec union(SetList) -> Set when - SetList :: [gb_set(),...], - Set :: gb_set(). + SetList :: [set(Element),...], + Set :: set(Element). union([S | Ss]) -> union_list(S, Ss); @@ -664,9 +673,9 @@ union_list(S, []) -> S. %% The rest is modelled on the above. -spec intersection(Set1, Set2) -> Set3 when - Set1 :: gb_set(), - Set2 :: gb_set(), - Set3 :: gb_set(). + Set1 :: set(Element), + Set2 :: set(Element), + Set3 :: set(Element). intersection({N1, T1}, {N2, T2}) when N2 < N1 -> intersection(to_list_1(T2), N2, T1, N1); @@ -715,8 +724,8 @@ intersection_2(_, [], As, S) -> {S, balance_revlist(As, S)}. -spec intersection(SetList) -> Set when - SetList :: [gb_set(),...], - Set :: gb_set(). + SetList :: [set(Element),...], + Set :: set(Element). intersection([S | Ss]) -> intersection_list(S, Ss). @@ -726,8 +735,8 @@ intersection_list(S, [S1 | Ss]) -> intersection_list(S, []) -> S. -spec is_disjoint(Set1, Set2) -> boolean() when - Set1 :: gb_set(), - Set2 :: gb_set(). + Set1 :: set(Element), + Set2 :: set(Element). is_disjoint({N1, T1}, {N2, T2}) when N1 < N2 -> is_disjoint_1(T1, T2); @@ -756,17 +765,17 @@ is_disjoint_1(_, nil) -> %% traverse the whole element list of the left operand. -spec subtract(Set1, Set2) -> Set3 when - Set1 :: gb_set(), - Set2 :: gb_set(), - Set3 :: gb_set(). + Set1 :: set(Element), + Set2 :: set(Element), + Set3 :: set(Element). subtract(S1, S2) -> difference(S1, S2). -spec difference(Set1, Set2) -> Set3 when - Set1 :: gb_set(), - Set2 :: gb_set(), - Set3 :: gb_set(). + Set1 :: set(Element), + Set2 :: set(Element), + Set3 :: set(Element). difference({N1, T1}, {N2, T2}) -> difference(to_list_1(T1), N1, T2, N2). @@ -815,8 +824,8 @@ difference_2(Xs, [], As, S) -> %% without the construction of a new set. -spec is_subset(Set1, Set2) -> boolean() when - Set1 :: gb_set(), - Set2 :: gb_set(). + Set1 :: set(Element), + Set2 :: set(Element). is_subset({N1, T1}, {N2, T2}) -> is_subset(to_list_1(T1), N1, T2, N2). @@ -865,20 +874,20 @@ is_set({N, {_, _, _}}) when is_integer(N), N >= 0 -> true; is_set(_) -> false. -spec filter(Pred, Set1) -> Set2 when - Pred :: fun((E :: term()) -> boolean()), - Set1 :: gb_set(), - Set2 :: gb_set(). + Pred :: fun((Element) -> boolean()), + Set1 :: set(Element), + Set2 :: set(Element). filter(F, S) -> from_ordset([X || X <- to_list(S), F(X)]). -spec fold(Function, Acc0, Set) -> Acc1 when - Function :: fun((E :: term(), AccIn) -> AccOut), - Acc0 :: term(), - Acc1 :: term(), - AccIn :: term(), - AccOut :: term(), - Set :: gb_set(). + Function :: fun((Element, AccIn) -> AccOut), + Acc0 :: Acc, + Acc1 :: Acc, + AccIn :: Acc, + AccOut :: Acc, + Set :: set(Element). fold(F, A, {_, T}) when is_function(F, 2) -> fold_1(F, A, T). diff --git a/lib/stdlib/src/gb_trees.erl b/lib/stdlib/src/gb_trees.erl index 6ad861ff5b..c4a20d92a7 100644 --- a/lib/stdlib/src/gb_trees.erl +++ b/lib/stdlib/src/gb_trees.erl @@ -1,25 +1,26 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% %% ===================================================================== %% General Balanced Trees - highly efficient dictionaries. %% -%% Copyright (C) 1999-2001 Sven-Olof Nystr�m, Richard Carlsson +%% Copyright (C) 1999-2001 Sven-Olof Nyström, Richard Carlsson %% %% An efficient implementation of Prof. Arne Andersson's General %% Balanced Trees. These have no storage overhead compared to plain @@ -102,6 +103,10 @@ %% approach is that it does not require the complete list of all %% elements to be built in memory at one time. %% +%% - iterator_from(K, T): returns an iterator that can be used for +%% traversing the entries of tree T with key greater than or +%% equal to K; see `next'. +%% %% - next(S): returns {X, V, S1} where X is the smallest key referred to %% by the iterator S, and S1 is the new iterator to be used for %% traversing the remaining entries, or the atom `none' if no entries @@ -117,7 +122,7 @@ update/3, enter/3, delete/2, delete_any/2, balance/1, is_defined/2, keys/1, values/1, to_list/1, from_orddict/1, smallest/1, largest/1, take_smallest/1, take_largest/1, - iterator/1, next/1, map/2]). + iterator/1, iterator_from/2, next/1, map/2]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -152,23 +157,24 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Some types. --type gb_tree_node() :: 'nil' | {_, _, _, _}. --opaque iter() :: [gb_tree_node()]. +-export_type([tree/0, tree/2, iter/0, iter/2]). -%% A declaration equivalent to the following is currently hard-coded -%% in erl_types.erl -%% -%% -opaque gb_tree() :: {non_neg_integer(), gb_tree_node()}. +-type gb_tree_node(K, V) :: 'nil' + | {K, V, gb_tree_node(K, V), gb_tree_node(K, V)}. +-opaque tree(Key, Value) :: {non_neg_integer(), gb_tree_node(Key, Value)}. +-type tree() :: tree(_, _). +-opaque iter(Key, Value) :: [gb_tree_node(Key, Value)]. +-type iter() :: iter(_, _). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --spec empty() -> gb_tree(). +-spec empty() -> tree(). empty() -> {0, nil}. -spec is_empty(Tree) -> boolean() when - Tree :: gb_tree(). + Tree :: tree(). is_empty({0, nil}) -> true; @@ -176,17 +182,15 @@ is_empty(_) -> false. -spec size(Tree) -> non_neg_integer() when - Tree :: gb_tree(). + Tree :: tree(). size({Size, _}) when is_integer(Size), Size >= 0 -> Size. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --spec lookup(Key, Tree) -> 'none' | {'value', Val} when - Key :: term(), - Val :: term(), - Tree :: gb_tree(). +-spec lookup(Key, Tree) -> 'none' | {'value', Value} when + Tree :: tree(Key, Value). lookup(Key, {_, T}) -> lookup_1(Key, T). @@ -212,8 +216,7 @@ lookup_1(_, nil) -> %% This is a specialized version of `lookup'. -spec is_defined(Key, Tree) -> boolean() when - Key :: term(), - Tree :: gb_tree(). + Tree :: tree(Key, Value :: term()). is_defined(Key, {_, T}) -> is_defined_1(Key, T). @@ -231,10 +234,8 @@ is_defined_1(_, nil) -> %% This is a specialized version of `lookup'. --spec get(Key, Tree) -> Val when - Key :: term(), - Tree :: gb_tree(), - Val :: term(). +-spec get(Key, Tree) -> Value when + Tree :: tree(Key, Value). get(Key, {_, T}) -> get_1(Key, T). @@ -248,11 +249,9 @@ get_1(_, {_, Value, _, _}) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --spec update(Key, Val, Tree1) -> Tree2 when - Key :: term(), - Val :: term(), - Tree1 :: gb_tree(), - Tree2 :: gb_tree(). +-spec update(Key, Value, Tree1) -> Tree2 when + Tree1 :: tree(Key, Value), + Tree2 :: tree(Key, Value). update(Key, Val, {S, T}) -> T1 = update_1(Key, Val, T), @@ -269,11 +268,9 @@ update_1(Key, Value, {_, _, Smaller, Bigger}) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --spec insert(Key, Val, Tree1) -> Tree2 when - Key :: term(), - Val :: term(), - Tree1 :: gb_tree(), - Tree2 :: gb_tree(). +-spec insert(Key, Value, Tree1) -> Tree2 when + Tree1 :: tree(Key, Value), + Tree2 :: tree(Key, Value). insert(Key, Val, {S, T}) when is_integer(S) -> S1 = S+1, @@ -322,11 +319,9 @@ insert_1(Key, _, _, _) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --spec enter(Key, Val, Tree1) -> Tree2 when - Key :: term(), - Val :: term(), - Tree1 :: gb_tree(), - Tree2 :: gb_tree(). +-spec enter(Key, Value, Tree1) -> Tree2 when + Tree1 :: tree(Key, Value), + Tree2 :: tree(Key, Value). enter(Key, Val, T) -> case is_defined(Key, T) of @@ -350,8 +345,8 @@ count(nil) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -spec balance(Tree1) -> Tree2 when - Tree1 :: gb_tree(), - Tree2 :: gb_tree(). + Tree1 :: tree(Key, Value), + Tree2 :: tree(Key, Value). balance({S, T}) -> {S, balance(T, S)}. @@ -377,8 +372,8 @@ balance_list_1(L, 0) -> {nil, L}. -spec from_orddict(List) -> Tree when - List :: [{Key :: term(), Val :: term()}], - Tree :: gb_tree(). + List :: [{Key, Value}], + Tree :: tree(Key, Value). from_orddict(L) -> S = length(L), @@ -387,9 +382,8 @@ from_orddict(L) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -spec delete_any(Key, Tree1) -> Tree2 when - Key :: term(), - Tree1 :: gb_tree(), - Tree2 :: gb_tree(). + Tree1 :: tree(Key, Value), + Tree2 :: tree(Key, Value). delete_any(Key, T) -> case is_defined(Key, T) of @@ -402,9 +396,8 @@ delete_any(Key, T) -> %%% delete. Assumes that key is present. -spec delete(Key, Tree1) -> Tree2 when - Key :: term(), - Tree1 :: gb_tree(), - Tree2 :: gb_tree(). + Tree1 :: tree(Key, Value), + Tree2 :: tree(Key, Value). delete(Key, {S, T}) when is_integer(S), S >= 0 -> {S - 1, delete_1(Key, T)}. @@ -430,11 +423,9 @@ merge(Smaller, Larger) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --spec take_smallest(Tree1) -> {Key, Val, Tree2} when - Tree1 :: gb_tree(), - Tree2 :: gb_tree(), - Key :: term(), - Val :: term(). +-spec take_smallest(Tree1) -> {Key, Value, Tree2} when + Tree1 :: tree(Key, Value), + Tree2 :: tree(Key, Value). take_smallest({Size, Tree}) when is_integer(Size), Size >= 0 -> {Key, Value, Larger} = take_smallest1(Tree), @@ -446,10 +437,8 @@ take_smallest1({Key, Value, Smaller, Larger}) -> {Key1, Value1, Smaller1} = take_smallest1(Smaller), {Key1, Value1, {Key, Value, Smaller1, Larger}}. --spec smallest(Tree) -> {Key, Val} when - Tree :: gb_tree(), - Key :: term(), - Val :: term(). +-spec smallest(Tree) -> {Key, Value} when + Tree :: tree(Key, Value). smallest({_, Tree}) -> smallest_1(Tree). @@ -459,11 +448,9 @@ smallest_1({Key, Value, nil, _Larger}) -> smallest_1({_Key, _Value, Smaller, _Larger}) -> smallest_1(Smaller). --spec take_largest(Tree1) -> {Key, Val, Tree2} when - Tree1 :: gb_tree(), - Tree2 :: gb_tree(), - Key :: term(), - Val :: term(). +-spec take_largest(Tree1) -> {Key, Value, Tree2} when + Tree1 :: tree(Key, Value), + Tree2 :: tree(Key, Value). take_largest({Size, Tree}) when is_integer(Size), Size >= 0 -> {Key, Value, Smaller} = take_largest1(Tree), @@ -475,10 +462,8 @@ take_largest1({Key, Value, Smaller, Larger}) -> {Key1, Value1, Larger1} = take_largest1(Larger), {Key1, Value1, {Key, Value, Smaller, Larger1}}. --spec largest(Tree) -> {Key, Val} when - Tree :: gb_tree(), - Key :: term(), - Val :: term(). +-spec largest(Tree) -> {Key, Value} when + Tree :: tree(Key, Value). largest({_, Tree}) -> largest_1(Tree). @@ -490,10 +475,8 @@ largest_1({_Key, _Value, _Smaller, Larger}) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --spec to_list(Tree) -> [{Key, Val}] when - Tree :: gb_tree(), - Key :: term(), - Val :: term(). +-spec to_list(Tree) -> [{Key, Value}] when + Tree :: tree(Key, Value). to_list({_, T}) -> to_list(T, []). @@ -507,8 +490,7 @@ to_list(nil, L) -> L. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -spec keys(Tree) -> [Key] when - Tree :: gb_tree(), - Key :: term(). + Tree :: tree(Key, Value :: term()). keys({_, T}) -> keys(T, []). @@ -519,9 +501,8 @@ keys(nil, L) -> L. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --spec values(Tree) -> [Val] when - Tree :: gb_tree(), - Val :: term(). +-spec values(Tree) -> [Value] when + Tree :: tree(Key :: term(), Value). values({_, T}) -> values(T, []). @@ -533,8 +514,8 @@ values(nil, L) -> L. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -spec iterator(Tree) -> Iter when - Tree :: gb_tree(), - Iter :: iter(). + Tree :: tree(Key, Value), + Iter :: iter(Key, Value). iterator({_, T}) -> iterator_1(T). @@ -552,11 +533,32 @@ iterator({_, _, L, _} = T, As) -> iterator(nil, As) -> As. --spec next(Iter1) -> 'none' | {Key, Val, Iter2} when - Iter1 :: iter(), - Iter2 :: iter(), - Key :: term(), - Val :: term(). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-spec iterator_from(Key, Tree) -> Iter when + Tree :: tree(Key, Value), + Iter :: iter(Key, Value). + +iterator_from(S, {_, T}) -> + iterator_1_from(S, T). + +iterator_1_from(S, T) -> + iterator_from(S, T, []). + +iterator_from(S, {K, _, _, T}, As) when K < S -> + iterator_from(S, T, As); +iterator_from(_, {_, _, nil, _} = T, As) -> + [T | As]; +iterator_from(S, {_, _, L, _} = T, As) -> + iterator_from(S, L, [T | As]); +iterator_from(_, nil, As) -> + As. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-spec next(Iter1) -> 'none' | {Key, Value, Iter2} when + Iter1 :: iter(Key, Value), + Iter2 :: iter(Key, Value). next([{X, V, _, T} | As]) -> {X, V, iterator(T, As)}; @@ -566,9 +568,9 @@ next([]) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -spec map(Function, Tree1) -> Tree2 when - Function :: fun((K :: term(), V1 :: term()) -> V2 :: term()), - Tree1 :: gb_tree(), - Tree2 :: gb_tree(). + Function :: fun((K :: Key, V1 :: Value1) -> V2 :: Value2), + Tree1 :: tree(Key, Value1), + Tree2 :: tree(Key, Value2). map(F, {Size, Tree}) when is_function(F, 2) -> {Size, map_1(F, Tree)}. diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl index 42555aedd7..597830cf9a 100644 --- a/lib/stdlib/src/gen.erl +++ b/lib/stdlib/src/gen.erl @@ -1,22 +1,24 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(gen). +-compile({inline,[get_node/1]}). %%%----------------------------------------------------------------- %%% This module implements the really generic stuff of the generic @@ -24,8 +26,9 @@ %%% %%% The standard behaviour should export init_it/6. %%%----------------------------------------------------------------- --export([start/5, start/6, debug_options/1, - call/3, call/4, reply/2]). +-export([start/5, start/6, debug_options/2, + name/1, unregister_name/1, get_proc_name/1, get_parent/0, + call/3, call/4, reply/2, stop/1, stop/3]). -export([init_it/6, init_it/7]). @@ -36,7 +39,9 @@ %%----------------------------------------------------------------- -type linkage() :: 'link' | 'nolink'. --type emgr_name() :: {'local', atom()} | {'global', term()} | {via, atom(), term()}. +-type emgr_name() :: {'local', atom()} + | {'global', term()} + | {'via', Module :: module(), Name :: term()}. -type start_ret() :: {'ok', pid()} | 'ignore' | {'error', term()}. @@ -120,7 +125,7 @@ init_it(GenMod, Starter, Parent, Mod, Args, Options) -> init_it2(GenMod, Starter, Parent, self(), Mod, Args, Options). init_it(GenMod, Starter, Parent, Name, Mod, Args, Options) -> - case name_register(Name) of + case register_name(Name) of true -> init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options); {false, Pid} -> @@ -142,68 +147,12 @@ init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options) -> call(Process, Label, Request) -> call(Process, Label, Request, ?default_timeout). -%% Local or remote by pid -call(Pid, Label, Request, Timeout) - when is_pid(Pid), Timeout =:= infinity; - is_pid(Pid), is_integer(Timeout), Timeout >= 0 -> - do_call(Pid, Label, Request, Timeout); -%% Local by name -call(Name, Label, Request, Timeout) - when is_atom(Name), Timeout =:= infinity; - is_atom(Name), is_integer(Timeout), Timeout >= 0 -> - case whereis(Name) of - Pid when is_pid(Pid) -> - do_call(Pid, Label, Request, Timeout); - undefined -> - exit(noproc) - end; -%% Global by name call(Process, Label, Request, Timeout) - when ((tuple_size(Process) == 2 andalso element(1, Process) == global) - orelse - (tuple_size(Process) == 3 andalso element(1, Process) == via)) - andalso - (Timeout =:= infinity orelse (is_integer(Timeout) andalso Timeout >= 0)) -> - case where(Process) of - Pid when is_pid(Pid) -> - Node = node(Pid), - try do_call(Pid, Label, Request, Timeout) - catch - exit:{nodedown, Node} -> - %% A nodedown not yet detected by global, - %% pretend that it was. - exit(noproc) - end; - undefined -> - exit(noproc) - end; -%% Local by name in disguise -call({Name, Node}, Label, Request, Timeout) - when Node =:= node(), Timeout =:= infinity; - Node =:= node(), is_integer(Timeout), Timeout >= 0 -> - call(Name, Label, Request, Timeout); -%% Remote by name -call({_Name, Node}=Process, Label, Request, Timeout) - when is_atom(Node), Timeout =:= infinity; - is_atom(Node), is_integer(Timeout), Timeout >= 0 -> - if - node() =:= nonode@nohost -> - exit({nodedown, Node}); - true -> - do_call(Process, Label, Request, Timeout) - end. + when Timeout =:= infinity; is_integer(Timeout), Timeout >= 0 -> + Fun = fun(Pid) -> do_call(Pid, Label, Request, Timeout) end, + do_for_proc(Process, Fun). do_call(Process, Label, Request, Timeout) -> - %% We trust the arguments to be correct, i.e - %% Process is either a local or remote pid, - %% or a {Name, Node} tuple (of atoms) and in this - %% case this node (node()) _is_ distributed and Node =/= node(). - Node = case Process of - {_S, N} when is_atom(N) -> - N; - _ when is_pid(Process) -> - node(Process) - end, try erlang:monitor(process, Process) of Mref -> %% If the monitor/2 call failed to set up a connection to a @@ -222,15 +171,12 @@ do_call(Process, Label, Request, Timeout) -> erlang:demonitor(Mref, [flush]), {ok, Reply}; {'DOWN', Mref, _, _, noconnection} -> + Node = get_node(Process), exit({nodedown, Node}); {'DOWN', Mref, _, _, Reason} -> exit(Reason) after Timeout -> - erlang:demonitor(Mref), - receive - {'DOWN', Mref, _, _, _} -> true - after 0 -> true - end, + erlang:demonitor(Mref, [flush]), exit(timeout) end catch @@ -241,6 +187,7 @@ do_call(Process, Label, Request, Timeout) -> %% Do the best possible with monitor_node/2. %% This code may hang indefinitely if the Process %% does not exist. It is only used for featureweak remote nodes. + Node = get_node(Process), monitor_node(Node, true), receive {nodedown, Node} -> @@ -253,6 +200,18 @@ do_call(Process, Label, Request, Timeout) -> end end. +get_node(Process) -> + %% We trust the arguments to be correct, i.e + %% Process is either a local or remote pid, + %% or a {Name, Node} tuple (of atoms) and in this + %% case this node (node()) _is_ distributed and Node =/= node(). + case Process of + {_S, N} when is_atom(N) -> + N; + _ when is_pid(Process) -> + node(Process) + end. + wait_resp(Node, Tag, Timeout) -> receive {Tag, Reply} -> @@ -273,6 +232,65 @@ reply({To, Tag}, Reply) -> Msg = {Tag, Reply}, try To ! Msg catch _:_ -> Msg end. +%%----------------------------------------------------------------- +%% Syncronously stop a generic process +%%----------------------------------------------------------------- +stop(Process) -> + stop(Process, normal, infinity). + +stop(Process, Reason, Timeout) + when Timeout =:= infinity; is_integer(Timeout), Timeout >= 0 -> + Fun = fun(Pid) -> proc_lib:stop(Pid, Reason, Timeout) end, + do_for_proc(Process, Fun). + +%%----------------------------------------------------------------- +%% Map different specifications of a process to either Pid or +%% {Name,Node}. Execute the given Fun with the process as only +%% argument. +%% ----------------------------------------------------------------- + +%% Local or remote by pid +do_for_proc(Pid, Fun) when is_pid(Pid) -> + Fun(Pid); +%% Local by name +do_for_proc(Name, Fun) when is_atom(Name) -> + case whereis(Name) of + Pid when is_pid(Pid) -> + Fun(Pid); + undefined -> + exit(noproc) + end; +%% Global by name +do_for_proc(Process, Fun) + when ((tuple_size(Process) == 2 andalso element(1, Process) == global) + orelse + (tuple_size(Process) == 3 andalso element(1, Process) == via)) -> + case where(Process) of + Pid when is_pid(Pid) -> + Node = node(Pid), + try Fun(Pid) + catch + exit:{nodedown, Node} -> + %% A nodedown not yet detected by global, + %% pretend that it was. + exit(noproc) + end; + undefined -> + exit(noproc) + end; +%% Local by name in disguise +do_for_proc({Name, Node}, Fun) when Node =:= node() -> + do_for_proc(Name, Fun); +%% Remote by name +do_for_proc({_Name, Node} = Process, Fun) when is_atom(Node) -> + if + node() =:= nonode@nohost -> + exit({nodedown, Node}); + true -> + Fun(Process) + end. + + %%%----------------------------------------------------------------- %%% Misc. functions. %%%----------------------------------------------------------------- @@ -280,19 +298,19 @@ where({global, Name}) -> global:whereis_name(Name); where({via, Module, Name}) -> Module:whereis_name(Name); where({local, Name}) -> whereis(Name). -name_register({local, Name} = LN) -> +register_name({local, Name} = LN) -> try register(Name, self()) of true -> true catch error:_ -> {false, where(LN)} end; -name_register({global, Name} = GN) -> +register_name({global, Name} = GN) -> case global:register_name(Name, self()) of yes -> true; no -> {false, where(GN)} end; -name_register({via, Module, Name} = GN) -> +register_name({via, Module, Name} = GN) -> case Module:register_name(Name, self()) of yes -> true; @@ -300,34 +318,108 @@ name_register({via, Module, Name} = GN) -> {false, where(GN)} end. +name({local,Name}) -> Name; +name({global,Name}) -> Name; +name({via,_, Name}) -> Name; +name(Pid) when is_pid(Pid) -> Pid. + +unregister_name({local,Name}) -> + try unregister(Name) of + _ -> ok + catch + _:_ -> ok + end; +unregister_name({global,Name}) -> + _ = global:unregister_name(Name), + ok; +unregister_name({via, Mod, Name}) -> + _ = Mod:unregister_name(Name), + ok; +unregister_name(Pid) when is_pid(Pid) -> + ok. + +get_proc_name(Pid) when is_pid(Pid) -> + Pid; +get_proc_name({local, Name}) -> + case process_info(self(), registered_name) of + {registered_name, Name} -> + Name; + {registered_name, _Name} -> + exit(process_not_registered); + [] -> + exit(process_not_registered) + end; +get_proc_name({global, Name}) -> + case global:whereis_name(Name) of + undefined -> + exit(process_not_registered_globally); + Pid when Pid =:= self() -> + Name; + _Pid -> + exit(process_not_registered_globally) + end; +get_proc_name({via, Mod, Name}) -> + case Mod:whereis_name(Name) of + undefined -> + exit({process_not_registered_via, Mod}); + Pid when Pid =:= self() -> + Name; + _Pid -> + exit({process_not_registered_via, Mod}) + end. + +get_parent() -> + case get('$ancestors') of + [Parent | _] when is_pid(Parent) -> + Parent; + [Parent | _] when is_atom(Parent) -> + name_to_pid(Parent); + _ -> + exit(process_was_not_started_by_proc_lib) + end. + +name_to_pid(Name) -> + case whereis(Name) of + undefined -> + case global:whereis_name(Name) of + undefined -> + exit(could_not_find_registered_name); + Pid -> + Pid + end; + Pid -> + Pid + end. + timeout(Options) -> - case opt(timeout, Options) of - {ok, Time} -> + case lists:keyfind(timeout, 1, Options) of + {_,Time} -> Time; - _ -> + false -> infinity end. spawn_opts(Options) -> - case opt(spawn_opt, Options) of - {ok, Opts} -> + case lists:keyfind(spawn_opt, 1, Options) of + {_,Opts} -> Opts; - _ -> + false -> [] end. -opt(Op, [{Op, Value}|_]) -> - {ok, Value}; -opt(Op, [_|Options]) -> - opt(Op, Options); -opt(_, []) -> - false. - -debug_options(Opts) -> - case opt(debug, Opts) of - {ok, Options} -> sys:debug_options(Options); - _ -> [] +debug_options(Name, Opts) -> + case lists:keyfind(debug, 1, Opts) of + {_,Options} -> + try sys:debug_options(Options) + catch _:_ -> + error_logger:format( + "~p: ignoring erroneous debug options - ~p~n", + [Name,Options]), + [] + end; + false -> + [] end. format_status_header(TagLine, Pid) when is_pid(Pid) -> diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index 2b8ba86909..ccacf658e9 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -31,8 +32,8 @@ %%% Modified by Martin - uses proc_lib, sys and gen! --export([start/0, start/1, start_link/0, start_link/1, stop/1, notify/2, - sync_notify/2, +-export([start/0, start/1, start_link/0, start_link/1, stop/1, stop/3, + notify/2, sync_notify/2, add_handler/3, add_sup_handler/3, delete_handler/3, swap_handler/3, swap_sup_handler/3, which_handlers/1, call/3, call/4, wake_hib/4]). @@ -40,6 +41,8 @@ system_continue/3, system_terminate/4, system_code_change/4, + system_get_state/1, + system_replace_state/2, format_status/2]). -export_type([handler/0, handler_args/0, add_handler_ret/0, @@ -47,8 +50,6 @@ -import(error_logger, [error_msg/2]). --define(reply(X), From ! {element(2,Tag), X}). - -record(handler, {module :: atom(), id = false, state, @@ -99,6 +100,14 @@ -callback code_change(OldVsn :: (term() | {down, term()}), State :: term(), Extra :: term()) -> {ok, NewState :: term()}. +-callback format_status(Opt, StatusData) -> Status when + Opt :: 'normal' | 'terminate', + StatusData :: [PDict | State], + PDict :: [{Key :: term(), Value :: term()}], + State :: term(), + Status :: term(). + +-optional_callbacks([format_status/2]). %%--------------------------------------------------------------------------- @@ -138,16 +147,11 @@ init_it(Starter, self, Name, Mod, Args, Options) -> init_it(Starter, self(), Name, Mod, Args, Options); init_it(Starter, Parent, Name0, _, _, Options) -> process_flag(trap_exit, true), - Debug = gen:debug_options(Options), + Name = gen:name(Name0), + Debug = gen:debug_options(Name, Options), proc_lib:init_ack(Starter, {ok, self()}), - Name = name(Name0), loop(Parent, Name, [], Debug, false). -name({local,Name}) -> Name; -name({global,Name}) -> Name; -name({via,_, Name}) -> Name; -name(Pid) when is_pid(Pid) -> Pid. - -spec add_handler(emgr_ref(), handler(), term()) -> term(). add_handler(M, Handler, Args) -> rpc(M, {add_handler, Handler, Args}). @@ -183,7 +187,11 @@ swap_sup_handler(M, {H1, A1}, {H2, A2}) -> which_handlers(M) -> rpc(M, which_handlers). -spec stop(emgr_ref()) -> 'ok'. -stop(M) -> rpc(M, stop). +stop(M) -> + gen:stop(M). + +stop(M, Reason, Timeout) -> + gen:stop(M, Reason, Timeout). rpc(M, Cmd) -> {ok, Reply} = gen:call(M, self(), Cmd, infinity), @@ -247,49 +255,49 @@ handle_msg(Msg, Parent, ServerName, MSL, Debug) -> {notify, Event} -> {Hib,MSL1} = server_notify(Event, handle_event, MSL, ServerName), loop(Parent, ServerName, MSL1, Debug, Hib); - {From, Tag, {sync_notify, Event}} -> + {_From, Tag, {sync_notify, Event}} -> {Hib, MSL1} = server_notify(Event, handle_event, MSL, ServerName), - ?reply(ok), + reply(Tag, ok), loop(Parent, ServerName, MSL1, Debug, Hib); {'EXIT', From, Reason} -> MSL1 = handle_exit(From, Reason, MSL, ServerName), loop(Parent, ServerName, MSL1, Debug, false); - {From, Tag, {call, Handler, Query}} -> + {_From, Tag, {call, Handler, Query}} -> {Hib, Reply, MSL1} = server_call(Handler, Query, MSL, ServerName), - ?reply(Reply), + reply(Tag, Reply), loop(Parent, ServerName, MSL1, Debug, Hib); - {From, Tag, {add_handler, Handler, Args}} -> + {_From, Tag, {add_handler, Handler, Args}} -> {Hib, Reply, MSL1} = server_add_handler(Handler, Args, MSL), - ?reply(Reply), + reply(Tag, Reply), loop(Parent, ServerName, MSL1, Debug, Hib); - {From, Tag, {add_sup_handler, Handler, Args, SupP}} -> + {_From, Tag, {add_sup_handler, Handler, Args, SupP}} -> {Hib, Reply, MSL1} = server_add_sup_handler(Handler, Args, MSL, SupP), - ?reply(Reply), + reply(Tag, Reply), loop(Parent, ServerName, MSL1, Debug, Hib); - {From, Tag, {delete_handler, Handler, Args}} -> + {_From, Tag, {delete_handler, Handler, Args}} -> {Reply, MSL1} = server_delete_handler(Handler, Args, MSL, ServerName), - ?reply(Reply), + reply(Tag, Reply), loop(Parent, ServerName, MSL1, Debug, false); - {From, Tag, {swap_handler, Handler1, Args1, Handler2, Args2}} -> + {_From, Tag, {swap_handler, Handler1, Args1, Handler2, Args2}} -> {Hib, Reply, MSL1} = server_swap_handler(Handler1, Args1, Handler2, Args2, MSL, ServerName), - ?reply(Reply), + reply(Tag, Reply), loop(Parent, ServerName, MSL1, Debug, Hib); - {From, Tag, {swap_sup_handler, Handler1, Args1, Handler2, Args2, + {_From, Tag, {swap_sup_handler, Handler1, Args1, Handler2, Args2, Sup}} -> {Hib, Reply, MSL1} = server_swap_handler(Handler1, Args1, Handler2, Args2, MSL, Sup, ServerName), - ?reply(Reply), + reply(Tag, Reply), loop(Parent, ServerName, MSL1, Debug, Hib); - {From, Tag, stop} -> + {_From, Tag, stop} -> catch terminate_server(normal, Parent, MSL, ServerName), - ?reply(ok); - {From, Tag, which_handlers} -> - ?reply(the_handlers(MSL)), + reply(Tag, ok); + {_From, Tag, which_handlers} -> + reply(Tag, the_handlers(MSL)), loop(Parent, ServerName, MSL, Debug, false); - {From, Tag, get_modules} -> - ?reply(get_modules(MSL)), + {_From, Tag, get_modules} -> + reply(Tag, get_modules(MSL)), loop(Parent, ServerName, MSL, Debug, false); Other -> {Hib, MSL1} = server_notify(Other, handle_info, MSL, ServerName), @@ -301,6 +309,10 @@ terminate_server(Reason, Parent, MSL, ServerName) -> do_unlink(Parent, MSL), exit(Reason). +reply({From, Ref}, Msg) -> + From ! {Ref, Msg}, + ok. + %% unlink the supervisor process of all supervised handlers. %% We do not want a handler supervisor to EXIT due to the %% termination of the event manager (server). @@ -365,6 +377,23 @@ system_code_change([ServerName, MSL, Hib], Module, OldVsn, Extra) -> MSL), {ok, [ServerName, MSL1, Hib]}. +system_get_state([_ServerName, MSL, _Hib]) -> + {ok, [{Mod,Id,State} || #handler{module=Mod, id=Id, state=State} <- MSL]}. + +system_replace_state(StateFun, [ServerName, MSL, Hib]) -> + {NMSL, NStates} = + lists:unzip([begin + Cur = {Mod,Id,State}, + try + NState = {Mod,Id,NS} = StateFun(Cur), + {HS#handler{state=NS}, NState} + catch + _:_ -> + {HS, Cur} + end + end || #handler{module=Mod, id=Id, state=State}=HS <- MSL]), + {ok, NStates, [ServerName, NMSL, Hib]}. + %%----------------------------------------------------------------- %% Format debug messages. Print them as the call-back module sees %% them, not as the real erlang messages. Use trace for that. diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index e480e2ac11..6e7528fd98 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -106,6 +107,7 @@ -export([start/3, start/4, start_link/3, start_link/4, + stop/1, stop/3, send_event/2, sync_send_event/2, sync_send_event/3, send_all_state_event/2, sync_send_all_state_event/2, sync_send_all_state_event/3, @@ -118,6 +120,8 @@ system_continue/3, system_terminate/4, system_code_change/4, + system_get_state/1, + system_replace_state/2, format_status/2]). -import(error_logger, [format/2]). @@ -158,6 +162,14 @@ -callback code_change(OldVsn :: term() | {down, term()}, StateName :: atom(), StateData :: term(), Extra :: term()) -> {ok, NextStateName :: atom(), NewStateData :: term()}. +-callback format_status(Opt, StatusData) -> Status when + Opt :: 'normal' | 'terminate', + StatusData :: [PDict | State], + PDict :: [{Key :: term(), Value :: term()}], + State :: term(), + Status :: term(). + +-optional_callbacks([format_status/2]). %%% --------------------------------------------------- %%% Starts a generic state machine. @@ -187,6 +199,11 @@ start_link(Mod, Args, Options) -> start_link(Name, Mod, Args, Options) -> gen:start(?MODULE, link, Name, Mod, Args, Options). +stop(Name) -> + gen:stop(Name). + +stop(Name, Reason, Timeout) -> + gen:stop(Name, Reason, Timeout). send_event({global, Name}, Event) -> catch global:send(Name, {'$gen_event', Event}), @@ -288,64 +305,11 @@ enter_loop(Mod, Options, StateName, StateData, Timeout) -> enter_loop(Mod, Options, StateName, StateData, self(), Timeout). enter_loop(Mod, Options, StateName, StateData, ServerName, Timeout) -> - Name = get_proc_name(ServerName), - Parent = get_parent(), - Debug = gen:debug_options(Options), + Name = gen:get_proc_name(ServerName), + Parent = gen:get_parent(), + Debug = gen:debug_options(Name, Options), loop(Parent, Name, StateName, StateData, Mod, Timeout, Debug). -get_proc_name(Pid) when is_pid(Pid) -> - Pid; -get_proc_name({local, Name}) -> - case process_info(self(), registered_name) of - {registered_name, Name} -> - Name; - {registered_name, _Name} -> - exit(process_not_registered); - [] -> - exit(process_not_registered) - end; -get_proc_name({global, Name}) -> - case global:whereis_name(Name) of - undefined -> - exit(process_not_registered_globally); - Pid when Pid =:= self() -> - Name; - _Pid -> - exit(process_not_registered_globally) - end; -get_proc_name({via, Mod, Name}) -> - case Mod:whereis_name(Name) of - undefined -> - exit({process_not_registered_via, Mod}); - Pid when Pid =:= self() -> - Name; - _Pid -> - exit({process_not_registered_via, Mod}) - end. - -get_parent() -> - case get('$ancestors') of - [Parent | _] when is_pid(Parent) -> - Parent; - [Parent | _] when is_atom(Parent) -> - name_to_pid(Parent); - _ -> - exit(process_was_not_started_by_proc_lib) - end. - -name_to_pid(Name) -> - case whereis(Name) of - undefined -> - case global:whereis_name(Name) of - undefined -> - exit(could_not_find_registered_name); - Pid -> - Pid - end; - Pid -> - Pid - end. - %%% --------------------------------------------------- %%% Initiate the new process. %%% Register the name using the Rfunc function @@ -356,8 +320,8 @@ name_to_pid(Name) -> init_it(Starter, self, Name, Mod, Args, Options) -> init_it(Starter, self(), Name, Mod, Args, Options); init_it(Starter, Parent, Name0, Mod, Args, Options) -> - Name = name(Name0), - Debug = gen:debug_options(Options), + Name = gen:name(Name0), + Debug = gen:debug_options(Name, Options), case catch Mod:init(Args) of {ok, StateName, StateData} -> proc_lib:init_ack(Starter, {ok, self()}), @@ -366,15 +330,15 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) -> proc_lib:init_ack(Starter, {ok, self()}), loop(Parent, Name, StateName, StateData, Mod, Timeout, Debug); {stop, Reason} -> - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); ignore -> - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, ignore), exit(normal); {'EXIT', Reason} -> - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); Else -> @@ -383,20 +347,6 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) -> exit(Error) end. -name({local,Name}) -> Name; -name({global,Name}) -> Name; -name({via,_, Name}) -> Name; -name(Pid) when is_pid(Pid) -> Pid. - -unregister_name({local,Name}) -> - _ = (catch unregister(Name)); -unregister_name({global,Name}) -> - _ = global:unregister_name(Name); -unregister_name({via, Mod, Name}) -> - _ = Mod:unregister_name(Name); -unregister_name(Pid) when is_pid(Pid) -> - Pid. - %%----------------------------------------------------------------- %% The MAIN loop %%----------------------------------------------------------------- @@ -456,6 +406,13 @@ system_code_change([Name, StateName, StateData, Mod, Time], Else -> Else end. +system_get_state([_Name, StateName, StateData, _Mod, _Time]) -> + {ok, {StateName, StateData}}. + +system_replace_state(StateFun, [Name, StateName, StateData, Mod, Time]) -> + Result = {NStateName, NStateData} = StateFun({StateName, StateData}), + {ok, Result, [Name, NStateName, NStateData, Mod, Time]}. + %%----------------------------------------------------------------- %% Format debug messages. Print them as the call-back module sees %% them, not as the real erlang messages. Use trace for that. @@ -538,7 +495,7 @@ handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, Debug) -> {stop, Reason, Reply, NStateData} when From =/= undefined -> {'EXIT', R} = (catch terminate(Reason, Name, Msg, Mod, StateName, NStateData, Debug)), - reply(Name, From, Reply, Debug, StateName), + _ = reply(Name, From, Reply, Debug, StateName), exit(R); {'EXIT', What} -> terminate(What, Name, Msg, Mod, StateName, StateData, Debug); @@ -585,7 +542,8 @@ reply(Name, {To, Tag}, Reply, Debug, StateName) -> terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) -> case catch Mod:terminate(Reason, StateName, StateData) of {'EXIT', R} -> - error_info(R, Name, Msg, StateName, StateData, Debug), + FmtStateData = format_status(terminate, Mod, get(), StateData), + error_info(R, Name, Msg, StateName, FmtStateData, Debug), exit(R); _ -> case Reason of @@ -596,17 +554,7 @@ terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) -> {shutdown,_}=Shutdown -> exit(Shutdown); _ -> - FmtStateData = - case erlang:function_exported(Mod, format_status, 2) of - true -> - Args = [get(), StateData], - case catch Mod:format_status(terminate, Args) of - {'EXIT', _} -> StateData; - Else -> Else - end; - _ -> - StateData - end, + FmtStateData = format_status(terminate, Mod, get(), StateData), error_info(Reason,Name,Msg,StateName,FmtStateData,Debug), exit(Reason) end @@ -671,21 +619,29 @@ format_status(Opt, StatusData) -> Header = gen:format_status_header("Status for state machine", Name), Log = sys:get_debug(log, Debug, []), - DefaultStatus = [{data, [{"StateData", StateData}]}], - Specfic = - case erlang:function_exported(Mod, format_status, 2) of - true -> - case catch Mod:format_status(Opt,[PDict,StateData]) of - {'EXIT', _} -> DefaultStatus; - StatusList when is_list(StatusList) -> StatusList; - Else -> [Else] - end; - _ -> - DefaultStatus - end, + Specfic = format_status(Opt, Mod, PDict, StateData), + Specfic = case format_status(Opt, Mod, PDict, StateData) of + S when is_list(S) -> S; + S -> [S] + end, [{header, Header}, {data, [{"Status", SysState}, {"Parent", Parent}, {"Logged events", Log}, {"StateName", StateName}]} | Specfic]. + +format_status(Opt, Mod, PDict, State) -> + DefStatus = case Opt of + terminate -> State; + _ -> [{data, [{"StateData", State}]}] + end, + case erlang:function_exported(Mod, format_status, 2) of + true -> + case catch Mod:format_status(Opt, [PDict, State]) of + {'EXIT', _} -> DefStatus; + Else -> Else + end; + _ -> + DefStatus + end. diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index 04308a51b7..5800aca66f 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -88,6 +89,7 @@ %% API -export([start/3, start/4, start_link/3, start_link/4, + stop/1, stop/3, call/2, call/3, cast/2, reply/2, abcast/2, abcast/3, @@ -98,6 +100,8 @@ -export([system_continue/3, system_terminate/4, system_code_change/4, + system_get_state/1, + system_replace_state/2, format_status/2]). %% Internal exports @@ -124,7 +128,7 @@ {noreply, NewState :: term()} | {noreply, NewState :: term(), timeout() | hibernate} | {stop, Reason :: term(), NewState :: term()}. --callback handle_info(Info :: timeout() | term(), State :: term()) -> +-callback handle_info(Info :: timeout | term(), State :: term()) -> {noreply, NewState :: term()} | {noreply, NewState :: term(), timeout() | hibernate} | {stop, Reason :: term(), NewState :: term()}. @@ -135,6 +139,15 @@ -callback code_change(OldVsn :: (term() | {down, term()}), State :: term(), Extra :: term()) -> {ok, NewState :: term()} | {error, Reason :: term()}. +-callback format_status(Opt, StatusData) -> Status when + Opt :: 'normal' | 'terminate', + StatusData :: [PDict | State], + PDict :: [{Key :: term(), Value :: term()}], + State :: term(), + Status :: term(). + +-optional_callbacks([format_status/2]). + %%% ----------------------------------------------------------------- %%% Starts a generic server. @@ -166,6 +179,17 @@ start_link(Name, Mod, Args, Options) -> %% ----------------------------------------------------------------- +%% Stop a generic server and wait for it to terminate. +%% If the server is located at another node, that node will +%% be monitored. +%% ----------------------------------------------------------------- +stop(Name) -> + gen:stop(Name). + +stop(Name, Reason, Timeout) -> + gen:stop(Name, Reason, Timeout). + +%% ----------------------------------------------------------------- %% Make a call to a generic server. %% If the server is located at another node, that node will %% be monitored. @@ -217,7 +241,7 @@ reply({To, Tag}, Reply) -> catch To ! {Tag, Reply}. %% ----------------------------------------------------------------- -%% Asyncronous broadcast, returns nothing, it's just send'n prey +%% Asynchronous broadcast, returns nothing, it's just send 'n' pray %%----------------------------------------------------------------- abcast(Name, Request) when is_atom(Name) -> do_abcast([node() | nodes()], Name, cast_msg(Request)). @@ -280,9 +304,9 @@ enter_loop(Mod, Options, State, Timeout) -> enter_loop(Mod, Options, State, self(), Timeout). enter_loop(Mod, Options, State, ServerName, Timeout) -> - Name = get_proc_name(ServerName), - Parent = get_parent(), - Debug = debug_options(Name, Options), + Name = gen:get_proc_name(ServerName), + Parent = gen:get_parent(), + Debug = gen:debug_options(Name, Options), loop(Parent, Name, State, Mod, Timeout, Debug). %%%======================================================================== @@ -299,8 +323,8 @@ enter_loop(Mod, Options, State, ServerName, Timeout) -> init_it(Starter, self, Name, Mod, Args, Options) -> init_it(Starter, self(), Name, Mod, Args, Options); init_it(Starter, Parent, Name0, Mod, Args, Options) -> - Name = name(Name0), - Debug = debug_options(Name, Options), + Name = gen:name(Name0), + Debug = gen:debug_options(Name, Options), case catch Mod:init(Args) of {ok, State} -> proc_lib:init_ack(Starter, {ok, self()}), @@ -315,15 +339,15 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) -> %% (Otherwise, the parent process could get %% an 'already_started' error if it immediately %% tried starting the process again.) - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); ignore -> - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, ignore), exit(normal); {'EXIT', Reason} -> - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); Else -> @@ -332,20 +356,6 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) -> exit(Error) end. -name({local,Name}) -> Name; -name({global,Name}) -> Name; -name({via,_, Name}) -> Name; -name(Pid) when is_pid(Pid) -> Pid. - -unregister_name({local,Name}) -> - _ = (catch unregister(Name)); -unregister_name({global,Name}) -> - _ = global:unregister_name(Name); -unregister_name({via, Mod, Name}) -> - _ = Mod:unregister_name(Name); -unregister_name(Pid) when is_pid(Pid) -> - Pid. - %%%======================================================================== %%% Internal functions %%%======================================================================== @@ -386,7 +396,7 @@ decode_msg(Msg, Parent, Name, State, Mod, Time, Debug, Hib) -> end. %%% --------------------------------------------------- -%%% Send/recive functions +%%% Send/receive functions %%% --------------------------------------------------- do_send(Dest, Msg) -> case catch erlang:send(Dest, Msg, [noconnect]) of @@ -465,11 +475,11 @@ rec_nodes(Tag, [{N,R}|Tail], Name, Badnodes, Replies, Time, TimerId ) -> {'DOWN', R, _, _, _} -> rec_nodes(Tag, Tail, Name, [N|Badnodes], Replies, Time, TimerId); {{Tag, N}, Reply} -> %% Tag is bound !!! - unmonitor(R), + erlang:demonitor(R, [flush]), rec_nodes(Tag, Tail, Name, Badnodes, [{N,Reply}|Replies], Time, TimerId); {timeout, TimerId, _} -> - unmonitor(R), + erlang:demonitor(R, [flush]), %% Collect all replies that already have arrived rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies) end; @@ -520,10 +530,10 @@ rec_nodes_rest(Tag, [{N,R}|Tail], Name, Badnodes, Replies) -> {'DOWN', R, _, _, _} -> rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies); {{Tag, N}, Reply} -> %% Tag is bound !!! - unmonitor(R), + erlang:demonitor(R, [flush]), rec_nodes_rest(Tag, Tail, Name, Badnodes, [{N,Reply}|Replies]) after 0 -> - unmonitor(R), + erlang:demonitor(R, [flush]), rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies) end; rec_nodes_rest(Tag, [N|Tail], Name, Badnodes, Replies) -> @@ -565,38 +575,88 @@ start_monitor(Node, Name) when is_atom(Node), is_atom(Name) -> end end. -%% Cancels a monitor started with Ref=erlang:monitor(_, _). -unmonitor(Ref) when is_reference(Ref) -> - erlang:demonitor(Ref), - receive - {'DOWN', Ref, _, _, _} -> - true - after 0 -> - true +%% --------------------------------------------------- +%% Helper functions for try-catch of callbacks. +%% Returns the return value of the callback, or +%% {'EXIT', ExitReason, ReportReason} (if an exception occurs) +%% +%% ExitReason is the reason that shall be used when the process +%% terminates. +%% +%% ReportReason is the reason that shall be printed in the error +%% report. +%% +%% These functions are introduced in order to add the stack trace in +%% the error report produced when a callback is terminated with +%% erlang:exit/1 (OTP-12263). +%% --------------------------------------------------- + +try_dispatch({'$gen_cast', Msg}, Mod, State) -> + try_dispatch(Mod, handle_cast, Msg, State); +try_dispatch(Info, Mod, State) -> + try_dispatch(Mod, handle_info, Info, State). + +try_dispatch(Mod, Func, Msg, State) -> + try + {ok, Mod:Func(Msg, State)} + catch + throw:R -> + {ok, R}; + error:R -> + Stacktrace = erlang:get_stacktrace(), + {'EXIT', {R, Stacktrace}, {R, Stacktrace}}; + exit:R -> + Stacktrace = erlang:get_stacktrace(), + {'EXIT', R, {R, Stacktrace}} + end. + +try_handle_call(Mod, Msg, From, State) -> + try + {ok, Mod:handle_call(Msg, From, State)} + catch + throw:R -> + {ok, R}; + error:R -> + Stacktrace = erlang:get_stacktrace(), + {'EXIT', {R, Stacktrace}, {R, Stacktrace}}; + exit:R -> + Stacktrace = erlang:get_stacktrace(), + {'EXIT', R, {R, Stacktrace}} end. +try_terminate(Mod, Reason, State) -> + try + {ok, Mod:terminate(Reason, State)} + catch + throw:R -> + {ok, R}; + error:R -> + Stacktrace = erlang:get_stacktrace(), + {'EXIT', {R, Stacktrace}, {R, Stacktrace}}; + exit:R -> + Stacktrace = erlang:get_stacktrace(), + {'EXIT', R, {R, Stacktrace}} + end. + + %%% --------------------------------------------------- %%% Message handling functions %%% --------------------------------------------------- -dispatch({'$gen_cast', Msg}, Mod, State) -> - Mod:handle_cast(Msg, State); -dispatch(Info, Mod, State) -> - Mod:handle_info(Info, State). - handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod) -> - case catch Mod:handle_call(Msg, From, State) of - {reply, Reply, NState} -> + Result = try_handle_call(Mod, Msg, From, State), + case Result of + {ok, {reply, Reply, NState}} -> reply(From, Reply), loop(Parent, Name, NState, Mod, infinity, []); - {reply, Reply, NState, Time1} -> + {ok, {reply, Reply, NState, Time1}} -> reply(From, Reply), loop(Parent, Name, NState, Mod, Time1, []); - {noreply, NState} -> + {ok, {noreply, NState}} -> loop(Parent, Name, NState, Mod, infinity, []); - {noreply, NState, Time1} -> + {ok, {noreply, NState, Time1}} -> loop(Parent, Name, NState, Mod, Time1, []); - {stop, Reason, Reply, NState} -> + {ok, {stop, Reason, Reply, NState}} -> {'EXIT', R} = (catch terminate(Reason, Name, Msg, Mod, NState, [])), reply(From, Reply), @@ -604,67 +664,68 @@ handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod) -> Other -> handle_common_reply(Other, Parent, Name, Msg, Mod, State) end; handle_msg(Msg, Parent, Name, State, Mod) -> - Reply = (catch dispatch(Msg, Mod, State)), + Reply = try_dispatch(Msg, Mod, State), handle_common_reply(Reply, Parent, Name, Msg, Mod, State). handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, Debug) -> - case catch Mod:handle_call(Msg, From, State) of - {reply, Reply, NState} -> + Result = try_handle_call(Mod, Msg, From, State), + case Result of + {ok, {reply, Reply, NState}} -> Debug1 = reply(Name, From, Reply, NState, Debug), loop(Parent, Name, NState, Mod, infinity, Debug1); - {reply, Reply, NState, Time1} -> + {ok, {reply, Reply, NState, Time1}} -> Debug1 = reply(Name, From, Reply, NState, Debug), loop(Parent, Name, NState, Mod, Time1, Debug1); - {noreply, NState} -> + {ok, {noreply, NState}} -> Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {noreply, NState}), loop(Parent, Name, NState, Mod, infinity, Debug1); - {noreply, NState, Time1} -> + {ok, {noreply, NState, Time1}} -> Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {noreply, NState}), loop(Parent, Name, NState, Mod, Time1, Debug1); - {stop, Reason, Reply, NState} -> + {ok, {stop, Reason, Reply, NState}} -> {'EXIT', R} = (catch terminate(Reason, Name, Msg, Mod, NState, Debug)), - reply(Name, From, Reply, NState, Debug), + _ = reply(Name, From, Reply, NState, Debug), exit(R); Other -> handle_common_reply(Other, Parent, Name, Msg, Mod, State, Debug) end; handle_msg(Msg, Parent, Name, State, Mod, Debug) -> - Reply = (catch dispatch(Msg, Mod, State)), + Reply = try_dispatch(Msg, Mod, State), handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Debug). handle_common_reply(Reply, Parent, Name, Msg, Mod, State) -> case Reply of - {noreply, NState} -> + {ok, {noreply, NState}} -> loop(Parent, Name, NState, Mod, infinity, []); - {noreply, NState, Time1} -> + {ok, {noreply, NState, Time1}} -> loop(Parent, Name, NState, Mod, Time1, []); - {stop, Reason, NState} -> + {ok, {stop, Reason, NState}} -> terminate(Reason, Name, Msg, Mod, NState, []); - {'EXIT', What} -> - terminate(What, Name, Msg, Mod, State, []); - _ -> - terminate({bad_return_value, Reply}, Name, Msg, Mod, State, []) + {'EXIT', ExitReason, ReportReason} -> + terminate(ExitReason, ReportReason, Name, Msg, Mod, State, []); + {ok, BadReply} -> + terminate({bad_return_value, BadReply}, Name, Msg, Mod, State, []) end. handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Debug) -> case Reply of - {noreply, NState} -> + {ok, {noreply, NState}} -> Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {noreply, NState}), loop(Parent, Name, NState, Mod, infinity, Debug1); - {noreply, NState, Time1} -> + {ok, {noreply, NState, Time1}} -> Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {noreply, NState}), loop(Parent, Name, NState, Mod, Time1, Debug1); - {stop, Reason, NState} -> + {ok, {stop, Reason, NState}} -> terminate(Reason, Name, Msg, Mod, NState, Debug); - {'EXIT', What} -> - terminate(What, Name, Msg, Mod, State, Debug); - _ -> - terminate({bad_return_value, Reply}, Name, Msg, Mod, State, Debug) + {'EXIT', ExitReason, ReportReason} -> + terminate(ExitReason, ReportReason, Name, Msg, Mod, State, Debug); + {ok, BadReply} -> + terminate({bad_return_value, BadReply}, Name, Msg, Mod, State, Debug) end. reply(Name, {To, Tag}, Reply, State, Debug) -> @@ -690,6 +751,13 @@ system_code_change([Name, State, Mod, Time], _Module, OldVsn, Extra) -> Else -> Else end. +system_get_state([_Name, State, _Mod, _Time]) -> + {ok, State}. + +system_replace_state(StateFun, [Name, State, Mod, Time]) -> + NState = StateFun(State), + {ok, NState, [Name, NState, Mod, Time]}. + %%----------------------------------------------------------------- %% Format debug messages. Print them as the call-back module sees %% them, not as the real erlang messages. Use trace for that. @@ -718,13 +786,20 @@ print_event(Dev, Event, Name) -> %%% Terminate the server. %%% --------------------------------------------------- +-spec terminate(_, _, _, _, _, _) -> no_return(). terminate(Reason, Name, Msg, Mod, State, Debug) -> - case catch Mod:terminate(Reason, State) of - {'EXIT', R} -> - error_info(R, Name, Msg, State, Debug), - exit(R); + terminate(Reason, Reason, Name, Msg, Mod, State, Debug). + +-spec terminate(_, _, _, _, _, _, _) -> no_return(). +terminate(ExitReason, ReportReason, Name, Msg, Mod, State, Debug) -> + Reply = try_terminate(Mod, ExitReason, State), + case Reply of + {'EXIT', ExitReason1, ReportReason1} -> + FmtState = format_status(terminate, Mod, get(), State), + error_info(ReportReason1, Name, Msg, FmtState, Debug), + exit(ExitReason1); _ -> - case Reason of + case ExitReason of normal -> exit(normal); shutdown -> @@ -732,19 +807,9 @@ terminate(Reason, Name, Msg, Mod, State, Debug) -> {shutdown,_}=Shutdown -> exit(Shutdown); _ -> - FmtState = - case erlang:function_exported(Mod, format_status, 2) of - true -> - Args = [get(), State], - case catch Mod:format_status(terminate, Args) of - {'EXIT', _} -> State; - Else -> Else - end; - _ -> - State - end, - error_info(Reason, Name, Msg, FmtState, Debug), - exit(Reason) + FmtState = format_status(terminate, Mod, get(), State), + error_info(ReportReason, Name, Msg, FmtState, Debug), + exit(ExitReason) end end. @@ -779,120 +844,34 @@ error_info(Reason, Name, Msg, State, Debug) -> sys:print_log(Debug), ok. -%%% --------------------------------------------------- -%%% Misc. functions. -%%% --------------------------------------------------- - -opt(Op, [{Op, Value}|_]) -> - {ok, Value}; -opt(Op, [_|Options]) -> - opt(Op, Options); -opt(_, []) -> - false. - -debug_options(Name, Opts) -> - case opt(debug, Opts) of - {ok, Options} -> dbg_options(Name, Options); - _ -> dbg_options(Name, []) - end. - -dbg_options(Name, []) -> - Opts = - case init:get_argument(generic_debug) of - error -> - []; - _ -> - [log, statistics] - end, - dbg_opts(Name, Opts); -dbg_options(Name, Opts) -> - dbg_opts(Name, Opts). - -dbg_opts(Name, Opts) -> - case catch sys:debug_options(Opts) of - {'EXIT',_} -> - format("~p: ignoring erroneous debug options - ~p~n", - [Name, Opts]), - []; - Dbg -> - Dbg - end. - -get_proc_name(Pid) when is_pid(Pid) -> - Pid; -get_proc_name({local, Name}) -> - case process_info(self(), registered_name) of - {registered_name, Name} -> - Name; - {registered_name, _Name} -> - exit(process_not_registered); - [] -> - exit(process_not_registered) - end; -get_proc_name({global, Name}) -> - case global:whereis_name(Name) of - undefined -> - exit(process_not_registered_globally); - Pid when Pid =:= self() -> - Name; - _Pid -> - exit(process_not_registered_globally) - end; -get_proc_name({via, Mod, Name}) -> - case Mod:whereis_name(Name) of - undefined -> - exit({process_not_registered_via, Mod}); - Pid when Pid =:= self() -> - Name; - _Pid -> - exit({process_not_registered_via, Mod}) - end. - -get_parent() -> - case get('$ancestors') of - [Parent | _] when is_pid(Parent)-> - Parent; - [Parent | _] when is_atom(Parent)-> - name_to_pid(Parent); - _ -> - exit(process_was_not_started_by_proc_lib) - end. - -name_to_pid(Name) -> - case whereis(Name) of - undefined -> - case global:whereis_name(Name) of - undefined -> - exit(could_not_find_registered_name); - Pid -> - Pid - end; - Pid -> - Pid - end. - %%----------------------------------------------------------------- %% Status information %%----------------------------------------------------------------- format_status(Opt, StatusData) -> [PDict, SysState, Parent, Debug, [Name, State, Mod, _Time]] = StatusData, - Header = gen:format_status_header("Status for generic server", - Name), + Header = gen:format_status_header("Status for generic server", Name), Log = sys:get_debug(log, Debug, []), - DefaultStatus = [{data, [{"State", State}]}], - Specfic = - case erlang:function_exported(Mod, format_status, 2) of - true -> - case catch Mod:format_status(Opt, [PDict, State]) of - {'EXIT', _} -> DefaultStatus; - StatusList when is_list(StatusList) -> StatusList; - Else -> [Else] - end; - _ -> - DefaultStatus - end, + Specfic = case format_status(Opt, Mod, PDict, State) of + S when is_list(S) -> S; + S -> [S] + end, [{header, Header}, {data, [{"Status", SysState}, {"Parent", Parent}, {"Logged events", Log}]} | Specfic]. + +format_status(Opt, Mod, PDict, State) -> + DefStatus = case Opt of + terminate -> State; + _ -> [{data, [{"State", State}]}] + end, + case erlang:function_exported(Mod, format_status, 2) of + true -> + case catch Mod:format_status(Opt, [PDict, State]) of + {'EXIT', _} -> DefStatus; + Else -> Else + end; + _ -> + DefStatus + end. diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl new file mode 100644 index 0000000000..018aca90e6 --- /dev/null +++ b/lib/stdlib/src/gen_statem.erl @@ -0,0 +1,1664 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(gen_statem). + +%% API +-export( + [start/3,start/4,start_link/3,start_link/4, + stop/1,stop/3, + cast/2,call/2,call/3, + enter_loop/4,enter_loop/5,enter_loop/6, + reply/1,reply/2]). + +%% gen callbacks +-export( + [init_it/6]). + +%% sys callbacks +-export( + [system_continue/3, + system_terminate/4, + system_code_change/4, + system_get_state/1, + system_replace_state/2, + format_status/2]). + +%% Internal callbacks +-export( + [wakeup_from_hibernate/3]). + +%% Type exports for templates and callback modules +-export_type( + [event_type/0, + init_result/0, + callback_mode_result/0, + state_function_result/0, + handle_event_result/0, + state_enter_result/1, + event_handler_result/1, + reply_action/0, + enter_action/0, + action/0]). + +%% Type that is exported just to be documented +-export_type([transition_option/0]). + +%%%========================================================================== +%%% Interface functions. +%%%========================================================================== + +-type from() :: + {To :: pid(), Tag :: term()}. % Reply-to specifier for call + +-type state() :: + state_name() | % For StateName/3 callback functions + term(). % For handle_event/4 callback function + +-type state_name() :: atom(). + +-type data() :: term(). + +-type event_type() :: + {'call',From :: from()} | 'cast' | + 'info' | 'timeout' | 'state_timeout' | 'internal'. + +-type callback_mode_result() :: + callback_mode() | [callback_mode() | state_enter()]. +-type callback_mode() :: 'state_functions' | 'handle_event_function'. +-type state_enter() :: 'state_enter'. + +-type transition_option() :: + postpone() | hibernate() | + event_timeout() | state_timeout(). +-type postpone() :: + %% If 'true' postpone the current event + %% and retry it when the state changes (=/=) + boolean(). +-type hibernate() :: + %% If 'true' hibernate the server instead of going into receive + boolean(). +-type event_timeout() :: + %% Generate a ('timeout', EventContent, ...) event after Time + %% unless some other event is delivered + Time :: timeout(). +-type state_timeout() :: + %% Generate a ('state_timeout', EventContent, ...) event after Time + %% unless the state is changed + Time :: timeout(). + +-type action() :: + %% During a state change: + %% * NextState and NewData are set. + %% * All action()s are executed in order of apperance. + %% * Postponing the current event is performed + %% iff 'postpone' is 'true'. + %% * A state timeout is started iff 'timeout' is set. + %% * Pending events are handled or if there are + %% no pending events the server goes into receive + %% or hibernate (iff 'hibernate' is 'true') + %% + %% These action()s are executed in order of appearence + %% in the containing list. The ones that set options + %% will override any previous so the last of each kind wins. + %% + 'postpone' | % Set the postpone option + {'postpone', Postpone :: postpone()} | + %% + %% All 'next_event' events are kept in a list and then + %% inserted at state changes so the first in the + %% action() list is the first to be delivered. + {'next_event', % Insert event as the next to handle + EventType :: event_type(), + EventContent :: term()} | + enter_action(). +-type enter_action() :: + 'hibernate' | % Set the hibernate option + {'hibernate', Hibernate :: hibernate()} | + %% + (Timeout :: event_timeout()) | % {timeout,Timeout} + {'timeout', % Set the event_timeout option + Time :: event_timeout(), EventContent :: term()} | + {'state_timeout', % Set the state_timeout option + Time :: state_timeout(), EventContent :: term()} | + %% + reply_action(). +-type reply_action() :: + {'reply', % Reply to a caller + From :: from(), Reply :: term()}. + +-type init_result() :: + {ok, state(), data()} | + {ok, state(), data(), [action()] | action()} | + 'ignore' | + {'stop', Reason :: term()}. + +%% Old, not advertised +-type state_function_result() :: + event_handler_result(state_name()). +-type handle_event_result() :: + event_handler_result(state()). +%% +-type state_enter_result(State) :: + {'next_state', % {next_state,NextState,NewData,[]} + State, + NewData :: data()} | + {'next_state', % State transition, maybe to the same state + State, + NewData :: data(), + Actions :: [enter_action()] | enter_action()} | + state_callback_result(enter_action()). +-type event_handler_result(StateType) :: + {'next_state', % {next_state,NextState,NewData,[]} + NextState :: StateType, + NewData :: data()} | + {'next_state', % State transition, maybe to the same state + NextState :: StateType, + NewData :: data(), + Actions :: [action()] | action()} | + state_callback_result(action()). +-type state_callback_result(ActionType) :: + {'keep_state', % {keep_state,NewData,[]} + NewData :: data()} | + {'keep_state', % Keep state, change data + NewData :: data(), + Actions :: [ActionType] | ActionType} | + 'keep_state_and_data' | % {keep_state_and_data,[]} + {'keep_state_and_data', % Keep state and data -> only actions + Actions :: [ActionType] | ActionType} | + 'stop' | % {stop,normal} + {'stop', % Stop the server + Reason :: term()} | + {'stop', % Stop the server + Reason :: term(), + NewData :: data()} | + {'stop_and_reply', % Reply then stop the server + Reason :: term(), + Replies :: [reply_action()] | reply_action()} | + {'stop_and_reply', % Reply then stop the server + Reason :: term(), + Replies :: [reply_action()] | reply_action(), + NewData :: data()}. + + +%% The state machine init function. It is called only once and +%% the server is not running until this function has returned +%% an {ok, ...} tuple. Thereafter the state callbacks are called +%% for all events to this server. +-callback init(Args :: term()) -> init_result(). + +%% This callback shall return the callback mode of the callback module. +%% +%% It is called once after init/0 and code_change/4 but before +%% the first state callback StateName/3 or handle_event/4. +-callback callback_mode() -> callback_mode_result(). + +%% Example state callback for StateName = 'state_name' +%% when callback_mode() =:= state_functions. +%% +%% In this mode all states has to be of type state_name() i.e atom(). +%% +%% Note that the only callbacks that have arity 3 are these +%% StateName/3 callbacks and terminate/3, so the state name +%% 'terminate' is unusable in this mode. +-callback state_name( + 'enter', + OldStateName :: state_name(), + Data :: data()) -> + state_enter_result('state_name'); + (event_type(), + EventContent :: term(), + Data :: data()) -> + event_handler_result(state_name()). +%% +%% State callback for all states +%% when callback_mode() =:= handle_event_function. +-callback handle_event( + 'enter', + OldState :: state(), + State, % Current state + Data :: data()) -> + state_enter_result(State); + (event_type(), + EventContent :: term(), + State :: state(), % Current state + Data :: data()) -> + event_handler_result(state()). + +%% Clean up before the server terminates. +-callback terminate( + Reason :: 'normal' | 'shutdown' | {'shutdown', term()} + | term(), + State :: state(), + Data :: data()) -> + any(). + +%% Note that the new code can expect to get an OldState from +%% the old code version not only in code_change/4 but in the first +%% state callback function called thereafter +-callback code_change( + OldVsn :: term() | {'down', term()}, + OldState :: state(), + OldData :: data(), + Extra :: term()) -> + {ok, NewState :: state(), NewData :: data()} | + (Reason :: term()). + +%% Format the callback module state in some sensible that is +%% often condensed way. For StatusOption =:= 'normal' the perferred +%% return term is [{data,[{"State",FormattedState}]}], and for +%% StatusOption =:= 'terminate' it is just FormattedState. +-callback format_status( + StatusOption, + [ [{Key :: term(), Value :: term()}] | + state() | + data()]) -> + Status :: term() when + StatusOption :: 'normal' | 'terminate'. + +-optional_callbacks( + [init/1, % One may use enter_loop/5,6,7 instead + format_status/2, % Has got a default implementation + %% + state_name/3, % Example for callback_mode() =:= state_functions: + %% there has to be a StateName/3 callback function + %% for every StateName in your state machine but the state name + %% 'state_name' does of course not have to be used. + %% + handle_event/4 % For callback_mode() =:= handle_event_function + ]). + +%% Type validation functions +callback_mode(CallbackMode) -> + case CallbackMode of + state_functions -> + true; + handle_event_function -> + true; + _ -> + false + end. +%% +from({Pid,_}) when is_pid(Pid) -> + true; +from(_) -> + false. +%% +event_type({call,From}) -> + from(From); +event_type(Type) -> + case Type of + cast -> + true; + info -> + true; + timeout -> + true; + internal -> + true; + _ -> + false + end. + + + +-define( + STACKTRACE(), + try throw(ok) catch _ -> erlang:get_stacktrace() end). + +%%%========================================================================== +%%% API + +-type server_name() :: + {'global', GlobalName :: term()} + | {'via', RegMod :: module(), Name :: term()} + | {'local', atom()}. +-type server_ref() :: + pid() + | (LocalName :: atom()) + | {Name :: atom(), Node :: atom()} + | {'global', GlobalName :: term()} + | {'via', RegMod :: module(), ViaName :: term()}. +-type debug_opt() :: + {'debug', + Dbgs :: + ['trace' | 'log' | 'statistics' | 'debug' + | {'logfile', string()}]}. +-type start_opt() :: + debug_opt() + | {'timeout', Time :: timeout()} + | {'spawn_opt', [proc_lib:spawn_option()]}. +-type start_ret() :: {'ok', pid()} | 'ignore' | {'error', term()}. + + + +%% Start a state machine +-spec start( + Module :: module(), Args :: term(), Opts :: [start_opt()]) -> + start_ret(). +start(Module, Args, Opts) -> + gen:start(?MODULE, nolink, Module, Args, Opts). +%% +-spec start( + ServerName :: server_name(), + Module :: module(), Args :: term(), Opts :: [start_opt()]) -> + start_ret(). +start(ServerName, Module, Args, Opts) -> + gen:start(?MODULE, nolink, ServerName, Module, Args, Opts). + +%% Start and link to a state machine +-spec start_link( + Module :: module(), Args :: term(), Opts :: [start_opt()]) -> + start_ret(). +start_link(Module, Args, Opts) -> + gen:start(?MODULE, link, Module, Args, Opts). +%% +-spec start_link( + ServerName :: server_name(), + Module :: module(), Args :: term(), Opts :: [start_opt()]) -> + start_ret(). +start_link(ServerName, Module, Args, Opts) -> + gen:start(?MODULE, link, ServerName, Module, Args, Opts). + +%% Stop a state machine +-spec stop(ServerRef :: server_ref()) -> ok. +stop(ServerRef) -> + gen:stop(ServerRef). +%% +-spec stop( + ServerRef :: server_ref(), + Reason :: term(), + Timeout :: timeout()) -> ok. +stop(ServerRef, Reason, Timeout) -> + gen:stop(ServerRef, Reason, Timeout). + +%% Send an event to a state machine that arrives with type 'event' +-spec cast(ServerRef :: server_ref(), Msg :: term()) -> ok. +cast({global,Name}, Msg) -> + try global:send(Name, wrap_cast(Msg)) of + _ -> ok + catch + _:_ -> ok + end; +cast({via,RegMod,Name}, Msg) -> + try RegMod:send(Name, wrap_cast(Msg)) of + _ -> ok + catch + _:_ -> ok + end; +cast({Name,Node} = ServerRef, Msg) when is_atom(Name), is_atom(Node) -> + send(ServerRef, wrap_cast(Msg)); +cast(ServerRef, Msg) when is_atom(ServerRef) -> + send(ServerRef, wrap_cast(Msg)); +cast(ServerRef, Msg) when is_pid(ServerRef) -> + send(ServerRef, wrap_cast(Msg)). + +%% Call a state machine (synchronous; a reply is expected) that +%% arrives with type {call,From} +-spec call(ServerRef :: server_ref(), Request :: term()) -> Reply :: term(). +call(ServerRef, Request) -> + call(ServerRef, Request, infinity). +%% +-spec call( + ServerRef :: server_ref(), + Request :: term(), + Timeout :: + timeout() | + {'clean_timeout',T :: timeout()} | + {'dirty_timeout',T :: timeout()}) -> + Reply :: term(). +call(ServerRef, Request, Timeout) -> + case parse_timeout(Timeout) of + {dirty_timeout,T} -> + try gen:call(ServerRef, '$gen_call', Request, T) of + {ok,Reply} -> + Reply + catch + Class:Reason -> + erlang:raise( + Class, + {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, + erlang:get_stacktrace()) + end; + {clean_timeout,T} -> + %% Call server through proxy process to dodge any late reply + Ref = make_ref(), + Self = self(), + Pid = spawn( + fun () -> + Self ! + try gen:call( + ServerRef, '$gen_call', Request, T) of + Result -> + {Ref,Result} + catch Class:Reason -> + {Ref,Class,Reason, + erlang:get_stacktrace()} + end + end), + Mref = monitor(process, Pid), + receive + {Ref,Result} -> + demonitor(Mref, [flush]), + case Result of + {ok,Reply} -> + Reply + end; + {Ref,Class,Reason,Stacktrace} -> + demonitor(Mref, [flush]), + erlang:raise( + Class, + {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, + Stacktrace); + {'DOWN',Mref,_,_,Reason} -> + %% There is a theoretical possibility that the + %% proxy process gets killed between try--of and ! + %% so this clause is in case of that + exit(Reason) + end; + Error when is_atom(Error) -> + erlang:error(Error, [ServerRef,Request,Timeout]) + end. + +parse_timeout(Timeout) -> + case Timeout of + {clean_timeout,infinity} -> + {dirty_timeout,infinity}; + {clean_timeout,_} -> + Timeout; + {dirty_timeout,_} -> + Timeout; + {_,_} -> + %% Be nice and throw a badarg for speling errors + badarg; + infinity -> + {dirty_timeout,infinity}; + T -> + {clean_timeout,T} + end. + +%% Reply from a state machine callback to whom awaits in call/2 +-spec reply([reply_action()] | reply_action()) -> ok. +reply({reply,From,Reply}) -> + reply(From, Reply); +reply(Replies) when is_list(Replies) -> + replies(Replies). +%% +-spec reply(From :: from(), Reply :: term()) -> ok. +reply({To,Tag}, Reply) when is_pid(To) -> + Msg = {Tag,Reply}, + try To ! Msg of + _ -> + ok + catch + _:_ -> ok + end. + +%% Instead of starting the state machine through start/3,4 +%% or start_link/3,4 turn the current process presumably +%% started by proc_lib into a state machine using +%% the same arguments as you would have returned from init/1 +-spec enter_loop( + Module :: module(), Opts :: [debug_opt()], + State :: state(), Data :: data()) -> + no_return(). +enter_loop(Module, Opts, State, Data) -> + enter_loop(Module, Opts, State, Data, self()). +%% +-spec enter_loop( + Module :: module(), Opts :: [debug_opt()], + State :: state(), Data :: data(), + Server_or_Actions :: + server_name() | pid() | [action()]) -> + no_return(). +enter_loop(Module, Opts, State, Data, Server_or_Actions) -> + if + is_list(Server_or_Actions) -> + enter_loop(Module, Opts, State, Data, self(), Server_or_Actions); + true -> + enter_loop(Module, Opts, State, Data, Server_or_Actions, []) + end. +%% +-spec enter_loop( + Module :: module(), Opts :: [debug_opt()], + State :: state(), Data :: data(), + Server :: server_name() | pid(), + Actions :: [action()] | action()) -> + no_return(). +enter_loop(Module, Opts, State, Data, Server, Actions) -> + is_atom(Module) orelse error({atom,Module}), + Parent = gen:get_parent(), + enter(Module, Opts, State, Data, Server, Actions, Parent). + +%%--------------------------------------------------------------------------- +%% API helpers + +wrap_cast(Event) -> + {'$gen_cast',Event}. + +replies([{reply,From,Reply}|Replies]) -> + reply(From, Reply), + replies(Replies); +replies([]) -> + ok. + +%% Might actually not send the message in case of caught exception +send(Proc, Msg) -> + try erlang:send(Proc, Msg, [noconnect]) of + noconnect -> + _ = spawn(erlang, send, [Proc,Msg]), + ok; + ok -> + ok + catch + _:_ -> + ok + end. + +%% Here the init_it/6 and enter_loop/5,6,7 functions converge +enter(Module, Opts, State, Data, Server, Actions, Parent) -> + %% The values should already have been type checked + Name = gen:get_proc_name(Server), + Debug = gen:debug_options(Name, Opts), + Events = [], + P = [], + Event = {internal,init_state}, + %% We enforce {postpone,false} to ensure that + %% our fake Event gets discarded, thought it might get logged + NewActions = + if + is_list(Actions) -> + Actions ++ [{postpone,false}]; + true -> + [Actions,{postpone,false}] + end, + S = #{ + callback_mode => undefined, + state_enter => false, + module => Module, + name => Name, + state => State, + data => Data, + postponed => P, + %% The rest of the fields are set from to the arguments to + %% loop_event_actions/10 when it finally loops back to loop/3 + %% in loop_events/10 + %% + %% Marker for initial state, cleared immediately when used + init_state => true + }, + NewDebug = sys_debug(Debug, S, State, {enter,Event,State}), + case call_callback_mode(S) of + {ok,NewS} -> + TimerRefs = #{}, + TimerTypes = #{}, + loop_event_actions( + Parent, NewDebug, NewS, TimerRefs, TimerTypes, + Events, Event, State, Data, NewActions); + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + NewDebug, S, [Event|Events]) + end. + +%%%========================================================================== +%%% gen callbacks + +init_it(Starter, self, ServerRef, Module, Args, Opts) -> + init_it(Starter, self(), ServerRef, Module, Args, Opts); +init_it(Starter, Parent, ServerRef, Module, Args, Opts) -> + try Module:init(Args) of + Result -> + init_result(Starter, Parent, ServerRef, Module, Result, Opts) + catch + Result -> + init_result(Starter, Parent, ServerRef, Module, Result, Opts); + Class:Reason -> + Stacktrace = erlang:get_stacktrace(), + Name = gen:get_proc_name(ServerRef), + gen:unregister_name(ServerRef), + proc_lib:init_ack(Starter, {error,Reason}), + error_info( + Class, Reason, Stacktrace, + #{name => Name, + callback_mode => undefined, + state_enter => false}, + [], [], undefined), + erlang:raise(Class, Reason, Stacktrace) + end. + +%%--------------------------------------------------------------------------- +%% gen callbacks helpers + +init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> + case Result of + {ok,State,Data} -> + proc_lib:init_ack(Starter, {ok,self()}), + enter(Module, Opts, State, Data, ServerRef, [], Parent); + {ok,State,Data,Actions} -> + proc_lib:init_ack(Starter, {ok,self()}), + enter(Module, Opts, State, Data, ServerRef, Actions, Parent); + {stop,Reason} -> + gen:unregister_name(ServerRef), + proc_lib:init_ack(Starter, {error,Reason}), + exit(Reason); + ignore -> + gen:unregister_name(ServerRef), + proc_lib:init_ack(Starter, ignore), + exit(normal); + _ -> + Name = gen:get_proc_name(ServerRef), + gen:unregister_name(ServerRef), + Error = {bad_return_from_init,Result}, + proc_lib:init_ack(Starter, {error,Error}), + error_info( + error, Error, ?STACKTRACE(), + #{name => Name, + callback_mode => undefined, + state_enter => false}, + [], [], undefined), + exit(Error) + end. + +%%%========================================================================== +%%% sys callbacks + +system_continue(Parent, Debug, S) -> + loop(Parent, Debug, S). + +system_terminate(Reason, _Parent, Debug, S) -> + terminate( + exit, Reason, ?STACKTRACE(), + Debug, S, []). + +system_code_change( + #{module := Module, + state := State, + data := Data} = S, + _Mod, OldVsn, Extra) -> + case + try Module:code_change(OldVsn, State, Data, Extra) + catch + Result -> Result + end + of + {ok,NewState,NewData} -> + {ok, + S#{callback_mode := undefined, + state := NewState, + data := NewData}}; + {ok,_} = Error -> + error({case_clause,Error}); + Error -> + Error + end. + +system_get_state(#{state := State, data := Data}) -> + {ok,{State,Data}}. + +system_replace_state( + StateFun, + #{state := State, + data := Data} = S) -> + {NewState,NewData} = Result = StateFun({State,Data}), + {ok,Result,S#{state := NewState, data := NewData}}. + +format_status( + Opt, + [PDict,SysState,Parent,Debug, + #{name := Name, postponed := P} = S]) -> + Header = gen:format_status_header("Status for state machine", Name), + Log = sys:get_debug(log, Debug, []), + [{header,Header}, + {data, + [{"Status",SysState}, + {"Parent",Parent}, + {"Logged Events",Log}, + {"Postponed",P}]} | + case format_status(Opt, PDict, S) of + L when is_list(L) -> L; + T -> [T] + end]. + +%%--------------------------------------------------------------------------- +%% Format debug messages. Print them as the call-back module sees +%% them, not as the real erlang messages. Use trace for that. +%%--------------------------------------------------------------------------- + +print_event(Dev, {in,Event}, {Name,State}) -> + io:format( + Dev, "*DBG* ~p receive ~s in state ~p~n", + [Name,event_string(Event),State]); +print_event(Dev, {out,Reply,{To,_Tag}}, {Name,State}) -> + io:format( + Dev, "*DBG* ~p send ~p to ~p from state ~p~n", + [Name,Reply,To,State]); +print_event(Dev, {terminate,Reason}, {Name,State}) -> + io:format( + Dev, "*DBG* ~p terminate ~p in state ~p~n", + [Name,Reason,State]); +print_event(Dev, {Tag,Event,NextState}, {Name,State}) -> + StateString = + case NextState of + State -> + io_lib:format("~p", [State]); + _ -> + io_lib:format("~p => ~p", [State,NextState]) + end, + io:format( + Dev, "*DBG* ~p ~w ~s in state ~s~n", + [Name,Tag,event_string(Event),StateString]). + +event_string(Event) -> + case Event of + {{call,{Pid,_Tag}},Request} -> + io_lib:format("call ~p from ~w", [Request,Pid]); + {EventType,EventContent} -> + io_lib:format("~w ~p", [EventType,EventContent]) + end. + +sys_debug(Debug, #{name := Name}, State, Entry) -> + case Debug of + [] -> + Debug; + _ -> + sys:handle_debug( + Debug, fun print_event/3, {Name,State}, Entry) + end. + +%%%========================================================================== +%%% Internal callbacks + +wakeup_from_hibernate(Parent, Debug, S) -> + %% It is a new message that woke us up so we have to receive it now + loop_receive(Parent, Debug, S). + +%%%========================================================================== +%%% State Machine engine implementation of proc_lib/gen server + +%% Server loop, consists of all loop* functions +%% and detours through sys:handle_system_message/7 and proc_lib:hibernate/3 + +%% Entry point for system_continue/3 +loop(Parent, Debug, #{hibernate := Hibernate} = S) -> + case Hibernate of + true -> + %% Does not return but restarts process at + %% wakeup_from_hibernate/3 that jumps to loop_receive/3 + proc_lib:hibernate( + ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]), + error( + {should_not_have_arrived_here_but_instead_in, + {wakeup_from_hibernate,3}}); + false -> + loop_receive(Parent, Debug, S) + end. + +%% Entry point for wakeup_from_hibernate/3 +loop_receive( + Parent, Debug, #{timer_refs := TimerRefs, timer_types := TimerTypes} = S) -> + receive + Msg -> + case Msg of + {system,Pid,Req} -> + #{hibernate := Hibernate} = S, + %% Does not return but tail recursively calls + %% system_continue/3 that jumps to loop/3 + sys:handle_system_msg( + Req, Pid, Parent, ?MODULE, Debug, S, Hibernate); + {'EXIT',Parent,Reason} = EXIT -> + %% EXIT is not a 2-tuple and therefore + %% not an event and has no event_type(), + %% but this will stand out in the crash report... + terminate( + exit, Reason, ?STACKTRACE(), Debug, S, [EXIT]); + {timeout,TimerRef,TimerMsg} -> + case TimerRefs of + #{TimerRef := TimerType} -> + Event = {TimerType,TimerMsg}, + %% Unregister the triggered timeout + loop_receive_result( + Parent, Debug, S, + maps:remove(TimerRef, TimerRefs), + maps:remove(TimerType, TimerTypes), + Event); + _ -> + Event = {info,Msg}, + loop_receive_result( + Parent, Debug, S, + TimerRefs, TimerTypes, Event) + end; + _ -> + Event = + case Msg of + {'$gen_call',From,Request} -> + {{call,From},Request}; + {'$gen_cast',E} -> + {cast,E}; + _ -> + {info,Msg} + end, + loop_receive_result( + Parent, Debug, S, + TimerRefs, TimerTypes, Event) + end + end. + +loop_receive_result( + Parent, Debug, #{state := State} = S, + TimerRefs, TimerTypes, Event) -> + %% The fields 'timer_refs', 'timer_types' and 'hibernate' + %% are now invalid in state map S - they will be recalculated + %% and restored when we return to loop/3 + %% + NewDebug = sys_debug(Debug, S, State, {in,Event}), + %% Here the queue of not yet handled events is created + Events = [], + Hibernate = false, + loop_event( + Parent, NewDebug, S, TimerRefs, TimerTypes, Events, Event, Hibernate). + +%% Entry point for handling an event, received or enqueued +loop_event( + Parent, Debug, #{state := State, data := Data} = S, TimerRefs, TimerTypes, + Events, {Type,Content} = Event, Hibernate) -> + %% + %% If Hibernate is true here it can only be + %% because it was set from an event action + %% and we did not go into hibernation since there + %% were events in queue, so we do what the user + %% might rely on i.e collect garbage which + %% would have happened if we actually hibernated + %% and immediately was awakened + Hibernate andalso garbage_collect(), + case call_state_function(S, Type, Content, State, Data) of + {ok,Result,NewS} -> + %% Cancel event timeout + {NewTimerRefs,NewTimerTypes} = + cancel_timer_by_type( + timeout, TimerRefs, TimerTypes), + {NewData,NextState,Actions} = + parse_event_result( + true, Debug, NewS, Result, + Events, Event, State, Data), + loop_event_actions( + Parent, Debug, S, NewTimerRefs, NewTimerTypes, + Events, Event, NextState, NewData, Actions); + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, Debug, S, [Event|Events]) + end. + +loop_event_actions( + Parent, Debug, + #{state := State, state_enter := StateEnter} = S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, Actions) -> + case parse_actions(Debug, S, State, Actions) of + {ok,NewDebug,Hibernate,TimeoutsR,Postpone,NextEventsR} -> + if + StateEnter, NextState =/= State -> + loop_event_enter( + Parent, NewDebug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR); + StateEnter -> + case maps:is_key(init_state, S) of + true -> + %% Avoid infinite loop in initial state + %% with state entry events + NewS = maps:remove(init_state, S), + loop_event_enter( + Parent, NewDebug, NewS, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR); + false -> + loop_event_result( + Parent, NewDebug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR) + end; + true -> + loop_event_result( + Parent, NewDebug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR) + end; + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + Debug, S#{data := NewData}, [Event|Events]) + end. + +loop_event_enter( + Parent, Debug, #{state := State} = S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR) -> + case call_state_function(S, enter, State, NextState, NewData) of + {ok,Result,NewS} -> + {NewerData,_,Actions} = + parse_event_result( + false, Debug, NewS, Result, + Events, Event, NextState, NewData), + loop_event_enter_actions( + Parent, Debug, NewS, TimerRefs, TimerTypes, + Events, Event, NextState, NewerData, + Hibernate, TimeoutsR, Postpone, NextEventsR, Actions); + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + Debug, S#{state := NextState, data := NewData}, + [Event|Events]) + end. + +loop_event_enter_actions( + Parent, Debug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR, Actions) -> + case + parse_enter_actions( + Debug, S, NextState, Actions, + Hibernate, TimeoutsR) + of + {ok,NewDebug,NewHibernate,NewTimeoutsR,_,_} -> + loop_event_result( + Parent, NewDebug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + NewHibernate, NewTimeoutsR, Postpone, NextEventsR); + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + Debug, S#{state := NextState, data := NewData}, + [Event|Events]) + end. + +loop_event_result( + Parent, Debug, + #{state := State, postponed := P_0} = S, TimerRefs_0, TimerTypes_0, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR) -> + %% + %% All options have been collected and next_events are buffered. + %% Do the actual state transition. + %% + {NewDebug,P_1} = % Move current event to postponed if Postpone + case Postpone of + true -> + {sys_debug(Debug, S, State, {postpone,Event,State}), + [Event|P_0]}; + false -> + {sys_debug(Debug, S, State, {consume,Event,State}), + P_0} + end, + {Events_1,NewP,{TimerRefs_1,TimerTypes_1}} = + %% Move all postponed events to queue and cancel the + %% state timeout if the state changes + if + NextState =:= State -> + {Events,P_1,{TimerRefs_0,TimerTypes_0}}; + true -> + {lists:reverse(P_1, Events),[], + cancel_timer_by_type( + state_timeout, TimerRefs_0, TimerTypes_0)} + end, + {TimerRefs_2,TimerTypes_2,TimeoutEvents} = + %% Stop and start timers non-event timers + parse_timers(TimerRefs_1, TimerTypes_1, TimeoutsR), + %% Place next events last in reversed queue + Events_2R = lists:reverse(Events_1, NextEventsR), + %% Enqueue immediate timeout events and start event timer + {NewTimerRefs,NewTimerTypes,Events_3R} = + process_timeout_events( + TimerRefs_2, TimerTypes_2, TimeoutEvents, Events_2R), + NewEvents = lists:reverse(Events_3R), + loop_events( + Parent, NewDebug, S, NewTimerRefs, NewTimerTypes, + NewEvents, Hibernate, NextState, NewData, NewP). + +%% Loop until out of enqueued events +%% +loop_events( + Parent, Debug, S, TimerRefs, TimerTypes, + [] = _Events, Hibernate, State, Data, P) -> + %% Update S and loop back to loop/3 to receive a new event + NewS = + S#{ + state := State, + data := Data, + postponed := P, + hibernate => Hibernate, + timer_refs => TimerRefs, + timer_types => TimerTypes}, + loop(Parent, Debug, NewS); +loop_events( + Parent, Debug, S, TimerRefs, TimerTypes, + [Event|Events], Hibernate, State, Data, P) -> + %% Update S and continue with enqueued events + NewS = + S#{ + state := State, + data := Data, + postponed := P}, + loop_event( + Parent, Debug, NewS, TimerRefs, TimerTypes, Events, Event, Hibernate). + + + +%%--------------------------------------------------------------------------- +%% Server loop helpers + +call_callback_mode(#{module := Module} = S) -> + try Module:callback_mode() of + CallbackMode -> + callback_mode_result(S, CallbackMode) + catch + CallbackMode -> + callback_mode_result(S, CallbackMode); + error:undef -> + %% Process undef to check for the simple mistake + %% of calling a nonexistent state function + %% to make the undef more precise + case erlang:get_stacktrace() of + [{Module,callback_mode,[]=Args,_} + |Stacktrace] -> + {error, + {undef_callback,{Module,callback_mode,Args}}, + Stacktrace}; + Stacktrace -> + {error,undef,Stacktrace} + end; + Class:Reason -> + {Class,Reason,erlang:get_stacktrace()} + end. + +callback_mode_result(S, CallbackMode) -> + case + parse_callback_mode( + if + is_atom(CallbackMode) -> + [CallbackMode]; + true -> + CallbackMode + end, undefined, false) + of + {undefined,_} -> + {error, + {bad_return_from_callback_mode,CallbackMode}, + ?STACKTRACE()}; + {CBMode,StateEnter} -> + {ok, + S#{ + callback_mode := CBMode, + state_enter := StateEnter}} + end. + +parse_callback_mode([], CBMode, StateEnter) -> + {CBMode,StateEnter}; +parse_callback_mode([H|T], CBMode, StateEnter) -> + case callback_mode(H) of + true -> + parse_callback_mode(T, H, StateEnter); + false -> + case H of + state_enter -> + parse_callback_mode(T, CBMode, true); + _ -> + {undefined,StateEnter} + end + end; +parse_callback_mode(_, _CBMode, StateEnter) -> + {undefined,StateEnter}. + + +call_state_function( + #{callback_mode := undefined} = S, + Type, Content, State, Data) -> + case call_callback_mode(S) of + {ok,NewS} -> + call_state_function(NewS, Type, Content, State, Data); + Error -> + Error + end; +call_state_function( + #{callback_mode := CallbackMode, + module := Module} = S, + Type, Content, State, Data) -> + try + case CallbackMode of + state_functions -> + erlang:apply(Module, State, [Type,Content,Data]); + handle_event_function -> + Module:handle_event(Type, Content, State, Data) + end + of + Result -> + {ok,Result,S} + catch + Result -> + {ok,Result,S}; + error:badarg -> + case erlang:get_stacktrace() of + [{erlang,apply, + [Module,State,[Type,Content,Data]=Args], + _} + |Stacktrace] + when CallbackMode =:= state_functions -> + %% We get here e.g if apply fails + %% due to State not being an atom + {error, + {undef_state_function,{Module,State,Args}}, + Stacktrace}; + Stacktrace -> + {error,badarg,Stacktrace} + end; + error:undef -> + %% Process undef to check for the simple mistake + %% of calling a nonexistent state function + %% to make the undef more precise + case erlang:get_stacktrace() of + [{Module,State,[Type,Content,Data]=Args,_} + |Stacktrace] + when CallbackMode =:= state_functions -> + {error, + {undef_state_function,{Module,State,Args}}, + Stacktrace}; + [{Module,handle_event,[Type,Content,State,Data]=Args,_} + |Stacktrace] + when CallbackMode =:= handle_event_function -> + {error, + {undef_state_function,{Module,handle_event,Args}}, + Stacktrace}; + Stacktrace -> + {error,undef,Stacktrace} + end; + Class:Reason -> + {Class,Reason,erlang:get_stacktrace()} + end. + + +%% Interpret all callback return variants +parse_event_result( + AllowStateChange, Debug, S, Result, Events, Event, State, Data) -> + case Result of + stop -> + terminate( + exit, normal, ?STACKTRACE(), Debug, S, [Event|Events]); + {stop,Reason} -> + terminate( + exit, Reason, ?STACKTRACE(), Debug, S, [Event|Events]); + {stop,Reason,NewData} -> + terminate( + exit, Reason, ?STACKTRACE(), + Debug, S#{data := NewData}, [Event|Events]); + {stop_and_reply,Reason,Replies} -> + Q = [Event|Events], + reply_then_terminate( + exit, Reason, ?STACKTRACE(), + Debug, S, Q, Replies); + {stop_and_reply,Reason,Replies,NewData} -> + Q = [Event|Events], + reply_then_terminate( + exit, Reason, ?STACKTRACE(), + Debug, S#{data := NewData}, Q, Replies); + {next_state,State,NewData} -> + {NewData,State,[]}; + {next_state,NextState,NewData} when AllowStateChange -> + {NewData,NextState,[]}; + {next_state,State,NewData,Actions} -> + {NewData,State,Actions}; + {next_state,NextState,NewData,Actions} when AllowStateChange -> + {NewData,NextState,Actions}; + {keep_state,NewData} -> + {NewData,State,[]}; + {keep_state,NewData,Actions} -> + {NewData,State,Actions}; + keep_state_and_data -> + {Data,State,[]}; + {keep_state_and_data,Actions} -> + {Data,State,Actions}; + _ -> + terminate( + error, + {bad_return_from_state_function,Result}, + ?STACKTRACE(), + Debug, S, [Event|Events]) + end. + + +parse_enter_actions( + Debug, S, State, Actions, + Hibernate, TimeoutsR) -> + Postpone = forbidden, + NextEventsR = forbidden, + parse_actions( + Debug, S, State, listify(Actions), + Hibernate, TimeoutsR, Postpone, NextEventsR). + +parse_actions(Debug, S, State, Actions) -> + Hibernate = false, + TimeoutsR = [], + Postpone = false, + NextEventsR = [], + parse_actions( + Debug, S, State, listify(Actions), + Hibernate, TimeoutsR, Postpone, NextEventsR). +%% +parse_actions( + Debug, _S, _State, [], + Hibernate, TimeoutsR, Postpone, NextEventsR) -> + {ok,Debug,Hibernate,TimeoutsR,Postpone,NextEventsR}; +parse_actions( + Debug, S, State, [Action|Actions], + Hibernate, TimeoutsR, Postpone, NextEventsR) -> + case Action of + %% Actual actions + {reply,From,Reply} -> + case from(From) of + true -> + NewDebug = do_reply(Debug, S, State, From, Reply), + parse_actions( + NewDebug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR); + false -> + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()} + end; + %% Actions that set options + {hibernate,NewHibernate} when is_boolean(NewHibernate) -> + parse_actions( + Debug, S, State, Actions, + NewHibernate, TimeoutsR, Postpone, NextEventsR); + {hibernate,_} -> + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()}; + hibernate -> + parse_actions( + Debug, S, State, Actions, + true, TimeoutsR, Postpone, NextEventsR); + {state_timeout,Time,_} = StateTimeout + when is_integer(Time), Time >= 0; + Time =:= infinity -> + parse_actions( + Debug, S, State, Actions, + Hibernate, [StateTimeout|TimeoutsR], Postpone, NextEventsR); + {state_timeout,_,_} -> + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()}; + {timeout,infinity,_} -> + %% Ignore - timeout will never happen and already cancelled + parse_actions( + Debug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR); + {timeout,Time,_} = Timeout when is_integer(Time), Time >= 0 -> + parse_actions( + Debug, S, State, Actions, + Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR); + {timeout,_,_} -> + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()}; + infinity -> % Ignore - timeout will never happen + parse_actions( + Debug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR); + Time when is_integer(Time), Time >= 0 -> + Timeout = {timeout,Time,Time}, + parse_actions( + Debug, S, State, Actions, + Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR); + {postpone,NewPostpone} + when is_boolean(NewPostpone), Postpone =/= forbidden -> + parse_actions( + Debug, S, State, Actions, + Hibernate, TimeoutsR, NewPostpone, NextEventsR); + {postpone,_} -> + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()}; + postpone when Postpone =/= forbidden -> + parse_actions( + Debug, S, State, Actions, + Hibernate, TimeoutsR, true, NextEventsR); + {next_event,Type,Content} -> + case event_type(Type) of + true when NextEventsR =/= forbidden -> + NewDebug = + sys_debug(Debug, S, State, {in,{Type,Content}}), + parse_actions( + NewDebug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, + [{Type,Content}|NextEventsR]); + _ -> + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()} + end; + _ -> + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()} + end. + + +%% Stop and start timers as well as create timeout zero events +%% and pending event timer +%% +%% Stop and start timers non-event timers +parse_timers(TimerRefs, TimerTypes, TimeoutsR) -> + parse_timers(TimerRefs, TimerTypes, TimeoutsR, #{}, []). +%% +parse_timers(TimerRefs, TimerTypes, [], _Seen, TimeoutEvents) -> + {TimerRefs,TimerTypes,TimeoutEvents}; +parse_timers( + TimerRefs, TimerTypes, [Timeout|TimeoutsR], Seen, TimeoutEvents) -> + {TimerType,Time,TimerMsg} = Timeout, + case Seen of + #{TimerType := _} -> + %% Type seen before - ignore + parse_timers( + TimerRefs, TimerTypes, TimeoutsR, Seen, TimeoutEvents); + #{} -> + %% Unseen type - handle + NewSeen = Seen#{TimerType => true}, + %% Cancel any running timer + {NewTimerRefs,NewTimerTypes} = + cancel_timer_by_type(TimerType, TimerRefs, TimerTypes), + if + Time =:= infinity -> + %% Ignore - timer will never fire + parse_timers( + NewTimerRefs, NewTimerTypes, TimeoutsR, + NewSeen, TimeoutEvents); + TimerType =:= timeout -> + %% Handle event timer later + parse_timers( + NewTimerRefs, NewTimerTypes, TimeoutsR, + NewSeen, [Timeout|TimeoutEvents]); + Time =:= 0 -> + %% Handle zero time timeouts later + TimeoutEvent = {TimerType,TimerMsg}, + parse_timers( + NewTimerRefs, NewTimerTypes, TimeoutsR, + NewSeen, [TimeoutEvent|TimeoutEvents]); + true -> + %% Start a new timer + TimerRef = erlang:start_timer(Time, self(), TimerMsg), + parse_timers( + NewTimerRefs#{TimerRef => TimerType}, + NewTimerTypes#{TimerType => TimerRef}, + TimeoutsR, NewSeen, TimeoutEvents) + end + end. + +%% Enqueue immediate timeout events and start event timer +process_timeout_events(TimerRefs, TimerTypes, [], EventsR) -> + {TimerRefs, TimerTypes, EventsR}; +process_timeout_events( + TimerRefs, TimerTypes, + [{timeout,0,TimerMsg}|TimeoutEvents], []) -> + %% No enqueued events - insert a timeout zero event + TimeoutEvent = {timeout,TimerMsg}, + process_timeout_events( + TimerRefs, TimerTypes, + TimeoutEvents, [TimeoutEvent]); +process_timeout_events( + TimerRefs, TimerTypes, + [{timeout,Time,TimerMsg}], []) -> + %% No enqueued events - start event timer + TimerRef = erlang:start_timer(Time, self(), TimerMsg), + process_timeout_events( + TimerRefs#{TimerRef => timeout}, TimerTypes#{timeout => TimerRef}, + [], []); +process_timeout_events( + TimerRefs, TimerTypes, + [{timeout,_Time,_TimerMsg}|TimeoutEvents], EventsR) -> + %% There will be some other event so optimize by not starting + %% an event timer to just have to cancel it again + process_timeout_events( + TimerRefs, TimerTypes, + TimeoutEvents, EventsR); +process_timeout_events( + TimerRefs, TimerTypes, + [{_TimeoutType,_TimeoutMsg} = TimeoutEvent|TimeoutEvents], EventsR) -> + process_timeout_events( + TimerRefs, TimerTypes, + TimeoutEvents, [TimeoutEvent|EventsR]). + + + +%%--------------------------------------------------------------------------- +%% Server helpers + +reply_then_terminate( + Class, Reason, Stacktrace, + Debug, #{state := State} = S, Q, Replies) -> + if + is_list(Replies) -> + do_reply_then_terminate( + Class, Reason, Stacktrace, + Debug, S, Q, Replies, State); + true -> + do_reply_then_terminate( + Class, Reason, Stacktrace, + Debug, S, Q, [Replies], State) + end. +%% +do_reply_then_terminate( + Class, Reason, Stacktrace, Debug, S, Q, [], _State) -> + terminate(Class, Reason, Stacktrace, Debug, S, Q); +do_reply_then_terminate( + Class, Reason, Stacktrace, Debug, S, Q, [R|Rs], State) -> + case R of + {reply,{_To,_Tag}=From,Reply} -> + NewDebug = do_reply(Debug, S, State, From, Reply), + do_reply_then_terminate( + Class, Reason, Stacktrace, NewDebug, S, Q, Rs, State); + _ -> + terminate( + error, + {bad_reply_action_from_state_function,R}, + ?STACKTRACE(), + Debug, S, Q) + end. + +do_reply(Debug, S, State, From, Reply) -> + reply(From, Reply), + sys_debug(Debug, S, State, {out,Reply,From}). + + +terminate( + Class, Reason, Stacktrace, + Debug, + #{module := Module, state := State, data := Data, postponed := P} = S, + Q) -> + try Module:terminate(Reason, State, Data) of + _ -> ok + catch + _ -> ok; + C:R -> + ST = erlang:get_stacktrace(), + error_info( + C, R, ST, S, Q, P, + format_status(terminate, get(), S)), + sys:print_log(Debug), + erlang:raise(C, R, ST) + end, + _ = + case Reason of + normal -> + sys_debug(Debug, S, State, {terminate,Reason}); + shutdown -> + sys_debug(Debug, S, State, {terminate,Reason}); + {shutdown,_} -> + sys_debug(Debug, S, State, {terminate,Reason}); + _ -> + error_info( + Class, Reason, Stacktrace, S, Q, P, + format_status(terminate, get(), S)), + sys:print_log(Debug) + end, + case Stacktrace of + [] -> + erlang:Class(Reason); + _ -> + erlang:raise(Class, Reason, Stacktrace) + end. + +error_info( + Class, Reason, Stacktrace, + #{name := Name, + callback_mode := CallbackMode, + state_enter := StateEnter}, + Q, P, FmtData) -> + {FixedReason,FixedStacktrace} = + case Stacktrace of + [{M,F,Args,_}|ST] + when Class =:= error, Reason =:= undef -> + case code:is_loaded(M) of + false -> + {{'module could not be loaded',M},ST}; + _ -> + Arity = + if + is_list(Args) -> + length(Args); + is_integer(Args) -> + Args + end, + case erlang:function_exported(M, F, Arity) of + true -> + {Reason,Stacktrace}; + false -> + {{'function not exported',{M,F,Arity}}, + ST} + end + end; + _ -> {Reason,Stacktrace} + end, + CBMode = + case StateEnter of + true -> + [CallbackMode,state_enter]; + false -> + CallbackMode + end, + error_logger:format( + "** State machine ~p terminating~n" ++ + case Q of + [] -> ""; + _ -> "** Last event = ~p~n" + end ++ + "** When server state = ~p~n" ++ + "** Reason for termination = ~w:~p~n" ++ + "** Callback mode = ~p~n" ++ + case Q of + [_,_|_] -> "** Queued = ~p~n"; + _ -> "" + end ++ + case P of + [] -> ""; + _ -> "** Postponed = ~p~n" + end ++ + case FixedStacktrace of + [] -> ""; + _ -> "** Stacktrace =~n** ~p~n" + end, + [Name | + case Q of + [] -> []; + [Event|_] -> [Event] + end] ++ + [FmtData, + Class,FixedReason, + CBMode] ++ + case Q of + [_|[_|_] = Events] -> [Events]; + _ -> [] + end ++ + case P of + [] -> []; + _ -> [P] + end ++ + case FixedStacktrace of + [] -> []; + _ -> [FixedStacktrace] + end). + + +%% Call Module:format_status/2 or return a default value +format_status( + Opt, PDict, + #{module := Module, state := State, data := Data}) -> + case erlang:function_exported(Module, format_status, 2) of + true -> + try Module:format_status(Opt, [PDict,State,Data]) + catch + Result -> Result; + _:_ -> + format_status_default( + Opt, State, + atom_to_list(Module) ++ ":format_status/2 crashed") + end; + false -> + format_status_default(Opt, State, Data) + end. + +%% The default Module:format_status/2 +format_status_default(Opt, State, Data) -> + StateData = {State,Data}, + case Opt of + terminate -> + StateData; + _ -> + [{data,[{"State",StateData}]}] + end. + +listify(Item) when is_list(Item) -> + Item; +listify(Item) -> + [Item]. + +%% Cancel timer if running, otherwise no op +cancel_timer_by_type(TimerType, TimerRefs, TimerTypes) -> + case TimerTypes of + #{TimerType := TimerRef} -> + cancel_timer(TimerRef), + {maps:remove(TimerRef, TimerRefs), + maps:remove(TimerType, TimerTypes)}; + #{} -> + {TimerRefs,TimerTypes} + end. + +%%cancel_timer(undefined) -> +%% ok; +cancel_timer(TRef) -> + case erlang:cancel_timer(TRef) of + false -> + %% We have to assume that TRef is the ref of a running timer + %% and if so the timer has expired + %% hence we must wait for the timeout message + receive + {timeout,TRef,_} -> + ok + end; + _TimeLeft -> + ok + end. diff --git a/lib/stdlib/src/io.erl b/lib/stdlib/src/io.erl index 9f65bbfa3a..f510f61e9f 100644 --- a/lib/stdlib/src/io.erl +++ b/lib/stdlib/src/io.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -22,28 +23,30 @@ get_chars/2,get_chars/3,get_line/1,get_line/2, get_password/0, get_password/1, setopts/1, setopts/2, getopts/0, getopts/1]). --export([write/1,write/2,read/1,read/2,read/3]). +-export([write/1,write/2,read/1,read/2,read/3,read/4]). -export([columns/0,columns/1,rows/0,rows/1]). -export([fwrite/1,fwrite/2,fwrite/3,fread/2,fread/3, format/1,format/2,format/3]). --export([scan_erl_exprs/1,scan_erl_exprs/2,scan_erl_exprs/3, - scan_erl_form/1,scan_erl_form/2,scan_erl_form/3, +-export([scan_erl_exprs/1,scan_erl_exprs/2,scan_erl_exprs/3,scan_erl_exprs/4, + scan_erl_form/1,scan_erl_form/2,scan_erl_form/3,scan_erl_form/4, parse_erl_exprs/1,parse_erl_exprs/2,parse_erl_exprs/3, - parse_erl_form/1,parse_erl_form/2,parse_erl_form/3]). + parse_erl_exprs/4,parse_erl_form/1,parse_erl_form/2, + parse_erl_form/3,parse_erl_form/4]). -export([request/1,request/2,requests/1,requests/2]). +%% Implemented in native code +-export([printable_range/0]). --export_type([device/0, format/0]). +-export_type([device/0, format/0, server_no_data/0]). %%------------------------------------------------------------------------- -type device() :: atom() | pid(). --type prompt() :: atom() | string(). +-type prompt() :: atom() | unicode:chardata(). --type error_description() :: term(). % Whatever the io-server sends. --type request_error() :: {'error',error_description()}. +%% ErrorDescription is whatever the I/O-server sends. +-type server_no_data() :: {'error', ErrorDescription :: term()} | 'eof'. -%% XXX: Some uses of line() in this file may need to read erl_scan:location() --type line() :: pos_integer(). +-type location() :: erl_anno:location(). %%------------------------------------------------------------------------- @@ -66,6 +69,11 @@ o_request(Io, Request, Func) -> Other end. +%% Request what the user considers printable characters +-spec printable_range() -> 'unicode' | 'latin1'. +printable_range() -> + erlang:nif_error(undefined). + %% Put chars takes mixed *unicode* list from R13 onwards. -spec put_chars(CharData) -> 'ok' when CharData :: unicode:chardata(). @@ -73,9 +81,9 @@ o_request(Io, Request, Func) -> put_chars(Chars) -> put_chars(default_output(), Chars). --spec put_chars(IoDevice, IoData) -> 'ok' when +-spec put_chars(IoDevice, CharData) -> 'ok' when IoDevice :: device(), - IoData :: unicode:chardata(). + CharData :: unicode:chardata(). put_chars(Io, Chars) -> o_request(Io, {put_chars,unicode,Chars}, put_chars). @@ -124,36 +132,34 @@ rows(Io) -> {error,enotsup} end. --spec get_chars(Prompt, Count) -> Data | 'eof' when +-spec get_chars(Prompt, Count) -> Data | server_no_data() when Prompt :: prompt(), Count :: non_neg_integer(), - Data :: [unicode:unicode_char()] | unicode:unicode_binary(). + Data :: string() | unicode:unicode_binary(). get_chars(Prompt, N) -> get_chars(default_input(), Prompt, N). --spec get_chars(IoDevice, Prompt, Count) -> Data | 'eof' | {error, Reason} when +-spec get_chars(IoDevice, Prompt, Count) -> Data | server_no_data() when IoDevice :: device(), Prompt :: prompt(), Count :: non_neg_integer(), - Reason :: term(), - Data :: [unicode:unicode_char()] | unicode:unicode_binary(). + Data :: string() | unicode:unicode_binary(). get_chars(Io, Prompt, N) when is_integer(N), N >= 0 -> request(Io, {get_chars,unicode,Prompt,N}). --spec get_line(Prompt) -> Data | 'eof' | {'error', Reason} when +-spec get_line(Prompt) -> Data | server_no_data() when Prompt :: prompt(), - Reason :: term(), - Data :: [unicode:unicode_char()] | unicode:unicode_binary(). + Data :: string() | unicode:unicode_binary(). get_line(Prompt) -> get_line(default_input(), Prompt). --spec get_line(IoDevice, Prompt) -> Data | 'eof' | {'error', term()} when +-spec get_line(IoDevice, Prompt) -> Data | server_no_data() when IoDevice :: device(), Prompt :: prompt(), - Data :: [unicode:unicode_char()] | unicode:unicode_binary(). + Data :: string() | unicode:unicode_binary(). get_line(Io, Prompt) -> request(Io, {get_line,unicode,Prompt}). @@ -172,13 +178,15 @@ get_password(Io) -> | {'expand_fun', expand_fun()} | {'encoding', encoding()}. --spec getopts() -> [opt_pair()]. +-spec getopts() -> [opt_pair()] | {'error', Reason} when + Reason :: term(). getopts() -> getopts(default_input()). --spec getopts(IoDevice) -> [opt_pair()] when - IoDevice :: device(). +-spec getopts(IoDevice) -> [opt_pair()] | {'error', Reason} when + IoDevice :: device(), + Reason :: term(). getopts(Io) -> request(Io, getopts). @@ -219,11 +227,10 @@ write(Io, Term) -> -spec read(Prompt) -> Result when Prompt :: prompt(), Result :: {'ok', Term :: term()} - | 'eof' - | {'error', ErrorInfo :: erl_scan:error_info()}. + | server_no_data() + | {'error', ErrorInfo}, + ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(). -% Read does not use get_until as erl_scan does not work with unicode -% XXX:PaN fixme? read(Prompt) -> read(default_input(), Prompt). @@ -231,8 +238,9 @@ read(Prompt) -> IoDevice :: device(), Prompt :: prompt(), Result :: {'ok', Term :: term()} - | 'eof' - | {'error', ErrorInfo :: erl_scan:error_info()}. + | server_no_data() + | {'error', ErrorInfo}, + ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(). read(Io, Prompt) -> case request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[1]}) of @@ -248,24 +256,41 @@ read(Io, Prompt) -> Other end. --spec read(IoDevice, Prompt, StartLine) -> Result when +-spec read(IoDevice, Prompt, StartLocation) -> Result when + IoDevice :: device(), + Prompt :: prompt(), + StartLocation :: location(), + Result :: {'ok', Term :: term(), EndLocation :: location()} + | {'eof', EndLocation :: location()} + | server_no_data() + | {'error', ErrorInfo, ErrorLocation :: location()}, + ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(). + +read(Io, Prompt, Pos0) -> + read(Io, Prompt, Pos0, []). + +-spec read(IoDevice, Prompt, StartLocation, Options) -> Result when IoDevice :: device(), Prompt :: prompt(), - StartLine :: line(), - Result :: {'ok', Term :: term(), EndLine :: line()} - | {'eof', EndLine :: line()} - | {'error', ErrorInfo :: erl_scan:error_info(), ErrorLine :: line()}. - -read(Io, Prompt, StartLine) when is_integer(StartLine) -> - case request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[StartLine]}) of - {ok,Toks,EndLine} -> + StartLocation :: location(), + Options :: erl_scan:options(), + Result :: {'ok', Term :: term(), EndLocation :: location()} + | {'eof', EndLocation :: location()} + | server_no_data() + | {'error', ErrorInfo, ErrorLocation :: location()}, + ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(). + +read(Io, Prompt, Pos0, Options) -> + Args = [Pos0,Options], + case request(Io, {get_until,unicode,Prompt,erl_scan,tokens,Args}) of + {ok,Toks,EndLocation} -> case erl_parse:parse_term(Toks) of - {ok,Term} -> {ok,Term,EndLine}; - {error,ErrorInfo} -> {error,ErrorInfo,EndLine} + {ok,Term} -> {ok,Term,EndLocation}; + {error,ErrorInfo} -> {error,ErrorInfo,EndLocation} end; - {error,_E,_EndLine} = Error -> + {error,_E,_EndLocation} = Error -> Error; - {eof,_EndLine} = Eof -> + {eof,_EndLocation} = Eof -> Eof; Other -> Other @@ -313,7 +338,9 @@ fread(Prompt, Format) -> IoDevice :: device(), Prompt :: prompt(), Format :: format(), - Result :: {'ok', Terms :: [term()]} | 'eof' | {'error', What :: term()}. + Result :: {'ok', Terms :: [term()]} + | {'error', {'fread', FreadError :: io_lib:fread_error()}} + | server_no_data(). fread(Io, Prompt, Format) -> case request(Io, {fread,Prompt,Format}) of @@ -348,7 +375,7 @@ format(Io, Format, Args) -> -spec scan_erl_exprs(Prompt) -> Result when Prompt :: prompt(), - Result :: erl_scan:tokens_result() | request_error(). + Result :: erl_scan:tokens_result() | server_no_data(). scan_erl_exprs(Prompt) -> scan_erl_exprs(default_input(), Prompt, 1). @@ -356,23 +383,33 @@ scan_erl_exprs(Prompt) -> -spec scan_erl_exprs(Device, Prompt) -> Result when Device :: device(), Prompt :: prompt(), - Result :: erl_scan:tokens_result() | request_error(). + Result :: erl_scan:tokens_result() | server_no_data(). scan_erl_exprs(Io, Prompt) -> scan_erl_exprs(Io, Prompt, 1). --spec scan_erl_exprs(Device, Prompt, StartLine) -> Result when +-spec scan_erl_exprs(Device, Prompt, StartLocation) -> Result when Device :: device(), Prompt :: prompt(), - StartLine :: line(), - Result :: erl_scan:tokens_result() | request_error(). + StartLocation :: location(), + Result :: erl_scan:tokens_result() | server_no_data(). scan_erl_exprs(Io, Prompt, Pos0) -> - request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[Pos0]}). + scan_erl_exprs(Io, Prompt, Pos0, []). + +-spec scan_erl_exprs(Device, Prompt, StartLocation, Options) -> Result when + Device :: device(), + Prompt :: prompt(), + StartLocation :: location(), + Options :: erl_scan:options(), + Result :: erl_scan:tokens_result() | server_no_data(). + +scan_erl_exprs(Io, Prompt, Pos0, Options) -> + request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[Pos0,Options]}). -spec scan_erl_form(Prompt) -> Result when Prompt :: prompt(), - Result :: erl_scan:tokens_result() | request_error(). + Result :: erl_scan:tokens_result() | server_no_data(). scan_erl_form(Prompt) -> scan_erl_form(default_input(), Prompt, 1). @@ -380,26 +417,41 @@ scan_erl_form(Prompt) -> -spec scan_erl_form(IoDevice, Prompt) -> Result when IoDevice :: device(), Prompt :: prompt(), - Result :: erl_scan:tokens_result() | request_error(). + Result :: erl_scan:tokens_result() | server_no_data(). scan_erl_form(Io, Prompt) -> scan_erl_form(Io, Prompt, 1). --spec scan_erl_form(IoDevice, Prompt, StartLine) -> Result when +-spec scan_erl_form(IoDevice, Prompt, StartLocation) -> Result when IoDevice :: device(), Prompt :: prompt(), - StartLine :: line(), - Result :: erl_scan:tokens_result() | request_error(). + StartLocation :: location(), + Result :: erl_scan:tokens_result() | server_no_data(). scan_erl_form(Io, Prompt, Pos0) -> - request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[Pos0]}). + scan_erl_form(Io, Prompt, Pos0, []). + +-spec scan_erl_form(IoDevice, Prompt, StartLocation, Options) -> Result when + IoDevice :: device(), + Prompt :: prompt(), + StartLocation :: location(), + Options :: erl_scan:options(), + Result :: erl_scan:tokens_result() | server_no_data(). + +scan_erl_form(Io, Prompt, Pos0, Options) -> + request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[Pos0,Options]}). %% Parsing Erlang code. --type parse_ret() :: {'ok', ExprList :: erl_parse:abstract_expr(), EndLine :: line()} - | {'eof', EndLine :: line()} - | {'error', ErrorInfo :: erl_scan:error_info(), ErrorLine :: line()} - | request_error(). +-type parse_ret() :: {'ok', + ExprList :: [erl_parse:abstract_expr()], + EndLocation :: location()} + | {'eof', EndLocation :: location()} + | {'error', + ErrorInfo :: erl_scan:error_info() + | erl_parse:error_info(), + ErrorLocation :: location()} + | server_no_data(). -spec parse_erl_exprs(Prompt) -> Result when Prompt :: prompt(), @@ -416,14 +468,24 @@ parse_erl_exprs(Prompt) -> parse_erl_exprs(Io, Prompt) -> parse_erl_exprs(Io, Prompt, 1). --spec parse_erl_exprs(IoDevice, Prompt, StartLine) -> Result when +-spec parse_erl_exprs(IoDevice, Prompt, StartLocation) -> Result when IoDevice :: device(), Prompt :: prompt(), - StartLine :: line(), + StartLocation :: location(), Result :: parse_ret(). parse_erl_exprs(Io, Prompt, Pos0) -> - case request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[Pos0]}) of + parse_erl_exprs(Io, Prompt, Pos0, []). + +-spec parse_erl_exprs(IoDevice, Prompt, StartLocation, Options) -> Result when + IoDevice :: device(), + Prompt :: prompt(), + StartLocation :: location(), + Options :: erl_scan:options(), + Result :: parse_ret(). + +parse_erl_exprs(Io, Prompt, Pos0, Options) -> + case request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[Pos0,Options]}) of {ok,Toks,EndPos} -> case erl_parse:parse_exprs(Toks) of {ok,Exprs} -> {ok,Exprs,EndPos}; @@ -433,10 +495,15 @@ parse_erl_exprs(Io, Prompt, Pos0) -> Other end. --type parse_form_ret() :: {'ok', AbsForm :: erl_parse:abstract_form(), EndLine :: line()} - | {'eof', EndLine :: line()} - | {'error', ErrorInfo :: erl_scan:error_info(), ErrorLine :: line()} - | request_error(). +-type parse_form_ret() :: {'ok', + AbsForm :: erl_parse:abstract_form(), + EndLocation :: location()} + | {'eof', EndLocation :: location()} + | {'error', + ErrorInfo :: erl_scan:error_info() + | erl_parse:error_info(), + ErrorLocation :: location()} + | server_no_data(). -spec parse_erl_form(Prompt) -> Result when Prompt :: prompt(), @@ -453,14 +520,25 @@ parse_erl_form(Prompt) -> parse_erl_form(Io, Prompt) -> parse_erl_form(Io, Prompt, 1). --spec parse_erl_form(IoDevice, Prompt, StartLine) -> Result when +-spec parse_erl_form(IoDevice, Prompt, StartLocation) -> Result when IoDevice :: device(), Prompt :: prompt(), - StartLine :: line(), + StartLocation :: location(), Result :: parse_form_ret(). parse_erl_form(Io, Prompt, Pos0) -> - case request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[Pos0]}) of + parse_erl_form(Io, Prompt, Pos0, []). + +-spec parse_erl_form(IoDevice, Prompt, StartLocation, Options) -> Result when + IoDevice :: device(), + Prompt :: prompt(), + StartLocation :: location(), + Options :: erl_scan:options(), + Result :: parse_form_ret(). + +parse_erl_form(Io, Prompt, Pos0, Options) -> + Args = [Pos0, Options], + case request(Io, {get_until,unicode,Prompt,erl_scan,tokens,Args}) of {ok,Toks,EndPos} -> case erl_parse:parse_form(Toks) of {ok,Exprs} -> {ok,Exprs,EndPos}; @@ -489,12 +567,23 @@ request(Name, Request) when is_atom(Name) -> execute_request(Pid, {Convert,Converted}) -> Mref = erlang:monitor(process, Pid), - Pid ! {io_request,self(),Pid,Converted}, - if - Convert -> - convert_binaries(wait_io_mon_reply(Pid, Mref)); - true -> - wait_io_mon_reply(Pid, Mref) + Pid ! {io_request,self(),Mref,Converted}, + + receive + {io_reply, Mref, Reply} -> + erlang:demonitor(Mref, [flush]), + if + Convert -> + convert_binaries(Reply); + true -> + Reply + end; + {'DOWN', Mref, _, _, _} -> + receive + {'EXIT', Pid, _What} -> true + after 0 -> true + end, + {error,terminated} end. requests(Requests) -> %Requests as atomic action @@ -520,30 +609,6 @@ default_input() -> default_output() -> group_leader(). -wait_io_mon_reply(From, Mref) -> - receive - {io_reply, From, Reply} -> - erlang:demonitor(Mref), - receive - {'DOWN', Mref, _, _, _} -> true - after 0 -> true - end, - Reply; - {'EXIT', From, _What} -> - receive - {'DOWN', Mref, _, _, _} -> true - after 0 -> true - end, - {error,terminated}; - {'DOWN', Mref, _, _, _} -> - receive - {'EXIT', From, _What} -> true - after 0 -> true - end, - {error,terminated} - end. - - %% io_requests(Requests) %% Transform requests into correct i/o server messages. Only handle the %% one we KNOW must be changed, others, including incorrect ones, are @@ -566,41 +631,20 @@ io_requests(Pid, [], [Rs|Cont], Tail) -> io_requests(_Pid, [], [], _Tail) -> {false,[]}. - -bc_req(Pid,{Op,Enc,Param},MaybeConvert) -> +bc_req(Pid, Req0, MaybeConvert) -> case net_kernel:dflag_unicode_io(Pid) of true -> - {false,{Op,Enc,Param}}; + %% The most common case. A modern i/o server. + {false,Req0}; false -> - {MaybeConvert,{Op,Param}} - end; -bc_req(Pid,{Op,Enc,P,F},MaybeConvert) -> - case net_kernel:dflag_unicode_io(Pid) of - true -> - {false,{Op,Enc,P,F}}; - false -> - {MaybeConvert,{Op,P,F}} - end; -bc_req(Pid, {Op,Enc,M,F,A},MaybeConvert) -> - case net_kernel:dflag_unicode_io(Pid) of - true -> - {false,{Op,Enc,M,F,A}}; - false -> - {MaybeConvert,{Op,M,F,A}} - end; -bc_req(Pid, {Op,Enc,P,M,F,A},MaybeConvert) -> - case net_kernel:dflag_unicode_io(Pid) of - true -> - {false,{Op,Enc,P,M,F,A}}; - false -> - {MaybeConvert,{Op,P,M,F,A}} - end; -bc_req(Pid,{Op,Enc},MaybeConvert) -> - case net_kernel:dflag_unicode_io(Pid) of - true -> - {false,{Op, Enc}}; - false -> - {MaybeConvert,Op} + %% Backward compatibility only. Unlikely to ever happen. + case tuple_to_list(Req0) of + [Op,_Enc] -> + {MaybeConvert,Op}; + [Op,_Enc|T] -> + Req = list_to_tuple([Op|T]), + {MaybeConvert,Req} + end end. io_request(Pid, {write,Term}) -> diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index 0252cdf742..ad98bc0420 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -46,52 +47,87 @@ %% 173 - 176 { - ~ punctuation %% 177 DEL control %% 200 - 237 control -%% 240 - 277 NBSP - � punctuation -%% 300 - 326 � - � uppercase -%% 327 � punctuation -%% 330 - 336 � - � uppercase -%% 337 - 366 � - � lowercase -%% 367 � punctuation -%% 370 - 377 � - � lowercase +%% 240 - 277 NBSP - ¿ punctuation +%% 300 - 326 À - Ö uppercase +%% 327 × punctuation +%% 330 - 336 Ø - Þ uppercase +%% 337 - 366 ß - ö lowercase +%% 367 ÷ punctuation +%% 370 - 377 ø - ÿ lowercase %% %% Many punctuation characters region have special meaning. Must -%% watch using � \327, very close to x \170 +%% watch using × \327, very close to x \170 -module(io_lib). -export([fwrite/2,fread/2,fread/3,format/2]). +-export([scan_format/2,unscan_format/1,build_text/1]). -export([print/1,print/4,indentation/2]). --export([write/1,write/2,write/3,nl/0,format_prompt/1]). --export([write_atom/1,write_string/1,write_string/2,write_unicode_string/1, - write_unicode_string/2, write_char/1, write_unicode_char/1]). +-export([write/1,write/2,write/3,nl/0,format_prompt/1,format_prompt/2]). +-export([write_atom/1,write_string/1,write_string/2,write_latin1_string/1, + write_latin1_string/2, write_char/1, write_latin1_char/1]). + +-export([write_string_as_latin1/1, write_string_as_latin1/2, + write_char_as_latin1/1]). --export([quote_atom/2, char_list/1, unicode_char_list/1, - deep_char_list/1, deep_unicode_char_list/1, - printable_list/1, printable_unicode_list/1]). +-export([quote_atom/2, char_list/1, latin1_char_list/1, + deep_char_list/1, deep_latin1_char_list/1, + printable_list/1, printable_latin1_list/1, printable_unicode_list/1]). %% Utilities for collecting characters. -export([collect_chars/3, collect_chars/4, collect_line/2, collect_line/3, collect_line/4, get_until/3, get_until/4]). --export_type([chars/0, continuation/0]). +%% The following functions were used by Yecc's include-file. +-export([write_unicode_string/1, write_unicode_char/1, + deep_unicode_char_list/1]). + +-export_type([chars/0, latin1_string/0, continuation/0, + fread_error/0, fread_item/0, format_spec/0]). %%---------------------------------------------------------------------- -type chars() :: [char() | chars()]. +-type latin1_string() :: [unicode:latin1_char()]. -type depth() :: -1 | non_neg_integer(). --opaque continuation() :: {_, _, _, _}. % XXX: refine +-opaque continuation() :: {Format :: string(), + Stack :: chars(), + Nchars :: non_neg_integer(), + Results :: [term()]}. + +-type fread_error() :: 'atom' + | 'based' + | 'character' + | 'float' + | 'format' + | 'input' + | 'integer' + | 'string' + | 'unsigned'. + +-type fread_item() :: string() | atom() | integer() | float(). + +-type format_spec() :: + #{ + control_char := char(), + args := [any()], + width := 'none' | integer(), + adjust := 'left' | 'right', + precision := 'none' | integer(), + pad_char := char(), + encoding := 'unicode' | 'latin1', + strings := boolean() + }. %%---------------------------------------------------------------------- %% Interface calls to sub-modules. --spec fwrite(Format, Data) -> chars() | UnicodeList when +-spec fwrite(Format, Data) -> chars() when Format :: io:format(), - Data :: [term()], - UnicodeList :: [unicode:unicode_char()], Data :: [term()]. fwrite(Format, Args) -> @@ -100,11 +136,11 @@ fwrite(Format, Args) -> -spec fread(Format, String) -> Result when Format :: string(), String :: string(), - Result :: {'ok', InputList :: [term()], LeftOverChars :: string()} + Result :: {'ok', InputList :: [fread_item()], LeftOverChars :: string()} | {'more', RestFormat :: string(), Nchars :: non_neg_integer(), InputStack :: chars()} - | {'error', What :: term()}. + | {'error', {'fread', What :: fread_error()}}. fread(Chars, Format) -> io_lib_fread:fread(Chars, Format). @@ -115,17 +151,16 @@ fread(Chars, Format) -> Format :: string(), Return :: {'more', Continuation1 :: continuation()} | {'done', Result, LeftOverChars :: string()}, - Result :: {'ok', InputList :: [term()]} + Result :: {'ok', InputList :: [fread_item()]} | 'eof' - | {'error', What :: term()}. + | {'error', {'fread', What :: fread_error()}}. fread(Cont, Chars, Format) -> io_lib_fread:fread(Cont, Chars, Format). --spec format(Format, Data) -> chars() | UnicodeList when +-spec format(Format, Data) -> chars() when Format :: io:format(), - Data :: [term()], - UnicodeList :: [unicode:unicode_char()]. + Data :: [term()]. format(Format, Args) -> case catch io_lib_format:fwrite(Format, Args) of @@ -135,6 +170,31 @@ format(Format, Args) -> Other end. +-spec scan_format(Format, Data) -> FormatList when + Format :: io:format(), + Data :: [term()], + FormatList :: [char() | format_spec()]. + +scan_format(Format, Args) -> + try io_lib_format:scan(Format, Args) + catch + _:_ -> erlang:error(badarg, [Format, Args]) + end. + +-spec unscan_format(FormatList) -> {Format, Data} when + FormatList :: [char() | format_spec()], + Format :: io:format(), + Data :: [term()]. + +unscan_format(FormatList) -> + io_lib_format:unscan(FormatList). + +-spec build_text(FormatList) -> chars() when + FormatList :: [char() | format_spec()]. + +build_text(FormatList) -> + io_lib_format:build(FormatList). + -spec print(Term) -> chars() when Term :: term(). @@ -159,27 +219,34 @@ indentation(Chars, Current) -> %% Format an IO-request prompt (handles formatting errors safely). -%% Atoms, binaries, and iolists can be used as-is, and will be -%% printed without any additional quotes. -%% Note that the output is a deep string, and not an iolist (i.e., -%% it may be deep, but never contains binaries, due to the "~s"). +%% Atoms, binaries, and iolists (or unicode:charlist()) can be used +%% as-is, and will be printed without any additional quotes. -spec format_prompt(term()) -> chars(). -format_prompt({format,Format,Args}) -> - format_prompt(Format,Args); -format_prompt(Prompt) - when is_list(Prompt); is_atom(Prompt); is_binary(Prompt) -> - format_prompt("~ts", [Prompt]); format_prompt(Prompt) -> - format_prompt("~tp", [Prompt]). + format_prompt(Prompt, latin1). -format_prompt(Format, Args) -> +-spec format_prompt(term(), atom()) -> chars(). + +format_prompt({format,Format,Args}, _Encoding) -> + do_format_prompt(Format, Args); +format_prompt(Prompt, Encoding) + when is_list(Prompt); is_atom(Prompt); is_binary(Prompt) -> + do_format_prompt(add_modifier(Encoding, "s"), [Prompt]); +format_prompt(Prompt, Encoding) -> + do_format_prompt(add_modifier(Encoding, "p"), [Prompt]). + +do_format_prompt(Format, Args) -> case catch io_lib:format(Format, Args) of {'EXIT',_} -> "???"; List -> List end. +add_modifier(latin1, C) -> + "~"++C; +add_modifier(_, C) -> + "~t"++C. %% write(Term) %% write(Term, Depth) @@ -221,6 +288,8 @@ write([H|T], D) -> end; write(F, _D) when is_function(F) -> erlang:fun_to_list(F); +write(Term, D) when is_map(Term) -> + write_map(Term, D); write(T, D) when is_tuple(T) -> if D =:= 1 -> "{...}"; @@ -247,13 +316,25 @@ write_port(Port) -> write_ref(Ref) -> erlang:ref_to_list(Ref). +write_map(Map, D) when is_integer(D) -> + [$#,${,write_map_body(maps:to_list(Map), D),$}]. + +write_map_body(_, 0) -> "..."; +write_map_body([],_) -> []; +write_map_body([{K,V}],D) -> write_map_assoc(K,V,D); +write_map_body([{K,V}|KVs], D) -> + [write_map_assoc(K,V,D),$, | write_map_body(KVs,D-1)]. + +write_map_assoc(K,V,D) -> + [write(K,D - 1),"=>",write(V,D-1)]. + write_binary(B, D) when is_integer(D) -> [$<,$<,write_binary_body(B, D),$>,$>]. -write_binary_body(_B, 1) -> - "..."; write_binary_body(<<>>, _D) -> ""; +write_binary_body(_B, 1) -> + "..."; write_binary_body(<<X:8>>, _D) -> [integer_to_list(X)]; write_binary_body(<<X:8,Rest/bitstring>>, D) -> @@ -291,7 +372,7 @@ quote_atom(Atom, Cs0) -> case Cs0 of [C|Cs] when C >= $a, C =< $z -> not name_chars(Cs); - [C|Cs] when C >= $�, C =< $�, C =/= $� -> + [C|Cs] when C >= $ß, C =< $ÿ, C =/= $÷ -> not name_chars(Cs); _ -> true end @@ -305,14 +386,19 @@ name_chars([C|Cs]) -> name_chars([]) -> true. name_char(C) when C >= $a, C =< $z -> true; -name_char(C) when C >= $�, C =< $�, C =/= $� -> true; +name_char(C) when C >= $ß, C =< $ÿ, C =/= $÷ -> true; name_char(C) when C >= $A, C =< $Z -> true; -name_char(C) when C >= $�, C =< $�, C =/= $� -> true; +name_char(C) when C >= $À, C =< $Þ, C =/= $× -> true; name_char(C) when C >= $0, C =< $9 -> true; name_char($_) -> true; name_char($@) -> true; name_char(_) -> false. +%%% There are two functions to write Unicode strings: +%%% - they both escape control characters < 160; +%%% - write_string() never escapes characters >= 160; +%%% - write_string_as_latin1() also escapes characters >= 255. + %% write_string([Char]) -> [Char] %% Generate the list of characters needed to print a string. @@ -325,13 +411,33 @@ write_string(S) -> -spec write_string(string(), char()) -> chars(). write_string(S, Q) -> - [Q|write_string1(latin1, S, Q)]. + [Q|write_string1(unicode_as_unicode, S, Q)]. +%% Backwards compatibility. write_unicode_string(S) -> - write_unicode_string(S, $"). %" + write_string(S). + +-spec write_latin1_string(Latin1String) -> latin1_string() when + Latin1String :: latin1_string(). + +write_latin1_string(S) -> + write_latin1_string(S, $"). %" + +-spec write_latin1_string(latin1_string(), char()) -> latin1_string(). + +write_latin1_string(S, Q) -> + [Q|write_string1(latin1, S, Q)]. + +-spec write_string_as_latin1(String) -> latin1_string() when + String :: string(). + +write_string_as_latin1(S) -> + write_string_as_latin1(S, $"). %" + +-spec write_string_as_latin1(string(), char()) -> latin1_string(). -write_unicode_string(S, Q) -> - [Q|write_string1(unicode, S, Q)]. +write_string_as_latin1(S, Q) -> + [Q|write_string1(unicode_as_latin1, S, Q)]. write_string1(_,[], Q) -> [Q]; @@ -344,7 +450,11 @@ string_char(_,C, _, Tail) when C >= $\s, C =< $~ -> [C|Tail]; string_char(latin1,C, _, Tail) when C >= $\240, C =< $\377 -> [C|Tail]; -string_char(unicode,C, _, Tail) when C >= $\240 -> +string_char(unicode_as_unicode,C, _, Tail) when C >= $\240 -> + [C|Tail]; +string_char(unicode_as_latin1,C, _, Tail) when C >= $\240, C =< $\377 -> + [C|Tail]; +string_char(unicode_as_latin1,C, _, Tail) when C >= $\377 -> "\\x{"++erlang:integer_to_list(C, 16)++"}"++Tail; string_char(_,$\n, _, Tail) -> [$\\,$n|Tail]; %\n = LF string_char(_,$\r, _, Tail) -> [$\\,$r|Tail]; %\r = CR @@ -360,6 +470,11 @@ string_char(_,C, _, Tail) when C < $\240-> %Other control characters. C3 = (C band 7) + $0, [$\\,C1,C2,C3|Tail]. +%%% There are two functions to write a Unicode character: +%%% - they both escape control characters < 160; +%%% - write_char() never escapes characters >= 160; +%%% - write_char_as_latin1() also escapes characters >= 255. + %% write_char(Char) -> [char()]. %% Generate the list of characters needed to print a character constant. %% Must special case SPACE, $\s, here. @@ -368,35 +483,63 @@ string_char(_,C, _, Tail) when C < $\240-> %Other control characters. Char :: char(). write_char($\s) -> "$\\s"; %Must special case this. -write_char(C) when is_integer(C), C >= $\000, C =< $\377 -> - [$$|string_char(latin1,C, -1, [])]. +write_char(C) when is_integer(C), C >= $\000 -> + [$$|string_char(unicode_as_unicode, C, -1, [])]. -write_unicode_char(Ch) when Ch =< 255 -> - write_char(Ch); -write_unicode_char(Uni) -> - [$$|string_char(unicode,Uni, -1, [])]. +%% Backwards compatibility. +write_unicode_char(C) -> + write_char(C). -%% char_list(CharList) -%% deep_char_list(CharList) -%% Return true if CharList is a (possibly deep) list of characters, else -%% false. +-spec write_latin1_char(Latin1Char) -> latin1_string() when + Latin1Char :: unicode:latin1_char(). + +write_latin1_char(Lat1) when is_integer(Lat1), Lat1 >= $\000, Lat1 =< $\377 -> + [$$|string_char(latin1, Lat1, -1, [])]. + +-spec write_char_as_latin1(Char) -> latin1_string() when + Char :: char(). + +write_char_as_latin1(Uni) when is_integer(Uni), Uni >= $\000 -> + [$$|string_char(unicode_as_latin1,Uni, -1, [])]. + +%% latin1_char_list(CharList) +%% deep_latin1_char_list(CharList) +%% Return true if CharList is a (possibly deep) list of Latin-1 +%% characters, else false. + +-spec latin1_char_list(Term) -> boolean() when + Term :: term(). + +latin1_char_list([C|Cs]) when is_integer(C), C >= $\000, C =< $\377 -> + latin1_char_list(Cs); +latin1_char_list([]) -> true; +latin1_char_list(_) -> false. %Everything else is false -spec char_list(Term) -> boolean() when Term :: term(). -char_list([C|Cs]) when is_integer(C), C >= $\000, C =< $\377 -> +char_list([C|Cs]) when is_integer(C), C >= 0, C < 16#D800; + is_integer(C), C > 16#DFFF, C < 16#FFFE; + is_integer(C), C > 16#FFFF, C =< 16#10FFFF -> char_list(Cs); char_list([]) -> true; char_list(_) -> false. %Everything else is false --spec unicode_char_list(term()) -> boolean(). +-spec deep_latin1_char_list(Term) -> boolean() when + Term :: term(). -unicode_char_list([C|Cs]) when is_integer(C), C >= 0, C < 16#D800; - is_integer(C), C > 16#DFFF, C < 16#FFFE; - is_integer(C), C > 16#FFFF, C =< 16#10FFFF -> - unicode_char_list(Cs); -unicode_char_list([]) -> true; -unicode_char_list(_) -> false. %Everything else is false +deep_latin1_char_list(Cs) -> + deep_latin1_char_list(Cs, []). + +deep_latin1_char_list([C|Cs], More) when is_list(C) -> + deep_latin1_char_list(C, [Cs|More]); +deep_latin1_char_list([C|Cs], More) when is_integer(C), C >= $\000, C =< $\377 -> + deep_latin1_char_list(Cs, More); +deep_latin1_char_list([], [Cs|More]) -> + deep_latin1_char_list(Cs, More); +deep_latin1_char_list([], []) -> true; +deep_latin1_char_list(_, _More) -> %Everything else is false + false. -spec deep_char_list(Term) -> boolean() when Term :: term(). @@ -406,65 +549,72 @@ deep_char_list(Cs) -> deep_char_list([C|Cs], More) when is_list(C) -> deep_char_list(C, [Cs|More]); -deep_char_list([C|Cs], More) when is_integer(C), C >= $\000, C =< $\377 -> +deep_char_list([C|Cs], More) + when is_integer(C), C >= 0, C < 16#D800; + is_integer(C), C > 16#DFFF, C < 16#FFFE; + is_integer(C), C > 16#FFFF, C =< 16#10FFFF -> deep_char_list(Cs, More); deep_char_list([], [Cs|More]) -> deep_char_list(Cs, More); deep_char_list([], []) -> true; -deep_char_list(_, _More) -> %Everything else is false +deep_char_list(_, _More) -> %Everything else is false false. --spec deep_unicode_char_list(term()) -> boolean(). +deep_unicode_char_list(Term) -> + deep_char_list(Term). -deep_unicode_char_list(Cs) -> - deep_unicode_char_list(Cs, []). +%% printable_latin1_list([Char]) -> boolean() +%% Return true if CharList is a list of printable Latin1 characters, else +%% false. -deep_unicode_char_list([C|Cs], More) when is_list(C) -> - deep_unicode_char_list(C, [Cs|More]); -deep_unicode_char_list([C|Cs], More) - when is_integer(C), C >= 0, C < 16#D800; - is_integer(C), C > 16#DFFF, C < 16#FFFE; - is_integer(C), C > 16#FFFF, C =< 16#10FFFF -> - deep_unicode_char_list(Cs, More); -deep_unicode_char_list([], [Cs|More]) -> - deep_unicode_char_list(Cs, More); -deep_unicode_char_list([], []) -> true; -deep_unicode_char_list(_, _More) -> %Everything else is false - false. +-spec printable_latin1_list(Term) -> boolean() when + Term :: term(). + +printable_latin1_list([C|Cs]) when is_integer(C), C >= $\040, C =< $\176 -> + printable_latin1_list(Cs); +printable_latin1_list([C|Cs]) when is_integer(C), C >= $\240, C =< $\377 -> + printable_latin1_list(Cs); +printable_latin1_list([$\n|Cs]) -> printable_latin1_list(Cs); +printable_latin1_list([$\r|Cs]) -> printable_latin1_list(Cs); +printable_latin1_list([$\t|Cs]) -> printable_latin1_list(Cs); +printable_latin1_list([$\v|Cs]) -> printable_latin1_list(Cs); +printable_latin1_list([$\b|Cs]) -> printable_latin1_list(Cs); +printable_latin1_list([$\f|Cs]) -> printable_latin1_list(Cs); +printable_latin1_list([$\e|Cs]) -> printable_latin1_list(Cs); +printable_latin1_list([]) -> true; +printable_latin1_list(_) -> false. %Everything else is false %% printable_list([Char]) -> boolean() %% Return true if CharList is a list of printable characters, else -%% false. +%% false. The notion of printable in Unicode terms is somewhat floating. +%% Everything that is not a control character and not invalid unicode +%% will be considered printable. +%% What the user has noted as printable characters is what actually +%% specifies when this function will return true. If the VM is started +%% with +pc latin1, only the latin1 range will be deemed as printable +%% if on the other hand +pc unicode is given, all characters in the Unicode +%% character set are deemed printable. latin1 is default. -spec printable_list(Term) -> boolean() when Term :: term(). -printable_list([C|Cs]) when is_integer(C), C >= $\040, C =< $\176 -> - printable_list(Cs); -printable_list([C|Cs]) when is_integer(C), C >= $\240, C =< $\377 -> - printable_list(Cs); -printable_list([$\n|Cs]) -> printable_list(Cs); -printable_list([$\r|Cs]) -> printable_list(Cs); -printable_list([$\t|Cs]) -> printable_list(Cs); -printable_list([$\v|Cs]) -> printable_list(Cs); -printable_list([$\b|Cs]) -> printable_list(Cs); -printable_list([$\f|Cs]) -> printable_list(Cs); -printable_list([$\e|Cs]) -> printable_list(Cs); -printable_list([]) -> true; -printable_list(_) -> false. %Everything else is false - -%% printable_unicode_list([Char]) -> boolean() -%% Return true if CharList is a list of printable characters, else -%% false. The notion of printable in Unicode terms is somewhat floating. -%% Everything that is not a control character and not invalid unicode -%% will be considered printable. +printable_list(L) -> + %% There will be more alternatives returns from io:printable range + %% in the future. To not have a catch-all clause is deliberate. + case io:printable_range() of + latin1 -> + printable_latin1_list(L); + unicode -> + printable_unicode_list(L) + end. --spec printable_unicode_list(term()) -> boolean(). +-spec printable_unicode_list(Term) -> boolean() when + Term :: term(). printable_unicode_list([C|Cs]) when is_integer(C), C >= $\040, C =< $\176 -> printable_unicode_list(Cs); -printable_unicode_list([C|Cs]) - when is_integer(C), C >= 16#A0, C < 16#D800; +printable_unicode_list([C|Cs]) + when is_integer(C), C >= 16#A0, C < 16#D800; is_integer(C), C > 16#DFFF, C < 16#FFFE; is_integer(C), C > 16#FFFF, C =< 16#10FFFF -> printable_unicode_list(Cs); @@ -485,7 +635,7 @@ printable_unicode_list(_) -> false. %Everything else is false nl() -> "\n". - + %% %% Utilities for collecting characters in input files %% diff --git a/lib/stdlib/src/io_lib_format.erl b/lib/stdlib/src/io_lib_format.erl index 49a00a4ec7..1da866dc88 100644 --- a/lib/stdlib/src/io_lib_format.erl +++ b/lib/stdlib/src/io_lib_format.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -20,10 +21,9 @@ %% Formatting functions of io library. --export([fwrite/2,fwrite_g/1,indentation/2]). +-export([fwrite/2,fwrite_g/1,indentation/2,scan/2,unscan/1,build/1]). -%% fwrite(Format, ArgList) -> [Char]. -%% Format the arguments in ArgList after string Format. Just generate +%% Format the arguments in Args after string Format. Just generate %% an error if there is an error in the arguments. %% %% To do the printing command correctly we need to calculate the @@ -37,15 +37,84 @@ %% and it also splits the handling of the control characters into two %% parts. -fwrite(Format, Args) when is_atom(Format) -> - fwrite(atom_to_list(Format), Args); -fwrite(Format, Args) when is_binary(Format) -> - fwrite(binary_to_list(Format), Args); +-spec fwrite(Format, Data) -> FormatList when + Format :: io:format(), + Data :: [term()], + FormatList :: [char() | io_lib:format_spec()]. + fwrite(Format, Args) -> - Cs = collect(Format, Args), + build(scan(Format, Args)). + +%% Build the output text for a pre-parsed format list. + +-spec build(FormatList) -> io_lib:chars() when + FormatList :: [char() | io_lib:format_spec()]. + +build(Cs) -> Pc = pcount(Cs), build(Cs, Pc, 0). +%% Parse all control sequences in the format string. + +-spec scan(Format, Data) -> FormatList when + Format :: io:format(), + Data :: [term()], + FormatList :: [char() | io_lib:format_spec()]. + +scan(Format, Args) when is_atom(Format) -> + scan(atom_to_list(Format), Args); +scan(Format, Args) when is_binary(Format) -> + scan(binary_to_list(Format), Args); +scan(Format, Args) -> + collect(Format, Args). + +%% Revert a pre-parsed format list to a plain character list and a +%% list of arguments. + +-spec unscan(FormatList) -> {Format, Data} when + FormatList :: [char() | io_lib:format_spec()], + Format :: io:format(), + Data :: [term()]. + +unscan(Cs) -> + {print(Cs), args(Cs)}. + +args([#{args := As} | Cs]) -> + As ++ args(Cs); +args([_C | Cs]) -> + args(Cs); +args([]) -> + []. + +print([#{control_char := C, width := F, adjust := Ad, precision := P, + pad_char := Pad, encoding := Encoding, strings := Strings} | Cs]) -> + print(C, F, Ad, P, Pad, Encoding, Strings) ++ print(Cs); +print([C | Cs]) -> + [C | print(Cs)]; +print([]) -> + []. + +print(C, F, Ad, P, Pad, Encoding, Strings) -> + [$~] ++ print_field_width(F, Ad) ++ print_precision(P) ++ + print_pad_char(Pad) ++ print_encoding(Encoding) ++ + print_strings(Strings) ++ [C]. + +print_field_width(none, _Ad) -> ""; +print_field_width(F, left) -> integer_to_list(-F); +print_field_width(F, right) -> integer_to_list(F). + +print_precision(none) -> ""; +print_precision(P) -> [$. | integer_to_list(P)]. + +print_pad_char($\s) -> ""; % default, no need to make explicit +print_pad_char(Pad) -> [$., Pad]. + +print_encoding(unicode) -> "t"; +print_encoding(latin1) -> "". + +print_strings(false) -> "l"; +print_strings(true) -> "". + collect([$~|Fmt0], Args0) -> {C,Fmt1,Args1} = collect_cseq(Fmt0, Args0), [C|collect(Fmt1, Args1)]; @@ -58,14 +127,25 @@ collect_cseq(Fmt0, Args0) -> {P,Fmt2,Args2} = precision(Fmt1, Args1), {Pad,Fmt3,Args3} = pad_char(Fmt2, Args2), {Encoding,Fmt4,Args4} = encoding(Fmt3, Args3), - {C,As,Fmt5,Args5} = collect_cc(Fmt4, Args4), - {{C,As,F,Ad,P,Pad,Encoding},Fmt5,Args5}. + {Strings,Fmt5,Args5} = strings(Fmt4, Args4), + {C,As,Fmt6,Args6} = collect_cc(Fmt5, Args5), + FormatSpec = #{control_char => C, args => As, width => F, adjust => Ad, + precision => P, pad_char => Pad, encoding => Encoding, + strings => Strings}, + {FormatSpec,Fmt6,Args6}. encoding([$t|Fmt],Args) -> + true = hd(Fmt) =/= $l, {unicode,Fmt,Args}; encoding(Fmt,Args) -> {latin1,Fmt,Args}. +strings([$l|Fmt],Args) -> + true = hd(Fmt) =/= $t, + {false,Fmt,Args}; +strings(Fmt,Args) -> + {true,Fmt,Args}. + field_width([$-|Fmt0], Args0) -> {F,Fmt,Args} = field_value(Fmt0, Args0), field_width(-F, Fmt, Args); @@ -128,18 +208,20 @@ collect_cc([$i|Fmt], [A|Args]) -> {$i,[A],Fmt,Args}. pcount(Cs) -> pcount(Cs, 0). -pcount([{$p,_As,_F,_Ad,_P,_Pad,_Enc}|Cs], Acc) -> pcount(Cs, Acc+1); -pcount([{$P,_As,_F,_Ad,_P,_Pad,_Enc}|Cs], Acc) -> pcount(Cs, Acc+1); +pcount([#{control_char := $p}|Cs], Acc) -> pcount(Cs, Acc+1); +pcount([#{control_char := $P}|Cs], Acc) -> pcount(Cs, Acc+1); pcount([_|Cs], Acc) -> pcount(Cs, Acc); pcount([], Acc) -> Acc. -%% build([Control], Pc, Indentation) -> [Char]. +%% build([Control], Pc, Indentation) -> io_lib:chars(). %% Interpret the control structures. Count the number of print %% remaining and only calculate indentation when necessary. Must also %% be smart when calculating indentation for characters in format. -build([{C,As,F,Ad,P,Pad,Enc}|Cs], Pc0, I) -> - S = control(C, As, F, Ad, P, Pad, Enc, I), +build([#{control_char := C, args := As, width := F, adjust := Ad, + precision := P, pad_char := Pad, encoding := Enc, + strings := Str} | Cs], Pc0, I) -> + S = control(C, As, F, Ad, P, Pad, Enc, Str, I), Pc1 = decr_pc(C, Pc0), if Pc1 > 0 -> [S|build(Cs, Pc1, indentation(S, I))]; @@ -154,10 +236,14 @@ decr_pc($p, Pc) -> Pc - 1; decr_pc($P, Pc) -> Pc - 1; decr_pc(_, Pc) -> Pc. -%% indentation([Char], Indentation) -> Indentation. + %% Calculate the indentation of the end of a string given its start %% indentation. We assume tabs at 8 cols. +-spec indentation(String, StartIndent) -> integer() when + String :: io_lib:chars(), + StartIndent :: integer(). + indentation([$\n|Cs], _I) -> indentation(Cs, 0); indentation([$\t|Cs], I) -> indentation(Cs, ((I + 8) div 8) * 8); indentation([C|Cs], I) when is_integer(C) -> @@ -167,64 +253,63 @@ indentation([C|Cs], I) -> indentation([], I) -> I. %% control(FormatChar, [Argument], FieldWidth, Adjust, Precision, PadChar, -%% Indentation) -> -%% [Char] +%% Encoding, Indentation) -> String %% This is the main dispatch function for the various formatting commands. %% Field widths and precisions have already been calculated. -control($w, [A], F, Adj, P, Pad, _Enc,_I) -> +control($w, [A], F, Adj, P, Pad, _Enc, _Str, _I) -> term(io_lib:write(A, -1), F, Adj, P, Pad); -control($p, [A], F, Adj, P, Pad, _Enc, I) -> - print(A, -1, F, Adj, P, Pad, I); -control($W, [A,Depth], F, Adj, P, Pad, _Enc, _I) when is_integer(Depth) -> +control($p, [A], F, Adj, P, Pad, Enc, Str, I) -> + print(A, -1, F, Adj, P, Pad, Enc, Str, I); +control($W, [A,Depth], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(Depth) -> term(io_lib:write(A, Depth), F, Adj, P, Pad); -control($P, [A,Depth], F, Adj, P, Pad, _Enc, I) when is_integer(Depth) -> - print(A, Depth, F, Adj, P, Pad, I); -control($s, [A], F, Adj, P, Pad, _Enc, _I) when is_atom(A) -> +control($P, [A,Depth], F, Adj, P, Pad, Enc, Str, I) when is_integer(Depth) -> + print(A, Depth, F, Adj, P, Pad, Enc, Str, I); +control($s, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_atom(A) -> string(atom_to_list(A), F, Adj, P, Pad); -control($s, [L0], F, Adj, P, Pad, latin1, _I) -> +control($s, [L0], F, Adj, P, Pad, latin1, _Str, _I) -> L = iolist_to_chars(L0), string(L, F, Adj, P, Pad); -control($s, [L0], F, Adj, P, Pad, unicode, _I) -> - L = unicode:characters_to_list(L0), +control($s, [L0], F, Adj, P, Pad, unicode, _Str, _I) -> + L = cdata_to_chars(L0), uniconv(string(L, F, Adj, P, Pad)); -control($e, [A], F, Adj, P, Pad, _Enc, _I) when is_float(A) -> +control($e, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) -> fwrite_e(A, F, Adj, P, Pad); -control($f, [A], F, Adj, P, Pad, _Enc, _I) when is_float(A) -> +control($f, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) -> fwrite_f(A, F, Adj, P, Pad); -control($g, [A], F, Adj, P, Pad, _Enc, _I) when is_float(A) -> +control($g, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) -> fwrite_g(A, F, Adj, P, Pad); -control($b, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($b, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> unprefixed_integer(A, F, Adj, base(P), Pad, true); -control($B, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($B, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> unprefixed_integer(A, F, Adj, base(P), Pad, false); -control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _I) when is_integer(A), +control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A), is_atom(Prefix) -> prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), true); -control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list prefixed_integer(A, F, Adj, base(P), Pad, Prefix, true); -control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _I) when is_integer(A), +control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A), is_atom(Prefix) -> prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), false); -control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list prefixed_integer(A, F, Adj, base(P), Pad, Prefix, false); -control($+, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($+, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> Base = base(P), Prefix = [integer_to_list(Base), $#], prefixed_integer(A, F, Adj, Base, Pad, Prefix, true); -control($#, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($#, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> Base = base(P), Prefix = [integer_to_list(Base), $#], prefixed_integer(A, F, Adj, Base, Pad, Prefix, false); -control($c, [A], F, Adj, P, Pad, unicode, _I) when is_integer(A) -> +control($c, [A], F, Adj, P, Pad, unicode, _Str, _I) when is_integer(A) -> char(A, F, Adj, P, Pad); -control($c, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($c, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> char(A band 255, F, Adj, P, Pad); -control($~, [], F, Adj, P, Pad, _Enc, _I) -> char($~, F, Adj, P, Pad); -control($n, [], F, Adj, P, Pad, _Enc, _I) -> newline(F, Adj, P, Pad); -control($i, [_A], _F, _Adj, _P, _Pad, _Enc, _I) -> []. +control($~, [], F, Adj, P, Pad, _Enc, _Str, _I) -> char($~, F, Adj, P, Pad); +control($n, [], F, Adj, P, Pad, _Enc, _Str, _I) -> newline(F, Adj, P, Pad); +control($i, [_A], _F, _Adj, _P, _Pad, _Enc, _Str, _I) -> []. -ifdef(UNICODE_AS_BINARIES). uniconv(C) -> @@ -248,7 +333,7 @@ term(T, none, _Adj, none, _Pad) -> T; term(T, none, Adj, P, Pad) -> term(T, P, Adj, P, Pad); term(T, F, Adj, P0, Pad) -> L = lists:flatlength(T), - P = case P0 of none -> erlang:min(L, F); _ -> P0 end, + P = erlang:min(L, case P0 of none -> F; _ -> min(P0, F) end), if L > P -> adjust(chars($*, P), chars(Pad, F-P), Adj); @@ -256,13 +341,21 @@ term(T, F, Adj, P0, Pad) -> adjust(T, chars(Pad, F-L), Adj) end. -%% print(Term, Depth, Field, Adjust, Precision, PadChar, Indentation) +%% print(Term, Depth, Field, Adjust, Precision, PadChar, Encoding, +%% Indentation) %% Print a term. -print(T, D, none, Adj, P, Pad, I) -> print(T, D, 80, Adj, P, Pad, I); -print(T, D, F, Adj, none, Pad, I) -> print(T, D, F, Adj, I+1, Pad, I); -print(T, D, F, right, P, _Pad, _I) -> - io_lib_pretty:print(T, P, F, D). +print(T, D, none, Adj, P, Pad, E, Str, I) -> + print(T, D, 80, Adj, P, Pad, E, Str, I); +print(T, D, F, Adj, none, Pad, E, Str, I) -> + print(T, D, F, Adj, I+1, Pad, E, Str, I); +print(T, D, F, right, P, _Pad, Enc, Str, _I) -> + Options = [{column, P}, + {line_length, F}, + {depth, D}, + {encoding, Enc}, + {strings, Str}], + io_lib_pretty:print(T, Options). %% fwrite_e(Float, Field, Adjust, Precision, PadChar) @@ -351,7 +444,6 @@ float_data([D|Cs], Ds) when D >= $0, D =< $9 -> float_data([_|Cs], Ds) -> float_data(Cs, Ds). -%% fwrite_g(Float) %% Writes the shortest, correctly rounded string that converts %% to Float when read back with list_to_float/1. %% @@ -359,6 +451,8 @@ float_data([_|Cs], Ds) -> %% in Proceedings of the SIGPLAN '96 Conference on Programming %% Language Design and Implementation. +-spec fwrite_g(float()) -> string(). + fwrite_g(0.0) -> "0.0"; fwrite_g(Float) when is_float(Float) -> @@ -554,6 +648,25 @@ iolist_to_chars([]) -> iolist_to_chars(B) when is_binary(B) -> binary_to_list(B). +%% cdata() :: clist() | cbinary() +%% clist() :: maybe_improper_list(char() | cbinary() | clist(), +%% cbinary() | nil()) +%% cbinary() :: unicode:unicode_binary() | unicode:latin1_binary() + +%% cdata_to_chars(cdata()) -> io_lib:deep_char_list() + +cdata_to_chars([C|Cs]) when is_integer(C), C >= $\000 -> + [C | cdata_to_chars(Cs)]; +cdata_to_chars([I|Cs]) -> + [cdata_to_chars(I) | cdata_to_chars(Cs)]; +cdata_to_chars([]) -> + []; +cdata_to_chars(B) when is_binary(B) -> + case catch unicode:characters_to_list(B) of + L when is_list(L) -> L; + _ -> binary_to_list(B) + end. + %% string(String, Field, Adjust, Precision, PadChar) string(S, none, _Adj, none, _Pad) -> S; @@ -608,7 +721,7 @@ prefixed_integer(Int, F, Adj, Base, Pad, Prefix, Lowercase) term([Prefix|S], F, Adj, none, Pad) end. -%% char(Char, Field, Adjust, Precision, PadChar) -> [Char]. +%% char(Char, Field, Adjust, Precision, PadChar) -> chars(). char(C, none, _Adj, none, _Pad) -> [C]; char(C, F, _Adj, none, _Pad) -> chars(C, F); diff --git a/lib/stdlib/src/io_lib_fread.erl b/lib/stdlib/src/io_lib_fread.erl index ded1346097..6a8f8f728e 100644 --- a/lib/stdlib/src/io_lib_fread.erl +++ b/lib/stdlib/src/io_lib_fread.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -22,7 +23,7 @@ -export([fread/2,fread/3]). --import(lists, [reverse/1,reverse/2]). +-import(lists, [reverse/1]). -define(is_whitespace(C), ((C) =:= $\s orelse (C) =:= $\t @@ -41,9 +42,9 @@ Format :: string(), Return :: {'more', Continuation1 :: io_lib:continuation()} | {'done', Result, LeftOverChars :: string()}, - Result :: {'ok', InputList :: io_lib:chars()} + Result :: {'ok', InputList :: [io_lib:fread_item()]} | 'eof' - | {'error', What :: term()}. + | {'error', {'fread', What :: io_lib:fread_error()}}. fread([], Chars, Format) -> %%io:format("FREAD: ~w `~s'~n", [Format,Chars]), @@ -101,11 +102,12 @@ fread_line(Format0, Line, N0, Results0, More, Newline) -> -spec fread(Format, String) -> Result when Format :: string(), String :: string(), - Result :: {'ok', InputList :: io_lib:chars(), LeftOverChars :: string()} + Result :: {'ok', InputList :: [io_lib:fread_item()], + LeftOverChars :: string()} | {'more', RestFormat :: string(), Nchars :: non_neg_integer(), InputStack :: io_lib:chars()} - | {'error', What :: term()}. + | {'error', {'fread', What :: io_lib:fread_error()}}. fread(Format, Line) -> fread(Format, Line, 0, []). diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl index 169410796b..16ca2f41dc 100644 --- a/lib/stdlib/src/io_lib_pretty.erl +++ b/lib/stdlib/src/io_lib_pretty.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -33,43 +34,77 @@ %% print(Term, Column, LineLength, Depth) -> [Chars] %% Depth = -1 gives unlimited print depth. Use io_lib:write for atomic terms. +-spec print(term()) -> io_lib:chars(). + print(Term) -> print(Term, 1, 80, -1). %% print(Term, RecDefFun) -> [Chars] %% print(Term, Depth, RecDefFun) -> [Chars] %% RecDefFun = fun(Tag, NoFields) -> [FieldTag] | no -%% Used by the shell for printing records. +%% Used by the shell for printing records and for Unicode. + +-type rec_print_fun() :: fun((Tag :: atom(), NFields :: non_neg_integer()) -> + no | [FieldName :: atom()]). +-type column() :: integer(). +-type line_length() :: pos_integer(). +-type depth() :: integer(). +-type max_chars() :: integer(). + +-type chars() :: io_lib:chars(). +-type option() :: {column, column()} + | {line_length, line_length()} + | {depth, depth()} + | {max_chars, max_chars()} + | {record_print_fun, rec_print_fun()} + | {strings, boolean()} + | {encoding, latin1 | utf8 | unicode}. +-type options() :: [option()]. + +-spec print(term(), rec_print_fun()) -> chars(); + (term(), options()) -> chars(). + +print(Term, Options) when is_list(Options) -> + Col = get_option(column, Options, 1), + Ll = get_option(line_length, Options, 80), + D = get_option(depth, Options, -1), + M = get_option(max_chars, Options, -1), + RecDefFun = get_option(record_print_fun, Options, no_fun), + Encoding = get_option(encoding, Options, epp:default_encoding()), + Strings = get_option(strings, Options, true), + print(Term, Col, Ll, D, M, RecDefFun, Encoding, Strings); print(Term, RecDefFun) -> print(Term, -1, RecDefFun). +-spec print(term(), depth(), rec_print_fun()) -> chars(). + print(Term, Depth, RecDefFun) -> print(Term, 1, 80, Depth, RecDefFun). +-spec print(term(), column(), line_length(), depth()) -> chars(). + print(Term, Col, Ll, D) -> - print(Term, Col, Ll, D, _M=-1, no_fun). + print(Term, Col, Ll, D, _M=-1, no_fun, latin1, true). +-spec print(term(), column(), line_length(), depth(), rec_print_fun()) -> + chars(). print(Term, Col, Ll, D, RecDefFun) -> print(Term, Col, Ll, D, _M=-1, RecDefFun). -print(_, _, _, 0, _M, _RF) -> "..."; -print(Term, Col, Ll, D, M, RecDefFun) when Col =< 0 -> - print(Term, 1, Ll, D, M, RecDefFun); -print(Term, Col, Ll, D, M0, RecDefFun) when is_tuple(Term); - is_list(Term) -> - If = {_S, Len} = print_length(Term, D, RecDefFun), - M = max_cs(M0, Len), - if - Len < Ll - Col, Len =< M -> - write(If); - true -> - TInd = while_fail([-1, 4], - fun(I) -> cind(If, Col, Ll, M, I, 0, 0) end, - 1), - pp(If, Col, Ll, M, TInd, indent(Col), 0, 0) - end; -print(<<_/bitstring>>=Term, Col, Ll, D, M0, RecDefFun) -> - If = {_S, Len} = print_length(Term, D, RecDefFun), +-spec print(term(), column(), line_length(), depth(), max_chars(), + rec_print_fun()) -> chars(). + +print(Term, Col, Ll, D, M, RecDefFun) -> + print(Term, Col, Ll, D, M, RecDefFun, latin1, true). + +print(_, _, _, 0, _M, _RF, _Enc, _Str) -> "..."; +print(Term, Col, Ll, D, M, RecDefFun, Enc, Str) when Col =< 0 -> + print(Term, 1, Ll, D, M, RecDefFun, Enc, Str); +print(Term, Col, Ll, D, M0, RecDefFun, Enc, Str) when is_tuple(Term); + is_list(Term); + is_map(Term); + is_bitstring(Term) -> + If = {_S, Len} = print_length(Term, D, RecDefFun, Enc, Str), M = max_cs(M0, Len), if Len < Ll - Col, Len =< M -> @@ -80,7 +115,7 @@ print(<<_/bitstring>>=Term, Col, Ll, D, M0, RecDefFun) -> 1), pp(If, Col, Ll, M, TInd, indent(Col), 0, 0) end; -print(Term, _Col, _Ll, _D, _M, _RF) -> +print(Term, _Col, _Ll, _D, _M, _RF, _Enc, _Str) -> io_lib:write(Term). %%% @@ -104,6 +139,10 @@ pp({{tuple,true,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) -> [${, pp_tag_tuple(L, Col, Ll, M, TInd, Ind, LD, W + 1), $}]; pp({{tuple,false,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) -> [${, pp_list(L, Col + 1, Ll, M, TInd, indent(1, Ind), LD, $,, W + 1), $}]; +pp({{map,Pairs},_Len}, Col, Ll, M, TInd, Ind, LD, W) -> + [$#,${, pp_list(Pairs, Col + 2, Ll, M, TInd, indent(2, Ind), LD, $,, W + 1), $}]; +pp({{map_pair,K,V},_Len}, Col, Ll, M, TInd, Ind, LD, W) -> + [pp(K, Col, Ll, M, TInd, Ind, LD, W), " => ", pp(V, Col, Ll, M, TInd, Ind, LD, W)]; pp({{record,[{Name,NLen} | L]}, _Len}, Col, Ll, M, TInd, Ind, LD, W) -> [Name, ${, pp_record(L, NLen, Col, Ll, M, TInd, Ind, LD, W + NLen+1), $}]; pp({{bin,S}, _Len}, Col, Ll, M, _TInd, Ind, LD, W) -> @@ -250,6 +289,10 @@ write({{tuple, _IsTagged, L}, _}) -> [${, write_list(L, $,), $}]; write({{list, L}, _}) -> [$[, write_list(L, $|), $]]; +write({{map, Pairs}, _}) -> + [$#,${, write_list(Pairs, $,), $}]; +write({{map_pair, K, V}, _}) -> + [write(K)," => ",write(V)]; write({{record, [{Name,_} | L]}, _}) -> [Name, ${, write_fields(L), $}]; write({{bin, S}, _}) -> @@ -294,50 +337,60 @@ write_tail(E, S) -> %% counted but need to be added later. %% D =/= 0 -print_length([], _D, _RF) -> +print_length([], _D, _RF, _Enc, _Str) -> {"[]", 2}; -print_length({}, _D, _RF) -> +print_length({}, _D, _RF, _Enc, _Str) -> {"{}", 2}; -print_length(List, D, RF) when is_list(List) -> - case printable_list(List, D) of +print_length(#{}=M, _D, _RF, _Enc, _Str) when map_size(M) =:= 0 -> + {"#{}", 3}; +print_length(List, D, RF, Enc, Str) when is_list(List) -> + case Str andalso printable_list(List, D, Enc) of true -> - S = io_lib:write_string(List, $"), %" + S = write_string(List, Enc), {S, length(S)}; %% Truncated lists could break some existing code. % {true, Prefix} -> - % S = io_lib:write_string(Prefix, $"), %" + % S = write_string(Prefix, Enc), % {[S | "..."], 3 + length(S)}; false -> - print_length_list(List, D, RF) + print_length_list(List, D, RF, Enc, Str) end; -print_length(Fun, _D, _RF) when is_function(Fun) -> +print_length(Fun, _D, _RF, _Enc, _Str) when is_function(Fun) -> S = io_lib:write(Fun), {S, iolist_size(S)}; -print_length(R, D, RF) when is_atom(element(1, R)), - is_function(RF) -> +print_length(R, D, RF, Enc, Str) when is_atom(element(1, R)), + is_function(RF) -> case RF(element(1, R), tuple_size(R) - 1) of no -> - print_length_tuple(R, D, RF); + print_length_tuple(R, D, RF, Enc, Str); RDefs -> - print_length_record(R, D, RF, RDefs) + print_length_record(R, D, RF, RDefs, Enc, Str) end; -print_length(Tuple, D, RF) when is_tuple(Tuple) -> - print_length_tuple(Tuple, D, RF); -print_length(<<>>, _D, _RF) -> +print_length(Tuple, D, RF, Enc, Str) when is_tuple(Tuple) -> + print_length_tuple(Tuple, D, RF, Enc, Str); +print_length(Map, D, RF, Enc, Str) when is_map(Map) -> + print_length_map(Map, D, RF, Enc, Str); +print_length(<<>>, _D, _RF, _Enc, _Str) -> {"<<>>", 4}; -print_length(<<_/bitstring>>, 1, _RF) -> +print_length(<<_/bitstring>>, 1, _RF, _Enc, _Str) -> {"<<...>>", 7}; -print_length(<<_/bitstring>>=Bin, D, _RF) -> +print_length(<<_/bitstring>>=Bin, D, _RF, Enc, Str) -> case bit_size(Bin) rem 8 of 0 -> D1 = D - 1, - case printable_bin(Bin, D1) of - List when is_list(List) -> - S = io_lib:write_string(List, $"), + case Str andalso printable_bin(Bin, D1, Enc) of + {true, List} when is_list(List) -> + S = io_lib:write_string(List, $"), %" {[$<,$<,S,$>,$>], 4 + length(S)}; - {true, Prefix} -> - S = io_lib:write_string(Prefix, $"), - {[$<,$<, S | "...>>"], 4 + length(S)}; + {false, List} when is_list(List) -> + S = io_lib:write_string(List, $"), %" + {[$<,$<,S,"/utf8>>"], 9 + length(S)}; + {true, true, Prefix} -> + S = io_lib:write_string(Prefix, $"), %" + {[$<,$<, S | "...>>"], 7 + length(S)}; + {false, true, Prefix} -> + S = io_lib:write_string(Prefix, $"), %" + {[$<,$<, S | "/utf8...>>"], 12 + length(S)}; false -> S = io_lib:write(Bin, D), {{bin,S}, iolist_size(S)} @@ -346,51 +399,72 @@ print_length(<<_/bitstring>>=Bin, D, _RF) -> S = io_lib:write(Bin, D), {{bin,S}, iolist_size(S)} end; -print_length(Term, _D, _RF) -> +print_length(Term, _D, _RF, _Enc, _Str) -> S = io_lib:write(Term), - {S, iolist_size(S)}. + {S, lists:flatlength(S)}. + +print_length_map(_Map, 1, _RF, _Enc, _Str) -> + {"#{...}", 6}; +print_length_map(Map, D, RF, Enc, Str) when is_map(Map) -> + Pairs = print_length_map_pairs(maps:to_list(Map), D, RF, Enc, Str), + {{map, Pairs}, list_length(Pairs, 3)}. + +print_length_map_pairs([], _D, _RF, _Enc, _Str) -> + []; +print_length_map_pairs(_Pairs, 1, _RF, _Enc, _Str) -> + {dots, 3}; +print_length_map_pairs([{K,V}|Pairs], D, RF, Enc, Str) -> + [print_length_map_pair(K,V,D-1,RF,Enc,Str) | + print_length_map_pairs(Pairs,D-1,RF,Enc,Str)]. -print_length_tuple(_Tuple, 1, _RF) -> +print_length_map_pair(K, V, D, RF, Enc, Str) -> + {KS, KL} = print_length(K, D, RF, Enc, Str), + {VS, VL} = print_length(V, D, RF, Enc, Str), + {{map_pair, {KS,KL}, {VS,VL}}, KL + VL}. + +print_length_tuple(_Tuple, 1, _RF, _Enc, _Str) -> {"{...}", 5}; -print_length_tuple(Tuple, D, RF) -> - L = print_length_list1(tuple_to_list(Tuple), D, RF), +print_length_tuple(Tuple, D, RF, Enc, Str) -> + L = print_length_list1(tuple_to_list(Tuple), D, RF, Enc, Str), IsTagged = is_atom(element(1, Tuple)) and (tuple_size(Tuple) > 1), {{tuple,IsTagged,L}, list_length(L, 2)}. -print_length_record(_Tuple, 1, _RF, _RDefs) -> +print_length_record(_Tuple, 1, _RF, _RDefs, _Enc, _Str) -> {"{...}", 5}; -print_length_record(Tuple, D, RF, RDefs) -> +print_length_record(Tuple, D, RF, RDefs, Enc, Str) -> Name = [$# | io_lib:write_atom(element(1, Tuple))], NameL = length(Name), - L = print_length_fields(RDefs, D - 1, tl(tuple_to_list(Tuple)), RF), + Elements = tl(tuple_to_list(Tuple)), + L = print_length_fields(RDefs, D - 1, Elements, RF, Enc, Str), {{record, [{Name,NameL} | L]}, list_length(L, NameL + 2)}. -print_length_fields([], _D, [], _RF) -> +print_length_fields([], _D, [], _RF, _Enc, _Str) -> []; -print_length_fields(_, 1, _, _RF) -> +print_length_fields(_, 1, _, _RF, _Enc, _Str) -> {dots, 3}; -print_length_fields([Def | Defs], D, [E | Es], RF) -> - [print_length_field(Def, D - 1, E, RF) | - print_length_fields(Defs, D - 1, Es, RF)]. +print_length_fields([Def | Defs], D, [E | Es], RF, Enc, Str) -> + [print_length_field(Def, D - 1, E, RF, Enc, Str) | + print_length_fields(Defs, D - 1, Es, RF, Enc, Str)]. -print_length_field(Def, D, E, RF) -> +print_length_field(Def, D, E, RF, Enc, Str) -> Name = io_lib:write_atom(Def), - {S, L} = print_length(E, D, RF), + {S, L} = print_length(E, D, RF, Enc, Str), NameL = length(Name) + 3, {{field, Name, NameL, {S, L}}, NameL + L}. -print_length_list(List, D, RF) -> - L = print_length_list1(List, D, RF), +print_length_list(List, D, RF, Enc, Str) -> + L = print_length_list1(List, D, RF, Enc, Str), {{list, L}, list_length(L, 2)}. -print_length_list1([], _D, _RF) -> +print_length_list1([], _D, _RF, _Enc, _Str) -> []; -print_length_list1(_, 1, _RF) -> +print_length_list1(_, 1, _RF, _Enc, _Str) -> {dots, 3}; -print_length_list1([E | Es], D, RF) -> - [print_length(E, D - 1, RF) | print_length_list1(Es, D - 1, RF)]; -print_length_list1(E, D, RF) -> - print_length(E, D - 1, RF). +print_length_list1([E | Es], D, RF, Enc, Str) -> + [print_length(E, D - 1, RF, Enc, Str) | + print_length_list1(Es, D - 1, RF, Enc, Str)]; +print_length_list1(E, D, RF, Enc, Str) -> + print_length(E, D - 1, RF, Enc, Str). list_length([], Acc) -> Acc; @@ -409,51 +483,53 @@ list_length_tail({_, Len}, Acc) -> %% ?CHARS printable characters has depth 1. -define(CHARS, 4). -printable_list(L, D) when D < 0 -> - io_lib:printable_list(L); -printable_list(_L, 1) -> +printable_list(_L, 1, _Enc) -> false; -printable_list(L, _D) -> +printable_list(L, _D, latin1) -> + io_lib:printable_latin1_list(L); +printable_list(L, _D, _Uni) -> io_lib:printable_list(L). -%% Truncated lists could break some existing code. -% printable_list(L, D) -> -% Len = ?CHARS * (D - 1), -% case printable_list1(L, Len) of -% all -> -% true; -% N when is_integer(N), Len - N >= D - 1 -> -% {L1, _} = lists:split(Len - N, L), -% {true, L1}; -% N when is_integer(N) -> -% false -% end. - -printable_bin(Bin, D) when D >= 0, ?CHARS * D =< byte_size(Bin) -> - printable_bin(Bin, erlang:min(?CHARS * D, byte_size(Bin)), D); -printable_bin(Bin, D) -> - printable_bin(Bin, byte_size(Bin), D). - -printable_bin(Bin, Len, D) -> + +printable_bin(Bin, D, Enc) when D >= 0, ?CHARS * D =< byte_size(Bin) -> + printable_bin(Bin, erlang:min(?CHARS * D, byte_size(Bin)), D, Enc); +printable_bin(Bin, D, Enc) -> + printable_bin(Bin, byte_size(Bin), D, Enc). + +printable_bin(Bin, Len, D, latin1) -> N = erlang:min(20, Len), L = binary_to_list(Bin, 1, N), - case printable_list1(L, N) of + case printable_latin1_list(L, N) of all when N =:= byte_size(Bin) -> - L; - all when N =:= Len -> % N < byte_size(Bin) {true, L}; + all when N =:= Len -> % N < byte_size(Bin) + {true, true, L}; all -> case printable_bin1(Bin, 1 + N, Len - N) of 0 when byte_size(Bin) =:= Len -> - binary_to_list(Bin); + {true, binary_to_list(Bin)}; NC when D > 0, Len - NC >= D -> - {true, binary_to_list(Bin, 1, Len - NC)}; + {true, true, binary_to_list(Bin, 1, Len - NC)}; NC when is_integer(NC) -> false end; NC when is_integer(NC), D > 0, N - NC >= D -> - {true, binary_to_list(Bin, 1, N - NC)}; + {true, true, binary_to_list(Bin, 1, N - NC)}; NC when is_integer(NC) -> false + end; +printable_bin(Bin, Len, D, _Uni) -> + case valid_utf8(Bin,Len) of + true -> + case printable_unicode(Bin, Len, [], io:printable_range()) of + {_, <<>>, L} -> + {byte_size(Bin) =:= length(L), L}; + {NC, Bin1, L} when D > 0, Len - NC >= D -> + {byte_size(Bin)-byte_size(Bin1) =:= length(L), true, L}; + {_NC, _Bin, _L} -> + false + end; + false -> + printable_bin(Bin, Len, D, latin1) end. printable_bin1(_Bin, _Start, 0) -> @@ -461,7 +537,7 @@ printable_bin1(_Bin, _Start, 0) -> printable_bin1(Bin, Start, Len) -> N = erlang:min(10000, Len), L = binary_to_list(Bin, Start, Start + N - 1), - case printable_list1(L, N) of + case printable_latin1_list(L, N) of all -> printable_bin1(Bin, Start + N, Len - N); NC when is_integer(NC) -> @@ -469,20 +545,60 @@ printable_bin1(Bin, Start, Len) -> end. %% -> all | integer() >=0. Adopted from io_lib.erl. -% printable_list1([_ | _], 0) -> 0; -printable_list1([C | Cs], N) when is_integer(C), C >= $\s, C =< $~ -> - printable_list1(Cs, N - 1); -printable_list1([C | Cs], N) when is_integer(C), C >= $\240, C =< $\377 -> - printable_list1(Cs, N - 1); -printable_list1([$\n | Cs], N) -> printable_list1(Cs, N - 1); -printable_list1([$\r | Cs], N) -> printable_list1(Cs, N - 1); -printable_list1([$\t | Cs], N) -> printable_list1(Cs, N - 1); -printable_list1([$\v | Cs], N) -> printable_list1(Cs, N - 1); -printable_list1([$\b | Cs], N) -> printable_list1(Cs, N - 1); -printable_list1([$\f | Cs], N) -> printable_list1(Cs, N - 1); -printable_list1([$\e | Cs], N) -> printable_list1(Cs, N - 1); -printable_list1([], _) -> all; -printable_list1(_, N) -> N. +% printable_latin1_list([_ | _], 0) -> 0; +printable_latin1_list([C | Cs], N) when C >= $\s, C =< $~ -> + printable_latin1_list(Cs, N - 1); +printable_latin1_list([C | Cs], N) when C >= $\240, C =< $\377 -> + printable_latin1_list(Cs, N - 1); +printable_latin1_list([$\n | Cs], N) -> printable_latin1_list(Cs, N - 1); +printable_latin1_list([$\r | Cs], N) -> printable_latin1_list(Cs, N - 1); +printable_latin1_list([$\t | Cs], N) -> printable_latin1_list(Cs, N - 1); +printable_latin1_list([$\v | Cs], N) -> printable_latin1_list(Cs, N - 1); +printable_latin1_list([$\b | Cs], N) -> printable_latin1_list(Cs, N - 1); +printable_latin1_list([$\f | Cs], N) -> printable_latin1_list(Cs, N - 1); +printable_latin1_list([$\e | Cs], N) -> printable_latin1_list(Cs, N - 1); +printable_latin1_list([], _) -> all; +printable_latin1_list(_, N) -> N. + +valid_utf8(<<>>,_) -> + true; +valid_utf8(_,0) -> + true; +valid_utf8(<<_/utf8, R/binary>>,N) -> + valid_utf8(R,N-1); +valid_utf8(_,_) -> + false. + +printable_unicode(<<C/utf8, R/binary>>=Bin, I, L, Range) when I > 0 -> + case printable_char(C,Range) of + true -> + printable_unicode(R, I - 1, [C | L],Range); + false -> + {I, Bin, lists:reverse(L)} + end; +printable_unicode(Bin, I, L,_) -> + {I, Bin, lists:reverse(L)}. + +printable_char($\n,_) -> true; +printable_char($\r,_) -> true; +printable_char($\t,_) -> true; +printable_char($\v,_) -> true; +printable_char($\b,_) -> true; +printable_char($\f,_) -> true; +printable_char($\e,_) -> true; +printable_char(C,latin1) -> + C >= $\s andalso C =< $~ orelse + C >= 16#A0 andalso C =< 16#FF; +printable_char(C,unicode) -> + C >= $\s andalso C =< $~ orelse + C >= 16#A0 andalso C < 16#D800 orelse + C > 16#DFFF andalso C < 16#FFFE orelse + C > 16#FFFF andalso C =< 16#10FFFF. + +write_string(S, latin1) -> + io_lib:write_latin1_string(S, $"); %" +write_string(S, _Uni) -> + io_lib:write_string(S, $"). %" %% Throw 'no_good' if the indentation exceeds half the line length %% unless there is room for M characters on the line. @@ -644,3 +760,10 @@ chars(C, N) when (N band 1) =:= 0 -> chars(C, N) -> S = chars(C, N bsr 1), [C, S | S]. + +get_option(Key, TupleList, Default) -> + case lists:keyfind(Key, 1, TupleList) of + false -> Default; + {Key, Value} -> Value; + _ -> Default + end. diff --git a/lib/stdlib/src/lib.erl b/lib/stdlib/src/lib.erl index cf4b87d7eb..56654097d9 100644 --- a/lib/stdlib/src/lib.erl +++ b/lib/stdlib/src/lib.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -21,8 +22,9 @@ -export([flush_receive/0, error_message/2, progname/0, nonl/1, send/2, sendw/2, eval_str/1]). --export([format_exception/6, format_stacktrace/4, - format_call/4, format_fun/1]). +-export([format_exception/6, format_exception/7, + format_stacktrace/4, format_stacktrace/5, + format_call/4, format_call/5, format_fun/1]). -spec flush_receive() -> 'ok'. @@ -43,7 +45,7 @@ flush_receive() -> Args :: [term()]. error_message(Format, Args) -> - io:format(<<"** ~s **\n">>, [io_lib:format(Format, Args)]). + io:format(<<"** ~ts **\n">>, [io_lib:format(Format, Args)]). %% Return the name of the script that starts (this) erlang %% @@ -71,7 +73,7 @@ nonl([H|T]) -> [H|nonl(T)]. send(To, Msg) -> To ! Msg. --spec sendw(To, Msg) -> Msg when +-spec sendw(To, Msg) -> term() when To :: pid() | atom() | {atom(), node()}, Msg :: term(). @@ -83,10 +85,14 @@ sendw(To, Msg) -> %% eval_str(InStr) -> {ok, OutStr} | {error, ErrStr'} %% InStr must represent a body +%% Note: If InStr is a binary it has to be a Latin-1 string. +%% If you have a UTF-8 encoded binary you have to call +%% unicode:characters_to_list/1 before the call to eval_str(). -define(result(F,D), lists:flatten(io_lib:format(F, D))). --spec eval_str(string() | binary()) -> {'ok', string()} | {'error', string()}. +-spec eval_str(string() | unicode:latin1_binary()) -> + {'ok', string()} | {'error', string()}. eval_str(Str) when is_list(Str) -> case erl_scan:tokens([], Str, 0) of @@ -104,12 +110,12 @@ eval_str(Str) when is_list(Str) -> {error, ?result("*** eval: ~p", [Other])} end; {error, {_Line, Mod, Args}} -> - Msg = ?result("*** ~s",[Mod:format_error(Args)]), + Msg = ?result("*** ~ts",[Mod:format_error(Args)]), {error, Msg} end; false -> {error, ?result("Non-white space found after " - "end-of-form :~s", [Rest])} + "end-of-form :~ts", [Rest])} end end; eval_str(Bin) when is_binary(Bin) -> @@ -128,32 +134,49 @@ all_white(_) -> false. %% as indentation whenever newline has been inserted); %% Class, Reason and StackTrace are the exception; %% FormatFun = fun(Term, I) -> iolist() formats terms; -%% StackFun = fun(Mod, Fun, Arity) -> bool() is used for trimming the +%% StackFun = fun(Mod, Fun, Arity) -> boolean() is used for trimming the %% end of the stack (typically calls to erl_eval are skipped). -format_exception(I, Class, Reason, StackTrace, StackFun, FormatFun) +format_exception(I, Class, Reason, StackTrace, StackFun, FormatFun) -> + format_exception(I, Class, Reason, StackTrace, StackFun, FormatFun, + latin1). + +%% -> iolist() | unicode:charlist() (no \n at end) +%% FormatFun = fun(Term, I) -> iolist() | unicode:charlist(). +format_exception(I, Class, Reason, StackTrace, StackFun, FormatFun, Encoding) when is_integer(I), I >= 1, is_function(StackFun, 3), is_function(FormatFun, 2) -> S = n_spaces(I-1), {Term,Trace1,Trace} = analyze_exception(Class, Reason, StackTrace), - Expl0 = explain_reason(Term, Class, Trace1, FormatFun, S), - Expl = io_lib:fwrite(<<"~s~s">>, [exited(Class), Expl0]), - case format_stacktrace1(S, Trace, FormatFun, StackFun) of + Expl0 = explain_reason(Term, Class, Trace1, FormatFun, S, Encoding), + FormatString = case Encoding of + latin1 -> "~s~s"; + _ -> "~s~ts" + end, + Expl = io_lib:fwrite(FormatString, [exited(Class), Expl0]), + case format_stacktrace1(S, Trace, FormatFun, StackFun, Encoding) of [] -> Expl; Stack -> [Expl, $\n, Stack] end. %% -> iolist() (no \n at end) -format_stacktrace(I, StackTrace, StackFun, FormatFun) +format_stacktrace(I, StackTrace, StackFun, FormatFun) -> + format_stacktrace(I, StackTrace, StackFun, FormatFun, latin1). + +%% -> iolist() | unicode:charlist() (no \n at end) +format_stacktrace(I, StackTrace, StackFun, FormatFun, Encoding) when is_integer(I), I >= 1, is_function(StackFun, 3), is_function(FormatFun, 2) -> S = n_spaces(I-1), - format_stacktrace1(S, StackTrace, FormatFun, StackFun). + format_stacktrace1(S, StackTrace, FormatFun, StackFun, Encoding). %% -> iolist() (no \n at end) -format_call(I, ForMForFun, As, FormatFun) when is_integer(I), I >= 1, - is_list(As), - is_function(FormatFun, 2) -> - format_call("", n_spaces(I-1), ForMForFun, As, FormatFun). +format_call(I, ForMForFun, As, FormatFun) -> + format_call(I, ForMForFun, As, FormatFun, latin1). + +%% -> iolist() | unicode:charlist() (no \n at end) +format_call(I, ForMForFun, As, FormatFun, Enc) + when is_integer(I), I >= 1, is_list(As), is_function(FormatFun, 2) -> + format_call("", n_spaces(I-1), ForMForFun, As, FormatFun, Enc). %% -> iolist() (no \n at end) format_fun(Fun) when is_function(Fun) -> @@ -204,79 +227,80 @@ is_stacktrace(_) -> false. %% ERTS exit codes (some of them are also returned by erl_eval): -explain_reason(badarg, error, [], _PF, _S) -> +explain_reason(badarg, error, [], _PF, _S, _Enc) -> <<"bad argument">>; -explain_reason({badarg,V}, error=Cl, [], PF, S) -> % orelse, andalso +explain_reason({badarg,V}, error=Cl, [], PF, S, _Enc) -> % orelse, andalso format_value(V, <<"bad argument: ">>, Cl, PF, S); -explain_reason(badarith, error, [], _PF, _S) -> +explain_reason(badarith, error, [], _PF, _S, _Enc) -> <<"an error occurred when evaluating an arithmetic expression">>; -explain_reason({badarity,{Fun,As}}, error, [], _PF, _S) +explain_reason({badarity,{Fun,As}}, error, [], _PF, _S, _Enc) when is_function(Fun) -> %% Only the arity is displayed, not the arguments As. io_lib:fwrite(<<"~s called with ~s">>, [format_fun(Fun), argss(length(As))]); -explain_reason({badfun,Term}, error=Cl, [], PF, S) -> +explain_reason({badfun,Term}, error=Cl, [], PF, S, _Enc) -> format_value(Term, <<"bad function ">>, Cl, PF, S); -explain_reason({badmatch,Term}, error=Cl, [], PF, S) -> - format_value(Term, <<"no match of right hand side value ">>, Cl, PF, S); -explain_reason({case_clause,V}, error=Cl, [], PF, S) -> +explain_reason({badmatch,Term}, error=Cl, [], PF, S, _Enc) -> + Str = <<"no match of right hand side value ">>, + format_value(Term, Str, Cl, PF, S); +explain_reason({case_clause,V}, error=Cl, [], PF, S, _Enc) -> %% "there is no case clause with a true guard sequence and a %% pattern matching..." format_value(V, <<"no case clause matching ">>, Cl, PF, S); -explain_reason(function_clause, error, [{F,A}], _PF, _S) -> +explain_reason(function_clause, error, [{F,A}], _PF, _S, _Enc) -> %% Shell commands FAs = io_lib:fwrite(<<"~w/~w">>, [F, A]), [<<"no function clause matching call to ">> | FAs]; -explain_reason(function_clause, error=Cl, [{M,F,As,Loc}], PF, S) -> +explain_reason(function_clause, error=Cl, [{M,F,As,Loc}], PF, S, Enc) -> Str = <<"no function clause matching ">>, - [format_errstr_call(Str, Cl, {M,F}, As, PF, S),$\s|location(Loc)]; -explain_reason(if_clause, error, [], _PF, _S) -> + [format_errstr_call(Str, Cl, {M,F}, As, PF, S, Enc),$\s|location(Loc)]; +explain_reason(if_clause, error, [], _PF, _S, _Enc) -> <<"no true branch found when evaluating an if expression">>; -explain_reason(noproc, error, [], _PF, _S) -> +explain_reason(noproc, error, [], _PF, _S, _Enc) -> <<"no such process or port">>; -explain_reason(notalive, error, [], _PF, _S) -> +explain_reason(notalive, error, [], _PF, _S, _Enc) -> <<"the node cannot be part of a distributed system">>; -explain_reason(system_limit, error, [], _PF, _S) -> +explain_reason(system_limit, error, [], _PF, _S, _Enc) -> <<"a system limit has been reached">>; -explain_reason(timeout_value, error, [], _PF, _S) -> +explain_reason(timeout_value, error, [], _PF, _S, _Enc) -> <<"bad receive timeout value">>; -explain_reason({try_clause,V}, error=Cl, [], PF, S) -> +explain_reason({try_clause,V}, error=Cl, [], PF, S, _Enc) -> %% "there is no try clause with a true guard sequence and a %% pattern matching..." format_value(V, <<"no try clause matching ">>, Cl, PF, S); -explain_reason(undef, error, [{M,F,A,_}], _PF, _S) -> +explain_reason(undef, error, [{M,F,A,_}], _PF, _S, _Enc) -> %% Only the arity is displayed, not the arguments, if there are any. io_lib:fwrite(<<"undefined function ~s">>, [mfa_to_string(M, F, n_args(A))]); -explain_reason({shell_undef,F,A,_}, error, [], _PF, _S) -> +explain_reason({shell_undef,F,A,_}, error, [], _PF, _S, _Enc) -> %% Give nicer reports for undefined shell functions %% (but not when the user actively calls shell_default:F(...)). io_lib:fwrite(<<"undefined shell command ~s/~w">>, [F, n_args(A)]); %% Exit codes returned by erl_eval only: -explain_reason({argument_limit,_Fun}, error, [], _PF, _S) -> +explain_reason({argument_limit,_Fun}, error, [], _PF, _S, _Enc) -> io_lib:fwrite(<<"limit of number of arguments to interpreted function" " exceeded">>, []); -explain_reason({bad_filter,V}, error=Cl, [], PF, S) -> +explain_reason({bad_filter,V}, error=Cl, [], PF, S, _Enc) -> format_value(V, <<"bad filter ">>, Cl, PF, S); -explain_reason({bad_generator,V}, error=Cl, [], PF, S) -> +explain_reason({bad_generator,V}, error=Cl, [], PF, S, _Enc) -> format_value(V, <<"bad generator ">>, Cl, PF, S); -explain_reason({unbound,V}, error, [], _PF, _S) -> +explain_reason({unbound,V}, error, [], _PF, _S, _Enc) -> io_lib:fwrite(<<"variable ~w is unbound">>, [V]); %% Exit codes local to the shell module (restricted shell): -explain_reason({restricted_shell_bad_return, V}, exit=Cl, [], PF, S) -> +explain_reason({restricted_shell_bad_return, V}, exit=Cl, [], PF, S, _Enc) -> Str = <<"restricted shell module returned bad value ">>, format_value(V, Str, Cl, PF, S); explain_reason({restricted_shell_disallowed,{ForMF,As}}, - exit=Cl, [], PF, S) -> + exit=Cl, [], PF, S, Enc) -> %% ForMF can be a fun, but not a shell fun. Str = <<"restricted shell does not allow ">>, - format_errstr_call(Str, Cl, ForMF, As, PF, S); -explain_reason(restricted_shell_started, exit, [], _PF, _S) -> + format_errstr_call(Str, Cl, ForMF, As, PF, S, Enc); +explain_reason(restricted_shell_started, exit, [], _PF, _S, _Enc) -> <<"restricted shell starts now">>; -explain_reason(restricted_shell_stopped, exit, [], _PF, _S) -> +explain_reason(restricted_shell_stopped, exit, [], _PF, _S, _Enc) -> <<"restricted shell stopped">>; %% Other exit code: -explain_reason(Reason, Class, [], PF, S) -> +explain_reason(Reason, Class, [], PF, S, _Enc) -> PF(Reason, (iolist_size(S)+1) + exited_size(Class)). n_args(A) when is_integer(A) -> @@ -293,28 +317,28 @@ argss(2) -> argss(I) -> io_lib:fwrite(<<"~w arguments">>, [I]). -format_stacktrace1(S0, Stack0, PF, SF) -> +format_stacktrace1(S0, Stack0, PF, SF, Enc) -> Stack1 = lists:dropwhile(fun({M,F,A,_}) -> SF(M, F, A) end, lists:reverse(Stack0)), S = [" " | S0], Stack = lists:reverse(Stack1), - format_stacktrace2(S, Stack, 1, PF). + format_stacktrace2(S, Stack, 1, PF, Enc). -format_stacktrace2(S, [{M,F,A,L}|Fs], N, PF) when is_integer(A) -> +format_stacktrace2(S, [{M,F,A,L}|Fs], N, PF, Enc) when is_integer(A) -> [io_lib:fwrite(<<"~s~s ~s ~s">>, [sep(N, S), origin(N, M, F, A), mfa_to_string(M, F, A), location(L)]) - | format_stacktrace2(S, Fs, N + 1, PF)]; -format_stacktrace2(S, [{M,F,As,_}|Fs], N, PF) when is_list(As) -> + | format_stacktrace2(S, Fs, N + 1, PF, Enc)]; +format_stacktrace2(S, [{M,F,As,_}|Fs], N, PF, Enc) when is_list(As) -> A = length(As), CalledAs = [S,<<" called as ">>], - C = format_call("", CalledAs, {M,F}, As, PF), - [io_lib:fwrite(<<"~s~s ~s\n~s~s">>, + C = format_call("", CalledAs, {M,F}, As, PF, Enc), + [io_lib:fwrite(<<"~s~s ~s\n~s~ts">>, [sep(N, S), origin(N, M, F, A), mfa_to_string(M, F, A), CalledAs, C]) - | format_stacktrace2(S, Fs, N + 1, PF)]; -format_stacktrace2(_S, [], _N, _PF) -> + | format_stacktrace2(S, Fs, N + 1, PF, Enc)]; +format_stacktrace2(_S, [], _N, _PF, _Enc) -> "". location(L) -> @@ -338,22 +362,22 @@ origin(1, M, F, A) -> origin(_N, _M, _F, _A) -> <<"in call from">>. -format_errstr_call(ErrStr, Class, ForMForFun, As, PF, Pre0) -> +format_errstr_call(ErrStr, Class, ForMForFun, As, PF, Pre0, Enc) -> Pre1 = [Pre0 | n_spaces(exited_size(Class))], - format_call(ErrStr, Pre1, ForMForFun, As, PF). + format_call(ErrStr, Pre1, ForMForFun, As, PF, Enc). -format_call(ErrStr, Pre1, ForMForFun, As, PF) -> +format_call(ErrStr, Pre1, ForMForFun, As, PF, Enc) -> Arity = length(As), [ErrStr | case is_op(ForMForFun, Arity) of {yes,Op} -> - format_op(ErrStr, Pre1, Op, As, PF); + format_op(ErrStr, Pre1, Op, As, PF, Enc); no -> MFs = mf_to_string(ForMForFun, Arity), I1 = iolist_size([Pre1,ErrStr|MFs]), - S1 = pp_arguments(PF, As, I1), - S2 = pp_arguments(PF, As, iolist_size([Pre1|MFs])), - Long = count_nl(pp_arguments(PF, [a2345,b2345], I1)) > 0, + S1 = pp_arguments(PF, As, I1, Enc), + S2 = pp_arguments(PF, As, iolist_size([Pre1|MFs]), Enc), + Long = count_nl(pp_arguments(PF, [a2345,b2345], I1, Enc)) > 0, case Long or (count_nl(S2) < count_nl(S1)) of true -> [$\n, Pre1, MFs, S2]; @@ -362,11 +386,11 @@ format_call(ErrStr, Pre1, ForMForFun, As, PF) -> end end]. -format_op(ErrStr, Pre, Op, [A1], PF) -> +format_op(ErrStr, Pre, Op, [A1], PF, _Enc) -> OpS = io_lib:fwrite(<<"~s ">>, [Op]), I1 = iolist_size([ErrStr,Pre,OpS]), [OpS | PF(A1, I1+1)]; -format_op(ErrStr, Pre, Op, [A1, A2], PF) -> +format_op(ErrStr, Pre, Op, [A1, A2], PF, Enc) -> I1 = iolist_size([ErrStr,Pre]), S1 = PF(A1, I1+1), S2 = PF(A2, I1+1), @@ -377,33 +401,40 @@ format_op(ErrStr, Pre, Op, [A1, A2], PF) -> [S1,Pre1,OpS,Pre1|S2]; false -> OpS2 = io_lib:fwrite(<<" ~s ">>, [Op]), - S2_2 = PF(A2, iolist_size([ErrStr,Pre,S1|OpS2])+1), + Size1 = iolist_size([ErrStr,Pre|OpS2]), + {Size2,S1_2} = size(Enc, S1), + S2_2 = PF(A2, Size1+Size2+1), case count_nl(S2) < count_nl(S2_2) of true -> - [S1,Pre1,OpS,Pre1|S2]; + [S1_2,Pre1,OpS,Pre1|S2]; false -> - [S1,OpS2|S2_2] + [S1_2,OpS2|S2_2] end end. -pp_arguments(PF, As, I) -> - case {As, io_lib:printable_list(As)} of +pp_arguments(PF, As, I, Enc) -> + case {As, printable_list(Enc, As)} of {[Int | T], true} -> L = integer_to_list(Int), Ll = length(L), A = list_to_atom(lists:duplicate(Ll, $a)), - S0 = binary_to_list(iolist_to_binary(PF([A | T], I+1))), - brackets_to_parens([$[,L,string:sub_string(S0, 2+Ll)]); + S0 = unicode:characters_to_list(PF([A | T], I+1), Enc), + brackets_to_parens([$[,L,string:sub_string(S0, 2+Ll)], Enc); _ -> - brackets_to_parens(PF(As, I+1)) + brackets_to_parens(PF(As, I+1), Enc) end. -brackets_to_parens(S) -> - B = iolist_to_binary(S), +brackets_to_parens(S, Enc) -> + B = unicode:characters_to_binary(S, Enc), Sz = byte_size(B) - 2, <<$[,R:Sz/binary,$]>> = B, [$(,R,$)]. +printable_list(latin1, As) -> + io_lib:printable_latin1_list(As); +printable_list(_, As) -> + io_lib:printable_list(As). + mfa_to_string(M, F, A) -> io_lib:fwrite(<<"~s/~w">>, [mf_to_string({M, F}, A), A]). @@ -472,3 +503,10 @@ exited(exit) -> <<"exception exit: ">>; exited(throw) -> <<"exception throw: ">>. + +size(latin1, S) -> + {iolist_size(S),S}; +size(_, S0) -> + S = unicode:characters_to_list(S0, unicode), + true = is_list(S), + {length(S),S}. diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl index e73c087753..af9d63ddd6 100644 --- a/lib/stdlib/src/lists.erl +++ b/lib/stdlib/src/lists.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -22,7 +23,7 @@ -compile({no_auto_import,[min/2]}). -export([append/2, append/1, subtract/2, reverse/1, - nth/2, nthtail/2, prefix/2, suffix/2, last/1, + nth/2, nthtail/2, prefix/2, suffix/2, droplast/1, last/1, seq/2, seq/3, sum/1, duplicate/2, min/1, max/1, sublist/2, sublist/3, delete/2, unzip/1, unzip3/1, zip/2, zip3/3, zipwith/3, zipwith3/4, @@ -33,15 +34,67 @@ keysort/2, keymerge/3, rkeymerge/3, rukeymerge/3, ukeysort/2, ukeymerge/3, keymap/3]). -%% Bifs: member/2, reverse/2 -%% Bifs: keymember/3, keysearch/3, keyfind/3 - -export([merge/3, rmerge/3, sort/2, umerge/3, rumerge/3, usort/2]). -export([all/2,any/2,map/2,flatmap/2,foldl/3,foldr/3,filter/2, - partition/2,zf/2, + partition/2,zf/2,filtermap/2, mapfoldl/3,mapfoldr/3,foreach/2,takewhile/2,dropwhile/2,splitwith/2, - split/2]). + split/2, + join/2]). + +%%% BIFs +-export([keyfind/3, keymember/3, keysearch/3, member/2, reverse/2]). + +%% Shadowed by erl_bif_types: lists:keyfind/3 +-spec keyfind(Key, N, TupleList) -> Tuple | false when + Key :: term(), + N :: pos_integer(), + TupleList :: [Tuple], + Tuple :: tuple(). + +keyfind(_, _, _) -> + erlang:nif_error(undef). + +%% Shadowed by erl_bif_types: lists:keymember/3 +-spec keymember(Key, N, TupleList) -> boolean() when + Key :: term(), + N :: pos_integer(), + TupleList :: [Tuple], + Tuple :: tuple(). + +keymember(_, _, _) -> + erlang:nif_error(undef). + +%% Shadowed by erl_bif_types: lists:keysearch/3 +-spec keysearch(Key, N, TupleList) -> {value, Tuple} | false when + Key :: term(), + N :: pos_integer(), + TupleList :: [Tuple], + Tuple :: tuple(). + +keysearch(_, _, _) -> + erlang:nif_error(undef). + +%% Shadowed by erl_bif_types: lists:member/2 +-spec member(Elem, List) -> boolean() when + Elem :: T, + List :: [T], + T :: term(). + +member(_, _) -> + erlang:nif_error(undef). + +%% Shadowed by erl_bif_types: lists:reverse/2 +-spec reverse(List1, Tail) -> List2 when + List1 :: [T], + Tail :: term(), + List2 :: [T], + T :: term(). + +reverse(_, _) -> + erlang:nif_error(undef). + +%%% End of BIFs %% member(X, L) -> (true | false) %% test if X is a member of the list L @@ -84,7 +137,7 @@ append([]) -> []. subtract(L1, L2) -> L1 -- L2. -%% reverse(L) reverse all elements in the list L. Is now a BIF! +%% reverse(L) reverse all elements in the list L. reverse/2 is now a BIF! -spec reverse(List1) -> List2 when List1 :: [T], @@ -152,6 +205,19 @@ suffix(Suffix, List) -> Delta = length(List) - length(Suffix), Delta >= 0 andalso nthtail(Delta, List) =:= Suffix. +%% droplast(List) returns the list dropping its last element + +-spec droplast(List) -> InitList when + List :: [T, ...], + InitList :: [T], + T :: term(). + +%% This is the simple recursive implementation +%% reverse(tl(reverse(L))) is faster on average, +%% but creates more garbage. +droplast([_T]) -> []; +droplast([H|T]) -> [H|droplast(T)]. + %% last(List) returns the last element in a list. -spec last(List) -> Last when @@ -579,8 +645,9 @@ flatlength([H|T], L) when is_list(H) -> flatlength([_|T], L) -> flatlength(T, L + 1); flatlength([], L) -> L. - + %% keymember(Key, Index, [Tuple]) Now a BIF! +%% keyfind(Key, Index, [Tuple]) A BIF! %% keysearch(Key, Index, [Tuple]) Now a BIF! %% keydelete(Key, Index, [Tuple]) %% keyreplace(Key, Index, [Tuple], NewTuple) @@ -1111,7 +1178,7 @@ rumerge(T1, []) -> T1; rumerge(T1, [H2 | T2]) -> lists:reverse(rumerge2_1(T1, T2, [], H2), []). - + %% all(Predicate, List) %% any(Predicate, List) %% map(Function, List) @@ -1126,8 +1193,7 @@ rumerge(T1, [H2 | T2]) -> %% takewhile(Predicate, List) %% dropwhile(Predicate, List) %% splitwith(Predicate, List) -%% for list programming. Function here is a 'fun'. For backward compatibility, -%% {Module,Function} is still accepted. +%% for list programming. Function here is a 'fun'. %% %% The name zf is a joke! %% @@ -1240,18 +1306,28 @@ partition(Pred, [H | T], As, Bs) -> partition(Pred, [], As, Bs) when is_function(Pred, 1) -> {reverse(As), reverse(Bs)}. --spec zf(fun((T) -> boolean() | {'true', X}), [T]) -> [(T | X)]. +-spec filtermap(Fun, List1) -> List2 when + Fun :: fun((Elem) -> boolean() | {'true', Value}), + List1 :: [Elem], + List2 :: [Elem | Value], + Elem :: term(), + Value :: term(). -zf(F, [Hd|Tail]) -> +filtermap(F, [Hd|Tail]) -> case F(Hd) of true -> - [Hd|zf(F, Tail)]; + [Hd|filtermap(F, Tail)]; {true,Val} -> - [Val|zf(F, Tail)]; + [Val|filtermap(F, Tail)]; false -> - zf(F, Tail) + filtermap(F, Tail) end; -zf(F, []) when is_function(F, 1) -> []. +filtermap(F, []) when is_function(F, 1) -> []. + +-spec zf(fun((T) -> boolean() | {'true', X}), [T]) -> [(T | X)]. + +zf(F, L) -> + filtermap(F, L). -spec foreach(Fun, List) -> ok when Fun :: fun((Elem :: T) -> term()), @@ -1364,6 +1440,18 @@ split(N, [H|T], R) -> split(_, [], _) -> badarg. +-spec join(Sep, List1) -> List2 when + Sep :: T, + List1 :: [T], + List2 :: [T], + T :: term(). + +join(_Sep, []) -> []; +join(Sep, [H|T]) -> [H|join_prepend(Sep, T)]. + +join_prepend(_Sep, []) -> []; +join_prepend(Sep, [H|T]) -> [Sep,H|join_prepend(Sep,T)]. + %%% ================================================================= %%% Here follows the implementation of the sort functions. %%% @@ -2192,6 +2280,8 @@ ukeysplit_2(I, Y, EY, [Z | L], R) -> ukeysplit_2(_I, Y, _EY, [], R) -> [Y | R]. +-dialyzer({no_improper_lists, ukeymergel/3}). + ukeymergel(I, [T1, [H2 | T2], [H3 | T3] | L], Acc) -> %% The fourth argument, [H2 | H3] (=HdM), may confuse type %% checkers. Its purpose is to ensure that the tests H2 == HdM diff --git a/lib/stdlib/src/log_mf_h.erl b/lib/stdlib/src/log_mf_h.erl index f7f128dac7..393da9ab27 100644 --- a/lib/stdlib/src/log_mf_h.erl +++ b/lib/stdlib/src/log_mf_h.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -25,6 +26,8 @@ -export([init/1, handle_event/2, handle_info/2, terminate/2]). -export([handle_call/2, code_change/3]). +-export_type([args/0]). + %%----------------------------------------------------------------- -type b() :: non_neg_integer(). @@ -133,7 +136,12 @@ handle_event(Event, State) -> State#state{cur_fd = NewFd, curF = NewF, curB = 0} end, [Hi,Lo] = put_int16(Size), - file:write(NewState#state.cur_fd, [Hi, Lo, Bin]), + case file:write(NewState#state.cur_fd, [Hi, Lo, Bin]) of + ok -> + ok; + {error, Reason} -> + exit({file_exit, Reason}) + end, {ok, NewState#state{curB = NewState#state.curB + Size + 2}}; _ -> {ok, State} @@ -172,7 +180,7 @@ file_open(Dir, FileNo) -> write_index_file(Dir, FileNo), {ok, Fd}; _ -> - exit({file, open}) + exit(file_open) end. put_int16(I) -> @@ -209,7 +217,7 @@ write_index_file(Dir, Index) -> ok = file:close(Fd), ok = file:rename(TmpFile,File), ok; - _ -> exit(open_index_file) + _ -> exit(write_index_file) end. inc(N, Max) -> diff --git a/lib/stdlib/src/maps.erl b/lib/stdlib/src/maps.erl new file mode 100644 index 0000000000..5dafdb282a --- /dev/null +++ b/lib/stdlib/src/maps.erl @@ -0,0 +1,279 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(maps). + +-export([get/3, filter/2,fold/3, + map/2, size/1, + update_with/3, update_with/4, + without/2, with/2]). + +%% BIFs +-export([get/2, find/2, from_list/1, + is_key/2, keys/1, merge/2, + new/0, put/3, remove/2, take/2, + to_list/1, update/3, values/1]). + +%% Shadowed by erl_bif_types: maps:get/2 +-spec get(Key,Map) -> Value when + Key :: term(), + Map :: map(), + Value :: term(). + +get(_,_) -> erlang:nif_error(undef). + + +-spec find(Key,Map) -> {ok, Value} | error when + Key :: term(), + Map :: map(), + Value :: term(). + +find(_,_) -> erlang:nif_error(undef). + +%% Shadowed by erl_bif_types: maps:from_list/1 +-spec from_list(List) -> Map when + List :: [{Key,Value}], + Key :: term(), + Value :: term(), + Map :: map(). + +from_list(_) -> erlang:nif_error(undef). + + +%% Shadowed by erl_bif_types: maps:is_key/2 +-spec is_key(Key,Map) -> boolean() when + Key :: term(), + Map :: map(). + +is_key(_,_) -> erlang:nif_error(undef). + + +-spec keys(Map) -> Keys when + Map :: map(), + Keys :: [Key], + Key :: term(). + +keys(_) -> erlang:nif_error(undef). + + +%% Shadowed by erl_bif_types: maps:merge/2 +-spec merge(Map1,Map2) -> Map3 when + Map1 :: map(), + Map2 :: map(), + Map3 :: map(). + +merge(_,_) -> erlang:nif_error(undef). + + + +-spec new() -> Map when + Map :: map(). + +new() -> erlang:nif_error(undef). + + +%% Shadowed by erl_bif_types: maps:put/3 +-spec put(Key,Value,Map1) -> Map2 when + Key :: term(), + Value :: term(), + Map1 :: map(), + Map2 :: map(). + +put(_,_,_) -> erlang:nif_error(undef). + + +-spec remove(Key,Map1) -> Map2 when + Key :: term(), + Map1 :: map(), + Map2 :: map(). + +remove(_,_) -> erlang:nif_error(undef). + +-spec take(Key,Map1) -> {Value,Map2} | error when + Key :: term(), + Map1 :: map(), + Value :: term(), + Map2 :: map(). + +take(_,_) -> erlang:nif_error(undef). + +%% Shadowed by erl_bif_types: maps:to_list/1 +-spec to_list(Map) -> [{Key,Value}] when + Map :: map(), + Key :: term(), + Value :: term(). + +to_list(_) -> erlang:nif_error(undef). + + +%% Shadowed by erl_bif_types: maps:update/3 +-spec update(Key,Value,Map1) -> Map2 when + Key :: term(), + Value :: term(), + Map1 :: map(), + Map2 :: map(). + +update(_,_,_) -> erlang:nif_error(undef). + + +-spec values(Map) -> Values when + Map :: map(), + Values :: [Value], + Value :: term(). + +values(_) -> erlang:nif_error(undef). + +%% End of BIFs + +-spec update_with(Key,Fun,Map1) -> Map2 when + Key :: term(), + Map1 :: map(), + Map2 :: map(), + Fun :: fun((Value1 :: term()) -> Value2 :: term()). + +update_with(Key,Fun,Map) when is_function(Fun,1), is_map(Map) -> + try maps:get(Key,Map) of + Val -> maps:update(Key,Fun(Val),Map) + catch + error:{badkey,_} -> + erlang:error({badkey,Key},[Key,Fun,Map]) + end; +update_with(Key,Fun,Map) -> + erlang:error(error_type(Map),[Key,Fun,Map]). + + +-spec update_with(Key,Fun,Init,Map1) -> Map2 when + Key :: term(), + Map1 :: Map1, + Map2 :: Map2, + Fun :: fun((Value1 :: term()) -> Value2 :: term()), + Init :: term(). + +update_with(Key,Fun,Init,Map) when is_function(Fun,1), is_map(Map) -> + case maps:find(Key,Map) of + {ok,Val} -> maps:update(Key,Fun(Val),Map); + error -> maps:put(Key,Init,Map) + end; +update_with(Key,Fun,Init,Map) -> + erlang:error(error_type(Map),[Key,Fun,Init,Map]). + + +-spec get(Key, Map, Default) -> Value | Default when + Key :: term(), + Map :: map(), + Value :: term(), + Default :: term(). + +get(Key,Map,Default) when is_map(Map) -> + case maps:find(Key, Map) of + {ok, Value} -> + Value; + error -> + Default + end; +get(Key,Map,Default) -> + erlang:error({badmap,Map},[Key,Map,Default]). + + +-spec filter(Pred,Map1) -> Map2 when + Pred :: fun((Key, Value) -> boolean()), + Key :: term(), + Value :: term(), + Map1 :: map(), + Map2 :: map(). + +filter(Pred,Map) when is_function(Pred,2), is_map(Map) -> + maps:from_list([{K,V}||{K,V}<-maps:to_list(Map),Pred(K,V)]); +filter(Pred,Map) -> + erlang:error(error_type(Map),[Pred,Map]). + + +-spec fold(Fun,Init,Map) -> Acc when + Fun :: fun((K, V, AccIn) -> AccOut), + Init :: term(), + Acc :: term(), + AccIn :: term(), + AccOut :: term(), + Map :: map(), + K :: term(), + V :: term(). + +fold(Fun,Init,Map) when is_function(Fun,3), is_map(Map) -> + lists:foldl(fun({K,V},A) -> Fun(K,V,A) end,Init,maps:to_list(Map)); +fold(Fun,Init,Map) -> + erlang:error(error_type(Map),[Fun,Init,Map]). + +-spec map(Fun,Map1) -> Map2 when + Fun :: fun((K, V1) -> V2), + Map1 :: map(), + Map2 :: map(), + K :: term(), + V1 :: term(), + V2 :: term(). + +map(Fun,Map) when is_function(Fun, 2), is_map(Map) -> + maps:from_list([{K,Fun(K,V)}||{K,V}<-maps:to_list(Map)]); +map(Fun,Map) -> + erlang:error(error_type(Map),[Fun,Map]). + + +-spec size(Map) -> non_neg_integer() when + Map :: map(). + +size(Map) when is_map(Map) -> + erlang:map_size(Map); +size(Val) -> + erlang:error({badmap,Val},[Val]). + + +-spec without(Ks,Map1) -> Map2 when + Ks :: [K], + Map1 :: map(), + Map2 :: map(), + K :: term(). + +without(Ks,M) when is_list(Ks), is_map(M) -> + lists:foldl(fun(K, M1) -> ?MODULE:remove(K, M1) end, M, Ks); +without(Ks,M) -> + erlang:error(error_type(M),[Ks,M]). + + +-spec with(Ks, Map1) -> Map2 when + Ks :: [K], + Map1 :: map(), + Map2 :: map(), + K :: term(). + +with(Ks,Map1) when is_list(Ks), is_map(Map1) -> + Fun = fun(K, List) -> + case ?MODULE:find(K, Map1) of + {ok, V} -> + [{K, V} | List]; + error -> + List + end + end, + ?MODULE:from_list(lists:foldl(Fun, [], Ks)); +with(Ks,M) -> + erlang:error(error_type(M),[Ks,M]). + + +error_type(M) when is_map(M) -> badarg; +error_type(V) -> {badmap, V}. diff --git a/lib/stdlib/src/math.erl b/lib/stdlib/src/math.erl index b2ea6195c5..97c965e27a 100644 --- a/lib/stdlib/src/math.erl +++ b/lib/stdlib/src/math.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -20,6 +21,121 @@ -export([pi/0]). +%%% BIFs + +-export([sin/1, cos/1, tan/1, asin/1, acos/1, atan/1, atan2/2, sinh/1, + cosh/1, tanh/1, asinh/1, acosh/1, atanh/1, exp/1, log/1, + log2/1, log10/1, pow/2, sqrt/1, erf/1, erfc/1]). + +-spec acos(X) -> float() when + X :: number(). +acos(_) -> + erlang:nif_error(undef). + +-spec acosh(X) -> float() when + X :: number(). +acosh(_) -> + erlang:nif_error(undef). + +-spec asin(X) -> float() when + X :: number(). +asin(_) -> + erlang:nif_error(undef). + +-spec asinh(X) -> float() when + X :: number(). +asinh(_) -> + erlang:nif_error(undef). + +-spec atan(X) -> float() when + X :: number(). +atan(_) -> + erlang:nif_error(undef). + +-spec atan2(Y, X) -> float() when + Y :: number(), + X :: number(). +atan2(_, _) -> + erlang:nif_error(undef). + +-spec atanh(X) -> float() when + X :: number(). +atanh(_) -> + erlang:nif_error(undef). + +-spec cos(X) -> float() when + X :: number(). +cos(_) -> + erlang:nif_error(undef). + +-spec cosh(X) -> float() when + X :: number(). +cosh(_) -> + erlang:nif_error(undef). + +-spec erf(X) -> float() when + X :: number(). +erf(_) -> + erlang:nif_error(undef). + +-spec erfc(X) -> float() when + X :: number(). +erfc(_) -> + erlang:nif_error(undef). + +-spec exp(X) -> float() when + X :: number(). +exp(_) -> + erlang:nif_error(undef). + +-spec log(X) -> float() when + X :: number(). +log(_) -> + erlang:nif_error(undef). + +-spec log2(X) -> float() when + X :: number(). +log2(_) -> + erlang:nif_error(undef). + +-spec log10(X) -> float() when + X :: number(). +log10(_) -> + erlang:nif_error(undef). + +-spec pow(X, Y) -> float() when + X :: number(), + Y :: number(). +pow(_, _) -> + erlang:nif_error(undef). + +-spec sin(X) -> float() when + X :: number(). +sin(_) -> + erlang:nif_error(undef). + +-spec sinh(X) -> float() when + X :: number(). +sinh(_) -> + erlang:nif_error(undef). + +-spec sqrt(X) -> float() when + X :: number(). +sqrt(_) -> + erlang:nif_error(undef). + +-spec tan(X) -> float() when + X :: number(). +tan(_) -> + erlang:nif_error(undef). + +-spec tanh(X) -> float() when + X :: number(). +tanh(_) -> + erlang:nif_error(undef). + +%%% End of BIFs + -spec pi() -> float(). pi() -> 3.1415926535897932. diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index 4389fd457c..98745b13f3 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2011. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -100,7 +101,7 @@ format_error({?ERR_GUARDREMOTECALL, Module, Name, Arithy}) -> [Module,Name,Arithy])); format_error({?ERR_GUARDELEMENT, Str}) -> lists:flatten( - io_lib:format("the language element ~s (in guard) cannot be translated " + io_lib:format("the language element ~ts (in guard) cannot be translated " "into match_spec", [Str])); format_error({?ERR_GUARDBINCONSTRUCT, Var}) -> lists:flatten( @@ -126,7 +127,7 @@ format_error({?ERR_BODYREMOTECALL, Module, Name, Arithy}) -> [Module,Name,Arithy])); format_error({?ERR_BODYELEMENT, Str}) -> lists:flatten( - io_lib:format("the language element ~s (in body) cannot be translated " + io_lib:format("the language element ~ts (in body) cannot be translated " "into match_spec", [Str])); format_error({?ERR_BODYBINCONSTRUCT, Var}) -> lists:flatten( @@ -223,8 +224,9 @@ transform_from_shell(Dialect, Clauses, BoundEnvironment) -> %% Called when translating during compiling %% --spec parse_transform(Forms, Options) -> Forms when - Forms :: [erl_parse:abstract_form()], +-spec parse_transform(Forms, Options) -> Forms2 when + Forms :: [erl_parse:abstract_form() | erl_parse:form_info()], + Forms2 :: [erl_parse:abstract_form() | erl_parse:form_info()], Options :: term(). parse_transform(Forms, _Options) -> @@ -306,15 +308,18 @@ cleanup_filename({Old,OldRec,OldWarnings}) -> add_record_definition({Name,FieldList}) -> {KeyList,_} = lists:foldl( - fun({record_field,_,{atom,Line0,FieldName}},{L,C}) -> - {[{FieldName,C,{atom,Line0,undefined}}|L],C+1}; - ({record_field,_,{atom,_,FieldName},Def},{L,C}) -> - {[{FieldName,C,Def}|L],C+1} - end, + fun(F, {L,C}) -> {[record_field(F, C)|L],C+1} end, {[],2}, FieldList), put_records([{Name,KeyList}|get_records()]). +record_field({record_field,_,{atom,Line0,FieldName}}, C) -> + {FieldName,C,{atom,Line0,undefined}}; +record_field({record_field,_,{atom,_,FieldName},Def}, C) -> + {FieldName,C,Def}; +record_field({typed_record_field,Field,_Type}, C) -> + record_field(Field, C). + forms([F0|Fs0]) -> F1 = form(F0), Fs1 = forms(Fs0), @@ -369,6 +374,13 @@ copy({var,_Line,Name} = VarDef,Bound) -> copy({'fun',Line,{clauses,Clauses}},Bound) -> % Dont export bindings from funs {NewClauses,_IgnoredBindings} = copy_list(Clauses,Bound), {{'fun',Line,{clauses,NewClauses}},Bound}; +copy({named_fun,Line,Name,Clauses},Bound) -> % Dont export bindings from funs + Bound1 = case Name of + '_' -> Bound; + Name -> gb_sets:add(Name,Bound) + end, + {NewClauses,_IgnoredBindings} = copy_list(Clauses,Bound1), + {{named_fun,Line,Name,NewClauses},Bound}; copy({'case',Line,Of,ClausesList},Bound) -> % Dont export bindings from funs {NewOf,NewBind0} = copy(Of,Bound), {NewClausesList,NewBindings} = copy_case_clauses(ClausesList,NewBind0,[]), @@ -439,6 +451,8 @@ check_type(_,[{record,_,_,_}],ets) -> ok; check_type(_,[{cons,_,_,_}],dbg) -> ok; +check_type(_,[{nil,_}],dbg) -> + ok; check_type(Line0,[{match,_,{var,_,_},X}],Any) -> check_type(Line0,[X],Any); check_type(Line0,[{match,_,X,{var,_,_}}],Any) -> @@ -718,10 +732,10 @@ transform_head([V],OuterBound) -> th(NewV,NewBind,OuterBound). -toplevel_head_match({match,Line,{var,_,VName},Expr},B,OB) -> +toplevel_head_match({match,_,{var,Line,VName},Expr},B,OB) -> warn_var_clash(Line,VName,OB), {Expr,new_bind({VName,'$_'},B)}; -toplevel_head_match({match,Line,Expr,{var,_,VName}},B,OB) -> +toplevel_head_match({match,_,Expr,{var,Line,VName}},B,OB) -> warn_var_clash(Line,VName,OB), {Expr,new_bind({VName,'$_'},B)}; toplevel_head_match(Other,B,_OB) -> @@ -815,9 +829,10 @@ th(T,B,OB) when is_tuple(T) -> th(Nonstruct,B,_OB) -> {Nonstruct,B}. -warn_var_clash(Line,Name,OuterBound) -> +warn_var_clash(Anno,Name,OuterBound) -> case gb_sets:is_member(Name,OuterBound) of true -> + Line = erl_anno:line(Anno), add_warning(Line,{?WARN_SHADOW_VAR,Name}); _ -> ok @@ -903,6 +918,7 @@ bool_test(is_pid,1) -> true; bool_test(is_port,1) -> true; bool_test(is_reference,1) -> true; bool_test(is_tuple,1) -> true; +bool_test(is_map,1) -> true; bool_test(is_binary,1) -> true; bool_test(is_function,1) -> true; bool_test(is_record,2) -> true; @@ -917,6 +933,7 @@ real_guard_function(node,0) -> true; real_guard_function(node,1) -> true; real_guard_function(round,1) -> true; real_guard_function(size,1) -> true; +real_guard_function(map_size,1) -> true; real_guard_function(tl,1) -> true; real_guard_function(trunc,1) -> true; real_guard_function(self,0) -> true; @@ -1070,6 +1087,12 @@ normalise({cons,_,Head,Tail}) -> [normalise(Head)|normalise(Tail)]; normalise({tuple,_,Args}) -> list_to_tuple(normalise_list(Args)); +normalise({map,_,Pairs0}) -> + Pairs1 = lists:map(fun ({map_field_exact,_,K,V}) -> + {normalise(K),normalise(V)} + end, + Pairs0), + maps:from_list(Pairs1); %% Special case for unary +/-. normalise({op,_,'+',{char,_,I}}) -> I; normalise({op,_,'+',{integer,_,I}}) -> I; diff --git a/lib/stdlib/src/orddict.erl b/lib/stdlib/src/orddict.erl index 45d3c84b3e..37cf0084f0 100644 --- a/lib/stdlib/src/orddict.erl +++ b/lib/stdlib/src/orddict.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -20,16 +21,18 @@ -module(orddict). %% Standard interface. --export([new/0,is_key/2,to_list/1,from_list/1,size/1]). +-export([new/0,is_key/2,to_list/1,from_list/1,size/1,is_empty/1]). -export([fetch/2,find/2,fetch_keys/1,erase/2]). -export([store/3,append/3,append_list/3,update/3,update/4,update_counter/3]). -export([fold/3,map/2,filter/2,merge/3]). --export_type([orddict/0]). +-export_type([orddict/0, orddict/2]). %%--------------------------------------------------------------------------- --type orddict() :: [{Key :: term(), Value :: term()}]. +-type orddict() :: orddict(_, _). + +-type orddict(Key, Value) :: [{Key, Value}]. %%--------------------------------------------------------------------------- @@ -38,8 +41,7 @@ new() -> []. -spec is_key(Key, Orddict) -> boolean() when - Key :: term(), - Orddict :: orddict(). + Orddict :: orddict(Key, Value :: term()). is_key(Key, [{K,_}|_]) when Key < K -> false; is_key(Key, [{K,_}|Dict]) when Key > K -> is_key(Key, Dict); @@ -47,35 +49,39 @@ is_key(_Key, [{_K,_Val}|_]) -> true; %Key == K is_key(_, []) -> false. -spec to_list(Orddict) -> List when - Orddict :: orddict(), - List :: [{Key :: term(), Value :: term()}]. + Orddict :: orddict(Key, Value), + List :: [{Key, Value}]. to_list(Dict) -> Dict. -spec from_list(List) -> Orddict when - List :: [{Key :: term(), Value :: term()}], - Orddict :: orddict(). + List :: [{Key, Value}], + Orddict :: orddict(Key, Value). +from_list([]) -> []; +from_list([{_,_}]=Pair) -> Pair; from_list(Pairs) -> - lists:foldl(fun ({K,V}, D) -> store(K, V, D) end, [], Pairs). + lists:ukeysort(1, reverse_pairs(Pairs, [])). -spec size(Orddict) -> non_neg_integer() when Orddict :: orddict(). size(D) -> length(D). --spec fetch(Key, Orddict) -> Value when - Key :: term(), - Value :: term(), +-spec is_empty(Orddict) -> boolean() when Orddict :: orddict(). +is_empty([]) -> true; +is_empty([_|_]) -> false. + +-spec fetch(Key, Orddict) -> Value when + Orddict :: orddict(Key, Value). + fetch(Key, [{K,_}|D]) when Key > K -> fetch(Key, D); fetch(Key, [{K,Value}|_]) when Key == K -> Value. -spec find(Key, Orddict) -> {'ok', Value} | 'error' when - Key :: term(), - Orddict :: orddict(), - Value :: term(). + Orddict :: orddict(Key, Value). find(Key, [{K,_}|_]) when Key < K -> error; find(Key, [{K,_}|D]) when Key > K -> find(Key, D); @@ -83,17 +89,16 @@ find(_Key, [{_K,Value}|_]) -> {ok,Value}; %Key == K find(_, []) -> error. -spec fetch_keys(Orddict) -> Keys when - Orddict :: orddict(), - Keys :: [term()]. + Orddict :: orddict(Key, Value :: term()), + Keys :: [Key]. fetch_keys([{Key,_}|Dict]) -> [Key|fetch_keys(Dict)]; fetch_keys([]) -> []. -spec erase(Key, Orddict1) -> Orddict2 when - Key :: term(), - Orddict1 :: orddict(), - Orddict2 :: orddict(). + Orddict1 :: orddict(Key, Value), + Orddict2 :: orddict(Key, Value). erase(Key, [{K,_}=E|Dict]) when Key < K -> [E|Dict]; erase(Key, [{K,_}=E|Dict]) when Key > K -> @@ -102,13 +107,11 @@ erase(_Key, [{_K,_Val}|Dict]) -> Dict; %Key == K erase(_, []) -> []. -spec store(Key, Value, Orddict1) -> Orddict2 when - Key :: term(), - Value :: term(), - Orddict1 :: orddict(), - Orddict2 :: orddict(). + Orddict1 :: orddict(Key, Value), + Orddict2 :: orddict(Key, Value). -store(Key, New, [{K,_}=E|Dict]) when Key < K -> - [{Key,New},E|Dict]; +store(Key, New, [{K,_}|_]=Dict) when Key < K -> + [{Key,New}|Dict]; store(Key, New, [{K,_}=E|Dict]) when Key > K -> [E|store(Key, New, Dict)]; store(Key, New, [{_K,_Old}|Dict]) -> %Key == K @@ -116,13 +119,11 @@ store(Key, New, [{_K,_Old}|Dict]) -> %Key == K store(Key, New, []) -> [{Key,New}]. -spec append(Key, Value, Orddict1) -> Orddict2 when - Key :: term(), - Value :: term(), - Orddict1 :: orddict(), - Orddict2 :: orddict(). + Orddict1 :: orddict(Key, Value), + Orddict2 :: orddict(Key, Value). -append(Key, New, [{K,_}=E|Dict]) when Key < K -> - [{Key,[New]},E|Dict]; +append(Key, New, [{K,_}|_]=Dict) when Key < K -> + [{Key,[New]}|Dict]; append(Key, New, [{K,_}=E|Dict]) when Key > K -> [E|append(Key, New, Dict)]; append(Key, New, [{_K,Old}|Dict]) -> %Key == K @@ -130,13 +131,12 @@ append(Key, New, [{_K,Old}|Dict]) -> %Key == K append(Key, New, []) -> [{Key,[New]}]. -spec append_list(Key, ValList, Orddict1) -> Orddict2 when - Key :: term(), - ValList :: [Value :: term()], - Orddict1 :: orddict(), - Orddict2 :: orddict(). + ValList :: [Value], + Orddict1 :: orddict(Key, Value), + Orddict2 :: orddict(Key, Value). -append_list(Key, NewList, [{K,_}=E|Dict]) when Key < K -> - [{Key,NewList},E|Dict]; +append_list(Key, NewList, [{K,_}|_]=Dict) when Key < K -> + [{Key,NewList}|Dict]; append_list(Key, NewList, [{K,_}=E|Dict]) when Key > K -> [E|append_list(Key, NewList, Dict)]; append_list(Key, NewList, [{_K,Old}|Dict]) -> %Key == K @@ -145,10 +145,9 @@ append_list(Key, NewList, []) -> [{Key,NewList}]. -spec update(Key, Fun, Orddict1) -> Orddict2 when - Key :: term(), - Fun :: fun((Value1 :: term()) -> Value2 :: term()), - Orddict1 :: orddict(), - Orddict2 :: orddict(). + Fun :: fun((Value1 :: Value) -> Value2 :: Value), + Orddict1 :: orddict(Key, Value), + Orddict2 :: orddict(Key, Value). update(Key, Fun, [{K,_}=E|Dict]) when Key > K -> [E|update(Key, Fun, Dict)]; @@ -156,14 +155,13 @@ update(Key, Fun, [{K,Val}|Dict]) when Key == K -> [{Key,Fun(Val)}|Dict]. -spec update(Key, Fun, Initial, Orddict1) -> Orddict2 when - Key :: term(), - Initial :: term(), - Fun :: fun((Value1 :: term()) -> Value2 :: term()), - Orddict1 :: orddict(), - Orddict2 :: orddict(). - -update(Key, _, Init, [{K,_}=E|Dict]) when Key < K -> - [{Key,Init},E|Dict]; + Initial :: Value, + Fun :: fun((Value1 :: Value) -> Value2 :: Value), + Orddict1 :: orddict(Key, Value), + Orddict2 :: orddict(Key, Value). + +update(Key, _, Init, [{K,_}|_]=Dict) when Key < K -> + [{Key,Init}|Dict]; update(Key, Fun, Init, [{K,_}=E|Dict]) when Key > K -> [E|update(Key, Fun, Init, Dict)]; update(Key, Fun, _Init, [{_K,Val}|Dict]) -> %Key == K @@ -171,13 +169,12 @@ update(Key, Fun, _Init, [{_K,Val}|Dict]) -> %Key == K update(Key, _, Init, []) -> [{Key,Init}]. -spec update_counter(Key, Increment, Orddict1) -> Orddict2 when - Key :: term(), - Increment :: number(), - Orddict1 :: orddict(), - Orddict2 :: orddict(). + Orddict1 :: orddict(Key, Value), + Orddict2 :: orddict(Key, Value), + Increment :: number(). -update_counter(Key, Incr, [{K,_}=E|Dict]) when Key < K -> - [{Key,Incr},E|Dict]; +update_counter(Key, Incr, [{K,_}|_]=Dict) when Key < K -> + [{Key,Incr}|Dict]; update_counter(Key, Incr, [{K,_}=E|Dict]) when Key > K -> [E|update_counter(Key, Incr, Dict)]; update_counter(Key, Incr, [{_K,Val}|Dict]) -> %Key == K @@ -185,28 +182,30 @@ update_counter(Key, Incr, [{_K,Val}|Dict]) -> %Key == K update_counter(Key, Incr, []) -> [{Key,Incr}]. -spec fold(Fun, Acc0, Orddict) -> Acc1 when - Fun :: fun((Key :: term(), Value :: term(), AccIn :: term()) -> AccOut :: term()), - Acc0 :: term(), - Acc1 :: term(), - Orddict :: orddict(). + Fun :: fun((Key, Value, AccIn) -> AccOut), + Orddict :: orddict(Key, Value), + Acc0 :: Acc, + Acc1 :: Acc, + AccIn :: Acc, + AccOut :: Acc. fold(F, Acc, [{Key,Val}|D]) -> fold(F, F(Key, Val, Acc), D); fold(F, Acc, []) when is_function(F, 3) -> Acc. -spec map(Fun, Orddict1) -> Orddict2 when - Fun :: fun((Key :: term(), Value1 :: term()) -> Value2 :: term()), - Orddict1 :: orddict(), - Orddict2 :: orddict(). + Fun :: fun((Key, Value1) -> Value2), + Orddict1 :: orddict(Key, Value1), + Orddict2 :: orddict(Key, Value2). map(F, [{Key,Val}|D]) -> [{Key,F(Key, Val)}|map(F, D)]; map(F, []) when is_function(F, 2) -> []. -spec filter(Pred, Orddict1) -> Orddict2 when - Pred :: fun((Key :: term(), Value :: term()) -> boolean()), - Orddict1 :: orddict(), - Orddict2 :: orddict(). + Pred :: fun((Key, Value) -> boolean()), + Orddict1 :: orddict(Key, Value), + Orddict2 :: orddict(Key, Value). filter(F, [{Key,Val}=E|D]) -> case F(Key, Val) of @@ -216,10 +215,10 @@ filter(F, [{Key,Val}=E|D]) -> filter(F, []) when is_function(F, 2) -> []. -spec merge(Fun, Orddict1, Orddict2) -> Orddict3 when - Fun :: fun((Key :: term(), Value1 :: term(), Value2 :: term()) -> Value :: term()), - Orddict1 :: orddict(), - Orddict2 :: orddict(), - Orddict3 :: orddict(). + Fun :: fun((Key, Value1, Value2) -> Value), + Orddict1 :: orddict(Key, Value1), + Orddict2 :: orddict(Key, Value2), + Orddict3 :: orddict(Key, Value). merge(F, [{K1,_}=E1|D1], [{K2,_}=E2|D2]) when K1 < K2 -> [E1|merge(F, D1, [E2|D2])]; @@ -229,3 +228,7 @@ merge(F, [{K1,V1}|D1], [{_K2,V2}|D2]) -> %K1 == K2 [{K1,F(K1, V1, V2)}|merge(F, D1, D2)]; merge(F, [], D2) when is_function(F, 3) -> D2; merge(F, D1, []) when is_function(F, 3) -> D1. + +reverse_pairs([{_,_}=H|T], Acc) -> + reverse_pairs(T, [H|Acc]); +reverse_pairs([], Acc) -> Acc. diff --git a/lib/stdlib/src/ordsets.erl b/lib/stdlib/src/ordsets.erl index 4a8b1275b2..569407f5ef 100644 --- a/lib/stdlib/src/ordsets.erl +++ b/lib/stdlib/src/ordsets.erl @@ -1,21 +1,21 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% -%% -module(ordsets). diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index b9fbef9ed0..3bd338071b 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -1,38 +1,41 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(otp_internal). --export([obsolete/3]). +-export([obsolete/3, obsolete_type/3]). %%---------------------------------------------------------------------- +-dialyzer({no_match, obsolete/3}). + -type tag() :: 'deprecated' | 'removed'. %% | 'experimental'. -type mfas() :: mfa() | {atom(), atom(), [byte()]}. -type release() :: string(). --spec obsolete(atom(), atom(), byte()) -> +-spec obsolete(module(), atom(), arity()) -> 'no' | {tag(), string()} | {tag(), mfas(), release()}. obsolete(Module, Name, Arity) -> case obsolete_1(Module, Name, Arity) of {deprecated=Tag,{_,_,_}=Replacement} -> - {Tag,Replacement,"in a future release"}; + {Tag,Replacement,"a future release"}; {_,String}=Ret when is_list(String) -> Ret; {_,_,_}=Ret -> @@ -44,26 +47,197 @@ obsolete(Module, Name, Arity) -> obsolete_1(net, _, _) -> {deprecated, "module 'net' obsolete; use 'net_adm'"}; -obsolete_1(erl_internal, builtins, 0) -> - {deprecated, {erl_internal, bif, 2}}; - -obsolete_1(erl_eval, seq, 2) -> - {deprecated, {erl_eval, exprs, 2}}; -obsolete_1(erl_eval, seq, 3) -> - {deprecated, {erl_eval, exprs, 3}}; -obsolete_1(erl_eval, arg_list, 2) -> - {deprecated, {erl_eval, expr_list, 2}}; -obsolete_1(erl_eval, arg_list, 3) -> - {deprecated, {erl_eval, expr_list, 3}}; - obsolete_1(erlang, hash, 2) -> {deprecated, {erlang, phash2, 2}}; +obsolete_1(erlang, now, 0) -> + {deprecated, + "Deprecated BIF. See the \"Time and Time Correction in Erlang\" " + "chapter of the ERTS User's Guide for more information."}; + obsolete_1(calendar, local_time_to_universal_time, 1) -> {deprecated, {calendar, local_time_to_universal_time_dst, 1}}; -obsolete_1(rpc, safe_multi_server_call, A) when A =:= 2; A =:= 3 -> - {deprecated, {rpc, multi_server_call, A}}; +%% *** CRYPTO added in OTP 19 *** + +obsolete_1(crypto, rand_bytes, 1) -> + {deprecated, {crypto, strong_rand_bytes, 1}}; + +%% *** CRYPTO added in R16B01 *** + +obsolete_1(crypto, md4, 1) -> + {deprecated, {crypto, hash, 2}}; +obsolete_1(crypto, md5, 1) -> + {deprecated, {crypto, hash, 2}}; +obsolete_1(crypto, sha, 1) -> + {deprecated, {crypto, hash, 2}}; + +obsolete_1(crypto, md4_init, 0) -> + {deprecated, {crypto, hash_init, 1}}; +obsolete_1(crypto, md5_init, 0) -> + {deprecated, {crypto, hash_init, 1}}; +obsolete_1(crypto, sha_init, 0) -> + {deprecated, {crypto, hash_init, 1}}; + +obsolete_1(crypto, md4_update, 2) -> + {deprecated, {crypto, hash_update, 2}}; +obsolete_1(crypto, md5_update, 2) -> + {deprecated, {crypto, hash_update, 2}}; +obsolete_1(crypto, sha_update, 2) -> + {deprecated, {crypto, hash_update, 2}}; + +obsolete_1(crypto, md4_final, 1) -> + {deprecated, {crypto, hash_final, 1}}; +obsolete_1(crypto, md5_final, 1) -> + {deprecated, {crypto, hash_final, 1}}; +obsolete_1(crypto, sha_final, 1) -> + {deprecated, {crypto, hash_final, 1}}; + +obsolete_1(crypto, md5_mac, 2) -> + {deprecated, {crypto, hmac, 3}}; +obsolete_1(crypto, sha_mac, 2) -> + {deprecated, {crypto, hmac, 3}}; +obsolete_1(crypto, sha_mac, 3) -> + {deprecated, {crypto, hmac, 4}}; + +obsolete_1(crypto, sha_mac_96, 2) -> + {deprecated, {crypto, hmac, 4}}; +obsolete_1(crypto, md5_mac_96, 2) -> + {deprecated, {crypto, hmac, 4}}; + +obsolete_1(crypto, rsa_sign, 2) -> + {deprecated, {crypto, sign, 4}}; +obsolete_1(crypto, rsa_sign, 3) -> + {deprecated, {crypto, sign, 4}}; +obsolete_1(crypto, rsa_verify, 3) -> + {deprecated, {crypto, verify, 5}}; +obsolete_1(crypto, rsa_verify, 4) -> + {deprecated, {crypto, verify, 5}}; + +obsolete_1(crypto, dss_sign, 2) -> + {deprecated, {crypto, sign, 4}}; +obsolete_1(crypto, dss_sign, 3) -> + {deprecated, {crypto, sign, 4}}; + +obsolete_1(crypto, dss_verify, 3) -> + {deprecated, {crypto, verify, 5}}; +obsolete_1(crypto, dss_verify, 4) -> + {deprecated, {crypto, verify, 5}}; + +obsolete_1(crypto, mod_exp, 3) -> + {deprecated, {crypto, mod_pow, 3}}; + +obsolete_1(crypto, dh_compute_key, 3) -> + {deprecated, {crypto, compute_key, 4}}; +obsolete_1(crypto, dh_generate_key, 1) -> + {deprecated, {crypto, generate_key, 2}}; +obsolete_1(crypto, dh_generate_key, 2) -> + {deprecated, {crypto, generate_key, 3}}; + +obsolete_1(crypto, des_cbc_encrypt, 3) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto, des3_cbc_encrypt, 5) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto, des_ecb_encrypt, 2) -> + {deprecated, {crypto, block_encrypt, 3}}; +obsolete_1(crypto, des_ede3_cbc_encrypt, 5) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto, des_cfb_encrypt, 3) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto, des3_cfb_encrypt, 5) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto, blowfish_ecb_encrypt, 2) -> + {deprecated, {crypto, block_encrypt, 3}}; +obsolete_1(crypto, blowfish_cbc_encrypt, 3) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto, blowfish_cfb64_encrypt, 3) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto, blowfish_ofb64_encrypt, 3) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto, aes_cfb_128_encrypt, 3) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto, aes_cbc_128_encrypt, 3) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto, aes_cbc_256_encrypt, 3) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto,rc2_cbc_encrypt, 3) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto,rc2_40_cbc_encrypt, 3) -> + {deprecated, {crypto, block_encrypt, 4}}; + +obsolete_1(crypto, des_cbc_decrypt, 3) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto, des3_cbc_decrypt, 5) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto, des_ecb_decrypt, 2) -> + {deprecated, {crypto, block_decrypt, 3}}; +obsolete_1(crypto, des_ede3_cbc_decrypt, 5) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto, des_cfb_decrypt, 3) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto, des3_cfb_decrypt, 5) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto, blowfish_ecb_decrypt, 2) -> + {deprecated, {crypto, block_decrypt, 3}}; +obsolete_1(crypto, blowfish_cbc_decrypt, 3) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto, blowfish_cfb64_decrypt, 3) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto, blowfish_ofb64_decrypt, 3) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto, aes_cfb_128_decrypt, 3) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto, aes_cbc_128_decrypt, 3) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto, aes_cbc_256_decrypt, 3) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto,rc2_cbc_decrypt, 3) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto,rc2_40_cbc_decrypt, 3) -> + {deprecated, {crypto, block_decrypt, 4}}; + +obsolete_1(crypto, aes_ctr_stream_decrypt, 2) -> + {deprecated, {crypto, stream_decrypt, 2}}; +obsolete_1(crypto, aes_ctr_stream_encrypt, 2) -> + {deprecated, {crypto, stream_encrypt, 2}}; +obsolete_1(crypto, aes_ctr_decrypt, 3) -> + {deprecated, {crypto, stream_decrypt, 2}}; +obsolete_1(crypto, aes_ctr_encrypt, 3) -> + {deprecated, {crypto, stream_encrypt, 2}}; +obsolete_1(crypto, rc4_encrypt, 2) -> + {deprecated, {crypto, stream_encrypt, 2}}; +obsolete_1(crypto, rc4_encrypt_with_state, 2) -> + {deprecated, {crypto, stream_encrypt, 2}}; +obsolete_1(crypto, aes_ctr_stream_init, 2) -> + {deprecated, {crypto, stream_init, 3}}; +obsolete_1(crypto, rc4_set_key, 1) -> + {deprecated, {crypto, stream_init, 2}}; + +obsolete_1(crypto, rsa_private_decrypt, 3) -> + {deprecated, {crypto, private_decrypt, 4}}; +obsolete_1(crypto, rsa_public_decrypt, 3) -> + {deprecated, {crypto, public_decrypt, 4}}; +obsolete_1(crypto, rsa_private_encrypt, 3) -> + {deprecated, {crypto, private_encrypt, 4}}; +obsolete_1(crypto, rsa_public_encrypt, 3) -> + {deprecated, {crypto, public_encrypt, 4}}; + +obsolete_1(crypto, des_cfb_ivec, 2) -> + {deprecated, {crypto, next_iv, 3}}; +obsolete_1(crypto,des_cbc_ivec, 1) -> + {deprecated, {crypto, next_iv, 2}}; +obsolete_1(crypto, aes_cbc_ivec, 1) -> + {deprecated, {crypto, next_iv, 2}}; + +obsolete_1(crypto,info, 0) -> + {deprecated, {crypto, module_info, 0}}; + +obsolete_1(crypto, strong_rand_mpint, 3) -> + {deprecated, "needed only by deprecated functions"}; +obsolete_1(crypto, erlint, 1) -> + {deprecated, "needed only by deprecated functions"}; +obsolete_1(crypto, mpint, 1) -> + {deprecated, "needed only by deprecated functions"}; %% *** SNMP *** @@ -73,94 +247,96 @@ obsolete_1(snmp, N, A) -> false -> no; true -> - {deprecated,"Deprecated; use snmpa:"++atom_to_list(N)++"/"++ + {deprecated, "Deprecated (will be removed in OTP 18); use snmpa:"++atom_to_list(N)++"/"++ integer_to_list(A)++" instead"} end; +obsolete_1(snmpa, old_info_format, 1) -> + {deprecated, "Deprecated; (will be removed in OTP 18); use \"new\" format instead"}; obsolete_1(snmpm, agent_info, 3) -> - {deprecated, {snmpm, agent_info, 2}, "R16B"}; + {removed, {snmpm, agent_info, 2}, "R16B"}; obsolete_1(snmpm, update_agent_info, 5) -> - {deprecated, {snmpm, update_agent_info, 4}, "R16B"}; + {removed, {snmpm, update_agent_info, 4}, "R16B"}; obsolete_1(snmpm, g, 3) -> - {deprecated, {snmpm, sync_get, 3}, "R16B"}; + {removed, {snmpm, sync_get, 3}, "R16B"}; obsolete_1(snmpm, g, 4) -> - {deprecated, {snmpm, sync_get, [3,4]}, "R16B"}; + {removed, {snmpm, sync_get, [3,4]}, "R16B"}; obsolete_1(snmpm, g, 5) -> - {deprecated, {snmpm, sync_get, [4,5]}, "R16B"}; + {removed, {snmpm, sync_get, [4,5]}, "R16B"}; obsolete_1(snmpm, g, 6) -> - {deprecated, {snmpm, sync_get, [5,6]}, "R16B"}; + {removed, {snmpm, sync_get, [5,6]}, "R16B"}; obsolete_1(snmpm, g, 7) -> - {deprecated, {snmpm, sync_get, 6}, "R16B"}; + {removed, {snmpm, sync_get, 6}, "R16B"}; obsolete_1(snmpm, ag, 3) -> - {deprecated, {snmpm, async_get, 3}, "R16B"}; + {removed, {snmpm, async_get, 3}, "R16B"}; obsolete_1(snmpm, ag, 4) -> - {deprecated, {snmpm, async_get, [3,4]}, "R16B"}; + {removed, {snmpm, async_get, [3,4]}, "R16B"}; obsolete_1(snmpm, ag, 5) -> - {deprecated, {snmpm, async_get, [4,5]}, "R16B"}; + {removed, {snmpm, async_get, [4,5]}, "R16B"}; obsolete_1(snmpm, ag, 6) -> - {deprecated, {snmpm, async_get, [5,6]}, "R16B"}; + {removed, {snmpm, async_get, [5,6]}, "R16B"}; obsolete_1(snmpm, ag, 7) -> - {deprecated, {snmpm, async_get, 6}, "R16B"}; + {removed, {snmpm, async_get, 6}, "R16B"}; obsolete_1(snmpm, gn, 3) -> - {deprecated, {snmpm, sync_get_next, 3}, "R16B"}; + {removed, {snmpm, sync_get_next, 3}, "R16B"}; obsolete_1(snmpm, gn, 4) -> - {deprecated, {snmpm, sync_get_next, [3,4]}, "R16B"}; + {removed, {snmpm, sync_get_next, [3,4]}, "R16B"}; obsolete_1(snmpm, gn, 5) -> - {deprecated, {snmpm, sync_get_next, [4,5]}, "R16B"}; + {removed, {snmpm, sync_get_next, [4,5]}, "R16B"}; obsolete_1(snmpm, gn, 6) -> - {deprecated, {snmpm, sync_get_next, [5,6]}, "R16B"}; + {removed, {snmpm, sync_get_next, [5,6]}, "R16B"}; obsolete_1(snmpm, gn, 7) -> - {deprecated, {snmpm, sync_get_next, 6}, "R16B"}; + {removed, {snmpm, sync_get_next, 6}, "R16B"}; obsolete_1(snmpm, agn, 3) -> - {deprecated, {snmpm, async_get_next, 3}, "R16B"}; + {removed, {snmpm, async_get_next, 3}, "R16B"}; obsolete_1(snmpm, agn, 4) -> - {deprecated, {snmpm, async_get_next, [3,4]}, "R16B"}; + {removed, {snmpm, async_get_next, [3,4]}, "R16B"}; obsolete_1(snmpm, agn, 5) -> - {deprecated, {snmpm, async_get_next, [4,5]}, "R16B"}; + {removed, {snmpm, async_get_next, [4,5]}, "R16B"}; obsolete_1(snmpm, agn, 6) -> - {deprecated, {snmpm, async_get_next, [5,6]}, "R16B"}; + {removed, {snmpm, async_get_next, [5,6]}, "R16B"}; obsolete_1(snmpm, agn, 7) -> - {deprecated, {snmpm, async_get_next, 6}, "R16B"}; + {removed, {snmpm, async_get_next, 6}, "R16B"}; obsolete_1(snmpm, s, 3) -> - {deprecated, {snmpm, sync_set, 3}, "R16B"}; + {removed, {snmpm, sync_set, 3}, "R16B"}; obsolete_1(snmpm, s, 4) -> - {deprecated, {snmpm, sync_set, [3,4]}, "R16B"}; + {removed, {snmpm, sync_set, [3,4]}, "R16B"}; obsolete_1(snmpm, s, 5) -> - {deprecated, {snmpm, sync_set, [4,5]}, "R16B"}; + {removed, {snmpm, sync_set, [4,5]}, "R16B"}; obsolete_1(snmpm, s, 6) -> - {deprecated, {snmpm, sync_set, [5,6]}, "R16B"}; + {removed, {snmpm, sync_set, [5,6]}, "R16B"}; obsolete_1(snmpm, s, 7) -> - {deprecated, {snmpm, sync_set, 6}, "R16B"}; + {removed, {snmpm, sync_set, 6}, "R16B"}; obsolete_1(snmpm, as, 3) -> - {deprecated, {snmpm, async_set, 3}, "R16B"}; + {removed, {snmpm, async_set, 3}, "R16B"}; obsolete_1(snmpm, as, 4) -> - {deprecated, {snmpm, async_set, [3,4]}, "R16B"}; + {removed, {snmpm, async_set, [3,4]}, "R16B"}; obsolete_1(snmpm, as, 5) -> - {deprecated, {snmpm, async_set, [4,5]}, "R16B"}; + {removed, {snmpm, async_set, [4,5]}, "R16B"}; obsolete_1(snmpm, as, 6) -> - {deprecated, {snmpm, async_set, [5,6]}, "R16B"}; + {removed, {snmpm, async_set, [5,6]}, "R16B"}; obsolete_1(snmpm, as, 7) -> - {deprecated, {snmpm, async_set, 6}, "R16B"}; + {removed, {snmpm, async_set, 6}, "R16B"}; obsolete_1(snmpm, gb, 5) -> - {deprecated, {snmpm, sync_get_bulk, 5}, "R16B"}; + {removed, {snmpm, sync_get_bulk, 5}, "R16B"}; obsolete_1(snmpm, gb, 6) -> - {deprecated, {snmpm, sync_get_bulk, [5,6]}, "R16B"}; + {removed, {snmpm, sync_get_bulk, [5,6]}, "R16B"}; obsolete_1(snmpm, gb, 7) -> - {deprecated, {snmpm, sync_get_bulk, [6,7]}, "R16B"}; + {removed, {snmpm, sync_get_bulk, [6,7]}, "R16B"}; obsolete_1(snmpm, gb, 8) -> - {deprecated, {snmpm, sync_get_bulk, [7,8]}, "R16B"}; + {removed, {snmpm, sync_get_bulk, [7,8]}, "R16B"}; obsolete_1(snmpm, gb, 9) -> - {deprecated, {snmpm, sync_get_bulk, 8}, "R16B"}; + {removed, {snmpm, sync_get_bulk, 8}, "R16B"}; obsolete_1(snmpm, agb, 5) -> - {deprecated, {snmpm, async_get_bulk, 5}, "R16B"}; + {removed, {snmpm, async_get_bulk, 5}, "R16B"}; obsolete_1(snmpm, agb, 6) -> - {deprecated, {snmpm, async_get_bulk, [5,6]}, "R16B"}; + {removed, {snmpm, async_get_bulk, [5,6]}, "R16B"}; obsolete_1(snmpm, agb, 7) -> - {deprecated, {snmpm, async_get_bulk, [6,7]}, "R16B"}; + {removed, {snmpm, async_get_bulk, [6,7]}, "R16B"}; obsolete_1(snmpm, agb, 8) -> - {deprecated, {snmpm, async_get_bulk, [7,8]}, "R16B"}; + {removed, {snmpm, async_get_bulk, [7,8]}, "R16B"}; obsolete_1(snmpm, agb, 9) -> - {deprecated, {snmpm, async_get_bulk, 8}, "R16B"}; + {removed, {snmpm, async_get_bulk, 8}, "R16B"}; %% *** MEGACO *** @@ -187,23 +363,6 @@ obsolete_1(auth, node_cookie, 1) -> obsolete_1(auth, node_cookie, 2) -> {deprecated, "Deprecated; use erlang:set_cookie/2 and net_adm:ping/1 instead"}; -obsolete_1(erlang, is_constant, 1) -> - {removed, "Removed in R13B"}; - -%% Added in R12B-0. -obsolete_1(ssl, port, 1) -> - {removed, {ssl, sockname, 1}, "R13B"}; -obsolete_1(ssl, accept, A) when A =:= 1; A =:= 2 -> - {removed, "deprecated; use ssl:transport_accept/1,2 and ssl:ssl_accept/1,2"}; -obsolete_1(erlang, fault, 1) -> - {removed, {erlang,error,1}, "R13B"}; -obsolete_1(erlang, fault, 2) -> - {removed, {erlang,error,2}, "R13B"}; - -%% Added in R12B-2. -obsolete_1(file, rawopen, 2) -> - {removed, "deprecated (will be removed in R13B); use file:open/2 with the raw option"}; - obsolete_1(http, request, 1) -> {removed,{httpc,request,1},"R15B"}; obsolete_1(http, request, 2) -> {removed,{httpc,request,2},"R15B"}; obsolete_1(http, request, 4) -> {removed,{httpc,request,4},"R15B"}; @@ -221,106 +380,10 @@ obsolete_1(http, cookie_header, 2) -> {removed,{httpc,cookie_header,2},"R15B" obsolete_1(http, stream_next, 1) -> {removed,{httpc,stream_next,1},"R15B"}; obsolete_1(http, default_profile, 0) -> {removed,{httpc,default_profile,0},"R15B"}; -obsolete_1(httpd, start, 0) -> {removed,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, start, 1) -> {removed,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, start_link, 0) -> {removed,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, start_link, 1) -> {removed,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, start_child, 0) -> {removed,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, start_child, 1) -> {removed,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, stop, 0) -> {removed,{inets,stop,2},"R14B"}; -obsolete_1(httpd, stop, 1) -> {removed,{inets,stop,2},"R14B"}; -obsolete_1(httpd, stop, 2) -> {removed,{inets,stop,2},"R14B"}; -obsolete_1(httpd, stop_child, 0) -> {removed,{inets,stop,2},"R14B"}; -obsolete_1(httpd, stop_child, 1) -> {removed,{inets,stop,2},"R14B"}; -obsolete_1(httpd, stop_child, 2) -> {removed,{inets,stop,2},"R14B"}; -obsolete_1(httpd, restart, 0) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, restart, 1) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, restart, 2) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, block, 0) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, block, 1) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, block, 2) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, block, 3) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, block, 4) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, unblock, 0) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, unblock, 1) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, unblock, 2) -> {removed,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd_util, key1search, 2) -> {removed,{proplists,get_value,2},"R13B"}; -obsolete_1(httpd_util, key1search, 3) -> {removed,{proplists,get_value,3},"R13B"}; -obsolete_1(ftp, open, 3) -> {removed,{inets,start,[2,3]},"R14B"}; -obsolete_1(ftp, force_active, 1) -> {removed,{inets,start,[2,3]},"R14B"}; - -%% Added in R12B-4. -obsolete_1(ssh_cm, connect, A) when 1 =< A, A =< 3 -> - {removed,{ssh,connect,A},"R14B"}; -obsolete_1(ssh_cm, listen, A) when 2 =< A, A =< 4 -> - {removed,{ssh,daemon,A},"R14B"}; -obsolete_1(ssh_cm, stop_listener, 1) -> - {removed,{ssh,stop_listener,[1,2]},"R14B"}; -obsolete_1(ssh_cm, session_open, A) when A =:= 2; A =:= 4 -> - {removed,{ssh_connection,session_channel,A},"R14B"}; -obsolete_1(ssh_cm, direct_tcpip, A) when A =:= 6; A =:= 8 -> - {removed,{ssh_connection,direct_tcpip,A}}; -obsolete_1(ssh_cm, tcpip_forward, 3) -> - {removed,{ssh_connection,tcpip_forward,3},"R14B"}; -obsolete_1(ssh_cm, cancel_tcpip_forward, 3) -> - {removed,{ssh_connection,cancel_tcpip_forward,3},"R14B"}; -obsolete_1(ssh_cm, open_pty, A) when A =:= 3; A =:= 7; A =:= 9 -> - {removed,{ssh_connection,open_pty,A},"R14"}; -obsolete_1(ssh_cm, setenv, 5) -> - {removed,{ssh_connection,setenv,5},"R14B"}; -obsolete_1(ssh_cm, shell, 2) -> - {removed,{ssh_connection,shell,2},"R14B"}; -obsolete_1(ssh_cm, exec, 4) -> - {removed,{ssh_connection,exec,4},"R14B"}; -obsolete_1(ssh_cm, subsystem, 4) -> - {removed,{ssh_connection,subsystem,4},"R14B"}; -obsolete_1(ssh_cm, winch, A) when A =:= 4; A =:= 6 -> - {removed,{ssh_connection,window_change,A},"R14B"}; -obsolete_1(ssh_cm, signal, 3) -> - {removed,{ssh_connection,signal,3},"R14B"}; -obsolete_1(ssh_cm, attach, A) when A =:= 2; A =:= 3 -> - {removed,{ssh,attach,A}}; -obsolete_1(ssh_cm, detach, 2) -> - {removed,"no longer useful; will be removed in R14B"}; -obsolete_1(ssh_cm, set_user_ack, 4) -> - {removed,"no longer useful; will be removed in R14B"}; -obsolete_1(ssh_cm, adjust_window, 3) -> - {removed,{ssh_connection,adjust_window,3},"R14B"}; -obsolete_1(ssh_cm, close, 2) -> - {removed,{ssh_connection,close,2},"R14B"}; -obsolete_1(ssh_cm, stop, 1) -> - {removed,{ssh,close,1},"R14B"}; -obsolete_1(ssh_cm, send_eof, 2) -> - {removed,{ssh_connection,send_eof,2},"R14B"}; -obsolete_1(ssh_cm, send, A) when A =:= 3; A =:= 4 -> - {removed,{ssh_connection,send,A},"R14B"}; -obsolete_1(ssh_cm, send_ack, A) when 3 =< A, A =< 5 -> - {removed,{ssh_connection,send,[3,4]},"R14B"}; -obsolete_1(ssh_ssh, connect, A) when 1 =< A, A =< 3 -> - {removed,{ssh,shell,A},"R14B"}; -obsolete_1(ssh_sshd, listen, A) when 0 =< A, A =< 3 -> - {removed,{ssh,daemon,[1,2,3]},"R14"}; -obsolete_1(ssh_sshd, stop, 1) -> - {removed,{ssh,stop_listener,1}}; - %% Added in R13A. obsolete_1(regexp, _, _) -> {removed, "removed in R15; use the re module instead"}; -obsolete_1(lists, flat_length, 1) -> - {removed,{lists,flatlength,1},"R14"}; - -obsolete_1(ssh_sftp, connect, A) when 1 =< A, A =< 3 -> - {removed,{ssh_sftp,start_channel,A},"R14B"}; -obsolete_1(ssh_sftp, stop, 1) -> - {removed,{ssh_sftp,stop_channel,1},"R14B"}; - -%% Added in R13B01. -obsolete_1(ssl_pkix, decode_cert_file, A) when A =:= 1; A =:= 2 -> - {removed,"removed in R14A; use public_key:pem_to_der/1 and public_key:pkix_decode_cert/2 instead"}; -obsolete_1(ssl_pkix, decode_cert, A) when A =:= 1; A =:= 2 -> - {removed,{public_key,pkix_decode_cert,2},"R14A"}; - %% Added in R13B04. obsolete_1(erlang, concat_binary, 1) -> {removed,{erlang,list_to_binary,1},"R15B"}; @@ -345,20 +408,149 @@ obsolete_1(docb_xml_check, _, _) -> %% Added in R15B obsolete_1(asn1rt, F, _) when F == load_driver; F == unload_driver -> - {deprecated,"deprecated (will be removed in R16A); has no effect as drivers are no longer used."}; + {deprecated,"deprecated (will be removed in OTP 18); has no effect as drivers are no longer used"}; obsolete_1(ssl, pid, 1) -> - {deprecated,"deprecated (will be removed in R17); is no longer needed"}; + {removed,"was removed in R16; is no longer needed"}; obsolete_1(inviso, _, _) -> - {deprecated,"the inviso application has been deprecated and will be removed in R16"}; + {removed,"the inviso application was removed in R16"}; %% Added in R15B01. obsolete_1(gs, _, _) -> - {deprecated,"the gs application has been deprecated and will be removed in R16; use the wx application instead"}; + {deprecated,"the gs application has been deprecated and will be removed in OTP 18; use the wx application instead"}; obsolete_1(ssh, sign_data, 2) -> {deprecated,"deprecated (will be removed in R16A); use public_key:pem_decode/1, public_key:pem_entry_decode/1 " "and public_key:sign/3 instead"}; obsolete_1(ssh, verify_data, 3) -> {deprecated,"deprecated (will be removed in R16A); use public_key:ssh_decode/1, and public_key:verify/4 instead"}; + +%% Added in R16 +obsolete_1(wxCalendarCtrl, enableYearChange, _) -> %% wx bug documented? + {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; +obsolete_1(wxDC, computeScaleAndOrigin, 1) -> + {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; +obsolete_1(wxClientDC, new, 0) -> + {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; +obsolete_1(wxPaintDC, new, 0) -> + {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; +obsolete_1(wxWindowDC, new, 0) -> + {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; +obsolete_1(wxGraphicsContext, createLinearGradientBrush, 7) -> + {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; +obsolete_1(wxGraphicsContext, createRadialGradientBrush, 8) -> + {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; +obsolete_1(wxGraphicsRenderer, createLinearGradientBrush, 7) -> + {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; +obsolete_1(wxGraphicsRenderer, createRadialGradientBrush, 8) -> + {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; +obsolete_1(wxGridCellEditor, endEdit, 4) -> + {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; +obsolete_1(wxGridCellEditor, paintBackground, 3) -> + {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; +obsolete_1(wxIdleEvent, canSend, 1) -> + {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; +obsolete_1(wxMDIClientWindow, new, 1) -> + {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; +obsolete_1(wxMDIClientWindow, new, 2) -> + {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; +obsolete_1(wxPostScriptDC, getResolution, 0) -> + {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; +obsolete_1(wxPostScriptDC, setResolution, 1) -> + {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; +obsolete_1(wxCursor, new, 3) -> + {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; +obsolete_1(wxCursor, new, 4) -> + {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; + +%% Added in OTP 17. +obsolete_1(asn1ct, decode,3) -> + {deprecated,"deprecated; use Mod:decode/2 instead"}; +obsolete_1(asn1ct, encode, 3) -> + {deprecated,"deprecated; use Mod:encode/2 instead"}; +obsolete_1(asn1rt, decode,3) -> + {deprecated,"deprecated; use Mod:decode/2 instead"}; +obsolete_1(asn1rt, encode, 2) -> + {deprecated,"deprecated; use Mod:encode/2 instead"}; +obsolete_1(asn1rt, encode, 3) -> + {deprecated,"deprecated; use Mod:encode/2 instead"}; +obsolete_1(asn1rt, info, 1) -> + {deprecated,"deprecated; use Mod:info/0 instead"}; +obsolete_1(asn1rt, utf8_binary_to_list, 1) -> + {deprecated,{unicode,characters_to_list,1}}; +obsolete_1(asn1rt, utf8_list_to_binary, 1) -> + {deprecated,{unicode,characters_to_binary,1}}; + +%% Added in OTP 18. +obsolete_1(core_lib, get_anno, 1) -> + {removed,{cerl,get_ann,1},"19"}; +obsolete_1(core_lib, set_anno, 2) -> + {removed,{cerl,set_ann,2},"19"}; +obsolete_1(core_lib, is_literal, 1) -> + {removed,{cerl,is_literal,1},"19"}; +obsolete_1(core_lib, is_literal_list, 1) -> + {removed,"removed; use lists:all(fun cerl:is_literal/1, L)" + " instead"}; +obsolete_1(core_lib, literal_value, 1) -> + {removed,{core_lib,concrete,1},"19"}; +obsolete_1(erl_scan, set_attribute, 3) -> + {removed,{erl_anno,set_line,2},"19.0"}; +obsolete_1(erl_scan, attributes_info, 1) -> + {removed,"removed in 19.0; use " + "erl_anno:{column,line,location,text}/1 instead"}; +obsolete_1(erl_scan, attributes_info, 2) -> + {removed,"removed in 19.0; use " + "erl_anno:{column,line,location,text}/1 instead"}; +obsolete_1(erl_scan, token_info, 1) -> + {removed,"removed in 19.0; use " + "erl_scan:{category,column,line,location,symbol,text}/1 instead"}; +obsolete_1(erl_scan, token_info, 2) -> + {removed,"removed in 19.0; use " + "erl_scan:{category,column,line,location,symbol,text}/1 instead"}; +obsolete_1(erl_parse, set_line, 2) -> + {removed,{erl_anno,set_line,2},"19.0"}; +obsolete_1(erl_parse, get_attributes, 1) -> + {removed,"removed in 19.0; use " + "erl_anno:{column,line,location,text}/1 instead"}; +obsolete_1(erl_parse, get_attribute, 2) -> + {removed,"removed in 19.0; use " + "erl_anno:{column,line,location,text}/1 instead"}; +obsolete_1(erl_lint, modify_line, 2) -> + {removed,{erl_parse,map_anno,2},"19.0"}; +obsolete_1(ssl, negotiated_next_protocol, 1) -> + {deprecated,{ssl,negotiated_protocol,1}}; + +obsolete_1(ssl, connection_info, 1) -> + {deprecated, "deprecated; use connection_information/[1,2] instead"}; + +obsolete_1(httpd_conf, check_enum, 2) -> + {deprecated, "deprecated; use lists:member/2 instead"}; +obsolete_1(httpd_conf, clean, 1) -> + {deprecated, "deprecated; use sting:strip/1 instead or possible the re module"}; +obsolete_1(httpd_conf, custom_clean, 3) -> + {deprecated, "deprecated; use sting:strip/3 instead or possible the re module"}; +obsolete_1(httpd_conf, is_directory, 1) -> + {deprecated, "deprecated; use filelib:is_dir/1 instead"}; +obsolete_1(httpd_conf, is_file, 1) -> + {deprecated, "deprecated; use filelib:is_file/1 instead"}; +obsolete_1(httpd_conf, make_integer, 1) -> + {deprecated, "deprecated; use erlang:list_to_integer/1 instead"}; + +%% Added in OTP 19. + +obsolete_1(random, _, _) -> + {deprecated, "the 'random' module is deprecated; " + "use the 'rand' module instead"}; +obsolete_1(code, rehash, 0) -> + {deprecated, "deprecated because the code path cache feature has been removed"}; +obsolete_1(queue, lait, 1) -> + {deprecated, {queue,liat,1}}; + +%% Removed in OTP 19. + +obsolete_1(overload, _, _) -> + {removed, "removed in OTP 19"}; +obsolete_1(rpc, safe_multi_server_call, A) when A =:= 2; A =:= 3 -> + {removed, {rpc, multi_server_call, A}}; + obsolete_1(_, _, _) -> no. @@ -405,3 +597,30 @@ is_snmp_agent_function(add_agent_caps, 2) -> true; is_snmp_agent_function(del_agent_caps, 1) -> true; is_snmp_agent_function(get_agent_caps, 0) -> true; is_snmp_agent_function(_, _) -> false. + +-dialyzer({no_match, obsolete_type/3}). + +-spec obsolete_type(module(), atom(), arity()) -> + 'no' | {tag(), string()} | {tag(), mfas(), release()}. + +-dialyzer({no_match, obsolete_type/3}). +obsolete_type(Module, Name, NumberOfVariables) -> + case obsolete_type_1(Module, Name, NumberOfVariables) of + {deprecated=Tag,{_,_,_}=Replacement} -> + {Tag,Replacement,"in a future release"}; + {_,String}=Ret when is_list(String) -> + Ret; + {_,_,_}=Ret -> + Ret; + no -> + no + end. + +obsolete_type_1(erl_scan,column,0) -> + {removed,{erl_anno,column,0},"19.0"}; +obsolete_type_1(erl_scan,line,0) -> + {removed,{erl_anno,line,0},"19.0"}; +obsolete_type_1(erl_scan,location,0) -> + {removed,{erl_anno,location,0},"19.0"}; +obsolete_type_1(_,_,_) -> + no. diff --git a/lib/stdlib/src/pg.erl b/lib/stdlib/src/pg.erl deleted file mode 100644 index ee177e4e0b..0000000000 --- a/lib/stdlib/src/pg.erl +++ /dev/null @@ -1,186 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2011. 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% -%% --module(pg). - -%% pg provides a process group facility. Messages -%% can be multicasted to all members in the group - --export([create/1, - create/2, - standby/2, - join/2, - send/2, - esend/2, - members/1, - name_to_pid/1, - master/1]). - - -%% Create a brand new empty process group with the master residing -%% at the local node - --spec create(PgName) -> 'ok' | {'error', Reason} when - PgName :: term(), - Reason :: 'already_created' | term(). - -create(PgName) -> - catch begin check(PgName), - Pid = spawn(pg,master,[PgName]), - global:register_name(PgName,Pid), - ok end. - -%% Create a brand new empty process group with the master -%% residing at Node - --spec create(PgName, Node) -> 'ok' | {'error', Reason} when - PgName :: term(), - Node :: node(), - Reason :: 'already_created' | term(). - -create(PgName, Node) -> - catch begin check(PgName), - Pid = spawn(Node,pg,master,[PgName]), - global:register_name(PgName,Pid), - ok end. - -%% Have a process on Node that will act as a standby for the process -%% group manager. So if the node where the manager runs fails, the -%% process group will continue to function. - --spec standby(term(), node()) -> 'ok'. - -standby(_PgName, _Node) -> - ok. - -%% Tell process group PgName that Pid is a new member of the group -%% synchronously return a list of all old members in the group - --spec join(PgName, Pid) -> Members when - PgName :: term(), - Pid :: pid(), - Members :: [pid()]. - -join(PgName, Pid) when is_atom(PgName) -> - global:send(PgName, {join,self(),Pid}), - receive - {_P,{members,Members}} -> - Members - end. - -%% Multi cast Mess to all members in the group - --spec send(PgName, Msg) -> 'ok' when - PgName :: term(), - Msg :: term(). - -send(PgName, Mess) when is_atom(PgName) -> - global:send(PgName, {send, self(), Mess}), - ok; -send(Pg, Mess) when is_pid(Pg) -> - Pg ! {send,self(),Mess}, - ok. - -%% multi cast a message to all members in the group but ourselves -%% If we are a member - --spec esend(PgName, Msg) -> 'ok' when - PgName :: term(), - Msg :: term(). - -esend(PgName, Mess) when is_atom(PgName) -> - global:send(PgName, {esend,self(),Mess}), - ok; -esend(Pg, Mess) when is_pid(Pg) -> - Pg ! {esend,self(),Mess}, - ok. - -%% Return the members of the group - --spec members(PgName) -> Members when - PgName :: term(), - Members :: [pid()]. - -members(PgName) when is_atom(PgName) -> - global:send(PgName, {self() ,members}), - receive - {_P,{members,Members}} -> - Members - end; -members(Pg) when is_pid(Pg) -> - Pg ! {self,members}, - receive - {_P,{members,Members}} -> - Members - end. - --spec name_to_pid(atom()) -> pid() | 'undefined'. - -name_to_pid(PgName) when is_atom(PgName) -> - global:whereis_name(PgName). - --spec master(term()) -> no_return(). - -master(PgName) -> - process_flag(trap_exit, true), - master_loop(PgName, []). - -master_loop(PgName,Members) -> - receive - {send,From,Message} -> - send_all(Members,{pg_message,From,PgName,Message}), - master_loop(PgName,Members); - {esend,From,Message} -> - send_all(lists:delete(From,Members), - {pg_message,From,PgName,Message}), - master_loop(PgName,Members); - {join,From,Pid} -> - link(Pid), - send_all(Members,{new_member,PgName,Pid}), - From ! {self(),{members,Members}}, - master_loop(PgName,[Pid|Members]); - {From,members} -> - From ! {self(),{members,Members}}, - master_loop(PgName,Members); - {'EXIT',From,_} -> - L = - case lists:member(From,Members) of - true -> - NewMembers = lists:delete(From,Members), - send_all(NewMembers, {crashed_member,PgName,From}), - NewMembers; - false -> - Members - end, - master_loop(PgName,L) - end. - -send_all([], _) -> ok; -send_all([P|Ps], M) -> - P ! M, - send_all(Ps, M). - -%% Check if the process group already exists - -check(PgName) -> - case global:whereis_name(PgName) of - Pid when is_pid(Pid) -> - throw({error,already_created}); - undefined -> - ok - end. diff --git a/lib/stdlib/src/pool.erl b/lib/stdlib/src/pool.erl index a5eb191ab2..05950a1d7c 100644 --- a/lib/stdlib/src/pool.erl +++ b/lib/stdlib/src/pool.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -63,7 +64,7 @@ start(Name) -> Args :: string(), Nodes :: [node()]. start(Name, Args) when is_atom(Name) -> - gen_server:start({global, pool_master}, pool, [], []), + _ = gen_server:start({global, pool_master}, pool, [], []), Hosts = net_adm:host_file(), Nodes = start_nodes(Hosts, Name, Args), lists:foreach(fun attach/1, Nodes), diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl index 02bcbb5a60..3dc1848550 100644 --- a/lib/stdlib/src/proc_lib.erl +++ b/lib/stdlib/src/proc_lib.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -29,7 +30,10 @@ start/3, start/4, start/5, start_link/3, start_link/4, start_link/5, hibernate/3, init_ack/1, init_ack/2, - init_p/3,init_p/5,format/1,initial_call/1,translate_initial_call/1]). + init_p/3,init_p/5,format/1,format/2,format/3, + initial_call/1, + translate_initial_call/1, + stop/1, stop/3]). %% Internal exports. -export([wake_up/3]). @@ -39,12 +43,19 @@ %%----------------------------------------------------------------------------- -type priority_level() :: 'high' | 'low' | 'max' | 'normal'. +-type max_heap_size() :: non_neg_integer() | + #{ size => non_neg_integer(), + kill => true, + error_logger => true}. -type spawn_option() :: 'link' | 'monitor' | {'priority', priority_level()} + | {'max_heap_size', max_heap_size()} | {'min_heap_size', non_neg_integer()} | {'min_bin_vheap_size', non_neg_integer()} - | {'fullsweep_after', non_neg_integer()}. + | {'fullsweep_after', non_neg_integer()} + | {'message_queue_data', + 'off_heap' | 'on_heap' | 'mixed' }. -type dict_or_pid() :: pid() | (ProcInfo :: [_]) @@ -184,6 +195,17 @@ check_for_monitor(SpawnOpts) -> false end. +spawn_mon(M,F,A) -> + Parent = get_my_name(), + Ancestors = get_ancestors(), + erlang:spawn_monitor(?MODULE, init_p, [Parent,Ancestors,M,F,A]). + +spawn_opt_mon(M, F, A, Opts) when is_atom(M), is_atom(F), is_list(A) -> + Parent = get_my_name(), + Ancestors = get_ancestors(), + check_for_monitor(Opts), + erlang:spawn_opt(?MODULE, init_p, [Parent,Ancestors,M,F,A], [monitor|Opts]). + -spec hibernate(Module, Function, Args) -> no_return() when Module :: module(), Function :: atom(), @@ -204,10 +226,8 @@ ensure_link(SpawnOpts) -> init_p(Parent, Ancestors, Fun) when is_function(Fun) -> put('$ancestors', [Parent|Ancestors]), - {module,Mod} = erlang:fun_info(Fun, module), - {name,Name} = erlang:fun_info(Fun, name), - {arity,Arity} = erlang:fun_info(Fun, arity), - put('$initial_call', {Mod,Name,Arity}), + Mfa = erlang:fun_info_mfa(Fun), + put('$initial_call', Mfa), try Fun() catch @@ -270,8 +290,8 @@ start(M, F, A) when is_atom(M), is_atom(F), is_list(A) -> Ret :: term() | {error, Reason :: term()}. start(M, F, A, Timeout) when is_atom(M), is_atom(F), is_list(A) -> - Pid = ?MODULE:spawn(M, F, A), - sync_wait(Pid, Timeout). + PidRef = spawn_mon(M, F, A), + sync_wait_mon(PidRef, Timeout). -spec start(Module, Function, Args, Time, SpawnOpts) -> Ret when Module :: module(), @@ -282,8 +302,8 @@ start(M, F, A, Timeout) when is_atom(M), is_atom(F), is_list(A) -> Ret :: term() | {error, Reason :: term()}. start(M, F, A, Timeout, SpawnOpts) when is_atom(M), is_atom(F), is_list(A) -> - Pid = ?MODULE:spawn_opt(M, F, A, SpawnOpts), - sync_wait(Pid, Timeout). + PidRef = spawn_opt_mon(M, F, A, SpawnOpts), + sync_wait_mon(PidRef, Timeout). -spec start_link(Module, Function, Args) -> Ret when Module :: module(), @@ -330,6 +350,23 @@ sync_wait(Pid, Timeout) -> {error, timeout} end. +sync_wait_mon({Pid, Ref}, Timeout) -> + receive + {ack, Pid, Return} -> + erlang:demonitor(Ref, [flush]), + Return; + {'DOWN', Ref, _Type, Pid, Reason} -> + {error, Reason}; + {'EXIT', Pid, Reason} -> %% link as spawn_opt? + erlang:demonitor(Ref, [flush]), + {error, Reason} + after Timeout -> + erlang:demonitor(Ref, [flush]), + exit(Pid, kill), + flush(Pid), + {error, timeout} + end. + -spec flush(pid()) -> 'true'. flush(Pid) -> @@ -442,16 +479,12 @@ trans_init(gen,init_it,[gen_server,_,_,supervisor_bridge,[Module|_],_]) -> {supervisor_bridge,Module,1}; trans_init(gen,init_it,[gen_server,_,_,_,supervisor_bridge,[Module|_],_]) -> {supervisor_bridge,Module,1}; -trans_init(gen,init_it,[gen_server,_,_,Module,_,_]) -> - {Module,init,1}; -trans_init(gen,init_it,[gen_server,_,_,_,Module|_]) -> - {Module,init,1}; -trans_init(gen,init_it,[gen_fsm,_,_,Module,_,_]) -> - {Module,init,1}; -trans_init(gen,init_it,[gen_fsm,_,_,_,Module|_]) -> - {Module,init,1}; trans_init(gen,init_it,[gen_event|_]) -> {gen_event,init_it,6}; +trans_init(gen,init_it,[_GenMod,_,_,Module,_,_]) when is_atom(Module) -> + {Module,init,1}; +trans_init(gen,init_it,[_GenMod,_,_,_,Module|_]) when is_atom(Module) -> + {Module,init,1}; trans_init(M, F, A) when is_atom(M), is_atom(F) -> {M,F,length(A)}. @@ -664,49 +697,125 @@ check(Res) -> Res. -spec format(CrashReport) -> string() when CrashReport :: [term()]. - -format([OwnReport,LinkReport]) -> - OwnFormat = format_report(OwnReport), - LinkFormat = format_report(LinkReport), - S = io_lib:format(" crasher:~n~s neighbours:~n~s",[OwnFormat,LinkFormat]), - lists:flatten(S). - -format_report(Rep) when is_list(Rep) -> - format_rep(Rep); -format_report(Rep) -> - io_lib:format("~p~n", [Rep]). - -format_rep([{initial_call,InitialCall}|Rep]) -> - [format_mfa(InitialCall)|format_rep(Rep)]; -format_rep([{error_info,{Class,Reason,StackTrace}}|Rep]) -> - [format_exception(Class, Reason, StackTrace)|format_rep(Rep)]; -format_rep([{Tag,Data}|Rep]) -> - [format_tag(Tag, Data)|format_rep(Rep)]; -format_rep(_) -> +format(CrashReport) -> + format(CrashReport, latin1). + +-spec format(CrashReport, Encoding) -> string() when + CrashReport :: [term()], + Encoding :: latin1 | unicode | utf8. + +format(CrashReport, Encoding) -> + format(CrashReport, Encoding, unlimited). + +-spec format(CrashReport, Encoding, Depth) -> string() when + CrashReport :: [term()], + Encoding :: latin1 | unicode | utf8, + Depth :: unlimited | pos_integer(). + +format([OwnReport,LinkReport], Encoding, Depth) -> + Extra = {Encoding,Depth}, + OwnFormat = format_report(OwnReport, Extra), + LinkFormat = format_report(LinkReport, Extra), + Str = io_lib:format(" crasher:~n~ts neighbours:~n~ts", + [OwnFormat, LinkFormat]), + lists:flatten(Str). + +format_report(Rep, Extra) when is_list(Rep) -> + format_rep(Rep, Extra); +format_report(Rep, {Enc,_}) -> + io_lib:format("~"++modifier(Enc)++"p~n", [Rep]). + +format_rep([{initial_call,InitialCall}|Rep], {_Enc,Depth}=Extra) -> + [format_mfa(InitialCall, Depth)|format_rep(Rep, Extra)]; +format_rep([{error_info,{Class,Reason,StackTrace}}|Rep], Extra) -> + [format_exception(Class, Reason, StackTrace, Extra)|format_rep(Rep, Extra)]; +format_rep([{Tag,Data}|Rep], Extra) -> + [format_tag(Tag, Data, Extra)|format_rep(Rep, Extra)]; +format_rep(_, _Extra) -> []. -format_exception(Class, Reason, StackTrace) -> - PF = pp_fun(), +format_exception(Class, Reason, StackTrace, {Enc,_}=Extra) -> + PF = pp_fun(Extra), StackFun = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end, %% EI = " exception: ", EI = " ", [EI, lib:format_exception(1+length(EI), Class, Reason, - StackTrace, StackFun, PF), "\n"]. + StackTrace, StackFun, PF, Enc), "\n"]. -format_mfa({M,F,Args}=StartF) -> +format_mfa({M,F,Args}=StartF, Depth) -> try A = length(Args), [" initial call: ",atom_to_list(M),$:,atom_to_list(F),$/, integer_to_list(A),"\n"] catch error:_ -> - format_tag(initial_call, StartF) + format_tag(initial_call, StartF, Depth) end. -pp_fun() -> +pp_fun({Enc,Depth}) -> + {Letter,Tl} = case Depth of + unlimited -> {"p",[]}; + _ -> {"P",[Depth]} + end, + P = modifier(Enc) ++ Letter, fun(Term, I) -> - io_lib:format("~." ++ integer_to_list(I) ++ "p", [Term]) + io_lib:format("~." ++ integer_to_list(I) ++ P, [Term|Tl]) + end. + +format_tag(Tag, Data, {_Enc,Depth}) -> + case Depth of + unlimited -> + io_lib:format(" ~p: ~80.18p~n", [Tag, Data]); + _ -> + io_lib:format(" ~p: ~80.18P~n", [Tag, Data, Depth]) end. -format_tag(Tag, Data) -> - io_lib:format(" ~p: ~80.18p~n", [Tag, Data]). +modifier(latin1) -> ""; +modifier(_) -> "t". + + +%%% ----------------------------------------------------------- +%%% Stop a process and wait for it to terminate +%%% ----------------------------------------------------------- +-spec stop(Process) -> 'ok' when + Process :: pid() | RegName | {RegName,node()}, + RegName :: atom(). +stop(Process) -> + stop(Process, normal, infinity). + +-spec stop(Process, Reason, Timeout) -> 'ok' when + Process :: pid() | RegName | {RegName,node()}, + RegName :: atom(), + Reason :: term(), + Timeout :: timeout(). +stop(Process, Reason, Timeout) -> + {Pid, Mref} = erlang:spawn_monitor(do_stop(Process, Reason)), + receive + {'DOWN', Mref, _, _, Reason} -> + ok; + {'DOWN', Mref, _, _, {noproc,{sys,terminate,_}}} -> + exit(noproc); + {'DOWN', Mref, _, _, CrashReason} -> + exit(CrashReason) + after Timeout -> + exit(Pid, kill), + receive + {'DOWN', Mref, _, _, _} -> + exit(timeout) + end + end. + +-spec do_stop(Process, Reason) -> Fun when + Process :: pid() | RegName | {RegName,node()}, + RegName :: atom(), + Reason :: term(), + Fun :: fun(() -> no_return()). +do_stop(Process, Reason) -> + fun() -> + Mref = erlang:monitor(process, Process), + ok = sys:terminate(Process, Reason, infinity), + receive + {'DOWN', Mref, _, _, ExitReason} -> + exit(ExitReason) + end + end. diff --git a/lib/stdlib/src/proplists.erl b/lib/stdlib/src/proplists.erl index e3eda5d932..5356467b19 100644 --- a/lib/stdlib/src/proplists.erl +++ b/lib/stdlib/src/proplists.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -51,20 +52,21 @@ -export_type([property/0, proplist/0]). --type property() :: atom() | tuple(). +-type property() :: atom() | tuple(). -type proplist() :: [property()]. %% --------------------------------------------------------------------- %% @doc Creates a normal form (minimal) representation of a property. If -%% <code>P</code> is <code>{Key, true}</code> where <code>Key</code> is -%% an atom, this returns <code>Key</code>, otherwise the whole term -%% <code>P</code> is returned. +%% <code>PropertyIn</code> is <code>{Key, true}</code> where +%% <code>Key</code> is an atom, this returns <code>Key</code>, otherwise +%% the whole term <code>PropertyIn</code> is returned. %% %% @see property/2 --spec property(Property) -> Property when - Property :: property(). +-spec property(PropertyIn) -> PropertyOut when + PropertyIn :: property(), + PropertyOut :: property(). property({Key, true}) when is_atom(Key) -> Key; @@ -92,13 +94,14 @@ property(Key, Value) -> %% --------------------------------------------------------------------- -%% @doc Unfolds all occurences of atoms in <code>List</code> to tuples +%% @doc Unfolds all occurences of atoms in <code>ListIn</code> to tuples %% <code>{Atom, true}</code>. %% %% @see compact/1 --spec unfold(List) -> List when - List :: [term()]. +-spec unfold(ListIn) -> ListOut when + ListIn :: [term()], + ListOut :: [term()]. unfold([P | Ps]) -> if is_atom(P) -> @@ -110,16 +113,17 @@ unfold([]) -> []. %% @doc Minimizes the representation of all entries in the list. This is -%% equivalent to <code>[property(P) || P <- List]</code>. +%% equivalent to <code>[property(P) || P <- ListIn]</code>. %% %% @see unfold/1 %% @see property/1 --spec compact(List) -> List when - List :: [property()]. +-spec compact(ListIn) -> ListOut when + ListIn :: [property()], + ListOut :: [property()]. -compact(List) -> - [property(P) || P <- List]. +compact(ListIn) -> + [property(P) || P <- ListIn]. %% --------------------------------------------------------------------- @@ -199,7 +203,7 @@ is_defined(_Key, []) -> -spec get_value(Key, List) -> term() when Key :: term(), - List :: List::[term()]. + List :: [term()]. get_value(Key, List) -> get_value(Key, List, undefined). @@ -272,9 +276,10 @@ get_all_values(_Key, []) -> %% %% @see get_all_values/2 --spec append_values(Key, List) -> List when +-spec append_values(Key, ListIn) -> ListOut when Key :: term(), - List :: [term()]. + ListIn :: [term()], + ListOut :: [term()]. append_values(Key, [P | Ps]) -> if is_atom(P), P =:= Key -> @@ -357,7 +362,7 @@ get_keys([], Keys) -> -spec delete(Key, List) -> List when Key :: term(), - List::[term()]. + List :: [term()]. delete(Key, [P | Ps]) -> if is_atom(P), P =:= Key -> @@ -374,7 +379,7 @@ delete(_, []) -> %% --------------------------------------------------------------------- %% @doc Substitutes keys of properties. For each entry in -%% <code>List</code>, if it is associated with some key <code>K1</code> +%% <code>ListIn</code>, if it is associated with some key <code>K1</code> %% such that <code>{K1, K2}</code> occurs in <code>Aliases</code>, the %% key of the entry is changed to <code>Key2</code>. If the same %% <code>K1</code> occurs more than once in <code>Aliases</code>, only @@ -388,10 +393,11 @@ delete(_, []) -> %% @see substitute_negations/2 %% @see normalize/2 --spec substitute_aliases(Aliases, List) -> List when +-spec substitute_aliases(Aliases, ListIn) -> ListOut when Aliases :: [{Key, Key}], Key :: term(), - List::[term()]. + ListIn :: [term()], + ListOut :: [term()]. substitute_aliases(As, Props) -> [substitute_aliases_1(As, P) || P <- Props]. @@ -411,13 +417,13 @@ substitute_aliases_1([], P) -> %% --------------------------------------------------------------------- %% @doc Substitutes keys of boolean-valued properties and simultaneously -%% negates their values. For each entry in <code>List</code>, if it is +%% negates their values. For each entry in <code>ListIn</code>, if it is %% associated with some key <code>K1</code> such that <code>{K1, %% K2}</code> occurs in <code>Negations</code>, then if the entry was %% <code>{K1, true}</code> it will be replaced with <code>{K2, %% false}</code>, otherwise it will be replaced with <code>{K2, %% true}</code>, thus changing the name of the option and simultaneously -%% negating the value given by <code>get_bool(List)</code>. If the same +%% negating the value given by <code>get_bool(ListIn)</code>. If the same %% <code>K1</code> occurs more than once in <code>Negations</code>, only %% the first occurrence is used. %% @@ -431,10 +437,12 @@ substitute_aliases_1([], P) -> %% @see substitute_aliases/2 %% @see normalize/2 --spec substitute_negations(Negations, List) -> List when - Negations :: [{Key, Key}], - Key :: term(), - List :: [term()]. +-spec substitute_negations(Negations, ListIn) -> ListOut when + Negations :: [{Key1, Key2}], + Key1 :: term(), + Key2 :: term(), + ListIn :: [term()], + ListOut :: [term()]. substitute_negations(As, Props) -> [substitute_negations_1(As, P) || P <- Props]. @@ -466,11 +474,11 @@ substitute_negations_1([], P) -> %% @doc Expands particular properties to corresponding sets of %% properties (or other terms). For each pair <code>{Property, %% Expansion}</code> in <code>Expansions</code>, if <code>E</code> is -%% the first entry in <code>List</code> with the same key as +%% the first entry in <code>ListIn</code> with the same key as %% <code>Property</code>, and <code>E</code> and <code>Property</code> %% have equivalent normal forms, then <code>E</code> is replaced with %% the terms in <code>Expansion</code>, and any following entries with -%% the same key are deleted from <code>List</code>. +%% the same key are deleted from <code>ListIn</code>. %% %% <p>For example, the following expressions all return <code>[fie, bar, %% baz, fum]</code>: @@ -497,9 +505,10 @@ substitute_negations_1([], P) -> %% %% @see normalize/2 --spec expand(Expansions, List) -> List when +-spec expand(Expansions, ListIn) -> ListOut when Expansions :: [{Property :: property(), Expansion :: [term()]}], - List :: [term()]. + ListIn :: [term()], + ListOut :: [term()]. expand(Es, Ps) when is_list(Ps) -> Es1 = [{property(P), V} || {P, V} <- Es], @@ -599,15 +608,16 @@ flatten([]) -> %% @see expand/2 %% @see compact/1 --spec normalize(List, Stages) -> List when - List :: [term()], +-spec normalize(ListIn, Stages) -> ListOut when + ListIn :: [term()], Stages :: [Operation], Operation :: {'aliases', Aliases} | {'negations', Negations} | {'expand', Expansions}, Aliases :: [{Key, Key}], Negations :: [{Key, Key}], - Expansions :: [{Property :: property(), Expansion :: [term()]}]. + Expansions :: [{Property :: property(), Expansion :: [term()]}], + ListOut :: [term()]. normalize(L, [{aliases, As} | Xs]) -> normalize(substitute_aliases(As, L), Xs); diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index 2b691e6abf..f3665824f2 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -50,6 +51,8 @@ -export([template_state/0, aux_name/3, name_suffix/2, vars/1, var_ufold/2, var_fold/3, all_selections/1]). +-dialyzer(no_improper_lists). + %% When cache=list lists bigger than ?MAX_LIST_SIZE bytes are put on %% file. Also used when merge join finds big equivalence classes. -define(MAX_LIST_SIZE, 512*1024). @@ -125,7 +128,7 @@ -define(THROWN_ERROR, {?MODULE, throw_error, _, _}). --export_type([query_handle/0]). +-export_type([query_cursor/0, query_handle/0]). %%% A query handle is a tuple {qlc_handle, Handle} where Handle is one %%% of #qlc_append, #qlc_table, #qlc_sort, and #qlc_lc. @@ -386,25 +389,25 @@ format_error(nomatch_pattern) -> format_error(nomatch_filter) -> io_lib:format("filter evaluates to 'false'", []); format_error({Line, Mod, Reason}) when is_integer(Line) -> - io_lib:format("~p: ~s~n", + io_lib:format("~p: ~ts~n", [Line, lists:flatten(Mod:format_error(Reason))]); %% file_sorter errors format_error({bad_object, FileName}) -> - io_lib:format("the temporary file \"~s\" holding answers is corrupt", + io_lib:format("the temporary file \"~ts\" holding answers is corrupt", [FileName]); format_error(bad_object) -> io_lib:format("the keys could not be extracted from some term", []); format_error({file_error, FileName, Reason}) -> - io_lib:format("\"~s\": ~p~n",[FileName, file:format_error(Reason)]); + io_lib:format("\"~ts\": ~tp~n",[FileName, file:format_error(Reason)]); format_error({premature_eof, FileName}) -> - io_lib:format("\"~s\": end-of-file was encountered inside some binary term", + io_lib:format("\"~ts\": end-of-file was encountered inside some binary term", [FileName]); format_error({tmpdir_usage, Why}) -> io_lib:format("temporary file was needed for ~w~n", [Why]); format_error({error, Module, Reason}) -> Module:format_error(Reason); format_error(E) -> - io_lib:format("~p~n", [E]). + io_lib:format("~tp~n", [E]). -spec(info(QH) -> Info when QH :: query_handle_or_list(), @@ -731,10 +734,11 @@ table(TraverseFun, Options) when is_function(TraverseFun) -> table(T1, T2) -> erlang:error(badarg, [T1, T2]). --spec(transform_from_evaluator(LC, Bs) -> Expr when +-spec(transform_from_evaluator(LC, Bs) -> Return when LC :: abstract_expr(), - Expr :: abstract_expr(), - Bs :: erl_eval:binding_struct()). + Bs :: erl_eval:binding_struct(), + Return :: {ok, abstract_expr()} + | {not_ok, {error, module(), Reason :: term()}}). transform_from_evaluator(LC, Bs0) -> qlc_pt:transform_from_evaluator(LC, Bs0). @@ -807,21 +811,21 @@ options(Options0, [Key | Keys], L) when is_list(Options0) -> {ok, U}; {pre_fun, U=undefined} -> {ok, U}; - {info_fun, Fun} when is_function(Fun), is_function(Fun, 1) -> + {info_fun, Fun} when is_function(Fun, 1) -> {ok, Fun}; - {pre_fun, Fun} when is_function(Fun), is_function(Fun, 1) -> + {pre_fun, Fun} when is_function(Fun, 1) -> {ok, Fun}; - {post_fun, Fun} when is_function(Fun), is_function(Fun, 0) -> + {post_fun, Fun} when is_function(Fun, 0) -> {ok, Fun}; - {lookup_fun, Fun} when is_function(Fun), is_function(Fun, 2) -> + {lookup_fun, Fun} when is_function(Fun, 2) -> {ok, Fun}; {max_lookup, Max} when is_integer(Max), Max >= 0 -> {ok, Max}; {max_lookup, infinity} -> {ok, -1}; - {format_fun, Fun} when is_function(Fun), is_function(Fun, 1) -> + {format_fun, Fun} when is_function(Fun, 1) -> {ok, Fun}; - {parent_fun, Fun} when is_function(Fun), is_function(Fun, 0) -> + {parent_fun, Fun} when is_function(Fun, 0) -> {ok, Fun}; {key_equality, KE='=='} -> {ok, KE}; @@ -884,7 +888,7 @@ options(Options0, [Key | Keys], L) when is_list(Options0) -> {depth, Depth} when Depth =:= infinity; is_integer(Depth), Depth >= 0 -> {ok, Depth}; - {order, Order} when is_function(Order), is_function(Order, 2); + {order, Order} when is_function(Order, 2); (Order =:= ascending); (Order =:= descending) -> {ok, Order}; @@ -1006,7 +1010,7 @@ listify(T) -> -record(simple_qlc, {p, % atom(), pattern variable le, - line, + line :: erl_anno:anno(), init_value, optz % #optz }). @@ -1148,15 +1152,18 @@ abstract(Info, true=_Flat, NElements, Depth) -> [{match,_,Expr,Q}] -> Q; [{match,_,Expr,Q} | Body] -> - {block, 0, lists:reverse(Body, [Q])}; + {block, anno0(), lists:reverse(Body, [Q])}; _ -> - {block, 0, lists:reverse(Body0, [Expr])} + {block, anno0(), lists:reverse(Body0, [Expr])} end. -abstract({qlc, E0, Qs0, Opt}, NElements, Depth) -> +abstract(Info, NElements, Depth) -> + abstract1(Info, NElements, Depth, anno1()). + +abstract1({qlc, E0, Qs0, Opt}, NElements, Depth, A) -> Qs = lists:map(fun({generate, P, LE}) -> - {generate, 1, binary_to_term(P), - abstract(LE, NElements, Depth)}; + {generate, A, binary_to_term(P), + abstract1(LE, NElements, Depth, A)}; (F) -> binary_to_term(F) end, Qs0), @@ -1165,12 +1172,12 @@ abstract({qlc, E0, Qs0, Opt}, NElements, Depth) -> [] -> []; _ -> [abstract_term(Opt, 1)] end, - ?QLC_Q(1, 1, 1, 1, {lc,1,E,Qs}, Os); -abstract({table, {M, F, As0}}, _NElements, _Depth) + ?QLC_Q(A, A, A, A, {lc,A,E,Qs}, Os); +abstract1({table, {M, F, As0}}, _NElements, _Depth, Anno) when is_atom(M), is_atom(F), is_list(As0) -> As = [abstract_term(A, 1) || A <- As0], - {call, 1, {remote, 1, {atom, 1, M}, {atom, 1, F}}, As}; -abstract({table, TableDesc}, _NElements, _Depth) -> + {call, Anno, {remote, Anno, {atom, Anno, M}, {atom, Anno, F}}, As}; +abstract1({table, TableDesc}, _NElements, _Depth, _A) -> case io_lib:deep_char_list(TableDesc) of true -> {ok, Tokens, _} = erl_scan:string(lists:flatten(TableDesc++".")), @@ -1179,27 +1186,28 @@ abstract({table, TableDesc}, _NElements, _Depth) -> false -> % abstract expression TableDesc end; -abstract({append, Infos}, NElements, Depth) -> +abstract1({append, Infos}, NElements, Depth, A) -> As = lists:foldr(fun(Info, As0) -> - {cons,1,abstract(Info, NElements, Depth),As0} - end, {nil, 1}, Infos), - {call, 1, {remote, 1, {atom, 1, ?MODULE}, {atom, 1, append}}, [As]}; -abstract({sort, Info, SortOptions}, NElements, Depth) -> - {call, 1, {remote, 1, {atom, 1, ?MODULE}, {atom, 1, sort}}, - [abstract(Info, NElements, Depth), abstract_term(SortOptions, 1)]}; -abstract({keysort, Info, Kp, SortOptions}, NElements, Depth) -> - {call, 1, {remote, 1, {atom, 1, ?MODULE}, {atom, 1, keysort}}, - [abstract_term(Kp, 1), abstract(Info, NElements, Depth), + {cons,A,abstract1(Info, NElements, Depth, A), + As0} + end, {nil, A}, Infos), + {call, A, {remote, A, {atom, A, ?MODULE}, {atom, A, append}}, [As]}; +abstract1({sort, Info, SortOptions}, NElements, Depth, A) -> + {call, A, {remote, A, {atom, A, ?MODULE}, {atom, A, sort}}, + [abstract1(Info, NElements, Depth, A), abstract_term(SortOptions, 1)]}; +abstract1({keysort, Info, Kp, SortOptions}, NElements, Depth, A) -> + {call, A, {remote, A, {atom, A, ?MODULE}, {atom, A, keysort}}, + [abstract_term(Kp, 1), abstract1(Info, NElements, Depth, A), abstract_term(SortOptions, 1)]}; -abstract({list,L,MS}, NElements, Depth) -> - {call, 1, {remote, 1, {atom, 1, ets}, {atom, 1, match_spec_run}}, - [abstract(L, NElements, Depth), - {call, 1, {remote, 1, {atom, 1, ets}, {atom, 1, match_spec_compile}}, +abstract1({list,L,MS}, NElements, Depth, A) -> + {call, A, {remote, A, {atom, A, ets}, {atom, A, match_spec_run}}, + [abstract1(L, NElements, Depth, A), + {call, A, {remote, A, {atom, A, ets}, {atom, A, match_spec_compile}}, [abstract_term(depth(MS, Depth), 1)]}]}; -abstract({list, L}, NElements, Depth) when NElements =:= infinity; - NElements >= length(L) -> +abstract1({list, L}, NElements, Depth, _A) when NElements =:= infinity; + NElements >= length(L) -> abstract_term(depth(L, Depth), 1); -abstract({list, L}, NElements, Depth) -> +abstract1({list, L}, NElements, Depth, _A) -> abstract_term(depth(lists:sublist(L, NElements), Depth) ++ '...', 1). depth(List, infinity) -> @@ -1251,14 +1259,14 @@ abstract_term(Term) -> abstract_term(Term, 0). abstract_term(Term, Line) -> - abstr_term(Term, Line). + abstr_term(Term, anno(Line)). abstr_term(Tuple, Line) when is_tuple(Tuple) -> {tuple,Line,[abstr_term(E, Line) || E <- tuple_to_list(Tuple)]}; abstr_term([_ | _]=L, Line) -> case io_lib:char_list(L) of true -> - erl_parse:abstract(L, Line); + erl_parse:abstract(L, erl_anno:line(Line)); false -> abstr_list(L, Line) end; @@ -1266,6 +1274,8 @@ abstr_term(Fun, Line) when is_function(Fun) -> case erl_eval:fun_data(Fun) of {fun_data, _Bs, Cs} -> {'fun', Line, {clauses, Cs}}; + {named_fun_data, _Bs, Name, Cs} -> + {named_fun, Line, Name, Cs}; false -> {name, Name} = erlang:fun_info(Fun, name), {arity, Arity} = erlang:fun_info(Fun, arity), @@ -1283,7 +1293,7 @@ abstr_term(Fun, Line) when is_function(Fun) -> abstr_term(PPR, Line) when is_pid(PPR); is_port(PPR); is_reference(PPR) -> {special, Line, lists:flatten(io_lib:write(PPR))}; abstr_term(Simple, Line) -> - erl_parse:abstract(Simple, Line). + erl_parse:abstract(Simple, erl_anno:line(Line)). abstr_list([H | T], Line) -> {cons, Line, abstr_term(H, Line), abstr_list(T, Line)}; @@ -1517,7 +1527,7 @@ join_info(Join, QInfo, Qdata, Code) -> %% Only compared constants (==). [Cs1_0, Cs2_0] end, - L = 0, + L = anno0(), G1_0 = {var,L,'G1'}, G2_0 = {var,L,'G2'}, JP = element(JQNum + 1, Code), %% Create code for wh1 and wh2 in #join{}: @@ -1569,7 +1579,7 @@ join_merge_info(QNum, QInfo, Code, G, ExtraConstants) -> {P, P}; _ -> {PV, _} = aux_name1('P', 0, abstract_vars(P)), - L = 0, + L = erl_anno:new(0), V = {var, L, PV}, {V, {match, L, V, P}} end, @@ -1577,19 +1587,20 @@ join_merge_info(QNum, QInfo, Code, G, ExtraConstants) -> LEI = {generate, term_to_binary(M), LEInfo}, TP = term_to_binary(G), CFs = [begin - Call = {call,0,{atom,0,element},[{integer,0,Col},EPV]}, - F = list2op([{op,0,Op,abstract_term(Con),Call} - || {Con,Op} <- ConstOps], 'or'), + A = anno0(), + Call = {call,A,{atom,A,element},[{integer,A,Col},EPV]}, + F = list2op([{op,A,Op,abstract_term(Con),Call} + || {Con,Op} <- ConstOps], 'or', A), term_to_binary(F) end || {Col,ConstOps} <- ExtraConstants], {{I,G}, [{generate, TP, {qlc, DQP, [LEI | CFs], []}}]} end. -list2op([E], _Op) -> +list2op([E], _Op, _Anno) -> E; -list2op([E | Es], Op) -> - {op,0,Op,E,list2op(Es, Op)}. +list2op([E | Es], Op, Anno) -> + {op,Anno,Op,E,list2op(Es, Op, Anno)}. join_lookup_info(QNum, QInfo, G) -> {generate, _, LEInfo}=I = lists:nth(QNum, QInfo), @@ -1702,7 +1713,7 @@ eval_le(LE_fun, GOpt) -> prep_qlc_lc({simple_v1, PVar, LE_fun, L}, Opt, GOpt, _H) -> check_lookup_option(Opt, false), - prep_simple_qlc(PVar, L, eval_le(LE_fun, GOpt), Opt); + prep_simple_qlc(PVar, anno(L), eval_le(LE_fun, GOpt), Opt); prep_qlc_lc({qlc_v1, QFun, CodeF, Qdata0, QOpt}, Opt, GOpt, _H) -> F = fun(?qual_data(_QNum, _GoI, _SI, fil)=QualData, ModGens) -> {QualData, ModGens}; @@ -1819,7 +1830,7 @@ may_create_simple(#qlc_opt{unique = Unique, cache = Cache} = Opt, if Unique and not IsUnique; (Cache =/= false) and not IsCached -> - prep_simple_qlc(?SIMPLE_QVAR, 1, Prep, Opt); + prep_simple_qlc(?SIMPLE_QVAR, anno(1), Prep, Opt); true -> Prep end. @@ -2762,8 +2773,8 @@ tmp_filename(TmpDirOpt) -> U = "_", Node = node(), Pid = os:getpid(), - {MSecs,Secs,MySecs} = erlang:now(), - F = lists:concat([?MODULE,U,Node,U,Pid,U,MSecs,U,Secs,U,MySecs]), + Unique = erlang:unique_integer(), + F = lists:concat([?MODULE,U,Node,U,Pid,U,Unique]), TmpDir = case TmpDirOpt of "" -> {ok, CurDir} = file:get_cwd(), @@ -3709,7 +3720,7 @@ maybe_error_logger(Name, Why) -> Trimmer = fun(M, _F, _A) -> M =:= erl_eval end, Formater = fun(Term, I) -> io_lib:print(Term, I, 80, -1) end, X = lib:format_stacktrace(1, Stacktrace, Trimmer, Formater), - error_logger:Name("qlc: temporary file was needed for ~w\n~s\n", + error_logger:Name("qlc: temporary file was needed for ~w\n~ts\n", [Why, lists:flatten(X)]). expand_stacktrace() -> @@ -3770,6 +3781,15 @@ grd(Fun, Arg) -> false end. +anno0() -> + anno(0). + +anno1() -> + anno(1). + +anno(L) -> + erl_anno:new(L). + family(L) -> sofs:to_external(sofs:relation_to_family(sofs:relation(L))). diff --git a/lib/stdlib/src/qlc_pt.erl b/lib/stdlib/src/qlc_pt.erl index 21504d707b..0db63b81f4 100644 --- a/lib/stdlib/src/qlc_pt.erl +++ b/lib/stdlib/src/qlc_pt.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -31,9 +32,6 @@ %% Also in qlc.erl. -define(QLC_Q(L1, L2, L3, L4, LC, Os), {call,L1,{remote,L2,{atom,L3,?APIMOD},{atom,L4,?Q}},[LC | Os]}). --define(QLC_QQ(L1, L2, L3, L4, L5, L6, LC, Os), % packages... - {call,L1,{remote,L2,{record_field,L3,{atom,L4,''}, - {atom,L5,?APIMOD}},{atom,L6,?Q}},[LC | Os]}). -define(IMP_Q(L1, L2, LC, Os), {call,L,{atom,L2,?Q},[LC | Os]}). %% Also in qlc.erl. @@ -42,7 +40,12 @@ opt % #qlc_opt }). --record(state, {imp, maxargs, records, xwarnings = []}). +-record(state, {imp, + maxargs, + records, + xwarnings = [], + intro_vars, + node_info}). %-define(debug, true). @@ -64,57 +67,71 @@ %%% -spec(parse_transform(Forms, Options) -> Forms2 when - Forms :: [erl_parse:abstract_form()], - Forms2 :: [erl_parse:abstract_form()], + Forms :: [erl_parse:abstract_form() | erl_parse:form_info()], + Forms2 :: [erl_parse:abstract_form() | erl_parse:form_info()], Options :: [Option], Option :: type_checker | compile:option()). -parse_transform(Forms, Options) -> +parse_transform(Forms0, Options) -> ?DEBUG("qlc Parse Transform~n", []), - State = #state{imp = is_qlc_q_imported(Forms), - maxargs = ?COMPILE_MAX_NUM_OF_ARGS, - records = record_attributes(Forms)}, - case called_from_type_checker(Options) of - true -> - %% The returned value should conform to the types, but - %% need not evaluate to anything meaningful. - L = 0, - {tuple,_,Fs0} = abstr(#qlc_lc{}, L), - F = fun(_Id, LC, A) -> - Init = simple(L, 'V', LC, L), - {{tuple,L,set_field(#qlc_lc.lc, Fs0, Init)}, A} - end, - {Forms1,ok} = qlc_mapfold(F, ok, Forms, State), - Forms1; - false -> - FormsNoShadows = no_shadows(Forms, State), - case compile_messages(Forms, FormsNoShadows, Options, State) of - {[],[],Warnings} -> - {NewForms, State1} = transform(FormsNoShadows, State), - ExtraWs = State1#state.xwarnings, - {[],WForms} = no_duplicates(NewForms, [], Warnings, - ExtraWs, Options), - WForms ++ NewForms; - {E0,Errors,Warnings} -> - {EForms,WForms} = no_duplicates(Forms, E0++Errors, - Warnings, [], Options), - EForms ++ WForms ++ Forms - end + Imported = is_qlc_q_imported(Forms0), + {Forms, FormsNoShadows, State} = initiate(Forms0, Imported), + NodeInfo = State#state.node_info, + try + case called_from_type_checker(Options) of + true -> + %% The returned value should conform to the types, but + %% need not evaluate to anything meaningful. + L = anno0(), + {tuple,_,Fs0} = abstr(#qlc_lc{}, L), + F = fun(_Id, LC, A) -> + Init = simple(L, 'V', LC, L), + {{tuple,L,set_field(#qlc_lc.lc, Fs0, Init)}, A} + end, + {Forms1,ok} = qlc_mapfold(F, ok, Forms, State), + Forms1; + false -> + case + compile_messages(Forms, FormsNoShadows, Options, State) + of + {[],Warnings} -> + ?DEBUG("node info1 ~p~n", + [lists:sort(ets:tab2list(NodeInfo))]), + {NewForms, State1} = + transform(FormsNoShadows, State), + ExtraWs = State1#state.xwarnings, + {[],WForms} = no_duplicates(NewForms, [], Warnings, + ExtraWs, Options), + (restore_locations(WForms, State) ++ + restore_anno(NewForms, NodeInfo)); + {Errors,Warnings} -> + ?DEBUG("node info2 ~p~n", + [lists:sort(ets:tab2list(NodeInfo))]), + {EForms,WForms} = no_duplicates(FormsNoShadows, Errors, + Warnings, [], + Options), + restore_locations(EForms ++ WForms, State) ++ Forms0 + end + end + after + true = ets:delete(NodeInfo) end. --spec(transform_from_evaluator(LC, Bs) -> Expr when +-spec(transform_from_evaluator(LC, Bs) -> Return when LC :: erl_parse:abstract_expr(), - Expr :: erl_parse:abstract_expr(), - Bs :: erl_eval:binding_struct()). + Bs :: erl_eval:binding_struct(), + Return :: {ok, erl_parse:abstract_expr()} + | {not_ok, {error, module(), Reason :: term()}}). transform_from_evaluator(LC, Bindings) -> ?DEBUG("qlc Parse Transform (Evaluator Version)~n", []), transform_expression(LC, Bindings, false). --spec(transform_expression(LC, Bs) -> Expr when +-spec(transform_expression(LC, Bs) -> Return when LC :: erl_parse:abstract_expr(), - Expr :: erl_parse:abstract_expr(), - Bs :: erl_eval:binding_struct()). + Bs :: erl_eval:binding_struct(), + Return :: {ok, erl_parse:abstract_expr()} + | {not_ok, [{error, Reason :: term()}]}). transform_expression(LC, Bindings) -> transform_expression(LC, Bindings, true). @@ -127,30 +144,78 @@ called_from_type_checker(Options) -> lists:member(type_checker, Options). transform_expression(LC, Bs0, WithLintErrors) -> - L = 1, + L = anno1(), As = [{var,L,V} || {V,_Val} <- Bs0], Ar = length(As), F = {function,L,bar,Ar,[{clause,L,As,[],[?QLC_Q(L, L, L, L, LC, [])]}]}, - Forms = [{attribute,L,file,{"foo",L}}, - {attribute,L,module,foo}, F], - State = #state{imp = false, - maxargs = ?EVAL_MAX_NUM_OF_ARGS, - records = record_attributes(Forms)}, + Forms0 = [{attribute,L,file,{"foo",L}}, + {attribute,L,module,foo}, F], + {Forms, FormsNoShadows, State} = initiate(Forms0, false), + NodeInfo = State#state.node_info, Options = [], - FormsNoShadows = no_shadows(Forms, State), - case compile_messages(Forms, FormsNoShadows, Options, State) of - {[],[],_Warnings} -> - {NewForms,_State1} = transform(FormsNoShadows, State), - {function,L,bar,Ar,[{clause,L,As,[],[NF]}]} = - lists:last(NewForms), - {ok,NF}; - {E0,Errors,_Warnings} when WithLintErrors -> - {not_ok,mforms(error, E0 ++ Errors)}; - {E0,Errors0,_Warnings} -> - [{error,Reason} | _] = mforms(error, E0++Errors0), - {not_ok, {error, ?APIMOD, Reason}} + try compile_messages(Forms, FormsNoShadows, Options, State) of + {Errors0,_Warnings} -> + case restore_locations(Errors0, State) of + [] -> + {NewForms,_State1} = transform(FormsNoShadows, State), + NewForms1 = restore_anno(NewForms, NodeInfo), + {function,L,bar,Ar,[{clause,L,As,[],[NF]}]} = + lists:last(NewForms1), + {ok,NF}; + Errors when WithLintErrors -> + {not_ok,mforms(error, Errors)}; + Errors -> + [{error,Reason} | _] = mforms(error, Errors), + {not_ok, {error, ?APIMOD, Reason}} + end + after + true = ets:delete(NodeInfo) end. +-ifdef(DEBUG). +-define(ILIM, 0). +-else. +-define(ILIM, 255). +-endif. + +initiate(Forms0, Imported) -> + NodeInfo = ets:new(?APIMOD, []), + true = ets:insert(NodeInfo, {var_n, ?ILIM}), + exclude_integers_from_unique_line_numbers(Forms0, NodeInfo), + ?DEBUG("node info0 ~p~n", + [lists:sort(ets:tab2list(NodeInfo))]), + State0 = #state{imp = Imported, + maxargs = ?EVAL_MAX_NUM_OF_ARGS, + records = record_attributes(Forms0), + node_info = NodeInfo}, + Forms = save_anno(Forms0, NodeInfo), + FormsNoShadows = no_shadows(Forms, State0), + IntroVars = intro_variables(FormsNoShadows, State0), + State = State0#state{intro_vars = IntroVars}, + {Forms, FormsNoShadows, State}. + +%% Make sure restore_locations() does not confuse integers with (the +%% unique) line numbers. +exclude_integers_from_unique_line_numbers(Forms, NodeInfo) -> + Integers = find_integers(Forms), + lists:foreach(fun(I) -> ets:insert(NodeInfo, {I}) end, Integers). + +find_integers(Forms) -> + F = fun(A) -> + Fs1 = map_anno(fun(_) -> A end, Forms), + ordsets:from_list(integers(Fs1, [])) + end, + ordsets:to_list(ordsets:intersection(F(anno0()), F(anno1()))). + +integers([E | Es], L) -> + integers(Es, integers(E, L)); +integers(T, L) when is_tuple(T) -> + integers(tuple_to_list(T), L); +integers(I, L) when is_integer(I), I > ?ILIM -> + [I | L]; +integers(_, L) -> + L. + -define(I(I), {integer, L, I}). -define(A(A), {atom, L, A}). -define(V(V), {var, L, V}). @@ -167,9 +232,15 @@ mforms(Tag, L) -> %% Avoid duplicated lint warnings and lint errors. Care has been taken %% not to introduce unused variables in the transformed code. %% -no_duplicates(Forms, Errors, Warnings0, ExtraWarnings, Options) -> +no_duplicates(Forms, Errors, Warnings0, ExtraWarnings0, Options) -> %% Some mistakes such as "{X} =:= {}" are found by strong %% validation as well as by qlc. Prefer the warnings from qlc: + %% The Compiler and qlc do not agree on the location of errors. + %% For now, qlc's messages about failing patterns and filters + %% are ignored. + ExtraWarnings = [W || W={_File,[{_,qlc,Tag}]} <- + ExtraWarnings0, + not lists:member(Tag, [nomatch_pattern,nomatch_filter])], Warnings1 = mforms(Warnings0) -- ([{File,[{L,v3_core,nomatch}]} || {File,[{L,qlc,M}]} <- mforms(ExtraWarnings), @@ -188,13 +259,22 @@ mforms(L) -> lists:sort([{File,[M]} || {File,Ms} <- L, M <- Ms]). mforms2(Tag, L) -> - Line = 0, + Line = anno0(), ML = lists:flatmap(fun({File,Ms}) -> - [[{attribute,Line,file,{File,Line}}, {Tag,M}] || + [[{attribute,Line,file,{File,0}}, {Tag,M}] || M <- Ms] end, lists:sort(L)), lists:flatten(lists:sort(ML)). +restore_locations([T | Ts], State) -> + [restore_locations(T, State) | restore_locations(Ts, State)]; +restore_locations(T, State) when is_tuple(T) -> + list_to_tuple(restore_locations(tuple_to_list(T), State)); +restore_locations(I, State) when I > ?ILIM -> + restore_loc(I, State); +restore_locations(T, _State) -> + T. + is_qlc_q_imported(Forms) -> [[] || {attribute,_,import,{?APIMOD,FAs}} <- Forms, {?Q,1} <- FAs] =/= []. @@ -215,13 +295,20 @@ compile_messages(Forms, FormsNoShadows, Options, State) -> (_QId, Q, GA, A) -> {Q,GA,A} end, - {_,BGens} = qual_fold(BGenF, [], [], FormsNoShadows, State), + {_,BGens} = qual_fold(BGenF, [], [], Forms, State), GenForm = used_genvar_check(FormsNoShadows, State), - ?DEBUG("GenForm = ~s~n", [catch erl_pp:form(GenForm)]), - WarnFun = fun(Id, LC, A) -> {tag_lines(LC, get_lcid_no(Id)), A} end, + ?DEBUG("GenForm = ~ts~n", [catch erl_pp:form(GenForm)]), + {GEs,_} = compile_forms([GenForm], Options), + UsedGenVarMsgs = used_genvar_messages(GEs, State), + NodeInfo = State#state.node_info, + WarnFun = fun(_Id, LC, A) -> {lc_nodes(LC, NodeInfo), A} end, {WForms,ok} = qlc_mapfold(WarnFun, ok, Forms, State), - {Es,Ws} = compile_forms(WForms ++ [GenForm], Options), - {badarg(Forms, State),tagged_messages(Es)++BGens,tagged_messages(Ws)}. + {Es,Ws} = compile_forms(WForms, Options), + LcEs = lc_messages(Es, NodeInfo), + LcWs = lc_messages(Ws, NodeInfo), + Errors = badarg(Forms, State) ++ UsedGenVarMsgs++LcEs++BGens, + Warnings = LcWs, + {Errors,Warnings}. badarg(Forms, State) -> F = fun(_Id, {lc,_L,_E,_Qs}=LC, Es) -> @@ -233,54 +320,39 @@ badarg(Forms, State) -> {_,E0} = qlc_mapfold(F, [], Forms, State), E0. -tag_lines(E, No) -> - map_lines(fun(Id) -> - case is_lcid(Id) of - true -> Id; - false -> make_lcid(Id, No) - end - end, E). - -map_lines(F, E) -> - erl_lint:modify_line(E, F). - -tagged_messages(MsL) -> - [{File, - [{Loc,Mod,untag(T)} || {Loc0,Mod,T} <- Ms, - {true,Loc} <- [tloc(Loc0)]]} - || {File,Ms} <- MsL] - ++ +lc_nodes(E, NodeInfo) -> + map_anno(fun(Anno) -> + N = erl_anno:line(Anno), + [{N, Data}] = ets:lookup(NodeInfo, N), + NData = Data#{inside_lc => true}, + true = ets:insert(NodeInfo, {N, NData}), + Anno + end, E). + +used_genvar_messages(MsL, S) -> [{File,[{Loc,?APIMOD,{used_generator_variable,V}}]} - || {_, Ms} <- MsL, + || {_, Ms} <- MsL, {XLoc,erl_lint,{unbound_var,_}} <- Ms, - {Loc,File,V} <- [extra(XLoc)]]. - -tloc({Id,Column}) -> - {IsLcid,T} = tloc(Id), - {IsLcid,{T,Column}}; -tloc(Id) -> - IsLcid = is_lcid(Id), - {IsLcid,case IsLcid of - true -> get_lcid_line(Id); - false -> any - end}. - -extra({extra,Line,File,V}) -> - {Line,File,V}; -extra({Line,Column}) -> - case extra(Line) of - {L,File,V} -> {{L,Column},File,V}; - Else -> Else - end; -extra(Else) -> - Else. - -untag([E | Es]) -> [untag(E) | untag(Es)]; -untag(T) when is_tuple(T) -> list_to_tuple(untag(tuple_to_list(T))); -untag(E) -> - case is_lcid(E) of - true -> get_lcid_line(E); - false -> E + {Loc,File,V} <- [genvar_pos(XLoc, S)]]. + +lc_messages(MsL, NodeInfo) -> + [{File,[{Loc,Mod,T} || {Loc,Mod,T} <- Ms, lc_loc(Loc, NodeInfo)]} || + {File,Ms} <- MsL]. + +lc_loc(N, NodeInfo) -> + case ets:lookup(NodeInfo, N) of + [{N, #{inside_lc := true}}] -> + true; + [{N, _}] -> + false + end. + +genvar_pos(Location, S) -> + case ets:lookup(S#state.node_info, Location) of + [{Location, #{genvar_pos := Pos}}] -> + Pos; + [] -> + Location end. %% -> [{Qid,[variable()]}]. @@ -296,6 +368,7 @@ untag(E) -> %% variables (unless they are unsafe). %% intro_variables(FormsNoShadows, State) -> + NodeInfo = State#state.node_info, Fun = fun(QId, {T,_L,P0,_E0}=Q, {GVs,QIds}, Foo) when T =:= b_generate; T =:= generate -> PVs = qlc:var_ufold(fun({var,_,V}) -> {QId,V} end, P0), @@ -305,10 +378,11 @@ intro_variables(FormsNoShadows, State) -> %% where E is an LC expression consisting of a %% template mentioning all variables occurring in F. Vs = ordsets:to_list(qlc:vars(Filter0)), - Id = QId#qid.lcid, - LC1 = embed_vars(intro_set_line({QId,f1}, Vs), Id), - LC2 = embed_vars(intro_set_line({QId,f2}, Vs), Id), - AnyLine = -1, + AnyLine = anno0(), + Vars = [{var,AnyLine,V} || V <- Vs], + LC = embed_vars(Vars, AnyLine), + LC1 = intro_anno(LC, before, QId, NodeInfo), + LC2 = intro_anno(LC, 'after', QId, NodeInfo), Filter = {block,AnyLine,[LC1,Filter0,LC2]}, {Filter,{GVs,[{QId,[]} | QIds]},Foo} end, @@ -320,9 +394,15 @@ intro_variables(FormsNoShadows, State) -> Es0 = compile_errors(FForms), %% A variable is bound inside the filter if it is not bound before %% the filter, but it is bound after the filter (obviously). - Before = [{QId,V} || {{QId,f1},erl_lint,{unbound_var,V}} <- Es0], - After = [{QId,V} || {{QId,f2},erl_lint,{unbound_var,V}} <- Es0], - Unsafe = [{QId,V} || {{QId,f2},erl_lint,{unsafe_var,V,_Where}} <- Es0], + Before = [{QId,V} || + {L,erl_lint,{unbound_var,V}} <- Es0, + {_L,{QId,before}} <- ets:lookup(NodeInfo, L)], + After = [{QId,V} || + {L,erl_lint,{unbound_var,V}} <- Es0, + {_L,{QId,'after'}} <- ets:lookup(NodeInfo, L)], + Unsafe = [{QId,V} || + {L,erl_lint,{unsafe_var,V,_Where}} <- Es0, + {_L,{QId,'after'}} <- ets:lookup(NodeInfo, L)], ?DEBUG("Before = ~p~n", [Before]), ?DEBUG("After = ~p~n", [After]), ?DEBUG("Unsafe = ~p~n", [Unsafe]), @@ -331,24 +411,32 @@ intro_variables(FormsNoShadows, State) -> I1 = family(IV ++ GenVars), sofs:to_external(sofs:family_union(sofs:family(QIds), I1)). -intro_set_line(Tag, Vars) -> - L = erl_parse:set_line(1, fun(_) -> Tag end), - [{var,L,V} || V <- Vars]. +intro_anno(LC, Where, QId, NodeInfo) -> + Data = {QId,Where}, + Fun = fun(Anno) -> + Location = erl_anno:location(Anno), + true = ets:insert(NodeInfo, {Location,Data}), + Anno + end, + map_anno(Fun, save_anno(LC, NodeInfo)). compile_errors(FormsNoShadows) -> case compile_forms(FormsNoShadows, []) of {[], _Warnings} -> []; {Errors, _Warnings} -> - ?DEBUG("got errors ~p~n", [Errors]), + ?DEBUG("got errors ~tp~n", [Errors]), lists:flatmap(fun({_File,Es}) -> Es end, Errors) end. --define(MAX_NUM_OF_LINES, 23). % assume max 1^23 lines (> 8 millions) - compile_forms(Forms0, Options) -> - Forms = [F || F <- Forms0, element(1, F) =/= eof] ++ - [{eof,1 bsl ?MAX_NUM_OF_LINES}], + Exclude = fun(eof) -> true; + (warning) -> true; + (error) -> true; + (_) -> false + end, + Forms = ([F || F <- Forms0, not Exclude(element(1, F))] + ++ [{eof,anno0()}]), try case compile:noenv_forms(Forms, compile_options(Options)) of {ok, _ModName, Ws0} -> @@ -387,20 +475,23 @@ bitstr_options() -> %% for each ListExpr. The expression mentions all introduced variables %% occurring in ListExpr. Running the function through the compiler %% yields error messages for erroneous use of introduced variables. -%% The messages have the form -%% {{extra,LineNo,File,Var},Module,{unbound_var,V}}, where Var is the -%% original variable name and V is the name invented by no_shadows/2. %% used_genvar_check(FormsNoShadows, State) -> - F = fun(QId, {T, Ln, _P, LE}=Q, {QsIVs0, Exprs0}, IVsSoFar0) + NodeInfo = State#state.node_info, + F = fun(QId, {T, Ln, _P, LE}=Q, {QsIVs0, Exprs0}, IVsSoFar0) when T =:= b_generate; T =:= generate -> - F = fun({var, _, V}=Var) -> - {var, L, OrigVar} = undo_no_shadows(Var), - AF = fun(Line) -> - {extra, Line, get(?QLC_FILE), OrigVar} - end, - L2 = erl_parse:set_line(L, AF), - {var, L2, V} + F = fun(Var) -> + {var, Anno0, OrigVar} = + undo_no_shadows(Var, State), + {var, Anno, _} = NewVar = save_anno(Var, NodeInfo), + Location0 = erl_anno:location(Anno0), + Location = erl_anno:location(Anno), + [{Location, Data}] = + ets:lookup(NodeInfo, Location), + Pos = {Location0,get(?QLC_FILE),OrigVar}, + NData = Data#{genvar_pos => Pos}, + true = ets:insert(NodeInfo, {Location, NData}), + NewVar end, Vs = [Var || {var, _, V}=Var <- qlc:var_fold(F, [], LE), lists:member(V, IVsSoFar0)], @@ -414,12 +505,12 @@ used_genvar_check(FormsNoShadows, State) -> {QsIVs, IVsSoFar} = q_intro_vars(QId, QsIVs0, IVsSoFar0), {Filter, {QsIVs, Exprs}, IVsSoFar} end, - IntroVars = intro_variables(FormsNoShadows, State), - Acc0 = {IntroVars, [{atom, 0, true}]}, + Acc0 = {State#state.intro_vars, [{atom, anno0(), true}]}, {_, {[], Exprs}} = qual_fold(F, Acc0, [], FormsNoShadows, State), FunctionNames = [Name || {function, _, Name, _, _} <- FormsNoShadows], UniqueFName = qlc:aux_name(used_genvar, 1, sets:from_list(FunctionNames)), - {function,0,UniqueFName,0,[{clause,0,[],[],lists:reverse(Exprs)}]}. + A = anno0(), + {function,A,UniqueFName,0,[{clause,A,[],[],lists:reverse(Exprs)}]}. q_intro_vars(QId, [{QId, IVs} | QsIVs], IVsSoFar) -> {QsIVs, IVs ++ IVsSoFar}. @@ -517,7 +608,8 @@ q_intro_vars(QId, [{QId, IVs} | QsIVs], IVsSoFar) -> {QsIVs, IVs ++ IVsSoFar}. %% (calling LEf returns the objects generated by LE). transform(FormsNoShadows, State) -> - IntroVars = intro_variables(FormsNoShadows, State), + _ = erlang:system_flag(backtrace_depth, 500), + IntroVars = State#state.intro_vars, AllVars = sets:from_list(ordsets:to_list(qlc:vars(FormsNoShadows))), ?DEBUG("AllVars = ~p~n", [sets:to_list(AllVars)]), F1 = fun(QId, {generate,_,P,LE}, Foo, {GoI,SI}) -> @@ -591,8 +683,8 @@ transform(FormsNoShadows, State) -> [{match,L,{var,L,Fun},FunC}, {call,L,{var,L,Fun},As0}]}]}}, {ok, OrigE0} = dict:find(Id, Source), - OrigE = undo_no_shadows(OrigE0), - QCode = qcode(OrigE, XQCs, Source, L), + OrigE = undo_no_shadows(OrigE0, State), + QCode = qcode(OrigE, XQCs, Source, L, State), Qdata = qdata(XQCs, L), TemplateInfo = template_columns(Qs, E, AllIVs, Dependencies, State), @@ -601,7 +693,7 @@ transform(FormsNoShadows, State) -> Opt = opt_info(TemplateInfo, SizeInfo, JoinInfo, MSQs, L, EqColumnConstants, EqualColumnConstants), LCTuple = - case qlc_kind(OrigE, Qs) of + case qlc_kind(OrigE, Qs, State) of qlc -> {tuple,L,[?A(qlc_v1),FunW,QCode,Qdata,Opt]}; {simple, PL, LE, V} -> @@ -615,7 +707,7 @@ transform(FormsNoShadows, State) -> end, {NForms,{[],XW}} = qlc_mapfold(F2, {IntroVars,[]}, ModifiedForms1, State), display_forms(NForms), - {restore_line_numbers(NForms), State#state{xwarnings = XW}}. + {NForms, State#state{xwarnings = XW}}. join_kind(Qs, LcL, AllIVs, Dependencies, State) -> {EqualCols2, EqualColsN} = equal_columns(Qs, AllIVs, Dependencies, State), @@ -626,20 +718,21 @@ join_kind(Qs, LcL, AllIVs, Dependencies, State) -> if EqualColsN =/= []; MatchColsN =/= [] -> {[], - [{get(?QLC_FILE),[{abs(LcL),?APIMOD,too_complex_join}]}]}; + [{get(?QLC_FILE),[{LcL,?APIMOD,too_complex_join}]}]}; EqualCols2 =:= [], MatchCols2 =:= [] -> {[], []}; length(Tables) > 2 -> {[], - [{get(?QLC_FILE),[{abs(LcL),?APIMOD,too_many_joins}]}]}; + [{get(?QLC_FILE),[{LcL,?APIMOD,too_many_joins}]}]}; EqualCols2 =:= MatchCols2 -> {EqualCols2, []}; true -> {{EqualCols2, MatchCols2}, []} end. -qlc_kind(OrigE, Qs) -> - {OrigFilterData, OrigGeneratorData} = qual_data(undo_no_shadows(Qs)), +qlc_kind(OrigE, Qs, State) -> + {OrigFilterData, OrigGeneratorData} = + qual_data(undo_no_shadows(Qs, State)), OrigAllFilters = filters_as_one(OrigFilterData), {_FilterData, GeneratorData} = qual_data(Qs), case {OrigE, OrigAllFilters, OrigGeneratorData} of @@ -666,12 +759,12 @@ warn_failing_qualifiers(Qualifiers, AllIVs, Dependencies, State) -> lists:foldl(fun({_QId,{fil,_Filter}}, {[]=Frames,Warnings}) -> {Frames,Warnings}; ({_QId,{fil,Filter}}, {Frames,Warnings}) -> - case filter(set_line(Filter, 0), Frames, BindFun, + case filter(reset_anno(Filter), Frames, BindFun, State, Imported) of [] -> {[], [{get(?QLC_FILE), - [{abs_loc(element(2, Filter)),?APIMOD, + [{loc(element(2, Filter)),?APIMOD, nomatch_filter}]} | Warnings]}; Frames1 -> {Frames1,Warnings} @@ -681,7 +774,7 @@ warn_failing_qualifiers(Qualifiers, AllIVs, Dependencies, State) -> {failed, _, _} -> {Frames, [{get(?QLC_FILE), - [{abs_loc(element(2, Pattern)),?APIMOD, + [{loc(element(2, Pattern)),?APIMOD, nomatch_pattern}]} | Warnings]}; _ -> {Frames,Warnings} @@ -754,8 +847,8 @@ opt_constants(L, ColumnConstants) -> || IdNo <- Ns] ++ [{clause,L,[?V('_')],[],[?A(no_column_fun)]}]. -abstr(Term, Line) -> - erl_parse:abstract(Term, Line). +abstr(Term, Anno) -> + erl_parse:abstract(Term, loc(Anno)). %% Extra generators are introduced for join. join_quals(JoinInfo, QCs, L, LcNo, ExtraConstants, AllVars) -> @@ -840,9 +933,10 @@ join_handle(AP, L, [F, H, O, C], Constants) -> {{var, _, _}, []} -> {'fun',L,{clauses,[{clause,L,[H],[],[H]}]}}; _ -> + A = anno0(), G0 = [begin - Call = {call,0,{atom,0,element},[{integer,0,Col},O]}, - list2op([{op,0,Op,Con,Call} || {Con,Op} <- Cs], 'or') + Call = {call,A,{atom,A,element},[{integer,A,Col},O]}, + list2op([{op,A,Op,Con,Call} || {Con,Op} <- Cs], 'or') end || {Col,Cs} <- Constants], G = if G0 =:= [] -> G0; true -> [G0] end, CC1 = {clause,L,[AP],G,[{cons,L,O,closure({call,L,F,[F,C]},L)}]}, @@ -879,14 +973,15 @@ join_handle_constants(QId, ExtraConstants) -> %% order the traverse fun would return them. column_fun(Columns, QualifierNumber, LcL) -> + A = anno0(), ColCls0 = [begin true = Vs0 =/= [], % at least one value to look up Vs1 = list2cons(Vs0), - Fils1 = {tuple,0,[{atom,0,FTag}, + Fils1 = {tuple,A,[{atom,A,FTag}, lists:foldr - (fun(F, A) -> {cons,0,{integer,0,F},A} - end, {nil,0}, Fils)]}, + (fun(F, Ac) -> {cons,A,{integer,A,F},Ac} + end, {nil,A}, Fils)]}, Tag = case ordsets:to_list(qlc:vars(Vs1)) of Imp when length(Imp) > 0, % imported vars length(Vs0) > 1 -> @@ -894,13 +989,13 @@ column_fun(Columns, QualifierNumber, LcL) -> _ -> values end, - Vs = {tuple,0,[{atom,0,Tag},Vs1,Fils1]}, - {clause,0,[erl_parse:abstract(Col)],[],[Vs]} + Vs = {tuple,A,[{atom,A,Tag},Vs1,Fils1]}, + {clause,A,[erl_parse:abstract(Col)],[],[Vs]} end || {{CIdNo,Col}, Vs0, {FTag,Fils}} <- Columns, CIdNo =:= QualifierNumber] - ++ [{clause,0,[{var,0,'_'}],[],[{atom,0,false}]}], - ColCls = set_line(ColCls0, LcL), + ++ [{clause,A,[{var,A,'_'}],[],[{atom,A,false}]}], + ColCls = set_anno(ColCls0, LcL), {'fun', LcL, {clauses, ColCls}}. %% Tries to find columns of the template that (1) are equal to (or @@ -923,7 +1018,7 @@ template_columns(Qs0, E0, AllIVs, Dependencies, State) -> MatchColumns = eq_columns2(Qs, AllIVs, Dependencies, State), Equal = template_cols(EqualColumns), Match = template_cols(MatchColumns), - L = 0, + L = anno0(), if Match =:= Equal -> [{?V('_'), Match}]; @@ -950,7 +1045,7 @@ template_cols(ColumnClasses) -> template_as_pattern(E) -> P = simple_template(E), - {?TID,foo,foo,{gen,P,{nil,0}}}. + {?TID,foo,foo,{gen,P,{nil,anno0()}}}. simple_template({call,L,{remote,_,{atom,_,erlang},{atom,_,element}}=Call, [{integer,_,I}=A1,A2]}) when I > 0 -> @@ -1007,10 +1102,10 @@ match_spec_quals(Template, Dependencies, Qualifiers, State) -> GQId =:= QId2, {FQId,{fil,F}}=Filter <- Filters, % guard filters only FQId =:= QId] - ++ [{GId#qid.no,Pattern,[],{atom,0,true}} || + ++ [{GId#qid.no,Pattern,[],{atom,anno0(),true}} || {GId,{gen,Pattern,_}} <- GeneratorData, lists:member(GId, NoFilterGIds)], - E = {nil, 0}, + E = {nil, anno0()}, GF = [{{GNum,Pattern},Filter} || {GNum,Pattern,Filter,F} <- Candidates, no =/= try_ms(E, Pattern, F, State)], @@ -1027,7 +1122,7 @@ match_spec_quals(Template, Dependencies, Qualifiers, State) -> %% expressione can be replaced by a match specification. [{GNum, AbstrMS, all}] catch _:_ -> - {TemplVar, _} = anon_var({var,0,'_'}, 0), + {TemplVar, _} = anon_var({var,anno0(),'_'}, 0), [one_gen_match_spec(GNum, Pattern, GFilterData, State, TemplVar) || {{GNum,Pattern},GFilterData} <- GFFL] end. @@ -1041,7 +1136,7 @@ gen_ms(E, Pattern, GFilterData, State) -> {ok, MS, AMS} = try_ms(E, Pattern, filters_as_one(GFilterData), State), case MS of [{'$1',[true],['$1']}] -> - {atom, 0, no_match_spec}; + {atom, anno0(), no_match_spec}; _ -> AMS end. @@ -1063,7 +1158,7 @@ pattern_as_template({match,_,_E,{var,_,_}=V}=P, _TemplVar) -> pattern_as_template({match,_,{var,_,_}=V,_E}=P, _TemplVar) -> {V, P}; pattern_as_template(E, TemplVar) -> - L = 0, + L = anno0(), {TemplVar, {match, L, E, TemplVar}}. %% Tries to find columns which are compared or matched against @@ -1206,7 +1301,7 @@ lu_skip(ColConstants, FilterData, PatternFrame, PatternVars, ColFil = [{Column, FId#qid.no} || {FId,{fil,Fil}} <- filter_list(FilterData, Dependencies, State), - [] =/= (SFs = safe_filter(set_line(Fil, 0), PatternFrames, + [] =/= (SFs = safe_filter(reset_anno(Fil), PatternFrames, BindFun, State, Imported)), {GId,PV} <- PatternVars, [] =/= @@ -1221,13 +1316,14 @@ lu_skip(ColConstants, FilterData, PatternFrame, PatternVars, %% column, the filter will not be skipped. %% (an example: {X=1} <- ..., X =:= 1). length(D = Cols -- PatternColumns) =:= 1, - Frame <- SFs, - begin + {{_,Col} = Column, Constants} <- D, + %% Check that the following holds for all frames. + lists:all( + fun(Frame) -> %% The column is compared/matched against a constant. %% If there are no more comparisons/matches then %% the filter can be replaced by the lookup of %% the constant. - [{{_,Col} = Column, Constants}] = D, {VarI, FrameI} = unify_column(Frame, PV, Col, BindFun, Imported), VarValues = deref_skip(VarI, FrameI, LookupOp, Imported), @@ -1256,7 +1352,7 @@ lu_skip(ColConstants, FilterData, PatternFrame, PatternVars, length(VarValues) =< 1 andalso (Constants -- LookedUpConstants =:= []) andalso bindings_is_subset(Frame, F2, Imported) - end], + end, SFs)], ColFils = family_list(ColFil), %% The skip tag 'all' means that all filters are covered by the lookup. %% It does not imply that there is only one generator as is the case @@ -1394,7 +1490,7 @@ join_skip(JoinClasses, FilterData, PatternFrame, PatternVars, Dependencies, JF = unify(JoinOp, V1, V2, JF2, BindFun, Imported), %% "Run" the filter: - SFs = safe_filter(set_line(Fil, 0), PatternFrames, + SFs = safe_filter(reset_anno(Fil), PatternFrames, BindFun, State, Imported), JImp = qlc:vars([SFs, JF]), % kludge lists:all(fun(Frame) -> @@ -1405,7 +1501,7 @@ join_skip(JoinClasses, FilterData, PatternFrame, PatternVars, Dependencies, filter_info(FilterData, AllIVs, Dependencies, State) -> FilterList = filter_list(FilterData, Dependencies, State), - Filter0 = set_line(filters_as_one(FilterList), 0), + Filter0 = reset_anno(filters_as_one(FilterList)), Anon0 = 0, {Filter, Anon1} = anon_var(Filter0, Anon0), Imported = ordsets:subtract(qlc:vars(Filter), % anonymous too @@ -1512,7 +1608,7 @@ pattern(P0, AnonI, Frame0, BindFun, State) -> catch _:_ -> P0 % template, records already expanded end, %% Makes test for equality simple: - P2 = set_line(P1, 0), + P2 = reset_anno(P1), {P3, AnonN} = anon_var(P2, AnonI), {P4, F1} = match_in_pattern(tuple2cons(P3), Frame0, BindFun), {P, F2} = element_calls(P4, F1, BindFun, _Imp=[]), % kludge for templates @@ -1552,8 +1648,11 @@ anon_var(E, AnonI) -> (Var, N) -> {Var, N} end, AnonI, E). -set_line(T, L) -> - map_lines(fun(_L) -> L end, T). +reset_anno(T) -> + set_anno(T, anno0()). + +set_anno(T, A) -> + map_anno(fun(_L) -> A end, T). -record(fstate, {state, bind_fun, imported}). @@ -1675,7 +1774,7 @@ frames_to_columns(Fs, PatternVars, DerefFun, SelectorFun, Imp, CompOp) -> %% same variables have to be the representatives in every frame.) SizesVarsL = [begin - PatVar = {var,0,PV}, + PatVar = {var,anno0(),PV}, PatternSizes = [pattern_size([F], PatVar, false) || F <- Fs], MaxPZ = lists:max([0 | PatternSizes -- [undefined]]), @@ -1694,8 +1793,8 @@ frames_to_columns(Fs, PatternVars, DerefFun, SelectorFun, Imp, CompOp) -> frames2cols(Fs, PatN, PatSizes, Vars, DerefFun, SelectorFun, CompOp) -> Rs = [ begin RL = [{{PatN,Col},cons2tuple(element(2, Const))} || - {V, Col} <- lists:zip(sublist(Vars, PatSz), - seq(1, PatSz)), + {V, Col} <- lists:zip(lists:sublist(Vars, PatSz), + lists:seq(1, PatSz)), %% Do not handle the case where several %% values compare equal, e.g. "X =:= 1 %% andalso X == 1.0". Looking up both @@ -1724,11 +1823,11 @@ frames2cols(Fs, PatN, PatSizes, Vars, DerefFun, SelectorFun, CompOp) -> [C || {_,Vs}=C <- sofs:to_external(Cs), not col_ignore(Vs, CompOp)]. pat_vars(N) -> - [unique_var() || _ <- seq(1, N)]. + [unique_var() || _ <- lists:seq(1, N)]. pat_tuple(Sz, Vars) when is_integer(Sz), Sz > 0 -> TupleTail = unique_var(), - {cons_tuple, list2cons(sublist(Vars, Sz) ++ TupleTail)}; + {cons_tuple, list2cons(lists:sublist(Vars, Sz) ++ TupleTail)}; pat_tuple(_, _Vars) -> unique_var(). @@ -1742,7 +1841,7 @@ col_ignore(Vs, '==') -> pattern_sizes(PatternVars, Fs) -> [{QId#qid.no, Size} || {QId,PV} <- PatternVars, - undefined =/= (Size = pattern_size(Fs, {var,0,PV}, true))]. + undefined =/= (Size = pattern_size(Fs, {var,anno0(),PV}, true))]. pattern_size(Fs, PatternVar, Exact) -> Fun = fun(F) -> (deref_pattern(_Imported = []))(PatternVar, F) end, @@ -1770,7 +1869,8 @@ prep_expr(E, F, S, BF, Imported) -> element_calls(tuple2cons(expand_expr_records(E, S)), F, BF, Imported). unify_column(Frame, Var, Col, BindFun, Imported) -> - Call = {call,0,{atom,0,element},[{integer,0,Col}, {var,0,Var}]}, + A = anno0(), + Call = {call,A,{atom,A,element},[{integer,A,Col}, {var,A,Var}]}, element_calls(Call, Frame, BindFun, Imported). %% cons_tuple is used for representing {V1, ..., Vi | TupleTail}. @@ -1802,21 +1902,23 @@ element_calls(E, F, _BF, _Imported) -> {E, F}. unique_var() -> - {var, 0, make_ref()}. + {var, anno0(), make_ref()}. is_unique_var({var, _L, V}) -> is_reference(V). expand_pattern_records(P, State) -> - E = {'case',0,{atom,0,true},[{clause,0,[P],[],[{atom,0,true}]}]}, - {'case',_,_,[{clause,0,[NP],_,_}]} = expand_expr_records(E, State), + A = anno0(), + E = {'case',A,{atom,A,true},[{clause,A,[P],[],[{atom,A,true}]}]}, + {'case',_,_,[{clause,A,[NP],_,_}]} = expand_expr_records(E, State), NP. expand_expr_records(E, State) -> RecordDefs = State#state.records, - Forms = RecordDefs ++ [{function,1,foo,0,[{clause,1,[],[],[pe(E)]}]}], - [{function,_,foo,0,[{clause,_,[],[],[NE]}]}] = - erl_expand_records:module(Forms, [no_strict_record_tests]), + A = anno1(), + Forms0 = RecordDefs ++ [{function,A,foo,0,[{clause,A,[],[],[pe(E)]}]}], + Forms = erl_expand_records:module(Forms0, [no_strict_record_tests]), + {function,_,foo,0,[{clause,_,[],[],[NE]}]} = lists:last(Forms), NE. %% Partial evaluation. @@ -2128,15 +2230,15 @@ tuple2cons(E) -> E. list2cons([E | Es]) -> - {cons, 0, E, list2cons(Es)}; + {cons, anno0(), E, list2cons(Es)}; list2cons([]) -> - {nil, 0}; + {nil, anno0()}; list2cons(E) -> E. %% Returns {..., Variable} if Variable is a tuple tail. cons2tuple({cons_tuple, Es}) -> - {tuple, 0, cons2list(Es)}; + {tuple, anno0(), cons2list(Es)}; cons2tuple(T) when is_tuple(T) -> list_to_tuple(cons2tuple(tuple_to_list(T))); cons2tuple([E | Es]) -> @@ -2175,18 +2277,17 @@ bindings_subset(F1, F2, Imp) -> %% not to have guard semantics, affected filters will have to be %% recognized and excluded here as well. try_ms(E, P, Fltr, State) -> - L = 1, + L = anno1(), Fun = {'fun',L,{clauses,[{clause,L,[P],[[Fltr]],[E]}]}}, Expr = {call,L,{remote,L,{atom,L,ets},{atom,L,fun2ms}},[Fun]}, - Form0 = {function,L,foo,0,[{clause,L,[],[],[Expr]}]}, - Form = restore_line_numbers(Form0), + Form = {function,L,foo,0,[{clause,L,[],[],[Expr]}]}, X = ms_transform:parse_transform(State#state.records ++ [Form], []), case catch begin {function,L,foo,0,[{clause,L,[],[],[MS0]}]} = lists:last(X), MS = erl_parse:normalise(var2const(MS0)), XMS = ets:match_spec_compile(MS), - true = is_binary(XMS), + true = ets:is_compiled_ms(XMS), {ok, MS, MS0} end of {'EXIT', _Reason} -> @@ -2196,11 +2297,11 @@ try_ms(E, P, Fltr, State) -> end. filters_as_one([]) -> - {atom, 0, true}; + {atom, anno0(), true}; filters_as_one(FilterData) -> [{_,{fil,Filter1}} | Filters] = lists:reverse(FilterData), lists:foldr(fun({_QId,{fil,Filter}}, AbstF) -> - {op,0,'andalso',Filter,AbstF} + {op,anno0(),'andalso',Filter,AbstF} end, Filter1, Filters). qual_data(Qualifiers) -> @@ -2235,38 +2336,40 @@ qdata([], L) -> {nil,L}. qcon(Cs) -> - list2cons([{tuple,0,[{integer,0,Col},list2cons(qcon1(ConstOps))]} || + A = anno0(), + list2cons([{tuple,A,[{integer,A,Col},list2cons(qcon1(ConstOps))]} || {Col,ConstOps} <- Cs]). qcon1(ConstOps) -> - [{tuple,0,[Const,abstr(Op, 0)]} || {Const,Op} <- ConstOps]. + A = anno0(), + [{tuple,A,[Const,abstr(Op, A)]} || {Const,Op} <- ConstOps]. %% The original code (in Source) is used for filters and the template %% since the translated code can have QLCs and we don't want them to %% be visible. -qcode(E, QCs, Source, L) -> +qcode(E, QCs, Source, L, State) -> CL = [begin Bin = term_to_binary(C, [compressed]), {bin, L, [{bin_element, L, {string, L, binary_to_list(Bin)}, default, default}]} end || {_,C} <- lists:keysort(1, [{qlc:template_state(),E} | - qcode(QCs, Source)])], + qcode(QCs, Source, State)])], {'fun', L, {clauses, [{clause, L, [], [], [{tuple, L, CL}]}]}}. -qcode([{_QId, {_QIvs, {{gen,P,_LE,_GV}, GoI, _SI}}} | QCs], Source) -> - [{GoI,undo_no_shadows(P)} | qcode(QCs, Source)]; -qcode([{QId, {_QIVs, {{fil,_F}, GoI, _SI}}} | QCs], Source) -> +qcode([{_QId, {_QIvs, {{gen,P,_LE,_GV}, GoI, _SI}}} | QCs], Source, State) -> + [{GoI,undo_no_shadows(P, State)} | qcode(QCs, Source, State)]; +qcode([{QId, {_QIVs, {{fil,_F}, GoI, _SI}}} | QCs], Source, State) -> {ok,OrigF} = dict:find(QId, Source), - [{GoI,undo_no_shadows(OrigF)} | qcode(QCs, Source)]; -qcode([], _Source) -> + [{GoI,undo_no_shadows(OrigF, State)} | qcode(QCs, Source, State)]; +qcode([], _Source, _State) -> []. closure(Code, L) -> {'fun',L,{clauses,[{clause,L,[],[],[Code]}]}}. -simple(L, Var, Init, Line) -> - {tuple,L,[?A(simple_v1),?A(Var),Init,?I(Line)]}. +simple(L, Var, Init, Anno) -> + {tuple,L,[?A(simple_v1),?A(Var),Init,abstr(loc(Anno), Anno)]}. clauses([{QId,{QIVs,{QualData,GoI,S}}} | QCs], RL, Fun, Go, NGV, E, IVs,St) -> ?DEBUG("QIVs = ~p~n", [QIVs]), @@ -2428,19 +2531,22 @@ aux_var(Name, LcN, QN, N, AllVars) -> qlc:aux_name(lists:concat([Name, LcN, '_', QN, '_']), N, AllVars). no_compiler_warning(L) -> - erl_parse:set_line(L, fun(Line) -> -abs(Line) end). + Anno = erl_anno:new(L), + erl_anno:set_generated(true, Anno). -abs_loc(L) -> - loc(erl_parse:set_line(L, fun(Line) -> abs(Line) end)). - -loc(L) -> - {location,Location} = erl_parse:get_attribute(L, location), - Location. +loc(A) -> + erl_anno:location(A). list2op([E], _Op) -> E; list2op([E | Es], Op) -> - {op,0,Op,E,list2op(Es, Op)}. + {op,anno0(),Op,E,list2op(Es, Op)}. + +anno0() -> + erl_anno:new(0). + +anno1() -> + erl_anno:new(1). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2475,13 +2581,6 @@ qlcmf(?QLC_Q(L1, L2, L3, L4, LC0, Os0), F, Imp, A0, No0) when length(Os0) < 2 -> NL = make_lcid(L1, No), {T, A} = F(NL, LC, A2), {?QLC_Q(L1, L2, L3, L4, T, Os), A, No + 1}; -qlcmf(?QLC_QQ(L1, L2, L3, L4, L5, L6, LC0, Os0), - F, Imp, A0, No0) when length(Os0) < 2 -> - {Os, A1, No1} = qlcmf(Os0, F, Imp, A0, No0), - {LC, A2, No} = qlcmf(LC0, F, Imp, A1, No1), % nested... - NL = make_lcid(L1, No), - {T, A} = F(NL, LC, A2), - {?QLC_QQ(L1, L2, L3, L4, L5, L6, T, Os), A, No + 1}; qlcmf(?IMP_Q(L1, L2, LC0, Os0), F, Imp=true, A0, No0) when length(Os0) < 2 -> {Os, A1, No1} = qlcmf(Os0, F, Imp, A0, No0), {LC, A2, No} = qlcmf(LC0, F, Imp, A1, No1), % nested... @@ -2500,13 +2599,61 @@ qlcmf(T, _F, _Imp, A, No) -> occ_vars(E) -> qlc:var_fold(fun({var,_L,V}) -> V end, [], E). +%% Every Anno is replaced by a unique number. The number is used in a +%% table that holds data about the abstract node where Anno resides. +%% In particular, the original location is kept there, so that the +%% original abstract code can be re-created. +save_anno(Abstr, NodeInfo) -> + F = fun(Anno) -> + N = next_slot(NodeInfo), + Location = erl_anno:location(Anno), + Data = {N, #{location => Location}}, + true = ets:insert(NodeInfo, Data), + erl_anno:new(N) + end, + map_anno(F, Abstr). + +next_slot(T) -> + I = ets:update_counter(T, var_n, 1), + case ets:lookup(T, I) of + [] -> + I; + _ -> + next_slot(T) + end. + +restore_anno(Abstr, NodeInfo) -> + F = fun(Anno) -> + Location = erl_anno:location(Anno), + case ets:lookup(NodeInfo, Location) of + [{Location, Data}] -> + OrigLocation = maps:get(location, Data), + erl_anno:set_location(OrigLocation, Anno); + [{Location}] -> % generated code + Anno; + [] -> + Anno + end + end, + map_anno(F, Abstr). + +restore_loc(Location, #state{node_info = NodeInfo}) -> + case ets:lookup(NodeInfo, Location) of + [{Location, #{location := OrigLocation}}] -> + OrigLocation; + [{Location}] -> + Location; + [] -> + Location + end. + no_shadows(Forms0, State) -> %% Variables that may shadow other variables are introduced in %% LCs and Funs. Such variables (call them SV, Shadowing %% Variables) are now renamed. Each (new) occurrence in a pattern %% is assigned an index (integer), unique in the file. %% - %% The state {LastIndex,ActiveVars,UsedVars,AllVars,Singletons} + %% The state {LastIndex,ActiveVars,UsedVars,AllVars,Singletons,State} %% holds the last index used for each SV (LastIndex), the SVs in %% the current scope (ActiveVars), used SVs (UsedVars, the indexed %% name is the key), all variables occurring in the file @@ -2516,16 +2663,15 @@ no_shadows(Forms0, State) -> %% the indexed name of an SV occurs in the file, next index is %% tried (to avoid mixing up introduced names with existing ones). %% - %% The original names of variables are kept in the line number - %% position of the abstract code: {var, {nos, OriginalName, L}, - %% NewName}. undo_no_shadows/1 re-creates the original code. + %% The original names of variables are kept in a table in State. + %% undo_no_shadows/2 re-creates the original code. AllVars = sets:from_list(ordsets:to_list(qlc:vars(Forms0))), ?DEBUG("nos AllVars = ~p~n", [sets:to_list(AllVars)]), VFun = fun(_Id, LC, Vs) -> nos(LC, Vs) end, LI = ets:new(?APIMOD,[]), UV = ets:new(?APIMOD,[]), D0 = dict:new(), - S1 = {LI, D0, UV, AllVars, []}, + S1 = {LI, D0, UV, AllVars, [], State}, _ = qlc_mapfold(VFun, S1, Forms0, State), ?DEBUG("UsedIntroVars = ~p~n", [ets:match_object(UV, '_')]), Singletons = ets:select(UV, ets:fun2ms(fun({K,0}) -> K end)), @@ -2533,7 +2679,7 @@ no_shadows(Forms0, State) -> true = ets:delete_all_objects(LI), true = ets:delete_all_objects(UV), %% Do it again, this time we know which variables are singletons. - S2 = {LI, D0, UV, AllVars, Singletons}, + S2 = {LI, D0, UV, AllVars, Singletons, State}, {Forms,_} = qlc_mapfold(VFun, S2, Forms0, State), true = ets:delete(LI), true = ets:delete(UV), @@ -2550,6 +2696,19 @@ nos({'fun',L,{clauses,Cs}}, S) -> {clause,Ln,H,G,B} end || {clause,Ln,H0,G0,B0} <- Cs], {{'fun',L,{clauses,NCs}}, S}; +nos({named_fun,Loc,Name,Cs}, S) -> + {{var,NLoc,NName}, S1} = case Name of + '_' -> + S; + Name -> + nos_pattern({var,Loc,Name}, S) + end, + NCs = [begin + {H, S2} = nos_pattern(H0, S1), + {[G, B], _} = nos([G0, B0], S2), + {clause,CLoc,H,G,B} + end || {clause,CLoc,H0,G0,B0} <- Cs], + {{named_fun,NLoc,NName,NCs}, S}; nos({lc,L,E0,Qs0}, S) -> %% QLCs as well as LCs. It is OK to modify LCs as long as they %% occur within QLCs--the warning messages have already been found @@ -2564,11 +2723,11 @@ nos({lc,L,E0,Qs0}, S) -> {Qs, S1} = lists:mapfoldl(F, S, Qs0), {E, _} = nos(E0, S1), {{lc,L,E,Qs}, S}; -nos({var,L,V}=Var, {_LI,Vs,UV,_A,_Sg}=S) when V =/= '_' -> +nos({var,L,V}=Var, {_LI,Vs,UV,_A,_Sg,State}=S) when V =/= '_' -> case used_var(V, Vs, UV) of {true, VN} -> - NL = nos_var(L, V), - {{var,NL,VN}, S}; + nos_var(L, V, State), + {{var,L,VN}, S}; false -> {Var, S} end; @@ -2586,7 +2745,7 @@ nos_pattern([P0 | Ps0], S0, PVs0) -> {P, S1, PVs1} = nos_pattern(P0, S0, PVs0), {Ps, S, PVs} = nos_pattern(Ps0, S1, PVs1), {[P | Ps], S, PVs}; -nos_pattern({var,L,V}, {LI,Vs0,UV,A,Sg}, PVs0) when V =/= '_' -> +nos_pattern({var,L,V}, {LI,Vs0,UV,A,Sg,State}, PVs0) when V =/= '_' -> {Name, Vs, PVs} = case lists:keyfind(V, 1, PVs0) of {V, VN} -> @@ -2600,16 +2759,25 @@ nos_pattern({var,L,V}, {LI,Vs0,UV,A,Sg}, PVs0) when V =/= '_' -> end, {N, Vs1, [{V,VN} | PVs0]} end, - NL = nos_var(L, V), - {{var,NL,Name}, {LI,Vs,UV,A,Sg}, PVs}; + nos_var(L, V, State), + {{var,L,Name}, {LI,Vs,UV,A,Sg,State}, PVs}; nos_pattern(T, S0, PVs0) when is_tuple(T) -> {TL, S, PVs} = nos_pattern(tuple_to_list(T), S0, PVs0), {list_to_tuple(TL), S, PVs}; nos_pattern(T, S, PVs) -> {T, S, PVs}. -nos_var(L, Name) -> - erl_parse:set_line(L, fun(Line) -> {nos,Name,Line} end). +nos_var(Anno, Name, State) -> + NodeInfo = State#state.node_info, + Location = erl_anno:location(Anno), + case ets:lookup(NodeInfo, Location) of + [{Location, #{name := _}}] -> + true; + [{Location, Data}] -> + true = ets:insert(NodeInfo, {Location, Data#{name => Name}}); + [] -> % cannot happen + true + end. used_var(V, Vs, UV) -> case dict:find(V, Vs) of @@ -2634,69 +2802,30 @@ next_var(V, Vs, AllVars, LI, UV) -> {VN, NVs} end. -undo_no_shadows(E) -> - var_map(fun undo_no_shadows1/1, E). +undo_no_shadows(E, State) -> + var_map(fun(Anno) -> undo_no_shadows1(Anno, State) end, E). -undo_no_shadows1({var, L, _}=Var) -> - case erl_parse:get_attribute(L, line) of - {line,{nos,V,_VL}} -> - NL = erl_parse:set_line(L, fun({nos,_V,VL}) -> VL end), - undo_no_shadows1({var, NL, V}); - _Else -> - Var - end. - -restore_line_numbers(E) -> - var_map(fun restore_line_numbers1/1, E). - -restore_line_numbers1({var, L, V}=Var) -> - case erl_parse:get_attribute(L, line) of - {line,{nos,_,_}} -> - NL = erl_parse:set_line(L, fun({nos,_V,VL}) -> VL end), - restore_line_numbers1({var, NL, V}); - _Else -> +undo_no_shadows1({var, Anno, _}=Var, State) -> + Location = erl_anno:location(Anno), + NodeInfo = State#state.node_info, + case ets:lookup(NodeInfo, Location) of + [{Location, #{name := Name}}] -> + {var, Anno, Name}; + _ -> Var end. %% QLC identifier. %% The first one encountered in the file has No=1. -make_lcid(Attrs, No) when is_integer(No), No > 0 -> - F = fun(Line) when is_integer(Line), Line < (1 bsl ?MAX_NUM_OF_LINES) -> - sgn(Line) * ((No bsl ?MAX_NUM_OF_LINES) + sgn(Line) * Line) - end, - erl_parse:set_line(Attrs, F). - -is_lcid(Attrs) -> - try - {line,Id} = erl_parse:get_attribute(Attrs, line), - is_integer(Id) andalso (abs(Id) > (1 bsl ?MAX_NUM_OF_LINES)) - catch _:_ -> - false - end. - -get_lcid_no(IdAttrs) -> - {line,Id} = erl_parse:get_attribute(IdAttrs, line), - abs(Id) bsr ?MAX_NUM_OF_LINES. - -get_lcid_line(IdAttrs) -> - {line,Id} = erl_parse:get_attribute(IdAttrs, line), - sgn(Id) * (abs(Id) band ((1 bsl ?MAX_NUM_OF_LINES) - 1)). - -sgn(X) when X >= 0 -> - 1; -sgn(X) when X < 0 -> - -1. +make_lcid(Anno, No) when is_integer(No), No > 0 -> + {No, erl_anno:line(Anno)}. -seq(S, E) when S - E =:= 1 -> - []; -seq(S, E) -> - lists:seq(S, E). +get_lcid_no({No, _Line}) -> + No. -sublist(_, 0) -> - []; -sublist(L, N) -> - lists:sublist(L, N). +get_lcid_line({_No, Line}) -> + Line. qid(LCId, No) -> #qid{no = No, lcid = LCId}. @@ -2723,6 +2852,9 @@ var2const(E) -> var_map(F, {var, _, _}=V) -> F(V); +var_map(F, {named_fun,NLoc,NName,Cs}) -> + {var,Loc,Name} = F({var,NLoc,NName}), + {named_fun,Loc,Name,var_map(F, Cs)}; var_map(F, T) when is_tuple(T) -> list_to_tuple(var_map(F, tuple_to_list(T))); var_map(F, [E | Es]) -> @@ -2742,6 +2874,14 @@ var_mapfold(F, A0, [E0 | Es0]) -> var_mapfold(_F, A, E) -> {E, A}. +map_anno(F, AbstrList) when is_list(AbstrList) -> + [map_anno1(F, Abstr) || Abstr <- AbstrList]; +map_anno(F, Abstr) -> + map_anno1(F, Abstr). + +map_anno1(F, Abstr) -> + erl_parse:map_anno(F, Abstr). + family_list(L) -> sofs:to_external(family(L)). @@ -2752,7 +2892,7 @@ family(L) -> display_forms(Forms) -> io:format("Forms ***~n"), lists:foreach(fun(Form) -> - io:format("~s~n", [catch erl_pp:form(Form)]) + io:format("~ts~n", [catch erl_pp:form(Form)]) end, Forms), io:format("End Forms ***~n"). -else. diff --git a/lib/stdlib/src/queue.erl b/lib/stdlib/src/queue.erl index afe917b151..11c0aa8d2b 100644 --- a/lib/stdlib/src/queue.erl +++ b/lib/stdlib/src/queue.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -30,7 +31,13 @@ %% Okasaki API from klacke -export([cons/2,head/1,tail/1, - snoc/2,last/1,daeh/1,init/1,liat/1,lait/1]). + snoc/2,last/1,daeh/1,init/1,liat/1]). + +-export_type([queue/0, queue/1]). + +%% Mis-spelled, deprecated. +-export([lait/1]). +-deprecated([lait/1]). %%-------------------------------------------------------------------------- %% Efficient implementation of double ended fifo queues @@ -44,10 +51,9 @@ %% that is; the RearList is reversed. %% -%% A declaration equivalent to the following is currently hard-coded -%% in erl_types.erl -%% -%% -opaque queue() :: {list(), list()}. +-opaque queue(Item) :: {list(Item), list(Item)}. + +-type queue() :: queue(_). %% Creation, inspection and conversion @@ -79,7 +85,7 @@ len(Q) -> erlang:error(badarg, [Q]). %% O(len(Q)) --spec to_list(Q :: queue()) -> list(). +-spec to_list(Q :: queue(Item)) -> list(Item). to_list({In,Out}) when is_list(In), is_list(Out) -> Out++lists:reverse(In, []); to_list(Q) -> @@ -88,7 +94,7 @@ to_list(Q) -> %% Create queue from list %% %% O(length(L)) --spec from_list(L :: list()) -> queue(). +-spec from_list(L :: list(Item)) -> queue(Item). from_list(L) when is_list(L) -> f2r(L); from_list(L) -> @@ -97,7 +103,7 @@ from_list(L) -> %% Return true or false depending on if element is in queue %% %% O(length(Q)) worst case --spec member(Item :: term(), Q :: queue()) -> boolean(). +-spec member(Item, Q :: queue(Item)) -> boolean(). member(X, {R,F}) when is_list(R), is_list(F) -> lists:member(X, R) orelse lists:member(X, F); member(X, Q) -> @@ -110,7 +116,7 @@ member(X, Q) -> %% Put at least one element in each list, if it is cheap %% %% O(1) --spec in(Item :: term(), Q1 :: queue()) -> Q2 :: queue(). +-spec in(Item, Q1 :: queue(Item)) -> Q2 :: queue(Item). in(X, {[_]=In,[]}) -> {[X], In}; in(X, {In,Out}) when is_list(In), is_list(Out) -> @@ -122,7 +128,7 @@ in(X, Q) -> %% Put at least one element in each list, if it is cheap %% %% O(1) --spec in_r(Item :: term(), Q1 :: queue()) -> Q2 :: queue(). +-spec in_r(Item, Q1 :: queue(Item)) -> Q2 :: queue(Item). in_r(X, {[],[_]=F}) -> {F,[X]}; in_r(X, {R,F}) when is_list(R), is_list(F) -> @@ -133,9 +139,9 @@ in_r(X, Q) -> %% Take from head/front %% %% O(1) amortized, O(len(Q)) worst case --spec out(Q1 :: queue()) -> - {{value, Item :: term()}, Q2 :: queue()} | - {empty, Q1 :: queue()}. +-spec out(Q1 :: queue(Item)) -> + {{value, Item}, Q2 :: queue(Item)} | + {empty, Q1 :: queue(Item)}. out({[],[]}=Q) -> {empty,Q}; out({[V],[]}) -> @@ -153,9 +159,9 @@ out(Q) -> %% Take from tail/rear %% %% O(1) amortized, O(len(Q)) worst case --spec out_r(Q1 :: queue()) -> - {{value, Item :: term()}, Q2 :: queue()} | - {empty, Q1 :: queue()}. +-spec out_r(Q1 :: queue(Item)) -> + {{value, Item}, Q2 :: queue(Item)} | + {empty, Q1 :: queue(Item)}. out_r({[],[]}=Q) -> {empty,Q}; out_r({[],[V]}) -> @@ -176,7 +182,7 @@ out_r(Q) -> %% Return the first element in the queue %% %% O(1) since the queue is supposed to be well formed --spec get(Q :: queue()) -> Item :: term(). +-spec get(Q :: queue(Item)) -> Item. get({[],[]}=Q) -> erlang:error(empty, [Q]); get({R,F}) when is_list(R), is_list(F) -> @@ -195,7 +201,7 @@ get([_|R], []) -> % malformed queue -> O(len(Q)) %% Return the last element in the queue %% %% O(1) since the queue is supposed to be well formed --spec get_r(Q :: queue()) -> Item :: term(). +-spec get_r(Q :: queue(Item)) -> Item. get_r({[],[]}=Q) -> erlang:error(empty, [Q]); get_r({[H|_],F}) when is_list(F) -> @@ -210,7 +216,7 @@ get_r(Q) -> %% Return the first element in the queue %% %% O(1) since the queue is supposed to be well formed --spec peek(Q :: queue()) -> empty | {value,Item :: term()}. +-spec peek(Q :: queue(Item)) -> empty | {value, Item}. peek({[],[]}) -> empty; peek({R,[H|_]}) when is_list(R) -> @@ -225,7 +231,7 @@ peek(Q) -> %% Return the last element in the queue %% %% O(1) since the queue is supposed to be well formed --spec peek_r(Q :: queue()) -> empty | {value,Item :: term()}. +-spec peek_r(Q :: queue(Item)) -> empty | {value, Item}. peek_r({[],[]}) -> empty; peek_r({[H|_],F}) when is_list(F) -> @@ -240,7 +246,7 @@ peek_r(Q) -> %% Remove the first element and return resulting queue %% %% O(1) amortized --spec drop(Q1 :: queue()) -> Q2 :: queue(). +-spec drop(Q1 :: queue(Item)) -> Q2 :: queue(Item). drop({[],[]}=Q) -> erlang:error(empty, [Q]); drop({[_],[]}) -> @@ -258,7 +264,7 @@ drop(Q) -> %% Remove the last element and return resulting queue %% %% O(1) amortized --spec drop_r(Q1 :: queue()) -> Q2 :: queue(). +-spec drop_r(Q1 :: queue(Item)) -> Q2 :: queue(Item). drop_r({[],[]}=Q) -> erlang:error(empty, [Q]); drop_r({[],[_]}) -> @@ -279,7 +285,7 @@ drop_r(Q) -> %% Return reversed queue %% %% O(1) --spec reverse(Q1 :: queue()) -> Q2 :: queue(). +-spec reverse(Q1 :: queue(Item)) -> Q2 :: queue(Item). reverse({R,F}) when is_list(R), is_list(F) -> {F,R}; reverse(Q) -> @@ -289,7 +295,7 @@ reverse(Q) -> %% %% Q2 empty: O(1) %% else: O(len(Q1)) --spec join(Q1 :: queue(), Q2 :: queue()) -> Q3 :: queue(). +-spec join(Q1 :: queue(Item), Q2 :: queue(Item)) -> Q3 :: queue(Item). join({R,F}=Q, {[],[]}) when is_list(R), is_list(F) -> Q; join({[],[]}, {R,F}=Q) when is_list(R), is_list(F) -> @@ -303,8 +309,8 @@ join(Q1, Q2) -> %% %% N = 0..len(Q) %% O(max(N, len(Q))) --spec split(N :: non_neg_integer(), Q1 :: queue()) -> - {Q2 :: queue(),Q3 :: queue()}. +-spec split(N :: non_neg_integer(), Q1 :: queue(Item)) -> + {Q2 :: queue(Item),Q3 :: queue(Item)}. split(0, {R,F}=Q) when is_list(R), is_list(F) -> {{[],[]},Q}; split(N, {R,F}=Q) when is_integer(N), N >= 1, is_list(R), is_list(F) -> @@ -345,8 +351,8 @@ split_r1_to_f2(N, [X|R1], F1, R2, F2) -> %% %% Fun(_) -> List: O(length(List) * len(Q)) %% else: O(len(Q) --spec filter(Fun, Q1 :: queue()) -> Q2 :: queue() when - Fun :: fun((Item :: term()) -> boolean() | list()). +-spec filter(Fun, Q1 :: queue(Item)) -> Q2 :: queue(Item) when + Fun :: fun((Item) -> boolean() | list(Item)). filter(Fun, {R0,F0}) when is_function(Fun, 1), is_list(R0), is_list(F0) -> F = filter_f(Fun, F0), R = filter_r(Fun, R0), @@ -422,7 +428,7 @@ filter_r(Fun, [X|R0]) -> %% Cons to head %% --spec cons(Item :: term(), Q1 :: queue()) -> Q2 :: queue(). +-spec cons(Item, Q1 :: queue(Item)) -> Q2 :: queue(Item). cons(X, Q) -> in_r(X, Q). @@ -431,7 +437,7 @@ cons(X, Q) -> %% Return the first element in the queue %% %% O(1) since the queue is supposed to be well formed --spec head(Q :: queue()) -> Item :: term(). +-spec head(Q :: queue(Item)) -> Item. head({[],[]}=Q) -> erlang:error(empty, [Q]); head({R,F}) when is_list(R), is_list(F) -> @@ -441,7 +447,7 @@ head(Q) -> %% Remove head element and return resulting queue %% --spec tail(Q1 :: queue()) -> Q2 :: queue(). +-spec tail(Q1 :: queue(Item)) -> Q2 :: queue(Item). tail(Q) -> drop(Q). @@ -449,22 +455,22 @@ tail(Q) -> %% Cons to tail %% --spec snoc(Q1 :: queue(), Item :: term()) -> Q2 :: queue(). +-spec snoc(Q1 :: queue(Item), Item) -> Q2 :: queue(Item). snoc(Q, X) -> in(X, Q). %% Return last element --spec daeh(Q :: queue()) -> Item :: term(). +-spec daeh(Q :: queue(Item)) -> Item. daeh(Q) -> get_r(Q). --spec last(Q :: queue()) -> Item :: term(). +-spec last(Q :: queue(Item)) -> Item. last(Q) -> get_r(Q). %% Remove last element and return resulting queue --spec liat(Q1 :: queue()) -> Q2 :: queue(). +-spec liat(Q1 :: queue(Item)) -> Q2 :: queue(Item). liat(Q) -> drop_r(Q). --spec lait(Q1 :: queue()) -> Q2 :: queue(). +-spec lait(Q1 :: queue(Item)) -> Q2 :: queue(Item). lait(Q) -> drop_r(Q). %% Oops, mis-spelled 'tail' reversed. Forget this one. --spec init(Q1 :: queue()) -> Q2 :: queue(). +-spec init(Q1 :: queue(Item)) -> Q2 :: queue(Item). init(Q) -> drop_r(Q). %%-------------------------------------------------------------------------- @@ -472,22 +478,24 @@ init(Q) -> drop_r(Q). -compile({inline, [{r2f,1},{f2r,1}]}). -%% Move all but two from R to F, if there are at least three +%% Move half of elements from R to F, if there are at least three r2f([]) -> {[],[]}; r2f([_]=R) -> {[],R}; r2f([X,Y]) -> {[X],[Y]}; -r2f([X,Y|R]) -> - {[X,Y],lists:reverse(R, [])}. +r2f(List) -> + {FF,RR} = lists:split(length(List) div 2 + 1, List), + {FF,lists:reverse(RR, [])}. -%% Move all but two from F to R, if there are enough +%% Move half of elements from F to R, if there are enough f2r([]) -> {[],[]}; f2r([_]=F) -> {F,[]}; f2r([X,Y]) -> {[Y],[X]}; -f2r([X,Y|F]) -> - {lists:reverse(F, []),[X,Y]}. +f2r(List) -> + {FF,RR} = lists:split(length(List) div 2 + 1, List), + {lists:reverse(RR, []),FF}. diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl new file mode 100644 index 0000000000..93409d95df --- /dev/null +++ b/lib/stdlib/src/rand.erl @@ -0,0 +1,596 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% ===================================================================== +%% Multiple PRNG module for Erlang/OTP +%% Copyright (c) 2015 Kenji Rikitake +%% ===================================================================== + +-module(rand). + +-export([seed_s/1, seed_s/2, seed/1, seed/2, + export_seed/0, export_seed_s/1, + uniform/0, uniform/1, uniform_s/1, uniform_s/2, + normal/0, normal_s/1 + ]). + +-compile({inline, [exs64_next/1, exsplus_next/1, + exs1024_next/1, exs1024_calc/2, + get_52/1, normal_kiwi/1]}). + +-define(DEFAULT_ALG_HANDLER, exsplus). +-define(SEED_DICT, rand_seed). + +%% ===================================================================== +%% Types +%% ===================================================================== + +%% This depends on the algorithm handler function +-type alg_seed() :: exs64_state() | exsplus_state() | exs1024_state(). +%% This is the algorithm handler function within this module +-type alg_handler() :: #{type := alg(), + max := integer(), + next := fun(), + uniform := fun(), + uniform_n := fun()}. + +%% Internal state +-opaque state() :: {alg_handler(), alg_seed()}. +-type alg() :: exs64 | exsplus | exs1024. +-opaque export_state() :: {alg(), alg_seed()}. +-export_type([alg/0, state/0, export_state/0]). + +%% ===================================================================== +%% API +%% ===================================================================== + +%% Return algorithm and seed so that RNG state can be recreated with seed/1 +-spec export_seed() -> undefined | export_state(). +export_seed() -> + case get(?SEED_DICT) of + {#{type:=Alg}, Seed} -> {Alg, Seed}; + _ -> undefined + end. + +-spec export_seed_s(state()) -> export_state(). +export_seed_s({#{type:=Alg}, Seed}) -> {Alg, Seed}. + +%% seed(Alg) seeds RNG with runtime dependent values +%% and return the NEW state + +%% seed({Alg,Seed}) setup RNG with a previously exported seed +%% and return the NEW state + +-spec seed(AlgOrExpState::alg() | export_state()) -> state(). +seed(Alg) -> + R = seed_s(Alg), + _ = seed_put(R), + R. + +-spec seed_s(AlgOrExpState::alg() | export_state()) -> state(). +seed_s(Alg) when is_atom(Alg) -> + seed_s(Alg, {erlang:phash2([{node(),self()}]), + erlang:system_time(), + erlang:unique_integer()}); +seed_s({Alg0, Seed}) -> + {Alg,_SeedFun} = mk_alg(Alg0), + {Alg, Seed}. + +%% seed/2: seeds RNG with the algorithm and given values +%% and returns the NEW state. + +-spec seed(Alg :: alg(), {integer(), integer(), integer()}) -> state(). +seed(Alg0, S0) -> + State = seed_s(Alg0, S0), + _ = seed_put(State), + State. + +-spec seed_s(Alg :: alg(), {integer(), integer(), integer()}) -> state(). +seed_s(Alg0, S0 = {_, _, _}) -> + {Alg, Seed} = mk_alg(Alg0), + AS = Seed(S0), + {Alg, AS}. + +%%% uniform/0, uniform/1, uniform_s/1, uniform_s/2 are all +%%% uniformly distributed random numbers. + +%% uniform/0: returns a random float X where 0.0 < X < 1.0, +%% updating the state in the process dictionary. + +-spec uniform() -> X::float(). +uniform() -> + {X, Seed} = uniform_s(seed_get()), + _ = seed_put(Seed), + X. + +%% uniform/1: given an integer N >= 1, +%% uniform/1 returns a random integer X where 1 =< X =< N, +%% updating the state in the process dictionary. + +-spec uniform(N :: pos_integer()) -> X::pos_integer(). +uniform(N) -> + {X, Seed} = uniform_s(N, seed_get()), + _ = seed_put(Seed), + X. + +%% uniform_s/1: given a state, uniform_s/1 +%% returns a random float X where 0.0 < X < 1.0, +%% and a new state. + +-spec uniform_s(state()) -> {X::float(), NewS :: state()}. +uniform_s(State = {#{uniform:=Uniform}, _}) -> + Uniform(State). + +%% uniform_s/2: given an integer N >= 1 and a state, uniform_s/2 +%% uniform_s/2 returns a random integer X where 1 =< X =< N, +%% and a new state. + +-spec uniform_s(N::pos_integer(), state()) -> {X::pos_integer(), NewS::state()}. +uniform_s(N, State = {#{uniform_n:=Uniform, max:=Max}, _}) + when 0 < N, N =< Max -> + Uniform(N, State); +uniform_s(N, State0 = {#{uniform:=Uniform}, _}) + when is_integer(N), 0 < N -> + {F, State} = Uniform(State0), + {trunc(F * N) + 1, State}. + +%% normal/0: returns a random float with standard normal distribution +%% updating the state in the process dictionary. + +-spec normal() -> float(). +normal() -> + {X, Seed} = normal_s(seed_get()), + _ = seed_put(Seed), + X. + +%% normal_s/1: returns a random float with standard normal distribution +%% The Ziggurat Method for generating random variables - Marsaglia and Tsang +%% Paper and reference code: http://www.jstatsoft.org/v05/i08/ + +-spec normal_s(state()) -> {float(), NewS :: state()}. +normal_s(State0) -> + {Sign, R, State} = get_52(State0), + Idx = R band 16#FF, + Idx1 = Idx+1, + {Ki, Wi} = normal_kiwi(Idx1), + X = R * Wi, + case R < Ki of + %% Fast path 95% of the time + true when Sign =:= 0 -> {X, State}; + true -> {-X, State}; + %% Slow path + false when Sign =:= 0 -> normal_s(Idx, Sign, X, State); + false -> normal_s(Idx, Sign, -X, State) + end. + +%% ===================================================================== +%% Internal functions + +-define(UINT21MASK, 16#00000000001fffff). +-define(UINT32MASK, 16#00000000ffffffff). +-define(UINT33MASK, 16#00000001ffffffff). +-define(UINT39MASK, 16#0000007fffffffff). +-define(UINT58MASK, 16#03ffffffffffffff). +-define(UINT64MASK, 16#ffffffffffffffff). + +-type uint64() :: 0..16#ffffffffffffffff. +-type uint58() :: 0..16#03ffffffffffffff. + +-spec seed_put(state()) -> undefined | state(). +seed_put(Seed) -> + put(?SEED_DICT, Seed). + +seed_get() -> + case get(?SEED_DICT) of + undefined -> seed(?DEFAULT_ALG_HANDLER); + Old -> Old % no type checking here + end. + +%% Setup alg record +mk_alg(exs64) -> + {#{type=>exs64, max=>?UINT64MASK, next=>fun exs64_next/1, + uniform=>fun exs64_uniform/1, uniform_n=>fun exs64_uniform/2}, + fun exs64_seed/1}; +mk_alg(exsplus) -> + {#{type=>exsplus, max=>?UINT58MASK, next=>fun exsplus_next/1, + uniform=>fun exsplus_uniform/1, uniform_n=>fun exsplus_uniform/2}, + fun exsplus_seed/1}; +mk_alg(exs1024) -> + {#{type=>exs1024, max=>?UINT64MASK, next=>fun exs1024_next/1, + uniform=>fun exs1024_uniform/1, uniform_n=>fun exs1024_uniform/2}, + fun exs1024_seed/1}. + +%% ===================================================================== +%% exs64 PRNG: Xorshift64* +%% Algorithm by Sebastiano Vigna +%% Reference URL: http://xorshift.di.unimi.it/ +%% ===================================================================== + +-type exs64_state() :: uint64(). + +exs64_seed({A1, A2, A3}) -> + {V1, _} = exs64_next(((A1 band ?UINT32MASK) * 4294967197 + 1)), + {V2, _} = exs64_next(((A2 band ?UINT32MASK) * 4294967231 + 1)), + {V3, _} = exs64_next(((A3 band ?UINT32MASK) * 4294967279 + 1)), + ((V1 * V2 * V3) rem (?UINT64MASK - 1)) + 1. + +%% Advance xorshift64* state for one step and generate 64bit unsigned integer +-spec exs64_next(exs64_state()) -> {uint64(), exs64_state()}. +exs64_next(R) -> + R1 = R bxor (R bsr 12), + R2 = R1 bxor ((R1 band ?UINT39MASK) bsl 25), + R3 = R2 bxor (R2 bsr 27), + {(R3 * 2685821657736338717) band ?UINT64MASK, R3}. + +exs64_uniform({Alg, R0}) -> + {V, R1} = exs64_next(R0), + {V / 18446744073709551616, {Alg, R1}}. + +exs64_uniform(Max, {Alg, R}) -> + {V, R1} = exs64_next(R), + {(V rem Max) + 1, {Alg, R1}}. + +%% ===================================================================== +%% exsplus PRNG: Xorshift116+ +%% Algorithm by Sebastiano Vigna +%% Reference URL: http://xorshift.di.unimi.it/ +%% 58 bits fits into an immediate on 64bits erlang and is thus much faster. +%% Modification of the original Xorshift128+ algorithm to 116 +%% by Sebastiano Vigna, a lot of thanks for his help and work. +%% ===================================================================== +-type exsplus_state() :: nonempty_improper_list(uint58(), uint58()). + +-dialyzer({no_improper_lists, exsplus_seed/1}). + +exsplus_seed({A1, A2, A3}) -> + {_, R1} = exsplus_next([(((A1 * 4294967197) + 1) band ?UINT58MASK)| + (((A2 * 4294967231) + 1) band ?UINT58MASK)]), + {_, R2} = exsplus_next([(((A3 * 4294967279) + 1) band ?UINT58MASK)| + tl(R1)]), + R2. + +-dialyzer({no_improper_lists, exsplus_next/1}). + +%% Advance xorshift116+ state for one step and generate 58bit unsigned integer +-spec exsplus_next(exsplus_state()) -> {uint58(), exsplus_state()}. +exsplus_next([S1|S0]) -> + %% Note: members s0 and s1 are swapped here + S11 = (S1 bxor (S1 bsl 24)) band ?UINT58MASK, + S12 = S11 bxor S0 bxor (S11 bsr 11) bxor (S0 bsr 41), + {(S0 + S12) band ?UINT58MASK, [S0|S12]}. + +exsplus_uniform({Alg, R0}) -> + {I, R1} = exsplus_next(R0), + {I / (?UINT58MASK+1), {Alg, R1}}. + +exsplus_uniform(Max, {Alg, R}) -> + {V, R1} = exsplus_next(R), + {(V rem Max) + 1, {Alg, R1}}. + +%% ===================================================================== +%% exs1024 PRNG: Xorshift1024* +%% Algorithm by Sebastiano Vigna +%% Reference URL: http://xorshift.di.unimi.it/ +%% ===================================================================== + +-type exs1024_state() :: {list(uint64()), list(uint64())}. + +exs1024_seed({A1, A2, A3}) -> + B1 = (((A1 band ?UINT21MASK) + 1) * 2097131) band ?UINT21MASK, + B2 = (((A2 band ?UINT21MASK) + 1) * 2097133) band ?UINT21MASK, + B3 = (((A3 band ?UINT21MASK) + 1) * 2097143) band ?UINT21MASK, + {exs1024_gen1024((B1 bsl 43) bor (B2 bsl 22) bor (B3 bsl 1) bor 1), + []}. + +%% Generate a list of 16 64-bit element list +%% of the xorshift64* random sequence +%% from a given 64-bit seed. +%% Note: dependent on exs64_next/1 +-spec exs1024_gen1024(uint64()) -> list(uint64()). +exs1024_gen1024(R) -> + exs1024_gen1024(16, R, []). + +exs1024_gen1024(0, _, L) -> + L; +exs1024_gen1024(N, R, L) -> + {X, R2} = exs64_next(R), + exs1024_gen1024(N - 1, R2, [X|L]). + +%% Calculation of xorshift1024*. +%% exs1024_calc(S0, S1) -> {X, NS1}. +%% X: random number output +-spec exs1024_calc(uint64(), uint64()) -> {uint64(), uint64()}. +exs1024_calc(S0, S1) -> + S11 = S1 bxor ((S1 band ?UINT33MASK) bsl 31), + S12 = S11 bxor (S11 bsr 11), + S01 = S0 bxor (S0 bsr 30), + NS1 = S01 bxor S12, + {(NS1 * 1181783497276652981) band ?UINT64MASK, NS1}. + +%% Advance xorshift1024* state for one step and generate 64bit unsigned integer +-spec exs1024_next(exs1024_state()) -> {uint64(), exs1024_state()}. +exs1024_next({[S0,S1|L3], RL}) -> + {X, NS1} = exs1024_calc(S0, S1), + {X, {[NS1|L3], [S0|RL]}}; +exs1024_next({[H], RL}) -> + NL = [H|lists:reverse(RL)], + exs1024_next({NL, []}). + +exs1024_uniform({Alg, R0}) -> + {V, R1} = exs1024_next(R0), + {V / 18446744073709551616, {Alg, R1}}. + +exs1024_uniform(Max, {Alg, R}) -> + {V, R1} = exs1024_next(R), + {(V rem Max) + 1, {Alg, R1}}. + +%% ===================================================================== +%% Ziggurat cont +%% ===================================================================== +-define(NOR_R, 3.6541528853610087963519472518). +-define(NOR_INV_R, 1/?NOR_R). + +%% return a {sign, Random51bits, State} +get_52({Alg=#{next:=Next}, S0}) -> + {Int,S1} = Next(S0), + {((1 bsl 51) band Int), Int band ((1 bsl 51)-1), {Alg, S1}}. + +%% Slow path +normal_s(0, Sign, X0, State0) -> + {U0, S1} = uniform_s(State0), + X = -?NOR_INV_R*math:log(U0), + {U1, S2} = uniform_s(S1), + Y = -math:log(U1), + case Y+Y > X*X of + false -> + normal_s(0, Sign, X0, S2); + true when Sign =:= 0 -> + {?NOR_R + X, S2}; + true -> + {-?NOR_R - X, S2} + end; +normal_s(Idx, _Sign, X, State0) -> + Fi2 = normal_fi(Idx+1), + {U0, S1} = uniform_s(State0), + case ((normal_fi(Idx) - Fi2)*U0 + Fi2) < math:exp(-0.5*X*X) of + true -> {X, S1}; + false -> normal_s(S1) + end. + +%% Tables for generating normal_s +%% ki is zipped with wi (slightly faster) +normal_kiwi(Indx) -> + element(Indx, + {{2104047571236786,1.736725412160263e-15}, {0,9.558660351455634e-17}, + {1693657211986787,1.2708704834810623e-16},{1919380038271141,1.4909740962495474e-16}, + {2015384402196343,1.6658733631586268e-16},{2068365869448128,1.8136120810119029e-16}, + {2101878624052573,1.9429720153135588e-16},{2124958784102998,2.0589500628482093e-16}, + {2141808670795147,2.1646860576895422e-16},{2154644611568301,2.2622940392218116e-16}, + {2164744887587275,2.353271891404589e-16},{2172897953696594,2.438723455742877e-16}, + {2179616279372365,2.5194879829274225e-16},{2185247251868649,2.5962199772528103e-16}, + {2190034623107822,2.6694407473648285e-16},{2194154434521197,2.7395729685142446e-16}, + {2197736978774660,2.8069646002484804e-16},{2200880740891961,2.871905890411393e-16}, + {2203661538010620,2.9346417484728883e-16},{2206138681109102,2.9953809336782113e-16}, + {2208359231806599,3.054303000719244e-16},{2210361007258210,3.111563633892157e-16}, + {2212174742388539,3.1672988018581815e-16},{2213825672704646,3.2216280350549905e-16}, + {2215334711002614,3.274657040793975e-16},{2216719334487595,3.326479811684171e-16}, + {2217994262139172,3.377180341735323e-16},{2219171977965032,3.4268340353119356e-16}, + {2220263139538712,3.475508873172976e-16},{2221276900117330,3.523266384600203e-16}, + {2222221164932930,3.5701624633953494e-16},{2223102796829069,3.616248057159834e-16}, + {2223927782546658,3.661569752965354e-16},{2224701368170060,3.7061702777236077e-16}, + {2225428170204312,3.75008892787478e-16},{2226112267248242,3.7933619401549554e-16}, + {2226757276105256,3.836022812967728e-16},{2227366415328399,3.8781025861250247e-16}, + {2227942558554684,3.919630085325768e-16},{2228488279492521,3.9606321366256378e-16}, + {2229005890047222,4.001133755254669e-16},{2229497472775193,4.041158312414333e-16}, + {2229964908627060,4.080727683096045e-16},{2230409900758597,4.119862377480744e-16}, + {2230833995044585,4.1585816580828064e-16},{2231238597816133,4.1969036444740733e-16}, + {2231624991250191,4.234845407152071e-16},{2231994346765928,4.272423051889976e-16}, + {2232347736722750,4.309651795716294e-16},{2232686144665934,4.346546035512876e-16}, + {2233010474325959,4.383119410085457e-16},{2233321557544881,4.4193848564470665e-16}, + {2233620161276071,4.455354660957914e-16},{2233906993781271,4.491040505882875e-16}, + {2234182710130335,4.52645351185714e-16},{2234447917093496,4.561604276690038e-16}, + {2234703177503020,4.596502910884941e-16},{2234949014150181,4.631159070208165e-16}, + {2235185913274316,4.665581985600875e-16},{2235414327692884,4.699780490694195e-16}, + {2235634679614920,4.733763047158324e-16},{2235847363174595,4.767537768090853e-16}, + {2236052746716837,4.8011124396270155e-16},{2236251174862869,4.834494540935008e-16}, + {2236442970379967,4.867691262742209e-16},{2236628435876762,4.900709524522994e-16}, + {2236807855342765,4.933555990465414e-16},{2236981495548562,4.966237084322178e-16}, + {2237149607321147,4.998759003240909e-16},{2237312426707209,5.031127730659319e-16}, + {2237470176035652,5.0633490483427195e-16},{2237623064889403,5.095428547633892e-16}, + {2237771290995388,5.127371639978797e-16},{2237915041040597,5.159183566785736e-16}, + {2238054491421305,5.190869408670343e-16},{2238189808931712,5.222434094134042e-16}, + {2238321151397660,5.253882407719454e-16},{2238448668260432,5.285218997682382e-16}, + {2238572501115169,5.316448383216618e-16},{2238692784207942,5.34757496126473e-16}, + {2238809644895133,5.378603012945235e-16},{2238923204068402,5.409536709623993e-16}, + {2239033576548190,5.440380118655467e-16},{2239140871448443,5.471137208817361e-16}, + {2239245192514958,5.501811855460336e-16},{2239346638439541,5.532407845392784e-16}, + {2239445303151952,5.56292888151909e-16},{2239541276091442,5.593378587248462e-16}, + {2239634642459498,5.623760510690043e-16},{2239725483455293,5.65407812864896e-16}, + {2239813876495186,5.684334850436814e-16},{2239899895417494,5.714534021509204e-16}, + {2239983610673676,5.744678926941961e-16},{2240065089506935,5.774772794756965e-16}, + {2240144396119183,5.804818799107686e-16},{2240221591827230,5.834820063333892e-16}, + {2240296735208969,5.864779662894365e-16},{2240369882240293,5.894700628185872e-16}, + {2240441086423386,5.924585947256134e-16},{2240510398907004,5.95443856841806e-16}, + {2240577868599305,5.984261402772028e-16},{2240643542273726,6.014057326642664e-16}, + {2240707464668391,6.043829183936125e-16},{2240769678579486,6.073579788423606e-16}, + {2240830224948980,6.103311925956439e-16},{2240889142947082,6.133028356617911e-16}, + {2240946470049769,6.162731816816596e-16},{2241002242111691,6.192425021325847e-16}, + {2241056493434746,6.222110665273788e-16},{2241109256832602,6.251791426088e-16}, + {2241160563691400,6.281469965398895e-16},{2241210444026879,6.311148930905604e-16}, + {2241258926538122,6.34083095820806e-16},{2241306038658137,6.370518672608815e-16}, + {2241351806601435,6.400214690888025e-16},{2241396255408788,6.429921623054896e-16}, + {2241439408989313,6.459642074078832e-16},{2241481290160038,6.489378645603397e-16}, + {2241521920683062,6.519133937646159e-16},{2241561321300462,6.548910550287415e-16}, + {2241599511767028,6.578711085350741e-16},{2241636510880960,6.608538148078259e-16}, + {2241672336512612,6.638394348803506e-16},{2241707005631362,6.668282304624746e-16}, + {2241740534330713,6.698204641081558e-16},{2241772937851689,6.728163993837531e-16}, + {2241804230604585,6.758163010371901e-16},{2241834426189161,6.78820435168298e-16}, + {2241863537413311,6.818290694006254e-16},{2241891576310281,6.848424730550038e-16}, + {2241918554154466,6.878609173251664e-16},{2241944481475843,6.908846754557169e-16}, + {2241969368073071,6.939140229227569e-16},{2241993223025298,6.969492376174829e-16}, + {2242016054702685,6.999906000330764e-16},{2242037870775710,7.030383934552151e-16}, + {2242058678223225,7.060929041565482e-16},{2242078483339331,7.091544215954873e-16}, + {2242097291739040,7.122232386196779e-16},{2242115108362774,7.152996516745303e-16}, + {2242131937479672,7.183839610172063e-16},{2242147782689725,7.214764709364707e-16}, + {2242162646924736,7.245774899788387e-16},{2242176532448092,7.276873311814693e-16}, + {2242189440853337,7.308063123122743e-16},{2242201373061537,7.339347561177405e-16}, + {2242212329317416,7.370729905789831e-16},{2242222309184237,7.4022134917658e-16}, + {2242231311537397,7.433801711647648e-16},{2242239334556717,7.465498018555889e-16}, + {2242246375717369,7.497305929136979e-16},{2242252431779415,7.529229026624058e-16}, + {2242257498775893,7.561270964017922e-16},{2242261571999416,7.5934354673958895e-16}, + {2242264645987196,7.625726339356756e-16},{2242266714504453,7.658147462610487e-16}, + {2242267770526109,7.690702803721919e-16},{2242267806216711,7.723396417018299e-16}, + {2242266812908462,7.756232448671174e-16},{2242264781077289,7.789215140963852e-16}, + {2242261700316818,7.822348836756411e-16},{2242257559310145,7.855637984161084e-16}, + {2242252345799276,7.889087141441755e-16},{2242246046552082,7.922700982152271e-16}, + {2242238647326615,7.956484300529366e-16},{2242230132832625,7.99044201715713e-16}, + {2242220486690076,8.024579184921259e-16},{2242209691384458,8.058900995272657e-16}, + {2242197728218684,8.093412784821501e-16},{2242184577261310,8.128120042284501e-16}, + {2242170217290819,8.163028415809877e-16},{2242154625735679,8.198143720706533e-16}, + {2242137778609839,8.23347194760605e-16},{2242119650443327,8.26901927108847e-16}, + {2242100214207556,8.304792058805374e-16},{2242079441234906,8.340796881136629e-16}, + {2242057301132135,8.377040521420222e-16},{2242033761687079,8.413529986798028e-16}, + {2242008788768107,8.450272519724097e-16},{2241982346215682,8.487275610186155e-16}, + {2241954395725356,8.524547008695596e-16},{2241924896721443,8.562094740106233e-16}, + {2241893806220517,8.599927118327665e-16},{2241861078683830,8.638052762005259e-16}, + {2241826665857598,8.676480611245582e-16},{2241790516600041,8.715219945473698e-16}, + {2241752576693881,8.754280402517175e-16},{2241712788642916,8.793671999021043e-16}, + {2241671091451078,8.833405152308408e-16},{2241627420382235,8.873490703813135e-16}, + {2241581706698773,8.913939944224086e-16},{2241533877376767,8.954764640495068e-16}, + {2241483854795281,8.9959770648911e-16},{2241431556397035,9.037590026260118e-16}, + {2241376894317345,9.079616903740068e-16},{2241319774977817,9.122071683134846e-16}, + {2241260098640860,9.164968996219135e-16},{2241197758920538,9.208324163262308e-16}, + {2241132642244704,9.252153239095693e-16},{2241064627262652,9.296473063086417e-16}, + {2240993584191742,9.341301313425265e-16},{2240919374095536,9.38665656618666e-16}, + {2240841848084890,9.432558359676707e-16},{2240760846432232,9.479027264651738e-16}, + {2240676197587784,9.526084961066279e-16},{2240587717084782,9.57375432209745e-16}, + {2240495206318753,9.622059506294838e-16},{2240398451183567,9.671026058823054e-16}, + {2240297220544165,9.720681022901626e-16},{2240191264522612,9.771053062707209e-16}, + {2240080312570155,9.822172599190541e-16},{2239964071293331,9.874071960480671e-16}, + {2239842221996530,9.926785548807976e-16},{2239714417896699,9.980350026183645e-16}, + {2239580280957725,1.003480452143618e-15},{2239439398282193,1.0090190861637457e-15}, + {2239291317986196,1.0146553831467086e-15},{2239135544468203,1.0203941464683124e-15}, + {2238971532964979,1.0262405372613567e-15},{2238798683265269,1.0322001115486456e-15}, + {2238616332424351,1.03827886235154e-15},{2238423746288095,1.044483267600047e-15}, + {2238220109591890,1.0508203448355195e-15},{2238004514345216,1.057297713900989e-15}, + {2237775946143212,1.06392366906768e-15},{2237533267957822,1.0707072623632994e-15}, + {2237275200846753,1.0776584002668106e-15},{2237000300869952,1.0847879564403425e-15}, + {2236706931309099,1.0921079038149563e-15},{2236393229029147,1.0996314701785628e-15}, + {2236057063479501,1.1073733224935752e-15},{2235695986373246,1.1153497865853155e-15}, + {2235307169458859,1.1235791107110833e-15},{2234887326941578,1.1320817840164846e-15}, + {2234432617919447,1.140880924258278e-15},{2233938522519765,1.1500027537839792e-15}, + {2233399683022677,1.159477189144919e-15},{2232809697779198,1.169338578691096e-15}, + {2232160850599817,1.17962663529558e-15},{2231443750584641,1.190387629928289e-15}, + {2230646845562170,1.2016759392543819e-15},{2229755753817986,1.2135560818666897e-15}, + {2228752329126533,1.2261054417450561e-15},{2227613325162504,1.2394179789163251e-15}, + {2226308442121174,1.2536093926602567e-15},{2224797391720399,1.268824481425501e-15}, + {2223025347823832,1.2852479319096109e-15},{2220915633329809,1.3031206634689985e-15}, + {2218357446087030,1.3227655770195326e-15},{2215184158448668,1.3446300925011171e-15}, + {2211132412537369,1.3693606835128518e-15},{2205758503851065,1.397943667277524e-15}, + {2198248265654987,1.4319989869661328e-15},{2186916352102141,1.4744848603597596e-15}, + {2167562552481814,1.5317872741611144e-15},{2125549880839716,1.6227698675312968e-15}}). + +normal_fi(Indx) -> + element(Indx, + {1.0000000000000000e+00,9.7710170126767082e-01,9.5987909180010600e-01, + 9.4519895344229909e-01,9.3206007595922991e-01,9.1999150503934646e-01, + 9.0872644005213032e-01,8.9809592189834297e-01,8.8798466075583282e-01, + 8.7830965580891684e-01,8.6900868803685649e-01,8.6003362119633109e-01, + 8.5134625845867751e-01,8.4291565311220373e-01,8.3471629298688299e-01, + 8.2672683394622093e-01,8.1892919160370192e-01,8.1130787431265572e-01, + 8.0384948317096383e-01,7.9654233042295841e-01,7.8937614356602404e-01, + 7.8234183265480195e-01,7.7543130498118662e-01,7.6863731579848571e-01, + 7.6195334683679483e-01,7.5537350650709567e-01,7.4889244721915638e-01, + 7.4250529634015061e-01,7.3620759812686210e-01,7.2999526456147568e-01, + 7.2386453346862967e-01,7.1781193263072152e-01,7.1183424887824798e-01, + 7.0592850133275376e-01,7.0009191813651117e-01,6.9432191612611627e-01, + 6.8861608300467136e-01,6.8297216164499430e-01,6.7738803621877308e-01, + 6.7186171989708166e-01,6.6639134390874977e-01,6.6097514777666277e-01, + 6.5561147057969693e-01,6.5029874311081637e-01,6.4503548082082196e-01, + 6.3982027745305614e-01,6.3465179928762327e-01,6.2952877992483625e-01, + 6.2445001554702606e-01,6.1941436060583399e-01,6.1442072388891344e-01, + 6.0946806492577310e-01,6.0455539069746733e-01,5.9968175261912482e-01, + 5.9484624376798689e-01,5.9004799633282545e-01,5.8528617926337090e-01, + 5.8055999610079034e-01,5.7586868297235316e-01,5.7121150673525267e-01, + 5.6658776325616389e-01,5.6199677581452390e-01,5.5743789361876550e-01, + 5.5291049042583185e-01,5.4841396325526537e-01,5.4394773119002582e-01, + 5.3951123425695158e-01,5.3510393238045717e-01,5.3072530440366150e-01, + 5.2637484717168403e-01,5.2205207467232140e-01,5.1775651722975591e-01, + 5.1348772074732651e-01,5.0924524599574761e-01,5.0502866794346790e-01, + 5.0083757512614835e-01,4.9667156905248933e-01,4.9253026364386815e-01, + 4.8841328470545758e-01,4.8432026942668288e-01,4.8025086590904642e-01, + 4.7620473271950547e-01,4.7218153846772976e-01,4.6818096140569321e-01, + 4.6420268904817391e-01,4.6024641781284248e-01,4.5631185267871610e-01, + 4.5239870686184824e-01,4.4850670150720273e-01,4.4463556539573912e-01, + 4.4078503466580377e-01,4.3695485254798533e-01,4.3314476911265209e-01, + 4.2935454102944126e-01,4.2558393133802180e-01,4.2183270922949573e-01, + 4.1810064983784795e-01,4.1438753404089090e-01,4.1069314827018799e-01, + 4.0701728432947315e-01,4.0335973922111429e-01,3.9972031498019700e-01, + 3.9609881851583223e-01,3.9249506145931540e-01,3.8890886001878855e-01, + 3.8534003484007706e-01,3.8178841087339344e-01,3.7825381724561896e-01, + 3.7473608713789086e-01,3.7123505766823922e-01,3.6775056977903225e-01, + 3.6428246812900372e-01,3.6083060098964775e-01,3.5739482014578022e-01, + 3.5397498080007656e-01,3.5057094148140588e-01,3.4718256395679348e-01, + 3.4380971314685055e-01,3.4045225704452164e-01,3.3711006663700588e-01, + 3.3378301583071823e-01,3.3047098137916342e-01,3.2717384281360129e-01, + 3.2389148237639104e-01,3.2062378495690530e-01,3.1737063802991350e-01, + 3.1413193159633707e-01,3.1090755812628634e-01,3.0769741250429189e-01, + 3.0450139197664983e-01,3.0131939610080288e-01,2.9815132669668531e-01, + 2.9499708779996164e-01,2.9185658561709499e-01,2.8872972848218270e-01, + 2.8561642681550159e-01,2.8251659308370741e-01,2.7943014176163772e-01, + 2.7635698929566810e-01,2.7329705406857691e-01,2.7025025636587519e-01, + 2.6721651834356114e-01,2.6419576399726080e-01,2.6118791913272082e-01, + 2.5819291133761890e-01,2.5521066995466168e-01,2.5224112605594190e-01, + 2.4928421241852824e-01,2.4633986350126363e-01,2.4340801542275012e-01, + 2.4048860594050039e-01,2.3758157443123795e-01,2.3468686187232990e-01, + 2.3180441082433859e-01,2.2893416541468023e-01,2.2607607132238020e-01, + 2.2323007576391746e-01,2.2039612748015194e-01,2.1757417672433113e-01, + 2.1476417525117358e-01,2.1196607630703015e-01,2.0917983462112499e-01, + 2.0640540639788071e-01,2.0364274931033485e-01,2.0089182249465656e-01, + 1.9815258654577511e-01,1.9542500351413428e-01,1.9270903690358912e-01, + 1.9000465167046496e-01,1.8731181422380025e-01,1.8463049242679927e-01, + 1.8196065559952254e-01,1.7930227452284767e-01,1.7665532144373500e-01, + 1.7401977008183875e-01,1.7139559563750595e-01,1.6878277480121151e-01, + 1.6618128576448205e-01,1.6359110823236570e-01,1.6101222343751107e-01, + 1.5844461415592431e-01,1.5588826472447920e-01,1.5334316106026283e-01, + 1.5080929068184568e-01,1.4828664273257453e-01,1.4577520800599403e-01, + 1.4327497897351341e-01,1.4078594981444470e-01,1.3830811644855071e-01, + 1.3584147657125373e-01,1.3338602969166913e-01,1.3094177717364430e-01, + 1.2850872227999952e-01,1.2608687022018586e-01,1.2367622820159654e-01, + 1.2127680548479021e-01,1.1888861344290998e-01,1.1651166562561080e-01, + 1.1414597782783835e-01,1.1179156816383801e-01,1.0944845714681163e-01, + 1.0711666777468364e-01,1.0479622562248690e-01,1.0248715894193508e-01, + 1.0018949876880981e-01,9.7903279038862284e-02,9.5628536713008819e-02, + 9.3365311912690860e-02,9.1113648066373634e-02,8.8873592068275789e-02, + 8.6645194450557961e-02,8.4428509570353374e-02,8.2223595813202863e-02, + 8.0030515814663056e-02,7.7849336702096039e-02,7.5680130358927067e-02, + 7.3522973713981268e-02,7.1377949058890375e-02,6.9245144397006769e-02, + 6.7124653827788497e-02,6.5016577971242842e-02,6.2921024437758113e-02, + 6.0838108349539864e-02,5.8767952920933758e-02,5.6710690106202902e-02, + 5.4666461324888914e-02,5.2635418276792176e-02,5.0617723860947761e-02, + 4.8613553215868521e-02,4.6623094901930368e-02,4.4646552251294443e-02, + 4.2684144916474431e-02,4.0736110655940933e-02,3.8802707404526113e-02, + 3.6884215688567284e-02,3.4980941461716084e-02,3.3093219458578522e-02, + 3.1221417191920245e-02,2.9365939758133314e-02,2.7527235669603082e-02, + 2.5705804008548896e-02,2.3902203305795882e-02,2.2117062707308864e-02, + 2.0351096230044517e-02,1.8605121275724643e-02,1.6880083152543166e-02, + 1.5177088307935325e-02,1.3497450601739880e-02,1.1842757857907888e-02, + 1.0214971439701471e-02,8.6165827693987316e-03,7.0508754713732268e-03, + 5.5224032992509968e-03,4.0379725933630305e-03,2.6090727461021627e-03, + 1.2602859304985975e-03}). diff --git a/lib/stdlib/src/random.erl b/lib/stdlib/src/random.erl index d7b51a151c..46dabb4323 100644 --- a/lib/stdlib/src/random.erl +++ b/lib/stdlib/src/random.erl @@ -1,22 +1,24 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(random). +-deprecated(module). %% Reasonable random number generator. %% The method is attributed to B. A. Wichmann and I. D. Hill @@ -57,11 +59,17 @@ seed() -> %% seed({A1, A2, A3}) %% Seed random number generation --spec seed({A1, A2, A3}) -> 'undefined' | ran() when +-spec seed(SValue) -> 'undefined' | ran() when + SValue :: {A1, A2, A3} | integer(), A1 :: integer(), A2 :: integer(), A3 :: integer(). +seed(Int) when is_integer(Int) -> + A1 = (Int bsr 16) band 16#fffffff, + A2 = Int band 16#ffffff, + A3 = (Int bsr 36) bor (A2 bsr 16), + seed(A1, A2, A3); seed({A1, A2, A3}) -> seed(A1, A2, A3). diff --git a/lib/stdlib/src/re.erl b/lib/stdlib/src/re.erl index 246d535943..52d3c35608 100644 --- a/lib/stdlib/src/re.erl +++ b/lib/stdlib/src/re.erl @@ -1,40 +1,109 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2011. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(re). -export([grun/3,urun/3,ucompile/2,replace/3,replace/4,split/2,split/3]). -%-opaque mp() :: {re_pattern, _, _, _}. --type mp() :: {re_pattern, _, _, _}. +-type mp() :: {re_pattern, _, _, _, _}. -type nl_spec() :: cr | crlf | lf | anycrlf | any. -type compile_option() :: unicode | anchored | caseless | dollar_endonly | dotall | extended | firstline | multiline | no_auto_capture | dupnames | ungreedy - | {newline, nl_spec()}| bsr_anycrlf - | bsr_unicode. + | {newline, nl_spec()} + | bsr_anycrlf | bsr_unicode + | no_start_optimize | ucp | never_utf. + +%%% BIFs + +-export([compile/1, compile/2, run/2, run/3, inspect/2]). + +-spec compile(Regexp) -> {ok, MP} | {error, ErrSpec} when + Regexp :: iodata(), + MP :: mp(), + ErrSpec :: {ErrString :: string(), Position :: non_neg_integer()}. + +compile(_) -> + erlang:nif_error(undef). + +-spec compile(Regexp, Options) -> {ok, MP} | {error, ErrSpec} when + Regexp :: iodata() | unicode:charlist(), + Options :: [Option], + Option :: compile_option(), + MP :: mp(), + ErrSpec :: {ErrString :: string(), Position :: non_neg_integer()}. + +compile(_, _) -> + erlang:nif_error(undef). + +-spec run(Subject, RE) -> {match, Captured} | nomatch when + Subject :: iodata() | unicode:charlist(), + RE :: mp() | iodata(), + Captured :: [CaptureData], + CaptureData :: {integer(), integer()}. + +run(_, _) -> + erlang:nif_error(undef). + +-spec run(Subject, RE, Options) -> {match, Captured} | + match | + nomatch | + {error, ErrType} when + Subject :: iodata() | unicode:charlist(), + RE :: mp() | iodata() | unicode:charlist(), + Options :: [Option], + Option :: anchored | global | notbol | noteol | notempty + | notempty_atstart | report_errors + | {offset, non_neg_integer()} | + {match_limit, non_neg_integer()} | + {match_limit_recursion, non_neg_integer()} | + {newline, NLSpec :: nl_spec()} | + bsr_anycrlf | bsr_unicode | {capture, ValueSpec} | + {capture, ValueSpec, Type} | CompileOpt, + Type :: index | list | binary, + ValueSpec :: all | all_but_first | all_names | first | none | ValueList, + ValueList :: [ValueID], + ValueID :: integer() | string() | atom(), + CompileOpt :: compile_option(), + Captured :: [CaptureData] | [[CaptureData]], + CaptureData :: {integer(), integer()} + | ListConversionData + | binary(), + ListConversionData :: string() + | {error, string(), binary()} + | {incomplete, string(), binary()}, + ErrType :: match_limit | match_limit_recursion | {compile, CompileErr}, + CompileErr :: {ErrString :: string(), Position :: non_neg_integer()}. + +run(_, _, _) -> + erlang:nif_error(undef). + +-spec inspect(MP,Item) -> {namelist, [ binary() ]} when + MP :: mp(), + Item :: namelist. + +inspect(_,_) -> + erlang:nif_error(undef). + -%% Emulator builtins in this module: -%% re:compile/1 -%% re:compile/2 -%% re:run/2 -%% re:run/3 +%%% End of BIFs -spec split(Subject, RE) -> SplitList when Subject :: iodata() | unicode:charlist(), @@ -48,8 +117,10 @@ split(Subject,RE) -> Subject :: iodata() | unicode:charlist(), RE :: mp() | iodata() | unicode:charlist(), Options :: [ Option ], - Option :: anchored | notbol | noteol | notempty + Option :: anchored | notbol | noteol | notempty | notempty_atstart | {offset, non_neg_integer()} | {newline, nl_spec()} + | {match_limit, non_neg_integer()} + | {match_limit_recursion, non_neg_integer()} | bsr_anycrlf | bsr_unicode | {return, ReturnType} | {parts, NumParts} | group | trim | CompileOpt, NumParts :: non_neg_integer() | infinity, @@ -61,8 +132,9 @@ split(Subject,RE) -> split(Subject,RE,Options) -> try - {NewOpt,Convert,Unicode,Limit,Strip,Group} = - process_split_params(Options,iodata,false,-1,false,false), + {NewOpt,Convert,Limit,Strip,Group} = + process_split_params(Options,iodata,-1,false,false), + Unicode = check_for_unicode(RE, Options), FlatSubject = to_binary(Subject, Unicode), case compile_split(RE,NewOpt) of {error,_Err} -> @@ -212,7 +284,7 @@ extend_subpatterns([],N) -> extend_subpatterns([H|T],N) -> [H | extend_subpatterns(T,N-1)]. -compile_split({re_pattern,N,_,_} = Comp, Options) -> +compile_split({re_pattern,N,_,_,_} = Comp, Options) -> {Comp,N,Options}; compile_split(Pat,Options0) when not is_tuple(Pat) -> Options = lists:filter(fun(O) -> @@ -221,7 +293,7 @@ compile_split(Pat,Options0) when not is_tuple(Pat) -> case re:compile(Pat,Options) of {error,Err} -> {error,Err}; - {ok, {re_pattern,N,_,_} = Comp} -> + {ok, {re_pattern,N,_,_,_} = Comp} -> NewOpt = lists:filter(fun(OO) -> (not copt(OO)) end, Options0), {Comp,N,NewOpt} end; @@ -241,8 +313,11 @@ replace(Subject,RE,Replacement) -> RE :: mp() | iodata() | unicode:charlist(), Replacement :: iodata() | unicode:charlist(), Options :: [Option], - Option :: anchored | global | notbol | noteol | notempty + Option :: anchored | global | notbol | noteol | notempty + | notempty_atstart | {offset, non_neg_integer()} | {newline, NLSpec} | bsr_anycrlf + | {match_limit, non_neg_integer()} + | {match_limit_recursion, non_neg_integer()} | bsr_unicode | {return, ReturnType} | CompileOpt, ReturnType :: iodata | list | binary, CompileOpt :: compile_option(), @@ -250,8 +325,8 @@ replace(Subject,RE,Replacement) -> replace(Subject,RE,Replacement,Options) -> try - {NewOpt,Convert,Unicode} = - process_repl_params(Options,iodata,false), + {NewOpt,Convert} = process_repl_params(Options,iodata), + Unicode = check_for_unicode(RE, Options), FlatSubject = to_binary(Subject, Unicode), FlatReplacement = to_binary(Replacement, Unicode), IoList = do_replace(FlatSubject,Subject,RE,FlatReplacement,NewOpt), @@ -293,61 +368,59 @@ do_replace(FlatSubject,Subject,RE,Replacement,Options) -> apply_mlist(FlatSubject,Replacement,[Slist]) end. -process_repl_params([],Convert,Unicode) -> - {[],Convert,Unicode}; -process_repl_params([unicode|T],C,_U) -> - {NT,NC,NU} = process_repl_params(T,C,true), - {[unicode|NT],NC,NU}; -process_repl_params([{capture,_,_}|_],_,_) -> +process_repl_params([],Convert) -> + {[],Convert}; +process_repl_params([report_errors|_],_) -> throw(badopt); -process_repl_params([{capture,_}|_],_,_) -> +process_repl_params([{capture,_,_}|_],_) -> throw(badopt); -process_repl_params([{return,iodata}|T],_C,U) -> - process_repl_params(T,iodata,U); -process_repl_params([{return,list}|T],_C,U) -> - process_repl_params(T,list,U); -process_repl_params([{return,binary}|T],_C,U) -> - process_repl_params(T,binary,U); -process_repl_params([{return,_}|_],_,_) -> +process_repl_params([{capture,_}|_],_) -> throw(badopt); -process_repl_params([H|T],C,U) -> - {NT,NC,NU} = process_repl_params(T,C,U), - {[H|NT],NC,NU}. - -process_split_params([],Convert,Unicode,Limit,Strip,Group) -> - {[],Convert,Unicode,Limit,Strip,Group}; -process_split_params([unicode|T],C,_U,L,S,G) -> - {NT,NC,NU,NL,NS,NG} = process_split_params(T,C,true,L,S,G), - {[unicode|NT],NC,NU,NL,NS,NG}; -process_split_params([trim|T],C,U,_L,_S,G) -> - process_split_params(T,C,U,-1,true,G); -process_split_params([{parts,0}|T],C,U,_L,_S,G) -> - process_split_params(T,C,U,-1,true,G); -process_split_params([{parts,N}|T],C,U,_L,_S,G) when is_integer(N), N >= 1 -> - process_split_params(T,C,U,N-1,false,G); -process_split_params([{parts,infinity}|T],C,U,_L,_S,G) -> - process_split_params(T,C,U,-1,false,G); -process_split_params([{parts,_}|_],_,_,_,_,_) -> +process_repl_params([{return,iodata}|T],_C) -> + process_repl_params(T,iodata); +process_repl_params([{return,list}|T],_C) -> + process_repl_params(T,list); +process_repl_params([{return,binary}|T],_C) -> + process_repl_params(T,binary); +process_repl_params([{return,_}|_],_) -> + throw(badopt); +process_repl_params([H|T],C) -> + {NT,NC} = process_repl_params(T,C), + {[H|NT],NC}. + +process_split_params([],Convert,Limit,Strip,Group) -> + {[],Convert,Limit,Strip,Group}; +process_split_params([trim|T],C,_L,_S,G) -> + process_split_params(T,C,-1,true,G); +process_split_params([{parts,0}|T],C,_L,_S,G) -> + process_split_params(T,C,-1,true,G); +process_split_params([{parts,N}|T],C,_L,_S,G) when is_integer(N), N >= 1 -> + process_split_params(T,C,N-1,false,G); +process_split_params([{parts,infinity}|T],C,_L,_S,G) -> + process_split_params(T,C,-1,false,G); +process_split_params([{parts,_}|_],_,_,_,_) -> throw(badopt); -process_split_params([group|T],C,U,L,S,_G) -> - process_split_params(T,C,U,L,S,true); -process_split_params([global|_],_,_,_,_,_) -> +process_split_params([group|T],C,L,S,_G) -> + process_split_params(T,C,L,S,true); +process_split_params([global|_],_,_,_,_) -> + throw(badopt); +process_split_params([report_errors|_],_,_,_,_) -> throw(badopt); -process_split_params([{capture,_,_}|_],_,_,_,_,_) -> +process_split_params([{capture,_,_}|_],_,_,_,_) -> throw(badopt); -process_split_params([{capture,_}|_],_,_,_,_,_) -> +process_split_params([{capture,_}|_],_,_,_,_) -> throw(badopt); -process_split_params([{return,iodata}|T],_C,U,L,S,G) -> - process_split_params(T,iodata,U,L,S,G); -process_split_params([{return,list}|T],_C,U,L,S,G) -> - process_split_params(T,list,U,L,S,G); -process_split_params([{return,binary}|T],_C,U,L,S,G) -> - process_split_params(T,binary,U,L,S,G); -process_split_params([{return,_}|_],_,_,_,_,_) -> +process_split_params([{return,iodata}|T],_C,L,S,G) -> + process_split_params(T,iodata,L,S,G); +process_split_params([{return,list}|T],_C,L,S,G) -> + process_split_params(T,list,L,S,G); +process_split_params([{return,binary}|T],_C,L,S,G) -> + process_split_params(T,binary,L,S,G); +process_split_params([{return,_}|_],_,_,_,_) -> throw(badopt); -process_split_params([H|T],C,U,L,S,G) -> - {NT,NC,NU,NL,NS,NG} = process_split_params(T,C,U,L,S,G), - {[H|NT],NC,NU,NL,NS,NG}. +process_split_params([H|T],C,L,S,G) -> + {NT,NC,NL,NS,NG} = process_split_params(T,C,L,S,G), + {[H|NT],NC,NL,NS,NG}. apply_mlist(Subject,Replacement,Mlist) -> do_mlist(Subject,Subject,0,precomp_repl(Replacement), Mlist). @@ -355,6 +428,12 @@ apply_mlist(Subject,Replacement,Mlist) -> precomp_repl(<<>>) -> []; +precomp_repl(<<$\\,$g,${,Rest/binary>>) when byte_size(Rest) > 0 -> + {NS, <<$},NRest/binary>>} = pick_int(Rest), + [list_to_integer(NS) | precomp_repl(NRest)]; +precomp_repl(<<$\\,$g,Rest/binary>>) when byte_size(Rest) > 0 -> + {NS,NRest} = pick_int(Rest), + [list_to_integer(NS) | precomp_repl(NRest)]; precomp_repl(<<$\\,X,Rest/binary>>) when X < $1 ; X > $9 -> %% Escaped character case precomp_repl(Rest) of @@ -427,17 +506,31 @@ do_replace(Subject,Repl,SubExprs0) -> end || Part <- Repl ]. -check_for_unicode({re_pattern,_,1,_},_) -> +check_for_unicode({re_pattern,_,1,_,_},_) -> true; -check_for_unicode({re_pattern,_,0,_},_) -> +check_for_unicode({re_pattern,_,0,_,_},_) -> false; check_for_unicode(_,L) -> lists:member(unicode,L). + +check_for_crlf({re_pattern,_,_,1,_},_) -> + true; +check_for_crlf({re_pattern,_,_,0,_},_) -> + false; +check_for_crlf(_,L) -> + case lists:keysearch(newline,1,L) of + {value,{newline,any}} -> true; + {value,{newline,crlf}} -> true; + {value,{newline,anycrlf}} -> true; + _ -> false + end. % SelectReturn = false | all | stirpfirst | none % ConvertReturn = index | list | binary % {capture, all} -> all (untouchded) -% {capture, first} -> kept in argumentt list and Select all +% {capture, all_names} -> if names are present: treated as a name {capture, [...]} +% else: same as {capture, []} +% {capture, first} -> kept in argument list and Select all % {capture, all_but_first} -> removed from argument list and selects stripfirst % {capture, none} -> removed from argument list and selects none % {capture, []} -> removed from argument list and selects none @@ -446,23 +539,30 @@ check_for_unicode(_,L) -> % Call as process_parameters([],0,false,index,NeedClean) -process_parameters([],InitialOffset, SelectReturn, ConvertReturn,_) -> +process_parameters([],InitialOffset, SelectReturn, ConvertReturn,_,_) -> {[], InitialOffset, SelectReturn, ConvertReturn}; -process_parameters([{offset, N} | T],_Init0,Select0,Return0,CC) -> - process_parameters(T,N,Select0,Return0,CC); -process_parameters([global | T],Init0,Select0,Return0,CC) -> - process_parameters(T,Init0,Select0,Return0,CC); -process_parameters([{capture,Values,Type}|T],Init0,Select0,_Return0,CC) -> - process_parameters([{capture,Values}|T],Init0,Select0,Type,CC); -process_parameters([{capture,Values}|T],Init0,Select0,Return0,CC) -> +process_parameters([{offset, N} | T],_Init0,Select0,Return0,CC,RE) -> + process_parameters(T,N,Select0,Return0,CC,RE); +process_parameters([global | T],Init0,Select0,Return0,CC,RE) -> + process_parameters(T,Init0,Select0,Return0,CC,RE); +process_parameters([{capture,Values,Type}|T],Init0,Select0,_Return0,CC,RE) -> + process_parameters([{capture,Values}|T],Init0,Select0,Type,CC,RE); +process_parameters([{capture,Values}|T],Init0,Select0,Return0,CC,RE) -> % First process the rest to see if capture was already present {NewTail, Init1, Select1, Return1} = - process_parameters(T,Init0,Select0,Return0,CC), + process_parameters(T,Init0,Select0,Return0,CC,RE), case Select1 of false -> case Values of all -> {[{capture,all} | NewTail], Init1, all, Return0}; + all_names -> + case re:inspect(RE,namelist) of + {namelist, []} -> + {[{capture,first} | NewTail], Init1, none, Return0}; + {namelist, List} -> + {[{capture,[0|List]} | NewTail], Init1, stripfirst, Return0} + end; first -> {[{capture,first} | NewTail], Init1, all, Return0}; all_but_first -> @@ -481,20 +581,20 @@ process_parameters([{capture,Values}|T],Init0,Select0,Return0,CC) -> % Found overriding further down list, ignore this one {NewTail, Init1, Select1, Return1} end; -process_parameters([H|T],Init0,Select0,Return0,true) -> +process_parameters([H|T],Init0,Select0,Return0,true,RE) -> case copt(H) of true -> - process_parameters(T,Init0,Select0,Return0,true); + process_parameters(T,Init0,Select0,Return0,true,RE); false -> {NewT,Init,Select,Return} = - process_parameters(T,Init0,Select0,Return0,true), + process_parameters(T,Init0,Select0,Return0,true,RE), {[H|NewT],Init,Select,Return} end; -process_parameters([H|T],Init0,Select0,Return0,false) -> +process_parameters([H|T],Init0,Select0,Return0,false,RE) -> {NewT,Init,Select,Return} = - process_parameters(T,Init0,Select0,Return0,false), + process_parameters(T,Init0,Select0,Return0,false,RE), {[H|NewT],Init,Select,Return}; -process_parameters(_,_,_,_,_) -> +process_parameters(_,_,_,_,_,_) -> throw(badlist). postprocess({match,[]},_,_,_,_) -> @@ -602,7 +702,7 @@ urun2(Subject0,RE0,Options0) -> RE = case RE0 of BinRE when is_binary(BinRE) -> BinRE; - {re_pattern,_,_,_} = ReCompiled -> + {re_pattern,_,_,_,_} = ReCompiled -> ReCompiled; ListRE -> unicode:characters_to_binary(ListRE,unicode) @@ -643,38 +743,46 @@ grun(Subject,RE,{Options,NeedClean,OrigRE}) -> grun2(Subject,RE,{Options,NeedClean}) -> Unicode = check_for_unicode(RE,Options), + CRLF = check_for_crlf(RE,Options), FlatSubject = to_binary(Subject, Unicode), - do_grun(FlatSubject,Subject,Unicode,RE,{Options,NeedClean}). + do_grun(FlatSubject,Subject,Unicode,CRLF,RE,{Options,NeedClean}). -do_grun(FlatSubject,Subject,Unicode,RE,{Options0,NeedClean}) -> +do_grun(FlatSubject,Subject,Unicode,CRLF,RE,{Options0,NeedClean}) -> {StrippedOptions, InitialOffset, SelectReturn, ConvertReturn} = case (catch - process_parameters(Options0, 0, false, index, NeedClean)) of + process_parameters(Options0, 0, false, index, NeedClean,RE)) of badlist -> erlang:error(badarg,[Subject,RE,Options0]); CorrectReturn -> CorrectReturn end, - postprocess(loopexec(FlatSubject,RE,InitialOffset, - byte_size(FlatSubject), - Unicode,StrippedOptions), - SelectReturn,ConvertReturn,FlatSubject,Unicode). + try + postprocess(loopexec(FlatSubject,RE,InitialOffset, + byte_size(FlatSubject), + Unicode,CRLF,StrippedOptions), + SelectReturn,ConvertReturn,FlatSubject,Unicode) + catch + throw:ErrTuple -> + ErrTuple + end. -loopexec(_,_,X,Y,_,_) when X > Y -> +loopexec(_,_,X,Y,_,_,_) when X > Y -> {match,[]}; -loopexec(Subject,RE,X,Y,Unicode,Options) -> +loopexec(Subject,RE,X,Y,Unicode,CRLF,Options) -> case re:run(Subject,RE,[{offset,X}]++Options) of + {error, Err} -> + throw({error,Err}); nomatch -> {match,[]}; {match,[{A,B}|More]} -> {match,Rest} = case B>0 of true -> - loopexec(Subject,RE,A+B,Y,Unicode,Options); + loopexec(Subject,RE,A+B,Y,Unicode,CRLF,Options); false -> {match,M} = - case re:run(Subject,RE,[{offset,X},notempty, + case re:run(Subject,RE,[{offset,X},notempty_atstart, anchored]++Options) of nomatch -> {match,[]}; @@ -685,10 +793,10 @@ loopexec(Subject,RE,X,Y,Unicode,Options) -> [{_,NStep}|_] when NStep > 0 -> A+NStep; _ -> - forward(Subject,A,1,Unicode) + forward(Subject,A,1,Unicode,CRLF) end, {match,MM} = loopexec(Subject,RE,NewA,Y, - Unicode,Options), + Unicode,CRLF,Options), case M of [] -> {match,MM}; @@ -699,11 +807,22 @@ loopexec(Subject,RE,X,Y,Unicode,Options) -> {match,[[{A,B}|More] | Rest]} end. -forward(_Chal,A,0,_) -> +forward(_Chal,A,0,_,_) -> A; -forward(_Chal,A,N,false) -> - A+N; -forward(Chal,A,N,true) -> +forward(Chal,A,N,U,true) -> + <<_:A/binary,Tl/binary>> = Chal, + case Tl of + <<$\r,$\n,_/binary>> -> + forward(Chal,A+2,N-1,U,true); + _ -> + forward2(Chal,A,N,U,true) + end; +forward(Chal,A,N,U,false) -> + forward2(Chal,A,N,U,false). + +forward2(Chal,A,N,false,CRLF) -> + forward(Chal,A+1,N-1,false,CRLF); +forward2(Chal,A,N,true,CRLF) -> <<_:A/binary,Tl/binary>> = Chal, Forw = case Tl of <<1:1,1:1,0:1,_:5,_/binary>> -> @@ -715,10 +834,16 @@ forward(Chal,A,N,true) -> _ -> 1 end, - forward(Chal,A+Forw,N-1,true). + forward(Chal,A+Forw,N-1,true,CRLF). copt(caseless) -> true; +copt(no_start_optimize) -> + true; +copt(never_utf) -> + true; +copt(ucp) -> + true; copt(dollar_endonly) -> true; copt(dotall) -> @@ -749,6 +874,8 @@ copt(_) -> runopt(notempty) -> true; +runopt(notempty_atstart) -> + true; runopt(notbol) -> true; runopt(noteol) -> @@ -761,6 +888,10 @@ runopt({capture,_}) -> true; runopt(global) -> true; +runopt({match_limit,_}) -> + true; +runopt({match_limit_recursion,_}) -> + true; runopt(_) -> false. diff --git a/lib/stdlib/src/sets.erl b/lib/stdlib/src/sets.erl index 3fd6c81e5f..3e70450320 100644 --- a/lib/stdlib/src/sets.erl +++ b/lib/stdlib/src/sets.erl @@ -1,23 +1,24 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2011. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -%% We use the dynamic hashing techniques by Per-�ke Larsson as +%% We use the dynamic hashing techniques by Per-Åke Larsson as %% described in "The Design and Implementation of Dynamic Hashing for %% Sets and Tables in Icon" by Griswold and Townsend. Much of the %% terminology comes from that paper as well. @@ -43,6 +44,8 @@ -export([subtract/2,is_subset/2]). -export([fold/3,filter/2]). +-export_type([set/0, set/1]). + %% Note: mk_seg/1 must be changed too if seg_size is changed. -define(seg_size, 16). -define(max_seg, 32). @@ -53,8 +56,8 @@ %%------------------------------------------------------------------------------ --type seg() :: tuple(). --type segs() :: tuple(). +-type seg() :: tuple(). +-type segs(_Element) :: tuple(). %% Define a hash set. The default values are the standard ones. -record(set, @@ -65,14 +68,12 @@ exp_size=?exp_size :: non_neg_integer(), % Size to expand at con_size=?con_size :: non_neg_integer(), % Size to contract at empty :: seg(), % Empty segment - segs :: segs() % Segments + segs :: segs(_) % Segments }). -%% A declaration equivalent to the following one is hard-coded in erl_types. -%% That declaration contains hard-coded information about the #set{} -%% record and the types of its fields. So, please make sure that any -%% changes to its structure are also propagated to erl_types.erl. -%% -%% -opaque set() :: #set{}. + +-type set() :: set(_). + +-opaque set(Element) :: #set{segs :: segs(Element)}. %%------------------------------------------------------------------------------ @@ -98,24 +99,23 @@ size(S) -> S#set.size. %% to_list(Set) -> [Elem]. %% Return the elements in Set as a list. -spec to_list(Set) -> List when - Set :: set(), - List :: [term()]. + Set :: set(Element), + List :: [Element]. to_list(S) -> fold(fun (Elem, List) -> [Elem|List] end, [], S). %% from_list([Elem]) -> Set. %% Build a set from the elements in List. -spec from_list(List) -> Set when - List :: [term()], - Set :: set(). + List :: [Element], + Set :: set(Element). from_list(L) -> lists:foldl(fun (E, S) -> add_element(E, S) end, new(), L). %% is_element(Element, Set) -> boolean(). %% Return 'true' if Element is an element of Set, else 'false'. -spec is_element(Element, Set) -> boolean() when - Element :: term(), - Set :: set(). + Set :: set(Element). is_element(E, S) -> Slot = get_slot(S, E), Bkt = get_bucket(S, Slot), @@ -124,9 +124,8 @@ is_element(E, S) -> %% add_element(Element, Set) -> Set. %% Return Set with Element inserted in it. -spec add_element(Element, Set1) -> Set2 when - Element :: term(), - Set1 :: set(), - Set2 :: set(). + Set1 :: set(Element), + Set2 :: set(Element). add_element(E, S0) -> Slot = get_slot(S0, E), {S1,Ic} = on_bucket(fun (B0) -> add_bkt_el(E, B0, B0) end, S0, Slot), @@ -141,9 +140,8 @@ add_bkt_el(E, [], Bkt) -> {[E|Bkt],1}. %% del_element(Element, Set) -> Set. %% Return Set but with Element removed. -spec del_element(Element, Set1) -> Set2 when - Element :: term(), - Set1 :: set(), - Set2 :: set(). + Set1 :: set(Element), + Set2 :: set(Element). del_element(E, S0) -> Slot = get_slot(S0, E), {S1,Dc} = on_bucket(fun (B0) -> del_bkt_el(E, B0) end, S0, Slot), @@ -159,9 +157,9 @@ del_bkt_el(_, []) -> {[],0}. %% union(Set1, Set2) -> Set %% Return the union of Set1 and Set2. -spec union(Set1, Set2) -> Set3 when - Set1 :: set(), - Set2 :: set(), - Set3 :: set(). + Set1 :: set(Element), + Set2 :: set(Element), + Set3 :: set(Element). union(S1, S2) when S1#set.size < S2#set.size -> fold(fun (E, S) -> add_element(E, S) end, S2, S1); union(S1, S2) -> @@ -170,14 +168,14 @@ union(S1, S2) -> %% union([Set]) -> Set %% Return the union of the list of sets. -spec union(SetList) -> Set when - SetList :: [set()], - Set :: set(). + SetList :: [set(Element)], + Set :: set(Element). union([S1,S2|Ss]) -> union1(union(S1, S2), Ss); union([S]) -> S; union([]) -> new(). --spec union1(set(), [set()]) -> set(). +-spec union1(set(E), [set(E)]) -> set(E). union1(S1, [S2|Ss]) -> union1(union(S1, S2), Ss); union1(S1, []) -> S1. @@ -185,9 +183,9 @@ union1(S1, []) -> S1. %% intersection(Set1, Set2) -> Set. %% Return the intersection of Set1 and Set2. -spec intersection(Set1, Set2) -> Set3 when - Set1 :: set(), - Set2 :: set(), - Set3 :: set(). + Set1 :: set(Element), + Set2 :: set(Element), + Set3 :: set(Element). intersection(S1, S2) when S1#set.size < S2#set.size -> filter(fun (E) -> is_element(E, S2) end, S1); intersection(S1, S2) -> @@ -196,13 +194,13 @@ intersection(S1, S2) -> %% intersection([Set]) -> Set. %% Return the intersection of the list of sets. -spec intersection(SetList) -> Set when - SetList :: [set(),...], - Set :: set(). + SetList :: [set(Element),...], + Set :: set(Element). intersection([S1,S2|Ss]) -> intersection1(intersection(S1, S2), Ss); intersection([S]) -> S. --spec intersection1(set(), [set()]) -> set(). +-spec intersection1(set(E), [set(E)]) -> set(E). intersection1(S1, [S2|Ss]) -> intersection1(intersection(S1, S2), Ss); intersection1(S1, []) -> S1. @@ -210,8 +208,8 @@ intersection1(S1, []) -> S1. %% is_disjoint(Set1, Set2) -> boolean(). %% Check whether Set1 and Set2 are disjoint. -spec is_disjoint(Set1, Set2) -> boolean() when - Set1 :: set(), - Set2 :: set(). + Set1 :: set(Element), + Set2 :: set(Element). is_disjoint(S1, S2) when S1#set.size < S2#set.size -> fold(fun (_, false) -> false; (E, true) -> not is_element(E, S2) @@ -225,9 +223,9 @@ is_disjoint(S1, S2) -> %% Return all and only the elements of Set1 which are not also in %% Set2. -spec subtract(Set1, Set2) -> Set3 when - Set1 :: set(), - Set2 :: set(), - Set3 :: set(). + Set1 :: set(Element), + Set2 :: set(Element), + Set3 :: set(Element). subtract(S1, S2) -> filter(fun (E) -> not is_element(E, S2) end, S1). @@ -235,34 +233,34 @@ subtract(S1, S2) -> %% Return 'true' when every element of Set1 is also a member of %% Set2, else 'false'. -spec is_subset(Set1, Set2) -> boolean() when - Set1 :: set(), - Set2 :: set(). + Set1 :: set(Element), + Set2 :: set(Element). is_subset(S1, S2) -> fold(fun (E, Sub) -> Sub andalso is_element(E, S2) end, true, S1). %% fold(Fun, Accumulator, Set) -> Accumulator. %% Fold function Fun over all elements in Set and return Accumulator. -spec fold(Function, Acc0, Set) -> Acc1 when - Function :: fun((E :: term(),AccIn) -> AccOut), - Set :: set(), - Acc0 :: T, - Acc1 :: T, - AccIn :: T, - AccOut :: T. + Function :: fun((Element, AccIn) -> AccOut), + Set :: set(Element), + Acc0 :: Acc, + Acc1 :: Acc, + AccIn :: Acc, + AccOut :: Acc. fold(F, Acc, D) -> fold_set(F, Acc, D). %% filter(Fun, Set) -> Set. %% Filter Set with Fun. -spec filter(Pred, Set1) -> Set2 when - Pred :: fun((E :: term()) -> boolean()), - Set1 :: set(), - Set2 :: set(). + Pred :: fun((Element) -> boolean()), + Set1 :: set(Element), + Set2 :: set(Element). filter(F, D) -> filter_set(F, D). %% get_slot(Hashdb, Key) -> Slot. %% Get the slot. First hash on the new range, if we hit a bucket %% which has not been split use the unsplit buddy bucket. --spec get_slot(set(), term()) -> non_neg_integer(). +-spec get_slot(set(E), E) -> non_neg_integer(). get_slot(T, Key) -> H = erlang:phash(Key, T#set.maxn), if @@ -276,8 +274,8 @@ get_bucket(T, Slot) -> get_bucket_s(T#set.segs, Slot). %% on_bucket(Fun, Hashdb, Slot) -> {NewHashDb,Result}. %% Apply Fun to the bucket in Slot and replace the returned bucket. --spec on_bucket(fun((_) -> {[_], 0 | 1}), set(), non_neg_integer()) -> - {set(), 0 | 1}. +-spec on_bucket(fun((_) -> {[_], 0 | 1}), set(E), non_neg_integer()) -> + {set(E), 0 | 1}. on_bucket(F, T, Slot) -> SegI = ((Slot-1) div ?seg_size) + 1, BktI = ((Slot-1) rem ?seg_size) + 1, @@ -351,7 +349,7 @@ put_bucket_s(Segs, Slot, Bkt) -> Seg = setelement(BktI, element(SegI, Segs), Bkt), setelement(SegI, Segs, Seg). --spec maybe_expand(set(), 0 | 1) -> set(). +-spec maybe_expand(set(E), 0 | 1) -> set(E). maybe_expand(T0, Ic) when T0#set.size + Ic > T0#set.exp_size -> T = maybe_expand_segs(T0), %Do we need more segments. N = T#set.n + 1, %Next slot to expand into @@ -369,14 +367,14 @@ maybe_expand(T0, Ic) when T0#set.size + Ic > T0#set.exp_size -> segs = Segs2}; maybe_expand(T, Ic) -> T#set{size = T#set.size + Ic}. --spec maybe_expand_segs(set()) -> set(). +-spec maybe_expand_segs(set(E)) -> set(E). maybe_expand_segs(T) when T#set.n =:= T#set.maxn -> T#set{maxn = 2 * T#set.maxn, bso = 2 * T#set.bso, segs = expand_segs(T#set.segs, T#set.empty)}; maybe_expand_segs(T) -> T. --spec maybe_contract(set(), non_neg_integer()) -> set(). +-spec maybe_contract(set(E), non_neg_integer()) -> set(E). maybe_contract(T, Dc) when T#set.size - Dc < T#set.con_size, T#set.n > ?seg_size -> N = T#set.n, @@ -395,7 +393,7 @@ maybe_contract(T, Dc) when T#set.size - Dc < T#set.con_size, segs = Segs2}); maybe_contract(T, Dc) -> T#set{size = T#set.size - Dc}. --spec maybe_contract_segs(set()) -> set(). +-spec maybe_contract_segs(set(E)) -> set(E). maybe_contract_segs(T) when T#set.n =:= T#set.bso -> T#set{maxn = T#set.maxn div 2, bso = T#set.bso div 2, @@ -422,7 +420,7 @@ mk_seg(16) -> {[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[]}. %% of segments. We special case the powers of 2 upto 32, this should %% catch most case. N.B. the last element in the segments tuple is %% an extra element containing a default empty segment. --spec expand_segs(segs(), seg()) -> segs(). +-spec expand_segs(segs(E), seg()) -> segs(E). expand_segs({B1}, Empty) -> {B1,Empty}; expand_segs({B1,B2}, Empty) -> @@ -440,7 +438,7 @@ expand_segs(Segs, Empty) -> list_to_tuple(tuple_to_list(Segs) ++ lists:duplicate(tuple_size(Segs), Empty)). --spec contract_segs(segs()) -> segs(). +-spec contract_segs(segs(E)) -> segs(E). contract_segs({B1,_}) -> {B1}; contract_segs({B1,B2,_,_}) -> diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index dc450f0ee6..28f37ef8bf 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -22,7 +23,7 @@ -export([whereis_evaluator/0, whereis_evaluator/1]). -export([start_restricted/1, stop_restricted/0]). -export([local_allowed/3, non_local_allowed/3]). --export([prompt_func/1]). +-export([catch_exception/1, prompt_func/1, strings/1]). -define(LINEMAX, 30). -define(CHAR_MAX, 60). @@ -30,6 +31,7 @@ -define(DEF_RESULTS, 20). -define(DEF_CATCH_EXCEPTION, false). -define(DEF_PROMPT_FUNC, default). +-define(DEF_STRINGS, true). -define(RECORDS, shell_records). @@ -57,7 +59,7 @@ start(NoCtrlG) -> start(NoCtrlG, false). start(NoCtrlG, StartSync) -> - code:ensure_loaded(user_default), + _ = code:ensure_loaded(user_default), spawn(fun() -> server(NoCtrlG, StartSync) end). %% Find the pid of the current evaluator process. @@ -128,7 +130,7 @@ start_restricted(RShMod) when is_atom(RShMod) -> error_logger:error_report( lists:flatten( io_lib:fwrite( - <<"Restricted shell module ~w not found: ~p\n">>, + "Restricted shell module ~w not found: ~tp\n", [RShMod,What]))), Error end. @@ -139,16 +141,6 @@ stop_restricted() -> application:unset_env(stdlib, restricted_shell), exit(restricted_shell_stopped). -default_packages() -> - []. -%%% ['erl','erl.lang']. - -default_modules() -> - []. -%%% [{pdict, 'erl.lang.proc.pdict'}, -%%% {keylist, 'erl.lang.list.keylist'}, -%%% {debug, 'erl.system.debug'}]. - -spec server(boolean(), boolean()) -> 'terminated'. server(NoCtrlG, StartSync) -> @@ -183,16 +175,7 @@ server(StartSync) -> end end, %% Our spawner has fixed the process groups. - Bs0 = erl_eval:new_bindings(), - Bs = lists:foldl(fun ({K, V}, D) -> - erl_eval:add_binding({module,K}, V, D) - end, - lists:foldl(fun (P, D) -> - import_all(P, D) - end, - Bs0, default_packages()), - default_modules()), - %% io:fwrite("Imported modules: ~p.\n", [erl_eval:bindings(Bs)]), + Bs = erl_eval:new_bindings(), %% Use an Ets table for record definitions. It takes too long to %% send a huge term to and from the evaluator. Ets makes it @@ -204,7 +187,7 @@ server(StartSync) -> %% Check if we're in user restricted mode. RShErr = case application:get_env(stdlib, restricted_shell) of - {ok,RShMod} -> + {ok,RShMod} when is_atom(RShMod) -> io:fwrite(<<"Restricted ">>, []), case code:ensure_loaded(RShMod) of {module,RShMod} -> @@ -212,6 +195,8 @@ server(StartSync) -> {error,What} -> {RShMod,What} end; + {ok, Term} -> + {Term,not_an_atom}; undefined -> undefined end, @@ -230,9 +215,9 @@ server(StartSync) -> ok; {RShMod2,What2} -> io:fwrite( - <<"Warning! Restricted shell module ~w not found: ~p.\n" - "Only the commands q() and init:stop() will be allowed!\n">>, - [RShMod2,What2]), + ("Warning! Restricted shell module ~w not found: ~tp.\n" + "Only the commands q() and init:stop() will be allowed!\n"), + [RShMod2,What2]), application:set_env(stdlib, restricted_shell, ?MODULE) end, @@ -244,7 +229,7 @@ server_loop(N0, Eval_0, Bs00, RT, Ds00, History0, Results0) -> {Eval_1,Bs0,Ds0,Prompt} = prompt(N, Eval_0, Bs00, RT, Ds00), {Res,Eval0} = get_command(Prompt, Eval_1, Bs0, RT, Ds0), case Res of - {ok,Es0,_EndLine} -> + {ok,Es0} -> case expand_hist(Es0, N) of {ok,Es} -> {V,Eval,Bs,Ds} = shell_cmd(Es, Eval0, Bs0, RT, Ds0, cmd), @@ -263,11 +248,11 @@ server_loop(N0, Eval_0, Bs00, RT, Ds00, History0, Results0) -> end, server_loop(N, Eval, Bs, RT, Ds, History, Results); {error,E} -> - fwrite_severity(benign, <<"~s">>, [E]), + fwrite_severity(benign, <<"~ts">>, [E]), server_loop(N0, Eval0, Bs0, RT, Ds0, History0, Results0) end; - {error,{Line,Mod,What},_EndLine} -> - fwrite_severity(benign, <<"~w: ~s">>, + {error,{Line,Mod,What}} -> + fwrite_severity(benign, <<"~w: ~ts">>, [Line, Mod:format_error(What)]), server_loop(N0, Eval0, Bs0, RT, Ds0, History0, Results0); {error,terminated} -> %Io process terminated @@ -277,20 +262,40 @@ server_loop(N0, Eval_0, Bs00, RT, Ds00, History0, Results0) -> exit(Eval0, kill), {_,Eval,_,_} = shell_rep(Eval0, Bs0, RT, Ds0), server_loop(N0, Eval, Bs0, RT, Ds0, History0, Results0); - {error,tokens} -> %Most probably unicode > 255 + {error,tokens} -> %Most probably character > 255 fwrite_severity(benign, <<"~w: Invalid tokens.">>, [N]), server_loop(N0, Eval0, Bs0, RT, Ds0, History0, Results0); - {eof,_EndLine} -> - fwrite_severity(fatal, <<"Terminating erlang (~w)">>, [node()]), - halt(); eof -> fwrite_severity(fatal, <<"Terminating erlang (~w)">>, [node()]), halt() end. get_command(Prompt, Eval, Bs, RT, Ds) -> - Parse = fun() -> exit(io:parse_erl_exprs(Prompt)) end, + Parse = + fun() -> + exit( + case + io:scan_erl_exprs(group_leader(), Prompt, 1) + of + {ok,Toks,_EndPos} -> + erl_parse:parse_exprs(Toks); + {eof,_EndPos} -> + eof; + {error,ErrorInfo,_EndPos} -> + %% Skip the rest of the line: + Opts = io:getopts(), + TmpOpts = lists:keyreplace(echo, 1, Opts, + {echo, false}), + _ = io:setopts(TmpOpts), + _ = io:get_line(''), + _ = io:setopts(Opts), + {error,ErrorInfo}; + Else -> + Else + end + ) + end, Pid = spawn_link(Parse), get_command1(Pid, Eval, Bs, RT, Ds). @@ -310,7 +315,8 @@ prompt(N, Eval0, Bs0, RT, Ds0) -> case get_prompt_func() of {M,F} -> L = [{history,N}], - C = {call,1,{remote,1,{atom,1,M},{atom,1,F}},[{value,1,L}]}, + A = erl_anno:new(1), + C = {call,A,{remote,A,{atom,A,M},{atom,A,F}},[{value,A,L}]}, {V,Eval,Bs,Ds} = shell_cmd([C], Eval0, Bs0, RT, Ds0, pmt), {Eval,Bs,Ds,case V of {pmt,Val} -> @@ -337,7 +343,7 @@ get_prompt_func() -> end. bad_prompt_func(M) -> - fwrite_severity(benign, <<"Bad prompt function: ~p">>, [M]). + fwrite_severity(benign, "Bad prompt function: ~tp", [M]). default_prompt(N) -> %% Don't bother flattening the list irrespective of what the @@ -367,6 +373,14 @@ expand_expr({bc,L,E,Qs}, C) -> {bc,L,expand_expr(E, C),expand_quals(Qs, C)}; expand_expr({tuple,L,Elts}, C) -> {tuple,L,expand_exprs(Elts, C)}; +expand_expr({map,L,Es}, C) -> + {map,L,expand_exprs(Es, C)}; +expand_expr({map,L,Arg,Es}, C) -> + {map,L,expand_expr(Arg, C),expand_exprs(Es, C)}; +expand_expr({map_field_assoc,L,K,V}, C) -> + {map_field_assoc,L,expand_expr(K, C),expand_expr(V, C)}; +expand_expr({map_field_exact,L,K,V}, C) -> + {map_field_exact,L,expand_expr(K, C),expand_expr(V, C)}; expand_expr({record_index,L,Name,F}, C) -> {record_index,L,Name,expand_expr(F, C)}; expand_expr({record,L,Name,Is}, C) -> @@ -404,7 +418,7 @@ expand_expr({call,_L,{atom,_,v},[N]}, C) -> {_,undefined,_} -> no_command(N); {Ces,V,CommandN} when is_list(Ces) -> - {value,CommandN,V} + {value,erl_anno:new(CommandN),V} end; expand_expr({call,L,F,Args}, C) -> {call,L,expand_expr(F, C),expand_exprs(Args, C)}; @@ -420,6 +434,8 @@ expand_expr({remote,L,M,F}, C) -> {remote,L,expand_expr(M, C),expand_expr(F, C)}; expand_expr({'fun',L,{clauses,Cs}}, C) -> {'fun',L,{clauses,expand_exprs(Cs, C)}}; +expand_expr({named_fun,L,Name,Cs}, C) -> + {named_fun,L,Name,expand_exprs(Cs, C)}; expand_expr({clause,L,H,G,B}, C) -> %% Could expand H and G, but then erl_eval has to be changed as well. {clause,L,H, G, expand_exprs(B, C)}; @@ -453,7 +469,8 @@ expand_bin_elements([{bin_element,L,E,Sz,Ts}|Fs], C) -> no_command(N) -> throw({error, - io_lib:fwrite(<<"~s: command not found">>, [erl_pp:expr(N)])}). + io_lib:fwrite(<<"~ts: command not found">>, + [erl_pp:expr(N, enc())])}). %% add_cmd(Number, Expressions, Value) %% get_cmd(Number, CurrentCommand) @@ -518,7 +535,7 @@ shell_rep(Ev, Bs0, RT, Ds0) -> {shell_rep,Ev,{value,V,Bs,Ds}} -> {V,Ev,Bs,Ds}; {shell_rep,Ev,{command_error,{Line,M,Error}}} -> - fwrite_severity(benign, <<"~w: ~s">>, + fwrite_severity(benign, <<"~w: ~ts">>, [Line, M:format_error(Error)]), {{'EXIT',Error},Ev,Bs0,Ds0}; {shell_req,Ev,get_cmd} -> @@ -570,9 +587,10 @@ report_exception(Class, Severity, {Reason,Stacktrace}, RT) -> I = iolist_size(Tag) + 1, PF = fun(Term, I1) -> pp(Term, I1, RT) end, SF = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end, - io:requests([{put_chars, Tag}, - {put_chars, - lib:format_exception(I, Class, Reason, Stacktrace, SF, PF)}, + Enc = encoding(), + Str = lib:format_exception(I, Class, Reason, Stacktrace, SF, PF, Enc), + io:requests([{put_chars, latin1, Tag}, + {put_chars, unicode, Str}, nl]). start_eval(Bs, RT, Ds) -> @@ -671,7 +689,10 @@ exprs([E0|Es], Bs1, RT, Lf, Ef, Bs0, W) -> if Es =:= [] -> VS = pp(V0, 1, RT), - [io:requests([{put_chars, VS}, nl]) || W =:= cmd], + case W of + cmd -> io:requests([{put_chars, unicode, VS}, nl]); + pmt -> ok + end, %% Don't send the result back if it will be %% discarded anyway. V = if @@ -747,13 +768,15 @@ used_records({call,_,{atom,_,record_info},[A,{atom,_,Name}]}) -> {name, Name, A}; used_records({call,Line,{tuple,_,[M,F]},As}) -> used_records({call,Line,{remote,Line,M,F},As}); +used_records({type,_,record,[{atom,_,Name}|Fs]}) -> + {name, Name, Fs}; used_records(T) when is_tuple(T) -> {expr, tuple_to_list(T)}; used_records(E) -> {expr, E}. fwrite_severity(Severity, S, As) -> - io:fwrite(<<"~s\n">>, [format_severity(Severity, S, As)]). + io:fwrite(<<"~ts\n">>, [format_severity(Severity, S, As)]). format_severity(Severity, S, As) -> add_severity(Severity, io_lib:fwrite(S, As)). @@ -836,16 +859,6 @@ not_restricted(h, []) -> true; not_restricted(b, []) -> true; -not_restricted(which, [_]) -> - true; -not_restricted(import, [_]) -> - true; -not_restricted(import_all, [_]) -> - true; -not_restricted(use, [_]) -> - true; -not_restricted(use_all, [_]) -> - true; not_restricted(history, [_]) -> true; not_restricted(results, [_]) -> @@ -892,7 +905,7 @@ prep_check({call,Line,{atom,_,f},[{var,_,_Name}]}) -> {atom,Line,ok}; prep_check({value,_CommandN,_Val}) -> %% erl_lint cannot handle the history expansion {value,_,_}. - {atom,0,ok}; + {atom,a0(),ok}; prep_check(T) when is_tuple(T) -> list_to_tuple(prep_check(tuple_to_list(T))); prep_check([E | Es]) -> @@ -904,11 +917,11 @@ expand_records([], E0) -> E0; expand_records(UsedRecords, E0) -> RecordDefs = [Def || {_Name,Def} <- UsedRecords], - L = 1, + L = erl_anno:new(1), E = prep_rec(E0), - Forms = RecordDefs ++ [{function,L,foo,0,[{clause,L,[],[],[E]}]}], - [{function,L,foo,0,[{clause,L,[],[],[NE]}]}] = - erl_expand_records:module(Forms, [strict_record_tests]), + Forms0 = RecordDefs ++ [{function,L,foo,0,[{clause,L,[],[],[E]}]}], + Forms = erl_expand_records:module(Forms0, [strict_record_tests]), + {function,L,foo,0,[{clause,L,[],[],[NE]}]} = lists:last(Forms), prep_rec(NE). prep_rec({value,_CommandN,_V}=Value) -> @@ -964,7 +977,7 @@ local_func(rd, [{atom,_,RecName},RecDef0], Bs, _Shell, RT, _Lf, _Ef) -> [RN] = add_records([AttrForm], Bs, RT), {value,RN,Bs}; {error,{_Line,M,ErrDesc}} -> - ErrStr = io_lib:fwrite(<<"~s">>, [M:format_error(ErrDesc)]), + ErrStr = io_lib:fwrite(<<"~ts">>, [M:format_error(ErrDesc)]), exit(lists:flatten(ErrStr)) end; local_func(rd, [_,_], _Bs, _Shell, _RT, _Lf, _Ef) -> @@ -988,11 +1001,8 @@ local_func(rl, [A], Bs0, _Shell, RT, Lf, Ef) -> {value,list_records(record_defs(RT, listify(Recs))),Bs}; local_func(rp, [A], Bs0, _Shell, RT, Lf, Ef) -> {[V],Bs} = expr_list([A], Bs0, Lf, Ef), - W = columns(), - io:requests([{put_chars, - io_lib_pretty:print(V, 1, W, -1, ?CHAR_MAX, - record_print_fun(RT))}, - nl]), + Cs = pp(V, _Column=1, _Depth=-1, RT), + io:requests([{put_chars, unicode, Cs}, nl]), {value,ok,Bs}; local_func(rr, [A], Bs0, _Shell, RT, Lf, Ef) -> {[File],Bs} = expr_list([A], Bs0, Lf, Ef), @@ -1003,47 +1013,6 @@ local_func(rr, [_,_]=As0, Bs0, _Shell, RT, Lf, Ef) -> local_func(rr, [_,_,_]=As0, Bs0, _Shell, RT, Lf, Ef) -> {[File,Sel,Options],Bs} = expr_list(As0, Bs0, Lf, Ef), {value,read_and_add_records(File, Sel, Options, Bs, RT),Bs}; -local_func(which, [{atom,_,M}], Bs, _Shell, _RT, _Lf, _Ef) -> - case erl_eval:binding({module,M}, Bs) of - {value, M1} -> - {value,M1,Bs}; - unbound -> - {value,M,Bs} - end; -local_func(which, [_Other], _Bs, _Shell, _RT, _Lf, _Ef) -> - erlang:raise(error, function_clause, [{shell,which,1}]); -local_func(import, [M], Bs, _Shell, _RT, _Lf, _Ef) -> - case erl_parse:package_segments(M) of - error -> erlang:raise(error, function_clause, [{shell,import,1}]); - M1 -> - Mod = packages:concat(M1), - case packages:is_valid(Mod) of - true -> - Key = list_to_atom(packages:last(Mod)), - Mod1 = list_to_atom(Mod), - {value,ok,erl_eval:add_binding({module,Key}, Mod1, Bs)}; - false -> - exit({{bad_module_name, Mod}, [{shell,import,1}]}) - end - end; -local_func(import_all, [P], Bs0, _Shell, _RT, _Lf, _Ef) -> - case erl_parse:package_segments(P) of - error -> erlang:raise(error, function_clause, [{shell,import_all,1}]); - P1 -> - Name = packages:concat(P1), - case packages:is_valid(Name) of - true -> - Bs1 = import_all(Name, Bs0), - {value,ok,Bs1}; - false -> - exit({{bad_package_name, Name}, - [{shell,import_all,1}]}) - end - end; -local_func(use, [M], Bs, Shell, RT, Lf, Ef) -> - local_func(import, [M], Bs, Shell, RT, Lf, Ef); -local_func(use_all, [M], Bs, Shell, RT, Lf, Ef) -> - local_func(import_all, [M], Bs, Shell, RT, Lf, Ef); local_func(history, [{integer,_,N}], Bs, _Shell, _RT, _Lf, _Ef) -> {value,history(N),Bs}; local_func(history, [_Other], _Bs, _Shell, _RT, _Lf, _Ef) -> @@ -1114,6 +1083,8 @@ record_fields([{record_field,_,{atom,_,Field}} | Fs]) -> [Field | record_fields(Fs)]; record_fields([{record_field,_,{atom,_,Field},_} | Fs]) -> [Field | record_fields(Fs)]; +record_fields([{typed_record_field,Field,_Type} | Fs]) -> + record_fields([Field | Fs]); record_fields([]) -> []. @@ -1166,7 +1137,7 @@ add_records(RAs, Bs0, RT) -> case check_command([], Bs1) of {error,{_Line,M,ErrDesc}} -> %% A source file that has not been compiled. - ErrStr = io_lib:fwrite(<<"~s">>, [M:format_error(ErrDesc)]), + ErrStr = io_lib:fwrite(<<"~ts">>, [M:format_error(ErrDesc)]), exit(lists:flatten(ErrStr)); ok -> true = ets:insert(RT, Recs), @@ -1179,18 +1150,13 @@ listify(E) -> [E]. check_command(Es, Bs) -> - erl_eval:check_command(Es, strip_bindings(Bs)). + erl_eval:check_command(Es, Bs). expr(E, Bs, Lf, Ef) -> - erl_eval:expr(E, strip_bindings(Bs), Lf, Ef). + erl_eval:expr(E, Bs, Lf, Ef). expr_list(Es, Bs, Lf, Ef) -> - erl_eval:expr_list(Es, strip_bindings(Bs), Lf, Ef). - --spec strip_bindings(erl_eval:binding_struct()) -> erl_eval:binding_struct(). - -strip_bindings(Bs) -> - Bs -- [B || {{module,_},_}=B <- Bs]. + erl_eval:expr_list(Es, Bs, Lf, Ef). %% Note that a sequence number is used here to make sure that if a %% record is used by another record, then the first record is parsed @@ -1323,15 +1289,6 @@ record_attrs(Forms) -> %%% End of reading record information from file(s) -import_all(P, Bs0) -> - Ms = packages:find_modules(P), - lists:foldl(fun (M, Bs) -> - Key = list_to_atom(M), - M1 = list_to_atom(packages:concat(P, M)), - erl_eval:add_binding({module,Key}, M1, Bs) - end, - Bs0, Ms). - shell_req(Shell, Req) -> Shell ! {shell_req,self(),Req}, receive @@ -1343,39 +1300,43 @@ list_commands([{{N,command},Es0}, {{N,result}, V} |Ds], RT) -> VS = pp(V, 4, RT), Ns = io_lib:fwrite(<<"~w: ">>, [N]), I = iolist_size(Ns), - io:requests([{put_chars, Ns}, - {format,<<"~s\n">>,[erl_pp:exprs(Es, I, none)]}, + io:requests([{put_chars, latin1, Ns}, + {format,<<"~ts\n">>,[erl_pp:exprs(Es, I, enc())]}, {format,<<"-> ">>,[]}, - {put_chars, VS}, + {put_chars, unicode, VS}, nl]), list_commands(Ds, RT); list_commands([{{N,command},Es0} |Ds], RT) -> Es = prep_list_commands(Es0), Ns = io_lib:fwrite(<<"~w: ">>, [N]), I = iolist_size(Ns), - io:requests([{put_chars, Ns}, - {format,<<"~s\n">>,[erl_pp:exprs(Es, I, none)]}]), + io:requests([{put_chars, latin1, Ns}, + {format,<<"~ts\n">>,[erl_pp:exprs(Es, I, enc())]}]), list_commands(Ds, RT); list_commands([_D|Ds], RT) -> list_commands(Ds, RT); list_commands([], _RT) -> ok. -list_bindings([{{module,M},Val}|Bs], RT) -> - io:fwrite(<<"~p is ~p\n">>, [M,Val]), - list_bindings(Bs, RT); list_bindings([{Name,Val}|Bs], RT) -> case erl_eval:fun_data(Val) of {fun_data,_FBs,FCs0} -> FCs = expand_value(FCs0), % looks nicer - F = {'fun',0,{clauses,FCs}}, - M = {match,0,{var,0,Name},F}, - io:fwrite(<<"~s\n">>, [erl_pp:expr(M)]); + A = a0(), + F = {'fun',A,{clauses,FCs}}, + M = {match,A,{var,A,Name},F}, + io:fwrite(<<"~ts\n">>, [erl_pp:expr(M, enc())]); + {named_fun_data,_FBs,FName,FCs0} -> + FCs = expand_value(FCs0), % looks nicer + A = a0(), + F = {named_fun,A,FName,FCs}, + M = {match,A,{var,A,Name},F}, + io:fwrite(<<"~ts\n">>, [erl_pp:expr(M, enc())]); false -> Namel = io_lib:fwrite(<<"~s = ">>, [Name]), Nl = iolist_size(Namel)+1, ValS = pp(Val, Nl, RT), - io:requests([{put_chars, Namel}, - {put_chars, ValS}, + io:requests([{put_chars, latin1, Namel}, + {put_chars, unicode, ValS}, nl]) end, list_bindings(Bs, RT); @@ -1384,7 +1345,7 @@ list_bindings([], _RT) -> list_records(Records) -> lists:foreach(fun({_Name,Attr}) -> - io:fwrite(<<"~s">>, [erl_pp:attribute(Attr)]) + io:fwrite(<<"~ts">>, [erl_pp:attribute(Attr, enc())]) end, Records). record_defs(RT, Names) -> @@ -1398,13 +1359,18 @@ expand_value(E) -> %% There is no abstract representation of funs. try_abstract(V, CommandN) -> try erl_parse:abstract(V) - catch _:_ -> {call,0,{atom,0,v},[{integer,0,CommandN}]} + catch + _:_ -> + A = a0(), + {call,A,{atom,A,v},[{integer,A,CommandN}]} end. %% Rather than listing possibly huge results the calls to v/1 are shown. prep_list_commands(E) -> - substitute_v1(fun({value,CommandN,_V}) -> - {call,0,{atom,0,v},[{integer,0,CommandN}]} + A = a0(), + substitute_v1(fun({value,Anno,_V}) -> + CommandN = erl_anno:line(Anno), + {call,A,{atom,A,v},[{integer,A,CommandN}]} end, E). substitute_v1(F, {value,_,_}=Value) -> @@ -1416,6 +1382,9 @@ substitute_v1(F, [E | Es]) -> substitute_v1(_F, E) -> E. +a0() -> + erl_anno:new(0). + check_and_get_history_and_results() -> check_env(shell_history_length), check_env(shell_saved_results), @@ -1427,14 +1396,35 @@ get_history_and_results() -> {History, erlang:min(Results, History)}. pp(V, I, RT) -> - io_lib_pretty:print(V, I, columns(), ?LINEMAX, ?CHAR_MAX, - record_print_fun(RT)). + pp(V, I, _Depth=?LINEMAX, RT). + +pp(V, I, D, RT) -> + Strings = + case application:get_env(stdlib, shell_strings) of + {ok, false} -> + false; + _ -> + true + end, + io_lib_pretty:print(V, ([{column, I}, {line_length, columns()}, + {depth, D}, {max_chars, ?CHAR_MAX}, + {strings, Strings}, + {record_print_fun, record_print_fun(RT)}] + ++ enc())). columns() -> case io:columns() of {ok,N} -> N; _ -> 80 end. +encoding() -> + [{encoding, Encoding}] = enc(), + Encoding. +enc() -> + case lists:keyfind(encoding, 1, io:getopts()) of + false -> [{encoding,latin1}]; % should never happen + Enc -> [Enc] + end. garb(Shell) -> erlang:garbage_collect(Shell), @@ -1457,9 +1447,9 @@ check_env(V) -> {ok, Val} when is_integer(Val), Val >= 0 -> ok; {ok, Val} -> - Txt = io_lib:fwrite( - <<"Invalid value of STDLIB configuration parameter ~p: ~p\n">>, - [V, Val]), + Txt = io_lib:fwrite + ("Invalid value of STDLIB configuration parameter" + "~w: ~tp\n", [V, Val]), error_logger:info_report(lists:flatten(Txt)) end. @@ -1485,14 +1475,22 @@ history(L) when is_integer(L), L >= 0 -> results(L) when is_integer(L), L >= 0 -> set_env(stdlib, shell_saved_results, L, ?DEF_RESULTS). --spec catch_exception(Bool) -> Bool when +-spec catch_exception(Bool) -> boolean() when Bool :: boolean(). catch_exception(Bool) -> set_env(stdlib, shell_catch_exception, Bool, ?DEF_CATCH_EXCEPTION). --spec prompt_func(PromptFunc) -> PromptFunc when - PromptFunc :: 'default' | {module(),atom()}. +-spec prompt_func(PromptFunc) -> PromptFunc2 when + PromptFunc :: 'default' | {module(),atom()}, + PromptFunc2 :: 'default' | {module(),atom()}. prompt_func(String) -> set_env(stdlib, shell_prompt_func, String, ?DEF_PROMPT_FUNC). + +-spec strings(Strings) -> Strings2 when + Strings :: boolean(), + Strings2 :: boolean(). + +strings(Strings) -> + set_env(stdlib, shell_strings, Strings, ?DEF_STRINGS). diff --git a/lib/stdlib/src/shell_default.erl b/lib/stdlib/src/shell_default.erl index 3fe359af0e..6947cf181b 100644 --- a/lib/stdlib/src/shell_default.erl +++ b/lib/stdlib/src/shell_default.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -23,7 +24,7 @@ -module(shell_default). -export([help/0,lc/1,c/1,c/2,nc/1,nl/1,l/1,i/0,pid/3,i/3,m/0,m/1, - memory/0,memory/1, + memory/0,memory/1,uptime/0, erlangrc/1,bi/1, regs/0, flush/0,pwd/0,ls/0,ls/1,cd/1, y/1, y/2, xm/1, bt/1, q/0, @@ -92,6 +93,7 @@ pid(X,Y,Z) -> c:pid(X,Y,Z). pwd() -> c:pwd(). q() -> c:q(). regs() -> c:regs(). +uptime() -> c:uptime(). xm(Mod) -> c:xm(Mod). y(File) -> c:y(File). y(File, Opts) -> c:y(File, Opts). diff --git a/lib/stdlib/src/slave.erl b/lib/stdlib/src/slave.erl index de0179da59..5b5c328c0c 100644 --- a/lib/stdlib/src/slave.erl +++ b/lib/stdlib/src/slave.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -128,7 +129,7 @@ relay1(Pid) -> %% {error, {already_running, Name@Host}} -spec start(Host) -> {ok, Node} | {error, Reason} when - Host :: atom(), + Host :: inet:hostname(), Node :: node(), Reason :: timeout | no_rsh | {already_running, Node}. @@ -138,8 +139,8 @@ start(Host) -> start(Host, Name, [], no_link). -spec start(Host, Name) -> {ok, Node} | {error, Reason} when - Host :: atom(), - Name :: atom(), + Host :: inet:hostname(), + Name :: atom() | string(), Node :: node(), Reason :: timeout | no_rsh | {already_running, Node}. @@ -147,8 +148,8 @@ start(Host, Name) -> start(Host, Name, []). -spec start(Host, Name, Args) -> {ok, Node} | {error, Reason} when - Host :: atom(), - Name :: atom(), + Host :: inet:hostname(), + Name :: atom() | string(), Args :: string(), Node :: node(), Reason :: timeout | no_rsh | {already_running, Node}. @@ -157,7 +158,7 @@ start(Host, Name, Args) -> start(Host, Name, Args, no_link). -spec start_link(Host) -> {ok, Node} | {error, Reason} when - Host :: atom(), + Host :: inet:hostname(), Node :: node(), Reason :: timeout | no_rsh | {already_running, Node}. @@ -167,8 +168,8 @@ start_link(Host) -> start(Host, Name, [], self()). -spec start_link(Host, Name) -> {ok, Node} | {error, Reason} when - Host :: atom(), - Name :: atom(), + Host :: inet:hostname(), + Name :: atom() | string(), Node :: node(), Reason :: timeout | no_rsh | {already_running, Node}. @@ -176,8 +177,8 @@ start_link(Host, Name) -> start_link(Host, Name, []). -spec start_link(Host, Name, Args) -> {ok, Node} | {error, Reason} when - Host :: atom(), - Name :: atom(), + Host :: inet:hostname(), + Name :: atom() | string(), Args :: string(), Node :: node(), Reason :: timeout | no_rsh | {already_running, Node}. @@ -210,7 +211,6 @@ start(Host0, Name, Args, LinkTo, Prog) -> Node :: node(). stop(Node) -> -% io:format("stop(~p)~n", [Node]), rpc:call(Node, erlang, halt, []), ok. @@ -229,7 +229,6 @@ wait_for_slave(Parent, Host, Name, Node, Args, LinkTo, Prog) -> Waiter = register_unique_name(0), case mk_cmd(Host, Name, Args, Waiter, Prog) of {ok, Cmd} -> -%% io:format("Command: ~s~n", [Cmd]), open_port({spawn, Cmd}, [stream]), receive {SlavePid, slave_started} -> @@ -289,7 +288,8 @@ register_unique_name(Number) -> %% If the node should run on the local host, there is %% no need to use rsh. -mk_cmd(Host, Name, Args, Waiter, Prog) -> +mk_cmd(Host, Name, Args, Waiter, Prog0) -> + Prog = quote_progname(Prog0), BasicCmd = lists:concat([Prog, " -detached -noinput -master ", node(), " ", long_or_short(), Name, "@", Host, @@ -309,6 +309,31 @@ mk_cmd(Host, Name, Args, Waiter, Prog) -> end end. +%% This is an attempt to distinguish between spaces in the program +%% path and spaces that separate arguments. The program is quoted to +%% allow spaces in the path. +%% +%% Arguments could exist either if the executable is excplicitly given +%% (through start/5) or if the -program switch to beam is used and +%% includes arguments (typically done by cerl in OTP test environment +%% in order to ensure that slave/peer nodes are started with the same +%% emulator and flags as the test node. The return from lib:progname() +%% could then typically be '/<full_path_to>/cerl -gcov'). +quote_progname(Progname) -> + do_quote_progname(string:tokens(to_list(Progname)," ")). + +do_quote_progname([Prog]) -> + "\""++Prog++"\""; +do_quote_progname([Prog,Arg|Args]) -> + case os:find_executable(Prog) of + false -> + do_quote_progname([Prog++" "++Arg | Args]); + _ -> + %% this one has an executable - we assume the rest are arguments + "\""++Prog++"\""++ + lists:flatten(lists:map(fun(X) -> [" ",X] end, [Arg|Args])) + end. + %% Give the user an opportunity to run another program, %% than the "rsh". On HP-UX rsh is called remsh; thus HP users %% must start erlang as erl -rsh remsh. diff --git a/lib/stdlib/src/sofs.erl b/lib/stdlib/src/sofs.erl index 34eb224647..c244e06ca4 100644 --- a/lib/stdlib/src/sofs.erl +++ b/lib/stdlib/src/sofs.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -620,6 +621,9 @@ canonical_relation(Sets) when ?IS_SET(Sets) -> %%% Functions on binary relations only. %%% +-spec(rel2fam(BinRel) -> Family when + Family :: family(), + BinRel :: binary_relation()). rel2fam(R) -> relation_to_family(R). @@ -1509,7 +1513,7 @@ family_projection(SetFun, F) when ?IS_SET(F) -> %%% -spec(family_to_digraph(Family) -> Graph when - Graph :: digraph(), + Graph :: digraph:graph(), Family :: family()). family_to_digraph(F) when ?IS_SET(F) -> case ?TYPE(F) of @@ -1519,7 +1523,7 @@ family_to_digraph(F) when ?IS_SET(F) -> end. -spec(family_to_digraph(Family, GraphType) -> Graph when - Graph :: digraph(), + Graph :: digraph:graph(), Family :: family(), GraphType :: [digraph:d_type()]). family_to_digraph(F, Type) when ?IS_SET(F) -> @@ -1541,7 +1545,7 @@ family_to_digraph(F, Type) when ?IS_SET(F) -> end. -spec(digraph_to_family(Graph) -> Family when - Graph :: digraph(), + Graph :: digraph:graph(), Family :: family()). digraph_to_family(G) -> case catch digraph_family(G) of @@ -1550,7 +1554,7 @@ digraph_to_family(G) -> end. -spec(digraph_to_family(Graph, Type) -> Family when - Graph :: digraph(), + Graph :: digraph:graph(), Family :: family(), Type :: type()). digraph_to_family(G, T) -> diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index a30685e830..09176d2ca0 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -39,6 +40,7 @@ edlin_expand, epp, eval_bits, + erl_anno, erl_bits, erl_compile, erl_eval, @@ -63,6 +65,7 @@ gen_event, gen_fsm, gen_server, + gen_statem, io, io_lib, io_lib_format, @@ -71,18 +74,19 @@ lib, lists, log_mf_h, + maps, math, ms_transform, orddict, ordsets, otp_internal, - pg, pool, proc_lib, proplists, qlc, qlc_pt, queue, + rand, random, re, sets, @@ -101,5 +105,8 @@ {registered,[timer_server,rsh_starter,take_over_monitor,pool_master, dets]}, {applications, [kernel]}, - {env, []}]}. + {env, []}, + {runtime_dependencies, ["sasl-3.0","kernel-5.0","erts-8.0","crypto-3.3", + "compiler-5.0"]} +]}. diff --git a/lib/stdlib/src/stdlib.appup.src b/lib/stdlib/src/stdlib.appup.src index 94e81188b5..e917b7ea1f 100644 --- a/lib/stdlib/src/stdlib.appup.src +++ b/lib/stdlib/src/stdlib.appup.src @@ -1,27 +1,26 @@ %% -*- erlang -*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% {"%VSN%", - %% Up from - max two major revisions back - [{<<"1\\.18(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R15 - {<<"1\\.17(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R14 - {<<"1\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R13 - %% Down to - max two major revisions back - [{<<"1\\.18(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R15 - {<<"1\\.17(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R14 - {<<"1\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R13 + %% Up from - max one major revision back + [{<<"3\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* + {<<"2\\.[5-8](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-18.* + %% Down to - max one major revision back + [{<<"3\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* + {<<"2\\.[5-8](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-18.* }. diff --git a/lib/stdlib/src/string.erl b/lib/stdlib/src/string.erl index 30eac4f07d..c659db78bd 100644 --- a/lib/stdlib/src/string.erl +++ b/lib/stdlib/src/string.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -29,6 +30,30 @@ %%--------------------------------------------------------------------------- +%%% BIFs + +-export([to_float/1, to_integer/1]). + +-spec to_float(String) -> {Float, Rest} | {error, Reason} when + String :: string(), + Float :: float(), + Rest :: string(), + Reason :: no_float | not_a_list. + +to_float(_) -> + erlang:nif_error(undef). + +-spec to_integer(String) -> {Int, Rest} | {error, Reason} when + String :: string(), + Int :: integer(), + Rest :: string(), + Reason :: no_integer | not_a_list. + +to_integer(_) -> + erlang:nif_error(undef). + +%%% End of BIFs + %% Robert's bit %% len(String) @@ -197,23 +222,47 @@ substr2([_|String], S) -> substr2(String, S-1). Tokens :: [Token :: nonempty_string()]. tokens(S, Seps) -> - tokens1(S, Seps, []). + case Seps of + [] -> + case S of + [] -> []; + [_|_] -> [S] + end; + [C] -> + tokens_single_1(reverse(S), C, []); + [_|_] -> + tokens_multiple_1(reverse(S), Seps, []) + end. -tokens1([C|S], Seps, Toks) -> +tokens_single_1([Sep|S], Sep, Toks) -> + tokens_single_1(S, Sep, Toks); +tokens_single_1([C|S], Sep, Toks) -> + tokens_single_2(S, Sep, Toks, [C]); +tokens_single_1([], _, Toks) -> + Toks. + +tokens_single_2([Sep|S], Sep, Toks, Tok) -> + tokens_single_1(S, Sep, [Tok|Toks]); +tokens_single_2([C|S], Sep, Toks, Tok) -> + tokens_single_2(S, Sep, Toks, [C|Tok]); +tokens_single_2([], _Sep, Toks, Tok) -> + [Tok|Toks]. + +tokens_multiple_1([C|S], Seps, Toks) -> case member(C, Seps) of - true -> tokens1(S, Seps, Toks); - false -> tokens2(S, Seps, Toks, [C]) + true -> tokens_multiple_1(S, Seps, Toks); + false -> tokens_multiple_2(S, Seps, Toks, [C]) end; -tokens1([], _Seps, Toks) -> - reverse(Toks). +tokens_multiple_1([], _Seps, Toks) -> + Toks. -tokens2([C|S], Seps, Toks, Cs) -> +tokens_multiple_2([C|S], Seps, Toks, Tok) -> case member(C, Seps) of - true -> tokens1(S, Seps, [reverse(Cs)|Toks]); - false -> tokens2(S, Seps, Toks, [C|Cs]) + true -> tokens_multiple_1(S, Seps, [Tok|Toks]); + false -> tokens_multiple_2(S, Seps, Toks, [C|Tok]) end; -tokens2([], _Seps, Toks, Cs) -> - reverse([reverse(Cs)|Toks]). +tokens_multiple_2([], _Seps, Toks, Tok) -> + [Tok|Toks]. -spec chars(Character, Number) -> String when Character :: char(), @@ -232,8 +281,8 @@ chars(C, N, Tail) when N > 0 -> chars(C, N-1, [C|Tail]); chars(C, 0, Tail) when is_integer(C) -> Tail. - -%% Torbj�rn's bit. + +%% Torbjörn's bit. %%% COPIES %%% @@ -436,7 +485,7 @@ sub_string(String, Start) -> substr(String, Start). Stop :: pos_integer(). sub_string(String, Start, Stop) -> substr(String, Start, Stop - Start + 1). - + %% ISO/IEC 8859-1 (latin1) letters are converted, others are ignored %% @@ -459,8 +508,8 @@ to_upper_char(C) -> C. -spec to_lower(String) -> Result when - String :: string(), - Result :: string() + String :: io_lib:latin1_string(), + Result :: io_lib:latin1_string() ; (Char) -> CharResult when Char :: char(), CharResult :: char(). @@ -471,8 +520,8 @@ to_lower(C) when is_integer(C) -> to_lower_char(C). -spec to_upper(String) -> Result when - String :: string(), - Result :: string() + String :: io_lib:latin1_string(), + Result :: io_lib:latin1_string() ; (Char) -> CharResult when Char :: char(), CharResult :: char(). diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 7d3c5a0e21..1cd65fbf18 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -25,16 +26,19 @@ start_child/2, restart_child/2, delete_child/2, terminate_child/2, which_children/1, count_children/1, - check_childspecs/1]). + check_childspecs/1, get_childspec/2]). %% Internal exports -export([init/1, handle_call/3, handle_cast/2, handle_info/2, - terminate/2, code_change/3]). + terminate/2, code_change/3, format_status/2]). -export([try_again_restart/2]). +%% For release_handler only +-export([get_callback_module/1]). + %%-------------------------------------------------------------------------- --export_type([child_spec/0, startchild_ret/0, strategy/0]). +-export_type([sup_flags/0, child_spec/0, startchild_ret/0, strategy/0]). %%-------------------------------------------------------------------------- @@ -45,12 +49,21 @@ -type restart() :: 'permanent' | 'transient' | 'temporary'. -type shutdown() :: 'brutal_kill' | timeout(). -type worker() :: 'worker' | 'supervisor'. --type sup_name() :: {'local', Name :: atom()} | {'global', Name :: atom()}. +-type sup_name() :: {'local', Name :: atom()} + | {'global', Name :: atom()} + | {'via', Module :: module(), Name :: any()}. -type sup_ref() :: (Name :: atom()) | {Name :: atom(), Node :: node()} | {'global', Name :: atom()} + | {'via', Module :: module(), Name :: any()} | pid(). --type child_spec() :: {Id :: child_id(), +-type child_spec() :: #{id := child_id(), % mandatory + start := mfargs(), % mandatory + restart => restart(), % optional + shutdown => shutdown(), % optional + type => worker(), % optional + modules => modules()} % optional + | {Id :: child_id(), StartFunc :: mfargs(), Restart :: restart(), Shutdown :: shutdown(), @@ -60,10 +73,29 @@ -type strategy() :: 'one_for_all' | 'one_for_one' | 'rest_for_one' | 'simple_one_for_one'. +-type sup_flags() :: #{strategy => strategy(), % optional + intensity => non_neg_integer(), % optional + period => pos_integer()} % optional + | {RestartStrategy :: strategy(), + Intensity :: non_neg_integer(), + Period :: pos_integer()}. + +%%-------------------------------------------------------------------------- +%% Defaults +-define(default_flags, #{strategy => one_for_one, + intensity => 1, + period => 5}). +-define(default_child_spec, #{restart => permanent, + type => worker}). +%% Default 'shutdown' is 5000 for workers and infinity for supervisors. +%% Default 'modules' is [M], where M comes from the child's start {M,F,A}. + %%-------------------------------------------------------------------------- -record(child, {% pid is undefined when child is not running - pid = undefined :: child() | {restarting,pid()} | [pid()], + pid = undefined :: child() + | {restarting, pid() | undefined} + | [pid()], name :: child_id(), mfargs :: mfargs(), restart_type :: restart(), @@ -72,17 +104,21 @@ modules = [] :: modules()}). -type child_rec() :: #child{}. --define(DICT, dict). +-define(DICTS, dict). +-define(DICT, dict:dict). -define(SETS, sets). --define(SET, set). +-define(SET, sets:set). -record(state, {name, - strategy :: strategy(), + strategy :: strategy() | 'undefined', children = [] :: [child_rec()], - dynamics :: ?DICT() | ?SET(), - intensity :: non_neg_integer(), - period :: pos_integer(), + dynamics :: {'dict', ?DICT(pid(), list())} + | {'set', ?SET(pid())} + | 'undefined', + intensity :: non_neg_integer() | 'undefined', + period :: pos_integer() | 'undefined', restarts = [], + dynamic_restarts = 0 :: non_neg_integer(), module, args}). -type state() :: #state{}. @@ -90,10 +126,7 @@ -define(is_simple(State), State#state.strategy =:= simple_one_for_one). -callback init(Args :: term()) -> - {ok, {{RestartStrategy :: strategy(), - MaxR :: non_neg_integer(), - MaxT :: non_neg_integer()}, - [ChildSpec :: child_spec()]}} + {ok, {SupFlags :: sup_flags(), [ChildSpec :: child_spec()]}} | ignore. -define(restarting(_Pid_), {restarting,_Pid_}). @@ -104,7 +137,9 @@ %%% SupName = {local, atom()} | {global, atom()}. %%% --------------------------------------------------- --type startlink_err() :: {'already_started', pid()} | 'shutdown' | term(). +-type startlink_err() :: {'already_started', pid()} + | {'shutdown', term()} + | term(). -type startlink_ret() :: {'ok', pid()} | 'ignore' | {'error', startlink_err()}. -spec start_link(Module, Args) -> startlink_ret() when @@ -170,6 +205,14 @@ delete_child(Supervisor, Name) -> terminate_child(Supervisor, Name) -> call(Supervisor, {terminate_child, Name}). +-spec get_childspec(SupRef, Id) -> Result when + SupRef :: sup_ref(), + Id :: pid() | child_id(), + Result :: {'ok', child_spec()} | {'error', Error}, + Error :: 'not_found'. +get_childspec(Supervisor, Name) -> + call(Supervisor, {get_childspec, Name}). + -spec which_children(SupRef) -> [{Id,Child,Type,Modules}] when SupRef :: sup_ref(), Id :: child_id() | undefined, @@ -203,7 +246,7 @@ check_childspecs(ChildSpecs) when is_list(ChildSpecs) -> check_childspecs(X) -> {error, {badarg, X}}. %%%----------------------------------------------------------------- -%%% Called by timer:apply_after from restart/2 +%%% Called by restart/2 -spec try_again_restart(SupRef, Child) -> ok when SupRef :: sup_ref(), Child :: child_id() | pid(). @@ -213,6 +256,22 @@ try_again_restart(Supervisor, Child) -> cast(Supervisor, Req) -> gen_server:cast(Supervisor, Req). +%%%----------------------------------------------------------------- +%%% Called by release_handler during upgrade +-spec get_callback_module(Pid) -> Module when + Pid :: pid(), + Module :: atom(). +get_callback_module(Pid) -> + {status, _Pid, {module, _Mod}, + [_PDict, _SysState, _Parent, _Dbg, Misc]} = sys:get_status(Pid), + case lists:keyfind(supervisor, 1, Misc) of + {supervisor, [{"Callback", Mod}]} -> + Mod; + _ -> + [_Header, _Data, {data, [{"State", State}]} | _] = Misc, + State#state.module + end. + %%% --------------------------------------------------- %%% %%% Initialize the supervisor. @@ -221,8 +280,10 @@ cast(Supervisor, Req) -> -type init_sup_name() :: sup_name() | 'self'. --type stop_rsn() :: 'shutdown' | {'bad_return', {module(),'init', term()}} - | {'bad_start_spec', term()} | {'start_spec', term()} +-type stop_rsn() :: {'shutdown', term()} + | {'bad_return', {module(),'init', term()}} + | {'bad_start_spec', term()} + | {'start_spec', term()} | {'supervisor_data', term()}. -spec init({init_sup_name(), module(), [term()]}) -> @@ -253,9 +314,9 @@ init_children(State, StartSpec) -> case start_children(Children, SupName) of {ok, NChildren} -> {ok, State#state{children = NChildren}}; - {error, NChildren} -> - terminate_children(NChildren, SupName), - {stop, shutdown} + {error, NChildren, Reason} -> + _ = terminate_children(NChildren, SupName), + {stop, {shutdown, Reason}} end; Error -> {stop, {start_spec, Error}} @@ -275,9 +336,9 @@ init_dynamic(_State, StartSpec) -> %% Func: start_children/2 %% Args: Children = [child_rec()] in start order %% SupName = {local, atom()} | {global, atom()} | {pid(), Mod} -%% Purpose: Start all children. The new list contains #child's +%% Purpose: Start all children. The new list contains #child's %% with pids. -%% Returns: {ok, NChildren} | {error, NChildren} +%% Returns: {ok, NChildren} | {error, NChildren, Reason} %% NChildren = [child_rec()] in termination order (reversed %% start order) %%----------------------------------------------------------------- @@ -293,7 +354,8 @@ start_children([Child|Chs], NChildren, SupName) -> start_children(Chs, [Child#child{pid = Pid}|NChildren], SupName); {error, Reason} -> report_error(start_error, Reason, Child, SupName), - {error, lists:reverse(Chs) ++ [Child | NChildren]} + {error, lists:reverse(Chs) ++ [Child | NChildren], + {failed_to_start_child,Child#child.name,Reason}} end; start_children([], NChildren, _SupName) -> {ok, NChildren}. @@ -342,7 +404,7 @@ handle_call({start_child, EArgs}, _From, State) when ?is_simple(State) -> #child{mfargs = {M, F, A}} = Child, Args = A ++ EArgs, case do_start_child_i(M, F, Args) of - {ok, undefined} when Child#child.restart_type =:= temporary -> + {ok, undefined} -> {reply, {ok, undefined}, State}; {ok, Pid} -> NState = save_dynamic_child(Child#child.restart_type, Pid, Args, State), @@ -354,6 +416,15 @@ handle_call({start_child, EArgs}, _From, State) when ?is_simple(State) -> {reply, What, State} end; +handle_call({start_child, ChildSpec}, _From, State) -> + case check_childspec(ChildSpec) of + {ok, Child} -> + {Resp, NState} = handle_start_child(Child, State), + {reply, Resp, NState}; + What -> + {reply, {error, What}, State} + end; + %% terminate_child for simple_one_for_one can only be done with pid handle_call({terminate_child, Name}, _From, State) when not is_pid(Name), ?is_simple(State) -> @@ -372,20 +443,10 @@ handle_call({terminate_child, Name}, _From, State) -> {reply, {error, not_found}, State} end; -%%% The requests delete_child and restart_child are invalid for -%%% simple_one_for_one supervisors. -handle_call({_Req, _Data}, _From, State) when ?is_simple(State) -> +%% restart_child request is invalid for simple_one_for_one supervisors +handle_call({restart_child, _Name}, _From, State) when ?is_simple(State) -> {reply, {error, simple_one_for_one}, State}; -handle_call({start_child, ChildSpec}, _From, State) -> - case check_childspec(ChildSpec) of - {ok, Child} -> - {Resp, NState} = handle_start_child(Child, State), - {reply, Resp, NState}; - What -> - {reply, {error, What}, State} - end; - handle_call({restart_child, Name}, _From, State) -> case get_child(Name, State) of {value, Child} when Child#child.pid =:= undefined -> @@ -407,6 +468,10 @@ handle_call({restart_child, Name}, _From, State) -> {reply, {error, not_found}, State} end; +%% delete_child request is invalid for simple_one_for_one supervisors +handle_call({delete_child, _Name}, _From, State) when ?is_simple(State) -> + {reply, {error, simple_one_for_one}, State}; + handle_call({delete_child, Name}, _From, State) -> case get_child(Name, State) of {value, Child} when Child#child.pid =:= undefined -> @@ -420,6 +485,14 @@ handle_call({delete_child, Name}, _From, State) -> {reply, {error, not_found}, State} end; +handle_call({get_childspec, Name}, _From, State) -> + case get_child(Name, State, ?is_simple(State)) of + {value, Child} -> + {reply, {ok, child_to_spec(Child)}, State}; + false -> + {reply, {error, not_found}, State} + end; + handle_call(which_children, _From, #state{children = [#child{restart_type = temporary, child_type = CT, modules = Mods}]} = @@ -434,7 +507,7 @@ handle_call(which_children, _From, #state{children = [#child{restart_type = RTyp State) when ?is_simple(State) -> Reply = lists:map(fun({?restarting(_),_}) -> {undefined,restarting,CT,Mods}; ({Pid, _}) -> {undefined, Pid, CT, Mods} end, - ?DICT:to_list(dynamics_db(RType, State#state.dynamics))), + ?DICTS:to_list(dynamics_db(RType, State#state.dynamics))), {reply, Reply, State}; handle_call(which_children, _From, State) -> @@ -453,39 +526,26 @@ handle_call(which_children, _From, State) -> handle_call(count_children, _From, #state{children = [#child{restart_type = temporary, child_type = CT}]} = State) when ?is_simple(State) -> - {Active, Count} = - ?SETS:fold(fun(Pid, {Alive, Tot}) -> - case is_pid(Pid) andalso is_process_alive(Pid) of - true ->{Alive+1, Tot +1}; - false -> - {Alive, Tot + 1} - end - end, {0, 0}, dynamics_db(temporary, State#state.dynamics)), + Sz = ?SETS:size(dynamics_db(temporary, State#state.dynamics)), Reply = case CT of - supervisor -> [{specs, 1}, {active, Active}, - {supervisors, Count}, {workers, 0}]; - worker -> [{specs, 1}, {active, Active}, - {supervisors, 0}, {workers, Count}] + supervisor -> [{specs, 1}, {active, Sz}, + {supervisors, Sz}, {workers, 0}]; + worker -> [{specs, 1}, {active, Sz}, + {supervisors, 0}, {workers, Sz}] end, {reply, Reply, State}; -handle_call(count_children, _From, #state{children = [#child{restart_type = RType, +handle_call(count_children, _From, #state{dynamic_restarts = Restarts, + children = [#child{restart_type = RType, child_type = CT}]} = State) when ?is_simple(State) -> - {Active, Count} = - ?DICT:fold(fun(Pid, _Val, {Alive, Tot}) -> - case is_pid(Pid) andalso is_process_alive(Pid) of - true -> - {Alive+1, Tot +1}; - false -> - {Alive, Tot + 1} - end - end, {0, 0}, dynamics_db(RType, State#state.dynamics)), + Sz = ?DICTS:size(dynamics_db(RType, State#state.dynamics)), + Active = Sz - Restarts, Reply = case CT of supervisor -> [{specs, 1}, {active, Active}, - {supervisors, Count}, {workers, 0}]; + {supervisors, Sz}, {workers, 0}]; worker -> [{specs, 1}, {active, Active}, - {supervisors, 0}, {workers, Count}] + {supervisors, 0}, {workers, Sz}] end, {reply, Reply, State}; @@ -516,8 +576,8 @@ count_child(#child{pid = Pid, child_type = supervisor}, end. -%%% If a restart attempt failed, this message is sent via -%%% timer:apply_after(0,...) in order to give gen_server the chance to +%%% If a restart attempt failed, this message is cast +%%% from restart/2 in order to give gen_server the chance to %%% check it's inbox before trying again. -spec handle_cast({try_again_restart, child_id() | pid()}, state()) -> {'noreply', state()} | {stop, shutdown, state()}. @@ -526,7 +586,7 @@ handle_cast({try_again_restart,Pid}, #state{children=[Child]}=State) when ?is_simple(State) -> RT = Child#child.restart_type, RPid = restarting(Pid), - case dynamic_child_args(RPid, dynamics_db(RT, State#state.dynamics)) of + case dynamic_child_args(RPid, RT, State#state.dynamics) of {ok, Args} -> {M, F, _} = Child#child.mfargs, NChild = Child#child{pid = RPid, mfargs = {M, F, Args}}, @@ -599,13 +659,11 @@ terminate(_Reason, State) -> code_change(_, State, _) -> case (State#state.module):init(State#state.args) of {ok, {SupFlags, StartSpec}} -> - case catch check_flags(SupFlags) of - ok -> - {Strategy, MaxIntensity, Period} = SupFlags, - update_childspec(State#state{strategy = Strategy, - intensity = MaxIntensity, - period = Period}, - StartSpec); + case set_flags(SupFlags, State) of + {ok, State1} -> + update_childspec(State1, StartSpec); + {invalid_type, SupFlags} -> + {error, {bad_flags, SupFlags}}; % backwards compatibility Error -> {error, Error} end; @@ -615,14 +673,6 @@ code_change(_, State, _) -> Error end. -check_flags({Strategy, MaxIntensity, Period}) -> - validStrategy(Strategy), - validIntensity(MaxIntensity), - validPeriod(Period), - ok; -check_flags(What) -> - {bad_flags, What}. - update_childspec(State, StartSpec) when ?is_simple(State) -> case check_startspec(StartSpec) of {ok, [Child]} -> @@ -694,7 +744,7 @@ handle_start_child(Child, State) -> restart_child(Pid, Reason, #state{children = [Child]} = State) when ?is_simple(State) -> RestartType = Child#child.restart_type, - case dynamic_child_args(Pid, dynamics_db(RestartType, State#state.dynamics)) of + case dynamic_child_args(Pid, RestartType, State#state.dynamics) of {ok, Args} -> {M, F, _} = Child#child.mfargs, NChild = Child#child{pid = Pid, mfargs = {M, F, Args}}, @@ -745,7 +795,10 @@ restart(Child, State) -> Id = if ?is_simple(State) -> Child#child.pid; true -> Child#child.name end, - timer:apply_after(0,?MODULE,try_again_restart,[self(),Id]), + ok = try_again_restart(self(), Id), + {ok,NState2}; + {try_again, NState2, #child{name=ChName}} -> + ok = try_again_restart(self(), ChName), {ok,NState2}; Other -> Other @@ -756,20 +809,31 @@ restart(Child, State) -> {shutdown, remove_child(Child, NState)} end. -restart(simple_one_for_one, Child, State) -> +restart(simple_one_for_one, Child, State0) -> #child{pid = OldPid, mfargs = {M, F, A}} = Child, - Dynamics = ?DICT:erase(OldPid, dynamics_db(Child#child.restart_type, + State = case OldPid of + ?restarting(_) -> + NRes = State0#state.dynamic_restarts - 1, + State0#state{dynamic_restarts = NRes}; + _ -> + State0 + end, + Dynamics = ?DICTS:erase(OldPid, dynamics_db(Child#child.restart_type, State#state.dynamics)), case do_start_child_i(M, F, A) of {ok, Pid} -> - NState = State#state{dynamics = ?DICT:store(Pid, A, Dynamics)}, + DynamicsDb = {dict, ?DICTS:store(Pid, A, Dynamics)}, + NState = State#state{dynamics = DynamicsDb}, {ok, NState}; {ok, Pid, _Extra} -> - NState = State#state{dynamics = ?DICT:store(Pid, A, Dynamics)}, + DynamicsDb = {dict, ?DICTS:store(Pid, A, Dynamics)}, + NState = State#state{dynamics = DynamicsDb}, {ok, NState}; {error, Error} -> - NState = State#state{dynamics = ?DICT:store(restarting(OldPid), A, - Dynamics)}, + NRestarts = State#state.dynamic_restarts + 1, + DynamicsDb = {dict, ?DICTS:store(restarting(OldPid), A, Dynamics)}, + NState = State#state{dynamic_restarts = NRestarts, + dynamics = DynamicsDb}, report_error(start_error, Error, Child, State#state.name), {try_again, NState} end; @@ -793,10 +857,16 @@ restart(rest_for_one, Child, State) -> case start_children(ChAfter2, State#state.name) of {ok, ChAfter3} -> {ok, State#state{children = ChAfter3 ++ ChBefore}}; - {error, ChAfter3} -> + {error, ChAfter3, {failed_to_start_child, ChName, _Reason}} + when ChName =:= Child#child.name -> NChild = Child#child{pid=restarting(Child#child.pid)}, NState = State#state{children = ChAfter3 ++ ChBefore}, - {try_again, replace_child(NChild,NState)} + {try_again, replace_child(NChild,NState)}; + {error, ChAfter3, {failed_to_start_child, ChName, _Reason}} -> + NChild = lists:keyfind(ChName, #child.name, ChAfter3), + NChild2 = NChild#child{pid=?restarting(undefined)}, + NState = State#state{children = ChAfter3 ++ ChBefore}, + {try_again, replace_child(NChild2,NState), NChild2} end; restart(one_for_all, Child, State) -> Children1 = del_child(Child#child.pid, State#state.children), @@ -804,10 +874,16 @@ restart(one_for_all, Child, State) -> case start_children(Children2, State#state.name) of {ok, NChs} -> {ok, State#state{children = NChs}}; - {error, NChs} -> + {error, NChs, {failed_to_start_child, ChName, _Reason}} + when ChName =:= Child#child.name -> NChild = Child#child{pid=restarting(Child#child.pid)}, NState = State#state{children = NChs}, - {try_again, replace_child(NChild,NState)} + {try_again, replace_child(NChild,NState)}; + {error, NChs, {failed_to_start_child, ChName, _Reason}} -> + NChild = lists:keyfind(ChName, #child.name, NChs), + NChild2 = NChild#child{pid=?restarting(undefined)}, + NState = State#state{children = NChs}, + {try_again, replace_child(NChild2,NState), NChild2} end. restarting(Pid) when is_pid(Pid) -> ?restarting(Pid); @@ -828,7 +904,7 @@ terminate_children(Children, SupName) -> %% we do want them to be shut down as many functions from this module %% use this function to just clear everything. terminate_children([Child = #child{restart_type=temporary} | Children], SupName, Res) -> - do_terminate(Child, SupName), + _ = do_terminate(Child, SupName), terminate_children(Children, SupName, Res); terminate_children([Child | Children], SupName, Res) -> NChild = do_terminate(Child, SupName), @@ -949,7 +1025,7 @@ terminate_dynamic_children(Child, Dynamics, SupName) -> wait_dynamic_children(Child, Pids, Sz, TRef, EStack0) end, %% Unroll stacked errors and report them - ?DICT:fold(fun(Reason, Ls, _) -> + ?DICTS:fold(fun(Reason, Ls, _) -> report_error(shutdown_error, Reason, Child#child{pid=Ls}, SupName) end, ok, EStack). @@ -963,22 +1039,22 @@ monitor_dynamic_children(#child{restart_type=temporary}, Dynamics) -> {error, normal} -> {Pids, EStack}; {error, Reason} -> - {Pids, ?DICT:append(Reason, P, EStack)} + {Pids, ?DICTS:append(Reason, P, EStack)} end - end, {?SETS:new(), ?DICT:new()}, Dynamics); + end, {?SETS:new(), ?DICTS:new()}, Dynamics); monitor_dynamic_children(#child{restart_type=RType}, Dynamics) -> - ?DICT:fold(fun(P, _, {Pids, EStack}) when is_pid(P) -> + ?DICTS:fold(fun(P, _, {Pids, EStack}) when is_pid(P) -> case monitor_child(P) of ok -> {?SETS:add_element(P, Pids), EStack}; {error, normal} when RType =/= permanent -> {Pids, EStack}; {error, Reason} -> - {Pids, ?DICT:append(Reason, P, EStack)} + {Pids, ?DICTS:append(Reason, P, EStack)} end; (?restarting(_), _, {Pids, EStack}) -> {Pids, EStack} - end, {?SETS:new(), ?DICT:new()}, Dynamics). + end, {?SETS:new(), ?DICTS:new()}, Dynamics). wait_dynamic_children(_Child, _Pids, 0, undefined, EStack) -> @@ -986,7 +1062,7 @@ wait_dynamic_children(_Child, _Pids, 0, undefined, EStack) -> wait_dynamic_children(_Child, _Pids, 0, TRef, EStack) -> %% If the timer has expired before its cancellation, we must empty the %% mail-box of the 'timeout'-message. - erlang:cancel_timer(TRef), + _ = erlang:cancel_timer(TRef), receive {timeout, TRef, kill} -> EStack @@ -1002,7 +1078,7 @@ wait_dynamic_children(#child{shutdown=brutal_kill} = Child, Pids, Sz, {'DOWN', _MRef, process, Pid, Reason} -> wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, - TRef, ?DICT:append(Reason, Pid, EStack)) + TRef, ?DICTS:append(Reason, Pid, EStack)) end; wait_dynamic_children(#child{restart_type=RType} = Child, Pids, Sz, TRef, EStack) -> @@ -1011,17 +1087,21 @@ wait_dynamic_children(#child{restart_type=RType} = Child, Pids, Sz, wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, TRef, EStack); + {'DOWN', _MRef, process, Pid, {shutdown, _}} -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, EStack); + {'DOWN', _MRef, process, Pid, normal} when RType =/= permanent -> wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, TRef, EStack); {'DOWN', _MRef, process, Pid, Reason} -> wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, - TRef, ?DICT:append(Reason, Pid, EStack)); + TRef, ?DICTS:append(Reason, Pid, EStack)); {timeout, TRef, kill} -> ?SETS:fold(fun(P, _) -> exit(P, kill) end, ok, Pids), - wait_dynamic_children(Child, Pids, Sz-1, undefined, EStack) + wait_dynamic_children(Child, Pids, Sz, undefined, EStack) end. %%----------------------------------------------------------------- @@ -1040,31 +1120,32 @@ save_child(Child, #state{children = Children} = State) -> State#state{children = [Child |Children]}. save_dynamic_child(temporary, Pid, _, #state{dynamics = Dynamics} = State) -> - State#state{dynamics = ?SETS:add_element(Pid, dynamics_db(temporary, Dynamics))}; + DynamicsDb = dynamics_db(temporary, Dynamics), + State#state{dynamics = {set, ?SETS:add_element(Pid, DynamicsDb)}}; save_dynamic_child(RestartType, Pid, Args, #state{dynamics = Dynamics} = State) -> - State#state{dynamics = ?DICT:store(Pid, Args, dynamics_db(RestartType, Dynamics))}. + DynamicsDb = dynamics_db(RestartType, Dynamics), + State#state{dynamics = {dict, ?DICTS:store(Pid, Args, DynamicsDb)}}. dynamics_db(temporary, undefined) -> ?SETS:new(); dynamics_db(_, undefined) -> - ?DICT:new(); -dynamics_db(_,Dynamics) -> - Dynamics. - -dynamic_child_args(Pid, Dynamics) -> - case ?SETS:is_set(Dynamics) of - true -> - {ok, undefined}; - false -> - ?DICT:find(Pid, Dynamics) - end. + ?DICTS:new(); +dynamics_db(_, {_Tag, DynamicsDb}) -> + DynamicsDb. + +dynamic_child_args(_Pid, temporary, _DynamicsDb) -> + {ok, undefined}; +dynamic_child_args(Pid, _RT, {dict, DynamicsDb}) -> + ?DICTS:find(Pid, DynamicsDb); +dynamic_child_args(_Pid, _RT, undefined) -> + error. state_del_child(#child{pid = Pid, restart_type = temporary}, State) when ?is_simple(State) -> NDynamics = ?SETS:del_element(Pid, dynamics_db(temporary, State#state.dynamics)), - State#state{dynamics = NDynamics}; + State#state{dynamics = {set, NDynamics}}; state_del_child(#child{pid = Pid, restart_type = RType}, State) when ?is_simple(State) -> - NDynamics = ?DICT:erase(Pid, dynamics_db(RType, State#state.dynamics)), - State#state{dynamics = NDynamics}; + NDynamics = ?DICTS:erase(Pid, dynamics_db(RType, State#state.dynamics)), + State#state{dynamics = {dict, NDynamics}}; state_del_child(Child, State) -> NChildren = del_child(Child#child.name, State#state.children), State#state{children = NChildren}. @@ -1098,19 +1179,19 @@ split_child(_, [], After) -> get_child(Name, State) -> get_child(Name, State, false). + get_child(Pid, State, AllowPid) when AllowPid, is_pid(Pid) -> get_dynamic_child(Pid, State); get_child(Name, State, _) -> lists:keysearch(Name, #child.name, State#state.children). get_dynamic_child(Pid, #state{children=[Child], dynamics=Dynamics}) -> - DynamicsDb = dynamics_db(Child#child.restart_type, Dynamics), - case is_dynamic_pid(Pid, DynamicsDb) of + case is_dynamic_pid(Pid, Dynamics) of true -> {value, Child#child{pid=Pid}}; false -> RPid = restarting(Pid), - case is_dynamic_pid(RPid, DynamicsDb) of + case is_dynamic_pid(RPid, Dynamics) of true -> {value, Child#child{pid=RPid}}; false -> @@ -1121,13 +1202,12 @@ get_dynamic_child(Pid, #state{children=[Child], dynamics=Dynamics}) -> end end. -is_dynamic_pid(Pid, Dynamics) -> - case ?SETS:is_set(Dynamics) of - true -> - ?SETS:is_element(Pid, Dynamics); - false -> - ?DICT:is_key(Pid, Dynamics) - end. +is_dynamic_pid(Pid, {dict, Dynamics}) -> + ?DICTS:is_key(Pid, Dynamics); +is_dynamic_pid(Pid, {set, Dynamics}) -> + ?SETS:is_element(Pid, Dynamics); +is_dynamic_pid(_Pid, undefined) -> + false. replace_child(Child, State) -> Chs = do_replace_child(Child, State#state.children), @@ -1156,25 +1236,36 @@ remove_child(Child, State) -> %% Returns: {ok, state()} | Error %%----------------------------------------------------------------- init_state(SupName, Type, Mod, Args) -> - case catch init_state1(SupName, Type, Mod, Args) of - {ok, State} -> - {ok, State}; - Error -> - Error + set_flags(Type, #state{name = supname(SupName,Mod), + module = Mod, + args = Args}). + +set_flags(Flags, State) -> + try check_flags(Flags) of + #{strategy := Strategy, intensity := MaxIntensity, period := Period} -> + {ok, State#state{strategy = Strategy, + intensity = MaxIntensity, + period = Period}} + catch + Thrown -> Thrown end. -init_state1(SupName, {Strategy, MaxIntensity, Period}, Mod, Args) -> +check_flags(SupFlags) when is_map(SupFlags) -> + do_check_flags(maps:merge(?default_flags,SupFlags)); +check_flags({Strategy, MaxIntensity, Period}) -> + check_flags(#{strategy => Strategy, + intensity => MaxIntensity, + period => Period}); +check_flags(What) -> + throw({invalid_type, What}). + +do_check_flags(#{strategy := Strategy, + intensity := MaxIntensity, + period := Period} = Flags) -> validStrategy(Strategy), validIntensity(MaxIntensity), validPeriod(Period), - {ok, #state{name = supname(SupName,Mod), - strategy = Strategy, - intensity = MaxIntensity, - period = Period, - module = Mod, - args = Args}}; -init_state1(_SupName, Type, _, _) -> - {invalid_type, Type}. + Flags. validStrategy(simple_one_for_one) -> true; validStrategy(one_for_one) -> true; @@ -1195,14 +1286,7 @@ supname(N, _) -> N. %%% ------------------------------------------------------ %%% Check that the children start specification is valid. -%%% Shall be a six (6) tuple -%%% {Name, Func, RestartType, Shutdown, ChildType, Modules} -%%% where Name is an atom -%%% Func is {Mod, Fun, Args} == {atom(), atom(), list()} -%%% RestartType is permanent | temporary | transient -%%% Shutdown = integer() > 0 | infinity | brutal_kill -%%% ChildType = supervisor | worker -%%% Modules = [atom()] | dynamic +%%% Input: [child_spec()] %%% Returns: {ok, [child_rec()]} | Error %%% ------------------------------------------------------ @@ -1212,6 +1296,9 @@ check_startspec([ChildSpec|T], Res) -> case check_childspec(ChildSpec) of {ok, Child} -> case lists:keymember(Child#child.name, #child.name, Res) of + %% The error message duplicate_child_name is kept for + %% backwards compatibility, although + %% duplicate_child_id would be more correct. true -> {duplicate_child_name, Child#child.name}; false -> check_startspec(T, [Child | Res]) end; @@ -1220,16 +1307,41 @@ check_startspec([ChildSpec|T], Res) -> check_startspec([], Res) -> {ok, lists:reverse(Res)}. +check_childspec(ChildSpec) when is_map(ChildSpec) -> + catch do_check_childspec(maps:merge(?default_child_spec,ChildSpec)); check_childspec({Name, Func, RestartType, Shutdown, ChildType, Mods}) -> - catch check_childspec(Name, Func, RestartType, Shutdown, ChildType, Mods); + check_childspec(#{id => Name, + start => Func, + restart => RestartType, + shutdown => Shutdown, + type => ChildType, + modules => Mods}); check_childspec(X) -> {invalid_child_spec, X}. -check_childspec(Name, Func, RestartType, Shutdown, ChildType, Mods) -> +do_check_childspec(#{restart := RestartType, + type := ChildType} = ChildSpec)-> + Name = case ChildSpec of + #{id := N} -> N; + _ -> throw(missing_id) + end, + Func = case ChildSpec of + #{start := F} -> F; + _ -> throw(missing_start) + end, validName(Name), validFunc(Func), validRestartType(RestartType), validChildType(ChildType), - validShutdown(Shutdown, ChildType), + Shutdown = case ChildSpec of + #{shutdown := S} -> S; + #{type := worker} -> 5000; + #{type := supervisor} -> infinity + end, + validShutdown(Shutdown), + Mods = case ChildSpec of + #{modules := Ms} -> Ms; + _ -> {M,_,_} = Func, [M] + end, validMods(Mods), {ok, #child{name = Name, mfargs = Func, restart_type = RestartType, shutdown = Shutdown, child_type = ChildType, modules = Mods}}. @@ -1250,11 +1362,11 @@ validRestartType(temporary) -> true; validRestartType(transient) -> true; validRestartType(RestartType) -> throw({invalid_restart_type, RestartType}). -validShutdown(Shutdown, _) +validShutdown(Shutdown) when is_integer(Shutdown), Shutdown > 0 -> true; -validShutdown(infinity, _) -> true; -validShutdown(brutal_kill, _) -> true; -validShutdown(Shutdown, _) -> throw({invalid_shutdown, Shutdown}). +validShutdown(infinity) -> true; +validShutdown(brutal_kill) -> true; +validShutdown(Shutdown) -> throw({invalid_shutdown, Shutdown}). validMods(dynamic) -> true; validMods(Mods) when is_list(Mods) -> @@ -1267,6 +1379,19 @@ validMods(Mods) when is_list(Mods) -> Mods); validMods(Mods) -> throw({invalid_modules, Mods}). +child_to_spec(#child{name = Name, + mfargs = Func, + restart_type = RestartType, + shutdown = Shutdown, + child_type = ChildType, + modules = Mods}) -> + #{id => Name, + start => Func, + restart => RestartType, + shutdown => Shutdown, + type => ChildType, + modules => Mods}. + %%% ------------------------------------------------------ %%% Add a new restart and calculate if the max restart %%% intensity has been reached (in that case the supervisor @@ -1280,7 +1405,7 @@ add_restart(State) -> I = State#state.intensity, P = State#state.period, R = State#state.restarts, - Now = erlang:now(), + Now = erlang:monotonic_time(1), R1 = add_restart([Now|R], Now, P), State1 = State#state{restarts = R1}, case length(R1) of @@ -1300,26 +1425,8 @@ add_restart([R|Restarts], Now, Period) -> add_restart([], _, _) -> []. -inPeriod(Time, Now, Period) -> - case difference(Time, Now) of - T when T > Period -> - false; - _ -> - true - end. - -%% -%% Time = {MegaSecs, Secs, MicroSecs} (NOTE: MicroSecs is ignored) -%% Calculate the time elapsed in seconds between two timestamps. -%% If MegaSecs is equal just subtract Secs. -%% Else calculate the Mega difference and add the Secs difference, -%% note that Secs difference can be negative, e.g. -%% {827, 999999, 676} diff {828, 1, 653753} == > 2 secs. -%% -difference({TimeM, TimeS, _}, {CurM, CurS, _}) when CurM > TimeM -> - ((CurM - TimeM) * 1000000) + (CurS - TimeS); -difference({_, TimeS, _}, {_, CurS, _}) -> - CurS - TimeS. +inPeriod(Then, Now, Period) -> + Now =< Then + Period. %%% ------------------------------------------------------ %%% Error and progress reporting. @@ -1335,14 +1442,14 @@ report_error(Error, Reason, Child, SupName) -> extract_child(Child) when is_list(Child#child.pid) -> [{nb_children, length(Child#child.pid)}, - {name, Child#child.name}, + {id, Child#child.name}, {mfargs, Child#child.mfargs}, {restart_type, Child#child.restart_type}, {shutdown, Child#child.shutdown}, {child_type, Child#child.child_type}]; extract_child(Child) -> [{pid, Child#child.pid}, - {name, Child#child.name}, + {id, Child#child.name}, {mfargs, Child#child.mfargs}, {restart_type, Child#child.restart_type}, {shutdown, Child#child.shutdown}, @@ -1352,3 +1459,9 @@ report_progress(Child, SupName) -> Progress = [{supervisor, SupName}, {started, extract_child(Child)}], error_logger:info_report(progress, Progress). + +format_status(terminate, [_PDict, State]) -> + State; +format_status(_, [_PDict, State]) -> + [{data, [{"State", State}]}, + {supervisor, [{"Callback", State#state.module}]}]. diff --git a/lib/stdlib/src/supervisor_bridge.erl b/lib/stdlib/src/supervisor_bridge.erl index e8405ab9a4..af1e046d30 100644 --- a/lib/stdlib/src/supervisor_bridge.erl +++ b/lib/stdlib/src/supervisor_bridge.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -101,7 +102,16 @@ handle_cast(_, State) -> {noreply, State}. handle_info({'EXIT', Pid, Reason}, State) when State#state.pid =:= Pid -> - report_error(child_terminated, Reason, State), + case Reason of + normal -> + ok; + shutdown -> + ok; + {shutdown, _Term} -> + ok; + _ -> + report_error(child_terminated, Reason, State) + end, {stop, Reason, State#state{pid = undefined}}; handle_info(_, State) -> {noreply, State}. diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl index f34201604c..a6ecf03716 100644 --- a/lib/stdlib/src/sys.erl +++ b/lib/stdlib/src/sys.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -21,7 +22,10 @@ %% External exports -export([suspend/1, suspend/2, resume/1, resume/2, get_status/1, get_status/2, + get_state/1, get_state/2, + replace_state/2, replace_state/3, change_code/4, change_code/5, + terminate/2, terminate/3, log/2, log/3, trace/2, trace/3, statistics/2, statistics/3, log_to_file/2, log_to_file/3, no_debug/1, no_debug/2, install/2, install/3, remove/2, remove/3]). @@ -32,37 +36,52 @@ %% Types %%----------------------------------------------------------------- +-export_type([dbg_opt/0]). + -type name() :: pid() | atom() | {'global', atom()}. -type system_event() :: {'in', Msg :: _} | {'in', Msg :: _, From :: _} | {'out', Msg :: _, To :: _} | term(). --opaque dbg_opt() :: list(). +-opaque dbg_opt() :: {'trace', 'true'} + | {'log', + {N :: non_neg_integer(), + [{Event :: system_event(), + FuncState :: _, + FormFunc :: format_fun()}]}} + | {'statistics', {file:date_time(), + {'reductions', non_neg_integer()}, + MessagesIn :: non_neg_integer(), + MessagesOut :: non_neg_integer()}} + | {'log_to_file', file:io_device()} + | {Func :: dbg_fun(), FuncState :: term()}. -type dbg_fun() :: fun((FuncState :: _, Event :: system_event(), ProcState :: _) -> 'done' | (NewFuncState :: _)). +-type format_fun() :: fun((Device :: io:device() | file:io_device(), + Event :: system_event(), + Extra :: term()) -> any()). + %%----------------------------------------------------------------- %% System messages %%----------------------------------------------------------------- --spec suspend(Name) -> Void when - Name :: name(), - Void :: term(). +-spec suspend(Name) -> 'ok' when + Name :: name(). suspend(Name) -> send_system_msg(Name, suspend). --spec suspend(Name, Timeout) -> Void when + +-spec suspend(Name, Timeout) -> 'ok' when Name :: name(), - Timeout :: timeout(), - Void :: term(). + Timeout :: timeout(). suspend(Name, Timeout) -> send_system_msg(Name, suspend, Timeout). --spec resume(Name) -> Void when - Name :: name(), - Void :: term(). +-spec resume(Name) -> 'ok' when + Name :: name(). resume(Name) -> send_system_msg(Name, resume). --spec resume(Name, Timeout) -> Void when + +-spec resume(Name, Timeout) -> 'ok' when Name :: name(), - Timeout :: timeout(), - Void :: term(). + Timeout :: timeout(). resume(Name, Timeout) -> send_system_msg(Name, resume, Timeout). -spec get_status(Name) -> Status when @@ -71,9 +90,10 @@ resume(Name, Timeout) -> send_system_msg(Name, resume, Timeout). SItem :: (PDict :: [{Key :: term(), Value :: term()}]) | (SysState :: 'running' | 'suspended') | (Parent :: pid()) - | (Dbg :: dbg_opt()) + | (Dbg :: [dbg_opt()]) | (Misc :: term()). get_status(Name) -> send_system_msg(Name, get_status). + -spec get_status(Name, Timeout) -> Status when Name :: name(), Timeout :: timeout(), @@ -81,10 +101,50 @@ get_status(Name) -> send_system_msg(Name, get_status). SItem :: (PDict :: [{Key :: term(), Value :: term()}]) | (SysState :: 'running' | 'suspended') | (Parent :: pid()) - | (Dbg :: dbg_opt()) + | (Dbg :: [dbg_opt()]) | (Misc :: term()). get_status(Name, Timeout) -> send_system_msg(Name, get_status, Timeout). +-spec get_state(Name) -> State when + Name :: name(), + State :: term(). +get_state(Name) -> + case send_system_msg(Name, get_state) of + {error, Reason} -> error(Reason); + State -> State + end. + +-spec get_state(Name, Timeout) -> State when + Name :: name(), + Timeout :: timeout(), + State :: term(). +get_state(Name, Timeout) -> + case send_system_msg(Name, get_state, Timeout) of + {error, Reason} -> error(Reason); + State -> State + end. + +-spec replace_state(Name, StateFun) -> NewState when + Name :: name(), + StateFun :: fun((State :: term()) -> NewState :: term()), + NewState :: term(). +replace_state(Name, StateFun) -> + case send_system_msg(Name, {replace_state, StateFun}) of + {error, Reason} -> error(Reason); + State -> State + end. + +-spec replace_state(Name, StateFun, Timeout) -> NewState when + Name :: name(), + StateFun :: fun((State :: term()) -> NewState :: term()), + Timeout :: timeout(), + NewState :: term(). +replace_state(Name, StateFun, Timeout) -> + case send_system_msg(Name, {replace_state, StateFun}, Timeout) of + {error, Reason} -> error(Reason); + State -> State + end. + -spec change_code(Name, Module, OldVsn, Extra) -> 'ok' | {error, Reason} when Name :: name(), Module :: module(), @@ -93,6 +153,7 @@ get_status(Name, Timeout) -> send_system_msg(Name, get_status, Timeout). Reason :: term(). change_code(Name, Mod, Vsn, Extra) -> send_system_msg(Name, {change_code, Mod, Vsn, Extra}). + -spec change_code(Name, Module, OldVsn, Extra, Timeout) -> 'ok' | {error, Reason} when Name :: name(), @@ -104,6 +165,19 @@ change_code(Name, Mod, Vsn, Extra) -> change_code(Name, Mod, Vsn, Extra, Timeout) -> send_system_msg(Name, {change_code, Mod, Vsn, Extra}, Timeout). +-spec terminate(Name, Reason) -> 'ok' when + Name :: name(), + Reason :: term(). +terminate(Name, Reason) -> + send_system_msg(Name, {terminate, Reason}). + +-spec terminate(Name, Reason, Timeout) -> 'ok' when + Name :: name(), + Reason :: term(), + Timeout :: timeout(). +terminate(Name, Reason, Timeout) -> + send_system_msg(Name, {terminate, Reason}, Timeout). + %%----------------------------------------------------------------- %% Debug commands %%----------------------------------------------------------------- @@ -189,35 +263,33 @@ no_debug(Name) -> send_system_msg(Name, {debug, no_debug}). Timeout :: timeout(). no_debug(Name, Timeout) -> send_system_msg(Name, {debug, no_debug}, Timeout). --spec install(Name, FuncSpec) -> Void when +-spec install(Name, FuncSpec) -> 'ok' when Name :: name(), FuncSpec :: {Func, FuncState}, Func :: dbg_fun(), - FuncState :: term(), - Void :: term(). + FuncState :: term(). install(Name, {Func, FuncState}) -> send_system_msg(Name, {debug, {install, {Func, FuncState}}}). --spec install(Name, FuncSpec, Timeout) -> Void when + +-spec install(Name, FuncSpec, Timeout) -> 'ok' when Name :: name(), FuncSpec :: {Func, FuncState}, Func :: dbg_fun(), FuncState :: term(), - Timeout :: timeout(), - Void :: term(). + Timeout :: timeout(). install(Name, {Func, FuncState}, Timeout) -> send_system_msg(Name, {debug, {install, {Func, FuncState}}}, Timeout). --spec remove(Name, Func) -> Void when +-spec remove(Name, Func) -> 'ok' when Name :: name(), - Func :: dbg_fun(), - Void :: term(). + Func :: dbg_fun(). remove(Name, Func) -> send_system_msg(Name, {debug, {remove, Func}}). --spec remove(Name, Func, Timeout) -> Void when + +-spec remove(Name, Func, Timeout) -> 'ok' when Name :: name(), Func :: dbg_fun(), - Timeout :: timeout(), - Void :: term(). + Timeout :: timeout(). remove(Name, Func, Timeout) -> send_system_msg(Name, {debug, {remove, Func}}, Timeout). @@ -241,39 +313,36 @@ mfa(Name, {debug, {Func, Arg2}}) -> {sys, Func, [Name, Arg2]}; mfa(Name, {change_code, Mod, Vsn, Extra}) -> {sys, change_code, [Name, Mod, Vsn, Extra]}; +mfa(Name, {terminate, Reason}) -> + {sys, terminate, [Name, Reason]}; mfa(Name, Atom) -> {sys, Atom, [Name]}. + mfa(Name, Req, Timeout) -> {M, F, A} = mfa(Name, Req), {M, F, A ++ [Timeout]}. %%----------------------------------------------------------------- %% Func: handle_system_msg/6 -%% Args: Msg ::= term() -%% From ::= {pid(),Ref} but don't count on that -%% Parent ::= pid() -%% Module ::= atom() -%% Debug ::= [debug_opts()] -%% Misc ::= term() %% Purpose: Used by a process module that wishes to take care of %% system messages. The process receives a {system, From, %% Msg} message, and passes the Msg to this function. %% Returns: This function *never* returns! It calls the function %% Module:system_continue(Parent, NDebug, Misc) %% there the process continues the execution or -%% Module:system_terminate(Raeson, Parent, Debug, Misc) if +%% Module:system_terminate(Reason, Parent, Debug, Misc) if %% the process should terminate. %% The Module must export system_continue/3, system_terminate/4 %% and format_status/2 for status information. %%----------------------------------------------------------------- --spec handle_system_msg(Msg, From, Parent, Module, Debug, Misc) -> Void when +-spec handle_system_msg(Msg, From, Parent, Module, Debug, Misc) -> + no_return() when Msg :: term(), From :: {pid(), Tag :: _}, Parent :: pid(), Module :: module(), Debug :: [dbg_opt()], - Misc :: term(), - Void :: term(). + Misc :: term(). handle_system_msg(Msg, From, Parent, Module, Debug, Misc) -> handle_system_msg(running, Msg, From, Parent, Module, Debug, Misc, false). @@ -283,26 +352,25 @@ handle_system_msg(Msg, From, Parent, Mod, Debug, Misc, Hib) -> handle_system_msg(SysState, Msg, From, Parent, Mod, Debug, Misc, Hib) -> case do_cmd(SysState, Msg, Parent, Mod, Debug, Misc) of {suspended, Reply, NDebug, NMisc} -> - gen:reply(From, Reply), + _ = gen:reply(From, Reply), suspend_loop(suspended, Parent, Mod, NDebug, NMisc, Hib); {running, Reply, NDebug, NMisc} -> - gen:reply(From, Reply), - Mod:system_continue(Parent, NDebug, NMisc) + _ = gen:reply(From, Reply), + Mod:system_continue(Parent, NDebug, NMisc); + {{terminating, Reason}, Reply, NDebug, NMisc} -> + _ = gen:reply(From, Reply), + Mod:system_terminate(Reason, Parent, NDebug, NMisc) end. %%----------------------------------------------------------------- %% Func: handle_debug/4 -%% Args: Debug ::= [debug_opts()] -%% Func ::= {M,F} | fun() arity 3 -%% State ::= term() -%% Event ::= {in, Msg} | {in, Msg, From} | {out, Msg, To} | term() %% Purpose: Called by a process that wishes to debug an event. %% Func is a formatting function, called as Func(Device, Event). %% Returns: [debug_opts()] %%----------------------------------------------------------------- -spec handle_debug(Debug, FormFunc, Extra, Event) -> [dbg_opt()] when Debug :: [dbg_opt()], - FormFunc :: dbg_fun(), + FormFunc :: format_fun(), Extra :: term(), Event :: system_event(). handle_debug([{trace, true} | T], FormFunc, State, Event) -> @@ -360,12 +428,19 @@ do_cmd(_, suspend, _Parent, _Mod, Debug, Misc) -> {suspended, ok, Debug, Misc}; do_cmd(_, resume, _Parent, _Mod, Debug, Misc) -> {running, ok, Debug, Misc}; +do_cmd(SysState, get_state, _Parent, Mod, Debug, Misc) -> + {SysState, do_get_state(Mod, Misc), Debug, Misc}; +do_cmd(SysState, {replace_state, StateFun}, _Parent, Mod, Debug, Misc) -> + {Res, NMisc} = do_replace_state(StateFun, Mod, Misc), + {SysState, Res, Debug, NMisc}; do_cmd(SysState, get_status, Parent, Mod, Debug, Misc) -> Res = get_status(SysState, Parent, Mod, Debug, Misc), {SysState, Res, Debug, Misc}; do_cmd(SysState, {debug, What}, _Parent, _Mod, Debug, Misc) -> {Res, NDebug} = debug_cmd(What, Debug), {SysState, Res, NDebug, Misc}; +do_cmd(_, {terminate, Reason}, _Parent, _Mod, Debug, Misc) -> + {{terminating, Reason}, ok, Debug, Misc}; do_cmd(suspended, {change_code, Module, Vsn, Extra}, _Parent, Mod, Debug, Misc) -> {Res, NMisc} = do_change_code(Mod, Module, Vsn, Extra, Misc), @@ -373,6 +448,40 @@ do_cmd(suspended, {change_code, Module, Vsn, Extra}, _Parent, do_cmd(SysState, Other, _Parent, _Mod, Debug, Misc) -> {SysState, {error, {unknown_system_msg, Other}}, Debug, Misc}. +do_get_state(Mod, Misc) -> + case erlang:function_exported(Mod, system_get_state, 1) of + true -> + try + {ok, State} = Mod:system_get_state(Misc), + State + catch + Cl:Exc -> + {error, {callback_failed,{Mod,system_get_state},{Cl,Exc}}} + end; + false -> + Misc + end. + +do_replace_state(StateFun, Mod, Misc) -> + case erlang:function_exported(Mod, system_replace_state, 2) of + true -> + try + {ok, State, NMisc} = Mod:system_replace_state(StateFun, Misc), + {State, NMisc} + catch + Cl:Exc -> + {{error, {callback_failed,{Mod,system_replace_state},{Cl,Exc}}}, Misc} + end; + false -> + try + NMisc = StateFun(Misc), + {NMisc, NMisc} + catch + Cl:Exc -> + {{error, {callback_failed,StateFun,{Cl,Exc}}}, Misc} + end + end. + get_status(SysState, Parent, Mod, Debug, Misc) -> PDict = get(), FmtMisc = @@ -451,6 +560,7 @@ print_event(Dev, {Event, State, FormFunc}) -> FormFunc(Dev, Event, State). init_stat() -> {erlang:localtime(), process_info(self(), reductions), 0, 0}. + get_stat({Time, {reductions, Reds}, In, Out}) -> {reductions, Reds2} = process_info(self(), reductions), [{start_time, Time}, {current_time, erlang:localtime()}, @@ -490,9 +600,8 @@ get_debug2(Item, Debug, Default) -> _ -> Default end. --spec print_log(Debug) -> Void when - Debug :: [dbg_opt()], - Void :: term(). +-spec print_log(Debug) -> 'ok' when + Debug :: [dbg_opt()]. print_log(Debug) -> {_N, Logs} = get_debug(log, Debug, {0, []}), lists:foreach(fun print_event/1, @@ -509,8 +618,6 @@ close_log_file(Debug) -> %%----------------------------------------------------------------- %% Func: debug_options/1 -%% Args: [trace|log|{log,N}|statistics|{log_to_file, FileName}| -%% {install, {Func, FuncState}}] %% Purpose: Initiate a debug structure. Called by a process that %% wishes to initiate the debug structure without the %% system messages. @@ -519,7 +626,11 @@ close_log_file(Debug) -> -spec debug_options(Options) -> [dbg_opt()] when Options :: [Opt], - Opt :: 'trace' | 'log' | 'statistics' | {'log_to_file', FileName} + Opt :: 'trace' + | 'log' + | {'log', pos_integer()} + | 'statistics' + | {'log_to_file', FileName} | {'install', FuncSpec}, FileName :: file:name(), FuncSpec :: {Func, FuncState}, @@ -527,6 +638,7 @@ close_log_file(Debug) -> FuncState :: term(). debug_options(Options) -> debug_options(Options, []). + debug_options([trace | T], Debug) -> debug_options(T, install_debug(trace, true, Debug)); debug_options([log | T], Debug) -> diff --git a/lib/stdlib/src/timer.erl b/lib/stdlib/src/timer.erl index 689e42051f..ca868627a9 100644 --- a/lib/stdlib/src/timer.erl +++ b/lib/stdlib/src/timer.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -161,10 +162,11 @@ sleep(T) -> Time :: integer(), Value :: term(). tc(F) -> - Before = os:timestamp(), + T1 = erlang:monotonic_time(), Val = F(), - After = os:timestamp(), - {now_diff(After, Before), Val}. + T2 = erlang:monotonic_time(), + Time = erlang:convert_time_unit(T2 - T1, native, micro_seconds), + {Time, Val}. %% %% Measure the execution time (in microseconds) for Fun(Args). @@ -175,10 +177,11 @@ tc(F) -> Time :: integer(), Value :: term(). tc(F, A) -> - Before = os:timestamp(), + T1 = erlang:monotonic_time(), Val = apply(F, A), - After = os:timestamp(), - {now_diff(After, Before), Val}. + T2 = erlang:monotonic_time(), + Time = erlang:convert_time_unit(T2 - T1, native, micro_seconds), + {Time, Val}. %% %% Measure the execution time (in microseconds) for an MFA. @@ -190,10 +193,11 @@ tc(F, A) -> Time :: integer(), Value :: term(). tc(M, F, A) -> - Before = os:timestamp(), + T1 = erlang:monotonic_time(), Val = apply(M, F, A), - After = os:timestamp(), - {now_diff(After, Before), Val}. + T2 = erlang:monotonic_time(), + Time = erlang:convert_time_unit(T2 - T1, native, micro_seconds), + {Time, Val}. %% %% Calculate the time difference (in microseconds) of two @@ -258,7 +262,7 @@ ensure_started() -> undefined -> C = {timer_server, {?MODULE, start_link, []}, permanent, 1000, worker, [?MODULE]}, - supervisor:start_child(kernel_safe_sup, C), % kernel_safe_sup + _ = supervisor:start_child(kernel_safe_sup, C), ok; _ -> ok end. @@ -354,7 +358,7 @@ timer_timeout(SysTime) -> '$end_of_table' -> infinity; {Time, _Ref} when Time > SysTime -> - Timeout = (Time - SysTime) div 1000, + Timeout = (Time - SysTime + 999) div 1000, %% Returned timeout must fit in a small int erlang:min(Timeout, ?MAX_TIMEOUT); Key -> @@ -414,7 +418,7 @@ next_timeout() -> '$end_of_table' -> infinity; {Time, _} -> - erlang:min(positive((Time - system_time()) div 1000), ?MAX_TIMEOUT) + erlang:min(positive((Time - system_time() + 999) div 1000), ?MAX_TIMEOUT) end. %% Help functions @@ -437,10 +441,8 @@ positive(X) -> %% %% system_time() -> time in microseconds %% -system_time() -> - {M,S,U} = erlang:now(), - 1000000 * (M*1000000 + S) + U. - +system_time() -> + erlang:monotonic_time(1000000). send([Pid, Msg]) -> Pid ! Msg. diff --git a/lib/stdlib/src/unicode.erl b/lib/stdlib/src/unicode.erl index e9b90befe6..617da11ba8 100644 --- a/lib/stdlib/src/unicode.erl +++ b/lib/stdlib/src/unicode.erl @@ -1,56 +1,96 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2011. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(unicode). -%% Implemented in the emulator: -%% characters_to_binary/2 (will trap to characters_to_binary_int/2 -%% if InEncoding is not {latin1 | unicode | utf8}) -%% characters_to_list/2 (will trap to characters_to_list_int/2 if -%% InEncoding is not {latin1 | unicode | utf8}) -%% - -export([characters_to_list/1, characters_to_list_int/2, characters_to_binary/1, characters_to_binary_int/2, characters_to_binary/3, bom_to_encoding/1, encoding_to_bom/1]). -export_type([chardata/0, charlist/0, encoding/0, external_chardata/0, - external_charlist/0, latin1_chardata/0, - latin1_charlist/0, unicode_binary/0, unicode_char/0]). + external_charlist/0, latin1_char/0, latin1_chardata/0, + latin1_charlist/0, latin1_binary/0, unicode_binary/0]). -type encoding() :: 'latin1' | 'unicode' | 'utf8' | 'utf16' | {'utf16', endian()} | 'utf32' | {'utf32', endian()}. -type endian() :: 'big' | 'little'. -type unicode_binary() :: binary(). --type unicode_char() :: non_neg_integer(). --type charlist() :: [unicode_char() | unicode_binary() | charlist()]. +-type charlist() :: + maybe_improper_list(char() | unicode_binary() | charlist(), + unicode_binary() | nil()). -type chardata() :: charlist() | unicode_binary(). -type external_unicode_binary() :: binary(). -type external_chardata() :: external_charlist() | external_unicode_binary(). --type external_charlist() :: [unicode_char() | external_unicode_binary() - | external_charlist()]. +-type external_charlist() :: + maybe_improper_list(char() | + external_unicode_binary() | + external_charlist(), + external_unicode_binary() | nil()). -type latin1_binary() :: binary(). -type latin1_char() :: byte(). -type latin1_chardata() :: latin1_charlist() | latin1_binary(). --type latin1_charlist() :: [latin1_char() | latin1_binary() - | latin1_charlist()]. +-type latin1_charlist() :: + maybe_improper_list(latin1_char() | + latin1_binary() | + latin1_charlist(), + latin1_binary() | nil()). + +%%% BIFs +%%% +%%% characters_to_binary/2 (will trap to characters_to_binary_int/2 +%%% if InEncoding is not {latin1 | unicode | utf8}) +%%% characters_to_list/2 (will trap to characters_to_list_int/2 if +%%% InEncoding is not {latin1 | unicode | utf8}) + +-export([bin_is_7bit/1, characters_to_binary/2, characters_to_list/2]). + +-spec bin_is_7bit(Binary) -> boolean() when + Binary :: binary(). + +bin_is_7bit(_) -> + erlang:nif_error(undef). + +-spec characters_to_binary(Data, InEncoding) -> Result when + Data :: latin1_chardata() | chardata() | external_chardata(), + InEncoding :: encoding(), + Result :: binary() + | {error, binary(), RestData} + | {incomplete, binary(), binary()}, + RestData :: latin1_chardata() | chardata() | external_chardata(). + +characters_to_binary(_, _) -> + erlang:nif_error(undef). + +-spec characters_to_list(Data, InEncoding) -> Result when + Data :: latin1_chardata() | chardata() | external_chardata(), + InEncoding :: encoding(), + Result :: list() + | {error, list(), RestData} + | {incomplete, list(), binary()}, + RestData :: latin1_chardata() | chardata() | external_chardata(). + +characters_to_list(_, _) -> + erlang:nif_error(undef). + +%%% End of BIFs -spec characters_to_list(Data) -> Result when Data :: latin1_chardata() | chardata() | external_chardata(), @@ -521,6 +561,8 @@ do_o_binary(F,L) -> erlang:iolist_to_binary(List) end. +-dialyzer({no_improper_lists, do_o_binary2/2}). + do_o_binary2(_F,[]) -> <<>>; do_o_binary2(F,[H|T]) -> diff --git a/lib/stdlib/src/win32reg.erl b/lib/stdlib/src/win32reg.erl index 598e77ffdc..8e82a79cbf 100644 --- a/lib/stdlib/src/win32reg.erl +++ b/lib/stdlib/src/win32reg.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -25,6 +26,8 @@ expand/1, format_error/1]). +-export_type([reg_handle/0]). + %% Key handles (always open). -define(hkey_classes_root, 16#80000000). -define(hkey_current_user, 16#80000001). @@ -216,12 +219,7 @@ expand([C|Rest], [], Result) -> expand(Rest, [], [C|Result]); expand([$%|Rest], Env0, Result) -> Env = lists:reverse(Env0), - case os:getenv(Env) of - false -> - expand(Rest, [], Result); - Value -> - expand(Rest, [], lists:reverse(Value)++Result) - end; + expand(Rest, [], lists:reverse(os:getenv(Env, ""))++Result); expand([C|Rest], Env, Result) -> expand(Rest, [C|Env], Result); expand([], [], Result) -> diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl index c383540db7..340cc21390 100644 --- a/lib/stdlib/src/zip.erl +++ b/lib/stdlib/src/zip.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2012. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -24,7 +25,7 @@ list_dir/1, list_dir/2, table/1, table/2, t/1, tt/1]). -%% unzipping peicemeal +%% unzipping piecemeal -export([openzip_open/1, openzip_open/2, openzip_get/1, openzip_get/2, openzip_t/1, openzip_tt/1, @@ -203,8 +204,20 @@ zip_comment_length}). --type zip_file() :: #zip_file{}. +-type create_option() :: memory | cooked | verbose | {comment, string()} + | {cwd, file:filename()} + | {compress, extension_spec()} + | {uncompress, extension_spec()}. +-type extension() :: string(). +-type extension_spec() :: all | [extension()] | {add, [extension()]} | {del, [extension()]}. +-type filename() :: file:filename(). + -type zip_comment() :: #zip_comment{}. +-type zip_file() :: #zip_file{}. + +-opaque handle() :: pid(). + +-export_type([create_option/0, filename/0, handle/0]). %% Open a zip archive with options %% @@ -266,7 +279,8 @@ do_openzip_get(F, #openzip{files = Files, in = In0, input = Input, case file_name_search(F, Files) of {#zip_file{offset = Offset},_}=ZFile -> In1 = Input({seek, bof, Offset}, In0), - case get_z_file(In1, Z, Input, Output, [], fun silent/1, CWD, ZFile) of + case get_z_file(In1, Z, Input, Output, [], fun silent/1, + CWD, ZFile, fun all/1) of {file, R, _In2} -> {ok, R}; _ -> throw(file_not_found) end; @@ -340,13 +354,13 @@ unzip(F) -> unzip(F, []). -spec(unzip(Archive, Options) -> RetValue when Archive :: file:name() | binary(), Options :: [Option], - Option :: {file_list, FileList} + Option :: {file_list, FileList} | cooked | keep_old_files | verbose | memory | {file_filter, FileFilter} | {cwd, CWD}, FileList :: [file:name()], FileBinList :: [{file:name(),binary()}], FileFilter :: fun((ZipFile) -> boolean()), - CWD :: string(), + CWD :: file:filename(), ZipFile :: zip_file(), RetValue :: {ok, FileList} | {ok, FileBinList} @@ -430,7 +444,7 @@ zip(F, Files) -> zip(F, Files, []). What :: all | [Extension] | {add, [Extension]} | {del, [Extension]}, Extension :: string(), Comment :: string(), - CWD :: string(), + CWD :: file:filename(), RetValue :: {ok, FileName :: file:name()} | {ok, {FileName :: file:name(), binary()}} | {error, Reason :: term()}). @@ -490,7 +504,7 @@ do_list_dir(F, Options) -> -spec(t(Archive) -> ok when Archive :: file:name() | binary() | ZipHandle, - ZipHandle :: pid()). + ZipHandle :: handle()). t(F) when is_pid(F) -> zip_t(F); t(F) when is_record(F, openzip) -> openzip_t(F); @@ -514,7 +528,7 @@ do_t(F, RawPrint) -> -spec(tt(Archive) -> ok when Archive :: file:name() | binary() | ZipHandle, - ZipHandle :: pid()). + ZipHandle :: handle()). tt(F) when is_pid(F) -> zip_tt(F); tt(F) when is_record(F, openzip) -> openzip_tt(F); @@ -610,9 +624,9 @@ get_zip_opt([Unknown | _Rest], _Opts) -> %% feedback funs silent(_) -> ok. -verbose_unzip(FN) -> io:format("extracting: ~p\n", [FN]). +verbose_unzip(FN) -> io:format("extracting: ~tp\n", [FN]). -verbose_zip(FN) -> io:format("adding: ~p\n", [FN]). +verbose_zip(FN) -> io:format("adding: ~tp\n", [FN]). %% file filter funs all(_) -> true. @@ -712,8 +726,8 @@ table(F, O) -> list_dir(F, O). FileList :: [FileSpec], FileSpec :: file:name() | {file:name(), binary()} | {file:name(), binary(), file:file_info()}, - RetValue :: {ok, FileName :: file:name()} - | {ok, {FileName :: file:name(), binary()}} + RetValue :: {ok, FileName :: filename()} + | {ok, {FileName :: filename(), binary()}} | {error, Reason :: term()}). create(F, Fs) -> zip(F, Fs). @@ -724,14 +738,9 @@ create(F, Fs) -> zip(F, Fs). FileSpec :: file:name() | {file:name(), binary()} | {file:name(), binary(), file:file_info()}, Options :: [Option], - Option :: memory | cooked | verbose | {comment, Comment} - | {cwd, CWD} | {compress, What} | {uncompress, What}, - What :: all | [Extension] | {add, [Extension]} | {del, [Extension]}, - Extension :: string(), - Comment :: string(), - CWD :: string(), - RetValue :: {ok, FileName :: file:name()} - | {ok, {FileName :: file:name(), binary()}} + Option :: create_option(), + RetValue :: {ok, FileName :: filename()} + | {ok, {FileName :: filename(), binary()}} | {error, Reason :: term()}). create(F, Fs, O) -> zip(F, Fs, O). @@ -755,7 +764,7 @@ extract(F) -> unzip(F). FileList :: [file:name()], FileBinList :: [{file:name(),binary()}], FileFilter :: fun((ZipFile) -> boolean()), - CWD :: string(), + CWD :: file:filename(), ZipFile :: zip_file(), RetValue :: {ok, FileList} | {ok, FileBinList} @@ -943,7 +952,7 @@ raw_short_print_info_etc(EOCD, X, Comment, Y, Acc) when is_record(EOCD, eocd) -> raw_long_print_info_etc(EOCD, X, Comment, Y, Acc). print_file_name(FileName) -> - io:format("~s\n", [FileName]). + io:format("~ts\n", [FileName]). %% for printing directory (tt/1) @@ -960,14 +969,14 @@ raw_long_print_info_etc(EOCD, _, Comment, _, Acc) when is_record(EOCD, eocd) -> Acc. print_header(CompSize, MTime, UncompSize, FileName, FileComment) -> - io:format("~8w ~s ~8w ~2w% ~s ~s\n", + io:format("~8w ~s ~8w ~2w% ~ts ~ts\n", [CompSize, time_to_string(MTime), UncompSize, get_percent(CompSize, UncompSize), FileName, FileComment]). print_comment("") -> ok; print_comment(Comment) -> - io:format("Archive comment: ~s\n", [Comment]). + io:format("Archive comment: ~ts\n", [Comment]). get_percent(_, 0) -> 100; get_percent(CompSize, Size) -> round(CompSize * 100 / Size). @@ -1109,15 +1118,19 @@ local_file_header_from_info_method_name(#file_info{mtime = MTime}, file_name_length = length(Name), extra_field_length = 0}. +server_init(Parent) -> + %% we want to know if our parent dies + process_flag(trap_exit, true), + server_loop(Parent, not_open). %% small, simple, stupid zip-archive server -server_loop(OpenZip) -> +server_loop(Parent, OpenZip) -> receive {From, {open, Archive, Options}} -> case openzip_open(Archive, Options) of {ok, NewOpenZip} -> From ! {self(), {ok, self()}}, - server_loop(NewOpenZip); + server_loop(Parent, NewOpenZip); Error -> From ! {self(), Error} end; @@ -1125,43 +1138,47 @@ server_loop(OpenZip) -> From ! {self(), openzip_close(OpenZip)}; {From, get} -> From ! {self(), openzip_get(OpenZip)}, - server_loop(OpenZip); + server_loop(Parent, OpenZip); {From, {get, FileName}} -> From ! {self(), openzip_get(FileName, OpenZip)}, - server_loop(OpenZip); + server_loop(Parent, OpenZip); {From, list_dir} -> From ! {self(), openzip_list_dir(OpenZip)}, - server_loop(OpenZip); + server_loop(Parent, OpenZip); {From, {list_dir, Opts}} -> From ! {self(), openzip_list_dir(OpenZip, Opts)}, - server_loop(OpenZip); + server_loop(Parent, OpenZip); {From, get_state} -> From ! {self(), OpenZip}, - server_loop(OpenZip); + server_loop(Parent, OpenZip); + {'EXIT', Parent, Reason} -> + _ = openzip_close(OpenZip), + exit({parent_died, Reason}); _ -> {error, bad_msg} end. -spec(zip_open(Archive) -> {ok, ZipHandle} | {error, Reason} when Archive :: file:name() | binary(), - ZipHandle :: pid(), + ZipHandle :: handle(), Reason :: term()). zip_open(Archive) -> zip_open(Archive, []). -spec(zip_open(Archive, Options) -> {ok, ZipHandle} | {error, Reason} when Archive :: file:name() | binary(), - ZipHandle :: pid(), + ZipHandle :: handle(), Options :: [Option], - Option :: cooked | memory | {cwd, CWD :: string()}, + Option :: cooked | memory | {cwd, CWD :: file:filename()}, Reason :: term()). zip_open(Archive, Options) -> - Pid = spawn(fun() -> server_loop(not_open) end), - request(self(), Pid, {open, Archive, Options}). + Self = self(), + Pid = spawn_link(fun() -> server_init(Self) end), + request(Self, Pid, {open, Archive, Options}). -spec(zip_get(ZipHandle) -> {ok, [Result]} | {error, Reason} when - ZipHandle :: pid(), + ZipHandle :: handle(), Result :: file:name() | {file:name(), binary()}, Reason :: term()). @@ -1169,14 +1186,14 @@ zip_get(Pid) when is_pid(Pid) -> request(self(), Pid, get). -spec(zip_close(ZipHandle) -> ok | {error, einval} when - ZipHandle :: pid()). + ZipHandle :: handle()). zip_close(Pid) when is_pid(Pid) -> request(self(), Pid, close). -spec(zip_get(FileName, ZipHandle) -> {ok, Result} | {error, Reason} when FileName :: file:name(), - ZipHandle :: pid(), + ZipHandle :: handle(), Result :: file:name() | {file:name(), binary()}, Reason :: term()). @@ -1185,7 +1202,7 @@ zip_get(FileName, Pid) when is_pid(Pid) -> -spec(zip_list_dir(ZipHandle) -> {ok, Result} | {error, Reason} when Result :: [zip_comment() | zip_file()], - ZipHandle :: pid(), + ZipHandle :: handle(), Reason :: term()). zip_list_dir(Pid) when is_pid(Pid) -> @@ -1387,9 +1404,10 @@ get_z_files([{#zip_file{offset = Offset},_} = ZFile | Rest], Z, In0, true -> In1 = Input({seek, bof, Offset}, In0), {In2, Acc1} = - case get_z_file(In1, Z, Input, Output, OpO, FB, CWD, ZFile) of + case get_z_file(In1, Z, Input, Output, OpO, FB, + CWD, ZFile, Filter) of {file, GZD, Inx} -> {Inx, [GZD | Acc0]}; - {dir, Inx} -> {Inx, Acc0} + {_, Inx} -> {Inx, Acc0} end, get_z_files(Rest, Z, In2, Opts, Acc1); _ -> @@ -1397,7 +1415,8 @@ get_z_files([{#zip_file{offset = Offset},_} = ZFile | Rest], Z, In0, end. %% get a file from the archive, reading chunks -get_z_file(In0, Z, Input, Output, OpO, FB, CWD, {ZipFile,Extra}) -> +get_z_file(In0, Z, Input, Output, OpO, FB, + CWD, {ZipFile,Extra}, Filter) -> case Input({read, ?LOCAL_FILE_HEADER_SZ}, In0) of {eof, In1} -> {eof, In1}; @@ -1417,29 +1436,64 @@ get_z_file(In0, Z, Input, Output, OpO, FB, CWD, {ZipFile,Extra}) -> end, {BFileN, In3} = Input({read, FileNameLen + ExtraLen}, In1), {FileName, _} = get_file_name_extra(FileNameLen, ExtraLen, BFileN), - FileName1 = add_cwd(CWD, FileName), - case lists:last(FileName) of - $/ -> - %% perhaps this should always be done? - Output({ensure_dir,FileName1},[]), - {dir, In3}; - _ -> - %% FileInfo = local_file_header_to_file_info(LH) - %%{Out, In4, CRC, UncompSize} = - {Out, In4, CRC, _UncompSize} = - get_z_data(CompMethod, In3, FileName1, - CompSize, Input, Output, OpO, Z), - In5 = skip_z_data_descriptor(GPFlag, Input, In4), - %% TODO This should be fixed some day: - %% In5 = Input({set_file_info, FileName, FileInfo#file_info{size=UncompSize}}, In4), - FB(FileName), - CRC =:= CRC32 orelse throw({bad_crc, FileName}), - {file, Out, In5} + ReadAndWrite = + case check_valid_location(CWD, FileName) of + {true,FileName1} -> + true; + {false,FileName1} -> + Filter({ZipFile#zip_file{name = FileName1},Extra}) + end, + case ReadAndWrite of + true -> + case lists:last(FileName) of + $/ -> + %% perhaps this should always be done? + Output({ensure_dir,FileName1},[]), + {dir, In3}; + _ -> + %% FileInfo = local_file_header_to_file_info(LH) + %%{Out, In4, CRC, UncompSize} = + {Out, In4, CRC, _UncompSize} = + get_z_data(CompMethod, In3, FileName1, + CompSize, Input, Output, OpO, Z), + In5 = skip_z_data_descriptor(GPFlag, Input, In4), + %% TODO This should be fixed some day: + %% In5 = Input({set_file_info, FileName, + %% FileInfo#file_info{size=UncompSize}}, In4), + FB(FileName), + CRC =:= CRC32 orelse throw({bad_crc, FileName}), + {file, Out, In5} + end; + false -> + {ignore, In3} end; _ -> throw(bad_local_file_header) end. +%% make sure FileName doesn't have relative path that points over CWD +check_valid_location(CWD, FileName) -> + %% check for directory traversal exploit + case check_dir_level(filename:split(FileName), 0) of + {FileOrDir,Level} when Level < 0 -> + CWD1 = if CWD == "" -> "./"; + true -> CWD + end, + error_logger:format("Illegal path: ~ts, extracting in ~ts~n", + [add_cwd(CWD,FileName),CWD1]), + {false,add_cwd(CWD, FileOrDir)}; + _ -> + {true,add_cwd(CWD, FileName)} + end. + +check_dir_level([FileOrDir], Level) -> + {FileOrDir,Level}; +check_dir_level(["." | Parts], Level) -> + check_dir_level(Parts, Level); +check_dir_level([".." | Parts], Level) -> + check_dir_level(Parts, Level-1); +check_dir_level([_Dir | Parts], Level) -> + check_dir_level(Parts, Level+1). get_file_name_extra(FileNameLen, ExtraLen, B) -> case B of @@ -1534,57 +1588,35 @@ unix_extra_field_and_var_from_bin(_) -> %% A pwrite-like function for iolists (used by memory-option) -split_iolist(B, Pos) when is_binary(B) -> - split_binary(B, Pos); -split_iolist(L, Pos) when is_list(L) -> - splitter([], L, Pos). +pwrite_binary(B, Pos, Bin) when byte_size(B) =:= Pos -> + append_bins(Bin, B); +pwrite_binary(B, Pos, Bin) -> + erlang:iolist_to_binary(pwrite_iolist(B, Pos, Bin)). -splitter(Left, Right, 0) -> - {Left, Right}; -splitter(Left, [A | Right], RelPos) when is_list(A) or is_binary(A) -> - Sz = erlang:iolist_size(A), - case Sz > RelPos of - true -> - {Leftx, Rightx} = split_iolist(A, RelPos), - {[Left | Leftx], [Rightx, Right]}; - _ -> - splitter([Left | A], Right, RelPos - Sz) - end; -splitter(Left, [A | Right], RelPos) when is_integer(A) -> - splitter([Left, A], Right, RelPos - 1); -splitter(Left, Right, RelPos) when is_binary(Right) -> - splitter(Left, [Right], RelPos). +append_bins([Bin|Bins], B) when is_binary(Bin) -> + append_bins(Bins, <<B/binary, Bin/binary>>); +append_bins([List|Bins], B) when is_list(List) -> + append_bins(Bins, append_bins(List, B)); +append_bins(Bin, B) when is_binary(Bin) -> + <<B/binary, Bin/binary>>; +append_bins([_|_]=List, B) -> + <<B/binary, (iolist_to_binary(List))/binary>>; +append_bins([], B) -> + B. -skip_iolist(B, Pos) when is_binary(B) -> - case B of - <<_:Pos/binary, Bin/binary>> -> Bin; - _ -> <<>> - end; -skip_iolist(L, Pos) when is_list(L) -> - skipper(L, Pos). - -skipper(Right, 0) -> - Right; -skipper([A | Right], RelPos) when is_list(A) or is_binary(A) -> - Sz = erlang:iolist_size(A), - case Sz > RelPos of - true -> - Rightx = skip_iolist(A, RelPos), - [Rightx, Right]; - _ -> - skip_iolist(Right, RelPos - Sz) - end; -skipper([A | Right], RelPos) when is_integer(A) -> - skip_iolist(Right, RelPos - 1). +-dialyzer({no_improper_lists, pwrite_iolist/3}). -pwrite_iolist(Iolist, Pos, Bin) -> - {Left, Right} = split_iolist(Iolist, Pos), +pwrite_iolist(B, Pos, Bin) -> + {Left, Right} = split_binary(B, Pos), Sz = erlang:iolist_size(Bin), - R = skip_iolist(Right, Sz), + R = skip_bin(Right, Sz), [Left, Bin | R]. -pwrite_binary(B, Pos, Bin) -> - erlang:iolist_to_binary(pwrite_iolist(B, Pos, Bin)). +skip_bin(B, Pos) when is_binary(B) -> + case B of + <<_:Pos/binary, Bin/binary>> -> Bin; + _ -> <<>> + end. %% ZIP header manipulations |