diff options
Diffstat (limited to 'lib/compiler')
92 files changed, 15736 insertions, 6985 deletions
diff --git a/lib/compiler/Makefile b/lib/compiler/Makefile index b8b2f562a2..f18df11e9f 100644 --- a/lib/compiler/Makefile +++ b/lib/compiler/Makefile @@ -36,3 +36,6 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=crypto hipe + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/compiler/doc/src/Makefile b/lib/compiler/doc/src/Makefile index 2fb163b9e7..e1c445662c 100644 --- a/lib/compiler/doc/src/Makefile +++ b/lib/compiler/doc/src/Makefile @@ -28,94 +28,19 @@ VSN=$(COMPILER_VSN) APPLICATION=compiler # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) -COMPILER_DIR = $(ERL_TOP)/lib/compiler/src - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml XML_REF3_FILES = compile.xml +EDOC_REF3_FILES = cerl.xml cerl_trees.xml cerl_clauses.xml XML_PART_FILES = internal.xml -XML_CHAPTER_FILES = notes.xml +XML_NOTES_FILES = notes.xml BOOK_FILES = book.xml -GIF_FILES = - XML_FILES = \ - $(BOOK_FILES) $(XML_CHAPTER_FILES) \ + $(BOOK_FILES) $(XML_NOTES_FILES) \ $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES) -XML_INTERNAL_FILES = \ - cerl.xml cerl_trees.xml cerl_clauses.xml - -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -XML_GEN_FILES = $(XML_INTERNAL_FILES:%=$(XMLDIR)/%) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -man: $(MAN3_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -$(XML_INTERNAL_FILES:%=$(XMLDIR)/%): $(COMPILER_DIR)/$(@:$(XMLDIR)/%.xml=%.erl) - $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(COMPILER_VSN) -dir $(XMLDIR) $(COMPILER_DIR)/$(@:$(XMLDIR)/%.xml=%.erl) - -debug opt: - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/compiler/scripts/.gitignore b/lib/compiler/scripts/.gitignore index 4e4eba766d..444b0cea1e 100644 --- a/lib/compiler/scripts/.gitignore +++ b/lib/compiler/scripts/.gitignore @@ -1 +1,5 @@ -/smoke-build +/smoke-build/* + +# The dependency lock file must be kept to ensure that the smoke +# test won't be broken as time passes. +!/smoke-build/mix.lock diff --git a/lib/compiler/scripts/smoke-build/mix.lock b/lib/compiler/scripts/smoke-build/mix.lock new file mode 100644 index 0000000000..9fb83798c4 --- /dev/null +++ b/lib/compiler/scripts/smoke-build/mix.lock @@ -0,0 +1,9 @@ +%{ + "credentials_obfuscation": {:hex, :credentials_obfuscation, "1.1.0", "513793cc20c18afc9e03e584b436192a751a8344890e03a8741c65c8d6866fab", [:rebar3], [], "hexpm"}, + "goldrush": {:hex, :goldrush, "0.1.9", "f06e5d5f1277da5c413e84d5a2924174182fb108dabb39d5ec548b27424cd106", [:rebar3], [], "hexpm"}, + "jsx": {:hex, :jsx, "2.9.0", "d2f6e5f069c00266cad52fb15d87c428579ea4d7d73a33669e12679e203329dd", [:mix, :rebar3], [], "hexpm"}, + "lager": {:hex, :lager, "3.8.0", "3402b9a7e473680ca179fc2f1d827cab88dd37dd1e6113090c6f45ef05228a1c", [:rebar3], [{:goldrush, "0.1.9", [hex: :goldrush, repo: "hexpm", optional: false]}], "hexpm"}, + "rabbit_common": {:hex, :rabbit_common, "3.7.18", "4249efdf1fd96a81739ffad675582f980cc55aa0a02217e4907b4cd719c44822", [:make, :rebar3], [{:credentials_obfuscation, "1.1.0", [hex: :credentials_obfuscation, repo: "hexpm", optional: false]}, {:jsx, "2.9.0", [hex: :jsx, repo: "hexpm", optional: false]}, {:lager, "3.8.0", [hex: :lager, repo: "hexpm", optional: false]}, {:ranch, "1.7.1", [hex: :ranch, repo: "hexpm", optional: false]}, {:recon, "2.5.0", [hex: :recon, repo: "hexpm", optional: false]}], "hexpm"}, + "ranch": {:hex, :ranch, "1.7.1", "6b1fab51b49196860b733a49c07604465a47bdb78aa10c1c16a3d199f7f8c881", [:rebar3], [], "hexpm"}, + "recon": {:hex, :recon, "2.5.0", "2f7fcbec2c35034bade2f9717f77059dc54eb4e929a3049ca7ba6775c0bd66cd", [:mix, :rebar3], [], "hexpm"}, +} diff --git a/lib/compiler/scripts/smoke-mix.exs b/lib/compiler/scripts/smoke-mix.exs index ba0815e465..0bfb80b53c 100644 --- a/lib/compiler/scripts/smoke-mix.exs +++ b/lib/compiler/scripts/smoke-mix.exs @@ -45,6 +45,7 @@ defmodule Smoke.MixProject do {:gpb, "~> 4.6"}, {:gproc, "~> 0.8.0"}, {:graphql, "~> 0.15.0", hex: :graphql_erl}, + {:hut, "~> 1.3"}, {:hackney, "~> 1.15.0"}, {:ibrowse, "~> 4.4.1"}, {:jose, "~> 1.9.0"}, @@ -89,12 +90,13 @@ defmodule Smoke.MixProject do defp build_wings do # If the Erlang system is not installed, the build will - # crash in plugins_src/accel when attempting to build - # the accel driver. Since there is very little Erlang code in - # the directory, skip the entire directory. + # crash in c_src or plugins_src/accel when attempting to + # build native code. Since there is very little Erlang + # code in these directories, skip them both. """ echo "all:\n\t" >plugins_src/accel/Makefile + echo "all:\n\t" >c_src/Makefile git commit -a -m'Disable for smoke testing' git tag -a -m'Smoke test' vsmoke_test make diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 87b0d345f2..6ce354359c 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -49,16 +49,18 @@ MODULES = \ beam_a \ beam_asm \ beam_block \ + beam_call_types \ beam_clean \ beam_dict \ + beam_digraph \ beam_disasm \ - beam_except \ beam_flatten \ beam_jump \ beam_listing \ beam_opcodes \ beam_peep \ beam_ssa \ + beam_ssa_bool \ beam_ssa_bsm \ beam_ssa_codegen \ beam_ssa_dead \ @@ -72,6 +74,7 @@ MODULES = \ beam_ssa_type \ beam_kernel_to_ssa \ beam_trim \ + beam_types \ beam_utils \ beam_validator \ beam_z \ @@ -93,6 +96,7 @@ MODULES = \ sys_core_fold \ sys_core_fold_lists \ sys_core_inline \ + sys_core_prepare \ sys_pre_attributes \ v3_core \ v3_kernel \ @@ -104,6 +108,7 @@ HRL_FILES= \ beam_disasm.hrl \ beam_ssa_opt.hrl \ beam_ssa.hrl \ + beam_types.hrl \ core_parse.hrl \ v3_kernel.hrl @@ -190,6 +195,7 @@ release_docs_spec: # Dependencies -- alphabetically, please # ---------------------------------------------------- +$(EBIN)/beam_call_types.beam: beam_types.hrl $(EBIN)/beam_disasm.beam: $(EGEN)/beam_opcodes.hrl beam_disasm.hrl $(EBIN)/beam_listing.beam: core_parse.hrl v3_kernel.hrl beam_ssa.hrl $(EBIN)/beam_kernel_to_ssa.beam: v3_kernel.hrl beam_ssa.hrl @@ -204,7 +210,9 @@ $(EBIN)/beam_ssa_pp.beam: beam_ssa.hrl $(EBIN)/beam_ssa_pre_codegen.beam: beam_ssa.hrl $(EBIN)/beam_ssa_recv.beam: beam_ssa.hrl $(EBIN)/beam_ssa_share.beam: beam_ssa.hrl -$(EBIN)/beam_ssa_type.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_type.beam: beam_ssa.hrl beam_types.hrl +$(EBIN)/beam_types.beam: beam_types.hrl +$(EBIN)/beam_validator.beam: beam_types.hrl $(EBIN)/cerl.beam: core_parse.hrl $(EBIN)/compile.beam: core_parse.hrl ../../stdlib/include/erl_compile.hrl $(EBIN)/core_lib.beam: core_parse.hrl diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index eadd858885..bd4be485bb 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -59,16 +59,6 @@ rename_instrs([{test,is_eq_exact,_,[Dst,Src]}=Test, rename_instrs([{test,is_eq_exact,_,[Same,Same]}|Is]) -> %% Same literal or same register. Will always succeed. rename_instrs(Is); -rename_instrs([{recv_set,_}, - {label,Lbl}, - {loop_rec,{f,Fail},{x,0}}, - {loop_rec_end,_},{label,Fail}|Is]) -> - %% This instruction sequence does nothing. All we need to - %% keep is the first label. - [{label,Lbl}|rename_instrs(Is)]; -rename_instrs([{loop_rec,{f,Fail},{x,0}},{loop_rec_end,_},{label,Fail}|Is]) -> - %% This instruction sequence does nothing. - rename_instrs(Is); rename_instrs([{apply_last,A,N}|Is]) -> [{apply,A},{deallocate,N},return|rename_instrs(Is)]; rename_instrs([{call_last,A,F,N}|Is]) -> diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index df09dcb06c..60e19ec596 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -64,11 +64,30 @@ module(Code, ExtraChunks, CompileInfo, CompilerOpts) -> assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, ExtraChunks, CompileInfo, CompilerOpts) -> {1,Dict0} = beam_dict:atom(Mod, beam_dict:new()), {0,Dict1} = beam_dict:fname(atom_to_list(Mod) ++ ".erl", Dict0), + Dict2 = shared_fun_wrappers(CompilerOpts, Dict1), NumFuncs = length(Asm0), {Asm,Attr} = on_load(Asm0, Attr0), Exp = cerl_sets:from_list(Exp0), - {Code,Dict2} = assemble_1(Asm, Exp, Dict1, []), - build_file(Code, Attr, Dict2, NumLabels, NumFuncs, ExtraChunks, CompileInfo, CompilerOpts). + {Code,Dict} = assemble_1(Asm, Exp, Dict2, []), + build_file(Code, Attr, Dict, NumLabels, NumFuncs, + ExtraChunks, CompileInfo, CompilerOpts). + +shared_fun_wrappers(Opts, Dict) -> + case proplists:get_bool(no_shared_fun_wrappers, Opts) of + false -> + %% The compiler in OTP 23 depends on the on the loader + %% using the new indices in funs and being able to have + %% multiple make_fun2 instructions referring to the same + %% fun entry. Artificially set the highest opcode for the + %% module to ensure that it cannot be loaded in OTP 22 + %% and earlier. + Swap = beam_opcodes:opcode(swap, 2), + beam_dict:opcode(Swap, Dict); + true -> + %% Fun wrappers are not shared for compatibility with a + %% previous OTP release. + Dict + end. on_load(Fs0, Attr0) -> case proplists:get_value(on_load, Attr0) of diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 707974b2c1..a734ca3a10 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -33,8 +33,9 @@ module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> function({function,Name,Arity,CLabel,Is0}) -> try - Is1 = blockify(Is0), - Is = embed_lines(Is1), + Is1 = swap_opt(Is0), + Is2 = blockify(Is1), + Is = embed_lines(Is2), {function,Name,Arity,CLabel,Is} catch Class:Error:Stack -> @@ -42,6 +43,40 @@ function({function,Name,Arity,CLabel,Is0}) -> erlang:raise(Class, Error, Stack) end. +%%% +%%% Try to use a `swap` instruction instead of a sequence of moves. +%%% +%%% Note that beam_ssa_codegen generates `swap` instructions only for +%%% the moves within a single SSA instruction (such as `call`), not +%%% for the moves generated by a sequence of SSA instructions. +%%% Therefore, this optimization is needed. +%%% + +swap_opt([{move,Reg1,{x,X}=Temp}=Move1, + {move,Reg2,Reg1}=Move2, + {move,Temp,Reg2}=Move3|Is]) when Reg1 =/= Temp -> + case is_unused(X, Is) of + true -> + [{swap,Reg1,Reg2}|swap_opt(Is)]; + false -> + [Move1|swap_opt([Move2,Move3|Is])] + end; +swap_opt([I|Is]) -> + [I|swap_opt(Is)]; +swap_opt([]) -> []. + +is_unused(X, [{call,A,_}|_]) when A =< X -> true; +is_unused(X, [{call_ext,A,_}|_]) when A =< X -> true; +is_unused(X, [{make_fun2,_,_,_,A}|_]) when A =< X -> true; +is_unused(X, [{move,Src,Dst}|Is]) -> + case {Src,Dst} of + {{x,X},_} -> false; + {_,{x,X}} -> true; + {_,_} -> is_unused(X, Is) + end; +is_unused(X, [{line,_}|Is]) -> is_unused(X, Is); +is_unused(_, _) -> false. + %% blockify(Instructions0) -> Instructions %% Collect sequences of instructions to basic blocks. %% Also do some simple optimations on instructions outside the blocks. diff --git a/lib/compiler/src/beam_call_types.erl b/lib/compiler/src/beam_call_types.erl new file mode 100644 index 0000000000..290a31b8ba --- /dev/null +++ b/lib/compiler/src/beam_call_types.erl @@ -0,0 +1,983 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. 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(beam_call_types). + +-include("beam_types.hrl"). + +-import(lists, [duplicate/2,foldl/3]). + +-export([will_succeed/3, types/3]). + +%% +%% Returns whether a call will succeed or not. +%% +%% Note that it only answers 'yes' for functions in the 'erlang' module as +%% calls to other modules may fail due to not being loaded, even if we consider +%% the module to be known. +%% + +-spec will_succeed(Mod, Func, ArgTypes) -> Result when + Mod :: atom(), + Func :: atom(), + ArgTypes :: [normal_type()], + Result :: yes | no | maybe. + +will_succeed(erlang, '++', [LHS, _RHS]) -> + succeeds_if_type(LHS, proper_list()); +will_succeed(erlang, '--', [LHS, RHS]) -> + case {succeeds_if_type(LHS, proper_list()), + succeeds_if_type(RHS, proper_list())} of + {yes, yes} -> yes; + {no, _} -> no; + {_, no} -> no; + {_, _} -> maybe + end; +will_succeed(erlang, BoolOp, [LHS, RHS]) when BoolOp =:= 'and'; + BoolOp =:= 'or' -> + case {succeeds_if_type(LHS, beam_types:make_boolean()), + succeeds_if_type(RHS, beam_types:make_boolean())} of + {yes, yes} -> yes; + {no, _} -> no; + {_, no} -> no; + {_, _} -> maybe + end; +will_succeed(erlang, bit_size, [Arg]) -> + succeeds_if_type(Arg, #t_bitstring{}); +will_succeed(erlang, byte_size, [Arg]) -> + succeeds_if_type(Arg, #t_bitstring{}); +will_succeed(erlang, hd, [Arg]) -> + succeeds_if_type(Arg, #t_cons{}); +will_succeed(erlang, is_map_key, [_Key, Map]) -> + succeeds_if_type(Map, #t_map{}); +will_succeed(erlang, length, [Arg]) -> + succeeds_if_type(Arg, proper_list()); +will_succeed(erlang, map_size, [Arg]) -> + succeeds_if_type(Arg, #t_map{}); +will_succeed(erlang, 'not', [Arg]) -> + succeeds_if_type(Arg, beam_types:make_boolean()); +will_succeed(erlang, setelement, [#t_integer{elements={Min,Max}}, + #t_tuple{exact=Exact,size=Size}, _]) -> + case Min >= 1 andalso Max =< Size of + true -> yes; + false when Exact -> no; + false -> maybe + end; +will_succeed(erlang, size, [Arg]) -> + ArgType = beam_types:join(#t_tuple{}, #t_bitstring{}), + succeeds_if_type(Arg, ArgType); +will_succeed(erlang, tuple_size, [Arg]) -> + succeeds_if_type(Arg, #t_tuple{}); +will_succeed(erlang, tl, [Arg]) -> + succeeds_if_type(Arg, #t_cons{}); +will_succeed(Mod, Func, Args) -> + Arity = length(Args), + case erl_bifs:is_safe(Mod, Func, Arity) of + true -> + yes; + false -> + case erl_bifs:is_exit_bif(Mod, Func, Arity) of + true -> + no; + false -> + %% While we can't infer success for functions outside the + %% 'erlang' module (see above comment), it's safe to infer + %% failure when we know the arguments must have certain + %% types. + {_, ArgTypes, _} = types(Mod, Func, Args), + fails_on_conflict(Args, ArgTypes) + end + end. + +fails_on_conflict([ArgType | Args], [Required | Types]) -> + case beam_types:meet(ArgType, Required) of + none -> no; + _ -> fails_on_conflict(Args, Types) + end; +fails_on_conflict([], []) -> + maybe. + +succeeds_if_type(ArgType, Required) -> + case beam_types:meet(ArgType, Required) of + ArgType -> yes; + none -> no; + _ -> maybe + end. + +%% +%% Returns the inferred return and argument types for known functions, and +%% whether it's safe to subtract argument types on failure. +%% +%% Note that the return type will be 'none' if we can statically determine that +%% the function will fail at runtime. +%% + +-spec types(Mod, Func, ArgTypes) -> {RetType, ArgTypes, CanSubtract} when + Mod :: atom(), + Func :: atom(), + ArgTypes :: [normal_type()], + RetType :: type(), + CanSubtract :: boolean(). + +%% Functions that only fail due to bad argument *types*, meaning it's safe to +%% subtract argument types on failure. +%% +%% Note that these are all from the erlang module; suitable functions in other +%% modules could fail due to the module not being loaded. +types(erlang, 'map_size', [_]) -> + sub_safe(#t_integer{}, [#t_map{}]); +types(erlang, 'tuple_size', [_]) -> + sub_safe(#t_integer{}, [#t_tuple{}]); +types(erlang, 'bit_size', [_]) -> + sub_safe(#t_integer{}, [#t_bitstring{}]); +types(erlang, 'byte_size', [_]) -> + sub_safe(#t_integer{}, [#t_bitstring{}]); +types(erlang, hd, [Src]) -> + RetType = erlang_hd_type(Src), + sub_safe(RetType, [#t_cons{}]); +types(erlang, tl, [Src]) -> + RetType = erlang_tl_type(Src), + sub_safe(RetType, [#t_cons{}]); +types(erlang, 'not', [_]) -> + Bool = beam_types:make_boolean(), + sub_safe(Bool, [Bool]); +types(erlang, 'length', [_]) -> + sub_safe(#t_integer{}, [proper_list()]); + +%% Boolean ops +types(erlang, 'and', [_,_]) -> + Bool = beam_types:make_boolean(), + sub_unsafe(Bool, [Bool, Bool]); +types(erlang, 'or', [_,_]) -> + Bool = beam_types:make_boolean(), + sub_unsafe(Bool, [Bool, Bool]); +types(erlang, 'xor', [_,_]) -> + Bool = beam_types:make_boolean(), + sub_unsafe(Bool, [Bool, Bool]); + +%% Bitwise ops +types(erlang, 'band', [_,_]=Args) -> + sub_unsafe(erlang_band_type(Args), [#t_integer{}, #t_integer{}]); +types(erlang, 'bor', [_,_]) -> + sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]); +types(erlang, 'bxor', [_,_]) -> + sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]); +types(erlang, 'bsl', [_,_]) -> + sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]); +types(erlang, 'bsr', [_,_]) -> + sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]); +types(erlang, 'bnot', [_]) -> + sub_unsafe(#t_integer{}, [#t_integer{}]); + +%% Fixed-type arithmetic +types(erlang, 'float', [_]) -> + sub_unsafe(#t_float{}, [number]); +types(erlang, 'round', [_]) -> + sub_unsafe(#t_integer{}, [number]); +types(erlang, 'floor', [_]) -> + sub_unsafe(#t_integer{}, [number]); +types(erlang, 'ceil', [_]) -> + sub_unsafe(#t_integer{}, [number]); +types(erlang, 'trunc', [_]) -> + sub_unsafe(#t_integer{}, [number]); +types(erlang, '/', [_,_]) -> + sub_unsafe(#t_float{}, [number, number]); +types(erlang, 'div', [_,_]) -> + sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]); +types(erlang, 'rem', [_,_]) -> + sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]); + +%% Mixed-type arithmetic; '+'/2 and friends are handled in the catch-all +%% clause for the 'erlang' module. +types(erlang, 'abs', [_]=Args) -> + mixed_arith_types(Args); + +%% List operations +types(erlang, '++', [LHS, RHS]) -> + %% `[] ++ RHS` yields RHS, even if RHS is not a list. + ListType = copy_list(LHS, same_length, proper), + RetType = beam_types:join(ListType, RHS), + sub_unsafe(RetType, [proper_list(), any]); +types(erlang, '--', [LHS, _]) -> + RetType = copy_list(LHS, new_length, proper), + sub_unsafe(RetType, [proper_list(), proper_list()]); + +types(erlang, 'iolist_to_binary', [_]) -> + %% Arg is an iodata(), despite its name. + ArgType = beam_types:join(#t_list{}, #t_bitstring{size_unit=8}), + sub_unsafe(#t_bitstring{size_unit=8}, [ArgType]); +types(erlang, 'list_to_binary', [_]) -> + %% Arg is an iolist(), despite its name. + sub_unsafe(#t_bitstring{size_unit=8}, [#t_list{}]); +types(erlang, 'list_to_bitstring', [_]) -> + %% As list_to_binary but with bitstrings rather than binaries. + sub_unsafe(#t_bitstring{}, [proper_list()]); + +%% Misc ops. +types(erlang, 'binary_part', [_, _]) -> + PosLen = make_two_tuple(#t_integer{}, #t_integer{}), + Binary = #t_bitstring{size_unit=8}, + sub_unsafe(Binary, [Binary, PosLen]); +types(erlang, 'binary_part', [_, _, _]) -> + Binary = #t_bitstring{size_unit=8}, + sub_unsafe(Binary, [Binary, #t_integer{}, #t_integer{}]); +types(erlang, 'is_map_key', [Key, Map]) -> + RetType = case erlang_map_get_type(Key, Map) of + none -> beam_types:make_atom(false); + _ -> beam_types:make_boolean() + end, + sub_unsafe(RetType, [any, #t_map{}]); +types(erlang, 'map_get', [Key, Map]) -> + RetType = erlang_map_get_type(Key, Map), + sub_unsafe(RetType, [any, #t_map{}]); +types(erlang, 'node', [_]) -> + sub_unsafe(#t_atom{}, [any]); +types(erlang, 'node', []) -> + sub_unsafe(#t_atom{}, []); +types(erlang, 'size', [_]) -> + ArgType = beam_types:join(#t_tuple{}, #t_bitstring{}), + sub_unsafe(#t_integer{}, [ArgType]); + +%% Tuple element ops +types(erlang, element, [PosType, TupleType]) -> + Index = case PosType of + #t_integer{elements={Same,Same}} when is_integer(Same) -> + Same; + _ -> + 0 + end, + + RetType = case TupleType of + #t_tuple{size=Sz,elements=Es} when Index =< Sz, + Index >= 1 -> + beam_types:get_tuple_element(Index, Es); + _ -> + any + end, + + sub_unsafe(RetType, [#t_integer{}, #t_tuple{size=Index}]); +types(erlang, setelement, [PosType, TupleType, ArgType]) -> + RetType = case {PosType,TupleType} of + {#t_integer{elements={Index,Index}}, + #t_tuple{elements=Es0,size=Size}=T} when Index >= 1 -> + %% This is an exact index, update the type of said + %% element or return 'none' if it's known to be out of + %% bounds. + Es = beam_types:set_tuple_element(Index, ArgType, Es0), + case T#t_tuple.exact of + false -> + T#t_tuple{size=max(Index, Size),elements=Es}; + true when Index =< Size -> + T#t_tuple{elements=Es}; + true -> + none + end; + {#t_integer{elements={Min,Max}}, + #t_tuple{elements=Es0,size=Size}=T} when Min >= 1 -> + %% We know this will land between Min and Max, so kill + %% the types for those indexes. + Es = discard_tuple_element_info(Min, Max, Es0), + case T#t_tuple.exact of + false -> + T#t_tuple{elements=Es,size=max(Min, Size)}; + true when Min =< Size -> + T#t_tuple{elements=Es,size=Size}; + true -> + none + end; + {_,#t_tuple{}=T} -> + %% Position unknown, so we have to discard all element + %% information. + T#t_tuple{elements=#{}}; + {#t_integer{elements={Min,_Max}},_} -> + #t_tuple{size=Min}; + {_,_} -> + #t_tuple{} + end, + sub_unsafe(RetType, [#t_integer{}, #t_tuple{}, any]); + +types(erlang, make_fun, [_,_,Arity0]) -> + Type = case Arity0 of + #t_integer{elements={Arity,Arity}} when Arity >= 0 -> + #t_fun{arity=Arity}; + _ -> + #t_fun{} + end, + sub_unsafe(Type, [#t_atom{}, #t_atom{}, #t_integer{}]); + +types(erlang, Name, Args) -> + Arity = length(Args), + + case erl_bifs:is_exit_bif(erlang, Name, Arity) of + true -> + {none, Args, false}; + false -> + case erl_internal:arith_op(Name, Arity) of + true -> + mixed_arith_types(Args); + false -> + IsTest = + erl_internal:new_type_test(Name, Arity) orelse + erl_internal:comp_op(Name, Arity), + + RetType = case IsTest of + true -> beam_types:make_boolean(); + false -> any + end, + + sub_unsafe(RetType, duplicate(Arity, any)) + end + end; + +%% +%% Math BIFs +%% + +types(math, cos, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, cosh, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, sin, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, sinh, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, tan, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, tanh, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, acos, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, acosh, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, asin, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, asinh, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, atan, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, atanh, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, erf, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, erfc, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, exp, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, log, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, log2, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, log10, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, sqrt, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, atan2, [_,_]) -> + sub_unsafe(#t_float{}, [number, number]); +types(math, pow, [_,_]) -> + sub_unsafe(#t_float{}, [number, number]); +types(math, ceil, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, floor, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, fmod, [_,_]) -> + sub_unsafe(#t_float{}, [number, number]); +types(math, pi, []) -> + sub_unsafe(#t_float{}, []); + +%% +%% List functions +%% +%% These tend to have tricky edge cases around nil and proper lists, be very +%% careful and try not to narrow the types needlessly. Keep in mind that they +%% need to be safe regardless of how the function is implemented, so it's best +%% not to say that a list is proper unless every element must be visited to +%% succeed. +%% + +%% Operator aliases. +types(lists, append, [_,_]=Args) -> + types(erlang, '++', Args); +types(lists, append, [_]) -> + %% This is implemented through folding the list over erlang:'++'/2, so it + %% can hypothetically return anything, but we can infer that its argument + %% is a proper list on success. + sub_unsafe(any, [proper_list()]); +types(lists, subtract, [_,_]=Args) -> + types(erlang, '--', Args); + +%% Functions returning booleans. +types(lists, all, [_,_]) -> + %% This can succeed on improper lists if the fun returns 'false' for an + %% element before reaching the end. + sub_unsafe(beam_types:make_boolean(), [#t_fun{arity=1}, #t_list{}]); +types(lists, any, [_,_]) -> + %% Doesn't imply that the argument is a proper list; see lists:all/2 + sub_unsafe(beam_types:make_boolean(), [#t_fun{arity=1}, #t_list{}]); +types(lists, keymember, [_,_,_]) -> + %% Doesn't imply that the argument is a proper list; see lists:all/2 + sub_unsafe(beam_types:make_boolean(), [any, #t_integer{}, #t_list{}]); +types(lists, member, [_,_]) -> + %% Doesn't imply that the argument is a proper list; see lists:all/2 + sub_unsafe(beam_types:make_boolean(), [any, #t_list{}]); +types(lists, prefix, [_,_]) -> + %% This function doesn't need to reach the end of either list to return + %% false, so we can succeed even when both are improper lists. + sub_unsafe(beam_types:make_boolean(), [#t_list{}, #t_list{}]); +types(lists, suffix, [_,_]) -> + %% A different implementation could return true when the first list is nil, + %% so we can't tell if either is proper. + sub_unsafe(beam_types:make_boolean(), [#t_list{}, #t_list{}]); + +%% Simple folds +types(lists, foldl, [Fun, Init, List]) -> + RetType = lists_fold_type(Fun, Init, List), + sub_unsafe(RetType, [#t_fun{arity=2}, any, proper_list()]); +types(lists, foldr, [Fun, Init, List]) -> + RetType = lists_fold_type(Fun, Init, List), + sub_unsafe(RetType, [#t_fun{arity=2}, any, proper_list()]); + +%% Functions returning plain lists. +types(lists, droplast, [List]) -> + RetType = copy_list(List, new_length, proper), + sub_unsafe(RetType, [proper_list()]); +types(lists, dropwhile, [_Fun, List]) -> + %% If the element is found before the end of the list, we could return an + %% improper list. + RetType = copy_list(List, new_length, maybe_improper), + sub_unsafe(RetType, [#t_fun{arity=1}, #t_list{}]); +types(lists, duplicate, [_Count, Element]) -> + sub_unsafe(proper_list(Element), [#t_integer{}, any]); +types(lists, filter, [_Fun, List]) -> + RetType = copy_list(List, new_length, proper), + sub_unsafe(RetType, [#t_fun{arity=1}, proper_list()]); +types(lists, flatten, [_]) -> + sub_unsafe(proper_list(), [proper_list()]); +types(lists, map, [Fun, List]) -> + RetType = lists_map_type(Fun, List), + sub_unsafe(RetType, [#t_fun{arity=1}, proper_list()]); +types(lists, reverse, [List]) -> + RetType = copy_list(List, same_length, proper), + sub_unsafe(RetType, [proper_list()]); +types(lists, sort, [List]) -> + RetType = copy_list(List, same_length, proper), + sub_unsafe(RetType, [proper_list()]); +types(lists, takewhile, [_Fun, List]) -> + %% Doesn't imply that the argument is a proper list; see lists:all/2 + RetType = copy_list(List, new_length, proper), + sub_unsafe(RetType, [#t_fun{arity=1}, #t_list{}]); +types(lists, usort, [List]) -> + %% The result is not quite the same length, but a non-empty list will stay + %% non-empty. + RetType = copy_list(List, same_length, proper), + sub_unsafe(RetType, [proper_list()]); +types(lists, zip, [_,_]=Lists) -> + {RetType, ArgType} = lists_zip_types(Lists), + sub_unsafe(RetType, [ArgType, ArgType]); +types(lists, zipwith, [Fun | [_,_]=Lists]) -> + {RetType, ArgType} = lists_zipwith_types(Fun, Lists), + sub_unsafe(RetType, [#t_fun{arity=2}, ArgType, ArgType]); + +%% Functions with complex return values. +types(lists, keyfind, [KeyType,PosType,_]) -> + %% Doesn't imply that the argument is a proper list; see lists:all/2 + TupleType = case PosType of + #t_integer{elements={Index,Index}} when is_integer(Index), + Index >= 1 -> + Es = beam_types:set_tuple_element(Index, KeyType, #{}), + #t_tuple{size=Index,elements=Es}; + _ -> + #t_tuple{} + end, + RetType = beam_types:join(TupleType, beam_types:make_atom(false)), + sub_unsafe(RetType, [any, #t_integer{}, #t_list{}]); +types(lists, MapFold, [Fun, Init, List]) + when MapFold =:= mapfoldl; MapFold =:= mapfoldr -> + RetType = lists_mapfold_type(Fun, Init, List), + sub_unsafe(RetType, [#t_fun{arity=2}, any, proper_list()]); +types(lists, partition, [_Fun, List]) -> + ListType = copy_list(List, new_length, proper), + RetType = make_two_tuple(ListType, ListType), + sub_unsafe(RetType, [#t_fun{arity=1}, proper_list()]); +types(lists, search, [_,_]) -> + %% Doesn't imply that the argument is a proper list; see lists:all/2 + TupleType = make_two_tuple(beam_types:make_atom(value), any), + RetType = beam_types:join(TupleType, beam_types:make_atom(false)), + sub_unsafe(RetType, [#t_fun{arity=1}, #t_list{}]); +types(lists, splitwith, [_Fun, List]) -> + %% Only the elements in the left list are guaranteed to be visited, so both + %% the argument and the right list may be improper. + Left = copy_list(List, new_length, proper), + Right = copy_list(List, new_length, maybe_improper), + sub_unsafe(make_two_tuple(Left, Right), [#t_fun{arity=1}, #t_list{}]); +types(lists, unzip, [List]) -> + RetType = lists_unzip_type(2, List), + sub_unsafe(RetType, [proper_list()]); + +%% +%% Map functions +%% + +types(maps, filter, [_Fun, Map]) -> + %% Conservatively assume that key/value types are unchanged. + RetType = case Map of + #t_map{}=T -> T; + _ -> #t_map{} + end, + sub_unsafe(RetType, [#t_fun{arity=2}, #t_map{}]); +types(maps, find, [Key, Map]) -> + TupleType = case erlang_map_get_type(Key, Map) of + none -> + none; + ValueType -> + make_two_tuple(beam_types:make_atom(ok), ValueType) + end, + %% error | {ok, Value} + RetType = beam_types:join(beam_types:make_atom(error), TupleType), + sub_unsafe(RetType, [any, #t_map{}]); +types(maps, fold, [Fun, Init, _Map]) -> + RetType = case Fun of + #t_fun{type=Type} -> + %% The map is potentially empty, so we have to assume it + %% can return the initial value. + beam_types:join(Type, Init); + _ -> + any + end, + sub_unsafe(RetType, [#t_fun{arity=3}, any, #t_map{}]); +types(maps, from_list, [Pairs]) -> + PairType = erlang_hd_type(Pairs), + RetType = case beam_types:normalize(PairType) of + #t_tuple{elements=Es} -> + SKey = beam_types:get_tuple_element(1, Es), + SValue = beam_types:get_tuple_element(2, Es), + #t_map{super_key=SKey,super_value=SValue}; + _ -> + #t_map{} + end, + sub_unsafe(RetType, [proper_list()]); +types(maps, get, [_Key, _Map]=Args) -> + types(erlang, map_get, Args); +types(maps, get, [Key, Map, Default]) -> + RetType = case erlang_map_get_type(Key, Map) of + none -> Default; + ValueType -> beam_types:join(ValueType, Default) + end, + sub_unsafe(RetType, [any, #t_map{}, any]); +types(maps, is_key, [_Key, _Map]=Args) -> + types(erlang, is_map_key, Args); +types(maps, keys, [Map]) -> + RetType = case Map of + #t_map{super_key=none} -> nil; + #t_map{super_key=SKey} -> proper_list(SKey); + _ -> proper_list() + end, + sub_unsafe(RetType, [#t_map{}]); +types(maps, map, [Fun, Map]) -> + RetType = case {Fun, Map} of + {#t_fun{type=FunRet}, #t_map{super_value=SValue0}} -> + SValue = beam_types:join(FunRet, SValue0), + Map#t_map{super_value=SValue}; + _ -> + #t_map{} + end, + sub_unsafe(RetType, [#t_fun{arity=2}, #t_map{}]); +types(maps, merge, [A, B]) -> + RetType = case {A, B} of + {#t_map{super_key=SKeyA,super_value=SValueA}, + #t_map{super_key=SKeyB,super_value=SValueB}} -> + SKey = beam_types:join(SKeyA, SKeyB), + SValue = beam_types:join(SValueA, SValueB), + #t_map{super_key=SKey,super_value=SValue}; + _ -> + #t_map{} + end, + sub_unsafe(RetType, [#t_map{}, #t_map{}]); +types(maps, new, []) -> + RetType = #t_map{super_key=none,super_value=none}, + sub_unsafe(RetType, []); +types(maps, put, [Key, Value, Map]) -> + RetType = case Map of + #t_map{super_key=SKey0,super_value=SValue0} -> + SKey = beam_types:join(Key, SKey0), + SValue = beam_types:join(Value, SValue0), + #t_map{super_key=SKey,super_value=SValue}; + _ -> + #t_map{} + end, + sub_unsafe(RetType, [any, any, #t_map{}]); +types(maps, remove, [Key, Map]) -> + RetType = maps_remove_type(Key, Map), + sub_unsafe(RetType, [any, #t_map{}]); +types(maps, take, [Key, Map]) -> + TupleType = case erlang_map_get_type(Key, Map) of + none -> + none; + ValueType -> + MapType = beam_types:meet(Map, #t_map{}), + make_two_tuple(ValueType, MapType) + end, + %% error | {Value, Map} + RetType = beam_types:join(beam_types:make_atom(error), TupleType), + sub_unsafe(RetType, [any, #t_map{}]); +types(maps, to_list, [Map]) -> + RetType = case Map of + #t_map{super_key=SKey,super_value=SValue} -> + proper_list(make_two_tuple(SKey, SValue)); + _ -> + proper_list() + end, + sub_unsafe(RetType, [#t_map{}]); +types(maps, update_with, [_Key, Fun, Map]) -> + RetType = case {Fun, Map} of + {#t_fun{type=FunRet}, #t_map{super_value=SValue0}} -> + SValue = beam_types:join(FunRet, SValue0), + Map#t_map{super_value=SValue}; + _ -> + #t_map{} + end, + sub_unsafe(RetType, [any, #t_fun{arity=1}, #t_map{}]); +types(maps, values, [Map]) -> + RetType = case Map of + #t_map{super_value=none} -> nil; + #t_map{super_value=SValue} -> proper_list(SValue); + _ -> proper_list() + end, + sub_unsafe(RetType, [#t_map{}]); +types(maps, with, [Keys, Map]) -> + RetType = case Map of + #t_map{super_key=SKey0} -> + %% Since we know that the Map will only contain the pairs + %% pointed out by Keys, we can restrict the types to + %% those in the list. + SKey = beam_types:meet(erlang_hd_type(Keys), SKey0), + Map#t_map{super_key=SKey}; + _ -> + #t_map{} + end, + sub_unsafe(RetType, [proper_list(), #t_map{}]); +types(maps, without, [Keys, Map]) -> + RetType = maps_remove_type(erlang_hd_type(Keys), Map), + sub_unsafe(RetType, [proper_list(), #t_map{}]); + +%% Catch-all clause for unknown functions. + +types(_, _, Args) -> + sub_unsafe(any, [any || _ <- Args]). + +%% +%% Function-specific helpers. +%% + +mixed_arith_types([FirstType | _]=Args0) -> + RetType = foldl(fun(#t_integer{}, #t_integer{}) -> #t_integer{}; + (#t_integer{}, number) -> number; + (#t_integer{}, #t_float{}) -> #t_float{}; + (#t_float{}, #t_integer{}) -> #t_float{}; + (#t_float{}, number) -> #t_float{}; + (#t_float{}, #t_float{}) -> #t_float{}; + (number, #t_integer{}) -> number; + (number, #t_float{}) -> #t_float{}; + (number, number) -> number; + (any, _) -> number; + (_, _) -> none + end, FirstType, Args0), + sub_unsafe(RetType, [number || _ <- Args0]). + +erlang_hd_type(Src) -> + case beam_types:meet(Src, #t_cons{}) of + #t_cons{type=Type} -> Type; + _ -> any + end. + +erlang_tl_type(Src) -> + case beam_types:meet(Src, #t_cons{}) of + #t_cons{terminator=Term}=Cons -> beam_types:join(Cons, Term); + _ -> any + end. + +erlang_band_type([#t_integer{elements={Int,Int}}, RHS]) when is_integer(Int) -> + erlang_band_type_1(RHS, Int); +erlang_band_type([LHS, #t_integer{elements={Int,Int}}]) when is_integer(Int) -> + erlang_band_type_1(LHS, Int); +erlang_band_type(_) -> + #t_integer{}. + +erlang_band_type_1(LHS, Int) -> + case LHS of + #t_integer{elements={Min0,Max0}} when Max0 - Min0 < 1 bsl 256 -> + {Intersection, Union} = range_masks(Min0, Max0), + + Min = Intersection band Int, + Max = min(Max0, Union band Int), + + #t_integer{elements={Min,Max}}; + _ when Int >= 0 -> + %% The range is either unknown or too wide, conservatively assume + %% that the new range is 0 .. Int. + beam_types:meet(LHS, #t_integer{elements={0,Int}}); + _ -> + %% We can't infer boundaries when LHS is not an integer or + %% the range is unknown and the other operand is a + %% negative number, as the latter sign-extends to infinity + %% and we can't express an inverted range at the moment + %% (cf. X band -8; either less than -7 or greater than 7). + beam_types:meet(LHS, #t_integer{}) + end. + +erlang_map_get_type(Key, Map) -> + case Map of + #t_map{super_key=SKey,super_value=SValue} -> + case beam_types:meet(SKey, Key) of + none -> none; + _ -> SValue + end; + _ -> + any + end. + +lists_fold_type(_Fun, Init, nil) -> + Init; +lists_fold_type(#t_fun{type=Type}, _Init, #t_cons{}) -> + %% The list is non-empty so it's safe to ignore Init. + Type; +lists_fold_type(#t_fun{type=Type}, Init, #t_list{}) -> + %% The list is possibly empty so we have to assume it can return the + %% initial value, whose type can differ significantly from the fun's + %% return value. + beam_types:join(Type, Init); +lists_fold_type(_Fun, _Init, _List) -> + any. + +lists_map_type(#t_fun{type=Type}, Types) -> + lists_map_type_1(Types, Type); +lists_map_type(_Fun, Types) -> + lists_map_type_1(Types, any). + +lists_map_type_1(nil, _ElementType) -> + nil; +lists_map_type_1(#t_cons{}, none) -> + %% The list is non-empty and the fun never returns. + none; +lists_map_type_1(#t_cons{}, ElementType) -> + proper_cons(ElementType); +lists_map_type_1(_, none) -> + %% The fun never returns, so the only way we could return normally is + %% if the list is empty. + nil; +lists_map_type_1(_, ElementType) -> + proper_list(ElementType). + +lists_mapfold_type(#t_fun{type=#t_tuple{size=2,elements=Es}}, Init, List) -> + ElementType = beam_types:get_tuple_element(1, Es), + AccType = beam_types:get_tuple_element(2, Es), + lists_mapfold_type_1(List, ElementType, Init, AccType); +lists_mapfold_type(#t_fun{type=none}, _Init, #t_cons{}) -> + %% The list is non-empty and the fun never returns. + none; +lists_mapfold_type(#t_fun{type=none}, Init, _List) -> + %% The fun never returns, so the only way we could return normally is + %% if the list is empty, in which case we'll return [] and the initial + %% value. + make_two_tuple(nil, Init); +lists_mapfold_type(_Fun, Init, List) -> + lists_mapfold_type_1(List, any, Init, any). + +lists_mapfold_type_1(nil, _ElementType, Init, _AccType) -> + make_two_tuple(nil, Init); +lists_mapfold_type_1(#t_cons{}, ElementType, _Init, AccType) -> + %% The list has at least one element, so it's safe to ignore Init. + make_two_tuple(proper_cons(ElementType), AccType); +lists_mapfold_type_1(_, ElementType, Init, AccType0) -> + %% We can only rely on AccType when we know the list is non-empty, so we + %% have to join it with the initial value in case the list is empty. + AccType = beam_types:join(AccType0, Init), + make_two_tuple(proper_list(ElementType), AccType). + +lists_unzip_type(Size, List) -> + Es = lut_make_elements(lut_list_types(Size, List), 1, #{}), + #t_tuple{size=Size,exact=true,elements=Es}. + +lut_make_elements([Type | Types], Index, Es0) -> + Es = beam_types:set_tuple_element(Index, Type, Es0), + lut_make_elements(Types, Index + 1, Es); +lut_make_elements([], _Index, Es) -> + Es. + +lut_list_types(Size, #t_cons{type=#t_tuple{size=Size,elements=Es}}) -> + Types = lut_element_types(1, Size, Es), + [proper_cons(T) || T <- Types]; +lut_list_types(Size, #t_list{type=#t_tuple{size=Size,elements=Es}}) -> + Types = lut_element_types(1, Size, Es), + [proper_list(T) || T <- Types]; +lut_list_types(Size, nil) -> + lists:duplicate(Size, nil); +lut_list_types(Size, _) -> + lists:duplicate(Size, proper_list()). + +lut_element_types(Index, Max, #{}) when Index > Max -> + []; +lut_element_types(Index, Max, Es) -> + ElementType = beam_types:get_tuple_element(Index, Es), + [ElementType | lut_element_types(Index + 1, Max, Es)]. + +%% lists:zip/2 and friends only succeed when all arguments have the same +%% length, so if one of them is #t_cons{}, we can infer that all of them are +%% #t_cons{} on success. + +lists_zip_types(Types) -> + lists_zip_types_1(Types, false, #{}, 1). + +lists_zip_types_1([nil | _], _AnyCons, _Es, _N) -> + %% Early exit; we know the result is [] on success. + {nil, nil}; +lists_zip_types_1([#t_cons{type=Type,terminator=nil} | Lists], + _AnyCons, Es0, N) -> + Es = beam_types:set_tuple_element(N, Type, Es0), + lists_zip_types_1(Lists, true, Es, N + 1); +lists_zip_types_1([#t_list{type=Type,terminator=nil} | Lists], + AnyCons, Es0, N) -> + Es = beam_types:set_tuple_element(N, Type, Es0), + lists_zip_types_1(Lists, AnyCons, Es, N + 1); +lists_zip_types_1([_ | Lists], AnyCons, Es, N) -> + lists_zip_types_1(Lists, AnyCons, Es, N + 1); +lists_zip_types_1([], true, Es, N) -> + %% At least one element was cons, so we know it's non-empty on success. + ElementType = #t_tuple{exact=true,size=(N - 1),elements=Es}, + RetType = proper_cons(ElementType), + ArgType = proper_cons(), + {RetType, ArgType}; +lists_zip_types_1([], false, Es, N) -> + ElementType = #t_tuple{exact=true,size=(N - 1),elements=Es}, + RetType = proper_list(ElementType), + ArgType = proper_list(), + {RetType, ArgType}. + +lists_zipwith_types(#t_fun{type=Type}, Types) -> + lists_zipwith_type_1(Types, Type); +lists_zipwith_types(_Fun, Types) -> + lists_zipwith_type_1(Types, any). + +lists_zipwith_type_1([nil | _], _ElementType) -> + %% Early exit; we know the result is [] on success. + {nil, nil}; +lists_zipwith_type_1([#t_cons{} | _Lists], none) -> + %% Early exit; the list is non-empty and we know the fun never + %% returns. + {none, any}; +lists_zipwith_type_1([#t_cons{} | _Lists], ElementType) -> + %% Early exit; we know the result is cons on success. + RetType = proper_cons(ElementType), + ArgType = proper_cons(), + {RetType, ArgType}; +lists_zipwith_type_1([_ | Lists], ElementType) -> + lists_zipwith_type_1(Lists, ElementType); +lists_zipwith_type_1([], none) -> + %% Since we know the fun won't return, the only way we could return + %% normally is if all lists are empty. + {nil, nil}; +lists_zipwith_type_1([], ElementType) -> + RetType = proper_list(ElementType), + ArgType = proper_list(), + {RetType, ArgType}. + +maps_remove_type(Key, #t_map{super_key=SKey0}=Map) -> + case beam_types:is_singleton_type(Key) of + true -> + SKey = beam_types:subtract(SKey0, Key), + Map#t_map{super_key=SKey}; + false -> + Map + end; +maps_remove_type(_Key, _Map) -> + #t_map{}. + +%%% +%%% Generic helpers +%%% + +sub_unsafe(RetType, ArgTypes) -> + {RetType, ArgTypes, false}. + +sub_safe(RetType, ArgTypes) -> + {RetType, ArgTypes, true}. + +discard_tuple_element_info(Min, Max, Es) -> + foldl(fun(El, Acc) when Min =< El, El =< Max -> + maps:remove(El, Acc); + (_El, Acc) -> Acc + end, Es, maps:keys(Es)). + +%% Returns two bitmasks describing all possible values between From and To. +%% +%% The first contains the bits that are common to all values, and the second +%% contains the bits that are set by any value in the range. +range_masks(From, To) when From =< To -> + range_masks_1(From, To, 0, -1, 0). + +range_masks_1(From, To, BitPos, Intersection, Union) when From < To -> + range_masks_1(From + (1 bsl BitPos), To, BitPos + 1, + Intersection band From, Union bor From); +range_masks_1(_From, To, _BitPos, Intersection0, Union0) -> + Intersection = To band Intersection0, + Union = To bor Union0, + {Intersection, Union}. + +proper_cons() -> + #t_cons{terminator=nil}. + +proper_cons(ElementType) -> + #t_cons{type=ElementType,terminator=nil}. + +proper_list() -> + #t_list{terminator=nil}. + +proper_list(ElementType) -> + #t_list{type=ElementType,terminator=nil}. + +%% Constructs a new list type based on another, optionally keeping the same +%% length and/or making it proper. +-spec copy_list(List, Length, Proper) -> type() when + List :: type(), + Length :: same_length | new_length, + Proper :: proper | maybe_improper. +copy_list(#t_cons{terminator=Term}=T, Length, maybe_improper) -> + copy_list_1(T, Length, Term); +copy_list(#t_list{terminator=Term}=T, Length, maybe_improper) -> + copy_list_1(T, Length, Term); +copy_list(T, Length, proper) -> + copy_list_1(T, Length, nil); +copy_list(T, Length, _Proper) -> + copy_list_1(T, Length, any). + +copy_list_1(#t_cons{}=T, same_length, Terminator) -> + T#t_cons{terminator=Terminator}; +copy_list_1(#t_cons{type=Type}, new_length, Terminator) -> + #t_list{type=Type,terminator=Terminator}; +copy_list_1(#t_list{}=T, _Length, Terminator) -> + T#t_list{terminator=Terminator}; +copy_list_1(nil, _Length, _Terminator) -> + nil; +copy_list_1(_, _Length, Terminator) -> + #t_list{terminator=Terminator}. + +make_two_tuple(Type1, Type2) -> + Es0 = beam_types:set_tuple_element(1, Type1, #{}), + Es = beam_types:set_tuple_element(2, Type2, Es0), + #t_tuple{size=2,exact=true,elements=Es}. diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index 7299654476..6b2b2ce085 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -34,7 +34,8 @@ module({Mod,Exp,Attr,Fs0,_}, Opts) -> Used = find_all_used(WorkList, All, cerl_sets:from_list(WorkList)), Fs1 = remove_unused(Order, Used, All), {Fs2,Lc} = clean_labels(Fs1), - Fs = maybe_remove_lines(Fs2, Opts), + Fs3 = fix_swap(Fs2, Opts), + Fs = maybe_remove_lines(Fs3, Opts), {ok,{Mod,Exp,Attr,Fs,Lc}}. %% Determine the rootset, i.e. exported functions and @@ -137,31 +138,54 @@ function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) -> function_replace([], _, Acc) -> Acc. %%% +%%% If compatibility with a previous release (OTP 22 or earlier) has +%%% been requested, replace swap instructions with a sequence of moves. +%%% + +fix_swap(Fs, Opts) -> + case proplists:get_bool(no_swap, Opts) of + false -> Fs; + true -> fold_functions(fun swap_moves/1, Fs) + end. + +swap_moves([{swap,Reg1,Reg2}|Is]) -> + Temp = {x,1022}, + [{move,Reg1,Temp},{move,Reg2,Reg1},{move,Temp,Reg2}|swap_moves(Is)]; +swap_moves([I|Is]) -> + [I|swap_moves(Is)]; +swap_moves([]) -> []. + +%%% %%% Remove line instructions if requested. %%% maybe_remove_lines(Fs, Opts) -> case proplists:get_bool(no_line_info, Opts) of false -> Fs; - true -> remove_lines(Fs) + true -> fold_functions(fun remove_lines/1, Fs) end. -remove_lines([{function,N,A,Lbl,Is0}|T]) -> - Is = remove_lines_fun(Is0), - [{function,N,A,Lbl,Is}|remove_lines(T)]; -remove_lines([]) -> []. - -remove_lines_fun([{line,_}|Is]) -> - remove_lines_fun(Is); -remove_lines_fun([{block,Bl0}|Is]) -> +remove_lines([{line,_}|Is]) -> + remove_lines(Is); +remove_lines([{block,Bl0}|Is]) -> Bl = remove_lines_block(Bl0), - [{block,Bl}|remove_lines_fun(Is)]; -remove_lines_fun([I|Is]) -> - [I|remove_lines_fun(Is)]; -remove_lines_fun([]) -> []. + [{block,Bl}|remove_lines(Is)]; +remove_lines([I|Is]) -> + [I|remove_lines(Is)]; +remove_lines([]) -> []. remove_lines_block([{set,_,_,{line,_}}|Is]) -> remove_lines_block(Is); remove_lines_block([I|Is]) -> [I|remove_lines_block(Is)]; remove_lines_block([]) -> []. + + +%%% +%%% Helpers. +%%% + +fold_functions(F, [{function,N,A,Lbl,Is0}|T]) -> + Is = F(Is0), + [{function,N,A,Lbl,Is}|fold_functions(F, T)]; +fold_functions(_F, []) -> []. diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index b2056332e6..b6f8c5a6e7 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -36,10 +36,11 @@ -type import_tab() :: gb_trees:tree(mfa(), index()). -type fname_tab() :: #{Name :: term() => index()}. -type line_tab() :: #{{Fname :: index(), Line :: term()} => index()}. --type literal_tab() :: dict:dict(Literal :: term(), index()). +-type literal_tab() :: #{Literal :: term() => index()}. -type lambda_info() :: {label(),{index(),label(),non_neg_integer()}}. -type lambda_tab() :: {non_neg_integer(),[lambda_info()]}. +-type wrapper() :: #{label() => index()}. -record(asm, {atoms = #{} :: atom_tab(), @@ -48,7 +49,8 @@ imports = gb_trees:empty() :: import_tab(), strings = <<>> :: binary(), %String pool lambdas = {0,[]} :: lambda_tab(), - literals = dict:new() :: literal_tab(), + wrappers = #{} :: wrapper(), + literals = #{} :: literal_tab(), fnames = #{} :: fname_tab(), lines = #{} :: line_tab(), num_lines = 0 :: non_neg_integer(), %Number of line instructions @@ -147,22 +149,32 @@ string(BinString, Dict) when is_binary(BinString) -> -spec lambda(label(), non_neg_integer(), bdict()) -> {non_neg_integer(), bdict()}. -lambda(Lbl, NumFree, #asm{lambdas={OldIndex,Lambdas0}}=Dict) -> - %% Set Index the same as OldIndex. - Index = OldIndex, - Lambdas = [{Lbl,{Index,Lbl,NumFree}}|Lambdas0], - {OldIndex,Dict#asm{lambdas={OldIndex+1,Lambdas}}}. +lambda(Lbl, NumFree, #asm{wrappers=Wrappers0, + lambdas={OldIndex,Lambdas0}}=Dict) -> + case Wrappers0 of + #{Lbl:=Index} -> + %% OTP 23: There old is a fun entry for this wrapper function. + %% Share the fun entry. + {Index,Dict}; + #{} -> + %% Set Index the same as OldIndex. + Index = OldIndex, + Wrappers = Wrappers0#{Lbl=>Index}, + Lambdas = [{Lbl,{Index,Lbl,NumFree}}|Lambdas0], + {OldIndex,Dict#asm{wrappers=Wrappers, + lambdas={OldIndex+1,Lambdas}}} + end. %% Returns the index for a literal (adding it to the literal table if necessary). %% literal(Literal, Dict) -> {Index,Dict'} -spec literal(term(), bdict()) -> {non_neg_integer(), bdict()}. literal(Lit, #asm{literals=Tab0,next_literal=NextIndex}=Dict) -> - case dict:find(Lit, Tab0) of - {ok,Index} -> + case Tab0 of + #{Lit:=Index} -> {Index,Dict}; - error -> - Tab = dict:store(Lit, NextIndex, Tab0), + #{} -> + Tab = Tab0#{Lit=>NextIndex}, {NextIndex,Dict#asm{literals=Tab,next_literal=NextIndex+1}} end. @@ -253,7 +265,7 @@ lambda_table(#asm{locals=Loc0,lambdas={NumLambdas,Lambdas0}}) -> -spec literal_table(bdict()) -> {non_neg_integer(), [[binary(),...]]}. literal_table(#asm{literals=Tab,next_literal=NumLiterals}) -> - L0 = dict:fold(fun(Lit, Num, Acc) -> + L0 = maps:fold(fun(Lit, Num, Acc) -> [{Num,my_term_to_binary(Lit)}|Acc] end, [], Tab), L1 = lists:sort(L0), @@ -261,7 +273,12 @@ literal_table(#asm{literals=Tab,next_literal=NumLiterals}) -> {NumLiterals,L}. my_term_to_binary(Term) -> - term_to_binary(Term, [{minor_version,1}]). + %% Use the latest possible minor version. Minor version 2 can be + %% be decoded by OTP 16, which is as far back as we have compatibility + %% options for the compiler. (When this comment was written, some time + %% after the release of OTP 22, the default minor version was 1.) + + term_to_binary(Term, [{minor_version,2}]). %% Return the line table. -spec line_table(bdict()) -> diff --git a/lib/compiler/src/beam_digraph.erl b/lib/compiler/src/beam_digraph.erl new file mode 100644 index 0000000000..800fcf4c22 --- /dev/null +++ b/lib/compiler/src/beam_digraph.erl @@ -0,0 +1,308 @@ + +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. 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% +%% +%% Digraph data type. Similar to the digraph module, but provides a +%% functional API. The functional API allows us to revert to a +%% previous version of the digraph when an optimization that may have +%% damaged the digraph has failed. +%% + +-module(beam_digraph). + +-export([new/0, + add_vertex/2, add_vertex/3, add_edge/3, add_edge/4, + del_edge/2, del_edges/2, + has_vertex/2, + is_path/3, + in_degree/2, in_edges/2, in_neighbours/2, + out_degree/2, out_edges/2, out_neighbours/2, + vertex/2, vertices/1, + reverse_postorder/2, + roots/1, + topsort/1, + strong_components/2]). + +%% Debugging. +-define(DEBUG, false). +-if(?DEBUG). +-export([dump/1,dump/2,dump/3]). +-endif. + +-import(lists, [foldl/3, reverse/1]). + +-type edge_map() :: #{ vertex() => ordsets:ordset(vertex()) }. +-type vertice_map() :: #{ vertex() => label() }. + +-record(dg, {vs = #{} :: vertice_map(), + in_es = #{} :: edge_map(), + out_es = #{} :: edge_map()}). + +-type graph() :: #dg{}. + +-type vertex() :: term(). +-type label() :: term(). +-type edge() :: {vertex(), vertex(), label()}. + +-spec new() -> graph(). +new() -> #dg{}. + +-spec add_vertex(graph(), vertex()) -> graph(). +add_vertex(Dg, V) -> + add_vertex(Dg, V, vertex). + +-spec add_vertex(graph(), vertex(), label()) -> graph(). +add_vertex(Dg, V, Label) -> + #dg{in_es=InEsMap0,out_es=OutEsMap0,vs=Vs0} = Dg, + InEsMap = init_edge_map(V, InEsMap0), + OutEsMap = init_edge_map(V, OutEsMap0), + Vs = Vs0#{V=>Label}, + Dg#dg{vs=Vs,in_es=InEsMap,out_es=OutEsMap}. + +init_edge_map(V, EsMap) -> + case is_map_key(V, EsMap) of + true -> + EsMap; + false -> + EsMap#{V=>ordsets:new()} + end. + +-spec add_edge(graph(), vertex(), vertex()) -> graph(). +add_edge(Dg, From, To) -> + add_edge(Dg, From, To, edge). + +-spec add_edge(graph(), vertex(), vertex(), label()) -> graph(). +add_edge(Dg, From, To, Label) -> + #dg{in_es=InEsMap0,out_es=OutEsMap0} = Dg, + Name = {From,To,Label}, + InEsMap = edge_map_add(To, Name, InEsMap0), + OutEsMap = edge_map_add(From, Name, OutEsMap0), + Dg#dg{in_es=InEsMap,out_es=OutEsMap}. + +edge_map_add(V, E, EsMap) -> + Es0 = map_get(V, EsMap), + Es = ordsets:add_element(E, Es0), + EsMap#{V:=Es}. + +-spec del_edge(graph(), edge()) -> graph(). +del_edge(Dg, {From,To,_}=E) -> + #dg{in_es=InEsMap0,out_es=OutEsMap0} = Dg, + InEsMap = edge_map_del(To, E, InEsMap0), + OutEsMap = edge_map_del(From, E, OutEsMap0), + Dg#dg{in_es=InEsMap,out_es=OutEsMap}. + +edge_map_del(V, E, EsMap) -> + Es0 = map_get(V, EsMap), + Es = Es0 -- [E], + EsMap#{V:=Es}. + +-spec del_edges(graph(), [edge()]) -> graph(). +del_edges(G, Es) when is_list(Es) -> + foldl(fun(E, A) -> del_edge(A, E) end, G, Es). + +-spec has_vertex(graph(), vertex()) -> boolean(). +has_vertex(#dg{vs=Vs}, V) -> + is_map_key(V, Vs). + +-spec in_degree(graph(), vertex()) -> non_neg_integer(). +in_degree(#dg{in_es=InEsMap}, V) -> + length(map_get(V, InEsMap)). + +-spec in_edges(graph(), vertex()) -> [edge()]. +in_edges(#dg{in_es=InEsMap}, V) -> + map_get(V, InEsMap). + +-spec in_neighbours(graph(), vertex()) -> [vertex()]. +in_neighbours(#dg{in_es=InEsMap}, V) -> + [From || {From,_,_} <- map_get(V, InEsMap)]. + +-spec is_path(graph(), vertex(), vertex()) -> boolean(). +is_path(G, From, To) -> + Seen = cerl_sets:new(), + try + _ = is_path_1([From], To, G, Seen), + false + catch + throw:true -> + true + end. + +is_path_1([To|_], To, _G, _Seen) -> + throw(true); +is_path_1([V|Vs], To, G, Seen0) -> + case cerl_sets:is_element(V, Seen0) of + true -> + is_path_1(Vs, To, G, Seen0); + false -> + Seen1 = cerl_sets:add_element(V, Seen0), + Successors = out_neighbours(G, V), + Seen = is_path_1(Successors, To, G, Seen1), + is_path_1(Vs, To, G, Seen) + end; +is_path_1([], _To, _G, Seen) -> + Seen. + +-spec out_degree(graph(), vertex()) -> non_neg_integer(). +out_degree(#dg{out_es=OutEsMap}, V) -> + length(map_get(V, OutEsMap)). + +-spec out_edges(graph(), vertex()) -> [edge()]. +out_edges(#dg{out_es=OutEsMap}, V) -> + map_get(V, OutEsMap). + +-spec out_neighbours(graph(), vertex()) -> [vertex()]. +out_neighbours(#dg{out_es=OutEsMap}, V) -> + [To || {_,To,_} <- map_get(V, OutEsMap)]. + +-spec vertex(graph(), vertex()) -> label(). +vertex(#dg{vs=Vs}, V) -> + map_get(V, Vs). + +-spec vertices(graph()) -> [{vertex(), label()}]. +vertices(#dg{vs=Vs}) -> + maps:to_list(Vs). + +-spec reverse_postorder(graph(), [vertex()]) -> [vertex()]. +reverse_postorder(G, Vs) -> + Seen = cerl_sets:new(), + {RPO, _} = reverse_postorder_1(Vs, G, Seen, []), + RPO. + +reverse_postorder_1([V|Vs], G, Seen0, Acc0) -> + case cerl_sets:is_element(V, Seen0) of + true -> + reverse_postorder_1(Vs, G, Seen0, Acc0); + false -> + Seen1 = cerl_sets:add_element(V, Seen0), + Successors = out_neighbours(G, V), + {Acc,Seen} = reverse_postorder_1(Successors, G, Seen1, Acc0), + reverse_postorder_1(Vs, G, Seen, [V|Acc]) + end; +reverse_postorder_1([], _, Seen, Acc) -> + {Acc, Seen}. + +-spec roots(graph()) -> [vertex()]. +roots(G) -> + roots_1(vertices(G), G). + +roots_1([{V,_}|Vs], G) -> + case in_degree(G, V) of + 0 -> + [V|roots_1(Vs, G)]; + _ -> + roots_1(Vs, G) + end; +roots_1([], _G) -> []. + +-spec topsort(graph()) -> [vertex()]. +topsort(G) -> + Seen = roots(G), + reverse_postorder(G, Seen). + +%% +%% Kosaraju's algorithm +%% +%% Visit each node in reverse post order. If the node has not been assigned to +%% a component yet, start a new component and add all of its in-neighbors to it +%% if they don't yet belong to one. Keep going until all nodes have been +%% visited. +%% +%% https://en.wikipedia.org/wiki/Kosaraju%27s_algorithm +%% + +-spec strong_components(graph(), [vertex()]) -> ComponentMap when + %% Vertices together with their components. + ComponentMap :: #{ vertex() => [vertex()] }. +strong_components(G, Vs) -> + sc_1(Vs, G, #{}, #{}). + +sc_1([V | Vs], G, Roots0, Components) when not is_map_key(V, Roots0) -> + %% V has not been assigned to a component, start a new one with this one as + %% the root. + {Roots, Component} = sc_2([V], G, V, Roots0, []), + sc_1(Vs, G, Roots, Components#{ V => Component }); +sc_1([V | Vs], G, Roots, Components0) -> + %% V is already part of a component, copy it over. + Root = map_get(V, Roots), + Components = Components0#{ V => map_get(Root, Components0) }, + + sc_1(Vs, G, Roots, Components); +sc_1([], _G, _Roots, Components) -> + Components. + +sc_2([V | Vs], G, Root, Roots, Acc) when not is_map_key(V, Roots) -> + %% V has not been assigned to a component, so assign it to the current one. + sc_2(in_neighbours(G, V) ++ Vs, G, Root, Roots#{ V => Root }, [V | Acc]); +sc_2([_V | Vs], G, Root, Roots, Acc) -> + %% V is already part of a component, skip it. + sc_2(Vs, G, Root, Roots, Acc); +sc_2([], _G, _Root, Roots, Acc) -> + {Roots, reverse(Acc)}. + +-if(?DEBUG). + +%% +%% Dumps the graph as a string in dot (graphviz) format. +%% +%% Use dot(1) to convert to an image: +%% +%% dot [input] -T[format] +%% dot graph_file -Tsvg > graph.svg + +-spec dump(any()) -> any(). +dump(G) -> + Formatter = fun(Node) -> io_lib:format("~p", [Node]) end, + io:format("~s", [dump_1(G, Formatter)]). + +-spec dump(any(), any()) -> any(). +dump(G, FileName) -> + Formatter = fun(Node) -> io_lib:format("~p", [Node]) end, + dump(G, FileName, Formatter). + +-spec dump(any(), any(), any()) -> any(). +dump(G, FileName, Formatter) -> + {ok, Fd} = file:open(FileName, [write]), + io:fwrite(Fd, "~s", [dump_1(G, Formatter)]), + file:close(Fd). + +dump_1(G, Formatter) -> + Vs = maps:keys(G#dg.vs), + + {Map, Vertices} = dump_vertices(Vs, 0, Formatter,#{}, []), + Edges = dump_edges(Vs, G, Map, []), + + io_lib:format("digraph g {~n~s~n~s~n}~n", [Vertices, Edges]). + +dump_vertices([V | Vs], Counter, Formatter, Map, Acc) -> + VerticeSlug = io_lib:format(" ~p [label=\"~s\"]~n", + [Counter, Formatter(V)]), + dump_vertices(Vs, Counter + 1, Formatter, + Map#{ V => Counter }, [VerticeSlug | Acc]); +dump_vertices([], _Counter, _Formatter, Map, Acc) -> + {Map, Acc}. + +dump_edges([V | Vs], G, Map, Acc) -> + SelfId = map_get(V, Map), + EdgeSlug = [io_lib:format(" ~p -> ~p~n", [SelfId, map_get(To, Map)]) || + {_, To, _} <- out_edges(G, V)], + dump_edges(Vs, G, Map, [EdgeSlug | Acc]); +dump_edges([], _G, _Map, Acc) -> + Acc. + +-endif. diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index 7d048716e4..c52edd6635 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -1123,6 +1123,15 @@ resolve_inst({put_tuple2,[Dst,{{z,1},{u,_},List0}]},_,_,_) -> {put_tuple2,Dst,{list,List}}; %% +%% OTP 23. +%% +resolve_inst({bs_start_match4,[Fail,Live,Src,Dst]},_,_,_) -> + {bs_start_match4,Fail,Live,Src,Dst}; +resolve_inst({swap,[_,_]=List},_,_,_) -> + [R1,R2] = resolve_args(List), + {swap,R1,R2}; + +%% %% Catches instructions that are not yet handled. %% resolve_inst(X,_,_,_) -> ?exit({resolve_inst,X}). diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl deleted file mode 100644 index 04a5e3430a..0000000000 --- a/lib/compiler/src/beam_except.erl +++ /dev/null @@ -1,256 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2011-2018. 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(beam_except). --export([module/2]). - -%%% Rewrite certain calls to erlang:error/{1,2} to specialized -%%% instructions: -%%% -%%% erlang:error({badmatch,Value}) => badmatch Value -%%% erlang:error({case_clause,Value}) => case_end Value -%%% erlang:error({try_clause,Value}) => try_case_end Value -%%% erlang:error(if_clause) => if_end -%%% erlang:error(function_clause, Args) => jump FuncInfoLabel -%%% - --import(lists, [reverse/1,reverse/2,seq/2,splitwith/2]). - --spec module(beam_utils:module_code(), [compile:option()]) -> - {'ok',beam_utils:module_code()}. - -module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> - Fs = [function(F) || F <- Fs0], - {ok,{Mod,Exp,Attr,Fs,Lc}}. - -function({function,Name,Arity,CLabel,Is0}) -> - try - Is = function_1(Is0), - {function,Name,Arity,CLabel,Is} - catch - Class:Error:Stack -> - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) - end. - --record(st, - {lbl :: beam_asm:label(), %func_info label - loc :: [_], %location for func_info - arity :: arity() %arity for function - }). - -function_1(Is0) -> - case Is0 of - [{label,Lbl},{line,Loc},{func_info,_,_,Arity}|_] -> - St = #st{lbl=Lbl,loc=Loc,arity=Arity}, - translate(Is0, St, []); - [{label,_}|_] -> - %% No line numbers. The source must be a .S file. - %% There is no need to do anything. - Is0 - end. - -translate([{call_ext,Ar,{extfunc,erlang,error,Ar}}=I|Is], St, Acc) -> - translate_1(Ar, I, Is, St, Acc); -translate([I|Is], St, Acc) -> - translate(Is, St, [I|Acc]); -translate([], _, Acc) -> - reverse(Acc). - -translate_1(Ar, I, Is, #st{arity=Arity}=St, [{line,_}=Line|Acc1]=Acc0) -> - case dig_out(Ar, Arity, Acc1) of - no -> - translate(Is, St, [I|Acc0]); - {yes,function_clause,Acc2} -> - case {Is,Line,St} of - {[return|_],{line,Loc},#st{lbl=Fi,loc=Loc}} -> - Instr = {jump,{f,Fi}}, - translate(Is, St, [Instr|Acc2]); - {_,_,_} -> - %% Not a call_only instruction, or not the same - %% location information as in in the line instruction - %% before the func_info instruction. Not safe - %% to translate to a jump. - translate(Is, St, [I|Acc0]) - end; - {yes,Instr,Acc2} -> - translate(Is, St, [Instr,Line|Acc2]) - end. - -dig_out(1, _Arity, Is) -> - dig_out(Is); -dig_out(2, Arity, Is) -> - dig_out_fc(Arity, Is); -dig_out(_, _, _) -> no. - -dig_out([{block,Bl0}|Is]) -> - case dig_out_block(reverse(Bl0)) of - no -> no; - {yes,What,[]} -> - {yes,What,Is}; - {yes,What,Bl} -> - {yes,What,[{block,Bl}|Is]} - end; -dig_out(_) -> no. - -dig_out_block([{set,[{x,0}],[{atom,if_clause}],move}]) -> - {yes,if_end,[]}; -dig_out_block([{set,[{x,0}],[{literal,{Exc,Value}}],move}|Is]) -> - translate_exception(Exc, {literal,Value}, Is, 0); -dig_out_block([{set,[{x,0}],[{atom,Exc},Value],put_tuple2}|Is]) -> - translate_exception(Exc, Value, Is, 3); -dig_out_block(_) -> no. - -translate_exception(badmatch, Val, Is, Words) -> - {yes,{badmatch,Val},fix_block(Is, Words)}; -translate_exception(case_clause, Val, Is, Words) -> - {yes,{case_end,Val},fix_block(Is, Words)}; -translate_exception(try_clause, Val, Is, Words) -> - {yes,{try_case_end,Val},fix_block(Is, Words)}; -translate_exception(_, _, _, _) -> no. - -fix_block(Is, 0) -> - reverse(Is); -fix_block(Is, Words) -> - reverse(fix_block_1(Is, Words)). - -fix_block_1([{set,[],[],{alloc,Live,{F1,F2,Needed0,F3}}}|Is], Words) - when is_integer(Needed0) -> - case Needed0 - Words of - 0 -> - Is; - Needed -> - true = Needed >= 0, %Assertion. - [{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is] - end; -fix_block_1([I|Is], Words) -> - [I|fix_block_1(Is, Words)]; -fix_block_1([], _Words) -> - %% Rare. The heap allocation was probably done by a binary - %% construction instruction. - []. - -dig_out_fc(Arity, Is0) -> - Regs0 = maps:from_list([{{x,X},{arg,X}} || X <- seq(0, Arity-1)]), - {Is,Acc0} = splitwith(fun({label,_}) -> false; - ({test,_,_,_}) -> false; - (_) -> true - end, Is0), - {Regs,Acc} = dig_out_fc_1(reverse(Is), Arity, Regs0, Acc0), - case Regs of - #{{x,0}:={atom,function_clause},{x,1}:=Args} -> - case moves_from_stack(Args, 0, []) of - {Moves,Arity} -> - {yes,function_clause,reverse(Moves, Acc)}; - {_,_} -> - no - end; - #{} -> - no - end. - -dig_out_fc_1([{block,Bl}|Is], Arity, Regs0, Acc) -> - Regs = dig_out_fc_block(Bl, Regs0), - dig_out_fc_1(Is, Arity, Regs, Acc); -dig_out_fc_1([{bs_set_position,_,_}=I|Is], Arity, Regs, Acc) -> - dig_out_fc_1(Is, Arity, Regs, [I|Acc]); -dig_out_fc_1([{bs_get_tail,Src,Dst,Live0}|Is], Arity, Regs0, Acc) -> - case Src of - {x,X} when X < Arity -> - %% The heuristic for determining the number of live - %% registers is likely to give an incorrect result. - %% Give up. - {#{},[]}; - _ -> - Regs = prune_xregs(Live0, Regs0), - Live = dig_out_stack_live(Regs, Live0), - I = {bs_get_tail,Src,Dst,Live}, - dig_out_fc_1(Is, Arity, Regs, [I|Acc]) - end; -dig_out_fc_1([_|_], _Arity, _Regs, _Acc) -> - {#{},[]}; -dig_out_fc_1([], _Arity, Regs, Acc) -> - {Regs,Acc}. - -dig_out_fc_block([{set,[],[],{alloc,Live,_}}|Is], Regs0) -> - Regs = prune_xregs(Live, Regs0), - dig_out_fc_block(Is, Regs); -dig_out_fc_block([{set,[Dst],[Hd,Tl],put_list}|Is], Regs0) -> - Regs = Regs0#{Dst=>{cons,get_reg(Hd, Regs0),get_reg(Tl, Regs0)}}, - dig_out_fc_block(Is, Regs); -dig_out_fc_block([{set,[Dst],[Src],move}|Is], Regs0) -> - Regs = Regs0#{Dst=>get_reg(Src, Regs0)}, - dig_out_fc_block(Is, Regs); -dig_out_fc_block([{set,_,_,_}|_], _Regs) -> - %% Unknown instruction. Fail. - #{}; -dig_out_fc_block([], Regs) -> Regs. - -dig_out_stack_live(Regs, Default) -> - Reg = {x,2}, - case Regs of - #{Reg:=List} -> - dig_out_stack_live_1(List, Default); - #{} -> - Default - end. - -dig_out_stack_live_1({cons,{arg,N},T}, Live) -> - dig_out_stack_live_1(T, max(N + 1, Live)); -dig_out_stack_live_1({cons,_,T}, Live) -> - dig_out_stack_live_1(T, Live); -dig_out_stack_live_1(nil, Live) -> - Live; -dig_out_stack_live_1(_, Live) -> Live. - -prune_xregs(Live, Regs) -> - maps:filter(fun({x,X}, _) -> X < Live end, Regs). - -moves_from_stack({cons,{arg,N},_}, I, _Acc) when N =/= I -> - %% Wrong argument. Give up. - {[],-1}; -moves_from_stack({cons,H,T}, I, Acc) -> - case H of - {arg,I} -> - moves_from_stack(T, I+1, Acc); - _ -> - moves_from_stack(T, I+1, [{move,H,{x,I}}|Acc]) - end; -moves_from_stack(nil, I, Acc) -> - {reverse(Acc),I}; -moves_from_stack({literal,[H|T]}, I, Acc) -> - Cons = {cons,tag_literal(H),tag_literal(T)}, - moves_from_stack(Cons, I, Acc); -moves_from_stack(_, _, _) -> - %% Not understood. Give up. - {[],-1}. - - -get_reg(R, Regs) -> - case Regs of - #{R:=Val} -> Val; - #{} -> R - end. - -tag_literal([]) -> nil; -tag_literal(T) when is_atom(T) -> {atom,T}; -tag_literal(T) when is_float(T) -> {float,T}; -tag_literal(T) when is_integer(T) -> {integer,T}; -tag_literal(T) -> {literal,T}. diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 2d5d3dc457..61738e4435 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -136,6 +136,8 @@ -type instruction() :: beam_utils:instruction(). +-include("beam_types.hrl"). + -spec module(beam_utils:module_code(), [compile:option()]) -> {'ok',beam_utils:module_code()}. @@ -189,6 +191,15 @@ eliminate_moves([{test,is_eq_exact,_,[Reg,Val]}=I, RegVal = {Reg,Val}, BlkIs = eliminate_moves_blk(BlkIs0, RegVal), eliminate_moves([{block,BlkIs}|Is], D, [I|Acc]); +eliminate_moves([{test,is_nonempty_list,Fail,[Reg]}=I|Is], D0, Acc) -> + case is_proper_list(Reg, Acc) of + true -> + D = update_value_dict([nil,Fail], Reg, D0), + eliminate_moves(Is, D, [I|Acc]); + false -> + D = update_unsafe_labels(I, D0), + eliminate_moves(Is, D, [I|Acc]) + end; eliminate_moves([{label,Lbl},{block,BlkIs0}=Blk|Is], D, Acc0) -> Acc = [{label,Lbl}|Acc0], case {no_fallthrough(Acc0),D} of @@ -198,6 +209,10 @@ eliminate_moves([{label,Lbl},{block,BlkIs0}=Blk|Is], D, Acc0) -> {_,_} -> eliminate_moves([Blk|Is], D, Acc) end; +eliminate_moves([{call,_,_}=I|Is], D, Acc) -> + eliminate_moves_call(Is, D, [I | Acc]); +eliminate_moves([{call_ext,_,_}=I|Is], D, Acc) -> + eliminate_moves_call(Is, D, [I | Acc]); eliminate_moves([{block,[]}|Is], D, Acc) -> %% Empty blocks can prevent further jump optimizations. eliminate_moves(Is, D, Acc); @@ -206,6 +221,21 @@ eliminate_moves([I|Is], D0, Acc) -> eliminate_moves(Is, D, [I|Acc]); eliminate_moves([], _, Acc) -> reverse(Acc). +eliminate_moves_call([{'%',{var_info,{x,0},Info}}=Anno, + {block,BlkIs0}=Blk | Is], D, Acc0) -> + Acc = [Anno | Acc0], + RetType = proplists:get_value(type, Info, none), + case beam_types:get_singleton_value(RetType) of + {ok, Value} -> + RegVal = {{x,0}, value_to_literal(Value)}, + BlkIs = eliminate_moves_blk(BlkIs0, RegVal), + eliminate_moves([{block,BlkIs}|Is], D, Acc); + error -> + eliminate_moves(Is, D, [Blk | Acc]) + end; +eliminate_moves_call(Is, D, Acc) -> + eliminate_moves(Is, D, Acc). + eliminate_moves_blk([{set,[Dst],[_],move}|_]=Is, {_,Dst}) -> Is; eliminate_moves_blk([{set,[Dst],[Lit],move}|Is], {Dst,Lit}) -> @@ -217,9 +247,29 @@ eliminate_moves_blk([{set,[_],[_],move}=I|Is], {_,_}=RegVal) -> [I|eliminate_moves_blk(Is, RegVal)]; eliminate_moves_blk(Is, _) -> Is. +no_fallthrough([{'%',_} | Is]) -> + no_fallthrough(Is); no_fallthrough([I|_]) -> is_unreachable_after(I). +is_proper_list(Reg, [{'%',{var_info,Reg,Info}}|_]) -> + case proplists:get_value(type, Info) of + #t_list{terminator=nil} -> + true; + _ -> + %% Unknown type or not a proper list. + false + end; +is_proper_list(Reg, [{'%',{var_info,_,_}}|Is]) -> + is_proper_list(Reg, Is); +is_proper_list(_, _) -> false. + +value_to_literal([]) -> nil; +value_to_literal(A) when is_atom(A) -> {atom,A}; +value_to_literal(F) when is_float(F) -> {float,F}; +value_to_literal(I) when is_integer(I) -> {integer,I}; +value_to_literal(Other) -> {literal,Other}. + update_value_dict([Lit,{f,Lbl}|T], Reg, D0) -> D = case D0 of #{Lbl:=unsafe} -> D0; @@ -267,55 +317,84 @@ insert_labels([], Lc, Acc) -> %%% (1) We try to share the code for identical code segments by replacing all %%% occurrences except the last with jumps to the last occurrence. %%% +%%% We must not share code that raises an exception from outside a +%%% try/catch block with code inside a try/catch block and vice versa, +%%% because beam_validator will probably flag it as unsafe +%%% (ambiguous_catch_try_state). The same goes for a plain catch. +%%% share(Is0) -> Is1 = eliminate_fallthroughs(Is0, []), Is2 = find_fixpoint(fun(Is) -> - share_1(Is, #{}, #{}, [], []) + share_1(Is) end, Is1), reverse(Is2). -share_1([{label,L}=Lbl|Is], Dict0, Lbls0, [_|_]=Seq, Acc) -> - case maps:find(Seq, Dict0) of - error -> - Dict = case is_shareable(Seq) of - true -> - maps:put(Seq, L, Dict0); - false -> - Dict0 - end, - share_1(Is, Dict, Lbls0, [], [[Lbl|Seq]|Acc]); - {ok,Label} -> - Lbls = maps:put(L, Label, Lbls0), - share_1(Is, Dict0, Lbls, [], [[Lbl,{jump,{f,Label}}]|Acc]) +share_1(Is) -> + Safe = classify_labels(Is), + share_1(Is, Safe, #{}, #{}, [], []). + +%% Note that we examine the instructions in reverse execution order. +share_1([{label,L}=Lbl|Is], Safe, Dict0, Lbls0, [_|_]=Seq, Acc) -> + case Dict0 of + #{Seq := Label} -> + %% This sequence of instructions has been seen previously. Find out + %% whether it would be safe to jump the label for previous occurrence. + case is_safely_shareable(L, Label, Seq, Safe) of + true -> + %% Safe, because either the sequence never raises an exception + %% or the jump to the label will not pass a try/catch or catch + %% boundary. + Lbls = Lbls0#{L => Label}, + share_1(Is, Safe, Dict0, Lbls, [], + [[Lbl,{jump,{f,Label}}]|Acc]); + false -> + %% Not safe, because the sequence can raise an exception + %% and the jump would pass the boundary going in + %% or out of a try/catch or catch block. + share_1(Is, Safe, Dict0, Lbls0, [], [[Lbl|Seq]|Acc]) + end; + #{} -> + %% This is first time we have seen this sequence of instructions. + case is_shareable(Seq) of + true -> + Dict = Dict0#{Seq => L}, + share_1(Is, Safe, Dict, Lbls0, [], [[Lbl|Seq]|Acc]); + false -> + %% The sequence begins with an inappropriate instruction. + share_1(Is, Safe, Dict0, Lbls0, [], [[Lbl|Seq]|Acc]) + end end; -share_1([{func_info,_,_,_}|_]=Is0, _, Lbls, [], Acc0) when Lbls =/= #{} -> - lists:foldl(fun(Is, Acc) -> - beam_utils:replace_labels(Is, Acc, Lbls, fun(Old) -> Old end) - end, Is0, Acc0); -share_1([{func_info,_,_,_}|_]=Is, _, Lbls, [], Acc) when Lbls =:= #{} -> - lists:foldl(fun lists:reverse/2, Is, Acc); -share_1([{'catch',_,_}=I|Is], Dict0, Lbls0, Seq, Acc) -> - {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0), - share_1(Is, Dict, Lbls, [I|Seq], Acc); -share_1([{'try',_,_}=I|Is], Dict0, Lbls0, Seq, Acc) -> - {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0), - share_1(Is, Dict, Lbls, [I|Seq], Acc); -share_1([{try_case,_}=I|Is], Dict0, Lbls0, Seq, Acc) -> - {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0), - share_1(Is, Dict, Lbls, [I|Seq], Acc); -share_1([{catch_end,_}=I|Is], Dict0, Lbls0, Seq, Acc) -> - {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0), - share_1(Is, Dict, Lbls, [I|Seq], Acc); -share_1([{jump,{f,To}}=I,{label,L}=Lbl|Is], Dict0, Lbls0, _Seq, Acc) -> - Lbls = maps:put(L, To, Lbls0), - share_1(Is, Dict0, Lbls, [], [[Lbl,I]|Acc]); -share_1([I|Is], Dict, Lbls, Seq, Acc) -> +share_1([{func_info,_,_,_}|_]=Is0, _Safe, _, Lbls, [], Acc0) -> + %% Replace jumps to jumps with a jump to the final destination + %% (jump threading). This optimization is done in the main + %% optimization pass of this module, but we do it here too because + %% it can give more opportunities for sharing code. + F = case Lbls =:= #{} of + true -> + fun lists:reverse/2; + false -> + fun(Is, Acc) -> + beam_utils:replace_labels(Is, Acc, Lbls, + fun(Old) -> Old end) + end + end, + foldl(F, Is0, Acc0); +share_1([{'catch',_,_}=I|Is], Safe, Dict, _Lbls0, Seq, Acc) -> + %% Disable the jump threading optimization because it may be unsafe. + share_1(Is, Safe, Dict, #{}, [I|Seq], Acc); +share_1([{'try',_,_}=I|Is], Safe, Dict, _Lbls, Seq, Acc) -> + %% Disable the jump threading optimization because it may be unsafe. + share_1(Is, Safe, Dict, #{}, [I|Seq], Acc); +share_1([{jump,{f,To}}=I,{label,From}=Lbl|Is], Safe, Dict0, Lbls0, _Seq, Acc) -> + Lbls = Lbls0#{From => To}, + share_1(Is, Safe, Dict0, Lbls, [], [[Lbl,I]|Acc]); +share_1([I|Is], Safe, Dict, Lbls, Seq, Acc) -> case is_unreachable_after(I) of false -> - share_1(Is, Dict, Lbls, [I|Seq], Acc); + share_1(Is, Safe, Dict, Lbls, [I|Seq], Acc); true -> - share_1(Is, Dict, Lbls, [I], Acc) + share_1(Is, Safe, Dict, Lbls, [I], Acc) end. is_shareable([{'catch',_,_}|_]) -> false; @@ -325,34 +404,73 @@ is_shareable([{try_case,_}|_]) -> false; is_shareable([{try_end,_}|_]) -> false; is_shareable(_) -> true. -clean_non_sharable(Dict0, Lbls0) -> - %% We are passing in or out of a 'catch' or 'try' block. Remove - %% sequences that should not be shared over the boundaries of the - %% block. Since the end of the sequence must match, the only - %% possible match between a sequence outside and a sequence inside - %% the 'catch'/'try' block is a sequence that ends with an - %% instruction that causes an exception. Any sequence that causes - %% an exception must contain a line/1 instruction. - Dict1 = maps:to_list(Dict0), - Lbls1 = maps:to_list(Lbls0), - {Dict2,Lbls2} = foldl(fun({K, V}, {Dict,Lbls}) -> - case sharable_with_try(K) of - true -> - {[{K,V}|Dict],lists:keydelete(V, 2, Lbls)}; - false -> - {Dict,Lbls} - end - end, {[],Lbls1}, Dict1), - {maps:from_list(Dict2),maps:from_list(Lbls2)}. - -sharable_with_try([{line,_}|_]) -> - %% This sequence may cause an exception and may potentially +%% There are identical code sequences Seq at labels Lbl1 and Lbl2. Is it +%% safe to replace the sequence at label Lbl1 with a jump to Lbl2? + +is_safely_shareable(Lbl1, Lbl2, Seq, Safe) -> + case no_exception(Seq) of + true -> + %% Safe, because the sequence Seq can't raise an exception. + true; + false -> + %% Safe if both labels are either ouside try/catch or inside + %% the same part of the same try/catch or catch block. + case Safe of + #{Lbl1 := Scope, Lbl2 := Scope} -> true; + #{} -> false + end + end. + +no_exception([{line,_}|_]) -> + %% This sequence may raise an exception and may potentially %% match a sequence on the other side of the 'catch'/'try' block %% boundary. false; -sharable_with_try([_|Is]) -> - sharable_with_try(Is); -sharable_with_try([]) -> true. +no_exception([_|Is]) -> + no_exception(Is); +no_exception([]) -> true. + +%% +%% Classify labels according to where the instructions that branch to +%% the labels are located. Each label is assigned a scope identifer. +%% If two labels have different scope identfiers, sharing a sequence +%% that raises an exception between the labels may not be safe, because +%% one label is inside a try/catch, and the other label is outside. +%% +%% Note that we don't care where the labels themselves are located, +%% only from where the branches to them are located. This is essential +%% to ensure that beam_jump is idempotent, ensuring that beam_jump +%% will not do any unsafe optimizations when when compiling from a .S +%% file. The move/1 optimization pass below (2) will move instruction +%% sequences that end in an exception raising instruction to the end +%% of the function. Thus instruction sequences initially being in +%% different scopes could be placed next to each other. +%% + +classify_labels(Is) -> + classify_labels(Is, 0, #{}). + +classify_labels([{'catch',_,_}|Is], Scope, Safe) -> + classify_labels(Is, Scope+1, Safe); +classify_labels([{catch_end,_}|Is], Scope, Safe) -> + classify_labels(Is, Scope+1, Safe); +classify_labels([{'try',_,_}|Is], Scope, Safe) -> + classify_labels(Is, Scope+1, Safe); +classify_labels([{'try_end',_}|Is], Scope, Safe) -> + classify_labels(Is, Scope+1, Safe); +classify_labels([{'try_case',_}|Is], Scope, Safe) -> + classify_labels(Is, Scope+1, Safe); +classify_labels([I|Is], Scope, Safe0) -> + Labels = instr_labels(I), + Safe = foldl(fun(L, A) -> + case A of + #{L := Scope} -> A; + #{L := _} -> maps:remove(L, A); + #{} -> A#{L => Scope} + end + end, Safe0, Labels), + classify_labels(Is, Scope, Safe); +classify_labels([], _Scope, Safe) -> Safe. %% Eliminate all fallthroughs. Return the result reversed. @@ -592,8 +710,6 @@ is_unreachable_after(I) -> is_exit_instruction(I). -spec is_exit_instruction(instruction()) -> boolean(). -is_exit_instruction({call_ext,_,{extfunc,M,F,A}}) -> - erl_bifs:is_exit_bif(M, F, A); is_exit_instruction(if_end) -> true; is_exit_instruction({case_end,_}) -> true; is_exit_instruction({try_case_end,_}) -> true; @@ -736,7 +852,13 @@ instr_labels({recv_set,Lbl}) -> do_instr_labels(Lbl); instr_labels({fcheckerror,Lbl}) -> do_instr_labels(Lbl); -instr_labels(_) -> []. +instr_labels({bs_start_match4,Fail,_,_,_}) -> + case Fail of + {f,L} -> [L]; + {atom,_} -> [] + end; +instr_labels(_) -> + []. do_instr_labels({f,0}) -> []; do_instr_labels({f,F}) -> [F]. diff --git a/lib/compiler/src/beam_kernel_to_ssa.erl b/lib/compiler/src/beam_kernel_to_ssa.erl index aa04a75804..6b552ae38c 100644 --- a/lib/compiler/src/beam_kernel_to_ssa.erl +++ b/lib/compiler/src/beam_kernel_to_ssa.erl @@ -24,7 +24,7 @@ %% The main interface. -export([module/2]). --import(lists, [append/1,duplicate/2,flatmap/2,foldl/3, +-import(lists, [all/2,append/1,flatmap/2,foldl/3, keysort/2,mapfoldl/3,map/2,member/2, reverse/1,reverse/2,sort/1]). @@ -34,13 +34,14 @@ -type label() :: beam_ssa:label(). %% Main codegen structure. --record(cg, {lcount=1 :: label(), %Label counter +-record(cg, {lcount=1 :: label(), %Label counter bfail=1 :: label(), catch_label=none :: 'none' | label(), vars=#{} :: map(), %Defined variables. break=0 :: label(), %Break label recv=0 :: label(), %Receive label - ultimate_failure=0 :: label() %Label for ultimate match failure. + ultimate_failure=0 :: label(), %Label for ultimate match failure. + labels=#{} :: #{atom() => label()} }). %% Internal records. @@ -83,6 +84,7 @@ function(#k_fdef{anno=Anno0,func=Name,arity=Arity, cg_fun(Ke, St0) -> {UltimateFail,FailIs,St1} = make_failure(badarg, St0), + ?EXCEPTION_BLOCK = UltimateFail, %Assertion. St2 = St1#cg{bfail=UltimateFail,ultimate_failure=UltimateFail}, {B,St} = cg(Ke, St2), Asm = [{label,0}|B++FailIs], @@ -105,8 +107,6 @@ make_failure(Reason, St0) -> cg(#k_match{body=M,ret=Rs}, St) -> do_match_cg(M, Rs, St); -cg(#k_guard_match{body=M,ret=Rs}, St) -> - do_match_cg(M, Rs, St); cg(#k_seq{arg=Arg,body=Body}, St0) -> {ArgIs,St1} = cg(Arg, St0), {BodyIs,St} = cg(Body, St1), @@ -123,14 +123,6 @@ cg(#k_try_enter{arg=Ta,vars=Vs,body=Tb,evars=Evs,handler=Th}, St) -> try_enter_cg(Ta, Vs, Tb, Evs, Th, St); cg(#k_catch{body=Cb,ret=[R]}, St) -> do_catch_cg(Cb, R, St); -cg(#k_receive{anno=Le,timeout=Te,var=Rvar,body=Rm,action=Tes,ret=Rs}, St) -> - recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, St); -cg(#k_receive_next{}, #cg{recv=Recv}=St) -> - Is = [#b_set{op=recv_next},make_uncond_branch(Recv)], - {Is,St}; -cg(#k_receive_accept{}, St) -> - Remove = #b_set{op=remove_message}, - {[Remove],St}; cg(#k_put{anno=Le,arg=Con,ret=Var}, St) -> put_cg(Var, Con, Le, St); cg(#k_return{args=[Ret0]}, St) -> @@ -139,18 +131,30 @@ cg(#k_return{args=[Ret0]}, St) -> cg(#k_break{args=Bs}, #cg{break=Br}=St) -> Args = ssa_args(Bs, St), {[#cg_break{args=Args,phi=Br}],St}; -cg(#k_guard_break{args=Bs}, St) -> - cg(#k_break{args=Bs}, St). +cg(#k_letrec_goto{label=Label,first=First,then=Then,ret=Rs}, + #cg{break=OldBreak,labels=Labels0}=St0) -> + {Tf,St1} = new_label(St0), + {B,St2} = new_label(St1), + Labels = Labels0#{Label=>Tf}, + {Fis,St3} = cg(First, St2#cg{labels=Labels,break=B}), + {Sis,St4} = cg(Then, St3), + St5 = St4#cg{labels=Labels0}, + {BreakVars,St} = new_ssa_vars(Rs, St5), + Phi = #cg_phi{vars=BreakVars}, + {Fis ++ [{label,Tf}] ++ Sis ++ [{label,B},Phi],St#cg{break=OldBreak}}; +cg(#k_goto{label=Label}, #cg{labels=Labels}=St) -> + Branch = map_get(Label, Labels), + {[make_uncond_branch(Branch)],St}. %% match_cg(Matc, [Ret], State) -> {[Ainstr],State}. %% Generate code for a match. -do_match_cg(M, Rs, St0) -> +do_match_cg(M, Rs, #cg{bfail=Bfail,break=OldBreak}=St0) -> {B,St1} = new_label(St0), - {Mis,St2} = match_cg(M, St1#cg.bfail, St1#cg{break=B}), - {BreakVars,St} = new_ssa_vars(Rs, St2), - {Mis ++ [{label,B},#cg_phi{vars=BreakVars}], - St#cg{bfail=St0#cg.bfail,break=St1#cg.break}}. + {Mis,St2} = match_cg(M, Bfail, St1#cg{break=B}), + St3 = St2#cg{break=OldBreak}, + {BreakVars,St} = new_ssa_vars(Rs, St3), + {Mis ++ [{label,B},#cg_phi{vars=BreakVars}],St}. %% match_cg(Match, Fail, State) -> {[Ainstr],State}. %% Generate code for a match tree. @@ -206,6 +210,22 @@ select_cg(#k_type_clause{type=Type,values=Scs}, Var, Tf, Vf, St0) -> {Is,St} = select_val_cg(Type, Arg, Vls, Tf, Vf, Sis, St2), {Is,St}. +select_val_cg(k_atom, {succeeded,Dst}, Vls, _Tf, _Vf, Sis, St0) -> + [{#b_literal{val=false},Fail},{#b_literal{val=true},Succ}] = sort(Vls), + case Dst of + #b_var{} -> + %% Generate a `succeeded` instruction and two-way branch + %% following the `peek_message` and `wait_timeout` + %% instructions. + {Bool,St} = new_ssa_var('@ssa_bool', St0), + Succeeded = #b_set{op=succeeded,dst=Bool,args=[Dst]}, + Br = #b_br{bool=Bool,succ=Succ,fail=Fail}, + {[Succeeded,Br|Sis],St}; + #b_literal{val=true}=Bool -> + %% A 'wait_timeout 0' instruction was optimized away. + Br = #b_br{bool=Bool,succ=Succ,fail=Succ}, + {[Br|Sis],St0} + end; select_val_cg(k_tuple, Tuple, Vls, Tf, Vf, Sis, St0) -> {Is0,St1} = make_cond_branch({bif,is_tuple}, [Tuple], Tf, St0), {Arity,St2} = new_ssa_var('@ssa_arity', St1), @@ -269,7 +289,7 @@ select_cons(#k_val_clause{val=#k_cons{hd=Hd,tl=Tl},body=B}, {Is,St} = make_cond_branch(is_nonempty_list, [Src], Tf, St2), {Is ++ Eis ++ Bis,St}. -select_nil(#k_val_clause{val=#k_nil{},body=B}, V, Tf, Vf, St0) -> +select_nil(#k_val_clause{val=#k_literal{val=[]},body=B}, V, Tf, Vf, St0) -> {Bis,St1} = match_cg(B, Vf, St0), Src = ssa_arg(V, St1), {Is,St} = make_cond_branch({bif,'=:='}, [Src,#b_literal{val=[]}], Tf, St1), @@ -279,9 +299,10 @@ select_binary(#k_val_clause{val=#k_binary{segs=#k_var{name=Ctx0}},body=B}, #k_var{}=Src, Tf, Vf, St0) -> {Ctx,St1} = new_ssa_var(Ctx0, St0), {Bis0,St2} = match_cg(B, Vf, St1), - {TestIs,St} = make_cond_branch(succeeded, [Ctx], Tf, St2), + {TestIs,St} = make_succeeded(Ctx, {guard, Tf}, St2), Bis1 = [#b_set{op=bs_start_match,dst=Ctx, - args=[ssa_arg(Src, St)]}] ++ TestIs ++ Bis0, + args=[#b_literal{val=new}, + ssa_arg(Src, St)]}] ++ TestIs ++ Bis0, Bis = finish_bs_matching(Bis1), {Bis,St}. @@ -311,6 +332,35 @@ make_cond_branch(Cond, Args, Fail, St0) -> make_uncond_branch(Fail) -> #b_br{bool=#b_literal{val=true},succ=Fail,fail=Fail}. +%% +%% The 'succeeded' instruction needs special treatment in catch blocks to +%% prevent the checked operation from being optimized away if a later pass +%% determines that it always fails. +%% + +make_succeeded(Var, {in_catch, CatchLbl}, St0) -> + {Bool, St1} = new_ssa_var('@ssa_bool', St0), + {Succ, St2} = new_label(St1), + {Fail, St} = new_label(St2), + + Check = [#b_set{op=succeeded,dst=Bool,args=[Var]}, + #b_br{bool=Bool,succ=Succ,fail=Fail}], + + %% Add a dummy block that references the checked variable, ensuring it + %% stays alive and that it won't be merged with the landing pad. + Trampoline = [{label,Fail}, + #b_set{op=exception_trampoline,args=[Var]}, + make_uncond_branch(CatchLbl)], + + {Check ++ Trampoline ++ [{label,Succ}], St}; +make_succeeded(Var, {no_catch, Fail}, St) -> + %% Ultimate failure raises an exception, so we must treat it as if it were + %% in a catch to keep it from being optimized out. + #cg{ultimate_failure=Fail} = St, %Assertion + make_succeeded(Var, {in_catch, Fail}, St); +make_succeeded(Var, {guard, Fail}, St) -> + make_cond_branch(succeeded, [Var], Fail, St). + %% Instructions for selection of binary segments. select_bin_segs(Scs, Ivar, Tf, St) -> @@ -375,15 +425,23 @@ select_bin_end(#k_val_clause{val=#k_bin_end{},body=B}, Src, Tf, St0) -> select_extract_bin(#k_var{name=Hd}, Size0, Unit, Type, Flags, Vf, Ctx, Anno, St0) -> {Dst,St1} = new_ssa_var(Hd, St0), - Size = ssa_arg(Size0, St0), + Size = case {Size0,ssa_arg(Size0, St0)} of + {#k_var{},#b_literal{val=all}} -> + %% The size `all` is used for the size of the final binary + %% segment in a pattern. Using `all` explicitly is not allowed, + %% so we convert it to an obvious invalid size. + #b_literal{val=bad_size}; + {_,Size1} -> + Size1 + end, build_bs_instr(Anno, Type, Vf, Ctx, Size, Unit, Flags, Dst, St1). -select_extract_int(#k_var{name=Tl}, 0, #k_int{val=0}, _U, _Fs, _Vf, +select_extract_int(#k_var{name=Tl}, 0, #k_literal{val=0}, _U, _Fs, _Vf, Ctx, St0) -> St = set_ssa_var(Tl, Ctx, St0), {[],St}; -select_extract_int(#k_var{name=Tl}, Val, #k_int{val=Sz}, U, Fs, Vf, - Ctx, St0) -> +select_extract_int(#k_var{name=Tl}, Val, #k_literal{val=Sz}, U, Fs, Vf, + Ctx, St0) when is_integer(Sz) -> {Dst,St1} = new_ssa_var(Tl, St0), Bits = U*Sz, Bin = case member(big, Fs) of @@ -394,7 +452,7 @@ select_extract_int(#k_var{name=Tl}, Val, #k_int{val=Sz}, U, Fs, Vf, <<Val:Bits/little>> end, Bits = bit_size(Bin), %Assertion. - {TestIs,St} = make_cond_branch(succeeded, [Dst], Vf, St1), + {TestIs,St} = make_succeeded(Dst, {guard, Vf}, St1), Set = #b_set{op=bs_match,dst=Dst, args=[#b_literal{val=string},Ctx,#b_literal{val=Bin}]}, {[Set|TestIs],St}. @@ -412,21 +470,14 @@ build_bs_instr(Anno, Type, Fail, Ctx, Size, Unit0, Flags0, Dst, St0) -> #b_set{anno=Anno,op=bs_match,dst=Dst, args=[TypeArg,Ctx,Flags]} end, - {Is,St} = make_cond_branch(succeeded, [Dst], Fail, St0), + {Is,St} = make_succeeded(Dst, {guard, Fail}, St0), {[Get|Is],St}. select_val(#k_val_clause{val=#k_tuple{es=Es},body=B}, V, Vf, St0) -> - #k{us=Used} = k_get_anno(B), - {Eis,St1} = select_extract_tuple(V, Es, Used, St0), + {Eis,St1} = select_extract_tuple(V, Es, St0), {Bis,St2} = match_cg(B, Vf, St1), {length(Es),Eis ++ Bis,St2}; -select_val(#k_val_clause{val=Val0,body=B}, _V, Vf, St0) -> - Val = case Val0 of - #k_atom{val=Lit} -> Lit; - #k_float{val=Lit} -> Lit; - #k_int{val=Lit} -> Lit; - #k_literal{val=Lit} -> Lit - end, +select_val(#k_val_clause{val=#k_literal{val=Val},body=B}, _V, Vf, St0) -> {Bis,St1} = match_cg(B, Vf, St0), {Val,Bis,St1}. @@ -438,17 +489,18 @@ select_val(#k_val_clause{val=Val0,body=B}, _V, Vf, St0) -> %% It is probably worthwhile because it is common to extract only a %% few elements from a huge record. -select_extract_tuple(Src, Vs, Used, St0) -> +select_extract_tuple(Src, Vs, St0) -> Tuple = ssa_arg(Src, St0), - F = fun (#k_var{name=V}, {Elem,S0}) -> - case member(V, Used) of + F = fun (#k_var{anno=Anno,name=V}, {Elem,S0}) -> + case member(unused, Anno) of true -> + {[],{Elem+1,S0}}; + false -> Args = [Tuple,#b_literal{val=Elem}], {Dst,S} = new_ssa_var(V, S0), - Get = #b_set{op=get_tuple_element,dst=Dst,args=Args}, - {[Get],{Elem+1,S}}; - false -> - {[],{Elem+1,S0}} + Get = #b_set{op=get_tuple_element, + dst=Dst,args=Args}, + {[Get],{Elem+1,S}} end end, {Es,{_,St}} = flatmapfoldl(F, {0,St0}, Vs), @@ -475,7 +527,7 @@ select_extract_map([P|Ps], Src, Fail, St0) -> Key = ssa_arg(Key0, St0), {Dst,St1} = new_ssa_var(Dst0, St0), Set = #b_set{op=get_map_element,dst=Dst,args=[MapSrc,Key]}, - {TestIs,St2} = make_cond_branch(succeeded, [Dst], Fail, St1), + {TestIs,St2} = make_succeeded(Dst, {guard, Fail}, St1), {Is,St} = select_extract_map(Ps, Src, Fail, St2), {[Set|TestIs]++Is,St}; select_extract_map([], _, _, St) -> @@ -501,11 +553,20 @@ guard_clause_cg(#k_guard_clause{guard=G,body=B}, Fail, St0) -> %% the correct exit point. Primops and tests all go to the next %% instruction on success or jump to a failure label. -guard_cg(#k_protected{arg=Ts,ret=Rs,inner=Inner}, Fail, St) -> - protected_cg(Ts, Rs, Inner, Fail, St); -guard_cg(#k_test{op=Test0,args=As,inverted=Inverted}, Fail, St0) -> - #k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Test}} = Test0, - test_cg(Test, Inverted, As, Fail, St0); +guard_cg(#k_try{arg=Ts,vars=[],body=#k_break{args=[]}, + evars=[],handler=#k_break{args=[]}}, + Fail, + #cg{bfail=OldBfail,break=OldBreak}=St0) -> + %% Do a try/catch without return value for effect. The return + %% value is not checked; success passes on to the next instruction + %% and failure jumps to Fail. + {Next,St1} = new_label(St0), + {Tis,St2} = guard_cg(Ts, Fail, St1#cg{bfail=Fail,break=Next}), + Is = Tis ++ [{label,Next},#cg_phi{vars=[]}], + {Is,St2#cg{bfail=OldBfail,break=OldBreak}}; +guard_cg(#k_test{op=Test0,args=As}, Fail, St0) -> + #k_remote{mod=#k_literal{val=erlang},name=#k_literal{val=Test}} = Test0, + test_cg(Test, false, As, Fail, St0); guard_cg(#k_seq{arg=Arg,body=Body}, Fail, St0) -> {ArgIs,St1} = guard_cg(Arg, Fail, St0), {BodyIs,St} = guard_cg(Body, Fail, St1), @@ -522,7 +583,8 @@ test_cg(Test, Inverted, As0, Fail, St0) -> case {Test,ssa_args(As0, St0)} of {is_record,[Tuple,#b_literal{val=Atom}=Tag,#b_literal{val=Int}=Arity]} when is_atom(Atom), is_integer(Int) -> - test_is_record_cg(Inverted, Fail, Tuple, Tag, Arity, St0); + false = Inverted, %Assertion. + test_is_record_cg(Fail, Tuple, Tag, Arity, St0); {_,As} -> {Bool,St1} = new_ssa_var('@ssa_bool', St0), {Succ,St} = new_label(St1), @@ -534,7 +596,7 @@ test_cg(Test, Inverted, As0, Fail, St0) -> {[Bif,Br,{label,Succ}],St} end. -test_is_record_cg(false, Fail, Tuple, TagVal, ArityVal, St0) -> +test_is_record_cg(Fail, Tuple, TagVal, ArityVal, St0) -> {Arity,St1} = new_ssa_var('@ssa_arity', St0), {Tag,St2} = new_ssa_var('@ssa_tag', St1), {Is0,St3} = make_cond_branch({bif,is_tuple}, [Tuple], Fail, St2), @@ -544,44 +606,8 @@ test_is_record_cg(false, Fail, Tuple, TagVal, ArityVal, St0) -> args=[Tuple,#b_literal{val=0}]}, {Is2,St} = make_cond_branch({bif,'=:='}, [Tag,TagVal], Fail, St4), Is = Is0 ++ [GetArity] ++ Is1 ++ [GetTag] ++ Is2, - {Is,St}; -test_is_record_cg(true, Fail, Tuple, TagVal, ArityVal, St0) -> - {Succ,St1} = new_label(St0), - {Arity,St2} = new_ssa_var('@ssa_arity', St1), - {Tag,St3} = new_ssa_var('@ssa_tag', St2), - {Is0,St4} = make_cond_branch({bif,is_tuple}, [Tuple], Succ, St3), - GetArity = #b_set{op={bif,tuple_size},dst=Arity,args=[Tuple]}, - {Is1,St5} = make_cond_branch({bif,'=:='}, [Arity,ArityVal], Succ, St4), - GetTag = #b_set{op=get_tuple_element,dst=Tag, - args=[Tuple,#b_literal{val=0}]}, - {Is2,St} = make_cond_branch({bif,'=:='}, [Tag,TagVal], Succ, St5), - Is3 = [make_uncond_branch(Fail),{label,Succ}], - Is = Is0 ++ [GetArity] ++ Is1 ++ [GetTag] ++ Is2 ++ Is3, {Is,St}. -%% protected_cg([Kexpr], [Ret], Fail, St) -> {[Ainstr],St}. -%% Do a protected. Protecteds without return values are just done -%% for effect, the return value is not checked, success passes on to -%% the next instruction and failure jumps to Fail. If there are -%% return values then these must be set to 'false' on failure, -%% control always passes to the next instruction. - -protected_cg(Ts, [], _, Fail, St0) -> - %% Protect these calls, revert when done. - {Tis,St1} = guard_cg(Ts, Fail, St0#cg{bfail=Fail}), - {Tis,St1#cg{bfail=St0#cg.bfail}}; -protected_cg(Ts, Rs, Inner0, _Fail, St0) -> - {Pfail,St1} = new_label(St0), - {Br,St2} = new_label(St1), - Prot = duplicate(length(Rs), #b_literal{val=false}), - {Tis,St3} = guard_cg(Ts, Pfail, St2#cg{break=Pfail,bfail=Pfail}), - Inner = ssa_args(Inner0, St3), - {BreakVars,St} = new_ssa_vars(Rs, St3), - Is = Tis ++ [#cg_break{args=Inner,phi=Br}, - {label,Pfail},#cg_break{args=Prot,phi=Br}, - {label,Br},#cg_phi{vars=BreakVars}], - {Is,St#cg{break=St0#cg.break,bfail=St0#cg.bfail}}. - %% match_fmf(Fun, LastFail, State, [Clause]) -> {Is,State}. %% This is a special flatmapfoldl for match code gen where we %% generate a "failure" label for each clause. The last clause uses @@ -596,7 +622,7 @@ match_fmf(F, LastFail, St0, [H|T]) -> {Rs,St3} = match_fmf(F, LastFail, St2, T), {R ++ [{label,Fail}] ++ Rs,St3}. -%% fail_label(State) -> {Where,FailureLabel}. +%% fail_context(State) -> {Where,FailureLabel}. %% Where = guard | no_catch | in_catch %% Return an indication of which part of a function code is %% being generated for and the appropriate failure label to @@ -609,7 +635,7 @@ match_fmf(F, LastFail, St0, [H|T]) -> %% a try/catch or catch. %% in_catch - In the scope of a try/catch or catch. -fail_label(#cg{catch_label=Catch,bfail=Fail,ultimate_failure=Ult}) -> +fail_context(#cg{catch_label=Catch,bfail=Fail,ultimate_failure=Ult}) -> if Fail =/= Ult -> {guard,Fail}; @@ -619,14 +645,6 @@ fail_label(#cg{catch_label=Catch,bfail=Fail,ultimate_failure=Ult}) -> {in_catch,Catch} end. -%% bif_fail_label(State) -> FailureLabel. -%% Return the appropriate failure label for a guard BIF call or -%% primop that fails. - -bif_fail_label(St) -> - {_,Fail} = fail_label(St), - Fail. - %% call_cg(Func, [Arg], [Ret], Le, State) -> %% {[Ainstr],State}. %% enter_cg(Func, [Arg], Le, St) -> {[Ainstr],St}. @@ -634,96 +652,58 @@ bif_fail_label(St) -> call_cg(Func, As, [], Le, St) -> call_cg(Func, As, [#k_var{name='@ssa_ignored'}], Le, St); -call_cg(Func0, As, [#k_var{name=R}|MoreRs]=Rs, Le, St0) -> - case fail_label(St0) of +call_cg(Func, As, [#k_var{name=R}|MoreRs]=Rs, Le, St0) -> + case fail_context(St0) of {guard,Fail} -> %% Inside a guard. The only allowed function call is to %% erlang:error/1,2. We will generate a branch to the %% failure branch. - #k_remote{mod=#k_atom{val=erlang}, - name=#k_atom{val=error}} = Func0, %Assertion. + #k_remote{mod=#k_literal{val=erlang}, + name=#k_literal{val=error}} = Func, %Assertion. [#k_var{name=DestVar}] = Rs, St = set_ssa_var(DestVar, #b_literal{val=unused}, St0), {[make_uncond_branch(Fail),#cg_unreachable{}],St}; - {Catch,Fail} -> + FailCtx -> %% Ordinary function call in a function body. - Args = ssa_args(As, St0), + Args = ssa_args([Func|As], St0), {Ret,St1} = new_ssa_var(R, St0), - Func = call_target(Func0, Args, St0), - Call = #b_set{anno=line_anno(Le),op=call,dst=Ret,args=[Func|Args]}, + Call = #b_set{anno=line_anno(Le),op=call,dst=Ret,args=Args}, %% If this is a call to erlang:error(), MoreRs could be a %% nonempty list of variables that each need a value. St2 = foldl(fun(#k_var{name=Dummy}, S) -> set_ssa_var(Dummy, #b_literal{val=unused}, S) end, St1, MoreRs), - case Catch of - no_catch -> - {[Call],St2}; - in_catch -> - {TestIs,St} = make_cond_branch(succeeded, [Ret], Fail, St2), - {[Call|TestIs],St} - end + + {TestIs,St} = make_succeeded(Ret, FailCtx, St2), + {[Call|TestIs],St} end. -enter_cg(Func0, As0, Le, St0) -> - Anno = line_anno(Le), - Func = call_target(Func0, As0, St0), - As = ssa_args(As0, St0), +enter_cg(Func, As0, Le, St0) -> + %% Adding a trampoline here would give us greater freedom in rewriting + %% calls, but doing so makes it difficult to tell tail calls apart from + %% body calls during code generation. + %% + %% We therefore skip the trampoline, reasoning that we've already left the + %% current function by the time an exception is thrown. + As = ssa_args([Func|As0], St0), {Ret,St} = new_ssa_var('@ssa_ret', St0), - Call = #b_set{anno=Anno,op=call,dst=Ret,args=[Func|As]}, + Call = #b_set{anno=line_anno(Le),op=call,dst=Ret,args=As}, {[Call,#b_ret{arg=Ret}],St}. -call_target(Func, As, St) -> - Arity = length(As), - case Func of - #k_remote{mod=Mod0,name=Name0} -> - Mod = ssa_arg(Mod0, St), - Name = ssa_arg(Name0, St), - #b_remote{mod=Mod,name=Name,arity=Arity}; - #k_local{name=Name} when is_atom(Name) -> - #b_local{name=#b_literal{val=Name},arity=Arity}; - #k_var{}=Var -> - ssa_arg(Var, St) - end. - %% bif_cg(#k_bif{}, Le,State) -> {[Ainstr],State}. %% Generate code for a guard BIF or primop. -bif_cg(#k_bif{op=#k_internal{name=Name},args=As,ret=Rs}, Le, St) -> - internal_cg(Name, As, Rs, Le, St); -bif_cg(#k_bif{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Name}}, +bif_cg(#k_bif{op=#k_internal{name=Name},args=As,ret=Rs}, _Le, St) -> + internal_cg(Name, As, Rs, St); +bif_cg(#k_bif{op=#k_remote{mod=#k_literal{val=erlang},name=#k_literal{val=Name}}, args=As,ret=Rs}, Le, St) -> bif_cg(Name, As, Rs, Le, St). %% internal_cg(Bif, [Arg], [Ret], Le, State) -> %% {[Ainstr],State}. -internal_cg(make_fun, [Name0,Arity0|As], Rs, _Le, St0) -> - #k_atom{val=Name} = Name0, - #k_int{val=Arity} = Arity0, - case Rs of - [#k_var{name=Dst0}] -> - {Dst,St} = new_ssa_var(Dst0, St0), - Args = ssa_args(As, St), - Local = #b_local{name=#b_literal{val=Name},arity=Arity}, - MakeFun = #b_set{op=make_fun,dst=Dst,args=[Local|Args]}, - {[MakeFun],St}; - [] -> - {[],St0} - end; -internal_cg(bs_init_writable=I, As, [#k_var{name=Dst0}], _Le, St0) -> - %% This behaves like a function call. - {Dst,St} = new_ssa_var(Dst0, St0), - Args = ssa_args(As, St), - Set = #b_set{op=I,dst=Dst,args=Args}, - {[Set],St}; -internal_cg(build_stacktrace=I, As, [#k_var{name=Dst0}], _Le, St0) -> - {Dst,St} = new_ssa_var(Dst0, St0), - Args = ssa_args(As, St), - Set = #b_set{op=I,dst=Dst,args=Args}, - {[Set],St}; -internal_cg(raise, As, [#k_var{name=Dst0}], _Le, St0) -> +internal_cg(raise, As, [#k_var{name=Dst0}], St0) -> Args = ssa_args(As, St0), {Dst,St} = new_ssa_var(Dst0, St0), Resume = #b_set{op=resume,dst=Dst,args=Args}, @@ -734,11 +714,41 @@ internal_cg(raise, As, [#k_var{name=Dst0}], _Le, St0) -> Is = [Resume,make_uncond_branch(Catch),#cg_unreachable{}], {Is,St} end; -internal_cg(raw_raise=I, As, [#k_var{name=Dst0}], _Le, St0) -> +internal_cg(recv_peek_message, [], [#k_var{name=Succeeded0}, + #k_var{name=Dst0}], St0) -> + {Dst,St1} = new_ssa_var(Dst0, St0), + St = new_succeeded_value(Succeeded0, Dst, St1), + Set = #b_set{op=peek_message,dst=Dst,args=[]}, + {[Set],St}; +internal_cg(recv_wait_timeout, As, [#k_var{name=Succeeded0}], St0) -> + case ssa_args(As, St0) of + [#b_literal{val=0}] -> + %% If beam_ssa_opt is run (which is default), the + %% `wait_timeout` instruction will be removed if the + %% operand is a literal 0. However, if optimizations have + %% been turned off, we must not not generate a + %% `wait_timeout` instruction with a literal 0 timeout, + %% because the BEAM instruction will not handle it + %% correctly. + St = new_succeeded_value(Succeeded0, #b_literal{val=true}, St0), + {[],St}; + Args -> + {Wait,St1} = new_ssa_var('@ssa_wait', St0), + St = new_succeeded_value(Succeeded0, Wait, St1), + Set = #b_set{op=wait_timeout,dst=Wait,args=Args}, + {[Set],St} + end; +internal_cg(Op, As, [#k_var{name=Dst0}], St0) when is_atom(Op) -> %% This behaves like a function call. {Dst,St} = new_ssa_var(Dst0, St0), Args = ssa_args(As, St), - Set = #b_set{op=I,dst=Dst,args=Args}, + Set = #b_set{op=Op,dst=Dst,args=Args}, + {[Set],St}; +internal_cg(Op, As, [], St0) when is_atom(Op) -> + %% This behaves like a function call. + {Dst,St} = new_ssa_var('@ssa_ignored', St0), + Args = ssa_args(As, St), + Set = #b_set{op=Op,dst=Dst,args=Args}, {[Set],St}. bif_cg(Bif, As0, [#k_var{name=Dst0}], Le, St0) -> @@ -752,8 +762,8 @@ bif_cg(Bif, As0, [#k_var{name=Dst0}], Le, St0) -> I = #b_set{anno=line_anno(Le),op={bif,Bif},dst=Dst,args=As}, case erl_bifs:is_safe(erlang, Bif, length(As)) of false -> - Fail = bif_fail_label(St1), - {Is,St} = make_cond_branch(succeeded, [Dst], Fail, St1), + FailCtx = fail_context(St1), + {Is,St} = make_succeeded(Dst, FailCtx, St1), {[I|Is],St}; true-> {[I],St1} @@ -779,50 +789,6 @@ bif_is_record_cg(Dst, Tuple, TagVal, ArityVal, St0) -> Is = Is0 ++ [GetArity] ++ Is1 ++ [GetTag] ++ Is2 ++ Is3, {Is,St}. -%% recv_loop_cg(TimeOut, ReceiveVar, ReceiveMatch, TimeOutExprs, -%% [Ret], Le, St) -> {[Ainstr],St}. - -recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, St0) -> - %% Get labels. - {Rl,St1} = new_label(St0), - {Tl,St2} = new_label(St1), - {Bl,St3} = new_label(St2), - St4 = St3#cg{break=Bl,recv=Rl}, - {Ris,St5} = cg_recv_mesg(Rvar, Rm, Tl, Le, St4), - {Wis,St6} = cg_recv_wait(Te, Tes, St5), - {BreakVars,St} = new_ssa_vars(Rs, St6), - {Ris ++ [{label,Tl}] ++ Wis ++ - [{label,Bl},#cg_phi{vars=BreakVars}], - St#cg{break=St0#cg.break,recv=St0#cg.recv}}. - -%% cg_recv_mesg( ) -> {[Ainstr],St}. - -cg_recv_mesg(#k_var{name=R}, Rm, Tl, Le, St0) -> - {Dst,St1} = new_ssa_var(R, St0), - {Mis,St2} = match_cg(Rm, none, St1), - RecvLbl = St1#cg.recv, - {TestIs,St} = make_cond_branch(succeeded, [Dst], Tl, St2), - Is = [#b_br{anno=line_anno(Le),bool=#b_literal{val=true}, - succ=RecvLbl,fail=RecvLbl}, - {label,RecvLbl}, - #b_set{op=peek_message,dst=Dst}|TestIs], - {Is++Mis,St}. - -%% cg_recv_wait(Te, Tes, St) -> {[Ainstr],St}. - -cg_recv_wait(#k_int{val=0}, Es, St0) -> - {Tis,St} = cg(Es, St0), - {[#b_set{op=timeout}|Tis],St}; -cg_recv_wait(Te, Es, St0) -> - {Tis,St1} = cg(Es, St0), - Args = [ssa_arg(Te, St1)], - {WaitDst,St2} = new_ssa_var('@ssa_wait', St1), - {WaitIs,St} = make_cond_branch(succeeded, [WaitDst], St1#cg.recv, St2), - %% Infinite timeout will be optimized later. - Is = [#b_set{op=wait_timeout,dst=WaitDst,args=Args}] ++ WaitIs ++ - [#b_set{op=timeout}] ++ Tis, - {Is,St}. - %% try_cg(TryBlock, [BodyVar], TryBody, [ExcpVar], TryHandler, [Ret], St) -> %% {[Ainstr],St}. @@ -835,24 +801,106 @@ try_cg(Ta, Vs, Tb, Evs, Th, Rs, St0) -> {SsaVs,St6} = new_ssa_vars(Vs, St5), {SsaEvs,St7} = new_ssa_vars(Evs, St6), {Ais,St8} = cg(Ta, St7#cg{break=B,catch_label=H}), - St9 = St8#cg{break=E,catch_label=St7#cg.catch_label}, - {Bis,St10} = cg(Tb, St9), - {His,St11} = cg(Th, St10), - {BreakVars,St12} = new_ssa_vars(Rs, St11), - {CatchedAgg,St} = new_ssa_var('@ssa_agg', St12), - ExtractVs = extract_vars(SsaEvs, CatchedAgg, 0), - KillTryTag = #b_set{op=kill_try_tag,args=[TryTag]}, - Args = [#b_literal{val='try'},TryTag], - Handler = [{label,H}, - #b_set{op=landingpad,dst=CatchedAgg,args=Args}] ++ - ExtractVs ++ [KillTryTag], - {[#b_set{op=new_try_tag,dst=TryTag,args=[#b_literal{val='try'}]}, - #b_br{bool=TryTag,succ=Next,fail=H}, - {label,Next}] ++ Ais ++ - [{label,B},#cg_phi{vars=SsaVs},KillTryTag] ++ Bis ++ - Handler ++ His ++ - [{label,E},#cg_phi{vars=BreakVars}], - St#cg{break=St0#cg.break}}. + + %% We try to avoid constructing a try/catch if the expression to + %% be evaluated don't have any side effects and if the error + %% reason is not explicitly matched. + %% + %% Starting in OTP 23, segment sizes in binary matching and keys + %% in map matching are allowed to be arbitrary guard + %% expressions. Those expressions are evaluated in a try/catch + %% so that matching can continue with the next clause if the evaluation + %% of such expression fails. + %% + %% It is not allowed to use try/catch during matching in a receive + %% (the try/catch would force the saving of fragile message references + %% to the stack frame). Therefore, avoiding creating try/catch is + %% not merely an optimization but necessary for correctness. + + case {Vs,Tb,Th,is_guard_cg_safe_list(Ais)} of + {[#k_var{name=X}],#k_break{args=[#k_var{name=X}]}, + #k_break{args=[#k_literal{}]},true} -> + %% There are no instructions that will clobber X registers + %% and the exception is not matched. Therefore, a + %% try/catch is not needed. This code is probably located + %% in a guard. + {ProtIs,St9} = guard_cg(Ta, H, St7#cg{break=B,bfail=H}), + {His,St10} = cg(Th, St9), + {RetVars,St} = new_ssa_vars(Rs, St10), + Is = ProtIs ++ [{label,H}] ++ His ++ + [{label,B},#cg_phi{vars=RetVars}], + {Is,St#cg{break=St0#cg.break,bfail=St7#cg.bfail}}; + {[#k_var{name=X}],#k_break{args=[#k_literal{}=SuccLit0,#k_var{name=X}]}, + #k_break{args=[#k_literal{val=false},#k_literal{}]},true} -> + %% There are no instructions that will clobber X registers + %% and the exception is not matched. Therefore, a + %% try/catch is not needed. This code probably evaluates + %% a key expression in map matching. + {FinalLabel,St9} = new_label(St7), + {ProtIs,St10} = guard_cg(Ta, H, St9#cg{break=B,bfail=H}), + {His,St11} = cg(Th, St10#cg{break=FinalLabel}), + {RetVars,St12} = new_ssa_vars(Rs, St11), + {Result,St} = new_ssa_var('@ssa_result', St12), + SuccLit = ssa_arg(SuccLit0, St), + Is = ProtIs ++ [{label,H}] ++ His ++ + [{label,B}, + #cg_phi{vars=[Result]}, + #cg_break{args=[SuccLit,Result],phi=FinalLabel}, + {label,FinalLabel}, + #cg_phi{vars=RetVars}], + {Is,St#cg{break=St0#cg.break,bfail=St7#cg.bfail}}; + {_,#k_break{args=[]},#k_break{args=[]},true} -> + %% There are no instructions that will clobber X registers + %% and the exception is not matched. Therefore, a + %% try/catch is not needed. This code probably does the + %% size calculation for a segment in binary matching. + {ProtIs,St9} = guard_cg(Ta, H, St7#cg{break=B,bfail=H}), + {His,St10} = cg(Th, St9), + {RetVars,St} = new_ssa_vars(Rs, St10), + Is = ProtIs ++ [{label,H}] ++ His ++ + [{label,B},#cg_phi{vars=RetVars}], + {Is,St#cg{break=St0#cg.break,bfail=St7#cg.bfail}}; + {_,_,_,_} -> + %% The general try/catch (not in a guard). + St9 = St8#cg{break=E,catch_label=St7#cg.catch_label}, + {Bis,St10} = cg(Tb, St9), + {His,St11} = cg(Th, St10), + {BreakVars,St12} = new_ssa_vars(Rs, St11), + {CatchedAgg,St13} = new_ssa_var('@ssa_agg', St12), + ExtractVs = extract_vars(SsaEvs, CatchedAgg, 0), + KillTryTag = #b_set{op=kill_try_tag,args=[TryTag]}, + Args = [#b_literal{val='try'},TryTag], + Handler = [{label,H}, + #b_set{op=landingpad,dst=CatchedAgg,args=Args}] ++ + ExtractVs ++ [KillTryTag], + {[#b_set{op=new_try_tag,dst=TryTag,args=[#b_literal{val='try'}]}, + #b_br{bool=TryTag,succ=Next,fail=H}, + {label,Next}] ++ Ais ++ + [{label,B},#cg_phi{vars=SsaVs},KillTryTag] ++ Bis ++ + Handler ++ His ++ + [{label,E},#cg_phi{vars=BreakVars}], + St13#cg{break=St0#cg.break}} + end. + +is_guard_cg_safe_list(Is) -> + all(fun is_guard_cg_safe/1, Is). + +is_guard_cg_safe(#b_set{op=call,args=Args}) -> + case Args of + [#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error}, + arity=1}|_] -> + true; + _ -> + false + end; +is_guard_cg_safe(#b_set{}=I) -> not beam_ssa:clobbers_xregs(I); +is_guard_cg_safe(#b_br{}) -> true; +is_guard_cg_safe(#b_switch{}) -> true; +is_guard_cg_safe(#cg_break{}) -> true; +is_guard_cg_safe(#cg_phi{}) -> true; +is_guard_cg_safe({label,_}) -> true; +is_guard_cg_safe(#cg_unreachable{}) -> false. try_enter_cg(Ta, Vs, Tb, Evs, Th, St0) -> {B,St1} = new_label(St0), %Body label @@ -928,9 +976,9 @@ put_cg([#k_var{name=R}], #k_tuple{es=Es}, _Le, St0) -> PutTuple = #b_set{op=put_tuple,dst=Ret,args=Args}, {[PutTuple],St}; put_cg([#k_var{name=R}], #k_binary{segs=Segs}, Le, St0) -> - Fail = bif_fail_label(St0), + FailCtx = fail_context(St0), {Dst,St1} = new_ssa_var(R, St0), - cg_binary(Dst, Segs, Fail, Le, St1); + cg_binary(Dst, Segs, FailCtx, Le, St1); put_cg([#k_var{name=R}], #k_map{op=Op,var=Map, es=[#k_map_pair{key=#k_var{}=K,val=V}]}, Le, St0) -> @@ -959,14 +1007,14 @@ put_cg([#k_var{name=R}], Con0, _Le, St0) -> {[],St}. put_cg_map(LineAnno, Op, SrcMap, Dst, List, St0) -> - Fail = bif_fail_label(St0), Args = [#b_literal{val=Op},SrcMap|List], PutMap = #b_set{anno=LineAnno,op=put_map,dst=Dst,args=Args}, if Op =:= assoc -> {[PutMap],St0}; true -> - {Is,St} = make_cond_branch(succeeded, [Dst], Fail, St0), + FailCtx = fail_context(St0), + {Is,St} = make_succeeded(Dst, FailCtx, St0), {[PutMap|Is],St} end. @@ -974,18 +1022,18 @@ put_cg_map(LineAnno, Op, SrcMap, Dst, List, St0) -> %%% Code generation for constructing binaries. %%% -cg_binary(Dst, Segs0, Fail, Le, St0) -> - {PutCode0,SzCalc0,St1} = cg_bin_put(Segs0, Fail, St0), +cg_binary(Dst, Segs0, FailCtx, Le, St0) -> + {PutCode0,SzCalc0,St1} = cg_bin_put(Segs0, FailCtx, St0), LineAnno = line_anno(Le), - Anno = Le#k.a, + Anno = Le, case PutCode0 of [#b_set{op=bs_put,dst=Bool,args=[_,_,Src,#b_literal{val=all}|_]}, #b_br{bool=Bool}, {label,_}|_] -> #k_bin_seg{unit=Unit0,next=Segs} = Segs0, Unit = #b_literal{val=Unit0}, - {PutCode,SzCalc1,St2} = cg_bin_put(Segs, Fail, St1), - {_,SzVar,SzCode0,St3} = cg_size_calc(1, SzCalc1, Fail, St2), + {PutCode,SzCalc1,St2} = cg_bin_put(Segs, FailCtx, St1), + {_,SzVar,SzCode0,St3} = cg_size_calc(1, SzCalc1, FailCtx, St2), SzCode = cg_bin_anno(SzCode0, LineAnno), Args = case member(single_use, Anno) of true -> @@ -994,14 +1042,14 @@ cg_binary(Dst, Segs0, Fail, Le, St0) -> [#b_literal{val=append},Src,SzVar,Unit] end, BsInit = #b_set{anno=LineAnno,op=bs_init,dst=Dst,args=Args}, - {TestIs,St} = make_cond_branch(succeeded, [Dst], Fail, St3), + {TestIs,St} = make_succeeded(Dst, FailCtx, St3), {SzCode ++ [BsInit] ++ TestIs ++ PutCode,St}; [#b_set{op=bs_put}|_] -> - {Unit,SzVar,SzCode0,St2} = cg_size_calc(8, SzCalc0, Fail, St1), + {Unit,SzVar,SzCode0,St2} = cg_size_calc(8, SzCalc0, FailCtx, St1), SzCode = cg_bin_anno(SzCode0, LineAnno), Args = [#b_literal{val=new},SzVar,Unit], BsInit = #b_set{anno=LineAnno,op=bs_init,dst=Dst,args=Args}, - {TestIs,St} = make_cond_branch(succeeded, [Dst], Fail, St2), + {TestIs,St} = make_succeeded(Dst, FailCtx, St2), {SzCode ++ [BsInit] ++ TestIs ++ PutCode0,St} end. @@ -1009,18 +1057,18 @@ cg_bin_anno([Set|Sets], Anno) -> [Set#b_set{anno=Anno}|Sets]; cg_bin_anno([], _) -> []. -%% cg_size_calc(PreferredUnit, SzCalc, Fail, St0) -> +%% cg_size_calc(PreferredUnit, SzCalc, FailCtx, St0) -> %% {ActualUnit,SizeVariable,SizeCode,St}. %% Generate size calculation code. -cg_size_calc(Unit, error, _Fail, St) -> +cg_size_calc(Unit, error, _FailCtx, St) -> {#b_literal{val=Unit},#b_literal{val=badarg},[],St}; -cg_size_calc(8, [{1,_}|_]=SzCalc, Fail, St) -> - cg_size_calc(1, SzCalc, Fail, St); -cg_size_calc(8, SzCalc, Fail, St0) -> - {Var,Pre,St} = cg_size_calc_1(SzCalc, Fail, St0), +cg_size_calc(8, [{1,_}|_]=SzCalc, FailCtx, St) -> + cg_size_calc(1, SzCalc, FailCtx, St); +cg_size_calc(8, SzCalc, FailCtx, St0) -> + {Var,Pre,St} = cg_size_calc_1(SzCalc, FailCtx, St0), {#b_literal{val=8},Var,Pre,St}; -cg_size_calc(1, SzCalc0, Fail, St0) -> +cg_size_calc(1, SzCalc0, FailCtx, St0) -> SzCalc = map(fun({8,#b_literal{val=Size}}) -> {1,#b_literal{val=8*Size}}; ({8,{{bif,byte_size},Src}}) -> @@ -1030,54 +1078,54 @@ cg_size_calc(1, SzCalc0, Fail, St0) -> ({_,_}=Pair) -> Pair end, SzCalc0), - {Var,Pre,St} = cg_size_calc_1(SzCalc, Fail, St0), + {Var,Pre,St} = cg_size_calc_1(SzCalc, FailCtx, St0), {#b_literal{val=1},Var,Pre,St}. -cg_size_calc_1(SzCalc, Fail, St0) -> - cg_size_calc_2(SzCalc, #b_literal{val=0}, Fail, St0). +cg_size_calc_1(SzCalc, FailCtx, St0) -> + cg_size_calc_2(SzCalc, #b_literal{val=0}, FailCtx, St0). -cg_size_calc_2([{_,{'*',Unit,{_,_}=Bif}}|T], Sum0, Fail, St0) -> - {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, Fail, St0), - {BifDst,Pre1,St2} = cg_size_bif(Bif, Fail, St1), - {Sum,Pre2,St} = cg_size_add(Sum1, BifDst, Unit, Fail, St2), +cg_size_calc_2([{_,{'*',Unit,{_,_}=Bif}}|T], Sum0, FailCtx, St0) -> + {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, FailCtx, St0), + {BifDst,Pre1,St2} = cg_size_bif(Bif, FailCtx, St1), + {Sum,Pre2,St} = cg_size_add(Sum1, BifDst, Unit, FailCtx, St2), {Sum,Pre0++Pre1++Pre2,St}; -cg_size_calc_2([{_,#b_literal{}=Sz}|T], Sum0, Fail, St0) -> - {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, Fail, St0), - {Sum,Pre,St} = cg_size_add(Sum1, Sz, #b_literal{val=1}, Fail, St1), +cg_size_calc_2([{_,#b_literal{}=Sz}|T], Sum0, FailCtx, St0) -> + {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, FailCtx, St0), + {Sum,Pre,St} = cg_size_add(Sum1, Sz, #b_literal{val=1}, FailCtx, St1), {Sum,Pre0++Pre,St}; -cg_size_calc_2([{_,#b_var{}=Sz}|T], Sum0, Fail, St0) -> - {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, Fail, St0), - {Sum,Pre,St} = cg_size_add(Sum1, Sz, #b_literal{val=1}, Fail, St1), +cg_size_calc_2([{_,#b_var{}=Sz}|T], Sum0, FailCtx, St0) -> + {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, FailCtx, St0), + {Sum,Pre,St} = cg_size_add(Sum1, Sz, #b_literal{val=1}, FailCtx, St1), {Sum,Pre0++Pre,St}; -cg_size_calc_2([{_,{_,_}=Bif}|T], Sum0, Fail, St0) -> - {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, Fail, St0), - {BifDst,Pre1,St2} = cg_size_bif(Bif, Fail, St1), - {Sum,Pre2,St} = cg_size_add(Sum1, BifDst, #b_literal{val=1}, Fail, St2), +cg_size_calc_2([{_,{_,_}=Bif}|T], Sum0, FailCtx, St0) -> + {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, FailCtx, St0), + {BifDst,Pre1,St2} = cg_size_bif(Bif, FailCtx, St1), + {Sum,Pre2,St} = cg_size_add(Sum1, BifDst, #b_literal{val=1}, FailCtx, St2), {Sum,Pre0++Pre1++Pre2,St}; -cg_size_calc_2([], Sum, _Fail, St) -> +cg_size_calc_2([], Sum, _FailCtx, St) -> {Sum,[],St}. -cg_size_bif(#b_var{}=Var, _Fail, St) -> +cg_size_bif(#b_var{}=Var, _FailCtx, St) -> {Var,[],St}; -cg_size_bif({Name,Src}, Fail, St0) -> +cg_size_bif({Name,Src}, FailCtx, St0) -> {Dst,St1} = new_ssa_var('@ssa_bif', St0), Bif = #b_set{op=Name,dst=Dst,args=[Src]}, - {TestIs,St} = make_cond_branch(succeeded, [Dst], Fail, St1), + {TestIs,St} = make_succeeded(Dst, FailCtx, St1), {Dst,[Bif|TestIs],St}. -cg_size_add(#b_literal{val=0}, Val, #b_literal{val=1}, _Fail, St) -> +cg_size_add(#b_literal{val=0}, Val, #b_literal{val=1}, _FailCtx, St) -> {Val,[],St}; -cg_size_add(A, B, Unit, Fail, St0) -> +cg_size_add(A, B, Unit, FailCtx, St0) -> {Dst,St1} = new_ssa_var('@ssa_sum', St0), - {TestIs,St} = make_cond_branch(succeeded, [Dst], Fail, St1), + {TestIs,St} = make_succeeded(Dst, FailCtx, St1), BsAdd = #b_set{op=bs_add,dst=Dst,args=[A,B,Unit]}, {Dst,[BsAdd|TestIs],St}. -cg_bin_put(Seg, Fail, St) -> - cg_bin_put_1(Seg, Fail, [], [], St). +cg_bin_put(Seg, FailCtx, St) -> + cg_bin_put_1(Seg, FailCtx, [], [], St). cg_bin_put_1(#k_bin_seg{size=Size0,unit=U,type=T,flags=Fs,seg=Src0,next=Next}, - Fail, Acc, SzCalcAcc, St0) -> + FailCtx, Acc, SzCalcAcc, St0) -> [Src,Size] = ssa_args([Src0,Size0], St0), NeedSize = bs_need_size(T), TypeArg = #b_literal{val=T}, @@ -1087,9 +1135,12 @@ cg_bin_put_1(#k_bin_seg{size=Size0,unit=U,type=T,flags=Fs,seg=Src0,next=Next}, true -> [TypeArg,Flags,Src,Size,Unit]; false -> [TypeArg,Flags,Src] end, - {Is,St} = make_cond_branch(bs_put, Args, Fail, St0), + %% bs_put has its own 'succeeded' logic, and should always jump directly to + %% the fail label regardless of whether it's in a catch or not. + {_, FailLbl} = FailCtx, + {Is,St} = make_cond_branch(bs_put, Args, FailLbl, St0), SzCalc = bin_size_calc(T, Src, Size, U), - cg_bin_put_1(Next, Fail, reverse(Is, Acc), [SzCalc|SzCalcAcc], St); + cg_bin_put_1(Next, FailCtx, reverse(Is, Acc), [SzCalc|SzCalcAcc], St); cg_bin_put_1(#k_bin_end{}, _, Acc, SzCalcAcc, St) -> SzCalc = fold_size_calc(SzCalcAcc, 0, []), {reverse(Acc),SzCalc,St}. @@ -1139,12 +1190,18 @@ fold_size_calc([], Bits, Acc) -> ssa_args(As, St) -> [ssa_arg(A, St) || A <- As]. -ssa_arg(#k_var{name=V}, #cg{vars=Vars}) -> maps:get(V, Vars); +ssa_arg(#k_var{name=V}, #cg{vars=Vars}) -> map_get(V, Vars); ssa_arg(#k_literal{val=V}, _) -> #b_literal{val=V}; -ssa_arg(#k_atom{val=V}, _) -> #b_literal{val=V}; -ssa_arg(#k_float{val=V}, _) -> #b_literal{val=V}; -ssa_arg(#k_int{val=V}, _) -> #b_literal{val=V}; -ssa_arg(#k_nil{}, _) -> #b_literal{val=[]}. +ssa_arg(#k_remote{mod=Mod0,name=Name0,arity=Arity}, St) -> + Mod = ssa_arg(Mod0, St), + Name = ssa_arg(Name0, St), + #b_remote{mod=Mod,name=Name,arity=Arity}; +ssa_arg(#k_local{name=Name,arity=Arity}, _) when is_atom(Name) -> + #b_local{name=#b_literal{val=Name},arity=Arity}. + +new_succeeded_value(VarBase, Var, #cg{vars=Vars0}=St) -> + Vars = Vars0#{VarBase=>{succeeded,Var}}, + St#cg{vars=Vars}. new_ssa_vars(Vs, St) -> mapfoldl(fun(#k_var{name=V}, S) -> @@ -1178,23 +1235,20 @@ new_label(#cg{lcount=Next}=St) -> %% current filename and line number. The annotation should be %% included in any operation that could cause an exception. -line_anno(#k{a=Anno}) -> - line_anno_1(Anno). - -line_anno_1([Line,{file,Name}]) when is_integer(Line) -> - line_anno_2(Name, Line); -line_anno_1([_|_]=A) -> +line_anno([Line,{file,Name}]) when is_integer(Line) -> + line_anno_1(Name, Line); +line_anno([_|_]=A) -> {Name,Line} = find_loc(A, no_file, 0), - line_anno_2(Name, Line); -line_anno_1([]) -> + line_anno_1(Name, Line); +line_anno([]) -> #{}. -line_anno_2(no_file, _) -> +line_anno_1(no_file, _) -> #{}; -line_anno_2(_, 0) -> +line_anno_1(_, 0) -> %% Missing line number or line number 0. #{}; -line_anno_2(Name, Line) -> +line_anno_1(Name, Line) -> #{location=>{Name,Line}}. find_loc([Line|T], File, _) when is_integer(Line) -> @@ -1220,27 +1274,37 @@ finalize(Asm0, St0) -> {Asm,St} = fix_sets(Asm1, [], St0), {build_map(Asm),St}. +%% fix_phis(Is0) -> Is. +%% Rewrite #cg_break{} and #cg_phi{} records to #b_set{} records. +%% A #cg_break{} is rewritten to an unconditional branch, and +%% and a #cg_phi{} is rewritten to one or more phi nodes. + fix_phis(Is) -> fix_phis_1(Is, none, #{}). -fix_phis_1([{label,L},#cg_phi{vars=[]}=Phi|Is0], _Lbl, Map0) -> - case maps:is_key(L, Map0) of - false -> - %% No #cg_break{} references this label. Nothing else can - %% reference it, so it can be safely be removed. - {Is,Map} = drop_upto_label(Is0, Map0), - fix_phis_1(Is, none, Map); - true -> - %% There is a break referencing this label; probably caused - %% by a try/catch whose return value is ignored. - [{label,L}|fix_phis_1([Phi|Is0], L, Map0)] +fix_phis_1([{label,Lbl},#cg_phi{vars=Vars}|Is0], _Lbl, Map0) -> + case Map0 of + #{Lbl:=Pairs} -> + %% This phi node was referenced by at least one #cg_break{}. + %% Create the phi nodes. + Phis = gen_phis(Vars, Pairs), + Map = maps:remove(Lbl, Map0), + [{label,Lbl}] ++ Phis ++ fix_phis_1(Is0, Lbl, Map); + #{} -> + %% No #cg_break{} instructions reference this label. + %% #cg_break{} instructions must reference the labels for + %% #cg_phi{} instructions; therefore this label is + %% unreachable and can be dropped. + Is = drop_upto_label(Is0), + fix_phis_1(Is, none, Map0) end; fix_phis_1([{label,L}=I|Is], _Lbl, Map) -> [I|fix_phis_1(Is, L, Map)]; -fix_phis_1([#cg_unreachable{}|Is0], _Lbl, Map0) -> - {Is,Map} = drop_upto_label(Is0, Map0), +fix_phis_1([#cg_unreachable{}|Is0], _Lbl, Map) -> + Is = drop_upto_label(Is0), fix_phis_1(Is, none, Map); fix_phis_1([#cg_break{args=Args,phi=Target}|Is], Lbl, Map) when is_integer(Lbl) -> + %% Pair each argument with the label for this block and save in the map. Pairs1 = case Map of #{Target:=Pairs0} -> Pairs0; #{} -> [] @@ -1248,17 +1312,6 @@ fix_phis_1([#cg_break{args=Args,phi=Target}|Is], Lbl, Map) when is_integer(Lbl) Pairs = [[{Arg,Lbl} || Arg <- Args]|Pairs1], I = make_uncond_branch(Target), [I|fix_phis_1(Is, none, Map#{Target=>Pairs})]; -fix_phis_1([#cg_phi{vars=Vars}|Is0], Lbl, Map0) -> - Pairs = maps:get(Lbl, Map0), - Map1 = maps:remove(Lbl, Map0), - case gen_phis(Vars, Pairs) of - [#b_set{op=phi,args=[]}] -> - {Is,Map} = drop_upto_label(Is0, Map1), - Ret = #b_ret{arg=#b_literal{val=unreachable}}, - [Ret|fix_phis_1(Is, none, Map)]; - Phis -> - Phis ++ fix_phis_1(Is0, Lbl, Map1) - end; fix_phis_1([I|Is], Lbl, Map) -> [I|fix_phis_1(Is, Lbl, Map)]; fix_phis_1([], _, Map) -> @@ -1267,6 +1320,7 @@ fix_phis_1([], _, Map) -> gen_phis([V|Vs], Preds0) -> {Pairs,Preds} = collect_preds(Preds0, [], []), + [_|_] = Pairs, %Assertion. [#b_set{op=phi,dst=V,args=Pairs}|gen_phis(Vs, Preds)]; gen_phis([], _) -> []. @@ -1275,6 +1329,36 @@ collect_preds([[First|Rest]|T], ColAcc, RestAcc) -> collect_preds([], ColAcc, RestAcc) -> {keysort(2, ColAcc),RestAcc}. +drop_upto_label([{label,_}|_]=Is) -> Is; +drop_upto_label([_|Is]) -> drop_upto_label(Is). + +%% fix_sets(Is0, Acc, St0) -> {Is,St}. +%% Ensure that #b_set.dst is filled in with a proper variable. +%% (For convenience, for instructions that don't have a useful return value, +%% the code generator would set #b_set.dst to `none`.) + +fix_sets([#b_set{op=Op,dst=Dst}=Set,#b_ret{arg=Dst}=Ret|Is], Acc, St) -> + NoValue = case Op of + remove_message -> true; + timeout -> true; + _ -> false + end, + case NoValue of + true -> + %% An instruction without value was used in effect + %% context in `after` block. Example: + %% + %% try + %% ... + %% after + %% receive _ -> ignored end + %% end, + %% ok. + %% + fix_sets(Is, [Ret#b_ret{arg=#b_literal{val=ok}},Set|Acc], St); + false -> + fix_sets(Is, [Ret,Set|Acc], St) + end; fix_sets([#b_set{dst=none}=Set|Is], Acc, St0) -> {Dst,St} = new_ssa_var('@ssa_ignored', St0), I = Set#b_set{dst=Dst}, @@ -1284,6 +1368,10 @@ fix_sets([I|Is], Acc, St) -> fix_sets([], Acc, St) -> {reverse(Acc),St}. +%% build_map(Is) -> #{}. +%% Split up the sequential instruction stream into blocks and +%% store them in a map. + build_map(Is) -> Blocks = build_graph_1(Is, [], []), maps:from_list(Blocks). @@ -1301,16 +1389,3 @@ make_blocks(Lbls, [Last|Is0]) -> Is = reverse(Is0), Block = #b_blk{is=Is,last=Last}, [{L,Block} || L <- Lbls]. - -drop_upto_label([{label,_}|_]=Is, Map) -> - {Is,Map}; -drop_upto_label([#cg_break{phi=Target}|Is], Map) -> - Pairs = case Map of - #{Target:=Pairs0} -> Pairs0; - #{} -> [] - end, - drop_upto_label(Is, Map#{Target=>Pairs}); -drop_upto_label([_|Is], Map) -> - drop_upto_label(Is, Map). - -k_get_anno(Thing) -> element(2, Thing). diff --git a/lib/compiler/src/beam_ssa.erl b/lib/compiler/src/beam_ssa.erl index 6492d1e1bf..9a8ae9b407 100644 --- a/lib/compiler/src/beam_ssa.erl +++ b/lib/compiler/src/beam_ssa.erl @@ -21,12 +21,13 @@ -module(beam_ssa). -export([add_anno/3,get_anno/2,get_anno/3, - clobbers_xregs/1,def/2,def_used/2, + clobbers_xregs/1,def/2,def_unused/3, definitions/1, dominators/1,common_dominators/3, flatmapfold_instrs_rpo/4, fold_po/3,fold_po/4,fold_rpo/3,fold_rpo/4, fold_instrs_rpo/4, + is_loop_header/1, linearize/1, mapfold_blocks_rpo/4, mapfold_instrs_rpo/4, @@ -79,7 +80,7 @@ -type var_base() :: atom() | non_neg_integer(). -type literal_value() :: atom() | integer() | float() | list() | - nil() | tuple() | map() | binary(). + nil() | tuple() | map() | binary() | fun(). -type op() :: {'bif',atom()} | {'float',float_op()} | prim_op() | cg_prim_op(). -type anno() :: #{atom() := any()}. @@ -101,7 +102,7 @@ 'bs_match' | 'bs_put' | 'bs_start_match' | 'bs_test_tail' | 'bs_utf16_size' | 'bs_utf8_size' | 'build_stacktrace' | 'call' | 'catch_end' | - 'extract' | + 'extract' | 'exception_trampoline' | 'get_hd' | 'get_map_element' | 'get_tl' | 'get_tuple_element' | 'has_map_field' | 'is_nonempty_list' | 'is_tagged_tuple' | @@ -120,10 +121,11 @@ %% Primops only used internally during code generation. -type cg_prim_op() :: 'bs_get' | 'bs_get_position' | 'bs_match_string' | 'bs_restore' | 'bs_save' | 'bs_set_position' | 'bs_skip' | - 'copy' | 'put_tuple_arity' | 'put_tuple_element' | - 'put_tuple_elements' | 'set_tuple_element'. + 'copy' | 'match_fail' | 'put_tuple_arity' | + 'put_tuple_element' | 'put_tuple_elements' | + 'set_tuple_element'. --import(lists, [foldl/3,keyfind/3,mapfoldl/3,member/2,reverse/1,umerge/1]). +-import(lists, [foldl/3,keyfind/3,mapfoldl/3,member/2,reverse/1,sort/1]). -spec add_anno(Key, Value, Construct) -> Construct when Key :: atom(), @@ -174,6 +176,8 @@ clobbers_xregs(#b_set{op=Op}) -> make_fun -> true; peek_message -> true; raw_raise -> true; + timeout -> true; + wait_timeout -> true; _ -> false end. @@ -188,13 +192,17 @@ no_side_effect(#b_set{op=Op}) -> case Op of {bif,_} -> true; {float,get} -> true; + bs_add -> true; bs_init -> true; + bs_init_writable -> true; bs_extract -> true; bs_match -> true; bs_start_match -> true; bs_test_tail -> true; bs_get_tail -> true; bs_put -> true; + bs_utf16_size -> true; + bs_utf8_size -> true; extract -> true; get_hd -> true; get_tl -> true; @@ -211,6 +219,18 @@ no_side_effect(#b_set{op=Op}) -> _ -> false end. +%% is_loop_header(#b_set{}) -> true|false. +%% Test whether this instruction is a loop header. + +-spec is_loop_header(b_set()) -> boolean(). + +is_loop_header(#b_set{op=Op}) -> + case Op of + peek_message -> true; + wait_timeout -> true; + _ -> false + end. + -spec predecessors(Blocks) -> #{BlockNumber:=[Predecessor]} when Blocks :: block_map(), BlockNumber :: label(), @@ -299,7 +319,7 @@ normalize(#b_switch{arg=Arg,fail=Fail,list=List}=Sw) -> #b_var{} when List =:= [] -> #b_br{bool=#b_literal{val=true},succ=Fail,fail=Fail}; #b_var{} -> - Sw + Sw#b_switch{list=sort(List)} end; normalize(#b_ret{}=Ret) -> Ret. @@ -319,17 +339,18 @@ def(Ls, Blocks) -> Blks = [map_get(L, Blocks) || L <- Top], def_1(Blks, []). --spec def_used(Ls, Blocks) -> {Def,Used} when +-spec def_unused(Ls, Used, Blocks) -> {Def,Unused} when Ls :: [label()], + Used :: ordsets:ordset(var_name()), Blocks :: block_map(), Def :: ordsets:ordset(var_name()), - Used :: ordsets:ordset(var_name()). + Unused :: ordsets:ordset(var_name()). -def_used(Ls, Blocks) -> +def_unused(Ls, Unused, Blocks) -> Top = rpo(Ls, Blocks), Blks = [map_get(L, Blocks) || L <- Top], Preds = cerl_sets:from_list(Top), - def_used_1(Blks, Preds, [], []). + def_unused_1(Blks, Preds, [], Unused). %% dominators(BlockMap) -> {Dominators,Numbering}. %% Calculate the dominator tree, returning a map where each entry @@ -651,34 +672,28 @@ is_commutative('=/=') -> true; is_commutative('/=') -> true; is_commutative(_) -> false. -def_used_1([#b_blk{is=Is,last=Last}|Bs], Preds, Def0, UsedAcc) -> - {Def,Used} = def_used_is(Is, Preds, Def0, used(Last)), - case Used of - [] -> - def_used_1(Bs, Preds, Def, UsedAcc); - [_|_] -> - def_used_1(Bs, Preds, Def, [Used|UsedAcc]) - end; -def_used_1([], _Preds, Def0, UsedAcc) -> - Def = ordsets:from_list(Def0), - Used = umerge(UsedAcc), - {Def,Used}. +def_unused_1([#b_blk{is=Is,last=Last}|Bs], Preds, Def0, Unused0) -> + Unused1 = ordsets:subtract(Unused0, used(Last)), + {Def,Unused} = def_unused_is(Is, Preds, Def0, Unused1), + def_unused_1(Bs, Preds, Def, Unused); +def_unused_1([], _Preds, Def, Unused) -> + {ordsets:from_list(Def), Unused}. -def_used_is([#b_set{op=phi,dst=Dst,args=Args}|Is], - Preds, Def0, Used0) -> +def_unused_is([#b_set{op=phi,dst=Dst,args=Args}|Is], + Preds, Def0, Unused0) -> Def = [Dst|Def0], %% We must be careful to only include variables that will %% be used when arriving from one of the predecessor blocks %% in Preds. - Used1 = [V || {#b_var{}=V,L} <- Args, cerl_sets:is_element(L, Preds)], - Used = ordsets:union(ordsets:from_list(Used1), Used0), - def_used_is(Is, Preds, Def, Used); -def_used_is([#b_set{dst=Dst}=I|Is], Preds, Def0, Used0) -> + Unused1 = [V || {#b_var{}=V,L} <- Args, cerl_sets:is_element(L, Preds)], + Unused = ordsets:subtract(Unused0, ordsets:from_list(Unused1)), + def_unused_is(Is, Preds, Def, Unused); +def_unused_is([#b_set{dst=Dst}=I|Is], Preds, Def0, Unused0) -> Def = [Dst|Def0], - Used = ordsets:union(used(I), Used0), - def_used_is(Is, Preds, Def, Used); -def_used_is([], _Preds, Def, Used) -> - {Def,Used}. + Unused = ordsets:subtract(Unused0, used(I)), + def_unused_is(Is, Preds, Def, Unused); +def_unused_is([], _Preds, Def, Unused) -> + {Def,Unused}. def_1([#b_blk{is=Is}|Bs], Def0) -> Def = def_is(Is, Def0), diff --git a/lib/compiler/src/beam_ssa.hrl b/lib/compiler/src/beam_ssa.hrl index fa76b08453..509a94135e 100644 --- a/lib/compiler/src/beam_ssa.hrl +++ b/lib/compiler/src/beam_ssa.hrl @@ -62,5 +62,13 @@ -record(b_local, {name :: beam_ssa:b_literal(), arity :: non_neg_integer()}). -%% If this block exists, it calls erlang:error(badarg). --define(BADARG_BLOCK, 1). +%% This is a psuedo-block used to express that certain instructions and BIFs +%% throw exceptions on failure. The code generator rewrites all branches to +%% this block to {f,0} which causes the instruction to throw an exception +%% instead of branching. +%% +%% Since this is not an ordinary block, it's illegal to merge it with other +%% blocks, and jumps are only valid when we know that an exception will be +%% thrown by the operation that branches here; the *block itself* does not +%% throw an exception. +-define(EXCEPTION_BLOCK, 1). diff --git a/lib/compiler/src/beam_ssa_bool.erl b/lib/compiler/src/beam_ssa_bool.erl new file mode 100644 index 0000000000..0860029c59 --- /dev/null +++ b/lib/compiler/src/beam_ssa_bool.erl @@ -0,0 +1,1625 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. 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% +%% +%% The purpose of this pass is to optimize boolean expressions in +%% guards. Instead of evaluating a boolean expression and finally +%% comparing it to 'true', evaluate the expression using control flow. +%% +%% This pass is run directly after conversion to SSA code because some +%% optimizations in beam_ssa_opt (especially sinking of +%% get_tuple_element instructions) would prevent these optimizations +%% or at least make them much more difficult to perform. +%% +%% As an example, take the guard: +%% +%% when is_integer(V0), is_atom(V1) -> +%% +%% The unoptimized SSA code translated to pseudo BEAM code would look +%% like: +%% +%% bif is_integer V0 => Bool0 +%% bif is_atom V1 => Bool1 +%% bif and Bool0 Bool1 => Bool +%% test Bool =:= true else goto Fail +%% ... +%% Fail: +%% ... +%% +%% The optimized code would look like: +%% +%% test is_integer V0 else goto Fail +%% test is_atom V1 else goto Fail +%% ... +%% Fail: +%% ... +%% +%% An 'or' operation is only slightly more complicated: +%% +%% test is_integer V0 else goto NotFailedYet +%% goto Success +%% +%% NotFailedYet: +%% test is_atom V1 else goto Fail +%% +%% Success: +%% ... +%% Fail: +%% ... +%% +%% The unoptimized SSA code for the first example looks like: +%% +%% 0: +%% _2 = bif:is_integer _0 +%% _3 = bif:is_atom _1 +%% _7 = bif:'and' _2, _3 +%% @ssa_bool = succeeded _7 +%% br @ssa_bool, label 4, label 3 +%% +%% 4: +%% @ssa_bool:5 = bif:'=:=' _7, literal true +%% br @ssa_bool:5, label 6, label 3 +%% +%% 6: +%% ret literal ok +%% +%% 3: Error. +%% ... +%% +%% The optimized SSA code looks like: +%% +%% 0: +%% _2 = bif:is_integer _0 +%% br _2, label 11, label 3 +%% +%% 11: +%% _3 = bif:is_atom _1 +%% br _3, label 6, label 3 +%% +%% 6: +%% ret literal ok +%% +%% 3: Error. +%% ... + +-module(beam_ssa_bool). +-export([module/2]). + +-import(lists, [all/2,foldl/3,keyfind/3,last/1,partition/2, + reverse/1,reverse/2,sort/1]). + +-include("beam_ssa.hrl"). + +-record(st, {defs=#{}, + ldefs=#{}, + count :: beam_ssa:label(), + dom, + uses}). + +-spec module(beam_ssa:b_module(), [compile:option()]) -> + {'ok',beam_ssa:b_module()}. + +module(#b_module{body=Fs0}=Module, _Opts) -> + Fs = [function(F) || F <- Fs0], + {ok,Module#b_module{body=Fs}}. + +function(#b_function{anno=Anno}=F) -> + try + opt_function(F) + catch + Class:Error:Stack -> + #{func_info:={_,Name,Arity}} = Anno, + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +opt_function(#b_function{bs=Blocks0,cnt=Count0}=F) -> + {Blocks1,Count1} = pre_opt(Blocks0, Count0), + DefVars = interesting_defs(Blocks1), + if + map_size(DefVars) > 1 -> + Dom = beam_ssa:dominators(Blocks1), + Uses = beam_ssa:uses(Blocks1), + St0 = #st{defs=DefVars,count=Count1,dom=Dom,uses=Uses}, + {Blocks,St} = bool_opt(Blocks1, St0), + Count = St#st.count, + F#b_function{bs=Blocks,cnt=Count}; + true -> + %% There are no boolean operators that can be optimized in + %% this function. + F#b_function{bs=Blocks1,cnt=Count1} + end. + +%%% +%%% Do some optimizations to help the main boolean optimization pass: +%%% +%%% * Remove `succeeded` instructions that can't fail after `and`, +%%% `or`, and `not`. The main optimization pass can only optimize +%%% boolean operators that are known not to fail. +%%% +%%% * Rewrite a boolean #b_switch{} to a #b_br{} if the fail label +%%% can't be reached or is not important. (The main optimization +%%% can't handle #b_switch{}.) +%%% +%%% * Simplify phi nodes, eliminating them if they only have one +%%% value. Also annotate phi nodes that are known to evaluate +%%% to a boolean. +%%% + +-type var() :: beam_ssa:b_var(). + +%% Note: We use the substitution map for both substitutions and type +%% information. If the associated value for a variable is a #b_set{}, +%% it means that the value is a boolean. +-type pre_sub_val() :: + beam_ssa:value() | %Value to be substituted. + beam_ssa:b_set() | %This variable is a boolean. + {'true_or_any',beam_ssa:label()} | + '=:='. + +-type pre_sub_map() :: #{'uses' => {'uses',beam_ssa:block_map() | list()}, + var() => pre_sub_val()}. + +pre_opt(Blocks, Count) -> + Top = beam_ssa:rpo(Blocks), + + %% Collect information to help the pre_opt pass to optimize + %% `switch` instructions. + Sub0 = #{uses => {uses,Blocks}}, + Sub1 = get_phi_info(Top, Blocks, Sub0), + Sub = maps:remove(uses, Sub1), + + %% Now do the actual optimizations. + Reached = gb_sets:singleton(hd(Top)), + pre_opt(Top, Sub, Reached, Count, Blocks). + +-spec get_phi_info(Ls, Blocks, Sub0) -> Sub when + Ls :: [beam_ssa:label()], + Blocks :: beam_ssa:block_map(), + Sub0 :: pre_sub_map(), + Sub :: pre_sub_map(). + +%% get_phi_info([Label], Blocks, Sub0) -> Sub. +%% Collect information to help us optimize `switch` instructions +%% such as: +%% +%% switch SomeVar, label _, [ {literal false, _ }, {literal true, _ } ] +%% . +%% . +%% . +%% PhiVar = phi { SomeVar, _ }, { literal fail, _ }, { literal false, _} +%% EqBool = bif:'=:=' PhiVar, literal true +%% +%% Here it can be seen that `SomeVar` is compared to `true`. If +%% `SomeVar` is not `true`, it does not matter whether its value is +%% `false` or some other value. That means that the `switch` can be +%% replaced with a two-way `br`: +%% +%% NewBoolVar = bif:'=:=' SomeVar, literal true +%% br NewBoolVar, label _, label _ +%% +%% For this example, the value {true_or_any,LabelOfPhiBlock} will be +%% added for the key `SomeVar` in the substitution map. + +get_phi_info([L|Ls], Blocks, Sub0) -> + Sub = get_phi_info(Ls, Blocks, Sub0), + #b_blk{is=Is} = map_get(L, Blocks), + get_phi_info_is(Is, L, Sub); +get_phi_info([], _, Sub) -> Sub. + +get_phi_info_is([I|Is], From, Sub0) -> + Sub = get_phi_info_is(Is, From, Sub0), + get_phi_info_instr(I, From, Sub); +get_phi_info_is([], _, Sub) -> Sub. + +get_phi_info_instr(#b_set{op={bif,'=:='}, + args=[#b_var{}=Bool,#b_literal{val=true}]}, + _From, Sub) -> + Sub#{Bool=>'=:='}; +get_phi_info_instr(#b_set{op=phi,dst=Dst,args=Args}, From, Sub0) -> + {Safe,Sub} = + case Sub0 of + #{Dst:='=:='} -> + get_phi_info_single_use(Dst, Sub0); + #{Dst:={true_or_any,_}} -> + get_phi_info_single_use(Dst, Sub0); + #{} -> + {false,Sub0} + end, + case Safe of + true -> + foldl(fun({#b_var{}=V,_}, A) -> + A#{V => {true_or_any,From}}; + (_, A) -> A + end, Sub, Args); + false -> Sub + end; +get_phi_info_instr(_, _, Sub) -> Sub. + +get_phi_info_single_use(Var, Sub) -> + case map_get(uses, Sub) of + Uses when is_map(Uses) -> + {case Uses of + #{Var:=[_]} -> true; + #{Var:=[_|_]} -> false + end,Sub}; + {uses,Blocks} -> + Uses = beam_ssa:uses(Blocks), + get_phi_info_single_use(Var, Sub#{uses => Uses}) + end. + +-spec pre_opt(Ls, Sub, Reached, Count0, Blocks0) -> {Blocks,Count} when + Ls :: [beam_ssa:label()], + Reached :: gb_sets:set(beam_ssa:label()), + Count0 :: beam_ssa:label(), + Blocks0 :: beam_ssa:block_map(), + Sub :: pre_sub_map(), + Count :: beam_ssa:label(), + Blocks :: beam_ssa:block_map(). + +pre_opt([L|Ls], Sub0, Reached0, Count0, Blocks) -> + case gb_sets:is_member(L, Reached0) of + false -> + %% This block will never be reached. + pre_opt(Ls, Sub0, Reached0, Count0, maps:remove(L, Blocks)); + true -> + #b_blk{is=Is0,last=Last0} = Blk0 = map_get(L, Blocks), + {Is,Sub} = pre_opt_is(Is0, Reached0, Sub0, []), + case pre_opt_terminator(Last0, Sub, Blocks) of + {#b_set{}=Test0,#b_br{}=Br0} -> + %% Here is a #b_switch{} that has been reduced to + %% a '=:=' followed by a two-way `br`. + Bool = #b_var{name={'@ssa_bool',Count0}}, + Count = Count0 + 1, + Test = Test0#b_set{dst=Bool}, + Br = Br0#b_br{bool=Bool}, + Blk = Blk0#b_blk{is=Is++[Test],last=Br}, + Successors = beam_ssa:successors(Blk), + Reached = gb_sets:union(Reached0, + gb_sets:from_list(Successors)), + pre_opt(Ls, Sub, Reached, Count, Blocks#{L:=Blk}); + Last -> + Blk = Blk0#b_blk{is=Is,last=Last}, + Successors = beam_ssa:successors(Blk), + Reached = gb_sets:union(Reached0, + gb_sets:from_list(Successors)), + pre_opt(Ls, Sub, Reached, Count0, Blocks#{L:=Blk}) + end + end; +pre_opt([], _, _, Count, Blocks) -> + {Blocks,Count}. + +pre_opt_is([#b_set{op=phi,dst=Dst,args=Args0}=I0|Is], Reached, Sub0, Acc) -> + Args1 = [{Val,From} || {Val,From} <- Args0, + gb_sets:is_member(From, Reached)], + Args = sub_args(Args1, Sub0), + case all_same(Args) of + true -> + %% Single value or all values are the same. We can remove + %% the phi node. + {Arg,_} = hd(Args), + Sub = Sub0#{Dst=>Arg}, + pre_opt_is(Is, Reached, Sub, Acc); + false -> + case pre_is_phi_bool(Args, Sub0) of + true -> + %% The value of the phi node is always a + %% boolean. Update type information in the sub map + %% and add an annotation. + Anno = I0#b_set.anno, + I = I0#b_set{args=Args,anno=Anno#{boolean_phi=>true}}, + Sub = Sub0#{Dst=>I}, + pre_opt_is(Is, Reached, Sub, [I|Acc]); + false -> + I = I0#b_set{args=Args}, + pre_opt_is(Is, Reached, Sub0, [I|Acc]) + end + end; +pre_opt_is([#b_set{op=succeeded,dst=Dst,args=Args0}=I0|Is], Reached, Sub0, Acc) -> + [Arg] = Args = sub_args(Args0, Sub0), + I = I0#b_set{args=Args}, + case pre_is_safe_bool(Arg, Sub0) of + true -> + %% The preceding boolean operation can't fail. Get rid + %% of this `succeeded` instruction. + Sub = Sub0#{Dst=>#b_literal{val=true}}, + pre_opt_is(Is, Reached, Sub, Acc); + false -> + pre_opt_is(Is, Reached, Sub0, [I|Acc]) + end; +pre_opt_is([#b_set{dst=Dst,args=Args0}=I0|Is], Reached, Sub0, Acc) -> + Args = sub_args(Args0, Sub0), + I = I0#b_set{args=Args}, + case is_bool_expr(I) of + true -> + case pre_eval_op(I, Sub0) of + none -> + Sub = Sub0#{Dst=>I}, + pre_opt_is(Is, Reached, Sub, [I|Acc]); + #b_var{}=Var -> + %% We must remove the 'succeeded' instruction that + %% follows since the variable it checks is gone. + [#b_set{op=succeeded,dst=SuccDst,args=[Dst]}] = Is, + Sub = Sub0#{Dst=>Var,SuccDst=>#b_literal{val=true}}, + pre_opt_is([], Reached, Sub, Acc); + #b_literal{}=Lit -> + Sub = Sub0#{Dst=>Lit}, + pre_opt_is(Is, Reached, Sub, Acc) + end; + false -> + pre_opt_is(Is, Reached, Sub0, [I|Acc]) + end; +pre_opt_is([], _Reached, Sub, Acc) -> + {reverse(Acc),Sub}. + +pre_opt_terminator(#b_br{bool=#b_literal{}}=Br, _Sub, _Blocks) -> + Br; +pre_opt_terminator(#b_br{bool=Bool}=Br0, Sub, Blocks) -> + case beam_ssa:normalize(Br0#b_br{bool=sub_arg(Bool, Sub)}) of + Br0 -> + Br0; + #b_br{bool=#b_literal{val=true},succ=Next}=Br -> + %% See if the terminator from the successor block + %% can be incorporated into this block to give + %% more opportunities for optimization. + #b_blk{is=Is,last=Last} = map_get(Next, Blocks), + case {Is,Last} of + {[],#b_switch{}} -> + pre_opt_terminator(Last, Sub, Blocks); + {_,_} -> + Br + end + end; +pre_opt_terminator(#b_ret{arg=Arg}=Ret, Sub, _Blocks) -> + Ret#b_ret{arg=sub_arg(Arg, Sub)}; +pre_opt_terminator(#b_switch{arg=Arg0,list=List}=Sw0, Sub, Blocks) -> + Arg = sub_arg(Arg0, Sub), + Sw = Sw0#b_switch{arg=Arg}, + case sort(List) of + [{#b_literal{val=false},Fail}, + {#b_literal{val=true},Succ}] -> + case pre_is_arg_bool(Arg, Sub) of + false -> + pre_opt_sw(Sw, Fail, Succ, Sub, Blocks); + true -> + beam_ssa:normalize(#b_br{bool=Arg,succ=Succ,fail=Fail}) + end; + _ -> + Sw + end. + +pre_opt_sw(#b_switch{arg=Arg,fail=Fail}=Sw, False, True, Sub, Blocks) -> + case Sub of + #{Arg:={true_or_any,PhiL}} -> + #{Fail:=FailBlk,False:=FalseBlk,PhiL:=PhiBlk} = Blocks, + case {FailBlk,FalseBlk,PhiBlk} of + {#b_blk{is=[],last=#b_br{succ=PhiL,fail=PhiL}}, + #b_blk{is=[],last=#b_br{succ=PhiL,fail=PhiL}}, + #b_blk{is=[#b_set{op=phi,args=PhiArgs}|_]}} -> + case keyfind(False, 2, PhiArgs) of + {#b_literal{val=Bool},False} when Bool =/= true -> + %% This is an `andalso` in a guard. The code + %% can be simplified to a two-way `br` because + %% the actual value of the variable does not + %% matter if it is not equal to `true`. + DummyDst = #b_var{name=0}, + {#b_set{op={bif,'=:='},dst=DummyDst, + args=[Arg,#b_literal{val=true}]}, + #b_br{bool=DummyDst,succ=True,fail=False}}; + {_,_} -> + Sw + end; + {_,_,_} -> + Sw + end; + #{} -> + Sw + end. + +pre_eval_op(#b_set{op={bif,Op},args=Args}, Sub) -> + case pre_are_args_bool(Args, Sub) of + true -> + case {Op,Args} of + {'and',[#b_literal{val=true},#b_var{}=Res]} -> Res; + {'and',[#b_literal{val=false}=Res,#b_var{}]} -> Res; + {'and',[#b_var{}=Res,#b_literal{val=true}]} -> Res; + {'and',[#b_var{},#b_literal{val=false}=Res]} -> Res; + {'or',[#b_literal{val=true}=Res,#b_var{}]} -> Res; + {'or',[#b_literal{val=false},#b_var{}=Res]} -> Res; + {'or',[#b_var{},#b_literal{val=true}=Res]} -> Res; + {'or',[#b_var{}=Res,#b_literal{val=false}]} -> Res; + _ -> none + end; + false -> + none + end. + +all_same([{H,_}|T]) -> + all(fun({E,_}) -> E =:= H end, T). + +pre_is_phi_bool([{#b_literal{val=Lit},_}|As], Sub) -> + is_boolean(Lit) andalso pre_is_phi_bool(As, Sub); +pre_is_phi_bool([{#b_var{}=A,_}|As], Sub) -> + case Sub of + #{A:=#b_set{}} -> + pre_is_phi_bool(As, Sub); + #{} -> + false + end; +pre_is_phi_bool([], _Sub) -> true. + +pre_is_safe_bool(#b_literal{}, _Sub) -> + true; +pre_is_safe_bool(Var, Sub) -> + case Sub of + #{Var:=#b_set{op={bif,is_function}, + args=[_,Arity]}} -> + case Arity of + #b_literal{val=Lit} -> + is_integer(Lit) andalso Lit >= 0; + #b_var{} -> + false + end; + #{Var:=#b_set{op={bif,Op},args=Args}} -> + Arity = length(Args), + erl_internal:bool_op(Op, Arity) andalso + pre_are_args_bool(Args, Sub); + #{} -> + false + end. + +pre_are_args_bool([A|As], Sub) -> + pre_is_arg_bool(A, Sub) andalso pre_are_args_bool(As, Sub); +pre_are_args_bool([], _Sub) -> true. + +pre_is_arg_bool(#b_literal{val=Lit}, _Sub) -> + is_boolean(Lit); +pre_is_arg_bool(#b_var{}=A, Sub) -> + case Sub of + #{A:=#b_set{}} -> + true; + #{} -> + false + end. + +%%% +%%% Build a map from variable to definitions for boolean expressions +%%% phi nodes. This map will be used by collect_bool_vars() and by +%%% shortcut_branches(). +%%% + +interesting_defs(Blocks) -> + interesting_defs(maps:to_list(Blocks), []). + +interesting_defs([{L,#b_blk{is=Is}}|Bs], Acc) -> + interesting_defs(Bs, interesting_defs_is(Is, L, Acc)); +interesting_defs([], Acc) -> + maps:from_list(Acc). + +interesting_defs_is([#b_set{op={bif,_},dst=V}=I|Is], L, Acc) -> + case is_bool_expr(I) of + true -> + interesting_defs_is(Is, L, [{V,{L,I}}|Acc]); + false -> + interesting_defs_is(Is, L, Acc) + end; +interesting_defs_is([#b_set{op=phi,dst=V}=Set|Is], L, Acc) -> + interesting_defs_is(Is, L, [{V,{L,Set}}|Acc]); +interesting_defs_is([#b_set{}|Is], L, Acc) -> + interesting_defs_is(Is, L, Acc); +interesting_defs_is([], _L, Acc) -> Acc. + +%%% +%%% Search for boolean expressions to optimize. +%%% +%%% The main purpose of this module is to optimize guards. A guard ends in the +%%% following instructions: +%%% +%%% Bool = bif:'=:=' Var, literal true +%%% br BoolVar, label Success, label Failure +%%% +%%% To make sure that we'll find the end of the guard instead of some +%%% interior '=:=' instruction we will visit the blocks in postorder. +%%% + +bool_opt(Blocks, St) -> + bool_opt(beam_ssa:rpo(Blocks), Blocks, St). + +bool_opt([L|Ls], Blocks0, St0) -> + {Blocks,St1} = bool_opt(Ls, Blocks0, St0), + case Blocks of + #{L:=#b_blk{is=[_|_]=Is,last=#b_br{bool=#b_var{}=Bool}=Br}} -> + case last(Is) of + #b_set{op={bif,'=:='},dst=Bool, + args=[#b_var{},#b_literal{val=true}]} -> + try + bool_opt_rewrite(Bool, L, Br, Blocks, St1) + catch + throw:not_possible -> + {Blocks,St1} + end; + #b_set{} -> + {Blocks,St1} + end; + #{} -> + %% Either this block was removed by a previous successful + %% optimization, it is empty, or its terminator is not a + %% two-way `br` instruction. + {Blocks,St1} + end; +bool_opt([], Blocks, St) -> + {Blocks,St}. + +bool_opt_rewrite(Bool, From, Br, Blocks0, St0) -> + TreeVars = collect_bool_vars(Bool, St0), + case TreeVars of + [Bool] -> + %% Only one variable means that there is nothing to + %% optimize. (The variable is either a function argument, + %% or has been defined by an instruction such as `call` or + %% `get_tuple_element`.) + not_possible(); + [_|_] -> + ok + end, + + %% Find the common dominator block for all the blocks with boolean + %% variables. + Dom = bool_opt_dom(TreeVars, St0), + + %% Split out non-boolean instruction from the block that dominates + %% all the boolean operators. Splitting will save some work, and + %% it could also make more optimizations possible since phi nodes + %% could be difficult to handle later when they have been included + %% in the graph. + {DomPreIs,Blocks1} = split_dom_block(Dom, Blocks0), + + %% Collect all blocks from the Dom block up to and including + %% the From block. + Bs = collect_digraph_blocks(Dom, From, Br, Blocks1), + + %% Build a digraph from the collected blocks. + {Root,G0,St1} = build_digraph(Bs, Br, St0), + + %% Optimize the digraph. + LDefs = digraph_bool_def(G0), + St = St1#st{ldefs=LDefs}, + G1 = opt_digraph_top(Bool, G0, St), + G = shortcut_branches(Root, G1, St), + + %% Make sure that every variable that is used will be defined + %% on every path to its use. + ensure_init(Root, G, G0), + + %% Delete the original blocks. This is important so that we will not + %% try optimize the already optimized code. That would not work + %% because the map of definitions in St#st.defs would not be updated + %% to include the newly optimized blocks. + DomBlk0 = map_get(Dom, Blocks1), + Blocks2 = maps:without([L || {L,#b_blk{}} <- Bs], Blocks1), + + %% Convert the optimized digraph back to SSA code. + Blocks3 = digraph_to_ssa([Root], G, Blocks2), + + %% Add a branch from the pre-sequence in the dominating block to + %% the first block of the optimized code. + DomBlk = DomBlk0#b_blk{is=DomPreIs,last=oneway_br(Root)}, + Blocks = Blocks3#{Dom => DomBlk}, + {Blocks,St#st{ldefs=#{}}}. + +%%% +%%% Collect boolean variables recursively reachable from the root +%%% boolean variable. +%%% + +collect_bool_vars(RootBool, St) -> + #b_set{args=[#b_var{}=Var,#b_literal{}]} = get_def(RootBool, St), + collect_bool_vars([Var], St, [RootBool]). + +collect_bool_vars([V|Vs], St, Acc) -> + case get_def(V, St) of + #b_set{op=phi,anno=Anno,args=Args} -> + {Vars,Ls} = collect_phi_args(Args, Anno), + collect_bool_vars(Vars ++ Vs, St, Ls ++ Vars ++ Acc); + #b_set{args=Args}=I -> + %% This is a boolean expression. + Vars = [Arg || #b_var{}=Arg <- Args], + case is_rewritable_bool_op(I) of + true -> + %% This is a bool op ('and', 'or', or + %% 'not'). Recursively collect more boolean + %% variables from its arguments. + collect_bool_vars(Vars ++ Vs, St, [V|Acc]); + false -> + %% This is a comparison operator (such as `<`) or + %% type test. Don't visit its arguments + %% recursively. + collect_bool_vars(Vs, St, [V|Acc]) + end; + none -> + collect_bool_vars(Vs, St, Acc) + end; +collect_bool_vars([], _St, Acc) -> + ordsets:from_list(Acc). + +is_rewritable_bool_op(#b_set{op={bif,Bif}}) -> + %% `xor` is a bool op, but it is not practical to rewrite it. + case Bif of + 'and' -> true; + 'or' -> true; + 'not' -> true; + _ -> false + end. + +collect_phi_args(Args, Anno) -> + case is_map_key(boolean_phi, Anno) of + true -> + Vars = [V || {#b_var{}=V,_} <- Args], + case Vars of + [_|_] -> + {Vars,[]}; + [] -> + %% This phi node only contains literal values. + %% Force the inclusion of referenced blocks. + Ls = [{block,L} || {_,L} <- Args], + {[],Ls} + end; + false -> + %% We can't rewrite phi nodes that don't return + %% a boolean value. + {[],[]} + end. + +%%% +%%% Dominator utility functions. +%%% + +bool_opt_dom(TreeVars, #st{defs=Defs,dom={DomBy,Num}}) -> + Ls0 = foldl(fun({block,L}, A) -> + [L|A]; + (V, A) -> + {L,_} = map_get(V, Defs), + [L|A] + end, [], TreeVars), + Ls = ordsets:from_list(Ls0), + [Common|_] = beam_ssa:common_dominators(Ls, DomBy, Num), + Common. + +split_dom_block(L, Blocks0) -> + #b_blk{is=Is} = Blk0 = map_get(L, Blocks0), + {PreIs,TailIs} = split_dom_block_is(Is, []), + Blk = Blk0#b_blk{is=TailIs}, + Blocks = Blocks0#{L:=Blk}, + {PreIs,Blocks}. + +split_dom_block_is([#b_set{},#b_set{op=succeeded}]=Is, PreAcc) -> + {reverse(PreAcc),Is}; +split_dom_block_is([#b_set{}=I|Is]=Is0, PreAcc) -> + case is_bool_expr(I) of + true -> + {reverse(PreAcc),Is0}; + false -> + split_dom_block_is(Is, [I|PreAcc]) + end; +split_dom_block_is([], PreAcc) -> + {reverse(PreAcc),[]}. + +%%% +%%% Find and collect the blocks that should be converted to a digraph. +%%% + +collect_digraph_blocks(FirstL, LastL, #b_br{succ=Succ,fail=Fail}, Blocks) -> + Ws = gb_sets:singleton(FirstL), + Seen = cerl_sets:from_list([Succ,Fail]), + collect_digraph_blocks(Ws, LastL, Blocks, Seen, []). + +collect_digraph_blocks(Ws0, LastL, Blocks, Seen0, Acc0) -> + case gb_sets:is_empty(Ws0) of + true -> + Acc0; + false -> + {L,Ws1} = gb_sets:take_smallest(Ws0), + Seen = cerl_sets:add_element(L, Seen0), + Blk = map_get(L, Blocks), + Acc = [{L,Blk}|Acc0], + Ws = cdb_update_workset(L, Blk, LastL, Seen, Ws1), + collect_digraph_blocks(Ws, LastL, Blocks, Seen, Acc) + end. + +cdb_update_workset(LastL, _Blk, LastL, _Seen, Ws) -> + Ws; +cdb_update_workset(_L, Blk, _LastL, Seen, Ws) -> + Successors = beam_ssa:successors(Blk), + cdb_update_workset(Successors, Seen, Ws). + +cdb_update_workset([L|Ls], Seen, Ws) -> + case cerl_sets:is_element(L, Seen) of + true -> + cdb_update_workset(Ls, Seen, Ws); + false -> + cdb_update_workset(Ls, Seen, gb_sets:add_element(L, Ws)) + end; +cdb_update_workset([], _Seen, Ws) -> Ws. + +%%% +%%% For the blocks from the dominating block up to the last block, +%%% build a digraph where each vertex is an instruction. This is just +%%% a more convenient way to represent the code, more suitable for +%%% the optimizations we are about to do. +%%% + +build_digraph(Bs, #b_br{succ=Succ,fail=Fail}, St0) -> + Ignore = ordsets:from_list([Succ,Fail]), + G0 = beam_digraph:new(), + {Map0,G1,St1} = build_mapping(Bs, #{}, G0, St0), + {Map,G2} = add_external_vertices(Ignore, Map0, G1), + {G,St} = build_digraph_1(Bs, G2, Map, St1), + + %% Find the root node now. After we have done optimizations, + %% there may be more than one root node (that is, nodes without + %% any incident vertices). + [Root] = digraph_roots(G), + {Root,G,St}. + +build_mapping([{L,Blk}|Bs], Map0, G0, St0) -> + {Vtx,St} = new_label(St0), + Map = Map0#{L=>Vtx}, + Label = case Blk of + #b_blk{is=[]} -> br; + #b_blk{} -> initial + end, + G = beam_digraph:add_vertex(G0, Vtx, Label), + build_mapping(Bs, Map, G, St); +build_mapping([], Map, G, St) -> + {Map,G,St}. + +add_external_vertices([V|Vs], Map0, G0) -> + G = beam_digraph:add_vertex(G0, V, {external,#{}}), + Map = Map0#{V=>V}, + add_external_vertices(Vs, Map, G); +add_external_vertices([], Map, G) -> + {Map,G}. + +build_digraph_1([{L,Blk}|Bs], G0, Map, St0) -> + #b_blk{is=Is,last=Last} = Blk, + Vtx = map_get(L, Map), + {G,St} = build_digraph_is(Is, Last, Vtx, Map, G0, St0), + build_digraph_1(Bs, G, Map, St); +build_digraph_1([], G, _Map, St) -> + {G,St}. + +build_digraph_is([#b_set{op=phi,args=Args0}=I0|Is], Last, Vtx, Map, G, St) -> + case Is of + [#b_set{op=phi}|_] -> not_possible(); + _ -> ok + end, + Args = [{V,map_get(L, Map)} || {V,L} <- Args0], + I = I0#b_set{args=Args}, + build_digraph_is_1(I, Is, Last, Vtx, Map, G, St); +build_digraph_is([#b_set{}=I|Is], Last, Vtx, Map, G, St) -> + case beam_ssa:no_side_effect(I) of + true -> + build_digraph_is_1(I, Is, Last, Vtx, Map, G, St); + false -> + not_possible() + end; +build_digraph_is([], Last, From, Map, G0, St) -> + case Last of + #b_br{bool=#b_literal{val=true},succ=To0,fail=To0} -> + To = map_get(To0, Map), + G = beam_digraph:add_edge(G0, From, To, next), + {G,St}; + #b_br{bool=#b_var{}=Bool,succ=Succ0,fail=Fail0} -> + #{Succ0:=Succ,Fail0:=Fail} = Map, + case beam_digraph:vertex(G0, From) of + #b_set{dst=Bool} -> + G = add_succ_fail_edges(From, Succ, Fail, G0), + {G,St}; + #b_set{} -> + %% Wrong variable being tested. This is rare. + not_possible(); + br -> + G1 = add_succ_fail_edges(From, Succ, Fail, G0), + G = beam_digraph:add_vertex(G1, From, {br,Bool}), + {G,St} + end; + _ -> + not_possible() + end. + +build_digraph_is_1(I, Is, Last, Vtx, Map, G0, St0) -> + G1 = beam_digraph:add_vertex(G0, Vtx, I), + case Is of + [] -> + build_digraph_is(Is, Last, Vtx, Map, G1, St0); + [_|_] -> + {NextVtx,St} = new_label(St0), + G2 = beam_digraph:add_vertex(G1, NextVtx, initial), + G = beam_digraph:add_edge(G2, Vtx, NextVtx, next), + build_digraph_is(Is, Last, NextVtx, Map, G, St) + end. + +%%% +%%% Optimize the graph, attempting to eliminating 'and', 'or', and 'not' +%%% instructions. +%%% + +opt_digraph_top(Arg, G0, St) -> + I = get_def(Arg, G0, St), + #b_set{op={bif,'=:='},dst=Dst, + args=[#b_var{}=Bool,#b_literal{val=true}]} = I, + {br,Succ,Fail} = get_targets(Dst, G0, St), + G1 = ensure_single_use(Dst, G0, St), + G = convert_to_br_node(I, Succ, G1, St), + redirect_test(Bool, {fail,Fail}, G, St). + +do_opt_digraph([A|As], G0, St) -> + I = get_def(A, G0, St), + try opt_digraph_instr(I, G0, St) of + G -> + do_opt_digraph(As, G, St) + catch + throw:not_possible -> + do_opt_digraph(As, G0, St) + end; +do_opt_digraph([], G, _St) -> G. + +opt_digraph_instr(#b_set{dst=Dst}=I, G0, St) -> + %% We KNOW that this node has two outgoing edges (one labeled + %% `succ` and one `fail`). + {br,Succ,Fail} = get_targets(Dst, G0, St), + G1 = ensure_single_use(Dst, G0, St), + case I of + #b_set{op={bif,'and'},args=Args} -> + G2 = convert_to_br_node(I, Succ, G1, St), + {First,Second} = order_args(Args, G2, St), + G = redirect_test(First, {fail,Fail}, G2, St), + redirect_test(Second, {fail,Fail}, G, St); + #b_set{op={bif,'or'},args=Args} -> + {First,Second} = order_args(Args, G1, St), + + %% Here we give up the optimization if the optimization + %% would skip instructions that may fail. A possible + %% future improvement would be to hoist the failing + %% instructions so that they would always be executed. + ensure_no_failing_instructions(First, Second, G1, St), + + G2 = convert_to_br_node(I, Succ, G1, St), + G = redirect_test(First, {succ,Succ}, G2, St), + redirect_test(Second, {fail,Fail}, G, St); + #b_set{op={bif,'xor'}} -> + %% Rewriting 'xor' is not practical. Fortunately, + %% 'xor' is almost never used in practice. + not_possible(); + #b_set{op={bif,'not'},args=[#b_var{}=Bool]} -> + G = convert_to_br_node(I, Fail, G1, St), + redirect_test(Bool, {fail,Succ}, G, St); + #b_set{op=phi,dst=Bool} -> + Vtx = get_vertex(Bool, St), + G2 = del_out_edges(Vtx, G1), + G = beam_digraph:add_edge(G2, Vtx, Succ, next), + redirect_test(Bool, {fail,Fail}, G, St); + #b_set{} -> + G1 + end. + +ensure_single_use(Bool, G, #st{uses=U}=St) -> + case map_get(Bool, U) of + [_] -> + G; + Uses -> + Vtx = get_vertex(Bool, St), + ensure_single_use_1(Bool, Vtx, Uses, G) + end. + +ensure_single_use_1(Bool, Vtx, Uses, G) -> + Fail = case get_targets(Vtx, G) of + {br,_,Fail0} -> Fail0; + _ -> not_possible() + end, + case partition(fun({L,#b_set{}}) when L =:= Fail -> true; + (_) -> false + end, Uses) of + {[_],[_]} -> + case beam_digraph:vertex(G, Fail) of + {external,Bs0} -> + %% The only other use of the variable Bool + %% is in the failure block. It can be + %% replaced with the literal `false` + %% in that block. + Bs = Bs0#{Bool => #b_literal{val=false}}, + beam_digraph:add_vertex(G, Fail, {external,Bs}); + _ -> + not_possible() + end; + {_,_} -> + not_possible() + end. + +convert_to_br_node(I, Target, G0, St) -> + Vtx = get_vertex(I, St), + G1 = del_out_edges(Vtx, G0), + G = beam_digraph:add_vertex(G1, Vtx, br), + beam_digraph:add_edge(G, Vtx, Target, next). + + +%% ensure_no_failing_instructions(First, Second, G, St) -> ok. +%% Ensure that there are no instructions that can fail that would not +%% be executed if right-hand side of the `or` would be skipped. That +%% means that the `or` could succeed when it was supposed to +%% fail. Example: +%% +%% (element(1, T) =:= tag) or +%% (element(10, T) =:= y) + +ensure_no_failing_instructions(First, Second, G, St) -> + Vs0 = covered(get_vertex(First, St), get_vertex(Second, St), G), + Vs = [{V,beam_digraph:vertex(G, V)} || V <- Vs0], + Failing = [P || {V,#b_set{op=succeeded}}=P <- Vs, + not eaten_by_phi(V, G)], + case Failing of + [] -> ok; + [_|_] -> not_possible() + end. + +eaten_by_phi(V, G) -> + {br,_,Fail} = get_targets(V, G), + case beam_digraph:vertex(G, Fail) of + br -> + [To] = beam_digraph:out_neighbours(G, Fail), + case beam_digraph:vertex(G, To) of + #b_set{op=phi} -> + true; + _ -> + false + end; + _ -> + false + end. + +%% order_args([Arg1,Arg2], G, St) -> {First,Second}. +%% Order arguments for a boolean operator so that there is path in the +%% digraph from the instruction referered to by the first operand to +%% the instruction refered to by the second operand. + +order_args([#b_var{}=VarA,#b_var{}=VarB], G, St) -> + {VA,VB} = {get_vertex(VarA, St),get_vertex(VarB, St)}, + case beam_digraph:is_path(G, VA, VB) of + true -> + %% Core Erlang code generated by v3_core always + %% has operands already in correct order. + {VarA,VarB}; + false -> + %% Core Erlang code generated by other frontends + %% such as LFE may have the operands swapped. + true = beam_digraph:is_path(G, VB, VA), %Assertion. + {VarB,VarB} + end; +order_args(_Args, _G, _St) -> + %% Literal operands. Can only happen if the Core Erlang optimization + %% passes have been turned off. + not_possible(). + +redirect_test(Bool, SuccFail, G0, St) -> + V = get_vertex(Bool, St), + I = get_def(Bool, G0, St), + case I of + #b_set{op=phi,args=Args} -> + G = ensure_single_use(Bool, G0, St), + redirect_phi(Bool, Args, SuccFail, G, St); + #b_set{} -> + G1 = redirect_test_1(V, SuccFail, G0), + G = ensure_single_use(Bool, G1, St), + do_opt_digraph([Bool], G, St) + end. + +redirect_test_1(V, SuccFail, G) -> + case get_targets(V, G) of + {br,_Succ,Fail} -> + %% I have only seen this happen in code generated by LFE + %% (in lfe_andor_SUITE.core and lfe_guard_SUITE.core) + case SuccFail of + {fail,Fail} -> G; + {succ,_} -> not_possible() + end; + {br,Next} -> + case SuccFail of + {succ,Succ} -> + add_succ_fail_edges(V, Succ, Next, G); + {fail,Fail} -> + add_succ_fail_edges(V, Next, Fail, G) + end + end. + +redirect_phi(Phi, Args, SuccFail, G0, St) -> + PhiVtx = get_vertex(Phi, St), + G = beam_digraph:add_vertex(G0, PhiVtx, br), + redirect_phi_1(PhiVtx, sort(Args), SuccFail, G, St). + +redirect_phi_1(PhiVtx, [{#b_literal{val=false},FalseExit}, + {#b_var{}=SuccBool,_BoolExit}], + SuccFail, G0, St) -> + BoolVtx = get_vertex(SuccBool, St), + [FalseOut] = beam_digraph:out_edges(G0, FalseExit), + G1 = beam_digraph:del_edge(G0, FalseOut), + case SuccFail of + {fail,Fail} -> + G2 = beam_digraph:add_edge(G1, FalseExit, Fail, next), + G = add_succ_fail_edges(BoolVtx, PhiVtx, FalseExit, G2), + do_opt_digraph([SuccBool], G, St); + {succ,Succ} -> + G2 = beam_digraph:add_edge(G1, FalseExit, PhiVtx, next), + G = add_succ_fail_edges(BoolVtx, Succ, PhiVtx, G2), + do_opt_digraph([SuccBool], G, St) + end; +redirect_phi_1(PhiVtx, [{#b_literal{val=true},TrueExit}, + {#b_var{}=SuccBool,_BoolExit}], + {fail,Fail}, G0, St) -> + %% This was probably an `orelse` in the source code. + BoolVtx = get_vertex(SuccBool, St), + [TrueOut] = beam_digraph:out_edges(G0, TrueExit), + G1 = beam_digraph:del_edge(G0, TrueOut), + G2 = beam_digraph:add_edge(G1, TrueExit, PhiVtx, next), + G = add_succ_fail_edges(BoolVtx, PhiVtx, Fail, G2), + %% As as future improvement, we could follow TrueExit + %% back to its originating boolean expression and + %% optimize that too. + do_opt_digraph([SuccBool], G, St); +redirect_phi_1(_PhiVtx, [{#b_literal{val=false},FalseExit}, + {#b_literal{val=true},TrueExit}], + SuccFail, G0, _St) -> + case SuccFail of + {fail,Fail} -> + [FalseOut] = beam_digraph:out_edges(G0, FalseExit), + G = beam_digraph:del_edge(G0, FalseOut), + beam_digraph:add_edge(G, FalseExit, Fail, next); + {succ,Succ} -> + [TrueOut] = beam_digraph:out_edges(G0, TrueExit), + G = beam_digraph:del_edge(G0, TrueOut), + beam_digraph:add_edge(G, TrueExit, Succ, next) + end; +redirect_phi_1(_PhiVtx, _Args, _SuccFail, _G, _St) -> + not_possible(). + +digraph_bool_def(G) -> + Vs = beam_digraph:vertices(G), + Ds = [{Dst,Vtx} || {Vtx,#b_set{dst=Dst}} <- Vs], + maps:from_list(Ds). + +%%% +%%% Shortcut branches that branch to other branches. +%%% +%%% Shortcutting may eliminate problems with variables that +%%% are not defined on all paths to their use. For example, +%%% code such as the following can be made safe again: +%%% +%%% ensure_written(Head, false) when not Head#head.ram_file -> ... +%%% +%%% Shortcutting also simplifies the conversion from the digraph +%%% back to the standard SSA format. +%%% + +shortcut_branches(Vtx, G, St) -> + Vs = reverse(beam_digraph:reverse_postorder(G, [Vtx])), + do_shortcut_branches(Vs, G, St). + +do_shortcut_branches([V|Vs], G0, St) -> + case get_targets(V, G0) of + {br,Succ0,Fail0} -> + {SuccBs,FailBs} = eval_bs(V, G0, St), + Succ = eval_instr(Succ0, G0, SuccBs), + G1 = redirect_edge(V, Succ0, {succ,Succ}, G0), + Fail = eval_instr(Fail0, G1, FailBs), + G = redirect_edge(V, Fail0, {fail,Fail}, G1), + do_shortcut_branches(Vs, G, St); + {br,Next0} -> + Next = eval_instr(Next0, G0, #{}), + G = redirect_edge(V, Next0, {next,Next}, G0), + do_shortcut_branches(Vs, G, St); + none -> + %% This is an external vertex. + do_shortcut_branches(Vs, G0, St) + end; +do_shortcut_branches([], G, _St) -> G. + +redirect_edge(_From, To, {_Label,To}, G) -> + G; +redirect_edge(From, To0, {Label,To}, G0) -> + G = beam_digraph:del_edge(G0, {From,To0,Label}), + beam_digraph:add_edge(G, From, To, Label). + +eval_bs(Vtx, G, St) -> + case beam_digraph:vertex(G, Vtx) of + #b_set{op={bif,'=:='},args=[#b_var{}=Bool,#b_literal{val=true}]} -> + case get_def(Bool, G, St) of + #b_set{op=phi}=Phi -> + phi_bs(Phi); + _ -> + {#{},#{}} + end; + _ -> + {#{},#{}} + end. + +phi_bs(#b_set{op=phi,dst=PhiDst,args=PhiArgs}) -> + Literals0 = [Lit || {#b_literal{}=Lit,_} <- PhiArgs], + case length(Literals0) =:= length(PhiArgs) of + true -> + %% The values in the phi node are all literals. + Literals = ordsets:from_list(Literals0), + case partition(fun(#b_literal{val=Val}) -> + Val =:= true + end, Literals) of + {[True],[FailVal]} -> + %% As there is only two possible values, we can + %% predict the value of the phi node on both + %% branches. + SuccBs = #{PhiDst => True}, + FailBs = #{PhiDst => FailVal}, + {SuccBs,FailBs}; + {_,_} -> + {#{},#{}} + end; + false -> + {#{},#{}} + end. + +eval_instr(Vtx, G, Bs) -> + case beam_digraph:vertex(G, Vtx) of + #b_set{} when map_size(Bs) =:= 0 -> + %% With no bindings, eval_safe_bool_expr() is + %% unlikely to do anything useful. If we would + %% call it anyway, the time complexity would be + %% quadratic, which would be slow for large + %% graphs. + Vtx; + #b_set{}=I -> + case is_safe_bool_expr(I) of + true -> eval_safe_bool_expr(I, Vtx, G, Bs); + false -> Vtx + end; + br -> + %% We can shortcut this branch unless its + %% target is a phi node. + [Next] = beam_digraph:out_neighbours(G, Vtx), + case beam_digraph:vertex(G, Next) of + #b_set{op=phi} -> Vtx; + _ -> eval_instr(Next, G, Bs) + end; + {br,#b_var{}} -> + Vtx; + {external,_} -> + Vtx + end. + +eval_safe_bool_expr(#b_set{op={bif,Bif},dst=Dst,args=Args0}, Vtx, G, Bs) -> + case get_targets(Vtx, G) of + {br,Succ,Fail} -> + True = #b_literal{val=true}, + False = #b_literal{val=false}, + Args = sub_args(Args0, Bs), + case eval_bif(Bif, Args) of + none -> + case {eval_instr(Succ, G, Bs#{Dst=>True}), + eval_instr(Fail, G, Bs#{Dst=>False})} of + {Same,Same} -> Same; + {_,_} -> Vtx + end; + true -> + eval_instr(Succ, G, Bs#{Dst=>True}); + false -> + eval_instr(Fail, G, Bs#{Dst=>False}) + end; + {br,_} -> + Vtx + end. + +eval_bif(Bif, Args0) -> + case eval_literal_args(Args0, []) of + none -> + none; + Args -> + %% We have already made sure that this expression can't + %% fail; thus there is no need for a `try`. + apply(erlang, Bif, Args) + end. + +eval_literal_args([#b_literal{val=Val}|As], Acc) -> + eval_literal_args(As, [Val|Acc]); +eval_literal_args([_|_], _) -> + none; +eval_literal_args([], Acc) -> + reverse(Acc). + +%%% +%%% Check that variables are initialized on all paths and abort +%%% the optimization if not. +%%% +%%% Expressions that use `or` and `not` may have added +%%% `bif:is_boolean` instructions at the end of the boolean +%%% expression. It can happen that the variables tested by +%%% `bif:is_boolean` are not initialized on all paths. +%%% + +ensure_init(Root, G, G0) -> + Vs = beam_digraph:vertices(G), + + %% Build an ordset of a all variables used by the code + %% before the optimization. + Used = ensure_init_used(G0), + + %% Build a map of all variables that are set by instructions in + %% the digraph. Variables not included in this map have been + %% defined by code before the code in the digraph. + Vars = maps:from_list([{Dst,unset} || + {_,#b_set{dst=Dst}} <- Vs]), + RPO = beam_digraph:reverse_postorder(G, [Root]), + ensure_init_1(RPO, Used, G, #{Root=>Vars}). + +ensure_init_1([V|Vs], Used, G, InitMaps0) -> + InitMaps = ensure_init_instr(V, Used, G, InitMaps0), + ensure_init_1(Vs, Used, G, InitMaps); +ensure_init_1([], _, _, _) -> ok. + +ensure_init_instr(Vtx, Used, G, InitMaps0) -> + VarMap0 = map_get(Vtx, InitMaps0), + case beam_digraph:vertex(G, Vtx) of + #b_set{dst=Dst}=I -> + do_ensure_init_instr(I, VarMap0, InitMaps0), + OutVs = beam_digraph:out_neighbours(G, Vtx), + VarMap = VarMap0#{Dst=>set}, + InitMaps = InitMaps0#{Vtx:=VarMap}, + ensure_init_successors(OutVs, G, VarMap, InitMaps); + {external,_} -> + %% We have reached the success or failure node. + %% If the code we have been optimizing does not + %% originate from a guard, it is possible that a + %% variable set in the optimized code will be used + %% here. + case [V || {V,unset} <- maps:to_list(VarMap0)] of + [] -> + InitMaps0; + [_|_]=Unset0 -> + %% There are some variables that are not always + %% set when this node is reached. We must make + %% sure that they are not used at this node or + %% one of its successors. + Unset = ordsets:from_list(Unset0), + case ordsets:is_subset(Unset, Used) of + true -> + %% Note that all of the potentially unset + %% variables are only used once (otherwise + %% the optimization would have been + %% aborted earlier). Therefore, since all + %% variables are used in the optimized code, + %% they cannot be used in this node or in one + %% of its successors. + InitMaps0; + false -> + %% The original code probably did not + %% originate from a guard. One of the + %% potentially unset variables are not + %% used in the optimized code. That means + %% that it must be used at this node or in + %% one of its successors. (Or that it was + %% not used at all in the original code, + %% but that basically only happens in test + %% cases.) + not_possible() + end + end; + _ -> + OutVs = beam_digraph:out_neighbours(G, Vtx), + ensure_init_successors(OutVs, G, VarMap0, InitMaps0) + end. + +ensure_init_used(G) -> + Vs = beam_digraph:vertices(G), + ensure_init_used_1(Vs, G, []). + +ensure_init_used_1([{Vtx,#b_set{dst=Dst}=I}|Vs], G, Acc0) -> + Acc1 = [beam_ssa:used(I)|Acc0], + case beam_digraph:out_degree(G, Vtx) of + 2 -> + Acc = [[Dst]|Acc1], + ensure_init_used_1(Vs, G, Acc); + _ -> + ensure_init_used_1(Vs, G, Acc1) + end; +ensure_init_used_1([{_Vtx,{br,Bool}}|Vs], G, Acc) -> + ensure_init_used_1(Vs, G, [[Bool]|Acc]); +ensure_init_used_1([_|Vs], G, Acc) -> + ensure_init_used_1(Vs, G, Acc); +ensure_init_used_1([], _G, Acc) -> + ordsets:union(Acc). + +do_ensure_init_instr(#b_set{op=phi,args=Args}, + _VarMap, InitMaps) -> + _ = [ensure_init_used(Var, map_get(From, InitMaps)) || + {#b_var{}=Var,From} <- Args], + ok; +do_ensure_init_instr(#b_set{}=I, VarMap, _InitMaps) -> + Used = beam_ssa:used(I), + _ = [ensure_init_used(Var, VarMap) || Var <- Used], + ok. + +ensure_init_used(Var, VarMap) -> + case VarMap of + #{Var:=unset} -> not_possible(); + #{Var:=set} -> ok; + #{} -> ok + end. + +ensure_init_successors([To|Vs], G, Vars0, InitMaps0) -> + case InitMaps0 of + #{To:=Vars1} -> + Vars = join_inits(Vars0, Vars1), + InitMaps = InitMaps0#{To:=Vars}, + ensure_init_successors(Vs, G, Vars0, InitMaps); + #{} -> + InitMaps = InitMaps0#{To=>Vars0}, + ensure_init_successors(Vs, G, Vars0, InitMaps) + end; +ensure_init_successors([], _, _, InitMaps) -> + InitMaps. + +join_inits(VarMap0, VarMap1) -> + join_inits_1(maps:to_list(VarMap0), VarMap1). + +join_inits_1([{V,State0}|Vs], VarMap) -> + State1 = map_get(V, VarMap), + State = case {State0,State1} of + {set,set} -> set; + {_,_} -> unset + end, + case State =:= State1 of + true -> + join_inits_1(Vs, VarMap); + false -> + join_inits_1(Vs, VarMap#{V:=State}) + end; +join_inits_1([], VarMap) -> + VarMap. + +%%% +%%% Transform the digraph back to standard SSA code. +%%% + +digraph_to_ssa(Ls, G, Blocks0) -> + Seen = cerl_sets:new(), + {Blocks,_} = digraph_to_ssa(Ls, G, Blocks0, Seen), + Blocks. + +digraph_to_ssa([L|Ls], G, Blocks0, Seen0) -> + Seen1 = cerl_sets:add_element(L, Seen0), + {Blk,Successors0} = digraph_to_ssa_blk(L, G, Blocks0, []), + Blocks1 = Blocks0#{L=>Blk}, + Successors = [S || S <- Successors0, + not cerl_sets:is_element(S, Seen1)], + {Blocks,Seen} = digraph_to_ssa(Successors, G, Blocks1, Seen1), + digraph_to_ssa(Ls, G, Blocks, Seen); +digraph_to_ssa([], _G, Blocks, Seen) -> + {Blocks,Seen}. + +digraph_to_ssa_blk(From, G, Blocks, Acc) -> + case beam_digraph:vertex(G, From) of + #b_set{dst=Dst}=I -> + case get_targets(From, G) of + {br,Succ,Fail} -> + %% This is a two-way branch that ends the current block. + Br = #b_br{bool=Dst,succ=Succ,fail=Fail}, + Is = reverse(Acc, [I]), + Blk = #b_blk{is=Is,last=Br}, + {Blk,beam_ssa:successors(Blk)}; + {br,Next} -> + case beam_digraph:in_degree(G, Next) of + 1 -> + digraph_to_ssa_blk(Next, G, Blocks, [I|Acc]); + _ -> + %% The Next node has multiple incident edge. That + %% means that it can't be part of the current block, + %% but must start a new block. + Br = oneway_br(Next), + Is = reverse(Acc, [I]), + Blk = #b_blk{is=Is,last=Br}, + {Blk,beam_ssa:successors(Blk)} + end + end; + br -> + case Acc of + [] -> + %% Create an empty block. + {br,Next} = get_targets(From, G), + Blk = #b_blk{is=[],last=oneway_br(Next)}, + {Blk,beam_ssa:successors(Blk)}; + [_|_] -> + %% Finish up the block, and let the block + %% transfer control to the `br` node at From. + Br = oneway_br(From), + Is = reverse(Acc), + Blk = #b_blk{is=Is,last=Br}, + {Blk,beam_ssa:successors(Blk)} + end; + {br,Bool} -> + %% This is a two-way `br` instruction. The most common + %% reason for its existence in the graph is that the root + %% node only contained a phi instruction (which was taken + %% out of the block before building the graph). + [] = Acc, %Assertion. + {br,Succ,Fail} = get_targets(From, G), + Br = #b_br{bool=Bool,succ=Succ,fail=Fail}, + Blk = #b_blk{is=[],last=Br}, + {Blk,beam_ssa:successors(Blk)}; + {external,Sub} -> + #b_blk{is=Is0} = Blk = map_get(From, Blocks), + Is = [I#b_set{args=sub_args(Args0, Sub)} || + #b_set{args=Args0}=I <- Is0], + {Blk#b_blk{is=Is},[]} + end. + +%%% +%%% Helper functions follow. +%%% + +%% get_def(Var, #st{}) -> #b_set{} | none. +%% Find the definition for a variable. Only boolean +%% expressions and phi nodes can be found. + +get_def(#b_var{}=Bool, #st{defs=Defs}) -> + case Defs of + #{Bool:={_,Def}} -> + Def; + #{} -> + none + end. + +%% get_def(Var, Graph, #st{}) -> #b_set{} | none. +%% Find the definition for a variable, looking first in the digraph +%% Graph. If it is not found there, look in the global map of +%% interesting definitions from the entire functions. + +get_def(Var, G, #st{ldefs=LDefs,defs=Defs}) -> + case LDefs of + #{Var:=Vtx} -> + beam_digraph:vertex(G, Vtx); + #{} -> + %% Not in the graph. Returning definitions for phi nodes + %% outside the graph is useful for shortcut_branches(). + case Defs of + #{Var:={_,Def}} -> Def; + #{} -> none + end + end. + +add_succ_fail_edges(From, Succ, Fail, G0) -> + G1 = beam_digraph:add_edge(G0, From, Succ, succ), + G = beam_digraph:add_edge(G1, From, Fail, fail), + case beam_digraph:out_edges(G0, From) of + [{From,_,next}=E] -> beam_digraph:del_edge(G, E); + [] -> G + end. + +get_vertex(#b_set{dst=Dst}, St) -> + get_vertex(Dst, St); +get_vertex(#b_var{}=Var, #st{ldefs=LDefs}) -> + map_get(Var, LDefs). + +get_targets(Vtx, G) when is_integer(Vtx) -> + case beam_digraph:out_edges(G, Vtx) of + [{_,To,next}] -> + {br,To}; + [{_,Succ,succ},{_,Fail,fail}] -> + {br,Succ,Fail}; + [{_,Fail,fail},{_,Succ,succ}] -> + {br,Succ,Fail}; + [] -> + none + end. + +get_targets(#b_var{}=Var, G, #st{ldefs=LDefs}) -> + get_targets(map_get(Var, LDefs), G). + +del_out_edges(V, G) -> + beam_digraph:del_edges(G, beam_digraph:out_edges(G, V)). + +covered(From, To, G) -> + Seen0 = gb_sets:empty(), + {yes,Seen} = covered_1(From, To, G, Seen0), + gb_sets:to_list(Seen). + +covered_1(To, To, _G, Seen) -> + {yes,Seen}; +covered_1(From, To, G, Seen0) -> + Vs0 = beam_digraph:out_neighbours(G, From), + Vs = [V || V <- Vs0, not gb_sets:is_member(V, Seen0)], + Seen = gb_sets:union(gb_sets:from_list(Vs), Seen0), + case Vs of + [] -> + no; + [_|_] -> + covered_list(Vs, To, G, Seen, false) + end. + +covered_list([V|Vs], To, G, Seen0, AnyFound) -> + case covered_1(V, To, G, Seen0) of + {yes,Seen} -> + covered_list(Vs, To, G, Seen, true); + no -> + covered_list(Vs, To, G, Seen0, AnyFound) + end; +covered_list([], _, _, Seen, AnyFound) -> + case AnyFound of + true -> {yes,Seen}; + false -> no + end. + +digraph_roots(G) -> + digraph_roots_1(beam_digraph:vertices(G), G). + +digraph_roots_1([{V,_}|Vs], G) -> + case beam_digraph:in_degree(G, V) of + 0 -> + [V|digraph_roots_1(Vs, G)]; + _ -> + digraph_roots_1(Vs, G) + end; +digraph_roots_1([], _G) -> []. + +not_possible() -> + throw(not_possible). + +new_label(#st{count=Count}=St) -> + {Count,St#st{count=Count+1}}. + +sub_args(Args, Sub) -> + [sub_arg(Arg, Sub) || Arg <- Args]. + +sub_arg({#b_var{}=Arg,From}, Sub) when is_integer(From) -> + {do_sub_arg(Arg, Sub),From}; +sub_arg(#b_var{}=Arg, Sub) -> + do_sub_arg(Arg, Sub); +sub_arg(#b_remote{mod=Mod,name=Name}=Rem, Sub) -> + Rem#b_remote{mod=do_sub_arg(Mod, Sub), + name=do_sub_arg(Name, Sub)}; +sub_arg(Arg, _Sub) -> Arg. + +do_sub_arg(#b_var{}=Old, Sub) -> + case Sub of + #{Old:=#b_literal{}=New} -> New; + #{Old:=#b_var{}=New} -> New; + #{} -> Old + end; +do_sub_arg(#b_literal{}=Old, _Sub) -> Old. + +is_bool_expr(#b_set{op={bif,Op},args=Args}) -> + Arity = length(Args), + erl_internal:comp_op(Op, Arity) orelse + erl_internal:new_type_test(Op, Arity) orelse + erl_internal:bool_op(Op, Arity); +is_bool_expr(_) -> false. + +%% Test whether the expression always succeeds and +%% always returns a boolean. +is_safe_bool_expr(#b_set{op={bif,Op},args=Args}) -> + Arity = length(Args), + erl_internal:comp_op(Op, Arity) orelse + erl_internal:new_type_test(Op, Arity); +is_safe_bool_expr(#b_set{}) -> false. + +oneway_br(To) -> + #b_br{bool=#b_literal{val=true},succ=To,fail=To}. diff --git a/lib/compiler/src/beam_ssa_bsm.erl b/lib/compiler/src/beam_ssa_bsm.erl index cb36f1c242..1d5a99a7a1 100644 --- a/lib/compiler/src/beam_ssa_bsm.erl +++ b/lib/compiler/src/beam_ssa_bsm.erl @@ -57,6 +57,7 @@ -export([module/2, format_error/1]). -include("beam_ssa.hrl"). +-include("beam_types.hrl"). -import(lists, [member/2, reverse/1, reverse/2, splitwith/2, map/2, foldl/3, mapfoldl/3, nth/2, max/1, unzip/1]). @@ -469,7 +470,7 @@ combine_matches(#b_function{bs=Blocks0,cnt=Counter0}=F, ModInfo) -> cm_1([#b_set{ op=bs_start_match, dst=Ctx, - args=[Src] }, + args=[_,Src] }, #b_set{ op=succeeded, dst=Bool, args=[Ctx] }]=MatchSeq, Acc0, Lbl, State0) -> @@ -574,7 +575,7 @@ aca_1(Blocks, State) -> EntryBlock = maps:get(0, Blocks), aca_enable_reuse(EntryBlock#b_blk.is, EntryBlock, Blocks, [], State). -aca_enable_reuse([#b_set{op=bs_start_match,args=[Src]}=I0 | Rest], +aca_enable_reuse([#b_set{op=bs_start_match,args=[_,Src]}=I0 | Rest], EntryBlock, Blocks0, Acc, State0) -> case aca_is_reuse_safe(Src, State0) of true -> @@ -618,7 +619,8 @@ aca_is_reuse_safe(Src, State) -> %% they're unused so far. ordsets:is_element(Src, State#aca.unused_parameters). -aca_reuse_context(#b_set{dst=Dst, args=[Src]}=I0, Block, Blocks0, State0) -> +aca_reuse_context(#b_set{op=bs_start_match,dst=Dst,args=[_,Src]}=I0, + Block, Blocks0, State0) -> %% When matching fails on a reused context it needs to be converted back %% to a binary. We only need to do this on the success path since it can't %% be a context on the type failure path, but it's very common for these @@ -687,9 +689,9 @@ aca_copy_successors(Lbl0, Blocks0, Counter0) -> Lbl = maps:get(Lbl0, BRs), {Lbl, Blocks, Counter}. -aca_cs_build_brs([?BADARG_BLOCK=Lbl | Path], Counter, Acc) -> - %% ?BADARG_BLOCK is a marker and not an actual block, so renaming it will - %% break exception handling. +aca_cs_build_brs([?EXCEPTION_BLOCK=Lbl | Path], Counter, Acc) -> + %% ?EXCEPTION_BLOCK is a marker and not an actual block, so renaming it + %% will break exception handling. aca_cs_build_brs(Path, Counter, Acc#{ Lbl => Lbl }); aca_cs_build_brs([Lbl | Path], Counter0, Acc) -> aca_cs_build_brs(Path, Counter0 + 1, Acc#{ Lbl => Counter0 }); @@ -874,25 +876,25 @@ sote_rewrite_call(Call0, [Arg | ArgsIn], ArgsOut, State0) -> sote_rewrite_call(Call0, ArgsIn, [Arg | ArgsOut], State0) end. -%% Adds parameter_type_info annotations to help the validator determine whether -%% our optimizations were safe. +%% Adds parameter annotations to help the validator determine whether our +%% optimizations were safe. annotate_context_parameters({Fs, ModInfo}) -> mapfoldl(fun annotate_context_parameters/2, ModInfo, Fs). annotate_context_parameters(F, ModInfo) -> ParamInfo = funcinfo_get(F, parameter_info, ModInfo), - TypeAnno0 = beam_ssa:get_anno(parameter_type_info, F, #{}), - TypeAnno = maps:fold(fun(K, _V, Acc) when is_map_key(K, Acc) -> - %% Assertion. - error(conflicting_parameter_types); - (K, suitable_for_reuse, Acc) -> - T = beam_validator:type_anno(match_context), - Acc#{ K => T }; - (_K, _V, Acc) -> - Acc - end, TypeAnno0, ParamInfo), - {beam_ssa:add_anno(parameter_type_info, TypeAnno, F), ModInfo}. + ParamAnno0 = beam_ssa:get_anno(parameter_info, F, #{}), + ParamAnno = maps:fold(fun(K, _V, Acc) when is_map_key(K, Acc) -> + %% Assertion. + error(conflicting_parameter_types); + (K, suitable_for_reuse, Acc) -> + Info = maps:get(K, Acc, []), + Acc#{ K => [accepts_match_context | Info] }; + (_K, _V, Acc) -> + Acc + end, ParamAnno0, ParamInfo), + {beam_ssa:add_anno(parameter_info, ParamAnno, F), ModInfo}. %%% %%% +bin_opt_info diff --git a/lib/compiler/src/beam_ssa_codegen.erl b/lib/compiler/src/beam_ssa_codegen.erl index 08641e2abc..5799f0e00f 100644 --- a/lib/compiler/src/beam_ssa_codegen.erl +++ b/lib/compiler/src/beam_ssa_codegen.erl @@ -28,7 +28,7 @@ -include("beam_ssa.hrl"). --import(lists, [foldl/3,keymember/3,keysort/2,last/1,map/2,mapfoldl/3, +-import(lists, [foldl/3,keymember/3,keysort/2,map/2,mapfoldl/3, reverse/1,reverse/2,sort/1,splitwith/2,takewhile/2]). -record(cg, {lcount=1 :: beam_label(), %Label counter @@ -37,7 +37,8 @@ used_labels=gb_sets:empty() :: gb_sets:set(ssa_label()), regs=#{} :: #{beam_ssa:var_name()=>ssa_register()}, ultimate_fail=1 :: beam_label(), - catches=gb_sets:empty() :: gb_sets:set(ssa_label()) + catches=gb_sets:empty() :: gb_sets:set(ssa_label()), + fc_label=1 :: beam_label() }). -spec module(beam_ssa:b_module(), [compile:option()]) -> @@ -114,17 +115,17 @@ functions(Forms, AtomMod) -> function(#b_function{anno=Anno,bs=Blocks}, AtomMod, St0) -> #{func_info:={_,Name,Arity}} = Anno, try - assert_badarg_block(Blocks), %Assertion. + assert_exception_block(Blocks), %Assertion. Regs = maps:get(registers, Anno), St1 = St0#cg{labels=#{},used_labels=gb_sets:empty(), regs=Regs}, {Fi,St2} = new_label(St1), %FuncInfo label {Entry,St3} = local_func_label(Name, Arity, St2), {Ult,St4} = new_label(St3), %Ultimate failure - Labels = (St4#cg.labels)#{0=>Entry,?BADARG_BLOCK=>0}, + Labels = (St4#cg.labels)#{0=>Entry,?EXCEPTION_BLOCK=>0}, St5 = St4#cg{labels=Labels,used_labels=gb_sets:singleton(Entry), ultimate_fail=Ult}, - {Body,St} = cg_fun(Blocks, St5), + {Body,St} = cg_fun(Blocks, St5#cg{fc_label=Fi}), Asm = [{label,Fi},line(Anno), {func_info,AtomMod,{atom,Name},Arity}] ++ add_parameter_annos(Body, Anno) ++ @@ -137,10 +138,10 @@ function(#b_function{anno=Anno,bs=Blocks}, AtomMod, St0) -> erlang:raise(Class, Error, Stack) end. -assert_badarg_block(Blocks) -> - %% Assertion: ?BADARG_BLOCK must be the call erlang:error(badarg). +assert_exception_block(Blocks) -> + %% Assertion: ?EXCEPTION_BLOCK must be a call erlang:error(badarg). case Blocks of - #{?BADARG_BLOCK:=Blk} -> + #{?EXCEPTION_BLOCK:=Blk} -> #b_blk{is=[#b_set{op=call,dst=Ret, args=[#b_remote{mod=#b_literal{val=erlang}, name=#b_literal{val=error}}, @@ -148,19 +149,21 @@ assert_badarg_block(Blocks) -> last=#b_ret{arg=Ret}} = Blk, ok; #{} -> - %% ?BADARG_BLOCK has been removed because it was never used. + %% ?EXCEPTION_BLOCK has been removed because it was never used. ok end. add_parameter_annos([{label, _}=Entry | Body], Anno) -> - ParamInfo = maps:get(parameter_type_info, Anno, #{}), + ParamTypes = maps:get(parameter_info, Anno, #{}), + Annos = maps:fold( - fun(K, V, Acc) when is_map_key(K, ParamInfo) -> - TypeInfo = maps:get(K, ParamInfo), - [{'%', {type_info, V, TypeInfo}} | Acc]; + fun(K, V, Acc) when is_map_key(K, ParamTypes) -> + Info = map_get(K, ParamTypes), + [{'%', {var_info, V, Info}} | Acc]; (_K, _V, Acc) -> Acc end, [], maps:get(registers, Anno)), + [Entry | sort(Annos)] ++ Body. cg_fun(Blocks, St0) -> @@ -365,7 +368,7 @@ classify_heap_need(bs_save) -> neutral; classify_heap_need(bs_get_position) -> gc; classify_heap_need(bs_set_position) -> neutral; classify_heap_need(bs_skip) -> gc; -classify_heap_need(bs_start_match) -> neutral; +classify_heap_need(bs_start_match) -> gc; classify_heap_need(bs_test_tail) -> neutral; classify_heap_need(bs_utf16_size) -> neutral; classify_heap_need(bs_utf8_size) -> neutral; @@ -384,6 +387,7 @@ classify_heap_need(is_tagged_tuple) -> neutral; classify_heap_need(kill_try_tag) -> gc; classify_heap_need(landingpad) -> gc; classify_heap_need(make_fun) -> gc; +classify_heap_need(match_fail) -> gc; classify_heap_need(new_try_tag) -> gc; classify_heap_need(peek_message) -> gc; classify_heap_need(put_map) -> gc; @@ -629,7 +633,7 @@ liveness_get(S, LiveMap) -> end. liveness_successors(Terminator) -> - successors(Terminator) -- [?BADARG_BLOCK]. + successors(Terminator) -- [?EXCEPTION_BLOCK]. liveness_is([#cg_alloc{}=I0|Is], Regs, Live, Acc) -> I = I0#cg_alloc{live=num_live(Live, Regs)}, @@ -973,6 +977,12 @@ cg_block(Is0, Last, Next, St0) -> case Last of #cg_br{succ=Next,fail=Next} -> cg_block(Is0, none, St0); + #cg_br{succ=Same,fail=Same} when Same =:= ?EXCEPTION_BLOCK -> + %% An expression in this block *always* throws an exception, so we + %% terminate it with an 'if_end' to make sure the validator knows + %% that the following instructions won't actually be reached. + {Is,St} = cg_block(Is0, none, St0), + {Is++[if_end],St}; #cg_br{succ=Same,fail=Same} -> {Fail,St1} = use_block_label(Same, St0), {Is,St} = cg_block(Is0, none, St1), @@ -1136,7 +1146,10 @@ cg_block([#cg_set{op=bs_init,dst=Dst0,args=Args0,anno=Anno}=I, Is = [Line,{bs_append,Fail,Bits,Alloc,Live,Unit,Src,Flags,Dst}], {Is,St} end; -cg_block([#cg_set{anno=Anno,op=bs_start_match,dst=Ctx0,args=[Bin0]}=I, +cg_block([#cg_set{anno=Anno, + op=bs_start_match, + dst=Ctx0, + args=[#b_literal{val=new},Bin0]}=I, #cg_set{op=succeeded,dst=Bool}], {Bool,Fail}, St) -> [Dst,Bin1] = beam_args([Ctx0,Bin0], St), {Bin,Pre} = force_reg(Bin1, Dst), @@ -1178,6 +1191,10 @@ cg_block([#cg_set{op=call}=I, #cg_set{op=succeeded,dst=Bool}], {Bool,_Fail}, St) -> %% A call in try/catch block. cg_block([I], none, St); +cg_block([#cg_set{op=match_fail}=I, + #cg_set{op=succeeded,dst=Bool}], {Bool,_Fail}, St) -> + %% A match_fail instruction in a try/catch block. + cg_block([I], none, St); cg_block([#cg_set{op=get_map_element,dst=Dst0,args=Args0}, #cg_set{op=succeeded,dst=Bool}], {Bool,Fail0}, St) -> [Dst,Map,Key] = beam_args([Dst0|Args0], St), @@ -1201,8 +1218,9 @@ cg_block([#cg_set{op=is_tagged_tuple,dst=Bool,args=Args0}], {Bool,Fail}, St) -> cg_block([#cg_set{op=is_nonempty_list,dst=Bool,args=Args0}], {Bool,Fail}, St) -> Args = beam_args(Args0, St), {[{test,is_nonempty_list,ensure_label(Fail, St),Args}],St}; -cg_block([#cg_set{op=has_map_field,dst=Bool,args=Args0}], {Bool,Fail}, St) -> +cg_block([#cg_set{op=has_map_field,dst=Bool,args=Args0}], {Bool,Fail0}, St) -> [Src,Key] = beam_args(Args0, St), + Fail = ensure_label(Fail0, St), {[{test,has_map_fields,Fail,Src,{list,[Key]}}],St}; cg_block([#cg_set{op=call}=Call], {_Bool,_Fail}=Context, St0) -> {Is0,St1} = cg_call(Call, body, none, St0), @@ -1220,15 +1238,24 @@ cg_block([#cg_set{op=call}=Call|T], Context, St0) -> {Is0,St1} = cg_call(Call, body, none, St0), {Is1,St} = cg_block(T, Context, St1), {Is0++Is1,St}; -cg_block([#cg_set{op=make_fun,dst=Dst0,args=[Local|Args0]}|T], +cg_block([#cg_set{anno=Anno,op=make_fun,dst=Dst0,args=[Local|Args0]}|T], Context, St0) -> #b_local{name=#b_literal{val=Func},arity=Arity} = Local, [Dst|Args] = beam_args([Dst0|Args0], St0), {FuncLbl,St1} = local_func_label(Func, Arity, St0), Is0 = setup_args(Args) ++ [{make_fun2,{f,FuncLbl},0,0,length(Args)}|copy({x,0}, Dst)], - {Is1,St} = cg_block(T, Context, St1), - {Is0++Is1,St}; + + Is1 = case Anno of + #{ result_type := Type } -> + Info = {var_info, Dst, [{fun_type, Type}]}, + Is0 ++ [{'%', Info}]; + #{} -> + Is0 + end, + + {Is2,St} = cg_block(T, Context, St1), + {Is1++Is2,St}; cg_block([#cg_set{op=copy}|_]=T0, Context, St0) -> {Is0,T} = cg_copy(T0, St0), {Is1,St} = cg_block(T, Context, St0), @@ -1239,6 +1266,28 @@ cg_block([#cg_set{op=copy}|_]=T0, Context, St0) -> no -> {Is,St} end; +cg_block([#cg_set{op=match_fail,args=Args0,anno=Anno}], none, St) -> + Args = beam_args(Args0, St), + Is = cg_match_fail(Args, line(Anno), none), + {Is,St}; +cg_block([#cg_set{op=match_fail,args=Args0,anno=Anno}|T], Context, St0) -> + FcLabel = case Context of + {return,_,none} -> + %% There is no stack frame. If this is a function_clause + %% exception, it is safe to jump to the label of the + %% func_info instruction. + St0#cg.fc_label; + _ -> + %% This is most probably not a function_clause. + %% If this is a function_clause exception + %% (rare), it is not safe to jump to the + %% func_info label. + none + end, + Args = beam_args(Args0, St0), + Is0 = cg_match_fail(Args, line(Anno), FcLabel), + {Is1,St} = cg_block(T, Context, St0), + {Is0++Is1,St}; cg_block([#cg_set{op=Op,dst=Dst0,args=Args0}=Set], none, St) -> [Dst|Args] = beam_args([Dst0|Args0], St), Is = cg_instr(Op, Args, Dst, Set), @@ -1270,8 +1319,7 @@ cg_copy(T0, St) -> end, T0), Moves0 = cg_copy_1(Copies, St), Moves1 = [Move || {move,Src,Dst}=Move <- Moves0, Src =/= Dst], - Scratch = {x,1022}, - Moves = order_moves(Moves1, Scratch), + Moves = order_moves(Moves1), {Moves,T}. cg_copy_1([#cg_set{dst=Dst0,args=Args}|T], St) -> @@ -1473,8 +1521,9 @@ cg_call(#cg_set{anno=Anno,op=call,dst=Dst0,args=[#b_local{}=Func0|Args0]}, Call = build_call(call, Arity, {f,FuncLbl}, Context, Dst), Is = setup_args(Args, Anno, Context, St) ++ Line ++ Call, case Anno of - #{ result_type := Info } -> - {Is ++ [{'%', {type_info, Dst, Info}}], St}; + #{ result_type := Type } -> + Info = {var_info, Dst, [{type,Type}]}, + {Is ++ [{'%', Info}], St}; #{} -> {Is, St} end; @@ -1510,7 +1559,49 @@ cg_call(#cg_set{anno=Anno,op=call,dst=Dst0,args=Args0}, Arity = length(Args), Call = build_call(call_fun, Arity, Func, Context, Dst), Is = setup_args(Args++[Func], Anno, Context, St) ++ Line ++ Call, - {Is,St}. + case Anno of + #{ result_type := Type } -> + Info = {var_info, Dst, [{type,Type}]}, + {Is ++ [{'%', Info}], St}; + #{} -> + {Is, St} + end. + +cg_match_fail([{atom,function_clause}|Args], Line, Fc) -> + case Fc of + none -> + %% There is a stack frame (probably because of inlining). + %% Jumping to the func_info label is not allowed by + %% beam_validator. Rewrite the instruction as a call to + %% erlang:error/2. + make_fc(Args, Line); + _ -> + setup_args(Args) ++ [{jump,{f,Fc}}] + end; +cg_match_fail([{atom,Op}], Line, _Fc) -> + [Line,Op]; +cg_match_fail([{atom,Op},Val], Line, _Fc) -> + [Line,{Op,Val}]. + +make_fc(Args, Line) -> + %% Recreate the original call to erlang:error/2. + Live = foldl(fun({x,X}, A) -> max(X+1, A); + (_, A) -> A + end, 0, Args), + TmpReg = {x,Live}, + StkMoves = build_stk(reverse(Args), TmpReg, nil), + [{test_heap,2*length(Args),Live}|StkMoves] ++ + [{move,{atom,function_clause},{x,0}}, + Line, + {call_ext,2,{extfunc,erlang,error,2}}]. + +build_stk([V], _TmpReg, Tail) -> + [{put_list,V,Tail,{x,1}}]; +build_stk([V|Vs], TmpReg, Tail) -> + I = {put_list,V,Tail,TmpReg}, + [I|build_stk(Vs, TmpReg, TmpReg)]; +build_stk([], _TmpReg, nil) -> + [{move,nil,{x,1}}]. build_call(call_fun, Arity, _Func, none, Dst) -> [{call_fun,Arity}|copy({x,0}, Dst)]; @@ -1550,15 +1641,22 @@ build_apply(Arity, {return,Val,N}, _Dst) when is_integer(N) -> build_apply(Arity, none, Dst) -> [{apply,Arity}|copy({x,0}, Dst)]. -cg_instr(put_map, [{atom,assoc},SrcMap|Ss], Dst, Set) -> +cg_instr(bs_start_match, [{atom,resume}, Src], Dst, Set) -> Live = get_live(Set), - [{put_map_assoc,{f,0},SrcMap,Dst,Live,{list,Ss}}]; + [{bs_start_match4,{atom,resume},Live,Src,Dst}]; +cg_instr(bs_start_match, [{atom,new}, Src0], Dst, Set) -> + {Src, Pre} = force_reg(Src0, Dst), + Live = get_live(Set), + Pre ++ [{bs_start_match4,{atom,no_fail},Live,Src,Dst}]; cg_instr(bs_get_tail, [Src], Dst, Set) -> Live = get_live(Set), [{bs_get_tail,Src,Dst,Live}]; cg_instr(bs_get_position, [Ctx], Dst, Set) -> Live = get_live(Set), [{bs_get_position,Ctx,Dst,Live}]; +cg_instr(put_map, [{atom,assoc},SrcMap|Ss], Dst, Set) -> + Live = get_live(Set), + [{put_map_assoc,{f,0},SrcMap,Dst,Live,{list,Ss}}]; cg_instr(Op, Args, Dst, _Set) -> cg_instr(Op, Args, Dst). @@ -1592,6 +1690,8 @@ cg_instr(get_tl=Op, [Src], Dst) -> [{Op,Src,Dst}]; cg_instr(get_tuple_element=Op, [Src,{integer,N}], Dst) -> [{Op,Src,N,Dst}]; +cg_instr(has_map_field, [Map,Key], Dst) -> + [{bif,is_map_key,{f,0},[Key,Map],Dst}]; cg_instr(put_list=Op, [Hd,Tl], Dst) -> [{Op,Hd,Tl,Dst}]; cg_instr(put_tuple, Elements, Dst) -> @@ -1728,7 +1828,7 @@ cg_catch(Agg, T0, Context, St0) -> cg_try(Agg, Tag, T0, Context, St0) -> {Moves0,T1} = cg_extract(T0, Agg, St0), - Moves = order_moves(Moves0, {x,3}), + Moves = order_moves(Moves0), [#cg_set{op=kill_try_tag}|T2] = T1, {T,St} = cg_block(T2, Context, St0), {[{try_case,Tag}|Moves++T],St}. @@ -1780,7 +1880,7 @@ linearize(Blocks) -> Linear = beam_ssa:linearize(Blocks), linearize_1(Linear, Blocks). -linearize_1([{?BADARG_BLOCK,_}|Ls], Blocks) -> +linearize_1([{?EXCEPTION_BLOCK,_}|Ls], Blocks) -> linearize_1(Ls, Blocks); linearize_1([{L,Block0}|Ls], Blocks) -> Block = translate_block(L, Block0, Blocks), @@ -1884,8 +1984,7 @@ setup_args([]) -> []; setup_args([_|_]=Args) -> Moves = gen_moves(Args, 0, []), - Scratch = {x,1+last(sort([length(Args)-1|[X || {x,X} <- Args]]))}, - order_moves(Moves, Scratch). + order_moves(Moves). %% kill_yregs(Anno, #cg{}) -> [{kill,{y,Y}}]. %% Kill Y registers that will not be used again. @@ -1905,47 +2004,48 @@ gen_moves([A|As], I, Acc) -> gen_moves([], _, Acc) -> keysort(3, Acc). -%% order_moves([Move], ScratchReg) -> [Move] +%% order_moves([Move]) -> [Move] %% Orders move instruction so that source registers are not %% destroyed before they are used. If there are cycles %% (such as {move,{x,0},{x,1}}, {move,{x,1},{x,1}}), -%% the scratch register is used to break up the cycle. -%% If possible, the first move of the input list is placed +%% swap instructions will be used to break up the cycle. +%% +%% If possible, the first move of the input list is placed %% last in the result list (to make the move to {x,0} occur %% just before the call to allow the Beam loader to coalesce %% the instructions). -order_moves(Ms, Scr) -> order_moves(Ms, Scr, []). +order_moves(Ms) -> order_moves(Ms, []). -order_moves([{move,_,_}=M|Ms0], ScrReg, Acc0) -> - {Chain,Ms} = collect_chain(Ms0, [M], ScrReg), +order_moves([{move,_,_}=M|Ms0], Acc0) -> + {Chain,Ms} = collect_chain(Ms0, [M]), Acc = reverse(Chain, Acc0), - order_moves(Ms, ScrReg, Acc); -order_moves([], _, Acc) -> Acc. + order_moves(Ms, Acc); +order_moves([], Acc) -> Acc. -collect_chain(Ms, Path, ScrReg) -> - collect_chain(Ms, Path, [], ScrReg). +collect_chain(Ms, Path) -> + collect_chain(Ms, Path, []). -collect_chain([{move,Src,Same}=M|Ms0], [{move,Same,_}|_]=Path, Others, ScrReg) -> +collect_chain([{move,Src,Same}=M|Ms0], [{move,Same,_}|_]=Path, Others) -> case keymember(Src, 3, Path) of false -> - collect_chain(reverse(Others, Ms0), [M|Path], [], ScrReg); + collect_chain(reverse(Others, Ms0), [M|Path], []); true -> - %% There is a cycle, which we must break up. - {break_up_cycle(M, Path, ScrReg),reverse(Others, Ms0)} + %% There is a cycle. + {break_up_cycle(M, Path),reverse(Others, Ms0)} end; -collect_chain([M|Ms], Path, Others, ScrReg) -> - collect_chain(Ms, Path, [M|Others], ScrReg); -collect_chain([], Path, Others, _) -> +collect_chain([M|Ms], Path, Others) -> + collect_chain(Ms, Path, [M|Others]); +collect_chain([], Path, Others) -> {Path,Others}. -break_up_cycle({move,Src,_}=M, Path, ScrReg) -> - [{move,ScrReg,Src},M|break_up_cycle1(Src, Path, ScrReg)]. +break_up_cycle({move,Src,_Dst}=M, Path) -> + break_up_cycle_1(Src, [M|Path], []). -break_up_cycle1(Dst, [{move,Src,Dst}|Path], ScrReg) -> - [{move,Src,ScrReg}|Path]; -break_up_cycle1(Dst, [M|Path], LastMove) -> - [M|break_up_cycle1(Dst, Path, LastMove)]. +break_up_cycle_1(Dst, [{move,_Src,Dst}|Path], Acc) -> + reverse(Acc, Path); +break_up_cycle_1(Dst, [{move,S,D}|Path], Acc) -> + break_up_cycle_1(Dst, Path, [{swap,S,D}|Acc]). %%% %%% General utility functions. diff --git a/lib/compiler/src/beam_ssa_dead.erl b/lib/compiler/src/beam_ssa_dead.erl index e78e4647a8..021b773419 100644 --- a/lib/compiler/src/beam_ssa_dead.erl +++ b/lib/compiler/src/beam_ssa_dead.erl @@ -28,7 +28,7 @@ -include("beam_ssa.hrl"). -import(lists, [append/1,keymember/3,last/1,member/2, - takewhile/2,reverse/1]). + reverse/1,sort/1,takewhile/2]). -type used_vars() :: #{beam_ssa:label():=cerl_sets:set(beam_ssa:var_name())}. @@ -97,38 +97,38 @@ shortcut_opt(#st{bs=Blocks}=St) -> %% in the first clause of shortcut_2/5). Ls = beam_ssa:rpo(Blocks), - shortcut_opt(Ls, #{}, St). + shortcut_opt(Ls, St). -shortcut_opt([L|Ls], Bs, #st{bs=Blocks0}=St) -> +shortcut_opt([L|Ls], #st{bs=Blocks0}=St) -> #b_blk{is=Is,last=Last0} = Blk0 = get_block(L, St), - case shortcut_terminator(Last0, Is, L, Bs, St) of + case shortcut_terminator(Last0, Is, L, St) of Last0 -> %% No change. No need to update the block. - shortcut_opt(Ls, Bs, St); + shortcut_opt(Ls, St); Last -> %% The terminator was simplified in some way. %% Update the block. Blk = Blk0#b_blk{last=Last}, Blocks = Blocks0#{L=>Blk}, - shortcut_opt(Ls, Bs, St#st{bs=Blocks}) + shortcut_opt(Ls, St#st{bs=Blocks}) end; -shortcut_opt([], _, St) -> St. +shortcut_opt([], St) -> St. shortcut_terminator(#b_br{bool=#b_literal{val=true},succ=Succ0}, - _Is, From, Bs, St0) -> + _Is, From, St0) -> St = St0#st{rel_op=none}, - shortcut(Succ0, From, Bs, St); + shortcut(Succ0, From, #{}, St); shortcut_terminator(#b_br{bool=#b_var{}=Bool,succ=Succ0,fail=Fail0}=Br, - Is, From, Bs, St0) -> + Is, From, St0) -> St = St0#st{target=one_way}, RelOp = get_rel_op(Bool, Is), %% The boolean in a `br` is seldom used by the successors. By %% not binding its value unless it is actually used we might be able %% to skip some work in shortcut/4 and sub/2. - SuccBs = bind_var_if_used(Succ0, Bool, #b_literal{val=true}, Bs, St), + SuccBs = bind_var_if_used(Succ0, Bool, #b_literal{val=true}, St), BrSucc = shortcut(Succ0, From, SuccBs, St#st{rel_op=RelOp}), - FailBs = bind_var_if_used(Fail0, Bool, #b_literal{val=false}, Bs, St), + FailBs = bind_var_if_used(Fail0, Bool, #b_literal{val=false}, St), BrFail = shortcut(Fail0, From, FailBs, St#st{rel_op=invert_op(RelOp)}), case {BrSucc,BrFail} of @@ -141,19 +141,34 @@ shortcut_terminator(#b_br{bool=#b_var{}=Bool,succ=Succ0,fail=Fail0}=Br, %% No change. Br end; -shortcut_terminator(#b_switch{arg=Bool,list=List0}=Sw, _Is, From, Bs, St) -> - List = shortcut_switch(List0, Bool, From, Bs, St), - beam_ssa:normalize(Sw#b_switch{list=List}); -shortcut_terminator(Last, _Is, _Bs, _From, _St) -> +shortcut_terminator(#b_switch{arg=Bool,fail=Fail0,list=List0}=Sw, + _Is, From, St) -> + Fail = shortcut_sw_fail(Fail0, List0, Bool, From, St), + List = shortcut_sw_list(List0, Bool, From, St), + beam_ssa:normalize(Sw#b_switch{fail=Fail,list=List}); +shortcut_terminator(Last, _Is, _From, _St) -> Last. -shortcut_switch([{Lit,L0}|T], Bool, From, Bs, St0) -> +shortcut_sw_fail(Fail0, List, Bool, From, St0) -> + case sort(List) of + [{#b_literal{val=false},_}, + {#b_literal{val=true},_}] -> + RelOp = {{'not',is_boolean},Bool}, + St = St0#st{rel_op=RelOp,target=one_way}, + #b_br{bool=#b_literal{val=true},succ=Fail} = + shortcut(Fail0, From, #{}, St), + Fail; + _ -> + Fail0 + end. + +shortcut_sw_list([{Lit,L0}|T], Bool, From, St0) -> RelOp = {'=:=',Bool,Lit}, St = St0#st{rel_op=RelOp}, #b_br{bool=#b_literal{val=true},succ=L} = - shortcut(L0, From, bind_var(Bool, Lit, Bs), St#st{target=one_way}), - [{Lit,L}|shortcut_switch(T, Bool, From, Bs, St0)]; -shortcut_switch([], _, _, _, _) -> []. + shortcut(L0, From, bind_var(Bool, Lit, #{}), St#st{target=one_way}), + [{Lit,L}|shortcut_sw_list(T, Bool, From, St0)]; +shortcut_sw_list([], _, _, _) -> []. shortcut(L, _From, Bs, #st{rel_op=none,target=one_way}) when map_size(Bs) =:= 0 -> %% There is no way that we can find a suitable branch, because there is no @@ -409,8 +424,10 @@ is_br_safe(UnsetVars, Br, #st{us=Us}=St) -> is_forbidden(L, St) -> case get_block(L, St) of - #b_blk{is=[#b_set{op=phi}|_]} -> true; - #b_blk{is=[#b_set{op=peek_message}|_]} -> true; + #b_blk{is=[#b_set{op=phi}|_]} -> + true; + #b_blk{is=[#b_set{}=I|_]} -> + beam_ssa:is_loop_header(I); #b_blk{} -> false end. @@ -423,11 +440,22 @@ eval_is([#b_set{op=phi,dst=Dst,args=Args}|Is], From, Bs0, St) -> Val = get_phi_arg(Args, From), Bs = bind_var(Dst, Val, Bs0), eval_is(Is, From, Bs, St); +eval_is([#b_set{op=succeeded,dst=Dst,args=[Var]}], _From, Bs, _St) -> + case Bs of + #{Var:=failed} -> + bind_var(Dst, #b_literal{val=false}, Bs); + #{Var:=#b_literal{}} -> + bind_var(Dst, #b_literal{val=true}, Bs); + #{} -> + Bs + end; eval_is([#b_set{op={bif,_},dst=Dst}=I0|Is], From, Bs, St) -> I = sub(I0, Bs), case eval_bif(I, St) of #b_literal{}=Val -> eval_is(Is, From, bind_var(Dst, Val, Bs), St); + failed -> + eval_is(Is, From, bind_var(Dst, failed, Bs), St); none -> eval_is(Is, From, Bs, St) end; @@ -521,15 +549,14 @@ eval_switch_1([], _Arg, _PrevOp, Fail) -> %% Fail is now either the failure label or 'none'. Fail. -bind_var_if_used(L, Var, Val0, Bs, #st{us=Us}) -> +bind_var_if_used(L, Var, Val, #st{us=Us}) -> case cerl_sets:is_element(Var, map_get(L, Us)) of - true -> - Val = get_value(Val0, Bs), - Bs#{Var=>Val}; - false -> - Bs + true -> #{Var=>Val}; + false -> #{} end. +bind_var(Var, failed, Bs) -> + Bs#{Var=>failed}; bind_var(Var, Val0, Bs) -> Val = get_value(Val0, Bs), Bs#{Var=>Val}. @@ -675,7 +702,7 @@ eval_rel_op(_Bif, _Args, #st{rel_op=none}) -> eval_rel_op(Bif, Args, #st{rel_op=Prev}) -> case normalize_op(Bif, Args) of none -> - none; + eval_boolean(Prev, Bif, Args); RelOp -> case will_succeed(Prev, RelOp) of yes -> #b_literal{val=true}; @@ -684,11 +711,22 @@ eval_rel_op(Bif, Args, #st{rel_op=Prev}) -> end end. +eval_boolean({{'not',is_boolean},Var}, {bif,'not'}, [Var]) -> + failed; +eval_boolean({{'not',is_boolean},Var}, {bif,Op}, Args) + when Op =:= 'and'; Op =:= 'or' -> + case member(Var, Args) of + true -> failed; + false -> none + end; +eval_boolean(_, _, _) -> + none. + %% will_succeed(PrevCondition, Condition) -> yes | no | maybe %% PrevCondition is a condition known to be true. This function %% will tell whether Condition will succeed. -will_succeed({_Op,_Var,_Value}=Same, {_Op,_Var,_Value}=Same) -> +will_succeed({_,_,_}=Same, {_,_,_}=Same) -> %% Repeated test. yes; will_succeed({Op1,Var,#b_literal{val=A}}, {Op2,Var,#b_literal{val=B}}) -> @@ -702,6 +740,9 @@ will_succeed({_,_}=Same, {_,_}=Same) -> yes; will_succeed({Test1,Var}, {Test2,Var}) -> will_succeed_test(Test1, Test2); +will_succeed({{'not',is_boolean},Var}, {'=:=',Var,#b_literal{val=Lit}}) + when is_boolean(Lit) -> + no; will_succeed({_,_}, {_,_}) -> maybe; will_succeed({_,_}, {_,_,_}) -> @@ -760,8 +801,8 @@ will_succeed_1('=/=', A, '=:=', B) when A =:= B -> no; will_succeed_1('<', A, '=:=', B) when B >= A -> no; will_succeed_1('<', A, '=/=', B) when B >= A -> yes; will_succeed_1('<', A, '<', B) when B >= A -> yes; -will_succeed_1('<', A, '=<', B) when B > A -> yes; -will_succeed_1('<', A, '>=', B) when B > A -> no; +will_succeed_1('<', A, '=<', B) when B >= A -> yes; +will_succeed_1('<', A, '>=', B) when B >= A -> no; will_succeed_1('<', A, '>', B) when B >= A -> no; will_succeed_1('=<', A, '=:=', B) when B > A -> no; @@ -781,9 +822,9 @@ will_succeed_1('>=', A, '>', B) when B < A -> yes; will_succeed_1('>', A, '=:=', B) when B =< A -> no; will_succeed_1('>', A, '=/=', B) when B =< A -> yes; will_succeed_1('>', A, '<', B) when B =< A -> no; -will_succeed_1('>', A, '=<', B) when B < A -> no; +will_succeed_1('>', A, '=<', B) when B =< A -> no; will_succeed_1('>', A, '>=', B) when B =< A -> yes; -will_succeed_1('>', A, '>', B) when B < A -> yes; +will_succeed_1('>', A, '>', B) when B =< A -> yes; will_succeed_1('==', A, '==', B) -> if @@ -920,17 +961,14 @@ combine_eqs_1([L|Ls], #st{bs=Blocks0}=St0) -> end; combine_eqs_1([], St) -> St. -comb_get_sw(L, Blocks) -> - comb_get_sw(L, true, Blocks). - -comb_get_sw(L, Safe0, #st{bs=Blocks,skippable=Skippable}) -> +comb_get_sw(L, #st{bs=Blocks,skippable=Skippable}) -> #b_blk{is=Is,last=Last} = map_get(L, Blocks), - Safe1 = Safe0 andalso is_map_key(L, Skippable), + Safe0 = is_map_key(L, Skippable), case Last of #b_ret{} -> none; #b_br{bool=#b_var{}=Bool,succ=Succ,fail=Fail} -> - case comb_is(Is, Bool, Safe1) of + case comb_is(Is, Bool, Safe0) of {none,_} -> none; {#b_set{op={bif,'=:='},args=[#b_var{}=Arg,#b_literal{}=Lit]},Safe} -> @@ -941,7 +979,7 @@ comb_get_sw(L, Safe0, #st{bs=Blocks,skippable=Skippable}) -> #b_br{} -> none; #b_switch{arg=#b_var{}=Arg,fail=Fail,list=List} -> - {none,Safe} = comb_is(Is, none, Safe1), + {none,Safe} = comb_is(Is, none, Safe0), {Safe,Arg,L,Fail,List} end. diff --git a/lib/compiler/src/beam_ssa_lint.erl b/lib/compiler/src/beam_ssa_lint.erl index a003607dab..224095d4c4 100644 --- a/lib/compiler/src/beam_ssa_lint.erl +++ b/lib/compiler/src/beam_ssa_lint.erl @@ -65,13 +65,19 @@ format_error({{_M,F,A},{phi_inside_block, Name, Id}}) -> [F, A, format_var(Name), Id]); format_error({{_M,F,A},{undefined_label_in_phi, Label, I}}) -> io_lib:format("~p/~p: Unknown block label ~p in phi node ~ts", - [F, A, Label, format_instr(I)]). + [F, A, Label, format_instr(I)]); +format_error({{_M,F,A},{succeeded_not_preceded, I}}) -> + io_lib:format("~p/~p: ~ts does not reference the preceding instruction", + [F, A, format_instr(I)]); +format_error({{_M,F,A},{succeeded_not_last, I}}) -> + io_lib:format("~p/~p: ~ts is not the last instruction in its block", + [F, A, format_instr(I)]). format_instr(I) -> [$',beam_ssa_pp:format_instr(I),$']. format_var(V) -> - beam_ssa_pp:format_var(#b_var{name=V}). + beam_ssa_pp:format_var(V). validate_function(F) -> try @@ -86,34 +92,36 @@ validate_function(F) -> erlang:raise(Class, Error, Stack) end. --type defined_vars() :: gb_sets:set(beam_ssa:var_name()). +-type defined_vars() :: gb_sets:set(beam_ssa:argument()). -record(vvars, {blocks :: #{ beam_ssa:label() => beam_ssa:b_blk() }, branch_def_vars :: #{ - %% Describes the variable state at the time of this exact branch (phi - %% node validation). - {From :: beam_ssa:label(), To :: beam_ssa:label()} => defined_vars(), - %% Describes the variable state common to all branches leading to this - %% label (un/redefined variable validation). - beam_ssa:label() => defined_vars() }, + %% Describes the variable state at the time of + %% this exact branch (phi node validation). + {From :: beam_ssa:label(), + To :: beam_ssa:label()} => defined_vars(), + %% Describes the variable state common to all + %% branches leading to this label (un/redefined + %% variable validation). + beam_ssa:label() => defined_vars() }, defined_vars :: defined_vars()}). -spec validate_variables(beam_ssa:b_function()) -> ok. validate_variables(#b_function{ args = Args, bs = Blocks }) -> %% Prefill the mapping with function arguments. - ArgNames = vvars_get_varnames(Args), - DefVars = gb_sets:from_list(ArgNames), + Args = vvars_get_variables(Args), + DefVars = gb_sets:from_list(Args), Entry = 0, State = #vvars{blocks = Blocks, branch_def_vars = #{ Entry => DefVars }, defined_vars = DefVars}, - ok = vvars_assert_unique(Blocks, ArgNames), + ok = vvars_assert_unique(Blocks, Args), vvars_phi_nodes(vvars_block(Entry, State)). %% Checks the uniqueness of all variables across all blocks. --spec vvars_assert_unique(Blocks, [beam_ssa:var_name()]) -> ok when +-spec vvars_assert_unique(Blocks, [beam_ssa:b_var()]) -> ok when Blocks :: #{ beam_ssa:label() => beam_ssa:b_blk() }. vvars_assert_unique(Blocks, Args) -> BlockIs = [Is || #b_blk{is=Is} <- maps:values(Blocks)], @@ -124,12 +132,12 @@ vvars_assert_unique(Blocks, Args) -> ok. -spec vvars_assert_unique_1(Is, Defined) -> ok when - Is :: list(beam_ssa:b_set()), - Defined :: #{ beam_ssa:var_name() => beam_ssa:b_set() }. -vvars_assert_unique_1([#b_set{dst=#b_var{name=DstName}}=I|Is], Defined) -> + Is :: list(beam_ssa:b_set()), + Defined :: #{ beam_ssa:b_var() => beam_ssa:b_set() }. +vvars_assert_unique_1([#b_set{dst=Dst}=I|Is], Defined) -> case Defined of - #{DstName:=Old} -> throw({redefined_variable, DstName, Old, I}); - _ -> vvars_assert_unique_1(Is, Defined#{DstName=>I}) + #{Dst:=Old} -> throw({redefined_variable, Dst, Old, I}); + _ -> vvars_assert_unique_1(Is, Defined#{Dst=>I}) end; vvars_assert_unique_1([], Defined) -> Defined. @@ -141,17 +149,17 @@ vvars_phi_nodes(#vvars{ blocks = Blocks }=State) -> ok. -spec vvars_phi_nodes_1(Is, Id, State) -> ok when - Is :: list(beam_ssa:b_set()), - Id :: beam_ssa:label(), - State :: #vvars{}. + Is :: list(beam_ssa:b_set()), + Id :: beam_ssa:label(), + State :: #vvars{}. vvars_phi_nodes_1([#b_set{ op = phi, args = Phis }=I | Is], Id, State) -> ok = vvars_assert_phi_paths(Phis, I, Id, State), ok = vvars_assert_phi_vars(Phis, I, Id, State), vvars_phi_nodes_1(Is, Id, State); vvars_phi_nodes_1([_ | Is], Id, _State) -> - case [Dst || #b_set{op=phi,dst=#b_var{name=Dst}} <- Is] of - [Name|_] -> - throw({phi_inside_block, Name, Id}); + case [Dst || #b_set{op=phi,dst=Dst} <- Is] of + [Var|_] -> + throw({phi_inside_block, Var, Id}); [] -> ok end; @@ -161,10 +169,10 @@ vvars_phi_nodes_1([], _Id, _State) -> %% Checks whether all paths leading to this phi node are represented, and that %% it doesn't reference any non-existent paths. -spec vvars_assert_phi_paths(Phis, I, Id, State) -> ok when - Phis :: list({beam_ssa:argument(), beam_ssa:label()}), - Id :: beam_ssa:label(), - I :: beam_ssa:b_set(), - State :: #vvars{}. + Phis :: list({beam_ssa:argument(), beam_ssa:label()}), + Id :: beam_ssa:label(), + I :: beam_ssa:b_set(), + State :: #vvars{}. vvars_assert_phi_paths(Phis, I, Id, State) -> BranchKeys = maps:keys(State#vvars.branch_def_vars), RequiredPaths = ordsets:from_list([From || {From, To} <- BranchKeys, To =:= Id]), @@ -173,34 +181,34 @@ vvars_assert_phi_paths(Phis, I, Id, State) -> [_|_]=MissingPaths -> throw({missing_phi_paths, MissingPaths, I}); [] -> ok end. - %% %% The following test is sometimes useful to find missing optimizations. - %% %% It is commented out, though, because it can be triggered by - %% %% by weird but legal code. - %% case ordsets:subtract(ProvidedPaths, RequiredPaths) of - %% [_|_]=GarbagePaths -> throw({garbage_phi_paths, GarbagePaths, I}); - %% [] -> ok - %% end. +%% %% The following test is sometimes useful to find missing optimizations. +%% %% It is commented out, though, because it can be triggered by +%% %% by weird but legal code. +%% case ordsets:subtract(ProvidedPaths, RequiredPaths) of +%% [_|_]=GarbagePaths -> throw({garbage_phi_paths, GarbagePaths, I}); +%% [] -> ok +%% end. %% Checks whether all variables used in this phi node are defined in the branch %% they arrived on. -spec vvars_assert_phi_vars(Phis, I, Id, State) -> ok when - Phis :: list({beam_ssa:argument(), beam_ssa:label()}), - Id :: beam_ssa:label(), - I :: beam_ssa:b_set(), - State :: #vvars{}. + Phis :: list({beam_ssa:argument(), beam_ssa:label()}), + Id :: beam_ssa:label(), + I :: beam_ssa:b_set(), + State :: #vvars{}. vvars_assert_phi_vars(Phis, I, Id, #vvars{blocks=Blocks, branch_def_vars=BranchDefVars}) -> Vars = [{Var, From} || {#b_var{}=Var, From} <- Phis], - foreach(fun({#b_var{name=VarName}, From}) -> + foreach(fun({Var, From}) -> BranchKey = {From, Id}, case BranchDefVars of #{BranchKey:=DefVars} -> - case gb_sets:is_member(VarName, DefVars) of + case gb_sets:is_member(Var, DefVars) of true -> ok; - false -> throw({unknown_variable, VarName, I}) + false -> throw({unknown_variable, Var, I}) end; #{} -> - throw({unknown_phi_variable, VarName, BranchKey, I}) + throw({unknown_phi_variable, Var, BranchKey, I}) end end, Vars), Labels = [From || {#b_literal{},From} <- Phis], @@ -214,32 +222,44 @@ vvars_assert_phi_vars(Phis, I, Id, #vvars{blocks=Blocks, end, Labels). -spec vvars_block(Id, State) -> #vvars{} when - Id :: beam_ssa:label(), - State :: #vvars{}. + Id :: beam_ssa:label(), + State :: #vvars{}. vvars_block(Id, State0) -> #{ Id := #b_blk{ is = Is, last = Terminator} } = State0#vvars.blocks, #{ Id := DefVars } = State0#vvars.branch_def_vars, State = State0#vvars{ defined_vars = DefVars }, vvars_terminator(Terminator, Id, vvars_block_1(Is, State)). --spec vvars_block_1(Blocks, State) -> #vvars{} when - Blocks :: list(beam_ssa:b_blk()), - State :: #vvars{}. +-spec vvars_block_1(Is, State) -> #vvars{} when + Is :: list(#b_set{}), + State :: #vvars{}. vvars_block_1([], State) -> State; -vvars_block_1([#b_set{ dst = #b_var{ name = DstName }, op = phi } | Is], State0) -> +vvars_block_1([#b_set{dst=OpVar,args=OpArgs}=I, + #b_set{op=succeeded,args=[OpVar],dst=SuccVar}], State) -> + ok = vvars_assert_args(OpArgs, I, State), + vvars_save_var(SuccVar, vvars_save_var(OpVar, State)); +vvars_block_1([#b_set{op=succeeded,args=Args}=I | [_|_]], State) -> + ok = vvars_assert_args(Args, I, State), + %% 'succeeded' must be the last instruction in its block. + throw({succeeded_not_last, I}); +vvars_block_1([#b_set{op=succeeded,args=Args}=I], State)-> + ok = vvars_assert_args(Args, I, State), + %% 'succeeded' must be be directly preceded by the operation it checks. + throw({succeeded_not_preceded, I}); +vvars_block_1([#b_set{ dst = Dst, op = phi } | Is], State) -> %% We don't check phi node arguments at this point since we may not have %% visited their definition yet. They'll be handled later on in %% vvars_phi_nodes/1 after all blocks are processed. - vvars_block_1(Is, vvars_save_var(DstName, State0)); -vvars_block_1([#b_set{ dst = #b_var{ name = DstName }, args = Args }=I | Is], State0) -> - ok = vvars_assert_args(Args, I, State0), - vvars_block_1(Is, vvars_save_var(DstName, State0)). + vvars_block_1(Is, vvars_save_var(Dst, State)); +vvars_block_1([#b_set{ dst = Dst, args = Args }=I | Is], State) -> + ok = vvars_assert_args(Args, I, State), + vvars_block_1(Is, vvars_save_var(Dst, State)). -spec vvars_terminator(Terminator, From, State) -> #vvars{} when - Terminator :: beam_ssa:terminator(), - From :: beam_ssa:label(), - State :: #vvars{}. + Terminator :: beam_ssa:terminator(), + From :: beam_ssa:label(), + State :: #vvars{}. vvars_terminator(#b_ret{ arg = Arg }=I, _From, State) -> ok = vvars_assert_args([Arg], I, State), State; @@ -264,62 +284,62 @@ vvars_terminator(#b_br{ bool = Arg, succ = Succ, fail = Fail }=I, From, State) - vvars_terminator_1(Labels, From, State). -spec vvars_terminator_1(Labels, From, State) -> #vvars{} when - Labels :: list(beam_ssa:label()), - From :: beam_ssa:label(), - State :: #vvars{}. + Labels :: list(beam_ssa:label()), + From :: beam_ssa:label(), + State :: #vvars{}. vvars_terminator_1(Labels0, From, State0) -> %% Filter out all branches that have already been taken. This should result %% in either all of Labels0 or an empty list. Labels = [To || To <- Labels0, - not maps:is_key({From, To}, State0#vvars.branch_def_vars)], + not maps:is_key({From, To}, State0#vvars.branch_def_vars)], true = Labels =:= Labels0 orelse Labels =:= [], %Assertion State1 = foldl(fun(To, State) -> - vvars_save_branch(From, To, State) + vvars_save_branch(From, To, State) end, State0, Labels), foldl(fun(To, State) -> - vvars_block(To, State) + vvars_block(To, State) end, State1, Labels). %% Gets all variable names in args, ignoring literals etc --spec vvars_get_varnames(Args) -> list(beam_ssa:var_name()) when - Args :: list(beam_ssa:argument()). -vvars_get_varnames(Args) -> - [Name || #b_var{ name = Name } <- Args]. +-spec vvars_get_variables(Args) -> list(beam_ssa:b_var()) when + Args :: list(beam_ssa:argument()). +vvars_get_variables(Args) -> + [Var || #b_var{}=Var <- Args]. %% Checks that all variables in Args are defined in all paths leading to the %% current State. -spec vvars_assert_args(Args, I, State) -> ok when - Args :: list(beam_ssa:argument()), - I :: beam_ssa:terminator() | beam_ssa:b_set(), - State :: #vvars{}. + Args :: list(beam_ssa:argument()), + I :: beam_ssa:terminator() | beam_ssa:b_set(), + State :: #vvars{}. vvars_assert_args(Args, I, #vvars{defined_vars=DefVars}=State) -> foreach(fun(#b_remote{mod=Mod,name=Name}) -> vvars_assert_args([Mod,Name], I, State); - (#b_var{name=Name}) -> - case gb_sets:is_member(Name, DefVars) of + (#b_var{}=Var) -> + case gb_sets:is_member(Var, DefVars) of true -> ok; - false -> throw({unknown_variable,Name,I}) + false -> throw({unknown_variable,Var,I}) end; (_) -> ok end, Args). %% Checks that all given labels are defined in State. -spec vvars_assert_labels(Labels, I, State) -> ok when - Labels :: list(beam_ssa:label()), - I :: beam_ssa:terminator(), - State :: #vvars{}. + Labels :: list(beam_ssa:label()), + I :: beam_ssa:terminator(), + State :: #vvars{}. vvars_assert_labels(Labels, I, #vvars{blocks=Blocks}) -> foreach(fun(Label) -> - case maps:is_key(Label, Blocks) of - false -> throw({unknown_block, Label, I}); - true -> ok - end + case maps:is_key(Label, Blocks) of + false -> throw({unknown_block, Label, I}); + true -> ok + end end, Labels). -spec vvars_save_branch(From, To, State) -> #vvars{} when - From :: beam_ssa:label(), - To :: beam_ssa:label(), - State :: #vvars{}. + From :: beam_ssa:label(), + To :: beam_ssa:label(), + State :: #vvars{}. vvars_save_branch(From, To, State) -> DefVars = State#vvars.defined_vars, Branches0 = State#vvars.branch_def_vars, @@ -335,15 +355,15 @@ vvars_save_branch(From, To, State) -> end. -spec vvars_merge_branches(New, Existing) -> defined_vars() when - New :: defined_vars(), - Existing :: defined_vars(). + New :: defined_vars(), + Existing :: defined_vars(). vvars_merge_branches(New, Existing) -> gb_sets:intersection(New, Existing). --spec vvars_save_var(VarName, State) -> #vvars{} when - VarName :: beam_ssa:var_name(), - State :: #vvars{}. -vvars_save_var(VarName, State0) -> +-spec vvars_save_var(Var, State) -> #vvars{} when + Var :: #b_var{}, + State :: #vvars{}. +vvars_save_var(Var, State0) -> %% vvars_assert_unique guarantees that variables are never set twice. - DefVars = gb_sets:insert(VarName, State0#vvars.defined_vars), + DefVars = gb_sets:insert(Var, State0#vvars.defined_vars), State0#vvars{ defined_vars = DefVars }. diff --git a/lib/compiler/src/beam_ssa_opt.erl b/lib/compiler/src/beam_ssa_opt.erl index d87c66c272..00d57ca7a9 100644 --- a/lib/compiler/src/beam_ssa_opt.erl +++ b/lib/compiler/src/beam_ssa_opt.erl @@ -28,9 +28,9 @@ %%% in one phase and then apply it in the next without having to risk working %%% with incomplete information. %%% -%%% Each sub-pass operates on a #st{} record and a func_info_db(), where the -%%% former is just a #b_function{} whose blocks can be represented either in -%%% linear or map form, and the latter is a map with information about all +%%% Each sub-pass operates on a #opt_st{} record and a func_info_db(), where +%%% the former is just a #b_function{} whose blocks can be represented either +%%% in linear or map form, and the latter is a map with information about all %%% functions in the module (see beam_ssa_opt.hrl for more details). %%% @@ -39,45 +39,76 @@ -include("beam_ssa_opt.hrl"). --import(lists, [all/2,append/1,duplicate/2,foldl/3,keyfind/3,member/2, - reverse/1,reverse/2, - splitwith/2,sort/1,takewhile/2,unzip/1]). +-import(lists, [all/2,append/1,duplicate/2,flatten/1,foldl/3,keyfind/3, + member/2,reverse/1,reverse/2,splitwith/2,sort/1, + takewhile/2,unzip/1]). --define(DEFAULT_REPETITIONS, 2). +-define(MAX_REPETITIONS, 16). -spec module(beam_ssa:b_module(), [compile:option()]) -> {'ok',beam_ssa:b_module()}. --record(st, {ssa :: [{beam_ssa:label(),beam_ssa:b_blk()}] | - beam_ssa:block_map(), - args :: [beam_ssa:b_var()], - cnt :: beam_ssa:label(), - anno :: beam_ssa:anno()}). --type st_map() :: #{ func_id() => #st{} }. - module(Module, Opts) -> - FuncDb0 = case proplists:get_value(no_module_opt, Opts, false) of - false -> build_func_db(Module); - true -> #{} - end, + FuncDb = case proplists:get_value(no_module_opt, Opts, false) of + false -> build_func_db(Module); + true -> #{} + end, %% Passes that perform module-level optimizations are often aided by %% optimizing callers before callees and vice versa, so we optimize all - %% functions in call order, flipping it as required. + %% functions in call order, alternating the order every time. StMap0 = build_st_map(Module), - Order = get_call_order_po(StMap0, FuncDb0), - - Phases = - [{Order, prologue_passes(Opts)}] ++ - repeat(Opts, repeated_passes(Opts), Order) ++ - [{Order, epilogue_passes(Opts)}], + Order = get_call_order_po(StMap0, FuncDb), - {StMap, _FuncDb} = foldl(fun({FuncIds, Ps}, {StMap, FuncDb}) -> - phase(FuncIds, Ps, StMap, FuncDb) - end, {StMap0, FuncDb0}, Phases), + Phases = [{once, Order, prologue_passes(Opts)}, + {module, module_passes(Opts)}, + {fixpoint, Order, repeated_passes(Opts)}, + {once, Order, epilogue_passes(Opts)}], + StMap = run_phases(Phases, StMap0, FuncDb), {ok, finish(Module, StMap)}. +run_phases([{module, Passes} | Phases], StMap0, FuncDb0) -> + {StMap, FuncDb} = compile:run_sub_passes(Passes, {StMap0, FuncDb0}), + run_phases(Phases, StMap, FuncDb); +run_phases([{once, FuncIds0, Passes} | Phases], StMap0, FuncDb0) -> + FuncIds = skip_removed(FuncIds0, StMap0), + {StMap, FuncDb} = phase(FuncIds, Passes, StMap0, FuncDb0), + run_phases(Phases, StMap, FuncDb); +run_phases([{fixpoint, FuncIds0, Passes} | Phases], StMap0, FuncDb0) -> + FuncIds = skip_removed(FuncIds0, StMap0), + RevFuncIds = reverse(FuncIds), + Order = {FuncIds, RevFuncIds}, + {StMap, FuncDb} = fixpoint(RevFuncIds, Order, Passes, + StMap0, FuncDb0, ?MAX_REPETITIONS), + run_phases(Phases, StMap, FuncDb); +run_phases([], StMap, _FuncDb) -> + StMap. + +skip_removed(FuncIds, StMap) -> + [F || F <- FuncIds, is_map_key(F, StMap)]. + +%% Run the given passes until a fixpoint is reached. +fixpoint(_FuncIds, _Order, _Passes, StMap, FuncDb, 0) -> + %% Too many repetitions. Give up and return what we have. + {StMap, FuncDb}; +fixpoint(FuncIds0, Order0, Passes, StMap0, FuncDb0, N) -> + {StMap, FuncDb} = phase(FuncIds0, Passes, StMap0, FuncDb0), + Repeat = changed(FuncIds0, FuncDb0, FuncDb, StMap0, StMap), + case cerl_sets:size(Repeat) of + 0 -> + %% No change. Fixpoint reached. + {StMap, FuncDb}; + _ -> + %% Repeat the optimizations for functions whose code has + %% changed or for which there is potentially updated type + %% information. + {OrderA, OrderB} = Order0, + Order = {OrderB, OrderA}, + FuncIds = [Id || Id <- OrderA, cerl_sets:is_element(Id, Repeat)], + fixpoint(FuncIds, Order, Passes, StMap, FuncDb, N - 1) + end. + phase([FuncId | Ids], Ps, StMap, FuncDb0) -> try compile:run_sub_passes(Ps, {map_get(FuncId, StMap), FuncDb0}) of {St, FuncDb} -> @@ -91,19 +122,94 @@ phase([FuncId | Ids], Ps, StMap, FuncDb0) -> phase([], _Ps, StMap, FuncDb) -> {StMap, FuncDb}. -%% Repeats the given passes, alternating the order between runs to make the -%% type pass more efficient. -repeat(Opts, Ps, OrderA) -> - Repeat = proplists:get_value(ssa_opt_repeat, Opts, ?DEFAULT_REPETITIONS), - OrderB = reverse(OrderA), - repeat_1(Repeat, Ps, OrderA, OrderB). - -repeat_1(0, _Opts, _OrderA, _OrderB) -> - []; -repeat_1(N, Ps, OrderA, OrderB) when N > 0, N rem 2 =:= 0 -> - [{OrderA, Ps} | repeat_1(N - 1, Ps, OrderA, OrderB)]; -repeat_1(N, Ps, OrderA, OrderB) when N > 0, N rem 2 =:= 1 -> - [{OrderB, Ps} | repeat_1(N - 1, Ps, OrderA, OrderB)]. +changed(PrevIds, FuncDb0, FuncDb, StMap0, StMap) -> + %% Find all functions in FuncDb that can be reached by changes + %% of argument and/or return types. Those are the functions that + %% may gain from running the optimization passes again. + %% + %% Note that we examine all functions in FuncDb, not only functions + %% optimized in the previous run, because the argument types can + %% have been updated for functions not included in the previous run. + + F = fun(Id, A) -> + case cerl_sets:is_element(Id, A) of + true -> + A; + false -> + {#func_info{arg_types=ATs0,succ_types=ST0}, + #func_info{arg_types=ATs1,succ_types=ST1}} = + {map_get(Id, FuncDb0),map_get(Id, FuncDb)}, + + %% If the argument types have changed for this + %% function, re-optimize this function and all + %% functions it calls directly or indirectly. + %% + %% If the return type has changed, re-optimize + %% this function and all functions that call + %% this function directly or indirectly. + Opts = case ATs0 =:= ATs1 of + true -> []; + false -> [called] + end ++ + case ST0 =:= ST1 of + true -> []; + false -> [callers] + end, + case Opts of + [] -> A; + [_|_] -> add_changed([Id], Opts, FuncDb, A) + end + end + end, + Ids = foldl(F, cerl_sets:new(), maps:keys(FuncDb)), + + %% From all functions that were optimized in the previous run, + %% find the functions that had any change in the SSA code. Those + %% functions might gain from being optimized again. (For example, + %% when beam_ssa_dead has shortcut branches, the types for some + %% variables could become narrower, giving beam_ssa_type new + %% opportunities for optimization.) + %% + %% Note that the functions examined could be functions with module-level + %% optimization turned off (and thus not included in FuncDb). + + foldl(fun(Id, A) -> + case cerl_sets:is_element(Id, A) of + true -> + %% Already scheduled for another optimization. + %% No need to compare the SSA code. + A; + false -> + %% Compare the SSA code before and after optimization. + case {map_get(Id, StMap0),map_get(Id, StMap)} of + {Same,Same} -> A; + {_,_} -> cerl_sets:add_element(Id, A) + end + end + end, Ids, PrevIds). + +add_changed([Id|Ids], Opts, FuncDb, S0) when is_map_key(Id, FuncDb) -> + case cerl_sets:is_element(Id, S0) of + true -> + add_changed(Ids, Opts, FuncDb, S0); + false -> + S1 = cerl_sets:add_element(Id, S0), + #func_info{in=In,out=Out} = map_get(Id, FuncDb), + S2 = case member(callers, Opts) of + true -> add_changed(In, Opts, FuncDb, S1); + false -> S1 + end, + S = case member(called, Opts) of + true -> add_changed(Out, Opts, FuncDb, S2); + false -> S2 + end, + add_changed(Ids, Opts, FuncDb, S) + end; +add_changed([_|Ids], Opts, FuncDb, S) -> + %% This function is exempt from module-level optimization and will not + %% provide any more information. + add_changed(Ids, Opts, FuncDb, S); +add_changed([], _, _, S) -> S. %% @@ -117,7 +223,7 @@ build_st_map(#b_module{body=Fs}) -> build_st_map_1([F | Fs], Map) -> #b_function{anno=Anno,args=Args,cnt=Counter,bs=Bs} = F, - St = #st{anno=Anno,args=Args,cnt=Counter,ssa=Bs}, + St = #opt_st{anno=Anno,args=Args,cnt=Counter,ssa=Bs}, build_st_map_1(Fs, Map#{ get_func_id(F) => St }); build_st_map_1([], Map) -> Map. @@ -127,9 +233,14 @@ finish(#b_module{body=Fs0}=Module, StMap) -> Module#b_module{body=finish_1(Fs0, StMap)}. finish_1([F0 | Fs], StMap) -> - #st{anno=Anno,cnt=Counter,ssa=Blocks} = map_get(get_func_id(F0), StMap), - F = F0#b_function{anno=Anno,bs=Blocks,cnt=Counter}, - [F | finish_1(Fs, StMap)]; + FuncId = get_func_id(F0), + case StMap of + #{ FuncId := #opt_st{anno=Anno,cnt=Counter,ssa=Blocks} } -> + F = F0#b_function{anno=Anno,bs=Blocks,cnt=Counter}, + [F | finish_1(Fs, StMap)]; + #{} -> + finish_1(Fs, StMap) + end; finish_1([], _StMap) -> []. @@ -145,10 +256,17 @@ prologue_passes(Opts) -> ?PASS(ssa_opt_linearize), ?PASS(ssa_opt_tuple_size), ?PASS(ssa_opt_record), - ?PASS(ssa_opt_cse), %Helps the first type pass. - ?PASS(ssa_opt_type_start)], + ?PASS(ssa_opt_cse), % Helps the first type pass. + ?PASS(ssa_opt_live)], % ... passes_1(Ps, Opts). +module_passes(Opts) -> + Ps0 = [{ssa_opt_type_start, + fun({StMap, FuncDb}) -> + beam_ssa_type:opt_start(StMap, FuncDb) + end}], + passes_1(Ps0, Opts). + %% These passes all benefit from each other (in roughly this order), so they %% are repeated as required. repeated_passes(Opts) -> @@ -157,6 +275,9 @@ repeated_passes(Opts) -> ?PASS(ssa_opt_dead), ?PASS(ssa_opt_cse), ?PASS(ssa_opt_tail_phis), + ?PASS(ssa_opt_sink), + ?PASS(ssa_opt_tuple_size), + ?PASS(ssa_opt_record), ?PASS(ssa_opt_type_continue)], %Must run after ssa_opt_dead to %clean up phi nodes. passes_1(Ps, Opts). @@ -169,14 +290,15 @@ epilogue_passes(Opts) -> %% Run live one more time to clean up after the float and sw %% passes. ?PASS(ssa_opt_live), + ?PASS(ssa_opt_try), ?PASS(ssa_opt_bsm), - ?PASS(ssa_opt_bsm_units), ?PASS(ssa_opt_bsm_shortcut), - ?PASS(ssa_opt_blockify), ?PASS(ssa_opt_sink), + ?PASS(ssa_opt_blockify), ?PASS(ssa_opt_merge_blocks), ?PASS(ssa_opt_get_tuple_element), - ?PASS(ssa_opt_trim_unreachable)], + ?PASS(ssa_opt_trim_unreachable), + ?PASS(ssa_opt_unfold_literals)], passes_1(Ps, Opts). passes_1(Ps, Opts0) -> @@ -194,16 +316,26 @@ passes_1(Ps, Opts0) -> %% Builds a function information map with basic information about incoming and %% outgoing local calls, as well as whether the function is exported. -spec build_func_db(#b_module{}) -> func_info_db(). -build_func_db(#b_module{body=Fs,exports=Exports}) -> +build_func_db(#b_module{body=Fs,attributes=Attr,exports=Exports0}) -> + Exports = fdb_exports(Attr, Exports0), try - fdb_1(Fs, gb_sets:from_list(Exports), #{}) + fdb_fs(Fs, Exports, #{}) catch %% All module-level optimizations are invalid when a NIF can override a %% function, so we have to bail out. throw:load_nif -> #{} end. -fdb_1([#b_function{ args=Args,bs=Bs }=F | Fs], Exports, FuncDb0) -> +fdb_exports([{on_load, L} | Attrs], Exports) -> + %% Functions marked with on_load must be treated as exported to prevent + %% them from being optimized away when unused. + fdb_exports(Attrs, flatten(L) ++ Exports); +fdb_exports([_Attr | Attrs], Exports) -> + fdb_exports(Attrs, Exports); +fdb_exports([], Exports) -> + gb_sets:from_list(Exports). + +fdb_fs([#b_function{ args=Args,bs=Bs }=F | Fs], Exports, FuncDb0) -> Id = get_func_id(F), #b_local{name=#b_literal{val=Name}, arity=Arity} = Id, @@ -224,8 +356,8 @@ fdb_1([#b_function{ args=Args,bs=Bs }=F | Fs], Exports, FuncDb0) -> fdb_is(Is, Id, FuncDb) end, FuncDb1, Bs), - fdb_1(Fs, Exports, FuncDb); -fdb_1([], _Exports, FuncDb) -> + fdb_fs(Fs, Exports, FuncDb); +fdb_fs([], _Exports, FuncDb) -> FuncDb. fdb_is([#b_set{op=call, @@ -237,6 +369,12 @@ fdb_is([#b_set{op=call, name=#b_literal{val=load_nif}}, _Path, _LoadInfo]} | _Is], _Caller, _FuncDb) -> throw(load_nif); +fdb_is([#b_set{op=make_fun, + args=[#b_local{}=Callee | _]} | Is], + Caller, FuncDb) -> + %% The make_fun instruction's type depends on the return type of the + %% function in question, so we treat this as a function call. + fdb_is(Is, Caller, fdb_update(Caller, Callee, FuncDb)); fdb_is([_ | Is], Caller, FuncDb) -> fdb_is(Is, Caller, FuncDb); fdb_is([], _Caller, FuncDb) -> @@ -289,29 +427,25 @@ gco_rpo([], _, Seen, Acc) -> %%% Trivial sub passes. %%% -ssa_opt_dead({#st{ssa=Linear}=St, FuncDb}) -> - {St#st{ssa=beam_ssa_dead:opt(Linear)}, FuncDb}. - -ssa_opt_linearize({#st{ssa=Blocks}=St, FuncDb}) -> - {St#st{ssa=beam_ssa:linearize(Blocks)}, FuncDb}. +ssa_opt_dead({#opt_st{ssa=Linear}=St, FuncDb}) -> + {St#opt_st{ssa=beam_ssa_dead:opt(Linear)}, FuncDb}. -ssa_opt_type_start({#st{ssa=Linear0,args=Args,anno=Anno}=St0, FuncDb0}) -> - {Linear, FuncDb} = beam_ssa_type:opt_start(Linear0, Args, Anno, FuncDb0), - {St0#st{ssa=Linear}, FuncDb}. +ssa_opt_linearize({#opt_st{ssa=Blocks}=St, FuncDb}) -> + {St#opt_st{ssa=beam_ssa:linearize(Blocks)}, FuncDb}. -ssa_opt_type_continue({#st{ssa=Linear0,args=Args,anno=Anno}=St0, FuncDb0}) -> +ssa_opt_type_continue({#opt_st{ssa=Linear0,args=Args,anno=Anno}=St0, FuncDb0}) -> {Linear, FuncDb} = beam_ssa_type:opt_continue(Linear0, Args, Anno, FuncDb0), - {St0#st{ssa=Linear}, FuncDb}. + {St0#opt_st{ssa=Linear}, FuncDb}. -ssa_opt_type_finish({#st{args=Args,anno=Anno0}=St0, FuncDb0}) -> +ssa_opt_type_finish({#opt_st{args=Args,anno=Anno0}=St0, FuncDb0}) -> {Anno, FuncDb} = beam_ssa_type:opt_finish(Args, Anno0, FuncDb0), - {St0#st{anno=Anno}, FuncDb}. + {St0#opt_st{anno=Anno}, FuncDb}. -ssa_opt_blockify({#st{ssa=Linear}=St, FuncDb}) -> - {St#st{ssa=maps:from_list(Linear)}, FuncDb}. +ssa_opt_blockify({#opt_st{ssa=Linear}=St, FuncDb}) -> + {St#opt_st{ssa=maps:from_list(Linear)}, FuncDb}. -ssa_opt_trim_unreachable({#st{ssa=Blocks}=St, FuncDb}) -> - {St#st{ssa=beam_ssa:trim_unreachable(Blocks)}, FuncDb}. +ssa_opt_trim_unreachable({#opt_st{ssa=Blocks}=St, FuncDb}) -> + {St#opt_st{ssa=beam_ssa:trim_unreachable(Blocks)}, FuncDb}. %%% %%% Split blocks before certain instructions to enable more optimizations. @@ -323,14 +457,14 @@ ssa_opt_trim_unreachable({#st{ssa=Blocks}=St, FuncDb}) -> %%% for sinking get_tuple_element instructions. %%% -ssa_opt_split_blocks({#st{ssa=Blocks0,cnt=Count0}=St, FuncDb}) -> +ssa_opt_split_blocks({#opt_st{ssa=Blocks0,cnt=Count0}=St, FuncDb}) -> P = fun(#b_set{op={bif,element}}) -> true; (#b_set{op=call}) -> true; (#b_set{op=make_fun}) -> true; (_) -> false end, {Blocks,Count} = beam_ssa:split_blocks(P, Blocks0, Count0), - {St#st{ssa=Blocks,cnt=Count}, FuncDb}. + {St#opt_st{ssa=Blocks,cnt=Count}, FuncDb}. %%% %%% Coalesce phi nodes. @@ -354,10 +488,10 @@ ssa_opt_split_blocks({#st{ssa=Blocks0,cnt=Count0}=St, FuncDb}) -> %%% different registers). %%% -ssa_opt_coalesce_phis({#st{ssa=Blocks0}=St, FuncDb}) -> +ssa_opt_coalesce_phis({#opt_st{ssa=Blocks0}=St, FuncDb}) -> Ls = beam_ssa:rpo(Blocks0), Blocks = c_phis_1(Ls, Blocks0), - {St#st{ssa=Blocks}, FuncDb}. + {St#opt_st{ssa=Blocks}, FuncDb}. c_phis_1([L|Ls], Blocks0) -> case map_get(L, Blocks0) of @@ -460,9 +594,9 @@ c_fix_branches([], _, Blocks) -> Blocks. %%% - Smaller stack frames %%% -ssa_opt_tail_phis({#st{ssa=SSA0,cnt=Count0}=St, FuncDb}) -> +ssa_opt_tail_phis({#opt_st{ssa=SSA0,cnt=Count0}=St, FuncDb}) -> {SSA,Count} = opt_tail_phis(SSA0, Count0), - {St#st{ssa=SSA,cnt=Count}, FuncDb}. + {St#opt_st{ssa=SSA,cnt=Count}, FuncDb}. opt_tail_phis(Blocks, Count) when is_map(Blocks) -> opt_tail_phis(maps:values(Blocks), Blocks, Count); @@ -591,7 +725,7 @@ are_all_literals(Args) -> %%% be replaced with get_tuple_element/3 instructions. %%% -ssa_opt_element({#st{ssa=Blocks}=St, FuncDb}) -> +ssa_opt_element({#opt_st{ssa=Blocks}=St, FuncDb}) -> %% Collect the information about element instructions in this %% function. GetEls = collect_element_calls(beam_ssa:linearize(Blocks)), @@ -603,7 +737,7 @@ ssa_opt_element({#st{ssa=Blocks}=St, FuncDb}) -> %% For each chain, swap the first element call with the %% element call with the highest index. - {St#st{ssa=swap_element_calls(Chains, Blocks)}, FuncDb}. + {St#opt_st{ssa=swap_element_calls(Chains, Blocks)}, FuncDb}. collect_element_calls([{L,#b_blk{is=Is0,last=Last}}|Bs]) -> case {Is0,Last} of @@ -664,9 +798,9 @@ swap_element_calls_1([], _, Blocks) -> %%% when applicable. %%% -ssa_opt_record({#st{ssa=Linear}=St, FuncDb}) -> +ssa_opt_record({#opt_st{ssa=Linear}=St, FuncDb}) -> Blocks = maps:from_list(Linear), - {St#st{ssa=record_opt(Linear, Blocks)}, FuncDb}. + {St#opt_st{ssa=record_opt(Linear, Blocks)}, FuncDb}. record_opt([{L,#b_blk{is=Is0,last=Last}=Blk0}|Bs], Blocks) -> Is = record_opt_is(Is0, Last, Blocks), @@ -759,9 +893,9 @@ is_tagged_tuple_4([], _, _) -> no. %%% subexpressions across instructions that clobber the X registers. %%% -ssa_opt_cse({#st{ssa=Linear}=St, FuncDb}) -> +ssa_opt_cse({#opt_st{ssa=Linear}=St, FuncDb}) -> M = #{0=>#{}}, - {St#st{ssa=cse(Linear, #{}, M)}, FuncDb}. + {St#opt_st{ssa=cse(Linear, #{}, M)}, FuncDb}. cse([{L,#b_blk{is=Is0,last=Last0}=Blk}|Bs], Sub0, M0) -> Es0 = map_get(L, M0), @@ -898,34 +1032,52 @@ cse_suitable(#b_set{}) -> false. -record(fs, {s=undefined :: 'undefined' | 'cleared', regs=#{} :: #{beam_ssa:b_var():=beam_ssa:b_var()}, + vars=cerl_sets:new() :: cerl_sets:set(), fail=none :: 'none' | beam_ssa:label(), non_guards :: gb_sets:set(beam_ssa:label()), bs :: beam_ssa:block_map() }). -ssa_opt_float({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> +ssa_opt_float({#opt_st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> NonGuards = non_guards(Linear0), Blocks = maps:from_list(Linear0), Fs = #fs{non_guards=NonGuards,bs=Blocks}, {Linear,Count} = float_opt(Linear0, Count0, Fs), - {St#st{ssa=Linear,cnt=Count}, FuncDb}. + {St#opt_st{ssa=Linear,cnt=Count}, FuncDb}. -float_blk_is_in_guard(#b_blk{last=#b_br{fail=F}}, #fs{non_guards=NonGuards}) -> - not gb_sets:is_member(F, NonGuards); -float_blk_is_in_guard(#b_blk{}, #fs{}) -> +%% The fconv instruction doesn't support jumping to a fail label, so we have to +%% skip this optimization if the fail block is a guard. +%% +%% We also skip the optimization in blocks that always fail, as it's both +%% difficult and pointless to rewrite them to use float ops. +float_can_optimize_blk(#b_blk{last=#b_br{bool=#b_var{},fail=F}}, + #fs{non_guards=NonGuards}) -> + gb_sets:is_member(F, NonGuards); +float_can_optimize_blk(#b_blk{}, #fs{}) -> false. +float_opt([{L,#b_blk{is=[#b_set{op=exception_trampoline,args=[Var]}]}=Blk0} | + Bs0], Count0, Fs) -> + %% If we've replaced a BIF with float operations, we'll have a lot of extra + %% blocks that jump to the same failure block, which may have a trampoline + %% that refers to the original operation. + %% + %% Since the point of the trampoline is to keep the BIF from being removed + %% by liveness optimization, we can discard it as the liveness pass leaves + %% floats alone. + Blk = case cerl_sets:is_element(Var, Fs#fs.vars) of + true -> Blk0#b_blk{is=[]}; + false -> Blk0 + end, + {Bs, Count} = float_opt(Bs0, Count0, Fs), + {[{L,Blk}|Bs],Count}; float_opt([{L,Blk}|Bs0], Count0, Fs) -> - case float_blk_is_in_guard(Blk, Fs) of + case float_can_optimize_blk(Blk, Fs) of true -> - %% This block is inside a guard. Don't do - %% any floating point optimizations. - {Bs,Count} = float_opt(Bs0, Count0, Fs), - {[{L,Blk}|Bs],Count}; + float_opt_1(L, Blk, Bs0, Count0, Fs); false -> - %% This block is not inside a guard. - %% We can do the optimization. - float_opt_1(L, Blk, Bs0, Count0, Fs) + {Bs,Count} = float_opt(Bs0, Count0, Fs), + {[{L,Blk}|Bs],Count} end; float_opt([], Count, _Fs) -> {[],Count}. @@ -1004,12 +1156,12 @@ float_maybe_flush(Blk0, #fs{s=cleared,fail=Fail,bs=Blocks}=Fs0, Count0) -> #b_blk{last=#b_br{bool=#b_var{},succ=Succ}=Br} = Blk0, %% If the success block starts with a floating point operation, we can - %% defer flushing to that block as long as it isn't a guard. + %% defer flushing to that block as long as it's suitable for optimization. #b_blk{is=Is} = SuccBlk = map_get(Succ, Blocks), - SuccIsGuard = float_blk_is_in_guard(SuccBlk, Fs0), + CanOptimizeSucc = float_can_optimize_blk(SuccBlk, Fs0), case Is of - [#b_set{anno=#{float_op:=_}}|_] when not SuccIsGuard -> + [#b_set{anno=#{float_op:=_}}|_] when CanOptimizeSucc -> %% No flush needed. {[],Blk0,Fs0,Count0}; _ -> @@ -1065,21 +1217,22 @@ float_opt_is([], Fs, _Count, _Acc) -> none. float_make_op(#b_set{op={bif,Op},dst=Dst,args=As0}=I0, - Ts, #fs{s=S,regs=Rs0}=Fs, Count0) -> + Ts, #fs{s=S,regs=Rs0,vars=Vs0}=Fs, Count0) -> {As1,Rs1,Count1} = float_load(As0, Ts, Rs0, Count0, []), {As,Is0} = unzip(As1), {Fr,Count2} = new_reg('@fr', Count1), FrDst = #b_var{name=Fr}, I = I0#b_set{op={float,Op},dst=FrDst,args=As}, + Vs = cerl_sets:add_element(Dst, Vs0), Rs = Rs1#{Dst=>FrDst}, Is = append(Is0) ++ [I], case S of undefined -> {Ignore,Count} = new_reg('@ssa_ignore', Count2), C = #b_set{op={float,clearerror},dst=#b_var{name=Ignore}}, - {[C|Is],Fs#fs{s=cleared,regs=Rs},Count}; + {[C|Is],Fs#fs{s=cleared,regs=Rs,vars=Vs},Count}; cleared -> - {Is,Fs#fs{regs=Rs},Count2} + {Is,Fs#fs{regs=Rs,vars=Vs},Count2} end. float_load([A|As], [T|Ts], Rs0, Count0, Acc) -> @@ -1143,12 +1296,12 @@ float_flush_regs(#fs{regs=Rs}) -> %%% with a cheaper instructions %%% -ssa_opt_live({#st{ssa=Linear0}=St, FuncDb}) -> +ssa_opt_live({#opt_st{ssa=Linear0}=St, FuncDb}) -> RevLinear = reverse(Linear0), Blocks0 = maps:from_list(RevLinear), Blocks = live_opt(RevLinear, #{}, Blocks0), Linear = beam_ssa:linearize(Blocks), - {St#st{ssa=Linear}, FuncDb}. + {St#opt_st{ssa=Linear}, FuncDb}. live_opt([{L,Blk0}|Bs], LiveMap0, Blocks) -> Blk1 = beam_ssa_share:block(Blk0, Blocks), @@ -1208,34 +1361,31 @@ live_opt_is([#b_set{op=phi,dst=Dst}=I|Is], Live, Acc) -> false -> live_opt_is(Is, Live, Acc) end; -live_opt_is([#b_set{op=succeeded,dst=SuccDst=SuccDstVar, - args=[Dst]}=SuccI, - #b_set{dst=Dst}=I|Is], Live0, Acc) -> - case gb_sets:is_member(Dst, Live0) of - true -> - Live1 = gb_sets:add(Dst, Live0), - Live = gb_sets:delete_any(SuccDst, Live1), - live_opt_is([I|Is], Live, [SuccI|Acc]); - false -> - case live_opt_unused(I) of - {replace,NewI0} -> - NewI = NewI0#b_set{dst=SuccDstVar}, - live_opt_is([NewI|Is], Live0, Acc); - keep -> - case gb_sets:is_member(SuccDst, Live0) of - true -> - Live1 = gb_sets:add(Dst, Live0), - Live = gb_sets:delete(SuccDst, Live1), - live_opt_is([I|Is], Live, [SuccI|Acc]); - false -> - live_opt_is([I|Is], Live0, Acc) - end - end +live_opt_is([#b_set{op=succeeded,dst=SuccDst,args=[MapDst]}=SuccI, + #b_set{op=get_map_element,dst=MapDst}=MapI | Is], + Live0, Acc) -> + case {gb_sets:is_member(SuccDst, Live0), + gb_sets:is_member(MapDst, Live0)} of + {true, true} -> + Live = gb_sets:delete(SuccDst, Live0), + live_opt_is([MapI | Is], Live, [SuccI | Acc]); + {true, false} -> + %% 'get_map_element' is unused; replace 'succeeded' with + %% 'has_map_field' + NewI = MapI#b_set{op=has_map_field,dst=SuccDst}, + live_opt_is([NewI | Is], Live0, Acc); + {false, true} -> + %% 'succeeded' is unused (we know it will succeed); discard it and + %% keep 'get_map_element' + live_opt_is([MapI | Is], Live0, Acc); + {false, false} -> + live_opt_is(Is, Live0, Acc) end; live_opt_is([#b_set{dst=Dst}=I|Is], Live0, Acc) -> case gb_sets:is_member(Dst, Live0) of true -> - Live1 = gb_sets:union(Live0, gb_sets:from_ordset(beam_ssa:used(I))), + LiveUsed = gb_sets:from_ordset(beam_ssa:used(I)), + Live1 = gb_sets:union(Live0, LiveUsed), Live = gb_sets:delete(Dst, Live1), live_opt_is(Is, Live, [I|Acc]); false -> @@ -1243,16 +1393,112 @@ live_opt_is([#b_set{dst=Dst}=I|Is], Live0, Acc) -> true -> live_opt_is(Is, Live0, Acc); false -> - Live = gb_sets:union(Live0, gb_sets:from_ordset(beam_ssa:used(I))), + LiveUsed = gb_sets:from_ordset(beam_ssa:used(I)), + Live = gb_sets:union(Live0, LiveUsed), live_opt_is(Is, Live, [I|Acc]) end end; live_opt_is([], Live, Acc) -> {Acc,Live}. -live_opt_unused(#b_set{op=get_map_element}=Set) -> - {replace,Set#b_set{op=has_map_field}}; -live_opt_unused(_) -> keep. +%%% +%%% Do a strength reduction of try/catch and catch. +%%% +%%% In try/catch constructs where the expression is restricted +%%% (essentially a guard expression) and the error reason is ignored +%%% in the catch part, such as: +%%% +%%% try +%%% <RestrictedExpression> +%%% catch +%%% _:_ -> +%%% ... +%%% end +%%% +%%% the try/catch can be eliminated by simply removing the `new_try_tag`, +%%% `landingpad`, and `kill_try_tag` instructions. + +ssa_opt_try({#opt_st{ssa=Linear0}=St, FuncDb}) -> + Linear = opt_try(Linear0), + {St#opt_st{ssa=Linear}, FuncDb}. + +opt_try([{L,#b_blk{is=[#b_set{op=new_try_tag}], + last=Last}=Blk0}|Bs0]) -> + #b_br{succ=Succ,fail=Fail} = Last, + Ws = cerl_sets:from_list([Succ,Fail]), + try do_opt_try(Bs0, Ws) of + Bs -> + Blk = Blk0#b_blk{is=[], + last=#b_br{bool=#b_literal{val=true}, + succ=Succ,fail=Succ}}, + [{L,Blk}|opt_try(Bs)] + catch + throw:not_possible -> + [{L,Blk0}|opt_try(Bs0)] + end; +opt_try([{L,Blk}|Bs]) -> + [{L,Blk}|opt_try(Bs)]; +opt_try([]) -> []. + +do_opt_try([{L,Blk}|Bs]=Bs0, Ws0) -> + case cerl_sets:is_element(L, Ws0) of + false -> + %% This block is not reachable from the block with the + %% `new_try_tag` instruction. Retain it. There is no + %% need to check it for safety. + case cerl_sets:size(Ws0) of + 0 -> Bs0; + _ -> [{L,Blk}|do_opt_try(Bs, Ws0)] + end; + true -> + Ws1 = cerl_sets:del_element(L, Ws0), + #b_blk{is=Is0} = Blk, + case is_safe_without_try(Is0, []) of + safe -> + %% This block does not execute any instructions + %% that would require a try. Analyze successors. + Successors = beam_ssa:successors(Blk), + Ws = cerl_sets:union(cerl_sets:from_list(Successors), + Ws1), + [{L,Blk}|do_opt_try(Bs, Ws)]; + unsafe -> + %% There is something unsafe in the block, for + %% example a `call` instruction or an `extract` + %% instruction. + throw(not_possible); + {done,Is} -> + %% This block kills the try tag (either after successful + %% execution or at the landing pad). Don't analyze + %% successors. + [{L,Blk#b_blk{is=Is}}|do_opt_try(Bs, Ws1)] + end + end; +do_opt_try([], Ws) -> + 0 = cerl_sets:size(Ws), %Assertion. + []. + +is_safe_without_try([#b_set{op=kill_try_tag}|Is], Acc) -> + %% Remove this kill_try_tag instruction. If there was a landingpad + %% instruction in this block, it has already been removed. Preserve + %% all other instructions in the block. + {done,reverse(Is, Acc)}; +is_safe_without_try([#b_set{op=extract}|_], _Acc) -> + %% The error reason is accessed. + unsafe; +is_safe_without_try([#b_set{op=exception_trampoline}|Is], Acc) -> + is_safe_without_try(Is, Acc); +is_safe_without_try([#b_set{op=landingpad}|Is], Acc) -> + is_safe_without_try(Is, Acc); +is_safe_without_try([#b_set{op=Op}=I|Is], Acc) -> + IsSafe = case Op of + phi -> true; + _ -> beam_ssa:no_side_effect(I) + end, + case IsSafe of + true -> is_safe_without_try(Is, [I|Acc]); + false -> unsafe + end; +is_safe_without_try([], _Acc) -> safe. %%% %%% Optimize binary matching. @@ -1264,10 +1510,10 @@ live_opt_unused(_) -> keep. %%% with bs_test_tail. %%% -ssa_opt_bsm({#st{ssa=Linear}=St, FuncDb}) -> +ssa_opt_bsm({#opt_st{ssa=Linear}=St, FuncDb}) -> Extracted0 = bsm_extracted(Linear), Extracted = cerl_sets:from_list(Extracted0), - {St#st{ssa=bsm_skip(Linear, Extracted)}, FuncDb}. + {St#opt_st{ssa=bsm_skip(Linear, Extracted)}, FuncDb}. bsm_skip([{L,#b_blk{is=Is0}=Blk}|Bs0], Extracted) -> Bs = bsm_skip(Bs0, Extracted), @@ -1365,14 +1611,14 @@ coalesce_skips_is(_, _, _) -> %%% Short-cutting binary matching instructions. %%% -ssa_opt_bsm_shortcut({#st{ssa=Linear}=St, FuncDb}) -> +ssa_opt_bsm_shortcut({#opt_st{ssa=Linear}=St, FuncDb}) -> Positions = bsm_positions(Linear, #{}), case map_size(Positions) of 0 -> %% No binary matching instructions. {St, FuncDb}; _ -> - {St#st{ssa=bsm_shortcut(Linear, Positions)}, FuncDb} + {St#opt_st{ssa=bsm_shortcut(Linear, Positions)}, FuncDb} end. bsm_positions([{L,#b_blk{is=Is,last=Last}}|Bs], PosMap0) -> @@ -1431,110 +1677,6 @@ bsm_shortcut([{L,#b_blk{is=Is,last=Last0}=Blk}|Bs], PosMap) -> bsm_shortcut([], _PosMap) -> []. %%% -%%% Eliminate redundant bs_test_unit2 instructions. -%%% - -ssa_opt_bsm_units({#st{ssa=Linear}=St, FuncDb}) -> - {St#st{ssa=bsm_units(Linear, #{})}, FuncDb}. - -bsm_units([{L,#b_blk{last=#b_br{succ=Succ,fail=Fail}}=Block0} | Bs], UnitMaps0) -> - UnitsIn = maps:get(L, UnitMaps0, #{}), - {Block, UnitsOut} = bsm_units_skip(Block0, UnitsIn), - UnitMaps1 = bsm_units_join(Succ, UnitsOut, UnitMaps0), - UnitMaps = bsm_units_join(Fail, UnitsIn, UnitMaps1), - [{L, Block} | bsm_units(Bs, UnitMaps)]; -bsm_units([{L,#b_blk{last=#b_switch{fail=Fail,list=Switch}}=Block} | Bs], UnitMaps0) -> - UnitsIn = maps:get(L, UnitMaps0, #{}), - Labels = [Fail | [Lbl || {_Arg, Lbl} <- Switch]], - UnitMaps = foldl(fun(Lbl, UnitMaps) -> - bsm_units_join(Lbl, UnitsIn, UnitMaps) - end, UnitMaps0, Labels), - [{L, Block} | bsm_units(Bs, UnitMaps)]; -bsm_units([{L, Block} | Bs], UnitMaps) -> - [{L, Block} | bsm_units(Bs, UnitMaps)]; -bsm_units([], _UnitMaps) -> - []. - -bsm_units_skip(Block, Units) -> - bsm_units_skip_1(Block#b_blk.is, Block, Units). - -bsm_units_skip_1([#b_set{op=bs_start_match,dst=New}|_], Block, Units) -> - %% We bail early since there can't be more than one match per block. - {Block, Units#{ New => 1 }}; -bsm_units_skip_1([#b_set{op=bs_match, - dst=New, - args=[#b_literal{val=skip}, - Ctx, - #b_literal{val=binary}, - _Flags, - #b_literal{val=all}, - #b_literal{val=OpUnit}]}=Skip | Test], - Block0, Units) -> - [#b_set{op=succeeded,dst=Bool,args=[New]}] = Test, %Assertion. - #b_br{bool=Bool} = Last0 = Block0#b_blk.last, %Assertion. - CtxUnit = map_get(Ctx, Units), - if - CtxUnit rem OpUnit =:= 0 -> - Is = takewhile(fun(I) -> I =/= Skip end, Block0#b_blk.is), - Last = Last0#b_br{bool=#b_literal{val=true}}, - Block = Block0#b_blk{is=Is,last=Last}, - {Block, Units#{ New => CtxUnit }}; - CtxUnit rem OpUnit =/= 0 -> - {Block0, Units#{ New => OpUnit, Ctx => OpUnit }} - end; -bsm_units_skip_1([#b_set{op=bs_match,dst=New,args=Args}|_], Block, Units) -> - [_,Ctx|_] = Args, - CtxUnit = map_get(Ctx, Units), - OpUnit = bsm_op_unit(Args), - {Block, Units#{ New => gcd(OpUnit, CtxUnit) }}; -bsm_units_skip_1([_I | Is], Block, Units) -> - bsm_units_skip_1(Is, Block, Units); -bsm_units_skip_1([], Block, Units) -> - {Block, Units}. - -bsm_op_unit([_,_,_,Size,#b_literal{val=U}]) -> - case Size of - #b_literal{val=Sz} when is_integer(Sz) -> Sz*U; - _ -> U - end; -bsm_op_unit([#b_literal{val=string},_,#b_literal{val=String}]) -> - bit_size(String); -bsm_op_unit([#b_literal{val=utf8}|_]) -> - 8; -bsm_op_unit([#b_literal{val=utf16}|_]) -> - 16; -bsm_op_unit([#b_literal{val=utf32}|_]) -> - 32; -bsm_op_unit(_) -> - 1. - -%% Several paths can lead to the same match instruction and the inferred units -%% may differ between them, so we can only keep the information that is common -%% to all paths. -bsm_units_join(Lbl, MapA, UnitMaps0) when is_map_key(Lbl, UnitMaps0) -> - MapB = map_get(Lbl, UnitMaps0), - Merged = if - map_size(MapB) =< map_size(MapA) -> - bsm_units_join_1(maps:keys(MapB), MapA, MapB); - map_size(MapB) > map_size(MapA) -> - bsm_units_join_1(maps:keys(MapA), MapB, MapA) - end, - UnitMaps0#{Lbl := Merged}; -bsm_units_join(Lbl, MapA, UnitMaps0) when MapA =/= #{} -> - UnitMaps0#{Lbl => MapA}; -bsm_units_join(_Lbl, _MapA, UnitMaps0) -> - UnitMaps0. - -bsm_units_join_1([Key | Keys], Left, Right) when is_map_key(Key, Left) -> - UnitA = map_get(Key, Left), - UnitB = map_get(Key, Right), - bsm_units_join_1(Keys, Left, Right#{Key := gcd(UnitA, UnitB)}); -bsm_units_join_1([Key | Keys], Left, Right) -> - bsm_units_join_1(Keys, Left, maps:remove(Key, Right)); -bsm_units_join_1([], _MapA, Right) -> - Right. - -%%% %%% Optimize binary construction. %%% %%% If an integer segment or a float segment has a literal size and @@ -1543,9 +1685,9 @@ bsm_units_join_1([], _MapA, Right) -> %%% to bs_put_string instructions in later pass. %%% -ssa_opt_bs_puts({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> +ssa_opt_bs_puts({#opt_st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> {Linear,Count} = opt_bs_puts(Linear0, Count0, []), - {St#st{ssa=Linear,cnt=Count}, FuncDb}. + {St#opt_st{ssa=Linear,cnt=Count}, FuncDb}. opt_bs_puts([{L,#b_blk{is=Is}=Blk0}|Bs], Count0, Acc0) -> case Is of @@ -1641,8 +1783,13 @@ opt_bs_put(#b_set{args=[#b_literal{val=Type},#b_literal{val=Flags}, I = I0#b_set{args=Args}, opt_bs_put(I); {binary,_} when is_bitstring(Val) -> - <<Bitstring:EffectiveSize/bits,_/bits>> = Val, - [Bitstring]; + case Val of + <<Bitstring:EffectiveSize/bits,_/bits>> -> + [Bitstring]; + _ -> + %% Specified size exceeds size of bitstring. + not_possible + end; {float,Endian} -> try [opt_bs_put_float(Val, EffectiveSize, Endian)] @@ -1763,12 +1910,12 @@ opt_bs_put_split_int_1(Int, L, R) -> %%% is_tuple_of_arity instruction by the loader. %%% -ssa_opt_tuple_size({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> +ssa_opt_tuple_size({#opt_st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> %% This optimization is only safe in guards, as prefixing tuple_size with %% an is_tuple check prevents it from throwing an exception. NonGuards = non_guards(Linear0), {Linear,Count} = opt_tup_size(Linear0, NonGuards, Count0, []), - {St#st{ssa=Linear,cnt=Count}, FuncDb}. + {St#opt_st{ssa=Linear,cnt=Count}, FuncDb}. opt_tup_size([{L,#b_blk{is=Is,last=Last}=Blk}|Bs], NonGuards, Count0, Acc0) -> case {Is,Last} of @@ -1835,33 +1982,20 @@ opt_tup_size_is([], _, _, _Acc) -> none. %%% %%% Optimize #b_switch{} instructions. %%% -%%% If the argument for a #b_switch{} comes from a phi node with all -%%% literals, any values in the switch list which are not in the phi -%%% node can be removed. -%%% -%%% If the values in the phi node and switch list are the same, -%%% the failure label can't be reached and be eliminated. -%%% %%% A #b_switch{} with only one value can be rewritten to %%% a #b_br{}. A switch that only verifies that the argument -%%% is 'true' or 'false' can be rewritten to a is_boolean test. -%%% +%%% is 'true' or 'false' can be rewritten to an is_boolean test. +%%%b -ssa_opt_sw({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> +ssa_opt_sw({#opt_st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> {Linear,Count} = opt_sw(Linear0, Count0, []), - {St#st{ssa=Linear,cnt=Count}, FuncDb}. + {St#opt_st{ssa=Linear,cnt=Count}, FuncDb}. opt_sw([{L,#b_blk{is=Is,last=#b_switch{}=Sw0}=Blk0}|Bs], Count0, Acc) -> - %% Ensure that no label in the switch list is the same - %% as the failure label. - #b_switch{fail=Fail,list=List0} = Sw0, - List = [{Val,Lbl} || {Val,Lbl} <- List0, Lbl =/= Fail], - Sw1 = beam_ssa:normalize(Sw0#b_switch{list=List}), - case Sw1 of + case Sw0 of #b_switch{arg=Arg,fail=Fail,list=[{Lit,Lbl}]} -> %% Rewrite a single value switch to a br. - Bool = #b_var{name={'@ssa_bool',Count0}}, - Count = Count0 + 1, + {Bool,Count} = new_var('@ssa_bool', Count0), IsEq = #b_set{op={bif,'=:='},dst=Bool,args=[Arg,Lit]}, Br = #b_br{bool=Bool,succ=Lbl,fail=Fail}, Blk = Blk0#b_blk{is=Is++[IsEq],last=Br}, @@ -1870,17 +2004,13 @@ opt_sw([{L,#b_blk{is=Is,last=#b_switch{}=Sw0}=Blk0}|Bs], Count0, Acc) -> list=[{#b_literal{val=B1},Lbl},{#b_literal{val=B2},Lbl}]} when B1 =:= not B2 -> %% Replace with is_boolean test. - Bool = #b_var{name={'@ssa_bool',Count0}}, - Count = Count0 + 1, + {Bool,Count} = new_var('@ssa_bool', Count0), IsBool = #b_set{op={bif,is_boolean},dst=Bool,args=[Arg]}, Br = #b_br{bool=Bool,succ=Lbl,fail=Fail}, Blk = Blk0#b_blk{is=Is++[IsBool],last=Br}, opt_sw(Bs, Count, [{L,Blk}|Acc]); - Sw0 -> - opt_sw(Bs, Count0, [{L,Blk0}|Acc]); - Sw -> - Blk = Blk0#b_blk{last=Sw}, - opt_sw(Bs, Count0, [{L,Blk}|Acc]) + _ -> + opt_sw(Bs, Count0, [{L,Blk0}|Acc]) end; opt_sw([{L,#b_blk{}=Blk}|Bs], Count, Acc) -> opt_sw(Bs, Count, [{L,Blk}|Acc]); @@ -1891,10 +2021,10 @@ opt_sw([], Count, Acc) -> %%% Merge blocks. %%% -ssa_opt_merge_blocks({#st{ssa=Blocks}=St, FuncDb}) -> +ssa_opt_merge_blocks({#opt_st{ssa=Blocks}=St, FuncDb}) -> Preds = beam_ssa:predecessors(Blocks), Merged = merge_blocks_1(beam_ssa:rpo(Blocks), Preds, Blocks), - {St#st{ssa=Merged}, FuncDb}. + {St#opt_st{ssa=Merged}, FuncDb}. merge_blocks_1([L|Ls], Preds0, Blocks0) -> case Preds0 of @@ -1937,9 +2067,17 @@ verify_merge_is([#b_set{op=Op}|_]) -> verify_merge_is(_) -> ok. -is_merge_allowed(_, #b_blk{}, #b_blk{is=[#b_set{op=peek_message}|_]}) -> +is_merge_allowed(_, #b_blk{}, #b_blk{is=[#b_set{op=exception_trampoline}|_]}) -> false; -is_merge_allowed(L, #b_blk{last=#b_br{}}=Blk, #b_blk{is=Is}) -> +is_merge_allowed(_, #b_blk{is=[#b_set{op=exception_trampoline}|_]}, #b_blk{}) -> + false; +is_merge_allowed(L, #b_blk{}=Blk1, #b_blk{is=[#b_set{}=I|_]}=Blk2) -> + not beam_ssa:is_loop_header(I) andalso + is_merge_allowed_1(L, Blk1, Blk2); +is_merge_allowed(L, Blk1, Blk2) -> + is_merge_allowed_1(L, Blk1, Blk2). + +is_merge_allowed_1(L, #b_blk{last=#b_br{}}=Blk, #b_blk{is=Is}) -> %% The predecessor block must have exactly one successor (L) for %% the merge to be safe. case beam_ssa:successors(Blk) of @@ -1958,7 +2096,7 @@ is_merge_allowed(L, #b_blk{last=#b_br{}}=Blk, #b_blk{is=Is}) -> [_|_] -> false end; -is_merge_allowed(_, #b_blk{last=#b_switch{}}, #b_blk{}) -> +is_merge_allowed_1(_, #b_blk{last=#b_switch{}}, #b_blk{}) -> false. %%% @@ -1977,9 +2115,7 @@ is_merge_allowed(_, #b_blk{last=#b_switch{}}, #b_blk{}) -> %%% extracted values. %%% -ssa_opt_sink({#st{ssa=Blocks0}=St, FuncDb}) -> - Linear = beam_ssa:linearize(Blocks0), - +ssa_opt_sink({#opt_st{ssa=Linear}=St, FuncDb}) -> %% Create a map with all variables that define get_tuple_element %% instructions. The variable name map to the block it is defined in. case def_blocks(Linear) of @@ -1988,10 +2124,12 @@ ssa_opt_sink({#st{ssa=Blocks0}=St, FuncDb}) -> {St, FuncDb}; [_|_]=Defs0 -> Defs = maps:from_list(Defs0), - {do_ssa_opt_sink(Linear, Defs, St), FuncDb} + {do_ssa_opt_sink(Defs, St), FuncDb} end. -do_ssa_opt_sink(Linear, Defs, #st{ssa=Blocks0}=St) -> +do_ssa_opt_sink(Defs, #opt_st{ssa=Linear}=St) -> + Blocks0 = maps:from_list(Linear), + %% Now find all the blocks that use variables defined by get_tuple_element %% instructions. Used = used_blocks(Linear, Defs, []), @@ -2016,7 +2154,8 @@ do_ssa_opt_sink(Linear, Defs, #st{ssa=Blocks0}=St) -> From = map_get(V, Defs), move_defs(V, From, To, A) end, Blocks0, DefLoc), - St#st{ssa=Blocks}. + + St#opt_st{ssa=beam_ssa:linearize(Blocks)}. def_blocks([{L,#b_blk{is=Is}}|Bs]) -> def_blocks_is(Is, L, def_blocks(Bs)); @@ -2045,15 +2184,14 @@ unsuitable(Linear, Blocks) -> Unsuitable1 = unsuitable_recv(Linear, Blocks, Predecessors), gb_sets:from_list(Unsuitable0 ++ Unsuitable1). -unsuitable_1([{L,#b_blk{is=[#b_set{op=Op}|_]}}|Bs]) -> +unsuitable_1([{L,#b_blk{is=[#b_set{op=Op}=I|_]}}|Bs]) -> Unsuitable = case Op of bs_extract -> true; bs_put -> true; + exception_trampoline -> true; {float,_} -> true; landingpad -> true; - peek_message -> true; - wait_timeout -> true; - _ -> false + _ -> beam_ssa:is_loop_header(I) end, case Unsuitable of true -> @@ -2087,10 +2225,10 @@ unsuitable_loop(L, Blocks, Predecessors, Acc) -> unsuitable_loop_1(Ps, Blocks, Predecessors, Acc). unsuitable_loop_1([P|Ps], Blocks, Predecessors, Acc0) -> - case map_get(P, Blocks) of - #b_blk{is=[#b_set{op=peek_message}|_]} -> + case is_loop_header(P, Blocks) of + true -> unsuitable_loop_1(Ps, Blocks, Predecessors, Acc0); - #b_blk{} -> + false -> case ordsets:is_element(P, Acc0) of false -> Acc1 = ordsets:add_element(P, Acc0), @@ -2102,6 +2240,14 @@ unsuitable_loop_1([P|Ps], Blocks, Predecessors, Acc0) -> end; unsuitable_loop_1([], _, _, Acc) -> Acc. +is_loop_header(L, Blocks) -> + case map_get(L, Blocks) of + #b_blk{is=[I|_]} -> + beam_ssa:is_loop_header(I); + #b_blk{} -> + false + end. + %% new_def_locations([{Variable,[UsedInBlock]}|Vs], Defs, %% Dominators, Numbering, Unsuitable) -> %% [{Variable,NewDefinitionBlock}] @@ -2207,9 +2353,9 @@ insert_def_is([], _V, Def) -> %%% for combining get_tuple_element instructions. %%% -ssa_opt_get_tuple_element({#st{ssa=Blocks0}=St, FuncDb}) -> +ssa_opt_get_tuple_element({#opt_st{ssa=Blocks0}=St, FuncDb}) -> Blocks = opt_get_tuple_element(maps:to_list(Blocks0), Blocks0), - {St#st{ssa=Blocks}, FuncDb}. + {St#opt_st{ssa=Blocks}, FuncDb}. opt_get_tuple_element([{L,#b_blk{is=Is0}=Blk0}|Bs], Blocks) -> case opt_get_tuple_element_is(Is0, false, []) of @@ -2243,27 +2389,247 @@ collect_get_tuple_element(Is, _Src, Acc) -> {Acc,Is}. %%% -%%% Common utilities. +%%% Unfold literals to avoid unnecessary move instructions in call +%%% instructions. +%%% +%%% Consider the following example: +%%% +%%% -module(whatever). +%%% -export([foo/0]). +%%% foo() -> +%%% foobar(1, 2, 3). +%%% foobar(A, B, C) -> +%%% foobar(A, B, C, []). +%%% foobar(A, B, C, D) -> ... +%%% +%%% The type optimization pass will find out that A, B, and C have constant +%%% values and do constant folding, rewriting foobar/3 to: +%%% +%%% foobar(A, B, C) -> +%%% foobar(1, 2, 3, []). +%%% +%%% That will result in three extra `move` instructions. +%%% +%%% This optimization sub pass will undo the constant folding +%%% optimization, rewriting code to use the original variable instead +%%% of the constant if the original variable is known to be in an x +%%% register. +%%% +%%% This optimization sub pass will also undo constant folding of the +%%% list of arguments in the call to error/2 in the last clause of a +%%% function. For example: +%%% +%%% bar(X, Y) -> +%%% error(function_clause, [X,42]). +%%% +%%% will be rewritten to: +%%% +%%% bar(X, Y) -> +%%% error(function_clause, [X,Y]). %%% -gcd(A, B) -> - case A rem B of - 0 -> B; - X -> gcd(B, X) +ssa_opt_unfold_literals({St,FuncDb}) -> + #opt_st{ssa=Blocks0,args=Args,anno=Anno,cnt=Count0} = St, + ParamInfo = maps:get(parameter_info, Anno, #{}), + LitMap = collect_arg_literals(Args, ParamInfo, 0, #{}), + case map_size(LitMap) of + 0 -> + %% None of the arguments for this function are known + %% literals. Nothing to do. + {St,FuncDb}; + _ -> + SafeMap = #{0 => true}, + {Blocks,Count} = unfold_literals(beam_ssa:rpo(Blocks0), + LitMap, SafeMap, Count0, Blocks0), + {St#opt_st{ssa=Blocks,cnt=Count},FuncDb} end. +collect_arg_literals([V|Vs], Info, X, Acc0) -> + case Info of + #{V:=VarInfo} -> + Type = proplists:get_value(type, VarInfo, any), + case beam_types:get_singleton_value(Type) of + {ok,Val} -> + F = fun(Vars) -> [{X,V}|Vars] end, + Acc = maps:update_with(Val, F, [{X,V}], Acc0), + collect_arg_literals(Vs, Info, X + 1, Acc); + error -> + collect_arg_literals(Vs, Info, X + 1, Acc0) + end; + #{} -> + collect_arg_literals(Vs, Info, X + 1, Acc0) + end; +collect_arg_literals([], _Info, _X, Acc) -> Acc. + +unfold_literals([L|Ls], LitMap, SafeMap0, Count0, Blocks0) -> + {Blocks,Safe,Count} = + case map_get(L, SafeMap0) of + false -> + %% Before reaching this block, an instruction that + %% clobbers x registers has been executed. *If* we + %% would use an argument variable instead of literal, + %% it would force the value to be saved to a y + %% register. This is not what we want. + {Blocks0,false,Count0}; + true -> + %% All x registers live when entering the function + %% are still live. Using the variable instead of + %% the substituted value will eliminate a `move` + %% instruction. + #b_blk{is=Is0} = Blk = map_get(L, Blocks0), + {Is,Safe0,Count1} = unfold_lit_is(Is0, LitMap, Count0, []), + {Blocks0#{L:=Blk#b_blk{is=Is}},Safe0,Count1} + end, + %% Propagate safeness to successors. + Successors = beam_ssa:successors(L, Blocks), + SafeMap = unfold_update_succ(Successors, Safe, SafeMap0), + unfold_literals(Ls, LitMap, SafeMap, Count,Blocks); +unfold_literals([], _, _, Count, Blocks) -> + {Blocks,Count}. + +unfold_update_succ([S|Ss], Safe, SafeMap0) -> + F = fun(Prev) -> Prev and Safe end, + SafeMap = maps:update_with(S, F, Safe, SafeMap0), + unfold_update_succ(Ss, Safe, SafeMap); +unfold_update_succ([], _, SafeMap) -> SafeMap. + +unfold_lit_is([#b_set{op=call, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error}, + arity=2}, + #b_literal{val=function_clause}, + ArgumentList]}=I0|Is], LitMap, Count0, Acc0) -> + %% This is a call to error/2 that raises a function_clause + %% exception in the final clause of a function. Try to undo + %% constant folding in the list of arguments (the second argument + %% for error/2). + case unfold_arg_list(Acc0, ArgumentList, LitMap, Count0, 0, []) of + {[FinalPutList|_]=Acc,Count} -> + %% Acc now contains the possibly rewritten code that + %% creates the argument list. All that remains is to + %% rewrite the call to error/2 itself so that is will + %% refer to rewritten argument list. This is essential + %% when all arguments have known literal values as in this + %% example: + %% + %% foo(X, Y) -> error(function_clause, [0,1]). + %% + #b_set{op=put_list,dst=ListVar} = FinalPutList, + #b_set{args=[ErlangError,Fc,_]} = I0, + I = I0#b_set{args=[ErlangError,Fc,ListVar]}, + {reverse(Acc, [I|Is]),false,Count}; + {[],_} -> + %% Handle code such as: + %% + %% bar(KnownValue, Stk) -> error(function_clause, Stk). + {reverse(Acc0, [I0|Is]),false,Count0} + end; +unfold_lit_is([#b_set{op=Op,args=Args0}=I0|Is], LitMap, Count, Acc) -> + %% Using a register instead of a literal is a clear win only for + %% `call` and `make_fun` instructions. Substituting into other + %% instructions is unlikely to be an improvement. + Unfold = case Op of + call -> true; + make_fun -> true; + _ -> false + end, + I = case Unfold of + true -> + Args = unfold_call_args(Args0, LitMap, -1), + I0#b_set{args=Args}; + false -> + I0 + end, + case beam_ssa:clobbers_xregs(I) of + true -> + %% This instruction clobbers x register. Don't do + %% any substitutions in rest of this block or in any + %% of its successors. + {reverse(Acc, [I|Is]),false,Count}; + false -> + unfold_lit_is(Is, LitMap, Count, [I|Acc]) + end; +unfold_lit_is([], _LitMap, Count, Acc) -> + {reverse(Acc),true,Count}. + +%% unfold_arg_list(Is, ArgumentList, LitMap, Count0, X, Acc) -> +%% {UpdatedAcc, Count}. +%% +%% Unfold the arguments in the argument list (second argument for error/2). +%% +%% Note that Is is the reversed list of instructions before the +%% call to error/2. Because of the way the list is built in reverse, +%% it means that the first put_list instruction found will add the first +%% argument (x0) to the list, the second the second argument (x1), and +%% so on. + +unfold_arg_list(Is, #b_literal{val=[Hd|Tl]}, LitMap, Count0, X, Acc) -> + %% Handle the case that the entire argument list (the second argument + %% for error/2) is a literal. + {PutListDst,Count} = new_var('@put_list', Count0), + PutList = #b_set{op=put_list,dst=PutListDst, + args=[#b_literal{val=Hd},#b_literal{val=Tl}]}, + unfold_arg_list([PutList|Is], PutListDst, LitMap, Count, X, Acc); +unfold_arg_list([#b_set{op=put_list,dst=List, + args=[Hd0,#b_literal{val=[Hd|Tl]}]}=I0|Is0], + List, LitMap, Count0, X, Acc) -> + %% The rest of the argument list is a literal list. + {PutListDst,Count} = new_var('@put_list', Count0), + PutList = #b_set{op=put_list,dst=PutListDst, + args=[#b_literal{val=Hd},#b_literal{val=Tl}]}, + I = I0#b_set{args=[Hd0,PutListDst]}, + unfold_arg_list([I,PutList|Is0], List, LitMap, Count, X, Acc); +unfold_arg_list([#b_set{op=put_list,dst=List,args=[Hd0,Tl]}=I0|Is], + List, LitMap, Count, X, Acc) -> + %% Unfold the head of the list. + Hd = unfold_arg(Hd0, LitMap, X), + I = I0#b_set{args=[Hd,Tl]}, + unfold_arg_list(Is, Tl, LitMap, Count, X + 1, [I|Acc]); +unfold_arg_list([I|Is], List, LitMap, Count, X, Acc) -> + %% Some other instruction, such as bs_get_tail. + unfold_arg_list(Is, List, LitMap, Count, X, [I|Acc]); +unfold_arg_list([], _, _, Count, _, Acc) -> + {reverse(Acc),Count}. + +unfold_call_args([A0|As], LitMap, X) -> + A = unfold_arg(A0, LitMap, X), + [A|unfold_call_args(As, LitMap, X + 1)]; +unfold_call_args([], _, _) -> []. + +unfold_arg(#b_literal{val=Val}=Lit, LitMap, X) -> + case LitMap of + #{Val:=Vars} -> + %% This literal is available in an x register. + %% If it is in the correct x register, use + %% the register. Don't bother if it is in the + %% wrong register, because that would still result + %% in a `move` instruction. + case keyfind(X, 1, Vars) of + false -> Lit; + {X,Var} -> Var + end; + #{} -> Lit + end; +unfold_arg(Expr, _LitMap, _X) -> Expr. + +%%% +%%% Common utilities. +%%% + non_guards(Linear) -> gb_sets:from_list(non_guards_1(Linear)). non_guards_1([{L,#b_blk{is=Is}}|Bs]) -> case Is of + [#b_set{op=exception_trampoline}|_] -> + [L | non_guards_1(Bs)]; [#b_set{op=landingpad}|_] -> [L | non_guards_1(Bs)]; _ -> non_guards_1(Bs) end; non_guards_1([]) -> - [?BADARG_BLOCK]. + [?EXCEPTION_BLOCK]. rel2fam(S0) -> S1 = sofs:relation(S0), @@ -2300,4 +2666,6 @@ new_var(#b_var{name={Base,N}}, Count) -> true = is_integer(N), %Assertion. {#b_var{name={Base,Count}},Count+1}; new_var(#b_var{name=Base}, Count) -> + {#b_var{name={Base,Count}},Count+1}; +new_var(Base, Count) when is_atom(Base) -> {#b_var{name={Base,Count}},Count+1}. diff --git a/lib/compiler/src/beam_ssa_opt.hrl b/lib/compiler/src/beam_ssa_opt.hrl index 37711a6f48..800096dce2 100644 --- a/lib/compiler/src/beam_ssa_opt.hrl +++ b/lib/compiler/src/beam_ssa_opt.hrl @@ -38,16 +38,34 @@ %% when dealing with co-recursive functions. arg_types = [] :: list(arg_type_map()), - %% The inferred return type of this function, this is either [type()] - %% or [] to note absence. - ret_type = [] :: list()}). + %% The success types of this function, grouping return values by their + %% argument types at the time of return. + %% + %% This gives us more precise types than a naive join of all returned + %% values, as we can rule out the cases where the arguments are + %% incompatible with the ones we're passing. + %% + %% Note that the argument types are those seen on successful return, + %% they do not cover all types that are provided to the function. + succ_types = [] :: success_type_set()}). -type arg_key() :: {CallerId :: func_id(), CallDst :: beam_ssa:b_var()}. -type arg_type_map() :: #{ arg_key() => term() }. +-type call_self() :: {call_self, ArgTypes :: [term()]}. +-type success_type_set() :: [{ArgTypes :: [term()], + RetType :: call_self() | term()}]. + %% Per-function metadata used by various optimization passes to perform %% module-level optimization. If a function is absent it means that %% module-level optimization has been turned off for said function. -type func_id() :: beam_ssa:b_local(). -type func_info_db() :: #{ func_id() => #func_info{} }. + +-record(opt_st, {ssa :: [{beam_ssa:label(),beam_ssa:b_blk()}] | + beam_ssa:block_map(), + args :: [beam_ssa:b_var()], + cnt :: beam_ssa:label(), + anno :: beam_ssa:anno()}). +-type st_map() :: #{ func_id() => #opt_st{} }. diff --git a/lib/compiler/src/beam_ssa_pp.erl b/lib/compiler/src/beam_ssa_pp.erl index 34ac08b32e..fdfc91b425 100644 --- a/lib/compiler/src/beam_ssa_pp.erl +++ b/lib/compiler/src/beam_ssa_pp.erl @@ -35,10 +35,10 @@ format_function(#b_function{anno=Anno0,args=Args, #{} -> Anno0 end, - ReachableBlocks = beam_ssa:rpo(Blocks), - All = maps:keys(Blocks), - Unreachable = ordsets:subtract(ordsets:from_list(All), - ordsets:from_list(ReachableBlocks)), + ReachableBlocks = beam_ssa:rpo(Blocks), + All = maps:keys(Blocks), + Unreachable = ordsets:subtract(ordsets:from_list(All), + ordsets:from_list(ReachableBlocks)), [case Anno0 of #{location:={Filename,Line}} -> io_lib:format("%% ~ts:~p\n", [Filename,Line]); @@ -48,7 +48,8 @@ format_function(#b_function{anno=Anno0,args=Args, io_lib:format("%% Counter = ~p\n", [Counter]), [format_anno(Key, Value) || {Key,Value} <- lists:sort(maps:to_list(Anno))], - io_lib:format("function ~p:~p(~ts) {\n", [M,F,format_args(Args, FuncAnno)]), + io_lib:format("function `~p`:`~p`(~ts) {\n", + [M, F, format_args(Args, FuncAnno)]), [format_live_interval(Var, FuncAnno) || Var <- Args], format_blocks(ReachableBlocks, Blocks, FuncAnno), case Unreachable of @@ -82,6 +83,20 @@ format_var(V) -> %%% Local functions. %%% +format_anno(parameter_info, Map) when is_map(Map) -> + case map_size(Map) of + 0 -> + []; + _ -> + Params = lists:sort(maps:to_list(Map)), + Break = "\n%% ", + [io_lib:format("%% Parameters\n", []), + [io_lib:format("%% ~s =>~s~s\n", + [format_var(V), + Break, + format_param_info(I, Break)]) || + {V,I} <- Params]] + end; format_anno(Key, Map) when is_map(Map) -> Sorted = lists:sort(maps:to_list(Map)), [io_lib:format("%% ~s:\n", [Key]), @@ -89,6 +104,20 @@ format_anno(Key, Map) when is_map(Map) -> format_anno(Key, Value) -> io_lib:format("%% ~s: ~p\n", [Key,Value]). +format_param_info([{type, T} | Infos], Break) -> + [format_type(T, Break) | + format_param_info(Infos, Break)]; +format_param_info([Info | Infos], Break) -> + [io_lib:format("~s~p", [Break, Info]) | + format_param_info(Infos, Break)]; +format_param_info([], _Break) -> + []. + +format_type(T, Break) -> + %% Gross hack, but it's short and simple. + Indented = lists:flatten(io_lib:format("~p", [T])), + string:replace(Indented, [$\n], Break, all). + format_blocks(Ls, Blocks, Anno) -> PP = [format_block(L, Blocks, Anno) || L <- Ls], lists:join($\n, PP). @@ -140,16 +169,20 @@ format_i_number(#{n:=N}) -> format_i_number(#{}) -> []. format_terminator(#b_br{anno=A,bool=#b_literal{val=true},succ=Lbl}, _) -> - io_lib:format(" ~sbr label ~p\n", [format_i_number(A),Lbl]); + io_lib:format(" ~sbr ~ts\n", [format_i_number(A),format_label(Lbl)]); format_terminator(#b_br{anno=A,bool=#b_literal{val=false},fail=Lbl}, _) -> - io_lib:format(" ~sbr label ~p\n", [format_i_number(A),Lbl]); + io_lib:format(" ~sbr ~ts\n", [format_i_number(A),format_label(Lbl)]); format_terminator(#b_br{anno=A,bool=Bool,succ=Succ,fail=Fail}, FuncAnno) -> - io_lib:format(" ~sbr ~ts, label ~p, label ~p\n", - [format_i_number(A),format_arg(Bool, FuncAnno),Succ,Fail]); + io_lib:format(" ~sbr ~ts, ~ts, ~ts\n", + [format_i_number(A), + format_arg(Bool, FuncAnno), + format_label(Succ), + format_label(Fail)]); format_terminator(#b_switch{anno=A,arg=Arg,fail=Fail,list=List}, FuncAnno) -> - io_lib:format(" ~sswitch ~ts, label ~p, ~ts\n", - [format_i_number(A),format_arg(Arg, FuncAnno),Fail, - format_list(List,FuncAnno)]); + io_lib:format(" ~sswitch ~ts, ~ts, ~ts\n", + [format_i_number(A),format_arg(Arg, FuncAnno), + format_label(Fail), + format_switch_list(List, FuncAnno)]); format_terminator(#b_ret{anno=A,arg=Arg}, FuncAnno) -> io_lib:format(" ~sret ~ts\n", [format_i_number(A),format_arg(Arg, FuncAnno)]). @@ -189,30 +222,36 @@ format_args(Args, FuncAnno) -> format_arg(#b_var{}=Arg, FuncAnno) -> format_var(Arg, FuncAnno); format_arg(#b_literal{val=Val}, _FuncAnno) -> - io_lib:format("literal ~p", [Val]); + io_lib:format("`~p`", [Val]); format_arg(#b_remote{mod=Mod,name=Name,arity=Arity}, FuncAnno) -> - io_lib:format("remote (~ts):(~ts)/~p", + io_lib:format("(~ts:~ts/~p)", [format_arg(Mod, FuncAnno),format_arg(Name, FuncAnno),Arity]); format_arg(#b_local{name=Name,arity=Arity}, FuncAnno) -> - io_lib:format("local ~ts/~p", [format_arg(Name, FuncAnno),Arity]); + io_lib:format("(~ts/~p)", [format_arg(Name, FuncAnno),Arity]); format_arg({Value,Label}, FuncAnno) when is_integer(Label) -> - io_lib:format("{ ~ts, ~p }", [format_arg(Value, FuncAnno),Label]); + io_lib:format("{ ~ts, ~ts }", [format_arg(Value, FuncAnno), + format_label(Label)]); format_arg(Other, _) -> io_lib:format("*** ~p ***", [Other]). -format_list(List, FuncAnno) -> - Ss = [io_lib:format("{ ~ts, ~ts }", [format_arg(Val, FuncAnno),format_label(L)]) || - {Val,L} <- List], - io_lib:format("[ ~ts ]", [lists:join(", ", Ss)]). +format_switch_list(List, FuncAnno) -> + Ss = [io_lib:format("{ ~ts, ~ts }", [format_arg(Val, FuncAnno), + format_label(L)]) || {Val,L} <- List], + io_lib:format("[\n ~ts\n ]", [lists:join(",\n ", Ss)]). format_label(L) -> - ["label ",integer_to_list(L)]. + io_lib:format("^~w", [L]). format_anno(#{n:=_}=Anno) -> format_anno(maps:remove(n, Anno)); format_anno(#{location:={File,Line}}=Anno0) -> Anno = maps:remove(location, Anno0), - [io_lib:format(" %% ~ts:~p\n", [File,Line])|format_anno_1(Anno)]; + [io_lib:format(" %% ~ts:~p\n", [File,Line])|format_anno(Anno)]; +format_anno(#{result_type:=T}=Anno0) -> + Anno = maps:remove(result_type, Anno0), + Break = "\n %% ", + [io_lib:format(" %% Result type:~s~s\n", + [Break, format_type(T, Break)]) | format_anno(Anno)]; format_anno(Anno) -> format_anno_1(Anno). diff --git a/lib/compiler/src/beam_ssa_pre_codegen.erl b/lib/compiler/src/beam_ssa_pre_codegen.erl index 6b4b4890a1..b94223c3cf 100644 --- a/lib/compiler/src/beam_ssa_pre_codegen.erl +++ b/lib/compiler/src/beam_ssa_pre_codegen.erl @@ -108,7 +108,8 @@ functions([], _Ps, _UseBSM3) -> []. intervals=[] :: [{b_var(),[range()]}], res=[] :: [{b_var(),reservation()}] | #{b_var():=reservation()}, regs=#{} :: #{b_var():=ssa_register()}, - extra_annos=[] :: [{atom(),term()}] + extra_annos=[] :: [{atom(),term()}], + location :: term() }). -define(PASS(N), {N,fun N/1}). @@ -118,8 +119,10 @@ passes(Opts) -> Ps = [?PASS(assert_no_critical_edges), %% Preliminaries. + ?PASS(exception_trampolines), ?PASS(fix_bs), ?PASS(sanitize), + ?PASS(match_fail_instructions), case FixTuples of false -> ignore; true -> ?PASS(fix_tuples) @@ -164,7 +167,9 @@ passes(Opts) -> function(#b_function{anno=Anno,args=Args,bs=Blocks0,cnt=Count0}=F0, Ps, UseBSM3) -> try - St0 = #st{ssa=Blocks0,args=Args,use_bsm3=UseBSM3,cnt=Count0}, + Location = maps:get(location, Anno, none), + St0 = #st{ssa=Blocks0,args=Args,use_bsm3=UseBSM3, + cnt=Count0,location=Location}, St = compile:run_sub_passes(Ps, St0), #st{ssa=Blocks,cnt=Count,regs=Regs,extra_annos=ExtraAnnos} = St, F1 = add_extra_annos(F0, ExtraAnnos), @@ -253,25 +258,26 @@ bs_pos_bsm3(Linear0, CtxChain, Count0) -> S = sofs:to_external(S1), {SavePoints,Count1} = make_bs_pos_dict(S, Count0, []), - {Gets,Count2} = make_bs_setpos_map(Rs, SavePoints, Count1, []), - {Sets,Count} = make_bs_getpos_map(maps:to_list(Rs0), SavePoints, Count2, []), + + {Gets,Count2} = make_bs_getpos_map(Rs, SavePoints, Count1, []), + {Sets,Count} = make_bs_setpos_map(maps:to_list(Rs0), SavePoints, Count2, []), %% Now insert all saves and restores. - {bs_insert_bsm3(Linear0, Gets, Sets, SavePoints),Count}. + {bs_insert_bsm3(Linear0, Gets, Sets), Count}. -make_bs_setpos_map([{Ctx,Save}=Ps|T], SavePoints, Count, Acc) -> +make_bs_getpos_map([{Ctx,Save}=Ps|T], SavePoints, Count, Acc) -> SavePoint = get_savepoint(Ps, SavePoints), I = #b_set{op=bs_get_position,dst=SavePoint,args=[Ctx]}, - make_bs_setpos_map(T, SavePoints, Count+1, [{Save,I}|Acc]); -make_bs_setpos_map([], _, Count, Acc) -> + make_bs_getpos_map(T, SavePoints, Count+1, [{Save,I}|Acc]); +make_bs_getpos_map([], _, Count, Acc) -> {maps:from_list(Acc),Count}. -make_bs_getpos_map([{Bef,{Ctx,_}=Ps}|T], SavePoints, Count, Acc) -> +make_bs_setpos_map([{Bef,{Ctx,_}=Ps}|T], SavePoints, Count, Acc) -> Ignored = #b_var{name={'@ssa_ignored',Count}}, Args = [Ctx, get_savepoint(Ps, SavePoints)], I = #b_set{op=bs_set_position,dst=Ignored,args=Args}, - make_bs_getpos_map(T, SavePoints, Count+1, [{Bef,I}|Acc]); -make_bs_getpos_map([], _, Count, Acc) -> + make_bs_setpos_map(T, SavePoints, Count+1, [{Bef,I}|Acc]); +make_bs_setpos_map([], _, Count, Acc) -> {maps:from_list(Acc),Count}. get_savepoint({_,_}=Ps, SavePoints) -> @@ -394,30 +400,37 @@ join_positions_1(MapPos0, MapPos1) -> %% bs_restores_is([#b_set{op=bs_start_match,dst=Start}|Is], - CtxChain, SPos0, FPos, Rs) -> - %% We only allow one match per block. - SPos0 = FPos, %Assertion. + CtxChain, SPos0, _FPos, Rs) -> + %% Match instructions leave the position unchanged on failure, so + %% FPos must be the SPos we entered the *instruction* with, and not the + %% *block*. + %% + %% This is important when we have multiple matches in a single block where + %% all but the last are guaranteed to succeed; the upcoming fail block must + %% restore to the position of the next-to-last match, not the position we + %% entered the current block with. + FPos = SPos0, SPos = SPos0#{Start=>Start}, bs_restores_is(Is, CtxChain, SPos, FPos, Rs); bs_restores_is([#b_set{op=bs_match,dst=NewPos,args=Args}=I|Is], - CtxChain, SPos0, FPos0, Rs0) -> - SPos0 = FPos0, %Assertion. + CtxChain, SPos0, _FPos, Rs0) -> Start = bs_subst_ctx(NewPos, CtxChain), [_,FromPos|_] = Args, case SPos0 of #{Start:=FromPos} -> %% Same position, no restore needed. SPos = case bs_match_type(I) of - plain -> - %% Update position to new position. - SPos0#{Start:=NewPos}; - _ -> - %% Position will not change (test_unit - %% instruction or no instruction at - %% all). - SPos0#{Start:=FromPos} - end, - bs_restores_is(Is, CtxChain, SPos, FPos0, Rs0); + plain -> + %% Update position to new position. + SPos0#{Start:=NewPos}; + _ -> + %% Position will not change (test_unit + %% instruction or no instruction at + %% all). + SPos0 + end, + FPos = SPos0, + bs_restores_is(Is, CtxChain, SPos, FPos, Rs0); #{Start:=_} -> %% Different positions, might need a restore instruction. case bs_match_type(I) of @@ -425,50 +438,71 @@ bs_restores_is([#b_set{op=bs_match,dst=NewPos,args=Args}=I|Is], %% This is a tail test that will be optimized away. %% There's no need to do a restore, and all %% positions are unchanged. - bs_restores_is(Is, CtxChain, SPos0, FPos0, Rs0); + FPos = SPos0, + bs_restores_is(Is, CtxChain, SPos0, FPos, Rs0); test_unit -> %% This match instruction will be replaced by %% a test_unit instruction. We will need a %% restore. The new position will be the position %% restored to (NOT NewPos). SPos = SPos0#{Start:=FromPos}, - FPos = FPos0#{Start:=FromPos}, + FPos = SPos, Rs = Rs0#{NewPos=>{Start,FromPos}}, bs_restores_is(Is, CtxChain, SPos, FPos, Rs); plain -> %% Match or skip. Position will be changed. SPos = SPos0#{Start:=NewPos}, - FPos = FPos0#{Start:=FromPos}, + FPos = SPos0#{Start:=FromPos}, Rs = Rs0#{NewPos=>{Start,FromPos}}, bs_restores_is(Is, CtxChain, SPos, FPos, Rs) end end; bs_restores_is([#b_set{op=bs_extract,args=[FromPos|_]}|Is], - CtxChain, SPos, FPos, Rs) -> + CtxChain, SPos, _FPos, Rs) -> Start = bs_subst_ctx(FromPos, CtxChain), + #{Start:=FromPos} = SPos, %Assertion. - #{Start:=FromPos} = FPos, %Assertion. + FPos = SPos, + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); bs_restores_is([#b_set{op=call,dst=Dst,args=Args}|Is], - CtxChain, SPos0, FPos0, Rs0) -> - {Rs, SPos1, FPos1} = bs_restore_args(Args, SPos0, FPos0, CtxChain, Dst, Rs0), - {SPos, FPos} = bs_invalidate_pos(Args, SPos1, FPos1, CtxChain), + CtxChain, SPos0, _FPos, Rs0) -> + {SPos1, Rs} = bs_restore_args(Args, SPos0, CtxChain, Dst, Rs0), + + SPos = bs_invalidate_pos(Args, SPos1, CtxChain), + FPos = SPos, + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); -bs_restores_is([#b_set{op=landingpad}|Is], CtxChain, SPos0, FPos0, Rs) -> +bs_restores_is([#b_set{op=landingpad}|Is], CtxChain, SPos0, _FPos, Rs) -> %% We can land here from any point, so all positions are invalid. Invalidate = fun(_Start,_Pos) -> unknown end, + SPos = maps:map(Invalidate, SPos0), - FPos = maps:map(Invalidate, FPos0), + FPos = SPos, + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); bs_restores_is([#b_set{op=Op,dst=Dst,args=Args}|Is], - CtxChain, SPos0, FPos0, Rs0) + CtxChain, SPos0, _FPos, Rs0) when Op =:= bs_test_tail; Op =:= bs_get_tail -> - {Rs, SPos, FPos} = bs_restore_args(Args, SPos0, FPos0, CtxChain, Dst, Rs0), + {SPos, Rs} = bs_restore_args(Args, SPos0, CtxChain, Dst, Rs0), + FPos = SPos, + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); -bs_restores_is([_|Is], CtxChain, SPos, FPos, Rs) -> +bs_restores_is([#b_set{op=succeeded,args=[Arg]}], CtxChain, SPos, FPos0, Rs) -> + %% If we're branching on a match operation, the positions will be different + %% depending on whether it succeeds. + Ctx = bs_subst_ctx(Arg, CtxChain), + FPos = case SPos of + #{ Ctx := _ } -> FPos0; + #{} -> SPos + end, + {SPos, FPos, Rs}; +bs_restores_is([_ | Is], CtxChain, SPos, _FPos, Rs) -> + FPos = SPos, bs_restores_is(Is, CtxChain, SPos, FPos, Rs); -bs_restores_is([], _CtxChain, SPos, FPos, Rs) -> +bs_restores_is([], _CtxChain, SPos, _FPos, Rs) -> + FPos = SPos, {SPos, FPos, Rs}. bs_match_type(#b_set{args=[#b_literal{val=skip},_Ctx, @@ -483,54 +517,52 @@ bs_match_type(_) -> %% Call instructions leave the match position in an undefined state, %% requiring us to invalidate each affected argument. -bs_invalidate_pos([#b_var{}=Arg|Args], SPos0, FPos0, CtxChain) -> +bs_invalidate_pos([#b_var{}=Arg|Args], Pos0, CtxChain) -> Start = bs_subst_ctx(Arg, CtxChain), - case SPos0 of + case Pos0 of #{Start:=_} -> - SPos = SPos0#{Start:=unknown}, - FPos = FPos0#{Start:=unknown}, - bs_invalidate_pos(Args, SPos, FPos, CtxChain); + Pos = Pos0#{Start:=unknown}, + bs_invalidate_pos(Args, Pos, CtxChain); #{} -> %% Not a match context. - bs_invalidate_pos(Args, SPos0, FPos0, CtxChain) + bs_invalidate_pos(Args, Pos0, CtxChain) end; -bs_invalidate_pos([_|Args], SPos, FPos, CtxChain) -> - bs_invalidate_pos(Args, SPos, FPos, CtxChain); -bs_invalidate_pos([], SPos, FPos, _CtxChain) -> - {SPos, FPos}. +bs_invalidate_pos([_|Args], Pos, CtxChain) -> + bs_invalidate_pos(Args, Pos, CtxChain); +bs_invalidate_pos([], Pos, _CtxChain) -> + Pos. -bs_restore_args([#b_var{}=Arg|Args], SPos0, FPos0, CtxChain, Dst, Rs0) -> +bs_restore_args([#b_var{}=Arg|Args], Pos0, CtxChain, Dst, Rs0) -> Start = bs_subst_ctx(Arg, CtxChain), - case SPos0 of + case Pos0 of #{Start:=Arg} -> %% Same position, no restore needed. - bs_restore_args(Args, SPos0, FPos0, CtxChain, Dst, Rs0); + bs_restore_args(Args, Pos0, CtxChain, Dst, Rs0); #{Start:=_} -> %% Different positions, need a restore instruction. - SPos = SPos0#{Start:=Arg}, - FPos = FPos0#{Start:=Arg}, + Pos = Pos0#{Start:=Arg}, Rs = Rs0#{Dst=>{Start,Arg}}, - bs_restore_args(Args, SPos, FPos, CtxChain, Dst, Rs); + bs_restore_args(Args, Pos, CtxChain, Dst, Rs); #{} -> %% Not a match context. - bs_restore_args(Args, SPos0, FPos0, CtxChain, Dst, Rs0) + bs_restore_args(Args, Pos0, CtxChain, Dst, Rs0) end; -bs_restore_args([_|Args], SPos, FPos, CtxChain, Dst, Rs) -> - bs_restore_args(Args, SPos, FPos, CtxChain, Dst, Rs); -bs_restore_args([], SPos, FPos, _CtxChain, _Dst, Rs) -> - {Rs,SPos,FPos}. +bs_restore_args([_|Args], Pos, CtxChain, Dst, Rs) -> + bs_restore_args(Args, Pos, CtxChain, Dst, Rs); +bs_restore_args([], Pos, _CtxChain, _Dst, Rs) -> + {Pos, Rs}. %% Insert all bs_save and bs_restore instructions. -bs_insert_bsm3(Blocks, Saves, Restores, SavePoints) -> - bs_insert_1(Blocks, Saves, Restores, SavePoints, fun(I) -> I end). +bs_insert_bsm3(Blocks, Saves, Restores) -> + bs_insert_1(Blocks, [], Saves, Restores, fun(I) -> I end). -bs_insert_bsm2(Blocks, Saves, Restores, SavePoints) -> +bs_insert_bsm2(Blocks, Saves, Restores, Slots) -> %% The old instructions require bs_start_match to be annotated with the %% number of position slots it needs. - bs_insert_1(Blocks, Saves, Restores, SavePoints, + bs_insert_1(Blocks, [], Saves, Restores, fun(#b_set{op=bs_start_match,dst=Dst}=I0) -> - NumSlots = case SavePoints of + NumSlots = case Slots of #{Dst:=NumSlots0} -> NumSlots0; #{} -> 0 end, @@ -539,46 +571,38 @@ bs_insert_bsm2(Blocks, Saves, Restores, SavePoints) -> I end). -bs_insert_1([{L,#b_blk{is=Is0}=Blk}|Bs0], Saves, Restores, Slots, XFrm) -> - Is = bs_insert_is_1(Is0, Restores, Slots, XFrm), - Bs = bs_insert_saves(Is, Bs0, Saves), - [{L,Blk#b_blk{is=Is}}|bs_insert_1(Bs, Saves, Restores, Slots, XFrm)]; -bs_insert_1([], _, _, _, _) -> []. +bs_insert_1([{L,#b_blk{is=Is0}=Blk} | Bs], Deferred0, Saves, Restores, XFrm) -> + Is1 = bs_insert_deferred(Is0, Deferred0), + {Is, Deferred} = bs_insert_is(Is1, Saves, Restores, XFrm, []), + [{L,Blk#b_blk{is=Is}} | bs_insert_1(Bs, Deferred, Saves, Restores, XFrm)]; +bs_insert_1([], [], _, _, _) -> + []. -bs_insert_is_1([#b_set{op=Op,dst=Dst}=I0|Is], Restores, SavePoints, XFrm) -> - I = XFrm(I0), - if - Op =:= bs_test_tail; - Op =:= bs_get_tail; - Op =:= bs_match; - Op =:= call -> - Rs = case Restores of - #{Dst:=R} -> [R]; - #{} -> [] - end, - Rs ++ [I|bs_insert_is_1(Is, Restores, SavePoints, XFrm)]; - true -> - [I|bs_insert_is_1(Is, Restores, SavePoints, XFrm)] - end; -bs_insert_is_1([], _, _, _) -> []. +bs_insert_deferred([#b_set{op=bs_extract}=I | Is], Deferred) -> + [I | bs_insert_deferred(Is, Deferred)]; +bs_insert_deferred(Is, Deferred) -> + Deferred ++ Is. -bs_insert_saves([#b_set{dst=Dst}|Is], Bs, Saves) -> - case Saves of - #{Dst:=S} -> - bs_insert_save(S, Bs); - #{} -> - bs_insert_saves(Is, Bs, Saves) +bs_insert_is([#b_set{dst=Dst}=I0|Is], Saves, Restores, XFrm, Acc0) -> + I = XFrm(I0), + Pre = case Restores of + #{Dst:=R} -> [R]; + #{} -> [] + end, + Post = case Saves of + #{Dst:=S} -> [S]; + #{} -> [] + end, + Acc = [I | Pre] ++ Acc0, + case Is of + [#b_set{op=succeeded,args=[Dst]}] -> + %% Defer the save sequence to the success block. + {reverse(Acc, Is), Post}; + _ -> + bs_insert_is(Is, Saves, Restores, XFrm, Post ++ Acc) end; -bs_insert_saves([], Bs, _) -> Bs. - -bs_insert_save(Save, [{L,#b_blk{is=Is0}=Blk}|Bs]) -> - Is = case Is0 of - [#b_set{op=bs_extract}=Ex|Is1] -> - [Ex,Save|Is1]; - _ -> - [Save|Is0] - end, - [{L,Blk#b_blk{is=Is}}|Bs]. +bs_insert_is([], _, _, _, Acc) -> + {reverse(Acc), []}. %% Translate bs_match instructions to bs_get, bs_match_string, %% or bs_skip. Also rename match context variables to use the @@ -598,6 +622,10 @@ bs_instrs([{L,#b_blk{is=Is0}=Blk}|Bs], CtxChain, Acc0) -> bs_instrs([], _, Acc) -> reverse(Acc). +bs_instrs_is([#b_set{op=succeeded}=I|Is], CtxChain, Acc) -> + %% This instruction refers to a specific operation, so we must not + %% substitute the context argument. + bs_instrs_is(Is, CtxChain, [I | Acc]); bs_instrs_is([#b_set{op=Op,args=Args0}=I0|Is], CtxChain, Acc) -> Args = [bs_subst_ctx(A, CtxChain) || A <- Args0], I1 = I0#b_set{args=Args}, @@ -606,8 +634,6 @@ bs_instrs_is([#b_set{op=Op,args=Args0}=I0|Is], CtxChain, Acc) -> I1#b_set{op=bs_skip,args=[Type,Ctx|As]}; {bs_match,[#b_literal{val=string},Ctx|As]} -> I1#b_set{op=bs_match_string,args=[Ctx|As]}; - {bs_get_tail,[Ctx|As]} -> - I1#b_set{op=bs_get_tail,args=[Ctx|As]}; {_,_} -> I1 end, @@ -691,6 +717,54 @@ legacy_bs_is([I|Is], Last, IsYreg, Count, Copies, Acc) -> legacy_bs_is([], _Last, _IsYreg, Count, Copies, Acc) -> {reverse(Acc),Count,Copies}. +%% exception_trampolines(St0) -> St. +%% +%% Removes the "exception trampolines" that were added to prevent exceptions +%% from being optimized away. + +exception_trampolines(#st{ssa=Blocks0}=St) -> + RPO = reverse(beam_ssa:rpo(Blocks0)), + Blocks = et_1(RPO, #{}, #{}, Blocks0), + St#st{ssa=Blocks}. + +et_1([L | Ls], Trampolines, Exceptions, Blocks) -> + #{ L := #b_blk{is=Is,last=Last0}=Block0 } = Blocks, + case {Is, Last0} of + {[#b_set{op=exception_trampoline,args=[Arg]}], #b_br{succ=Succ}} -> + et_1(Ls, + Trampolines#{ L => Succ }, + Exceptions#{ L => Arg }, + maps:remove(L, Blocks)); + {_, #b_br{succ=Same,fail=Same}} when Same =:= ?EXCEPTION_BLOCK -> + %% The exception block is just a marker saying that we should raise + %% an exception (= {f,0}) instead of jumping to a particular fail + %% block. Since it's not a reachable block we can't allow + %% unconditional jumps to it except through a trampoline. + error({illegal_jump_to_exception_block, L}); + {_, #b_br{succ=Same,fail=Same}} + when map_get(Same, Trampolines) =:= ?EXCEPTION_BLOCK -> + %% This block always fails at runtime (and we are not in a + %% try/catch); rewrite the terminator to a return. + Last = #b_ret{arg=map_get(Same, Exceptions)}, + Block = Block0#b_blk{last=Last}, + et_1(Ls, Trampolines, Exceptions, Blocks#{ L := Block }); + {_, #b_br{succ=Succ0,fail=Fail0}} -> + Succ = maps:get(Succ0, Trampolines, Succ0), + Fail = maps:get(Fail0, Trampolines, Fail0), + if + Succ =/= Succ0; Fail =/= Fail0 -> + Last = Last0#b_br{succ=Succ,fail=Fail}, + Block = Block0#b_blk{last=Last}, + et_1(Ls, Trampolines, Exceptions, Blocks#{ L := Block }); + Succ =:= Succ0, Fail =:= Fail0 -> + et_1(Ls, Trampolines, Exceptions, Blocks) + end; + {_, _} -> + et_1(Ls, Trampolines, Exceptions, Blocks) + end; +et_1([], _Trampolines, _Exceptions, Blocks) -> + Blocks. + %% sanitize(St0) -> St. %% Remove constructs that can cause problems later: %% @@ -819,12 +893,17 @@ sanitize_instr(is_tagged_tuple, [#b_literal{val=Tuple}, true -> {value,false} end; +sanitize_instr(bs_add, [_,#b_literal{val=Sz},_|_], I0) -> + if + is_integer(Sz), Sz >= 0 -> ok; + true -> {ok,sanitize_badarg(I0)} + end; sanitize_instr(bs_init, [#b_literal{val=new},#b_literal{val=Sz}|_], I0) -> if is_integer(Sz), Sz >= 0 -> ok; true -> {ok,sanitize_badarg(I0)} end; -sanitize_instr(bs_init, [#b_literal{val=append},_,#b_literal{val=Sz}|_], I0) -> +sanitize_instr(bs_init, [#b_literal{},_,#b_literal{val=Sz}|_], I0) -> if is_integer(Sz), Sz >= 0 -> ok; true -> {ok,sanitize_badarg(I0)} @@ -856,6 +935,114 @@ prune_phi(#b_set{args=Args0}=Phi, Reachable) -> gb_sets:is_element(Pred, Reachable)], Phi#b_set{args=Args}. +%%% Rewrite certain calls to erlang:error/{1,2} to specialized +%%% instructions: +%%% +%%% erlang:error({badmatch,Value}) => badmatch Value +%%% erlang:error({case_clause,Value}) => case_end Value +%%% erlang:error({try_clause,Value}) => try_case_end Value +%%% erlang:error(if_clause) => if_end +%%% erlang:error(function_clause, Args) => jump FuncInfoLabel +%%% +%%% In SSA code, we represent those instructions as a 'match_fail' +%%% instruction with the name of the BEAM instruction as the first +%%% argument. + +match_fail_instructions(#st{ssa=Blocks0,args=Args,location=Location}=St) -> + Ls = maps:to_list(Blocks0), + Info = {length(Args),Location}, + Blocks = match_fail_instrs_1(Ls, Info, Blocks0), + St#st{ssa=Blocks}. + +match_fail_instrs_1([{L,#b_blk{is=Is0}=Blk}|Bs], Arity, Blocks0) -> + case match_fail_instrs_blk(Is0, Arity, []) of + none -> + match_fail_instrs_1(Bs, Arity, Blocks0); + Is -> + Blocks = Blocks0#{L:=Blk#b_blk{is=Is}}, + match_fail_instrs_1(Bs, Arity, Blocks) + end; +match_fail_instrs_1([], _Arity, Blocks) -> Blocks. + +match_fail_instrs_blk([#b_set{op=put_tuple,dst=Dst, + args=[#b_literal{val=Tag},Val]}, + #b_set{op=call, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error}}, + Dst]}=Call|Is], + _Arity, Acc) -> + match_fail_instr(Call, Tag, Val, Is, Acc); +match_fail_instrs_blk([#b_set{op=call, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error}}, + #b_literal{val={Tag,Val}}]}=Call|Is], + _Arity, Acc) -> + match_fail_instr(Call, Tag, #b_literal{val=Val}, Is, Acc); +match_fail_instrs_blk([#b_set{op=call, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error}}, + #b_literal{val=if_clause}]}=Call|Is], + _Arity, Acc) -> + I = Call#b_set{op=match_fail,args=[#b_literal{val=if_end}]}, + reverse(Acc, [I|Is]); +match_fail_instrs_blk([#b_set{op=call,anno=Anno, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error}}, + #b_literal{val=function_clause}, + Stk]}=Call], + {Arity,Location}, Acc) -> + case match_fail_stk(Stk, Acc, [], []) of + {[_|_]=Vars,Is} when length(Vars) =:= Arity -> + case maps:get(location, Anno, none) of + Location -> + I = Call#b_set{op=match_fail, + args=[#b_literal{val=function_clause}|Vars]}, + Is ++ [I]; + _ -> + %% erlang:error/2 has a different location than the + %% func_info instruction at the beginning of the function + %% (probably because of inlining). Keep the original call. + reverse(Acc, [Call]) + end; + _ -> + %% Either the stacktrace could not be picked apart (for example, + %% if the call to erlang:error/2 was handwritten) or the number + %% of arguments in the stacktrace was different from the arity + %% of the host function (because it is the implementation of a + %% fun). Keep the original call. + reverse(Acc, [Call]) + end; +match_fail_instrs_blk([I|Is], Arity, Acc) -> + match_fail_instrs_blk(Is, Arity, [I|Acc]); +match_fail_instrs_blk(_, _, _) -> + none. + +match_fail_instr(Call, Tag, Val, Is, Acc) -> + Op = case Tag of + badmatch -> Tag; + case_clause -> case_end; + try_clause -> try_case_end; + _ -> none + end, + case Op of + none -> + none; + _ -> + I = Call#b_set{op=match_fail,args=[#b_literal{val=Op},Val]}, + reverse(Acc, [I|Is]) + end. + +match_fail_stk(#b_var{}=V, [#b_set{op=put_list,dst=V,args=[H,T]}|Is], IAcc, VAcc) -> + match_fail_stk(T, Is, IAcc, [H|VAcc]); +match_fail_stk(#b_literal{val=[H|T]}, Is, IAcc, VAcc) -> + match_fail_stk(#b_literal{val=T}, Is, IAcc, [#b_literal{val=H}|VAcc]); +match_fail_stk(#b_literal{val=[]}, [], IAcc, VAcc) -> + {reverse(VAcc),IAcc}; +match_fail_stk(T, [#b_set{op=Op}=I|Is], IAcc, VAcc) + when Op =:= bs_get_tail; Op =:= bs_set_position -> + match_fail_stk(T, Is, [I|IAcc], VAcc); +match_fail_stk(_, _, _, _) -> none. + %%% %%% Fix tuples. %%% @@ -911,9 +1098,8 @@ use_set_tuple_element(#st{ssa=Blocks0}=St) -> Blocks = use_ste_1(RPO, Uses, Blocks0), St#st{ssa=Blocks}. -use_ste_1([L|Ls], Uses, Blocks0) -> - {Blk0,Blocks} = use_ste_across(L, Uses, Blocks0), - #b_blk{is=Is0} = Blk0, +use_ste_1([L|Ls], Uses, Blocks) -> + #b_blk{is=Is0} = Blk0 = map_get(L, Blocks), case use_ste_is(Is0, Uses) of Is0 -> use_ste_1(Ls, Uses, Blocks); @@ -976,69 +1162,6 @@ extract_ste(#b_set{op=call,dst=Dst, end; extract_ste(#b_set{}) -> none. -%%% Optimize accross blocks within a try/catch block. - -use_ste_across(L, Uses, Blocks) -> - case map_get(L, Blocks) of - #b_blk{last=#b_br{bool=#b_var{}}}=Blk -> - try - use_ste_across_1(L, Blk, Uses, Blocks) - catch - throw:not_possible -> - {Blk,Blocks} - end; - #b_blk{}=Blk -> - {Blk,Blocks} - end. - -use_ste_across_1(L, Blk0, Uses, Blocks0) -> - #b_blk{is=IsThis,last=#b_br{bool=Bool,succ=Next}} = Blk0, - case reverse(IsThis) of - [#b_set{op=succeeded,dst=Bool,args=[Result]}=Succ0, - #b_set{op=call,args=[#b_remote{}|_],dst=Result}=Call1|Prefix] -> - case is_single_use(Bool, Uses) andalso - is_n_uses(2, Result, Uses) of - true -> ok; - false -> throw(not_possible) - end, - Call2 = use_ste_across_next(Next, Uses, Blocks0), - Is = [Call1,Call2], - case use_ste_is(Is, decrement_uses(Result, Uses)) of - [#b_set{}=Call,#b_set{op=set_tuple_element}=Ste] -> - Blocks1 = use_ste_fix_next(Ste, Next, Blocks0), - Succ = Succ0#b_set{args=[Call#b_set.dst]}, - Blk = Blk0#b_blk{is=reverse(Prefix, [Call,Succ])}, - Blocks = Blocks1#{L:=Blk}, - {Blk,Blocks}; - _ -> - throw(not_possible) - end; - _ -> - throw(not_possible) - end. - -use_ste_across_next(Next, Uses, Blocks) -> - case map_get(Next, Blocks) of - #b_blk{is=[#b_set{op=call,dst=Result,args=[#b_remote{}|_]}=Call, - #b_set{op=succeeded,dst=Bool,args=[Result]}], - last=#b_br{bool=Bool}} -> - case is_single_use(Bool, Uses) andalso - is_n_uses(2, Result, Uses) of - true -> ok; - false -> throw(not_possible) - end, - Call; - #b_blk{} -> - throw(not_possible) - end. - -use_ste_fix_next(Ste, Next, Blocks) -> - Blk0 = map_get(Next, Blocks), - #b_blk{is=[#b_set{op=call},#b_set{op=succeeded}],last=Br0} = Blk0, - Br = beam_ssa:normalize(Br0#b_br{bool=#b_literal{val=true}}), - Blk = Blk0#b_blk{is=[Ste],last=Br}, - Blocks#{Next:=Blk}. - %% Count how many times each variable is used. count_uses(Blocks) -> @@ -1048,7 +1171,7 @@ count_uses_blk([#b_blk{is=Is,last=Last}|Bs], CountMap0) -> F = fun(I, CountMap) -> foldl(fun(Var, Acc) -> case Acc of - #{Var:=3} -> Acc; + #{Var:=2} -> Acc; #{Var:=C} -> Acc#{Var:=C+1}; #{} -> Acc#{Var=>1} end @@ -1058,16 +1181,6 @@ count_uses_blk([#b_blk{is=Is,last=Last}|Bs], CountMap0) -> count_uses_blk(Bs, CountMap); count_uses_blk([], CountMap) -> CountMap. -decrement_uses(V, Uses) -> - #{V:=C} = Uses, - Uses#{V:=C-1}. - -is_n_uses(N, V, Uses) -> - case Uses of - #{V:=N} -> true; - #{} -> false - end. - is_single_use(V, Uses) -> case Uses of #{V:=1} -> true; @@ -1189,10 +1302,10 @@ place_frame_here(L, Blocks, Doms, Frames) -> Descendants = beam_ssa:rpo([L], Blocks), PhiPredecessors = phi_predecessors(L, Blocks), MustDominate = ordsets:from_list(PhiPredecessors ++ Descendants), - Dominates = all(fun(?BADARG_BLOCK) -> + Dominates = all(fun(?EXCEPTION_BLOCK) -> %% This block defines no variables and calls %% erlang:error(badarg). It does not matter - %% whether L dominates ?BADARG_BLOCK or not; + %% whether L dominates ?EXCEPTION_BLOCK or not; %% it is still safe to put the frame in L. true; (Bl) -> @@ -1250,14 +1363,9 @@ need_frame_1([#b_set{op=call,args=[Func|_]}|Is], Context) -> #b_remote{mod=#b_literal{val=Mod}, name=#b_literal{val=Name}, arity=Arity} when is_atom(Mod), is_atom(Name) -> - case erl_bifs:is_exit_bif(Mod, Name, Arity) of - true -> - false; - false -> - Context =:= body orelse - Is =/= [] orelse - is_trap_bif(Mod, Name, Arity) - end; + Context =:= body orelse + Is =/= [] orelse + is_trap_bif(Mod, Name, Arity); #b_remote{} -> %% This is an apply(), which always needs a frame. true; @@ -1340,9 +1448,9 @@ recv_common(_Defs, none, _Blocks) -> %% in the tail position of a function. []; recv_common(Defs, Exit, Blocks) -> - {ExitDefs,ExitUsed} = beam_ssa:def_used([Exit], Blocks), + {ExitDefs,ExitUnused} = beam_ssa:def_unused([Exit], Defs, Blocks), Def = ordsets:subtract(Defs, ExitDefs), - ordsets:intersection(Def, ExitUsed). + ordsets:subtract(Def, ExitUnused). %% recv_crit_edges([RemoveMessageLabel], LoopExit, %% Blocks0, Count0) -> {Blocks,Count}. @@ -1447,9 +1555,9 @@ exit_predecessors([], _Exit, _Blocks) -> []. %% later used within a clause of the receive. fix_receive([L|Ls], Defs, Blocks0, Count0) -> - {RmDefs,Used0} = beam_ssa:def_used([L], Blocks0), + {RmDefs,Unused} = beam_ssa:def_unused([L], Defs, Blocks0), Def = ordsets:subtract(Defs, RmDefs), - Used = ordsets:intersection(Def, Used0), + Used = ordsets:subtract(Def, Unused), {NewVars,Count} = new_vars([Base || #b_var{name=Base} <- Used], Count0), Ren = zip(Used, NewVars), Blocks1 = beam_ssa:rename_vars(Ren, [L], Blocks0), @@ -1483,8 +1591,8 @@ find_loop_exit(_, _) -> %% loop exit block. none. -find_loop_exit_1([?BADARG_BLOCK|Ls], RmSet, Dominators, Blocks) -> - %% ?BADARG_BLOCK is a marker and not an actual block, so it is not +find_loop_exit_1([?EXCEPTION_BLOCK|Ls], RmSet, Dominators, Blocks) -> + %% ?EXCEPTION_BLOCK is a marker and not an actual block, so it is not %% the block we are looking for. find_loop_exit_1(Ls, RmSet, Dominators, Blocks); find_loop_exit_1([L|Ls0], RmSet, Dominators, Blocks) -> @@ -1767,7 +1875,7 @@ collect_yregs([], Yregs) -> Yregs. copy_retval_2([L|Ls], Yregs, Copy0, Blocks0, Count0) -> #b_blk{is=Is0,last=Last} = Blk = map_get(L, Blocks0), RC = case {Last,Ls} of - {#b_br{succ=Succ,fail=?BADARG_BLOCK},[Succ|_]} -> + {#b_br{succ=Succ,fail=?EXCEPTION_BLOCK},[Succ|_]} -> true; {_,_} -> false @@ -1984,11 +2092,9 @@ number_is_2([], N, Acc) -> live_intervals(#st{args=Args,ssa=Blocks}=St) -> Vars0 = [{V,{0,1}} || #b_var{}=V <- Args], - F = fun(L, _, A) -> live_interval_blk(L, Blocks, A) end, - LiveMap0 = #{}, - Acc0 = {[],LiveMap0}, - {Vars,_} = beam_ssa:fold_po(F, Acc0, Blocks), - Intervals = merge_ranges(rel2fam(Vars0++Vars)), + PO = reverse(beam_ssa:rpo(Blocks)), + Vars = live_interval_blk(PO, Blocks, Vars0, #{}), + Intervals = merge_ranges(rel2fam(Vars)), St#st{intervals=Intervals}. merge_ranges([{V,Rs}|T]) -> @@ -2001,32 +2107,51 @@ merge_ranges_1([R|Rs]) -> [R|merge_ranges_1(Rs)]; merge_ranges_1([]) -> []. -live_interval_blk(L, Blocks, {Vars0,LiveMap0}) -> +live_interval_blk([L|Ls], Blocks, Vars0, LiveMap0) -> Live0 = [], - Successors = beam_ssa:successors(L, Blocks), + Blk = map_get(L, Blocks), + Successors = beam_ssa:successors(Blk), Live1 = update_successors(Successors, L, Blocks, LiveMap0, Live0), %% Add ranges for all variables that are live in the successors. - #b_blk{is=Is,last=Last} = map_get(L, Blocks), + #b_blk{is=Is,last=Last} = Blk, End = beam_ssa:get_anno(n, Last), - Use = [{V,{use,End+1}} || V <- Live1], + EndUse = {use,End+1}, + Use = [{V,EndUse} || V <- Live1], %% Determine used and defined variables in this block. FirstNumber = first_number(Is, Last), - UseDef0 = live_interval_blk_1([Last|reverse(Is)], FirstNumber, Use), - UseDef = rel2fam(UseDef0), + UseDef0 = live_interval_last(Last, Use), + UseDef1 = live_interval_blk_is(Is, FirstNumber, UseDef0), + UseDef = rel2fam(UseDef1), %% Update what is live at the beginning of this block and %% store it. - Used = [V || {V,[{use,_}|_]} <- UseDef], - Live2 = ordsets:union(Live1, Used), - Killed = [V || {V,[{def,_}|_]} <- UseDef], - Live = ordsets:subtract(Live2, Killed), + Live = [V || {V,[{use,_}|_]} <- UseDef], LiveMap = LiveMap0#{L=>Live}, %% Construct the ranges for this block. Vars = make_block_ranges(UseDef, FirstNumber, Vars0), - {Vars,LiveMap}. + live_interval_blk(Ls, Blocks, Vars, LiveMap); +live_interval_blk([], _Blocks, Vars, _LiveMap) -> + Vars. + +live_interval_last(I, Acc) -> + N = beam_ssa:get_anno(n, I), + Used = beam_ssa:used(I), + [{V,{use,N}} || V <- Used] ++ Acc. + +live_interval_blk_is([#b_set{op=phi,dst=Dst}|Is], FirstNumber, Acc0) -> + Acc = [{Dst,{def,FirstNumber}}|Acc0], + live_interval_blk_is(Is, FirstNumber, Acc); +live_interval_blk_is([#b_set{dst=Dst}=I|Is], FirstNumber, Acc0) -> + N = beam_ssa:get_anno(n, I), + Acc1 = [{Dst,{def,N}}|Acc0], + Used = beam_ssa:used(I), + Acc = [{V,{use,N}} || V <- Used] ++ Acc1, + live_interval_blk_is(Is, FirstNumber, Acc); +live_interval_blk_is([], _FirstNumber, Acc) -> + Acc. make_block_ranges([{V,[{def,Def}]}|Vs], First, Acc) -> make_block_ranges(Vs, First, [{V,{Def,Def}}|Acc]); @@ -2038,30 +2163,6 @@ make_block_ranges([{V,[{use,_}|_]=Uses}|Vs], First, Acc) -> make_block_ranges(Vs, First, [{V,{First,Last}}|Acc]); make_block_ranges([], _, Acc) -> Acc. -live_interval_blk_1([#b_set{op=phi,dst=Dst}|Is], FirstNumber, Acc0) -> - Acc = [{Dst,{def,FirstNumber}}|Acc0], - live_interval_blk_1(Is, FirstNumber, Acc); -live_interval_blk_1([#b_set{op=bs_start_match}=I|Is], - FirstNumber, Acc0) -> - N = beam_ssa:get_anno(n, I), - #b_set{dst=Dst} = I, - Acc1 = [{Dst,{def,N}}|Acc0], - Acc = [{V,{use,N}} || V <- beam_ssa:used(I)] ++ Acc1, - live_interval_blk_1(Is, FirstNumber, Acc); -live_interval_blk_1([I|Is], FirstNumber, Acc0) -> - N = beam_ssa:get_anno(n, I), - Acc1 = case I of - #b_set{dst=Dst} -> - [{Dst,{def,N}}|Acc0]; - _ -> - Acc0 - end, - Used = beam_ssa:used(I), - Acc = [{V,{use,N}} || V <- Used] ++ Acc1, - live_interval_blk_1(Is, FirstNumber, Acc); -live_interval_blk_1([], _FirstNumber, Acc) -> - Acc. - %% first_number([#b_set{}]) -> InstructionNumber. %% Return the number for the first instruction for the block. %% Note that this number is one less than the first @@ -2116,8 +2217,8 @@ reserve_yregs(#st{frames=Frames}=St0) -> reserve_yregs_1(L, #st{ssa=Blocks0,cnt=Count0,res=Res0}=St) -> Blk = map_get(L, Blocks0), Yregs = beam_ssa:get_anno(yregs, Blk), - {Def,Used} = beam_ssa:def_used([L], Blocks0), - UsedYregs = ordsets:intersection(Yregs, Used), + {Def,Unused} = beam_ssa:def_unused([L], Yregs, Blocks0), + UsedYregs = ordsets:subtract(Yregs, Unused), DefBefore = ordsets:subtract(UsedYregs, Def), {BeforeVars,Blocks,Count} = rename_vars(DefBefore, L, Blocks0, Count0), InsideVars = ordsets:subtract(UsedYregs, DefBefore), @@ -2307,68 +2408,69 @@ reserve_zregs(Blocks, Intervals, Res) -> end, beam_ssa:fold_rpo(F, [0], Res, Blocks). -reserve_zreg([#b_set{op=Op,dst=Dst}], - #b_br{bool=Dst}, _ShortLived, A) when Op =:= call; - Op =:= get_tuple_element -> - %% If type optimization has determined that the result of these - %% instructions can be used directly in a branch, we must avoid reserving a - %% z register or code generation will fail. - A; reserve_zreg([#b_set{op={bif,tuple_size},dst=Dst}, - #b_set{op={bif,'=:='},args=[Dst,Val]}], Last, ShortLived, A0) -> + #b_set{op={bif,'=:='},args=[Dst,Val],dst=Bool}], + Last, ShortLived, A) -> case {Val,Last} of - {#b_literal{val=Arity},#b_br{bool=#b_var{}}} when Arity bsr 32 =:= 0 -> + {#b_literal{val=Arity},#b_br{bool=Bool}} when Arity bsr 32 =:= 0 -> %% These two instructions can be combined to a test_arity %% instruction provided that the arity variable is short-lived. - reserve_zreg_1(Dst, ShortLived, A0); + reserve_test_zreg(Dst, ShortLived, A); {_,_} -> %% Either the arity is too big, or the boolean value is not %% used in a conditional branch. - A0 + A end; reserve_zreg([#b_set{op={bif,tuple_size},dst=Dst}], - #b_switch{}, ShortLived, A) -> - reserve_zreg_1(Dst, ShortLived, A); -reserve_zreg([#b_set{op={bif,'xor'}}], _Last, _ShortLived, A) -> - %% There is no short, easy way to rewrite 'xor' to a series of - %% test instructions. - A; -reserve_zreg([#b_set{op={bif,is_record}}], _Last, _ShortLived, A) -> - %% There is no short, easy way to rewrite is_record/2 to a series of - %% test instructions. - A; -reserve_zreg([#b_set{op=Op,dst=Dst}|Is], Last, ShortLived, A0) -> - IsZReg = case Op of - bs_match_string -> true; - bs_save -> true; - bs_restore -> true; - bs_set_position -> true; - {float,clearerror} -> true; - kill_try_tag -> true; - landingpad -> true; - put_tuple_elements -> true; - remove_message -> true; - set_tuple_element -> true; - succeeded -> true; - timeout -> true; - wait_timeout -> true; - _ -> false - end, - A = case IsZReg of - true -> [{Dst,z}|A0]; - false -> A0 - end, - reserve_zreg(Is, Last, ShortLived, A); -reserve_zreg([], #b_br{bool=Bool}, ShortLived, A) -> - reserve_zreg_1(Bool, ShortLived, A); + #b_switch{arg=Dst}, ShortLived, A) -> + reserve_test_zreg(Dst, ShortLived, A); +reserve_zreg([#b_set{op=Op,dst=Dst}], #b_br{bool=Dst}, ShortLived, A) -> + case use_zreg(Op) of + yes -> [{Dst,z} | A]; + no -> A; + maybe -> reserve_test_zreg(Dst, ShortLived, A) + end; +reserve_zreg([#b_set{op=Op,dst=Dst} | Is], Last, ShortLived, A) -> + case use_zreg(Op) of + yes -> reserve_zreg(Is, Last, ShortLived, [{Dst,z} | A]); + _Other -> reserve_zreg(Is, Last, ShortLived, A) + end; reserve_zreg([], _, _, A) -> A. -reserve_zreg_1(#b_var{}=V, ShortLived, A) -> +use_zreg(bs_match_string) -> yes; +use_zreg(bs_save) -> yes; +use_zreg(bs_restore) -> yes; +use_zreg(bs_set_position) -> yes; +use_zreg({float,clearerror}) -> yes; +use_zreg(kill_try_tag) -> yes; +use_zreg(landingpad) -> yes; +use_zreg(put_tuple_elements) -> yes; +use_zreg(remove_message) -> yes; +use_zreg(set_tuple_element) -> yes; +use_zreg(succeeded) -> yes; +use_zreg(timeout) -> yes; +use_zreg(wait_timeout) -> yes; +%% There's no way we can combine these into a test instruction, so we must +%% avoid using a z register if their result is used directly in a branch. +use_zreg(call) -> no; +use_zreg({bif,is_map_key}) -> no; +use_zreg({bif,is_record}) -> no; +use_zreg({bif,map_get}) -> no; +use_zreg({bif,'xor'}) -> no; +use_zreg(get_hd) -> no; +use_zreg(get_tl) -> no; +use_zreg(get_tuple_element) -> no; +%% Assume the instruction can use a z register, provided it's the last in its +%% block and that the result is only used in the terminator. +use_zreg(_) -> maybe. + +%% If V is defined just before a branch, we may be able to combine it into a +%% test instruction. +reserve_test_zreg(#b_var{}=V, ShortLived, A) -> case cerl_sets:is_element(V, ShortLived) of true -> [{V,z}|A]; false -> A - end; -reserve_zreg_1(#b_literal{}, _, A) -> A. + end. reserve_fregs(Blocks, Res) -> F = fun(_, #b_blk{is=Is}, A) -> @@ -2506,9 +2608,9 @@ reserve_xregs_is([], Res, Xs, _Used) -> {Res,Xs}. %% Pick up register hints from the successors of this blocks. -reserve_terminator(_L, _Is, #b_br{bool=#b_var{},succ=Succ,fail=?BADARG_BLOCK}, +reserve_terminator(_L, _Is, #b_br{bool=#b_var{},succ=Succ,fail=?EXCEPTION_BLOCK}, _Blocks, XsMap, _Res) -> - %% We know that no variables are used at ?BADARG_BLOCK, so + %% We know that no variables are used at ?EXCEPTION_BLOCK, so %% any register hints from the success blocks are safe to use. map_get(Succ, XsMap); reserve_terminator(L, Is, #b_br{bool=#b_var{},succ=Succ,fail=Fail}, @@ -2915,11 +3017,9 @@ are_overlapping_1({_,_}, []) -> false. %% Check whether the block is a loop header. is_loop_header(L, Blocks) -> - %% We KNOW that a loop header must start with a peek_message - %% instruction. case map_get(L, Blocks) of - #b_blk{is=[#b_set{op=peek_message}|_]} -> true; - _ -> false + #b_blk{is=[I|_]} -> beam_ssa:is_loop_header(I); + #b_blk{} -> false end. rel2fam(S0) -> diff --git a/lib/compiler/src/beam_ssa_recv.erl b/lib/compiler/src/beam_ssa_recv.erl index 767242d1e5..20fcd3e9a6 100644 --- a/lib/compiler/src/beam_ssa_recv.erl +++ b/lib/compiler/src/beam_ssa_recv.erl @@ -165,19 +165,21 @@ recv_opt_makes_ref([I|Is], RecvLbl, Blocks, Acc) -> recv_opt_makes_ref([], _, _, _) -> no. makes_ref(#b_set{dst=Dst,args=[Func0|_]}, Blocks) -> - Func = case Func0 of - #b_remote{mod=#b_literal{val=erlang}, - name=#b_literal{val=Name},arity=A0} -> - {Name,A0}; + MFA = case Func0 of + #b_remote{mod=#b_literal{val=Mod}, + name=#b_literal{val=Func},arity=A0} -> + {Mod,Func,A0}; _ -> none end, - case Func of - {make_ref,0} -> + case MFA of + {erlang,make_ref,0} -> {yes,Dst}; - {monitor,2} -> + {erlang,monitor,2} -> {yes,Dst}; - {spawn_monitor,A} when A =:= 1; A =:= 3 -> + {erlang,spawn_request,A} when 1 =< A, A =< 5 -> + {yes,Dst}; + {erlang,spawn_monitor,A} when 1 =< A, A =< 4 -> ref_in_tuple(Dst, Blocks); _ -> no diff --git a/lib/compiler/src/beam_ssa_share.erl b/lib/compiler/src/beam_ssa_share.erl index 73983bd34a..98cf0d9247 100644 --- a/lib/compiler/src/beam_ssa_share.erl +++ b/lib/compiler/src/beam_ssa_share.erl @@ -117,8 +117,8 @@ share_terminator(_Last, _Blocks) -> none. %% possible if the blocks are not equivalent, as that is the common %% case. -are_equivalent(_Succ, _, ?BADARG_BLOCK, _, _Blocks) -> - %% ?BADARG_BLOCK is special. Sharing could be incorrect. +are_equivalent(_Succ, _, ?EXCEPTION_BLOCK, _, _Blocks) -> + %% ?EXCEPTION_BLOCK is special. Sharing could be incorrect. false; are_equivalent(_Succ, #b_blk{is=Is1,last=#b_ret{arg=RetVal1}=Ret1}, _Fail, #b_blk{is=Is2,last=#b_ret{arg=RetVal2}=Ret2}, _Blocks) -> @@ -331,11 +331,16 @@ canonical_terminator(_, _, _) -> none. canonical_terminator_phis([#b_set{op=phi,args=PhiArgs}=Phi|Is], L) -> {Value,L} = keyfind(L, 2, PhiArgs), [Phi#b_set{op=copy,args=[Value]}|canonical_terminator_phis(Is, L)]; -canonical_terminator_phis([#b_set{op=peek_message}=I|_], L) -> - %% We could get stuck into an infinite loop if we allowed the - %% comparisons to continue into this block. Force an unequal - %% compare with all other predecessors of this block. - [I#b_set{op=copy,args=[#b_literal{val=L}]}]; +canonical_terminator_phis([#b_set{}=I|_], L) -> + case beam_ssa:is_loop_header(I) of + true -> + %% We could get stuck into an infinite loop if we allowed the + %% comparisons to continue into this loop. Force an unequal + %% compare with all other predecessors of this block. + [I#b_set{op=copy,args=[#b_literal{val=L}]}]; + false -> + [] + end; canonical_terminator_phis(_, _) -> []. canonical_arg(#b_var{}=Var, VarMap) -> @@ -368,7 +373,9 @@ shortcut_nonempty_block(L, Blocks) -> is_forbidden(L, Blocks) -> case map_get(L, Blocks) of - #b_blk{is=[#b_set{op=phi}|_]} -> true; - #b_blk{is=[#b_set{op=peek_message}|_]} -> true; + #b_blk{is=[#b_set{op=phi}|_]} -> + true; + #b_blk{is=[#b_set{}=I|_]} -> + beam_ssa:is_loop_header(I); #b_blk{} -> false end. diff --git a/lib/compiler/src/beam_ssa_type.erl b/lib/compiler/src/beam_ssa_type.erl index 3c06c83e2e..e0baadccb2 100644 --- a/lib/compiler/src/beam_ssa_type.erl +++ b/lib/compiler/src/beam_ssa_type.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2018. All Rights Reserved. +%% Copyright Ericsson AB 2018-2019. 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. @@ -17,126 +17,553 @@ %% %% %CopyrightEnd% %% +%% This pass infers types from expressions and attempts to simplify or remove +%% subsequent instructions based on that information. +%% +%% This is divided into two subpasses; the first figures out function type +%% signatures for the whole module without optimizing anything, and the second +%% optimizes based on that information, further refining the type signatures as +%% it goes. +%% -module(beam_ssa_type). --export([opt_start/4, opt_continue/4, opt_finish/3]). +-export([opt_start/2, opt_continue/4, opt_finish/3]). -include("beam_ssa_opt.hrl"). --import(lists, [all/2,any/2,droplast/1,foldl/3,last/1,member/2, - keyfind/3,reverse/1,reverse/2, - sort/1,split/2]). - --define(UNICODE_INT, #t_integer{elements={0,16#10FFFF}}). - --record(d, - {ds :: #{beam_ssa:b_var():=beam_ssa:b_set()}, - ls :: #{beam_ssa:label():=type_db()}, - once :: cerl_sets:set(beam_ssa:b_var()), - func_id :: func_id(), - func_db :: func_info_db(), - sub = #{} :: #{beam_ssa:b_var():=beam_ssa:value()}, - ret_type = [] :: [type()]}). - --define(ATOM_SET_SIZE, 5). - -%% Records that represent type information. --record(t_atom, {elements=any :: 'any' | [atom()]}). --record(t_integer, {elements=any :: 'any' | {integer(),integer()}}). --record(t_bs_match, {type :: type()}). --record(t_tuple, {size=0 :: integer(), - exact=false :: boolean(), - %% Known element types (1-based index), unknown elements are - %% are assumed to be 'any'. - elements=#{} :: #{ non_neg_integer() => type() }}). - --type type() :: 'any' | 'none' | - #t_atom{} | #t_integer{} | #t_bs_match{} | #t_tuple{} | - {'binary',pos_integer()} | 'cons' | 'float' | 'list' | 'map' | 'nil' | 'number'. --type type_db() :: #{beam_ssa:var_name():=type()}. - --spec opt_start(Linear, Args, Anno, FuncDb) -> {Linear, FuncDb} when - Linear :: [{non_neg_integer(), beam_ssa:b_blk()}], - Args :: [beam_ssa:b_var()], - Anno :: beam_ssa:anno(), - FuncDb :: func_info_db(). -opt_start(Linear, Args, Anno, FuncDb) -> - %% This is the first run through the module, so our arg_types can be - %% incomplete as we may not have visited all call sites at least once. - Ts = maps:from_list([{V,any} || #b_var{}=V <- Args]), - opt_continue_1(Linear, Args, get_func_id(Anno), Ts, FuncDb). +-include("beam_types.hrl"). + +-import(lists, [all/2,any/2,duplicate/2,foldl/3,member/2, + keyfind/3,reverse/1,split/2,zip/2]). + +%% The maximum number of #b_ret{} terminators a function can have before +%% collapsing success types into a single entry. Consider the following code: +%% +%% f(0) -> 1; +%% f(...) -> ...; +%% f(500000) -> 500000. +%% +%% Since success types are grouped by return type and each clause returns a +%% distinct type (singleton #t_integer{}s), we'll add 500000 entries which +%% makes progress glacial since every call needs to examine them all to +%% determine the return type. +%% +%% The entries are collapsed unconditionally if the number of returns in a +%% function exceeds this threshold. This is necessary because collapsing as we +%% go might widen a type; if we're at (?RETURN_LIMIT - 1) entries and suddenly +%% narrow a type down, it could push us over the edge and collapse all entries, +%% possibly widening the return type and breaking optimizations that were based +%% on the earlier (narrower) types. +-define(RETURN_LIMIT, 100). + +%% Constants common to all subpasses. +-record(metadata, + { func_id :: func_id(), + limit_return :: boolean(), + params :: [beam_ssa:b_var()], + used_once :: cerl_sets:set(beam_ssa:b_var()) }). + +-type type_db() :: #{ beam_ssa:var_name() := type() }. + +%% + +-spec opt_start(term(), term()) -> term(). +opt_start(StMap, FuncDb0) when FuncDb0 =/= #{} -> + {ArgDb, FuncDb} = signatures(StMap, FuncDb0), + + opt_start_1(maps:keys(StMap), ArgDb, StMap, FuncDb); +opt_start(StMap, FuncDb) -> + %% Module-level analysis is disabled, likely because of a call to + %% load_nif/2 or similar. opt_continue/4 will assume that all arguments and + %% return types are 'any'. + {StMap, FuncDb}. + +opt_start_1([Id | Ids], ArgDb, StMap0, FuncDb0) -> + case ArgDb of + #{ Id := ArgTypes } -> + #opt_st{ssa=Linear0,args=Args} = St0 = map_get(Id, StMap0), + + Ts = maps:from_list(zip(Args, ArgTypes)), + {Linear, FuncDb} = opt_function(Linear0, Args, Id, Ts, FuncDb0), + + St = St0#opt_st{ssa=Linear}, + StMap = StMap0#{ Id := St }, + + opt_start_1(Ids, ArgDb, StMap, FuncDb); + #{} -> + %% Unreachable functions must be removed so that opt_continue/4 + %% won't process them and potentially taint the argument types of + %% other functions. + StMap = maps:remove(Id, StMap0), + FuncDb = maps:remove(Id, FuncDb0), + + opt_start_1(Ids, ArgDb, StMap, FuncDb) + end; +opt_start_1([], _CommittedArgs, StMap, FuncDb) -> + {StMap, FuncDb}. + +%% +%% The initial signature analysis is based on the paper "Practical Type +%% Inference Based on Success Typings" [1] by `Tobias Lindahl` and +%% `Konstantinos Sagonas`, mainly section 6.1 and onwards. +%% +%% The general idea is to start out at the module's entry points and propagate +%% types to the functions we call. The argument types of all exported functions +%% start out a 'any', whereas local functions start at 'none'. Every time a +%% function call widens the argument types, we analyze the callee again and +%% propagate its return types to the callers, analyzing them again, and +%% continuing this process until all arguments and return types have been +%% widened as far as they can be. +%% +%% Note that we do not "jump-start the analysis" by first determining success +%% types as in the paper because we need to know all possible inputs including +%% those that will not return. +%% +%% [1] http://www.it.uu.se/research/group/hipe/papers/succ_types.pdf +%% + +-record(sig_st, + { wl = wl_new() :: worklist(), + committed = #{} :: #{ func_id() => [type()] }, + updates = #{} :: #{ func_id() => [type()] }}). + +signatures(StMap, FuncDb0) -> + State0 = init_sig_st(StMap, FuncDb0), + {State, FuncDb} = signatures_1(StMap, FuncDb0, State0), + {State#sig_st.committed, FuncDb}. + +signatures_1(StMap, FuncDb0, State0) -> + case wl_next(State0#sig_st.wl) of + {ok, FuncId} -> + {State, FuncDb} = sig_function(FuncId, StMap, State0, FuncDb0), + signatures_1(StMap, FuncDb, State); + empty -> + %% No more work to do, assert that we don't have any outstanding + %% updates. + #sig_st{updates=Same,committed=Same} = State0, %Assertion. + + {State0, FuncDb0} + end. + +sig_function(Id, StMap, State0, FuncDb0) -> + case sig_function_1(Id, StMap, State0, FuncDb0) of + {false, false, State, FuncDb} -> + %% No added work and the types are identical. Pop ourselves from + %% the work list and move on to the next function. + Wl = wl_pop(Id, State#sig_st.wl), + {State#sig_st{wl=Wl}, FuncDb}; + {false, true, State, FuncDb} -> + %% We've added some work and our return type is unchanged. Keep + %% following the work list without popping ourselves; we're very + %% likely to need to return here later and can avoid a lot of + %% redundant work by keeping our place in line. + {State, FuncDb}; + {true, WlChanged, State, FuncDb} -> + %% Our return type has changed so all of our (previously analyzed) + %% callers need to be analyzed again. + %% + %% If our worklist is unchanged we'll pop ourselves since our + %% callers will add us back if we need to analyzed again, and + %% it's wasteful to stay in the worklist when we don't. + Wl0 = case WlChanged of + true -> State#sig_st.wl; + false -> wl_pop(Id, State#sig_st.wl) + end, + + #func_info{in=Cs0} = map_get(Id, FuncDb0), + Callers = [C || C <- Cs0, is_map_key(C, State#sig_st.updates)], + Wl = wl_defer_list(Callers, Wl0), + + {State#sig_st{wl=Wl}, FuncDb} + end. + +sig_function_1(Id, StMap, State0, FuncDb) -> + #opt_st{ssa=Linear,args=Args} = map_get(Id, StMap), + + {ArgTypes, State1} = sig_commit_args(Id, State0), + Ts = maps:from_list(zip(Args, ArgTypes)), + + FakeCall = #b_set{op=call,args=[#b_remote{mod=#b_literal{val=unknown}, + name=#b_literal{val=unknown}, + arity=0}]}, + + Ds = maps:from_list([{Var, FakeCall#b_set{dst=Var}} || + #b_var{}=Var <- Args]), + + Ls = #{ ?EXCEPTION_BLOCK => Ts, + 0 => Ts }, + + Meta = init_metadata(Id, Linear, Args), + + Wl0 = State1#sig_st.wl, + + {State, SuccTypes} = sig_bs(Linear, Ds, Ls, FuncDb, #{}, [], Meta, State1), + + WlChanged = wl_changed(Wl0, State#sig_st.wl), + #{ Id := #func_info{succ_types=SuccTypes0}=Entry0 } = FuncDb, + + if + SuccTypes0 =:= SuccTypes -> + {false, WlChanged, State, FuncDb}; + SuccTypes0 =/= SuccTypes -> + Entry = Entry0#func_info{succ_types=SuccTypes}, + {true, WlChanged, State, FuncDb#{ Id := Entry }} + end. + +sig_bs([{L, #b_blk{is=Is,last=Last0}} | Bs], + Ds0, Ls0, Fdb, Sub0, SuccTypes0, Meta, State0) when is_map_key(L, Ls0) -> + + #{ L := Ts0 } = Ls0, + + {Ts, Ds, Sub, State} = sig_is(Is, Ts0, Ds0, Ls0, Fdb, Sub0, State0), + + Last = simplify_terminator(Last0, Ts, Ds, Sub), + SuccTypes = update_success_types(Last, Ts, Ds, Meta, SuccTypes0), + {_, Ls} = update_successors(Last, Ts, Ds, Ls0, Meta#metadata.used_once), + + sig_bs(Bs, Ds, Ls, Fdb, Sub, SuccTypes, Meta, State); +sig_bs([_Blk | Bs], Ds, Ls, Fdb, Sub, SuccTypes, Meta, State) -> + %% This block is never reached. Ignore it. + sig_bs(Bs, Ds, Ls, Fdb, Sub, SuccTypes, Meta, State); +sig_bs([], _Ds, _Ls, _Fdb, _Sub, SuccTypes, _Meta, State) -> + {State, SuccTypes}. + +sig_is([#b_set{op=call, + args=[#b_local{}=Callee | _]=Args0, + dst=Dst}=I0 | Is], + Ts0, Ds0, Ls, Fdb, Sub, State0) -> + Args = simplify_args(Args0, Ts0, Sub), + I1 = beam_ssa:normalize(I0#b_set{args=Args}), + + [_ | CallArgs] = Args, + {I, State} = sig_local_call(I1, Callee, CallArgs, Ts0, Fdb, State0), + + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{ Dst => I }, + sig_is(Is, Ts, Ds, Ls, Fdb, Sub, State); +sig_is([#b_set{op=call, + args=[#b_var{} | _]=Args0, + dst=Dst}=I0 | Is], + Ts0, Ds0, Ls, Fdb, Sub, State) -> + Args = simplify_args(Args0, Ts0, Sub), + I1 = beam_ssa:normalize(I0#b_set{args=Args}), + + [Fun | _] = Args, + I = case normalized_type(Fun, Ts0) of + #t_fun{type=Type} -> beam_ssa:add_anno(result_type, Type, I1); + _ -> I1 + end, + + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{ Dst => I }, + sig_is(Is, Ts, Ds, Ls, Fdb, Sub, State); +sig_is([#b_set{op=make_fun,args=Args0,dst=Dst}=I0|Is], + Ts0, Ds0, Ls, Fdb, Sub0, State0) -> + Args = simplify_args(Args0, Ts0, Sub0), + I1 = beam_ssa:normalize(I0#b_set{args=Args}), + + {I, State} = sig_make_fun(I1, Ts0, Fdb, State0), + + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{ Dst => I }, + sig_is(Is, Ts, Ds, Ls, Fdb, Sub0, State); +sig_is([I0 | Is], Ts0, Ds0, Ls, Fdb, Sub0, State) -> + case simplify(I0, Ts0, Ds0, Ls, Sub0) of + {#b_set{}, Ts, Ds} -> + sig_is(Is, Ts, Ds, Ls, Fdb, Sub0, State); + Sub when is_map(Sub) -> + sig_is(Is, Ts0, Ds0, Ls, Fdb, Sub, State) + end; +sig_is([], Ts, Ds, _Ls, _Fdb, Sub, State) -> + {Ts, Ds, Sub, State}. + +sig_local_call(I0, Callee, Args, Ts, Fdb, State) -> + ArgTypes = argument_types(Args, Ts), + I = sig_local_return(I0, Callee, ArgTypes, Fdb), + {I, sig_update_args(Callee, ArgTypes, State)}. + +%% While it's impossible to tell which arguments a fun will be called with +%% (someone could steal it through tracing and call it), we do know its free +%% variables and can update their types as if this were a local call. +sig_make_fun(#b_set{op=make_fun, + args=[#b_local{}=Callee | FreeVars]}=I0, + Ts, Fdb, State) -> + ArgCount = Callee#b_local.arity - length(FreeVars), + + FVTypes = [raw_type(FreeVar, Ts) || FreeVar <- FreeVars], + ArgTypes = duplicate(ArgCount, any) ++ FVTypes, + + I = sig_local_return(I0, Callee, ArgTypes, Fdb), + {I, sig_update_args(Callee, ArgTypes, State)}. + +sig_local_return(I, Callee, ArgTypes, Fdb) -> + #func_info{succ_types=SuccTypes} = map_get(Callee, Fdb), + case return_type(SuccTypes, ArgTypes) of + any -> I; + Type -> beam_ssa:add_anno(result_type, Type, I) + end. + +init_sig_st(StMap, FuncDb) -> + %% Start out as if all the roots have been called with 'any' for all + %% arguments. + Roots = init_sig_roots(FuncDb), + #sig_st{ committed=#{}, + updates=init_sig_args(Roots, StMap, #{}), + wl=wl_defer_list(Roots, wl_new()) }. + +init_sig_roots(FuncDb) -> + maps:fold(fun(Id, #func_info{exported=true}, Acc) -> + [Id | Acc]; + (_, _, Acc) -> + Acc + end, [], FuncDb). + +init_sig_args([Root | Roots], StMap, Acc) -> + #opt_st{args=Args0} = map_get(Root, StMap), + ArgTypes = lists:duplicate(length(Args0), any), + init_sig_args(Roots, StMap, Acc#{ Root => ArgTypes }); +init_sig_args([], _StMap, Acc) -> + Acc. + +sig_commit_args(Id, #sig_st{updates=Us,committed=Committed0}=State0) -> + Types = map_get(Id, Us), + Committed = Committed0#{ Id => Types }, + State = State0#sig_st{committed=Committed}, + {Types, State}. + +sig_update_args(Callee, Types, #sig_st{committed=Committed}=State) -> + case Committed of + #{ Callee := Current } -> + case parallel_join(Current, Types) of + Current -> + %% We've already processed this function with these + %% arguments, so there's no need to visit it again. + State; + Widened -> + sig_update_args_1(Callee, Widened, State) + end; + #{} -> + sig_update_args_1(Callee, Types, State) + end. + +sig_update_args_1(Callee, Types, #sig_st{updates=Us0,wl=Wl0}=State) -> + Us = case Us0 of + #{ Callee := Current } -> + Us0#{ Callee => parallel_join(Current, Types) }; + #{} -> + Us0#{ Callee => Types } + end, + State#sig_st{updates=Us,wl=wl_add(Callee, Wl0)}. -spec opt_continue(Linear, Args, Anno, FuncDb) -> {Linear, FuncDb} when Linear :: [{non_neg_integer(), beam_ssa:b_blk()}], Args :: [beam_ssa:b_var()], Anno :: beam_ssa:anno(), FuncDb :: func_info_db(). -opt_continue(Linear, Args, Anno, FuncDb) -> +opt_continue(Linear0, Args, Anno, FuncDb) when FuncDb =/= #{} -> Id = get_func_id(Anno), case FuncDb of #{ Id := #func_info{exported=false,arg_types=ArgTypes} } -> %% This is a local function and we're guaranteed to have visited %% every call site at least once, so we know that the parameter %% types are at least as narrow as the join of all argument types. - Ts = join_arg_types(Args, ArgTypes, Anno), - opt_continue_1(Linear, Args, Id, Ts, FuncDb); - #{} -> - %% We can't infer the parameter types of exported functions, nor - %% the ones where module-level optimization is disabled, but + Ts = join_arg_types(Args, ArgTypes, #{}), + opt_function(Linear0, Args, Id, Ts, FuncDb); + #{ Id := #func_info{exported=true} } -> + %% We can't infer the parameter types of exported functions, but %% running the pass again could still help other functions. Ts = maps:from_list([{V,any} || #b_var{}=V <- Args]), - opt_continue_1(Linear, Args, Id, Ts, FuncDb) - end. + opt_function(Linear0, Args, Id, Ts, FuncDb) + end; +opt_continue(Linear0, Args, Anno, _FuncDb) -> + %% Module-level optimization is disabled, pass an empty function database + %% so we only perform local optimizations. + Id = get_func_id(Anno), + Ts = maps:from_list([{V,any} || #b_var{}=V <- Args]), + {Linear, _} = opt_function(Linear0, Args, Id, Ts, #{}), + {Linear, #{}}. -join_arg_types(Args, ArgTypes, Anno) -> - %% We suppress type optimization for parameters that have already been - %% optimized by another pass, as they may have done things we have no idea - %% how to interpret and running them over could generate incorrect code. - ParamTypes = maps:get(parameter_type_info, Anno, #{}), - Ts0 = join_arg_types_1(Args, ArgTypes, #{}), - maps:fold(fun(Arg, _V, Ts) -> - maps:put(Arg, any, Ts) - end, Ts0, ParamTypes). - -join_arg_types_1([Arg | Args], [TM | TMs], Ts) when map_size(TM) =/= 0 -> - join_arg_types_1(Args, TMs, Ts#{ Arg => join(maps:values(TM))}); -join_arg_types_1([Arg | Args], [_TM | TMs], Ts) -> - join_arg_types_1(Args, TMs, Ts#{ Arg => any }); -join_arg_types_1([], [], Ts) -> +join_arg_types([Arg | Args], [TypeMap | TMs], Ts) -> + Type = beam_types:join(maps:values(TypeMap)), + join_arg_types(Args, TMs, Ts#{ Arg => Type }); +join_arg_types([], [], Ts) -> Ts. --spec opt_continue_1(Linear, Args, Id, Ts, FuncDb) -> Result when +%% +%% Optimizes a function based on the type information inferred by signatures/2 +%% and earlier runs of opt_function/5. +%% +%% This is pretty straightforward as it only walks through each function once, +%% and because it only makes types narrower it's safe to optimize the functions +%% in any order or not at all. +%% + +-spec opt_function(Linear, Args, Id, Ts, FuncDb) -> Result when Linear :: [{non_neg_integer(), beam_ssa:b_blk()}], Args :: [beam_ssa:b_var()], Id :: func_id(), Ts :: type_db(), FuncDb :: func_info_db(), Result :: {Linear, FuncDb}. -opt_continue_1(Linear0, Args, Id, Ts, FuncDb0) -> - UsedOnce = used_once(Linear0, Args), +opt_function(Linear0, Args, Id, Ts, FuncDb0) -> FakeCall = #b_set{op=call,args=[#b_remote{mod=#b_literal{val=unknown}, name=#b_literal{val=unknown}, arity=0}]}, - Defs = maps:from_list([{Var,FakeCall#b_set{dst=Var}} || - #b_var{}=Var <- Args]), - D = #d{ func_db=FuncDb0, - func_id=Id, - ds=Defs, - ls=#{0=>Ts,?BADARG_BLOCK=>#{}}, - once=UsedOnce }, + Ds = maps:from_list([{Var, FakeCall#b_set{dst=Var}} || + #b_var{}=Var <- Args]), + + Ls = #{ ?EXCEPTION_BLOCK => Ts, + 0 => Ts }, + + Meta = init_metadata(Id, Linear0, Args), - {Linear, FuncDb, NewRet} = opt(Linear0, D, []), + {Linear, FuncDb, SuccTypes} = + opt_bs(Linear0, Ds, Ls, FuncDb0, #{}, [], Meta, []), case FuncDb of #{ Id := Entry0 } -> - Entry = Entry0#func_info{ret_type=NewRet}, + Entry = Entry0#func_info{succ_types=SuccTypes}, {Linear, FuncDb#{ Id := Entry }}; #{} -> - %% Module-level optimizations have been turned off for this - %% function. + %% Module-level optimizations have been turned off. {Linear, FuncDb} end. +get_func_id(Anno) -> + #{func_info:={_Mod, Name, Arity}} = Anno, + #b_local{name=#b_literal{val=Name}, arity=Arity}. + +opt_bs([{L, #b_blk{is=Is0,last=Last0}=Blk0} | Bs], + Ds0, Ls0, Fdb0, Sub0, SuccTypes0, Meta, Acc) when is_map_key(L, Ls0) -> + + #{ L := Ts0 } = Ls0, + {Is, Ts, Ds, Fdb, Sub} = opt_is(Is0, Ts0, Ds0, Ls0, Fdb0, Sub0, Meta, []), + + Last1 = simplify_terminator(Last0, Ts, Ds, Sub), + + SuccTypes = update_success_types(Last1, Ts, Ds, Meta, SuccTypes0), + {Last, Ls} = update_successors(Last1, Ts, Ds, Ls0, Meta#metadata.used_once), + + Blk = Blk0#b_blk{is=Is,last=Last}, + opt_bs(Bs, Ds, Ls, Fdb, Sub, SuccTypes, Meta, [{L,Blk} | Acc]); +opt_bs([_Blk | Bs], Ds, Ls, Fdb, Sub, SuccTypes, Meta, Acc) -> + %% This block is never reached. Discard it. + opt_bs(Bs, Ds, Ls, Fdb, Sub, SuccTypes, Meta, Acc); +opt_bs([], _Ds, _Ls, Fdb, _Sub, SuccTypes, _Meta, Acc) -> + {reverse(Acc), Fdb, SuccTypes}. + +opt_is([#b_set{op=call, + args=[#b_local{}=Callee | _]=Args0, + dst=Dst}=I0 | Is], + Ts0, Ds0, Ls, Fdb0, Sub, Meta, Acc) -> + Args = simplify_args(Args0, Ts0, Sub), + I1 = beam_ssa:normalize(I0#b_set{args=Args}), + + [_ | CallArgs] = Args, + {I, Fdb} = opt_local_call(I1, Callee, CallArgs, Dst, Ts0, Fdb0, Meta), + + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{ Dst => I }, + opt_is(Is, Ts, Ds, Ls, Fdb, Sub, Meta, [I | Acc]); +opt_is([#b_set{op=call, + args=[#b_var{} | _]=Args0, + dst=Dst}=I0 | Is], + Ts0, Ds0, Ls, Fdb, Sub, Meta, Acc) -> + Args = simplify_args(Args0, Ts0, Sub), + I1 = beam_ssa:normalize(I0#b_set{args=Args}), + + [Fun | _] = Args, + I = case normalized_type(Fun, Ts0) of + #t_fun{type=Type} -> beam_ssa:add_anno(result_type, Type, I1); + _ -> I1 + end, + + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{ Dst => I }, + opt_is(Is, Ts, Ds, Ls, Fdb, Sub, Meta, [I | Acc]); +opt_is([#b_set{op=make_fun,args=Args0,dst=Dst}=I0|Is], + Ts0, Ds0, Ls, Fdb0, Sub0, Meta, Acc) -> + Args = simplify_args(Args0, Ts0, Sub0), + I1 = beam_ssa:normalize(I0#b_set{args=Args}), + + {I, Fdb} = opt_make_fun(I1, Ts0, Fdb0, Meta), + + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{ Dst => I }, + opt_is(Is, Ts, Ds, Ls, Fdb, Sub0, Meta, [I|Acc]); +opt_is([I0 | Is], Ts0, Ds0, Ls, Fdb, Sub0, Meta, Acc) -> + case simplify(I0, Ts0, Ds0, Ls, Sub0) of + {#b_set{}=I, Ts, Ds} -> + opt_is(Is, Ts, Ds, Ls, Fdb, Sub0, Meta, [I | Acc]); + Sub when is_map(Sub) -> + opt_is(Is, Ts0, Ds0, Ls, Fdb, Sub, Meta, Acc) + end; +opt_is([], Ts, Ds, _Ls, Fdb, Sub, _Meta, Acc) -> + {reverse(Acc), Ts, Ds, Fdb, Sub}. + +opt_local_call(I0, Callee, Args, Dst, Ts, Fdb, Meta) -> + ArgTypes = argument_types(Args, Ts), + I = opt_local_return(I0, Callee, ArgTypes, Fdb), + case Fdb of + #{ Callee := #func_info{exported=false,arg_types=AT0}=Info0 } -> + %% Update the argument types of *this exact call*, the types + %% will be joined later when the callee is optimized. + CallId = {Meta#metadata.func_id, Dst}, + + AT = update_arg_types(ArgTypes, AT0, CallId), + Info = Info0#func_info{arg_types=AT}, + + {I, Fdb#{ Callee := Info }}; + #{} -> + %% We can't narrow the argument types of exported functions as they + %% can receive anything as part of an external call. We can still + %% rely on their return types however. + {I, Fdb} + end. + +%% See sig_make_fun/4 +opt_make_fun(#b_set{op=make_fun, + dst=Dst, + args=[#b_local{}=Callee | FreeVars]}=I0, + Ts, Fdb, Meta) -> + ArgCount = Callee#b_local.arity - length(FreeVars), + FVTypes = [raw_type(FreeVar, Ts) || FreeVar <- FreeVars], + ArgTypes = duplicate(ArgCount, any) ++ FVTypes, + + I = opt_local_return(I0, Callee, ArgTypes, Fdb), + + case Fdb of + #{ Callee := #func_info{exported=false,arg_types=AT0}=Info0 } -> + CallId = {Meta#metadata.func_id, Dst}, + + AT = update_arg_types(ArgTypes, AT0, CallId), + Info = Info0#func_info{arg_types=AT}, + + {I, Fdb#{ Callee := Info }}; + #{} -> + %% We can't narrow the argument types of exported functions as they + %% can receive anything as part of an external call. + {I, Fdb} + end. + +opt_local_return(I, Callee, ArgTypes, Fdb) when Fdb =/= #{} -> + #func_info{succ_types=SuccTypes} = map_get(Callee, Fdb), + case return_type(SuccTypes, ArgTypes) of + any -> I; + Type -> beam_ssa:add_anno(result_type, Type, I) + end; +opt_local_return(I, _Callee, _ArgTyps, _Fdb) -> + %% Module-level optimization is disabled, assume it returns anything. + I. + +update_arg_types([ArgType | ArgTypes], [TypeMap0 | TypeMaps], CallId) -> + TypeMap = TypeMap0#{ CallId => ArgType }, + [TypeMap | update_arg_types(ArgTypes, TypeMaps, CallId)]; +update_arg_types([], [], _CallId) -> + []. + +%% + -spec opt_finish(Args, Anno, FuncDb) -> {Anno, FuncDb} when Args :: [beam_ssa:b_var()], Anno :: beam_ssa:anno(), @@ -145,325 +572,129 @@ opt_finish(Args, Anno, FuncDb) -> Id = get_func_id(Anno), case FuncDb of #{ Id := #func_info{exported=false,arg_types=ArgTypes} } -> - ParamInfo0 = maps:get(parameter_type_info, Anno, #{}), + ParamInfo0 = maps:get(parameter_info, Anno, #{}), ParamInfo = opt_finish_1(Args, ArgTypes, ParamInfo0), - {Anno#{ parameter_type_info => ParamInfo }, FuncDb}; + {Anno#{ parameter_info => ParamInfo }, FuncDb}; #{} -> {Anno, FuncDb} end. -opt_finish_1([Arg | Args], [TypeMap | TypeMaps], ParamInfo) - when is_map_key(Arg, ParamInfo); %% See join_arg_types/3 - map_size(TypeMap) =:= 0 -> - opt_finish_1(Args, TypeMaps, ParamInfo); -opt_finish_1([Arg | Args], [TypeMap | TypeMaps], ParamInfo0) -> - case join(maps:values(TypeMap)) of +opt_finish_1([Arg | Args], [TypeMap | TypeMaps], Acc0) -> + case beam_types:join(maps:values(TypeMap)) of any -> - opt_finish_1(Args, TypeMaps, ParamInfo0); - none -> - %% This function will never be called. Pretend that we don't - %% know the type for this argument. - opt_finish_1(Args, TypeMaps, ParamInfo0); + opt_finish_1(Args, TypeMaps, Acc0); JoinedType -> - JoinedType = verified_type(JoinedType), - ParamInfo = ParamInfo0#{ Arg => validator_anno(JoinedType) }, - opt_finish_1(Args, TypeMaps, ParamInfo) + Info = maps:get(Arg, Acc0, []), + Acc = Acc0#{ Arg => [{type, JoinedType} | Info] }, + opt_finish_1(Args, TypeMaps, Acc) end; -opt_finish_1([], [], ParamInfo) -> - ParamInfo. - -validator_anno(#t_tuple{size=Size,exact=Exact,elements=Elements0}) -> - Elements = maps:fold(fun(Index, Type, Acc) -> - Key = beam_validator:type_anno(integer, Index), - Acc#{ Key => validator_anno(Type) } - end, #{}, Elements0), - beam_validator:type_anno(tuple, Size, Exact, Elements); -validator_anno(#t_integer{elements={Same,Same}}) -> - beam_validator:type_anno(integer, Same); -validator_anno(#t_integer{}) -> - beam_validator:type_anno(integer); -validator_anno(float) -> - beam_validator:type_anno(float); -validator_anno(#t_atom{elements=[Val]}) -> - beam_validator:type_anno(atom, Val); -validator_anno(#t_atom{}=A) -> - case t_is_boolean(A) of - true -> beam_validator:type_anno(bool); - false -> beam_validator:type_anno(atom) - end; -validator_anno(T) -> - beam_validator:type_anno(T). +opt_finish_1([], [], Acc) -> + Acc. -get_func_id(Anno) -> - #{func_info:={_Mod, Name, Arity}} = Anno, - #b_local{name=#b_literal{val=Name}, arity=Arity}. +%%% +%%% Optimization helpers +%%% -opt([{L,Blk}|Bs], #d{ls=Ls}=D, Acc) -> - case Ls of - #{L:=Ts} -> - opt_1(L, Blk, Bs, Ts, D, Acc); - #{} -> - %% This block is never reached. Discard it. - opt(Bs, D, Acc) +simplify_terminator(#b_br{bool=Bool}=Br0, Ts, Ds, Sub) -> + Br = beam_ssa:normalize(Br0#b_br{bool=simplify_arg(Bool, Ts, Sub)}), + simplify_not(Br, Ts, Ds, Sub); +simplify_terminator(#b_switch{arg=Arg0,fail=Fail,list=List0}=Sw0, + Ts, Ds, Sub) -> + Arg = simplify_arg(Arg0, Ts, Sub), + %% Ensure that no label in the switch list is the same as the + %% failure label. + List = [{Val,Lbl} || {Val,Lbl} <- List0, Lbl =/= Fail], + case beam_ssa:normalize(Sw0#b_switch{arg=Arg,list=List}) of + #b_switch{}=Sw -> + case beam_types:is_boolean_type(raw_type(Arg, Ts)) of + true -> simplify_switch_bool(Sw, Ts, Ds, Sub); + false -> Sw + end; + #b_br{}=Br -> + simplify_terminator(Br, Ts, Ds, Sub) end; -opt([], D, Acc) -> - #d{func_db=FuncDb,ret_type=NewRet} = D, - {reverse(Acc), FuncDb, NewRet}. - -opt_1(L, #b_blk{is=Is0,last=Last0}=Blk0, Bs, Ts0, - #d{ds=Ds0,sub=Sub0,func_db=Fdb0}=D0, Acc) -> - case opt_is(Is0, Ts0, Ds0, Fdb0, D0, Sub0, []) of - {Is,Ts,Ds,Fdb,Sub} -> - D1 = D0#d{ds=Ds,sub=Sub,func_db=Fdb}, - Last1 = simplify_terminator(Last0, Sub, Ts, Ds), - Last = opt_terminator(Last1, Ts, Ds), - D = update_successors(Last, Ts, D1), - Blk = Blk0#b_blk{is=Is,last=Last}, - opt(Bs, D, [{L,Blk}|Acc]); - {no_return,Ret,Is,Ds,Fdb,Sub} -> - %% This call will never reach the successor block. - %% Rewrite the terminator to a 'ret', and remove - %% all type information for this label. That can - %% potentially narrow the type of the phi node - %% in the former successor. - Ls = maps:remove(L, D0#d.ls), - RetType = join([none|D0#d.ret_type]), - D = D0#d{ds=Ds,ls=Ls,sub=Sub, - func_db=Fdb,ret_type=[RetType]}, - Blk = Blk0#b_blk{is=Is,last=Ret}, - opt(Bs, D, [{L,Blk}|Acc]) - end. - -simplify_terminator(#b_br{bool=Bool}=Br, Sub, Ts, _Ds) -> - Br#b_br{bool=simplify_arg(Bool, Sub, Ts)}; -simplify_terminator(#b_switch{arg=Arg}=Sw, Sub, Ts, _Ds) -> - Sw#b_switch{arg=simplify_arg(Arg, Sub, Ts)}; -simplify_terminator(#b_ret{arg=Arg}=Ret, Sub, Ts, Ds) -> +simplify_terminator(#b_ret{arg=Arg}=Ret, Ts, Ds, Sub) -> %% Reducing the result of a call to a literal (fairly common for 'ok') %% breaks tail call optimization. case Ds of #{ Arg := #b_set{op=call}} -> Ret; - #{} -> Ret#b_ret{arg=simplify_arg(Arg, Sub, Ts)} + #{} -> Ret#b_ret{arg=simplify_arg(Arg, Ts, Sub)} end. -opt_is([#b_set{op=phi,dst=Dst,args=Args0}=I0|Is], - Ts0, Ds0, Fdb, #d{ls=Ls}=D, Sub0, Acc) -> +%% +%% Simplifies an instruction, returning either a new instruction (with updated +%% type and definition maps), or an updated substitution map if the instruction +%% was redundant. +%% + +simplify(#b_set{op=phi,dst=Dst,args=Args0}=I0, Ts0, Ds0, Ls, Sub) -> %% Simplify the phi node by removing all predecessor blocks that no %% longer exists or no longer branches to this block. - Args = [{simplify_arg(Arg, Sub0, Ts0),From} || + Args = [{simplify_arg(Arg, Ts0, Sub), From} || {Arg,From} <- Args0, maps:is_key(From, Ls)], case all_same(Args) of true -> %% Eliminate the phi node if there is just one source %% value or if the values are identical. [{Val,_}|_] = Args, - Sub = Sub0#{Dst=>Val}, - opt_is(Is, Ts0, Ds0, Fdb, D, Sub, Acc); + Sub#{ Dst => Val }; false -> I = I0#b_set{args=Args}, Ts = update_types(I, Ts0, Ds0), Ds = Ds0#{Dst=>I}, - opt_is(Is, Ts, Ds, Fdb, D, Sub0, [I|Acc]) + {I, Ts, Ds} end; -opt_is([#b_set{op=call,args=Args0,dst=Dst}=I0|Is], - Ts0, Ds0, Fdb0, D, Sub0, Acc) -> - Args = simplify_args(Args0, Sub0, Ts0), - I1 = beam_ssa:normalize(I0#b_set{args=Args}), - {Ts1,Ds,Fdb,I2} = opt_call(I1, D, Ts0, Ds0, Fdb0), - case {map_get(Dst, Ts1),Is} of - {Type,[#b_set{op=succeeded}]} when Type =/= none -> - %% This call instruction is inside a try/catch - %% block. Don't attempt to simplify it. - opt_is(Is, Ts1, Ds, Fdb, D, Sub0, [I2|Acc]); - {none,[#b_set{op=succeeded}]} -> - %% This call instruction is inside a try/catch - %% block, but we know it will never return and - %% later optimizations may try to exploit that. - %% - %% For example, if we have an expression that - %% either returns this call or a tuple, we know - %% that the expression always returns a tuple - %% and can turn a later element/3 into - %% get_tuple_element. - %% - %% This is sound but difficult to validate in a - %% meaningful way as try/catch currently forces - %% us to maintain the illusion that the success - %% block is reachable even when its not, so we - %% disable the optimization to keep things - %% simple. - Ts = Ts1#{ Dst := any }, - opt_is(Is, Ts, Ds, Fdb, D, Sub0, [I2|Acc]); - {none,_} -> - %% This call never returns. The rest of the - %% instructions will not be executed. - Ret = #b_ret{arg=Dst}, - {no_return,Ret,reverse(Acc, [I2]),Ds,Fdb,Sub0}; - {_,_} -> - case simplify_call(I2) of - #b_set{}=I -> - opt_is(Is, Ts1, Ds, Fdb, D, Sub0, [I|Acc]); - #b_literal{}=Lit -> - Sub = Sub0#{Dst=>Lit}, - Ts = maps:remove(Dst, Ts1), - opt_is(Is, Ts, Ds0, Fdb, D, Sub, Acc); - #b_var{}=Var -> - Ts = maps:remove(Dst, Ts1), - Sub = Sub0#{Dst=>Var}, - opt_is(Is, Ts, Ds0, Fdb, D, Sub, Acc) - end +simplify(#b_set{op=succeeded,dst=Dst}=I0, Ts0, Ds0, _Ls, Sub) -> + case will_succeed(I0, Ts0, Ds0, Sub) of + yes -> + Lit = #b_literal{val=true}, + Sub#{ Dst => Lit }; + no -> + Lit = #b_literal{val=false}, + Sub#{ Dst => Lit }; + maybe -> + %% Note that we never simplify args; this instruction is specific + %% to the operation being checked, and simplifying could break that + %% connection. + I = beam_ssa:normalize(I0), + Ts = Ts0#{ Dst => beam_types:make_boolean() }, + Ds = Ds0#{ Dst => I }, + {I, Ts, Ds} end; -opt_is([#b_set{op=succeeded,args=[Arg],dst=Dst}=I], - Ts0, Ds0, Fdb, D, Sub0, Acc) -> - case Ds0 of - #{ Arg := #b_set{op=call} } -> - %% The success check of a call is part of exception handling and - %% must not be optimized away. We still have to update its type - %% though. - Ts = update_types(I, Ts0, Ds0), - Ds = Ds0#{Dst=>I}, - - opt_is([], Ts, Ds, Fdb, D, Sub0, [I|Acc]); - #{} -> - Args = simplify_args([Arg], Sub0, Ts0), - Type = type(succeeded, Args, Ts0, Ds0), - case get_literal_from_type(Type) of - #b_literal{}=Lit -> - Sub = Sub0#{Dst=>Lit}, - opt_is([], Ts0, Ds0, Fdb, D, Sub, Acc); - none -> - Ts = Ts0#{Dst=>Type}, - Ds = Ds0#{Dst=>I}, - opt_is([], Ts, Ds, Fdb, D, Sub0, [I|Acc]) - end - end; -opt_is([#b_set{args=Args0,dst=Dst}=I0|Is], - Ts0, Ds0, Fdb, D, Sub0, Acc) -> - Args = simplify_args(Args0, Sub0, Ts0), +simplify(#b_set{op=bs_match,dst=Dst,args=Args0}=I0, Ts0, Ds0, _Ls, Sub) -> + Args = simplify_args(Args0, Ts0, Sub), + I1 = beam_ssa:normalize(I0#b_set{args=Args}), + I2 = case {Args0,Args} of + {[_,_,_,#b_var{},_],[Type,Val,Flags,#b_literal{val=all},Unit]} -> + %% The size `all` is used for the size of the final binary + %% segment in a pattern. Using `all` explicitly is not allowed, + %% so we convert it to an obvious invalid size. + I1#b_set{args=[Type,Val,Flags,#b_literal{val=bad_size},Unit]}; + {_,_} -> + I1 + end, + %% We KNOW that simplify/2 will return a #b_set{} record when called with + %% a bs_match instruction. + #b_set{} = I3 = simplify(I2, Ts0), + I = beam_ssa:normalize(I3), + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{ Dst => I }, + {I, Ts, Ds}; +simplify(#b_set{dst=Dst,args=Args0}=I0, Ts0, Ds0, _Ls, Sub) -> + Args = simplify_args(Args0, Ts0, Sub), I1 = beam_ssa:normalize(I0#b_set{args=Args}), case simplify(I1, Ts0) of #b_set{}=I2 -> I = beam_ssa:normalize(I2), Ts = update_types(I, Ts0, Ds0), - Ds = Ds0#{Dst=>I}, - opt_is(Is, Ts, Ds, Fdb, D, Sub0, [I|Acc]); + Ds = Ds0#{ Dst => I }, + {I, Ts, Ds}; #b_literal{}=Lit -> - Sub = Sub0#{Dst=>Lit}, - opt_is(Is, Ts0, Ds0, Fdb, D, Sub, Acc); + Sub#{ Dst => Lit }; #b_var{}=Var -> - case Is of - [#b_set{op=succeeded,dst=SuccDst,args=[Dst]}] -> - %% We must remove this 'succeeded' instruction. - Sub = Sub0#{Dst=>Var,SuccDst=>#b_literal{val=true}}, - opt_is([], Ts0, Ds0, Fdb, D, Sub, Acc); - _ -> - Sub = Sub0#{Dst=>Var}, - opt_is(Is, Ts0, Ds0, Fdb, D, Sub, Acc) - end - end; -opt_is([], Ts, Ds, Fdb, _D, Sub, Acc) -> - {reverse(Acc), Ts, Ds, Fdb, Sub}. - -simplify_call(#b_set{op=call,args=[#b_remote{}=Rem|Args]}=I) -> - case Rem of - #b_remote{mod=#b_literal{val=Mod}, - name=#b_literal{val=Name}} -> - case erl_bifs:is_pure(Mod, Name, length(Args)) of - true -> - simplify_remote_call(Mod, Name, Args, I); - false -> - I - end; - #b_remote{} -> - I - end; -simplify_call(I) -> I. - -%% Simplify a remote call to a pure BIF. -simplify_remote_call(erlang, '++', [#b_literal{val=[]},Tl], _I) -> - Tl; -simplify_remote_call(erlang, setelement, - [#b_literal{val=Pos}, - #b_literal{val=Tuple}, - #b_var{}=Value], I) - when is_integer(Pos), 1 =< Pos, Pos =< tuple_size(Tuple) -> - %% Position is a literal integer and the shape of the - %% tuple is known. - Els0 = [#b_literal{val=El} || El <- tuple_to_list(Tuple)], - {Bef,[_|Aft]} = split(Pos - 1, Els0), - Els = Bef ++ [Value|Aft], - I#b_set{op=put_tuple,args=Els}; -simplify_remote_call(Mod, Name, Args0, I) -> - case make_literal_list(Args0) of - none -> - I; - Args -> - %% The arguments are literals. Try to evaluate the BIF. - try apply(Mod, Name, Args) of - Val -> - case cerl:is_literal_term(Val) of - true -> - #b_literal{val=Val}; - false -> - %% The value can't be expressed as a literal - %% (e.g. a pid). - I - end - catch - _:_ -> - %% Failed. Don't bother trying to optimize - %% the call. - I - end + Sub#{ Dst => Var } end. -opt_call(#b_set{dst=Dst,args=[#b_local{}=Callee|Args]}=I0, D, Ts0, Ds0, Fdb0) -> - {Ts, Ds, I} = opt_local_call(I0, Ts0, Ds0, Fdb0), - case Fdb0 of - #{ Callee := #func_info{exported=false,arg_types=ArgTypes0}=Info } -> - %% Update the argument types of *this exact call*, the types - %% will be joined later when the callee is optimized. - CallId = {D#d.func_id, Dst}, - ArgTypes = update_arg_types(Args, ArgTypes0, CallId, Ts0), - - Fdb = Fdb0#{ Callee => Info#func_info{arg_types=ArgTypes} }, - {Ts, Ds, Fdb, I}; - #{} -> - %% We can't narrow the argument types of exported functions as they - %% can receive anything as part of an external call. - {Ts, Ds, Fdb0, I} - end; -opt_call(#b_set{dst=Dst}=I, _D, Ts0, Ds0, Fdb) -> - Ts = update_types(I, Ts0, Ds0), - Ds = Ds0#{ Dst => I }, - {Ts, Ds, Fdb, I}. - -opt_local_call(#b_set{dst=Dst,args=[Id|_]}=I0, Ts0, Ds0, Fdb) -> - Type = case Fdb of - #{ Id := #func_info{ret_type=[T]} } -> T; - #{} -> any - end, - I = case Type of - any -> I0; - none -> I0; - _ -> beam_ssa:add_anno(result_type, validator_anno(Type), I0) - end, - Ts = Ts0#{ Dst => Type }, - Ds = Ds0#{ Dst => I }, - {Ts, Ds, I}. - -update_arg_types([Arg | Args], [TypeMap0 | TypeMaps], CallId, Ts) -> - %% Match contexts are treated as bitstrings when optimizing arguments, as - %% we don't yet support removing the "bs_start_match3" instruction. - NewType = case get_type(Arg, Ts) of - #t_bs_match{} -> {binary, 1}; - Type -> Type - end, - TypeMap = TypeMap0#{ CallId => NewType }, - [TypeMap | update_arg_types(Args, TypeMaps, CallId, Ts)]; -update_arg_types([], [], _CallId, _Ts) -> - []. - simplify(#b_set{op={bif,'and'},args=Args}=I, Ts) -> case is_safe_bool_op(Args, Ts) of true -> @@ -487,8 +718,10 @@ simplify(#b_set{op={bif,'or'},args=Args}=I, Ts) -> I end; simplify(#b_set{op={bif,element},args=[#b_literal{val=Index},Tuple]}=I0, Ts) -> - case t_tuple_size(get_type(Tuple, Ts)) of - {_,Size} when is_integer(Index), 1 =< Index, Index =< Size -> + case normalized_type(Tuple, Ts) of + #t_tuple{size=Size} when is_integer(Index), + 1 =< Index, + Index =< Size -> I = I0#b_set{op=get_tuple_element, args=[Tuple,#b_literal{val=Index-1}]}, simplify(I, Ts); @@ -496,67 +729,110 @@ simplify(#b_set{op={bif,element},args=[#b_literal{val=Index},Tuple]}=I0, Ts) -> eval_bif(I0, Ts) end; simplify(#b_set{op={bif,hd},args=[List]}=I, Ts) -> - case get_type(List, Ts) of - cons -> + case normalized_type(List, Ts) of + #t_cons{} -> I#b_set{op=get_hd}; _ -> eval_bif(I, Ts) end; simplify(#b_set{op={bif,tl},args=[List]}=I, Ts) -> - case get_type(List, Ts) of - cons -> + case normalized_type(List, Ts) of + #t_cons{} -> I#b_set{op=get_tl}; _ -> eval_bif(I, Ts) end; simplify(#b_set{op={bif,size},args=[Term]}=I, Ts) -> - case get_type(Term, Ts) of + case normalized_type(Term, Ts) of #t_tuple{} -> simplify(I#b_set{op={bif,tuple_size}}, Ts); + #t_bitstring{size_unit=U} when U rem 8 =:= 0 -> + %% If the bitstring is a binary (the size in bits is + %% evenly divisibly by 8), byte_size/1 gives + %% the same result as size/1. + simplify(I#b_set{op={bif,byte_size}}, Ts); _ -> eval_bif(I, Ts) end; simplify(#b_set{op={bif,tuple_size},args=[Term]}=I, Ts) -> - case get_type(Term, Ts) of + case normalized_type(Term, Ts) of #t_tuple{size=Size,exact=true} -> #b_literal{val=Size}; _ -> I end; -simplify(#b_set{op={bif,'=='},args=Args}=I, Ts) -> - Types = get_types(Args, Ts), - EqEq = case {meet(Types),join(Types)} of - {none,any} -> true; - {#t_integer{},#t_integer{}} -> true; - {float,float} -> true; - {{binary,_},_} -> true; - {#t_atom{},_} -> true; - {_,_} -> false - end, +simplify(#b_set{op={bif,is_function},args=[Fun,#b_literal{val=Arity}]}=I, Ts) + when is_integer(Arity), Arity >= 0 -> + case normalized_type(Fun, Ts) of + #t_fun{arity=any} -> + I; + #t_fun{arity=Arity} -> + #b_literal{val=true}; + any -> + I; + _ -> + #b_literal{val=false} + end; +simplify(#b_set{op={bif,is_map_key},args=[Key,Map]}=I, Ts) -> + case normalized_type(Map, Ts) of + #t_map{} -> + I#b_set{op=has_map_field,args=[Map,Key]}; + _ -> + I + end; +simplify(#b_set{op={bif,Op0},args=Args}=I, Ts) when Op0 =:= '=='; + Op0 =:= '/=' -> + Types = normalized_types(Args, Ts), + EqEq0 = case {beam_types:meet(Types),beam_types:join(Types)} of + {none,any} -> true; + {#t_integer{},#t_integer{}} -> true; + {#t_float{},#t_float{}} -> true; + {#t_bitstring{},_} -> true; + {#t_atom{},_} -> true; + {_,_} -> false + end, + EqEq = EqEq0 orelse any_non_numeric_argument(Args, Ts), case EqEq of true -> - simplify(I#b_set{op={bif,'=:='}}, Ts); + Op = case Op0 of + '==' -> '=:='; + '/=' -> '=/=' + end, + simplify(I#b_set{op={bif,Op}}, Ts); false -> eval_bif(I, Ts) end; simplify(#b_set{op={bif,'=:='},args=[Same,Same]}, _Ts) -> #b_literal{val=true}; -simplify(#b_set{op={bif,'=:='},args=[A1,_A2]=Args}=I, Ts) -> - [T1,T2] = get_types(Args, Ts), - case meet(T1, T2) of +simplify(#b_set{op={bif,'=:='},args=[LHS,RHS]}=I, Ts) -> + LType = raw_type(LHS, Ts), + RType = raw_type(RHS, Ts), + case beam_types:meet(LType, RType) of none -> #b_literal{val=false}; _ -> - case {t_is_boolean(T1),T2} of + case {beam_types:is_boolean_type(LType), + beam_types:normalize(RType)} of {true,#t_atom{elements=[true]}} -> %% Bool =:= true ==> Bool - A1; + LHS; + {true,#t_atom{elements=[false]}} -> + %% Bool =:= false ==> not Bool + %% + %% This will be further optimized to eliminate the + %% 'not', swapping the success and failure + %% branches in the br instruction. If LHS comes + %% from a type test (such as is_atom/1) or a + %% comparison operator (such as >=) that can be + %% translated to test instruction, this + %% optimization will eliminate one instruction. + simplify(I#b_set{op={bif,'not'},args=[LHS]}, Ts); {_,_} -> eval_bif(I, Ts) end end; simplify(#b_set{op={bif,Op},args=Args}=I, Ts) -> - Types = get_types(Args, Ts), + Types = normalized_types(Args, Ts), case is_float_op(Op, Types) of false -> eval_bif(I, Ts); @@ -564,29 +840,57 @@ simplify(#b_set{op={bif,Op},args=Args}=I, Ts) -> AnnoArgs = [anno_float_arg(A) || A <- Types], eval_bif(beam_ssa:add_anno(float_op, AnnoArgs, I), Ts) end; -simplify(#b_set{op=get_tuple_element,args=[Tuple,#b_literal{val=N}]}=I, Ts) -> - case get_type(Tuple, Ts) of - #t_tuple{size=Size,elements=Es} when Size > N -> - ElemType = get_element_type(N + 1, Es), - case get_literal_from_type(ElemType) of - #b_literal{}=Lit -> Lit; - none -> I - end; - none -> - %% Will never be executed because of type conflict. - %% #b_literal{val=ignored}; +simplify(#b_set{op=bs_extract,args=[Ctx]}=I, Ts) -> + case raw_type(Ctx, Ts) of + #t_bitstring{} -> + %% This is a bs_match that has been rewritten as a bs_get_tail; + %% just return the input as-is. + Ctx; + #t_bs_context{} -> I end; +simplify(#b_set{op=bs_match, + args=[#b_literal{val=binary}, Ctx, _Flags, + #b_literal{val=all}, + #b_literal{val=OpUnit}]}=I, Ts) -> + %% <<..., Foo/binary>> can be rewritten as <<..., Foo/bits>> if we know the + %% unit is correct. + #t_bs_context{tail_unit=CtxUnit} = raw_type(Ctx, Ts), + if + CtxUnit rem OpUnit =:= 0 -> + I#b_set{op=bs_get_tail,args=[Ctx]}; + CtxUnit rem OpUnit =/= 0 -> + I + end; +simplify(#b_set{op=bs_start_match,args=[#b_literal{val=new}, Src]}=I, Ts) -> + case raw_type(Src, Ts) of + #t_bs_context{} -> + I#b_set{op=bs_start_match,args=[#b_literal{val=resume}, Src]}; + _ -> + I + end; +simplify(#b_set{op=get_tuple_element,args=[Tuple,#b_literal{val=N}]}=I, Ts) -> + #t_tuple{size=Size,elements=Es} = normalized_type(Tuple, Ts), + true = Size > N, %Assertion. + ElemType = beam_types:get_tuple_element(N + 1, Es), + case beam_types:get_singleton_value(ElemType) of + {ok, Val} -> #b_literal{val=Val}; + error -> I + end; simplify(#b_set{op=is_nonempty_list,args=[Src]}=I, Ts) -> - case get_type(Src, Ts) of - any -> I; - list -> I; - cons -> #b_literal{val=true}; - _ -> #b_literal{val=false} + case normalized_type(Src, Ts) of + any -> + I; + #t_list{} -> + I; + #t_cons{} -> + #b_literal{val=true}; + _ -> + #b_literal{val=false} end; simplify(#b_set{op=is_tagged_tuple, args=[Src,#b_literal{val=Size},#b_literal{}=Tag]}=I, Ts) -> - simplify_is_record(I, get_type(Src, Ts), Size, Tag, Ts); + simplify_is_record(I, normalized_type(Src, Ts), Size, Tag, Ts); simplify(#b_set{op=put_list,args=[#b_literal{val=H}, #b_literal{val=T}]}, _Ts) -> #b_literal{val=[H|T]}; @@ -599,8 +903,274 @@ simplify(#b_set{op=wait_timeout,args=[#b_literal{val=0}]}, _Ts) -> #b_literal{val=true}; simplify(#b_set{op=wait_timeout,args=[#b_literal{val=infinity}]}=I, _Ts) -> I#b_set{op=wait,args=[]}; +simplify(#b_set{op=call,args=[#b_remote{}=Rem|Args]}=I, _Ts) -> + case Rem of + #b_remote{mod=#b_literal{val=Mod}, + name=#b_literal{val=Name}} -> + case erl_bifs:is_pure(Mod, Name, length(Args)) of + true -> + simplify_remote_call(Mod, Name, Args, I); + false -> + I + end; + #b_remote{} -> + I + end; simplify(I, _Ts) -> I. +will_succeed(#b_set{args=[Src]}, Ts, Ds, Sub) -> + case {Ds, Ts} of + {#{}, #{ Src := none }} -> + %% Checked operation never returns. + no; + {#{ Src := I }, #{}} -> + will_succeed_1(I, Src, Ts, Sub); + {#{}, #{}} -> + %% The checked instruction has been removed and substituted, so we + %% can assume it always succeeds. + true = is_map_key(Src, Sub), %Assertion. + yes + end. + +will_succeed_1(#b_set{op=bs_get_tail}, _Src, _Ts, _Sub) -> + yes; +will_succeed_1(#b_set{op=bs_start_match,args=[_, Arg]}, _Src, Ts, _Sub) -> + ArgType = raw_type(Arg, Ts), + case beam_types:is_bs_matchable_type(ArgType) of + true -> + %% In the future we may be able to remove this instruction + %% altogether when we have a #t_bs_context{}, but for now we need + %% to keep it for compatibility with older releases of OTP. + yes; + false -> + %% Is it at all possible to match? + case beam_types:meet(ArgType, #t_bs_matchable{}) of + none -> no; + _ -> maybe + end + end; + +will_succeed_1(#b_set{op={bif,Bif},args=BifArgs}, _Src, Ts, _Sub) -> + ArgTypes = normalized_types(BifArgs, Ts), + beam_call_types:will_succeed(erlang, Bif, ArgTypes); +will_succeed_1(#b_set{op=call, + args=[#b_remote{mod=#b_literal{val=Mod}, + name=#b_literal{val=Func}} | + CallArgs]}, + _Src, Ts, _Sub) -> + ArgTypes = normalized_types(CallArgs, Ts), + beam_call_types:will_succeed(Mod, Func, ArgTypes); + +will_succeed_1(#b_set{op=get_hd}, _Src, _Ts, _Sub) -> + yes; +will_succeed_1(#b_set{op=get_tl}, _Src, _Ts, _Sub) -> + yes; +will_succeed_1(#b_set{op=has_map_field}, _Src, _Ts, _Sub) -> + yes; +will_succeed_1(#b_set{op=get_tuple_element}, _Src, _Ts, _Sub) -> + yes; +will_succeed_1(#b_set{op=put_tuple}, _Src, _Ts, _Sub) -> + yes; + +%% Remove the success branch from binary operations with invalid +%% sizes. That will remove subsequent bs_put and bs_match instructions, +%% which are probably not loadable. +will_succeed_1(#b_set{op=bs_add,args=[_,#b_literal{val=Size},_]}, + _Src, _Ts, _Sub) -> + if + is_integer(Size), Size >= 0 -> + maybe; + true -> + no + end; +will_succeed_1(#b_set{op=bs_init, + args=[#b_literal{val=new},#b_literal{val=Size},_Unit]}, + _Src, _Ts, _Sub) -> + if + is_integer(Size), Size >= 0 -> + maybe; + true -> + no + end; +will_succeed_1(#b_set{op=bs_init, + args=[#b_literal{},_,#b_literal{val=Size},_Unit]}, + _Src, _Ts, _Sub) -> + if + is_integer(Size), Size >= 0 -> + maybe; + true -> + no + end; +will_succeed_1(#b_set{op=bs_match, + args=[#b_literal{val=Type},_,_,#b_literal{val=Size},_]}, + _Src, _Ts, _Sub) -> + if + is_integer(Size), Size >= 0 -> + maybe; + Type =:= binary, Size =:= all -> + %% `all` is a legal size for binary segments at the end of + %% a binary pattern. + maybe; + true -> + %% Invalid size. Matching will fail. + no + end; + +%% These operations may fail even though we know their return value on success. +will_succeed_1(#b_set{op=call}, _Src, _Ts, _Sub) -> + maybe; +will_succeed_1(#b_set{op=get_map_element}, _Src, _Ts, _Sub) -> + maybe; + +will_succeed_1(#b_set{op=wait}, _Src, _Ts, _Sub) -> + no; + +will_succeed_1(#b_set{}, Src, Ts, Sub) -> + case simplify_arg(Src, Ts, Sub) of + #b_var{}=Src -> + %% No substitution; might fail at runtime. + maybe; + _ -> + %% Substituted with literal or other variable; always succeeds. + yes + end. + +simplify_is_record(I, #t_tuple{exact=Exact, + size=Size, + elements=Es}, + RecSize, #b_literal{val=TagVal}=RecTag, Ts) -> + TagType = maps:get(1, Es, any), + TagMatch = case beam_types:get_singleton_value(TagType) of + {ok, TagVal} -> yes; + {ok, _} -> no; + error -> + %% Is it at all possible for the tag to match? + case beam_types:meet(raw_type(RecTag, Ts), TagType) of + none -> no; + _ -> maybe + end + end, + if + Size =/= RecSize, Exact; Size > RecSize; TagMatch =:= no -> + #b_literal{val=false}; + Size =:= RecSize, Exact, TagMatch =:= yes -> + #b_literal{val=true}; + true -> + I + end; +simplify_is_record(I, any, _Size, _Tag, _Ts) -> + I; +simplify_is_record(_I, _Type, _Size, _Tag, _Ts) -> + #b_literal{val=false}. + +simplify_switch_bool(#b_switch{arg=B,fail=Fail,list=List0}, Ts, Ds, Sub) -> + FalseVal = #b_literal{val=false}, + TrueVal = #b_literal{val=true}, + List1 = List0 ++ [{FalseVal,Fail},{TrueVal,Fail}], + {_,FalseLbl} = keyfind(FalseVal, 1, List1), + {_,TrueLbl} = keyfind(TrueVal, 1, List1), + Br = #b_br{bool=B,succ=TrueLbl,fail=FalseLbl}, + simplify_terminator(Br, Ts, Ds, Sub). + +simplify_not(#b_br{bool=#b_var{}=V,succ=Succ,fail=Fail}=Br0, Ts, Ds, Sub) -> + case Ds of + #{V:=#b_set{op={bif,'not'},args=[Bool]}} -> + case beam_types:is_boolean_type(raw_type(Bool, Ts)) of + true -> + Br = Br0#b_br{bool=Bool,succ=Fail,fail=Succ}, + simplify_terminator(Br, Ts, Ds, Sub); + false -> + Br0 + end; + #{} -> + Br0 + end; +simplify_not(#b_br{bool=#b_literal{}}=Br, _Sub, _Ts, _Ds) -> + Br. + +%% Simplify a remote call to a pure BIF. +simplify_remote_call(erlang, '++', [#b_literal{val=[]},Tl], _I) -> + Tl; +simplify_remote_call(erlang, setelement, + [#b_literal{val=Pos}, + #b_literal{val=Tuple}, + #b_var{}=Value], I) + when is_integer(Pos), 1 =< Pos, Pos =< tuple_size(Tuple) -> + %% Position is a literal integer and the shape of the + %% tuple is known. + Els0 = [#b_literal{val=El} || El <- tuple_to_list(Tuple)], + {Bef,[_|Aft]} = split(Pos - 1, Els0), + Els = Bef ++ [Value|Aft], + I#b_set{op=put_tuple,args=Els}; +simplify_remote_call(Mod, Name, Args0, I) -> + case make_literal_list(Args0) of + none -> + I; + Args -> + %% The arguments are literals. Try to evaluate the BIF. + try apply(Mod, Name, Args) of + Val -> + case cerl:is_literal_term(Val) of + true -> + #b_literal{val=Val}; + false -> + %% The value can't be expressed as a literal + %% (e.g. a pid). + I + end + catch + _:_ -> + %% Failed. Don't bother trying to optimize + %% the call. + I + end + end. + +any_non_numeric_argument([#b_literal{val=Lit}|_], _Ts) -> + is_non_numeric(Lit); +any_non_numeric_argument([#b_var{}=V|T], Ts) -> + is_non_numeric_type(raw_type(V, Ts)) orelse any_non_numeric_argument(T, Ts); +any_non_numeric_argument([], _Ts) -> false. + +is_non_numeric([H|T]) -> + is_non_numeric(H) andalso is_non_numeric(T); +is_non_numeric(Tuple) when is_tuple(Tuple) -> + is_non_numeric_tuple(Tuple, tuple_size(Tuple)); +is_non_numeric(Map) when is_map(Map) -> + %% Starting from OTP 18, map keys are compared using `=:=`. + %% Therefore, we only need to check that the values in the map are + %% non-numeric. (Support for compiling BEAM files for OTP releases + %% older than OTP 18 has been dropped.) + is_non_numeric(maps:values(Map)); +is_non_numeric(Num) when is_number(Num) -> + false; +is_non_numeric(_) -> true. + +is_non_numeric_tuple(Tuple, El) when El >= 1 -> + is_non_numeric(element(El, Tuple)) andalso + is_non_numeric_tuple(Tuple, El-1); +is_non_numeric_tuple(_Tuple, 0) -> true. + +is_non_numeric_type(#t_atom{}) -> true; +is_non_numeric_type(#t_bitstring{}) -> true; +is_non_numeric_type(#t_cons{type=Type,terminator=Terminator}) -> + is_non_numeric_type(Type) andalso is_non_numeric_type(Terminator); +is_non_numeric_type(#t_list{type=Type,terminator=Terminator}) -> + is_non_numeric_type(Type) andalso is_non_numeric_type(Terminator); +is_non_numeric_type(#t_map{super_value=Value}) -> + is_non_numeric_type(Value); +is_non_numeric_type(nil) -> true; +is_non_numeric_type(#t_tuple{size=Size,exact=true,elements=Types}) + when map_size(Types) =:= Size -> + is_non_numeric_tuple_type(Size, Types); +is_non_numeric_type(_) -> false. + +is_non_numeric_tuple_type(0, _Types) -> + true; +is_non_numeric_tuple_type(Pos, Types) -> + is_non_numeric_type(map_get(Pos, Types)) andalso + is_non_numeric_tuple_type(Pos - 1, Types). + make_literal_list(Args) -> make_literal_list(Args, []). @@ -611,9 +1181,11 @@ make_literal_list([_|_], _) -> make_literal_list([], Acc) -> reverse(Acc). -is_safe_bool_op(Args, Ts) -> - [T1,T2] = get_types(Args, Ts), - t_is_boolean(T1) andalso t_is_boolean(T2). +is_safe_bool_op([LHS, RHS], Ts) -> + LType = raw_type(LHS, Ts), + RType = raw_type(RHS, Ts), + beam_types:is_boolean_type(LType) andalso + beam_types:is_boolean_type(RType). all_same([{H,_}|T]) -> all(fun({E,_}) -> E =:= H end, T). @@ -626,21 +1198,7 @@ eval_bif(#b_set{op={bif,Bif},args=Args}=I, Ts) -> true -> case make_literal_list(Args) of none -> - case get_types(Args, Ts) of - [any] -> - I; - [Type] -> - case will_succeed(Bif, Type) of - yes -> - #b_literal{val=true}; - no -> - #b_literal{val=false}; - maybe -> - I - end; - _ -> - I - end; + eval_type_test_bif(I, Bif, raw_types(Args, Ts)); LitArgs -> try apply(erlang, Bif, LitArgs) of Val -> #b_literal{val=Val} @@ -651,24 +1209,101 @@ eval_bif(#b_set{op={bif,Bif},args=Args}=I, Ts) -> end end. -simplify_args(Args, Sub, Ts) -> - [simplify_arg(Arg, Sub, Ts) || Arg <- Args]. +eval_type_test_bif(I, is_atom, [Type]) -> + eval_type_test_bif_1(I, Type, #t_atom{}); +eval_type_test_bif(I, is_binary, [Type]) -> + eval_type_test_bif_1(I, Type, #t_bs_matchable{tail_unit=8}); +eval_type_test_bif(I, is_bitstring, [Type]) -> + eval_type_test_bif_1(I, Type, #t_bs_matchable{}); +eval_type_test_bif(I, is_boolean, [Type]) -> + case beam_types:is_boolean_type(Type) of + true -> + #b_literal{val=true}; + false -> + case beam_types:meet(Type, #t_atom{}) of + #t_atom{elements=[_|_]=Es} -> + case any(fun is_boolean/1, Es) of + true -> I; + false -> #b_literal{val=false} + end; + #t_atom{} -> + I; + none -> + #b_literal{val=false} + end + end; +eval_type_test_bif(I, is_float, [Type]) -> + eval_type_test_bif_1(I, Type, #t_float{}); +eval_type_test_bif(I, is_function, [Type]) -> + eval_type_test_bif_1(I, Type, #t_fun{}); +eval_type_test_bif(I, is_integer, [Type]) -> + eval_type_test_bif_1(I, Type, #t_integer{}); +eval_type_test_bif(I, is_list, [Type]) -> + eval_type_test_bif_1(I, Type, #t_list{}); +eval_type_test_bif(I, is_map, [Type]) -> + eval_type_test_bif_1(I, Type, #t_map{}); +eval_type_test_bif(I, is_number, [Type]) -> + eval_type_test_bif_1(I, Type, number); +eval_type_test_bif(I, is_tuple, [Type]) -> + eval_type_test_bif_1(I, Type, #t_tuple{}); +eval_type_test_bif(I, Op, Types) -> + case Types of + [#t_integer{},#t_integer{elements={0,0}}] + when Op =:= '+'; Op =:= '-'; Op =:= 'bor'; Op =:= 'bxor' -> + #b_set{args=[Result,_]} = I, + Result; + [#t_integer{},#t_integer{elements={0,0}}] when Op =:= '*'; Op =:= 'band' -> + #b_literal{val=0}; + [#t_integer{},#t_integer{elements={1,1}}] when Op =:= '*'; Op =:= 'div' -> + #b_set{args=[Result,_]} = I, + Result; + [#t_integer{elements={LMin,LMax}},#t_integer{elements={RMin,RMax}}] -> + case is_inequality_op(Op) of + true -> + case {erlang:Op(LMin, RMin),erlang:Op(LMax, RMin), + erlang:Op(LMin, RMax),erlang:Op(LMax, RMax)} of + {Bool,Bool,Bool,Bool} -> + #b_literal{val=Bool}; + _ -> + I + end; + false -> + I + end; + _ -> + I + end. + +is_inequality_op('<') -> true; +is_inequality_op('=<') -> true; +is_inequality_op('>') -> true; +is_inequality_op('>=') -> true; +is_inequality_op(_) -> false. + +eval_type_test_bif_1(I, ArgType, Required) -> + case beam_types:meet(ArgType, Required) of + ArgType -> #b_literal{val=true}; + none -> #b_literal{val=false}; + _ -> I + end. + +simplify_args(Args, Ts, Sub) -> + [simplify_arg(Arg, Ts, Sub) || Arg <- Args]. -simplify_arg(#b_var{}=Arg0, Sub, Ts) -> +simplify_arg(#b_var{}=Arg0, Ts, Sub) -> case sub_arg(Arg0, Sub) of #b_literal{}=LitArg -> LitArg; #b_var{}=Arg -> - Type = get_type(Arg, Ts), - case get_literal_from_type(Type) of - none -> Arg; - #b_literal{}=Lit -> Lit + case beam_types:get_singleton_value(raw_type(Arg, Ts)) of + {ok, Val} -> #b_literal{val=Val}; + error -> Arg end end; -simplify_arg(#b_remote{mod=Mod,name=Name}=Rem, Sub, Ts) -> - Rem#b_remote{mod=simplify_arg(Mod, Sub, Ts), - name=simplify_arg(Name, Sub, Ts)}; -simplify_arg(Arg, _Sub, _Ts) -> Arg. +simplify_arg(#b_remote{mod=Mod,name=Name}=Rem, Ts, Sub) -> + Rem#b_remote{mod=simplify_arg(Mod, Ts, Sub), + name=simplify_arg(Name, Ts, Sub)}; +simplify_arg(Arg, _Ts, _Sub) -> Arg. sub_arg(#b_var{}=Old, Sub) -> case Sub of @@ -676,13 +1311,13 @@ sub_arg(#b_var{}=Old, Sub) -> #{} -> Old end. -is_float_op('-', [float]) -> +is_float_op('-', [#t_float{}]) -> true; is_float_op('/', [_,_]) -> true; -is_float_op(Op, [float,_Other]) -> +is_float_op(Op, [#t_float{},_Other]) -> is_float_op_1(Op); -is_float_op(Op, [_Other,float]) -> +is_float_op(Op, [_Other,#t_float{}]) -> is_float_op_1(Op); is_float_op(_, _) -> false. @@ -691,486 +1326,365 @@ is_float_op_1('-') -> true; is_float_op_1('*') -> true; is_float_op_1(_) -> false. -anno_float_arg(float) -> float; +anno_float_arg(#t_float{}) -> float; anno_float_arg(_) -> convert. -opt_terminator(#b_br{bool=#b_literal{}}=Br, _Ts, _Ds) -> - beam_ssa:normalize(Br); -opt_terminator(#b_br{bool=#b_var{}}=Br, Ts, Ds) -> - simplify_not(Br, Ts, Ds); -opt_terminator(#b_switch{arg=#b_literal{}}=Sw, _Ts, _Ds) -> - beam_ssa:normalize(Sw); -opt_terminator(#b_switch{arg=#b_var{}=V}=Sw, Ts, Ds) -> - case get_type(V, Ts) of - any -> - beam_ssa:normalize(Sw); - Type -> - beam_ssa:normalize(opt_switch(Sw, Type, Ts, Ds)) - end; -opt_terminator(#b_ret{}=Ret, _Ts, _Ds) -> Ret. - - -opt_switch(#b_switch{fail=Fail,list=List0}=Sw0, Type, Ts, Ds) -> - List = prune_switch_list(List0, Fail, Type, Ts), - Sw1 = Sw0#b_switch{list=List}, - case Type of - #t_integer{elements={_,_}=Range} -> - simplify_switch_int(Sw1, Range); - #t_atom{elements=[_|_]} -> - case t_is_boolean(Type) of - true -> - #b_br{} = Br = simplify_switch_bool(Sw1, Ts, Ds), - opt_terminator(Br, Ts, Ds); - false -> - simplify_switch_atom(Type, Sw1) - end; - _ -> - Sw1 - end. +%%% +%%% Type helpers +%%% -prune_switch_list([{_,Fail}|T], Fail, Type, Ts) -> - prune_switch_list(T, Fail, Type, Ts); -prune_switch_list([{Arg,_}=Pair|T], Fail, Type, Ts) -> - case meet(get_type(Arg, Ts), Type) of - none -> - %% Different types. This value can never match. - prune_switch_list(T, Fail, Type, Ts); - _ -> - [Pair|prune_switch_list(T, Fail, Type, Ts)] - end; -prune_switch_list([], _, _, _) -> []. +%% Returns the narrowest possible return type for the given success types and +%% arguments. +return_type(SuccTypes0, CallArgs0) -> + SuccTypes = st_filter_reachable(SuccTypes0, CallArgs0, [], []), + st_join_return_types(SuccTypes, none). -update_successors(#b_br{bool=#b_literal{val=true},succ=S}, Ts, D) -> - update_successor(S, Ts, D); -update_successors(#b_br{bool=#b_var{}=Bool,succ=Succ,fail=Fail}, Ts0, D0) -> - case cerl_sets:is_element(Bool, D0#d.once) of +st_filter_reachable([{SuccArgs, {call_self, SelfArgs}}=SuccType | Rest], + CallArgs0, Deferred, Acc) -> + case st_is_reachable(SuccArgs, CallArgs0) of true -> - %% This variable is defined in this block and is only - %% referenced by this br terminator. Therefore, there is - %% no need to include it in the type database passed on to - %% the successors of this block. - Ts = maps:remove(Bool, Ts0), - {SuccTs,FailTs} = infer_types_br(Bool, Ts, D0), - D = update_successor(Fail, FailTs, D0), - update_successor(Succ, SuccTs, D); + %% If we return a call to ourselves, we need to join our current + %% argument types with that of the call to ensure all possible + %% return paths are covered. + CallArgs = parallel_join(SelfArgs, CallArgs0), + st_filter_reachable(Rest, CallArgs, Deferred, Acc); false -> - {SuccTs,FailTs} = infer_types_br(Bool, Ts0, D0), - D = update_successor_bool(Bool, false, Fail, FailTs, D0), - update_successor_bool(Bool, true, Succ, SuccTs, D) + %% This may be reachable after we've joined another self-call, so + %% we defer it until we've gone through all other self-calls. + st_filter_reachable(Rest, CallArgs0, [SuccType | Deferred], Acc) end; -update_successors(#b_switch{arg=#b_var{}=V,fail=Fail,list=List}, Ts, D0) -> - case cerl_sets:is_element(V, D0#d.once) of +st_filter_reachable([SuccType | Rest], CallArgs, Deferred, Acc) -> + st_filter_reachable(Rest, CallArgs, Deferred, [SuccType | Acc]); +st_filter_reachable([], CallArgs, Deferred, Acc) -> + case st_any_reachable(Deferred, CallArgs) of true -> - %% This variable is defined in this block and is only - %% referenced by this switch terminator. Therefore, there is - %% no need to include it in the type database passed on to - %% the successors of this block. - D = update_successor(Fail, Ts, D0), - F = fun({Val,S}, A) -> - SuccTs0 = infer_types_switch(V, Val, Ts, D), - SuccTs = maps:remove(V, SuccTs0), - update_successor(S, SuccTs, A) - end, - foldl(F, D, List); + %% Handle all deferred self calls that may be reachable now that + %% we've expanded our argument types. + st_filter_reachable(Deferred, CallArgs, [], Acc); false -> - %% V can not be equal to any of the values in List at the fail - %% block. - FailTs = subtract_sw_list(V, List, Ts), - D = update_successor(Fail, FailTs, D0), - F = fun({Val,S}, A) -> - SuccTs = infer_types_switch(V, Val, Ts, D), - update_successor(S, SuccTs, A) - end, - foldl(F, D, List) - end; -update_successors(#b_ret{arg=Arg}, Ts, D) -> - FuncId = D#d.func_id, - case D#d.ds of - #{ Arg := #b_set{op=call,args=[FuncId | _]} } -> - %% Returning a call to ourselves doesn't affect our own return - %% type. - D; - #{} -> - RetType = join([get_type(Arg, Ts) | D#d.ret_type]), - D#d{ret_type=[RetType]} + %% We have no reachable self calls, so we know our argument types + %% can't expand any further. Filter out our reachable sites and + %% return. + [ST || {SuccArgs, _}=ST <- Acc, st_is_reachable(SuccArgs, CallArgs)] end. -subtract_sw_list(V, List, Ts) -> - Ts#{ V := sub_sw_list_1(get_type(V, Ts), List, Ts) }. +st_join_return_types([{_SuccArgs, SuccRet} | Rest], Acc0) -> + st_join_return_types(Rest, beam_types:join(SuccRet, Acc0)); +st_join_return_types([], Acc) -> + Acc. -sub_sw_list_1(Type, [{Val,_}|T], Ts) -> - ValType = get_type(Val, Ts), - sub_sw_list_1(subtract(Type, ValType), T, Ts); -sub_sw_list_1(Type, [], _Ts) -> - Type. +st_any_reachable([{SuccArgs, _} | SuccType], CallArgs) -> + case st_is_reachable(SuccArgs, CallArgs) of + true -> true; + false -> st_any_reachable(SuccType, CallArgs) + end; +st_any_reachable([], _CallArgs) -> + false. -update_successor_bool(#b_var{}=Var, BoolValue, S, Ts, D) -> - case t_is_boolean(get_type(Var, Ts)) of - true -> - update_successor(S, Ts#{Var:=t_atom(BoolValue)}, D); - false -> - %% The `br` terminator is preceeded by an instruction that - %% does not produce a boolean value, such a `new_try_tag`. - update_successor(S, Ts, D) - end. +st_is_reachable([A | SuccArgs], [B | CallArgs]) -> + case beam_types:meet(A, B) of + none -> false; + _Other -> st_is_reachable(SuccArgs, CallArgs) + end; +st_is_reachable([], []) -> + true. + +update_success_types(#b_ret{arg=Arg}, Ts, Ds, Meta, SuccTypes) -> + #metadata{ func_id=FuncId, + limit_return=Limited, + params=Params } = Meta, + + RetType = case Ds of + #{ Arg := #b_set{op=call,args=[FuncId | Args]} } -> + {call_self, argument_types(Args, Ts)}; + #{} -> + argument_type(Arg, Ts) + end, + ArgTypes = argument_types(Params, Ts), + + case Limited of + true -> ust_limited(SuccTypes, ArgTypes, RetType); + false -> ust_unlimited(SuccTypes, ArgTypes, RetType) + end; +update_success_types(_Last, _Ts, _Ds, _Meta, SuccTypes) -> + SuccTypes. + +%% See ?RETURN_LIMIT for details. +ust_limited(SuccTypes, CallArgs, {call_self, SelfArgs}) -> + NewArgs = parallel_join(CallArgs, SelfArgs), + ust_limited_1(SuccTypes, NewArgs, none); +ust_limited(SuccTypes, CallArgs, CallRet) -> + ust_limited_1(SuccTypes, CallArgs, CallRet). + +ust_limited_1([], ArgTypes, RetType) -> + [{ArgTypes, RetType}]; +ust_limited_1([{SuccArgs, SuccRet}], CallArgs, CallRet) -> + NewTypes = parallel_join(SuccArgs, CallArgs), + NewType = beam_types:join(SuccRet, CallRet), + [{NewTypes, NewType}]. + +%% Adds a new success type, collapsing it with entries that have the same +%% return type to keep the list short. +ust_unlimited(SuccTypes, _CallArgs, none) -> + %% 'none' is implied since functions can always fail. + SuccTypes; +ust_unlimited([{SuccArgs, Same} | SuccTypes], CallArgs, Same) -> + NewArgs = parallel_join(SuccArgs, CallArgs), + [{NewArgs, Same} | SuccTypes]; +ust_unlimited([SuccType | SuccTypes], CallArgs, CallRet) -> + [SuccType | ust_unlimited(SuccTypes, CallArgs, CallRet)]; +ust_unlimited([], CallArgs, CallRet) -> + [{CallArgs, CallRet}]. + +update_successors(#b_br{bool=#b_literal{val=true},succ=Succ}=Last, + Ts, _Ds, Ls, _UsedOnce) -> + {Last, update_successor(Succ, Ts, Ls)}; +update_successors(#b_br{bool=#b_var{}=Bool,succ=Succ,fail=Fail}=Last0, + Ts, Ds, Ls0, UsedOnce) -> + IsTempVar = cerl_sets:is_element(Bool, UsedOnce), + case infer_types_br(Bool, Ts, IsTempVar, Ds) of + {#{}=SuccTs, #{}=FailTs} -> + Ls1 = update_successor(Succ, SuccTs, Ls0), + Ls = update_successor(Fail, FailTs, Ls1), + {Last0, Ls}; + {#{}=SuccTs, none} -> + Last = Last0#b_br{bool=#b_literal{val=true},fail=Succ}, + {Last, update_successor(Succ, SuccTs, Ls0)}; + {none, #{}=FailTs} -> + Last = Last0#b_br{bool=#b_literal{val=true},succ=Fail}, + {Last, update_successor(Fail, FailTs, Ls0)} + end; +update_successors(#b_switch{arg=#b_var{}=V,fail=Fail0,list=List0}=Last0, + Ts, Ds, Ls0, UsedOnce) -> + IsTempVar = cerl_sets:is_element(V, UsedOnce), + + {List1, FailTs, Ls1} = + update_switch(List0, V, raw_type(V, Ts), Ts, Ds, Ls0, IsTempVar, []), + + case FailTs of + none -> + %% The fail block is unreachable; swap it with one of the choices. + case List1 of + [{#b_literal{val=0},_}|_] -> + %% Swap with the last choice in order to keep the zero the + %% first choice. If the loader can substitute a jump table + %% instruction, then a shorter version of the jump table + %% instruction can be used if the first value is zero. + {List, [{_,Fail}]} = split(length(List1)-1, List1), + Last = Last0#b_switch{fail=Fail,list=List}, + {Last, Ls1}; + [{_,Fail}|List] -> + %% Swap with the first choice in the list. + Last = Last0#b_switch{fail=Fail,list=List}, + {Last, Ls1} + end; + #{} -> + Ls = update_successor(Fail0, FailTs, Ls1), + Last = Last0#b_switch{list=List1}, + {Last, Ls} + end; +update_successors(#b_ret{}=Last, _Ts, _Ds, Ls, _UsedOnce) -> + {Last, Ls}. -update_successor(?BADARG_BLOCK, _Ts, #d{}=D) -> - %% We KNOW that no variables are used in the ?BADARG_BLOCK, +update_switch([{Val, Lbl}=Sw | List], + V, FailType0, Ts, Ds, Ls0, IsTempVar, Acc) -> + FailType = beam_types:subtract(FailType0, raw_type(Val, Ts)), + case infer_types_switch(V, Val, Ts, IsTempVar, Ds) of + none -> + update_switch(List, V, FailType, Ts, Ds, Ls0, IsTempVar, Acc); + SwTs -> + Ls = update_successor(Lbl, SwTs, Ls0), + update_switch(List, V, FailType, Ts, Ds, Ls, IsTempVar, [Sw | Acc]) + end; +update_switch([], _V, none, _Ts, _Ds, Ls, _IsTempVar, Acc) -> + %% Fail label is unreachable. + {reverse(Acc), none, Ls}; +update_switch([], V, FailType, Ts, Ds, Ls, IsTempVar, Acc) -> + %% Fail label is reachable, see if we can narrow the type down further. + FailTs = case beam_types:get_singleton_value(FailType) of + {ok, Value} -> + %% This is the only possible value at the fail label, so + %% we can infer types as if we matched it directly. + Lit = #b_literal{val=Value}, + infer_types_switch(V, Lit, Ts, IsTempVar, Ds); + error when IsTempVar -> + ts_remove_var(V, Ts); + error -> + Ts#{ V := FailType } + end, + {reverse(Acc), FailTs, Ls}. + +update_successor(?EXCEPTION_BLOCK, _Ts, Ls) -> + %% We KNOW that no variables are used in the ?EXCEPTION_BLOCK, %% so there is no need to update the type information. That %% can be a huge timesaver for huge functions. - D; -update_successor(S, Ts0, #d{ls=Ls}=D) -> + Ls; +update_successor(S, Ts0, Ls) -> case Ls of - #{S:=Ts1} -> + #{ S := Ts1 } -> Ts = join_types(Ts0, Ts1), - D#d{ls=Ls#{S:=Ts}}; + Ls#{ S := Ts }; #{} -> - D#d{ls=Ls#{S=>Ts0}} + Ls#{ S => Ts0 } end. -update_types(#b_set{op=Op,dst=Dst,args=Args}, Ts, Ds) -> - T = type(Op, Args, Ts, Ds), +update_types(#b_set{op=Op,dst=Dst,anno=Anno,args=Args}, Ts, Ds) -> + T = type(Op, Args, Anno, Ts, Ds), Ts#{Dst=>T}. -type(phi, Args, Ts, _Ds) -> - Types = [get_type(A, Ts) || {A,_} <- Args], - join(Types); -type({bif,'band'}, Args, Ts, _Ds) -> - band_type(Args, Ts); -type({bif,Bif}, Args, Ts, _Ds) -> - case bif_type(Bif, Args) of - number -> - arith_op_type(Args, Ts); - Type -> - Type +type(phi, Args, _Anno, Ts, _Ds) -> + Types = [raw_type(A, Ts) || {A,_} <- Args], + beam_types:join(Types); +type({bif,Bif}, Args, _Anno, Ts, _Ds) -> + ArgTypes = normalized_types(Args, Ts), + {RetType, _, _} = beam_call_types:types(erlang, Bif, ArgTypes), + RetType; +type(bs_init, _Args, _Anno, _Ts, _Ds) -> + #t_bitstring{}; +type(bs_extract, [Ctx], _Anno, _Ts, Ds) -> + #b_set{op=bs_match,args=Args} = map_get(Ctx, Ds), + bs_match_type(Args); +type(bs_start_match, [_, Src], _Anno, Ts, _Ds) -> + case beam_types:meet(#t_bs_matchable{}, raw_type(Src, Ts)) of + none -> + none; + T -> + Unit = beam_types:get_bs_matchable_unit(T), + #t_bs_context{tail_unit=Unit} end; -type(bs_init, _Args, _Ts, _Ds) -> - {binary, 1}; -type(bs_extract, [Ctx], Ts, _Ds) -> - #t_bs_match{type=Type} = get_type(Ctx, Ts), - Type; -type(bs_match, Args, _Ts, _Ds) -> - #t_bs_match{type=bs_match_type(Args)}; -type(bs_get_tail, _Args, _Ts, _Ds) -> - {binary, 1}; +type(bs_match, [#b_literal{val=binary}, Ctx, _Flags, + #b_literal{val=all}, #b_literal{val=OpUnit}], + _Anno, Ts, _Ds) -> + + %% This is an explicit tail unit test which does not advance the match + %% position. + CtxType = raw_type(Ctx, Ts), + OpType = #t_bs_context{tail_unit=OpUnit}, + + beam_types:meet(CtxType, OpType); +type(bs_match, Args, _Anno, Ts, _Ds) -> + [_, Ctx | _] = Args, + + %% Matches advance the current position without testing the tail unit. We + %% try to retain unit information by taking the GCD of our current unit and + %% the increments we know the match will advance by. + #t_bs_context{tail_unit=CtxUnit} = raw_type(Ctx, Ts), + OpUnit = bs_match_stride(Args, Ts), + + #t_bs_context{tail_unit=gcd(OpUnit, CtxUnit)}; +type(bs_get_tail, [Ctx], _Anno, Ts, _Ds) -> + #t_bs_context{tail_unit=Unit} = raw_type(Ctx, Ts), + #t_bitstring{size_unit=Unit}; type(call, [#b_remote{mod=#b_literal{val=Mod}, - name=#b_literal{val=Name}}|Args], Ts, _Ds) -> - case {Mod,Name,Args} of - {erlang,setelement,[Pos,Tuple,Arg]} -> - case {get_type(Pos, Ts),get_type(Tuple, Ts)} of - {#t_integer{elements={Index,Index}}, - #t_tuple{elements=Es0,size=Size}=T} -> - %% This is an exact index, update the type of said element - %% or return 'none' if it's known to be out of bounds. - Es = set_element_type(Index, get_type(Arg, Ts), Es0), - case T#t_tuple.exact of - false -> - T#t_tuple{size=max(Index, Size),elements=Es}; - true when Index =< Size -> - T#t_tuple{elements=Es}; - true -> - none - end; - {#t_integer{elements={Min,_}}=IntType, - #t_tuple{elements=Es0,size=Size}=T} -> - %% Remove type information for all indices that - %% falls into the range of the integer. - Es = remove_element_info(IntType, Es0), - case T#t_tuple.exact of - false -> - T#t_tuple{elements=Es,size=max(Min, Size)}; - true when Min =< Size -> - T#t_tuple{elements=Es,size=Size}; - true -> - none - end; - {_,#t_tuple{}=T} -> - %% Position unknown, so we have to discard all element - %% information. - T#t_tuple{elements=#{}}; - {#t_integer{elements={Min,_Max}},_} -> - #t_tuple{size=Min}; - {_,_} -> - #t_tuple{} - end; - {erlang,'++',[LHS,RHS]} -> - LType = get_type(LHS, Ts), - RType = get_type(RHS, Ts), - case LType =:= cons orelse RType =:= cons of - true -> - cons; - false -> - %% `[] ++ RHS` yields RHS, even if RHS is not a list. - join(list, RType) - end; - {erlang,'--',[_,_]} -> - list; - {lists,F,Args} -> - Types = get_types(Args, Ts), - lists_function_type(F, Types); - {math,_,_} -> - case is_math_bif(Name, length(Args)) of - false -> any; - true -> float - end; - {_,_,_} -> - case erl_bifs:is_exit_bif(Mod, Name, length(Args)) of - true -> none; - false -> any - end + name=#b_literal{val=Name}}|Args], _Anno, Ts, _Ds) -> + ArgTypes = normalized_types(Args, Ts), + {RetType, _, _} = beam_call_types:types(Mod, Name, ArgTypes), + RetType; +type(call, [#b_remote{} | _Args], _Anno, _Ts, _Ds) -> + %% Remote call with variable Module and/or Function. + any; +type(call, [#b_local{} | _Args], Anno, _Ts, _Ds) -> + case Anno of + #{ result_type := Type } -> Type; + #{} -> any end; -type(get_tuple_element, [Tuple, Offset], Ts, _Ds) -> - #t_tuple{size=Size,elements=Es} = get_type(Tuple, Ts), +type(call, [#b_var{} | _Args], Anno, _Ts, _Ds) -> + case Anno of + #{ result_type := Type } -> Type; + #{} -> any + end; +type(call, [#b_literal{} | _Args], _Anno, _Ts, _Ds) -> + none; +type(get_hd, [Src], _Anno, Ts, _Ds) -> + SrcType = #t_cons{} = normalized_type(Src, Ts), %Assertion. + {RetType, _, _} = beam_call_types:types(erlang, hd, [SrcType]), + RetType; +type(get_tl, [Src], _Anno, Ts, _Ds) -> + SrcType = #t_cons{} = normalized_type(Src, Ts), %Assertion. + {RetType, _, _} = beam_call_types:types(erlang, tl, [SrcType]), + RetType; +type(get_map_element, [_, _]=Args0, _Anno, Ts, _Ds) -> + [#t_map{}=Map, Key] = normalized_types(Args0, Ts), %Assertion. + {RetType, _, _} = beam_call_types:types(erlang, map_get, [Key, Map]), + RetType; +type(get_tuple_element, [Tuple, Offset], _Anno, Ts, _Ds) -> + #t_tuple{size=Size,elements=Es} = normalized_type(Tuple, Ts), #b_literal{val=N} = Offset, true = Size > N, %Assertion. - get_element_type(N + 1, Es); -type(is_nonempty_list, [_], _Ts, _Ds) -> - t_boolean(); -type(is_tagged_tuple, [_,#b_literal{},#b_literal{}], _Ts, _Ds) -> - t_boolean(); -type(put_map, _Args, _Ts, _Ds) -> - map; -type(put_list, _Args, _Ts, _Ds) -> - cons; -type(put_tuple, Args, Ts, _Ds) -> + beam_types:get_tuple_element(N + 1, Es); +type(has_map_field, [_, _]=Args0, _Anno, Ts, _Ds) -> + [#t_map{}=Map, Key] = normalized_types(Args0, Ts), %Assertion. + {RetType, _, _} = beam_call_types:types(erlang, is_map_key, [Key, Map]), + RetType; +type(is_nonempty_list, [_], _Anno, _Ts, _Ds) -> + beam_types:make_boolean(); +type(is_tagged_tuple, [_,#b_literal{},#b_literal{}], _Anno, _Ts, _Ds) -> + beam_types:make_boolean(); +type(make_fun, [#b_local{arity=TotalArity} | Env], Anno, _Ts, _Ds) -> + RetType = case Anno of + #{ result_type := Type } -> Type; + #{} -> any + end, + #t_fun{arity=TotalArity - length(Env), type=RetType}; +type(put_map, [_Kind, Map | Ss], _Anno, Ts, _Ds) -> + put_map_type(Map, Ss, Ts); +type(put_list, [Head, Tail], _Anno, Ts, _Ds) -> + HeadType = raw_type(Head, Ts), + TailType = raw_type(Tail, Ts), + beam_types:make_cons(HeadType, TailType); +type(put_tuple, Args, _Anno, Ts, _Ds) -> {Es, _} = foldl(fun(Arg, {Es0, Index}) -> - Type = get_type(Arg, Ts), - Es = set_element_type(Index, Type, Es0), - {Es, Index + 1} + Type = raw_type(Arg, Ts), + Es = beam_types:set_tuple_element(Index, Type, Es0), + {Es, Index + 1} end, {#{}, 1}, Args), #t_tuple{exact=true,size=length(Args),elements=Es}; -type(succeeded, [#b_var{}=Src], Ts, Ds) -> - case maps:get(Src, Ds) of - #b_set{op={bif,Bif},args=BifArgs} -> - Types = get_types(BifArgs, Ts), - case {Bif,Types} of - {BoolOp,[T1,T2]} when BoolOp =:= 'and'; BoolOp =:= 'or' -> - case t_is_boolean(T1) andalso t_is_boolean(T2) of - true -> t_atom(true); - false -> t_boolean() - end; - {byte_size,[{binary,_}]} -> - t_atom(true); - {bit_size,[{binary,_}]} -> - t_atom(true); - {map_size,[map]} -> - t_atom(true); - {'not',[Type]} -> - case t_is_boolean(Type) of - true -> t_atom(true); - false -> t_boolean() - end; - {size,[{binary,_}]} -> - t_atom(true); - {tuple_size,[#t_tuple{}]} -> - t_atom(true); - {_,_} -> - t_boolean() - end; - #b_set{op=get_hd} -> - t_atom(true); - #b_set{op=get_tl} -> - t_atom(true); - #b_set{op=get_tuple_element} -> - t_atom(true); - #b_set{op=wait} -> - t_atom(false); - #b_set{} -> - t_boolean() - end; -type(succeeded, [#b_literal{}], _Ts, _Ds) -> - t_atom(true); -type(_, _, _, _) -> any. - -arith_op_type(Args, Ts) -> - Types = get_types(Args, Ts), - foldl(fun(#t_integer{}, unknown) -> t_integer(); - (#t_integer{}, number) -> number; - (#t_integer{}, float) -> float; - (#t_integer{}, #t_integer{}) -> t_integer(); - (float, unknown) -> float; - (float, #t_integer{}) -> float; - (float, number) -> float; - (number, unknown) -> number; - (number, #t_integer{}) -> number; - (number, float) -> float; - (any, _) -> number; - (Same, Same) -> Same; - (_, _) -> none - end, unknown, Types). - -lists_function_type(F, Types) -> - case {F,Types} of - %% Functions that return booleans. - {all,[_,_]} -> - t_boolean(); - {any,[_,_]} -> - t_boolean(); - {keymember,[_,_,_]} -> - t_boolean(); - {member,[_,_]} -> - t_boolean(); - {prefix,[_,_]} -> - t_boolean(); - {suffix,[_,_]} -> - t_boolean(); - - %% Functions that return lists. - {dropwhile,[_,_]} -> - list; - {duplicate,[_,_]} -> - list; - {filter,[_,_]} -> - list; - {flatten,[_]} -> - list; - {map,[_Fun,List]} -> - same_length_type(List); - {MapFold,[_Fun,_Acc,List]} when MapFold =:= mapfoldl; - MapFold =:= mapfoldr -> - #t_tuple{size=2,exact=true, - elements=#{1=>same_length_type(List)}}; - {partition,[_,_]} -> - t_two_tuple(list, list); - {reverse,[List]} -> - same_length_type(List); - {sort,[List]} -> - same_length_type(List); - {splitwith,[_,_]} -> - t_two_tuple(list, list); - {takewhile,[_,_]} -> - list; - {unzip,[List]} -> - ListType = same_length_type(List), - t_two_tuple(ListType, ListType); - {usort,[List]} -> - same_length_type(List); - {zip,[_,_]} -> - list; - {zipwith,[_,_,_]} -> - list; - {_,_} -> - any - end. +type(_, _, _, _, _) -> any. -%% For a lists function that return a list of the same -%% length as the input list, return the type of the list. -same_length_type(cons) -> cons; -same_length_type(nil) -> nil; -same_length_type(_) -> list. +put_map_type(Map, Ss, Ts) -> + pmt_1(Ss, Ts, normalized_type(Map, Ts)). -t_two_tuple(Type1, Type2) -> - #t_tuple{size=2,exact=true, - elements=#{1=>Type1,2=>Type2}}. - -%% will_succeed(TestOperation, Type) -> yes|no|maybe. -%% Test whether TestOperation applied to an argument of type Type -%% will succeed. Return yes, no, or maybe. -%% -%% Type is a type as described in the comment for verified_type/1 at -%% the very end of this file, but it will *never* be 'any'. - -will_succeed(is_atom, Type) -> - case Type of - #t_atom{} -> yes; - _ -> no - end; -will_succeed(is_binary, Type) -> - case Type of - {binary,U} when U rem 8 =:= 0 -> yes; - {binary,_} -> maybe; - _ -> no - end; -will_succeed(is_bitstring, Type) -> - case Type of - {binary,_} -> yes; - _ -> no - end; -will_succeed(is_boolean, Type) -> - case Type of - #t_atom{elements=any} -> - maybe; - #t_atom{elements=Es} -> - case t_is_boolean(Type) of - true -> - yes; - false -> - case any(fun is_boolean/1, Es) of - true -> maybe; - false -> no - end - end; - _ -> - no - end; -will_succeed(is_float, Type) -> - case Type of - float -> yes; - number -> maybe; - _ -> no - end; -will_succeed(is_integer, Type) -> - case Type of - #t_integer{} -> yes; - number -> maybe; - _ -> no - end; -will_succeed(is_list, Type) -> - case Type of - list -> yes; - cons -> yes; - _ -> no - end; -will_succeed(is_map, Type) -> - case Type of - map -> yes; - _ -> no - end; -will_succeed(is_number, Type) -> - case Type of - float -> yes; - #t_integer{} -> yes; - number -> yes; - _ -> no - end; -will_succeed(is_tuple, Type) -> - case Type of - #t_tuple{} -> yes; - _ -> no - end; -will_succeed(_, _) -> maybe. - - -band_type([Other,#b_literal{val=Int}], Ts) when is_integer(Int) -> - band_type_1(Int, Other, Ts); -band_type([_,_], _) -> t_integer(). +pmt_1([Key0, Value0 | Ss], Ts, Acc0) -> + Key = normalized_type(Key0, Ts), + Value = normalized_type(Value0, Ts), + {Acc, _, _} = beam_call_types:types(maps, put, [Key, Value, Acc0]), + pmt_1(Ss, Ts, Acc); +pmt_1([], _Ts, Acc) -> + Acc. -band_type_1(Int, OtherSrc, Ts) -> - Type = band_type_2(Int, 0), - OtherType = get_type(OtherSrc, Ts), - meet(Type, OtherType). +%% We seldom know how far a match operation may advance, but we can often tell +%% which increment it will advance by. +bs_match_stride([#b_literal{val=Type} | Args], Ts) -> + bs_match_stride(Type, Args, Ts). -band_type_2(N, Bits) when Bits < 64 -> - case 1 bsl Bits of - P when P =:= N + 1 -> - t_integer(0, N); - P when P > N + 1 -> - t_integer(); +bs_match_stride(_, [_,_,Size,#b_literal{val=Unit}], Ts) -> + case raw_type(Size, Ts) of + #t_integer{elements={Sz, Sz}} when is_integer(Sz) -> + Sz * Unit; _ -> - band_type_2(N, Bits+1) + Unit end; -band_type_2(_, _) -> - %% Negative or large positive number. Give up. - t_integer(). +bs_match_stride(string, [_,#b_literal{val=String}], _) -> + bit_size(String); +bs_match_stride(utf8, _, _) -> + 8; +bs_match_stride(utf16, _, _) -> + 16; +bs_match_stride(utf32, _, _) -> + 32; +bs_match_stride(_, _, _) -> + 1. + +-define(UNICODE_MAX, (16#10FFFF)). bs_match_type([#b_literal{val=Type}|Args]) -> bs_match_type(Type, Args). bs_match_type(binary, Args) -> [_,_,_,#b_literal{val=U}] = Args, - {binary,U}; + #t_bitstring{size_unit=U}; bs_match_type(float, _) -> - float; + #t_float{}; bs_match_type(integer, Args) -> case Args of [_, @@ -1180,194 +1694,48 @@ bs_match_type(integer, Args) -> NumBits = Size * Unit, case member(unsigned, Flags) of true -> - t_integer(0, (1 bsl NumBits)-1); + beam_types:make_integer(0, (1 bsl NumBits)-1); false -> %% Signed integer. Don't bother. - t_integer() + #t_integer{} end; [_|_] -> - t_integer() + #t_integer{} end; bs_match_type(skip, _) -> any; bs_match_type(string, _) -> any; bs_match_type(utf8, _) -> - ?UNICODE_INT; + beam_types:make_integer(0, ?UNICODE_MAX); bs_match_type(utf16, _) -> - ?UNICODE_INT; + beam_types:make_integer(0, ?UNICODE_MAX); bs_match_type(utf32, _) -> - ?UNICODE_INT. - -simplify_switch_atom(#t_atom{elements=Atoms}, #b_switch{list=List0}=Sw) -> - case sort([A || {#b_literal{val=A},_} <- List0]) of - Atoms -> - %% All possible atoms are included in the list. The - %% failure label will never be used. - [{_,Fail}|List] = List0, - Sw#b_switch{fail=Fail,list=List}; - _ -> - Sw - end. - -simplify_switch_int(#b_switch{list=List0}=Sw, {Min,Max}) -> - List1 = sort(List0), - Vs = [V || {#b_literal{val=V},_} <- List1], - case eq_ranges(Vs, Min, Max) of - true -> - {_,LastL} = last(List1), - List = droplast(List1), - Sw#b_switch{fail=LastL,list=List}; - false -> - Sw - end. - -eq_ranges([H], H, H) -> true; -eq_ranges([H|T], H, Max) -> eq_ranges(T, H+1, Max); -eq_ranges(_, _, _) -> false. - -simplify_is_record(I, #t_tuple{exact=Exact, - size=Size, - elements=Es}, - RecSize, RecTag, Ts) -> - TagType = maps:get(1, Es, any), - TagMatch = case get_literal_from_type(TagType) of - #b_literal{}=RecTag -> yes; - #b_literal{} -> no; - none -> - %% Is it at all possible for the tag to match? - case meet(get_type(RecTag, Ts), TagType) of - none -> no; - _ -> maybe - end - end, - if - Size =/= RecSize, Exact; Size > RecSize; TagMatch =:= no -> - #b_literal{val=false}; - Size =:= RecSize, Exact, TagMatch =:= yes -> - #b_literal{val=true}; - true -> - I - end; -simplify_is_record(I, any, _Size, _Tag, _Ts) -> - I; -simplify_is_record(_I, _Type, _Size, _Tag, _Ts) -> - #b_literal{val=false}. - -simplify_switch_bool(#b_switch{arg=B,fail=Fail,list=List0}, Ts, Ds) -> - FalseVal = #b_literal{val=false}, - TrueVal = #b_literal{val=true}, - List1 = List0 ++ [{FalseVal,Fail},{TrueVal,Fail}], - {_,FalseLbl} = keyfind(FalseVal, 1, List1), - {_,TrueLbl} = keyfind(TrueVal, 1, List1), - Br = beam_ssa:normalize(#b_br{bool=B,succ=TrueLbl,fail=FalseLbl}), - simplify_not(Br, Ts, Ds). - -simplify_not(#b_br{bool=#b_var{}=V,succ=Succ,fail=Fail}=Br0, Ts, Ds) -> - case Ds of - #{V:=#b_set{op={bif,'not'},args=[Bool]}} -> - case t_is_boolean(get_type(Bool, Ts)) of - true -> - Br = Br0#b_br{bool=Bool,succ=Fail,fail=Succ}, - beam_ssa:normalize(Br); - false -> - Br0 - end; - #{} -> - Br0 - end; -simplify_not(#b_br{bool=#b_literal{}}=Br, _Ts, _Ds) -> Br. + beam_types:make_integer(0, ?UNICODE_MAX). -%%% -%%% Calculate the set of variables that are only used once in the -%%% terminator of the block that defines them. That will allow us to -%%% discard type information for variables that will never be -%%% referenced by the successor blocks, potentially improving -%%% compilation times. -%%% +normalized_types(Values, Ts) -> + [normalized_type(Val, Ts) || Val <- Values]. -used_once(Linear, Args) -> - Map0 = used_once_1(reverse(Linear), #{}), - Map = maps:without(Args, Map0), - cerl_sets:from_list(maps:keys(Map)). +normalized_type(V, Ts) -> + beam_types:normalize(raw_type(V, Ts)). -used_once_1([{L,#b_blk{is=Is,last=Last}}|Bs], Uses0) -> - Uses1 = used_once_last_uses(beam_ssa:used(Last), L, Uses0), - Uses = used_once_2(reverse(Is), L, Uses1), - used_once_1(Bs, Uses); -used_once_1([], Uses) -> Uses. +argument_types(Values, Ts) -> + [argument_type(Val, Ts) || Val <- Values]. -used_once_2([#b_set{dst=Dst}=I|Is], L, Uses0) -> - Uses = used_once_uses(beam_ssa:used(I), L, Uses0), - case Uses of - #{Dst:=[L]} -> - used_once_2(Is, L, Uses); - #{} -> - %% Used more than once or used once in - %% in another block. - used_once_2(Is, L, maps:remove(Dst, Uses)) - end; -used_once_2([], _, Uses) -> Uses. - -used_once_uses([V|Vs], L, Uses) -> - case Uses of - #{V:=more_than_once} -> - used_once_uses(Vs, L, Uses); - #{} -> - %% Already used or first use is not in - %% a terminator. - used_once_uses(Vs, L, Uses#{V=>more_than_once}) - end; -used_once_uses([], _, Uses) -> Uses. +-spec argument_type(beam_ssa:value(), type_db()) -> type(). -used_once_last_uses([V|Vs], L, Uses) -> - case Uses of - #{V:=[_]} -> - %% Second time this variable is used. - used_once_last_uses(Vs, L, Uses#{V:=more_than_once}); - #{V:=more_than_once} -> - %% Used at least twice before. - used_once_last_uses(Vs, L, Uses); - #{} -> - %% First time this variable is used. - used_once_last_uses(Vs, L, Uses#{V=>[L]}) - end; -used_once_last_uses([], _, Uses) -> Uses. +argument_type(V, Ts) -> + beam_types:limit_depth(raw_type(V, Ts)). +raw_types(Values, Ts) -> + [raw_type(Val, Ts) || Val <- Values]. -get_types(Values, Ts) -> - [get_type(Val, Ts) || Val <- Values]. --spec get_type(beam_ssa:value(), type_db()) -> type(). +-spec raw_type(beam_ssa:value(), type_db()) -> type(). -get_type(#b_var{}=V, Ts) -> - #{V:=T} = Ts, - T; -get_type(#b_literal{val=Val}, _Ts) -> - if - is_atom(Val) -> - t_atom(Val); - is_float(Val) -> - float; - is_integer(Val) -> - t_integer(Val); - is_list(Val), Val =/= [] -> - cons; - is_map(Val) -> - map; - Val =:= {} -> - #t_tuple{exact=true}; - is_tuple(Val) -> - {Es, _} = foldl(fun(E, {Es0, Index}) -> - Type = get_type(#b_literal{val=E}, #{}), - Es = set_element_type(Index, Type, Es0), - {Es, Index + 1} - end, {#{}, 1}, tuple_to_list(Val)), - #t_tuple{exact=true,size=tuple_size(Val),elements=Es}; - Val =:= [] -> - nil; - true -> - any - end. +raw_type(#b_literal{val=Value}, _Ts) -> + beam_types:make_type_from_value(Value); +raw_type(V, Ts) -> + map_get(V, Ts). %% infer_types(Var, Types, #d{}) -> {SuccTypes,FailTypes} %% Looking at the expression that defines the variable Var, infer @@ -1390,10 +1758,107 @@ get_type(#b_literal{val=Val}, _Ts) -> %% 'cons' would give 'nil' as the only possible type. The result of the %% subtraction for L will be added to FailTypes. -infer_types_br(#b_var{}=V, Ts, #d{ds=Ds}) -> +infer_types_br(#b_var{}=V, Ts, IsTempVar, Ds) -> #{V:=#b_set{op=Op,args=Args}} = Ds, - PosTypes0 = infer_type(Op, Args, Ds), - NegTypes0 = infer_type_negative(Op, Args, Ds), + + {PosTypes, NegTypes} = infer_type(Op, Args, Ts, Ds), + + SuccTs0 = meet_types(PosTypes, Ts), + FailTs0 = subtract_types(NegTypes, Ts), + + case IsTempVar of + true -> + %% The branch variable is defined in this block and is only + %% referenced by this terminator. Therefore, there is no need to + %% include it in the type database passed on to the successors of + %% of this block. + SuccTs = ts_remove_var(V, SuccTs0), + FailTs = ts_remove_var(V, FailTs0), + {SuccTs, FailTs}; + false -> + SuccTs = infer_br_value(V, true, SuccTs0), + FailTs = infer_br_value(V, false, FailTs0), + {SuccTs, FailTs} + end. + +infer_br_value(_V, _Bool, none) -> + none; +infer_br_value(V, Bool, NewTs) -> + #{ V := T } = NewTs, + case beam_types:is_boolean_type(T) of + true -> + NewTs#{ V := beam_types:make_atom(Bool) }; + false -> + %% V is a try/catch tag or similar, leave it alone. + NewTs + end. + +infer_types_switch(V, Lit, Ts0, IsTempVar, Ds) -> + {PosTypes, _} = infer_type({bif,'=:='}, [V, Lit], Ts0, Ds), + Ts = meet_types(PosTypes, Ts0), + case IsTempVar of + true -> ts_remove_var(V, Ts); + false -> Ts + end. + +ts_remove_var(_V, none) -> none; +ts_remove_var(V, Ts) -> maps:remove(V, Ts). + +infer_type(succeeded, [#b_var{}=Src], Ts, Ds) -> + #b_set{op=Op,args=Args} = maps:get(Src, Ds), + infer_success_type(Op, Args, Ts, Ds); + +%% Type tests are handled separately from other BIFs as we're inferring types +%% based on their result, so we know that subtraction is safe even if we're +%% not branching on 'succeeded'. +infer_type(is_tagged_tuple, [#b_var{}=Src,#b_literal{val=Size}, + #b_literal{}=Tag], _Ts, _Ds) -> + Es = beam_types:set_tuple_element(1, raw_type(Tag, #{}), #{}), + T = {Src,#t_tuple{exact=true,size=Size,elements=Es}}, + {[T], [T]}; +infer_type(is_nonempty_list, [#b_var{}=Src], _Ts, _Ds) -> + T = {Src,#t_cons{}}, + {[T], [T]}; +infer_type({bif,is_atom}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_atom{}}, + {[T], [T]}; +infer_type({bif,is_binary}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_bitstring{size_unit=8}}, + {[T], [T]}; +infer_type({bif,is_bitstring}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_bitstring{}}, + {[T], [T]}; +infer_type({bif,is_boolean}, [Arg], _Ts, _Ds) -> + T = {Arg, beam_types:make_boolean()}, + {[T], [T]}; +infer_type({bif,is_float}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_float{}}, + {[T], [T]}; +infer_type({bif,is_integer}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_integer{}}, + {[T], [T]}; +infer_type({bif,is_list}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_list{}}, + {[T], [T]}; +infer_type({bif,is_map}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_map{}}, + {[T], [T]}; +infer_type({bif,is_number}, [Arg], _Ts, _Ds) -> + T = {Arg, number}, + {[T], [T]}; +infer_type({bif,is_tuple}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_tuple{}}, + {[T], [T]}; +infer_type({bif,'=:='}, [#b_var{}=LHS,#b_var{}=RHS], Ts, _Ds) -> + %% As an example, assume that L1 is known to be 'list', and L2 is + %% known to be 'cons'. Then if 'L1 =:= L2' evaluates to 'true', it can + %% be inferred that L1 is 'cons' (the meet of 'cons' and 'list'). + LType = raw_type(LHS, Ts), + RType = raw_type(RHS, Ts), + Type = beam_types:meet(LType, RType), + + PosTypes = [{V,Type} || {V, OrigType} <- [{LHS, LType}, {RHS, RType}], + OrigType =/= Type], %% We must be careful with types inferred from '=:='. %% @@ -1404,219 +1869,72 @@ infer_types_br(#b_var{}=V, Ts, #d{ds=Ds}) -> %% %% However, it is safe to subtract a type inferred from '=:=' if %% it is single-valued, e.g. if it is [] or the atom 'true'. + NegTypes = case beam_types:is_singleton_type(Type) of + true -> PosTypes; + false -> [] + end, - EqTypes = infer_eq_type(Op, Args, Ts, Ds), - NegTypes1 = [P || {_,T}=P <- EqTypes, is_singleton_type(T)], + {PosTypes, NegTypes}; +infer_type({bif,'=:='}, [#b_var{}=Src,#b_literal{}=Lit], Ts, Ds) -> + Def = maps:get(Src, Ds), + LitType = raw_type(Lit, Ts), + PosTypes = [{Src, LitType} | infer_eq_lit(Def, LitType)], - PosTypes = EqTypes ++ PosTypes0, - SuccTs = meet_types(PosTypes, Ts), + %% Subtraction is only safe if LitType is single-valued. + NegTypes = case beam_types:is_singleton_type(LitType) of + true -> PosTypes; + false -> [] + end, - NegTypes = NegTypes0 ++ NegTypes1, - FailTs = subtract_types(NegTypes, Ts), + {PosTypes, NegTypes}; +infer_type(_Op, _Args, _Ts, _Ds) -> + {[], []}. - {SuccTs,FailTs}. +infer_success_type({bif,Op}, Args, Ts, _Ds) -> + ArgTypes = normalized_types(Args, Ts), -infer_types_switch(V, Lit, Ts, #d{ds=Ds}) -> - Types = infer_eq_type({bif,'=:='}, [V, Lit], Ts, Ds), - meet_types(Types, Ts). + {_, PosTypes0, CanSubtract} = beam_call_types:types(erlang, Op, ArgTypes), + PosTypes = [T || {#b_var{},_}=T <- zip(Args, PosTypes0)], -infer_eq_type({bif,'=:='}, [#b_var{}=Src,#b_literal{}=Lit], Ts, Ds) -> - Def = maps:get(Src, Ds), - Type = get_type(Lit, Ts), - [{Src,Type} | infer_eq_lit(Def, Lit)]; -infer_eq_type({bif,'=:='}, [#b_var{}=Arg0,#b_var{}=Arg1], Ts, _Ds) -> - %% As an example, assume that L1 is known to be 'list', and L2 is - %% known to be 'cons'. Then if 'L1 =:= L2' evaluates to 'true', it can - %% be inferred that L1 is 'cons' (the meet of 'cons' and 'list'). - Type0 = get_type(Arg0, Ts), - Type1 = get_type(Arg1, Ts), - Type = meet(Type0, Type1), - [{V,MeetType} || - {V,OrigType,MeetType} <- - [{Arg0,Type0,Type},{Arg1,Type1,Type}], - OrigType =/= MeetType]; -infer_eq_type(_Op, _Args, _Ts, _Ds) -> - []. + case CanSubtract of + true -> {PosTypes, PosTypes}; + false -> {PosTypes, []} + end; +infer_success_type(call, [#b_var{}=Fun|Args], _Ts, _Ds) -> + T = {Fun, #t_fun{arity=length(Args)}}, + {[T], []}; +infer_success_type(bs_start_match, [_, #b_var{}=Src], _Ts, _Ds) -> + T = {Src,#t_bs_matchable{}}, + {[T], [T]}; +infer_success_type(bs_match, [#b_literal{val=binary}, + Ctx, _Flags, + #b_literal{val=all}, + #b_literal{val=OpUnit}], + _Ts, _Ds) -> + %% This is an explicit tail unit test which does not advance the match + %% position, so we know that Ctx has the same unit. + T = {Ctx, #t_bs_context{tail_unit=OpUnit}}, + {[T], [T]}; +infer_success_type(_Op, _Args, _Ts, _Ds) -> + {[], []}. infer_eq_lit(#b_set{op={bif,tuple_size},args=[#b_var{}=Tuple]}, - #b_literal{val=Size}) when is_integer(Size) -> + #t_integer{elements={Size,Size}}) -> [{Tuple,#t_tuple{exact=true,size=Size}}]; infer_eq_lit(#b_set{op=get_tuple_element, args=[#b_var{}=Tuple,#b_literal{val=N}]}, - #b_literal{}=Lit) -> + LitType) -> Index = N + 1, - Es = set_element_type(Index, get_type(Lit, #{}), #{}), - [{Tuple,#t_tuple{size=Index,elements=Es}}]; -infer_eq_lit(_, _) -> []. - -infer_type_negative(Op, Args, Ds) -> - case is_negative_inference_safe(Op, Args) of - true -> - infer_type(Op, Args, Ds); - false -> - [] - end. - -%% Conservative list of instructions for which negative -%% inference is safe. -is_negative_inference_safe(is_nonempty_list, _Args) -> true; -is_negative_inference_safe(_, _) -> false. - -infer_type({bif,element}, [#b_literal{val=Pos},#b_var{}=Tuple], _Ds) -> - if - is_integer(Pos), 1 =< Pos -> - [{Tuple,#t_tuple{size=Pos}}]; - true -> + case beam_types:set_tuple_element(Index, LitType, #{}) of + #{ Index := _ }=Es -> + [{Tuple,#t_tuple{size=Index,elements=Es}}]; + #{} -> + %% Index was above the element limit; subtraction is not safe. [] end; -infer_type({bif,element}, [#b_var{}=Position,#b_var{}=Tuple], _Ds) -> - [{Position,t_integer()},{Tuple,#t_tuple{}}]; -infer_type({bif,Bif}, [#b_var{}=Src]=Args, _Ds) -> - case inferred_bif_type(Bif, Args) of - any -> []; - T -> [{Src,T}] - end; -infer_type({bif,binary_part}, [#b_var{}=Src,_], _Ds) -> - [{Src,{binary,8}}]; -infer_type({bif,is_map_key}, [_,#b_var{}=Src], _Ds) -> - [{Src,map}]; -infer_type({bif,map_get}, [_,#b_var{}=Src], _Ds) -> - [{Src,map}]; -infer_type({bif,Bif}, [_,_]=Args, _Ds) -> - case inferred_bif_type(Bif, Args) of - any -> []; - T -> [{A,T} || #b_var{}=A <- Args] - end; -infer_type({bif,binary_part}, [#b_var{}=Src,Pos,Len], _Ds) -> - [{Src,{binary,8}}| - [{V,t_integer()} || #b_var{}=V <- [Pos,Len]]]; -infer_type(bs_start_match, [#b_var{}=Bin], _Ds) -> - [{Bin,{binary,1}}]; -infer_type(is_nonempty_list, [#b_var{}=Src], _Ds) -> - [{Src,cons}]; -infer_type(is_tagged_tuple, [#b_var{}=Src,#b_literal{val=Size}, - #b_literal{}=Tag], _Ds) -> - Es = set_element_type(1, get_type(Tag, #{}), #{}), - [{Src,#t_tuple{exact=true,size=Size,elements=Es}}]; -infer_type(succeeded, [#b_var{}=Src], Ds) -> - #b_set{op=Op,args=Args} = maps:get(Src, Ds), - infer_type(Op, Args, Ds); -infer_type(_Op, _Args, _Ds) -> +infer_eq_lit(_, _) -> []. -%% bif_type(Name, Args) -> Type -%% Return the return type for the guard BIF or operator Name with -%% arguments Args. -%% -%% Note that that the following BIFs are handle elsewhere: -%% -%% band/2 - -bif_type(abs, [_]) -> number; -bif_type(bit_size, [_]) -> t_integer(); -bif_type(byte_size, [_]) -> t_integer(); -bif_type(ceil, [_]) -> t_integer(); -bif_type(float, [_]) -> float; -bif_type(floor, [_]) -> t_integer(); -bif_type(is_map_key, [_,_]) -> t_boolean(); -bif_type(length, [_]) -> t_integer(); -bif_type(map_size, [_]) -> t_integer(); -bif_type(node, []) -> #t_atom{}; -bif_type(node, [_]) -> #t_atom{}; -bif_type(round, [_]) -> t_integer(); -bif_type(size, [_]) -> t_integer(); -bif_type(trunc, [_]) -> t_integer(); -bif_type(tuple_size, [_]) -> t_integer(); -bif_type('bnot', [_]) -> t_integer(); -bif_type('bor', [_,_]) -> t_integer(); -bif_type('bsl', [_,_]) -> t_integer(); -bif_type('bsr', [_,_]) -> t_integer(); -bif_type('bxor', [_,_]) -> t_integer(); -bif_type('div', [_,_]) -> t_integer(); -bif_type('rem', [_,_]) -> t_integer(); -bif_type('/', [_,_]) -> float; -bif_type(Name, Args) -> - Arity = length(Args), - case erl_internal:new_type_test(Name, Arity) orelse - erl_internal:bool_op(Name, Arity) orelse - erl_internal:comp_op(Name, Arity) of - true -> - t_boolean(); - false -> - case erl_internal:arith_op(Name, Arity) of - true -> number; - false -> any - end - end. - -inferred_bif_type(is_atom, [_]) -> t_atom(); -inferred_bif_type(is_binary, [_]) -> {binary,8}; -inferred_bif_type(is_bitstring, [_]) -> {binary,1}; -inferred_bif_type(is_boolean, [_]) -> t_boolean(); -inferred_bif_type(is_float, [_]) -> float; -inferred_bif_type(is_integer, [_]) -> t_integer(); -inferred_bif_type(is_list, [_]) -> list; -inferred_bif_type(is_map, [_]) -> map; -inferred_bif_type(is_number, [_]) -> number; -inferred_bif_type(is_tuple, [_]) -> #t_tuple{}; -inferred_bif_type(abs, [_]) -> number; -inferred_bif_type(bit_size, [_]) -> {binary,1}; -inferred_bif_type('bnot', [_]) -> t_integer(); -inferred_bif_type(byte_size, [_]) -> {binary,1}; -inferred_bif_type(ceil, [_]) -> number; -inferred_bif_type(float, [_]) -> number; -inferred_bif_type(floor, [_]) -> number; -inferred_bif_type(hd, [_]) -> cons; -inferred_bif_type(length, [_]) -> list; -inferred_bif_type(map_size, [_]) -> map; -inferred_bif_type('not', [_]) -> t_boolean(); -inferred_bif_type(round, [_]) -> number; -inferred_bif_type(trunc, [_]) -> number; -inferred_bif_type(tl, [_]) -> cons; -inferred_bif_type(tuple_size, [_]) -> #t_tuple{}; -inferred_bif_type('and', [_,_]) -> t_boolean(); -inferred_bif_type('or', [_,_]) -> t_boolean(); -inferred_bif_type('xor', [_,_]) -> t_boolean(); -inferred_bif_type('band', [_,_]) -> t_integer(); -inferred_bif_type('bor', [_,_]) -> t_integer(); -inferred_bif_type('bsl', [_,_]) -> t_integer(); -inferred_bif_type('bsr', [_,_]) -> t_integer(); -inferred_bif_type('bxor', [_,_]) -> t_integer(); -inferred_bif_type('div', [_,_]) -> t_integer(); -inferred_bif_type('rem', [_,_]) -> t_integer(); -inferred_bif_type('+', [_,_]) -> number; -inferred_bif_type('-', [_,_]) -> number; -inferred_bif_type('*', [_,_]) -> number; -inferred_bif_type('/', [_,_]) -> number; -inferred_bif_type(_, _) -> any. - -is_math_bif(cos, 1) -> true; -is_math_bif(cosh, 1) -> true; -is_math_bif(sin, 1) -> true; -is_math_bif(sinh, 1) -> true; -is_math_bif(tan, 1) -> true; -is_math_bif(tanh, 1) -> true; -is_math_bif(acos, 1) -> true; -is_math_bif(acosh, 1) -> true; -is_math_bif(asin, 1) -> true; -is_math_bif(asinh, 1) -> true; -is_math_bif(atan, 1) -> true; -is_math_bif(atanh, 1) -> true; -is_math_bif(erf, 1) -> true; -is_math_bif(erfc, 1) -> true; -is_math_bif(exp, 1) -> true; -is_math_bif(log, 1) -> true; -is_math_bif(log2, 1) -> true; -is_math_bif(log10, 1) -> true; -is_math_bif(sqrt, 1) -> true; -is_math_bif(atan2, 2) -> true; -is_math_bif(pow, 2) -> true; -is_math_bif(ceil, 1) -> true; -is_math_bif(floor, 1) -> true; -is_math_bif(fmod, 2) -> true; -is_math_bif(pi, 0) -> true; -is_math_bif(_, _) -> false. - join_types(Ts0, Ts1) -> if map_size(Ts0) < map_size(Ts1) -> @@ -1630,7 +1948,7 @@ join_types_1([V|Vs], Ts0, Ts1) -> {#{V:=Same},#{V:=Same}} -> join_types_1(Vs, Ts0, Ts1); {#{V:=T0},#{V:=T1}} -> - case join(T0, T1) of + case beam_types:join(T0, T1) of T1 -> join_types_1(Vs, Ts0, Ts1); T -> @@ -1642,326 +1960,175 @@ join_types_1([V|Vs], Ts0, Ts1) -> join_types_1([], Ts0, Ts1) -> maps:merge(Ts0, Ts1). -join([T1,T2|Ts]) -> - join([join(T1, T2)|Ts]); -join([T]) -> T. - -get_literal_from_type(#t_atom{elements=[Atom]}) -> - #b_literal{val=Atom}; -get_literal_from_type(#t_integer{elements={Int,Int}}) -> - #b_literal{val=Int}; -get_literal_from_type(nil) -> - #b_literal{val=[]}; -get_literal_from_type(_) -> none. - -remove_element_info(#t_integer{elements={Min,Max}}, Es) -> - foldl(fun(El, Acc) when Min =< El, El =< Max -> - maps:remove(El, Acc); - (_El, Acc) -> Acc - end, Es, maps:keys(Es)). - -t_atom() -> - #t_atom{elements=any}. - -t_atom(Atom) when is_atom(Atom) -> - #t_atom{elements=[Atom]}. - -t_boolean() -> - #t_atom{elements=[false,true]}. - -t_integer() -> - #t_integer{elements=any}. - -t_integer(Int) when is_integer(Int) -> - #t_integer{elements={Int,Int}}. - -t_integer(Min, Max) when is_integer(Min), is_integer(Max) -> - #t_integer{elements={Min,Max}}. - -t_is_boolean(#t_atom{elements=[F,T]}) -> - F =:= false andalso T =:= true; -t_is_boolean(#t_atom{elements=[B]}) -> - is_boolean(B); -t_is_boolean(_) -> false. - -t_tuple_size(#t_tuple{size=Size,exact=false}) -> - {at_least,Size}; -t_tuple_size(#t_tuple{size=Size,exact=true}) -> - {exact,Size}; -t_tuple_size(_) -> - none. - -is_singleton_type(Type) -> - get_literal_from_type(Type) =/= none. - -get_element_type(Index, Es) -> - case Es of - #{ Index := T } -> T; - #{} -> any - end. - -set_element_type(_Key, none, Es) -> - Es; -set_element_type(Key, any, Es) -> - maps:remove(Key, Es); -set_element_type(Key, Type, Es) -> - Es#{ Key => Type }. - -%% join(Type1, Type2) -> Type -%% Return the "join" of Type1 and Type2. The join is a more general -%% type than Type1 and Type2. For example: -%% -%% join(#t_integer{elements=any}, #t_integer=elements={0,3}}) -> -%% #t_integer{} -%% -%% The join for two different types result in 'any', which is -%% the top element for our type lattice: -%% -%% join(#t_integer{}, map) -> any - --spec join(type(), type()) -> type(). - -join(T, T) -> - verified_type(T); -join(none, T) -> - verified_type(T); -join(T, none) -> - verified_type(T); -join(any, _) -> any; -join(_, any) -> any; -join(#t_atom{elements=[_|_]=Set1}, #t_atom{elements=[_|_]=Set2}) -> - Set = ordsets:union(Set1, Set2), - case ordsets:size(Set) of - Size when Size =< ?ATOM_SET_SIZE -> - #t_atom{elements=Set}; - _Size -> - #t_atom{elements=any} - end; -join(#t_atom{elements=any}=T, #t_atom{elements=[_|_]}) -> T; -join(#t_atom{elements=[_|_]}, #t_atom{elements=any}=T) -> T; -join({binary,U1}, {binary,U2}) -> - {binary,gcd(U1, U2)}; -join(#t_integer{}, #t_integer{}) -> t_integer(); -join(list, cons) -> list; -join(cons, list) -> list; -join(nil, cons) -> list; -join(cons, nil) -> list; -join(nil, list) -> list; -join(list, nil) -> list; -join(#t_integer{}, float) -> number; -join(float, #t_integer{}) -> number; -join(#t_integer{}, number) -> number; -join(number, #t_integer{}) -> number; -join(float, number) -> number; -join(number, float) -> number; -join(#t_tuple{size=Sz,exact=ExactA,elements=EsA}, - #t_tuple{size=Sz,exact=ExactB,elements=EsB}) -> - Exact = ExactA and ExactB, - Es = join_tuple_elements(Sz, EsA, EsB), - #t_tuple{size=Sz,exact=Exact,elements=Es}; -join(#t_tuple{size=SzA,elements=EsA}, #t_tuple{size=SzB,elements=EsB}) -> - Sz = min(SzA, SzB), - Es = join_tuple_elements(Sz, EsA, EsB), - #t_tuple{size=Sz,elements=Es}; -join(_T1, _T2) -> - %%io:format("~p ~p\n", [_T1,_T2]), - any. - -join_tuple_elements(MinSize, EsA, EsB) -> - Es0 = join_elements(EsA, EsB), - maps:filter(fun(Index, _Type) -> Index =< MinSize end, Es0). - -join_elements(Es1, Es2) -> - Keys = if - map_size(Es1) =< map_size(Es2) -> maps:keys(Es1); - map_size(Es1) > map_size(Es2) -> maps:keys(Es2) - end, - join_elements_1(Keys, Es1, Es2, #{}). - -join_elements_1([Key | Keys], Es1, Es2, Acc0) -> - case {Es1, Es2} of - {#{ Key := Type1 }, #{ Key := Type2 }} -> - Acc = set_element_type(Key, join(Type1, Type2), Acc0), - join_elements_1(Keys, Es1, Es2, Acc); - {#{}, #{}} -> - join_elements_1(Keys, Es1, Es2, Acc0) - end; -join_elements_1([], _Es1, _Es2, Acc) -> - Acc. - -gcd(A, B) -> - case A rem B of - 0 -> B; - X -> gcd(B, X) - end. - meet_types([{V,T0}|Vs], Ts) -> #{V:=T1} = Ts, - case meet(T0, T1) of + case beam_types:meet(T0, T1) of + none -> none; T1 -> meet_types(Vs, Ts); T -> meet_types(Vs, Ts#{V:=T}) end; meet_types([], Ts) -> Ts. -meet([T1,T2|Ts]) -> - meet([meet(T1, T2)|Ts]); -meet([T]) -> T. - subtract_types([{V,T0}|Vs], Ts) -> #{V:=T1} = Ts, - case subtract(T1, T0) of + case beam_types:subtract(T1, T0) of + none -> none; T1 -> subtract_types(Vs, Ts); T -> subtract_types(Vs, Ts#{V:=T}) end; subtract_types([], Ts) -> Ts. -%% subtract(Type1, Type2) -> Type. -%% Subtract Type2 from Type1. Example: -%% -%% subtract(list, cons) -> nil +parallel_join([A | As], [B | Bs]) -> + [beam_types:join(A, B) | parallel_join(As, Bs)]; +parallel_join([], []) -> + []. -subtract(#t_atom{elements=[_|_]=Set0}, #t_atom{elements=[_|_]=Set1}) -> - case ordsets:subtract(Set0, Set1) of - [] -> none; - [_|_]=Set -> #t_atom{elements=Set} - end; -subtract(number, float) -> #t_integer{}; -subtract(number, #t_integer{elements=any}) -> float; -subtract(list, cons) -> nil; -subtract(list, nil) -> cons; -subtract(T, _) -> T. - -%% meet(Type1, Type2) -> Type -%% Return the "meet" of Type1 and Type2. The meet is a narrower -%% type than Type1 and Type2. For example: -%% -%% meet(#t_integer{elements=any}, #t_integer{elements={0,3}}) -> -%% #t_integer{elements={0,3}} -%% -%% The meet for two different types result in 'none', which is -%% the bottom element for our type lattice: -%% -%% meet(#t_integer{}, map) -> none +gcd(A, B) -> + case A rem B of + 0 -> B; + X -> gcd(B, X) + end. + +%%% +%%% Helpers +%%% --spec meet(type(), type()) -> type(). +init_metadata(FuncId, Linear, Params) -> + {RetCounter, Map0} = init_metadata_1(reverse(Linear), 0, #{}), + Map = maps:without(Params, Map0), + UsedOnce = cerl_sets:from_list(maps:keys(Map)), + + #metadata{ func_id = FuncId, + limit_return = (RetCounter >= ?RETURN_LIMIT), + params = Params, + used_once = UsedOnce }. + +init_metadata_1([{L,#b_blk{is=Is,last=Last}} | Bs], RetCounter0, Uses0) -> + %% Track the number of return terminators in use. See ?RETURN_LIMIT for + %% details. + RetCounter = case Last of + #b_ret{} -> RetCounter0 + 1; + _ -> RetCounter0 + end, + + %% Calculate the set of variables that are only used once in the terminator + %% of the block that defines them. That will allow us to discard type + %% information discard type information for variables that will never be + %% referenced by the successor blocks, potentially improving compilation + %% times. -meet(T, T) -> - verified_type(T); -meet(#t_atom{elements=[_|_]=Set1}, #t_atom{elements=[_|_]=Set2}) -> - case ordsets:intersection(Set1, Set2) of - [] -> - none; - [_|_]=Set -> - #t_atom{elements=Set} + Uses1 = used_once_last_uses(beam_ssa:used(Last), L, Uses0), + Uses = used_once_2(reverse(Is), L, Uses1), + init_metadata_1(Bs, RetCounter, Uses); +init_metadata_1([], RetCounter, Uses) -> + {RetCounter, Uses}. + +used_once_2([#b_set{dst=Dst}=I|Is], L, Uses0) -> + Uses = used_once_uses(beam_ssa:used(I), L, Uses0), + case Uses of + #{Dst:=[L]} -> + used_once_2(Is, L, Uses); + #{} -> + %% Used more than once or used once in + %% in another block. + used_once_2(Is, L, maps:remove(Dst, Uses)) end; -meet(#t_atom{elements=[_|_]}=T, #t_atom{elements=any}) -> - T; -meet(#t_atom{elements=any}, #t_atom{elements=[_|_]}=T) -> - T; -meet(#t_integer{elements={_,_}}=T, #t_integer{elements=any}) -> - T; -meet(#t_integer{elements=any}, #t_integer{elements={_,_}}=T) -> - T; -meet(#t_integer{elements={Min1,Max1}}, - #t_integer{elements={Min2,Max2}}) -> - #t_integer{elements={max(Min1, Min2),min(Max1, Max2)}}; -meet(#t_integer{}=T, number) -> T; -meet(float=T, number) -> T; -meet(number, #t_integer{}=T) -> T; -meet(number, float=T) -> T; -meet(list, cons) -> cons; -meet(list, nil) -> nil; -meet(cons, list) -> cons; -meet(nil, list) -> nil; -meet(#t_tuple{}=T1, #t_tuple{}=T2) -> - meet_tuples(T1, T2); -meet({binary,U1}, {binary,U2}) -> - {binary,max(U1, U2)}; -meet(any, T) -> - verified_type(T); -meet(T, any) -> - verified_type(T); -meet(_, _) -> - %% Inconsistent types. There will be an exception at runtime. - none. - -meet_tuples(#t_tuple{size=Sz1,exact=true}, - #t_tuple{size=Sz2,exact=true}) when Sz1 =/= Sz2 -> - none; -meet_tuples(#t_tuple{size=Sz1,exact=Ex1,elements=Es1}, - #t_tuple{size=Sz2,exact=Ex2,elements=Es2}) -> - Size = max(Sz1, Sz2), - Exact = Ex1 or Ex2, - case meet_elements(Es1, Es2) of - none -> - none; - Es -> - #t_tuple{size=Size,exact=Exact,elements=Es} - end. +used_once_2([], _, Uses) -> Uses. -meet_elements(Es1, Es2) -> - Keys = maps:keys(Es1) ++ maps:keys(Es2), - meet_elements_1(Keys, Es1, Es2, #{}). +used_once_uses([V|Vs], L, Uses) -> + case Uses of + #{V:=more_than_once} -> + used_once_uses(Vs, L, Uses); + #{} -> + %% Already used or first use is not in + %% a terminator. + used_once_uses(Vs, L, Uses#{V=>more_than_once}) + end; +used_once_uses([], _, Uses) -> Uses. -meet_elements_1([Key | Keys], Es1, Es2, Acc) -> - case {Es1, Es2} of - {#{ Key := Type1 }, #{ Key := Type2 }} -> - case meet(Type1, Type2) of - none -> none; - Type -> meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type }) - end; - {#{ Key := Type1 }, _} -> - meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type1 }); - {_, #{ Key := Type2 }} -> - meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type2 }) +used_once_last_uses([V|Vs], L, Uses) -> + case Uses of + #{V:=[_]} -> + %% Second time this variable is used. + used_once_last_uses(Vs, L, Uses#{V:=more_than_once}); + #{V:=more_than_once} -> + %% Used at least twice before. + used_once_last_uses(Vs, L, Uses); + #{} -> + %% First time this variable is used. + used_once_last_uses(Vs, L, Uses#{V=>[L]}) end; -meet_elements_1([], _Es1, _Es2, Acc) -> - Acc. +used_once_last_uses([], _, Uses) -> Uses. -%% verified_type(Type) -> Type -%% Returns the passed in type if it is one of the defined types. -%% Crashes if there is anything wrong with the type. %% -%% Here are all possible types: +%% Ordered worklist used in signatures/2. %% -%% any Any Erlang term (top element for the type lattice). +%% This is equivalent to consing (wl_add) and appending (wl_defer_list) +%% to a regular list, but avoids uneccessary work by reordering elements. %% -%% #t_atom{} Any atom or some specific atoms. -%% {binary,Unit} Binary/bitstring aligned to unit Unit. -%% float Floating point number. -%% #t_integer{} Integer -%% list Empty or nonempty list. -%% map Map. -%% nil Empty list. -%% cons Cons (nonempty list). -%% number A number (float or integer). -%% #t_tuple{} Tuple. +%% We can do this since a function only needs to be visited *once* for all +%% prior updates to take effect, so if an element is added to the front, then +%% all earlier instances of the same element are redundant. %% -%% none No type (bottom element for the type lattice). - --spec verified_type(T) -> T when - T :: type(). - -verified_type(any=T) -> T; -verified_type(none=T) -> T; -verified_type(#t_atom{elements=any}=T) -> T; -verified_type(#t_atom{elements=[_|_]}=T) -> T; -verified_type({binary,U}=T) when is_integer(U) -> T; -verified_type(#t_integer{elements=any}=T) -> T; -verified_type(#t_integer{elements={Min,Max}}=T) - when is_integer(Min), is_integer(Max) -> T; -verified_type(list=T) -> T; -verified_type(map=T) -> T; -verified_type(nil=T) -> T; -verified_type(cons=T) -> T; -verified_type(number=T) -> T; -verified_type(#t_tuple{size=Size,elements=Es}=T) -> - %% All known elements must have a valid index and type. 'any' is prohibited - %% since it's implicit and should never be present in the map. - maps:fold(fun(Index, Element, _) when is_integer(Index), - 1 =< Index, Index =< Size, - Element =/= any, Element =/= none -> - verified_type(Element) - end, [], Es), - T; -verified_type(float=T) -> T. + +-record(worklist, + { counter = 0 :: integer(), + elements = gb_trees:empty() :: gb_trees:tree(integer(), term()), + indexes = #{} :: #{ term() => integer() } }). + +-type worklist() :: #worklist{}. + +wl_new() -> #worklist{}. + +%% Adds an element to the worklist, or moves it to the front if it's already +%% present. +wl_add(Element, #worklist{counter=Counter,elements=Es,indexes=Is}) -> + case Is of + #{ Element := Index } -> + wl_add_1(Element, Counter, gb_trees:delete(Index, Es), Is); + #{} -> + wl_add_1(Element, Counter, Es, Is) + end. + +wl_add_1(Element, Counter0, Es0, Is0) -> + Counter = Counter0 + 1, + Es = gb_trees:insert(Counter, Element, Es0), + Is = Is0#{ Element => Counter }, + #worklist{counter=Counter,elements=Es,indexes=Is}. + +%% All mutations bump the counter, so we can check for changes without a deep +%% comparison. +wl_changed(#worklist{counter=Same}, #worklist{counter=Same}) -> false; +wl_changed(#worklist{}, #worklist{}) -> true. + +%% Adds the given elements to the back of the worklist, skipping the elements +%% that are already present. This lets us append elements arbitrarly after the +%% current front without changing the work order. +wl_defer_list(Elements, #worklist{counter=Counter,elements=Es,indexes=Is}) -> + wl_defer_list_1(Elements, Counter, Es, Is). + +wl_defer_list_1([Element | Elements], Counter0, Es0, Is0) -> + case Is0 of + #{ Element := _ } -> + wl_defer_list_1(Elements, Counter0, Es0, Is0); + #{} -> + Counter = Counter0 + 1, + Es = gb_trees:insert(-Counter, Element, Es0), + Is = Is0#{ Element => -Counter }, + wl_defer_list_1(Elements, Counter, Es, Is) + end; +wl_defer_list_1([], Counter, Es, Is) -> + #worklist{counter=Counter,elements=Es,indexes=Is}. + +wl_next(#worklist{indexes=Is}) when Is =:= #{} -> + empty; +wl_next(#worklist{elements=Es,indexes=Is}) when Is =/= #{} -> + {_Key, Element} = gb_trees:largest(Es), + {ok, Element}. + +%% Removes the front of the worklist. +wl_pop(Element, #worklist{counter=Counter0,elements=Es0,indexes=Is0}=Wl) -> + Counter = Counter0 + 1, + {_Key, Element, Es} = gb_trees:take_largest(Es0), %Assertion. + Is = maps:remove(Element, Is0), + Wl#worklist{counter=Counter,elements=Es,indexes=Is}. diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl index acf3838da4..ddf8e6f89c 100644 --- a/lib/compiler/src/beam_trim.erl +++ b/lib/compiler/src/beam_trim.erl @@ -208,6 +208,9 @@ remap([{block,Bl0}|Is], Map, Acc) -> remap([{bs_get_tail,Src,Dst,Live}|Is], Map, Acc) -> I = {bs_get_tail,Map(Src),Map(Dst),Live}, remap(Is, Map, [I|Acc]); +remap([{bs_start_match4,Fail,Live,Src,Dst}|Is], Map, Acc) -> + I = {bs_start_match4,Fail,Live,Map(Src),Map(Dst)}, + remap(Is, Map, [I|Acc]); remap([{bs_set_position,Src1,Src2}|Is], Map, Acc) -> I = {bs_set_position,Map(Src1),Map(Src2)}, remap(Is, Map, [I|Acc]); @@ -244,6 +247,9 @@ remap([{make_fun2,_,_,_,_}=I|T], Map, Acc) -> remap([{deallocate,N}|Is], Map, Acc) -> I = {deallocate,Map({frame_size,N})}, remap(Is, Map, [I|Acc]); +remap([{swap,Reg1,Reg2}|Is], Map, Acc) -> + I = {swap,Map(Reg1),Map(Reg2)}, + remap(Is, Map, [I|Acc]); remap([{test,Name,Fail,Ss}|Is], Map, Acc) -> I = {test,Name,Fail,[Map(S) || S <- Ss]}, remap(Is, Map, [I|Acc]); @@ -378,10 +384,17 @@ frame_size([{deallocate,N}|_], _) -> N; frame_size([{line,_}|Is], Safe) -> frame_size(Is, Safe); +frame_size([{bs_start_match4,Fail,_,_,_}|Is], Safe) -> + case Fail of + {f,L} -> frame_size_branch(L, Is, Safe); + _ -> frame_size(Is, Safe) + end; frame_size([{bs_set_position,_,_}|Is], Safe) -> frame_size(Is, Safe); frame_size([{bs_get_tail,_,_,_}|Is], Safe) -> frame_size(Is, Safe); +frame_size([{swap,_,_}|Is], Safe) -> + frame_size(Is, Safe); frame_size(_, _) -> throw(not_possible). frame_size_branch(0, Is, Safe) -> @@ -417,6 +430,9 @@ is_not_used(Y, [{bs_init,_,_,_,Ss,Dst}|Is]) -> is_not_used_ss_dst(Y, Ss, Dst, Is); is_not_used(Y, [{bs_put,{f,_},_,Ss}|Is]) -> not member(Y, Ss) andalso is_not_used(Y, Is); +is_not_used(Y, [{bs_start_match4,_Fail,_Live,Src,Dst}|Is]) -> + Y =/= Src andalso Y =/= Dst andalso + is_not_used(Y, Is); is_not_used(Y, [{bs_set_position,Src1,Src2}|Is]) -> Y =/= Src1 andalso Y =/= Src2 andalso is_not_used(Y, Is); @@ -444,6 +460,8 @@ is_not_used(Y, [{line,_}|Is]) -> is_not_used(Y, Is); is_not_used(Y, [{make_fun2,_,_,_,_}|Is]) -> is_not_used(Y, Is); +is_not_used(Y, [{swap,Reg1,Reg2}|Is]) -> + Y =/= Reg1 andalso Y =/= Reg2 andalso is_not_used(Y, Is); is_not_used(Y, [{test,_,_,Ss}|Is]) -> not member(Y, Ss) andalso is_not_used(Y, Is); is_not_used(Y, [{test,_Op,{f,_},_Live,Ss,Dst}|Is]) -> diff --git a/lib/compiler/src/beam_types.erl b/lib/compiler/src/beam_types.erl new file mode 100644 index 0000000000..5577fe79d8 --- /dev/null +++ b/lib/compiler/src/beam_types.erl @@ -0,0 +1,1127 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. 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(beam_types). + +-define(BEAM_TYPES_INTERNAL, true). +-include("beam_types.hrl"). + +-import(lists, [foldl/3, reverse/1]). + +-export([meet/1, meet/2, join/1, join/2, subtract/2]). + +-export([is_boolean_type/1, + get_bs_matchable_unit/1, + is_bs_matchable_type/1, + get_singleton_value/1, + is_singleton_type/1, + normalize/1]). + +-export([get_tuple_element/2, set_tuple_element/3]). + +-export([make_type_from_value/1]). + +-export([make_atom/1, + make_boolean/0, + make_cons/2, + make_float/1, + make_float/2, + make_integer/1, + make_integer/2]). + +-export([limit_depth/1]). + +%% This is exported to help catch errors in property test generators and is not +%% meant to be used outside of test suites. +-export([verified_type/1]). + +-define(IS_LIST_TYPE(N), + is_record(N, t_list) orelse + is_record(N, t_cons) orelse + N =:= nil). + +-define(IS_NUMBER_TYPE(N), + N =:= number orelse + is_record(N, t_float) orelse + is_record(N, t_integer)). + +%% Folds meet/2 over a list. + +-spec meet([type()]) -> type(). + +meet([T1, T2 | Ts]) -> + meet([meet(T1, T2) | Ts]); +meet([T]) -> T. + +%% Return the "meet" of Type1 and Type2, which is more specific than Type1 and +%% Type2. This is identical to glb/2 but can operate on and produce unions. +%% +%% A = #t_union{list=nil, number=[number], other=[#t_map{}]} +%% B = #t_union{number=[#t_integer{}], other=[#t_map{}]} +%% +%% meet(A, B) -> +%% #t_union{number=[#t_integer{}], other=[#t_map{}]} +%% +%% The meet of two different types result in 'none', which is the bottom +%% element for our type lattice: +%% +%% meet(#t_integer{}, #t_map{}) -> none + +-spec meet(type(), type()) -> type(). + +meet(T, T) -> + verified_type(T); +meet(any, T) -> + verified_type(T); +meet(T, any) -> + verified_type(T); +meet(#t_union{}=A, B) -> + meet_unions(A, B); +meet(A, #t_union{}=B) -> + meet_unions(B, A); +meet(A, B) -> + glb(A, B). + +meet_unions(#t_union{atom=AtomA,list=ListA,number=NumberA, + tuple_set=TSetA,other=OtherA}, + #t_union{atom=AtomB,list=ListB,number=NumberB, + tuple_set=TSetB,other=OtherB}) -> + Union = #t_union{atom=glb(AtomA, AtomB), + list=glb(ListA, ListB), + number=glb(NumberA, NumberB), + tuple_set=meet_tuple_sets(TSetA, TSetB), + other=glb(OtherA, OtherB)}, + shrink_union(Union); +meet_unions(#t_union{atom=AtomA}, #t_atom{}=B) -> + case glb(AtomA, B) of + none -> none; + Atom -> Atom + end; +meet_unions(#t_union{number=NumberA}, B) when ?IS_NUMBER_TYPE(B) -> + case glb(NumberA, B) of + none -> none; + Number -> Number + end; +meet_unions(#t_union{list=ListA}, B) when ?IS_LIST_TYPE(B) -> + case glb(ListA, B) of + none -> none; + List -> List + end; +meet_unions(#t_union{tuple_set=Tuples}, #t_tuple{}=B) -> + Set = meet_tuple_sets(Tuples, new_tuple_set(B)), + shrink_union(#t_union{tuple_set=Set}); +meet_unions(#t_union{other=OtherA}, OtherB) -> + case glb(OtherA, OtherB) of + none -> none; + Other -> Other + end. + +meet_tuple_sets(none, _) -> + none; +meet_tuple_sets(_, none) -> + none; +meet_tuple_sets(#t_tuple{}=A, #t_tuple{}=B) -> + new_tuple_set(glb(A, B)); +meet_tuple_sets(#t_tuple{}=Tuple, Records) -> + mts_tuple(Records, Tuple, []); +meet_tuple_sets(Records, #t_tuple{}=Tuple) -> + meet_tuple_sets(Tuple, Records); +meet_tuple_sets(RecordsA, RecordsB) -> + mts_records(RecordsA, RecordsB). + +mts_tuple([{Key, Type} | Records], Tuple, Acc) -> + case glb(Type, Tuple) of + none -> mts_tuple(Records, Tuple, Acc); + T -> mts_tuple(Records, Tuple, [{Key, T} | Acc]) + end; +mts_tuple([], _Tuple, [_|_]=Acc) -> + reverse(Acc); +mts_tuple([], _Tuple, []) -> + none. + +mts_records(RecordsA, RecordsB) -> + mts_records(RecordsA, RecordsB, []). + +mts_records([{Key, A} | RsA], [{Key, B} | RsB], Acc) -> + case glb(A, B) of + none -> mts_records(RsA, RsB, Acc); + T -> mts_records(RsA, RsB, [{Key, T} | Acc]) + end; +mts_records([{KeyA, _} | _ ]=RsA, [{KeyB, _} | RsB], Acc) when KeyA > KeyB -> + mts_records(RsA, RsB, Acc); +mts_records([{KeyA, _} | RsA], [{KeyB, _} | _] = RsB, Acc) when KeyA < KeyB -> + mts_records(RsA, RsB, Acc); +mts_records(_RsA, [], [_|_]=Acc) -> + reverse(Acc); +mts_records([], _RsB, [_|_]=Acc) -> + reverse(Acc); +mts_records(_RsA, _RsB, []) -> + none. + +%% Folds join/2 over a list. + +-spec join([type()]) -> type(). + +join([T1, T2| Ts]) -> + join([join(T1, T2) | Ts]); +join([T]) -> T. + +%% Return the "join" of Type1 and Type2, which is more general than Type1 and +%% Type2. This is identical to lub/2 but can operate on and produce unions. +%% +%% join(#t_integer{}, #t_map{}) -> #t_union{number=[#t_integer{}], +%% other=[#t_map{}]} + +-spec join(type(), type()) -> type(). + +join(T, T) -> T; +join(_T, any) -> any; +join(any, _T) -> any; +join(T, none) -> T; +join(none, T) -> T; + +join(#t_union{}=A, B) -> + join_unions(A, B); +join(A, #t_union{}=B) -> + join_unions(B, A); + +%% Union creation... +join(#t_atom{}=A, #t_atom{}=B) -> + lub(A, B); +join(#t_atom{}=A, B) when ?IS_LIST_TYPE(B) -> + #t_union{atom=A,list=B}; +join(#t_atom{}=A, B) when ?IS_NUMBER_TYPE(B) -> + #t_union{atom=A,number=B}; +join(#t_atom{}=A, #t_tuple{}=B) -> + #t_union{atom=A,tuple_set=new_tuple_set(B)}; +join(#t_atom{}=A, B) -> + #t_union{atom=A,other=B}; +join(A, #t_atom{}=B) -> + join(B, A); + +join(A, B) when ?IS_LIST_TYPE(A), ?IS_LIST_TYPE(B) -> + lub(A, B); +join(A, B) when ?IS_LIST_TYPE(A), ?IS_NUMBER_TYPE(B) -> + #t_union{list=A,number=B}; +join(A, #t_tuple{}=B) when ?IS_LIST_TYPE(A) -> + #t_union{list=A,tuple_set=new_tuple_set(B)}; +join(A, B) when ?IS_LIST_TYPE(A) -> + #t_union{list=A,other=B}; +join(A, B) when ?IS_LIST_TYPE(B) -> + join(B, A); + +join(A, B) when ?IS_NUMBER_TYPE(A), ?IS_NUMBER_TYPE(B) -> + lub(A, B); +join(A, #t_tuple{}=B) when ?IS_NUMBER_TYPE(A) -> + #t_union{number=A,tuple_set=new_tuple_set(B)}; +join(A, B) when ?IS_NUMBER_TYPE(A) -> + #t_union{number=A,other=B}; +join(A, B) when ?IS_NUMBER_TYPE(B) -> + join(B, A); + +join(#t_tuple{}=A, #t_tuple{}=B) -> + case {record_key(A), record_key(B)} of + {Same, Same} -> + lub(A, B); + {none, _Key} -> + lub(A, B); + {_Key, none} -> + lub(A, B); + {KeyA, KeyB} when KeyA < KeyB -> + #t_union{tuple_set=[{KeyA, A}, {KeyB, B}]}; + {KeyA, KeyB} when KeyA > KeyB -> + #t_union{tuple_set=[{KeyB, B}, {KeyA, A}]} + end; +join(#t_tuple{}=A, B) -> + %% All other combinations have been tried already, so B must be 'other' + #t_union{tuple_set=new_tuple_set(A),other=B}; +join(A, #t_tuple{}=B) -> + join(B, A); + +join(A, B) -> + lub(A, B). + +join_unions(#t_union{atom=AtomA,list=ListA,number=NumberA, + tuple_set=TSetA,other=OtherA}, + #t_union{atom=AtomB,list=ListB,number=NumberB, + tuple_set=TSetB,other=OtherB}) -> + Union = #t_union{atom=lub(AtomA, AtomB), + list=lub(ListA, ListB), + number=lub(NumberA, NumberB), + tuple_set=join_tuple_sets(TSetA, TSetB), + other=lub(OtherA, OtherB)}, + shrink_union(Union); +join_unions(#t_union{atom=AtomA}=A, #t_atom{}=B) -> + A#t_union{atom=lub(AtomA, B)}; +join_unions(#t_union{list=ListA}=A, B) when ?IS_LIST_TYPE(B) -> + A#t_union{list=lub(ListA, B)}; +join_unions(#t_union{number=NumberA}=A, B) when ?IS_NUMBER_TYPE(B) -> + A#t_union{number=lub(NumberA, B)}; +join_unions(#t_union{tuple_set=TSetA}=A, #t_tuple{}=B) -> + Set = join_tuple_sets(TSetA, new_tuple_set(B)), + shrink_union(A#t_union{tuple_set=Set}); +join_unions(#t_union{other=OtherA}=A, B) -> + case lub(OtherA, B) of + any -> any; + T -> A#t_union{other=T} + end. + +join_tuple_sets(A, none) -> + A; +join_tuple_sets(none, B) -> + B; +join_tuple_sets(#t_tuple{}=A, #t_tuple{}=B) -> + lub(A, B); +join_tuple_sets(#t_tuple{}=Tuple, Records) -> + jts_tuple(Records, Tuple); +join_tuple_sets(Records, #t_tuple{}=Tuple) -> + join_tuple_sets(Tuple, Records); +join_tuple_sets(RecordsA, RecordsB) -> + jts_records(RecordsA, RecordsB). + +jts_tuple([{_Key, Tuple} | Records], Acc) -> + jts_tuple(Records, lub(Tuple, Acc)); +jts_tuple([], Acc) -> + Acc. + +jts_records(RsA, RsB) -> + jts_records(RsA, RsB, 0, []). + +jts_records([], [], _N, Acc) -> + reverse(Acc); +jts_records(RsA, RsB, N, Acc) when N > ?TUPLE_SET_LIMIT -> + A = normalize_tuple_set(RsA, none), + B = normalize_tuple_set(RsB, A), + #t_tuple{} = normalize_tuple_set(Acc, B); +jts_records([{Key, A} | RsA], [{Key, B} | RsB], N, Acc) -> + jts_records(RsA, RsB, N + 1, [{Key, lub(A, B)} | Acc]); +jts_records([{KeyA, _} | _]=RsA, [{KeyB, B} | RsB], N, Acc) when KeyA > KeyB -> + jts_records(RsA, RsB, N + 1, [{KeyB, B} | Acc]); +jts_records([{KeyA, A} | RsA], [{KeyB, _} | _] = RsB, N, Acc) when KeyA < KeyB -> + jts_records(RsA, RsB, N + 1, [{KeyA, A} | Acc]); +jts_records([{KeyA, A} | RsA], [], N, Acc) -> + jts_records(RsA, [], N + 1, [{KeyA, A} | Acc]); +jts_records([], [{KeyB, B} | RsB], N, Acc) -> + jts_records([], RsB, N + 1, [{KeyB, B} | Acc]). + +%% Subtract Type2 from Type1. Example: +%% subtract(list, cons) -> nil + +-spec subtract(type(), type()) -> type(). + +subtract(#t_atom{elements=[_|_]=Set0}, #t_atom{elements=[_|_]=Set1}) -> + case ordsets:subtract(Set0, Set1) of + [] -> none; + [_|_]=Set -> #t_atom{elements=Set} + end; +subtract(#t_bitstring{size_unit=UnitA}=T, #t_bs_matchable{tail_unit=UnitB}) -> + subtract_matchable(T, UnitA, UnitB); +subtract(#t_bitstring{size_unit=UnitA}=T, #t_bitstring{size_unit=UnitB}) -> + subtract_matchable(T, UnitA, UnitB); +subtract(#t_bs_context{tail_unit=UnitA}=T, #t_bs_matchable{tail_unit=UnitB}) -> + subtract_matchable(T, UnitA, UnitB); +subtract(#t_bs_context{tail_unit=UnitA}=T, #t_bs_context{tail_unit=UnitB}) -> + subtract_matchable(T, UnitA, UnitB); +subtract(#t_integer{elements={Min, Max}}, #t_integer{elements={N,N}}) -> + if + Min =:= N, Max =:= N -> + none; + Min =/= N, Max =/= N -> + #t_integer{elements={Min, Max}}; + Min =:= N -> + #t_integer{elements={Min + 1, Max}}; + Max =:= N -> + #t_integer{elements={Min, Max - 1}} + end; +subtract(number, #t_float{elements=any}) -> #t_integer{}; +subtract(number, #t_integer{elements=any}) -> #t_float{}; + +%% A list is essentially `#t_cons{} | nil`, so we're left with nil if we +%% subtract a cons cell that is more general than the one in the list. +subtract(#t_list{type=TypeA,terminator=TermA}=T, + #t_cons{type=TypeB,terminator=TermB}) -> + case {meet(TypeA, TypeB), meet(TermA, TermB)} of + {TypeA, TermA} -> nil; + _ -> T + end; +subtract(#t_list{type=Type,terminator=Term}, nil) -> + #t_cons{type=Type,terminator=Term}; + +subtract(#t_union{atom=Atom}=A, #t_atom{}=B)-> + shrink_union(A#t_union{atom=subtract(Atom, B)}); +subtract(#t_union{number=Number}=A, B) when ?IS_NUMBER_TYPE(B) -> + shrink_union(A#t_union{number=subtract(Number, B)}); +subtract(#t_union{list=List}=A, B) when ?IS_LIST_TYPE(B) -> + shrink_union(A#t_union{list=subtract(List, B)}); +subtract(#t_union{tuple_set=[_|_]=Records0}=A, #t_tuple{}=B) -> + %% Filter out all records that are more specific than B. + NewSet = case [{Key, T} || {Key, T} <- Records0, meet(T, B) =/= T] of + [_|_]=Records -> Records; + [] -> none + end, + shrink_union(A#t_union{tuple_set=NewSet}); +subtract(#t_union{tuple_set=#t_tuple{}=Tuple}=A, #t_tuple{}=B) -> + %% Exclude Tuple if it's more specific than B. + case meet(Tuple, B) of + Tuple -> shrink_union(A#t_union{tuple_set=none}); + _ -> A + end; +subtract(#t_union{other=Other}=A, B) -> + shrink_union(A#t_union{other=subtract(Other, B)}); + +subtract(A, B) -> + %% There's nothing left if A is more specific than B. + case meet(A, B) of + A -> none; + _Other -> A + end. + +subtract_matchable(T, UnitA, UnitB) -> + if + UnitA rem UnitB =:= 0 -> none; + UnitA rem UnitB =/= 0 -> T + end. + +%%% +%%% Type operators +%%% + +-spec get_bs_matchable_unit(type()) -> pos_integer() | error. +get_bs_matchable_unit(#t_bitstring{size_unit=Unit}) -> + Unit; +get_bs_matchable_unit(#t_bs_context{tail_unit=Unit}) -> + Unit; +get_bs_matchable_unit(#t_bs_matchable{tail_unit=Unit}) -> + Unit; +get_bs_matchable_unit(_) -> + error. + +-spec is_bs_matchable_type(type()) -> boolean(). +is_bs_matchable_type(Type) -> + get_bs_matchable_unit(Type) =/= error. + +-spec get_singleton_value(Type) -> Result when + Type :: type(), + Result :: {ok, term()} | error. +get_singleton_value(#t_atom{elements=[Atom]}) -> + {ok, Atom}; +get_singleton_value(#t_float{elements={Float,Float}}) -> + {ok, Float}; +get_singleton_value(#t_integer{elements={Int,Int}}) -> + {ok, Int}; +get_singleton_value(#t_map{super_key=none,super_value=none}) -> + {ok, #{}}; +get_singleton_value(#t_tuple{exact=true,size=Size,elements=Es}) -> + case gsv_elements(Size, Es, []) of + Values when is_list(Values) -> + {ok, list_to_tuple(Values)}; + error -> + error + end; +get_singleton_value(nil) -> + {ok, []}; +get_singleton_value(_) -> + error. + +gsv_elements(0, _Es, Acc) -> + %% The elements were added right-to-left, so it's already in order. + Acc; +gsv_elements(N, Es, Acc) -> + ElementType = get_tuple_element(N, Es), + case get_singleton_value(ElementType) of + {ok, Value} -> gsv_elements(N - 1, Es, [Value | Acc]); + error -> error + end. + +-spec is_singleton_type(type()) -> boolean(). +is_singleton_type(Type) -> + get_singleton_value(Type) =/= error. + +-spec is_boolean_type(type()) -> boolean(). +is_boolean_type(#t_atom{elements=[F,T]}) -> + F =:= false andalso T =:= true; +is_boolean_type(#t_atom{elements=[B]}) -> + is_boolean(B); +is_boolean_type(#t_union{}=T) -> + is_boolean_type(normalize(T)); +is_boolean_type(_) -> + false. + +-spec set_tuple_element(Index, Type, Elements) -> Elements when + Index :: pos_integer(), + Type :: type(), + Elements :: tuple_elements(). +set_tuple_element(Index, _Type, Es) when Index > ?TUPLE_ELEMENT_LIMIT -> + Es; +set_tuple_element(_Index, none, Es) -> + Es; +set_tuple_element(Index, any, Es) -> + maps:remove(Index, Es); +set_tuple_element(Index, Type, Es) -> + Es#{ Index => Type }. + +-spec get_tuple_element(Index, Elements) -> type() when + Index :: pos_integer(), + Elements :: tuple_elements(). +get_tuple_element(Index, Es) -> + case Es of + #{ Index := T } -> T; + #{} -> any + end. + +-spec normalize(type()) -> normal_type(). +normalize(#t_union{atom=Atom,list=List,number=Number, + tuple_set=Tuples,other=Other}) -> + A = lub(Atom, List), + B = lub(A, Number), + C = lub(B, Other), + normalize_tuple_set(Tuples, C); +normalize(T) -> + verified_normal_type(T). + +normalize_tuple_set([{_, A} | Records], B) -> + normalize_tuple_set(Records, lub(A, B)); +normalize_tuple_set([], B) -> + B; +normalize_tuple_set(A, B) -> + lub(A, B). + +%%% +%%% Type constructors +%%% + +-spec make_type_from_value(term()) -> type(). +make_type_from_value(Value) -> + mtfv_1(Value). + +mtfv_1(A) when is_atom(A) -> + #t_atom{elements=[A]}; +mtfv_1(B) when is_bitstring(B) -> + case bit_size(B) of + 0 -> + %% This is a bit of a hack, but saying that empty binaries have a + %% unit of 8 helps us get rid of is_binary/1 checks. + #t_bitstring{size_unit=8}; + Size -> + #t_bitstring{size_unit=Size} + end; +mtfv_1(F) when is_float(F) -> + make_float(F); +mtfv_1(F) when is_function(F) -> + {arity, Arity} = erlang:fun_info(F, arity), + #t_fun{arity=Arity}; +mtfv_1(I) when is_integer(I) -> + make_integer(I); +mtfv_1(L) when is_list(L) -> + case L of + [_|_] -> mtfv_cons(L, none); + [] -> nil + end; +mtfv_1(M) when is_map(M) -> + {SKey, SValue} = + maps:fold(fun(Key, Value, {SKey0, SValue0}) -> + SKey = join(mtfv_1(Key), SKey0), + SValue = join(mtfv_1(Value), SValue0), + {SKey, SValue} + end, {none, none}, M), + #t_map{super_key=SKey,super_value=SValue}; +mtfv_1(T) when is_tuple(T) -> + {Es,_} = foldl(fun(Val, {Es0, Index}) -> + Type = mtfv_1(Val), + Es = set_tuple_element(Index, Type, Es0), + {Es, Index + 1} + end, {#{}, 1}, tuple_to_list(T)), + #t_tuple{exact=true,size=tuple_size(T),elements=Es}; +mtfv_1(_Term) -> + any. + +mtfv_cons([Head | Tail], Type) -> + mtfv_cons(Tail, join(mtfv_1(Head), Type)); +mtfv_cons(Terminator, Type) -> + #t_cons{type=Type,terminator=mtfv_1(Terminator)}. + +-spec make_atom(atom()) -> type(). +make_atom(Atom) when is_atom(Atom) -> + #t_atom{elements=[Atom]}. + +-spec make_boolean() -> type(). +make_boolean() -> + #t_atom{elements=[false,true]}. + +-spec make_cons(type(), type()) -> type(). +make_cons(Head0, Tail) -> + case meet(Tail, #t_cons{}) of + #t_cons{type=Type0,terminator=Term0} -> + %% Propagate element and terminator types. Note that if the tail is + %% the union of a list and something else, the new list could be + %% terminated by the other types in the union. + Type = join(Head0, Type0), + Term = join(subtract(Tail, #t_cons{}), Term0), + #t_cons{type=Type,terminator=Term}; + _ -> + %% Tail can't be a cons cell, so we know it terminates the list. + #t_cons{type=Head0,terminator=Tail} + end. + +-spec make_float(float()) -> type(). +make_float(Float) when is_float(Float) -> + make_float(Float, Float). + +-spec make_float(float(), float()) -> type(). +make_float(Min, Max) when is_float(Min), is_float(Max), Min =< Max -> + #t_float{elements={Min, Max}}. + +-spec make_integer(integer()) -> type(). +make_integer(Int) when is_integer(Int) -> + make_integer(Int, Int). + +-spec make_integer(Min, Max) -> type() when + Min :: integer(), + Max :: integer(). +make_integer(Min, Max) when is_integer(Min), is_integer(Max), Min =< Max -> + #t_integer{elements={Min,Max}}. + +-spec limit_depth(type()) -> type(). + +limit_depth(Type) -> + limit_depth(Type, ?MAX_TYPE_DEPTH). + +limit_depth(#t_cons{}=T, Depth) -> + limit_depth_list(T, Depth); +limit_depth(#t_list{}=T, Depth) -> + limit_depth_list(T, Depth); +limit_depth(#t_tuple{}=T, Depth) -> + limit_depth_tuple(T, Depth); +limit_depth(#t_fun{}=T, Depth) -> + limit_depth_fun(T, Depth); +limit_depth(#t_map{}=T, Depth) -> + limit_depth_map(T, Depth); +limit_depth(#t_union{list=List0,tuple_set=TupleSet0,other=Other0}=U, Depth) -> + TupleSet = limit_depth_tuple(TupleSet0, Depth), + List = limit_depth_list(List0, Depth), + Other = limit_depth(Other0, Depth), + shrink_union(U#t_union{list=List,tuple_set=TupleSet,other=Other}); +limit_depth(Type, _Depth) -> + Type. + +limit_depth_fun(#t_fun{type=Type0}=T, Depth) -> + Type = if + Depth > 0 -> limit_depth(Type0, Depth - 1); + Depth =< 0 -> any + end, + T#t_fun{type=Type}. + +limit_depth_list(#t_cons{type=Type0,terminator=Term0}=T, Depth) -> + {Type, Term} = limit_depth_list_1(Type0, Term0, Depth), + T#t_cons{type=Type,terminator=Term}; +limit_depth_list(#t_list{type=Type0,terminator=Term0}=T, Depth) -> + {Type, Term} = limit_depth_list_1(Type0, Term0, Depth), + T#t_list{type=Type,terminator=Term}; +limit_depth_list(nil, _Depth) -> + nil; +limit_depth_list(none, _Depth) -> + none. + +limit_depth_list_1(Type0, Terminator0, Depth) when Depth > 0 -> + Type = limit_depth(Type0, Depth - 1), + Terminator = limit_depth(Terminator0, Depth - 1), + {Type, Terminator}; +limit_depth_list_1(_Type, _Terminator, Depth) when Depth =< 0 -> + {any, any}. + +limit_depth_map(#t_map{ super_key=SKey0, + super_value=SValue0 }, Depth) when Depth > 0 -> + SKey = limit_depth(SKey0, Depth - 1), + SValue = limit_depth(SValue0, Depth - 1), + #t_map{super_key=SKey,super_value=SValue}; +limit_depth_map(#t_map{}, Depth) when Depth =< 0 -> + #t_map{}. + +limit_depth_tuple(#t_tuple{elements=Es0}=T, Depth) -> + if + Depth > 0 -> + Es = maps:map(fun(_, E) -> limit_depth(E, Depth - 1) end, Es0), + T#t_tuple{elements=Es}; + Depth =< 0 -> + #t_tuple{elements=#{}} + end; +limit_depth_tuple([{{MinSize,_},_}|_], Depth) when Depth =< 0 -> + %% Preserve the minimum size of the tuple set. + #t_tuple{exact=false,size=MinSize}; +limit_depth_tuple([{SzTag,Tuple}|Ts], Depth) -> + [{SzTag, limit_depth_tuple(Tuple, Depth)} | limit_depth_tuple(Ts, Depth)]; +limit_depth_tuple([], _Depth) -> + []; +limit_depth_tuple(none, _Depth) -> + none. + +%%% +%%% Helpers +%%% + +%% Return the greatest lower bound of the types Type1 and Type2. The GLB is a +%% more specific type than Type1 and Type2, and is always a normal type. +%% +%% glb(#t_integer{elements=any}, #t_integer{elements={0,3}}) -> +%% #t_integer{elements={0,3}} +%% +%% The GLB of two different types result in 'none', which is the bottom +%% element for our type lattice: +%% +%% glb(#t_integer{}, #t_map{}) -> none + +-spec glb(normal_type(), normal_type()) -> normal_type(). + +glb(T, T) -> + verified_normal_type(T); +glb(any, T) -> + verified_normal_type(T); +glb(T, any) -> + verified_normal_type(T); +glb(#t_atom{elements=[_|_]=Set1}, #t_atom{elements=[_|_]=Set2}) -> + case ordsets:intersection(Set1, Set2) of + [] -> + none; + [_|_]=Set -> + #t_atom{elements=Set} + end; +glb(#t_atom{elements=[_|_]}=T, #t_atom{elements=any}) -> + T; +glb(#t_atom{elements=any}, #t_atom{elements=[_|_]}=T) -> + T; +glb(#t_bitstring{size_unit=U1}, #t_bitstring{size_unit=U2}) -> + #t_bitstring{size_unit=U1 * U2 div gcd(U1, U2)}; +glb(#t_bitstring{size_unit=UnitA}=T, #t_bs_matchable{tail_unit=UnitB}) -> + Unit = UnitA * UnitB div gcd(UnitA, UnitB), + T#t_bitstring{size_unit=Unit}; +glb(#t_bs_context{tail_unit=UnitA,slots=SlotCountA,valid=ValidSlotsA}, + #t_bs_context{tail_unit=UnitB,slots=SlotCountB,valid=ValidSlotsB}) -> + CommonSlotMask = (1 bsl min(SlotCountA, SlotCountB)) - 1, + CommonSlotsA = ValidSlotsA band CommonSlotMask, + CommonSlotsB = ValidSlotsB band CommonSlotMask, + Unit = UnitA * UnitB div gcd(UnitA, UnitB), + if + CommonSlotsA =:= CommonSlotsB -> + #t_bs_context{tail_unit=Unit, + slots=max(SlotCountA, SlotCountB), + valid=ValidSlotsA bor ValidSlotsB}; + CommonSlotsA =/= CommonSlotsB -> + none + end; +glb(#t_bs_context{tail_unit=UnitA}=T, #t_bs_matchable{tail_unit=UnitB}) -> + Unit = UnitA * UnitB div gcd(UnitA, UnitB), + T#t_bs_context{tail_unit=Unit}; +glb(#t_bs_matchable{tail_unit=UnitA}, #t_bs_matchable{tail_unit=UnitB}) -> + Unit = UnitA * UnitB div gcd(UnitA, UnitB), + #t_bs_matchable{tail_unit=Unit}; +glb(#t_bs_matchable{tail_unit=UnitA}, #t_bitstring{size_unit=UnitB}=T) -> + Unit = UnitA * UnitB div gcd(UnitA, UnitB), + T#t_bitstring{size_unit=Unit}; +glb(#t_bs_matchable{tail_unit=UnitA}, #t_bs_context{tail_unit=UnitB}=T) -> + Unit = UnitA * UnitB div gcd(UnitA, UnitB), + T#t_bs_context{tail_unit=Unit}; +glb(#t_cons{type=TypeA,terminator=TermA}, + #t_cons{type=TypeB,terminator=TermB}) -> + %% Note the use of meet/2; elements don't need to be normal types. + case {meet(TypeA, TypeB), meet(TermA, TermB)} of + {none, _} -> none; + {_, none} -> none; + {Type, Term} -> #t_cons{type=Type,terminator=Term} + end; +glb(#t_cons{type=TypeA,terminator=TermA}, + #t_list{type=TypeB,terminator=TermB}) -> + case {meet(TypeA, TypeB), meet(TermA, TermB)} of + {none, _} -> none; + {_, none} -> none; + {Type, Term} -> #t_cons{type=Type,terminator=Term} + end; +glb(#t_float{}=T, #t_float{elements=any}) -> + T; +glb(#t_float{elements=any}, #t_float{}=T) -> + T; +glb(#t_float{elements={MinA,MaxA}}, #t_float{elements={MinB,MaxB}}) + when MinA >= MinB, MinA =< MaxB; + MinB >= MinA, MinB =< MaxA -> + true = MinA =< MaxA andalso MinB =< MaxB, %Assertion. + #t_float{elements={max(MinA, MinB),min(MaxA, MaxB)}}; +glb(#t_fun{arity=Same,type=TypeA}, #t_fun{arity=Same,type=TypeB}=T) -> + T#t_fun{type=meet(TypeA, TypeB)}; +glb(#t_fun{arity=any,type=TypeA}, #t_fun{type=TypeB}=T) -> + T#t_fun{type=meet(TypeA, TypeB)}; +glb(#t_fun{type=TypeA}=T, #t_fun{arity=any,type=TypeB}) -> + T#t_fun{type=meet(TypeA, TypeB)}; +glb(#t_integer{elements={_,_}}=T, #t_integer{elements=any}) -> + T; +glb(#t_integer{elements=any}, #t_integer{elements={_,_}}=T) -> + T; +glb(#t_integer{elements={MinA,MaxA}}, #t_integer{elements={MinB,MaxB}}) + when MinA >= MinB, MinA =< MaxB; + MinB >= MinA, MinB =< MaxA -> + true = MinA =< MaxA andalso MinB =< MaxB, %Assertion. + #t_integer{elements={max(MinA, MinB),min(MaxA, MaxB)}}; +glb(#t_integer{}=T, number) -> + T; +glb(#t_float{}=T, number) -> + T; +glb(#t_list{type=TypeA,terminator=TermA}, + #t_list{type=TypeB,terminator=TermB}) -> + %% A list is a union of `[type() | _]` and `[]`, so we're left with + %% nil when the element types are incompatible. + case {meet(TypeA, TypeB), meet(TermA, TermB)} of + {none, _} -> nil; + {_, none} -> nil; + {Type, Term} -> #t_list{type=Type,terminator=Term} + end; +glb(#t_list{}=A, #t_cons{}=B) -> + glb(B, A); +glb(#t_list{}, nil) -> + nil; +glb(nil, #t_list{}) -> + nil; +glb(number, #t_integer{}=T) -> + T; +glb(number, #t_float{}=T) -> + T; +glb(#t_map{super_key=SKeyA,super_value=SValueA}, + #t_map{super_key=SKeyB,super_value=SValueB}) -> + %% Note the use of meet/2; elements don't need to be normal types. + SKey = meet(SKeyA, SKeyB), + SValue = meet(SValueA, SValueB), + #t_map{super_key=SKey,super_value=SValue}; +glb(#t_tuple{}=T1, #t_tuple{}=T2) -> + glb_tuples(T1, T2); +glb(_, _) -> + %% Inconsistent types. There will be an exception at runtime. + none. + +glb_tuples(#t_tuple{size=Sz1,exact=Ex1}, #t_tuple{size=Sz2,exact=Ex2}) + when Ex1, Sz1 < Sz2; + Ex2, Sz2 < Sz1 -> + none; +glb_tuples(#t_tuple{size=Sz1,exact=Ex1,elements=Es1}, + #t_tuple{size=Sz2,exact=Ex2,elements=Es2}) -> + Size = max(Sz1, Sz2), + Exact = Ex1 or Ex2, + case glb_elements(Es1, Es2) of + none -> + none; + Es -> + #t_tuple{size=Size,exact=Exact,elements=Es} + end. + +glb_elements(Es1, Es2) -> + Keys = maps:keys(Es1) ++ maps:keys(Es2), + glb_elements_1(Keys, Es1, Es2, #{}). + +glb_elements_1([Key | Keys], Es1, Es2, Acc) -> + case {Es1, Es2} of + {#{ Key := Type1 }, #{ Key := Type2 }} -> + %% Note the use of meet/2; elements don't need to be normal types. + case meet(Type1, Type2) of + none -> none; + Type -> glb_elements_1(Keys, Es1, Es2, Acc#{ Key => Type }) + end; + {#{ Key := Type1 }, _} -> + glb_elements_1(Keys, Es1, Es2, Acc#{ Key => Type1 }); + {_, #{ Key := Type2 }} -> + glb_elements_1(Keys, Es1, Es2, Acc#{ Key => Type2 }) + end; +glb_elements_1([], _Es1, _Es2, Acc) -> + Acc. + +%% Return the least upper bound of the types Type1 and Type2. The LUB is a more +%% general type than Type1 and Type2, and is always a normal type. +%% +%% For example: +%% +%% lub(#t_integer{elements=any}, #t_integer=elements={0,3}}) -> +%% #t_integer{} +%% +%% The LUB for two different types result in 'any' (not a union type!), which +%% is the top element for our type lattice: +%% +%% lub(#t_integer{}, #t_map{}) -> any + +-spec lub(normal_type(), normal_type()) -> normal_type(). + +lub(T, T) -> + verified_normal_type(T); +lub(none, T) -> + verified_normal_type(T); +lub(T, none) -> + verified_normal_type(T); +lub(any, _) -> + any; +lub(_, any) -> + any; +lub(#t_atom{elements=[_|_]=Set1}, #t_atom{elements=[_|_]=Set2}) -> + Set = ordsets:union(Set1, Set2), + case ordsets:size(Set) of + Size when Size =< ?ATOM_SET_SIZE -> + #t_atom{elements=Set}; + _Size -> + #t_atom{elements=any} + end; +lub(#t_atom{elements=any}=T, #t_atom{elements=[_|_]}) -> T; +lub(#t_atom{elements=[_|_]}, #t_atom{elements=any}=T) -> T; +lub(#t_bitstring{size_unit=U1}, #t_bitstring{size_unit=U2}) -> + #t_bitstring{size_unit=gcd(U1, U2)}; +lub(#t_bitstring{size_unit=U1}, #t_bs_context{tail_unit=U2}) -> + #t_bs_matchable{tail_unit=gcd(U1, U2)}; +lub(#t_bitstring{size_unit=UnitA}, #t_bs_matchable{tail_unit=UnitB}) -> + lub_bs_matchable(UnitA, UnitB); +lub(#t_bs_context{tail_unit=UnitA,slots=SlotsA,valid=ValidA}, + #t_bs_context{tail_unit=UnitB,slots=SlotsB,valid=ValidB}) -> + #t_bs_context{tail_unit=gcd(UnitA, UnitB), + slots=min(SlotsA, SlotsB), + valid=ValidA band ValidB}; +lub(#t_bs_context{tail_unit=U1}, #t_bitstring{size_unit=U2}) -> + #t_bs_matchable{tail_unit=gcd(U1, U2)}; +lub(#t_bs_context{tail_unit=UnitA}, #t_bs_matchable{tail_unit=UnitB}) -> + lub_bs_matchable(UnitA, UnitB); +lub(#t_bs_matchable{tail_unit=UnitA}, #t_bs_matchable{tail_unit=UnitB}) -> + lub_bs_matchable(UnitA, UnitB); +lub(#t_bs_matchable{tail_unit=UnitA}, #t_bitstring{size_unit=UnitB}) -> + lub_bs_matchable(UnitA, UnitB); +lub(#t_bs_matchable{tail_unit=UnitA}, #t_bs_context{tail_unit=UnitB}) -> + lub_bs_matchable(UnitA, UnitB); +lub(#t_cons{type=TypeA,terminator=TermA}, + #t_cons{type=TypeB,terminator=TermB}) -> + %% Note the use of join/2; elements don't need to be normal types. + #t_cons{type=join(TypeA,TypeB),terminator=join(TermA, TermB)}; +lub(#t_cons{type=TypeA,terminator=TermA}, + #t_list{type=TypeB,terminator=TermB}) -> + #t_list{type=join(TypeA,TypeB),terminator=join(TermA, TermB)}; +lub(#t_cons{type=Type,terminator=Term}, nil) -> + #t_list{type=Type,terminator=Term}; +lub(#t_float{elements={MinA,MaxA}}, + #t_float{elements={MinB,MaxB}}) -> + #t_float{elements={min(MinA,MinB),max(MaxA,MaxB)}}; +lub(#t_float{}, #t_float{}) -> + #t_float{}; +lub(#t_float{}, #t_integer{}) -> + number; +lub(#t_float{}, number) -> + number; +lub(#t_fun{arity=Same,type=TypeA}, #t_fun{arity=Same,type=TypeB}) -> + #t_fun{arity=Same,type=join(TypeA, TypeB)}; +lub(#t_fun{type=TypeA}, #t_fun{type=TypeB}) -> + #t_fun{type=join(TypeA, TypeB)}; +lub(#t_integer{elements={MinA,MaxA}}, + #t_integer{elements={MinB,MaxB}}) -> + #t_integer{elements={min(MinA,MinB),max(MaxA,MaxB)}}; +lub(#t_integer{}, #t_integer{}) -> + #t_integer{}; +lub(#t_integer{}, #t_float{}) -> + number; +lub(#t_integer{}, number) -> + number; +lub(#t_list{type=TypeA,terminator=TermA}, + #t_list{type=TypeB,terminator=TermB}) -> + #t_list{type=join(TypeA, TypeB),terminator=join(TermA, TermB)}; +lub(#t_list{}=A, #t_cons{}=B) -> + lub(B, A); +lub(nil=A, #t_cons{}=B) -> + lub(B, A); +lub(nil, #t_list{}=T) -> + T; +lub(#t_list{}=T, nil) -> + T; +lub(number, #t_integer{}) -> + number; +lub(number, #t_float{}) -> + number; +lub(#t_map{super_key=SKeyA,super_value=SValueA}, + #t_map{super_key=SKeyB,super_value=SValueB}) -> + %% Note the use of join/2; elements don't need to be normal types. + SKey = join(SKeyA, SKeyB), + SValue = join(SValueA, SValueB), + #t_map{super_key=SKey,super_value=SValue}; +lub(#t_tuple{size=Sz,exact=ExactA,elements=EsA}, + #t_tuple{size=Sz,exact=ExactB,elements=EsB}) -> + Exact = ExactA and ExactB, + Es = lub_tuple_elements(Sz, EsA, EsB), + #t_tuple{size=Sz,exact=Exact,elements=Es}; +lub(#t_tuple{size=SzA,elements=EsA}, #t_tuple{size=SzB,elements=EsB}) -> + Sz = min(SzA, SzB), + Es = lub_tuple_elements(Sz, EsA, EsB), + #t_tuple{size=Sz,elements=Es}; +lub(_T1, _T2) -> + %%io:format("~p ~p\n", [_T1,_T2]), + any. + +lub_bs_matchable(UnitA, UnitB) -> + #t_bs_matchable{tail_unit=gcd(UnitA, UnitB)}. + +lub_tuple_elements(MinSize, EsA, EsB) -> + Es0 = lub_elements(EsA, EsB), + maps:filter(fun(Index, _Type) -> Index =< MinSize end, Es0). + +lub_elements(Es1, Es2) -> + Keys = if + map_size(Es1) =< map_size(Es2) -> maps:keys(Es1); + map_size(Es1) > map_size(Es2) -> maps:keys(Es2) + end, + lub_elements_1(Keys, Es1, Es2, #{}). + +lub_elements_1([Key | Keys], Es1, Es2, Acc0) -> + case {Es1, Es2} of + {#{ Key := Type1 }, #{ Key := Type2 }} -> + %% Note the use of join/2; elements don't need to be normal types. + Acc = set_tuple_element(Key, join(Type1, Type2), Acc0), + lub_elements_1(Keys, Es1, Es2, Acc); + {#{}, #{}} -> + lub_elements_1(Keys, Es1, Es2, Acc0) + end; +lub_elements_1([], _Es1, _Es2, Acc) -> + Acc. + +%% + +gcd(A, B) -> + case A rem B of + 0 -> B; + X -> gcd(B, X) + end. + +%% + +record_key(#t_tuple{exact=true,size=Size,elements=#{ 1 := Tag }}) -> + case is_singleton_type(Tag) of + true -> {Size, Tag}; + false -> none + end; +record_key(_) -> + none. + +new_tuple_set(T) -> + case record_key(T) of + none -> T; + Key -> [{Key, T}] + end. + +%% + +shrink_union(#t_union{other=any}) -> + any; +shrink_union(#t_union{atom=Atom,list=none,number=none, + tuple_set=none,other=none}) -> + Atom; +shrink_union(#t_union{atom=none,list=List,number=none, + tuple_set=none,other=none}) -> + List; +shrink_union(#t_union{atom=none,list=none,number=Number, + tuple_set=none,other=none}) -> + Number; +shrink_union(#t_union{atom=none,list=none,number=none, + tuple_set=#t_tuple{}=Tuple,other=none}) -> + Tuple; +shrink_union(#t_union{atom=none,list=none,number=none, + tuple_set=[{_Key, Record}],other=none}) -> + #t_tuple{} = Record; %Assertion. +shrink_union(#t_union{atom=none,list=none,number=none, + tuple_set=none,other=Other}) -> + Other; +shrink_union(#t_union{}=T) -> + T. + +%% Verifies that the given type is well-formed. + +-spec verified_type(T) -> T when + T :: type(). + +verified_type(#t_union{atom=Atom, + list=List, + number=Number, + tuple_set=TSet, + other=Other}=T) -> + _ = verified_normal_type(Atom), + _ = verified_normal_type(List), + _ = verified_normal_type(Number), + _ = verify_tuple_set(TSet), + _ = verified_normal_type(Other), + T; +verified_type(T) -> + verified_normal_type(T). + +verify_tuple_set([_|_]=T) -> + _ = verify_tuple_set_1(T, 0), + T; +verify_tuple_set(#t_tuple{}=T) -> + none = record_key(T), %Assertion. + T; +verify_tuple_set(none=T) -> + T. + +verify_tuple_set_1([{_Tag, Record} | Records], Size) -> + true = Size =< ?TUPLE_SET_LIMIT, %Assertion. + _ = verified_normal_type(Record), + verify_tuple_set_1(Records, Size + 1); +verify_tuple_set_1([], _Size) -> + ok. + +-spec verified_normal_type(T) -> T when + T :: normal_type(). + +verified_normal_type(any=T) -> T; +verified_normal_type(none=T) -> T; +verified_normal_type(#t_atom{elements=any}=T) -> T; +verified_normal_type(#t_atom{elements=[_|_]}=T) -> T; +verified_normal_type(#t_bitstring{size_unit=U}=T) + when is_integer(U), U >= 1 -> + T; +verified_normal_type(#t_bs_context{tail_unit=U}=T) + when is_integer(U), U >= 1 -> + T; +verified_normal_type(#t_bs_matchable{tail_unit=U}=T) + when is_integer(U), U >= 1 -> + T; +verified_normal_type(#t_cons{type=Type,terminator=Term}=T) -> + _ = verified_type(Type), + _ = verified_type(Term), + T; +verified_normal_type(#t_fun{arity=Arity,type=ReturnType}=T) + when Arity =:= any; is_integer(Arity) -> + _ = verified_type(ReturnType), + T; +verified_normal_type(#t_float{}=T) -> T; +verified_normal_type(#t_integer{elements=any}=T) -> T; +verified_normal_type(#t_integer{elements={Min,Max}}=T) + when is_integer(Min), is_integer(Max), Min =< Max -> + T; +verified_normal_type(#t_list{type=Type,terminator=Term}=T) -> + _ = verified_type(Type), + _ = verified_type(Term), + T; +verified_normal_type(#t_map{}=T) -> T; +verified_normal_type(nil=T) -> T; +verified_normal_type(number=T) -> T; +verified_normal_type(#t_tuple{size=Size,elements=Es}=T) -> + %% All known elements must have a valid index and type (which may be a + %% union). 'any' is prohibited since it's implicit and should never be + %% present in the map, and a 'none' element ought to have reduced the + %% entire tuple to 'none'. + maps:fold(fun(Index, Element, _) when is_integer(Index), + 1 =< Index, Index =< Size, + Index =< ?TUPLE_ELEMENT_LIMIT, + Element =/= any, Element =/= none -> + verified_type(Element) + end, [], Es), + T. diff --git a/lib/compiler/src/beam_types.hrl b/lib/compiler/src/beam_types.hrl new file mode 100644 index 0000000000..c20e1ce7a0 --- /dev/null +++ b/lib/compiler/src/beam_types.hrl @@ -0,0 +1,154 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. 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% +%% + +%% Common term types for passes operating on beam SSA and assembly. Helper +%% functions for wrangling these can be found in beam_types.erl +%% +%% The type lattice is as follows: +%% +%% any Any Erlang term (top element). +%% +%% - #t_atom{} Atom, or a set thereof. +%% - #t_bs_matchable{} Binary-matchable types. +%% - #t_bitstring{} Bitstring. +%% - #t_bs_context{} Match context. +%% - #t_fun{} Fun. +%% - #t_map{} Map. +%% - number Any number. +%% -- #t_float{} Floating point number. +%% -- #t_integer{} Integer. +%% - #t_list{} Any list. +%% -- #t_cons{} Cons (nonempty list). +%% -- nil The empty list. +%% - #t_tuple{} Tuple. +%% +%% none No type (bottom element). +%% +%% We also use #t_union{} to represent conflicting types produced by certain +%% expressions, e.g. the "#t_atom{} or #t_tuple{}" of lists:keyfind/3, which is +%% very useful for preserving type information when we would otherwise have +%% reduced it to 'any'. Since few operations can make direct use of this extra +%% type information, types should generally be normalized to one of the above +%% before use. +%% +%% When adding a new type it's important that the lattice stays consistent [1]. +%% In brief, the following properties must hold: +%% +%% * All types must be unambiguous; any given value must narrow down to a +%% single type, and multiple supertypes are not allowed. +%% +%% * `meet` is used when we know more about a value (e.g. type tests), so it +%% must not return a more general type than either of its arguments. In other +%% words, we're only allowed to *add* knowledge in a `meet`. +%% +%% * `join` is used when we know less about a value (e.g. phi node), so it +%% must not return a more specific type than either of its arguments. In +%% other words we're only allowed to *remove* knowledge in a `join`. +%% +%% * Both `join` and `meet` must be commutative, associative, and idempotent. +%% +%% Maintaining the above may seem trivial but subtle errors can creep in when +%% adding fields or restrictions to a type. ?TUPLE_ELEMENT_LIMIT is a great +%% example of this. +%% +%% The property test suite ensures that the above holds, so don't forget to +%% add your new types there. You should also consider increasing ?REPETITIONS +%% during development to ensure it hits all nooks and crannies. +%% +%% [1] https://en.wikipedia.org/wiki/Lattice_(order)#General_lattice + +-define(ATOM_SET_SIZE, 5). + +-record(t_atom, {elements=any :: 'any' | ordsets:ordset(atom())}). +-record(t_bitstring, {size_unit=1 :: pos_integer()}). +-record(t_bs_context, {tail_unit=1 :: pos_integer(), + slots=0 :: non_neg_integer(), + valid=0 :: non_neg_integer()}). +-record(t_bs_matchable, {tail_unit=1}). +-record(t_float, {elements=any :: 'any' | {float(),float()}}). +-record(t_fun, {arity=any :: arity() | 'any', + type=any :: type() }). +-record(t_integer, {elements=any :: 'any' | {integer(),integer()}}). + +%% `super_key` and `super_value` are the join of all key and value types. +%% +%% Note that we don't track specific elements as we have no obvious way to +%% limit them. See ?TUPLE_ELEMENT_LIMIT for details. +-record(t_map, {super_key=any :: type(), + super_value=any :: type()}). + +%% `type` is the join of all list elements, and `terminator` is the tail of the +%% last cons cell ('nil' for proper lists). +%% +%% Note that `type` may not be updated unless the entire list is known, and +%% that the terminator being known is not a guarantee that the rest of the list +%% is. +-record(t_cons, {type=any :: type(), terminator=any :: type()}). +-record(t_list, {type=any :: type(), terminator=any :: type()}). + +-record(t_tuple, {size=0 :: integer(), + exact=false :: boolean(), + elements=#{} :: tuple_elements()}). + +%% Known element types, where the key is a 1-based integer index. Unknown +%% elements are assumed to be 'any', and indexes above ?TUPLE_ELEMENT_LIMIT are +%% ignored for performance reasons. +%% +%% Cutting off all indexes above a certain limit may seem strange, but is +%% required to ensure that a meet of two types always returns a type that's at +%% least as specific as either type. Consider the following types: +%% +%% A = #t_tuple{elements=#{ ... elements 1 .. 6 ... }} +%% B = #t_tuple{elements=#{ ... elements 7 .. 13 ... }} +%% +%% If we'd collapse types once a tuple has more than 12 elements, meet(A, B) +%% would suddenly be less specific than either A or B. Ignoring all elements +%% above a certain index avoids this problem, at the small price of losing type +%% information in huge tuples. + +-define(TUPLE_ELEMENT_LIMIT, 12). +-type tuple_elements() :: #{ Key :: pos_integer() => type() }. + +-type normal_type() :: any | none | + number | #t_float{} | #t_integer{} | + #t_atom{} | + #t_bitstring{} | #t_bs_context{} | #t_bs_matchable{} | + #t_fun{} | + #t_list{} | #t_cons{} | nil | + #t_map{} | + #t_tuple{}. + +-type record_key() :: {Arity :: integer(), Tag :: normal_type() }. +-type record_set() :: ordsets:ordset({record_key(), #t_tuple{}}). +-type tuple_set() :: #t_tuple{} | record_set(). + +-record(t_union, {atom=none :: none | #t_atom{}, + list=none :: none | #t_list{} | #t_cons{} | nil, + number=none :: none | number | #t_float{} | #t_integer{}, + tuple_set=none :: none | tuple_set(), + other=none :: normal_type()}). + +-type type() :: #t_union{} | normal_type(). + +-ifdef(BEAM_TYPES_INTERNAL). +%% Internal constants used by beam_types.erl and its whitebox tests +-define(TUPLE_SET_LIMIT, 12). +-define(MAX_TYPE_DEPTH, 4). +-endif. diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 6e6574c0b3..9bf18911c5 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -88,11 +88,12 @@ split_even(Rs) -> split_even(Rs, [], []). %%% %%% Local functions. %%% - replace_labels_1([{test,Test,{f,Lbl},Ops}|Is], Acc, D, Fb) -> - replace_labels_1(Is, [{test,Test,{f,label(Lbl, D, Fb)},Ops}|Acc], D, Fb); + I = {test,Test,{f,label(Lbl, D, Fb)},Ops}, + replace_labels_1(Is, [I | Acc], D, Fb); replace_labels_1([{test,Test,{f,Lbl},Live,Ops,Dst}|Is], Acc, D, Fb) -> - replace_labels_1(Is, [{test,Test,{f,label(Lbl, D, Fb)},Live,Ops,Dst}|Acc], D, Fb); + I = {test,Test,{f,label(Lbl, D, Fb)},Live,Ops,Dst}, + replace_labels_1(Is, [I | Acc], D, Fb); replace_labels_1([{select,I,R,{f,Fail0},Vls0}|Is], Acc, D, Fb) -> Vls = map(fun ({f,L}) -> {f,label(L, D, Fb)}; (Other) -> Other @@ -134,6 +135,9 @@ replace_labels_1([{put_map=I,{f,Lbl},Op,Src,Dst,Live,List}|Is], Acc, D, Fb) replace_labels_1(Is, [{I,{f,label(Lbl, D, Fb)},Op,Src,Dst,Live,List}|Acc], D, Fb); replace_labels_1([{get_map_elements=I,{f,Lbl},Src,List}|Is], Acc, D, Fb) when Lbl =/= 0 -> replace_labels_1(Is, [{I,{f,label(Lbl, D, Fb)},Src,List}|Acc], D, Fb); +replace_labels_1([{bs_start_match4,{f,Lbl},Live,Src,Dst}|Is], Acc, D, Fb) -> + I = {bs_start_match4,{f,label(Lbl, D, Fb)},Live,Src,Dst}, + replace_labels_1(Is, [I | Acc], D, Fb); replace_labels_1([I|Is], Acc, D, Fb) -> replace_labels_1(Is, [I|Acc], D, Fb); replace_labels_1([], Acc, _, _) -> Acc. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 12aaa01b6b..8a71ac35e3 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -19,6 +19,10 @@ -module(beam_validator). +-include("beam_types.hrl"). + +-define(UNICODE_MAX, (16#10FFFF)). + -compile({no_auto_import,[min/2]}). %% Avoid warning for local function error/1 clashing with autoimported BIF. @@ -26,7 +30,6 @@ %% Interface for compiler. -export([module/2, format_error/1]). --export([type_anno/1, type_anno/2, type_anno/4]). -import(lists, [dropwhile/2,foldl/3,member/2,reverse/1,sort/1,zip/2]). @@ -45,34 +48,6 @@ module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts) {error,[{atom_to_list(Mod),Es}]} end. -%% Provides a stable interface for type annotations, used by certain passes to -%% indicate that we can safely assume that a register has a given type. --spec type_anno(term()) -> term(). -type_anno(atom) -> {atom,[]}; -type_anno(bool) -> bool; -type_anno({binary,_}) -> binary; -type_anno(cons) -> cons; -type_anno(float) -> {float,[]}; -type_anno(integer) -> {integer,[]}; -type_anno(list) -> list; -type_anno(map) -> map; -type_anno(match_context) -> match_context; -type_anno(number) -> number; -type_anno(nil) -> nil. - --spec type_anno(term(), term()) -> term(). -type_anno(atom, Value) when is_atom(Value) -> {atom, Value}; -type_anno(float, Value) when is_float(Value) -> {float, Value}; -type_anno(integer, Value) when is_integer(Value) -> {integer, Value}. - --spec type_anno(term(), term(), term(), term()) -> term(). -type_anno(tuple, Size, Exact, Elements) when is_integer(Size), Size >= 0, - is_map(Elements) -> - case Exact of - true -> {tuple, Size, Elements}; - false -> {tuple, [Size], Elements} - end. - -spec format_error(term()) -> iolist(). format_error({{_M,F,A},{I,Off,limit}}) -> @@ -119,7 +94,7 @@ format_error(Error) -> %% format as used in the compiler and in .S files. validate(Module, Fs) -> - Ft = index_parameter_types(Fs, []), + Ft = build_function_table(Fs, []), validate_0(Module, Fs, Ft). validate_0(_Module, [], _) -> []; @@ -127,17 +102,24 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> try validate_1(Code, Name, Ar, Entry, Ft) of _ -> validate_0(Module, Fs, Ft) catch - throw:Error -> - %% Controlled error. - [Error|validate_0(Module, Fs, Ft)]; + throw:Error -> + %% Controlled error. + [Error|validate_0(Module, Fs, Ft)]; Class:Error:Stack -> %% Crash. io:fwrite("Function: ~w/~w\n", [Name,Ar]), erlang:raise(Class, Error, Stack) end. +-record(t_abstract, {kind}). + +%% The types are the same as in 'beam_types.hrl', with the addition of +%% #t_abstract{} that describes tuples under construction, match context +%% positions, and so on. +-type validator_type() :: #t_abstract{} | type(). + -record(value_ref, {id :: index()}). --record(value, {op :: term(), args :: [argument()], type :: type()}). +-record(value, {op :: term(), args :: [argument()], type :: validator_type()}). -type argument() :: #value_ref{} | literal(). @@ -149,34 +131,28 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> {literal, term()} | nil. --type tuple_sz() :: [non_neg_integer()] | %% Inexact - non_neg_integer(). %% Exact. - -%% Match context type. --record(ms, - {id=make_ref() :: reference(), %Unique ID. - valid=0 :: non_neg_integer(), %Valid slots - slots=0 :: non_neg_integer() %Number of slots - }). - --type type() :: binary | - cons | - list | - map | - nil | - #ms{} | - ms_position | - none | - number | - term | - tuple_in_progress | - {tuple, tuple_sz(), #{ literal() => type() }} | - literal(). - +%% Register tags describe the state of the register rather than the value they +%% contain (if any). +%% +%% initialized The register has been initialized with some valid term +%% so that it is safe to pass to the garbage collector. +%% NOT safe to use in any other way (will not crash the +%% emulator, but clearly points to a bug in the compiler). +%% +%% uninitialized The register contains any old garbage and can not be +%% passed to the garbage collector. +%% +%% {catchtag,[Lbl]} A special term used within a catch. Must only be used +%% by the catch instructions; NOT safe to use in other +%% instructions. +%% +%% {trytag,[Lbl]} A special term used within a try block. Must only be +%% used by the catch instructions; NOT safe to use in other +%% instructions. -type tag() :: initialized | uninitialized | - {catchtag, [label()]} | - {trytag, [label()]}. + {catchtag, ordsets:ordset(label())} | + {trytag, ordsets:ordset(label())}. -type x_regs() :: #{ {x, index()} => #value_ref{} }. -type y_regs() :: #{ {y, index()} => tag() | #value_ref{} }. @@ -200,11 +176,11 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> numy=none :: none | undecided | index(), %% Available heap size. h=0, - %Available heap size for floats. + %%Available heap size for floats. hf=0, %% Floating point state. fls=undefined, - %% List of hot catch/try labels + %% List of hot catch/try tags ct=[], %% Previous instruction was setelement/3. setelem=false, @@ -230,36 +206,34 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> branched=gb_trees:empty() :: branched_tab(), %% All defined labels labels=gb_sets:empty() :: label_set(), - %% Argument information of other functions in the module + %% Information of other functions in the module ft=gb_trees:empty() :: ft_tab(), %% Counter for #value_ref{} creation ref_ctr=0 :: index() }). -index_parameter_types([{function,_,_,Entry,Code0}|Fs], Acc0) -> +build_function_table([{function,_,Arity,Entry,Code0}|Fs], Acc0) -> Code = dropwhile(fun({label,L}) when L =:= Entry -> false; (_) -> true end, Code0), case Code of [{label,Entry}|Is] -> - Acc = index_parameter_types_1(Is, Entry, Acc0), - index_parameter_types(Fs, Acc); + Info = #{ arity => Arity, + parameter_info => find_parameter_info(Is, #{}) }, + build_function_table(Fs, [{Entry, Info} | Acc0]); _ -> - %% Something serious is wrong. Ignore it for now. + %% Something is seriously wrong. Ignore it for now. %% It will be detected and diagnosed later. - index_parameter_types(Fs, Acc0) + build_function_table(Fs, Acc0) end; -index_parameter_types([], Acc) -> +build_function_table([], Acc) -> gb_trees:from_orddict(sort(Acc)). -index_parameter_types_1([{'%', {type_info, Reg, Type0}} | Is], Entry, Acc) -> - Type = case Type0 of - match_context -> #ms{}; - _ -> Type0 - end, - Key = {Entry, Reg}, - index_parameter_types_1(Is, Entry, [{Key, Type} | Acc]); -index_parameter_types_1(_, _, Acc) -> +find_parameter_info([{'%', {var_info, Reg, Info}} | Is], Acc) -> + find_parameter_info(Is, Acc#{ Reg => Info }); +find_parameter_info([{'%', _} | Is], Acc) -> + find_parameter_info(Is, Acc); +find_parameter_info(_, Acc) -> Acc. validate_1(Is, Name, Arity, Entry, Ft) -> @@ -278,7 +252,7 @@ validate_3({Ls2,Is}, Name, Arity, Entry, Mod, Ls1, Ft) -> EntryOK -> Vst0 = init_vst(Arity, Ls1, Ls2, Ft), MFA = {Mod,Name,Arity}, - Vst = valfun(Is, MFA, Offset, Vst0), + Vst = validate_instrs(Is, MFA, Offset, Vst0), validate_fun_info_branches(Ls1, MFA, Vst); true -> error({{Mod,Name,Arity},{first(Is),Offset,no_entry_label}}) @@ -331,12 +305,12 @@ init_vst(Arity, Ls1, Ls2, Ft) -> init_function_args(-1, Vst) -> Vst; init_function_args(X, Vst) -> - init_function_args(X - 1, create_term(term, argument, [], {x,X}, Vst)). + init_function_args(X - 1, create_term(any, argument, [], {x,X}, Vst)). kill_heap_allocation(St) -> St#st{h=0,hf=0}. -valfun([], MFA, _Offset, #vst{branched=Targets0,labels=Labels0}=Vst) -> +validate_instrs([], MFA, _Offset, #vst{branched=Targets0,labels=Labels0}=Vst) -> Targets = gb_trees:keys(Targets0), Labels = gb_sets:to_list(Labels0), case Targets -- Labels of @@ -345,109 +319,134 @@ valfun([], MFA, _Offset, #vst{branched=Targets0,labels=Labels0}=Vst) -> Error = {undef_labels,Undef}, error({MFA,Error}) end; -valfun([I|Is], MFA, Offset, Vst0) -> - valfun(Is, MFA, Offset+1, +validate_instrs([I|Is], MFA, Offset, Vst0) -> + validate_instrs(Is, MFA, Offset+1, try - Vst = val_dsetel(I, Vst0), - valfun_1(I, Vst) + Vst = validate_mutation(I, Vst0), + vi_safe(I, Vst) catch Error -> error({MFA,{I,Offset,Error}}) end). -%% Instructions that are allowed in dead code or when failing, -%% that is while the state is undecided in some way. -valfun_1({label,Lbl}, #vst{current=St0, - ref_ctr=Counter0, - branched=B, - labels=Lbls}=Vst) -> +%%% +%%% vi_safe/2 handles instructions that will never throw an exception, and can +%%% thus be used when the state is undecided in some way. +%%% +vi_safe({label,Lbl}, #vst{current=St0, + ref_ctr=Counter0, + branched=B, + labels=Lbls}=Vst) -> {St, Counter} = merge_states(Lbl, St0, B, Counter0), Vst#vst{current=St, ref_ctr=Counter, branched=gb_trees:enter(Lbl, St, B), labels=gb_sets:add(Lbl, Lbls)}; -valfun_1(_I, #vst{current=none}=Vst) -> - %% Ignore instructions after erlang:error/1,2, which - %% the original R10B compiler thought would return. +vi_safe(_I, #vst{current=none}=Vst) -> + %% Ignore all unreachable code. Vst; -valfun_1({badmatch,Src}, Vst) -> - assert_durable_term(Src, Vst), - verify_y_init(Vst), - kill_state(Vst); -valfun_1({case_end,Src}, Vst) -> - assert_durable_term(Src, Vst), - verify_y_init(Vst), - kill_state(Vst); -valfun_1(if_end, Vst) -> - verify_y_init(Vst), - kill_state(Vst); -valfun_1({try_case_end,Src}, Vst) -> - verify_y_init(Vst), - assert_durable_term(Src, Vst), - kill_state(Vst); -%% Instructions that cannot cause exceptions -valfun_1({bs_get_tail,Ctx,Dst,Live}, Vst0) -> - bsm_validate_context(Ctx, Vst0), +vi_safe({bs_get_tail,Ctx,Dst,Live}, Vst0) -> + assert_type(#t_bs_context{}, Ctx, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), + + #t_bs_context{tail_unit=Unit} = get_raw_type(Ctx, Vst0), + Vst = prune_x_regs(Live, Vst0), - extract_term(binary, bs_get_tail, [Ctx], Dst, Vst, Vst0); -valfun_1(bs_init_writable=I, Vst) -> + extract_term(#t_bitstring{size_unit=Unit}, bs_get_tail, [Ctx], Dst, + Vst, Vst0); +vi_safe(bs_init_writable=I, Vst) -> call(I, 1, Vst); -valfun_1(build_stacktrace=I, Vst) -> +vi_safe(build_stacktrace=I, Vst) -> call(I, 1, Vst); -valfun_1({move,Src,Dst}, Vst) -> +vi_safe({move,Src,Dst}, Vst) -> assign(Src, Dst, Vst); -valfun_1({fmove,Src,{fr,_}=Dst}, Vst) -> - assert_type(float, Src, Vst), +vi_safe({swap,RegA,RegB}, Vst0) -> + assert_movable(RegA, Vst0), + assert_movable(RegB, Vst0), + + %% We don't expect fragile registers to be swapped. + %% Therefore, we can conservatively make both registers + %% fragile if one of the register is fragile instead of + %% swapping the fragility of the registers. + Sources = [RegA,RegB], + Vst1 = propagate_fragility(RegA, Sources, Vst0), + Vst2 = propagate_fragility(RegB, Sources, Vst1), + + %% Swap the value references. + VrefA = get_reg_vref(RegA, Vst2), + VrefB = get_reg_vref(RegB, Vst2), + Vst = set_reg_vref(VrefB, RegA, Vst2), + set_reg_vref(VrefA, RegB, Vst); +vi_safe({fmove,Src,{fr,_}=Dst}, Vst) -> + assert_type(#t_float{}, Src, Vst), set_freg(Dst, Vst); -valfun_1({fmove,{fr,_}=Src,Dst}, Vst0) -> +vi_safe({fmove,{fr,_}=Src,Dst}, Vst0) -> assert_freg_set(Src, Vst0), assert_fls(checked, Vst0), Vst = eat_heap_float(Vst0), - create_term({float,[]}, fmove, [], Dst, Vst); -valfun_1({kill,Reg}, Vst) -> + create_term(#t_float{}, fmove, [], Dst, Vst); +vi_safe({kill,Reg}, Vst) -> create_tag(initialized, kill, [], Reg, Vst); -valfun_1({init,Reg}, Vst) -> +vi_safe({init,Reg}, Vst) -> create_tag(initialized, init, [], Reg, Vst); -valfun_1({test_heap,Heap,Live}, Vst) -> +vi_safe({test_heap,Heap,Live}, Vst) -> test_heap(Heap, Live, Vst); -valfun_1({bif,Op,{f,_},Ss,Dst}=I, Vst) -> - case is_bif_safe(Op, length(Ss)) of - false -> - %% Since the BIF can fail, make sure that any catch state - %% is updated. - valfun_2(I, Vst); - true -> - %% It can't fail, so we finish handling it here (not updating - %% catch state). - validate_src(Ss, Vst), - Type = bif_return_type(Op, Ss, Vst), - extract_term(Type, {bif,Op}, Ss, Dst, Vst) +vi_safe({bif,Op,{f,0},Ss,Dst}=I, Vst0) -> + case will_bif_succeed(Op, Ss, Vst0) of + yes -> + %% This BIF cannot fail, handle it here without updating catch + %% state. + validate_bif(Op, cannot_fail, Ss, Dst, Vst0); + no -> + %% The stack will be scanned, so Y registers must be initialized. + Vst = branch_exception(Vst0), + verify_y_init(Vst), + kill_state(Vst); + maybe -> + %% The BIF can fail, make sure that any catch state is updated. + Vst = branch_exception(Vst0), + vi_float(I, Vst) + end; +vi_safe({gc_bif,Op,{f,0},Live,Ss,Dst}=I, Vst0) -> + case will_bif_succeed(Op, Ss, Vst0) of + yes -> + validate_gc_bif(Op, cannot_fail, Ss, Dst, Live, Vst0); + no -> + Vst = branch_exception(Vst0), + verify_y_init(Vst), + kill_state(Vst); + maybe -> + Vst = branch_exception(Vst0), + assert_float_checked(Vst), + vi_float(I, Vst) end; %% Put instructions. -valfun_1({put_list,A,B,Dst}, Vst0) -> - assert_term(A, Vst0), - assert_term(B, Vst0), +vi_safe({put_list,A,B,Dst}, Vst0) -> Vst = eat_heap(2, Vst0), - create_term(cons, put_list, [A, B], Dst, Vst); -valfun_1({put_tuple2,Dst,{list,Elements}}, Vst0) -> + + Head = get_term_type(A, Vst), + Tail = get_term_type(B, Vst), + + create_term(beam_types:make_cons(Head, Tail), put_list, [A, B], Dst, Vst); +vi_safe({put_tuple2,Dst,{list,Elements}}, Vst0) -> _ = [assert_term(El, Vst0) || El <- Elements], Size = length(Elements), Vst = eat_heap(Size+1, Vst0), {Es,_} = foldl(fun(Val, {Es0, Index}) -> Type = get_term_type(Val, Vst0), - Es = set_element_type({integer,Index}, Type, Es0), + Es = beam_types:set_tuple_element(Index, Type, Es0), {Es, Index + 1} end, {#{}, 1}, Elements), - Type = {tuple,Size,Es}, + Type = #t_tuple{exact=true,size=Size,elements=Es}, create_term(Type, put_tuple2, [], Dst, Vst); -valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) -> +vi_safe({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) -> Vst1 = eat_heap(1, Vst0), - Vst = create_term(tuple_in_progress, put_tuple, [], Dst, Vst1), + Vst = create_term(#t_abstract{kind=unfinished_tuple}, put_tuple, [], + Dst, Vst1), #vst{current=St0} = Vst, St = St0#st{puts_left={Sz,{Dst,Sz,#{}}}}, Vst#vst{current=St}; -valfun_1({put,Src}, Vst0) -> +vi_safe({put,Src}, Vst0) -> assert_term(Src, Vst0), Vst = eat_heap(1, Vst0), #vst{current=St0} = Vst, @@ -455,35 +454,46 @@ valfun_1({put,Src}, Vst0) -> #st{puts_left=none} -> error(not_building_a_tuple); #st{puts_left={1,{Dst,Sz,Es0}}} -> - Es = Es0#{ {integer,Sz} => get_term_type(Src, Vst0) }, + ElementType = get_term_type(Src, Vst0), + Es = beam_types:set_tuple_element(Sz, ElementType, Es0), St = St0#st{puts_left=none}, - create_term({tuple,Sz,Es}, put_tuple, [], Dst, Vst#vst{current=St}); + Type = #t_tuple{exact=true,size=Sz,elements=Es}, + create_term(Type, put_tuple, [], Dst, Vst#vst{current=St}); #st{puts_left={PutsLeft,{Dst,Sz,Es0}}} when is_integer(PutsLeft) -> Index = Sz - PutsLeft + 1, - Es = Es0#{ {integer,Index} => get_term_type(Src, Vst0) }, + ElementType = get_term_type(Src, Vst0), + Es = beam_types:set_tuple_element(Index, ElementType, Es0), St = St0#st{puts_left={PutsLeft-1,{Dst,Sz,Es}}}, Vst#vst{current=St} end; +%% This instruction never fails, though it may be invalid in some contexts; see +%% validate_mutation/2 +vi_safe({set_tuple_element,Src,Tuple,N}, Vst) -> + I = N + 1, + assert_term(Src, Vst), + assert_type(#t_tuple{size=I}, Tuple, Vst), + %% Manually update the tuple type; we can't rely on the ordinary update + %% helpers as we must support overwriting (rather than just widening or + %% narrowing) known elements, and we can't use extract_term either since + %% the source tuple may be aliased. + #t_tuple{elements=Es0}=Type = normalize(get_term_type(Tuple, Vst)), + Es = beam_types:set_tuple_element(I, get_term_type(Src, Vst), Es0), + override_type(Type#t_tuple{elements=Es}, Tuple, Vst); %% Instructions for optimization of selective receives. -valfun_1({recv_mark,{f,Fail}}, Vst) when is_integer(Fail) -> +vi_safe({recv_mark,{f,Fail}}, Vst) when is_integer(Fail) -> set_receive_marker(initialized, Vst); -valfun_1({recv_set,{f,Fail}}, Vst) when is_integer(Fail) -> +vi_safe({recv_set,{f,Fail}}, Vst) when is_integer(Fail) -> set_receive_marker(committed, Vst); %% Misc. -valfun_1(remove_message, Vst0) -> +vi_safe(remove_message, Vst0) -> Vst = set_receive_marker(none, Vst0), %% The message term is no longer fragile. It can be used %% without restrictions. remove_fragility(Vst); -valfun_1({'%', {type_info, Reg, match_context}}, Vst) -> - update_type(fun meet/2, #ms{}, Reg, Vst); -valfun_1({'%', {type_info, Reg, Type}}, Vst) -> - %% Explicit type information inserted by optimization passes to indicate - %% that Reg has a certain type, so that we can accept cross-function type - %% optimizations. - update_type(fun meet/2, Type, Reg, Vst); -valfun_1({'%', {remove_fragility, Reg}}, Vst) -> +vi_safe({'%', {var_info, Reg, Info}}, Vst) -> + validate_var_info(Info, Reg, Vst); +vi_safe({'%', {remove_fragility, Reg}}, Vst) -> %% This is a hack to make prim_eval:'receive'/2 work. %% %% Normally it's illegal to pass fragile terms as a function argument as we @@ -491,40 +501,50 @@ valfun_1({'%', {remove_fragility, Reg}}, Vst) -> %% prim_eval:'receive'/2 won't leak the term, nor cause a GC since it's %% disabled while matching messages. remove_fragility(Reg, Vst); -valfun_1({'%',_}, Vst) -> +vi_safe({'%',_}, Vst) -> Vst; -valfun_1({line,_}, Vst) -> +vi_safe({line,_}, Vst) -> Vst; -%% Exception generating calls -valfun_1({call_ext,Live,Func}=I, Vst) -> - case call_return_type(Func, Vst) of - exception -> - verify_live(Live, Vst), - %% The stack will be scanned, so Y registers - %% must be initialized. - verify_y_init(Vst), - kill_state(Vst); - _ -> - valfun_2(I, Vst) - end; -valfun_1(_I, #vst{current=#st{ct=undecided}}) -> + +%% +%% Calls; these may be okay when the try/catch state or stack is undecided, +%% depending on whether they always succeed or always fail. +%% +vi_safe({apply,Live}, Vst) -> + validate_body_call(apply, Live+2, Vst); +vi_safe({apply_last,Live,N}, Vst) -> + validate_tail_call(N, apply, Live+2, Vst); +vi_safe({call,Live,Func}, Vst) -> + validate_body_call(Func, Live, Vst); +vi_safe({call_ext,Live,Func}, Vst) -> + validate_body_call(Func, Live, Vst); +vi_safe({call_only,Live,Func}, Vst) -> + validate_tail_call(none, Func, Live, Vst); +vi_safe({call_ext_only,Live,Func}, Vst) -> + validate_tail_call(none, Func, Live, Vst); +vi_safe({call_last,Live,Func,N}, Vst) -> + validate_tail_call(N, Func, Live, Vst); +vi_safe({call_ext_last,Live,Func,N}, Vst) -> + validate_tail_call(N, Func, Live, Vst); +vi_safe(_I, #vst{current=#st{ct=undecided}}) -> error(unknown_catch_try_state); %% %% Allocate and deallocate, et.al -valfun_1({allocate,Stk,Live}, Vst) -> +%% +vi_safe({allocate,Stk,Live}, Vst) -> allocate(uninitialized, Stk, 0, Live, Vst); -valfun_1({allocate_heap,Stk,Heap,Live}, Vst) -> +vi_safe({allocate_heap,Stk,Heap,Live}, Vst) -> allocate(uninitialized, Stk, Heap, Live, Vst); -valfun_1({allocate_zero,Stk,Live}, Vst) -> +vi_safe({allocate_zero,Stk,Live}, Vst) -> allocate(initialized, Stk, 0, Live, Vst); -valfun_1({allocate_heap_zero,Stk,Heap,Live}, Vst) -> +vi_safe({allocate_heap_zero,Stk,Heap,Live}, Vst) -> allocate(initialized, Stk, Heap, Live, Vst); -valfun_1({deallocate,StkSize}, #vst{current=#st{numy=StkSize}}=Vst) -> +vi_safe({deallocate,StkSize}, #vst{current=#st{numy=StkSize}}=Vst) -> verify_no_ct(Vst), deallocate(Vst); -valfun_1({deallocate,_}, #vst{current=#st{numy=NumY}}) -> +vi_safe({deallocate,_}, #vst{current=#st{numy=NumY}}) -> error({allocated,NumY}); -valfun_1({trim,N,Remaining}, #vst{current=St0}=Vst) -> +vi_safe({trim,N,Remaining}, #vst{current=St0}=Vst) -> #st{numy=NumY} = St0, if N =< NumY, N+Remaining =:= NumY -> @@ -533,13 +553,13 @@ valfun_1({trim,N,Remaining}, #vst{current=St0}=Vst) -> error({trim,N,Remaining,allocated,NumY}) end; %% Catch & try. -valfun_1({'catch',Dst,{f,Fail}}, Vst) when Fail =/= none -> +vi_safe({'catch',Dst,{f,Fail}}, Vst) when Fail =/= none -> init_try_catch_branch(catchtag, Dst, Fail, Vst); -valfun_1({'try',Dst,{f,Fail}}, Vst) when Fail =/= none -> +vi_safe({'try',Dst,{f,Fail}}, Vst) when Fail =/= none -> init_try_catch_branch(trytag, Dst, Fail, Vst); -valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst0) -> +vi_safe({catch_end,Reg}, #vst{current=#st{ct=[Tag|_]}}=Vst0) -> case get_tag_type(Reg, Vst0) of - {catchtag,Fail} -> + {catchtag,_Fail}=Tag -> %% Kill the catch tag and receive marker. %% %% The marker is only cleared when an exception is thrown, but it's @@ -548,164 +568,116 @@ valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst0) -> Vst = set_receive_marker(none, Vst1), %% {x,0} contains the caught term, if any. - create_term(term, catch_end, [], {x,0}, Vst); + create_term(any, catch_end, [], {x,0}, Vst); Type -> error({wrong_tag_type,Type}) end; -valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst) -> +vi_safe({try_end,Reg}, #vst{current=#st{ct=[Tag|_]}}=Vst) -> case get_tag_type(Reg, Vst) of - {trytag,Fail} -> + {trytag,_Fail}=Tag -> %% Kill the catch tag. Note that x registers and the receive marker %% are unaffected. kill_catch_tag(Reg, Vst); Type -> error({wrong_tag_type,Type}) end; -valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst0) -> +vi_safe({try_case,Reg}, #vst{current=#st{ct=[Tag|_]}}=Vst0) -> case get_tag_type(Reg, Vst0) of - {trytag,Fail} -> + {trytag,_Fail}=Tag -> %% Kill the catch tag, all x registers, and the receive marker. Vst1 = kill_catch_tag(Reg, Vst0), Vst2 = prune_x_regs(0, Vst1), Vst3 = set_receive_marker(none, Vst2), %% Class:Error:Stacktrace - Vst4 = create_term({atom,[]}, try_case, [], {x,0}, Vst3), - Vst = create_term(term, try_case, [], {x,1}, Vst4), - create_term(term, try_case, [], {x,2}, Vst); + Vst4 = create_term(#t_atom{}, try_case, [], {x,0}, Vst3), + Vst = create_term(any, try_case, [], {x,1}, Vst4), + create_term(any, try_case, [], {x,2}, Vst); Type -> error({wrong_tag_type,Type}) end; -valfun_1({get_list,Src,D1,D2}, Vst0) -> +%% Simple getters that can't fail. +vi_safe({get_list,Src,D1,D2}, Vst0) -> assert_not_literal(Src), - assert_type(cons, Src, Vst0), - Vst = extract_term(term, get_hd, [Src], D1, Vst0), - extract_term(term, get_tl, [Src], D2, Vst); -valfun_1({get_hd,Src,Dst}, Vst) -> + assert_type(#t_cons{}, Src, Vst0), + + SrcType = get_term_type(Src, Vst0), + {HeadType, _, _} = beam_call_types:types(erlang, hd, [SrcType]), + {TailType, _, _} = beam_call_types:types(erlang, tl, [SrcType]), + + Vst = extract_term(HeadType, get_hd, [Src], D1, Vst0), + extract_term(TailType, get_tl, [Src], D2, Vst, Vst0); +vi_safe({get_hd,Src,Dst}, Vst) -> assert_not_literal(Src), - assert_type(cons, Src, Vst), - extract_term(term, get_hd, [Src], Dst, Vst); -valfun_1({get_tl,Src,Dst}, Vst) -> + assert_type(#t_cons{}, Src, Vst), + + SrcType = get_term_type(Src, Vst), + {HeadType, _, _} = beam_call_types:types(erlang, hd, [SrcType]), + + extract_term(HeadType, get_hd, [Src], Dst, Vst); +vi_safe({get_tl,Src,Dst}, Vst) -> assert_not_literal(Src), - assert_type(cons, Src, Vst), - extract_term(term, get_tl, [Src], Dst, Vst); -valfun_1({get_tuple_element,Src,N,Dst}, Vst) -> + assert_type(#t_cons{}, Src, Vst), + + SrcType = get_term_type(Src, Vst), + {TailType, _, _} = beam_call_types:types(erlang, tl, [SrcType]), + + extract_term(TailType, get_tl, [Src], Dst, Vst); +vi_safe({get_tuple_element,Src,N,Dst}, Vst) -> + Index = N+1, assert_not_literal(Src), - assert_type({tuple_element,N+1}, Src, Vst), - Index = {integer,N+1}, - Type = get_element_type(Index, Src, Vst), - extract_term(Type, {bif,element}, [Index, Src], Dst, Vst); -valfun_1({jump,{f,Lbl}}, Vst) -> + assert_type(#t_tuple{size=Index}, Src, Vst), + #t_tuple{elements=Es} = normalize(get_term_type(Src, Vst)), + Type = beam_types:get_tuple_element(Index, Es), + extract_term(Type, {bif,element}, [{integer,Index}, Src], Dst, Vst); +vi_safe({jump,{f,Lbl}}, Vst) -> branch(Lbl, Vst, fun(SuccVst) -> %% The next instruction is never executed. kill_state(SuccVst) end); -valfun_1(return, Vst) -> +vi_safe(return, Vst) -> assert_durable_term({x,0}, Vst), - verify_return(Vst), - kill_state(Vst); + verify_return(Vst); -valfun_1({set_tuple_element,Src,Tuple,N}, Vst) -> - I = N + 1, - assert_term(Src, Vst), - assert_type({tuple_element,I}, Tuple, Vst), - %% Manually update the tuple type; we can't rely on the ordinary update - %% helpers as we must support overwriting (rather than just widening or - %% narrowing) known elements, and we can't use extract_term either since - %% the source tuple may be aliased. - {tuple, Sz, Es0} = get_term_type(Tuple, Vst), - Es = set_element_type({integer,I}, get_term_type(Src, Vst), Es0), - override_type({tuple, Sz, Es}, Tuple, Vst); +%% +%% Matching and test instructions. +%% -%% Match instructions. -valfun_1({select_val,Src,{f,Fail},{list,Choices}}, Vst) -> +vi_safe({select_val,Src,{f,Fail},{list,Choices}}, Vst) -> assert_term(Src, Vst), assert_choices(Choices), validate_select_val(Fail, Choices, Src, Vst); -valfun_1({select_tuple_arity,Tuple,{f,Fail},{list,Choices}}, Vst) -> - assert_type(tuple, Tuple, Vst), +vi_safe({select_tuple_arity,Tuple,{f,Fail},{list,Choices}}, Vst) -> + assert_type(#t_tuple{}, Tuple, Vst), assert_arities(Choices), validate_select_tuple_arity(Fail, Choices, Tuple, Vst); - -%% New bit syntax matching instructions. -valfun_1({test,bs_start_match3,{f,Fail},Live,[Src],Dst}, Vst) -> - validate_bs_start_match(Fail, Live, bsm_match_state(), Src, Dst, Vst); -valfun_1({test,bs_start_match2,{f,Fail},Live,[Src,Slots],Dst}, Vst) -> - validate_bs_start_match(Fail, Live, bsm_match_state(Slots), Src, Dst, Vst); -valfun_1({test,bs_match_string,{f,Fail},[Ctx,_,_]}, Vst) -> - bsm_validate_context(Ctx, Vst), - branch(Fail, Vst, fun(V) -> V end); -valfun_1({test,bs_skip_bits2,{f,Fail},[Ctx,Src,_,_]}, Vst) -> - bsm_validate_context(Ctx, Vst), - assert_term(Src, Vst), - branch(Fail, Vst, fun(V) -> V end); -valfun_1({test,bs_test_tail2,{f,Fail},[Ctx,_]}, Vst) -> - bsm_validate_context(Ctx, Vst), - branch(Fail, Vst, fun(V) -> V end); -valfun_1({test,bs_test_unit,{f,Fail},[Ctx,_]}, Vst) -> - bsm_validate_context(Ctx, Vst), - branch(Fail, Vst, fun(V) -> V end); -valfun_1({test,bs_skip_utf8,{f,Fail},[Ctx,Live,_]}, Vst) -> - validate_bs_skip_utf(Fail, Ctx, Live, Vst); -valfun_1({test,bs_skip_utf16,{f,Fail},[Ctx,Live,_]}, Vst) -> - validate_bs_skip_utf(Fail, Ctx, Live, Vst); -valfun_1({test,bs_skip_utf32,{f,Fail},[Ctx,Live,_]}, Vst) -> - validate_bs_skip_utf(Fail, Ctx, Live, Vst); -valfun_1({test,bs_get_integer2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> - validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); -valfun_1({test,bs_get_float2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> - validate_bs_get(Op, Fail, Ctx, Live, {float, []}, Dst, Vst); -valfun_1({test,bs_get_binary2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> - validate_bs_get(Op, Fail, Ctx, Live, binary, Dst, Vst); -valfun_1({test,bs_get_utf8=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> - validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); -valfun_1({test,bs_get_utf16=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> - validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); -valfun_1({test,bs_get_utf32=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> - validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); -valfun_1({bs_save2,Ctx,SavePoint}, Vst) -> - bsm_save(Ctx, SavePoint, Vst); -valfun_1({bs_restore2,Ctx,SavePoint}, Vst) -> - bsm_restore(Ctx, SavePoint, Vst); -valfun_1({bs_get_position, Ctx, Dst, Live}, Vst0) -> - bsm_validate_context(Ctx, Vst0), - verify_live(Live, Vst0), - verify_y_init(Vst0), - Vst = prune_x_regs(Live, Vst0), - create_term(ms_position, bs_get_position, [Ctx], Dst, Vst, Vst0); -valfun_1({bs_set_position, Ctx, Pos}, Vst) -> - bsm_validate_context(Ctx, Vst), - assert_type(ms_position, Pos, Vst), - Vst; -valfun_1({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) -> - assert_type(map, Src, Vst), - assert_unique_map_keys(List), - branch(Lbl, Vst, fun(V) -> V end); -valfun_1({test,is_atom,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, {atom,[]}, Src, Vst); -valfun_1({test,is_binary,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, binary, Src, Vst); -valfun_1({test,is_bitstr,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, binary, Src, Vst); -valfun_1({test,is_boolean,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, bool, Src, Vst); -valfun_1({test,is_float,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, {float,[]}, Src, Vst); -valfun_1({test,is_tuple,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, {tuple,[0],#{}}, Src, Vst); -valfun_1({test,is_integer,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, {integer,[]}, Src, Vst); -valfun_1({test,is_nonempty_list,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, cons, Src, Vst); -valfun_1({test,is_number,{f,Lbl},[Src]}, Vst) -> +vi_safe({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) -> + verify_has_map_fields(Lbl, Src, List, Vst); +vi_safe({test,is_atom,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, #t_atom{}, Src, Vst); +vi_safe({test,is_binary,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, #t_bitstring{size_unit=8}, Src, Vst); +vi_safe({test,is_bitstr,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, #t_bitstring{}, Src, Vst); +vi_safe({test,is_boolean,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, beam_types:make_boolean(), Src, Vst); +vi_safe({test,is_float,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, #t_float{}, Src, Vst); +vi_safe({test,is_tuple,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, #t_tuple{}, Src, Vst); +vi_safe({test,is_integer,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, #t_integer{}, Src, Vst); +vi_safe({test,is_nonempty_list,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, #t_cons{}, Src, Vst); +vi_safe({test,is_number,{f,Lbl},[Src]}, Vst) -> type_test(Lbl, number, Src, Vst); -valfun_1({test,is_list,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, list, Src, Vst); -valfun_1({test,is_map,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, map, Src, Vst); -valfun_1({test,is_nil,{f,Lbl},[Src]}, Vst) -> +vi_safe({test,is_list,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, #t_list{}, Src, Vst); +vi_safe({test,is_map,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, #t_map{}, Src, Vst); +vi_safe({test,is_nil,{f,Lbl},[Src]}, Vst) -> %% is_nil is an exact check against the 'nil' value, and should not be %% treated as a simple type test. assert_term(Src, Vst), @@ -716,15 +688,16 @@ valfun_1({test,is_nil,{f,Lbl},[Src]}, Vst) -> fun(SuccVst) -> update_eq_types(Src, nil, SuccVst) end); -valfun_1({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) -> - assert_type(tuple, Tuple, Vst), - Type = {tuple, Sz, #{}}, +vi_safe({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) -> + assert_type(#t_tuple{}, Tuple, Vst), + Type = #t_tuple{exact=true,size=Sz}, type_test(Lbl, Type, Tuple, Vst); -valfun_1({test,is_tagged_tuple,{f,Lbl},[Src,Sz,Atom]}, Vst) -> +vi_safe({test,is_tagged_tuple,{f,Lbl},[Src,Sz,Atom]}, Vst) -> assert_term(Src, Vst), - Type = {tuple, Sz, #{ {integer,1} => Atom }}, + Es = #{ 1 => get_literal_type(Atom) }, + Type = #t_tuple{exact=true,size=Sz,elements=Es}, type_test(Lbl, Type, Src, Vst); -valfun_1({test,is_eq_exact,{f,Lbl},[Src,Val]=Ss}, Vst) -> +vi_safe({test,is_eq_exact,{f,Lbl},[Src,Val]=Ss}, Vst) -> validate_src(Ss, Vst), branch(Lbl, Vst, fun(FailVst) -> @@ -733,7 +706,7 @@ valfun_1({test,is_eq_exact,{f,Lbl},[Src,Val]=Ss}, Vst) -> fun(SuccVst) -> update_eq_types(Src, Val, SuccVst) end); -valfun_1({test,is_ne_exact,{f,Lbl},[Src,Val]=Ss}, Vst) -> +vi_safe({test,is_ne_exact,{f,Lbl},[Src,Val]=Ss}, Vst) -> validate_src(Ss, Vst), branch(Lbl, Vst, fun(FailVst) -> @@ -742,63 +715,220 @@ valfun_1({test,is_ne_exact,{f,Lbl},[Src,Val]=Ss}, Vst) -> fun(SuccVst) -> update_ne_types(Src, Val, SuccVst) end); -valfun_1({test,_Op,{f,Lbl},Src}, Vst) -> +%% +%% New bit syntax matching instructions. +%% +vi_safe({bs_start_match4,Fail,Live,Src,Dst}, Vst) -> + validate_bs_start_match(Fail, Live, 0, Src, Dst, Vst); +vi_safe({test,bs_start_match3,{f,_}=Fail,Live,[Src],Dst}, Vst) -> + validate_bs_start_match(Fail, Live, 0, Src, Dst, Vst); +vi_safe({test,bs_start_match2,{f,_}=Fail,Live,[Src,Slots],Dst}, Vst) -> + validate_bs_start_match(Fail, Live, Slots, Src, Dst, Vst); +%% +%% Bit syntax positioning +%% +vi_safe({bs_save2,Ctx,SavePoint}, Vst) -> + bsm_save(Ctx, SavePoint, Vst); +vi_safe({bs_restore2,Ctx,SavePoint}, Vst) -> + bsm_restore(Ctx, SavePoint, Vst); +vi_safe({bs_get_position, Ctx, Dst, Live}, Vst0) -> + assert_type(#t_bs_context{}, Ctx, Vst0), + verify_live(Live, Vst0), + verify_y_init(Vst0), + Vst = prune_x_regs(Live, Vst0), + create_term(#t_abstract{kind=ms_position}, bs_get_position, [Ctx], + Dst, Vst, Vst0); +vi_safe({bs_set_position, Ctx, Pos}, Vst) -> + assert_type(#t_bs_context{}, Ctx, Vst), + assert_type(#t_abstract{kind=ms_position}, Pos, Vst), + Vst; +%% +%% Bit syntax matching +%% +vi_safe({test,bs_match_string,{f,Fail},[Ctx,Rem,{string,String}]}, Vst) -> + true = is_bitstring(String), %Assertion. + Stride = bit_size(String) + Rem, + validate_bs_skip(Fail, Ctx, Stride, Vst); +vi_safe({test,bs_skip_bits2,{f,Fail},[Ctx,Size,Unit,_Flags]}, Vst) -> + assert_term(Size, Vst), + + Stride = case get_raw_type(Size, Vst) of + #t_integer{elements={Same,Same}} -> Same * Unit; + _ -> Unit + end, + + validate_bs_skip(Fail, Ctx, Stride, Vst); +vi_safe({test,bs_test_tail2,{f,Fail},[Ctx,_Size]}, Vst) -> + assert_type(#t_bs_context{}, Ctx, Vst), + branch(Fail, Vst, fun(V) -> V end); +vi_safe({test,bs_test_unit,{f,Fail},[Ctx,Unit]}, Vst) -> + assert_type(#t_bs_context{}, Ctx, Vst), + type_test(Fail, #t_bs_context{tail_unit=Unit}, Ctx, Vst); +vi_safe({test,bs_skip_utf8,{f,Fail},[Ctx,Live,_]}, Vst) -> + validate_bs_skip(Fail, Ctx, 8, Live, Vst); +vi_safe({test,bs_skip_utf16,{f,Fail},[Ctx,Live,_]}, Vst) -> + validate_bs_skip(Fail, Ctx, 16, Live, Vst); +vi_safe({test,bs_skip_utf32,{f,Fail},[Ctx,Live,_]}, Vst) -> + validate_bs_skip(Fail, Ctx, 32, Live, Vst); +vi_safe({test,bs_get_integer2=Op,{f,Fail},Live, + [Ctx,{integer,Size},Unit,{field_flags,Flags}],Dst},Vst) -> + NumBits = Size * Unit, + Type = case member(unsigned, Flags) of + true when NumBits =< 64 -> + beam_types:make_integer(0, (1 bsl NumBits)-1); + _ -> + %% Signed integer or way too large, don't bother. + #t_integer{} + end, + validate_bs_get(Op, Fail, Ctx, Live, NumBits, Type, Dst, Vst); +vi_safe({test,bs_get_integer2=Op,{f,Fail},Live, + [Ctx,_Size,Unit,_Flags],Dst},Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, Unit, #t_integer{}, Dst, Vst); +vi_safe({test,bs_get_float2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, 1, #t_float{}, Dst, Vst); +vi_safe({test,bs_get_binary2=Op,{f,Fail},Live,[Ctx,_,Unit,_],Dst}, Vst) -> + Type = #t_bitstring{size_unit=Unit}, + validate_bs_get(Op, Fail, Ctx, Live, Unit, Type, Dst, Vst); +vi_safe({test,bs_get_utf8=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> + Type = beam_types:make_integer(0, ?UNICODE_MAX), + validate_bs_get(Op, Fail, Ctx, Live, 8, Type, Dst, Vst); +vi_safe({test,bs_get_utf16=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> + Type = beam_types:make_integer(0, ?UNICODE_MAX), + validate_bs_get(Op, Fail, Ctx, Live, 16, Type, Dst, Vst); +vi_safe({test,bs_get_utf32=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> + Type = beam_types:make_integer(0, ?UNICODE_MAX), + validate_bs_get(Op, Fail, Ctx, Live, 32, Type, Dst, Vst); + +vi_safe({test,_Op,{f,Lbl},Src}, Vst) -> %% is_pid, is_reference, et cetera. validate_src(Src, Vst), branch(Lbl, Vst, fun(V) -> V end); - -%% Map instructions. -valfun_1({put_map_assoc=Op,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> +vi_safe({put_map_assoc=Op,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> verify_put_map(Op, Fail, Src, Dst, Live, List, Vst); -valfun_1({get_map_elements,{f,Fail},Src,{list,List}}, Vst) -> +vi_safe({get_map_elements,{f,Fail},Src,{list,List}}, Vst) -> verify_get_map(Fail, Src, List, Vst); +vi_safe(I, Vst0) -> + Vst = branch_exception(Vst0), + vi_float(I, Vst). + +validate_var_info([{fun_type, Type} | Info], Reg, Vst0) -> + %% Explicit type information inserted after make_fun2 instructions to mark + %% the return type of the created fun. + Vst = update_type(fun meet/2, #t_fun{type=Type}, Reg, Vst0), + validate_var_info(Info, Reg, Vst); +validate_var_info([{type, none} | _Info], _Reg, Vst) -> + %% Unreachable code, typically after a call that never returns. + kill_state(Vst); +validate_var_info([{type, Type} | Info], Reg, Vst0) -> + %% Explicit type information inserted by optimization passes to indicate + %% that Reg has a certain type, so that we can accept cross-function type + %% optimizations. + Vst = update_type(fun meet/2, Type, Reg, Vst0), + validate_var_info(Info, Reg, Vst); +validate_var_info([_ | Info], Reg, Vst) -> + validate_var_info(Info, Reg, Vst); +validate_var_info([], _Reg, Vst) -> + Vst. + +validate_tail_call(Deallocate, Func, Live, #vst{current=#st{numy=NumY}}=Vst0) -> + assert_float_checked(Vst0), + case will_call_succeed(Func, Vst0) of + yes when Deallocate =:= NumY -> + %% This call cannot fail, handle it without updating catch state. + tail_call(Func, Live, Vst0); + maybe when Deallocate =:= NumY -> + %% The call can fail, make sure that any catch state is updated. + Vst = branch_exception(Vst0), + tail_call(Func, Live, Vst); + no -> + %% The stack will be scanned, so Y registers must be initialized. + %% + %% Note that the compiler is allowed to emit garbage values for + %% "Deallocate" as we know that it will not be used in this case. + Vst = branch_exception(Vst0), + verify_live(Live, Vst), + verify_y_init(Vst), + kill_state(Vst); + _ when Deallocate =/= NumY -> + error({allocated, NumY}) + end. + +validate_body_call(Func, Live, + #vst{current=#st{numy=NumY}}=Vst0) when is_integer(NumY)-> + assert_float_checked(Vst0), + case will_call_succeed(Func, Vst0) of + yes -> + call(Func, Live, Vst0); + maybe -> + Vst = branch_exception(Vst0), + call(Func, Live, Vst); + no -> + Vst = branch_exception(Vst0), + verify_live(Live, Vst), + verify_y_init(Vst), + kill_state(Vst) + end; +validate_body_call(_, _, #vst{current=#st{numy=NumY}}) -> + error({allocated, NumY}). -valfun_1(I, Vst) -> - valfun_2(I, Vst). +assert_float_checked(Vst) -> + case get_fls(Vst) of + undefined -> ok; + checked -> ok; + Fls -> error({unsafe_instruction,{float_error_state,Fls}}) + end. -init_try_catch_branch(Tag, Dst, Fail, Vst0) -> - Vst1 = create_tag({Tag,[Fail]}, 'try_catch', [], Dst, Vst0), - #vst{current=#st{ct=Fails}=St0} = Vst1, - St = St0#st{ct=[[Fail]|Fails]}, - Vst = Vst0#vst{current=St}, +init_try_catch_branch(Kind, Dst, Fail, Vst0) -> + Tag = {Kind, [Fail]}, + Vst = create_tag(Tag, 'try_catch', [], Dst, Vst0), branch(Fail, Vst, fun(CatchVst0) -> - #vst{current=#st{ys=Ys}} = CatchVst0, - CatchVst = maps:fold(fun init_catch_handler_1/3, - CatchVst0, Ys), - %% The receive marker is cleared on exceptions. - set_receive_marker(none, CatchVst) + %% We add the tag here because branch/4 rejects jumps to + %% labels referenced by try tags. + #vst{current=#st{ct=Tags,ys=Ys}=St0} = CatchVst0, + St = St0#st{ct=[Tag|Tags]}, + CatchVst1 = CatchVst0#vst{current=St}, + + %% The receive marker is cleared on exceptions. + CatchVst = set_receive_marker(none, CatchVst1), + + maps:fold(fun init_catch_handler_1/3, CatchVst, Ys) end, - fun(SuccVst) -> - %% All potentially-throwing instructions after this - %% one will implicitly branch to the fail label; - %% see valfun_2/2 - SuccVst + fun(SuccVst0) -> + #vst{current=#st{ct=Tags}=St0} = SuccVst0, + St = St0#st{ct=[Tag|Tags]}, + SuccVst = SuccVst0#vst{current=St}, + + %% All potentially-throwing instructions after this one will + %% implicitly branch to the current try/catch handler; see + %% the base case of vi_safe/2 + SuccVst end). %% Set the initial state at the try/catch label. Assume that Y registers %% contain terms or try/catch tags. init_catch_handler_1(Reg, initialized, Vst) -> - create_term(term, 'catch_handler', [], Reg, Vst); + create_term(any, 'catch_handler', [], Reg, Vst); init_catch_handler_1(Reg, uninitialized, Vst) -> - create_term(term, 'catch_handler', [], Reg, Vst); + create_term(any, 'catch_handler', [], Reg, Vst); init_catch_handler_1(_, _, Vst) -> Vst. -valfun_2(I, #vst{current=#st{ct=[[Fail]|_]}}=Vst) when is_integer(Fail) -> +branch_exception(#vst{current=#st{ct=[{_,[Fail]}|_]}}=Vst) + when is_integer(Fail) -> %% We have an active try/catch tag and we can jump there from this %% instruction, so we need to update the branched state of the try/catch %% handler. - valfun_3(I, branch_state(Fail, Vst)); -valfun_2(I, #vst{current=#st{ct=[]}}=Vst) -> - valfun_3(I, Vst); -valfun_2(_, _) -> + fork_state(Fail, Vst); +branch_exception(#vst{current=#st{ct=[]}}=Vst) -> + Vst; +branch_exception(_) -> error(ambiguous_catch_try_state). %% Handle the remaining floating point instructions here. %% Floating point. -valfun_3({fconv,Src,{fr,_}=Dst}, Vst) -> +vi_float({fconv,Src,{fr,_}=Dst}, Vst) -> assert_term(Src, Vst), %% An exception is raised on error, hence branching to 0. @@ -807,184 +937,127 @@ valfun_3({fconv,Src,{fr,_}=Dst}, Vst) -> SuccVst = update_type(fun meet/2, number, Src, SuccVst0), set_freg(Dst, SuccVst) end); -valfun_3({bif,fadd,_,[_,_]=Ss,Dst}, Vst) -> +vi_float({bif,fadd,_,[_,_]=Ss,Dst}, Vst) -> float_op(Ss, Dst, Vst); -valfun_3({bif,fdiv,_,[_,_]=Ss,Dst}, Vst) -> +vi_float({bif,fdiv,_,[_,_]=Ss,Dst}, Vst) -> float_op(Ss, Dst, Vst); -valfun_3({bif,fmul,_,[_,_]=Ss,Dst}, Vst) -> +vi_float({bif,fmul,_,[_,_]=Ss,Dst}, Vst) -> float_op(Ss, Dst, Vst); -valfun_3({bif,fnegate,_,[_]=Ss,Dst}, Vst) -> +vi_float({bif,fnegate,_,[_]=Ss,Dst}, Vst) -> float_op(Ss, Dst, Vst); -valfun_3({bif,fsub,_,[_,_]=Ss,Dst}, Vst) -> +vi_float({bif,fsub,_,[_,_]=Ss,Dst}, Vst) -> float_op(Ss, Dst, Vst); -valfun_3(fclearerror, Vst) -> +vi_float(fclearerror, Vst) -> case get_fls(Vst) of - undefined -> ok; - checked -> ok; - Fls -> error({bad_floating_point_state,Fls}) + undefined -> ok; + checked -> ok; + Fls -> error({bad_floating_point_state,Fls}) end, set_fls(cleared, Vst); -valfun_3({fcheckerror,_}, Vst) -> +vi_float({fcheckerror,_}, Vst) -> assert_fls(cleared, Vst), set_fls(checked, Vst); -valfun_3(I, Vst) -> - %% The instruction is not a float instruction. - case get_fls(Vst) of - undefined -> - valfun_4(I, Vst); - checked -> - valfun_4(I, Vst); - Fls -> - error({unsafe_instruction,{float_error_state,Fls}}) - end. - -%% Instructions that can cause exceptions. -valfun_4({put_map_exact=Op,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> - verify_put_map(Op, Fail, Src, Dst, Live, List, Vst); -valfun_4({apply,Live}, Vst) -> - call(apply, Live+2, Vst); -valfun_4({apply_last,Live,_}, Vst) -> - tail_call(apply, Live+2, Vst); -valfun_4({call_fun,Live}, Vst) -> - validate_src([{x,Live}], Vst), - call('fun', Live+1, Vst); -valfun_4({call,Live,Func}, Vst) -> - call(Func, Live, Vst); -valfun_4({call_ext,Live,Func}, Vst) -> - %% Exception BIFs has already been taken care of above. - call(Func, Live, Vst); -valfun_4({call_only,Live,Func}, Vst) -> - tail_call(Func, Live, Vst); -valfun_4({call_ext_only,Live,Func}, Vst) -> - tail_call(Func, Live, Vst); -valfun_4({call_last,Live,Func,StkSize}, #vst{current=#st{numy=StkSize}}=Vst) -> - tail_call(Func, Live, Vst); -valfun_4({call_last,_,_,_}, #vst{current=#st{numy=NumY}}) -> - error({allocated,NumY}); -valfun_4({call_ext_last,Live,Func,StkSize}, - #vst{current=#st{numy=StkSize}}=Vst) -> - tail_call(Func, Live, Vst); -valfun_4({call_ext_last,_,_,_}, #vst{current=#st{numy=NumY}}) -> - error({allocated,NumY}); -valfun_4({make_fun2,_,_,_,Live}, Vst) -> - call(make_fun, Live, Vst); -%% Other BIFs -valfun_4({bif,element,{f,Fail},[Pos,Src],Dst}, Vst) -> - branch(Fail, Vst, - fun(SuccVst0) -> - PosType = get_term_type(Pos, SuccVst0), - TupleType = {tuple,[get_tuple_size(PosType)],#{}}, +vi_float(I, Vst) -> + assert_float_checked(Vst), + vi_throwing(I, Vst). - SuccVst1 = update_type(fun meet/2, TupleType, - Src, SuccVst0), - SuccVst = update_type(fun meet/2, {integer,[]}, - Pos, SuccVst1), - - ElementType = get_element_type(PosType, Src, SuccVst), - extract_term(ElementType, {bif,element}, [Pos,Src], - Dst, SuccVst) - end); -valfun_4({bif,raise,{f,0},Src,_Dst}, Vst) -> - validate_src(Src, Vst), +%%% +%%% vi_throwing/2 handles instructions that can cause exceptions. +%%% +vi_throwing({badmatch,Src}, Vst) -> + assert_durable_term(Src, Vst), + verify_y_init(Vst), kill_state(Vst); -valfun_4(raw_raise=I, Vst) -> - call(I, 3, Vst); -valfun_4({bif,Op,{f,Fail},[Src]=Ss,Dst}, Vst) when Op =:= hd; Op =:= tl -> - assert_term(Src, Vst), - branch(Fail, Vst, - fun(FailVst) -> - update_type(fun subtract/2, cons, Src, FailVst) - end, - fun(SuccVst0) -> - SuccVst = update_type(fun meet/2, cons, Src, SuccVst0), - extract_term(term, {bif,Op}, Ss, Dst, SuccVst) - end); -valfun_4({bif,Op,{f,Fail},Ss,Dst}, Vst) -> - validate_src(Ss, Vst), - branch(Fail, Vst, +vi_throwing({case_end,Src}, Vst) -> + assert_durable_term(Src, Vst), + verify_y_init(Vst), + kill_state(Vst); +vi_throwing(if_end, Vst) -> + verify_y_init(Vst), + kill_state(Vst); +vi_throwing({try_case_end,Src}, Vst) -> + verify_y_init(Vst), + assert_durable_term(Src, Vst), + kill_state(Vst); +vi_throwing({call_fun,Live}, Vst) -> + Fun = {x,Live}, + assert_term(Fun, Vst), + + %% An exception is raised on error, hence branching to 0. + branch(0, Vst, fun(SuccVst0) -> - %% Infer argument types. Note that we can't subtract - %% types as the BIF could fail for reasons other than - %% bad argument types. - ArgTypes = bif_arg_types(Op, Ss), - SuccVst = foldl(fun({Arg, T}, V) -> - update_type(fun meet/2, T, Arg, V) - end, SuccVst0, zip(Ss, ArgTypes)), - Type = bif_return_type(Op, Ss, SuccVst), - extract_term(Type, {bif,Op}, Ss, Dst, SuccVst) + SuccVst = update_type(fun meet/2, #t_fun{arity=Live}, + Fun, SuccVst0), + validate_body_call('fun', Live+1, SuccVst) end); -valfun_4({gc_bif,Op,{f,Fail},Live,Ss,Dst}, #vst{current=St0}=Vst0) -> - validate_src(Ss, Vst0), - verify_live(Live, Vst0), - verify_y_init(Vst0), +vi_throwing({make_fun2,{f,Lbl},_,_,NumFree}, #vst{ft=Ft}=Vst0) -> + #{ arity := Arity0 } = gb_trees:get(Lbl, Ft), + Arity = Arity0 - NumFree, - %% Heap allocations and X registers are killed regardless of whether we - %% fail or not, as we may fail after GC. - St = kill_heap_allocation(St0), - Vst = prune_x_regs(Live, Vst0#vst{current=St}), - - branch(Fail, Vst, - fun(SuccVst0) -> - ArgTypes = bif_arg_types(Op, Ss), - SuccVst = foldl(fun({Arg, T}, V) -> - update_type(fun meet/2, T, Arg, V) - end, SuccVst0, zip(Ss, ArgTypes)), + true = Arity >= 0, %Assertion. - Type = bif_return_type(Op, Ss, SuccVst), + Vst = prune_x_regs(NumFree, Vst0), + verify_call_args(make_fun, NumFree, Vst), + verify_y_init(Vst), - %% We're passing Vst0 as the original because the - %% registers were pruned before the branch. - extract_term(Type, {gc_bif,Op}, Ss, Dst, SuccVst, Vst0) - end); -valfun_4({loop_rec,{f,Fail},Dst}, Vst) -> + create_term(#t_fun{arity=Arity}, make_fun, [], {x,0}, Vst); +%% Other BIFs +vi_throwing({bif,raise,{f,0},Src,_Dst}, Vst) -> + validate_src(Src, Vst), + kill_state(Vst); +vi_throwing(raw_raise=I, Vst) -> + call(I, 3, Vst); +vi_throwing({bif,Op,{f,Fail},Ss,Dst}, Vst) -> + validate_bif(Op, Fail, Ss, Dst, Vst); +vi_throwing({gc_bif,Op,{f,Fail},Live,Ss,Dst}, Vst) -> + validate_gc_bif(Op, Fail, Ss, Dst, Live, Vst); +vi_throwing({loop_rec,{f,Fail},Dst}, Vst) -> %% This term may not be part of the root set until remove_message/0 is %% executed. If control transfers to the loop_rec_end/1 instruction, no %% part of this term must be stored in a Y register. branch(Fail, Vst, fun(SuccVst0) -> - {Ref, SuccVst} = new_value(term, loop_rec, [], SuccVst0), + {Ref, SuccVst} = new_value(any, loop_rec, [], SuccVst0), mark_fragile(Dst, set_reg_vref(Ref, Dst, SuccVst)) end); -valfun_4({wait,_}, Vst) -> +vi_throwing({wait,_}, Vst) -> verify_y_init(Vst), kill_state(Vst); -valfun_4({wait_timeout,_,Src}, Vst) -> +vi_throwing({wait_timeout,_,Src}, Vst) -> %% Note that the receive marker is not cleared since we may re-enter the %% loop while waiting. If we time out we'll be transferred to a timeout %% instruction that clears the marker. assert_term(Src, Vst), verify_y_init(Vst), prune_x_regs(0, Vst); -valfun_4({loop_rec_end,_}, Vst) -> +vi_throwing({loop_rec_end,_}, Vst) -> verify_y_init(Vst), kill_state(Vst); -valfun_4(timeout, Vst0) -> +vi_throwing(timeout, Vst0) -> Vst = set_receive_marker(none, Vst0), prune_x_regs(0, Vst); -valfun_4(send, Vst) -> +vi_throwing(send, Vst) -> call(send, 2, Vst); - -%% Other test instructions. -valfun_4({bs_add,{f,Fail},[A,B,_],Dst}, Vst) -> +vi_throwing({bs_add,{f,Fail},[A,B,_],Dst}, Vst) -> assert_term(A, Vst), assert_term(B, Vst), branch(Fail, Vst, fun(SuccVst) -> - create_term({integer,[]}, bs_add, [A, B], Dst, SuccVst) + create_term(#t_integer{}, bs_add, [A, B], Dst, SuccVst) end); -valfun_4({bs_utf8_size,{f,Fail},A,Dst}, Vst) -> +vi_throwing({bs_utf8_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), branch(Fail, Vst, fun(SuccVst) -> - create_term({integer,[]}, bs_utf8_size, [A], Dst, SuccVst) + create_term(#t_integer{}, bs_utf8_size, [A], Dst, SuccVst) end); -valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) -> +vi_throwing({bs_utf16_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), branch(Fail, Vst, fun(SuccVst) -> - create_term({integer,[]}, bs_utf16_size, [A], Dst, SuccVst) + create_term(#t_integer{}, bs_utf16_size, [A], Dst, SuccVst) end); -valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> +vi_throwing({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), if @@ -997,9 +1070,10 @@ valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> branch(Fail, Vst, fun(SuccVst0) -> SuccVst = prune_x_regs(Live, SuccVst0), - create_term(binary, bs_init2, [], Dst, SuccVst, SuccVst0) + create_term(#t_bitstring{size_unit=8}, bs_init2, [], Dst, + SuccVst, SuccVst0) end); -valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> +vi_throwing({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), if @@ -1012,9 +1086,9 @@ valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> branch(Fail, Vst, fun(SuccVst0) -> SuccVst = prune_x_regs(Live, SuccVst0), - create_term(binary, bs_init_bits, [], Dst, SuccVst) + create_term(#t_bitstring{}, bs_init_bits, [], Dst, SuccVst) end); -valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> +vi_throwing({bs_append,{f,Fail},Bits,Heap,Live,Unit,Bin,_Flags,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), assert_term(Bits, Vst0), @@ -1023,62 +1097,81 @@ valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> branch(Fail, Vst, fun(SuccVst0) -> SuccVst = prune_x_regs(Live, SuccVst0), - create_term(binary, bs_append, [Bin], Dst, SuccVst, SuccVst0) + create_term(#t_bitstring{size_unit=Unit}, bs_append, + [Bin], Dst, SuccVst, SuccVst0) end); -valfun_4({bs_private_append,{f,Fail},Bits,_Unit,Bin,_Flags,Dst}, Vst) -> +vi_throwing({bs_private_append,{f,Fail},Bits,Unit,Bin,_Flags,Dst}, Vst) -> assert_term(Bits, Vst), assert_term(Bin, Vst), branch(Fail, Vst, fun(SuccVst) -> - create_term(binary, bs_private_append, [Bin], Dst, SuccVst) + create_term(#t_bitstring{size_unit=Unit}, bs_private_append, + [Bin], Dst, SuccVst) end); -valfun_4({bs_put_string,Sz,_}, Vst) when is_integer(Sz) -> +vi_throwing({bs_put_string,Sz,_}, Vst) when is_integer(Sz) -> Vst; -valfun_4({bs_put_binary,{f,Fail},Sz,_,_,Src}, Vst) -> +vi_throwing({bs_put_binary,{f,Fail},Sz,_,_,Src}, Vst) -> assert_term(Sz, Vst), assert_term(Src, Vst), branch(Fail, Vst, fun(SuccVst) -> - update_type(fun meet/2, binary, Src, SuccVst) + update_type(fun meet/2, #t_bitstring{}, Src, SuccVst) end); -valfun_4({bs_put_float,{f,Fail},Sz,_,_,Src}, Vst) -> +vi_throwing({bs_put_float,{f,Fail},Sz,_,_,Src}, Vst) -> assert_term(Sz, Vst), assert_term(Src, Vst), branch(Fail, Vst, fun(SuccVst) -> - update_type(fun meet/2, {float,[]}, Src, SuccVst) + update_type(fun meet/2, #t_float{}, Src, SuccVst) end); -valfun_4({bs_put_integer,{f,Fail},Sz,_,_,Src}, Vst) -> +vi_throwing({bs_put_integer,{f,Fail},Sz,_,_,Src}, Vst) -> assert_term(Sz, Vst), assert_term(Src, Vst), branch(Fail, Vst, fun(SuccVst) -> - update_type(fun meet/2, {integer,[]}, Src, SuccVst) + update_type(fun meet/2, #t_integer{}, Src, SuccVst) end); -valfun_4({bs_put_utf8,{f,Fail},_,Src}, Vst) -> +vi_throwing({bs_put_utf8,{f,Fail},_,Src}, Vst) -> assert_term(Src, Vst), branch(Fail, Vst, fun(SuccVst) -> - update_type(fun meet/2, {integer,[]}, Src, SuccVst) + update_type(fun meet/2, #t_integer{}, Src, SuccVst) end); -valfun_4({bs_put_utf16,{f,Fail},_,Src}, Vst) -> +vi_throwing({bs_put_utf16,{f,Fail},_,Src}, Vst) -> assert_term(Src, Vst), branch(Fail, Vst, fun(SuccVst) -> - update_type(fun meet/2, {integer,[]}, Src, SuccVst) + update_type(fun meet/2, #t_integer{}, Src, SuccVst) end); -valfun_4({bs_put_utf32,{f,Fail},_,Src}, Vst) -> +vi_throwing({bs_put_utf32,{f,Fail},_,Src}, Vst) -> assert_term(Src, Vst), branch(Fail, Vst, fun(SuccVst) -> - update_type(fun meet/2, {integer,[]}, Src, SuccVst) + update_type(fun meet/2, #t_integer{}, Src, SuccVst) end); -valfun_4(_, _) -> +%% Map instructions. +vi_throwing({put_map_exact=Op,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> + verify_put_map(Op, Fail, Src, Dst, Live, List, Vst); +vi_throwing(_, _) -> error(unknown_instruction). +verify_has_map_fields(Lbl, Src, List, Vst) -> + assert_type(#t_map{}, Src, Vst), + assert_unique_map_keys(List), + verify_map_fields(List, Src, Lbl, Vst). + +verify_map_fields([Key | Keys], Map, Lbl, Vst) -> + assert_term(Key, Vst), + case bif_types(map_get, [Key, Map], Vst) of + {none, _, _} -> kill_state(Vst); + {_, _, _} -> verify_map_fields(Keys, Map, Lbl, Vst) + end; +verify_map_fields([], _Map, Lbl, Vst) -> + branch(Lbl, Vst, fun(V) -> V end). + verify_get_map(Fail, Src, List, Vst0) -> assert_not_literal(Src), %OTP 22. - assert_type(map, Src, Vst0), + assert_type(#t_map{}, Src, Vst0), branch(Fail, Vst0, fun(FailVst) -> @@ -1102,7 +1195,7 @@ verify_get_map(Fail, Src, List, Vst0) -> clobber_map_vals([Key,Dst|T], Map, Vst0) -> case is_reg_initialized(Dst, Vst0) of true -> - Vst = extract_term(term, {bif,map_get}, [Key, Map], Dst, Vst0), + Vst = extract_term(any, {bif,map_get}, [Key, Map], Dst, Vst0), clobber_map_vals(T, Map, Vst); false -> clobber_map_vals(T, Map, Vst0) @@ -1125,15 +1218,20 @@ extract_map_keys([Key,_Val|T]) -> [Key|extract_map_keys(T)]; extract_map_keys([]) -> []. -extract_map_vals([Key,Dst|Vs], Map, Vst0, Vsti0) -> +extract_map_vals([Key, Dst | Vs], Map, Vst0, Vsti0) -> assert_term(Key, Vst0), - Vsti = extract_term(term, {bif,map_get}, [Key, Map], Dst, Vsti0), - extract_map_vals(Vs, Map, Vst0, Vsti); + case bif_types(map_get, [Key, Map], Vst0) of + {none, _, _} -> + kill_state(Vsti0); + {DstType, _, _} -> + Vsti = extract_term(DstType, {bif,map_get}, [Key, Map], Dst, Vsti0), + extract_map_vals(Vs, Map, Vst0, Vsti) + end; extract_map_vals([], _Map, _Vst0, Vst) -> Vst. verify_put_map(Op, Fail, Src, Dst, Live, List, Vst0) -> - assert_type(map, Src, Vst0), + assert_type(#t_map{}, Src, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), _ = [assert_term(Term, Vst0) || Term <- List], @@ -1144,9 +1242,22 @@ verify_put_map(Op, Fail, Src, Dst, Live, List, Vst0) -> SuccVst = prune_x_regs(Live, SuccVst0), Keys = extract_map_keys(List), assert_unique_map_keys(Keys), - create_term(map, Op, [Src], Dst, SuccVst, SuccVst0) + + Type = put_map_type(Src, List, Vst), + create_term(Type, Op, [Src], Dst, SuccVst, SuccVst0) end). +put_map_type(Map0, List, Vst) -> + Map = normalize(get_term_type(Map0, Vst)), + pmt_1(List, Vst, Map). + +pmt_1([Key0, Value0 | List], Vst, Acc0) -> + Key = normalize(get_term_type(Key0, Vst)), + Value = normalize(get_term_type(Value0, Vst)), + {Acc, _, _} = beam_call_types:types(maps, put, [Key, Value, Acc0]), + pmt_1(List, Vst, Acc); +pmt_1([], _Vst, Acc) -> + Acc. %% %% Common code for validating returns, whether naked or as part of a tail call. @@ -1172,66 +1283,162 @@ verify_return(#vst{current=#st{recv_marker=Mark}}) when Mark =/= none -> error({return_with_receive_marker,Mark}); verify_return(Vst) -> verify_no_ct(Vst), - ok. + kill_state(Vst). + +%% +%% Common code for validating BIFs. +%% +%% OrigVst is the state we entered the instruction with, which is needed for +%% gc_bifs as X registers are pruned prior to calling this function, which may +%% have clobbered the sources. +%% + +validate_bif(Op, Fail, Ss, Dst, Vst) -> + validate_src(Ss, Vst), + validate_bif_1(bif, Op, Fail, Ss, Dst, Vst, Vst). + +validate_gc_bif(Op, Fail, Ss, Dst, Live, #vst{current=St0}=Vst0) -> + validate_src(Ss, Vst0), + verify_live(Live, Vst0), + verify_y_init(Vst0), + + %% Heap allocations and X registers are killed regardless of whether we + %% fail or not, as we may fail after GC. + St = kill_heap_allocation(St0), + Vst = prune_x_regs(Live, Vst0#vst{current=St}), + validate_src(Ss, Vst), + + validate_bif_1(gc_bif, Op, Fail, Ss, Dst, Vst, Vst). + +validate_bif_1(Kind, Op, cannot_fail, Ss, Dst, OrigVst, Vst0) -> + %% This BIF explicitly cannot fail; it will not jump to a guard nor throw + %% an exception. Validation will fail if it returns 'none' or has a type + %% conflict on one of its arguments. + + {Type, ArgTypes, _CanSubtract} = bif_types(Op, Ss, Vst0), + ZippedArgs = zip(Ss, ArgTypes), + + Vst = foldl(fun({A, T}, V) -> + update_type(fun meet/2, T, A, V) + end, Vst0, ZippedArgs), + + true = Type =/= none, %Assertion. + + extract_term(Type, {Kind, Op}, Ss, Dst, Vst, OrigVst); +validate_bif_1(Kind, Op, Fail, Ss, Dst, OrigVst, Vst) -> + {Type, ArgTypes, CanSubtract} = bif_types(Op, Ss, Vst), + ZippedArgs = zip(Ss, ArgTypes), + + FailFun = case CanSubtract of + true -> + fun(FailVst0) -> + foldl(fun({A, T}, V) -> + update_type(fun subtract/2, T, A, V) + end, FailVst0, ZippedArgs) + end; + false -> + fun(S) -> S end + end, + SuccFun = fun(SuccVst0) -> + SuccVst = foldl(fun({A, T}, V) -> + update_type(fun meet/2, T, A, V) + end, SuccVst0, ZippedArgs), + extract_term(Type, {Kind, Op}, Ss, Dst, SuccVst, OrigVst) + end, + + branch(Fail, Vst, FailFun, SuccFun). %% %% Common code for validating bs_start_match* instructions. %% -validate_bs_start_match(Fail, Live, Type, Src, Dst, Vst) -> - verify_live(Live, Vst), - verify_y_init(Vst), +validate_bs_start_match({atom,resume}, Live, 0, Src, Dst, Vst0) -> + assert_type(#t_bs_context{}, Src, Vst0), + verify_live(Live, Vst0), + verify_y_init(Vst0), + + Vst = assign(Src, Dst, Vst0), + prune_x_regs(Live, Vst); +validate_bs_start_match({atom,no_fail}, Live, Slots, Src, Dst, Vst0) -> + verify_live(Live, Vst0), + verify_y_init(Vst0), + + Vst1 = update_type(fun meet/2, #t_bs_matchable{}, Src, Vst0), + + %% Retain the current unit, if known. + SrcType = get_movable_term_type(Src, Vst1), + TailUnit = beam_types:get_bs_matchable_unit(SrcType), - %% #ms{} can represent either a match context or a term, so we have to mark - %% the source as a term if it fails with a match context as an input. This - %% hack is only needed until we get proper union types. + CtxType = #t_bs_context{slots=Slots,tail_unit=TailUnit}, + + Vst = prune_x_regs(Live, Vst1), + extract_term(CtxType, bs_start_match, [Src], Dst, Vst, Vst0); +validate_bs_start_match({f,Fail}, Live, Slots, Src, Dst, Vst) -> branch(Fail, Vst, fun(FailVst) -> - case get_movable_term_type(Src, FailVst) of - #ms{} -> override_type(term, Src, FailVst); - _ -> FailVst - end + update_type(fun subtract/2, #t_bs_matchable{}, Src, FailVst) end, - fun(SuccVst0) -> - SuccVst1 = update_type(fun meet/2, binary, - Src, SuccVst0), - SuccVst = prune_x_regs(Live, SuccVst1), - extract_term(Type, bs_start_match, [Src], Dst, - SuccVst, SuccVst0) + fun(SuccVst) -> + validate_bs_start_match({atom,no_fail}, Live, Slots, + Src, Dst, SuccVst) end). %% %% Common code for validating bs_get* instructions. %% -validate_bs_get(Op, Fail, Ctx, Live, Type, Dst, Vst) -> - bsm_validate_context(Ctx, Vst), +validate_bs_get(Op, Fail, Ctx, Live, Stride, Type, Dst, Vst) -> + assert_type(#t_bs_context{}, Ctx, Vst), verify_live(Live, Vst), verify_y_init(Vst), + #t_bs_context{tail_unit=TailUnit} = get_raw_type(Ctx, Vst), + CtxType = #t_bs_context{tail_unit=gcd(Stride, TailUnit)}, + branch(Fail, Vst, fun(SuccVst0) -> - SuccVst = prune_x_regs(Live, SuccVst0), + SuccVst1 = update_type(fun meet/2, CtxType, Ctx, SuccVst0), + SuccVst = prune_x_regs(Live, SuccVst1), extract_term(Type, Op, [Ctx], Dst, SuccVst, SuccVst0) end). %% -%% Common code for validating bs_skip_utf* instructions. +%% Common code for validating bs_skip* instructions. %% -validate_bs_skip_utf(Fail, Ctx, Live, Vst) -> - bsm_validate_context(Ctx, Vst), +validate_bs_skip(Fail, Ctx, Stride, Vst) -> + validate_bs_skip(Fail, Ctx, Stride, no_live, Vst). + +validate_bs_skip(Fail, Ctx, Stride, Live, Vst) -> + assert_type(#t_bs_context{}, Ctx, Vst), + + #t_bs_context{tail_unit=TailUnit} = get_raw_type(Ctx, Vst), + CtxType = #t_bs_context{tail_unit=gcd(Stride, TailUnit)}, + + validate_bs_skip_1(Fail, Ctx, CtxType, Live, Vst). + +validate_bs_skip_1(Fail, Ctx, CtxType, no_live, Vst) -> + branch(Fail, Vst, + fun(SuccVst0) -> + update_type(fun meet/2, CtxType, Ctx, SuccVst0) + end); +validate_bs_skip_1(Fail, Ctx, CtxType, Live, Vst) -> verify_y_init(Vst), verify_live(Live, Vst), - branch(Fail, Vst, - fun(SuccVst) -> + fun(SuccVst0) -> + SuccVst = update_type(fun meet/2, CtxType, Ctx, SuccVst0), prune_x_regs(Live, SuccVst) end). - %% %% Common code for is_$type instructions. %% +type_test(Fail, #t_bs_context{}=Type, Reg, Vst) -> + assert_movable(Reg, Vst), + type_test_1(Fail, Type, Reg, Vst); type_test(Fail, Type, Reg, Vst) -> assert_term(Reg, Vst), + type_test_1(Fail, Type, Reg, Vst). + +type_test_1(Fail, Type, Reg, Vst) -> branch(Fail, Vst, fun(FailVst) -> update_type(fun subtract/2, Type, Reg, FailVst) @@ -1247,21 +1454,27 @@ type_test(Fail, Type, Reg, Vst) -> %% %% Note that #vst.current will be 'none' if the instruction is unreachable. %% -val_dsetel({move,_,_}, Vst) -> + +validate_mutation(I, Vst) -> + vm_1(I, Vst). + +vm_1({move,_,_}, Vst) -> Vst; -val_dsetel({call_ext,3,{extfunc,erlang,setelement,3}}, #vst{current=#st{}=St}=Vst) -> +vm_1({swap,_,_}, Vst) -> + Vst; +vm_1({call_ext,3,{extfunc,erlang,setelement,3}}, #vst{current=#st{}=St}=Vst) -> Vst#vst{current=St#st{setelem=true}}; -val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=false}}) -> +vm_1({set_tuple_element,_,_,_}, #vst{current=#st{setelem=false}}) -> error(illegal_context_for_set_tuple_element); -val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=true}}=Vst) -> +vm_1({set_tuple_element,_,_,_}, #vst{current=#st{setelem=true}}=Vst) -> Vst; -val_dsetel({get_tuple_element,_,_,_}, Vst) -> +vm_1({get_tuple_element,_,_,_}, Vst) -> Vst; -val_dsetel({line,_}, Vst) -> +vm_1({line,_}, Vst) -> Vst; -val_dsetel(_, #vst{current=#st{setelem=true}=St}=Vst) -> +vm_1(_, #vst{current=#st{setelem=true}=St}=Vst) -> Vst#vst{current=St#st{setelem=false}}; -val_dsetel(_, Vst) -> Vst. +vm_1(_, Vst) -> Vst. kill_state(Vst) -> Vst#vst{current=none}. @@ -1272,12 +1485,13 @@ kill_state(Vst) -> call(Name, Live, #vst{current=St0}=Vst0) -> verify_call_args(Name, Live, Vst0), verify_y_init(Vst0), - case call_return_type(Name, Vst0) of - Type when Type =/= exception -> - %% Type is never 'exception' because it has been handled earlier. + case call_types(Name, Live, Vst0) of + {none, _, _} -> + kill_state(Vst0); + {RetType, _, _} -> St = St0#st{f=init_fregs()}, Vst = prune_x_regs(0, Vst0#vst{current=St}), - create_term(Type, call, [], {x,0}, Vst) + create_term(RetType, call, [], {x,0}, Vst) end. %% Tail call. @@ -1287,16 +1501,19 @@ tail_call(Name, Live, Vst0) -> verify_y_init(Vst0), Vst = deallocate(Vst0), verify_call_args(Name, Live, Vst), - case call_return_type(Name, Vst0) of - exception -> verify_no_ct(Vst); - _ -> verify_return(Vst) - end, - kill_state(Vst). + verify_return(Vst). verify_call_args(_, 0, #vst{}) -> ok; -verify_call_args({f,Lbl}, Live, Vst) when is_integer(Live)-> - verify_local_args(Live - 1, Lbl, #{}, Vst); +verify_call_args({f,Lbl}, Live, #vst{ft=Ft}=Vst) when is_integer(Live) -> + case gb_trees:lookup(Lbl, Ft) of + {value, FuncInfo} -> + #{ arity := Live, + parameter_info := ParamInfo } = FuncInfo, + verify_local_args(Live - 1, ParamInfo, #{}, Vst); + none -> + error(local_call_to_unknown_function) + end; verify_call_args(_, Live, Vst) when is_integer(Live)-> verify_remote_args_1(Live - 1, Vst); verify_call_args(_, Live, _) -> @@ -1308,86 +1525,50 @@ verify_remote_args_1(X, Vst) -> assert_durable_term({x, X}, Vst), verify_remote_args_1(X - 1, Vst). -verify_local_args(-1, _Lbl, _CtxIds, _Vst) -> +verify_local_args(-1, _ParamInfo, _CtxIds, _Vst) -> ok; -verify_local_args(X, Lbl, CtxIds, Vst) -> +verify_local_args(X, ParamInfo, CtxRefs, Vst) -> Reg = {x, X}, assert_not_fragile(Reg, Vst), case get_movable_term_type(Reg, Vst) of - #ms{id=Id}=Type -> - case CtxIds of - #{ Id := Other } -> + #t_bs_context{}=Type -> + VRef = get_reg_vref(Reg, Vst), + case CtxRefs of + #{ VRef := Other } -> error({multiple_match_contexts, [Reg, Other]}); #{} -> - verify_arg_type(Lbl, Reg, Type, Vst), - verify_local_args(X - 1, Lbl, CtxIds#{ Id => Reg }, Vst) + verify_arg_type(Reg, Type, ParamInfo), + verify_local_args(X - 1, ParamInfo, + CtxRefs#{ VRef => Reg }, Vst) end; Type -> - verify_arg_type(Lbl, Reg, Type, Vst), - verify_local_args(X - 1, Lbl, CtxIds, Vst) + verify_arg_type(Reg, Type, ParamInfo), + verify_local_args(X - 1, ParamInfo, CtxRefs, Vst) end. -%% Verifies that the given argument narrows to what the function expects. -verify_arg_type(Lbl, Reg, #ms{}, #vst{ft=Ft}) -> - %% Match contexts require explicit support, and may not be passed to a - %% function that accepts arbitrary terms. - case gb_trees:lookup({Lbl, Reg}, Ft) of - {value, #ms{}} -> ok; - _ -> error(no_bs_start_match2) - end; -verify_arg_type(Lbl, Reg, GivenType, #vst{ft=Ft}) -> - case gb_trees:lookup({Lbl, Reg}, Ft) of - {value, #ms{}} -> - %% Functions that accept match contexts also accept all other - %% terms. This will change once we support union types. - ok; - {value, RequiredType} -> - case vat_1(GivenType, RequiredType) of - true -> ok; - false -> error({bad_arg_type, Reg, GivenType, RequiredType}) +verify_arg_type(Reg, GivenType, ParamTypes) -> + case {ParamTypes, GivenType} of + {#{ Reg := Info }, #t_bs_context{}} -> + %% Match contexts require explicit support, and may not be passed + %% to a function that accepts arbitrary terms. + case member(accepts_match_context, Info) of + true -> verify_arg_type_1(Reg, GivenType, Info); + false -> error(no_bs_start_match2) end; - none -> + {_, #t_bs_context{}} -> + error(no_bs_start_match2); + {#{ Reg := Info }, _} -> + verify_arg_type_1(Reg, GivenType, Info); + {#{}, _} -> ok end. -%% Checks whether the Given argument is compatible with the Required one. This -%% is essentially a relaxed version of 'meet(Given, Req) =:= Given', where we -%% accept that the Given value has the right type but not necessarily the exact -%% same value; if {atom,gurka} is required, we'll consider {atom,[]} valid. -%% -%% This will catch all problems that could crash the emulator, like passing a -%% 1-tuple when the callee expects a 3-tuple, but some value errors might slip -%% through. -vat_1(Same, Same) -> true; -vat_1({atom,A}, {atom,B}) -> A =:= B orelse is_list(A) orelse is_list(B); -vat_1({atom,A}, bool) -> is_boolean(A) orelse is_list(A); -vat_1(bool, {atom,B}) -> is_boolean(B) orelse is_list(B); -vat_1(cons, list) -> true; -vat_1({float,A}, {float,B}) -> A =:= B orelse is_list(A) orelse is_list(B); -vat_1({float,_}, number) -> true; -vat_1({integer,A}, {integer,B}) -> A =:= B orelse is_list(A) orelse is_list(B); -vat_1({integer,_}, number) -> true; -vat_1(_, {literal,_}) -> false; -vat_1({literal,_}=Lit, Required) -> vat_1(get_literal_type(Lit), Required); -vat_1(nil, list) -> true; -vat_1({tuple,SzA,EsA}, {tuple,SzB,EsB}) -> - if - is_list(SzB) -> - tuple_sz(SzA) >= tuple_sz(SzB) andalso vat_elements(EsA, EsB); - SzA =:= SzB -> - vat_elements(EsA, EsB); - SzA =/= SzB -> - false - end; -vat_1(_, _) -> false. - -vat_elements(EsA, EsB) -> - maps:fold(fun(Key, Req, Acc) -> - case EsA of - #{ Key := Given } -> Acc andalso vat_1(Given, Req); - #{} -> false - end - end, true, EsB). +verify_arg_type_1(Reg, GivenType, Info) -> + RequiredType = proplists:get_value(type, Info, any), + case meet(GivenType, RequiredType) of + GivenType -> ok; + _ -> error({bad_arg_type, Reg, GivenType, RequiredType}) + end. allocate(Tag, Stk, Heap, Live, #vst{current=#st{numy=none}=St}=Vst0) -> verify_live(Live, Vst0), @@ -1560,7 +1741,7 @@ assert_unique_map_keys([_,_|_]=Ls) -> assert_literal(L), L end || L <- Ls], - case length(Vs) =:= sets:size(sets:from_list(Vs)) of + case length(Vs) =:= cerl_sets:size(cerl_sets:from_list(Vs)) of true -> ok; false -> error(keys_not_unique) end. @@ -1569,49 +1750,35 @@ assert_unique_map_keys([_,_|_]=Ls) -> %%% New binary matching instructions. %%% -bsm_match_state() -> - #ms{}. -bsm_match_state(Slots) -> - #ms{slots=Slots}. - -bsm_validate_context(Reg, Vst) -> - _ = bsm_get_context(Reg, Vst), - ok. - -bsm_get_context({Kind,_}=Reg, Vst) when Kind =:= x; Kind =:= y-> - case get_movable_term_type(Reg, Vst) of - #ms{}=Ctx -> Ctx; - _ -> error({no_bsm_context,Reg}) - end; -bsm_get_context(Reg, _) -> - error({bad_source,Reg}). - bsm_save(Reg, {atom,start}, Vst) -> %% Save point refering to where the match started. %% It is always valid. But don't forget to validate the context register. - bsm_validate_context(Reg, Vst), + assert_type(#t_bs_context{}, Reg, Vst), Vst; bsm_save(Reg, SavePoint, Vst) -> - case bsm_get_context(Reg, Vst) of - #ms{valid=Bits,slots=Slots}=Ctxt0 when SavePoint < Slots -> - Ctx = Ctxt0#ms{valid=Bits bor (1 bsl SavePoint),slots=Slots}, - override_type(Ctx, Reg, Vst); - _ -> error({illegal_save,SavePoint}) + case get_movable_term_type(Reg, Vst) of + #t_bs_context{valid=Bits,slots=Slots}=Ctxt0 when SavePoint < Slots -> + Ctx = Ctxt0#t_bs_context{valid=Bits bor (1 bsl SavePoint), + slots=Slots}, + override_type(Ctx, Reg, Vst); + _ -> + error({illegal_save, SavePoint}) end. bsm_restore(Reg, {atom,start}, Vst) -> %% (Mostly) automatic save point refering to where the match started. %% It is always valid. But don't forget to validate the context register. - bsm_validate_context(Reg, Vst), + assert_type(#t_bs_context{}, Reg, Vst), Vst; bsm_restore(Reg, SavePoint, Vst) -> - case bsm_get_context(Reg, Vst) of - #ms{valid=Bits,slots=Slots} when SavePoint < Slots -> - case Bits band (1 bsl SavePoint) of - 0 -> error({illegal_restore,SavePoint,not_set}); - _ -> Vst - end; - _ -> error({illegal_restore,SavePoint,range}) + case get_movable_term_type(Reg, Vst) of + #t_bs_context{valid=Bits,slots=Slots} when SavePoint < Slots -> + case Bits band (1 bsl SavePoint) of + 0 -> error({illegal_restore, SavePoint, not_set}); + _ -> Vst + end; + _ -> + error({illegal_restore, SavePoint, range}) end. validate_select_val(_Fail, _Choices, _Src, #vst{current=none}=Vst) -> @@ -1627,7 +1794,7 @@ validate_select_val(Fail, [Val,{f,L}|T], Src, Vst0) -> update_ne_types(Src, Val, FailVst) end), validate_select_val(Fail, T, Src, Vst); -validate_select_val(Fail, [], _, Vst) -> +validate_select_val(Fail, [], _Src, Vst) -> branch(Fail, Vst, fun(SuccVst) -> %% The next instruction is never executed. @@ -1639,7 +1806,7 @@ validate_select_tuple_arity(_Fail, _Choices, _Src, #vst{current=none}=Vst) -> %% can't reach the fail label or any of the remaining choices. Vst; validate_select_tuple_arity(Fail, [Arity,{f,L}|T], Tuple, Vst0) -> - Type = {tuple, Arity, #{}}, + Type = #t_tuple{exact=true,size=Arity}, Vst = branch(L, Vst0, fun(BranchVst) -> update_type(fun meet/2, Type, Tuple, BranchVst) @@ -1655,63 +1822,103 @@ validate_select_tuple_arity(Fail, [], _, #vst{}=Vst) -> kill_state(SuccVst) end). -infer_types({Kind,_}=Reg, Vst) when Kind =:= x; Kind =:= y -> - infer_types(get_reg_vref(Reg, Vst), Vst); -infer_types(#value_ref{}=Ref, #vst{current=#st{vs=Vs}}) -> +%% +%% Infers types from comparisons, looking at the expressions that produced the +%% compared values and updates their types if we've learned something new from +%% the comparison. +%% + +infer_types(CompareOp, {Kind,_}=LHS, RHS, Vst) when Kind =:= x; Kind =:= y -> + infer_types(CompareOp, get_reg_vref(LHS, Vst), RHS, Vst); +infer_types(CompareOp, LHS, {Kind,_}=RHS, Vst) when Kind =:= x; Kind =:= y -> + infer_types(CompareOp, LHS, get_reg_vref(RHS, Vst), Vst); +infer_types(CompareOp, LHS, RHS, #vst{current=#st{vs=Vs}}=Vst0) -> case Vs of - #{ Ref := Entry } -> infer_types_1(Entry); - #{} -> fun(_, S) -> S end + #{ LHS := LEntry, RHS := REntry } -> + Vst = infer_types_1(LEntry, RHS, CompareOp, Vst0), + infer_types_1(REntry, LHS, CompareOp, Vst); + #{ LHS := LEntry } -> + infer_types_1(LEntry, RHS, CompareOp, Vst0); + #{ RHS := REntry } -> + infer_types_1(REntry, LHS, CompareOp, Vst0); + #{} -> + Vst0 + end. + +infer_types_1(#value{op={bif,'=:='},args=[LHS,RHS]}, Val, Op, Vst) -> + case Val of + {atom, Bool} when Op =:= eq_exact, Bool; Op =:= ne_exact, not Bool -> + update_eq_types(LHS, RHS, Vst); + {atom, Bool} when Op =:= ne_exact, Bool; Op =:= eq_exact, not Bool -> + update_ne_types(LHS, RHS, Vst); + _ -> + Vst end; -infer_types(_, #vst{}) -> - fun(_, S) -> S end. - -infer_types_1(#value{op={bif,'=:='},args=[LHS,RHS]}) -> - fun({atom,true}, S) -> - %% Either side might contain something worth inferring, so we need - %% to check them both. - Infer_L = infer_types(RHS, S), - Infer_R = infer_types(LHS, S), - Infer_R(RHS, Infer_L(LHS, S)); - (_, S) -> S +infer_types_1(#value{op={bif,'=/='},args=[LHS,RHS]}, Val, Op, Vst) -> + case Val of + {atom, Bool} when Op =:= ne_exact, Bool; Op =:= eq_exact, not Bool -> + update_ne_types(LHS, RHS, Vst); + {atom, Bool} when Op =:= eq_exact, Bool; Op =:= ne_exact, not Bool -> + update_eq_types(LHS, RHS, Vst); + _ -> + Vst end; -infer_types_1(#value{op={bif,element},args=[{integer,Index}=Key,Tuple]}) -> - fun(Val, S) -> - Type = {tuple,[Index], #{ Key => get_term_type(Val, S) }}, - update_type(fun meet/2, Type, Tuple, S) +infer_types_1(#value{op={bif,element},args=[{integer,Index},Tuple]}, + Val, Op, Vst) when Index >= 1 -> + ElementType = get_term_type(Val, Vst), + Es = beam_types:set_tuple_element(Index, ElementType, #{}), + TupleType = #t_tuple{size=Index,elements=Es}, + case Op of + eq_exact -> + update_type(fun meet/2, TupleType, Tuple, Vst); + ne_exact -> + %% Subtraction is only safe when ElementType is single-valued and + %% the index is below the tuple element limit. + case beam_types:is_singleton_type(ElementType) of + true when Es =/= #{} -> + update_type(fun subtract/2, TupleType, Tuple, Vst); + _ -> + Vst + end end; -infer_types_1(#value{op={bif,is_atom},args=[Src]}) -> - infer_type_test_bif({atom,[]}, Src); -infer_types_1(#value{op={bif,is_boolean},args=[Src]}) -> - infer_type_test_bif(bool, Src); -infer_types_1(#value{op={bif,is_binary},args=[Src]}) -> - infer_type_test_bif(binary, Src); -infer_types_1(#value{op={bif,is_bitstring},args=[Src]}) -> - infer_type_test_bif(binary, Src); -infer_types_1(#value{op={bif,is_float},args=[Src]}) -> - infer_type_test_bif(float, Src); -infer_types_1(#value{op={bif,is_integer},args=[Src]}) -> - infer_type_test_bif({integer,{}}, Src); -infer_types_1(#value{op={bif,is_list},args=[Src]}) -> - infer_type_test_bif(list, Src); -infer_types_1(#value{op={bif,is_map},args=[Src]}) -> - infer_type_test_bif(map, Src); -infer_types_1(#value{op={bif,is_number},args=[Src]}) -> - infer_type_test_bif(number, Src); -infer_types_1(#value{op={bif,is_tuple},args=[Src]}) -> - infer_type_test_bif({tuple,[0],#{}}, Src); -infer_types_1(#value{op={bif,tuple_size}, args=[Tuple]}) -> - fun({integer,Arity}, S) -> - update_type(fun meet/2, {tuple,Arity,#{}}, Tuple, S); - (_, S) -> S +infer_types_1(#value{op={bif,is_atom},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_atom{}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_boolean},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(beam_types:make_boolean(), Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_binary},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_bitstring{size_unit=8}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_bitstring},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_bitstring{}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_float},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_float{}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_integer},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_integer{}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_list},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_list{}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_map},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_map{}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_number},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(number, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_tuple},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_tuple{}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,tuple_size}, args=[Tuple]}, + {integer,Arity}, Op, Vst) -> + Type = #t_tuple{exact=true,size=Arity}, + case Op of + eq_exact -> update_type(fun meet/2, Type, Tuple, Vst); + ne_exact -> update_type(fun subtract/2, Type, Tuple, Vst) end; -infer_types_1(_) -> - fun(_, S) -> S end. - -infer_type_test_bif(Type, Src) -> - fun({atom,true}, S) -> - update_type(fun meet/2, Type, Src, S); - (_, S) -> - S +infer_types_1(_, _, _, Vst) -> + Vst. + +infer_type_test_bif(Type, Src, Val, Op, Vst) -> + case Val of + {atom, Bool} when Op =:= eq_exact, Bool; Op =:= ne_exact, not Bool -> + update_type(fun meet/2, Type, Src, Vst); + {atom, Bool} when Op =:= ne_exact, Bool; Op =:= eq_exact, not Bool -> + update_type(fun subtract/2, Type, Src, Vst); + _ -> + Vst end. %%% @@ -1822,43 +2029,58 @@ update_type(Merge, With, #value_ref{}=Ref, Vst) -> update_type(Merge, With, {Kind,_}=Reg, Vst) when Kind =:= x; Kind =:= y -> update_type(Merge, With, get_reg_vref(Reg, Vst), Vst); update_type(Merge, With, Literal, Vst) -> - assert_literal(Literal), %% Literals always retain their type, but we still need to bail on type %% conflicts. - case Merge(Literal, With) of - none -> throw({type_conflict, Literal, With}); + Type = get_literal_type(Literal), + case Merge(Type, With) of + none -> throw({type_conflict, Type, With}); _Type -> Vst end. -update_ne_types(LHS, RHS, Vst) -> +update_eq_types(LHS, RHS, Vst0) -> + LType = get_term_type(LHS, Vst0), + RType = get_term_type(RHS, Vst0), + + Vst1 = update_type(fun meet/2, RType, LHS, Vst0), + Vst = update_type(fun meet/2, LType, RHS, Vst1), + + infer_types(eq_exact, LHS, RHS, Vst). + +update_ne_types(LHS, RHS, Vst0) -> + Vst1 = update_ne_types_1(LHS, RHS, Vst0), + Vst = update_ne_types_1(RHS, LHS, Vst1), + + infer_types(ne_exact, LHS, RHS, Vst). + +update_ne_types_1(LHS, RHS, Vst0) -> %% While updating types on equality is fairly straightforward, inequality %% is a bit trickier since all we know is that the *value* of LHS differs %% from RHS, so we can't blindly subtract their types. %% - %% Consider `number =/= {integer,[]}`; all we know is that LHS isn't equal + %% Consider `number =/= #t_integer{}`; all we know is that LHS isn't equal %% to some *specific integer* of unknown value, and if we were to subtract - %% {integer,[]} we would erroneously infer that the new type is {float,[]}. + %% #t_integer{} we would erroneously infer that the new type is float. %% %% Therefore, we only subtract when we know that RHS has a specific value. - RType = get_term_type(RHS, Vst), - case is_literal(RType) of - true -> update_type(fun subtract/2, RType, LHS, Vst); - false -> Vst + RType = get_term_type(RHS, Vst0), + case beam_types:is_singleton_type(RType) of + true -> + Vst = update_type(fun subtract/2, RType, LHS, Vst0), + + %% If LHS has a specific value after subtraction we can infer types + %% as if we've made an exact match, which is much stronger than + %% ne_exact. + LType = get_term_type(LHS, Vst), + case beam_types:get_singleton_value(LType) of + {ok, Value} -> + infer_types(eq_exact, LHS, value_to_literal(Value), Vst); + error -> + Vst + end; + false -> + Vst0 end. -update_eq_types(LHS, RHS, Vst0) -> - %% Either side might contain something worth inferring, so we need - %% to check them both. - Infer_L = infer_types(RHS, Vst0), - Infer_R = infer_types(LHS, Vst0), - Vst1 = Infer_R(RHS, Infer_L(LHS, Vst0)), - - T1 = get_term_type(LHS, Vst1), - T2 = get_term_type(RHS, Vst1), - - Vst = update_type(fun meet/2, T2, LHS, Vst1), - update_type(fun meet/2, T1, RHS, Vst). - %% Helper functions for the above. assign_1(Src, Dst, Vst0) -> @@ -1909,16 +2131,9 @@ get_reg_vref({y,_}=Src, #vst{current=#st{ys=Ys}}) -> end. set_type(Type, #value_ref{}=Ref, #vst{current=#st{vs=Vs0}=St}=Vst) -> - case Vs0 of - #{ Ref := #value{}=Entry } -> - Vs = Vs0#{ Ref => Entry#value{type=Type} }, - Vst#vst{current=St#st{vs=Vs}}; - #{} -> - %% Dead references may happen during type inference and are not an - %% error in and of themselves. If a problem were to arise from this - %% it'll explode elsewhere. - Vst - end. + #{ Ref := #value{}=Entry } = Vs0, + Vs = Vs0#{ Ref => Entry#value{type=Type} }, + Vst#vst{current=St#st{vs=Vs}}. new_value(Type, Op, Ss, #vst{current=#st{vs=Vs0}=St,ref_ctr=Counter}=Vst) -> Ref = #value_ref{id=Counter}, @@ -1926,9 +2141,9 @@ new_value(Type, Op, Ss, #vst{current=#st{vs=Vs0}=St,ref_ctr=Counter}=Vst) -> {Ref, Vst#vst{current=St#st{vs=Vs},ref_ctr=Counter+1}}. -kill_catch_tag(Reg, #vst{current=#st{ct=[Fail|Fails]}=St}=Vst0) -> - Vst = Vst0#vst{current=St#st{ct=Fails,fls=undefined}}, - {_, Fail} = get_tag_type(Reg, Vst), %Assertion. +kill_catch_tag(Reg, #vst{current=#st{ct=[Tag|Tags]}=St}=Vst0) -> + Vst = Vst0#vst{current=St#st{ct=Tags,fls=undefined}}, + Tag = get_tag_type(Reg, Vst), %Assertion. kill_tag(Reg, Vst). check_try_catch_tags(Type, {y,N}=Reg, Vst) -> @@ -1973,308 +2188,44 @@ is_literal({integer,I}) when is_integer(I) -> true; is_literal({literal,_L}) -> true; is_literal(_) -> false. -%% The possible types. -%% -%% First non-term types: -%% -%% initialized Only for Y registers. Means that the Y register -%% has been initialized with some valid term so that -%% it is safe to pass to the garbage collector. -%% NOT safe to use in any other way (will not crash the -%% emulator, but clearly points to a bug in the compiler). -%% -%% {catchtag,[Lbl]} A special term used within a catch. Must only be used -%% by the catch instructions; NOT safe to use in other -%% instructions. -%% -%% {trytag,[Lbl]} A special term used within a try block. Must only be -%% used by the catch instructions; NOT safe to use in other -%% instructions. -%% -%% exception Can only be used as a type returned by -%% call_return_type/2 (which gives the type of the value -%% returned by a call). Thus 'exception' is never stored -%% as type descriptor for a register. -%% -%% #ms{} A match context for bit syntax matching. We do allow -%% it to moved/to from stack, but otherwise it must only -%% be accessed by bit syntax matching instructions. -%% -%% -%% Normal terms: -%% -%% term Any valid Erlang (but not of the special types above). -%% -%% binary Binary or bitstring. -%% -%% bool The atom 'true' or the atom 'false'. -%% -%% cons Cons cell: [_|_] -%% -%% nil Empty list: [] -%% -%% list List: [] or [_|_] -%% -%% {tuple,[Sz],Es} Tuple. An element has been accessed using -%% element/2 or setelement/3 so that it is known that -%% the type is a tuple of size at least Sz. Es is a map -%% containing known types by tuple index. -%% -%% {tuple,Sz,Es} Tuple. A test_arity instruction has been seen -%% so that it is known that the size is exactly Sz. -%% -%% {atom,[]} Atom. -%% {atom,Atom} -%% -%% {integer,[]} Integer. -%% {integer,Integer} -%% -%% {float,[]} Float. -%% {float,Float} -%% -%% number Integer or Float of unknown value -%% -%% map Map. -%% -%% none A conflict in types. There will be an exception at runtime. -%% - -%% join(Type1, Type2) -> Type -%% Return the most specific type possible. -join(Same, Same) -> - Same; -join(none, Other) -> - Other; -join(Other, none) -> - Other; -join({literal,_}=T1, T2) -> - join_literal(T1, T2); -join(T1, {literal,_}=T2) -> - join_literal(T2, T1); -join({tuple,Size,EsA}, {tuple,Size,EsB}) -> - Es = join_tuple_elements(tuple_sz(Size), EsA, EsB), - {tuple, Size, Es}; -join({tuple,A,EsA}, {tuple,B,EsB}) -> - Size = min(tuple_sz(A), tuple_sz(B)), - Es = join_tuple_elements(Size, EsA, EsB), - {tuple, [Size], Es}; -join({Type,A}, {Type,B}) - when Type =:= atom; Type =:= integer; Type =:= float -> - if A =:= B -> {Type,A}; - true -> {Type,[]} - end; -join({Type,_}, number) - when Type =:= integer; Type =:= float -> - number; -join(number, {Type,_}) - when Type =:= integer; Type =:= float -> - number; -join({integer,_}, {float,_}) -> - number; -join({float,_}, {integer,_}) -> - number; -join(bool, {atom,A}) -> - join_bool(A); -join({atom,A}, bool) -> - join_bool(A); -join({atom,A}, {atom,B}) when is_boolean(A), is_boolean(B) -> - bool; -join({atom,_}, {atom,_}) -> - {atom,[]}; -join(#ms{id=Id1,valid=B1,slots=Slots1}, - #ms{id=Id2,valid=B2,slots=Slots2}) -> - Id = if - Id1 =:= Id2 -> Id1; - true -> make_ref() - end, - #ms{id=Id,valid=B1 band B2,slots=min(Slots1, Slots2)}; -join(T1, T2) when T1 =/= T2 -> - %% We've exhaused all other options, so the type must either be a list or - %% a 'term'. - join_list(T1, T2). +value_to_literal([]) -> nil; +value_to_literal(A) when is_atom(A) -> {atom,A}; +value_to_literal(F) when is_float(F) -> {float,F}; +value_to_literal(I) when is_integer(I) -> {integer,I}; +value_to_literal(Other) -> {literal,Other}. -join_tuple_elements(Limit, EsA, EsB) -> - Es0 = join_elements(EsA, EsB), - maps:filter(fun({integer,Index}, _Type) -> Index =< Limit end, Es0). - -join_elements(Es1, Es2) -> - Keys = if - map_size(Es1) =< map_size(Es2) -> maps:keys(Es1); - map_size(Es1) > map_size(Es2) -> maps:keys(Es2) - end, - join_elements_1(Keys, Es1, Es2, #{}). - -join_elements_1([Key | Keys], Es1, Es2, Acc0) -> - Type = case {Es1, Es2} of - {#{ Key := Same }, #{ Key := Same }} -> Same; - {#{ Key := Type1 }, #{ Key := Type2 }} -> join(Type1, Type2); - {#{}, #{}} -> term - end, - Acc = set_element_type(Key, Type, Acc0), - join_elements_1(Keys, Es1, Es2, Acc); -join_elements_1([], _Es1, _Es2, Acc) -> - Acc. - -%% Joins types of literals; note that the left argument must either be a -%% literal or exactly equal to the second argument. -join_literal(Same, Same) -> - Same; -join_literal({literal,_}=Lit, T) -> - join_literal(T, get_literal_type(Lit)); -join_literal(T1, T2) -> - %% We're done extracting the types, try merging them again. - join(T1, T2). - -join_list(nil, cons) -> list; -join_list(nil, list) -> list; -join_list(cons, list) -> list; -join_list(T, nil) -> join_list(nil, T); -join_list(T, cons) -> join_list(cons, T); -join_list(_, _) -> - %% Not a list, so it must be a term. - term. - -join_bool([]) -> {atom,[]}; -join_bool(true) -> bool; -join_bool(false) -> bool; -join_bool(_) -> {atom,[]}. - -%% meet(Type1, Type2) -> Type -%% Return the meet of two types. The meet is a more specific type. -%% It will be 'none' if the types are in conflict. - -meet(Same, Same) -> - Same; -meet(term, Other) -> - Other; -meet(Other, term) -> - Other; -meet(#ms{}, binary) -> - #ms{}; -meet(binary, #ms{}) -> - #ms{}; -meet({literal,_}, {literal,_}) -> - none; -meet(T1, {literal,_}=T2) -> - meet(T2, T1); -meet({literal,_}=T1, T2) -> - case meet(get_literal_type(T1), T2) of - none -> none; - _ -> T1 - end; -meet(T1, T2) -> - case {erlang:min(T1, T2),erlang:max(T1, T2)} of - {{atom,_}=A,{atom,[]}} -> A; - {bool,{atom,B}=Atom} when is_boolean(B) -> Atom; - {bool,{atom,[]}} -> bool; - {cons,list} -> cons; - {{float,_}=T,{float,[]}} -> T; - {{integer,_}=T,{integer,[]}} -> T; - {list,nil} -> nil; - {number,{integer,_}=T} -> T; - {number,{float,_}=T} -> T; - {{tuple,Size1,Es1},{tuple,Size2,Es2}} -> - Es = meet_elements(Es1, Es2), - case {Size1,Size2,Es} of - {_, _, none} -> - none; - {[Sz1],[Sz2],_} -> - Sz = erlang:max(Sz1, Sz2), - assert_tuple_elements(Sz, Es), - {tuple,[Sz],Es}; - {Sz1,[Sz2],_} when Sz2 =< Sz1 -> - assert_tuple_elements(Sz1, Es), - {tuple,Sz1,Es}; - {Sz,Sz,_} -> - assert_tuple_elements(Sz, Es), - {tuple,Sz,Es}; - {_,_,_} -> - none - end; - {_,_} -> none +%% These are just wrappers around their equivalents in beam_types, which +%% handle the validator-specific #t_abstract{} type. +%% +%% The funny-looking abstract types produced here are intended to provoke +%% errors on actual use; they do no harm just lying around. + +normalize(#t_abstract{}=A) -> error({abstract_type, A}); +normalize(T) -> beam_types:normalize(T). + +join(Same, Same) -> Same; +join(#t_abstract{}=A, B) -> #t_abstract{kind={join, A, B}}; +join(A, #t_abstract{}=B) -> #t_abstract{kind={join, A, B}}; +join(A, B) -> beam_types:join(A, B). + +meet(Same, Same) -> Same; +meet(#t_abstract{}=A, B) -> #t_abstract{kind={meet, A, B}}; +meet(A, #t_abstract{}=B) -> #t_abstract{kind={meet, A, B}}; +meet(A, B) -> beam_types:meet(A, B). + +subtract(#t_abstract{}=A, B) -> #t_abstract{kind={subtract, A, B}}; +subtract(A, #t_abstract{}=B) -> #t_abstract{kind={subtract, A, B}}; +subtract(A, B) -> beam_types:subtract(A, B). + +assert_type(RequiredType, Term, Vst) -> + GivenType = get_movable_term_type(Term, Vst), + case meet(RequiredType, GivenType) of + GivenType -> + ok; + _RequiredType -> + error({bad_type,{needed,RequiredType},{actual,GivenType}}) end. -meet_elements(Es1, Es2) -> - Keys = maps:keys(Es1) ++ maps:keys(Es2), - meet_elements_1(Keys, Es1, Es2, #{}). - -meet_elements_1([Key | Keys], Es1, Es2, Acc) -> - case {Es1, Es2} of - {#{ Key := Type1 }, #{ Key := Type2 }} -> - case meet(Type1, Type2) of - none -> none; - Type -> meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type }) - end; - {#{ Key := Type1 }, _} -> - meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type1 }); - {_, #{ Key := Type2 }} -> - meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type2 }) - end; -meet_elements_1([], _Es1, _Es2, Acc) -> - Acc. - -%% No tuple elements may have an index above the known size. -assert_tuple_elements(Limit, Es) -> - true = maps:fold(fun({integer,Index}, _T, true) -> - Index =< Limit - end, true, Es). %Assertion. - -%% subtract(Type1, Type2) -> Type -%% Subtract Type2 from Type2. Example: -%% subtract(list, nil) -> cons - -subtract(Same, Same) -> none; -subtract(list, nil) -> cons; -subtract(list, cons) -> nil; -subtract(number, {integer,[]}) -> {float,[]}; -subtract(number, {float,[]}) -> {integer,[]}; -subtract(bool, {atom,false}) -> {atom, true}; -subtract(bool, {atom,true}) -> {atom, false}; -subtract(Type, _) -> Type. - -assert_type(WantedType, Term, Vst) -> - Type = get_term_type(Term, Vst), - assert_type(WantedType, Type). - -assert_type(Correct, Correct) -> ok; -assert_type(float, {float,_}) -> ok; -assert_type(tuple, {tuple,_,_}) -> ok; -assert_type(tuple, {literal,Tuple}) when is_tuple(Tuple) -> ok; -assert_type({tuple_element,I}, {tuple,[Sz],_}) - when 1 =< I, I =< Sz -> - ok; -assert_type({tuple_element,I}, {tuple,Sz,_}) - when is_integer(Sz), 1 =< I, I =< Sz -> - ok; -assert_type({tuple_element,I}, {literal,Lit}) when I =< tuple_size(Lit) -> - ok; -assert_type(cons, {literal,[_|_]}) -> - ok; -assert_type(Needed, Actual) -> - error({bad_type,{needed,Needed},{actual,Actual}}). - -get_element_type(Key, Src, Vst) -> - get_element_type_1(Key, get_term_type(Src, Vst)). - -get_element_type_1({integer,_}=Key, {tuple,_Sz,Es}) -> - case Es of - #{ Key := Type } -> Type; - #{} -> term - end; -get_element_type_1(_Index, _Type) -> - term. - -set_element_type(_Key, none, Es) -> - Es; -set_element_type(Key, term, Es) -> - maps:remove(Key, Es); -set_element_type(Key, Type, Es) -> - Es#{ Key => Type }. - -get_tuple_size({integer,[]}) -> 0; -get_tuple_size({integer,Sz}) -> Sz; -get_tuple_size(_) -> 0. - validate_src(Ss, Vst) when is_list(Ss) -> _ = [assert_term(S, Vst) || S <- Ss], ok. @@ -2285,7 +2236,8 @@ validate_src(Ss, Vst) when is_list(Ss) -> get_term_type(Src, Vst) -> case get_movable_term_type(Src, Vst) of - #ms{} -> error({match_context,Src}); + #t_bs_context{} -> error({match_context,Src}); + #t_abstract{} -> error({abstract_term,Src}); Type -> Type end. @@ -2295,12 +2247,11 @@ get_term_type(Src, Vst) -> get_movable_term_type(Src, Vst) -> case get_raw_type(Src, Vst) of + #t_abstract{kind=unfinished_tuple=Kind} -> error({Kind,Src}); initialized -> error({unassigned,Src}); uninitialized -> error({uninitialized_reg,Src}); {catchtag,_} -> error({catchtag,Src}); {trytag,_} -> error({trytag,Src}); - tuple_in_progress -> error({tuple_in_progress,Src}); - {literal,_}=Lit -> get_literal_type(Lit); Type -> Type end. @@ -2339,33 +2290,21 @@ get_raw_type(#value_ref{}=Ref, #vst{current=#st{vs=Vs}}) -> #{ Ref := #value{type=Type} } -> Type; #{} -> none end; -get_raw_type(Src, #vst{}) -> +get_raw_type(Src, #vst{current=#st{}}) -> get_literal_type(Src). -get_literal_type(nil=T) -> T; -get_literal_type({atom,A}=T) when is_atom(A) -> T; -get_literal_type({float,F}=T) when is_float(F) -> T; -get_literal_type({integer,I}=T) when is_integer(I) -> T; -get_literal_type({literal,[_|_]}) -> cons; -get_literal_type({literal,Bitstring}) when is_bitstring(Bitstring) -> binary; -get_literal_type({literal,Map}) when is_map(Map) -> map; -get_literal_type({literal,Tuple}) when is_tuple(Tuple) -> glt_1(Tuple); -get_literal_type({literal,_}) -> term; -get_literal_type(T) -> error({not_literal,T}). - -glt_1([]) -> nil; -glt_1(A) when is_atom(A) -> {atom, A}; -glt_1(F) when is_float(F) -> {float, F}; -glt_1(I) when is_integer(I) -> {integer, I}; -glt_1(T) when is_tuple(T) -> - {Es,_} = foldl(fun(Val, {Es0, Index}) -> - Type = glt_1(Val), - Es = set_element_type({integer,Index}, Type, Es0), - {Es, Index + 1} - end, {#{}, 1}, tuple_to_list(T)), - {tuple, tuple_size(T), Es}; -glt_1(L) -> - {literal, L}. +get_literal_type(nil) -> + beam_types:make_type_from_value([]); +get_literal_type({atom,A}) when is_atom(A) -> + beam_types:make_type_from_value(A); +get_literal_type({float,F}) when is_float(F) -> + beam_types:make_type_from_value(F); +get_literal_type({integer,I}) when is_integer(I) -> + beam_types:make_type_from_value(I); +get_literal_type({literal,L}) -> + beam_types:make_type_from_value(L); +get_literal_type(T) -> + error({not_literal,T}). %%% %%% Branch tracking @@ -2383,10 +2322,12 @@ glt_1(L) -> SuccFun :: BranchFun) -> #vst{} when BranchFun :: fun((#vst{}) -> #vst{}). branch(Lbl, Vst0, FailFun, SuccFun) -> + validate_branch(Lbl, Vst0), #vst{current=St0} = Vst0, + try FailFun(Vst0) of Vst1 -> - Vst2 = branch_state(Lbl, Vst1), + Vst2 = fork_state(Lbl, Vst1), Vst = Vst2#vst{current=St0}, try SuccFun(Vst) of V -> V @@ -2404,6 +2345,24 @@ branch(Lbl, Vst0, FailFun, SuccFun) -> SuccFun(Vst0) end. +validate_branch(Lbl, #vst{current=#st{ct=Tags}}) -> + validate_branch_1(Lbl, Tags). + +validate_branch_1(Lbl, [{trytag, FailLbls} | Tags]) -> + %% 'try_case' assumes that an exception has been thrown, so a direct branch + %% will crash the emulator. + %% + %% (Jumping to a 'catch_end' is fine however as it will simply nop in the + %% absence of an exception.) + case ordsets:is_element(Lbl, FailLbls) of + true -> error({illegal_branch, try_handler, Lbl}); + false -> validate_branch_1(Lbl, Tags) + end; +validate_branch_1(Lbl, [_ | Tags]) -> + validate_branch_1(Lbl, Tags); +validate_branch_1(_Lbl, []) -> + ok. + %% A shorthand version of branch/4 for when the state is only altered on %% success. branch(Fail, Vst, SuccFun) -> @@ -2411,12 +2370,12 @@ branch(Fail, Vst, SuccFun) -> %% Directly branches off the state. This is an "internal" operation that should %% be used sparingly. -branch_state(0, #vst{}=Vst) -> +fork_state(0, #vst{}=Vst) -> %% If the instruction fails, the stack may be scanned looking for a catch %% tag. Therefore the Y registers must be initialized at this point. verify_y_init(Vst), Vst; -branch_state(L, #vst{current=St,branched=B,ref_ctr=Counter0}=Vst) -> +fork_state(L, #vst{current=St,branched=B,ref_ctr=Counter0}=Vst) -> case gb_trees:is_defined(L, B) of true -> {MergedSt, Counter} = merge_states(L, St, B, Counter0), @@ -2432,14 +2391,14 @@ branch_state(L, #vst{current=St,branched=B,ref_ctr=Counter0}=Vst) -> merge_states(L, St, Branched, Counter) when L =/= 0 -> case gb_trees:lookup(L, Branched) of - none -> - {St, Counter}; - {value,OtherSt} when St =:= none -> - {OtherSt, Counter}; - {value,OtherSt} -> - merge_states_1(St, OtherSt, Counter) + {value, OtherSt} -> merge_states_1(St, OtherSt, Counter); + none -> {St, Counter} end. +merge_states_1(St, none, Counter) -> + {St, Counter}; +merge_states_1(none, St, Counter) -> + {St, Counter}; merge_states_1(StA, StB, Counter0) -> #st{xs=XsA,ys=YsA,vs=VsA,fragile=FragA,numy=NumYA, h=HA,ct=CtA,recv_marker=MarkerA} = StA, @@ -2501,10 +2460,10 @@ merge_tags(uninitialized, _) -> uninitialized; merge_tags(_, uninitialized) -> uninitialized; -merge_tags({catchtag,T0}, {catchtag,T1}) -> - {catchtag, ordsets:from_list(T0 ++ T1)}; -merge_tags({trytag,T0}, {trytag,T1}) -> - {trytag, ordsets:from_list(T0 ++ T1)}; +merge_tags({trytag, LblsA}, {trytag, LblsB}) -> + {trytag, ordsets:union(LblsA, LblsB)}; +merge_tags({catchtag, LblsA}, {catchtag, LblsB}) -> + {catchtag, ordsets:union(LblsA, LblsB)}; merge_tags(_A, _B) -> %% All other combinations leave the register initialized. Errors arising %% from this will be caught later on. @@ -2587,13 +2546,14 @@ merge_stk(_, _) -> undecided. merge_ct(S, S) -> S; merge_ct(Ct0, Ct1) -> merge_ct_1(Ct0, Ct1). -merge_ct_1([C0|Ct0], [C1|Ct1]) -> - [ordsets:from_list(C0++C1)|merge_ct_1(Ct0, Ct1)]; -merge_ct_1([], []) -> []; -merge_ct_1(_, _) -> undecided. - -tuple_sz([Sz]) -> Sz; -tuple_sz(Sz) -> Sz. +merge_ct_1([], []) -> + []; +merge_ct_1([{trytag, LblsA} | CtA], [{trytag, LblsB} | CtB]) -> + [{trytag, ordsets:union(LblsA, LblsB)} | merge_ct_1(CtA, CtB)]; +merge_ct_1([{catchtag, LblsA} | CtA], [{catchtag, LblsB} | CtB]) -> + [{catchtag, ordsets:union(LblsA, LblsB)} | merge_ct_1(CtA, CtB)]; +merge_ct_1(_, _) -> + undecided. verify_y_init(#vst{current=#st{numy=NumY,ys=Ys}}=Vst) when is_integer(NumY) -> HighestY = maps:fold(fun({y,Y}, _, Acc) -> max(Y, Acc) end, -1, Ys), @@ -2770,320 +2730,46 @@ assert_not_fragile(Lit, #vst{}) -> ok. %%% -%%% Return/argument types of BIFs -%%% - -bif_return_type('-', Src, Vst) -> - arith_return_type(Src, Vst); -bif_return_type('+', Src, Vst) -> - arith_return_type(Src, Vst); -bif_return_type('*', Src, Vst) -> - arith_return_type(Src, Vst); -bif_return_type(abs, [Num], Vst) -> - case get_term_type(Num, Vst) of - {float,_}=T -> T; - {integer,_}=T -> T; - _ -> number - end; -bif_return_type(float, _, _) -> {float,[]}; -bif_return_type('/', _, _) -> {float,[]}; -%% Binary operations -bif_return_type('binary_part', [_,_], _) -> binary; -bif_return_type('binary_part', [_,_,_], _) -> binary; -bif_return_type('bit_size', [_], _) -> {integer,[]}; -bif_return_type('byte_size', [_], _) -> {integer,[]}; -%% Integer operations. -bif_return_type(ceil, [_], _) -> {integer,[]}; -bif_return_type('div', [_,_], _) -> {integer,[]}; -bif_return_type(floor, [_], _) -> {integer,[]}; -bif_return_type('rem', [_,_], _) -> {integer,[]}; -bif_return_type(length, [_], _) -> {integer,[]}; -bif_return_type(size, [_], _) -> {integer,[]}; -bif_return_type(trunc, [_], _) -> {integer,[]}; -bif_return_type(round, [_], _) -> {integer,[]}; -bif_return_type('band', [_,_], _) -> {integer,[]}; -bif_return_type('bor', [_,_], _) -> {integer,[]}; -bif_return_type('bxor', [_,_], _) -> {integer,[]}; -bif_return_type('bnot', [_], _) -> {integer,[]}; -bif_return_type('bsl', [_,_], _) -> {integer,[]}; -bif_return_type('bsr', [_,_], _) -> {integer,[]}; -%% Booleans. -bif_return_type('==', [_,_], _) -> bool; -bif_return_type('/=', [_,_], _) -> bool; -bif_return_type('=<', [_,_], _) -> bool; -bif_return_type('<', [_,_], _) -> bool; -bif_return_type('>=', [_,_], _) -> bool; -bif_return_type('>', [_,_], _) -> bool; -bif_return_type('=:=', [_,_], _) -> bool; -bif_return_type('=/=', [_,_], _) -> bool; -bif_return_type('not', [_], _) -> bool; -bif_return_type('and', [_,_], _) -> bool; -bif_return_type('or', [_,_], _) -> bool; -bif_return_type('xor', [_,_], _) -> bool; -bif_return_type(is_atom, [_], _) -> bool; -bif_return_type(is_boolean, [_], _) -> bool; -bif_return_type(is_binary, [_], _) -> bool; -bif_return_type(is_float, [_], _) -> bool; -bif_return_type(is_function, [_], _) -> bool; -bif_return_type(is_function, [_,_], _) -> bool; -bif_return_type(is_integer, [_], _) -> bool; -bif_return_type(is_list, [_], _) -> bool; -bif_return_type(is_map, [_], _) -> bool; -bif_return_type(is_map_key, [_, _], _) -> bool; -bif_return_type(is_number, [_], _) -> bool; -bif_return_type(is_pid, [_], _) -> bool; -bif_return_type(is_port, [_], _) -> bool; -bif_return_type(is_reference, [_], _) -> bool; -bif_return_type(is_tuple, [_], _) -> bool; -%% Misc. -bif_return_type(tuple_size, [_], _) -> {integer,[]}; -bif_return_type(map_size, [_], _) -> {integer,[]}; -bif_return_type(node, [], _) -> {atom,[]}; -bif_return_type(node, [_], _) -> {atom,[]}; -bif_return_type(hd, [_], _) -> term; -bif_return_type(tl, [_], _) -> term; -bif_return_type(get, [_], _) -> term; -bif_return_type(Bif, _, _) when is_atom(Bif) -> term. - -%% Generic -bif_arg_types(tuple_size, [_]) -> [{tuple,[0],#{}}]; -bif_arg_types(map_size, [_]) -> [map]; -bif_arg_types(is_map_key, [_,_]) -> [term, map]; -bif_arg_types(map_get, [_,_]) -> [term, map]; -bif_arg_types(length, [_]) -> [list]; -bif_arg_types(hd, [_]) -> [cons]; -bif_arg_types(tl, [_]) -> [cons]; -%% Boolean -bif_arg_types('not', [_]) -> [bool]; -bif_arg_types('and', [_,_]) -> [bool, bool]; -bif_arg_types('or', [_,_]) -> [bool, bool]; -bif_arg_types('xor', [_,_]) -> [bool, bool]; -%% Binary -bif_arg_types('binary_part', [_,_]) -> - PosLen = {tuple, 2, #{ {integer,1} => {integer,[]}, - {integer,2} => {integer,[]} }}, - [binary, PosLen]; -bif_arg_types('binary_part', [_,_,_]) -> - [binary, {integer,[]}, {integer,[]}]; -bif_arg_types('bit_size', [_]) -> [binary]; -bif_arg_types('byte_size', [_]) -> [binary]; -%% Numerical -bif_arg_types('-', [_]) -> [number]; -bif_arg_types('-', [_,_]) -> [number,number]; -bif_arg_types('+', [_]) -> [number]; -bif_arg_types('+', [_,_]) -> [number,number]; -bif_arg_types('*', [_,_]) -> [number, number]; -bif_arg_types('/', [_,_]) -> [number, number]; -bif_arg_types(abs, [_]) -> [number]; -bif_arg_types(ceil, [_]) -> [number]; -bif_arg_types(float, [_]) -> [number]; -bif_arg_types(floor, [_]) -> [number]; -bif_arg_types(trunc, [_]) -> [number]; -bif_arg_types(round, [_]) -> [number]; -%% Integer-specific -bif_arg_types('div', [_,_]) -> [{integer,[]}, {integer,[]}]; -bif_arg_types('rem', [_,_]) -> [{integer,[]}, {integer,[]}]; -bif_arg_types('band', [_,_]) -> [{integer,[]}, {integer,[]}]; -bif_arg_types('bor', [_,_]) -> [{integer,[]}, {integer,[]}]; -bif_arg_types('bxor', [_,_]) -> [{integer,[]}, {integer,[]}]; -bif_arg_types('bnot', [_]) -> [{integer,[]}]; -bif_arg_types('bsl', [_,_]) -> [{integer,[]}, {integer,[]}]; -bif_arg_types('bsr', [_,_]) -> [{integer,[]}, {integer,[]}]; -%% Unsafe type tests that may fail if an argument doesn't have the right type. -bif_arg_types(is_function, [_,_]) -> [term, {integer,[]}]; -bif_arg_types(_, Args) -> [term || _Arg <- Args]. - -is_bif_safe('/=', 2) -> true; -is_bif_safe('<', 2) -> true; -is_bif_safe('=/=', 2) -> true; -is_bif_safe('=:=', 2) -> true; -is_bif_safe('=<', 2) -> true; -is_bif_safe('==', 2) -> true; -is_bif_safe('>', 2) -> true; -is_bif_safe('>=', 2) -> true; -is_bif_safe(is_atom, 1) -> true; -is_bif_safe(is_boolean, 1) -> true; -is_bif_safe(is_binary, 1) -> true; -is_bif_safe(is_bitstring, 1) -> true; -is_bif_safe(is_float, 1) -> true; -is_bif_safe(is_function, 1) -> true; -is_bif_safe(is_integer, 1) -> true; -is_bif_safe(is_list, 1) -> true; -is_bif_safe(is_map, 1) -> true; -is_bif_safe(is_number, 1) -> true; -is_bif_safe(is_pid, 1) -> true; -is_bif_safe(is_port, 1) -> true; -is_bif_safe(is_reference, 1) -> true; -is_bif_safe(is_tuple, 1) -> true; -is_bif_safe(get, 1) -> true; -is_bif_safe(self, 0) -> true; -is_bif_safe(node, 0) -> true; -is_bif_safe(_, _) -> false. - -arith_return_type([A], Vst) -> - %% Unary '+' or '-'. - case get_term_type(A, Vst) of - {integer,_} -> {integer,[]}; - {float,_} -> {float,[]}; - _ -> number - end; -arith_return_type([A,B], Vst) -> - TypeA = get_term_type(A, Vst), - TypeB = get_term_type(B, Vst), - case {TypeA, TypeB} of - {{integer,_},{integer,_}} -> {integer,[]}; - {{float,_},_} -> {float,[]}; - {_,{float,_}} -> {float,[]}; - {_,_} -> number - end; -arith_return_type(_, _) -> number. - -%%% -%%% Return/argument types of calls +%%% Return/argument types of calls and BIFs %%% -call_return_type({extfunc,M,F,A}, Vst) -> call_return_type_1(M, F, A, Vst); -call_return_type(_, _) -> term. - -call_return_type_1(erlang, setelement, 3, Vst) -> - IndexType = get_term_type({x,0}, Vst), - TupleType = - case get_term_type({x,1}, Vst) of - {literal,Tuple}=Lit when is_tuple(Tuple) -> get_literal_type(Lit); - {tuple,_,_}=TT -> TT; - _ -> {tuple,[0],#{}} - end, - case IndexType of - {integer,I} when is_integer(I) -> - case meet({tuple,[I],#{}}, TupleType) of - {tuple, Sz, Es0} -> - ValueType = get_term_type({x,2}, Vst), - Es = set_element_type({integer,I}, ValueType, Es0), - {tuple, Sz, Es}; - none -> - TupleType - end; - _ -> - %% The index could point anywhere, so we must discard all element - %% information. - setelement(3, TupleType, #{}) - end; -call_return_type_1(erlang, '++', 2, Vst) -> - LType = get_term_type({x,0}, Vst), - RType = get_term_type({x,1}, Vst), - case LType =:= cons orelse RType =:= cons of - true -> - cons; - false -> - %% `[] ++ RHS` yields RHS, even if RHS is not a list - join(list, RType) - end; -call_return_type_1(erlang, '--', 2, _Vst) -> - list; -call_return_type_1(erlang, F, A, _) -> - erlang_mod_return_type(F, A); -call_return_type_1(lists, F, A, Vst) -> - lists_mod_return_type(F, A, Vst); -call_return_type_1(math, F, A, _) -> - math_mod_return_type(F, A); -call_return_type_1(M, F, A, _) when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> - term. - -erlang_mod_return_type(exit, 1) -> exception; -erlang_mod_return_type(throw, 1) -> exception; -erlang_mod_return_type(error, 1) -> exception; -erlang_mod_return_type(error, 2) -> exception; -erlang_mod_return_type(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. - -math_mod_return_type(cos, 1) -> {float,[]}; -math_mod_return_type(cosh, 1) -> {float,[]}; -math_mod_return_type(sin, 1) -> {float,[]}; -math_mod_return_type(sinh, 1) -> {float,[]}; -math_mod_return_type(tan, 1) -> {float,[]}; -math_mod_return_type(tanh, 1) -> {float,[]}; -math_mod_return_type(acos, 1) -> {float,[]}; -math_mod_return_type(acosh, 1) -> {float,[]}; -math_mod_return_type(asin, 1) -> {float,[]}; -math_mod_return_type(asinh, 1) -> {float,[]}; -math_mod_return_type(atan, 1) -> {float,[]}; -math_mod_return_type(atanh, 1) -> {float,[]}; -math_mod_return_type(erf, 1) -> {float,[]}; -math_mod_return_type(erfc, 1) -> {float,[]}; -math_mod_return_type(exp, 1) -> {float,[]}; -math_mod_return_type(log, 1) -> {float,[]}; -math_mod_return_type(log2, 1) -> {float,[]}; -math_mod_return_type(log10, 1) -> {float,[]}; -math_mod_return_type(sqrt, 1) -> {float,[]}; -math_mod_return_type(atan2, 2) -> {float,[]}; -math_mod_return_type(pow, 2) -> {float,[]}; -math_mod_return_type(ceil, 1) -> {float,[]}; -math_mod_return_type(floor, 1) -> {float,[]}; -math_mod_return_type(fmod, 2) -> {float,[]}; -math_mod_return_type(pi, 0) -> {float,[]}; -math_mod_return_type(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. - -lists_mod_return_type(all, 2, _Vst) -> - bool; -lists_mod_return_type(any, 2, _Vst) -> - bool; -lists_mod_return_type(keymember, 3, _Vst) -> - bool; -lists_mod_return_type(member, 2, _Vst) -> - bool; -lists_mod_return_type(prefix, 2, _Vst) -> - bool; -lists_mod_return_type(suffix, 2, _Vst) -> - bool; -lists_mod_return_type(dropwhile, 2, _Vst) -> - list; -lists_mod_return_type(duplicate, 2, _Vst) -> - list; -lists_mod_return_type(filter, 2, _Vst) -> - list; -lists_mod_return_type(flatten, 1, _Vst) -> - list; -lists_mod_return_type(map, 2, Vst) -> - same_length_type({x,1}, Vst); -lists_mod_return_type(MF, 3, Vst) when MF =:= mapfoldl; MF =:= mapfoldr -> - ListType = same_length_type({x,2}, Vst), - {tuple,2,#{ {integer,1} => ListType} }; -lists_mod_return_type(partition, 2, _Vst) -> - two_tuple(list, list); -lists_mod_return_type(reverse, 1, Vst) -> - same_length_type({x,0}, Vst); -lists_mod_return_type(seq, 2, _Vst) -> - list; -lists_mod_return_type(sort, 1, Vst) -> - same_length_type({x,0}, Vst); -lists_mod_return_type(sort, 2, Vst) -> - same_length_type({x,1}, Vst); -lists_mod_return_type(splitwith, 2, _Vst) -> - two_tuple(list, list); -lists_mod_return_type(takewhile, 2, _Vst) -> - list; -lists_mod_return_type(unzip, 1, Vst) -> - ListType = same_length_type({x,0}, Vst), - two_tuple(ListType, ListType); -lists_mod_return_type(usort, 1, Vst) -> - same_length_type({x,0}, Vst); -lists_mod_return_type(zip, 2, _Vst) -> - list; -lists_mod_return_type(zipwith, 3, _Vst) -> - list; -lists_mod_return_type(_, _, _) -> - term. - -two_tuple(Type1, Type2) -> - {tuple,2,#{ {integer,1} => Type1, - {integer,2} => Type2 }}. - -same_length_type(Reg, Vst) -> - case get_term_type(Reg, Vst) of - {literal,[_|_]} -> cons; - cons -> cons; - nil -> nil; - _ -> list - end. +bif_types(Op, Ss, Vst) -> + Args = [normalize(get_term_type(Arg, Vst)) || Arg <- Ss], + beam_call_types:types(erlang, Op, Args). + +call_types({extfunc,M,F,A}, A, Vst) -> + Args = get_call_args(A, Vst), + beam_call_types:types(M, F, Args); +call_types(_, A, Vst) -> + {any, get_call_args(A, Vst), false}. + +will_bif_succeed(fadd, [_,_], _Vst) -> + maybe; +will_bif_succeed(fdiv, [_,_], _Vst) -> + maybe; +will_bif_succeed(fmul, [_,_], _Vst) -> + maybe; +will_bif_succeed(fnegate, [_], _Vst) -> + maybe; +will_bif_succeed(fsub, [_,_], _Vst) -> + maybe; +will_bif_succeed(Op, Ss, Vst) -> + Args = [normalize(get_term_type(Arg, Vst)) || Arg <- Ss], + beam_call_types:will_succeed(erlang, Op, Args). + +will_call_succeed({extfunc,M,F,A}, Vst) -> + beam_call_types:will_succeed(M, F, get_call_args(A, Vst)); +will_call_succeed(_Call, _Vst) -> + maybe. + +get_call_args(Arity, Vst) -> + get_call_args_1(0, Arity, Vst). + +get_call_args_1(Arity, Arity, _) -> + []; +get_call_args_1(N, Arity, Vst) when N < Arity -> + ArgType = normalize(get_movable_term_type({x,N}, Vst)), + [ArgType | get_call_args_1(N + 1, Arity, Vst)]. check_limit({x,X}=Src) when is_integer(X) -> if @@ -3108,6 +2794,12 @@ check_limit({fr,Fr}=Src) when is_integer(Fr) -> min(A, B) when is_integer(A), is_integer(B), A < B -> A; min(A, B) when is_integer(A), is_integer(B) -> B. +gcd(A, B) -> + case A rem B of + 0 -> B; + X -> gcd(B, X) + end. + gb_trees_from_list(L) -> gb_trees:from_orddict(sort(L)). error(Error) -> throw(Error). diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl index 415b579240..b5b2dde22c 100644 --- a/lib/compiler/src/beam_z.erl +++ b/lib/compiler/src/beam_z.erl @@ -47,16 +47,31 @@ function({function,Name,Arity,CLabel,Is0}, NoGetHdTl) -> undo_renames([{call_ext,2,send}|Is]) -> [send|undo_renames(Is)]; + undo_renames([{apply,A},{deallocate,N},return|Is]) -> [{apply_last,A,N}|undo_renames(Is)]; + +undo_renames([{call,A,F},{'%',{var_info,{x,0},_}},{deallocate,N},return|Is]) -> + %% We've removed a redundant move of a literal to {x,0}. + [{call_last,A,F,N} | undo_renames(Is)]; undo_renames([{call,A,F},{deallocate,N},return|Is]) -> - [{call_last,A,F,N}|undo_renames(Is)]; + [{call_last,A,F,N} | undo_renames(Is)]; + +undo_renames([{call_ext,A,F},{'%',{var_info,{x,0},_}},{deallocate,N},return|Is]) -> + [{call_ext_last,A,F,N} | undo_renames(Is)]; undo_renames([{call_ext,A,F},{deallocate,N},return|Is]) -> - [{call_ext_last,A,F,N}|undo_renames(Is)]; + [{call_ext_last,A,F,N} | undo_renames(Is)]; + +undo_renames([{call,A,F},{'%',{var_info,{x,0},_}},return|Is]) -> + [{call_only,A,F} | undo_renames(Is)]; undo_renames([{call,A,F},return|Is]) -> [{call_only,A,F}|undo_renames(Is)]; + +undo_renames([{call_ext,A,F},{'%',{var_info,{x,0},_}},return|Is]) -> + [{call_ext_only,A,F} | undo_renames(Is)]; undo_renames([{call_ext,A,F},return|Is]) -> [{call_ext_only,A,F}|undo_renames(Is)]; + undo_renames([{bif,raise,_,_,_}=I|Is0]) -> %% A minor optimization. Done here because: %% (1) beam_jump may move or share 'raise' instructions, and that diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl index caff47dbcb..8a2ea77b99 100644 --- a/lib/compiler/src/cerl_inline.erl +++ b/lib/compiler/src/cerl_inline.erl @@ -65,7 +65,7 @@ map_pair_op/1, map_pair_key/1, map_pair_val/1 ]). --import(lists, [foldl/3, foldr/3, mapfoldl/3, reverse/1]). +-import(lists, [foldl/3, foldr/3, member/2, mapfoldl/3, reverse/1]). %% %% Constants @@ -142,7 +142,7 @@ weight(module) -> 1. % Like a letrec with a constant body %% environment, the state location, and the effort counter at the call %% site (cf. `visit'). --record(opnd, {expr, ren, env, loc, effort}). +-record(opnd, {expr, ren, env, loc, effort, no_inline}). %% Since expressions are only visited in `effect' context when they are %% not bound to a referenced variable, only expressions visited in @@ -903,10 +903,14 @@ i_fun(E, Ctxt, Ren, Env, S) -> %% side of each definition. i_letrec(E, Ctxt, Ren, Env, S) -> + %% We must turn off inlining if this `letrec' is specially + %% implemented. + NoInline = member(letrec_goto, get_ann(E)), + %% Note that we pass an empty list for the auto-referenced %% (exported) functions here. {Es, B, _, S1} = i_letrec(letrec_defs(E), letrec_body(E), [], Ctxt, - Ren, Env, S), + Ren, Env, NoInline, S), %% If no bindings remain, only the body is returned. case Es of @@ -920,12 +924,13 @@ i_letrec(E, Ctxt, Ren, Env, S) -> %% The major part of this is shared by letrec-expressions and module %% definitions alike. -i_letrec(Es, B, Xs, Ctxt, Ren, Env, S) -> +i_letrec(Es, B, Xs, Ctxt, Ren, Env, NoInline, S) -> %% First, we create operands with dummy renamings and environments, %% and with fresh store locations for cached expressions and operand %% info. {Opnds, S1} = mapfoldl(fun ({_, E}, S) -> - make_opnd(E, undefined, undefined, S) + make_opnd(E, undefined, undefined, + NoInline, S) end, S, Es), @@ -1277,7 +1282,7 @@ i_module(E, Ctxt, Ren, Env, S) -> %% "body" parameter. Exps = i_module_exports(E), {Es, _, Xs1, S1} = i_letrec(module_defs(E), void(), - Exps, Ctxt, Ren, Env, S), + Exps, Ctxt, Ren, Env, false, S), %% Sanity check: case Es of [] -> @@ -1500,23 +1505,15 @@ inline(E, #app{opnds = Opnds, ctxt = Ctxt, loc = L}, Ren, Env, S) -> %% respective operand structures from the app-structure. {Rs, Ren1, Env1, S1} = bind_locals(Vs, Opnds, Ren, Env, S), - %% function_clause exceptions that have been inlined - %% into another function (or even into the same function) - %% will not work properly. The v3_kernel pass will - %% take care of it, but we will need to help it by - %% removing any function_name annotations on match_fail - %% primops that we inline. - E1 = kill_function_name_anns(fun_body(E)), - %% Visit the body in the context saved in the structure. - {E2, S2} = i(E1, Ctxt, Ren1, Env1, S1), + {E1, S2} = i(fun_body(E), Ctxt, Ren1, Env1, S1), %% Create necessary bindings and/or set flags. - {E3, S3} = make_let_bindings(Rs, E2, S2), + {E2, S3} = make_let_bindings(Rs, E1, S2), %% Lastly, flag the application as inlined, since the inlining %% attempt was not aborted before we reached this point. - {E3, st__set_app_inlined(L, S3)} + {E2, st__set_app_inlined(L, S3)} end. %% For the (possibly renamed) argument variables to an inlined call, @@ -1674,6 +1671,8 @@ copy_var(R, Ctxt, Env, S) -> end end. +copy_1(R, #opnd{no_inline = true}, _E, _Ctxt, _Env, S) -> + residualize_var(R, S); copy_1(R, Opnd, E, Ctxt, Env, S) -> case type(E) of 'fun' -> @@ -2075,9 +2074,13 @@ ref_to_var(#ref{name = Name}) -> %% passive, the operands will also be processed with a passive counter. make_opnd(E, Ren, Env, S) -> + make_opnd(E, Ren, Env, false, S). + +make_opnd(E, Ren, Env, NoInline, S) -> {L, S1} = st__new_opnd_loc(S), C = st__get_effort(S1), - Opnd = #opnd{expr = E, ren = Ren, env = Env, loc = L, effort = C}, + Opnd = #opnd{expr = E, ren = Ren, env = Env, loc = L, + effort = C, no_inline = NoInline}, {Opnd, S1}. keep_referenced(Rs, S) -> @@ -2469,19 +2472,6 @@ kill_id_anns([A | As]) -> kill_id_anns([]) -> []. -kill_function_name_anns(Body) -> - F = fun(P) -> - case type(P) of - primop -> - Ann = get_ann(P), - Ann1 = lists:keydelete(function_name, 1, Ann), - set_ann(P, Ann1); - _ -> - P - end - end, - cerl_trees:map(F, Body). - %% ===================================================================== %% General utilities @@ -2526,21 +2516,19 @@ set_clause_bodies([], _) -> %% Abstract datatype: renaming() ren__identity() -> - dict:new(). + #{}. ren__add(X, Y, Ren) -> - dict:store(X, Y, Ren). + Ren#{X=>Y}. ren__map(X, Ren) -> - case dict:find(X, Ren) of - {ok, Y} -> - Y; - error -> - X + case Ren of + #{X:=Y} -> Y; + #{} -> X end. ren__add_identity(X, Ren) -> - dict:erase(X, Ren). + maps:remove(X, Ren). %% ===================================================================== @@ -2633,7 +2621,7 @@ st__new(Effort, Size, Unroll) -> size = counter__new_passive(Size), effort = counter__new_passive(Effort), unroll = Unroll, - cache = dict:new(), + cache = maps:new(), var_flags = ets:new(var, EtsOpts), opnd_flags = ets:new(opnd, EtsOpts), app_flags = ets:new(app, EtsOpts)}. @@ -2664,12 +2652,12 @@ st__get_var_referenced(L, S) -> ets:lookup_element(S#state.var_flags, L, #var_flags.referenced). st__lookup_opnd_cache(L, S) -> - dict:find(L, S#state.cache). + maps:find(L, S#state.cache). %% Note that setting the cache should only be done once. st__set_opnd_cache(L, C, S) -> - S#state{cache = dict:store(L, C, S#state.cache)}. + S#state{cache = maps:put(L, C, S#state.cache)}. st__set_opnd_effect(L, S) -> T = S#state.opnd_flags, diff --git a/lib/compiler/src/cerl_sets.erl b/lib/compiler/src/cerl_sets.erl index f489baf238..0564779f39 100644 --- a/lib/compiler/src/cerl_sets.erl +++ b/lib/compiler/src/cerl_sets.erl @@ -130,8 +130,10 @@ union1(S1, []) -> S1. Set2 :: set(Element), Set3 :: set(Element). +intersection(S1, S2) when map_size(S1) >= map_size(S2) -> + filter(fun (E) -> is_element(E, S1) end, S2); intersection(S1, S2) -> - filter(fun (E) -> is_element(E, S1) end, S2). + intersection(S2, S1). %% intersection([Set]) -> Set. %% Return the intersection of the list of sets. @@ -153,14 +155,21 @@ intersection1(S1, []) -> S1. Set1 :: set(Element), Set2 :: set(Element). -is_disjoint(S1, S2) when map_size(S1) < map_size(S2) -> - fold(fun (_, false) -> false; - (E, true) -> not is_element(E, S2) - end, true, S1); +is_disjoint(S1, S2) when map_size(S1) > map_size(S2) -> + is_disjoint_1(S1, maps:iterator(S2)); is_disjoint(S1, S2) -> - fold(fun (_, false) -> false; - (E, true) -> not is_element(E, S1) - end, true, S2). + is_disjoint_1(S2, maps:iterator(S1)). + +is_disjoint_1(Set, Iter) -> + case maps:next(Iter) of + {K, _, NextIter} -> + case Set of + #{K := _} -> false; + #{} -> is_disjoint_1(Set, NextIter) + end; + none -> + true + end. %% subtract(Set1, Set2) -> Set. %% Return all and only the elements of Set1 which are not also in @@ -180,8 +189,21 @@ subtract(S1, S2) -> Set1 :: set(Element), Set2 :: set(Element). +is_subset(S1, S2) when map_size(S1) > map_size(S2) -> + false; is_subset(S1, S2) -> - fold(fun (E, Sub) -> Sub andalso is_element(E, S2) end, true, S1). + is_subset_1(S2, maps:iterator(S1)). + +is_subset_1(Set, Iter) -> + case maps:next(Iter) of + {K, _, NextIter} -> + case Set of + #{K := _} -> is_subset_1(Set, NextIter); + #{} -> false + end; + none -> + true + end. %% fold(Fun, Accumulator, Set) -> Accumulator. %% Fold function Fun over all elements in Set and return Accumulator. @@ -193,8 +215,16 @@ is_subset(S1, S2) -> AccIn :: Acc, AccOut :: Acc. -fold(F, Init, D) -> - lists:foldl(fun(E,Acc) -> F(E,Acc) end,Init,maps:keys(D)). +fold(Fun, Init, Set) -> + fold_1(Fun, Init, maps:iterator(Set)). + +fold_1(Fun, Acc, Iter) -> + case maps:next(Iter) of + {K, _, NextIter} -> + fold_1(Fun, Fun(K,Acc), NextIter); + none -> + Acc + end. %% filter(Fun, Set) -> Set. %% Filter Set with Fun. @@ -203,5 +233,18 @@ fold(F, Init, D) -> Set1 :: set(Element), Set2 :: set(Element). -filter(F, D) -> - maps:filter(fun(K,_) -> F(K) end, D). +filter(Fun, Set) -> + maps:from_list(filter_1(Fun, maps:iterator(Set))). + +filter_1(Fun, Iter) -> + case maps:next(Iter) of + {K, _, NextIter} -> + case Fun(K) of + true -> + [{K,ok} | filter_1(Fun, NextIter)]; + false -> + filter_1(Fun, NextIter) + end; + none -> + [] + end. diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl index 533c984221..a2089b5c1b 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -823,7 +823,7 @@ label(T) -> -spec label(cerl:cerl(), integer()) -> {cerl:cerl(), integer()}. label(T, N) -> - label(T, N, dict:new()). + label(T, N, #{}). label(T, N, Env) -> case type(T) of @@ -831,12 +831,13 @@ label(T, N, Env) -> %% Constant literals are not labeled. {T, N}; var -> + VarName = var_name(T), {As, N1} = - case dict:find(var_name(T), Env) of - {ok, L} -> + case Env of + #{VarName := L} -> {A, _} = label_ann(T, L), {A, N}; - error -> + #{} -> label_ann(T, N) end, {set_ann(T, As), N1}; @@ -974,7 +975,7 @@ label_list([], N, _Env) -> {[], N}. label_vars([T | Ts], N, Env) -> - Env1 = dict:store(var_name(T), N, Env), + Env1 = Env#{var_name(T) => N}, {As, N1} = label_ann(T, N), T1 = set_ann(T, As), {Ts1, N2, Env2} = label_vars(Ts, N1, Env1), diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index fd5233d379..e7f58b3783 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -20,6 +20,7 @@ %% Purpose: Run the Erlang compiler. -module(compile). +-compile([{nowarn_deprecated_function,{crypto,block_encrypt,4}}]). %% High-level interface. -export([file/1,file/2,noenv_file/2,format_error/1,iofile/1]). @@ -253,11 +254,11 @@ expand_opt(return, Os) -> [return_errors,return_warnings|Os]; expand_opt(no_bsm3, Os) -> %% The new bsm pass requires bsm3 instructions. - [no_bsm3,no_bsm_opt|Os]; -expand_opt(r16, Os) -> - expand_opt_before_21(Os); -expand_opt(r17, Os) -> - expand_opt_before_21(Os); + [no_bsm3,no_bsm_opt|expand_opt(no_bsm4, Os)]; +expand_opt(no_bsm4, Os) -> + %% bsm4 instructions are only used when type optimization has determined + %% that a match instruction won't fail. + expand_opt(no_type_opt, Os); expand_opt(r18, Os) -> expand_opt_before_21(Os); expand_opt(r19, Os) -> @@ -265,7 +266,11 @@ expand_opt(r19, Os) -> expand_opt(r20, Os) -> expand_opt_before_21(Os); expand_opt(r21, Os) -> - [no_put_tuple2 | expand_opt(no_bsm3, Os)]; + [no_shared_fun_wrappers, + no_swap, no_put_tuple2 | expand_opt(no_bsm3, Os)]; +expand_opt(r22, Os) -> + [no_shared_fun_wrappers, + no_swap | expand_opt(no_bsm4, Os)]; expand_opt({debug_info_key,_}=O, Os) -> [encrypt_debug_info,O|Os]; expand_opt(no_type_opt=O, Os) -> @@ -278,7 +283,8 @@ expand_opt(no_type_opt=O, Os) -> expand_opt(O, Os) -> [O|Os]. expand_opt_before_21(Os) -> - [no_put_tuple2, no_get_hd_tl, no_ssa_opt_record, + [no_shared_fun_wrappers, no_swap, + no_put_tuple2, no_get_hd_tl, no_ssa_opt_record, no_utf8_atoms | expand_opt(no_bsm3, Os)]. %% format_error(ErrorDescriptor) -> string() @@ -597,7 +603,7 @@ passes_1([]) -> {".erl",[?pass(parse_module)|standard_passes()]}. pass(from_core) -> - {".core",[?pass(parse_core)|core_passes(mandatory_core_lint)]}; + {".core",[?pass(parse_core)|core_passes(non_verified_core)]}; pass(from_asm) -> {".S",[?pass(beam_consult_asm)|asm_passes()]}; pass(from_beam) -> @@ -795,33 +801,35 @@ standard_passes() -> ?pass(core), {iff,'dcore',{listing,"core"}}, {iff,'to_core0',{done,"core"}} - | core_passes(optional_core_lint)]. + | core_passes(verified_core)]. -core_passes(LintOpt) -> +core_passes(CoreStatus) -> %% Optimization and transforms of Core Erlang code. - CoreLint = case LintOpt of - mandatory_core_lint -> - ?pass(core_lint_module); - optional_core_lint -> - {iff,clint0,?pass(core_lint_module)} - end, - [CoreLint, - {delay, - [{unless,no_copt, - [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/2}, - {iff,doldinline,{listing,"oldinline"}}, - {unless,no_fold,{pass,sys_core_fold}}, - {iff,dcorefold,{listing,"corefold"}}, - {core_inline_module,fun test_core_inliner/1,fun core_inline_module/2}, - {iff,dinline,{listing,"inline"}}, - {core_fold_after_inlining,fun test_any_inliner/1, - fun core_fold_module_after_inlining/2}, - {iff,dcopt,{listing,"copt"}}, - {unless,no_alias,{pass,sys_core_alias}}, - {iff,dalias,{listing,"core_alias"}}, - ?pass(core_transforms)]}, - {iff,'to_core',{done,"core"}}]} - | kernel_passes()]. + case CoreStatus of + non_verified_core -> + [?pass(core_lint_module), + {pass,sys_core_prepare}, + {iff,dprep,{listing,"prepare"}}]; + verified_core -> + [{iff,clint0,?pass(core_lint_module)}] + end ++ + [ + {delay, + [{unless,no_copt, + [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/2}, + {iff,doldinline,{listing,"oldinline"}}, + {unless,no_fold,{pass,sys_core_fold}}, + {iff,dcorefold,{listing,"corefold"}}, + {core_inline_module,fun test_core_inliner/1,fun core_inline_module/2}, + {iff,dinline,{listing,"inline"}}, + {core_fold_after_inlining,fun test_any_inliner/1, + fun core_fold_module_after_inlining/2}, + {iff,dcopt,{listing,"copt"}}, + {unless,no_alias,{pass,sys_core_alias}}, + {iff,dalias,{listing,"core_alias"}}, + ?pass(core_transforms)]}, + {iff,'to_core',{done,"core"}}]} + | kernel_passes()]. kernel_passes() -> %% Optimizations that must be done after all other optimizations. @@ -839,7 +847,9 @@ kernel_passes() -> {iff,dssa,{listing,"ssa"}}, {iff,ssalint,{pass,beam_ssa_lint}}, {delay, - [{unless,no_share_opt,{pass,beam_ssa_share}}, + [{unless,no_bool_opt,{pass,beam_ssa_bool}}, + {iff,dbool,{listing,"bool"}}, + {unless,no_share_opt,{pass,beam_ssa_share}}, {iff,dssashare,{listing,"ssashare"}}, {iff,ssalint,{pass,beam_ssa_lint}}, {unless,no_bsm_opt,{pass,beam_ssa_bsm}}, @@ -869,8 +879,6 @@ asm_passes() -> {unless,no_postopt, [{pass,beam_block}, {iff,dblk,{listing,"block"}}, - {unless,no_except,{pass,beam_except}}, - {iff,dexcept,{listing,"except"}}, {unless,no_jopt,{pass,beam_jump}}, {iff,djmp,{listing,"jump"}}, {unless,no_peep_opt,{pass,beam_peep}}, @@ -915,8 +923,6 @@ remove_file(Code, St) -> exports, labels, functions=[], - cfun, - code, attributes=[]}). preprocess_asm_forms(Forms) -> @@ -926,36 +932,30 @@ preprocess_asm_forms(Forms) -> {R1#asm_module.module, R1#asm_module.exports, R1#asm_module.attributes, - R1#asm_module.functions, + reverse(R1#asm_module.functions), R1#asm_module.labels}}. -collect_asm([], R) -> - case R#asm_module.cfun of - undefined -> - R; - {A,B,C} -> - R#asm_module{functions=R#asm_module.functions++ - [{function,A,B,C,R#asm_module.code}]} - end; collect_asm([{module,M} | Rest], R) -> collect_asm(Rest, R#asm_module{module=M}); collect_asm([{exports,M} | Rest], R) -> collect_asm(Rest, R#asm_module{exports=M}); collect_asm([{labels,M} | Rest], R) -> collect_asm(Rest, R#asm_module{labels=M}); -collect_asm([{function,A,B,C} | Rest], R) -> - R1 = case R#asm_module.cfun of - undefined -> - R; - {A0,B0,C0} -> - R#asm_module{functions=R#asm_module.functions++ - [{function,A0,B0,C0,R#asm_module.code}]} - end, - collect_asm(Rest, R1#asm_module{cfun={A,B,C}, code=[]}); +collect_asm([{function,A,B,C} | Rest0], R0) -> + {Code,Rest} = collect_asm_function(Rest0, []), + Func = {function,A,B,C,Code}, + R = R0#asm_module{functions=[Func | R0#asm_module.functions]}, + collect_asm(Rest, R); collect_asm([{attributes, Attr} | Rest], R) -> collect_asm(Rest, R#asm_module{attributes=Attr}); -collect_asm([X | Rest], R) -> - collect_asm(Rest, R#asm_module{code=R#asm_module.code++[X]}). +collect_asm([], R) -> R. + +collect_asm_function([{function,_,_,_}|_]=Is, Acc) -> + {reverse(Acc),Is}; +collect_asm_function([I|Is], Acc) -> + collect_asm_function(Is, [I|Acc]); +collect_asm_function([], Acc) -> + {reverse(Acc),[]}. beam_consult_asm(_Code, St) -> case file:consult(St#compile.ifile) of @@ -2102,15 +2102,17 @@ pre_load() -> L = [beam_a, beam_asm, beam_block, + beam_call_types, beam_clean, beam_dict, - beam_except, + beam_digraph, beam_flatten, beam_jump, beam_kernel_to_ssa, beam_opcodes, beam_peep, beam_ssa, + beam_ssa_bool, beam_ssa_bsm, beam_ssa_codegen, beam_ssa_dead, @@ -2121,6 +2123,7 @@ pre_load() -> beam_ssa_share, beam_ssa_type, beam_trim, + beam_types, beam_utils, beam_validator, beam_z, diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index a086a3a8d3..e6f5604d59 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -24,10 +24,11 @@ beam_a, beam_asm, beam_block, + beam_call_types, beam_clean, beam_dict, + beam_digraph, beam_disasm, - beam_except, beam_flatten, beam_jump, beam_kernel_to_ssa, @@ -35,6 +36,7 @@ beam_opcodes, beam_peep, beam_ssa, + beam_ssa_bool, beam_ssa_bsm, beam_ssa_codegen, beam_ssa_dead, @@ -47,6 +49,7 @@ beam_ssa_share, beam_ssa_type, beam_trim, + beam_types, beam_utils, beam_validator, beam_z, @@ -68,6 +71,7 @@ sys_core_fold, sys_core_fold_lists, sys_core_inline, + sys_core_prepare, sys_pre_attributes, v3_core, v3_kernel, @@ -76,5 +80,5 @@ {registered, []}, {applications, [kernel, stdlib]}, {env, []}, - {runtime_dependencies, ["stdlib-2.5","kernel-4.0","hipe-3.12","erts-9.0", + {runtime_dependencies, ["stdlib-@OTP-15251@","kernel-@OTP-15251@","hipe-3.12","erts-@OTP-15251@", "crypto-3.6"]}]}. diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl index c1806272bd..c16881cb0d 100644 --- a/lib/compiler/src/core_lib.erl +++ b/lib/compiler/src/core_lib.erl @@ -26,6 +26,15 @@ -include("core_parse.hrl"). +%% Removed functions + +-removed([{get_anno,1,"use cerl:get_ann/1 instead"}, + {set_anno,2,"use cerl:set_ann/2 instead"}]). + +-removed([{is_literal,1,"use cerl:is_literal/1 instead"}, + {is_literal_list,1,"use cerl:is_literal_list/1 instead"}, + {literal_value,1,"use cerl:concrete/1 instead"}]). + %% Make a suitable values structure, expr or values, depending on Expr. -spec make_values([cerl:cerl()] | cerl:cerl()) -> cerl:cerl(). @@ -79,8 +88,6 @@ vu_expr(V, #c_seq{arg=Arg,body=B}) -> vu_expr(V, Arg) orelse vu_expr(V, B); vu_expr(V, #c_case{arg=Arg,clauses=Cs}) -> vu_expr(V, Arg) orelse vu_clauses(V, Cs); -vu_expr(V, #c_receive{clauses=Cs,timeout=T,action=A}) -> - vu_clauses(V, Cs) orelse vu_expr(V, T) orelse vu_expr(V, A); vu_expr(V, #c_apply{op=Op,args=As}) -> vu_expr_list(V, [Op|As]); vu_expr(V, #c_call{module=M,name=N,args=As}) -> @@ -115,77 +122,47 @@ vu_seg_list(V, Ss) -> vu_expr(V, Val) orelse vu_expr(V, Size) end, Ss). -%% Have to get the pattern results right. - -spec vu_clause(cerl:var_name(), cerl:c_clause()) -> boolean(). vu_clause(V, #c_clause{pats=Ps,guard=G,body=B}) -> - case vu_pattern_list(V, Ps) of - {true,_Shad} -> true; %It is used - {false,true} -> false; %Shadowed - {false,false} -> %Not affected - %% Neither used nor shadowed. Check guard and body. - vu_expr(V, G) orelse vu_expr(V, B) - end. + vu_pattern_list(V, Ps) orelse vu_expr(V, G) orelse vu_expr(V, B). -spec vu_clauses(cerl:var_name(), [cerl:c_clause()]) -> boolean(). vu_clauses(V, Cs) -> lists:any(fun(C) -> vu_clause(V, C) end, Cs). -%% vu_pattern(VarName, Pattern) -> {Used,Shadow}. -%% vu_pattern_list(VarName, [Pattern]) -> {Used,Shadow}. -%% Binaries complicate patterns as a variable can both be properly -%% used, in a bit segment size, and shadow. They can also do both. - -%% vu_pattern(V, Pat) -> vu_pattern(V, Pat, {false,false}). - -vu_pattern(V, #c_var{name=V2}, {Used,_}) -> - {Used,V =:= V2}; -vu_pattern(V, #c_cons{hd=H,tl=T}, St0) -> - case vu_pattern(V, H, St0) of - {true,_}=St1 -> St1; %Nothing more to know - St1 -> vu_pattern(V, T, St1) - end; -vu_pattern(V, #c_tuple{es=Es}, St) -> - vu_pattern_list(V, Es, St); -vu_pattern(V, #c_binary{segments=Ss}, St) -> - vu_pat_seg_list(V, Ss, St); -vu_pattern(V, #c_map{es=Es}, St) -> - vu_map_pairs(V, Es, St); -vu_pattern(V, #c_alias{var=Var,pat=P}, St0) -> - case vu_pattern(V, Var, St0) of - {true,_}=St1 -> St1; - St1 -> vu_pattern(V, P, St1) - end; -vu_pattern(_, _, St) -> St. - -vu_pattern_list(V, Ps) -> vu_pattern_list(V, Ps, {false,false}). - -vu_pattern_list(V, Ps, St0) -> - lists:foldl(fun(P, St) -> vu_pattern(V, P, St) end, St0, Ps). - -vu_pat_seg_list(V, Ss, St) -> - lists:foldl(fun(_, {true,_}=St0) -> St0; - (#c_bitstr{val=Val,size=Size}, St0) -> - case vu_pattern(V, Val, St0) of - {true,_}=St1 -> St1; - {false,Shad} -> - {vu_expr(V, Size),Shad} - end - end, St, Ss). - -vu_map_pairs(V, [#c_map_pair{key=Key,val=Pat}|T], St0) -> - case vu_expr(V, Key) of - true -> - {true,false}; - false -> - case vu_pattern(V, Pat, St0) of - {true,_}=St -> St; - St -> vu_map_pairs(V, T, St) - end - end; -vu_map_pairs(_, [], St) -> St. +%% vu_pattern(VarName, Pattern) -> Used. +%% vu_pattern_list(VarName, [Pattern]) -> Used. +%% Binary and map patterns can use variables. + +vu_pattern(V, #c_var{name=V2}) -> + V =:= V2; +vu_pattern(V, #c_cons{hd=H,tl=T}) -> + vu_pattern(V, H) orelse vu_pattern(V, T); +vu_pattern(V, #c_tuple{es=Es}) -> + vu_pattern_list(V, Es); +vu_pattern(V, #c_binary{segments=Ss}) -> + vu_pat_seg_list(V, Ss); +vu_pattern(V, #c_map{es=Es}) -> + vu_map_pairs(V, Es); +vu_pattern(V, #c_alias{var=Var,pat=P}) -> + vu_pattern(V, Var) orelse vu_pattern(V, P); +vu_pattern(_V, #c_literal{}) -> false. + +vu_pattern_list(V, Ps) -> + lists:any(fun(P) -> vu_pattern(V, P) end, Ps). + +vu_pat_seg_list(V, Ss) -> + lists:any(fun(#c_bitstr{size=Size}) -> + vu_pattern(V, Size) + end, Ss). + +vu_map_pairs(V, [#c_map_pair{key=Key,val=Pat}|T]) -> + vu_expr(V, Key) orelse + vu_pattern(V, Pat) orelse + vu_map_pairs(V, T); +vu_map_pairs(_, []) -> false. -spec vu_var_list(cerl:var_name(), [cerl:c_var()]) -> boolean(). diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl index 3f69cb03a9..579fa59487 100644 --- a/lib/compiler/src/core_lint.erl +++ b/lib/compiler/src/core_lint.erl @@ -55,9 +55,9 @@ -type fa() :: {atom(), arity()}. -type err_desc() :: 'invalid_attributes' | 'invalid_exports' - | {'arg_mismatch', fa()} | {'bittype_unit', fa()} + | {'arg_mismatch', fa()} | {'illegal_expr', fa()} | {'illegal_guard', fa()} - | {'illegal_pattern', fa()} | {'illegal_try', fa()} + | {'illegal_try', fa()} | {'not_bs_pattern', fa()} | {'not_pattern', fa()} | {'not_var', fa()} | {'pattern_mismatch', fa()} | {'return_mismatch', fa()} | {'undefined_function', fa()} @@ -88,14 +88,10 @@ format_error(invalid_attributes) -> "invalid attributes"; format_error(invalid_exports) -> "invalid exports"; format_error({arg_mismatch,{F,A}}) -> io_lib:format("argument count mismatch in ~w/~w", [F,A]); -format_error({bittype_unit,{F,A}}) -> - io_lib:format("unit without size in bit syntax pattern/expression in ~w/~w", [F,A]); format_error({illegal_expr,{F,A}}) -> io_lib:format("illegal expression in ~w/~w", [F,A]); format_error({illegal_guard,{F,A}}) -> io_lib:format("illegal guard expression in ~w/~w", [F,A]); -format_error({illegal_pattern,{F,A}}) -> - io_lib:format("illegal pattern in ~w/~w", [F,A]); format_error({illegal_try,{F,A}}) -> io_lib:format("illegal try expression in ~w/~w", [F,A]); format_error({not_bs_pattern,{F,A}}) -> @@ -111,9 +107,9 @@ format_error({return_mismatch,{F,A}}) -> format_error({undefined_function,{F,A}}) -> io_lib:format("function ~w/~w undefined", [F,A]); format_error({duplicate_var,N,{F,A}}) -> - io_lib:format("duplicate variable ~s in ~w/~w", [N,F,A]); + io_lib:format("duplicate variable ~p in ~w/~w", [N,F,A]); format_error({unbound_var,N,{F,A}}) -> - io_lib:format("unbound variable ~s in ~w/~w", [N,F,A]); + io_lib:format("unbound variable ~p in ~w/~w", [N,F,A]); format_error({undefined_function,{F1,A1},{F2,A2}}) -> io_lib:format("undefined function ~w/~w in ~w/~w", [F1,A1,F2,A2]); format_error({tail_segment_not_at_end,{F,A}}) -> @@ -201,8 +197,13 @@ module_defs(B, Def, St) -> %% functions([Fdef], Defined, State) -> State. -functions(Fs, Def, St0) -> - foldl(fun (F, St) -> function(F, Def, St) end, St0, Fs). +functions(Fs, Def, Rt, St0) -> + foldl(fun ({_Name,#c_fun{vars=Vs,body=B}}, Sti0) -> + {Vvs,St} = variable_list(Vs, Sti0), + body(B, union(Vvs, Def), Rt, St); + (_, St) -> + add_error({illegal_expr,St#lint.func}, St) + end, St0, Fs). %% function(CoreFunc, Defined, State) -> State. @@ -347,7 +348,7 @@ expr(#c_let{vars=Vs,arg=Arg,body=B}, Def, Rt, St0) -> body(B, union(Lvs, Def), Rt, St2); expr(#c_letrec{defs=Fs,body=B}, Def0, Rt, St0) -> Def1 = union(defined_funcs(Fs), Def0), %All defined stuff - St1 = functions(Fs, Def1, St0), + St1 = functions(Fs, Def1, Rt, St0), body(B, Def1, Rt, St1#lint{func=St0#lint.func}); expr(#c_case{arg=Arg,clauses=Cs}, Def, Rt, St0) -> Pc = case_patcount(Cs), @@ -357,9 +358,9 @@ expr(#c_receive{clauses=Cs,timeout=T,action=A}, Def, Rt, St0) -> St1 = expr(T, Def, 1, St0), St2 = body(A, Def, Rt, St1), clauses(Cs, Def, 1, Rt, St2); -expr(#c_apply{op=Op,args=As}, Def, Rt, St0) -> +expr(#c_apply{op=Op,args=As}, Def, _Rt, St0) -> St1 = apply_op(Op, Def, length(As), St0), - return_match(Rt, 1, expr_list(As, Def, St1)); + return_match(any, 1, expr_list(As, Def, St1)); expr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=Name},args=As}, Def, Rt, St0) when is_atom(Name) -> St1 = expr_list(As, Def, St0), @@ -375,6 +376,7 @@ expr(#c_primop{name=#c_literal{val=A},args=As}, Def, Rt, St0) when is_atom(A) -> St1 = expr_list(As, Def, St0), case A of match_fail -> St1; + recv_peek_message -> return_match(Rt, 2, St1); _ -> return_match(Rt, 1, St1) end; expr(#c_catch{body=B}, Def, Rt, St) -> @@ -513,22 +515,16 @@ pat_var(N, _Def, Ps, St) -> %% pat_bin_list([Elem], Defined, [PatVar], State) -> {[PatVar],State}. -pat_bin(Es, Def0, Ps0, St0) -> - {Ps,_,St} = foldl(fun (E, {Ps,Def,St}) -> - pat_segment(E, Def, Ps, St) - end, {Ps0,Def0,St0}, Es), - {Ps,St}. - -pat_segment(#c_bitstr{val=V,size=S,type=T}, Def0, Ps0, St0) -> - St1 = pat_bit_expr(S, T, Def0, St0), - {Ps,St2} = pattern(V, Def0, Ps0, St1), - Def = case V of - #c_var{name=Name} -> add_element(Name, Def0); - _ -> Def0 - end, - {Ps,Def,St2}; -pat_segment(_, Def, Ps, St) -> - {Ps,Def,add_error({not_bs_pattern,St#lint.func}, St)}. +pat_bin(Es, Def, Ps0, St0) -> + foldl(fun (E, {Ps,St}) -> + pat_segment(E, Def, Ps, St) + end, {Ps0,St0}, Es). + +pat_segment(#c_bitstr{val=V,size=S,type=T}, Def, Ps0, St0) -> + St1 = pat_bit_expr(S, T, Def, St0), + pattern(V, Def, Ps0, St1); +pat_segment(_, _, Ps, St) -> + {Ps,add_error({not_bs_pattern,St#lint.func}, St)}. %% pat_bin_tail_check([Elem], State) -> State. %% There must be at most one tail segment (a size-less segment of diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl index cb3f24fd08..19fa11235c 100644 --- a/lib/compiler/src/core_pp.erl +++ b/lib/compiler/src/core_pp.erl @@ -214,7 +214,7 @@ format_1(#c_let{anno=Anno0,vars=Vs0,arg=A0,body=B}, #ctxt{clean=Clean}=Ctxt) -> {Vs0,A0,Anno0}; true -> {[cerl:set_ann(V, []) || V <- Vs0], - cerl:set_ann(A0, []), + clean_anno_carefully(A0), []} end, case is_simple_term(A) andalso Anno =:= [] of @@ -546,3 +546,13 @@ segs_from_bitstring(Bitstring) -> unit=#c_literal{val=1}, type=#c_literal{val=integer}, flags=#c_literal{val=[unsigned,big]}}]. + +clean_anno_carefully(Node) -> + Anno = clean_anno_carefully_1(cerl:get_ann(Node)), + cerl:set_ann(Node, Anno). + +clean_anno_carefully_1([letrec_goto=Keep|Annos]) -> + [Keep|clean_anno_carefully_1(Annos)]; +clean_anno_carefully_1([_|Annos]) -> + clean_anno_carefully_1(Annos); +clean_anno_carefully_1([]) -> []. diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index 94a5dfe012..caf067fde7 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -80,10 +80,12 @@ is_pure(erlang, 'or', 2) -> true; is_pure(erlang, 'rem', 2) -> true; is_pure(erlang, 'xor', 2) -> true; is_pure(erlang, abs, 1) -> true; +is_pure(erlang, atom_to_binary, 1) -> true; is_pure(erlang, atom_to_binary, 2) -> true; is_pure(erlang, atom_to_list, 1) -> true; is_pure(erlang, binary_part, 2) -> true; is_pure(erlang, binary_part, 3) -> true; +is_pure(erlang, binary_to_atom, 1) -> true; is_pure(erlang, binary_to_atom, 2) -> true; is_pure(erlang, binary_to_float, 1) -> true; is_pure(erlang, binary_to_integer, 1) -> true; @@ -144,6 +146,9 @@ is_pure(erlang, tuple_size, 1) -> true; is_pure(erlang, tuple_to_list, 1) -> true; is_pure(lists, append, 2) -> true; is_pure(lists, subtract, 2) -> true; +is_pure(maps, get, 2) -> true; +is_pure(maps, is_key, 2) -> true; +is_pure(maps, new, 0) -> true; is_pure(math, acos, 1) -> true; is_pure(math, acosh, 1) -> true; is_pure(math, asin, 1) -> true; diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index 86590fad87..64680ca1ed 100755 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -596,3 +596,15 @@ BEAM_FORMAT_NUMBER=0 ## @spec bs_set_positon Ctx Pos ## @doc Sets the current position of Ctx to Pos 168: bs_set_position/2 + +# OTP 23 + +## @spec swap Register1 Register2 +## @doc Swaps the contents of two registers. +169: swap/2 + +## @spec bs_start_match4 Fail Bin Live Dst +## @doc As bs_start_match3, but the fail label can be 'no_fail' when we know +## it will never fail at runtime, or 'resume' when we know the input is +## a match context. +170: bs_start_match4/4 diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index eb1f69269c..b8cf4b42ff 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -99,10 +99,6 @@ t=#{} :: map(), %Types in_guard=false}). %In guard or not. --type type_info() :: cerl:cerl() | 'bool' | 'integer' | {'fun', pos_integer()}. --type yes_no_maybe() :: 'yes' | 'no' | 'maybe'. --type sub() :: #sub{}. - -spec module(cerl:c_module(), [compile:option()]) -> {'ok', cerl:c_module(), [_]}. @@ -315,10 +311,10 @@ expr(#c_seq{arg=Arg0,body=B0}=Seq0, Ctxt, Sub) -> false -> %% Arg cannot be "values" here - only a single value %% make sense here. - case {Ctxt,is_safe_simple(Arg, Sub)} of + case {Ctxt,is_safe_simple(Arg)} of {effect,true} -> B1; {effect,false} -> - case is_safe_simple(B1, Sub) of + case is_safe_simple(B1) of true -> Arg; false -> Seq0#c_seq{arg=Arg,body=B1} end; @@ -384,11 +380,11 @@ expr(#c_case{}=Case0, Ctxt, Sub) -> %% according to the rules above). %% case opt_bool_case(Case0, Sub) of - #c_case{arg=Arg0,clauses=Cs0}=Case1 -> + #c_case{anno=Anno,arg=Arg0,clauses=Cs0}=Case1 -> Arg1 = body(Arg0, value, Sub), LitExpr = cerl:is_literal(Arg1), {Arg2,Cs1} = case_opt(Arg1, Cs0, Sub), - Cs2 = clauses(Arg2, Cs1, Ctxt, Sub, LitExpr), + Cs2 = clauses(Arg2, Cs1, Ctxt, Sub, LitExpr, Anno), Case = Case1#c_case{arg=Arg2,clauses=Cs2}, warn_no_clause_match(Case1, Case), Expr = eval_case(Case, Sub), @@ -396,11 +392,6 @@ expr(#c_case{}=Case0, Ctxt, Sub) -> Other -> expr(Other, Ctxt, Sub) end; -expr(#c_receive{clauses=Cs0,timeout=T0,action=A0}=Recv, Ctxt, Sub) -> - Cs1 = clauses(#c_var{name='_'}, Cs0, Ctxt, Sub, false), - T1 = expr(T0, value, Sub), - A1 = body(A0, Ctxt, Sub), - Recv#c_receive{clauses=Cs1,timeout=T1,action=A1}; expr(#c_apply{anno=Anno,op=Op0,args=As0}=Apply0, _, Sub) -> Op1 = expr(Op0, value, Sub), As1 = expr_list(As0, value, Sub), @@ -442,7 +433,7 @@ expr(#c_catch{anno=Anno,body=B}, effect, Sub) -> expr(#c_catch{body=B0}=Catch, _, Sub) -> %% We can remove catch if the value is simple B1 = body(B0, value, Sub), - case is_safe_simple(B1, Sub) of + case is_safe_simple(B1) of true -> B1; false -> Catch#c_catch{body=B1} end; @@ -458,7 +449,7 @@ expr(#c_try{arg=E0,vars=[#c_var{name=X}],body=#c_var{name=X}, %% We can remove try/catch if the expression is an %% expression that cannot fail. - case is_safe_bool_expr(E2, Sub) orelse is_safe_simple(E2, Sub) of + case is_safe_bool_expr(E2) orelse is_safe_simple(E2) of true -> E2; false -> Try#c_try{arg=E2} end; @@ -472,27 +463,15 @@ expr(#c_try{anno=A,arg=E0,vars=Vs0,body=B0,evars=Evs0,handler=H0}=Try, _, Sub0) E1 = body(E0, value, Sub0), {Vs1,Sub1} = var_list(Vs0, Sub0), B1 = body(B0, value, Sub1), - case is_safe_simple(E1, Sub0) of + case is_safe_simple(E1) of true -> expr(#c_let{anno=A,vars=Vs1,arg=E1,body=B1}, value, Sub0); false -> {Evs1,Sub2} = var_list(Evs0, Sub0), H1 = body(H0, value, Sub2), - H2 = opt_try_handler(H1, lists:last(Evs1)), - Try#c_try{arg=E1,vars=Vs1,body=B1,evars=Evs1,handler=H2} + Try#c_try{arg=E1,vars=Vs1,body=B1,evars=Evs1,handler=H1} end. -%% Attempts to convert old erlang:get_stacktrace/0 calls into the new -%% three-argument catch, with possibility of further optimisations. -opt_try_handler(#c_call{anno=A,module=#c_literal{val=erlang},name=#c_literal{val=get_stacktrace},args=[]}, Var) -> - #c_primop{anno=A,name=#c_literal{val=build_stacktrace},args=[Var]}; -opt_try_handler(#c_case{clauses=Cs0} = Case, Var) -> - Cs = [C#c_clause{body=opt_try_handler(B, Var)} || #c_clause{body=B} = C <- Cs0], - Case#c_case{clauses=Cs}; -opt_try_handler(#c_let{arg=Arg} = Let, Var) -> - Let#c_let{arg=opt_try_handler(Arg, Var)}; -opt_try_handler(X, _) -> X. - %% If a fun or its application is used as an argument, then it's unsafe to %% handle it in effect context as the side-effects may rely on its return %% value. The following is a minimal example of where it can go wrong: @@ -545,10 +524,6 @@ ifes_1(FVar, #c_map_pair{key=Key,val=Val}, _Safe) -> ifes_1(FVar, Key, false) andalso ifes_1(FVar, Val, false); ifes_1(FVar, #c_primop{args=Args}, _Safe) -> ifes_list(FVar, Args, false); -ifes_1(FVar, #c_receive{timeout=Timeout,action=Action,clauses=Clauses}, Safe) -> - ifes_1(FVar, Timeout, false) andalso - ifes_1(FVar, Action, Safe) andalso - ifes_list(FVar, Clauses, Safe); ifes_1(FVar, #c_seq{arg=Arg,body=Body}, Safe) -> %% Arg of a #c_seq{} has no effect so it's okay to use FVar there even if %% Safe=false. @@ -602,20 +577,20 @@ is_literal_fun(_) -> false. %% Currently, we don't attempt to check binaries because they %% are difficult to check. -is_safe_simple(#c_var{}=Var, _) -> +is_safe_simple(#c_var{}=Var) -> not cerl:is_c_fname(Var); -is_safe_simple(#c_cons{hd=H,tl=T}, Sub) -> - is_safe_simple(H, Sub) andalso is_safe_simple(T, Sub); -is_safe_simple(#c_tuple{es=Es}, Sub) -> is_safe_simple_list(Es, Sub); -is_safe_simple(#c_literal{}, _) -> true; +is_safe_simple(#c_cons{hd=H,tl=T}) -> + is_safe_simple(H) andalso is_safe_simple(T); +is_safe_simple(#c_tuple{es=Es}) -> is_safe_simple_list(Es); +is_safe_simple(#c_literal{}) -> true; is_safe_simple(#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=Name}, - args=Args}, Sub) when is_atom(Name) -> + args=Args}) when is_atom(Name) -> NumArgs = length(Args), case erl_internal:bool_op(Name, NumArgs) of true -> %% Boolean operators are safe if the arguments are boolean. - all(fun(C) -> is_boolean_type(C, Sub) =:= yes end, Args); + all(fun is_bool_expr/1, Args); false -> %% We need a rather complicated test to ensure that %% we only allow safe calls that are allowed in a guard. @@ -624,9 +599,9 @@ is_safe_simple(#c_call{module=#c_literal{val=erlang}, (erl_internal:comp_op(Name, NumArgs) orelse erl_internal:new_type_test(Name, NumArgs)) end; -is_safe_simple(_, _) -> false. +is_safe_simple(_) -> false. -is_safe_simple_list(Es, Sub) -> all(fun(E) -> is_safe_simple(E, Sub) end, Es). +is_safe_simple_list(Es) -> all(fun(E) -> is_safe_simple(E) end, Es). %% will_fail(Expr) -> true|false. %% Determine whether the expression will fail with an exception. @@ -696,15 +671,7 @@ eval_binary(#c_binary{anno=Anno,segments=Ss}=Bin) -> eval_binary_1([#c_bitstr{val=#c_literal{val=Val},size=#c_literal{val=Sz}, unit=#c_literal{val=Unit},type=#c_literal{val=Type}, flags=#c_literal{val=Flags}}|Ss], Acc0) -> - Endian = case member(big, Flags) of - true -> - big; - false -> - case member(little, Flags) of - true -> little; - false -> throw(impossible) %Native endian. - end - end, + Endian = bs_endian(Flags), %% Make sure that the size is reasonable. case Type of @@ -738,10 +705,14 @@ eval_binary_1([#c_bitstr{val=#c_literal{val=Val},size=#c_literal{val=Sz}, end; float when is_float(Val) -> %% Bad float size. - case Sz*Unit of + try Sz*Unit of 32 -> ok; 64 -> ok; - _ -> throw(impossible) + _ -> + throw({badarg,bad_float_size}) + catch + error:_ -> + throw({badarg,bad_float_size}) end; utf8 -> ok; utf16 -> ok; @@ -750,6 +721,11 @@ eval_binary_1([#c_bitstr{val=#c_literal{val=Val},size=#c_literal{val=Sz}, throw(impossible) end, + case Endian =:= native andalso Type =/= binary of + true -> throw(impossible); + false -> ok + end, + %% Evaluate the field. try eval_binary_2(Acc0, Val, Sz, Unit, Type, Endian) of Acc -> eval_binary_1(Ss, Acc) @@ -813,6 +789,11 @@ eval_binary_2(Acc, Val, all, Unit, binary, _) -> eval_binary_2(Acc, Val, Size, Unit, binary, _) -> <<Acc/bitstring,Val:(Size*Unit)/bitstring>>. +bs_endian([big=E|_]) -> E; +bs_endian([little=E|_]) -> E; +bs_endian([native=E|_]) -> E; +bs_endian([_|Fs]) -> bs_endian(Fs). + %% Count the number of bits approximately needed to store Int. %% (We don't need an exact result for this purpose.) @@ -853,7 +834,7 @@ useless_call(_, _) -> no. %% Anything that will not have any effect will be thrown away. make_effect_seq([H|T], Sub) -> - case is_safe_simple(H, Sub) of + case is_safe_simple(H) of true -> make_effect_seq(T, Sub); false -> #c_seq{arg=H,body=make_effect_seq(T, Sub)} end; @@ -880,25 +861,45 @@ fold_apply(Apply, _, _) -> Apply. %% Handling remote calls. The module/name fields have been processed. -call(#c_call{args=As}=Call, #c_literal{val=M}=M0, #c_literal{val=N}=N0, Sub) -> - case get(no_inline_list_funcs) of - true -> - call_1(Call, M0, N0, As, Sub); - false -> - case sys_core_fold_lists:call(Call, M, N, As) of - none -> - call_1(Call, M0, N0, As, Sub); - Core -> - expr(Core, Sub) - end - - end; -call(#c_call{args=As}=Call, M, N, Sub) -> - call_1(Call, M, N, As, Sub). - -call_1(Call, M, N, As0, Sub) -> +call(#c_call{args=As0}=Call0, #c_literal{val=M}=M0, #c_literal{val=N}=N0, Sub) -> As1 = expr_list(As0, value, Sub), - fold_call(Call#c_call{args=As1}, M, N, As1, Sub). + case simplify_call(Call0, M, N, As1) of + #c_literal{}=Lit -> + Lit; + #c_call{args=As}=Call -> + case get(no_inline_list_funcs) of + true -> + fold_call(Call, M0, N0, As, Sub); + false -> + case sys_core_fold_lists:call(Call, M, N, As) of + none -> fold_call(Call, M0, N0, As, Sub); + Core -> expr(Core, Sub) + end + end + end; +call(#c_call{args=As0}=Call, M, N, Sub) -> + As = expr_list(As0, value, Sub), + fold_call(Call#c_call{args=As}, M, N, As, Sub). + +%% Rewrite certain known functions to BIFs, improving performance +%% slightly at the cost of making tracing and stack traces incorrect. +simplify_call(Call, maps, get, [Key, Map]) -> + rewrite_call(Call, erlang, map_get, [Key, Map]); +simplify_call(Call, maps, is_key, [Key, Map]) -> + rewrite_call(Call, erlang, is_map_key, [Key, Map]); +simplify_call(_Call, maps, new, []) -> + #c_literal{val=#{}}; +simplify_call(Call, maps, size, [Map]) -> + rewrite_call(Call, erlang, map_size, [Map]); +simplify_call(Call, _, _, Args) -> + Call#c_call{args=Args}. + +%% rewrite_call(Call0, Mod, Func, Args, Sub) -> Call +%% Rewrites a call to the given MFA. +rewrite_call(Call, Mod, Func, Args) -> + ModLit = #c_literal{val=Mod}, + FuncLit = #c_literal{val=Func}, + Call#c_call{module=ModLit,name=FuncLit,args=Args}. %% fold_call(Call, Mod, Name, Args, Sub) -> Expr. %% Try to safely evaluate the call. Just try to evaluate arguments, @@ -959,138 +960,14 @@ fold_lit_args(Call, Module, Name, Args0) -> %% Attempt to evaluate some pure BIF calls with one or more %% non-literals arguments. %% -fold_non_lit_args(Call, erlang, is_boolean, [Arg], Sub) -> - eval_is_boolean(Call, Arg, Sub); fold_non_lit_args(Call, erlang, length, [Arg], _) -> eval_length(Call, Arg); fold_non_lit_args(Call, erlang, '++', [Arg1,Arg2], _) -> eval_append(Call, Arg1, Arg2); fold_non_lit_args(Call, lists, append, [Arg1,Arg2], _) -> eval_append(Call, Arg1, Arg2); -fold_non_lit_args(Call, erlang, is_function, [Arg1], Sub) -> - eval_is_function_1(Call, Arg1, Sub); -fold_non_lit_args(Call, erlang, is_function, [Arg1,Arg2], Sub) -> - eval_is_function_2(Call, Arg1, Arg2, Sub); -fold_non_lit_args(Call, erlang, N, Args, Sub) -> - NumArgs = length(Args), - case erl_internal:comp_op(N, NumArgs) of - true -> - eval_rel_op(Call, N, Args, Sub); - false -> - case erl_internal:bool_op(N, NumArgs) of - true -> - eval_bool_op(Call, N, Args, Sub); - false -> - Call - end - end; fold_non_lit_args(Call, _, _, _, _) -> Call. -eval_is_function_1(Call, Arg1, Sub) -> - case get_type(Arg1, Sub) of - none -> Call; - {'fun',_} -> #c_literal{anno=cerl:get_ann(Call),val=true}; - _ -> #c_literal{anno=cerl:get_ann(Call),val=false} - end. - -eval_is_function_2(Call, Arg1, #c_literal{val=Arity}, Sub) - when is_integer(Arity), Arity > 0 -> - case get_type(Arg1, Sub) of - none -> Call; - {'fun',Arity} -> #c_literal{anno=cerl:get_ann(Call),val=true}; - _ -> #c_literal{anno=cerl:get_ann(Call),val=false} - end; -eval_is_function_2(Call, _Arg1, _Arg2, _Sub) -> Call. - -%% Evaluate a relational operation using type information. -eval_rel_op(Call, Op, [#c_var{name=V},#c_var{name=V}], _) -> - Bool = erlang:Op(same, same), - #c_literal{anno=cerl:get_ann(Call),val=Bool}; -eval_rel_op(Call, '=:=', [Term,#c_literal{val=true}], Sub) -> - %% BoolVar =:= true ==> BoolVar - case is_boolean_type(Term, Sub) of - yes -> Term; - maybe -> Call; - no -> #c_literal{val=false} - end; -eval_rel_op(Call, '==', Ops, Sub) -> - case is_exact_eq_ok(Ops, Sub) of - true -> - Name = #c_literal{anno=cerl:get_ann(Call),val='=:='}, - Call#c_call{name=Name}; - false -> - Call - end; -eval_rel_op(Call, '/=', Ops, Sub) -> - case is_exact_eq_ok(Ops, Sub) of - true -> - Name = #c_literal{anno=cerl:get_ann(Call),val='=/='}, - Call#c_call{name=Name}; - false -> - Call - end; -eval_rel_op(Call, _, _, _) -> Call. - -is_exact_eq_ok([A,B]=L, Sub) -> - case is_int_type(A, Sub) =:= yes andalso is_int_type(B, Sub) =:= yes of - true -> true; - false -> is_exact_eq_ok_1(L) - end. - -is_exact_eq_ok_1([#c_literal{val=Lit}|_]) -> - is_non_numeric(Lit); -is_exact_eq_ok_1([_|T]) -> - is_exact_eq_ok_1(T); -is_exact_eq_ok_1([]) -> false. - -is_non_numeric([H|T]) -> - is_non_numeric(H) andalso is_non_numeric(T); -is_non_numeric(Tuple) when is_tuple(Tuple) -> - is_non_numeric_tuple(Tuple, tuple_size(Tuple)); -is_non_numeric(Map) when is_map(Map) -> - %% Note that 17.x and 18.x compare keys in different ways. - %% Be very conservative -- require that both keys and values - %% are non-numeric. - is_non_numeric(maps:to_list(Map)); -is_non_numeric(Num) when is_number(Num) -> - false; -is_non_numeric(_) -> true. - -is_non_numeric_tuple(Tuple, El) when El >= 1 -> - is_non_numeric(element(El, Tuple)) andalso - is_non_numeric_tuple(Tuple, El-1); -is_non_numeric_tuple(_Tuple, 0) -> true. - -%% Evaluate a bool op using type information. We KNOW that -%% there must be at least one non-literal argument (i.e. -%% there is no need to handle the case that all argments -%% are literal). - -eval_bool_op(Call, 'and', [#c_literal{val=true},Term], Sub) -> - eval_bool_op_1(Call, Term, Term, Sub); -eval_bool_op(Call, 'and', [Term,#c_literal{val=true}], Sub) -> - eval_bool_op_1(Call, Term, Term, Sub); -eval_bool_op(Call, 'and', [#c_literal{val=false}=Res,Term], Sub) -> - eval_bool_op_1(Call, Res, Term, Sub); -eval_bool_op(Call, 'and', [Term,#c_literal{val=false}=Res], Sub) -> - eval_bool_op_1(Call, Res, Term, Sub); -eval_bool_op(Call, _, _, _) -> Call. - -eval_bool_op_1(Call, Res, Term, Sub) -> - case is_boolean_type(Term, Sub) of - yes -> Res; - no -> eval_failure(Call, badarg); - maybe -> Call - end. - -%% Evaluate is_boolean/1 using type information. -eval_is_boolean(Call, Term, Sub) -> - case is_boolean_type(Term, Sub) of - no -> #c_literal{val=false}; - yes -> #c_literal{val=true}; - maybe -> Call - end. - %% eval_length(Call, List) -> Val. %% Evaluates the length for the prefix of List which has a known %% shape. @@ -1199,10 +1076,6 @@ clause_1(#c_clause{guard=G0,body=B0}=Cl, Ps1, Cexpr, Ctxt, Sub1) -> %% No need for substitution tricks when the guard %% does not contain any variables. Sub1; - {#c_var{name='_'},_,_} -> - %% In a 'receive', Cexpr is the variable '_', which represents the - %% message being matched. We must NOT do any extra substiutions. - Sub1; {#c_var{},[#c_var{}=Var],_} -> %% The idea here is to optimize expressions such as %% @@ -1329,20 +1202,27 @@ map_pair_pattern(#c_map_pair{op=#c_literal{val=exact},key=K0,val=V0}=Pair,{Isub, {V,Osub} = pattern(V0,Isub,Osub0), {Pair#c_map_pair{key=K,val=V},{Isub,Osub}}. -bin_pattern_list(Ps0, Isub, Osub0) -> - {Ps,{_,Osub}} = mapfoldl(fun bin_pattern/2, {Isub,Osub0}, Ps0), - {Ps,Osub}. - -bin_pattern(#c_bitstr{val=E0,size=Size0}=Pat0, {Isub0,Osub0}) -> - Size1 = expr(Size0, Isub0), - {E1,Osub} = pattern(E0, Isub0, Osub0), - Isub = case E0 of - #c_var{} -> sub_set_var(E0, E1, Isub0); - _ -> Isub0 - end, - Pat = Pat0#c_bitstr{val=E1,size=Size1}, +bin_pattern_list(Ps, Isub, Osub0) -> + mapfoldl(fun(P, Osub) -> + bin_pattern(P, Isub, Osub) + end, Osub0, Ps). + +bin_pattern(#c_bitstr{val=E0,size=Size0}=Pat0, Isub, Osub0) -> + Size2 = case {Size0,expr(Size0, Isub)} of + {#c_var{},#c_literal{val=all}} -> + %% The size `all` is used for the size of the final binary + %% segment in a pattern. Using `all` explicitly is not allowed, + %% so we convert it to an obvious invalid size. We also need + %% to add an annotation to get the correct wording of the warning + %% that will soon be issued. + #c_literal{anno=[size_was_all],val=bad_size}; + {_,Size1} -> + Size1 + end, + {E1,Osub} = pattern(E0, Isub, Osub0), + Pat = Pat0#c_bitstr{val=E1,size=Size2}, bin_pat_warn(Pat), - {Pat,{Isub,Osub}}. + {Pat,Osub}. pattern_list(Ps, Sub) -> pattern_list(Ps, Sub, Sub). @@ -1365,7 +1245,7 @@ var_list(Vs, Sub0) -> bin_pat_warn(#c_bitstr{type=#c_literal{val=Type}, val=Val0, - size=#c_literal{val=Sz}, + size=#c_literal{anno=SizeAnno,val=Sz}, unit=#c_literal{val=Unit}, flags=Fl}=Pat) -> case {Type,Sz} of @@ -1375,7 +1255,12 @@ bin_pat_warn(#c_bitstr{type=#c_literal{val=Type}, {utf16,undefined} -> ok; {utf32,undefined} -> ok; {_,_} -> - add_warning(Pat, {nomatch_bit_syntax_size,Sz}), + case member(size_was_all, SizeAnno) of + true -> + add_warning(Pat, {nomatch_bit_syntax_size,all}); + false -> + add_warning(Pat, {nomatch_bit_syntax_size,Sz}) + end, throw(nomatch) end, case {Type,Val0} of @@ -1562,11 +1447,11 @@ warn_no_clause_match(CaseOrig, CaseOpt) -> ok end. -%% clauses(E, [Clause], TopLevel, Context, Sub) -> [Clause]. +%% clauses(E, [Clause], TopLevel, Context, Sub, Anno) -> [Clause]. %% Trim the clauses by removing all clauses AFTER the first one which %% is guaranteed to match. Also remove all trivially false clauses. -clauses(E, [C0|Cs], Ctxt, Sub, LitExpr) -> +clauses(E, [C0|Cs], Ctxt, Sub, LitExpr, Anno) -> #c_clause{pats=Ps,guard=G} = C1 = clause(C0, E, Ctxt, Sub), %%ok = io:fwrite("~w: ~p~n", [?LINE,{E,Ps}]), case {will_match(E, Ps),will_succeed(G)} of @@ -1574,7 +1459,7 @@ clauses(E, [C0|Cs], Ctxt, Sub, LitExpr) -> case LitExpr of false -> Line = get_line(cerl:get_ann(C1)), - shadow_warning(Cs, Line); + shadow_warning(Cs, Line, Anno); true -> %% If the case expression is a literal, %% it is probably OK that some clauses don't match. @@ -1584,19 +1469,24 @@ clauses(E, [C0|Cs], Ctxt, Sub, LitExpr) -> [C1]; %Skip the rest {_Mat,no} -> %Guard fails. add_warning(C1, nomatch_guard), - clauses(E, Cs, Ctxt, Sub, LitExpr); %Skip this clause + clauses(E, Cs, Ctxt, Sub, LitExpr, Anno); %Skip this clause {_Mat,_Suc} -> - [C1|clauses(E, Cs, Ctxt, Sub, LitExpr)] + [C1|clauses(E, Cs, Ctxt, Sub, LitExpr, Anno)] end; -clauses(_, [], _, _, _) -> []. +clauses(_, [], _, _, _, _) -> []. -shadow_warning([C|Cs], none) -> +shadow_warning([C|Cs], none, Anno) -> add_warning(C, nomatch_shadow), - shadow_warning(Cs, none); -shadow_warning([C|Cs], Line) -> - add_warning(C, {nomatch_shadow, Line}), - shadow_warning(Cs, Line); -shadow_warning([], _) -> ok. + shadow_warning(Cs, none, Anno); +shadow_warning([C|Cs], Line, Anno) -> + case keyfind(function, 1, Anno) of + {function, {Name, Arity}} -> + add_warning(C, {nomatch_shadow, Line, {Name, Arity}}); + _ -> + add_warning(C, {nomatch_shadow, Line}) + end, + shadow_warning(Cs, Line, Anno); +shadow_warning([], _, _) -> ok. %% will_succeed(Guard) -> yes | maybe | no. %% Test if we know whether a guard will succeed/fail or just don't @@ -1669,7 +1559,7 @@ opt_bool_clauses(Cs, true, true) -> %% Any remaining clauses cannot possibly match. case Cs of [_|_] -> - shadow_warning(Cs, none), + shadow_warning(Cs, none, []), []; [] -> [] @@ -1771,7 +1661,7 @@ opt_bool_not_invert(#c_clause{pats=[#c_literal{val=Bool}]}=C) -> opt_bool_case_redundant(#c_case{arg=Arg,clauses=Cs}=Case) -> case all(fun opt_bool_case_redundant_1/1, Cs) of true -> Arg; - false -> opt_bool_case_guard(Case) + false -> Case end. opt_bool_case_redundant_1(#c_clause{pats=[#c_literal{val=B}], @@ -1779,45 +1669,6 @@ opt_bool_case_redundant_1(#c_clause{pats=[#c_literal{val=B}], true; opt_bool_case_redundant_1(_) -> false. -%% opt_bool_case_guard(Case) -> Case'. -%% Move a boolean case expression into the guard if we are sure that -%% it cannot fail. -%% -%% case SafeBoolExpr of case <> of -%% true -> TrueClause; ==> <> when SafeBoolExpr -> TrueClause; -%% false -> FalseClause <> when true -> FalseClause -%% end. end. -%% -%% Generally, evaluting a boolean expression in a guard should -%% be faster than evaulating it in the body. -%% -opt_bool_case_guard(#c_case{arg=#c_literal{}}=Case) -> - %% It is not necessary to move a literal case expression into the - %% guard, because it will be handled quite well in other - %% optimizations, and moving the literal into the guard will - %% cause some extra warnings, for instance for this code - %% - %% case true of - %% true -> ...; - %% false -> ... - %% end. - %% - Case; -opt_bool_case_guard(#c_case{arg=Arg,clauses=Cs0}=Case) -> - case is_safe_bool_expr(Arg, sub_new()) of - false -> - Case; - true -> - Cs = opt_bool_case_guard(Arg, Cs0), - Case#c_case{arg=#c_values{anno=cerl:get_ann(Arg),es=[]}, - clauses=Cs} - end. - -opt_bool_case_guard(Arg, [#c_clause{pats=[#c_literal{val=true}]}=Tc,Fc]) -> - [Tc#c_clause{pats=[],guard=Arg},Fc#c_clause{pats=[]}]; -opt_bool_case_guard(Arg, [#c_clause{pats=[#c_literal{val=false}]}=Fc,Tc]) -> - [Tc#c_clause{pats=[],guard=Arg},Fc#c_clause{pats=[]}]. - %% eval_case(Case) -> #c_case{} | #c_let{}. %% If possible, evaluate a case at compile time. We know that the %% last clause is guaranteed to match so if there is only one clause @@ -1945,7 +1796,7 @@ case_opt_arg(E0, Sub, Cs, LitExpr) -> {error,Cs}; false -> %% If possible, expand this variable to a previously - %% matched term. + %% constructed tuple E = case_expand_var(E0, Sub), case_opt_arg_1(E, Cs, LitExpr) end @@ -2004,13 +1855,8 @@ case_opt_compiler_generated(Core) -> case_expand_var(E, #sub{t=Tdb}) -> Key = cerl:var_name(E), case Tdb of - #{Key:=T} -> - case cerl:is_c_tuple(T) of - false -> E; - true -> T - end; - _ -> - E + #{Key:=T} -> T; + _ -> E end. %% case_opt_nomatch(E, Clauses, LitExpr) -> Clauses' @@ -2302,115 +2148,84 @@ is_simple_case_arg(_) -> false. %% Check whether the Core expression is guaranteed to return %% a boolean IF IT RETURNS AT ALL. %% -is_bool_expr(Core) -> - is_bool_expr(Core, sub_new()). -%% is_bool_expr(Core, Sub) -> true|false -%% Check whether the Core expression is guaranteed to return -%% a boolean IF IT RETURNS AT ALL. Uses type information -%% to be able to identify more expressions as booleans. -%% is_bool_expr(#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=Name},args=Args}=Call, _) -> + name=#c_literal{val=Name},args=Args}=Call) -> NumArgs = length(Args), erl_internal:comp_op(Name, NumArgs) orelse erl_internal:new_type_test(Name, NumArgs) orelse erl_internal:bool_op(Name, NumArgs) orelse will_fail(Call); is_bool_expr(#c_try{arg=E,vars=[#c_var{name=X}],body=#c_var{name=X}, - handler=#c_literal{val=false}}, Sub) -> - is_bool_expr(E, Sub); -is_bool_expr(#c_case{clauses=Cs}, Sub) -> - is_bool_expr_list(Cs, Sub); -is_bool_expr(#c_clause{body=B}, Sub) -> - is_bool_expr(B, Sub); -is_bool_expr(#c_let{vars=[V],arg=Arg,body=B}, Sub0) -> - Sub = case is_bool_expr(Arg, Sub0) of - true -> update_types(V, [bool], Sub0); - false -> Sub0 - end, - is_bool_expr(B, Sub); -is_bool_expr(#c_let{body=B}, Sub) -> - %% Binding of multiple variables. - is_bool_expr(B, Sub); -is_bool_expr(C, Sub) -> - is_boolean_type(C, Sub) =:= yes. - -is_bool_expr_list([C|Cs], Sub) -> - is_bool_expr(C, Sub) andalso is_bool_expr_list(Cs, Sub); -is_bool_expr_list([], _) -> true. + handler=#c_literal{val=false}}) -> + is_bool_expr(E); +is_bool_expr(#c_case{clauses=Cs}) -> + is_bool_expr_list(Cs); +is_bool_expr(#c_clause{body=B}) -> + is_bool_expr(B); +is_bool_expr(#c_let{body=B}) -> + is_bool_expr(B); +is_bool_expr(#c_literal{val=Val}) -> + is_boolean(Val); +is_bool_expr(_) -> false. + +is_bool_expr_list([C|Cs]) -> + is_bool_expr(C) andalso is_bool_expr_list(Cs); +is_bool_expr_list([]) -> true. %% is_safe_bool_expr(Core) -> true|false %% Check whether the Core expression ALWAYS returns a boolean -%% (i.e. it cannot fail). Also make sure that the expression -%% is suitable for a guard (no calls to non-guard BIFs, local -%% functions, or is_record/2). +%% (i.e. it cannot fail). %% -is_safe_bool_expr(Core, Sub) -> - is_safe_bool_expr_1(Core, Sub, cerl_sets:new()). +is_safe_bool_expr(Core) -> + is_safe_bool_expr_1(Core, cerl_sets:new()). is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_record}, - args=[A,#c_literal{val=Tag},#c_literal{val=Size}]}, - Sub, _BoolVars) when is_atom(Tag), is_integer(Size) -> - is_safe_simple(A, Sub); -is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_record}}, - _Sub, _BoolVars) -> - %% The is_record/2 BIF is NOT allowed in guards. - %% The is_record/3 BIF where its second argument is not an atom or its third - %% is not an integer is NOT allowed in guards. - %% - %% NOTE: Calls like is_record(Expr, LiteralTag), where LiteralTag - %% is a literal atom referring to a defined record, have already - %% been rewritten to is_record(Expr, LiteralTag, TupleSize). - false; -is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[A,#c_literal{val=Arity}]}, - Sub, _BoolVars) when is_integer(Arity), Arity >= 0 -> - is_safe_simple(A, Sub); + _BoolVars) when is_integer(Arity), Arity >= 0 -> + is_safe_simple(A); is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}}, - _Sub, _BoolVars) -> + _BoolVars) -> false; is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=Name},args=Args}, - Sub, BoolVars) -> + BoolVars) -> NumArgs = length(Args), case (erl_internal:comp_op(Name, NumArgs) orelse erl_internal:new_type_test(Name, NumArgs)) andalso - is_safe_simple_list(Args, Sub) of + is_safe_simple_list(Args) of true -> true; false -> %% Boolean operators are safe if all arguments are boolean. erl_internal:bool_op(Name, NumArgs) andalso - is_safe_bool_expr_list(Args, Sub, BoolVars) + is_safe_bool_expr_list(Args, BoolVars) end; -is_safe_bool_expr_1(#c_let{vars=Vars,arg=Arg,body=B}, Sub, BoolVars) -> - case is_safe_simple(Arg, Sub) of +is_safe_bool_expr_1(#c_let{vars=Vars,arg=Arg,body=B}, BoolVars) -> + case is_safe_simple(Arg) of true -> - case {is_safe_bool_expr_1(Arg, Sub, BoolVars),Vars} of + case {is_safe_bool_expr_1(Arg, BoolVars),Vars} of {true,[#c_var{name=V}]} -> - is_safe_bool_expr_1(B, Sub, cerl_sets:add_element(V, BoolVars)); + is_safe_bool_expr_1(B, cerl_sets:add_element(V, BoolVars)); {false,_} -> - is_safe_bool_expr_1(B, Sub, BoolVars) + is_safe_bool_expr_1(B, BoolVars) end; false -> false end; -is_safe_bool_expr_1(#c_literal{val=Val}, _Sub, _) -> +is_safe_bool_expr_1(#c_literal{val=Val}, _BoolVars) -> is_boolean(Val); -is_safe_bool_expr_1(#c_var{name=V}, _Sub, BoolVars) -> +is_safe_bool_expr_1(#c_var{name=V}, BoolVars) -> cerl_sets:is_element(V, BoolVars); -is_safe_bool_expr_1(_, _, _) -> false. +is_safe_bool_expr_1(_, _) -> false. -is_safe_bool_expr_list([C|Cs], Sub, BoolVars) -> - case is_safe_bool_expr_1(C, Sub, BoolVars) of - true -> is_safe_bool_expr_list(Cs, Sub, BoolVars); +is_safe_bool_expr_list([C|Cs], BoolVars) -> + case is_safe_bool_expr_1(C, BoolVars) of + true -> is_safe_bool_expr_list(Cs, BoolVars); false -> false end; -is_safe_bool_expr_list([], _, _) -> true. +is_safe_bool_expr_list([], _) -> true. %% simplify_let(Let, Sub) -> Expr | impossible %% If the argument part of an let contains a complex expression, such @@ -2705,19 +2520,6 @@ delay_build_expr_1(#c_case{clauses=Cs0}=Case, TypeSig) -> delay_build_expr_1(#c_let{body=B0}=Let, TypeSig) -> B = delay_build_expr(B0, TypeSig), Let#c_let{body=B}; -delay_build_expr_1(#c_receive{clauses=Cs0, - timeout=Timeout, - action=A0}=Rec, TypeSig) -> - Cs = delay_build_cs(Cs0, TypeSig), - A = case {Timeout,A0} of - {#c_literal{val=infinity},#c_literal{}} -> - {_Type,Arity} = TypeSig, - Es = lists:duplicate(Arity, A0), - core_lib:make_values(Es); - _ -> - delay_build_expr(A0, TypeSig) - end, - Rec#c_receive{clauses=Cs,action=A}; delay_build_expr_1(#c_seq{body=B0}=Seq, TypeSig) -> B = delay_build_expr(B0, TypeSig), Seq#c_seq{body=B}; @@ -2770,32 +2572,24 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Sub) -> {[],#c_values{es=[]},_} -> %% No variables left. Body; - {[#c_var{name=V}=Var|Vars]=Vars0,Arg1,Body} -> + {[#c_var{name=V}=Var]=Vars0,Arg1,Body} -> case core_lib:is_var_used(V, Body) of - false when Vars =:= [] -> + false -> %% If the variable is not used in the body, we can %% rewrite the let to a sequence: %% let <Var> = Arg in BodyWithoutVar ==> %% seq Arg BodyWithoutVar Arg = maybe_suppress_warnings(Arg1, Var, PrevBody), #c_seq{arg=Arg,body=Body}; - false -> - %% There are multiple values returned by the argument - %% and the first value is not used (this is a 'case' - %% with exported variables, but the return value is - %% ignored). We can remove the first variable and the - %% the first value returned from the 'let' argument. - Arg2 = remove_first_value(Arg1, Sub), - Let1 = Let0#c_let{vars=Vars,arg=Arg2,body=Body}, - post_opt_let(Let1, Sub); true -> Let1 = Let0#c_let{vars=Vars0,arg=Arg1,body=Body}, post_opt_let(Let1, Sub) end; - {[],Arg,Body} -> + {_,_,_} -> %% The argument for a sequence must be a single value (not %% #c_values{}). Therefore, we must keep the let. - post_opt_let(#c_let{vars=[],arg=Arg,body=Body}, Sub) + Let1 = Let0#c_let{vars=Vs0,arg=Arg0,body=Body}, + post_opt_let(Let1, Sub) end. %% post_opt_let(Let, Sub) @@ -2808,39 +2602,6 @@ post_opt_let(Let0, Sub) -> Let1 = opt_bool_case_in_let(Let0, Sub), opt_build_stacktrace(Let1). - -%% remove_first_value(Core0, Sub) -> Core. -%% Core0 is an expression that returns at least two values. -%% Remove the first value returned from Core0. - -remove_first_value(#c_values{es=[V|Vs]}, Sub) -> - Values = core_lib:make_values(Vs), - case is_safe_simple(V, Sub) of - false -> - #c_seq{arg=V,body=Values}; - true -> - Values - end; -remove_first_value(#c_case{clauses=Cs0}=Core, Sub) -> - Cs = remove_first_value_cs(Cs0, Sub), - Core#c_case{clauses=Cs}; -remove_first_value(#c_receive{clauses=Cs0,action=Act0}=Core, Sub) -> - Cs = remove_first_value_cs(Cs0, Sub), - Act = remove_first_value(Act0, Sub), - Core#c_receive{clauses=Cs,action=Act}; -remove_first_value(#c_let{body=B}=Core, Sub) -> - Core#c_let{body=remove_first_value(B, Sub)}; -remove_first_value(#c_seq{body=B}=Core, Sub) -> - Core#c_seq{body=remove_first_value(B, Sub)}; -remove_first_value(#c_primop{}=Core, _Sub) -> - Core; -remove_first_value(#c_call{}=Core, _Sub) -> - Core. - -remove_first_value_cs(Cs, Sub) -> - [C#c_clause{body=remove_first_value(B, Sub)} || - #c_clause{body=B}=C <- Cs]. - %% maybe_suppress_warnings(Arg, #c_var{}, PreviousBody) -> Arg' %% Try to suppress false warnings when a variable is not used. %% For instance, we don't expect a warning for useless building in: @@ -2966,54 +2727,6 @@ move_case_into_arg(Expr, _) -> Expr. %%% -%%% Retrieving information about types. -%%% - --spec get_type(cerl:cerl(), #sub{}) -> type_info() | 'none'. - -get_type(#c_var{name=V}, #sub{t=Tdb}) -> - case Tdb of - #{V:=Type} -> Type; - _ -> none - end; -get_type(C, _) -> - case cerl:type(C) of - binary -> C; - map -> C; - _ -> - case cerl:is_data(C) of - true -> C; - false -> none - end - end. - --spec is_boolean_type(cerl:cerl(), sub()) -> yes_no_maybe(). - -is_boolean_type(Var, Sub) -> - case get_type(Var, Sub) of - none -> - maybe; - bool -> - yes; - C -> - B = cerl:is_c_atom(C) andalso - is_boolean(cerl:atom_val(C)), - yes_no(B) - end. - --spec is_int_type(cerl:cerl(), sub()) -> yes_no_maybe(). - -is_int_type(Var, Sub) -> - case get_type(Var, Sub) of - none -> maybe; - integer -> yes; - C -> yes_no(cerl:is_c_int(C)) - end. - -yes_no(true) -> yes; -yes_no(false) -> no. - -%%% %%% Update type information. %%% @@ -3024,70 +2737,14 @@ update_let_types(_Vs, _Arg, Sub) -> %% that returns multiple values. Sub. -update_let_types_1([#c_var{}=V|Vs], [A|As], Sub0) -> - Sub = update_types_from_expr(V, A, Sub0), +update_let_types_1([#c_var{name=V}|Vs], [A|As], Sub0) -> + Sub = update_types(V, A, Sub0), update_let_types_1(Vs, As, Sub); update_let_types_1([], [], Sub) -> Sub. -update_types_from_expr(V, Expr, Sub) -> - Type = extract_type(Expr, Sub), - update_types(V, [Type], Sub). - -extract_type(#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=Name}, - args=Args}=Call, Sub) -> - case returns_integer(Name, Args) of - true -> integer; - false -> extract_type_1(Call, Sub) - end; -extract_type(Expr, Sub) -> - extract_type_1(Expr, Sub). - -extract_type_1(Expr, Sub) -> - case is_bool_expr(Expr, Sub) of - false -> Expr; - true -> bool - end. - -returns_integer('band', [_,_]) -> true; -returns_integer('bnot', [_]) -> true; -returns_integer('bor', [_,_]) -> true; -returns_integer('bxor', [_,_]) -> true; -returns_integer(bit_size, [_]) -> true; -returns_integer('bsl', [_,_]) -> true; -returns_integer('bsr', [_,_]) -> true; -returns_integer(byte_size, [_]) -> true; -returns_integer(ceil, [_]) -> true; -returns_integer('div', [_,_]) -> true; -returns_integer(floor, [_]) -> true; -returns_integer(length, [_]) -> true; -returns_integer('rem', [_,_]) -> true; -returns_integer('round', [_]) -> true; -returns_integer(size, [_]) -> true; -returns_integer(tuple_size, [_]) -> true; -returns_integer(trunc, [_]) -> true; -returns_integer(_, _) -> false. - -%% update_types(Expr, Pattern, Sub) -> Sub' -%% Update the type database. - --spec update_types(cerl:c_var(), [type_info()], sub()) -> sub(). - -update_types(#c_var{name=V}, Pat, #sub{t=Tdb0}=Sub) -> - Tdb = update_types_1(V, Pat, Tdb0), - Sub#sub{t=Tdb}. - -update_types_1(V, [#c_tuple{}=P], Types) -> - Types#{V=>P}; -update_types_1(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) -> - Types#{V=>bool}; -update_types_1(V, [#c_fun{vars=Vars}], Types) -> - Types#{V=>{'fun',length(Vars)}}; -update_types_1(V, [#c_var{name={_,Arity}}], Types) -> - Types#{V=>{'fun',Arity}}; -update_types_1(V, [Type], Types) when is_atom(Type) -> - Types#{V=>Type}; -update_types_1(_, _, Types) -> Types. +update_types(V, #c_tuple{}=P, #sub{t=Tdb}=Sub) -> + Sub#sub{t=Tdb#{V=>P}}; +update_types(_, _, Sub) -> Sub. %% kill_types(V, Tdb) -> Tdb' %% Kill any entries that references the variable, @@ -3103,10 +2760,6 @@ kill_types2(V, [{_,#c_tuple{}=Tuple}=Entry|Tdb]) -> false -> [Entry|kill_types2(V, Tdb)]; true -> kill_types2(V, Tdb) end; -kill_types2(V, [{_, {'fun',_}}=Entry|Tdb]) -> - [Entry|kill_types2(V, Tdb)]; -kill_types2(V, [{_,Atom}=Entry|Tdb]) when is_atom(Atom) -> - [Entry|kill_types2(V, Tdb)]; kill_types2(_, []) -> []. %% copy_type(DestVar, SrcVar, Tdb) -> Tdb' @@ -3198,6 +2851,13 @@ format_error({embedded_unit,Unit,Size}) -> format_error(bad_unicode) -> "binary construction will fail with a 'badarg' exception " "(invalid Unicode code point in a utf8/utf16/utf32 segment)"; +format_error(bad_float_size) -> + "binary construction will fail with a 'badarg' exception " + "(invalid size for a float segment)"; +format_error({nomatch_shadow,Line,{Name, Arity}}) -> + M = io_lib:format("this clause for ~ts/~B cannot match because a previous " + "clause at line ~p always matches", [Name, Arity, Line]), + flatten(M); format_error({nomatch_shadow,Line}) -> M = io_lib:format("this clause cannot match because a previous clause at line ~p " "always matches", [Line]), diff --git a/lib/compiler/src/sys_core_fold_lists.erl b/lib/compiler/src/sys_core_fold_lists.erl index e93b435011..ab5fcb3da4 100644 --- a/lib/compiler/src/sys_core_fold_lists.erl +++ b/lib/compiler/src/sys_core_fold_lists.erl @@ -56,9 +56,8 @@ call(#c_call{anno=Anno}, lists, all, [Arg1,Arg2]) -> name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, body=#c_literal{val=true}}, - Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^all',1}}|Anno], Err2)}, + body=function_clause(Anno, [F, Xs])}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -90,9 +89,8 @@ call(#c_call{anno=Anno}, lists, any, [Arg1,Arg2]) -> name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, body=#c_literal{val=false}}, - Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^any',1}}|Anno], Err2)}, + body=function_clause(Anno, [F, Xs])}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -113,9 +111,8 @@ call(#c_call{anno=Anno}, lists, foreach, [Arg1,Arg2]) -> name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, body=#c_literal{val=ok}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^foreach',1}}|Anno], Err)}, + body=function_clause(Anno, [F, Xs])}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -143,9 +140,8 @@ call(#c_call{anno=Anno}, lists, map, [Arg1,Arg2]) -> name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, body=#c_literal{val=[]}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^map',1}}|Anno], Err)}, + body=function_clause(Anno, [F, Xs])}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -174,9 +170,8 @@ call(#c_call{anno=Anno}, lists, flatmap, [Arg1,Arg2]) -> name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, body=#c_literal{val=[]}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^flatmap',1}}|Anno], Err)}, + body=function_clause(Anno, [F, Xs])}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -213,10 +208,9 @@ call(#c_call{anno=Anno}, lists, filter, [Arg1,Arg2]) -> name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, body=#c_literal{val=[]}}, - Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^filter',1}}|Anno], Err2)}, + body=function_clause(Anno, [F, Xs])}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -241,9 +235,8 @@ call(#c_call{anno=Anno}, lists, foldl, [Arg1,Arg2,Arg3]) -> name=#c_literal{val=is_function}, args=[F, #c_literal{val=2}]}, body=A}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]}, C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^foldl',2}}|Anno], Err)}, + body=function_clause(Anno, [F, A, Xs])}, Fun = #c_fun{vars=[Xs, A], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -268,9 +261,8 @@ call(#c_call{anno=Anno}, lists, foldr, [Arg1,Arg2,Arg3]) -> name=#c_literal{val=is_function}, args=[F, #c_literal{val=2}]}, body=A}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]}, C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^foldr',2}}|Anno], Err)}, + body=function_clause(Anno, [F, A, Xs])}, Fun = #c_fun{vars=[Xs, A], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -321,9 +313,8 @@ call(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3]) -> es=[#c_literal{val=[]}, Avar]}}, %%% Multiple-value version %%% body=#c_values{es=[#c_literal{val=[]}, A]}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]}, C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^mapfoldl',2}}|Anno], Err)}, + body=function_clause(Anno, [F, Avar, Xs])}, Fun = #c_fun{vars=[Xs, Avar], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -382,9 +373,8 @@ call(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3]) -> es=[#c_literal{val=[]}, Avar]}}, %%% Multiple-value version %%% body=#c_values{es=[#c_literal{val=[]}, A]}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]}, C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^mapfoldr',2}}|Anno], Err)}, + body=function_clause(Anno, [F, Avar, Xs])}, Fun = #c_fun{vars=[Xs, Avar], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -406,3 +396,9 @@ match_fail(Ann, Arg) -> Name = cerl:abstract(match_fail), Args = [Arg], cerl:ann_c_primop(Ann, Name, Args). + +function_clause(Anno, Args) -> + #c_call{anno=Anno, + module=#c_literal{val=erlang}, + name=#c_literal{val=error}, + args=[#c_literal{val=function_clause},cerl:ann_make_list(Anno, Args)]}. diff --git a/lib/compiler/src/sys_core_inline.erl b/lib/compiler/src/sys_core_inline.erl index 3380e3f1bd..f8d26d1c5d 100644 --- a/lib/compiler/src/sys_core_inline.erl +++ b/lib/compiler/src/sys_core_inline.erl @@ -44,7 +44,7 @@ -export([module/2]). --import(lists, [member/2,map/2,foldl/3,mapfoldl/3,keydelete/3]). +-import(lists, [member/2,map/2,foldl/3,mapfoldl/3]). -include("core_parse.hrl"). @@ -116,14 +116,11 @@ inline(Fs0, St0) -> false -> {Fst,Ifs} end end, [], Fs1), - Is1 = map(fun (#ifun{body=B}=If) -> - If#ifun{body=cerl_trees:map(match_fail_fun(), B)} - end, Is0), - Is2 = [inline_inline(If, Is1) || If <- Is1], + Is1 = [inline_inline(If, Is0) || If <- Is0], %% We would like to remove inlined, non-exported functions here, %% but this can be difficult as they may be recursive. %% Use fixed inline functions on all functions. - Fs = [inline_func(F, Is2) || F <- Fs2], + Fs = [inline_func(F, Is1) || F <- Fs2], %% Regenerate module body. [Def || #fstat{def=Def} <- Fs]. @@ -172,17 +169,6 @@ inline_func(#fstat{def={Name,F0}}=Fstat, Is) -> weight_func(_Core, Acc) -> Acc + 1. -%% match_fail_fun() -> fun/1. -%% Return a function to use with map to fix inlineable functions -%% function_clause match_fail (if they have one). - -match_fail_fun() -> - fun (#c_primop{anno=Anno0,name=#c_literal{val=match_fail}}=P) -> - Anno = keydelete(function_name, 1, Anno0), - P#c_primop{anno=Anno}; - (Other) -> Other - end. - %% find_inl(Func, Arity, [Inline]) -> #ifun{} | no. find_inl(F, A, [#ifun{func=F,arity=A}=If|_]) -> If; diff --git a/lib/compiler/src/sys_core_prepare.erl b/lib/compiler/src/sys_core_prepare.erl new file mode 100644 index 0000000000..5d9954e04f --- /dev/null +++ b/lib/compiler/src/sys_core_prepare.erl @@ -0,0 +1,130 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. 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% +%% +%% Purpose: Prepare Core Erlang not generated by v3_core. + +-module(sys_core_prepare). +-export([module/2]). + +-include("core_parse.hrl"). + +-spec module(cerl:c_module(), [compile:option()]) -> + {'ok',cerl:c_module(),[]}. + +module(Mod0, _Opts) -> + Count = cerl_trees:next_free_variable_name(Mod0), + {Mod,_} = cerl_trees:mapfold(fun rewrite_recv/2, Count, Mod0), + {ok,Mod,[]}. + +rewrite_recv(#c_receive{clauses=[],timeout=Timeout0,action=Action}, Count0) -> + %% Lower a receive with only an after blcok to its primitive operations. + False = #c_literal{val=false}, + True = #c_literal{val=true}, + + {TimeoutVal,Count1} = new_var(Count0), + {LoopName,Count2} = new_func_varname(Count1), + LoopFun = #c_var{name={LoopName,0}}, + ApplyLoop = #c_apply{op=LoopFun,args=[]}, + + TimeoutCs = [#c_clause{pats=[True],guard=True, + body=#c_seq{arg=primop(timeout), + body=Action}}, + #c_clause{pats=[False],guard=True, + body=ApplyLoop}], + {TimeoutBool,Count4} = new_var(Count2), + TimeoutCase = #c_case{arg=TimeoutBool,clauses=TimeoutCs}, + TimeoutLet = #c_let{vars=[TimeoutBool], + arg=primop(recv_wait_timeout, [TimeoutVal]), + body=TimeoutCase}, + + Fun = #c_fun{vars=[],body=TimeoutLet}, + + Letrec = #c_letrec{anno=[letrec_goto], + defs=[{LoopFun,Fun}], + body=ApplyLoop}, + + OuterLet = #c_let{vars=[TimeoutVal],arg=Timeout0,body=Letrec}, + {OuterLet,Count4}; +rewrite_recv(#c_receive{clauses=Cs0,timeout=Timeout0,action=Action}, Count0) -> + %% Lower receive to its primitive operations. + False = #c_literal{val=false}, + True = #c_literal{val=true}, + + {TimeoutVal,Count1} = new_var(Count0), + {LoopName,Count2} = new_func_varname(Count1), + LoopFun = #c_var{name={LoopName,0}}, + ApplyLoop = #c_apply{op=LoopFun,args=[]}, + + Cs1 = rewrite_cs(Cs0), + RecvNext = #c_seq{arg=primop(recv_next), + body=ApplyLoop}, + RecvNextC = #c_clause{anno=[compiler_generated], + pats=[#c_var{name='Other'}],guard=True,body=RecvNext}, + Cs = Cs1 ++ [RecvNextC], + {Msg,Count3} = new_var(Count2), + MsgCase = #c_case{arg=Msg,clauses=Cs}, + + TimeoutCs = [#c_clause{pats=[True],guard=True, + body=#c_seq{arg=primop(timeout), + body=Action}}, + #c_clause{pats=[False],guard=True, + body=ApplyLoop}], + {TimeoutBool,Count4} = new_var(Count3), + TimeoutCase = #c_case{arg=TimeoutBool,clauses=TimeoutCs}, + TimeoutLet = #c_let{vars=[TimeoutBool], + arg=primop(recv_wait_timeout, [TimeoutVal]), + body=TimeoutCase}, + + {PeekSucceeded,Count5} = new_var(Count4), + PeekCs = [#c_clause{pats=[True],guard=True, + body=MsgCase}, + #c_clause{pats=[False],guard=True, + body=TimeoutLet}], + PeekCase = #c_case{arg=PeekSucceeded,clauses=PeekCs}, + PeekLet = #c_let{vars=[PeekSucceeded,Msg], + arg=primop(recv_peek_message), + body=PeekCase}, + Fun = #c_fun{vars=[],body=PeekLet}, + + Letrec = #c_letrec{anno=[letrec_goto], + defs=[{LoopFun,Fun}], + body=ApplyLoop}, + + OuterLet = #c_let{vars=[TimeoutVal],arg=Timeout0,body=Letrec}, + {OuterLet,Count5}; +rewrite_recv(Tree, Count) -> + {Tree,Count}. + +rewrite_cs([#c_clause{body=B0}=C|Cs]) -> + B = #c_seq{arg=primop(remove_message),body=B0}, + [C#c_clause{body=B}|rewrite_cs(Cs)]; +rewrite_cs([]) -> []. + +primop(Name) -> + primop(Name, []). + +primop(Name, Args) -> + #c_primop{name=#c_literal{val=Name},args=Args}. + +new_var(Count) -> + {#c_var{name=Count},Count+1}. + +new_func_varname(Count) -> + Name = list_to_atom("@pre" ++ integer_to_list(Count)), + {Name,Count+1}. diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 007a0247f4..0efc8f7821 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -22,7 +22,7 @@ %% At this stage all preprocessing has been done. All that is left are %% "pure" Erlang functions. %% -%% Core transformation is done in three stages: +%% Core transformation is done in four stages: %% %% 1. Flatten expressions into an internal core form without doing %% matching. @@ -37,6 +37,12 @@ %% annotations to change implicit exported variables to explicit %% returns. %% +%% 4. Lower receives to more primitive operations. Split binary +%% patterns where a value is matched out and then used used as +%% a size in the same pattern. That simplifies the subsequent +%% passes as all variables are within a single pattern are either +%% new or used, but never both at the same time. +%% %% To ensure the evaluation order we ensure that all arguments are %% safe. A "safe" is basically a core_lib simple with VERY restricted %% binaries. @@ -91,13 +97,16 @@ -record(iapply, {anno=#a{},op,args}). -record(ibinary, {anno=#a{},segments}). %Not used in patterns. +-record(ibitstr, {anno=#a{},val,size,unit,type,flags}). -record(icall, {anno=#a{},module,name,args}). -record(icase, {anno=#a{},args,clauses,fc}). -record(icatch, {anno=#a{},body}). --record(iclause, {anno=#a{},pats,pguard=[],guard,body}). +-record(iclause, {anno=#a{},pats,guard,body}). -record(ifun, {anno=#a{},id,vars,clauses,fc,name=unnamed}). -record(iletrec, {anno=#a{},defs,body}). -record(imatch, {anno=#a{},pat,guard=[],arg,fc}). +-record(imap, {anno=#a{},arg=#c_literal{val=#{}},es,is_pat=false}). +-record(imappair, {anno=#a{},op,key,val}). -record(iprimop, {anno=#a{},name,args}). -record(iprotect, {anno=#a{},body}). -record(ireceive1, {anno=#a{},clauses}). @@ -105,7 +114,7 @@ -record(iset, {anno=#a{},var,arg}). -record(itry, {anno=#a{},args,vars,body,evars,handler}). -record(ifilter, {anno=#a{},arg}). --record(igen, {anno=#a{},ceps=[],acc_pat,acc_guard, +-record(igen, {anno=#a{},acc_pat,acc_guard, skip_pat,tail,tail_pat,arg}). -record(isimple, {anno=#a{},term :: cerl:cerl()}). @@ -118,6 +127,7 @@ -type ifun() :: #ifun{}. -type iletrec() :: #iletrec{}. -type imatch() :: #imatch{}. +-type imap() :: #imap{}. -type iprimop() :: #iprimop{}. -type iprotect() :: #iprotect{}. -type ireceive1() :: #ireceive1{}. @@ -128,19 +138,22 @@ -type igen() :: #igen{}. -type isimple() :: #isimple{}. --type i() :: iapply() | ibinary() | icall() | icase() | icatch() - | iclause() | ifun() | iletrec() | imatch() | iprimop() - | iprotect() | ireceive1() | ireceive2() | iset() | itry() - | ifilter() | igen() | isimple(). +-type i() :: iapply() | ibinary() | icall() | icase() | icatch() + | iclause() | ifun() | iletrec() | imatch() | imap() + | iprimop() | iprotect() | ireceive1() | ireceive2() + | iset() | itry() | ifilter() + | igen() | isimple(). -type warning() :: {file:filename(), [{integer(), module(), term()}]}. -record(core, {vcount=0 :: non_neg_integer(), %Variable counter fcount=0 :: non_neg_integer(), %Function counter + gcount=0 :: non_neg_integer(), %Goto counter function={none,0} :: fa(), %Current function. in_guard=false :: boolean(), %In guard or not. wanted=true :: boolean(), %Result wanted or not. - opts :: [compile:option()], %Options. + opts=[] :: [compile:option()], %Options. + dialyzer=false :: boolean(), %Help dialyzer or not. ws=[] :: [warning()], %Warnings. file=[{file,""}] %File. }). @@ -216,69 +229,61 @@ defined_functions(Forms) -> %% ok. function({function,_,Name,Arity,Cs0}, Ws0, File, Opts) -> - St0 = #core{vcount=0,function={Name,Arity},opts=Opts, - ws=Ws0,file=[{file,File}]}, - {B0,St1} = body(Cs0, Name, Arity, St0), - %% ok = function_dump(Name,Arity,"body:~n~p~n",[B0]), - {B1,St2} = ubody(B0, St1), - %% ok = function_dump(Name,Arity,"ubody:~n~p~n",[B1]), - {B2,#core{ws=Ws}} = cbody(B1, St2), - %% ok = function_dump(Name,Arity,"cbody:~n~p~n",[B2]), - {{#c_var{name={Name,Arity}},B2},Ws}. + try + St0 = #core{vcount=0,function={Name,Arity},opts=Opts, + dialyzer=member(dialyzer, Opts), + ws=Ws0,file=[{file,File}]}, + {B0,St1} = body(Cs0, Name, Arity, St0), + %% ok = function_dump(Name, Arity, "body:~n~p~n",[B0]), + {B1,St2} = ubody(B0, St1), + %% ok = function_dump(Name, Arity, "ubody:~n~p~n",[B1]), + {B2,St3} = cbody(B1, St2), + %% ok = function_dump(Name, Arity, "cbody:~n~p~n",[B2]), + {B3,#core{ws=Ws}} = lbody(B2, St3), + %% ok = function_dump(Name, Arity, "lbody:~n~p~n",[B3]), + {{#c_var{name={Name,Arity}},B3},Ws} + catch + Class:Error:Stack -> + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. body(Cs0, Name, Arity, St0) -> Anno = lineno_anno(element(2, hd(Cs0)), St0), + FunAnno = [{function,{Name,Arity}} | Anno], {Args0,St1} = new_vars(Anno, Arity, St0), Args = reverse(Args0), %Nicer order - case clauses(Cs0, St1) of - {Cs1,[],St2} -> - {Ps,St3} = new_vars(Arity, St2), %Need new variables here - Fc = function_clause(Ps, Anno, {Name,Arity}), - {#ifun{anno=#a{anno=Anno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3}; - {Cs1,Eps,St2} -> - %% We have pre-expressions from patterns and - %% these needs to be letified before matching - %% since only bound variables are allowed - AnnoGen = #a{anno=[compiler_generated]}, - {Ps1,St3} = new_vars(Arity, St2), %Need new variables here - Fc1 = function_clause(Ps1, Anno, {Name,Arity}), - {Ps2,St4} = new_vars(Arity, St3), %Need new variables here - Fc2 = function_clause(Ps2, Anno, {Name,Arity}), - Case = #icase{anno=AnnoGen,args=Args, - clauses=Cs1, - fc=Fc2}, - {#ifun{anno=#a{anno=Anno},id=[],vars=Args, - clauses=[#iclause{anno=AnnoGen,pats=Ps1, - guard=[#c_literal{val=true}], - body=Eps ++ [Case]}], - fc=Fc1},St4} - end. + {Cs1,St2} = clauses(Cs0, St1), + {Ps,St3} = new_vars(Arity, St2), %Need new variables here + Fc = function_clause(Ps, Anno), + {#ifun{anno=#a{anno=FunAnno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3}. %% clause(Clause, State) -> {Cclause,State} | noclause. %% clauses([Clause], State) -> {[Cclause],State}. %% Convert clauses. Trap bad pattern aliases and remove clause from %% clause list. -clauses([C0|Cs0],St0) -> +clauses([C0|Cs0], St0) -> case clause(C0, St0) of - {noclause,_,St} -> clauses(Cs0,St); - {C,Eps1,St1} -> - {Cs,Eps2,St2} = clauses(Cs0, St1), - {[C|Cs],Eps1++Eps2,St2} + {noclause,St} -> + clauses(Cs0, St); + {C,St1} -> + {Cs,St2} = clauses(Cs0, St1), + {[C|Cs],St2} end; -clauses([],St) -> {[],[],St}. +clauses([], St) -> {[],St}. clause({clause,Lc,H0,G0,B0}, St0) -> try head(H0, St0) of - {H1,Eps,St1} -> + {H1,St1} -> {G1,St2} = guard(G0, St1), {B1,St3} = exprs(B0, St2), Anno = lineno_anno(Lc, St3), - {#iclause{anno=#a{anno=Anno},pats=H1,guard=G1,body=B1},Eps,St3} + {#iclause{anno=#a{anno=Anno},pats=H1,guard=G1,body=B1},St3} catch throw:nomatch -> St = add_warning(Lc, nomatch, St0), - {noclause,[],St} %Bad pattern + {noclause,St} %Bad pattern end. clause_arity({clause,_,H0,_,_}) -> length(H0). @@ -419,9 +424,21 @@ gexpr_test(E0, Bools0, St0) -> {E1,Eps0,St1} = expr(E0, St0), %% Generate "top-level" test and argument calls. case E1 of + #icall{anno=Anno,module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[_,_]} -> + %% is_function/2 is not a safe type test. We must force + %% it to be protected. + Lanno = Anno#a.anno, + {New,St2} = new_var(Lanno, St1), + {icall_eq_true(New), + Eps0 ++ [#iset{anno=Anno,var=New,arg=E1}],Bools0,St2}; #icall{anno=Anno,module=#c_literal{val=erlang},name=#c_literal{val=N},args=As} -> + %% Note that erl_expand_records has renamed type + %% tests to the new names; thus, float/1 as a type + %% test will now be named is_float/1. Ar = length(As), - case erl_internal:type_test(N, Ar) orelse + case erl_internal:new_type_test(N, Ar) orelse erl_internal:comp_op(N, Ar) orelse erl_internal:bool_op(N, Ar) of true -> {E1,Eps0,Bools0,St1}; @@ -586,14 +603,14 @@ expr({bin,L,Es0}, St0) -> try expr_bin(Es0, full_anno(L, St0), St0) of {_,_,_}=Res -> Res catch - throw:bad_binary -> - St = add_warning(L, bad_binary, St0), + throw:{bad_binary,Eps,St1} -> + St = add_warning(L, bad_binary, St1), LineAnno = lineno_anno(L, St), As = [#c_literal{anno=LineAnno,val=badarg}], {#icall{anno=#a{anno=LineAnno}, %Must have an #a{} module=#c_literal{anno=LineAnno,val=erlang}, name=#c_literal{anno=LineAnno,val=error}, - args=As},[],St} + args=As},Eps,St} end; expr({block,_,Es0}, St0) -> %% Inline the block directly. @@ -601,26 +618,26 @@ expr({block,_,Es0}, St0) -> {E1,Eps,St2} = expr(last(Es0), St1), {E1,Es1 ++ Eps,St2}; expr({'if',L,Cs0}, St0) -> - {Cs1,Ceps,St1} = clauses(Cs0, St0), + {Cs1,St1} = clauses(Cs0, St0), Lanno = lineno_anno(L, St1), Fc = fail_clause([], Lanno, #c_literal{val=if_clause}), - {#icase{anno=#a{anno=Lanno},args=[],clauses=Cs1,fc=Fc},Ceps,St1}; + {#icase{anno=#a{anno=Lanno},args=[],clauses=Cs1,fc=Fc},[],St1}; expr({'case',L,E0,Cs0}, St0) -> {E1,Eps,St1} = novars(E0, St0), - {Cs1,Ceps,St2} = clauses(Cs0, St1), + {Cs1,St2} = clauses(Cs0, St1), {Fpat,St3} = new_var(St2), Lanno = lineno_anno(L, St2), Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=case_clause},Fpat])), - {#icase{anno=#a{anno=Lanno},args=[E1],clauses=Cs1,fc=Fc},Eps++Ceps,St3}; + {#icase{anno=#a{anno=Lanno},args=[E1],clauses=Cs1,fc=Fc},Eps,St3}; expr({'receive',L,Cs0}, St0) -> - {Cs1,Ceps,St1} = clauses(Cs0, St0), - {#ireceive1{anno=#a{anno=lineno_anno(L, St1)},clauses=Cs1},Ceps, St1}; + {Cs1,St1} = clauses(Cs0, St0), + {#ireceive1{anno=#a{anno=lineno_anno(L, St1)},clauses=Cs1},[],St1}; expr({'receive',L,Cs0,Te0,Tes0}, St0) -> {Te1,Teps,St1} = novars(Te0, St0), {Tes1,St2} = exprs(Tes0, St1), - {Cs1,Ceps,St3} = clauses(Cs0, St2), + {Cs1,St3} = clauses(Cs0, St2), {#ireceive2{anno=#a{anno=lineno_anno(L, St3)}, - clauses=Cs1,timeout=Te1,action=Tes1},Teps++Ceps,St3}; + clauses=Cs1,timeout=Te1,action=Tes1},Teps,St3}; expr({'try',L,Es0,[],Ecs,[]}, St0) -> %% 'try ... catch ... end' {Es1,St1} = exprs(Es0, St0), @@ -634,7 +651,7 @@ expr({'try',L,Es0,Cs0,Ecs,[]}, St0) -> %% 'try ... of ... catch ... end' {Es1,St1} = exprs(Es0, St0), {V,St2} = new_var(St1), %This name should be arbitrary - {Cs1,Ceps,St3} = clauses(Cs0, St2), + {Cs1,St3} = clauses(Cs0, St2), {Fpat,St4} = new_var(St3), Lanno = lineno_anno(L, St4), Fc = fail_clause([Fpat], Lanno, @@ -643,7 +660,7 @@ expr({'try',L,Es0,Cs0,Ecs,[]}, St0) -> {#itry{anno=#a{anno=lineno_anno(L, St5)},args=Es1, vars=[V],body=[#icase{anno=#a{anno=Lanno},args=[V],clauses=Cs1,fc=Fc}], evars=Evs,handler=Hs}, - Ceps,St5}; + [],St5}; expr({'try',L,Es0,[],[],As0}, St0) -> %% 'try ... after ... end' {Es1,St1} = exprs(Es0, St0), @@ -652,7 +669,7 @@ expr({'try',L,Es0,[],[],As0}, St0) -> {V,St4} = new_var(St3), % (must not exist in As1) LA = lineno_anno(L, St4), Lanno = #a{anno=LA}, - Fc = function_clause([], LA, {Name,0}), + Fc = function_clause([], LA), Fun = #ifun{anno=Lanno,id=[],vars=[], clauses=[#iclause{anno=Lanno,pats=[], guard=[#c_literal{val=true}], @@ -699,7 +716,7 @@ expr({call,Lc,{atom,Lf,F},As0}, St0) -> Op = #c_var{anno=lineno_anno(Lf, St1),name={F,length(As1)}}, {#iapply{anno=#a{anno=lineno_anno(Lc, St1)},op=Op,args=As1},Aps,St1}; expr({call,L,FunExp,As0}, St0) -> - {Fun,Fps,St1} = safe_fun(length(As0), FunExp, St0), + {Fun,Fps,St1} = safe(FunExp, St0), {As1,Aps,St2} = safe_list(As0, St1), Lanno = lineno_anno(L, St2), {#iapply{anno=#a{anno=Lanno},op=Fun,args=As1},Fps ++ Aps,St2}; @@ -712,12 +729,12 @@ expr({match,L,P0,E0}, St0) -> end, {E2,Eps1,St2} = novars(E1, St1), St3 = St2#core{wanted=St0#core.wanted}, - {P2,Eps2,St4} = try - pattern(P1, St3) - catch - throw:Thrown -> - {Thrown,[],St3} - end, + {P2,St4} = try + pattern(P1, St3) + catch + throw:Thrown -> + {Thrown,St3} + end, {Fpat,St5} = new_var(St4), Lanno = lineno_anno(L, St5), Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=badmatch},Fpat])), @@ -746,15 +763,15 @@ expr({match,L,P0,E0}, St0) -> St6 = add_warning(L, nomatch, St5), {Expr,Eps3,St7} = safe(E1, St6), SanPat0 = sanitize(P1), - {SanPat,Eps4,St} = pattern(SanPat0, St7), + {SanPat,St} = pattern(SanPat0, St7), Badmatch = c_tuple([#c_literal{val=badmatch},Expr]), Fail = #iprimop{anno=#a{anno=Lanno}, name=#c_literal{val=match_fail}, args=[Badmatch]}, - Eps = Eps3 ++ Eps4 ++ [Fail], + Eps = Eps3 ++ [Fail], {#imatch{anno=#a{anno=Lanno},pat=SanPat,arg=Expr,fc=Fc},Eps,St}; Other when not is_atom(Other) -> - {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps1++Eps2,St5} + {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps1,St5} end; expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) -> %% Optimise '++' here because of the list comprehension algorithm. @@ -820,6 +837,8 @@ sanitize({tuple,L,Ps0}) -> sanitize({map,L,Ps0}) -> Ps = [sanitize(V) || {map_field_exact,_,_,V} <- Ps0], {tuple,L,Ps}; +sanitize({op,L,_Name,P1,P2}) -> + {tuple,L,[sanitize(P1),sanitize(P2)]}; sanitize(P) -> P. make_bool_switch(L, E, V, T, F, #core{in_guard=true}) -> @@ -924,7 +943,7 @@ is_valid_map_src(_) -> false. try_exception(Ecs0, St0) -> %% Note that Tag is not needed for rethrow - it is already in Info. {Evs,St1} = new_vars(3, St0), % Tag, Value, Info - {Ecs1,Ceps,St2} = clauses(Ecs0, St1), + {Ecs1,St2} = clauses(Ecs0, St1), Ecs2 = try_build_stacktrace(Ecs1, hd(Evs)), [_,Value,Info] = Evs, LA = case Ecs2 of @@ -937,7 +956,7 @@ try_exception(Ecs0, St0) -> name=#c_literal{val=raise}, args=[Info,Value]}]}, Hs = [#icase{anno=#a{anno=LA},args=[c_tuple(Evs)],clauses=Ecs2,fc=Ec}], - {Evs,Ceps++Hs,St2}. + {Evs,Hs,St2}. try_after(As, St0) -> %% See above. @@ -992,14 +1011,30 @@ bin_element({bin_element,Line,Expr,Size0,Type0}) -> make_bit_type(Line, default, Type0) -> case erl_bits:set_bit_type(default, Type0) of - {ok,all,Bt} -> {{atom,Line,all},erl_bits:as_list(Bt)}; + {ok,all,Bt} -> {make_all_size(Line),erl_bits:as_list(Bt)}; {ok,undefined,Bt} -> {{atom,Line,undefined},erl_bits:as_list(Bt)}; {ok,Size,Bt} -> {{integer,Line,Size},erl_bits:as_list(Bt)} end; +make_bit_type(_Line, {atom,Anno,all}=Size, Type0) -> + case erl_anno:generated(Anno) of + true -> + %% This `all` was created by the compiler from a binary + %% segment without a size. + {ok,Size,Bt} = erl_bits:set_bit_type(Size, Type0), + {Size,erl_bits:as_list(Bt)}; + false -> + %% This `all` was present in the source code. It is not + %% a valid size. + throw(nomatch) + end; make_bit_type(_Line, Size, Type0) -> %Integer or 'all' {ok,Size,Bt} = erl_bits:set_bit_type(Size, Type0), {Size,erl_bits:as_list(Bt)}. +make_all_size(Line) -> + Anno = erl_anno:set_generated(true, Line), + {atom,Anno,all}. + %% constant_bin([{bin_element,_,_,_,_}]) -> binary() | error %% If the binary construction is truly constant (no variables, %% no native fields), and does not contain fields whose expansion @@ -1112,8 +1147,9 @@ expr_bin_1(Es, St) -> end, {[],[],St}, Es). bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) -> - {E1,Eps,St1} = safe(E0, St0), - {Size1,Eps2,St2} = safe(Size0, St1), + {E1,Eps0,St1} = safe(E0, St0), + {Size1,Eps1,St2} = safe(Size0, St1), + Eps = Eps0 ++ Eps1, case {Type,E1} of {_,#c_var{}} -> ok; {integer,#c_literal{val=I}} when is_integer(I) -> ok; @@ -1123,41 +1159,43 @@ bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) -> {float,#c_literal{val=V}} when is_number(V) -> ok; {binary,#c_literal{val=V}} when is_bitstring(V) -> ok; {_,_} -> - throw(bad_binary) + %% Note that the pre expressions may bind variables that + %% are used later or have side effects. + throw({bad_binary,Eps,St2}) end, case Size1 of #c_var{} -> ok; #c_literal{val=Sz} when is_integer(Sz), Sz >= 0 -> ok; #c_literal{val=undefined} -> ok; #c_literal{val=all} -> ok; - _ -> throw(bad_binary) + _ -> throw({bad_binary,Eps,St2}) end, {#c_bitstr{val=E1,size=Size1, unit=#c_literal{val=Unit}, type=#c_literal{val=Type}, flags=#c_literal{val=Flags}}, - Eps ++ Eps2,St2}. + Eps,St2}. %% fun_tq(Id, [Clauses], Line, State, NameInfo) -> {Fun,[PreExp],State}. fun_tq(Cs0, L, St0, NameInfo) -> Arity = clause_arity(hd(Cs0)), - {Cs1,Ceps,St1} = clauses(Cs0, St0), + {Cs1,St1} = clauses(Cs0, St0), {Args,St2} = new_vars(Arity, St1), {Ps,St3} = new_vars(Arity, St2), %Need new variables here Anno = full_anno(L, St3), {Name,St4} = new_fun_name(St3), - Fc = function_clause(Ps, Anno, {Name,Arity}), + Fc = function_clause(Ps, Anno), Id = {0,0,Name}, Fun = #ifun{anno=#a{anno=Anno}, id=[{id,Id}], %We KNOW! vars=Args,clauses=Cs1,fc=Fc,name=NameInfo}, - {Fun,Ceps,St4}. + {Fun,[],St4}. %% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}. %% This TQ from Simon PJ pp 127-138. -lc_tq(Line, E, [#igen{anno=#a{anno=GA}=GAnno,ceps=Ceps, +lc_tq(Line, E, [#igen{anno=#a{anno=GA}=GAnno, acc_pat=AccPat,acc_guard=AccGuard, skip_pat=SkipPat,tail=Tail,tail_pat=TailPat, arg={Pre,Arg}}|Qs], Mc, St0) -> @@ -1167,7 +1205,7 @@ lc_tq(Line, E, [#igen{anno=#a{anno=GA}=GAnno,ceps=Ceps, F = #c_var{anno=LA,name={Name,1}}, Nc = #iapply{anno=GAnno,op=F,args=[Tail]}, {Var,St2} = new_var(St1), - Fc = function_clause([Var], GA, {Name,1}), + Fc = function_clause([Var], GA), TailClause = #iclause{anno=LAnno,pats=[TailPat],guard=[],body=[Mc]}, Cs0 = case {AccPat,AccGuard} of {SkipPat,[]} -> @@ -1193,7 +1231,7 @@ lc_tq(Line, E, [#igen{anno=#a{anno=GA}=GAnno,ceps=Ceps, Fun = #ifun{anno=GAnno,id=[],vars=[Var],clauses=Cs,fc=Fc}, {#iletrec{anno=GAnno#a{anno=[list_comprehension|GA]},defs=[{{Name,1},Fun}], body=Pre ++ [#iapply{anno=GAnno,op=F,args=[Arg]}]}, - Ceps,St4}; + [],St4}; lc_tq(Line, E, [#ifilter{}=Filter|Qs], Mc, St) -> filter_tq(Line, E, Filter, Mc, St, Qs, fun lc_tq/5); lc_tq(Line, E0, [], Mc0, St0) -> @@ -1218,7 +1256,7 @@ bc_tq(Line, Exp, Qs0, St0) -> args=[Sz]}}] ++ BcPre, {E,Pre,St}. -bc_tq1(Line, E, [#igen{anno=GAnno,ceps=Ceps, +bc_tq1(Line, E, [#igen{anno=GAnno, acc_pat=AccPat,acc_guard=AccGuard, skip_pat=SkipPat,tail=Tail,tail_pat=TailPat, arg={Pre,Arg}}|Qs], Mc, St0) -> @@ -1228,7 +1266,7 @@ bc_tq1(Line, E, [#igen{anno=GAnno,ceps=Ceps, {Vars=[_,AccVar],St2} = new_vars(LA, 2, St1), F = #c_var{anno=LA,name={Name,2}}, Nc = #iapply{anno=GAnno,op=F,args=[Tail,AccVar]}, - Fc = function_clause(Vars, LA, {Name,2}), + Fc = function_clause(Vars, LA), TailClause = #iclause{anno=LAnno,pats=[TailPat,AccVar],guard=[], body=[AccVar]}, Cs0 = case {AccPat,AccGuard} of @@ -1257,14 +1295,14 @@ bc_tq1(Line, E, [#igen{anno=GAnno,ceps=Ceps, Fun = #ifun{anno=LAnno,id=[],vars=Vars,clauses=Cs,fc=Fc}, {#iletrec{anno=LAnno#a{anno=[list_comprehension|LA]},defs=[{{Name,2},Fun}], body=Pre ++ [#iapply{anno=LAnno,op=F,args=[Arg,Mc]}]}, - Ceps,St4}; + [],St4}; bc_tq1(Line, E, [#ifilter{}=Filter|Qs], Mc, St) -> filter_tq(Line, E, Filter, Mc, St, Qs, fun bc_tq1/5); bc_tq1(_, {bin,Bl,Elements}, [], AccVar, St0) -> bc_tq_build(Bl, [], AccVar, Elements, St0); bc_tq1(Line, E0, [], AccVar, St0) -> BsFlags = [binary,{unit,1}], - BsSize = {atom,Line,all}, + BsSize = make_all_size(Line), {E1,Pre0,St1} = safe(E0, St0), case E1 of #c_var{name=VarName} -> @@ -1287,7 +1325,7 @@ bc_tq1(Line, E0, [], AccVar, St0) -> end. bc_tq_build(Line, Pre0, #c_var{name=AccVar}, Elements0, St0) -> - Elements = [{bin_element,Line,{var,Line,AccVar},{atom,Line,all}, + Elements = [{bin_element,Line,{var,Line,AccVar},make_all_size(Line), [binary,{unit,1}]}|Elements0], {E,Pre,St} = expr({bin,Line,Elements}, St0), #a{anno=A} = Anno0 = get_anno(E), @@ -1399,7 +1437,7 @@ get_qual_anno(Abstract) -> element(2, Abstract). generator(Line, {generate,Lg,P0,E}, Gs, St0) -> LA = lineno_anno(Line, St0), GA = lineno_anno(Lg, St0), - {Head,Ceps,St1} = list_gen_pattern(P0, Line, St0), + {Head,St1} = list_gen_pattern(P0, Line, St0), {[Tail,Skip],St2} = new_vars(2, St1), {Cg,St3} = lc_guard_tests(Gs, St2), {AccPat,SkipPat} = case Head of @@ -1419,44 +1457,55 @@ generator(Line, {generate,Lg,P0,E}, Gs, St0) -> ann_c_cons(LA, Skip, Tail)} end, {Ce,Pre,St4} = safe(E, St3), - Gen = #igen{anno=#a{anno=GA},ceps=Ceps, + Gen = #igen{anno=#a{anno=GA}, acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat, tail=Tail,tail_pat=#c_literal{anno=LA,val=[]},arg={Pre,Ce}}, {Gen,St4}; generator(Line, {b_generate,Lg,P,E}, Gs, St0) -> LA = lineno_anno(Line, St0), GA = lineno_anno(Lg, St0), - {Cp = #c_binary{segments=Segs},[],St1} = pattern(P, St0), - - %% The function append_tail_segment/2 keeps variable patterns as-is, making - %% it possible to have the same skip clause removal as with list generators. - {AccSegs,Tail,TailSeg,St2} = append_tail_segment(Segs, St1), - AccPat = Cp#c_binary{segments=AccSegs}, - {Cg,St3} = lc_guard_tests(Gs, St2), - {SkipSegs,St4} = emasculate_segments(AccSegs, St3), - SkipPat = Cp#c_binary{segments=SkipSegs}, - {Ce,Pre,St5} = safe(E, St4), - Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat, - tail=Tail,tail_pat=#c_binary{anno=LA,segments=[TailSeg]}, - arg={Pre,Ce}}, - {Gen,St5}. + try pattern(P, St0) of + {#ibinary{segments=Segs}=Cp,St1} -> + %% The function append_tail_segment/2 keeps variable + %% patterns as-is, making it possible to have the same + %% skip clause removal as with list generators. + {AccSegs,Tail,TailSeg,St2} = append_tail_segment(Segs, St1), + AccPat = Cp#ibinary{segments=AccSegs}, + {Cg,St3} = lc_guard_tests(Gs, St2), + {SkipSegs,St4} = emasculate_segments(AccSegs, St3), + SkipPat = Cp#ibinary{segments=SkipSegs}, + {Ce,Pre,St5} = safe(E, St4), + Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg, + skip_pat=SkipPat,tail=Tail, + tail_pat=#ibinary{anno=#a{anno=LA},segments=[TailSeg]}, + arg={Pre,Ce}}, + {Gen,St5} + catch + throw:nomatch -> + {Ce,Pre,St1} = safe(E, St0), + Gen = #igen{anno=#a{anno=GA},acc_pat=nomatch,acc_guard=[], + skip_pat=nomatch, + tail_pat=#c_var{name='_'}, + arg={Pre,Ce}}, + {Gen,St1} + end. append_tail_segment(Segs, St0) -> {Var,St} = new_var(St0), - Tail = #c_bitstr{val=Var,size=#c_literal{val=all}, - unit=#c_literal{val=1}, - type=#c_literal{val=binary}, - flags=#c_literal{val=[unsigned,big]}}, + Tail = #ibitstr{val=Var,size=[#c_literal{val=all}], + unit=#c_literal{val=1}, + type=#c_literal{val=binary}, + flags=#c_literal{val=[unsigned,big]}}, {Segs++[Tail],Var,Tail,St}. emasculate_segments(Segs, St) -> emasculate_segments(Segs, St, []). -emasculate_segments([#c_bitstr{val=#c_var{}}=B|Rest], St, Acc) -> +emasculate_segments([#ibitstr{val=#c_var{}}=B|Rest], St, Acc) -> emasculate_segments(Rest, St, [B|Acc]); emasculate_segments([B|Rest], St0, Acc) -> {Var,St1} = new_var(St0), - emasculate_segments(Rest, St1, [B#c_bitstr{val=Var}|Acc]); + emasculate_segments(Rest, St1, [B#ibitstr{val=Var}|Acc]); emasculate_segments([], St, Acc) -> {reverse(Acc),St}. @@ -1468,9 +1517,9 @@ lc_guard_tests(Gs0, St0) -> list_gen_pattern(P0, Line, St) -> try - pattern(P0,St) - catch - nomatch -> {nomatch,[],add_warning(Line, nomatch, St)} + pattern(P0, St) + catch + nomatch -> {nomatch,add_warning(Line, nomatch, St)} end. %%% @@ -1502,7 +1551,9 @@ bc_initial_size(E0, Q, St0) -> end catch throw:impossible -> - {#c_literal{val=256},[],St0} + {#c_literal{val=256},[],St0}; + throw:nomatch -> + {#c_literal{val=1},[],St0} end. bc_elem_size({bin,_,El}, St0) -> @@ -1737,18 +1788,6 @@ force_novars(#c_map{}=Bin, St) -> {Bin,[],St}; force_novars(Ce, St) -> force_safe(Ce, St). - -%% safe_pattern_expr(Expr, State) -> {Cexpr,[PreExpr],State}. -%% only literals and variables are safe expressions in patterns -safe_pattern_expr(E,St0) -> - case safe(E,St0) of - {#c_var{},_,_}=Safe -> Safe; - {#c_literal{},_,_}=Safe -> Safe; - {Ce,Eps,St1} -> - {V,St2} = new_var(St1), - {V,Eps++[#iset{var=V,arg=Ce}],St2} - end. - %% safe(Expr, State) -> {Safe,[PreExpr],State}. %% Generate an internal safe expression. These are simples without %% binaries which can fail. At this level we do not need to do a @@ -1759,15 +1798,6 @@ safe(E0, St0) -> {Se,Sps,St2} = force_safe(E1, St1), {Se,Eps ++ Sps,St2}. -safe_fun(A0, E0, St0) -> - case safe(E0, St0) of - {#c_var{name={_,A1}}=E1,Eps,St1} when A1 =/= A0 -> - {V,St2} = new_var(St1), - {V,Eps ++ [#iset{var=V,arg=E1}],St2}; - Result -> - Result - end. - safe_list(Es, St) -> foldr(fun (E, {Ces,Esp,St0}) -> {Ce,Ep,St1} = safe(E, St0), @@ -1825,44 +1855,33 @@ fold_match({match,L,P0,E0}, P) -> fold_match(E, P) -> {P,E}. %% pattern(Pattern, State) -> {CorePat,[PreExp],State}. -%% Transform a pattern by removing line numbers. We also normalise -%% aliases in patterns to standard form, {alias,Pat,[Var]}. -%% -%% In patterns we may have expressions -%% 1) Binaries -> #c_bitstr{size=Expr} -%% 2) Maps -> #c_map_pair{key=Expr} -%% -%% Both of these may generate pre-expressions since only bound variables -%% or literals are allowed for these in core patterns. -%% -%% Therefor, we need to drag both the state and the collection of pre-expression -%% around in the whole pattern transformation tree. - -pattern({var,L,V}, St) -> {#c_var{anno=lineno_anno(L, St),name=V},[],St}; -pattern({char,L,C}, St) -> {#c_literal{anno=lineno_anno(L, St),val=C},[],St}; -pattern({integer,L,I}, St) -> {#c_literal{anno=lineno_anno(L, St),val=I},[],St}; -pattern({float,L,F}, St) -> {#c_literal{anno=lineno_anno(L, St),val=F},[],St}; -pattern({atom,L,A}, St) -> {#c_literal{anno=lineno_anno(L, St),val=A},[],St}; -pattern({string,L,S}, St) -> {#c_literal{anno=lineno_anno(L, St),val=S},[],St}; -pattern({nil,L}, St) -> {#c_literal{anno=lineno_anno(L, St),val=[]},[],St}; +%% Transform a pattern by removing line numbers. We also normalise +%% aliases in patterns to standard form: {alias,Pat,[Var]}. + +pattern({var,L,V}, St) -> {#c_var{anno=lineno_anno(L, St),name=V},St}; +pattern({char,L,C}, St) -> {#c_literal{anno=lineno_anno(L, St),val=C},St}; +pattern({integer,L,I}, St) -> {#c_literal{anno=lineno_anno(L, St),val=I},St}; +pattern({float,L,F}, St) -> {#c_literal{anno=lineno_anno(L, St),val=F},St}; +pattern({atom,L,A}, St) -> {#c_literal{anno=lineno_anno(L, St),val=A},St}; +pattern({string,L,S}, St) -> {#c_literal{anno=lineno_anno(L, St),val=S},St}; +pattern({nil,L}, St) -> {#c_literal{anno=lineno_anno(L, St),val=[]},St}; pattern({cons,L,H,T}, St) -> - {Ph,Eps1,St1} = pattern(H, St), - {Pt,Eps2,St2} = pattern(T, St1), - {annotate_cons(lineno_anno(L, St), Ph, Pt, St2),Eps1++Eps2,St2}; + {Ph,St1} = pattern(H, St), + {Pt,St2} = pattern(T, St1), + {annotate_cons(lineno_anno(L, St), Ph, Pt, St2),St2}; pattern({tuple,L,Ps}, St) -> - {Ps1,Eps,St1} = pattern_list(Ps,St), - {annotate_tuple(record_anno(L, St), Ps1, St),Eps,St1}; + {Ps1,St1} = pattern_list(Ps, St), + {annotate_tuple(record_anno(L, St), Ps1, St),St1}; pattern({map,L,Pairs}, St0) -> - {Ps,Eps,St1} = pattern_map_pairs(Pairs, St0), - {#c_map{anno=lineno_anno(L, St1),es=Ps,is_pat=true},Eps,St1}; -pattern({bin,L,Ps}, St) -> - %% We don't create a #ibinary record here, since there is - %% no need to hold any used/new annotations in a pattern. - {#c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)},[],St}; + {Ps,St1} = pattern_map_pairs(Pairs, St0), + {#imap{anno=#a{anno=lineno_anno(L, St1)},es=Ps},St1}; +pattern({bin,L,Ps}, St0) -> + {Segments,St} = pat_bin(Ps, St0), + {#ibinary{anno=#a{anno=lineno_anno(L, St)},segments=Segments},St}; pattern({match,_,P1,P2}, St) -> - {Cp1,Eps1,St1} = pattern(P1,St), - {Cp2,Eps2,St2} = pattern(P2,St1), - {pat_alias(Cp1,Cp2),Eps1++Eps2,St2}; + {Cp1,St1} = pattern(P1, St), + {Cp2,St2} = pattern(P2, St1), + {pat_alias(Cp1, Cp2),St2}; %% Evaluate compile-time expressions. pattern({op,_,'++',{nil,_},R}, St) -> pattern(R, St); @@ -1876,57 +1895,76 @@ pattern({op,_Line,_Op,_L,_R}=Op, St) -> pattern(erl_eval:partial_eval(Op), St). %% pattern_map_pairs([MapFieldExact],State) -> [#c_map_pairs{}] -pattern_map_pairs(Ps, St) -> - %% check literal key uniqueness - %% - guaranteed via aliasing map pairs - %% pattern all pairs in two steps - %% 1) Construct Core Pattern - %% 2) Alias Keys in Core Pattern - {CMapPairs, {Eps,St1}} = lists:mapfoldl(fun - (P,{EpsM,Sti0}) -> - {CMapPair,EpsP,Sti1} = pattern_map_pair(P,Sti0), - {CMapPair, {EpsM++EpsP,Sti1}} - end, {[],St}, Ps), - {pat_alias_map_pairs(CMapPairs),Eps,St1}. +pattern_map_pairs(Ps, St0) -> + {CMapPairs,St1} = mapfoldl(fun pattern_map_pair/2, St0, Ps), + {pat_alias_map_pairs(CMapPairs),St1}. pattern_map_pair({map_field_exact,L,K,V}, St0) -> - {Ck,EpsK,St1} = safe_pattern_expr(K, St0), - {Cv,EpsV,St2} = pattern(V, St1), - {#c_map_pair{anno=lineno_anno(L, St2), - op=#c_literal{val=exact}, - key=Ck, - val=Cv},EpsK++EpsV,St2}. + Ck0 = erl_eval:partial_eval(K), + {Ck,St1} = exprs([Ck0], St0), + {Cv,St2} = pattern(V, St1), + {#imappair{anno=#a{anno=lineno_anno(L, St2)}, + op=#c_literal{val=exact}, + key=Ck, + val=Cv},St2}. pat_alias_map_pairs(Ps) -> - D = foldl(fun(#c_map_pair{key=K0}=Pair, D0) -> - K = cerl:set_ann(K0, []), - dict:append(K, Pair, D0) - end, dict:new(), Ps), - pat_alias_map_pairs_1(dict:to_list(D)). - -pat_alias_map_pairs_1([{_,[#c_map_pair{val=V0}=Pair|Vs]}|T]) -> - V = foldl(fun(#c_map_pair{val=V}, Pat) -> + D0 = foldl(fun(#imappair{key=K0}=Pair, A) -> + K = map_sort_key(K0, A), + case A of + #{K:=Aliases} -> + A#{K:=[Pair|Aliases]}; + #{} -> + A#{K=>[Pair]} + end + end, #{}, Ps), + %% We must sort to ensure that the order remains consistent + %% between compilations. + D = sort(maps:to_list(D0)), + pat_alias_map_pairs_1(D). + +pat_alias_map_pairs_1([{_,[#imappair{val=V0}=Pair|Vs]}|T]) -> + V = foldl(fun(#imappair{val=V}, Pat) -> pat_alias(V, Pat) end, V0, Vs), - [Pair#c_map_pair{val=V}|pat_alias_map_pairs_1(T)]; + [Pair#imappair{val=V}|pat_alias_map_pairs_1(T)]; pat_alias_map_pairs_1([]) -> []. +map_sort_key(Key, KeyMap) -> + case Key of + [#c_literal{}=Lit] -> + {atomic,cerl:set_ann(Lit, [])}; + [#c_var{}=Var] -> + {atomic,cerl:set_ann(Var, [])}; + _ -> + {expr,map_size(KeyMap)} + end. + %% pat_bin([BinElement], State) -> [BinSeg]. -pat_bin(Ps, St) -> [pat_segment(P, St) || P <- bin_expand_strings(Ps)]. +pat_bin(Ps0, St) -> + Ps = bin_expand_strings(Ps0), + pat_segments(Ps, St). + +pat_segments([P0|Ps0], St0) -> + {P,St1} = pat_segment(P0, St0), + {Ps,St2} = pat_segments(Ps0, St1), + {[P|Ps],St2}; +pat_segments([], St) -> {[],St}. pat_segment({bin_element,L,Val,Size0,Type0}, St) -> - {Size,Type1} = make_bit_type(L, Size0, Type0), + {Size1,Type1} = make_bit_type(L, Size0, Type0), [Type,{unit,Unit}|Flags] = Type1, Anno = lineno_anno(L, St), - {Pval0,[],St1} = pattern(Val, St), + {Pval0,St1} = pattern(Val, St), Pval = coerce_to_float(Pval0, Type0), - {Psize,[],_St2} = pattern(Size, St1), - #c_bitstr{anno=Anno, - val=Pval,size=Psize, - unit=#c_literal{val=Unit}, - type=#c_literal{val=Type}, - flags=#c_literal{val=Flags}}. + Size = erl_eval:partial_eval(Size1), + {Psize,St2} = exprs([Size], St1), + {#ibitstr{anno=#a{anno=Anno}, + val=Pval,size=Psize, + unit=#c_literal{val=Unit}, + type=#c_literal{val=Type}, + flags=#c_literal{val=Flags}},St2}. coerce_to_float(#c_literal{val=Int}=E, [float|_]) when is_integer(Int) -> try @@ -1964,8 +2002,8 @@ pat_alias(#c_alias{var=#c_var{name=V1}=Var1,pat=P1}, pat_alias(#c_alias{var=#c_var{}=Var,pat=P1}, P2) -> #c_alias{var=Var,pat=pat_alias(P1, P2)}; -pat_alias(#c_map{es=Es1}=M, #c_map{es=Es2}) -> - M#c_map{es=pat_alias_map_pairs(Es1 ++ Es2)}; +pat_alias(#imap{es=Es1}=M, #imap{es=Es2}) -> + M#imap{es=pat_alias_map_pairs(Es1 ++ Es2)}; pat_alias(P1, #c_var{}=Var) -> #c_alias{var=Var,pat=P1}; @@ -1999,11 +2037,11 @@ pat_alias_list(_, _) -> throw(nomatch). %% pattern_list([P], State) -> {[P],Exprs,St} pattern_list([P0|Ps0], St0) -> - {P1,Eps,St1} = pattern(P0, St0), - {Ps1,Epsl,St2} = pattern_list(Ps0, St1), - {[P1|Ps1], Eps ++ Epsl, St2}; + {P1,St1} = pattern(P0, St0), + {Ps1,St2} = pattern_list(Ps0, St1), + {[P1|Ps1],St2}; pattern_list([], St) -> - {[],[],St}. + {[],St}. string_to_conses(Line, Cs, Tail) -> foldr(fun (C, T) -> {cons,Line,{char,Line,C},T} end, Tail, Cs). @@ -2049,9 +2087,8 @@ new_vars_1(N, Anno, St0, Vs) when N > 0 -> new_vars_1(N-1, Anno, St1, [V|Vs]); new_vars_1(0, _, St, Vs) -> {Vs,St}. -function_clause(Ps, LineAnno, Name) -> - FcAnno = [{function_name,Name}|LineAnno], - fail_clause(Ps, FcAnno, +function_clause(Ps, LineAnno) -> + fail_clause(Ps, LineAnno, ann_c_tuple(LineAnno, [#c_literal{val=function_clause}|Ps])). fail_clause(Pats, Anno, Arg) -> @@ -2065,8 +2102,8 @@ right_assoc({op,L1,Op,{op,L2,Op,E1,E2},E3}, Op) -> right_assoc({op,L2,Op,E1,{op,L1,Op,E2,E3}}, Op); right_assoc(E, _Op) -> E. -annotate_tuple(A, Es, St) -> - case member(dialyzer, St#core.opts) of +annotate_tuple(A, Es, #core{dialyzer=Dialyzer}) -> + case Dialyzer of true -> %% Do not coalesce constant tuple elements. A Hack. Node = cerl:ann_c_tuple(A, [cerl:c_var(any)]), @@ -2075,8 +2112,8 @@ annotate_tuple(A, Es, St) -> ann_c_tuple(A, Es) end. -annotate_cons(A, H, T, St) -> - case member(dialyzer, St#core.opts) of +annotate_cons(A, H, T, #core{dialyzer=Dialyzer}) -> + case Dialyzer of true -> %% Do not coalesce constant conses. A Hack. Node= cerl:ann_c_cons(A, cerl:c_var(any), cerl:c_var(any)), @@ -2157,6 +2194,20 @@ uexprs([#imatch{anno=A,pat=P0,arg=Arg,fc=Fc}|Les], Ks, St0) -> uexprs([#icase{anno=A,args=[Arg], clauses=[Mc],fc=Fc}], Ks, St0) end; +uexprs([#ireceive1{clauses=[]}=Le0|_], Ks, St0) -> + %% All clauses have been optimized away because they had impossible patterns. + %% For example: + %% + %% receive + %% a = b -> + %% V = whatever + %% end, + %% V + %% + %% Discard the unreachable code following the receive to ensure + %% that there are no references to unbound variables. + {Le1,St1} = uexpr(Le0, Ks, St0), + {[Le1],St1}; uexprs([Le0|Les0], Ks, St0) -> {Le1,St1} = uexpr(Le0, Ks, St0), {Les1,St2} = uexprs(Les0, union((get_anno(Le1))#a.ns, Ks), St1), @@ -2210,18 +2261,26 @@ uexpr(#icase{anno=#a{anno=Anno}=A,args=As0,clauses=Cs0,fc=Fc0}, Ks, St0) -> false -> new_in_all(Cs1) end, {#icase{anno=A#a{us=Used,ns=New},args=As1,clauses=Cs1,fc=Fc1},St3}; -uexpr(#ifun{anno=A0,id=Id,vars=As,clauses=Cs0,fc=Fc0,name=Name}, Ks0, St0) -> +uexpr(#ifun{anno=A0,id=Id,vars=As,clauses=Cs0,fc=Fc0,name=Name}=Fun0, Ks0, St0) -> + {Fun1,St2} = case Ks0 of + [] -> + {Fun0,St0}; + [_|_] -> + {Cs1,St1} = rename_shadowing_clauses(Cs0, Ks0, St0), + {Fun0#ifun{clauses=Cs1},St1} + end, + #ifun{clauses=Cs2} = Fun1, Avs = lit_list_vars(As), Ks1 = case Name of unnamed -> Ks0; {named,FName} -> union(subtract([FName], Avs), Ks0) end, Ks2 = union(Avs, Ks1), - {Cs1,St1} = ufun_clauses(Cs0, Ks2, St0), - {Fc1,St2} = ufun_clause(Fc0, Ks2, St1), - Used = subtract(intersection(used_in_any(Cs1), Ks1), Avs), + {Cs3,St3} = ufun_clauses(Cs2, Ks2, St2), + {Fc1,St4} = ufun_clause(Fc0, Ks2, St3), + Used = subtract(intersection(used_in_any(Cs3), Ks1), Avs), A1 = A0#a{us=Used,ns=[]}, - {#ifun{anno=A1,id=Id,vars=As,clauses=Cs1,fc=Fc1,name=Name},St2}; + {#ifun{anno=A1,id=Id,vars=As,clauses=Cs3,fc=Fc1,name=Name},St4}; uexpr(#iapply{anno=A,op=Op,args=As}, _, St) -> Used = union(lit_vars(Op), lit_list_vars(As)), {#iapply{anno=A#a{us=Used},op=Op,args=As},St}; @@ -2318,20 +2377,17 @@ upattern(#c_cons{hd=H0,tl=T0}=Cons, Ks, St0) -> upattern(#c_tuple{es=Es0}=Tuple, Ks, St0) -> {Es1,Esg,Esv,Eus,St1} = upattern_list(Es0, Ks, St0), {Tuple#c_tuple{es=Es1},Esg,Esv,Eus,St1}; -upattern(#c_map{es=Es0}=Map, Ks, St0) -> +upattern(#imap{es=Es0}=Map, Ks, St0) -> {Es1,Esg,Esv,Eus,St1} = upattern_list(Es0, Ks, St0), - {Map#c_map{es=Es1},Esg,Esv,Eus,St1}; -upattern(#c_map_pair{op=#c_literal{val=exact},key=K0,val=V0}=Pair,Ks,St0) -> + {Map#imap{es=Es1},Esg,Esv,Eus,St1}; +upattern(#imappair{op=#c_literal{val=exact},key=K0,val=V0}=Pair,Ks,St0) -> {V,Vg,Vn,Vu,St1} = upattern(V0, Ks, St0), - % A variable key must be considered used here - Ku = case K0 of - #c_var{name=Name} -> [Name]; - _ -> [] - end, - {Pair#c_map_pair{val=V},Vg,Vn,union(Ku,Vu),St1}; -upattern(#c_binary{segments=Es0}=Bin, Ks, St0) -> + {K,St2} = uexprs(K0, Ks, St1), + Ku = used_in_expr(K), + {Pair#imappair{key=K,val=V},Vg,Vn,union(Ku, Vu),St2}; +upattern(#ibinary{segments=Es0}=Bin, Ks, St0) -> {Es1,Esg,Esv,Eus,St1} = upat_bin(Es0, Ks, St0), - {Bin#c_binary{segments=Es1},Esg,Esv,Eus,St1}; + {Bin#ibinary{segments=Es1},Esg,Esv,Eus,St1}; upattern(#c_alias{var=V0,pat=P0}=Alias, Ks, St0) -> {V1,Vg,Vv,Vu,St1} = upattern(V0, Ks, St0), {P1,Pg,Pv,Pu,St2} = upattern(P0, union(Vv, Ks), St1), @@ -2377,7 +2433,7 @@ upat_bin([], _, _, St) -> {[],[],[],[],St}. %% upat_element(Segment, [KnownVar], [LocalVar], State) -> %% {Segment,[GuardTest],[NewVar],[UsedVar],[LocalVar],State} -upat_element(#c_bitstr{val=H0,size=Sz0}=Seg, Ks, Bs0, St0) -> +upat_element(#ibitstr{val=H0,size=Sz0}=Seg, Ks, Bs0, St0) -> {H1,Hg,Hv,[],St1} = upattern(H0, Ks, St0), Bs1 = case H0 of #c_var{name=Hname} -> @@ -2390,13 +2446,22 @@ upat_element(#c_bitstr{val=H0,size=Sz0}=Seg, Ks, Bs0, St0) -> _ -> Bs0 end, - {Sz1,Us} = case Sz0 of - #c_var{name=Vname} -> - rename_bitstr_size(Vname, Bs0); - _Other -> - {Sz0,[]} - end, - {Seg#c_bitstr{val=H1,size=Sz1},Hg,Hv,Us,Bs1,St1}. + case Sz0 of + [#c_var{name=Vname}] -> + {Sz1,Us} = rename_bitstr_size(Vname, Bs0), + {Sz2,St2} = uexprs([Sz1], Ks, St1), + {Seg#ibitstr{val=H1,size=Sz2},Hg,Hv,Us,Bs1,St2}; + [#c_literal{}] -> + {Sz1,St2} = uexprs(Sz0, Ks, St1), + Us = [], + {Seg#ibitstr{val=H1,size=Sz1},Hg,Hv,Us,Bs1,St2}; + Expr when is_list(Expr) -> + Sz1 = [#iset{var=#c_var{name=Old},arg=#c_var{name=New}} || + {Old,New} <- Bs0] ++ Expr, + {Sz2,St2} = uexprs(Sz1, Ks, St1), + Us = used_in_expr(Sz2), + {Seg#ibitstr{val=H1,size=Sz2},Hg,Hv,Us,Bs1,St2} + end. rename_bitstr_size(V, [{V,N}|_]) -> New = #c_var{name=N}, @@ -2406,7 +2471,13 @@ rename_bitstr_size(V, [_|Rest]) -> rename_bitstr_size(V, []) -> Old = #c_var{name=V}, {Old,[V]}. - + +used_in_expr([Le|Les]) -> + #a{us=Us,ns=Ns} = get_anno(Le), + Used = used_in_expr(Les), + union(Us, subtract(Used, Ns)); +used_in_expr([]) -> []. + used_in_any(Les) -> foldl(fun (Le, Ns) -> union((get_anno(Le))#a.us, Ns) end, [], Les). @@ -2420,6 +2491,114 @@ new_in_all([Le|Les]) -> (get_anno(Le))#a.ns, Les); new_in_all([]) -> []. +%%% +%%% Rename shadowing variables in fun heads. +%%% +%%% Pattern variables in fun heads always shadow variables bound in +%%% the enclosing environment. Because that is the way that variables +%%% behave in Core Erlang, there was previously no need to rename +%%% the variables. +%%% +%%% However, to support splitting of patterns and/or pattern matching +%%% compilation in Core Erlang, there is a need to rename all +%%% shadowing variables to avoid changing the semantics of the Erlang +%%% program. +%%% + +rename_shadowing_clauses([C0|Cs0], Ks, St0) -> + {C,St1} = rename_shadowing_clause(C0, Ks, St0), + {Cs,St} = rename_shadowing_clauses(Cs0, Ks, St1), + {[C|Cs],St}; +rename_shadowing_clauses([], _Ks, St) -> + {[],St}. + +rename_shadowing_clause(#iclause{pats=Ps0,guard=G0,body=B0}=C, Ks, St0) -> + Subs = {[],[]}, + {Ps,{_Isub,Osub},St} = ren_pats(Ps0, Ks, Subs, St0), + G = case G0 of + [] -> G0; + [_|_] -> Osub ++ G0 + end, + B = Osub ++ B0, + {C#iclause{pats=Ps,guard=G,body=B},St}. + +ren_pats([P0|Ps0], Ks, {_,_}=Subs0, St0) -> + {P,Subs1,St1} = ren_pat(P0, Ks, Subs0, St0), + {Ps,Subs,St} = ren_pats(Ps0, Ks, Subs1, St1), + {[P|Ps],Subs,St}; +ren_pats([], _Ks, {_,_}=Subs, St) -> + {[],Subs,St}. + +ren_pat(#c_var{name='_'}=P, _Ks, Subs, St) -> + {P,Subs,St}; +ren_pat(#c_var{name=V}=Old, Ks, {Isub0,Osub0}=Subs, St0) -> + case member(V, Ks) of + true -> + case ren_is_subst(V, Osub0) of + {yes,New} -> + {New,Subs,St0}; + no -> + {New,St} = new_var(St0), + Osub = [#iset{var=Old,arg=New}|Osub0], + {New,{Isub0,Osub},St} + end; + false -> + {Old,Subs,St0} + end; +ren_pat(#c_literal{}=P, _Ks, {_,_}=Subs, St) -> + {P,Subs,St}; +ren_pat(#c_alias{var=Var0,pat=Pat0}=Alias, Ks, {_,_}=Subs0, St0) -> + {Var,Subs1,St1} = ren_pat(Var0, Ks, Subs0, St0), + {Pat,Subs,St} = ren_pat(Pat0, Ks, Subs1, St1), + {Alias#c_alias{var=Var,pat=Pat},Subs,St}; +ren_pat(#imap{es=Es0}=Map, Ks, {_,_}=Subs0, St0) -> + {Es,Subs,St} = ren_pat_map(Es0, Ks, Subs0, St0), + {Map#imap{es=Es},Subs,St}; +ren_pat(#ibinary{segments=Es0}=P, Ks, {Isub,Osub0}, St0) -> + {Es,_Isub,Osub,St} = ren_pat_bin(Es0, Ks, Isub, Osub0, St0), + {P#ibinary{segments=Es},{Isub,Osub},St}; +ren_pat(P, Ks0, {_,_}=Subs0, St0) -> + Es0 = cerl:data_es(P), + {Es,Subs,St} = ren_pats(Es0, Ks0, Subs0, St0), + {cerl:make_data(cerl:data_type(P), Es),Subs,St}. + +ren_pat_bin([#ibitstr{val=Val0,size=Sz0}=E|Es0], Ks, Isub0, Osub0, St0) -> + Sz = ren_get_subst(Sz0, Isub0), + {Val,{_,Osub1},St1} = ren_pat(Val0, Ks, {Isub0,Osub0}, St0), + Isub1 = case Val0 of + #c_var{} -> + [#iset{var=Val0,arg=Val}|Isub0]; + _ -> + Isub0 + end, + {Es,Isub,Osub,St} = ren_pat_bin(Es0, Ks, Isub1, Osub1, St1), + {[E#ibitstr{val=Val,size=Sz}|Es],Isub,Osub,St}; +ren_pat_bin([], _Ks, Isub, Osub, St) -> + {[],Isub,Osub,St}. + +ren_pat_map([#imappair{val=Val0}=MapPair|Es0], Ks, Subs0, St0) -> + {Val,Subs1,St1} = ren_pat(Val0, Ks, Subs0, St0), + {Es,Subs,St} = ren_pat_map(Es0, Ks, Subs1, St1), + {[MapPair#imappair{val=Val}|Es],Subs,St}; +ren_pat_map([], _Ks, Subs, St) -> + {[],Subs,St}. + +ren_get_subst([#c_var{name=V}]=Old, Sub) -> + case ren_is_subst(V, Sub) of + no -> Old; + {yes,New} -> [New] + end; +ren_get_subst([#c_literal{}]=Old, _Sub) -> + Old; +ren_get_subst(Expr, Sub) when is_list(Expr) -> + Sub ++ Expr. + +ren_is_subst(V, [#iset{var=#c_var{name=V},arg=Arg}|_]) -> + {yes,Arg}; +ren_is_subst(V, [_|Sub]) -> + ren_is_subst(V, Sub); +ren_is_subst(_V, []) -> no. + %% The AfterVars are the variables which are used afterwards. We need %% this to work out which variables are actually exported and used %% from case/receive. In subblocks/clauses the AfterVars of the block @@ -2432,7 +2611,8 @@ cbody(B0, St0) -> %% cclause(Lclause, [AfterVar], State) -> {Cclause,State}. %% The AfterVars are the exported variables. -cclause(#iclause{anno=#a{anno=Anno},pats=Ps,guard=G0,body=B0}, Exp, St0) -> +cclause(#iclause{anno=#a{anno=Anno},pats=Ps0,guard=G0,body=B0}, Exp, St0) -> + Ps = cpattern_list(Ps0), {B1,_Us1,St1} = cexprs(B0, Exp, St0), {G1,St2} = cguard(G0, St1), {#c_clause{anno=Anno,pats=Ps,guard=G1,body=B1},St2}. @@ -2444,7 +2624,36 @@ cguard([], St) -> {#c_literal{val=true},St}; cguard(Gs, St0) -> {G,_,St1} = cexprs(Gs, [], St0), {G,St1}. - + +cpattern_list([P|Ps]) -> + [cpattern(P)|cpattern_list(Ps)]; +cpattern_list([]) -> []. + +cpattern(#c_alias{pat=Pat}=Alias) -> + Alias#c_alias{pat=cpattern(Pat)}; +cpattern(#c_cons{hd=Hd,tl=Tl}=Cons) -> + Cons#c_cons{hd=cpattern(Hd),tl=cpattern(Tl)}; +cpattern(#c_tuple{es=Es}=Tup) -> + Tup#c_tuple{es=cpattern_list(Es)}; +cpattern(#imap{anno=#a{anno=Anno},es=Es}) -> + #c_map{anno=Anno,es=cpat_map_pairs(Es),is_pat=true}; +cpattern(#ibinary{anno=#a{anno=Anno},segments=Segs0}) -> + Segs = [cpat_bin_seg(S) || S <- Segs0], + #c_binary{anno=Anno,segments=Segs}; +cpattern(Other) -> Other. + +cpat_map_pairs([#imappair{anno=#a{anno=Anno},op=Op,key=Key0,val=Val0}|T]) -> + {Key,_,_} = cexprs(Key0, [], #core{}), + Val = cpattern(Val0), + Pair = #c_map_pair{anno=Anno,op=Op,key=Key,val=Val}, + [Pair|cpat_map_pairs(T)]; +cpat_map_pairs([]) -> []. + +cpat_bin_seg(#ibitstr{anno=#a{anno=Anno},val=E,size=Sz0,unit=Unit, + type=Type,flags=Flags}) -> + {Sz,_,_} = cexprs(Sz0, [], #core{}), + #c_bitstr{anno=Anno,val=E,size=Sz,unit=Unit,type=Type,flags=Flags}. + %% cexprs([Lexpr], [AfterVar], State) -> {Cexpr,[AfterVar],State}. %% Must be sneaky here at the last expr when combining exports for the %% whole sequence and exports for that expr. @@ -2625,6 +2834,508 @@ c_call_erl(Fun, Args) -> As = [compiler_generated], cerl:ann_c_call(As, cerl:c_atom(erlang), cerl:c_atom(Fun), Args). +%%% +%%% Lower a `receive` to more primitive operations. Rewrite patterns +%%% that use and bind the same variable as nested cases. +%%% +%%% Here follows an example of how a receive in this Erlang code: +%%% +%%% foo(Timeout) -> +%%% receive +%%% {tag,Msg} -> Msg +%%% after +%%% Timeout -> +%%% no_message +%%% end. +%%% +%%% is translated into Core Erlang: +%%% +%%% 'foo'/1 = +%%% fun (Timeout) -> +%%% ( letrec +%%% 'recv$^0'/0 = +%%% fun () -> +%%% let <PeekSucceeded,Message> = +%%% primop 'recv_peek_message'() +%%% in case PeekSucceeded of +%%% <'true'> when 'true' -> +%%% case Message of +%%% <{'tag',Msg}> when 'true' -> +%%% do primop 'remove_message'() +%%% Msg +%%% ( <Other> when 'true' -> +%%% do primop 'recv_next'() +%%% apply 'recv$^0'/0() +%%% -| ['compiler_generated'] ) +%%% end +%%% <'false'> when 'true' -> +%%% let <TimedOut> = +%%% primop 'recv_wait_timeout'(Timeout) +%%% in case TimedOut of +%%% <'true'> when 'true' -> +%%% do primop 'timeout'() +%%% 'no_message' +%%% <'false'> when 'true' -> +%%% apply 'recv$^0'/0() +%%% end +%%% end +%%% in apply 'recv$^0'/0() +%%% -| ['letrec_goto'] ) + +lbody(B, St) -> + cerl_trees:mapfold(fun lexpr/2, St, B). + +lexpr(#c_case{}=Case, St) -> + %% Split patterns that bind and use the same variable. + split_case(Case, St); +lexpr(#c_receive{clauses=[],timeout=Timeout0,action=Action}, St0) -> + %% Lower a receive with only an after to its primitive operations. + False = #c_literal{val=false}, + True = #c_literal{val=true}, + + {Timeout,Outer0,St1} = + case is_safe(Timeout0) of + true -> + {Timeout0,False,St0}; + false -> + {TimeoutVar,Sti0} = new_var(St0), + OuterLet = #c_let{vars=[TimeoutVar],arg=Timeout0,body=False}, + {TimeoutVar,OuterLet,Sti0} + end, + + MaybeIgnore = case Timeout of + #c_literal{val=infinity} -> [dialyzer_ignore]; + _ -> [] + end, + + {LoopName,St2} = new_fun_name("recv", St1), + LoopFun = #c_var{name={LoopName,0}}, + ApplyLoop = #c_apply{anno=[dialyzer_ignore],op=LoopFun,args=[]}, + + TimeoutCs = [#c_clause{anno=MaybeIgnore,pats=[True],guard=True, + body=#c_seq{arg=primop(timeout), + body=Action}}, + #c_clause{anno=[compiler_generated,dialyzer_ignore], + pats=[False],guard=True, + body=ApplyLoop}], + {TimeoutBool,St3} = new_var(St2), + TimeoutCase = #c_case{anno=[receive_timeout],arg=TimeoutBool, + clauses=TimeoutCs}, + TimeoutLet = #c_let{vars=[TimeoutBool], + arg=primop(recv_wait_timeout, [Timeout]), + body=TimeoutCase}, + + Fun = #c_fun{vars=[],body=TimeoutLet}, + + Letrec = #c_letrec{anno=[letrec_goto], + defs=[{LoopFun,Fun}], + body=ApplyLoop}, + + %% If the 'after' expression is unsafe we evaluate it in an outer 'let'. + Outer = case Outer0 of + #c_let{} -> Outer0#c_let{body=Letrec}; + _ -> Letrec + end, + {Outer,St3}; +lexpr(#c_receive{anno=RecvAnno,clauses=Cs0,timeout=Timeout0,action=Action}, St0) -> + %% Lower receive to its primitive operations. + False = #c_literal{val=false}, + True = #c_literal{val=true}, + + {Timeout,Outer0,St1} = + case is_safe(Timeout0) of + true -> + {Timeout0,False,St0}; + false -> + {TimeoutVar,Sti0} = new_var(St0), + OuterLet = #c_let{vars=[TimeoutVar],arg=Timeout0,body=False}, + {TimeoutVar,OuterLet,Sti0} + end, + + MaybeIgnore = case Timeout of + #c_literal{val=infinity} -> [dialyzer_ignore]; + _ -> [] + end, + + {LoopName,St2} = new_fun_name("recv", St1), + LoopFun = #c_var{name={LoopName,0}}, + ApplyLoop = #c_apply{anno=[dialyzer_ignore],op=LoopFun,args=[]}, + + Cs1 = rewrite_cs(Cs0), + RecvNext = #c_seq{arg=primop(recv_next), + body=ApplyLoop}, + RecvNextC = #c_clause{anno=[compiler_generated,dialyzer_ignore], + pats=[#c_var{name='Other'}],guard=True,body=RecvNext}, + Cs = Cs1 ++ [RecvNextC], + {Msg,St3} = new_var(St2), + {MsgCase,St4} = split_case(#c_case{anno=RecvAnno,arg=Msg,clauses=Cs}, St3), + + TimeoutCs = [#c_clause{pats=[True],guard=True, + body=#c_seq{arg=primop(timeout), + body=Action}}, + #c_clause{anno=[dialyzer_ignore],pats=[False],guard=True, + body=ApplyLoop}], + {TimeoutBool,St5} = new_var(St4), + TimeoutCase = #c_case{arg=TimeoutBool,clauses=TimeoutCs}, + TimeoutLet = #c_let{vars=[TimeoutBool], + arg=primop(recv_wait_timeout, [Timeout]), + body=TimeoutCase}, + + {PeekSucceeded,St6} = new_var(St5), + PeekCs = [#c_clause{pats=[True],guard=True, + body=MsgCase}, + #c_clause{anno=MaybeIgnore, + pats=[False],guard=True, + body=TimeoutLet}], + PeekCase = #c_case{arg=PeekSucceeded,clauses=PeekCs}, + PeekLet = #c_let{vars=[PeekSucceeded,Msg], + arg=primop(recv_peek_message), + body=PeekCase}, + Fun = #c_fun{vars=[],body=PeekLet}, + + Letrec = #c_letrec{anno=[letrec_goto], + defs=[{LoopFun,Fun}], + body=ApplyLoop}, + + %% If the 'after' expression is unsafe we evaluate it in an outer 'let'. + Outer = case Outer0 of + #c_let{} -> Outer0#c_let{body=Letrec}; + _ -> Letrec + end, + {Outer,St6}; +lexpr(Tree, St) -> + {Tree,St}. + +rewrite_cs([#c_clause{body=B0}=C|Cs]) -> + B = #c_seq{arg=primop(remove_message),body=B0}, + [C#c_clause{body=B}|rewrite_cs(Cs)]; +rewrite_cs([]) -> []. + +primop(Name) -> + primop(Name, []). + +primop(Name, Args) -> + #c_primop{name=#c_literal{val=Name},args=Args}. + +%%% +%%% Split patterns such as <<Size:32,Tail:Size>> that bind +%%% and use a variable in the same pattern. Rewrite to a +%%% nested case in a letrec. +%%% + +split_case(#c_case{anno=CaseAnno,arg=Arg,clauses=Cs0}=Case0, St0) -> + Args = case Arg of + #c_values{es=Es} -> Es; + _ -> [Arg] + end, + {VarArgs,St1} = split_var_args(Args, St0), + case split_clauses(Cs0, VarArgs, CaseAnno, St1) of + none -> + {Case0,St0}; + {PreCase,AftCs,St2} -> + AftCase = Case0#c_case{arg=core_lib:make_values(VarArgs), + clauses=AftCs}, + AftFun = #c_fun{vars=[],body=AftCase}, + {Letrec,St3} = split_case_letrec(AftFun, PreCase, St2), + Body = split_letify(VarArgs, Args, Letrec, [], []), + {Body,St3} + end. + +split_var_args(Args, St) -> + mapfoldl(fun(#c_var{}=Var, S0) -> + {Var,S0}; + (#c_literal{}=Lit, S0) -> + {Lit,S0}; + (_, S0) -> + new_var(S0) + end, St, Args). + +split_letify([Same|Vs], [Same|Args], Body, VsAcc, ArgAcc) -> + split_letify(Vs, Args, Body, VsAcc, ArgAcc); +split_letify([V|Vs], [Arg|Args], Body, VsAcc, ArgAcc) -> + split_letify(Vs, Args, Body, [V|VsAcc], [Arg|ArgAcc]); +split_letify([], [], Body, [], []) -> + Body; +split_letify([], [], Body, [_|_]=VsAcc, [_|_]=ArgAcc) -> + #c_let{vars=reverse(VsAcc), + arg=core_lib:make_values(reverse(ArgAcc)), + body=Body}. + +split_case_letrec(#c_fun{anno=FunAnno0}=Fun0, Body, #core{gcount=C}=St0) -> + FunAnno = [compiler_generated|FunAnno0], + Fun = Fun0#c_fun{anno=FunAnno}, + Anno = [letrec_goto], + DefFunName = goto_func(C), + Letrec = #c_letrec{anno=Anno,defs=[{#c_var{name=DefFunName},Fun}],body=Body}, + St = St0#core{gcount=C+1}, + lbody(Letrec, St). + +split_clauses([C0|Cs0], Args, CaseAnno, St0) -> + case split_clauses(Cs0, Args, CaseAnno, St0) of + none -> + case split_clause(C0, St0) of + none -> + none; + {Ps,Nested,St1} -> + {Case,St2} = split_reconstruct(Args, Ps, Nested, + C0, CaseAnno, St1), + {Case,Cs0,St2} + end; + {Case0,Cs,St} -> + #c_case{clauses=NewClauses} = Case0, + Case = Case0#c_case{clauses=[C0|NewClauses]}, + {Case,Cs,St} + end; +split_clauses([], _, _, _) -> + none. + +goto_func(Count) -> + {list_to_atom("label^" ++ integer_to_list(Count)),0}. + +split_reconstruct(Args, Ps, nil, #c_clause{anno=Anno}=C0, CaseAnno, St0) -> + C = C0#c_clause{pats=Ps}, + {Fc,St1} = split_fc_clause(Ps, Anno, St0), + {#c_case{anno=CaseAnno,arg=core_lib:make_values(Args),clauses=[C,Fc]},St1}; +split_reconstruct(Args, Ps, {split,SplitArgs,Pat,Nested}, C, CaseAnno, St) -> + Split = {split,SplitArgs,fun(Body) -> Body end,Pat,Nested}, + split_reconstruct(Args, Ps, Split, C, CaseAnno, St); +split_reconstruct(Args, Ps, {split,SplitArgs,Wrap,Pat,Nested}, + #c_clause{anno=Anno}=C0, CaseAnno, St0) -> + {InnerCase,St1} = split_reconstruct(SplitArgs, [Pat], Nested, C0, + CaseAnno, St0), + {Fc,St2} = split_fc_clause(Args, Anno, St1), + Wrapped = Wrap(InnerCase), + C = C0#c_clause{pats=Ps,guard=#c_literal{val=true},body=Wrapped}, + {#c_case{anno=CaseAnno,arg=core_lib:make_values(Args),clauses=[C,Fc]},St2}. + +split_fc_clause(Args, Anno0, #core{gcount=Count}=St0) -> + Anno = [compiler_generated|Anno0], + Arity = length(Args), + {Vars,St1} = new_vars(Arity, St0), + Op = #c_var{name=goto_func(Count)}, + Apply = #c_apply{anno=Anno,op=Op,args=[]}, + {#c_clause{anno=[dialyzer_ignore|Anno],pats=Vars, + guard=#c_literal{val=true},body=Apply},St1}. + +split_clause(#c_clause{pats=Ps0}, St0) -> + case split_pats(Ps0, St0) of + none -> + none; + {Ps,Case,St} -> + {Ps,Case,St} + end. + +split_pats([P0|Ps0], St0) -> + case split_pats(Ps0, St0) of + none -> + case split_pat(P0, St0) of + none -> + none; + {P,Case,St} -> + {[P|Ps0],Case,St} + end; + {Ps,Case,St} -> + {[P0|Ps],Case,St} + end; +split_pats([], _) -> + none. + +split_pat(#c_binary{segments=Segs0}=Bin, St0) -> + Vars = gb_sets:empty(), + case split_bin_segments(Segs0, Vars, St0, []) of + none -> + none; + {TailVar,Wrap,Bef,Aft,St} -> + BefBin = Bin#c_binary{segments=Bef}, + {BefBin,{split,[TailVar],Wrap,Bin#c_binary{segments=Aft},nil},St} + end; +split_pat(#c_map{es=Es}=Map, St) -> + split_map_pat(Es, Map, St, []); +split_pat(#c_var{}, _) -> + none; +split_pat(#c_alias{pat=Pat}=Alias0, St0) -> + case split_pat(Pat, St0) of + none -> + none; + {Ps,Split,St1} -> + {Var,St} = new_var(St1), + Alias = Alias0#c_alias{pat=Var}, + {Alias,{split,[Var],Ps,Split},St} + end; +split_pat(Data, St0) -> + Type = cerl:data_type(Data), + Es = cerl:data_es(Data), + split_data(Es, Type, St0, []). + +split_map_pat([#c_map_pair{key=Key,val=Val}=E0|Es], Map0, St0, Acc) -> + case eval_map_key(Key, E0, Es, Map0, St0) of + none -> + case split_pat(Val, St0) of + none -> + split_map_pat(Es, Map0, St0, [E0|Acc]); + {Ps,Split,St1} -> + {Var,St} = new_var(St1), + E = E0#c_map_pair{val=Var}, + Map = Map0#c_map{es=reverse(Acc, [E|Es])}, + {Map,{split,[Var],Ps,Split},St} + end; + {MapVar,Split,St1} -> + BefMap0 = Map0#c_map{es=reverse(Acc)}, + BefMap = #c_alias{var=MapVar,pat=BefMap0}, + {BefMap,Split,St1} + end; +split_map_pat([], _, _, _) -> none. + +eval_map_key(#c_var{}, _E, _Es, _Map, _St) -> + none; +eval_map_key(#c_literal{}, _E, _Es, _Map, _St) -> + none; +eval_map_key(Key, E0, Es, Map, St0) -> + {[KeyVar,MapVar],St1} = new_vars(2, St0), + E = E0#c_map_pair{key=KeyVar}, + AftMap0 = Map#c_map{es=[E|Es]}, + {Wrap,CaseArg,AftMap,St2} = wrap_map_key_fun(Key, KeyVar, MapVar, AftMap0, St1), + {MapVar,{split,[CaseArg],Wrap,AftMap,nil},St2}. + +wrap_map_key_fun(Key, KeyVar, MapVar, AftMap, St0) -> + case is_safe(Key) of + true -> + {fun(Body) -> + #c_let{vars=[KeyVar],arg=Key,body=Body} + end,MapVar,AftMap,St0}; + false -> + {[SuccVar|Evars],St} = new_vars(4, St0), + {fun(Body) -> + Try = #c_try{arg=Key,vars=[KeyVar], + body=#c_values{es=[#c_literal{val=true},KeyVar]}, + evars=Evars, + handler=#c_values{es=[#c_literal{val=false}, + #c_literal{val=false}]}}, + #c_let{vars=[SuccVar,KeyVar],arg=Try,body=Body} + end, + #c_tuple{es=[SuccVar,MapVar]}, + #c_tuple{es=[#c_literal{val=true},AftMap]}, + St} + end. + +split_data([E|Es0], Type, St0, Acc) -> + case split_pat(E, St0) of + none -> + split_data(Es0, Type, St0, [E|Acc]); + {Ps,Split,St1} -> + {Var,St} = new_var(St1), + Data = cerl:make_data(Type, reverse(Acc, [Var|Es0])), + {Data,{split,[Var],Ps,Split},St} + end; +split_data([], _, _, _) -> none. + +split_bin_segments([#c_bitstr{val=Val,size=Size}=S0|Segs], Vars0, St0, Acc) -> + Vars = case Val of + #c_var{name=V} -> gb_sets:add(V, Vars0); + _ -> Vars0 + end, + case Size of + #c_literal{} -> + split_bin_segments(Segs, Vars, St0, [S0|Acc]); + #c_var{name=SizeVar} -> + case gb_sets:is_member(SizeVar, Vars0) of + true -> + %% The size variable is variable previously bound + %% in this same segment. Split the clause here to + %% avoid a variable that is both defined and used + %% in the same pattern. + {TailVar,Tail,St} = split_tail_seg(S0, Segs, St0), + Wrap = fun(Body) -> Body end, + {TailVar,Wrap,reverse(Acc, [Tail]),[S0|Segs],St}; + false -> + split_bin_segments(Segs, Vars, St0, [S0|Acc]) + end; + _ -> + %% The size is an expression. Split the clause here, + %% calculate the expression in a try/catch, and finally + %% continue the match in an inner case. + {TailVar,Tail,St1} = split_tail_seg(S0, Segs, St0), + {SizeVar,St2} = new_var(St1), + S = S0#c_bitstr{size=SizeVar}, + {Wrap,St3} = split_wrap(SizeVar, Size, St2), + {TailVar,Wrap,reverse(Acc, [Tail]),[S|Segs],St3} + end; +split_bin_segments(_, _, _, _) -> + none. + +split_tail_seg(#c_bitstr{anno=A}=S, Segs, St0) -> + {TailVar,St} = new_var(St0), + Unit = split_bin_unit([S|Segs], St0), + {TailVar, + #c_bitstr{anno=A,val=TailVar, + size=#c_literal{val=all}, + unit=#c_literal{val=Unit}, + type=#c_literal{val=binary}, + flags=#c_literal{val=[unsigned,big]}}, + St}. + +split_wrap(SizeVar, SizeExpr, St0) -> + {Evars,St1} = new_vars(3, St0), + {fun(Body) -> + Try = #c_try{arg=SizeExpr,vars=[SizeVar],body=SizeVar, + evars=Evars,handler=#c_literal{val=bad_size}}, + #c_let{vars=[SizeVar],arg=Try,body=Body} + end,St1}. + +split_bin_unit(Ss, #core{dialyzer=Dialyzer}) -> + case Dialyzer of + true -> + %% When a binary match has been rewritten to a nested + %% case like this: + %% + %% case Bin of + %% <<Size:32,Tail:Size/bitstring-unit:1>> -> + %% case Tail of + %% <<Result/binary-unit:8>> -> Result; + %% ... + %% end + %% + %% dialyzer will determine the type of Bin based solely on + %% the binary pattern in the outer case. It will not + %% back-propagate any type information for Tail to Bin. For + %% this example, dialyzer would infer the type of Bin to + %% be <<_:8,_:_*1>>. + %% + %% Help dialyzer to infer a better type by calculating the + %% greatest common unit for the segments in the inner case + %% expression. For this example, the greatest common unit + %% for the pattern in the inner case is 8; it will allow + %% dialyzer to infer the type for Bin to be + %% <<_:32,_:_*8>>. + + split_bin_unit_1(Ss, 0); + false -> + %% Return the unit for pattern in the outer case that + %% results in the best code. + + 1 + end. + +split_bin_unit_1([#c_bitstr{type=#c_literal{val=Type},size=Size, + unit=#c_literal{val=U}}|Ss], + GCU) -> + Bits = case {Type,Size} of + {utf8,_} -> 8; + {utf16,_} -> 16; + {utf32,_} -> 32; + {_,#c_literal{val=0}} -> 1; + {_,#c_literal{val=Sz}} when is_integer(Sz) -> Sz * U; + {_,_} -> U + end, + split_bin_unit_1(Ss, gcd(GCU, Bits)); +split_bin_unit_1([], GCU) -> GCU. + +gcd(A, B) -> + case A rem B of + 0 -> B; + X -> gcd(B, X) + end. + %% lit_vars(Literal) -> [Var]. lit_vars(Lit) -> lit_vars(Lit, []). @@ -2649,10 +3360,8 @@ bitstr_vars(Segs, Vs) -> lit_vars(V, lit_vars(S, Vs0)) end, Vs, Segs). -record_anno(L, St) -> - case - erl_anno:record(L) andalso member(dialyzer, St#core.opts) - of +record_anno(L, #core{dialyzer=Dialyzer}=St) -> + case erl_anno:record(L) andalso Dialyzer of true -> [record | lineno_anno(L, St)]; false -> diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index bcdc59699b..733acf7a46 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -29,11 +29,7 @@ %% %% 3. Pattern matching (in cases and receives) has been compiled. %% -%% 4. The annotations contain variable usages. Seeing we have to work -%% this out anyway for funs we might as well pass it on for free to -%% later passes. -%% -%% 5. All remote-calls are to statically named m:f/a. Meta-calls are +%% 4. All remote-calls are to statically named m:f/a. Meta-calls are %% passed via erlang:apply/3. %% %% The translation is done in two passes: @@ -81,13 +77,17 @@ -export([module/2,format_error/1]). --import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2, - keyfind/3,partition/2,droplast/1,last/1,sort/1,reverse/1]). --import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]). --import(cerl, [c_tuple/1]). +-import(lists, [all/2,droplast/1,flatten/1,foldl/3,foldr/3, + map/2,mapfoldl/3,member/2, + keyfind/3,keyreplace/4, + last/1,partition/2,reverse/1, + sort/1,sort/2,splitwith/2]). +-import(ordsets, [add_element/2,intersection/2, + subtract/2,union/2,union/1]). -include("core_parse.hrl"). -include("v3_kernel.hrl"). +-define(EXPAND_MAX_SIZE_SEGMENT, 1024). %% These are not defined in v3_kernel.hrl. get_kanno(Kthing) -> element(2, Kthing). @@ -105,33 +105,34 @@ copy_anno(Kdst, Ksrc) -> -record(iletrec, {anno=[],defs}). -record(ialias, {anno=[],vars,pat}). -record(iclause, {anno=[],isub,osub,pats,guard,body}). --record(ireceive_accept, {anno=[],arg}). --record(ireceive_next, {anno=[],arg}). --record(ignored, {anno=[]}). -type warning() :: term(). % XXX: REFINE %% State record for kernel translator. -record(kern, {func, %Current host function - ff, %Current function + fargs=[] :: [#k_var{}], %Arguments for current function vcount=0, %Variable counter fcount=0, %Fun counter ds=cerl_sets:new() :: cerl_sets:set(), %Defined variables funs=[], %Fun functions free=#{}, %Free variables ws=[] :: [warning()], %Warnings. - guard_refc=0}). %> 0 means in guard + no_shared_fun_wrappers=false :: boolean(), + labels=cerl_sets:new() + }). -spec module(cerl:c_module(), [compile:option()]) -> {'ok', #k_mdef{}, [warning()]}. -module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, _Options) -> +module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, Options) -> Kas = attributes(As), Kes = map(fun (#c_var{name={_,_}=Fname}) -> Fname end, Es), - St0 = #kern{}, + NoSharedFunWrappers = proplists:get_bool(no_shared_fun_wrappers, + Options), + St0 = #kern{no_shared_fun_wrappers=NoSharedFunWrappers}, {Kfs,St} = mapfoldl(fun function/2, St0, Fs), {ok,#k_mdef{anno=A,name=M#c_literal.val,exports=Kes,attributes=Kas, - body=Kfs ++ St#kern.funs},lists:sort(St#kern.ws)}. + body=Kfs ++ St#kern.funs},sort(St#kern.ws)}. attributes([{#c_literal{val=Name},#c_literal{val=Val}}|As]) -> case include_attribute(Name) of @@ -162,11 +163,11 @@ function({#c_var{name={F,Arity}=FA},Body}, St0) -> %% the function. We use integers as variable names to avoid %% filling up the atom table when compiling huge functions. Count = cerl_trees:next_free_variable_name(Body), - St1 = St0#kern{func=FA,ff=undefined,vcount=Count,fcount=0,ds=cerl_sets:new()}, + St1 = St0#kern{func=FA,vcount=Count,fcount=0,ds=cerl_sets:new()}, {#ifun{anno=Ab,vars=Kvs,body=B0},[],St2} = expr(Body, new_sub(), St1), {B1,_,St3} = ubody(B0, return, St2), %%B1 = B0, St3 = St2, %Null second pass - {make_fdef(#k{us=[],ns=[],a=Ab}, F, Arity, Kvs, B1),St3} + {make_fdef(Ab, F, Arity, Kvs, B1),St3} catch Class:Error:Stack -> io:fwrite("Function: ~w/~w\n", [F,Arity]), @@ -180,512 +181,27 @@ function({#c_var{name={F,Arity}=FA},Body}, St0) -> body(#c_values{anno=A,es=Ces}, Sub, St0) -> %% Do this here even if only in bodies. {Kes,Pe,St1} = atomic_list(Ces, Sub, St0), - %%{Kes,Pe,St1} = expr_list(Ces, Sub, St0), {#ivalues{anno=A,args=Kes},Pe,St1}; -body(#ireceive_next{anno=A}, _, St) -> - {#k_receive_next{anno=A},[],St}; body(Ce, Sub, St0) -> expr(Ce, Sub, St0). %% guard(Cexpr, Sub, State) -> {Kexpr,State}. %% We handle guards almost as bodies. The only special thing we %% must do is to make the final Kexpr a #k_test{}. -%% Also, we wrap the entire guard in a try/catch which is -%% not strictly needed, but makes sure that every 'bif' instruction -%% will get a proper failure label. guard(G0, Sub, St0) -> - {G1,St1} = wrap_guard(G0, St0), - {Ge0,Pre,St2} = expr(G1, Sub, St1), - {Ge1,St3} = gexpr_test(Ge0, St2), - {Ge,St} = guard_opt(Ge1, St3), + {Ge0,Pre,St1} = expr(G0, Sub, St0), + {Ge,St} = gexpr_test(Ge0, St1), {pre_seq(Pre, Ge),St}. -%% guard_opt(Kexpr, State) -> {Kexpr,State}. -%% Optimize the Kexpr for the guard. Instead of evaluating a boolean -%% expression comparing it to 'true' in a final #k_test{}, -%% replace BIF calls with #k_test{} in the expression. -%% -%% As an example, take the guard: -%% -%% when is_integer(V0), is_atom(V1) -> -%% -%% The unoptimized Kexpr translated to pseudo BEAM assembly -%% code would look like: -%% -%% bif is_integer V0 => Bool0 -%% bif is_atom V1 => Bool1 -%% bif and Bool0 Bool1 => Bool -%% test Bool =:= true else goto Fail -%% ... -%% Fail: -%% ... -%% -%% The optimized code would look like: -%% -%% test is_integer V0 else goto Fail -%% test is_atom V1 else goto Fail -%% ... -%% Fail: -%% ... -%% -%% An 'or' operation is only slightly more complicated: -%% -%% test is_integer V0 else goto NotFailedYet -%% goto Success -%% -%% NotFailedYet: -%% test is_atom V1 else goto Fail -%% -%% Success: -%% ... -%% Fail: -%% ... - -guard_opt(G, St0) -> - {Root,Forest0,St1} = make_forest(G, St0), - {Exprs,Forest,St} = rewrite_bool(Root, Forest0, false, St1), - E = forest_pre_seq(Exprs, Forest), - {G#k_try{arg=E},St}. - -%% rewrite_bool(Kexpr, Forest, Inv, St) -> {[Kexpr],Forest,St}. -%% Rewrite Kexpr to use #k_test{} operations instead of comparison -%% and type test BIFs. -%% -%% If Kexpr is a #k_test{} operation, the call will always -%% succeed. Otherwise, a 'not_possible' exception will be -%% thrown if Kexpr cannot be rewritten. - -rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}}, - args=[#k_var{}=V,#k_atom{val=true}]}=Test, Forest0, Inv, St0) -> - try rewrite_bool_var(V, Forest0, Inv, St0) of - {_,_,_}=Res -> - Res - catch - throw:not_possible -> - {[Test],Forest0,St0} - end; -rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}}, - args=[#k_var{}=V,#k_atom{val=false}]}=Test, Forest0, Inv, St0) -> - try rewrite_bool_var(V, Forest0, not Inv, St0) of - {_,_,_}=Res -> - Res - catch - throw:not_possible -> - {[Test],Forest0,St0} - end; -rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}}, - args=[#k_atom{val=V1},#k_atom{val=V2}]}, Forest0, false, St0) -> - case V1 =:= V2 of - true -> - {[make_test(is_boolean, [#k_atom{val=true}])],Forest0,St0}; - false -> - {[make_failing_test()],Forest0,St0} - end; -rewrite_bool(#k_test{}=Test, Forest, false, St) -> - {[Test],Forest,St}; -rewrite_bool(#k_try{vars=[#k_var{name=X}],body=#k_var{name=X}, - handler=#k_atom{val=false},ret=[]}=Prot, - Forest0, Inv, St0) -> - {Root,Forest1,St1} = make_forest(Prot, Forest0, St0), - {Exprs,Forest2,St} = rewrite_bool(Root, Forest1, Inv, St1), - InnerForest = maps:without(maps:keys(Forest0), Forest2), - Forest = maps:without(maps:keys(InnerForest), Forest2), - E = forest_pre_seq(Exprs, InnerForest), - {[Prot#k_try{arg=E}],Forest,St}; -rewrite_bool(#k_match{body=Body,ret=[]}, Forest, Inv, St) -> - rewrite_match(Body, Forest, Inv, St); -rewrite_bool(Other, Forest, Inv, St) -> - case extract_bif(Other) of - {Name,Args} -> - rewrite_bif(Name, Args, Forest, Inv, St); - error -> - throw(not_possible) - end. - -%% rewrite_bool_var(Var, Forest, Inv, St) -> {[Kexpr],Forest,St}. -%% Rewrite the boolean expression whose key in Forest is -%% given by Var. Throw a 'not_possible' expression if something -%% prevents the rewriting. - -rewrite_bool_var(Arg, Forest0, Inv, St) -> - {Expr,Forest} = forest_take_expr(Arg, Forest0), - rewrite_bool(Expr, Forest, Inv, St). - -%% rewrite_bool_args([Kexpr], Forest, Inv, St) -> {[[Kexpr]],Forest,St}. -%% Rewrite each Kexpr in the list. The input Kexpr should be variables -%% or boolean values. Throw a 'not_possible' expression if something -%% prevents the rewriting. -%% -%% This function is suitable for handling the arguments for both -%% 'and' and 'or'. - -rewrite_bool_args([#k_atom{val=B}=A|Vs], Forest0, false=Inv, St0) when is_boolean(B) -> - {Tail,Forest1,St1} = rewrite_bool_args(Vs, Forest0, Inv, St0), - Bif = make_bif('=:=', [A,#k_atom{val=true}]), - {Exprs,Forest,St} = rewrite_bool(Bif, Forest1, Inv, St1), - {[Exprs|Tail],Forest,St}; -rewrite_bool_args([#k_var{}=Var|Vs], Forest0, false=Inv, St0) -> - {Tail,Forest1,St1} = rewrite_bool_args(Vs, Forest0, Inv, St0), - {Exprs,Forest,St} = - case is_bool_expr(Var, Forest0) of - true -> - rewrite_bool_var(Var, Forest1, Inv, St1); - false -> - Bif = make_bif('=:=', [Var,#k_atom{val=true}]), - rewrite_bool(Bif, Forest1, Inv, St1) - end, - {[Exprs|Tail],Forest,St}; -rewrite_bool_args([_|_], _Forest, _Inv, _St) -> - throw(not_possible); -rewrite_bool_args([], Forest, _Inv, St) -> - {[],Forest,St}. - -%% rewrite_bif(Name, [Kexpr], Forest, Inv, St) -> {[Kexpr],Forest,St}. -%% Rewrite a BIF. Throw a 'not_possible' expression if something -%% prevents the rewriting. - -rewrite_bif('or', Args, Forest, true, St) -> - rewrite_not_args('and', Args, Forest, St); -rewrite_bif('and', Args, Forest, true, St) -> - rewrite_not_args('or', Args, Forest, St); -rewrite_bif('and', [#k_atom{val=Val},Arg], Forest0, Inv, St0) -> - false = Inv, %Assertion. - case Val of - true -> - %% The result only depends on Arg. - rewrite_bool_var(Arg, Forest0, Inv, St0); - _ -> - %% Will fail. There is no need to evalute the expression - %% represented by Arg. Take it out from the forest and - %% discard the expression. - Failing = make_failing_test(), - try rewrite_bool_var(Arg, Forest0, Inv, St0) of - {_,Forest,St} -> - {[Failing],Forest,St} - catch - throw:not_possible -> - try forest_take_expr(Arg, Forest0) of - {_,Forest} -> - {[Failing],Forest,St0} - catch - throw:not_possible -> - %% Arg is probably a variable bound in an - %% outer scope. - {[Failing],Forest0,St0} - end - end - end; -rewrite_bif('and', [Arg,#k_atom{}=Atom], Forest, Inv, St) -> - false = Inv, %Assertion. - rewrite_bif('and', [Atom,Arg], Forest, Inv, St); -rewrite_bif('and', Args, Forest0, Inv, St0) -> - false = Inv, %Assertion. - {[Es1,Es2],Forest,St} = rewrite_bool_args(Args, Forest0, Inv, St0), - {Es1 ++ Es2,Forest,St}; -rewrite_bif('or', Args, Forest0, Inv, St0) -> - false = Inv, %Assertion. - {[First,Then],Forest,St} = rewrite_bool_args(Args, Forest0, Inv, St0), - Alt = make_alt(First, Then), - {[Alt],Forest,St}; -rewrite_bif('xor', [_,_], _Forest, _Inv, _St) -> - %% Rewriting 'xor' is not practical. Fortunately, 'xor' is - %% almost never used in practice. - throw(not_possible); -rewrite_bif('not', [Arg], Forest0, Inv, St) -> - {Expr,Forest} = forest_take_expr(Arg, Forest0), - rewrite_bool(Expr, Forest, not Inv, St); -rewrite_bif(Op, Args, Forest, Inv, St) -> - case is_test(Op, Args) of - true -> - rewrite_bool(make_test(Op, Args, Inv), Forest, false, St); - false -> - throw(not_possible) - end. - -rewrite_not_args(Op, [A0,B0], Forest0, St0) -> - {A,Forest1,St1} = rewrite_not_args_1(A0, Forest0, St0), - {B,Forest2,St2} = rewrite_not_args_1(B0, Forest1, St1), - rewrite_bif(Op, [A,B], Forest2, false, St2). - -rewrite_not_args_1(Arg, Forest, St) -> - Not = make_bif('not', [Arg]), - forest_add_expr(Not, Forest, St). - -%% rewrite_match(Kvar, TypeClause, Forest, Inv, St) -> -%% {[Kexpr],Forest,St}. -%% Try to rewrite a #k_match{} originating from an 'andalso' or an 'orelse'. - -rewrite_match(#k_alt{first=First,then=Then}, Forest, Inv, St) -> - case {First,Then} of - {#k_select{var=#k_var{name=V}=Var,types=[TypeClause]},#k_var{name=V}} -> - rewrite_match_1(Var, TypeClause, Forest, Inv, St); - {_,_} -> - throw(not_possible) - end. - -rewrite_match_1(Var, #k_type_clause{values=Cs0}, Forest0, Inv, St0) -> - Cs = sort([{Val,B} || #k_val_clause{val=#k_atom{val=Val},body=B} <- Cs0]), - case Cs of - [{false,False},{true,True}] -> - rewrite_match_2(Var, False, True, Forest0, Inv, St0); - _ -> - throw(not_possible) - end. - -rewrite_match_2(Var, False, #k_atom{val=true}, Forest0, Inv, St0) -> - %% Originates from an 'orelse'. - case False of - #k_atom{val=NotBool} when not is_boolean(NotBool) -> - rewrite_bool(Var, Forest0, Inv, St0); - _ -> - {CodeVar,Forest1,St1} = add_protected_expr(False, Forest0, St0), - rewrite_bif('or', [Var,CodeVar], Forest1, Inv, St1) - end; -rewrite_match_2(Var, #k_atom{val=false}, True, Forest0, Inv, St0) -> - %% Originates from an 'andalso'. - {CodeVar,Forest1,St1} = add_protected_expr(True, Forest0, St0), - rewrite_bif('and', [Var,CodeVar], Forest1, Inv, St1); -rewrite_match_2(_V, _, _, _Forest, _Inv, _St) -> - throw(not_possible). - -%% is_bool_expr(#k_var{}, Forest) -> true|false. -%% Return true if the variable refers to a boolean expression -%% that does not need an explicit '=:= true' test. - -is_bool_expr(V, Forest) -> - case forest_peek_expr(V, Forest) of - error -> - %% Defined outside of the guard. We can't know. - false; - Expr -> - case extract_bif(Expr) of - {Name,Args} -> - is_test(Name, Args) orelse - erl_internal:bool_op(Name, length(Args)); - error -> - %% Not a BIF. Should be possible to rewrite - %% to a boolean. Definitely does not need - %% a '=:= true' test. - true - end - end. - -make_bif(Op, Args) -> - #k_bif{op=#k_remote{mod=#k_atom{val=erlang}, - name=#k_atom{val=Op}, - arity=length(Args)}, - args=Args}. - -extract_bif(#k_bif{op=#k_remote{mod=#k_atom{val=erlang}, - name=#k_atom{val=Name}}, - args=Args}) -> - {Name,Args}; -extract_bif(_) -> - error. - -%% make_alt(First, Then) -> KMatch. -%% Make a #k_alt{} within a #k_match{} to implement -%% 'or' or 'orelse'. - -make_alt(First0, Then0) -> - First1 = pre_seq(droplast(First0), last(First0)), - Then1 = pre_seq(droplast(Then0), last(Then0)), - First2 = make_protected(First1), - Then2 = make_protected(Then1), - Body = #ignored{}, - First3 = #k_guard_clause{guard=First2,body=Body}, - Then3 = #k_guard_clause{guard=Then2,body=Body}, - First = #k_guard{clauses=[First3]}, - Then = #k_guard{clauses=[Then3]}, - Alt = #k_alt{first=First,then=Then}, - #k_match{vars=[],body=Alt}. - -add_protected_expr(#k_atom{}=Atom, Forest, St) -> - {Atom,Forest,St}; -add_protected_expr(#k_var{}=Var, Forest, St) -> - {Var,Forest,St}; -add_protected_expr(E0, Forest, St) -> - E = make_protected(E0), - forest_add_expr(E, Forest, St). - -make_protected(#k_try{}=Try) -> - Try; -make_protected(B) -> - #k_try{arg=B,vars=[#k_var{name=''}],body=#k_var{name=''}, - handler=#k_atom{val=false}}. - -make_failing_test() -> - make_test(is_boolean, [#k_atom{val=fail}]). - -make_test(Op, Args) -> - make_test(Op, Args, false). - -make_test(Op, Args, Inv) -> - Remote = #k_remote{mod=#k_atom{val=erlang}, - name=#k_atom{val=Op}, - arity=length(Args)}, - #k_test{op=Remote,args=Args,inverted=Inv}. - -is_test(Op, Args) -> - A = length(Args), - erl_internal:new_type_test(Op, A) orelse erl_internal:comp_op(Op, A). - -%% make_forest(Kexpr, St) -> {RootKexpr,Forest,St}. -%% Build a forest out of Kexpr. RootKexpr is the final expression -%% nested inside Kexpr. - -make_forest(G, St) -> - make_forest_1(G, #{}, 0, St). - -%% make_forest(Kexpr, St) -> {RootKexpr,Forest,St}. -%% Add to Forest from Kexpr. RootKexpr is the final expression -%% nested inside Kexpr. - -make_forest(G, Forest0, St) -> - N = forest_next_index(Forest0), - make_forest_1(G, Forest0, N, St). - -make_forest_1(#k_try{arg=B}, Forest, I, St) -> - make_forest_1(B, Forest, I, St); -make_forest_1(#iset{vars=[]}=Iset0, Forest, I, St0) -> - {UnrefVar,St} = new_var(St0), - Iset = Iset0#iset{vars=[UnrefVar]}, - make_forest_1(Iset, Forest, I, St); -make_forest_1(#iset{vars=[#k_var{name=V}],arg=Arg,body=B}, Forest0, I, St) -> - Forest = Forest0#{V => {I,Arg}, {untaken,V} => true}, - make_forest_1(B, Forest, I+1, St); -make_forest_1(Innermost, Forest, _I, St) -> - {Innermost,Forest,St}. - -%% forest_take_expr(Kexpr, Forest) -> {Expr,Forest}. -%% If Kexpr is a variable, take out the expression corresponding -%% to variable in Forest. Expressions that have been taken out -%% of the forest will not be included the Kexpr returned -%% by forest_pre_seq/2. -%% -%% Throw a 'not_possible' exception if Kexpr is not a variable or -%% if the name of the variable is not a key in Forest. - -forest_take_expr(#k_var{name=V}, Forest0) -> - %% v3_core currently always generates guard expressions that can - %% be represented as a tree. Other code generators (such as LFE) - %% could generate guard expressions that can only be represented - %% as a DAG (i.e. some nodes are referenced more than once). To - %% handle DAGs, we must never remove a node from the forest, but - %% just remove the {untaken,V} marker. That will effectively convert - %% the DAG to a tree by duplicating the shared nodes and their - %% descendants. - - case maps:find(V, Forest0) of - {ok,{_,Expr}} -> - Forest = maps:remove({untaken,V}, Forest0), - {Expr,Forest}; - error -> - throw(not_possible) - end; -forest_take_expr(_, _) -> - throw(not_possible). - -%% forest_peek_expr(Kvar, Forest) -> Kexpr | error. -%% Return the expression corresponding to Kvar in Forest or -%% return 'error' if there is a corresponding expression. - -forest_peek_expr(#k_var{name=V}, Forest0) -> - case maps:find(V, Forest0) of - {ok,{_,Expr}} -> Expr; - error -> error - end. - -%% forest_add_expr(Kexpr, Forest, St) -> {Kvar,Forest,St}. -%% Add a new expression to Forest. - -forest_add_expr(Expr, Forest0, St0) -> - {#k_var{name=V}=Var,St} = new_var(St0), - N = forest_next_index(Forest0), - Forest = Forest0#{V => {N,Expr}}, - {Var,Forest,St}. - -forest_next_index(Forest) -> - 1 + lists:max([N || {N,_} <- maps:values(Forest), - is_integer(N)] ++ [0]). - -%% forest_pre_seq([Kexpr], Forest) -> Kexpr. -%% Package the list of Kexprs into a nested Kexpr, prepending all -%% expressions in Forest that have not been taken out using -%% forest_take_expr/2. - -forest_pre_seq(Exprs, Forest) -> - Es0 = [#k_var{name=V} || {untaken,V} <- maps:keys(Forest)], - Es = Es0 ++ Exprs, - Vs = extract_all_vars(Es, Forest, []), - Pre0 = sort([{maps:get(V, Forest),V} || V <- Vs]), - Pre = [#iset{vars=[#k_var{name=V}],arg=A} || - {{_,A},V} <- Pre0], - pre_seq(Pre++droplast(Exprs), last(Exprs)). - -extract_all_vars(Es, Forest, Acc0) -> - case extract_var_list(Es) of - [] -> - Acc0; - [_|_]=Vs0 -> - Vs = [V || V <- Vs0, maps:is_key(V, Forest)], - NewVs = ordsets:subtract(Vs, Acc0), - NewEs = [begin - {_,E} = maps:get(V, Forest), - E - end || V <- NewVs], - Acc = union(NewVs, Acc0), - extract_all_vars(NewEs, Forest, Acc) - end. - -extract_vars(#iset{arg=A,body=B}) -> - union(extract_vars(A), extract_vars(B)); -extract_vars(#k_bif{args=Args}) -> - ordsets:from_list(lit_list_vars(Args)); -extract_vars(#k_call{}) -> - []; -extract_vars(#k_test{args=Args}) -> - ordsets:from_list(lit_list_vars(Args)); -extract_vars(#k_match{body=Body}) -> - extract_vars(Body); -extract_vars(#k_alt{first=First,then=Then}) -> - union(extract_vars(First), extract_vars(Then)); -extract_vars(#k_guard{clauses=Cs}) -> - extract_var_list(Cs); -extract_vars(#k_guard_clause{guard=G}) -> - extract_vars(G); -extract_vars(#k_select{var=Var,types=Types}) -> - union(ordsets:from_list(lit_vars(Var)), - extract_var_list(Types)); -extract_vars(#k_type_clause{values=Values}) -> - extract_var_list(Values); -extract_vars(#k_val_clause{body=Body}) -> - extract_vars(Body); -extract_vars(#k_try{arg=Arg}) -> - extract_vars(Arg); -extract_vars(Lit) -> - ordsets:from_list(lit_vars(Lit)). - -extract_var_list(L) -> - union([extract_vars(E) || E <- L]). - -%% Wrap the entire guard in a try/catch if needed. - -wrap_guard(#c_try{}=Try, St) -> {Try,St}; -wrap_guard(Core, St0) -> - {VarName,St} = new_var_name(St0), - Var = #c_var{name=VarName}, - Try = #c_try{arg=Core,vars=[Var],body=Var,evars=[],handler=#c_literal{val=false}}, - {Try,St}. - %% gexpr_test(Kexpr, State) -> {Kexpr,State}. %% Builds the final boolean test from the last Kexpr in a guard test. %% Must enter try blocks and isets and find the last Kexpr in them. %% This must end in a recognised BEAM test! -gexpr_test(#k_bif{anno=A,op=#k_remote{mod=#k_atom{val=erlang}, - name=#k_atom{val=F},arity=Ar}=Op, +gexpr_test(#k_bif{anno=A, + op=#k_remote{mod=#k_literal{val=erlang}, + name=#k_literal{val=F},arity=Ar}=Op, args=Kargs}=Ke, St) -> %% Either convert to test if ok, or add test. %% At this stage, erlang:float/1 is not a type test. (It should @@ -696,7 +212,7 @@ gexpr_test(#k_bif{anno=A,op=#k_remote{mod=#k_atom{val=erlang}, false -> gexpr_test_add(Ke, St) %Add equality test end; gexpr_test(#k_try{arg=B0,vars=[#k_var{name=X}],body=#k_var{name=X}, - handler=#k_atom{val=false}}=Try, St0) -> + handler=#k_literal{val=false}}=Try, St0) -> {B,St} = gexpr_test(B0, St0), %%ok = io:fwrite("~w: ~p~n", [?LINE,{B0,B}]), {Try#k_try{arg=B},St}; @@ -706,42 +222,41 @@ gexpr_test(#iset{body=B0}=Iset, St0) -> gexpr_test(Ke, St) -> gexpr_test_add(Ke, St). %Add equality test gexpr_test_add(Ke, St0) -> - Test = #k_remote{mod=#k_atom{val='erlang'}, - name=#k_atom{val='=:='}, + Test = #k_remote{mod=#k_literal{val='erlang'}, + name=#k_literal{val='=:='}, arity=2}, {Ae,Ap,St1} = force_atomic(Ke, St0), {pre_seq(Ap, #k_test{anno=get_kanno(Ke), - op=Test,args=[Ae,#k_atom{val='true'}]}),St1}. + op=Test,args=[Ae,#k_literal{val='true'}]}),St1}. %% expr(Cexpr, Sub, State) -> {Kexpr,[PreKexpr],State}. %% Convert a Core expression, flattening it at the same time. -expr(#c_var{anno=A,name={_Name,Arity}}=Fname, Sub, St) -> - %% A local in an expression. - %% For now, these are wrapped into a fun by reverse - %% eta-conversion, but really, there should be exactly one - %% such "lambda function" for each escaping local name, - %% instead of one for each occurrence as done now. +expr(#c_var{anno=A0,name={Name,Arity}}=Fname, Sub, St) -> Vs = [#c_var{name=list_to_atom("V" ++ integer_to_list(V))} || - V <- integers(1, Arity)], - Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{anno=A,op=Fname,args=Vs}}, - expr(Fun, Sub, St); + V <- integers(1, Arity)], + case St#kern.no_shared_fun_wrappers of + false -> + %% Generate a (possibly shared) wrapper function for calling + %% this function. + Wrapper0 = ["-fun.",atom_to_list(Name),"/",integer_to_list(Arity),"-"], + Wrapper = list_to_atom(flatten(Wrapper0)), + Id = {id,{0,0,Wrapper}}, + A = keyreplace(id, 1, A0, Id), + Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{anno=A,op=Fname,args=Vs}}, + expr(Fun, Sub, St); + true -> + %% For backward compatibility with OTP 22 and earlier, + %% use the pre-generated name for the fun wrapper. + %% There will be one wrapper function for each occurrence + %% of `fun F/A`. + Fun = #c_fun{anno=A0,vars=Vs,body=#c_apply{anno=A0,op=Fname,args=Vs}}, + expr(Fun, Sub, St) + end; expr(#c_var{anno=A,name=V}, Sub, St) -> {#k_var{anno=A,name=get_vsub(V, Sub)},[],St}; expr(#c_literal{anno=A,val=V}, _Sub, St) -> - Klit = case V of - [] -> - #k_nil{anno=A}; - V when is_integer(V) -> - #k_int{anno=A,val=V}; - V when is_float(V) -> - #k_float{anno=A,val=V}; - V when is_atom(V) -> - #k_atom{anno=A,val=V}; - _ -> - #k_literal{anno=A,val=V} - end, - {Klit,[],St}; + {#k_literal{anno=A,val=V},[],St}; expr(#c_cons{anno=A,hd=Ch,tl=Ct}, Sub, St0) -> %% Do cons in two steps, first the expressions left to right, then %% any remaining literals right to left. @@ -768,24 +283,12 @@ expr(#c_binary{anno=A,segments=Cv}, Sub, St0) -> Error = #c_call{anno=A,module=Erl,name=Name,args=Args}, expr(Error, Sub, St1) end; -expr(#c_fun{anno=A,vars=Cvs,body=Cb}, Sub0, #kern{ff=OldFF,func=Func}=St0) -> - FA = case OldFF of - undefined -> - Func; - _ -> - case lists:keyfind(id, 1, A) of - {id,{_,_,Name}} -> Name; - _ -> - case lists:keyfind(letrec_name, 1, A) of - {letrec_name,Name} -> Name; - _ -> unknown_fun - end - end - end, - {Kvs,Sub1,St1} = pattern_list(Cvs, Sub0, St0#kern{ff=FA}), +expr(#c_fun{anno=A,vars=Cvs,body=Cb}, Sub0, + #kern{fargs=OldFargs}=St0) -> + {Kvs,Sub1,St1} = pattern_list(Cvs, Sub0, St0), %%ok = io:fwrite("~w: ~p~n", [?LINE,{{Cvs,Sub0,St0},{Kvs,Sub1,St1}}]), - {Kb,Pb,St2} = body(Cb, Sub1, St1#kern{ff=FA}), - {#ifun{anno=A,vars=Kvs,body=pre_seq(Pb, Kb)},[],St2#kern{ff=OldFF}}; + {Kb,Pb,St2} = body(Cb, Sub1, St1#kern{fargs=Kvs}), + {#ifun{anno=A,vars=Kvs,body=pre_seq(Pb, Kb)},[],St2#kern{fargs=OldFargs}}; expr(#c_seq{arg=Ca,body=Cb}, Sub, St0) -> {Ka,Pa,St1} = body(Ca, Sub, St0), {Kb,Pb,St2} = body(Cb, Sub, St1), @@ -806,104 +309,42 @@ expr(#c_let{anno=A,vars=Cvs,arg=Ca,body=Cb}, Sub0, St0) -> end, {Kb,Pb,St3} = body(Cb, Sub1, St2), {Kb,Pa ++ Sets ++ Pb,St3}; -expr(#c_letrec{anno=A,defs=Cfs,body=Cb}, Sub0, St0) -> - %% Make new function names and store substitution. - {Fs0,{Sub1,St1}} = - mapfoldl(fun ({#c_var{name={F,Ar}},B0}, {Sub,S0}) -> - {N,St1} = new_fun_name(atom_to_list(F) - ++ "/" ++ - integer_to_list(Ar), - S0), - B = set_kanno(B0, [{letrec_name,N}]), - {{N,B},{set_fsub(F, Ar, N, Sub),St1}} - end, {Sub0,St0}, Cfs), - %% Run translation on functions and body. - {Fs1,St2} = mapfoldl(fun ({N,Fd0}, S1) -> - {Fd1,[],St2} = expr(Fd0, Sub1, S1#kern{ff=N}), - Fd = set_kanno(Fd1, A), - {{N,Fd},St2} - end, St1, Fs0), - {Kb,Pb,St3} = body(Cb, Sub1, St2#kern{ff=St1#kern.ff}), - {Kb,[#iletrec{anno=A,defs=Fs1}|Pb],St3}; +expr(#c_letrec{anno=A,defs=Cfs,body=Cb}, Sub, St) -> + case member(letrec_goto, A) of + true -> + letrec_goto(Cfs, Cb, Sub, St); + false -> + letrec_local_function(A, Cfs, Cb, Sub, St) + end; expr(#c_case{arg=Ca,clauses=Ccs}, Sub, St0) -> {Ka,Pa,St1} = body(Ca, Sub, St0), %This is a body! {Kvs,Pv,St2} = match_vars(Ka, St1), %Must have variables here! {Km,St3} = kmatch(Kvs, Ccs, Sub, St2), - Match = flatten_seq(build_match(Kvs, Km)), + Match = flatten_seq(build_match(Km)), {last(Match),Pa ++ Pv ++ droplast(Match),St3}; -expr(#c_receive{anno=A,clauses=Ccs0,timeout=Ce,action=Ca}, Sub, St0) -> - {Ke,Pe,St1} = atomic(Ce, Sub, St0), %Force this to be atomic! - {Rvar,St2} = new_var(St1), - %% Need to massage accept clauses and add reject clause before matching. - Ccs1 = map(fun (#c_clause{anno=Banno,body=B0}=C) -> - B1 = #c_seq{arg=#ireceive_accept{anno=A},body=B0}, - C#c_clause{anno=Banno,body=B1} - end, Ccs0), - {Mpat,St3} = new_var_name(St2), - Rc = #c_clause{anno=[compiler_generated|A], - pats=[#c_var{name=Mpat}],guard=#c_literal{anno=A,val=true}, - body=#ireceive_next{anno=A}}, - {Km,St4} = kmatch([Rvar], Ccs1 ++ [Rc], Sub, add_var_def(Rvar, St3)), - {Ka,Pa,St5} = body(Ca, Sub, St4), - {#k_receive{anno=A,var=Rvar,body=Km,timeout=Ke,action=pre_seq(Pa, Ka)}, - Pe,St5}; expr(#c_apply{anno=A,op=Cop,args=Cargs}, Sub, St) -> c_apply(A, Cop, Cargs, Sub, St); -expr(#c_call{anno=A,module=#c_literal{val=erlang},name=#c_literal{val=is_record}, - args=[_,Tag,Sz]=Args0}, Sub, St0) -> - {Args,Ap,St} = atomic_list(Args0, Sub, St0), - Remote = #k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=is_record},arity=3}, - case {Tag,Sz} of - {#c_literal{val=Atom},#c_literal{val=Int}} - when is_atom(Atom), is_integer(Int) -> - %% Tag and size are literals. Make it a BIF, which will actually - %% be expanded out in a later pass. - {#k_bif{anno=A,op=Remote,args=Args},Ap,St}; - {_,_} -> - %% (Only in bodies.) Make it into an actual call to the BIF. - {#k_call{anno=A,op=Remote,args=Args},Ap,St} - end; expr(#c_call{anno=A,module=M0,name=F0,args=Cargs}, Sub, St0) -> Ar = length(Cargs), - {Type,St1} = case call_type(M0, F0, Ar) of - error -> - %% Invalid call (e.g. M:42/3). Issue a warning, - %% and let the generated code use the old explict apply. - {old_apply,add_warning(get_line(A), bad_call, A, St0)}; - Type0 -> - {Type0,St0} - end, - - case Type of - old_apply -> + {[M,F|Kargs],Ap,St1} = atomic_list([M0,F0|Cargs], Sub, St0), + Remote = #k_remote{mod=M,name=F,arity=Ar}, + case call_type(M0, F0, Cargs) of + bif -> + {#k_bif{anno=A,op=Remote,args=Kargs},Ap,St1}; + call -> + {#k_call{anno=A,op=Remote,args=Kargs},Ap,St1}; + error -> + %% Invalid call (e.g. M:42/3). Issue a warning, and let + %% the generated code use the old explict apply. + St = add_warning(get_line(A), bad_call, A, St0), Call = #c_call{anno=A, module=#c_literal{val=erlang}, name=#c_literal{val=apply}, args=[M0,F0,cerl:make_list(Cargs)]}, - expr(Call, Sub, St1); - _ -> - {[M1,F1|Kargs],Ap,St} = atomic_list([M0,F0|Cargs], Sub, St1), - Call = case Type of - bif -> - #k_bif{anno=A,op=#k_remote{mod=M1,name=F1,arity=Ar}, - args=Kargs}; - call -> - #k_call{anno=A,op=#k_remote{mod=M1,name=F1,arity=Ar}, - args=Kargs}; - apply -> - #k_call{anno=A,op=#k_remote{mod=M1,name=F1,arity=Ar}, - args=Kargs} - end, - {Call,Ap,St} + expr(Call, Sub, St) end; -expr(#c_primop{anno=A,name=#c_literal{val=match_fail},args=Cargs0}, Sub, St0) -> - Cargs = translate_match_fail(Cargs0, Sub, A, St0), - {Kargs,Ap,St} = atomic_list(Cargs, Sub, St0), - Ar = length(Cargs), - Call = #k_call{anno=A,op=#k_remote{mod=#k_atom{val=erlang}, - name=#k_atom{val=error}, - arity=Ar},args=Kargs}, - {Call,Ap,St}; +expr(#c_primop{anno=A,name=#c_literal{val=match_fail},args=[Arg]}, Sub, St) -> + translate_match_fail(Arg, Sub, A, St); expr(#c_primop{anno=A,name=#c_literal{val=N},args=Cargs}, Sub, St0) -> {Kargs,Ap,St1} = atomic_list(Cargs, Sub, St0), Ar = length(Cargs), @@ -921,60 +362,90 @@ expr(#c_try{anno=A,arg=Ca,vars=Cvs,body=Cb,evars=Evs,handler=Ch}, Sub0, St0) -> evars=Kevs,handler=pre_seq(Ph, Kh)},[],St5}; expr(#c_catch{anno=A,body=Cb}, Sub, St0) -> {Kb,Pb,St1} = body(Cb, Sub, St0), - {#k_catch{anno=A,body=pre_seq(Pb, Kb)},[],St1}; -%% Handle internal expressions. -expr(#ireceive_accept{anno=A}, _Sub, St) -> {#k_receive_accept{anno=A},[],St}. - -%% Translate a function_clause exception to a case_clause exception if -%% it has been moved into another function. (A function_clause exception -%% will not work correctly if it is moved into another function, or -%% even if it is invoked not from the top level in the correct function.) -translate_match_fail(Args, Sub, Anno, St) -> - case Args of - [#c_tuple{es=[#c_literal{val=function_clause}|As]}] -> - translate_match_fail_1(Anno, As, Sub, St); - [#c_literal{val=Tuple}] when is_tuple(Tuple) -> - %% The inliner may have created a literal out of - %% the original #c_tuple{}. - case tuple_to_list(Tuple) of - [function_clause|As0] -> - As = [#c_literal{val=E} || E <- As0], - translate_match_fail_1(Anno, As, Sub, St); - _ -> - Args - end; - _ -> - %% Not a function_clause exception. - Args + {#k_catch{anno=A,body=pre_seq(Pb, Kb)},[],St1}. + +%% Implement letrec in the traditional way as a local +%% function for each definition in the letrec. + +letrec_local_function(A, Cfs, Cb, Sub0, St0) -> + %% Make new function names and store substitution. + {Fs0,{Sub1,St1}} = + mapfoldl(fun ({#c_var{name={F,Ar}},B0}, {Sub,S0}) -> + {N,St1} = new_fun_name(atom_to_list(F) + ++ "/" ++ + integer_to_list(Ar), + S0), + B = set_kanno(B0, [{letrec_name,N}]), + {{N,B},{set_fsub(F, Ar, N, Sub),St1}} + end, {Sub0,St0}, Cfs), + %% Run translation on functions and body. + {Fs1,St2} = mapfoldl(fun ({N,Fd0}, S1) -> + {Fd1,[],St2} = expr(Fd0, Sub1, S1), + Fd = set_kanno(Fd1, A), + {{N,Fd},St2} + end, St1, Fs0), + {Kb,Pb,St3} = body(Cb, Sub1, St2), + {Kb,[#iletrec{anno=A,defs=Fs1}|Pb],St3}. + +%% Implement letrec with the single definition as a label and each +%% apply of it as a goto. + +letrec_goto([{#c_var{name={Label,0}},Cfail}], Cb, Sub0, + #kern{labels=Labels0}=St0) -> + Labels = cerl_sets:add_element(Label, Labels0), + {Kb,Pb,St1} = body(Cb, Sub0, St0#kern{labels=Labels}), + #c_fun{body=FailBody} = Cfail, + {Kfail,Fb,St2} = body(FailBody, Sub0, St1), + case {Kb,Kfail,Fb} of + {#k_goto{label=Label},#k_goto{}=InnerGoto,[]} -> + {InnerGoto,Pb,St2}; + {_,_,_} -> + St3 = St2#kern{labels=Labels0}, + Alt = #k_letrec_goto{label=Label,first=Kb,then=pre_seq(Fb, Kfail)}, + {Alt,Pb,St3} end. -translate_match_fail_1(Anno, As, Sub, #kern{ff=FF}) -> - AnnoFunc = case keyfind(function_name, 1, Anno) of - false -> - none; %Force rewrite. - {function_name,{Name,Arity}} -> - {get_fsub(Name, Arity, Sub),Arity} - end, - case {AnnoFunc,FF} of - {Same,Same} -> - %% Still in the correct function. - translate_fc(As); - {{F,_},F} -> - %% Still in the correct function. - translate_fc(As); - _ -> - %% Wrong function or no function_name annotation. - %% - %% The inliner has copied the match_fail(function_clause) - %% primop from another function (or from another instance of - %% the current function). match_fail(function_clause) will - %% only work at the top level of the function it was originally - %% defined in, so we will need to rewrite it to a case_clause. - [c_tuple([#c_literal{val=case_clause},c_tuple(As)])] +%% translate_match_fail(Arg, Sub, Anno, St) -> {Kexpr,[PreKexpr],State}. +%% Translate a match_fail primop to a call erlang:error/1 or +%% erlang:error/2. + +translate_match_fail(Arg, Sub, Anno, St0) -> + Cargs = case {cerl:data_type(Arg),cerl:data_es(Arg)} of + {tuple,[#c_literal{val=function_clause}|As]} -> + translate_fc_args(As, Sub, St0); + {_,_} -> + [Arg] + end, + {Kargs,Ap,St} = atomic_list(Cargs, Sub, St0), + Ar = length(Cargs), + Call = #k_call{anno=Anno, + op=#k_remote{mod=#k_literal{val=erlang}, + name=#k_literal{val=error}, + arity=Ar},args=Kargs}, + {Call,Ap,St}. + +translate_fc_args(As, Sub, #kern{fargs=Fargs}) -> + case same_args(As, Fargs, Sub) of + true -> + %% The arguments for the `function_clause` exception are + %% the arguments for the current function in the correct + %% order. + [#c_literal{val=function_clause},cerl:make_list(As)]; + false -> + %% The arguments in the `function_clause` exception don't + %% match the arguments for the current function because + %% of inlining. Keeping the `function_clause` + %% exception reason would be confusing. Rewrite it to + %% a `case_clause` exception with the arguments in a + %% tuple. + [cerl:c_tuple([#c_literal{val=case_clause}, + cerl:c_tuple(As)])] end. -translate_fc(Args) -> - [#c_literal{val=function_clause},cerl:make_list(Args)]. +same_args([#c_var{name=Cv}|Vs], [#k_var{name=Kv}|As], Sub) -> + get_vsub(Cv, Sub) =:= Kv andalso same_args(Vs, As, Sub); +same_args([], [], _Sub) -> true; +same_args(_, _, _) -> false. expr_map(A,Var0,Ces,Sub,St0) -> {Var,Mps,St1} = expr(Var0, Sub, St0), @@ -1031,45 +502,43 @@ map_group_pairs(A, Var, Pairs0, Esp, St0) -> end. map_remove_dup_keys(Es) -> - dict:to_list(map_remove_dup_keys(Es, dict:new())). + map_remove_dup_keys(Es, #{}). -map_remove_dup_keys([{assoc,K0,V}|Es0],Used0) -> +map_remove_dup_keys([{assoc,K0,V}|Es0], Used0) -> K = map_key_clean(K0), - Op = case dict:find(K, Used0) of - {ok,{exact,_,_}} -> exact; - _ -> assoc - end, - Used1 = dict:store(K, {Op,K0,V}, Used0), + Op = case Used0 of + #{K:={exact,_,_}} -> exact; + #{} -> assoc + end, + Used1 = Used0#{K=>{Op,K0,V}}, map_remove_dup_keys(Es0, Used1); -map_remove_dup_keys([{exact,K0,V}|Es0],Used0) -> +map_remove_dup_keys([{exact,K0,V}|Es0], Used0) -> K = map_key_clean(K0), - Op = case dict:find(K, Used0) of - {ok,{assoc,_,_}} -> assoc; - _ -> exact - end, - Used1 = dict:store(K, {Op,K0,V}, Used0), + Op = case Used0 of + #{K:={assoc,_,_}} -> assoc; + #{} -> exact + end, + Used1 = Used0#{K=>{Op,K0,V}}, map_remove_dup_keys(Es0, Used1); -map_remove_dup_keys([], Used) -> Used. +map_remove_dup_keys([], Used) -> + %% We must sort the map entries to ensure consistent + %% order from compilation to compilation. + sort(maps:to_list(Used)). -%% Be explicit instead of using set_kanno(K, []). +%% Clean a map key from annotations. map_key_clean(#k_var{name=V}) -> {var,V}; -map_key_clean(#k_literal{val=V}) -> {lit,V}; -map_key_clean(#k_int{val=V}) -> {lit,V}; -map_key_clean(#k_float{val=V}) -> {lit,V}; -map_key_clean(#k_atom{val=V}) -> {lit,V}; -map_key_clean(#k_nil{}) -> {lit,[]}. - +map_key_clean(#k_literal{val=V}) -> {lit,V}. -%% call_type(Module, Function, Arity) -> call | bif | apply | error. +%% call_type(Module, Function, Arity) -> call | bif | error. %% Classify the call. -call_type(#c_literal{val=M}, #c_literal{val=F}, Ar) when is_atom(M), is_atom(F) -> - case is_remote_bif(M, F, Ar) of +call_type(#c_literal{val=M}, #c_literal{val=F}, As) when is_atom(M), is_atom(F) -> + case is_remote_bif(M, F, As) of false -> call; true -> bif end; -call_type(#c_var{}, #c_literal{val=A}, _) when is_atom(A) -> apply; -call_type(#c_literal{val=A}, #c_var{}, _) when is_atom(A) -> apply; -call_type(#c_var{}, #c_var{}, _) -> apply; +call_type(#c_var{}, #c_literal{val=A}, _) when is_atom(A) -> call; +call_type(#c_literal{val=A}, #c_var{}, _) when is_atom(A) -> call; +call_type(#c_var{}, #c_var{}, _) -> call; call_type(_, _, _) -> error. %% match_vars(Kexpr, State) -> {[Kvar],[PreKexpr],State}. @@ -1085,13 +554,19 @@ match_vars(Ka, St0) -> {[V],Vp,St1}. %% c_apply(A, Op, [Carg], Sub, State) -> {Kexpr,[PreKexpr],State}. -%% Transform application, detect which are guaranteed to be bifs. +%% Transform application. -c_apply(A, #c_var{anno=Ra,name={F0,Ar}}, Cargs, Sub, St0) -> - {Kargs,Ap,St1} = atomic_list(Cargs, Sub, St0), - F1 = get_fsub(F0, Ar, Sub), %Has it been rewritten - {#k_call{anno=A,op=#k_local{anno=Ra,name=F1,arity=Ar},args=Kargs}, - Ap,St1}; +c_apply(A, #c_var{anno=Ra,name={F0,Ar}}, Cargs, Sub, #kern{labels=Labels}=St0) -> + case Ar =:= 0 andalso cerl_sets:is_element(F0, Labels) of + true -> + %% This is a goto to a label in a letrec_goto construct. + {#k_goto{label=F0},[],St0}; + false -> + {Kargs,Ap,St1} = atomic_list(Cargs, Sub, St0), + F1 = get_fsub(F0, Ar, Sub), %Has it been rewritten + {#k_call{anno=A,op=#k_local{anno=Ra,name=F1,arity=Ar},args=Kargs}, + Ap,St1} + end; c_apply(A, Cop, Cargs, Sub, St0) -> {Kop,Op,St1} = variable(Cop, Sub, St0), {Kargs,Ap,St2} = atomic_list(Cargs, Sub, St1), @@ -1125,12 +600,6 @@ force_atomic(Ke, St0) -> {V,[#iset{vars=[V],arg=Ke}],St1} end. -% force_atomic_list(Kes, St) -> -% foldr(fun (Ka, {As,Asp,St0}) -> -% {A,Ap,St1} = force_atomic(Ka, St0), -% {[A|As],Ap ++ Asp,St1} -% end, {[],[],St}, Kes). - atomic_bin([#c_bitstr{anno=A,val=E0,size=S0,unit=U0,type=T,flags=Fs0}|Es0], Sub, St0) -> {E,Ap1,St1} = atomic(E0, Sub, St0), @@ -1148,11 +617,14 @@ atomic_bin([#c_bitstr{anno=A,val=E0,size=S0,unit=U0,type=T,flags=Fs0}|Es0], atomic_bin([], _Sub, St) -> {#k_bin_end{},[],St}. validate_bin_element_size(#k_var{}) -> ok; -validate_bin_element_size(#k_int{val=V}) when V >= 0 -> ok; -validate_bin_element_size(#k_atom{val=all}) -> ok; -validate_bin_element_size(#k_atom{val=undefined}) -> ok; -validate_bin_element_size(_) -> throw(bad_element_size). - +validate_bin_element_size(#k_literal{val=Val}) -> + case Val of + all -> ok; + undefined -> ok; + _ when is_integer(Val), Val >= 0 -> ok; + _ -> throw(bad_element_size) + end. + %% atomic_list([Cexpr], Sub, State) -> {[Kexpr],[PreKexpr],State}. atomic_list(Ces, Sub, St) -> @@ -1162,15 +634,11 @@ atomic_list(Ces, Sub, St) -> end, {[],[],St}, Ces). %% is_atomic(Kexpr) -> boolean(). -%% Is a Kexpr atomic? Strings are NOT considered atomic! +%% Is a Kexpr atomic? is_atomic(#k_literal{}) -> true; -is_atomic(#k_int{}) -> true; -is_atomic(#k_float{}) -> true; -is_atomic(#k_atom{}) -> true; -%%is_atomic(#k_char{}) -> true; %No characters -is_atomic(#k_nil{}) -> true; is_atomic(#k_var{}) -> true; +%%is_atomic(#k_char{}) -> true; %No characters is_atomic(_) -> false. %% variable(Cexpr, Sub, State) -> {Kvar,[PreKexpr],State}. @@ -1234,7 +702,7 @@ flatten_alias(Pat) -> {[],Pat}. pattern_map_pairs(Ces0, Isub, Osub0, St0) -> %% pattern the pair keys and values as normal - {Kes,{Osub1,St1}} = lists:mapfoldl(fun + {Kes,{Osub1,St1}} = mapfoldl(fun (#c_map_pair{anno=A,key=Ck,val=Cv},{Osubi0,Sti0}) -> {Kk,[],Sti1} = expr(Ck, Isub, Sti0), {Kv,Osubi2,Sti2} = pattern(Cv, Isub, Osubi0, Sti1), @@ -1242,7 +710,7 @@ pattern_map_pairs(Ces0, Isub, Osub0, St0) -> end, {Osub0, St0}, Ces0), %% It is later assumed that these keys are term sorted %% so we need to sort them here - Kes1 = lists:sort(fun + Kes1 = sort(fun (#k_map_pair{key=KkA},#k_map_pair{key=KkB}) -> A = map_key_clean(KkA), B = map_key_clean(KkB), @@ -1250,41 +718,84 @@ pattern_map_pairs(Ces0, Isub, Osub0, St0) -> end, Kes), {Kes1,Osub1,St1}. -pattern_bin(Es, Isub, Osub0, St0) -> - {Kbin,{_,Osub},St} = pattern_bin_1(Es, Isub, Osub0, St0), - {Kbin,Osub,St}. +pattern_bin(Es, Isub, Osub0, St) -> + pattern_bin_1(Es, Isub, Osub0, St). -pattern_bin_1([#c_bitstr{anno=A,val=E0,size=S0,unit=U,type=T,flags=Fs}|Es0], - Isub0, Osub0, St0) -> - {S1,[],St1} = expr(S0, Isub0, St0), +pattern_bin_1([#c_bitstr{anno=A,val=E0,size=S0,unit=U0,type=T,flags=Fs0}|Es0], + Isub, Osub0, St0) -> + {S1,[],St1} = expr(S0, Isub, St0), S = case S1 of - #k_int{} -> S1; #k_var{} -> S1; - #k_atom{} -> S1; + #k_literal{val=Val} when is_integer(Val); is_atom(Val) -> S1; _ -> %% Bad size (coming from an optimization or Core Erlang %% source code) - replace it with a known atom because %% a literal or bit syntax construction can cause further %% problems. - #k_atom{val=bad_size} + #k_literal{val=bad_size} end, - U0 = cerl:concrete(U), - Fs0 = cerl:concrete(Fs), - %%ok= io:fwrite("~w: ~p~n", [?LINE,{B0,S,U0,Fs0}]), - {E,Osub1,St2} = pattern(E0, Isub0, Osub0, St1), - Isub1 = case E0 of - #c_var{name=V} -> - set_vsub(V, E#k_var.name, Isub0); - _ -> Isub0 - end, - {Es,{Isub,Osub},St3} = pattern_bin_1(Es0, Isub1, Osub1, St2), - {#k_bin_seg{anno=A,size=S, - unit=U0, - type=cerl:concrete(T), - flags=Fs0, - seg=E,next=Es}, - {Isub,Osub},St3}; -pattern_bin_1([], Isub, Osub, St) -> {#k_bin_end{},{Isub,Osub},St}. + U = cerl:concrete(U0), + Fs = cerl:concrete(Fs0), + {E,Osub1,St2} = pattern(E0, Isub, Osub0, St1), + {Es,Osub,St3} = pattern_bin_1(Es0, Isub, Osub1, St2), + {build_bin_seg(A, S, U, cerl:concrete(T), Fs, E, Es),Osub,St3}; +pattern_bin_1([], _Isub, Osub, St) -> + {#k_bin_end{},Osub,St}. + +%% build_bin_seg(Anno, Size, Unit, Type, Flags, Seg, Next) -> #k_bin_seg{}. +%% This function normalizes literal integers with size > 8 and literal +%% utf8 segments into integers with size = 8 (and potentially an integer +%% with size less than 8 at the end). This is so further optimizations +%% have a normalized view of literal integers, allowing us to generate +%% more literals and group more clauses. Those integers may be "squeezed" +%% later into the largest integer possible. +%% +build_bin_seg(A, #k_literal{val=Bits} = Sz, U, integer=Type, + [unsigned,big]=Flags, #k_literal{val=Int}=Seg, Next) -> + Size = Bits * U, + case integer_fits_and_is_expandable(Int, Size) of + true -> build_bin_seg_integer_recur(A, Size, Int, Next); + false -> #k_bin_seg{anno=A,size=Sz,unit=U,type=Type,flags=Flags,seg=Seg,next=Next} + end; +build_bin_seg(A, Sz, U, utf8=Type, [unsigned,big]=Flags, #k_literal{val=Utf8} = Seg, Next) -> + case utf8_fits(Utf8) of + {Int, Bits} -> build_bin_seg_integer_recur(A, Bits, Int, Next); + error -> #k_bin_seg{anno=A,size=Sz,unit=U,type=Type,flags=Flags,seg=Seg,next=Next} + end; +build_bin_seg(A, Sz, U, Type, Flags, Seg, Next) -> + #k_bin_seg{anno=A,size=Sz,unit=U,type=Type,flags=Flags,seg=Seg,next=Next}. + +build_bin_seg_integer_recur(A, Bits, Val, Next) when Bits > 8 -> + NextBits = Bits - 8, + NextVal = Val band ((1 bsl NextBits) - 1), + Last = build_bin_seg_integer_recur(A, NextBits, NextVal, Next), + build_bin_seg_integer(A, 8, Val bsr NextBits, Last); + +build_bin_seg_integer_recur(A, Bits, Val, Next) -> + build_bin_seg_integer(A, Bits, Val, Next). + +build_bin_seg_integer(A, Bits, Val, Next) -> + Sz = #k_literal{anno=A,val=Bits}, + Seg = #k_literal{anno=A,val=Val}, + #k_bin_seg{anno=A,size=Sz,unit=1,type=integer,flags=[unsigned,big],seg=Seg,next=Next}. + +integer_fits_and_is_expandable(Int, Size) when 0 < Size, Size =< ?EXPAND_MAX_SIZE_SEGMENT -> + case <<Int:Size>> of + <<Int:Size>> -> true; + _ -> false + end; +integer_fits_and_is_expandable(_Int, _Size) -> + false. + +utf8_fits(Utf8) -> + try + Bin = <<Utf8/utf8>>, + Bits = bit_size(Bin), + <<Int:Bits>> = Bin, + {Int, Bits} + catch + _:_ -> error + end. %% pattern_list([Cexpr], Sub, State) -> {[Kexpr],Sub,State}. @@ -1411,23 +922,25 @@ new_vars(0, St, Vs) -> {Vs,St}. make_vars(Vs) -> [ #k_var{name=V} || V <- Vs ]. -add_var_def(V, St) -> - St#kern{ds=cerl_sets:add_element(V#k_var.name, St#kern.ds)}. - -%%add_vars_def(Vs, St) -> -%% Ds = foldl(fun (#k_var{name=V}, Ds) -> add_element(V, Ds) end, -%% St#kern.ds, Vs), -%% St#kern{ds=Ds}. - %% is_remote_bif(Mod, Name, Arity) -> true | false. %% Test if function is really a BIF. -is_remote_bif(erlang, get, 1) -> true; -is_remote_bif(erlang, N, A) -> - case erl_internal:guard_bif(N, A) of +is_remote_bif(erlang, get, [_]) -> true; +is_remote_bif(erlang, is_record, [_,Tag,Sz]) -> + case {Tag,Sz} of + {#c_literal{val=Atom},#c_literal{val=Int}} + when is_atom(Atom), is_integer(Int) -> + %% Tag and size are literals. This is a guard BIF. + true; + {_,_} -> + false + end; +is_remote_bif(erlang, N, As) -> + Arity = length(As), + case erl_internal:guard_bif(N, Arity) of true -> true; false -> - try erl_internal:op_type(N, A) of + try erl_internal:op_type(N, Arity) of arith -> true; bool -> true; comp -> true; @@ -1445,6 +958,7 @@ is_remote_bif(_, _, _) -> false. %% return multiple values. Only used in bodies where a BIF may be %% called for effect only. +bif_vals(recv_peek_message, 0) -> 2; bif_vals(_, _) -> 1. bif_vals(_, _, _) -> 1. @@ -1488,11 +1002,6 @@ foldr2(_, Acc, [], []) -> Acc. kmatch(Us, Ccs, Sub, St0) -> {Cs,St1} = match_pre(Ccs, Sub, St0), %Convert clauses Def = fail, -%% Def = #k_call{anno=[compiler_generated], -%% op=#k_remote{mod=#k_atom{val=erlang}, -%% name=#k_atom{val=exit}, -%% arity=1}, -%% args=[#k_atom{val=kernel_match_error}]}, match(Us, Cs, Def, St1). %Do the match. %% match_pre([Cclause], Sub, State) -> {[Clause],State}. @@ -1566,7 +1075,7 @@ maybe_add_warning(Ke, MatchAnno, St) -> get_line([Line|_]) when is_integer(Line) -> Line; get_line([_|T]) -> get_line(T); get_line([]) -> none. - + get_file([{file,File}|_]) -> File; get_file([_|T]) -> get_file(T); get_file([]) -> "no_file". % should not happen @@ -1682,31 +1191,27 @@ expand_pat_lit_clause(#iclause{pats=[#k_literal{anno=A,val=Val}|Ps]}=C) -> expand_pat_lit_clause(C) -> C. expand_pat_lit([H|T], A) -> - #k_cons{anno=A,hd=literal(H, A),tl=literal(T, A)}; + #k_cons{anno=A,hd=#k_literal{anno=A,val=H},tl=#k_literal{anno=A,val=T}}; expand_pat_lit(Tuple, A) when is_tuple(Tuple) -> - #k_tuple{anno=A,es=[literal(E, A) || E <- tuple_to_list(Tuple)]}; + #k_tuple{anno=A,es=[#k_literal{anno=A,val=E} || E <- tuple_to_list(Tuple)]}; expand_pat_lit(Lit, A) -> - literal(Lit, A). - -literal([], A) -> - #k_nil{anno=A}; -literal(Val, A) when is_integer(Val) -> - #k_int{anno=A,val=Val}; -literal(Val, A) when is_float(Val) -> - #k_float{anno=A,val=Val}; -literal(Val, A) when is_atom(Val) -> - #k_atom{anno=A,val=Val}; -literal(Val, A) when is_list(Val); is_tuple(Val) -> - #k_literal{anno=A,val=Val}. + #k_literal{anno=A,val=Lit}. %% opt_singled_valued([{Type,Clauses}]) -> [{Type,Clauses}]. -%% If a type only has one clause and if the pattern is literal, -%% the matching can be done more efficiently by directly comparing -%% with the literal (that is especially true for binaries). +%% If a type only has one clause and if the pattern is a complex +%% literal, the matching can be done more efficiently by directly +%% comparing with the literal (that is especially true for binaries). +%% +%% It is important not to do this transformation for atomic literals +%% (such as `[]`), since that would cause the test for an emtpy list +%% to be executed before the test for a nonempty list. opt_single_valued(Ttcs) -> opt_single_valued(Ttcs, [], []). +opt_single_valued([{_,[#iclause{pats=[#k_literal{}|_]}]}=Ttc|Ttcs], TtcAcc, LitAcc) -> + %% This is an atomic literal. + opt_single_valued(Ttcs, [Ttc|TtcAcc], LitAcc); opt_single_valued([{_,[#iclause{pats=[P0|Ps]}=Tc]}=Ttc|Ttcs], TtcAcc, LitAcc) -> try combine_lit_pat(P0) of P -> @@ -1736,26 +1241,13 @@ opt_single_valued([], TtcAcc, LitAcc) -> combine_lit_pat(#ialias{pat=Pat0}=Alias) -> Pat = combine_lit_pat(Pat0), Alias#ialias{pat=Pat}; +combine_lit_pat(#k_literal{}) -> + %% This is an atomic literal. Rewriting would be a pessimization, + %% especially for `[]`. + throw(not_possible); combine_lit_pat(Pat) -> - case do_combine_lit_pat(Pat) of - #k_literal{val=Val} when is_atom(Val) -> - throw(not_possible); - #k_literal{val=Val} when is_number(Val) -> - throw(not_possible); - #k_literal{val=[]} -> - throw(not_possible); - #k_literal{}=Lit -> - Lit - end. + do_combine_lit_pat(Pat). -do_combine_lit_pat(#k_atom{anno=A,val=Val}) -> - #k_literal{anno=A,val=Val}; -do_combine_lit_pat(#k_float{anno=A,val=Val}) -> - #k_literal{anno=A,val=Val}; -do_combine_lit_pat(#k_int{anno=A,val=Val}) -> - #k_literal{anno=A,val=Val}; -do_combine_lit_pat(#k_nil{anno=A}) -> - #k_literal{anno=A,val=[]}; do_combine_lit_pat(#k_binary{anno=A,segs=Segs}) -> Bin = combine_bin_segs(Segs), #k_literal{anno=A,val=Bin}; @@ -1774,27 +1266,10 @@ do_combine_lit_pat(#k_tuple{anno=A,es=Es0}) -> do_combine_lit_pat(_) -> throw(not_possible). -combine_bin_segs(#k_bin_seg{size=Size0,unit=Unit,type=integer, - flags=[unsigned,big],seg=Seg,next=Next}) -> - #k_literal{val=Size1} = do_combine_lit_pat(Size0), - #k_literal{val=Int} = do_combine_lit_pat(Seg), - Size = Size1 * Unit, - if - 0 < Size, Size < 64 -> - Bin = <<Int:Size>>, - case Bin of - <<Int:Size>> -> - NextBin = combine_bin_segs(Next), - <<Bin/bits,NextBin/bits>>; - _ -> - %% The integer Int does not fit in the segment, - %% thus it will not match. - throw(not_possible) - end; - true -> - %% Avoid creating huge binary literals. - throw(not_possible) - end; +combine_bin_segs(#k_bin_seg{size=#k_literal{val=8},unit=1,type=integer, + flags=[unsigned,big],seg=#k_literal{val=Int},next=Next}) + when is_integer(Int), 0 =< Int, Int =< 255 -> + <<Int,(combine_bin_segs(Next))/bits>>; combine_bin_segs(#k_bin_end{}) -> <<>>; combine_bin_segs(_) -> @@ -1862,13 +1337,12 @@ handle_bin_con_not_possible([]) -> []. %% exception is thrown. select_bin_int([#iclause{pats=[#k_bin_seg{anno=A,type=integer, - size=#k_int{val=Bits0}=Sz,unit=U, - flags=Fl,seg=#k_literal{val=Val}, - next=N}|Ps]}=C|Cs0]) - when is_integer(Val) -> + size=#k_literal{val=Bits0}=Sz,unit=U, + flags=Fl,seg=#k_literal{val=Val}, + next=N}|Ps]}=C|Cs0]) when is_integer(Bits0) -> Bits = U * Bits0, if - Bits > 1024 -> throw(not_possible); %Expands the code too much. + Bits > ?EXPAND_MAX_SIZE_SEGMENT -> throw(not_possible); %Expands the code too much. true -> ok end, select_assert_match_possible(Bits, Val, Fl), @@ -1879,20 +1353,10 @@ select_bin_int([#iclause{pats=[#k_bin_seg{anno=A,type=integer, end, Cs = select_bin_int_1(Cs0, Bits, Fl, Val), [{k_bin_int,[C#iclause{pats=[P|Ps]}|Cs]}]; -select_bin_int([#iclause{pats=[#k_bin_seg{anno=A,type=utf8, - flags=[unsigned,big]=Fl, - seg=#k_literal{val=Val0}, - next=N}|Ps]}=C|Cs0]) - when is_integer(Val0) -> - {Val,Bits} = select_utf8(Val0), - P = #k_bin_int{anno=A,size=#k_int{val=Bits},unit=1, - flags=Fl,val=Val,next=N}, - Cs = select_bin_int_1(Cs0, Bits, Fl, Val), - [{k_bin_int,[C#iclause{pats=[P|Ps]}|Cs]}]; select_bin_int(_) -> throw(not_possible). select_bin_int_1([#iclause{pats=[#k_bin_seg{anno=A,type=integer, - size=#k_int{val=Bits0}=Sz, + size=#k_literal{val=Bits0}=Sz, unit=U, flags=Fl,seg=#k_literal{val=Val}, next=N}|Ps]}=C|Cs], @@ -1903,18 +1367,6 @@ select_bin_int_1([#iclause{pats=[#k_bin_seg{anno=A,type=integer, end, P = #k_bin_int{anno=A,size=Sz,unit=U,flags=Fl,val=Val,next=N}, [C#iclause{pats=[P|Ps]}|select_bin_int_1(Cs, Bits, Fl, Val)]; -select_bin_int_1([#iclause{pats=[#k_bin_seg{anno=A,type=utf8, - flags=Fl, - seg=#k_literal{val=Val0}, - next=N}|Ps]}=C|Cs], - Bits, Fl, Val) when is_integer(Val0) -> - case select_utf8(Val0) of - {Val,Bits} -> ok; - {_,_} -> throw(not_possible) - end, - P = #k_bin_int{anno=A,size=#k_int{val=Bits},unit=1, - flags=[unsigned,big],val=Val,next=N}, - [C#iclause{pats=[P|Ps]}|select_bin_int_1(Cs, Bits, Fl, Val)]; select_bin_int_1([], _, _, _) -> []; select_bin_int_1(_, _, _, _) -> throw(not_possible). @@ -1940,17 +1392,6 @@ match_fun(Val) -> {match,Bs} end. -select_utf8(Val0) -> - try - Bin = <<Val0/utf8>>, - Size = bit_size(Bin), - <<Val:Size>> = Bin, - {Val,Size} - catch - error:_ -> - throw(not_possible) - end. - %% match_value([Var], Con, [Clause], Default, State) -> {SelectExpr,State}. %% At this point all the clauses have the same constructor, we must %% now separate them according to value. @@ -1961,104 +1402,108 @@ match_value(Us0, T, Cs0, Def, St0) -> %%ok = io:format("match_value ~p ~p~n", [T, Css]), mapfoldl(fun ({Us,Cs}, St) -> match_clause(Us, Cs, Def, St) end, St1, UCss). -%% partition_intersection -%% Partitions a map into two maps with the most common keys to the first map. +%% partition_intersection(Type, Us, [Clause], State) -> {Us,Cs,State}. +%% Partitions a map into two maps with the most common keys to the +%% first map. +%% %% case <M> of -%% <#{a}> %% <#{a,b}> %% <#{a,c}> -%% <#{c}> +%% <#{a}> %% end +%% %% becomes +%% %% case <M,M> of -%% <#{a}, #{ }> %% <#{a}, #{b}> -%% <#{ }, #{c}> %% <#{a}, #{c}> +%% <#{a}, #{ }> %% end -%% The intention is to group as many keys together as possible and thus -%% reduce the number of lookups to that key. -partition_intersection(k_map, [U|_]=Us0, [_,_|_]=Cs0,St0) -> +%% +%% The intention is to group as many keys together as possible and +%% thus reduce the number of lookups to that key. + +partition_intersection(k_map, [U|_]=Us, [_,_|_]=Cs0, St0) -> Ps = [clause_val(C) || C <- Cs0], - case find_key_partition(Ps) of - no_partition -> - {Us0,Cs0,St0}; + case find_key_intersection(Ps) of + none -> + {Us,Cs0,St0}; Ks -> - {Cs1,St1} = mapfoldl(fun(#iclause{pats=[Arg|Args]}=C, Sti) -> - {{Arg1,Arg2},St} = partition_key_intersection(Arg, Ks, Sti), - {C#iclause{pats=[Arg1,Arg2|Args]}, St} - end, St0, Cs0), - {[U|Us0],Cs1,St1} + Cs1 = map(fun(#iclause{pats=[Arg|Args]}=C) -> + {Arg1,Arg2} = partition_keys(Arg, Ks), + C#iclause{pats=[Arg1,Arg2|Args]} + end, Cs0), + {[U|Us],Cs1,St0} end; partition_intersection(_, Us, Cs, St) -> {Us,Cs,St}. -partition_key_intersection(#k_map{es=Pairs}=Map,Ks,St0) -> - F = fun(#k_map_pair{key=Key}) -> member(map_key_clean(Key), Ks) end, +partition_keys(#k_map{es=Pairs}=Map, Ks) -> + F = fun(#k_map_pair{key=Key}) -> + cerl_sets:is_element(map_key_clean(Key), Ks) + end, {Ps1,Ps2} = partition(F, Pairs), - {{Map#k_map{es=Ps1},Map#k_map{es=Ps2}},St0}; -partition_key_intersection(#ialias{pat=Map}=Alias,Ks,St0) -> - %% only alias one of them - {{Map1,Map2},St1} = partition_key_intersection(Map, Ks, St0), - {{Map1,Alias#ialias{pat=Map2}},St1}. - -% Only check for the complete intersection of keys and not commonality -find_key_partition(Ps) -> - Sets = [sets:from_list(Ks)||Ks <- Ps], - Is = sets:intersection(Sets), - case sets:to_list(Is) of - [] -> no_partition; - KeyIntersection -> - %% Check if the intersection are all keys in all clauses. - %% Don't split if they are since this will only - %% infer extra is_map instructions with no gain. - All = foldl(fun (Kset, Bool) -> - Bool andalso sets:is_subset(Kset, Is) - end, true, Sets), - if All -> no_partition; - true -> KeyIntersection + {Map#k_map{es=Ps1},Map#k_map{es=Ps2}}; +partition_keys(#ialias{pat=Map}=Alias, Ks) -> + %% Only alias one of them. + {Map1,Map2} = partition_keys(Map, Ks), + {Map1,Alias#ialias{pat=Map2}}. + +find_key_intersection(Ps) -> + Sets = [cerl_sets:from_list(Ks) || Ks <- Ps], + Intersection = cerl_sets:intersection(Sets), + case cerl_sets:size(Intersection) of + 0 -> + none; + _ -> + All = all(fun (Kset) -> Kset =:= Intersection end, Sets), + case All of + true -> + %% All clauses test the same keys. Partitioning + %% the keys could only make the code worse. + none; + false -> + Intersection end end. %% group_value([Clause]) -> [[Clause]]. %% Group clauses according to value. Here we know that %% 1. Some types are singled valued -%% 2. The clauses in bin_segs cannot be reordered only grouped +%% 2. The clauses in maps and bin_segs cannot be reordered, +%% only grouped %% 3. Other types are disjoint and can be reordered -group_value(k_cons, Us, Cs) -> [{Us,Cs}]; %These are single valued +group_value(k_cons, Us, Cs) -> [{Us,Cs}]; %These are single valued group_value(k_nil, Us, Cs) -> [{Us,Cs}]; group_value(k_binary, Us, Cs) -> [{Us,Cs}]; group_value(k_bin_end, Us, Cs) -> [{Us,Cs}]; -group_value(k_bin_seg, Us, Cs) -> group_bin_seg(Us,Cs); +group_value(k_bin_seg, Us, Cs) -> group_keeping_order(Us, Cs); group_value(k_bin_int, Us, Cs) -> [{Us,Cs}]; -group_value(k_map, Us, Cs) -> group_map(Us,Cs); +group_value(k_map, Us, Cs) -> group_keeping_order(Us, Cs); group_value(_, Us, Cs) -> - %% group_value(Cs). - Cd = foldl(fun (C, Gcs0) -> dict:append(clause_val(C), C, Gcs0) end, - dict:new(), Cs), - dict:fold(fun (_, Vcs, Css) -> [{Us,Vcs}|Css] end, [], Cd). - -group_bin_seg(Us, [C1|Cs]) -> - V1 = clause_val(C1), - {More,Rest} = splitwith(fun (C) -> clause_val(C) == V1 end, Cs), - [{Us,[C1|More]}|group_bin_seg(Us,Rest)]; -group_bin_seg(_, []) -> []. + Map = group_values(Cs, #{}), + %% We must sort the grouped values to ensure consistent + %% order from compilation to compilation. + sort(maps:fold(fun (_, Vcs, Css) -> + [{Us,reverse(Vcs)}|Css] + end, [], Map)). + +group_values([C|Cs], Acc) -> + Val = clause_val(C), + case Acc of + #{Val:=Gcs} -> + group_values(Cs, Acc#{Val:=[C|Gcs]}); + #{} -> + group_values(Cs, Acc#{Val=>[C]}) + end; +group_values([], Acc) -> Acc. -group_map(Us, [C1|Cs]) -> +group_keeping_order(Us, [C1|Cs]) -> V1 = clause_val(C1), {More,Rest} = splitwith(fun (C) -> clause_val(C) =:= V1 end, Cs), - [{Us,[C1|More]}|group_map(Us,Rest)]; -group_map(_, []) -> []. - -%% Profiling shows that this quadratic implementation account for a big amount -%% of the execution time if there are many values. -% group_value([C|Cs]) -> -% V = clause_val(C), -% Same = [ Cv || Cv <- Cs, clause_val(Cv) == V ], %Same value -% Rest = [ Cv || Cv <- Cs, clause_val(Cv) /= V ], % and all the rest -% [[C|Same]|group_value(Rest)]; -% group_value([]) -> []. + [{Us,[C1|More]}|group_keeping_order(Us, Rest)]; +group_keeping_order(_, []) -> []. %% match_clause([Var], [Clause], Default, State) -> {Clause,State}. %% At this point all the clauses have the same "value". Build one @@ -2070,7 +1515,8 @@ match_clause([U|Us], [C|_]=Cs0, Def, St0) -> {Match0,Vs,St1} = get_match(get_con(Cs0), St0), Match = sub_size_var(Match0, Cs0), {Cs1,St2} = new_clauses(Cs0, U, St1), - {B,St3} = match(Vs ++ Us, Cs1, Def, St2), + Cs2 = squeeze_clauses_by_bin_integer_count(Cs1, []), + {B,St3} = match(Vs ++ Us, Cs2, Def, St2), {#k_val_clause{anno=Anno,val=Match,body=B},St3}. sub_size_var(#k_bin_seg{size=#k_var{name=Name}=Kvar}=BinSeg, [#iclause{isub=Sub}|_]) -> @@ -2085,17 +1531,14 @@ get_match(#k_cons{}, St0) -> get_match(#k_binary{}, St0) -> {[V]=Mes,St1} = new_vars(1, St0), {#k_binary{segs=V},Mes,St1}; -get_match(#k_bin_seg{size=#k_atom{val=all},next={k_bin_end,[]}}=Seg, St0) -> - {[S,N0],St1} = new_vars(2, St0), - N = set_kanno(N0, [no_usage]), +get_match(#k_bin_seg{size=#k_literal{val=all},next={k_bin_end,[]}}=Seg, St0) -> + {[S,N],St1} = new_vars(2, St0), {Seg#k_bin_seg{seg=S,next=N},[S],St1}; get_match(#k_bin_seg{}=Seg, St0) -> - {[S,N0],St1} = new_vars(2, St0), - N = set_kanno(N0, [no_usage]), + {[S,N],St1} = new_vars(2, St0), {Seg#k_bin_seg{seg=S,next=N},[S,N],St1}; get_match(#k_bin_int{}=BinInt, St0) -> - {N0,St1} = new_var(St0), - N = set_kanno(N0, [no_usage]), + {N,St1} = new_var(St0), {BinInt#k_bin_int{next=N},[N],St1}; get_match(#k_tuple{es=Es}, St0) -> {Mes,St1} = new_vars(length(Es), St0), @@ -2116,7 +1559,7 @@ new_clauses(Cs0, U, St) -> #k_cons{hd=H,tl=T} -> [H,T|As]; #k_tuple{es=Es} -> Es ++ As; #k_binary{segs=E} -> [E|As]; - #k_bin_seg{size=#k_atom{val=all}, + #k_bin_seg{size=#k_literal{val=all}, seg=S,next={k_bin_end,[]}} -> [S|As]; #k_bin_seg{seg=S,next=N} -> @@ -2140,6 +1583,104 @@ new_clauses(Cs0, U, St) -> end, Cs0), {Cs1,St}. +%% group and squeeze +%% The goal of those functions is to group subsequent integer k_bin_seg +%% literals by count so we can leverage bs_get_integer_16 whenever possible. +%% +%% The priority is to create large groups. So if we have three clauses matching +%% on 16-bits/16-bits/8-bits, we will first have a single 8-bits match for all +%% three clauses instead of clauses (one with 16 and another with 8). But note +%% the algorithm is recursive, so the remaining 8-bits for the first two clauses +%% will be grouped next. +%% +%% We also try to not create too large groups. If we have too many clauses, +%% it is preferrable to match on 8-bits, select a branch, then match on the +%% next 8-bits, rather than match on 16-bits which would force us to have +%% to select to many values at the same time, which would not be efficient. +%% +%% Another restriction is that we create groups only if the end of the +%% group is a variadic clause or the end of the binary. That's because +%% if we have 16-bits/16-bits/catch-all, breaking it into a 16-bits lookup +%% will make the catch-all more expensive. +%% +%% Clauses are grouped in reverse when squeezing and then flattened and +%% re-reversed at the end. +squeeze_clauses_by_bin_integer_count([Clause | Clauses], Acc) -> + case clause_count_bin_integer_segments(Clause) of + {literal, N} -> squeeze_clauses_by_bin_integer_count(Clauses, N, 1, [Clause], Acc); + _ -> squeeze_clauses_by_bin_integer_count(Clauses, [[Clause] | Acc]) + end; +squeeze_clauses_by_bin_integer_count(_, Acc) -> + flat_reverse(Acc, []). + +squeeze_clauses_by_bin_integer_count([], N, Count, GroupAcc, Acc) -> + Squeezed = squeeze_clauses(GroupAcc, fix_count_without_variadic_segment(N), Count), + flat_reverse([Squeezed | Acc], []); +squeeze_clauses_by_bin_integer_count([#iclause{pats=[#k_bin_end{} | _]} = Clause], N, Count, GroupAcc, Acc) -> + Squeezed = squeeze_clauses(GroupAcc, fix_count_without_variadic_segment(N), Count), + flat_reverse([[Clause | Squeezed] | Acc], []); +squeeze_clauses_by_bin_integer_count([Clause | Clauses], N, Count, GroupAcc, Acc) -> + case clause_count_bin_integer_segments(Clause) of + {literal, NewN} -> + squeeze_clauses_by_bin_integer_count(Clauses, min(N, NewN), Count + 1, [Clause | GroupAcc], Acc); + + {variadic, NewN} when NewN =< N -> + Squeezed = squeeze_clauses(GroupAcc, NewN, Count), + squeeze_clauses_by_bin_integer_count(Clauses, [[Clause | Squeezed] | Acc]); + + _ -> + squeeze_clauses_by_bin_integer_count(Clauses, [[Clause | GroupAcc] | Acc]) + end. + +clause_count_bin_integer_segments(#iclause{pats=[#k_bin_seg{seg=#k_literal{}} = BinSeg | _]}) -> + count_bin_integer_segments(BinSeg, 0); +clause_count_bin_integer_segments(#iclause{pats=[#k_bin_seg{size=#k_literal{val=Size},unit=Unit, + type=integer,flags=[unsigned,big], + seg=#k_var{}} | _]}) + when ((Size * Unit) rem 8) =:= 0 -> + {variadic, (Size * Unit) div 8}; +clause_count_bin_integer_segments(_) -> + error. + +count_bin_integer_segments(#k_bin_seg{size=#k_literal{val=8},unit=1,type=integer,flags=[unsigned,big], + seg=#k_literal{val=Int},next=Next}, Count) + when is_integer(Int), 0 =< Int, Int =< 255 -> + count_bin_integer_segments(Next, Count + 1); +count_bin_integer_segments(_, Count) when Count > 0 -> + {literal, Count}; +count_bin_integer_segments(_, _Count) -> + error. + +%% Since 4 bytes in on 32-bits systems are bignums, we convert +%% anything more than 3 into 2 bytes lookup. The goal is to convert +%% any multi-clause segment into 2-byte lookups with a potential +%% 3 byte lookup at the end. +fix_count_without_variadic_segment(N) when N > 3 -> 2; +fix_count_without_variadic_segment(N) -> N. + +%% If we have more than 16 clauses, then it is better +%% to branch multiple times than getting a large integer. +%% We also abort if we have nothing to squeeze. +squeeze_clauses(Clauses, Size, Count) when Count >= 16; Size == 1 -> Clauses; +squeeze_clauses(Clauses, Size, _Count) -> squeeze_clauses(Clauses, Size). + +squeeze_clauses([#iclause{pats=[#k_bin_seg{seg=#k_literal{}} = BinSeg | Pats]} = Clause | Clauses], Size) -> + [Clause#iclause{pats=[squeeze_segments(BinSeg, 0, 0, Size) | Pats]} | + squeeze_clauses(Clauses, Size)]; +squeeze_clauses([], _Size) -> + []. + +squeeze_segments(#k_bin_seg{size=Sz, seg=#k_literal{val=Val}=Lit} = BinSeg, Acc, Size, 1) -> + BinSeg#k_bin_seg{size=Sz#k_literal{val=Size + 8}, seg=Lit#k_literal{val=(Acc bsl 8) bor Val}}; +squeeze_segments(#k_bin_seg{seg=#k_literal{val=Val},next=Next}, Acc, Size, Count) -> + squeeze_segments(Next, (Acc bsl 8) bor Val, Size + 8, Count - 1). + +flat_reverse([Head | Tail], Acc) -> flat_reverse(Tail, flat_reverse_1(Head, Acc)); +flat_reverse([], Acc) -> Acc. + +flat_reverse_1([Head | Tail], Acc) -> flat_reverse_1(Tail, [Head | Acc]); +flat_reverse_1([], Acc) -> Acc. + %% build_guard([GuardClause]) -> GuardExpr. build_guard([]) -> fail; @@ -2160,13 +1701,13 @@ build_alt_1st_no_fail(First, fail) -> First; build_alt_1st_no_fail(First, Then) -> copy_anno(#k_alt{first=First,then=Then}, First). -%% build_match([MatchVar], MatchExpr) -> Kexpr. +%% build_match(MatchExpr) -> Kexpr. %% Build a match expr if there is a match. -build_match(Us, #k_alt{}=Km) -> copy_anno(#k_match{vars=Us,body=Km}, Km); -build_match(Us, #k_select{}=Km) -> copy_anno(#k_match{vars=Us,body=Km}, Km); -build_match(Us, #k_guard{}=Km) -> copy_anno(#k_match{vars=Us,body=Km}, Km); -build_match(_, Km) -> Km. +build_match(#k_alt{}=Km) -> copy_anno(#k_match{body=Km}, Km); +build_match(#k_select{}=Km) -> copy_anno(#k_match{body=Km}, Km); +build_match(#k_guard{}=Km) -> copy_anno(#k_match{body=Km}, Km); +build_match(Km) -> Km. %% clause_arg(Clause) -> FirstArg. %% clause_con(Clause) -> Constructor. @@ -2195,26 +1736,26 @@ arg_alias(_Con) -> []. arg_con(Arg) -> case arg_arg(Arg) of - #k_literal{} -> k_literal; - #k_int{} -> k_int; - #k_float{} -> k_float; - #k_atom{} -> k_atom; - #k_nil{} -> k_nil; - #k_cons{} -> k_cons; + #k_cons{} -> k_cons; #k_tuple{} -> k_tuple; #k_map{} -> k_map; #k_binary{} -> k_binary; #k_bin_end{} -> k_bin_end; #k_bin_seg{} -> k_bin_seg; - #k_var{} -> k_var + #k_var{} -> k_var; + #k_literal{val=[]} -> k_nil; + #k_literal{val=Val} -> + if + is_atom(Val) -> k_atom; + is_integer(Val) -> k_int; + is_float(Val) -> k_float; + true -> k_literal + end end. arg_val(Arg, C) -> case arg_arg(Arg) of #k_literal{val=Lit} -> Lit; - #k_int{val=I} -> I; - #k_float{val=F} -> F; - #k_atom{val=A} -> A; #k_tuple{es=Es} -> length(Es); #k_bin_seg{size=S,unit=U,type=T,flags=Fs} -> case S of @@ -2225,7 +1766,7 @@ arg_val(Arg, C) -> {set_kanno(S, []),U,T,Fs} end; #k_map{op=exact,es=Es} -> - lists:sort(fun(A,B) -> + sort(fun(A,B) -> %% on the form K :: {'lit' | 'var', term()} %% lit < var as intended erts_internal:cmp_term(A,B) < 0 @@ -2248,23 +1789,22 @@ ubody(#iset{vars=[],arg=#iletrec{}=Let,body=B0}, Br, St0) -> %% An iletrec{} should never be last. St = iletrec_funs(Let, St0), ubody(B0, Br, St); +ubody(#iset{vars=[],arg=#k_literal{},body=B0}, Br, St0) -> + ubody(B0, Br, St0); ubody(#iset{anno=A,vars=Vs,arg=E0,body=B0}, Br, St0) -> {E1,Eu,St1} = uexpr(E0, {break,Vs}, St0), {B1,Bu,St2} = ubody(B0, Br, St1), Ns = lit_list_vars(Vs), Used = union(Eu, subtract(Bu, Ns)), %Used external vars - {#k_seq{anno=#k{us=Used,ns=Ns,a=A},arg=E1,body=B1},Used,St2}; + {#k_seq{anno=A,arg=E1,body=B1},Used,St2}; ubody(#ivalues{anno=A,args=As}, return, St) -> Au = lit_list_vars(As), - {#k_return{anno=#k{us=Au,ns=[],a=A},args=As},Au,St}; + {#k_return{anno=A,args=As},Au,St}; ubody(#ivalues{anno=A,args=As}, {break,_Vbs}, St) -> Au = lit_list_vars(As), - case is_in_guard(St) of - true -> - {#k_guard_break{anno=#k{us=Au,ns=[],a=A},args=As},Au,St}; - false -> - {#k_break{anno=#k{us=Au,ns=[],a=A},args=As},Au,St} - end; + {#k_break{anno=A,args=As},Au,St}; +ubody(#k_goto{}=Goto, _Br, St) -> + {Goto,[],St}; ubody(E, return, St0) -> %% Enterable expressions need no trailing return. case is_enter_expr(E) of @@ -2273,27 +1813,14 @@ ubody(E, return, St0) -> {Ea,Pa,St1} = force_atomic(E, St0), ubody(pre_seq(Pa, #ivalues{args=[Ea]}), return, St1) end; -ubody(#ignored{}, {break,_} = Break, St) -> - ubody(#ivalues{args=[]}, Break, St); ubody(E, {break,[_]} = Break, St0) -> - %%ok = io:fwrite("ubody ~w:~p~n", [?LINE,{E,Br}]), - %% Exiting expressions need no trailing break. - case is_exit_expr(E) of - true -> uexpr(E, return, St0); - false -> - {Ea,Pa,St1} = force_atomic(E, St0), - ubody(pre_seq(Pa, #ivalues{args=[Ea]}), Break, St1) - end; + {Ea,Pa,St1} = force_atomic(E, St0), + ubody(pre_seq(Pa, #ivalues{args=[Ea]}), Break, St1); ubody(E, {break,Rs}=Break, St0) -> - case is_exit_expr(E) of - true -> - uexpr(E, return, St0); - false -> - {Vs,St1} = new_vars(length(Rs), St0), - Iset = #iset{vars=Vs,arg=E}, - PreSeq = pre_seq([Iset], #ivalues{args=Vs}), - ubody(PreSeq, Break, St1) - end. + {Vs,St1} = new_vars(length(Rs), St0), + Iset = #iset{vars=Vs,arg=E}, + PreSeq = pre_seq([Iset], #ivalues{args=Vs}), + ubody(PreSeq, Break, St1). iletrec_funs(#iletrec{defs=Fs}, St0) -> %% Use union of all free variables. @@ -2319,20 +1846,13 @@ iletrec_funs_gen(_, _, #kern{funs=ignore}=St) -> iletrec_funs_gen(Fs, FreeVs, St) -> foldl(fun ({N,#ifun{anno=Fa,vars=Vs,body=Fb0}}, Lst0) -> Arity0 = length(Vs), - {Fb1,_,Lst1} = ubody(Fb0, return, Lst0#kern{ff={N,Arity0}}), + {Fb1,_,Lst1} = ubody(Fb0, return, Lst0), Arity = Arity0 + length(FreeVs), - Fun = make_fdef(#k{us=[],ns=[],a=Fa}, N, Arity, - Vs++FreeVs, Fb1), + Fun = make_fdef(Fa, N, Arity, Vs++FreeVs, Fb1), Lst1#kern{funs=[Fun|Lst1#kern.funs]} end, St, Fs). -%% is_exit_expr(Kexpr) -> boolean(). -%% Test whether Kexpr always exits and never returns. - -is_exit_expr(#k_receive_next{}) -> true; -is_exit_expr(_) -> false. - %% is_enter_expr(Kexpr) -> boolean(). %% Test whether Kexpr is "enterable", i.e. can handle return from %% within itself without extra #k_return{}. @@ -2340,95 +1860,77 @@ is_exit_expr(_) -> false. is_enter_expr(#k_try{}) -> true; is_enter_expr(#k_call{}) -> true; is_enter_expr(#k_match{}) -> true; -is_enter_expr(#k_receive{}) -> true; -is_enter_expr(#k_receive_next{}) -> true; +is_enter_expr(#k_letrec_goto{}) -> true; is_enter_expr(_) -> false. %% uexpr(Expr, Break, State) -> {Expr,[UsedVar],State}. -%% Tag an expression with its used variables. +%% Calculate the used variables for an expression. %% Break = return | {break,[RetVar]}. uexpr(#k_test{anno=A,op=Op,args=As}=Test, {break,Rs}, St) -> [] = Rs, %Sanity check Used = union(op_vars(Op), lit_list_vars(As)), - {Test#k_test{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A}}, - Used,St}; + {Test#k_test{anno=A},Used,St}; uexpr(#iset{anno=A,vars=Vs,arg=E0,body=B0}, {break,_}=Br, St0) -> Ns = lit_list_vars(Vs), {E1,Eu,St1} = uexpr(E0, {break,Vs}, St0), {B1,Bu,St2} = uexpr(B0, Br, St1), Used = union(Eu, subtract(Bu, Ns)), - {#k_seq{anno=#k{us=Used,ns=Ns,a=A},arg=E1,body=B1},Used,St2}; + {#k_seq{anno=A,arg=E1,body=B1},Used,St2}; uexpr(#k_call{anno=A,op=#k_local{name=F,arity=Ar}=Op,args=As0}=Call, Br, St) -> Free = get_free(F, Ar, St), As1 = As0 ++ Free, %Add free variables LAST! Used = lit_list_vars(As1), {case Br of {break,Rs} -> - Call#k_call{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A}, + Call#k_call{anno=A, op=Op#k_local{arity=Ar + length(Free)}, args=As1,ret=Rs}; return -> - #k_enter{anno=#k{us=Used,ns=[],a=A}, + #k_enter{anno=A, op=Op#k_local{arity=Ar + length(Free)}, args=As1} end,Used,St}; uexpr(#k_call{anno=A,op=Op,args=As}=Call, {break,Rs}, St) -> Used = union(op_vars(Op), lit_list_vars(As)), - {Call#k_call{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A},ret=Rs}, - Used,St}; + {Call#k_call{anno=A,ret=Rs},Used,St}; uexpr(#k_call{anno=A,op=Op,args=As}, return, St) -> Used = union(op_vars(Op), lit_list_vars(As)), - {#k_enter{anno=#k{us=Used,ns=[],a=A},op=Op,args=As}, - Used,St}; + {#k_enter{anno=A,op=Op,args=As},Used,St}; uexpr(#k_bif{anno=A,op=Op,args=As}=Bif, {break,Rs}, St0) -> Used = union(op_vars(Op), lit_list_vars(As)), {Brs,St1} = bif_returns(Op, Rs, St0), - {Bif#k_bif{anno=#k{us=Used,ns=lit_list_vars(Brs),a=A},ret=Brs}, - Used,St1}; -uexpr(#k_match{anno=A,vars=Vs,body=B0}, Br, St0) -> + {Bif#k_bif{anno=A,ret=Brs},Used,St1}; +uexpr(#k_match{anno=A,body=B0}, Br, St0) -> Rs = break_rets(Br), {B1,Bu,St1} = umatch(B0, Br, St0), - case is_in_guard(St1) of - true -> - {#k_guard_match{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A}, - vars=Vs,body=B1,ret=Rs},Bu,St1}; - false -> - {#k_match{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A}, - vars=Vs,body=B1,ret=Rs},Bu,St1} - end; -uexpr(#k_receive{anno=A,var=V,body=B0,timeout=T,action=A0}, Br, St0) -> - Rs = break_rets(Br), - Tu = lit_vars(T), %Timeout is atomic - {B1,Bu,St1} = umatch(B0, Br, St0), - {A1,Au,St2} = ubody(A0, Br, St1), - Used = del_element(V#k_var.name, union(Bu, union(Tu, Au))), - {#k_receive{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A}, - var=V,body=B1,timeout=T,action=A1,ret=Rs}, - Used,St2}; -uexpr(#k_receive_accept{anno=A}, _, St) -> - {#k_receive_accept{anno=#k{us=[],ns=[],a=A}},[],St}; -uexpr(#k_receive_next{anno=A}, _, St) -> - {#k_receive_next{anno=#k{us=[],ns=[],a=A}},[],St}; + {#k_match{anno=A,body=B1,ret=Rs},Bu,St1}; uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0}, {break,Rs0}=Br, St0) -> - case is_in_guard(St0) of - true -> - {[#k_var{name=X}],#k_var{name=X}} = {Vs,B0}, %Assertion. - #k_atom{val=false} = H0, %Assertion. - {Avs,St1} = new_vars(length(Rs0), St0), - {A1,Bu,St} = uexpr(A0, {break,Avs}, St1), - {#k_protected{anno=#k{us=Bu,ns=lit_list_vars(Rs0),a=A}, - arg=A1,ret=Rs0,inner=Avs},Bu,St}; - false -> + case {Vs,B0,H0,Rs0} of + {[#k_var{name=X}],#k_var{name=X},#k_literal{},[]} -> + %% This is a simple try/catch whose return value is + %% ignored: + %% + %% try E of V -> V when _:_:_ -> ignored_literal end, ... + %% + %% This is most probably a try/catch in a guard. To + %% correctly handle the #k_test{} that ends the body of + %% the guard, we MUST pass an empty list of break + %% variables when processing the body. + {A1,Bu,St} = ubody(A0, {break,[]}, St0), + {#k_try{anno=A,arg=A1,vars=[],body=#k_break{}, + evars=[],handler=#k_break{},ret=Rs0}, + Bu,St}; + {_,_,_,_} -> + %% The general try/catch (in a guard or in body). {Avs,St1} = new_vars(length(Vs), St0), {A1,Au,St2} = ubody(A0, {break,Avs}, St1), {B1,Bu,St3} = ubody(B0, Br, St2), {H1,Hu,St4} = ubody(H0, Br, St3), Used = union([Au,subtract(Bu, lit_list_vars(Vs)), subtract(Hu, lit_list_vars(Evs))]), - {#k_try{anno=#k{us=Used,ns=lit_list_vars(Rs0),a=A}, - arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1,ret=Rs0}, + {#k_try{anno=A,arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1,ret=Rs0}, Used,St4} end; uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0}, @@ -2439,8 +1941,7 @@ uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0}, {H1,Hu,St4} = ubody(H0, return, St3), Used = union([Au,subtract(Bu, lit_list_vars(Vs)), subtract(Hu, lit_list_vars(Evs))]), - {#k_try_enter{anno=#k{us=Used,ns=[],a=A}, - arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1}, + {#k_try_enter{anno=A,arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1}, Used,St4}; uexpr(#k_catch{anno=A,body=B0}, {break,Rs0}, St0) -> {Rb,St1} = new_var(St0), @@ -2448,7 +1949,7 @@ uexpr(#k_catch{anno=A,body=B0}, {break,Rs0}, St0) -> %% Guarantee ONE return variable. {Ns,St3} = new_vars(1 - length(Rs0), St2), Rs1 = Rs0 ++ Ns, - {#k_catch{anno=#k{us=Bu,ns=lit_list_vars(Rs1),a=A},body=B1,ret=Rs1},Bu,St3}; + {#k_catch{anno=A,body=B1,ret=Rs1},Bu,St3}; uexpr(#ifun{anno=A,vars=Vs,body=B0}, {break,Rs}, St0) -> {B1,Bu,St1} = ubody(B0, return, St0), %Return out of new function Ns = lit_list_vars(Vs), @@ -2456,37 +1957,55 @@ uexpr(#ifun{anno=A,vars=Vs,body=B0}, {break,Rs}, St0) -> Fvs = make_vars(Free), Arity = length(Vs) + length(Free), {Fname,St} = - case lists:keyfind(id, 1, A) of + case keyfind(id, 1, A) of {id,{_,_,Fname0}} -> {Fname0,St1}; false -> %% No id annotation. Must invent a fun name. new_fun_name(St1) end, - Fun = make_fdef(#k{us=[],ns=[],a=A}, Fname, Arity, Vs++Fvs, B1), - {#k_bif{anno=#k{us=Free,ns=lit_list_vars(Rs),a=A}, + Fun = make_fdef(A, Fname, Arity, Vs++Fvs, B1), + Local = #k_local{name=Fname,arity=Arity}, + {#k_bif{anno=A, op=#k_internal{name=make_fun,arity=length(Free)+2}, - args=[#k_atom{val=Fname},#k_int{val=Arity}|Fvs], + args=[Local|Fvs], ret=Rs}, Free,add_local_function(Fun, St)}; +uexpr(#k_letrec_goto{anno=A,first=F0,then=T0}=MatchAlt, Br, St0) -> + Rs = break_rets(Br), + {F1,Fu,St1} = ubody(F0, Br, St0), + {T1,Tu,St2} = ubody(T0, Br, St1), + Used = union(Fu, Tu), + {MatchAlt#k_letrec_goto{anno=A,first=F1,then=T1,ret=Rs},Used,St2}; uexpr(Lit, {break,Rs0}, St0) -> %% Transform literals to puts here. %%ok = io:fwrite("uexpr ~w:~p~n", [?LINE,Lit]), Used = lit_vars(Lit), {Rs,St1} = ensure_return_vars(Rs0, St0), - {#k_put{anno=#k{us=Used,ns=lit_list_vars(Rs),a=get_kanno(Lit)}, - arg=Lit,ret=Rs},Used,St1}. + {#k_put{anno=get_kanno(Lit),arg=Lit,ret=Rs},Used,St1}. + +add_local_function(_, #kern{funs=ignore}=St) -> + St; +add_local_function(#k_fdef{func=Name,arity=Arity}=F, #kern{funs=Funs}=St) -> + case is_defined(Name, Arity, Funs) of + false -> + St#kern{funs=[F|Funs]}; + true -> + St + end. -add_local_function(_, #kern{funs=ignore}=St) -> St; -add_local_function(F, #kern{funs=Funs}=St) -> St#kern{funs=[F|Funs]}. +is_defined(Name, Arity, [#k_fdef{func=Name,arity=Arity}|_]) -> + true; +is_defined(Name, Arity, [#k_fdef{}|T]) -> + is_defined(Name, Arity, T); +is_defined(_, _, []) -> false. %% Make a #k_fdef{}, making sure that the body is always a #k_match{}. make_fdef(Anno, Name, Arity, Vs, #k_match{}=Body) -> #k_fdef{anno=Anno,func=Name,arity=Arity,vars=Vs,body=Body}; make_fdef(Anno, Name, Arity, Vs, Body) -> Ka = get_kanno(Body), - Match = #k_match{anno=#k{us=Ka#k.us,ns=[],a=Ka#k.a}, - vars=Vs,body=Body,ret=[]}, + Match = #k_match{anno=Ka,body=Body,ret=[]}, #k_fdef{anno=Anno,func=Name,arity=Arity,vars=Vs,body=Match}. %% get_free(Name, Arity, State) -> [Free]. @@ -2524,42 +2043,34 @@ ensure_return_vars([], St) -> new_vars(1, St); ensure_return_vars([_]=Rs, St) -> {Rs,St}. %% umatch(Match, Break, State) -> {Match,[UsedVar],State}. -%% Tag a match expression with its used variables. +%% Calculate the used variables for a match expression. umatch(#k_alt{anno=A,first=F0,then=T0}, Br, St0) -> {F1,Fu,St1} = umatch(F0, Br, St0), {T1,Tu,St2} = umatch(T0, Br, St1), Used = union(Fu, Tu), - {#k_alt{anno=#k{us=Used,ns=[],a=A},first=F1,then=T1}, - Used,St2}; + {#k_alt{anno=A,first=F1,then=T1},Used,St2}; umatch(#k_select{anno=A,var=V,types=Ts0}, Br, St0) -> {Ts1,Tus,St1} = umatch_list(Ts0, Br, St0), - Used = case member(no_usage, get_kanno(V)) of - true -> Tus; - false -> add_element(V#k_var.name, Tus) - end, - {#k_select{anno=#k{us=Used,ns=[],a=A},var=V,types=Ts1},Used,St1}; + Used = add_element(V#k_var.name, Tus), + {#k_select{anno=A,var=V,types=Ts1},Used,St1}; umatch(#k_type_clause{anno=A,type=T,values=Vs0}, Br, St0) -> {Vs1,Vus,St1} = umatch_list(Vs0, Br, St0), - {#k_type_clause{anno=#k{us=Vus,ns=[],a=A},type=T,values=Vs1},Vus,St1}; + {#k_type_clause{anno=A,type=T,values=Vs1},Vus,St1}; umatch(#k_val_clause{anno=A,val=P0,body=B0}, Br, St0) -> {U0,Ps} = pat_vars(P0), - P = set_kanno(P0, #k{us=U0,ns=Ps,a=get_kanno(P0)}), {B1,Bu,St1} = umatch(B0, Br, St0), + P = pat_anno_unused(P0, Bu, Ps), Used = union(U0, subtract(Bu, Ps)), - {#k_val_clause{anno=#k{us=Used,ns=[],a=A},val=P,body=B1}, - Used,St1}; + {#k_val_clause{anno=A,val=P,body=B1},Used,St1}; umatch(#k_guard{anno=A,clauses=Gs0}, Br, St0) -> {Gs1,Gus,St1} = umatch_list(Gs0, Br, St0), - {#k_guard{anno=#k{us=Gus,ns=[],a=A},clauses=Gs1},Gus,St1}; + {#k_guard{anno=A,clauses=Gs1},Gus,St1}; umatch(#k_guard_clause{anno=A,guard=G0,body=B0}, Br, St0) -> - %%ok = io:fwrite("~w: ~p~n", [?LINE,G0]), - {G1,Gu,St1} = uexpr(G0, {break,[]}, - St0#kern{guard_refc=St0#kern.guard_refc+1}), - %%ok = io:fwrite("~w: ~p~n", [?LINE,G1]), - {B1,Bu,St2} = umatch(B0, Br, St1#kern{guard_refc=St1#kern.guard_refc-1}), + {G1,Gu,St1} = uexpr(G0, {break,[]}, St0), + {B1,Bu,St2} = umatch(B0, Br, St1), Used = union(Gu, Bu), - {#k_guard_clause{anno=#k{us=Used,ns=[],a=A},guard=G1,body=B1},Used,St2}; + {#k_guard_clause{anno=A,guard=G1,body=B1},Used,St2}; umatch(B0, Br, St0) -> ubody(B0, Br, St0). umatch_list(Ms0, Br, St) -> @@ -2568,6 +2079,19 @@ umatch_list(Ms0, Br, St) -> {[M1|Ms1],union(Mu, Us),Stb} end, {[],[],St}, Ms0). +pat_anno_unused(#k_tuple{es=Es0}=P, Used0, Ps) -> + %% Not extracting unused tuple elements is an optimization for + %% compile time and memory use during compilation. It is probably + %% worthwhile because it is common to extract only a few elements + %% from a huge record. + Used = intersection(Used0, Ps), + Es = [case member(V, Used) of + true -> Var; + false -> set_kanno(Var, [unused|get_kanno(Var)]) + end || #k_var{name=V}=Var <- Es0], + P#k_tuple{es=Es}; +pat_anno_unused(P, _Used, _Ps) -> P. + %% op_vars(Op) -> [VarName]. op_vars(#k_remote{mod=Mod,name=Name}) -> @@ -2579,11 +2103,7 @@ op_vars(Atomic) -> lit_vars(Atomic). %% Return the variables in a literal. lit_vars(#k_var{name=N}) -> [N]; -lit_vars(#k_int{}) -> []; -lit_vars(#k_float{}) -> []; -lit_vars(#k_atom{}) -> []; %%lit_vars(#k_char{}) -> []; -lit_vars(#k_nil{}) -> []; lit_vars(#k_cons{hd=H,tl=T}) -> union(lit_vars(H), lit_vars(T)); lit_vars(#k_map{var=Var,es=Es}) -> @@ -2603,27 +2123,24 @@ lit_list_vars(Ps) -> %% pat_vars(Pattern) -> {[UsedVarName],[NewVarName]}. %% Return variables in a pattern. All variables are new variables -%% except those in the size field of binary segments. -%% and map_pair keys +%% except those in the size field of binary segments and the key +%% field in map_pairs. pat_vars(#k_var{name=N}) -> {[],[N]}; %%pat_vars(#k_char{}) -> {[],[]}; pat_vars(#k_literal{}) -> {[],[]}; -pat_vars(#k_int{}) -> {[],[]}; -pat_vars(#k_float{}) -> {[],[]}; -pat_vars(#k_atom{}) -> {[],[]}; -pat_vars(#k_nil{}) -> {[],[]}; pat_vars(#k_cons{hd=H,tl=T}) -> pat_list_vars([H,T]); pat_vars(#k_binary{segs=V}) -> pat_vars(V); -pat_vars(#k_bin_seg{size=Size,seg=S}) -> - {U1,New} = pat_list_vars([S]), +pat_vars(#k_bin_seg{size=Size,seg=S,next=N}) -> + {U1,New} = pat_list_vars([S,N]), {[],U2} = pat_vars(Size), {union(U1, U2),New}; -pat_vars(#k_bin_int{size=Size}) -> +pat_vars(#k_bin_int{size=Size,next=N}) -> + {[],New} = pat_vars(N), {[],U} = pat_vars(Size), - {U,[]}; + {U,New}; pat_vars(#k_bin_end{}) -> {[],[]}; pat_vars(#k_tuple{es=Es}) -> pat_list_vars(Es); @@ -2646,11 +2163,6 @@ integers(N, M) when N =< M -> [N|integers(N + 1, M)]; integers(_, _) -> []. -%% is_in_guard(State) -> true|false. - -is_in_guard(#kern{guard_refc=Refc}) -> - Refc > 0. - %%% %%% Handling of errors and warnings. %%% @@ -2662,7 +2174,7 @@ is_in_guard(#kern{guard_refc=Refc}) -> format_error({nomatch_shadow,Line}) -> M = io_lib:format("this clause cannot match because a previous clause at line ~p " "always matches", [Line]), - lists:flatten(M); + flatten(M); format_error(nomatch_shadow) -> "this clause cannot match because a previous clause always matches"; format_error(bad_call) -> diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl index e26360a6da..582e4f9b12 100644 --- a/lib/compiler/src/v3_kernel.hrl +++ b/lib/compiler/src/v3_kernel.hrl @@ -24,19 +24,10 @@ %% this could make including this file difficult. %% N.B. the annotation field is ALWAYS the first field! -%% Kernel annotation record. --record(k, {us, %Used variables - ns, %New variables - a}). %Core annotation - %% Literals %% NO CHARACTERS YET. %%-record(k_char, {anno=[],val}). --record(k_literal, {anno=[],val}). %Only used for complex literals. --record(k_int, {anno=[],val}). --record(k_float, {anno=[],val}). --record(k_atom, {anno=[],val}). --record(k_nil, {anno=[]}). +-record(k_literal, {anno=[],val}). -record(k_tuple, {anno=[],es}). -record(k_map, {anno=[],var=#k_literal{val=#{}},op,es}). @@ -58,19 +49,17 @@ -record(k_seq, {anno=[],arg,body}). -record(k_put, {anno=[],arg,ret=[]}). -record(k_bif, {anno=[],op,args,ret=[]}). --record(k_test, {anno=[],op,args,inverted=false}). +-record(k_test, {anno=[],op,args}). -record(k_call, {anno=[],op,args,ret=[]}). -record(k_enter, {anno=[],op,args}). --record(k_receive, {anno=[],var,body,timeout,action,ret=[]}). --record(k_receive_accept, {anno=[]}). --record(k_receive_next, {anno=[]}). -record(k_try, {anno=[],arg,vars,body,evars,handler,ret=[]}). -record(k_try_enter, {anno=[],arg,vars,body,evars,handler}). --record(k_protected, {anno=[],arg,ret=[],inner}). -record(k_catch, {anno=[],body,ret=[]}). --record(k_guard_match, {anno=[],vars,body,ret=[]}). --record(k_match, {anno=[],vars,body,ret=[]}). +-record(k_letrec_goto, {anno=[],label,first,then,ret=[]}). +-record(k_goto, {anno=[],label}). + +-record(k_match, {anno=[],body,ret=[]}). -record(k_alt, {anno=[],first,then}). -record(k_select, {anno=[],var,types}). -record(k_type_clause, {anno=[],type,values}). @@ -79,7 +68,6 @@ -record(k_guard_clause, {anno=[],guard,body}). -record(k_break, {anno=[],args=[]}). --record(k_guard_break, {anno=[],args=[]}). -record(k_return, {anno=[],args=[]}). %%k_get_anno(Thing) -> element(2, Thing). diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl index c12c301ee2..f7479e6b15 100644 --- a/lib/compiler/src/v3_kernel_pp.erl +++ b/lib/compiler/src/v3_kernel_pp.erl @@ -57,8 +57,6 @@ format(Node, Ctxt) -> format_1(Node, Ctxt); [L,{file,_}] when is_integer(L) -> format_1(Node, Ctxt); - #k{a=Anno}=K when Anno =/= [] -> - format(setelement(2, Node, K#k{a=[]}), Ctxt); List -> format_anno(List, Ctxt, fun (Ctxt1) -> format_1(Node, Ctxt1) @@ -83,11 +81,7 @@ format_anno(Anno, Ctxt0, ObjFun) -> %% format_1(Kexpr, Context) -> string(). -format_1(#k_atom{val=A}, _Ctxt) -> core_atom(A); %%format_1(#k_char{val=C}, _Ctxt) -> io_lib:write_char(C); -format_1(#k_float{val=F}, _Ctxt) -> float_to_list(F); -format_1(#k_int{val=I}, _Ctxt) -> integer_to_list(I); -format_1(#k_nil{}, _Ctxt) -> "[]"; format_1(#k_var{name=V}, _Ctxt) -> if is_atom(V) -> case atom_to_list(V) of @@ -135,10 +129,13 @@ format_1(#k_bin_seg{next=Next}=S, Ctxt) -> [format_bin_seg_1(S, Ctxt), format_bin_seg(Next, ctxt_bump_indent(Ctxt, 2))]; format_1(#k_bin_int{size=Sz,unit=U,flags=Fs,val=Val,next=Next}, Ctxt) -> - S = #k_bin_seg{size=Sz,unit=U,type=integer,flags=Fs,seg=#k_int{val=Val},next=Next}, + S = #k_bin_seg{size=Sz,unit=U,type=integer,flags=Fs, + seg=#k_literal{val=Val},next=Next}, [format_bin_seg_1(S, Ctxt), format_bin_seg(Next, ctxt_bump_indent(Ctxt, 2))]; format_1(#k_bin_end{}, _Ctxt) -> "#<>#"; +format_1(#k_literal{val=A}, _Ctxt) when is_atom(A) -> + core_atom(A); format_1(#k_literal{val=Term}, _Ctxt) -> io_lib:format("~p", [Term]); format_1(#k_local{name=N,arity=A}, Ctxt) -> @@ -158,20 +155,9 @@ format_1(#k_seq{arg=A,body=B}, Ctxt) -> nl_indent(Ctxt) | format(B, Ctxt) ]; -format_1(#k_match{vars=Vs,body=Bs,ret=Rs}, Ctxt) -> +format_1(#k_match{body=Bs,ret=Rs}, Ctxt) -> Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.item_indent), - ["match ", - format_hseq(Vs, ",", ctxt_bump_indent(Ctxt, 6), fun format/2), - nl_indent(Ctxt1), - format(Bs, Ctxt1), - nl_indent(Ctxt), - "end", - format_ret(Rs, Ctxt1) - ]; -format_1(#k_guard_match{vars=Vs,body=Bs,ret=Rs}, Ctxt) -> - Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.item_indent), - ["guard_match ", - format_hseq(Vs, ",", ctxt_bump_indent(Ctxt, 6), fun format/2), + ["match", nl_indent(Ctxt1), format(Bs, Ctxt1), nl_indent(Ctxt), @@ -185,6 +171,20 @@ format_1(#k_alt{first=O,then=T}, Ctxt) -> format(O, Ctxt1), nl_indent(Ctxt1), format(T, Ctxt1)]; +format_1(#k_letrec_goto{label=Label,first=First,then=Then,ret=Rs}, Ctxt) -> + Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.item_indent), + ["letrec_goto ", + atom_to_list(Label), + nl_indent(Ctxt1), + format(Then, Ctxt1), + nl_indent(Ctxt1), + format(First, Ctxt1), + nl_indent(Ctxt), + "end", + format_ret(Rs, Ctxt1) + ]; +format_1(#k_goto{label=Label}, _Ctxt) -> + ["goto ",atom_to_list(Label)]; format_1(#k_select{var=V,types=Cs}, Ctxt) -> Ctxt1 = ctxt_bump_indent(Ctxt, 2), ["select ", @@ -235,13 +235,8 @@ format_1(#k_bif{op=Op,args=As,ret=Rs}, Ctxt) -> [Txt,format_args(As, Ctxt1), format_ret(Rs, Ctxt1) ]; -format_1(#k_test{op=Op,args=As,inverted=Inverted}, Ctxt) -> - Txt = case Inverted of - false -> - ["test (",format(Op, ctxt_bump_indent(Ctxt, 6)),$)]; - true -> - ["inverted_test (",format(Op, ctxt_bump_indent(Ctxt, 6)),$)] - end, +format_1(#k_test{op=Op,args=As}, Ctxt) -> + Txt = ["test (",format(Op, ctxt_bump_indent(Ctxt, 6)),$)], Ctxt1 = ctxt_bump_indent(Ctxt, 2), [Txt,format_args(As, Ctxt1)]; format_1(#k_put{arg=A,ret=Rs}, Ctxt) -> @@ -285,15 +280,6 @@ format_1(#k_try_enter{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Ctxt) -> nl_indent(Ctxt), "end" ]; -format_1(#k_protected{arg=A,ret=Rs}, Ctxt) -> - Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent), - ["protected", - nl_indent(Ctxt1), - format(A, Ctxt1), - nl_indent(Ctxt), - "end", - format_ret(Rs, ctxt_bump_indent(Ctxt, 1)) - ]; format_1(#k_catch{body=B,ret=Rs}, Ctxt) -> Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent), ["catch", @@ -303,34 +289,11 @@ format_1(#k_catch{body=B,ret=Rs}, Ctxt) -> "end", format_ret(Rs, Ctxt1) ]; -format_1(#k_receive{var=V,body=B,timeout=T,action=A,ret=Rs}, Ctxt) -> - Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.item_indent), - ["receive ", - format(V, Ctxt), - nl_indent(Ctxt1), - format(B, Ctxt1), - nl_indent(Ctxt), - "after ", - format(T, ctxt_bump_indent(Ctxt, 6)), - " ->", - nl_indent(Ctxt1), - format(A, Ctxt1), - nl_indent(Ctxt), - "end", - format_ret(Rs, Ctxt1) - ]; -format_1(#k_receive_accept{}, _Ctxt) -> "receive_accept"; -format_1(#k_receive_next{}, _Ctxt) -> "receive_next"; format_1(#k_break{args=As}, Ctxt) -> ["<", format_hseq(As, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), ">" ]; -format_1(#k_guard_break{args=As}, Ctxt) -> - [":<", - format_hseq(As, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), - ">:" - ]; format_1(#k_return{args=As}, Ctxt) -> ["<<", format_hseq(As, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), @@ -347,7 +310,7 @@ format_1(#k_fdef{func=F,arity=A,vars=Vs,body=B}, Ctxt) -> ]; format_1(#k_mdef{name=N,exports=Es,attributes=As,body=B}, Ctxt) -> ["module ", - format(#k_atom{val=N}, ctxt_bump_indent(Ctxt, 7)), + format(#k_literal{val=N}, ctxt_bump_indent(Ctxt, 7)), nl_indent(Ctxt), "export [", format_vseq(Es, @@ -437,17 +400,17 @@ format_fa_pair({F,A}, _Ctxt) -> [core_atom(F),$/,integer_to_list(A)]. %% format_attribute({Name,Val}, Context) -> Txt. format_attribute({Name,Val}, Ctxt) when is_list(Val) -> - Txt = format(#k_atom{val=Name}, Ctxt), + Txt = format(#k_literal{val=Name}, Ctxt), Ctxt1 = ctxt_bump_indent(Ctxt, width(Txt,Ctxt)+4), [Txt," = ", $[,format_vseq(Val, "", ",", Ctxt1, fun (A, _C) -> io_lib:write(A) end),$] ]; format_attribute({Name,Val}, Ctxt) -> - Txt = format(#k_atom{val=Name}, Ctxt), + Txt = format(#k_literal{val=Name}, Ctxt), [Txt," = ",io_lib:write(Val)]. -format_list_tail(#k_nil{anno=[]}, _Ctxt) -> "]"; +format_list_tail(#k_literal{anno=[],val=[]}, _Ctxt) -> "]"; format_list_tail(#k_cons{anno=[],hd=H,tl=T}, Ctxt) -> Txt = [$,|format(H, Ctxt)], Ctxt1 = ctxt_bump_indent(Ctxt, width(Txt, Ctxt)), diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 7be23fbb93..1a6628fc9f 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -16,12 +16,14 @@ MODULES= \ beam_reorder_SUITE \ beam_ssa_SUITE \ beam_type_SUITE \ + beam_types_SUITE \ beam_utils_SUITE \ bif_SUITE \ bs_bincomp_SUITE \ bs_bit_binaries_SUITE \ bs_construct_SUITE \ bs_match_SUITE \ + bs_size_expr_SUITE \ bs_utf_SUITE \ core_alias_SUITE \ core_fold_SUITE \ @@ -59,6 +61,7 @@ NO_OPT= \ bif \ bs_construct \ bs_match \ + bs_size_expr \ bs_utf \ core_fold \ float \ @@ -84,6 +87,7 @@ INLINE= \ bs_bit_binaries \ bs_construct \ bs_match \ + bs_size_expr \ bs_utf \ core_fold \ float \ @@ -101,6 +105,8 @@ R21= \ bs_construct \ bs_match +DIALYZER = bs_match + CORE_MODULES = \ lfe_andor_SUITE \ lfe_guard_SUITE @@ -125,6 +131,8 @@ NO_SSA_OPT_MODULES= $(NO_SSA_OPT:%=%_no_ssa_opt_SUITE) NO_SSA_OPT_ERL_FILES= $(NO_SSA_OPT_MODULES:%=%.erl) NO_TYPE_OPT_MODULES= $(NO_TYPE_OPT:%=%_no_type_opt_SUITE) NO_TYPE_OPT_ERL_FILES= $(NO_TYPE_OPT_MODULES:%=%.erl) +DIALYZER_MODULES= $(DIALYZER:%=%_dialyzer_SUITE) +DIALYZER_ERL_FILES= $(DIALYZER_MODULES:%=%.erl) ERL_FILES= $(MODULES:%=%.erl) CORE_FILES= $(CORE_MODULES:%=%.core) @@ -154,7 +162,8 @@ EBIN = . # ---------------------------------------------------- make_emakefile: $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) $(NO_SSA_OPT_ERL_FILES) \ - $(INLINE_ERL_FILES) $(R21_ERL_FILES) $(NO_MOD_OPT_ERL_FILES) $(NO_TYPE_OPT_ERL_FILES) + $(INLINE_ERL_FILES) $(R21_ERL_FILES) $(NO_MOD_OPT_ERL_FILES) $(NO_TYPE_OPT_ERL_FILES) \ + $(DIALYZER_ERL_FILES) $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \ > $(EMAKEFILE) $(ERL_TOP)/make/make_emakefile +no_copt +no_postopt \ @@ -175,6 +184,8 @@ make_emakefile: $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) $(NO_SSA_OPT_ERL_FILES -o$(EBIN) $(CORE_MODULES) >> $(EMAKEFILE) $(ERL_TOP)/make/make_emakefile +no_type_opt $(ERL_COMPILE_FLAGS) \ -o$(EBIN) $(NO_TYPE_OPT_MODULES) >> $(EMAKEFILE) + $(ERL_TOP)/make/make_emakefile +dialyzer $(ERL_COMPILE_FLAGS) \ + -o$(EBIN) $(DIALYZER_MODULES) >> $(EMAKEFILE) tests debug opt: make_emakefile erl $(ERL_MAKE_FLAGS) -make @@ -211,6 +222,8 @@ docs: %_no_type_opt_SUITE.erl: %_SUITE.erl sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@ +%_dialyzer_SUITE.erl: %_SUITE.erl + sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@ # ---------------------------------------------------- # Release Target @@ -227,7 +240,8 @@ release_tests_spec: make_emakefile $(INLINE_ERL_FILES) $(R21_ERL_FILES) \ $(NO_MOD_OPT_ERL_FILES) \ $(NO_SSA_OPT_ERL_FILES) \ - $(NO_TYPE_OPT_ERL_FILES) "$(RELSYSDIR)" + $(NO_TYPE_OPT_ERL_FILES) \ + $(DIALYZER_ERL_FILES) "$(RELSYSDIR)" $(INSTALL_DATA) $(CORE_FILES) "$(RELSYSDIR)" for file in $(ERL_DUMMY_FILES); do \ module=`basename $$file .erl`; \ @@ -236,6 +250,6 @@ release_tests_spec: make_emakefile $(INSTALL_DATA) $(ERL_DUMMY_FILES) "$(RELSYSDIR)" rm $(ERL_DUMMY_FILES) chmod -R u+w "$(RELSYSDIR)" - @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) + @tar cf - *_SUITE_data property_test | (cd "$(RELSYSDIR)"; tar xf -) release_docs_spec: diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl index 5c463063c1..7232eb0ffd 100644 --- a/lib/compiler/test/andor_SUITE.erl +++ b/lib/compiler/test/andor_SUITE.erl @@ -66,6 +66,17 @@ t_case(Config) when is_list(Config) -> true = (catch t_case_e({a,b}, {a,b})), false = (catch t_case_e({a,b}, 42)), + {true,false} = t_case_f1(true, pos), + {false,true} = t_case_f1(true, whatever), + {false,true} = t_case_f1(false, pos), + {false,true} = t_case_f1(false, whatever), + {false,false} = t_case_f1(not_boolean, pos), + {false,false} = t_case_f1(not_boolean, whatever), + + false = t_case_f2(true), + true = t_case_f2(false), + false = t_case_f2(whatever), + true = t_case_xy(42, 100, 700), true = t_case_xy(42, 100, whatever), false = t_case_xy(42, wrong, 700), @@ -109,6 +120,25 @@ t_case_e(A, B) -> Bool when is_tuple(A) -> id(Bool) end. +t_case_f1(IsInt, Eval) -> + B = case IsInt of + true -> Eval =:= pos; + false -> false; + _ -> IsInt + end, + + %% The above is the same as `IsInt andalso Eval =:= pos` in a guard. + %% In a real guard, variable `B` will only be used once. + {B =:= true, B =:= false}. + +t_case_f2(IsInt) -> + B = case IsInt of + true -> false; + false -> true; + _ -> IsInt + end, + B =:= true. + t_case_xy(X, Y, Z) -> Res = t_case_x(X, Y, Z), Res = t_case_y(X, Y, Z). diff --git a/lib/compiler/test/beam_except_SUITE.erl b/lib/compiler/test/beam_except_SUITE.erl index c8dfc81969..7ffaf54609 100644 --- a/lib/compiler/test/beam_except_SUITE.erl +++ b/lib/compiler/test/beam_except_SUITE.erl @@ -127,19 +127,26 @@ coverage(_) -> {'EXIT',{function_clause,[{?MODULE,foobar,[[fail],1,2], [{file,"fake.erl"},{line,16}]}|_]}} = (catch foobar([fail], 1, 2)), - {'EXIT',{function_clause,[{?MODULE,fake_function_clause,[{a,b},42.0],_}|_]}} = - (catch fake_function_clause({a,b})), + {'EXIT',{function_clause,[{?MODULE,fake_function_clause1,[{a,b},42.0],_}|_]}} = + (catch fake_function_clause1({a,b})), + + {'EXIT',{function_clause,[{?MODULE,fake_function_clause2,[42|bad_tl],_}|_]}} = + (catch fake_function_clause2(42, bad_tl)), + {'EXIT',{function_clause,[{?MODULE,fake_function_clause3,[x,y],_}|_]}} = + (catch fake_function_clause3(42, id([x,y]))), {'EXIT',{{badmatch,0.0},_}} = (catch coverage_1(id(42))), {'EXIT',{badarith,_}} = (catch coverage_1(id(a))), + ok. coverage_1(X) -> %% ERL-1167: Would crash beam_except. true = 0 / X. -fake_function_clause(A) -> error(function_clause, [A,42.0]). - +fake_function_clause1(A) -> error(function_clause, [A,42.0]). +fake_function_clause2(A, Tl) -> error(function_clause, [A|Tl]). +fake_function_clause3(_, Stk) -> error(function_clause, Stk). binary_construction_allocation(_Config) -> ok = do_binary_construction_allocation("PUT"), diff --git a/lib/compiler/test/beam_ssa_SUITE.erl b/lib/compiler/test/beam_ssa_SUITE.erl index 26676644b7..d687fcfab7 100644 --- a/lib/compiler/test/beam_ssa_SUITE.erl +++ b/lib/compiler/test/beam_ssa_SUITE.erl @@ -23,7 +23,7 @@ init_per_group/2,end_per_group/2, calls/1,tuple_matching/1,recv/1,maps/1, cover_ssa_dead/1,combine_sw/1,share_opt/1, - beam_ssa_dead_crash/1,stack_init/1]). + beam_ssa_dead_crash/1,stack_init/1,grab_bag/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -40,7 +40,8 @@ groups() -> combine_sw, share_opt, beam_ssa_dead_crash, - stack_init + stack_init, + grab_bag ]}]. init_per_suite(Config) -> @@ -208,6 +209,8 @@ recv(_Config) -> %% tricky_recv_6/0 is a compile-time error. tricky_recv_6(), + recv_coverage(), + ok. sync_wait_mon({Pid, Ref}, Timeout) -> @@ -357,7 +360,7 @@ tricky_recv_5a() -> %% When fixing tricky_recv_5, we introduced a compiler crash when the common -%% exit block was ?BADARG_BLOCK and floats were in the picture. +%% exit block was ?EXCEPTION_BLOCK and floats were in the picture. tricky_recv_6() -> RefA = make_ref(), RefB = make_ref(), @@ -368,6 +371,69 @@ tricky_recv_6() -> ok end. +recv_coverage() -> + self() ! 1, + a = recv_coverage_1(), + self() ! 2, + b = recv_coverage_1(), + + self() ! 1, + a = recv_coverage_2(), + self() ! 2, + b = recv_coverage_2(), + + ok. + +%% Similar to tricky_recv_5/0, but provides test coverage for the #b_switch{} +%% terminator. +recv_coverage_1() -> + receive + X=1 -> + %% Jump to common exit block through #b_switch{list=L} + case id(0) of + 0 -> a; + 1 -> b; + 2 -> c; + 3 -> d + end; + X=2 -> + %% Jump to common exit block through #b_switch{fail=F} + case id(42) of + 0 -> exit(quit); + 1 -> exit(quit); + 2 -> exit(quit); + 3 -> exit(quit); + _ -> b + end + end, + case X of + 1 -> a; + 2 -> b + end. + +%% Similar to recv_coverage_1/0, providing test coverage for #b_br{}. +recv_coverage_2() -> + receive + X=1 -> + A = id(1), + %% Jump to common exit block through #b_br{succ=S}. + if + A =:= 1 -> a; + true -> exit(quit) + end; + X=2 -> + A = id(2), + %% Jump to common exit block through #b_br{fail=F}. + if + A =:= 1 -> exit(quit); + true -> a + end + end, + case X of + 1 -> a; + 2 -> b + end. + maps(_Config) -> {'EXIT',{{badmatch,#{}},_}} = (catch maps_1(any)), ok. @@ -419,48 +485,8 @@ cover_ssa_dead(_Config) -> 40.0 = percentage(4.0, 10.0), 60.0 = percentage(6, 10), - %% Cover '=:=', followed by '=/='. - false = 'cover__=:=__=/='(41), - true = 'cover__=:=__=/='(42), - false = 'cover__=:=__=/='(43), - - %% Cover '<', followed by '=/='. - true = 'cover__<__=/='(41), - false = 'cover__<__=/='(42), - false = 'cover__<__=/='(43), - - %% Cover '=<', followed by '=/='. - true = 'cover__=<__=/='(41), - true = 'cover__=<__=/='(42), - false = 'cover__=<__=/='(43), - - %% Cover '>=', followed by '=/='. - false = 'cover__>=__=/='(41), - true = 'cover__>=__=/='(42), - true = 'cover__>=__=/='(43), - - %% Cover '>', followed by '=/='. - false = 'cover__>__=/='(41), - false = 'cover__>__=/='(42), - true = 'cover__>__=/='(43), - ok. -'cover__=:=__=/='(X) when X =:= 42 -> X =/= 43; -'cover__=:=__=/='(_) -> false. - -'cover__<__=/='(X) when X < 42 -> X =/= 42; -'cover__<__=/='(_) -> false. - -'cover__=<__=/='(X) when X =< 42 -> X =/= 43; -'cover__=<__=/='(_) -> false. - -'cover__>=__=/='(X) when X >= 42 -> X =/= 41; -'cover__>=__=/='(_) -> false. - -'cover__>__=/='(X) when X > 42 -> X =/= 42; -'cover__>__=/='(_) -> false. - format_str(Str, FormatData, IoList, EscChars) -> Escapable = FormatData =:= escapable, case id(Str) of @@ -668,5 +694,72 @@ stack_init(Key, Map) -> %% (if the second clause was executed). id(Res). +grab_bag(_Config) -> + {'EXIT',_} = (catch grab_bag_1()), + {'EXIT',_} = (catch grab_bag_2()), + {'EXIT',_} = (catch grab_bag_3()), + {'EXIT',_} = (catch grab_bag_4()), + ok. + +grab_bag_1() -> + %% beam_kernel_to_ssa would crash when attempting to translate a make_fun + %% instruction without a destination variable. + (catch fun () -> 15 end)(true#{}). + +grab_bag_2() -> + %% is_guard_cg_safe/1 will be called with #cg_unreachable{}, which was + %% not handled. + 27 + or + try + try + x#{} + catch + _:_ -> + [] + end + after + false + end. + +grab_bag_3() -> + case + fun (V0) + when + %% The only thing left after optimizations would be + %% a bs_add instruction not followed by succeeded, + %% which would crash beam_ssa_codegen because there + %% was no failure label available. + binary_part(<<>>, + <<V0:V0/unit:196>>) -> + [] + end + of + <<>> -> + [] + end. + +grab_bag_4() -> + %% beam_kernel_to_ssa would crash because there was a #cg_phi{} + %% instruction that was not referenced from any #cg_break{}. + case $f of + V0 -> + try + try fy of + V0 -> + fu + catch + throw:$s -> + fy + end + catch + error:#{#{[] + [] => []} := false} when [] -> + fy + after + ok + end + end. + + %% The identity function. id(I) -> I. diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl index a99dee48aa..4ec427cdec 100644 --- a/lib/compiler/test/beam_type_SUITE.erl +++ b/lib/compiler/test/beam_type_SUITE.erl @@ -85,6 +85,8 @@ integers(_Config) -> two = do_integers_5(0, 2), three = do_integers_5(0, 3), + {'EXIT',{badarith,_}} = (catch do_integers_6()), + ok. do_integers_1(B0) -> @@ -131,6 +133,9 @@ do_integers_5(X0, Y0) -> 3 -> three end. +do_integers_6() -> + try b after 1 end band 0. + numbers(_Config) -> Int = id(42), true = is_integer(Int), diff --git a/lib/compiler/test/beam_types_SUITE.erl b/lib/compiler/test/beam_types_SUITE.erl new file mode 100644 index 0000000000..4fbf6a130e --- /dev/null +++ b/lib/compiler/test/beam_types_SUITE.erl @@ -0,0 +1,166 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. 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(beam_types_SUITE). + +-define(BEAM_TYPES_INTERNAL, true). +-include_lib("compiler/src/beam_types.hrl"). + +-export([all/0, suite/0, groups/0, + init_per_suite/1, end_per_suite/1]). + +-export([absorption/1, + associativity/1, + commutativity/1, + idempotence/1, + identity/1, + subtraction/1]). + +-export([binary_absorption/1, + integer_absorption/1, + integer_associativity/1, + tuple_absorption/1, + tuple_set_limit/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + [{group,property_tests}, + binary_absorption, + integer_absorption, + integer_associativity, + tuple_absorption, + tuple_set_limit]. + +groups() -> + [{property_tests,[parallel], + [absorption, + associativity, + commutativity, + idempotence, + identity, + subtraction]}]. + +init_per_suite(Config) -> + ct_property_test:init_per_suite(Config). + +end_per_suite(Config) -> + Config. + +absorption(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(beam_types_prop:absorption()). + true = ct_property_test:quickcheck(beam_types_prop:absorption(), Config). + +associativity(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(beam_types_prop:associativity()). + true = ct_property_test:quickcheck(beam_types_prop:associativity(), Config). + +commutativity(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(beam_types_prop:commutativity()). + true = ct_property_test:quickcheck(beam_types_prop:commutativity(), Config). + +idempotence(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(beam_types_prop:idempotence()). + true = ct_property_test:quickcheck(beam_types_prop:idempotence(), Config). + +identity(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(beam_types_prop:identity()). + true = ct_property_test:quickcheck(beam_types_prop:identity(), Config). + +subtraction(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(beam_types_prop:subtraction()). + true = ct_property_test:quickcheck(beam_types_prop:subtraction(), Config). + +binary_absorption(Config) when is_list(Config) -> + %% These binaries should meet into {binary,12} as that's the best common + %% unit for both types. + A = #t_bitstring{size_unit=4}, + B = #t_bitstring{size_unit=6}, + + #t_bitstring{size_unit=12} = beam_types:meet(A, B), + #t_bitstring{size_unit=2} = beam_types:join(A, B), + + A = beam_types:meet(A, beam_types:join(A, B)), + A = beam_types:join(A, beam_types:meet(A, B)), + + ok. + +integer_absorption(Config) when is_list(Config) -> + %% Integers that don't overlap at all should never meet. + A = #t_integer{elements={2,3}}, + B = #t_integer{elements={4,5}}, + + none = beam_types:meet(A, B), + #t_integer{elements={2,5}} = beam_types:join(A, B), + + A = beam_types:meet(A, beam_types:join(A, B)), + A = beam_types:join(A, beam_types:meet(A, B)), + + ok. + +integer_associativity(Config) when is_list(Config) -> + A = #t_integer{elements={3,5}}, + B = #t_integer{elements={4,6}}, + C = #t_integer{elements={5,5}}, + + %% a ∨ (b ∨ c) = (a ∨ b) ∨ c, + LHS_Join = beam_types:join(A, beam_types:join(B, C)), + RHS_Join = beam_types:join(beam_types:join(A, B), C), + #t_integer{elements={3,6}} = LHS_Join = RHS_Join, + + %% a ∧ (b ∧ c) = (a ∧ b) ∧ c. + LHS_Meet = beam_types:meet(A, beam_types:meet(B, C)), + RHS_Meet = beam_types:meet(beam_types:meet(A, B), C), + #t_integer{elements={5,5}} = LHS_Meet = RHS_Meet, + + ok. + +tuple_absorption(Config) when is_list(Config) -> + %% An inexact tuple can't meet an exact one that's smaller + + A = #t_tuple{size=3,exact=true, + elements=#{1 => #t_atom{elements=[gurka]}}}, + B = #t_tuple{size=5,exact=false, + elements=#{3 => #t_atom{elements=[gaffel]}}}, + + A = beam_types:meet(A, beam_types:join(A, B)), + A = beam_types:join(A, beam_types:meet(A, B)), + + ok. + +tuple_set_limit(Config) when is_list(Config) -> + %% When joining two tuple sets of differing sizes, the resulting set could + %% become larger than ?TUPLE_SET_LIMIT. + + As = [#t_tuple{size=N,exact=true, + elements=#{ 1 => #t_integer{elements={N,N}} }} || + N <- lists:seq(1, ?TUPLE_SET_LIMIT)], + + Bs = [#t_tuple{size=1,exact=true, + elements=#{ 1 => #t_integer{elements={N,N}} }} || + N <- lists:seq(1, ?TUPLE_SET_LIMIT)], + + A = beam_types:join(As), + B = beam_types:join(Bs), + + beam_types:verified_type(beam_types:join(A, B)), + + ok. diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index a3f42213e8..89981f1992 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -35,7 +35,8 @@ map_field_lists/1,cover_bin_opt/1, val_dsetel/1,bad_tuples/1,bad_try_catch_nesting/1, receive_stacked/1,aliased_types/1,type_conflict/1, - infer_on_eq/1,infer_dead_value/1, + infer_on_eq/1,infer_dead_value/1,infer_on_ne/1, + branch_to_try_handler/1,call_without_stack/1, receive_marker/1,safe_instructions/1, missing_return_type/1]). @@ -67,8 +68,10 @@ groups() -> map_field_lists,cover_bin_opt,val_dsetel, bad_tuples,bad_try_catch_nesting, receive_stacked,aliased_types,type_conflict, - infer_on_eq,infer_dead_value,receive_marker, - safe_instructions,missing_return_type]}]. + infer_on_eq,infer_dead_value,infer_on_ne, + branch_to_try_handler,call_without_stack, + receive_marker,safe_instructions, + missing_return_type]}]. init_per_suite(Config) -> test_lib:recompile(?MODULE), @@ -151,19 +154,34 @@ stack(Config) when is_list(Config) -> call_last(Config) when is_list(Config) -> Errors = do_val(call_last, Config), - [{{t,a,1},{{call_last,1,{f,8},2},9,{allocated,1}}}, + [{{t,a,1}, + {{call_last,1,{f,8},2},9,{allocated,1}}}, {{t,b,1}, - {{call_ext_last,2,{extfunc,lists,seq,2},2}, - 10, - {allocated,1}}}] = Errors, + {{call_ext_last,2,{extfunc,lists,seq,2},2},10,{allocated,1}}}, + {{t,baz,2}, + {{call_ext_only,2,{extfunc,erlang,put,2}},5,{allocated,0}}}, + {{t,biz,2}, + {{call_only,2,{f,10}},5,{allocated,0}}}] = Errors, + ok. + +call_without_stack(Config) when is_list(Config) -> + Errors = do_val(call_without_stack, Config), + [{{t,local,2}, + {{call,2,{f,2}},4,{allocated,none}}}, + {{t,remote,2}, + {{call_ext,2,{extfunc,lists,seq,2}},4,{allocated,none}}}] = Errors, ok. merge_undefined(Config) when is_list(Config) -> Errors = do_val(merge_undefined, Config), - [{{t,handle_call,2}, + [{{t,undecided,2}, {{call_ext,2,{extfunc,debug,filter,2}}, 22, - {uninitialized_reg,{y,_}}}}] = Errors, + {allocated,undecided}}}, + {{t,uninitialized,2}, + {{call_ext,2,{extfunc,io,format,2}}, + 17, + {uninitialized_reg,{y,1}}}}] = Errors, ok. uninit(Config) when is_list(Config) -> @@ -220,11 +238,11 @@ bad_catch_try(Config) when is_list(Config) -> {{catch_end,{x,9}}, 8,{invalid_tag_register,{x,9}}}}, {{bad_catch_try,bad_3,1}, - {{catch_end,{y,1}},9,{invalid_tag,{y,1},{atom,kalle}}}}, + {{catch_end,{y,1}},9,{invalid_tag,{y,1},{t_atom,[kalle]}}}}, {{bad_catch_try,bad_4,1}, {{'try',{x,0},{f,15}},5,{invalid_tag_register,{x,0}}}}, {{bad_catch_try,bad_5,1}, - {{try_case,{y,1}},12,{invalid_tag,{y,1},term}}}, + {{try_case,{y,1}},12,{invalid_tag,{y,1},any}}}, {{bad_catch_try,bad_6,1}, {{move,{integer,1},{y,1}},7, {invalid_store,{y,1}}}}] = Errors, @@ -235,7 +253,7 @@ cons_guard(Config) when is_list(Config) -> [{{cons,foo,1}, {{get_list,{x,0},{x,1},{x,2}}, 5, - {bad_type,{needed,cons},{actual,term}}}}] = Errors, + {bad_type,{needed,{t_cons,any,any}},{actual,any}}}}] = Errors, ok. freg_range(Config) when is_list(Config) -> @@ -266,7 +284,7 @@ freg_uninit(Config) when is_list(Config) -> {uninitialized_reg,{fr,1}}}}, {{t,sum_2,2}, {{bif,fadd,{f,0},[{fr,0},{fr,1}],{fr,0}}, - 9, + 10, {uninitialized_reg,{fr,0}}}}] = Errors, ok. @@ -523,9 +541,9 @@ bad_tuples(Config) -> {{bad_tuples,long,2}, {{put,{atom,too_long}},8,not_building_a_tuple}}, {{bad_tuples,self_referential,1}, - {{put,{x,1}},7,{tuple_in_progress,{x,1}}}}, + {{put,{x,1}},7,{unfinished_tuple,{x,1}}}}, {{bad_tuples,short,1}, - {{move,{x,1},{x,0}},7,{tuple_in_progress,{x,1}}}}] = Errors, + {{move,{x,1},{x,0}},7,{unfinished_tuple,{x,1}}}}] = Errors, ok. @@ -708,6 +726,25 @@ idv_1({_A, _B, _C, _D, _E, F, G}, idv_1(_A, _B) -> error. +%% ERL-998; type inference for select_val (#b_switch{}) was more clever than +%% that for is_ne_exact (#b_br{}), sometimes failing validation when the type +%% optimization pass acted on the former and the validator got the latter. + +-record(ion, {state}). + +infer_on_ne(Config) when is_list(Config) -> + #ion{state = closing} = ion_1(#ion{ state = id(open) }), + #ion{state = closing} = ion_close(#ion{ state = open }), + ok. + +ion_1(State = #ion{state = open}) -> ion_2(State); +ion_1(State = #ion{state = closing}) -> ion_2(State). + +ion_2(State = #ion{state = open}) -> ion_close(State); +ion_2(#ion{state = closing}) -> ok. + +ion_close(State = #ion{}) -> State#ion{state = closing}. + %% ERL-995: The first solution to ERIERL-348 was incomplete and caused %% validation to fail when living values depended on delayed type inference on %% "dead" values. @@ -725,6 +762,17 @@ idv_2(State) -> idv_called_once(_State) -> ok. +%% Direct jumps to try/catch handlers crash the emulator and must fail +%% validation. This is provoked by OTP-15945. + +branch_to_try_handler(Config) -> + Errors = do_val(branch_to_try_handler, Config), + [{{branch_to_try_handler,main,1}, + {{bif,tuple_size,{f,3},[{y,0}],{x,0}}, + 12, + {illegal_branch,try_handler,3}}}] = Errors, + ok. + receive_marker(Config) when is_list(Config) -> Errors = do_val(receive_marker, Config), diff --git a/lib/compiler/test/beam_validator_SUITE_data/branch_to_try_handler.S b/lib/compiler/test/beam_validator_SUITE_data/branch_to_try_handler.S new file mode 100644 index 0000000000..6d43ec7b54 --- /dev/null +++ b/lib/compiler/test/beam_validator_SUITE_data/branch_to_try_handler.S @@ -0,0 +1,48 @@ +{module, branch_to_try_handler}. %% version = 0 + +{exports, [{main,1}]}. + +{attributes, []}. + +{labels, 11}. + +{function, main, 1, 2}. + {label,1}. + {line,[{location,"t.erl",4}]}. + {func_info,{atom,branch_to_try_handler},{atom,main},1}. + {label,2}. + {allocate,2,1}. + {move,{x,0},{y,0}}. + {'try',{y,1},{f,3}}. + {move,{atom,ignored},{x,0}}. + {line,[{location,"t.erl",6}]}. + {call,1,{f,6}}. + {'%',{type_info,{x,0},{t_atom,[ignored]}}}. + {line,[{location,"t.erl",7}]}. + %% + %% Fail directly to the try handler instead of throwing an exception; this + %% will crash the emulator. + %% + {bif,tuple_size,{f,3},[{y,0}],{x,0}}. + %% + {test,is_eq_exact,{f,4},[{x,0},{integer,1}]}. + {move,{atom,error},{x,0}}. + {try_end,{y,1}}. + {deallocate,2}. + return. + {label,3}. + {try_case,{y,1}}. + {move,{atom,ok},{x,0}}. + {deallocate,2}. + return. + {label,4}. + {line,[{location,"t.erl",7}]}. + {badmatch,{x,0}}. + +{function, id, 1, 6}. + {label,5}. + {line,[{location,"t.erl",13}]}. + {func_info,{atom,branch_to_try_handler},{atom,id},1}. + {label,6}. + {'%',{type_info,{x,0},{t_atom,[ignored]}}}. + return. diff --git a/lib/compiler/test/beam_validator_SUITE_data/call_last.S b/lib/compiler/test/beam_validator_SUITE_data/call_last.S index 827b6c0ae6..ff81da1b57 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/call_last.S +++ b/lib/compiler/test/beam_validator_SUITE_data/call_last.S @@ -1,6 +1,6 @@ {module, call_last}. %% version = 0 -{exports, [{a,1},{b,1},{bar,1},{foo,1},{module_info,0},{module_info,1}]}. +{exports, [{a,1},{b,1},{bar,1},{foo,1},{baz,2},{biz,2}]}. {attributes, []}. @@ -53,19 +53,16 @@ {'%live',1}. return. - -{function, module_info, 0, 10}. +{function, baz, 2, 10}. {label,9}. - {func_info,{atom,t},{atom,module_info},0}. + {func_info,{atom,t},{atom,baz},2}. {label,10}. - {move,{atom,t},{x,0}}. - {call_ext_only,1,{extfunc,erlang,get_module_info,1}}. - + {allocate,0,2}. + {call_ext_only,2,{extfunc,erlang,put,2}}. -{function, module_info, 1, 12}. +{function, biz, 2, 12}. {label,11}. - {func_info,{atom,t},{atom,module_info},1}. + {func_info,{atom,t},{atom,biz},2}. {label,12}. - {move,{x,0},{x,1}}. - {move,{atom,t},{x,0}}. - {call_ext_only,2,{extfunc,erlang,get_module_info,2}}. + {allocate,0,2}. + {call_only,2,{f,10}}. diff --git a/lib/compiler/test/beam_validator_SUITE_data/call_without_stack.S b/lib/compiler/test/beam_validator_SUITE_data/call_without_stack.S new file mode 100644 index 0000000000..9ccbc163e3 --- /dev/null +++ b/lib/compiler/test/beam_validator_SUITE_data/call_without_stack.S @@ -0,0 +1,21 @@ +{module, call_without_stack}. %% version = 0 + +{exports, [{remote,2},{local,2}]}. + +{attributes, []}. + +{labels, 9}. + +{function, remote, 2, 2}. + {label,1}. + {func_info,{atom,t},{atom,remote},2}. + {label,2}. + {call_ext,2,{extfunc,lists,seq,2}}. + if_end. + +{function, local, 2, 4}. + {label,3}. + {func_info,{atom,t},{atom,local},2}. + {label,4}. + {call,2,{f,2}}. + if_end. diff --git a/lib/compiler/test/beam_validator_SUITE_data/freg_uninit.S b/lib/compiler/test/beam_validator_SUITE_data/freg_uninit.S index 71e833446a..2d4cbc9388 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/freg_uninit.S +++ b/lib/compiler/test/beam_validator_SUITE_data/freg_uninit.S @@ -21,12 +21,14 @@ {label,3}. {func_info,{atom,t},{atom,sum_2},2}. {label,4}. + {allocate,0,2}. {fconv,{x,0},{fr,0}}. {fconv,{x,1},{fr,1}}. fclearerror. {fcheckerror,{f,0}}. {call,2,{f,6}}. {bif,fadd,{f,0},[{fr,0},{fr,1}],{fr,0}}. + {deallocate,0}. return. {function, foo, 2, 6}. diff --git a/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S b/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S index aa344807e4..3035471f04 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S +++ b/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S @@ -1,15 +1,14 @@ {module, merge_undefined}. %% version = 0 -{exports, [{bar,2},{foo,1},{handle_call,2},{module_info,0},{module_info,1}]}. +{exports, [{uninitialized,2},{undecided,2}]}. {attributes, []}. {labels, 15}. - -{function, handle_call, 2, 2}. +{function, uninitialized, 2, 2}. {label,1}. - {func_info,{atom,t},{atom,handle_call},2}. + {func_info,{atom,t},{atom,uninitialized},2}. {label,2}. {test,is_atom,{f,1},[{x,0}]}. {select_val,{x,0},{f,1},{list,[{atom,gurka},{f,3},{atom,delete},{f,4}]}}. @@ -21,7 +20,7 @@ {move,{atom,nisse},{x,0}}. {call_ext,1,{extfunc,erlang,exit,1}}. {label,4}. - {allocate_heap,1,6,2}. + {allocate_heap,2,6,2}. {move,{x,1},{y,0}}. {put_list,{integer,112},nil,{x,0}}. {put_list,{integer,126},{x,0},{x,0}}. @@ -51,37 +50,57 @@ {call_ext,1,{extfunc,erlang,exit,1}}. {label,6}. {move,{y,0},{x,0}}. - {call_last,1,{f,8},1}. + {call_last,1,{f,14},1}. - -{function, foo, 1, 8}. +{function, undecided, 2, 8}. {label,7}. - {func_info,{atom,t},{atom,foo},1}. + {func_info,{atom,t},{atom,undecided},2}. {label,8}. - {move,{atom,ok},{x,0}}. - return. - - -{function, bar, 2, 10}. + {test,is_atom,{f,7},[{x,0}]}. + {select_val,{x,0},{f,1},{list,[{atom,gurka},{f,9},{atom,delete},{f,10}]}}. {label,9}. - {func_info,{atom,t},{atom,bar},2}. + {allocate_heap,2,6,2}. + {test,is_eq_exact,{f,11},[{x,0},{atom,ok}]}. + %% This is unreachable since {x,0} is known not to be 'ok'. We should not + %% fail with "uninitialized y registers" on erlang:exit/1 + {move,{atom,nisse},{x,0}}. + {call_ext,1,{extfunc,erlang,exit,1}}. {label,10}. - {move,{atom,ok},{x,0}}. - return. - - -{function, module_info, 0, 12}. + {allocate_heap,1,6,2}. + {move,{x,1},{y,0}}. + {put_list,{integer,112},nil,{x,0}}. + {put_list,{integer,126},{x,0},{x,0}}. + {put_list,{y,0},nil,{x,1}}. + {'%live',2}. + {call_ext,2,{extfunc,io,format,2}}. + {test,is_ne_exact,{f,12},[{x,0},{atom,ok}]}. {label,11}. - {func_info,{atom,t},{atom,module_info},0}. + %% The number of allocated Y registers are in conflict here. + {move,{atom,logReader},{x,1}}. + {move,{atom,console},{x,0}}. + {call_ext,2,{extfunc,debug,filter,2}}. + {test_heap,14,1}. + {put_list,{atom,logReader},nil,{x,1}}. + {put_list,{atom,console},{x,1},{x,1}}. + {put_tuple,3,{x,2}}. + {put,{atom,debug}}. + {put,{atom,filter}}. + {put,{x,1}}. + {put_tuple,2,{x,1}}. + {put,{x,2}}. + {put,{x,0}}. + {put_tuple,2,{x,0}}. + {put,{atom,badmatch}}. + {put,{x,1}}. + {'%live',1}. + {call_ext,1,{extfunc,erlang,exit,1}}. {label,12}. - {move,{atom,t},{x,0}}. - {call_ext_only,1,{extfunc,erlang,get_module_info,1}}. - + {move,{y,0},{x,0}}. + {call_last,1,{f,8},1}. -{function, module_info, 1, 14}. +{function, foo, 1, 14}. {label,13}. - {func_info,{atom,t},{atom,module_info},1}. + {func_info,{atom,t},{atom,foo},1}. {label,14}. - {move,{x,0},{x,1}}. - {move,{atom,t},{x,0}}. - {call_ext_only,2,{extfunc,erlang,get_module_info,2}}. + {move,{atom,ok},{x,0}}. + return. diff --git a/lib/compiler/test/bs_bincomp_SUITE.erl b/lib/compiler/test/bs_bincomp_SUITE.erl index 0419b16eea..eade3ff93f 100644 --- a/lib/compiler/test/bs_bincomp_SUITE.erl +++ b/lib/compiler/test/bs_bincomp_SUITE.erl @@ -191,7 +191,13 @@ coverage_trimmer(Params) -> coverage_summer(A, B, C, D) -> A+B+C+D. nomatch(Config) when is_list(Config) -> + Bin = id(<<1,2,3,4,5>>), <<>> = << <<X:8>> || X = {_,_} = [_|_] <- [1,2,3] >>, + [] = [X || <<X:all/binary>> <= Bin], + [] = [X || <<X:bad/binary>> <= Bin], + <<>> = << <<X:32>> || <<X:all/binary>> <= Bin >>, + <<>> = << <<X:32>> || <<X:bad/binary>> <= Bin >>, + ok. sizes(Config) when is_list(Config) -> diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl index bccd70d6cb..1c61d6cce4 100644 --- a/lib/compiler/test/bs_construct_SUITE.erl +++ b/lib/compiler/test/bs_construct_SUITE.erl @@ -31,7 +31,7 @@ two/1,test1/1,fail/1,float_bin/1,in_guard/1,in_catch/1, nasty_literals/1,coerce_to_float/1,side_effect/1, opt/1,otp_7556/1,float_arith/1,otp_8054/1, - cover/1]). + cover/1,bad_size/1]). -include_lib("common_test/include/ct.hrl"). @@ -47,7 +47,7 @@ groups() -> [verify_highest_opcode, two,test1,fail,float_bin,in_guard,in_catch, nasty_literals,side_effect,opt,otp_7556,float_arith, - otp_8054,cover]}]. + otp_8054,cover,bad_size]}]. init_per_suite(Config) -> @@ -332,6 +332,24 @@ fail(Config) when is_list(Config) -> %% Unaligned sizes with literal binaries. {'EXIT',{badarg,_}} = (catch <<0,(<<7777:17>>)/binary>>), + %% Make sure that variables are bound even if binary + %% construction fails. + {'EXIT',{badarg,_}} = (catch case <<face:(V0 = 42)>> of + _Any -> V0 + end), + {'EXIT',{badarg,_}} = (catch case <<face:(V1 = 3)>> of + a when V1 -> + office + end), + {'EXIT',{badarg,_}} = (catch <<13:(put(?FUNCTION_NAME, 17))>>), + 17 = erase(?FUNCTION_NAME), + + %% Size exceeds length of binary. 'native' is redundant for + %% binaries, but when it was present sys_core_fold would not + %% detect the overlong binary and beam_ssa_opt would crash. + {'EXIT',{badarg,_}} = (catch << <<$t/little-signed>>:42/native-bytes >>), + {'EXIT',{badarg,_}} = (catch << <<$t/little-signed>>:42/bytes >>), + ok. float_bin(Config) when is_list(Config) -> @@ -559,6 +577,7 @@ otp_7556(Bin, A, B, C) -> float_arith(Config) when is_list(Config) -> {<<1,2,3,64,69,0,0,0,0,0,0>>,21.0} = do_float_arith(<<1,2,3>>, 42, 2), + ok. do_float_arith(Bin0, X, Y) -> @@ -597,3 +616,30 @@ cover(Config) -> Bin = id(<<L:32,?LONG_STRING>>), <<L:32,?LONG_STRING>> = Bin, ok. + +bad_size(_Config) -> + {'EXIT',{badarg,_}} = (catch bad_float_size()), + {'EXIT',{badarg,_}} = (catch bad_float_size(<<"abc">>)), + {'EXIT',{badarg,_}} = (catch bad_integer_size()), + {'EXIT',{badarg,_}} = (catch bad_integer_size(<<"xyz">>)), + {'EXIT',{badarg,_}} = (catch bad_binary_size()), + {'EXIT',{badarg,_}} = (catch bad_binary_size(<<"xyz">>)), + ok. + +bad_float_size() -> + <<4.087073429964284:case 0 of 0 -> art end/float>>. + +bad_float_size(Bin) -> + <<Bin/binary,4.087073429964284:case 0 of 0 -> art end/float>>. + +bad_integer_size() -> + <<0:case 0 of 0 -> art end/integer>>. + +bad_integer_size(Bin) -> + <<Bin/binary,0:case 0 of 0 -> art end/integer>>. + +bad_binary_size() -> + <<<<"abc">>:case 0 of 0 -> art end/binary>>. + +bad_binary_size(Bin) -> + <<Bin/binary,<<"abc">>:case 0 of 0 -> art end/binary>>. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index a789b82910..226d526534 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -24,7 +24,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, - verify_highest_opcode/1, + verify_highest_opcode/1, expand_and_squeeze/1, size_shadow/1,int_float/1,otp_5269/1,null_fields/1,wiger/1, bin_tail/1,save_restore/1, partitioned_bs_match/1,function_clause/1, @@ -45,7 +45,8 @@ expression_before_match/1,erl_689/1,restore_on_call/1, restore_after_catch/1,matches_on_parameter/1,big_positions/1, matching_meets_apply/1,bs_start_match2_defs/1, - exceptions_after_match_failure/1, bad_phi_paths/1]). + exceptions_after_match_failure/1, + bad_phi_paths/1,many_clauses/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -61,10 +62,10 @@ all() -> [{group,p}]. groups() -> - [{p,[], + [{p,test_lib:parallel(), [verify_highest_opcode, size_shadow,int_float,otp_5269,null_fields,wiger, - bin_tail,save_restore, + bin_tail,save_restore,expand_and_squeeze, partitioned_bs_match,function_clause,unit, shared_sub_bins,bin_and_float,dec_subidentifiers, skip_optional_tag,decode_integer,wfbm,degenerated_match,bs_sum, @@ -82,8 +83,8 @@ groups() -> expression_before_match,erl_689,restore_on_call, matches_on_parameter,big_positions, matching_meets_apply,bs_start_match2_defs, - exceptions_after_match_failure,bad_phi_paths]}]. - + exceptions_after_match_failure,bad_phi_paths, + many_clauses]}]. init_per_suite(Config) -> test_lib:recompile(?MODULE), @@ -137,22 +138,59 @@ size_shadow(Config) when is_list(Config) -> size_shadow_1() -> L = 8, - F = fun(<<L:L,B:L>>) -> B end, - F(<<16:8, 7:16>>). + Fs = [fun(<<L:L,B:L>>) -> B end, + fun(A) -> + (fun([<<L:L,B:L>>]) -> B end)([A]) + end, + fun(A) -> + (fun([<<L:L,B:L>>,<<L:L,B:L>>]) -> B end)([A,A]) + end, + fun(A) -> + <<Size:L,_/bits>> = A, + Inner = fun([L], {#{key1 := <<L:L,B:L>>, + key2 := <<L:L,B:L>>}, L}) -> B end, + Inner([Size], {#{key1 => A,key2 => A},Size}) + end], + size_shadow_apply(Fs, <<16:8, 7:16>>). size_shadow_2(L) -> - F = fun(<<L:L,B:L>>) -> B end, - F(<<16:8, 7:16>>). + Fs = [fun(<<L:L,B:L>>) -> B end, + fun(A) -> + (fun([<<L:L,B:L>>]) -> B end)([A]) + end, + fun(A) -> + (fun({<<L:L,B:L>>,<<L:L,B:L>>}) -> B end)({A,A}) + end], + size_shadow_apply(Fs, <<16:8, 7:16>>). size_shadow_3() -> L = 8, - F = fun(<<L:L,B:L,L:L>>) -> B end, - F(<<16:8, 7:16,16:16>>). + Fs = [fun(<<L:L,B:L,L:L>>) -> B end, + fun(A) -> + (fun({tag,[<<L:L,B:L,L:L>>]}) -> B end)({tag,[A]}) + end, + fun(A) -> + (fun({tag,<<L:L,B:L,L:L>>,<<L:L,B:L,L:L>>}) -> B end)({tag,A,A}) + end], + size_shadow_apply(Fs, <<16:8, 7:16,16:16>>). size_shadow_4(L) -> - F = fun(<<L:L,B:L,L:L>>) -> B; - (_) -> no end, - F(<<16:8, 7:16,15:16>>). + Fs = [fun(<<L:L,B:L,L:L>>) -> B; + (_) -> no + end, + fun(A) -> + Inner = fun([<<L:L,B:L,L:L>>]) -> B; + (_) -> no + end, + Inner([A]) + end, + fun(A) -> + Inner = fun({<<L:L,B:L,L:L>>,<<L:L,B:L,L:L>>}) -> B; + (_) -> no + end, + Inner({A,A}) + end], + size_shadow_apply(Fs, <<16:8, 7:16,15:16>>). size_shadow_5(X, Y) -> fun (<< A:Y >>, Y, B) -> fum(A, X, Y, B) end. @@ -166,6 +204,14 @@ fum(A, B, C, D) -> size_shadow_7({int,N}, <<N:16,B:N/binary,T/binary>>) -> {B,T}. +size_shadow_apply([F|Fs], Arg) when is_function(F, 1) -> + size_shadow_apply(Fs, Arg, F(Arg)). + +size_shadow_apply([F|Fs], Arg, Res) when is_function(F, 1) -> + Res = F(Arg), + size_shadow_apply(Fs, Arg, Res); +size_shadow_apply([], _, Res) -> + Res. int_float(Config) when is_list(Config) -> %% OTP-5323 @@ -502,6 +548,9 @@ unit(Config) when is_list(Config) -> {'EXIT',_} = (catch unit_opt_2(<<1:32,33:7>>)), {'EXIT',_} = (catch unit_opt_2(<<2:32,55:7>>)), + <<0:64>> = unit_opt_3(<<1:128>>), + <<1:64>> = unit_opt_3(<<1:64>>), + ok. peek1(<<B:8,_/bitstring>>) -> B. @@ -533,6 +582,13 @@ unit_opt_2(<<St:32,KO/binary>> = Bin0) -> end, id(Bin). +unit_opt_3(A) when is_binary(A) -> + %% There should be no test_unit instruction after the first segment, since + %% we already know A is a binary and its tail will still be a binary after + %% matching 8 bytes from it. + <<Bin:8/binary, _/binary>> = A, + Bin. + shared_sub_bins(Config) when is_list(Config) -> {15,[<<>>,<<5>>,<<4,5>>,<<3,4,5>>,<<2,3,4,5>>]} = sum(<<1,2,3,4,5>>, [], 0), ok. @@ -1256,11 +1312,80 @@ zero_width(Config) when is_list(Config) -> %% OTP_7650: A invalid size for binary segments could crash the compiler. bad_size(Config) when is_list(Config) -> Tuple = {a,b,c}, - {'EXIT',{{badmatch,<<>>},_}} = (catch <<32:Tuple>> = id(<<>>)), Binary = <<1,2,3>>, + Atom = an_atom, + + {'EXIT',{{badmatch,<<>>},_}} = (catch <<32:Tuple>> = id(<<>>)), {'EXIT',{{badmatch,<<>>},_}} = (catch <<32:Binary>> = id(<<>>)), + {'EXIT',{{badmatch,<<>>},_}} = (catch <<32:Atom>> = id(<<>>)), + + {'EXIT',{{badmatch,<<>>},_}} = (catch <<42.0:Tuple/float>> = id(<<>>)), + {'EXIT',{{badmatch,<<>>},_}} = (catch <<42.0:Binary/float>> = id(<<>>)), + {'EXIT',{{badmatch,<<>>},_}} = (catch <<42.0:Atom/float>> = id(<<>>)), + + %% Matched out value is ignored. + {'EXIT',{{badmatch,<<>>},_}} = (catch <<_:Binary>> = id(<<>>)), + {'EXIT',{{badmatch,<<>>},_}} = (catch <<_:Tuple>> = id(<<>>)), + {'EXIT',{{badmatch,<<>>},_}} = (catch <<_:Atom>> = id(<<>>)), + + no_match = bad_all_size(<<>>), + no_match = bad_all_size(<<1,2,3>>), + ok. +bad_all_size(Bin) -> + Res = bad_all_size_1(Bin), + Res = bad_all_size_2(Bin), + Res = bad_all_size_3(Bin), + Res = bad_all_size_4(Bin), + Res = bad_all_size_5(Bin), + Res = bad_all_size_6(Bin), + Res. + +bad_all_size_1(Bin) -> + case Bin of + <<B:all/binary>> -> B; + _ -> no_match + end. + +bad_all_size_2(Bin) -> + case Bin of + <<_:all/binary>> -> ok; + _ -> no_match + end. + +bad_all_size_3(Bin) -> + All = all, + case Bin of + <<B:All/binary>> -> B; + _ -> no_match + end. + +bad_all_size_4(Bin) -> + All = all, + case Bin of + <<_:All/binary>> -> ok; + _ -> no_match + end. + +bad_all_size_5(Bin) -> + All = case 0 of + 0 -> all + end, + case Bin of + <<B:All/binary>> -> B; + _ -> no_match + end. + +bad_all_size_6(Bin) -> + All = case 0 of + 0 -> all + end, + case Bin of + <<_:All/binary>> -> ok; + _ -> no_match + end. + haystack(Config) when is_list(Config) -> <<0:10/unit:8>> = haystack_1(<<0:10/unit:8>>), [<<0:10/unit:8>>, @@ -1324,23 +1449,182 @@ matched_out_size(Config) when is_list(Config) -> {<<1,2,3,7>>,19,42} = mos_bin(<<4,1,2,3,7,19,4,42>>), <<1,2,3,7>> = mos_bin(<<4,1,2,3,7,"abcdefghij">>), - ok. + false = mos_verify_sig(not_a_binary), + false = mos_verify_sig(<<>>), + false = mos_verify_sig(<<42:32>>), + <<"123456789">> = mos_verify_sig(<<77:32,0:77/unit:8,9:32,"123456789">>), + + ok. + +mos_int(B) -> + Res = mos_int_plain(B), + Res = mos_int_list([B]), + Res = mos_int_tuple({a,[B],z}), + + Res = mos_int_mixed([B]), + Res = mos_int_mixed({a,[B],z}), + 42 = mos_int_mixed({30,12}), + no_match = mos_int_mixed([B,B,B]), + + Res = mos_int_pats1({tag,[B]}, {0,1,2,3,4,5,6,7,8,9}), + Res = mos_int_pats2({tag,[B]}, {a,a,a,a,a,a,a,a,a,a}, [z]), + {I,X} = Res, + Res = mos_int_pats3({tag,[B]}, [I,{X,B,X},I]), + Res = mos_int_map(#{key => [B]}), + Key = {my,key}, + Res = mos_int_map(Key, #{Key => [B]}), + {I,X,B} = mos_int_alias([[B]]), + Res = {I,X}, + Res = mos_int_try([B]), + Res = mos_int_receive(B), + Res = mos_int_fun([B]), + Res = mos_int_exported(B), + Res = mos_int_utf(B), + Res. + +mos_int_plain(<<L,I:L,X:32>>) -> + {I,X}; +mos_int_plain(<<L,I:L,X:64>>) -> + {I,X}. + +mos_int_list([<<L,I:L,X:32>>]) -> + {I,X}; +mos_int_list([<<L,I:L,X:64>>]) -> + {I,X}. -mos_int(<<L,I:L,X:32>>) -> +mos_int_tuple({a,[<<L,I:L,X:32>>],z}) -> {I,X}; -mos_int(<<L,I:L,X:64>>) -> +mos_int_tuple({a,[<<L,I:L,X:64>>],z}) -> {I,X}. -mos_bin(<<L,Bin:L/binary,X:8,L>>) -> +mos_int_mixed({a,[<<L,I:L,X:32>>],z}) -> + {I,X}; +mos_int_mixed({a,[<<L,I:L,X:64>>],z}) -> + {I,X}; +mos_int_mixed([<<L,I:L,X:32>>]) -> + {I,X}; +mos_int_mixed([<<L,I:L,X:64>>]) -> + {I,X}; +mos_int_mixed({A,B}) when is_integer(A), is_integer(B) -> + A + B; +mos_int_mixed(_) -> + no_match. + +mos_int_pats1({tag,[<<L,I:L,X:32>>]}, {_,_,_,_,_,_,_,_,_,_}) -> + {I,X}; +mos_int_pats1({tag,[<<L,I:L,X:64>>]}, {_,_,_,_,_,_,_,_,_,_}) -> + {I,X}. + +mos_int_pats2({tag,[<<L,I:L,X:32>>]}, {S,S,S,S,S,S,S,S,S,S}, [_|_]) -> + {I,X}; +mos_int_pats2({tag,[<<L,I:L,X:64>>]}, {S,S,S,S,S,S,S,S,S,S}, [_|_]) -> + {I,X}. + +mos_int_pats3({tag,[<<L,I:L,X:32>>]}, [I,{X,<<L,I:L,X:32>>,X},I]) -> + {I,X}; +mos_int_pats3({tag,[<<L,I:L,X:64>>]}, [I,{X,<<L,I:L,X:64>>,X},I]) -> + {I,X}. + +mos_int_map(#{key := [<<L,I:L,X:32>>]}) -> + {I,X}; +mos_int_map(#{key := [<<L,I:L,X:64>>]}) -> + {I,X}. + +mos_int_map(Key, Map) -> + case Map of + #{Key := [<<L,I:L,X:32>>]} -> {I,X}; + #{Key := [<<L,I:L,X:64>>]} -> {I,X} + end. + +mos_int_alias([[<<L,I:L,X:32>> = B]]) -> + {I,X,B}; +mos_int_alias([[<<L,I:L,X:64>> = B]]) -> + {I,X,B}. + +mos_int_try(B) -> + try id(B) of + [<<L,I:L,X:32>>] -> {I,X}; + [<<L,I:L,X:64>>] -> {I,X} + after + ok + end. + +mos_int_receive(Msg) -> + Res = (fun() -> + self() ! Msg, + receive + <<L,I:L,X:32>> -> {I,X}; + <<L,I:L,X:64>> -> {I,X} + end + end)(), + self() ! Msg, + Res = receive + <<L,I:L,X:32>> -> {I,X}; + <<L,I:L,X:64>> -> {I,X} + end, + self() ! {tag,[Msg]}, + Res = receive + {tag,[<<L,I:L,X:32>>]} -> {I,X}; + {tag,[<<L,I:L,X:64>>]} -> {I,X} + end, + Res. + +mos_int_fun(B) -> + L = ignore_me, + F = fun ([<<L,I:L,X:32>>]) -> {I,X}; + ([<<L,I:L,X:64>>]) -> {I,X} + end, + F(B). + +mos_int_exported(B) -> + case B of + <<L,I:L,X:32>> -> ok; + <<L,I:L,X:64>> -> ok + end, + {I,X}. + +mos_int_utf(B0) -> + B = id(<<B0/bits,777/utf8,7777/utf16,9999/utf32>>), + case B of + <<L,I:L,X:32,777/utf8,7777/utf16,9999/utf32>> -> {I,X}; + <<L,I:L,X:64,777/utf8,7777/utf16,9999/utf32>> -> {I,X} + end. + +mos_bin(B) -> + Res = mos_bin_plain(B), + Res = mos_bin_tuple({outer,{inner,B}}), + Res. + +mos_bin_plain(<<L,Bin:L/binary,X:8,L>>) -> L = byte_size(Bin), {Bin,X}; -mos_bin(<<L,Bin:L/binary,X:8,L,Y:8>>) -> +mos_bin_plain(<<L,Bin:L/binary,X:8,L,Y:8>>) -> L = byte_size(Bin), {Bin,X,Y}; -mos_bin(<<L,Bin:L/binary,"abcdefghij">>) -> +mos_bin_plain(<<L,Bin:L/binary,"abcdefghij">>) -> L = byte_size(Bin), Bin. +mos_bin_tuple({outer,{inner,<<L,Bin:L/binary,X:8,L>>}}) -> + L = byte_size(Bin), + {Bin,X}; +mos_bin_tuple({outer,{inner,<<L,Bin:L/binary,X:8,L,Y:8>>}}) -> + L = byte_size(Bin), + {Bin,X,Y}; +mos_bin_tuple({outer,{inner,<<L,Bin:L/binary,"abcdefghij">>}}) -> + L = byte_size(Bin), + Bin. + +mos_verify_sig(AlgSig) -> + try + <<AlgLen:32, _Alg:AlgLen/binary, + SigLen:32, Sig:SigLen/binary>> = AlgSig, + Sig + catch + _:_ -> + false + end. + follow_fail_branch(_) -> 42 = ffb_1(<<0,1>>, <<0>>), 8 = ffb_1(<<0,1>>, [a]), @@ -2034,3 +2318,187 @@ bad_phi_paths_1(Arg) -> id(B). id(I) -> I. + +expand_and_squeeze(Config) when is_list(Config) -> + %% UTF8 literals are expanded and then squeezed into integer16 + [ + {test,bs_get_integer2,_,_,[_,{integer,16}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<$á/utf8,_/binary>>"), + ?Q("<<$é/utf8,_/binary>>") + ]), + + %% Sized integers are expanded and then squeezed into integer16 + [ + {test,bs_get_integer2,_,_,[_,{integer,16}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<0:32,_/binary>>"), + ?Q("<<\"bbbb\",_/binary>>") + ]), + + %% Groups of 8 bits are squeezed into integer16 + [ + {test,bs_get_integer2,_,_,[_,{integer,16}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<\"aaaa\",_/binary>>"), + ?Q("<<\"bbbb\",_/binary>>") + ]), + + %% Groups of 8 bits with empty binary are also squeezed + [ + {test,bs_get_integer2,_,_,[_,{integer,16}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<\"aaaa\",_/binary>>"), + ?Q("<<\"bbbb\",_/binary>>"), + ?Q("<<>>") + ]), + + %% Groups of 8 bits with float lookup are not squeezed + [ + {test,bs_get_integer2,_,_,[_,{integer,8}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<\"aaaa\",_/binary>>"), + ?Q("<<\"bbbb\",_/binary>>"), + ?Q("<<_/float>>") + ]), + + %% Groups of diverse bits go with minimum possible + [ + {test,bs_get_integer2,_,_,[_,{integer,8}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<\"aa\",_/binary>>"), + ?Q("<<\"bb\",_/binary>>"), + ?Q("<<\"c\",_/binary>>") + ]), + + %% Groups of diverse bits go with minimum possible but are recursive... + [ + {test,bs_get_integer2,_,_,[_,{integer,8}|_],_} + | RestDiverse + ] = binary_match_to_asm([ + ?Q("<<\"aaa\",_/binary>>"), + ?Q("<<\"abb\",_/binary>>"), + ?Q("<<\"c\",_/binary>>") + ]), + + %% so we still perform a 16 bits lookup for the remaining + true = lists:any(fun({test,bs_get_integer2,_,_,[_,{integer,16}|_],_}) -> true; + (_) -> false end, RestDiverse), + + %% Large match is kept as is if there is a sized match later + [ + {test,bs_get_integer2,_,_,[_,{integer,64}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<255,255,255,255,255,255,255,255>>"), + ?Q("<<_:64>>") + ]), + + %% Large match is kept as is with large matches before and after + [ + {test,bs_get_integer2,_,_,[_,{integer,32}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<A:32,_:A>>"), + ?Q("<<0:32>>"), + ?Q("<<_:32>>") + ]), + + %% Large match is kept as is with large matches before and after + [ + {test,bs_get_integer2,_,_,[_,{integer,32}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<A:32,_:A>>"), + ?Q("<<0,0,0,0>>"), + ?Q("<<_:32>>") + ]), + + %% Large match is kept as is with smaller but still large matches before and after + [ + {test,bs_get_integer2,_,_,[_,{integer,32}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<A:32, _:A>>"), + ?Q("<<0:64>>"), + ?Q("<<_:32>>") + ]), + + %% There is no squeezing for groups with more than 16 matches + [ + {test,bs_get_integer2,_,_,[_,{integer,8}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<\"aa\", _/binary>>"), + ?Q("<<\"bb\", _/binary>>"), + ?Q("<<\"cc\", _/binary>>"), + ?Q("<<\"dd\", _/binary>>"), + ?Q("<<\"ee\", _/binary>>"), + ?Q("<<\"ff\", _/binary>>"), + ?Q("<<\"gg\", _/binary>>"), + ?Q("<<\"hh\", _/binary>>"), + ?Q("<<\"ii\", _/binary>>"), + ?Q("<<\"jj\", _/binary>>"), + ?Q("<<\"kk\", _/binary>>"), + ?Q("<<\"ll\", _/binary>>"), + ?Q("<<\"mm\", _/binary>>"), + ?Q("<<\"nn\", _/binary>>"), + ?Q("<<\"oo\", _/binary>>"), + ?Q("<<\"pp\", _/binary>>") + ]), + + ok. + +binary_match_to_asm(Matches) -> + Clauses = [ + begin + Ann = element(2, Match), + {clause,Ann,[Match],[],[{integer,Ann,Return}]} + end || {Match,Return} <- lists:zip(Matches, lists:seq(1, length(Matches))) + ], + + Module = [ + {attribute,1,module,match_to_asm}, + {attribute,2,export,[{example,1}]}, + {function,3,example,1,Clauses} + ], + + {ok,match_to_asm,{match_to_asm,_Exports,_Attrs,Funs,_},_} = + compile:forms(Module, [return, to_asm]), + + [{function,example,1,2,AllInstructions}|_] = Funs, + [{label,_},{line,_},{func_info,_,_,_},{label,_},{'%',_}, + {test,bs_start_match3,_,_,_,_},{bs_get_position,_,_,_}|Instructions] = AllInstructions, + Instructions. + +many_clauses(_Config) -> + Mod = list_to_atom(?MODULE_STRING ++ "_" ++ + atom_to_list(?FUNCTION_NAME)), + Seq = lists:seq(1, 200), + S = [one_clause(I) || I <- Seq], + Code = ?Q(["-module('@Mod@').\n" + "-export([f/1]).\n" + "f(Bin) ->\n" + "case Bin of\n" + " dummy -> _@_@S\n" + "end.\n"]), + %% merl:print(Code), + Opts = test_lib:opt_opts(?MODULE), + {ok,_} = merl:compile_and_load(Code, Opts), + _ = [begin + H = erlang:phash2(I), + Sz = 16, + <<Res0:Sz>> = <<H:Sz>>, + Res = I + Res0, + Res = Mod:f({I,<<Sz:8,H:Sz>>}) + end || I <- Seq], + ok. + +one_clause(I) -> + ?Q(<<"{_@I@,<<L:8,Val:L>>} -> _@I@ + Val">>). diff --git a/lib/compiler/test/bs_size_expr_SUITE.erl b/lib/compiler/test/bs_size_expr_SUITE.erl new file mode 100644 index 0000000000..a9e562313b --- /dev/null +++ b/lib/compiler/test/bs_size_expr_SUITE.erl @@ -0,0 +1,286 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. 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(bs_size_expr_SUITE). +-compile(nowarn_shadow_vars). + +-export([all/0,suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2, + basic/1,size_shadow/1,complex/1, + recv/1,no_match/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. + +all() -> + [{group,p}]. + +groups() -> + [{p,test_lib:parallel(), + [basic, + size_shadow, + complex, + recv, + no_match]}]. + +init_per_suite(Config) -> + test_lib:recompile(?MODULE), + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> + Config. + +end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> + ok. + +basic(_Config) -> + <<>> = do_basic(<<1:32>>), + <<"abcd">> = do_basic(<<2:32,"abcd">>), + no_match = do_basic(<<0:32>>), + no_match = do_basic(<<777:32>>), + ok. + +do_basic(Bin) -> + Res = do_basic_1(Bin), + + Res = do_basic_2({tag,Bin}), + Res = do_basic_2([list,Bin]), + 6 = do_basic_2({2,4}), + + Res = do_basic_3(Bin), + Res = do_basic_4(Bin), + + {result,Res} = do_basic_5(Bin), + case Res of + no_match -> + ok; + _ -> + {result,{Res,7777777}} = do_basic_5(<<Bin/binary,7777777:32>>) + end, + + Res. + +do_basic_1(<<Sz:32,Tail:(4*Sz-4)/binary>>) -> + Tail; +do_basic_1(<<_/binary>>) -> + no_match. + +do_basic_2({tag,<<Sz:32,Tail:(4*Sz-4)/binary>>}) -> + Tail; +do_basic_2([list,<<Sz:32,Tail:((Sz-1)*4)/binary>>]) -> + Tail; +do_basic_2({A,B}) when is_integer(A), is_integer(B) -> + A + B; +do_basic_2(_) -> + no_match. + +do_basic_3(Bin) -> + WordSize = id(4), + case Bin of + <<Sz:32,Tail:(WordSize*Sz-WordSize)/binary>> -> + Tail; + _ -> + no_match + end. + +do_basic_4(Bin) -> + WordSize = id(4), + F = fun() -> + case Bin of + <<Sz:32,Tail:(WordSize*Sz-WordSize)/binary>> -> + Tail; + _ -> + no_match + end + end, + F(). + +do_basic_5(Bin) -> + WordSize = id(4), + F = fun() -> + Res = case Bin of + <<Sz:32,Tail:(WordSize*Sz-WordSize)/binary,More:(8*WordSize)>> -> + {Tail,More}; + <<Sz:32,Tail:(WordSize*Sz-WordSize)/binary>> -> + Tail; + _ -> + no_match + end, + {result,Res} + end, + F(). + +size_shadow(_Config) -> + 12345678 = size_shadow_1(), + ok. + +size_shadow_1() -> + L = 8, + Offset = 16, + Fs = [fun(<<L:L,B:(L+16)>>) -> B end, + fun(<<L:L,B:(L+Offset)>>) -> B end, + fun(A) -> + Res = (fun([<<L:L,B:(L+16)>>]) -> B end)([A]), + Res = (fun([<<L:L,B:(L+Offset)>>]) -> B end)([A]) + end, + fun(A) -> + Res = (fun({<<L:L,B:(L+16)>>,<<L:L,B:(L+16)>>}) -> B end)({A,A}), + Res = (fun({<<L:L,B:(L+Offset)>>,<<L:L,B:(L+16)>>}) -> B end)({A,A}), + Res = (fun({<<L:L,B:(L+16)>>,<<L:L,B:(L+Offset)>>}) -> B end)({A,A}), + Res = (fun({<<L:L,B:(L+Offset)>>,<<L:L,B:(L+Offset)>>}) -> B end)({A,A}) + end, + fun(A) -> + <<Size:L,_/bits>> = A, + Inner = fun([L], {#{key1 := <<L:L,B:(L+Offset)>>, + key2 := <<L:L,B:(L+Offset)>>}, L}) -> B end, + Inner([Size], {#{key1 => A,key2 => A},Size}) + end], + size_shadow_apply(Fs, <<16:8, 12345678:32>>). + +size_shadow_apply([F|Fs], Arg) when is_function(F, 1) -> + size_shadow_apply(Fs, Arg, F(Arg)). + +size_shadow_apply([F|Fs], Arg, Res) when is_function(F, 1) -> + Res = F(Arg), + size_shadow_apply(Fs, Arg, Res); +size_shadow_apply([], _, Res) -> + Res. + +-record(r, {a,b,c}). +complex(Config) -> + (fun() -> + Len = length(id(Config)), + Bin = << <<I:13>> || I <- lists:seq(1, Len) >>, + <<Bin:(length(Config))/binary-unit:13>> = Bin + end)(), + + (fun() -> + V = id([a,b,c]), + F = fun(<<V:(bit_size(<<0:(length(V))>>)*8)/signed-integer>>) -> + V; + ({A,B}) -> + A + B + end, + -1 = F(<<-1:(length(V)*8)>>), + 7 = F({3,4}) + end)(), + + (fun() -> + A = a, + B = b, + F = fun(<<A:16,B:16,C:(A+B),D/bits>>) -> + {A,B,C,D}; + (<<A:16,B:16>>) -> + {A,B}; + (<<A:8,B:8>>) -> + {A,B} + end, + {13,21,16#cafebeef,<<"more">>} = F(<<13:16,21:16,16#cafebeef:34,"more">>), + {100,500} = F(<<100:16,500:16>>), + {157,77} = F(<<157:8,77:8>>), + {A,B} + end)(), + + (fun() -> + Two = id(2), + F = fun(a, <<_:(#r.a - Two)/binary,Int:8,_/binary>>) -> Int; + (b, <<_:(#r.b - Two)/binary,Int:8,_/binary>>) -> Int; + (c, <<_:(#r.c - Two)/binary,Int:8,_/binary>>) -> Int + end, + 1 = F(a, <<1,2,3>>), + 2 = F(b, <<1,2,3>>), + 3 = F(c, <<1,2,3>>) + end)(), + + (fun() -> + Bin = <<1,2,3,4>>, + F = fun(R) -> + <<First:(R#r.a)/binary,Tail/binary>> = Bin, + {First,Tail} + end, + {<<>>,<<1,2,3,4>>} = F(#r{a=0}), + {<<1>>,<<2,3,4>>} = F(#r{a=1}), + {<<1,2>>,<<3,4>>} = F(#r{a=2}), + {<<1,2,3>>,<<4>>} = F(#r{a=3}), + {<<1,2,3,4>>,<<>>} = F(#r{a=4}) + end)(), + + ok. + +recv(_Config) -> + R = fun(Msg) -> + self() ! Msg, + Res = receive + <<L,I:(L-1)/unit:8,X:32>> -> {I,X}; + <<L,I:(L-1)/unit:8,X:64>> -> {I,X} + end, + self() ! {tag,[Msg]}, + Res = receive + {tag,[<<L,I:(8*(L-1)),X:32>>]} -> {I,X}; + {tag,[<<L,I:(8*(L-1)),X:64>>]} -> {I,X} + end + end, + {1234,16#deadbeef} = R(<<3,1234:16,16#deadbeef:32>>), + {99,16#cafebeeff00d} = R(<<2,99:8,16#cafebeeff00d:64>>), + ok. + +no_match(_Config) -> + B = id(<<1,2,3,4>>), + no_match = case B of + <<Int:(bit_size(B)-1)>> -> Int; + <<Int:(bit_size(B)*2)>> -> Int; + <<Int:(length(B))>> -> Int; + _ -> no_match + end, + no_match = case B of + <<L:8,Int2:(is_integer(L))>> -> Int2; + <<L:8,Int2:(L+3.0)>> -> Int2; + _ -> no_match + end, + + no_match = case B of + <<Int3:(1/0)>> -> Int3; + _ -> no_match + end, + + no_match = case B of + <<Int4:all>> -> Int4; + <<Int4:bad_size>> -> Int4; + _ -> no_match + end, + + [] = [X || <<X:(is_list(B))/binary>> <= B], + <<>> = << <<X:32>> || <<X:(is_list(B))/binary>> <= B >>, + + ok. + +id(I) -> + I. diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 53627b9d81..c634c5841a 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -374,11 +374,12 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> {dcbsm, ".core_bsm"}, {dkern, ".kernel"}, {dssa, ".ssa"}, + {dbool, ".bool"}, + {dssashare, ".ssashare"}, {dssaopt, ".ssaopt"}, {dprecg, ".precodegen"}, {dcg, ".codegen"}, {dblk, ".block"}, - {dexcept, ".except"}, {djmp, ".jump"}, {dclean, ".clean"}, {dpeep, ".peep"}, @@ -1383,36 +1384,47 @@ env_compiler_options(_Config) -> bc_options(Config) -> DataDir = proplists:get_value(data_dir, Config), - L = [{101, small_float, [no_get_hd_tl,no_line_info]}, - {103, big, [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record, + L = [{101, small_float, [no_shared_fun_wrappers, + no_get_hd_tl,no_line_info]}, + {103, big, [no_shared_fun_wrappers, + no_put_tuple2,no_get_hd_tl,no_ssa_opt_record, no_line_info,no_stack_trimming]}, - {125, small_float, [no_get_hd_tl,no_line_info,no_ssa_opt_float]}, + {125, small_float, [no_shared_fun_wrappers,no_get_hd_tl, + no_line_info, + no_ssa_opt_float]}, - {132, small, [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record, + {132, small, [no_shared_fun_wrappers, + no_put_tuple2,no_get_hd_tl,no_ssa_opt_record, no_ssa_opt_float,no_line_info,no_bsm3]}, + {136, big, [no_shared_fun_wrappers,no_put_tuple2,no_get_hd_tl, + no_ssa_opt_record,no_line_info]}, + {153, small, [r20]}, {153, small, [r21]}, - {136, big, [no_put_tuple2,no_get_hd_tl, - no_ssa_opt_record,no_line_info]}, - - {153, big, [no_put_tuple2,no_get_hd_tl, no_ssa_opt_record]}, - {153, big, [r16]}, - {153, big, [r17]}, + {153, big, [no_shared_fun_wrappers, + no_put_tuple2,no_get_hd_tl, no_ssa_opt_record]}, {153, big, [r18]}, {153, big, [r19]}, - {153, small_float, [r16]}, - {153, small_float, []}, + {153, small_float, [no_shared_fun_wrappers]}, - {158, small_maps, [r17]}, {158, small_maps, [r18]}, {158, small_maps, [r19]}, {158, small_maps, [r20]}, {158, small_maps, [r21]}, - {164, small_maps, []}, - {164, big, []} + {164, small_maps, [r22]}, + {164, big, [r22]}, + {164, small_maps, [no_shared_fun_wrappers]}, + {164, big, [no_shared_fun_wrappers]}, + + {168, small, [r22]}, + {170, small, [no_shared_fun_wrappers]}, + + {169, small_maps, []}, + {169, big, []}, + {170, small, []} ], Test = fun({Expected,Mod,Options}) -> diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl index 72016c6d76..e20744f9cb 100644 --- a/lib/compiler/test/core_SUITE.erl +++ b/lib/compiler/test/core_SUITE.erl @@ -30,7 +30,8 @@ cover_v3_kernel_1/1,cover_v3_kernel_2/1,cover_v3_kernel_3/1, cover_v3_kernel_4/1,cover_v3_kernel_5/1, non_variable_apply/1,name_capture/1,fun_letrec_effect/1, - get_map_element/1]). + get_map_element/1,receive_tests/1, + core_lint/1]). -include_lib("common_test/include/ct.hrl"). @@ -59,7 +60,8 @@ groups() -> cover_v3_kernel_1,cover_v3_kernel_2,cover_v3_kernel_3, cover_v3_kernel_4,cover_v3_kernel_5, non_variable_apply,name_capture,fun_letrec_effect, - get_map_element + get_map_element,receive_tests, + core_lint ]}]. @@ -98,6 +100,7 @@ end_per_group(_GroupName, Config) -> ?comp(name_capture). ?comp(fun_letrec_effect). ?comp(get_map_element). +?comp(receive_tests). try_it(Mod, Conf) -> Src = filename:join(proplists:get_value(data_dir, Conf), @@ -112,3 +115,58 @@ compile_and_load(Src, Opts) -> _ = code:delete(Mod), _ = code:purge(Mod), ok. + +core_lint(_Config) -> + OK = cerl:c_atom(ok), + core_lint_function(illegal), + core_lint_function(cerl:c_let([OK], OK, OK)), + core_lint_function(cerl:c_let([cerl:c_var(var)], cerl:c_var(999), OK)), + core_lint_function(cerl:c_let([cerl:c_var(var)], cerl:c_var(unknown), OK)), + core_lint_function(cerl:c_try(OK, [], OK, [], handler)), + core_lint_function(cerl:c_apply(cerl:c_var({OK,0}), [OK])), + + core_lint_function([], [OK], OK), + core_lint_function([cerl:c_var({cerl:c_char($*),OK})], [], OK), + + core_lint_pattern([cerl:c_var(99),cerl:c_var(99)]), + core_lint_pattern([cerl:c_let([cerl:c_var(var)], OK, OK)]), + core_lint_bs_pattern([OK]), + Flags = cerl:make_list([big,unsigned]), + core_lint_bs_pattern([cerl:c_bitstr(cerl:c_var(tail), cerl:c_atom(binary), Flags), + cerl:c_bitstr(cerl:c_var(value), cerl:c_atom(binary), Flags)]), + + BadGuard1 = cerl:c_call(OK, OK, []), + BadGuard2 = cerl:c_call(cerl:c_atom(erlang), OK, []), + BadGuard3 = cerl:c_call(cerl:c_atom(erlang), cerl:c_atom(is_record), [OK,OK,OK]), + PatMismatch = cerl:c_case(cerl:c_nil(), + [cerl:c_clause([], OK), + cerl:c_clause([OK], OK), + cerl:c_clause([OK], BadGuard1, OK), + cerl:c_clause([OK], BadGuard2, OK), + cerl:c_clause([OK], BadGuard3, OK)]), + core_lint_function(PatMismatch), + + ok. + +core_lint_bs_pattern(Ps) -> + core_lint_pattern([cerl:c_binary(Ps)]). + +core_lint_pattern(Ps) -> + Cs = [cerl:c_clause(Ps, cerl:c_float(42))], + core_lint_function(cerl:c_case(cerl:c_nil(), Cs)). + +core_lint_function(Body) -> + core_lint_function([], [], Body). + +core_lint_function(Exports, Attributes, Body) -> + ModName = cerl:c_atom(core_lint_test), + MainFun = cerl:c_fun([], Body), + MainVar = cerl:c_var({main,0}), + Mod = cerl:c_module(ModName, Exports, Attributes, [{MainVar,MainFun}]), + {error,[{core_lint_test,Errors}],[]} = + compile:forms(Mod, [from_core,clint0,return]), + io:format("~p\n", [Errors]), + [] = lists:filter(fun({none,core_lint,_}) -> false; + (_) -> true + end, Errors), + error = compile:forms(Mod, [from_core,clint0,report]). diff --git a/lib/compiler/test/core_SUITE_data/bs_shadowed_size_var.core b/lib/compiler/test/core_SUITE_data/bs_shadowed_size_var.core index 0ade037e05..2e59f9efde 100644 --- a/lib/compiler/test/core_SUITE_data/bs_shadowed_size_var.core +++ b/lib/compiler/test/core_SUITE_data/bs_shadowed_size_var.core @@ -52,8 +52,14 @@ module 'bs_shadowed_size_var' case T of %% Variable 'Sz' repeated here. Should work. <#{#<Sz>(32,1,'integer',['unsigned','big']), - #<Data>(Sz,8,'binary',['unsigned','big'])}#> when 'true' -> - Data + #<Tail>('all',1,'binary',['unsigned','big'])}#> when 'true' -> + case Tail of + <#{#<Data>(Sz,8,'binary',['unsigned','big'])}#> when 'true' -> + Data + <_cor5> when 'true' -> + primop 'match_fail' + ({'case_clause',{_cor5}}) + end <_cor5> when 'true' -> primop 'match_fail' ({'case_clause',{_cor5}}) diff --git a/lib/compiler/test/core_SUITE_data/receive_tests.core b/lib/compiler/test/core_SUITE_data/receive_tests.core new file mode 100644 index 0000000000..8e56af8cd4 --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/receive_tests.core @@ -0,0 +1,1761 @@ +%% Derived from receive_SUITE, with the ref_opt/1 test case removed. +%% The purpose if this module is to make sure that the traditional +%% syntax for receive in Core Erlang continues to work and is properly +%% lowered. + +module 'receive_tests' ['module_info'/0, + 'module_info'/1, + 'receive_tests'/0] + attributes [] +'receive_tests'/0 = + %% Line 27 + fun () -> + case <> of + <> when 'true' -> + do %% Line 28 + apply 'recv'/0 + () + do %% Line 28 + apply 'coverage'/0 + () + do %% Line 28 + apply 'otp_7980'/0 + () + do %% Line 28 + apply 'export'/0 + () + do %% Line 28 + apply 'wait'/0 + () + do %% Line 29 + apply 'recv_in_try'/0 + () + do %% Line 29 + apply 'double_recv'/0 + () + do %% Line 29 + apply 'receive_var_zero'/0 + () + do %% Line 30 + apply 'match_built_terms'/0 + () + do %% Line 30 + apply 'elusive_common_exit'/0 + () + do %% Line 31 + apply 'after_expression'/0 + () + %% Line 32 + 'ok' + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'recv'/0 = + %% Line 36 + fun () -> + case <> of + <> when 'true' -> + let <_0> = + fun () -> + %% Line 37 + case <> of + <> when 'true' -> + apply 'loop'/1 + ({'state','true'}) + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end + in let <Pid> = + call %% Line 37 + 'erlang':%% Line 37 + 'spawn_link' + (_0) + in let <Self> = + call %% Line 38 + 'erlang':%% Line 38 + 'self' + () + in do %% Line 39 + call 'erlang':'!' + (Pid, {Self,'test'}) + do %% Line 40 + receive + %% Line 41 + <{'ok','test'}> when 'true' -> + 'ok' + %% Line 42 + <{'error',Other}> when 'true' -> + do %% Line 43 + call 'io':'format' + ([71|[111|[116|[32|[117|[110|[112|[101|[120|[101|[99|[116|[101|[100|[32|[126|[112]]]]]]]]]]]]]]]]], [Other|[]]) + %% Line 44 + call 'ct':'fail' + ('unexpected') + after %% Line 45 + 10000 -> + %% Line 46 + call 'ct':'fail' + ('no_answer') + do %% Line 48 + receive + %% Line 49 + <X> when 'true' -> + do %% Line 50 + call 'io':'format' + ([85|[110|[101|[120|[112|[101|[99|[116|[101|[100|[32|[101|[120|[116|[114|[97|[32|[109|[101|[115|[115|[97|[103|[101|[58|[32|[126|[112]]]]]]]]]]]]]]]]]]]]]]]]]]]], [X|[]]) + %% Line 51 + call 'ct':'fail' + ('unexpected') + after %% Line 52 + 10 -> + do %% Line 53 + call 'erlang':'unlink' + (Pid) + do %% Line 54 + call 'erlang':'exit' + (Pid, 'kill') + %% Line 55 + 'ok' + %% Line 57 + 'ok' + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'loop'/1 = + %% Line 59 + fun (_0) -> + case _0 of + <S> when 'true' -> + %% Line 60 + receive + %% Line 61 + <_8> + when ( try + ( let <_3> = + case ( call ( 'erlang' + -| ['compiler_generated'] ):( 'is_record' + -| ['compiler_generated'] ) + (S, ( 'state' + -| ['compiler_generated'] ), ( 2 + -| ['compiler_generated'] )) + -| ['compiler_generated'] ) of + ( <( 'true' + -| ['compiler_generated'] )> when 'true' -> + ( 'true' + -| ['compiler_generated'] ) + -| ['compiler_generated'] ) + ( <( 'false' + -| ['compiler_generated'] )> when 'true' -> + ( 'fail' + -| ['compiler_generated'] ) + -| ['compiler_generated'] ) + ( <( _1 + -| ['compiler_generated'] )> when 'true' -> + ( _1 + -| ['compiler_generated'] ) + -| ['compiler_generated'] ) + ( <_2> when 'true' -> + ( primop 'match_fail' + ({'case_clause',_2}) + -| ['compiler_generated'] ) + -| ['compiler_generated'] ) + end + in let <_4> = + call 'erlang':'=:=' + (( _3 + -| ['compiler_generated'] ), 'true') + in let <_5> = + call 'erlang':'element' + (2, S) + in let <_6> = + call 'erlang':'==' + (_5, 'false') + in ( call ( 'erlang' + -| ['compiler_generated'] ):( 'and' + -| ['compiler_generated'] ) + (_4, _6) + -| ['compiler_generated'] ) + -| ['compiler_generated'] ) + of <Try> -> + Try + catch <T,R> -> + 'false' + -| ['compiler_generated'] ) -> + %% Line 62 + apply 'loop'/1 + (S) + %% Line 63 + <{P,'test'}> when 'true' -> + do %% Line 64 + call 'erlang':'!' + (P, {'ok','test'}) + %% Line 65 + apply 'loop'/1 + (S) + %% Line 66 + <_X_X> when 'true' -> + %% Line 67 + apply 'loop'/1 + (S) + after 'infinity' -> + 'true' + ( <_7> when 'true' -> + primop 'match_fail' + ({'function_clause',_7}) + -| ['compiler_generated'] ) + end +'coverage'/0 = + %% Line 70 + fun () -> + case <> of + <> when 'true' -> + let <_0> = + call %% Line 71 + 'erlang':%% Line 71 + 'self' + () + in do %% Line 71 + apply 'do_link'/1 + (_0) + let <_1> = + call %% Line 72 + 'erlang':%% Line 72 + 'self' + () + in do %% Line 72 + apply 'do_unlink'/1 + (_1) + let <_2> = + call %% Line 73 + 'erlang':%% Line 73 + 'node' + () + in do %% Line 73 + apply 'do_monitor_node'/2 + (_2, 'true') + let <_3> = + call %% Line 74 + 'erlang':%% Line 74 + 'node' + () + in do %% Line 74 + apply 'do_monitor_node'/2 + (_3, 'false') + let <_5> = + call %% Line 75 + 'erlang':%% Line 75 + 'group_leader' + () + in let <_4> = + call %% Line 75 + 'erlang':%% Line 75 + 'self' + () + in do %% Line 75 + apply 'do_group_leader'/2 + (_5, _4) + let <_6> = + call %% Line 76 + 'erlang':%% Line 76 + 'self' + () + in let <_7> = + call %% Line 76 + 'erlang':%% Line 76 + 'node' + (_6) + in do %% Line 76 + apply 'id'/1 + (_7) + let <_8> = + call %% Line 78 + 'erlang':%% Line 78 + 'self' + () + in do %% Line 78 + call 'erlang':'!' + (_8, {'a',10}) + let <_9> = + call %% Line 79 + 'erlang':%% Line 79 + 'self' + () + in do %% Line 79 + call 'erlang':'!' + (_9, {'b',20}) + %% Line 80 + case apply 'receive_all'/0 + () of + <[{'a',10}|[{'b',20}]]> when 'true' -> + let <_11> = + call %% Line 81 + 'erlang':%% Line 81 + 'self' + () + in do %% Line 81 + call 'erlang':'!' + (_11, {'c',42}) + do %% Line 82 + receive + %% Line 83 + <{'c',42}> when 'true' -> + %% Line 84 + 'ok' + after %% Line 85 + 'infinity' -> + %% Line 86 + call 'erlang':'exit' + ('cant_happen') + let <_12> = + call %% Line 89 + 'erlang':%% Line 89 + 'self' + () + in do %% Line 89 + call 'erlang':'!' + (_12, 17) + let <_13> = + call %% Line 90 + 'erlang':%% Line 90 + 'self' + () + in do %% Line 90 + call 'erlang':'!' + (_13, 19) + %% Line 91 + case apply 'tuple_to_values'/2 + ('infinity', 'x') of + <59> when 'true' -> + %% Line 92 + case apply 'tuple_to_values'/2 + (999999, 'x') of + <61> when 'true' -> + %% Line 93 + case apply 'tuple_to_values'/2 + (1, 'x') of + <0> when 'true' -> + let <_18> = + catch + let <_17> = + call %% Line 95 + 'erlang':%% Line 95 + 'self' + () + in %% Line 95 + apply 'monitor_plus_badmap'/1 + (_17) + in %% Line 95 + case _18 of + <{'EXIT',{{'badmap',[]},_23}}> when 'true' -> + let <_20> = + call %% Line 98 + 'erlang':%% Line 98 + 'self' + () + in do %% Line 98 + call 'erlang':'!' + (_20, {'data','no_data'}) + %% Line 99 + case apply 'receive_sink_tuple'/1 + ({'any','pattern'}) of + <'ok'> when 'true' -> + %% Line 100 + case apply 'receive_sink_tuple'/1 + ({'a','b'}) of + <{'b','a'}> when 'true' -> + %% Line 102 + 'ok' + ( <_22> when 'true' -> + primop 'match_fail' + ({'badmatch',_22}) + -| ['compiler_generated'] ) + end + ( <_21> when 'true' -> + primop 'match_fail' + ({'badmatch',_21}) + -| ['compiler_generated'] ) + end + ( <_19> when 'true' -> + primop 'match_fail' + ({'badmatch',_19}) + -| ['compiler_generated'] ) + end + ( <_16> when 'true' -> + primop 'match_fail' + ({'badmatch',_16}) + -| ['compiler_generated'] ) + end + ( <_15> when 'true' -> + primop 'match_fail' + ({'badmatch',_15}) + -| ['compiler_generated'] ) + end + ( <_14> when 'true' -> + primop 'match_fail' + ({'badmatch',_14}) + -| ['compiler_generated'] ) + end + ( <_10> when 'true' -> + primop 'match_fail' + ({'badmatch',_10}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'monitor_plus_badmap'/1 = + %% Line 104 + fun (_0) -> + case _0 of + <Pid> when 'true' -> + let <_2> = + call %% Line 105 + 'erlang':%% Line 105 + 'monitor' + (%% Line 105 + 'process', %% Line 105 + Pid) + in let <_1> = + primop 'match_fail' + ({'badmap',[]}) + in %% Line 105 + call 'erlang':'+' + (_2, _1) + ( <_3> when 'true' -> + primop 'match_fail' + ({'function_clause',_3}) + -| ['compiler_generated'] ) + end +'receive_all'/0 = + %% Line 107 + fun () -> + case <> of + <> when 'true' -> + %% Line 108 + receive + %% Line 109 + <Any> when 'true' -> + let <_0> = + apply %% Line 110 + 'receive_all'/0 + () + in %% Line 110 + [Any|_0] + after %% Line 111 + 0 -> + %% Line 112 + [] + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'do_monitor_node'/2 = + %% Line 115 + fun (_0,_1) -> + case <_0,_1> of + <Node,Bool> when 'true' -> + %% Line 116 + call 'erlang':'monitor_node' + (Node, Bool) + ( <_3,_2> when 'true' -> + primop 'match_fail' + ({'function_clause',_3,_2}) + -| ['compiler_generated'] ) + end +'do_link'/1 = + %% Line 118 + fun (_0) -> + case _0 of + <Pid> when 'true' -> + %% Line 119 + call 'erlang':'link' + (Pid) + ( <_1> when 'true' -> + primop 'match_fail' + ({'function_clause',_1}) + -| ['compiler_generated'] ) + end +'do_unlink'/1 = + %% Line 121 + fun (_0) -> + case _0 of + <Pid> when 'true' -> + %% Line 122 + call 'erlang':'unlink' + (Pid) + ( <_1> when 'true' -> + primop 'match_fail' + ({'function_clause',_1}) + -| ['compiler_generated'] ) + end +'do_group_leader'/2 = + %% Line 124 + fun (_0,_1) -> + case <_0,_1> of + <Leader,Pid> when 'true' -> + %% Line 125 + call 'erlang':'group_leader' + (Leader, Pid) + ( <_3,_2> when 'true' -> + primop 'match_fail' + ({'function_clause',_3,_2}) + -| ['compiler_generated'] ) + end +'tuple_to_values'/2 = + %% Line 129 + fun (_0,_1) -> + case <_0,_1> of + <'infinity',X> when 'true' -> + let <_3> = + case %% Line 130 + X of + %% Line 131 + <'x'> when 'true' -> + %% Line 132 + receive + %% Line 133 + <Any> when 'true' -> + %% Line 134 + {42,Any} + after 'infinity' -> + 'true' + ( <_2> when 'true' -> + %% Line 130 + primop 'match_fail' + ({'case_clause',_2}) + -| ['compiler_generated'] ) + end + in %% Line 130 + case _3 of + <{A,B}> when 'true' -> + %% Line 137 + call 'erlang':'+' + (A, B) + ( <_4> when 'true' -> + primop 'match_fail' + ({'badmatch',_4}) + -| ['compiler_generated'] ) + end + %% Line 138 + <Timeout,X> when 'true' -> + let <_6> = + case %% Line 139 + X of + %% Line 140 + <'x'> when 'true' -> + %% Line 141 + receive + %% Line 142 + <Any> when 'true' -> + %% Line 143 + {42,Any} + after %% Line 144 + Timeout -> + %% Line 145 + {0,0} + ( <_5> when 'true' -> + %% Line 139 + primop 'match_fail' + ({'case_clause',_5}) + -| ['compiler_generated'] ) + end + in %% Line 139 + case _6 of + <{A,B}> when 'true' -> + %% Line 148 + call 'erlang':'+' + (A, B) + ( <_7> when 'true' -> + primop 'match_fail' + ({'badmatch',_7}) + -| ['compiler_generated'] ) + end + ( <_9,_8> when 'true' -> + primop 'match_fail' + ({'function_clause',_9,_8}) + -| ['compiler_generated'] ) + end +'receive_sink_tuple'/1 = + %% Line 151 + fun (_0) -> + case _0 of + <{Line,Pattern}> when 'true' -> + %% Line 152 + receive + %% Line 153 + <{'data',_2}> when 'true' -> + %% Line 154 + 'ok' + after %% Line 155 + 1 -> + %% Line 156 + apply 'id'/1 + ({Pattern,Line}) + ( <_1> when 'true' -> + primop 'match_fail' + ({'function_clause',_1}) + -| ['compiler_generated'] ) + end +'otp_7980'/0 = + %% Line 163 + fun () -> + case <> of + <> when 'true' -> + %% Line 164 + case apply 'otp_7980_add_clients'/1 + (10) of + <7> when 'true' -> + %% Line 165 + 'ok' + ( <_0> when 'true' -> + primop 'match_fail' + ({'badmatch',_0}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'otp_7980_add_clients'/1 = + %% Line 167 + fun (_0) -> + case _0 of + <Count> when 'true' -> + let <Timeout> = 42 + in let <_7> = + fun (_4,_3) -> + %% Line 169 + case <_4,_3> of + <_9,N> when 'true' -> + do %% Line 170 + case N of + %% Line 171 + <1> when 'true' -> + 'ok' + %% Line 172 + <_10> when 'true' -> + receive + + after Timeout -> + 'ok' + ( <_2> when 'true' -> + primop 'match_fail' + ({'case_clause',_2}) + -| ['compiler_generated'] ) + end + %% Line 174 + call 'erlang':'-' + (N, 1) + ( <_6,_5> when 'true' -> + primop 'match_fail' + ({'function_clause',_6,_5}) + -| ['compiler_generated'] ) + end + in %% Line 169 + call 'lists':'foldl' + (_7, %% Line 175 + Count, %% Line 175 + [1|[2|[3]]]) + ( <_8> when 'true' -> + primop 'match_fail' + ({'function_clause',_8}) + -| ['compiler_generated'] ) + end +'export'/0 = + %% Line 177 + fun () -> + case <> of + <> when 'true' -> + let <Ref> = + call %% Line 178 + 'erlang':%% Line 178 + 'make_ref' + () + in let <_1> = + call %% Line 179 + 'erlang':%% Line 179 + 'self' + () + in do %% Line 179 + call 'erlang':'!' + (_1, {'result',Ref,42}) + %% Line 180 + case apply 'export_1'/1 + (Ref) of + <42> when 'true' -> + %% Line 181 + case apply 'export_1'/1 + (Ref) of + <{'error','timeout'}> when 'true' -> + let <_4> = + call %% Line 183 + 'erlang':%% Line 183 + 'self' + () + in do %% Line 183 + call 'erlang':'!' + (_4, {'result',Ref}) + %% Line 184 + case apply 'export_2'/0 + () of + <{'ok',_6}> + when call 'erlang':'=:=' + (_6, + Ref) -> + %% Line 186 + 'ok' + ( <_5> when 'true' -> + primop 'match_fail' + ({'badmatch',_5}) + -| ['compiler_generated'] ) + end + ( <_3> when 'true' -> + primop 'match_fail' + ({'badmatch',_3}) + -| ['compiler_generated'] ) + end + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',_2}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'export_1'/1 = + %% Line 188 + fun (_0) -> + case _0 of + <Reference> when 'true' -> + do %% Line 189 + apply 'id'/1 + (Reference) + let <_5,Result> = + receive + %% Line 191 + <{'result',_4,Result}> + when call 'erlang':'=:=' + (_4, + Reference) -> + %% Line 192 + <Result,Result> + after %% Line 193 + 1 -> + let <Result> = + {'error','timeout'} + in %% Line 194 + <Result,Result> + in let <_2> = + call %% Line 199 + 'erlang':%% Line 199 + 'self' + () + in do %% Line 199 + apply 'id'/1 + ({'build',_2}) + %% Line 200 + Result + ( <_3> when 'true' -> + primop 'match_fail' + ({'function_clause',_3}) + -| ['compiler_generated'] ) + end +'export_2'/0 = + %% Line 202 + fun () -> + case <> of + <> when 'true' -> + let <_0,Result> = + receive + %% Line 203 + <{'result',Result}> when 'true' -> + <'ok',Result> + after 'infinity' -> + <'true','true'> + in %% Line 204 + {'ok',Result} + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'wait'/0 = + %% Line 206 + fun () -> + case <> of + <> when 'true' -> + let <_0> = + call %% Line 207 + 'erlang':%% Line 207 + 'self' + () + in do %% Line 207 + call 'erlang':'!' + (_0, #{#<42>(8,1,'integer',['unsigned'|['big']])}#) + %% Line 208 + case apply 'wait_1'/3 + ('r', 1, 2) of + <#{#<42>(8,1,'integer',['unsigned'|['big']])}#> when 'true' -> + %% Line 209 + case apply 'wait_1'/3 + (1, 2, 3) of + <{1,2,3}> when 'true' -> + let <_3> = + catch + %% Line 210 + receive + + after [] -> + 'timeout' + in %% Line 210 + case _3 of + <{'EXIT',{'timeout_value',_5}}> when 'true' -> + %% Line 211 + 'ok' + ( <_4> when 'true' -> + primop 'match_fail' + ({'badmatch',_4}) + -| ['compiler_generated'] ) + end + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',_2}) + -| ['compiler_generated'] ) + end + ( <_1> when 'true' -> + primop 'match_fail' + ({'badmatch',_1}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'wait_1'/3 = + %% Line 213 + fun (_0,_1,_2) -> + case <_0,_1,_2> of + <'r',_7,_8> when 'true' -> + %% Line 214 + receive + %% Line 215 + <B> + when try + let <_3> = + call 'erlang':'byte_size' + (B) + in call 'erlang':'>' + (_3, 0) + of <Try> -> + Try + catch <T,R> -> + 'false' -> + %% Line 216 + B + after 'infinity' -> + 'true' + %% Line 220 + <A,B,C> when 'true' -> + %% Line 221 + {A,B,C} + ( <_6,_5,_4> when 'true' -> + primop 'match_fail' + ({'function_clause',_6,_5,_4}) + -| ['compiler_generated'] ) + end +'recv_in_try'/0 = + %% Line 223 + fun () -> + case <> of + <> when 'true' -> + let <_0> = + call %% Line 224 + 'erlang':%% Line 224 + 'self' + () + in do %% Line 224 + call 'erlang':'!' + (_0, {'ok','fh'}) + %% Line 224 + case apply 'recv_in_try'/2 + ('infinity', 'native') of + <{'ok','fh'}> when 'true' -> + let <_2> = + call %% Line 225 + 'erlang':%% Line 225 + 'self' + () + in do %% Line 225 + call 'erlang':'!' + (_2, {'ok','ignored'}) + %% Line 225 + case apply 'recv_in_try'/2 + ('infinity', 'plain') of + <{'ok',42}> when 'true' -> + let <_4> = + call %% Line 226 + 'erlang':%% Line 226 + 'self' + () + in do %% Line 226 + call 'erlang':'!' + (_4, {'error','ignored'}) + %% Line 226 + case apply 'recv_in_try'/2 + ('infinity', 'plain') of + <'nok'> when 'true' -> + %% Line 227 + case apply 'recv_in_try'/2 + (1, 'plain') of + <'timeout'> when 'true' -> + %% Line 228 + 'ok' + ( <_6> when 'true' -> + primop 'match_fail' + ({'badmatch',_6}) + -| ['compiler_generated'] ) + end + ( <_5> when 'true' -> + primop 'match_fail' + ({'badmatch',_5}) + -| ['compiler_generated'] ) + end + ( <_3> when 'true' -> + primop 'match_fail' + ({'badmatch',_3}) + -| ['compiler_generated'] ) + end + ( <_1> when 'true' -> + primop 'match_fail' + ({'badmatch',_1}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'recv_in_try'/2 = + %% Line 230 + fun (_0,_1) -> + case <_0,_1> of + <Timeout,Format> when 'true' -> + %% Line 231 + try + %% Line 232 + receive + %% Line 233 + <{Status,History}> when 'true' -> + let <_3> = + case %% Line 244 + Format of + %% Line 245 + <'native'> when 'true' -> + %% Line 246 + apply 'id'/1 + (History) + %% Line 247 + <'plain'> when 'true' -> + %% Line 248 + apply 'id'/1 + (42) + ( <_2> when 'true' -> + %% Line 244 + primop 'match_fail' + ({'case_clause',_2}) + -| ['compiler_generated'] ) + end + in let <FH> = _3 + in %% Line 250 + case Status of + %% Line 251 + <'ok'> when 'true' -> + %% Line 252 + {'ok',FH} + %% Line 253 + <'error'> when 'true' -> + %% Line 254 + 'nok' + ( <_5> when 'true' -> + primop 'match_fail' + ({'case_clause',_5}) + -| ['compiler_generated'] ) + end + after %% Line 256 + Timeout -> + %% Line 257 + 'timeout' + of <_6> -> + _6 + catch <_9,_8,_7> -> + %% Line 262 + case {_9,_8,_7} of + <{'throw',{'error',Reason},_12}> when 'true' -> + %% Line 263 + {'nok',Reason} + ( <{_9,_8,_7}> when 'true' -> + primop 'raise' + (_7, _8) + -| ['compiler_generated'] ) + end + ( <_11,_10> when 'true' -> + primop 'match_fail' + ({'function_clause',_11,_10}) + -| ['compiler_generated'] ) + end +'double_recv'/0 = + %% Line 270 + fun () -> + case <> of + <> when 'true' -> + let <_0> = + call %% Line 271 + 'erlang':%% Line 271 + 'self' + () + in do %% Line 271 + call 'erlang':'!' + (_0, {'more',{'a','term'}}) + %% Line 272 + case apply 'do_double_recv'/2 + ({'more',{'a','term'}}, 'any') of + <'ok'> when 'true' -> + let <_2> = + call %% Line 273 + 'erlang':%% Line 273 + 'self' + () + in do %% Line 273 + call 'erlang':'!' + (_2, 'message') + %% Line 274 + case apply 'do_double_recv'/2 + ('whatever', 'message') of + <'ok'> when 'true' -> + %% Line 276 + case apply 'do_double_recv'/2 + ({'more',42}, 'whatever') of + <'error'> when 'true' -> + %% Line 277 + case apply 'do_double_recv'/2 + ('whatever', 'whatever') of + <'error'> when 'true' -> + %% Line 278 + 'ok' + ( <_5> when 'true' -> + primop 'match_fail' + ({'badmatch',_5}) + -| ['compiler_generated'] ) + end + ( <_4> when 'true' -> + primop 'match_fail' + ({'badmatch',_4}) + -| ['compiler_generated'] ) + end + ( <_3> when 'true' -> + primop 'match_fail' + ({'badmatch',_3}) + -| ['compiler_generated'] ) + end + ( <_1> when 'true' -> + primop 'match_fail' + ({'badmatch',_1}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'do_double_recv'/2 = + %% Line 280 + fun (_0,_1) -> + case <_0,_1> of + <{'more',Rest},_X_Msg> when 'true' -> + %% Line 281 + receive + %% Line 282 + <{'more',_4}> + when call 'erlang':'=:=' + (_4, + Rest) -> + %% Line 283 + 'ok' + after %% Line 284 + 0 -> + %% Line 285 + 'error' + %% Line 287 + <_5,Msg> when 'true' -> + %% Line 288 + receive + %% Line 289 + <_6> + when call 'erlang':'=:=' + (_6, + Msg) -> + %% Line 290 + 'ok' + after %% Line 291 + 0 -> + %% Line 292 + 'error' + ( <_3,_2> when 'true' -> + primop 'match_fail' + ({'function_clause',_3,_2}) + -| ['compiler_generated'] ) + end +'receive_var_zero'/0 = + %% Line 297 + fun () -> + case <> of + <> when 'true' -> + let <_0> = + call %% Line 298 + 'erlang':%% Line 298 + 'self' + () + in do %% Line 298 + call 'erlang':'!' + (_0, 'x') + let <_1> = + call %% Line 299 + 'erlang':%% Line 299 + 'self' + () + in do %% Line 299 + call 'erlang':'!' + (_1, 'y') + let <Z> = + apply %% Line 300 + 'zero'/0 + () + in let <_3> = + receive + %% Line 302 + <'z'> when 'true' -> + 'ok' + after %% Line 303 + Z -> + %% Line 303 + 'timeout' + in %% Line 301 + case _3 of + <'timeout'> when 'true' -> + let <_5> = + receive + + after %% Line 306 + Z -> + %% Line 306 + 'timeout' + in %% Line 305 + case _5 of + <'timeout'> when 'true' -> + let <_7> = + call %% Line 308 + 'erlang':%% Line 308 + 'self' + () + in do %% Line 308 + call 'erlang':'!' + (_7, 'w') + %% Line 309 + receive + %% Line 310 + <'x'> when 'true' -> + do %% Line 311 + receive + <'y'> when 'true' -> + 'ok' + after 'infinity' -> + 'true' + do %% Line 312 + receive + <'w'> when 'true' -> + 'ok' + after 'infinity' -> + 'true' + %% Line 313 + 'ok' + %% Line 314 + <Other> when 'true' -> + %% Line 315 + call 'ct':'fail' + ({'bad_message',Other}) + after 'infinity' -> + 'true' + ( <_6> when 'true' -> + primop 'match_fail' + ({'badmatch',_6}) + -| ['compiler_generated'] ) + end + ( <_4> when 'true' -> + primop 'match_fail' + ({'badmatch',_4}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'zero'/0 = + %% Line 318 + fun () -> + case <> of + <> when 'true' -> + 0 + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'match_built_terms'/0 = + %% Line 339 + fun () -> + case <> of + <> when 'true' -> + let <_5> = + fun () -> + %% Line 340 + case <> of + <> when 'true' -> + let <Ref> = + call 'erlang':'make_ref' + () + in let <A> = + apply 'id'/1 + (97) + in let <B> = + apply 'id'/1 + (98) + in let <Built> = + apply 'id'/1 + ([A|[B|[]]]) + in let <_4> = + call 'erlang':'self' + () + in do call 'erlang':'!' + (_4, {Ref,A,B}) + receive + <{_28,_29,_30}> + when let <_35> = + call 'erlang':'=:=' + (_28, Ref) + in let <_33> = + call 'erlang':'=:=' + (_29, A) + in let <_31> = + call 'erlang':'=:=' + (_30, B) + in let <_32> = + call 'erlang':'=:=' + ([A|[B|[]]], Built) + in let <_34> = + call 'erlang':'and' + (_31, _32) + in let <_36> = + call 'erlang':'and' + (_33, _34) + in call 'erlang':'and' + (_35, _36) -> + 'ok' + after 5000 -> + call 'ct':'fail' + ([70|[97|[105|[108|[101|[100|[32|[116|[111|[32|[109|[97|[116|[99|[104|[32|[109|[101|[115|[115|[97|[103|[101|[32|[119|[105|[116|[104|[32|[116|[101|[114|[109|[32|[98|[117|[105|[108|[116|[32|[105|[110|[32|[114|[101|[99|[101|[105|[118|[101|[32|[103|[117|[97|[114|[100|[46]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]) + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end + in do %% Line 340 + apply _5 + () + let <_11> = + fun () -> + %% Line 341 + case <> of + <> when 'true' -> + let <Ref> = + call 'erlang':'make_ref' + () + in let <A> = + apply 'id'/1 + (97) + in let <B> = + apply 'id'/1 + (98) + in let <Built> = + apply 'id'/1 + ({A,B}) + in let <_10> = + call 'erlang':'self' + () + in do call 'erlang':'!' + (_10, {Ref,A,B}) + receive + <{_37,_38,_39}> + when let <_44> = + call 'erlang':'=:=' + (_37, Ref) + in let <_42> = + call 'erlang':'=:=' + (_38, A) + in let <_40> = + call 'erlang':'=:=' + (_39, B) + in let <_41> = + call 'erlang':'=:=' + ({A,B}, Built) + in let <_43> = + call 'erlang':'and' + (_40, _41) + in let <_45> = + call 'erlang':'and' + (_42, _43) + in call 'erlang':'and' + (_44, _45) -> + 'ok' + after 5000 -> + call 'ct':'fail' + ([70|[97|[105|[108|[101|[100|[32|[116|[111|[32|[109|[97|[116|[99|[104|[32|[109|[101|[115|[115|[97|[103|[101|[32|[119|[105|[116|[104|[32|[116|[101|[114|[109|[32|[98|[117|[105|[108|[116|[32|[105|[110|[32|[114|[101|[99|[101|[105|[118|[101|[32|[103|[117|[97|[114|[100|[46]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]) + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end + in do %% Line 341 + apply _11 + () + let <_19> = + fun () -> + %% Line 342 + case <> of + <> when 'true' -> + let <Ref> = + call 'erlang':'make_ref' + () + in let <A> = + apply 'id'/1 + (97) + in let <B> = + apply 'id'/1 + (98) + in let <_15> = + #{#<A>(8,1,'integer',['unsigned'|['big']]), + #<B>(8,1,'integer',['unsigned'|['big']])}# + in let <Built> = + apply 'id'/1 + (_15) + in let <_17> = + call 'erlang':'self' + () + in do call 'erlang':'!' + (_17, {Ref,A,B}) + receive + <{_46,_47,_48}> + when let <_53> = + call 'erlang':'=:=' + (_46, Ref) + in let <_51> = + call 'erlang':'=:=' + (_47, A) + in let <_49> = + call 'erlang':'=:=' + (_48, B) + in let <_50> = + try + let <_18> = + #{#<A>(8,1,'integer',['unsigned'|['big']]), + #<B>(8,1,'integer',['unsigned'|['big']])}# + in call 'erlang':'=:=' + (_18, Built) + of <Try> -> + Try + catch <T,R> -> + 'false' + in let <_52> = + call 'erlang':'and' + (_49, _50) + in let <_54> = + call 'erlang':'and' + (_51, _52) + in call 'erlang':'and' + (_53, _54) -> + 'ok' + after 5000 -> + call 'ct':'fail' + ([70|[97|[105|[108|[101|[100|[32|[116|[111|[32|[109|[97|[116|[99|[104|[32|[109|[101|[115|[115|[97|[103|[101|[32|[119|[105|[116|[104|[32|[116|[101|[114|[109|[32|[98|[117|[105|[108|[116|[32|[105|[110|[32|[114|[101|[99|[101|[105|[118|[101|[32|[103|[117|[97|[114|[100|[46]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]) + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end + in do %% Line 342 + apply _19 + () + let <_27> = + fun () -> + %% Line 343 + case <> of + <> when 'true' -> + let <Ref> = + call 'erlang':'make_ref' + () + in let <A> = + apply 'id'/1 + (97) + in let <B> = + apply 'id'/1 + (98) + in let <_23> = + ~{1=>A,2=>B}~ + in let <Built> = + apply 'id'/1 + (_23) + in let <_25> = + call 'erlang':'self' + () + in do call 'erlang':'!' + (_25, {Ref,A,B}) + receive + <{_55,_56,_57}> + when let <_62> = + call 'erlang':'=:=' + (_55, Ref) + in let <_60> = + call 'erlang':'=:=' + (_56, A) + in let <_58> = + call 'erlang':'=:=' + (_57, B) + in let <_59> = + try + let <_26> = + ~{1=>A,2=>B}~ + in call 'erlang':'=:=' + (_26, Built) + of <Try> -> + Try + catch <T,R> -> + 'false' + in let <_61> = + call 'erlang':'and' + (_58, _59) + in let <_63> = + call 'erlang':'and' + (_60, _61) + in call 'erlang':'and' + (_62, _63) -> + 'ok' + after 5000 -> + call 'ct':'fail' + ([70|[97|[105|[108|[101|[100|[32|[116|[111|[32|[109|[97|[116|[99|[104|[32|[109|[101|[115|[115|[97|[103|[101|[32|[119|[105|[116|[104|[32|[116|[101|[114|[109|[32|[98|[117|[105|[108|[116|[32|[105|[110|[32|[114|[101|[99|[101|[105|[118|[101|[32|[103|[117|[97|[114|[100|[46]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]) + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end + in %% Line 343 + apply _27 + () + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'elusive_common_exit'/0 = + %% Line 345 + fun () -> + case <> of + <> when 'true' -> + let <_0> = + call %% Line 346 + 'erlang':%% Line 346 + 'self' + () + in do %% Line 346 + call 'erlang':'!' + (_0, {1,'a'}) + let <_1> = + call %% Line 347 + 'erlang':%% Line 347 + 'self' + () + in do %% Line 347 + call 'erlang':'!' + (_1, {2,'b'}) + %% Line 348 + case apply 'elusive_loop'/3 + (['x'|['y'|['z']]], 2, []) of + <{['z'],[{2,'b'}|[{1,'a'}]]}> when 'true' -> + let <CodeServer> = + call %% Line 350 + 'erlang':%% Line 350 + 'whereis' + (%% Line 350 + 'code_server') + in let <Self> = + call %% Line 351 + 'erlang':%% Line 351 + 'self' + () + in do %% Line 352 + call 'erlang':'!' + (Self, {Self,'abc'}) + do %% Line 353 + call 'erlang':'!' + (Self, {CodeServer,[]}) + do %% Line 354 + call 'erlang':'!' + (Self, {Self,'other'}) + do %% Line 355 + try + apply 'elusive2'/1 + ([]) + of <_5> -> + case _5 of + %% Line 356 + <Unexpected> when 'true' -> + %% Line 357 + call 'ct':'fail' + ([69|[120|[112|[101|[99|[116|[101|[100|[32|[97|[110|[32|[101|[120|[99|[101|[112|[116|[105|[111|[110|[59|[32|[103|[111|[116|[32|[126|[112|[10]]]]]]]]]]]]]]]]]]]]]]]]]]]]]], [Unexpected|[]]) + ( <_6> when 'true' -> + primop 'match_fail' + ({'try_clause',_6}) + -| ['compiler_generated'] ) + end + catch <_9,_8,_7> -> + %% Line 359 + case {_9,_8,_7} of + <{'throw',['other'|[_10|[_11|[]]]],_12}> + when let <_13> = + call 'erlang':'=:=' + (_10, CodeServer) + in let <_14> = + call 'erlang':'=:=' + (_11, Self) + in call 'erlang':'and' + (_13, _14) -> + %% Line 360 + 'ok' + ( <{_9,_8,_7}> when 'true' -> + primop 'raise' + (_7, _8) + -| ['compiler_generated'] ) + end + %% Line 363 + 'ok' + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',_2}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'elusive_loop'/3 = + %% Line 365 + fun (_0,_1,_2) -> + case <_0,_1,_2> of + <List,0,Results> when 'true' -> + %% Line 366 + {List,Results} + %% Line 367 + <List,ToReceive,Results> when 'true' -> + let <_4> = + receive + %% Line 370 + <Res = {_X_Pos,_X_R}> + when call 'erlang':'=/=' + (List, + []) -> + %% Line 371 + case List of + <[_X_H|T]> when 'true' -> + %% Line 372 + {Res,T} + ( <_3> when 'true' -> + primop 'match_fail' + ({'badmatch',_3}) + -| ['compiler_generated'] ) + end + %% Line 373 + <Res = {_X_Pos,_X_R}> + when call 'erlang':'=:=' + (List, + []) -> + %% Line 374 + {Res,[]} + after 'infinity' -> + 'true' + in %% Line 368 + case _4 of + <{Result,RemList}> when 'true' -> + let <_6> = + call %% Line 379 + 'erlang':%% Line 379 + '-' + (%% Line 379 + ToReceive, %% Line 379 + 1) + in %% Line 379 + apply 'elusive_loop'/3 + (RemList, _6, [Result|Results]) + ( <_5> when 'true' -> + primop 'match_fail' + ({'badmatch',_5}) + -| ['compiler_generated'] ) + end + ( <_9,_8,_7> when 'true' -> + primop 'match_fail' + ({'function_clause',_9,_8,_7}) + -| ['compiler_generated'] ) + end +'elusive2'/1 = + %% Line 382 + fun (_0) -> + case _0 of + <Acc> when 'true' -> + let <_2,Pid> = + receive + %% Line 384 + <{Pid,'abc'}> when 'true' -> + %% Line 385 + <'ok',Pid> + %% Line 386 + <{Pid,[]}> when 'true' -> + %% Line 387 + <'ok',Pid> + %% Line 388 + <{Pid,Res}> when 'true' -> + %% Line 397 + <call 'erlang':'throw' + ([Res|Acc]),Pid> + after 'infinity' -> + <'true','true'> + in %% Line 400 + apply 'elusive2'/1 + ([Pid|Acc]) + ( <_1> when 'true' -> + primop 'match_fail' + ({'function_clause',_1}) + -| ['compiler_generated'] ) + end +'after_expression'/0 = + %% Line 402 + fun () -> + case <> of + <> when 'true' -> + let <_0> = + call %% Line 403 + 'erlang':%% Line 403 + 'self' + () + in do %% Line 403 + call 'erlang':'!' + (_0, {'a','message'}) + %% Line 404 + case apply 'after_expr'/1 + (0) of + <{'a','message'}> when 'true' -> + %% Line 405 + case apply 'after_expr'/1 + (0) of + <'timeout'> when 'true' -> + %% Line 406 + case apply 'after_expr'/1 + (10) of + <'timeout'> when 'true' -> + %% Line 407 + 'ok' + ( <_3> when 'true' -> + primop 'match_fail' + ({'badmatch',_3}) + -| ['compiler_generated'] ) + end + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',_2}) + -| ['compiler_generated'] ) + end + ( <_1> when 'true' -> + primop 'match_fail' + ({'badmatch',_1}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'after_expr'/1 = + %% Line 409 + fun (_0) -> + case _0 of + <Timeout> when 'true' -> + %% Line 410 + receive + %% Line 411 + <Msg> when 'true' -> + Msg + after %% Line 412 + apply 'id'/1 + (Timeout) -> + %% Line 413 + 'timeout' + ( <_1> when 'true' -> + primop 'match_fail' + ({'function_clause',_1}) + -| ['compiler_generated'] ) + end +'id'/1 = + %% Line 416 + fun (_0) -> + case _0 of + <I> when 'true' -> + I + ( <_1> when 'true' -> + primop 'match_fail' + ({'function_clause',_1}) + -| ['compiler_generated'] ) + end +'module_info'/0 = + fun () -> + case <> of + <> when 'true' -> + call 'erlang':'get_module_info' + ('receive_tests') + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'module_info'/1 = + fun (_0) -> + case _0 of + <X> when 'true' -> + call 'erlang':'get_module_info' + ('receive_tests', X) + ( <_1> when 'true' -> + primop 'match_fail' + ({'function_clause',_1}) + -| ['compiler_generated'] ) + end +end
\ No newline at end of file diff --git a/lib/compiler/test/core_alias_SUITE.erl b/lib/compiler/test/core_alias_SUITE.erl index 737b1567d4..094d3c8557 100644 --- a/lib/compiler/test/core_alias_SUITE.erl +++ b/lib/compiler/test/core_alias_SUITE.erl @@ -47,11 +47,10 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - id(X) -> X. tuples(Config) when is_list(Config) -> - Tuple = {ok,id(value)}, + Tuple = id({ok,id(value)}), true = erts_debug:same(Tuple, simple_tuple(Tuple)), true = erts_debug:same(Tuple, simple_tuple_in_map(#{hello => Tuple})), @@ -59,24 +58,24 @@ tuples(Config) when is_list(Config) -> true = erts_debug:same(Tuple, simple_tuple_fun_repeated(Tuple, Tuple)), true = erts_debug:same(Tuple, simple_tuple_twice_head(Tuple, Tuple)), - {Tuple1, Tuple2} = simple_tuple_twice_body(Tuple), + {Tuple1, Tuple2} = id(simple_tuple_twice_body(Tuple)), true = erts_debug:same(Tuple, Tuple1), true = erts_debug:same(Tuple, Tuple2), - Nested = {nested,Tuple}, + Nested = id({nested,Tuple}), true = erts_debug:same(Tuple, nested_tuple_part(Nested)), true = erts_debug:same(Nested, nested_tuple_whole(Nested)), true = erts_debug:same(Nested, nested_tuple_with_alias(Nested)), true = erts_debug:same(Tuple, tuple_rebinding_after(Tuple)), - Tuple = unaliased_tuple_rebinding_before(Tuple), + Tuple = id(unaliased_tuple_rebinding_before(Tuple)), false = erts_debug:same(Tuple, unaliased_tuple_rebinding_before(Tuple)), - Nested = unaliased_literal_tuple_head(Nested), + Nested = id(unaliased_literal_tuple_head(Nested)), false = erts_debug:same(Nested, unaliased_literal_tuple_head(Nested)), - Nested = unaliased_literal_tuple_body(Nested), + Nested = id(unaliased_literal_tuple_body(Nested)), false = erts_debug:same(Nested, unaliased_literal_tuple_body(Nested)), - Nested = unaliased_different_var_tuple(Nested, Tuple), + Nested = id(unaliased_different_var_tuple(Nested, Tuple)), false = erts_debug:same(Nested, unaliased_different_var_tuple(Nested, Tuple)). simple_tuple({ok,X}) -> @@ -119,7 +118,7 @@ unaliased_different_var_tuple({nested,{ok,value}=X}, Y) -> {nested,Y}. cons(Config) when is_list(Config) -> - Cons = [ok|id(value)], + Cons = id([ok|id(value)]), true = erts_debug:same(Cons, simple_cons(Cons)), true = erts_debug:same(Cons, simple_cons_in_map(#{hello => Cons})), @@ -127,27 +126,27 @@ cons(Config) when is_list(Config) -> true = erts_debug:same(Cons, simple_cons_fun_repeated(Cons, Cons)), true = erts_debug:same(Cons, simple_cons_twice_head(Cons, Cons)), - {Cons1,Cons2} = simple_cons_twice_body(Cons), + {Cons1,Cons2} = id(simple_cons_twice_body(Cons)), true = erts_debug:same(Cons, Cons1), true = erts_debug:same(Cons, Cons2), - Nested = [nested,Cons], + Nested = id([nested,Cons]), true = erts_debug:same(Cons, nested_cons_part(Nested)), true = erts_debug:same(Nested, nested_cons_whole(Nested)), true = erts_debug:same(Nested, nested_cons_with_alias(Nested)), true = erts_debug:same(Cons, cons_rebinding_after(Cons)), Unstripped = id([a,b]), - Stripped = cons_with_binary([<<>>|Unstripped]), + Stripped = id(cons_with_binary([<<>>|Unstripped])), true = erts_debug:same(Unstripped, Stripped), - Cons = unaliased_cons_rebinding_before(Cons), + Cons = id(unaliased_cons_rebinding_before(Cons)), false = erts_debug:same(Cons, unaliased_cons_rebinding_before(Cons)), - Nested = unaliased_literal_cons_head(Nested), + Nested = id(unaliased_literal_cons_head(Nested)), false = erts_debug:same(Nested, unaliased_literal_cons_head(Nested)), - Nested = unaliased_literal_cons_body(Nested), + Nested = id(unaliased_literal_cons_body(Nested)), false = erts_debug:same(Nested, unaliased_literal_cons_body(Nested)), - Nested = unaliased_different_var_cons(Nested, Cons), + Nested = id(unaliased_different_var_cons(Nested, Cons)), false = erts_debug:same(Nested, unaliased_different_var_cons(Nested, Cons)). simple_cons([ok|X]) -> diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl index 8b9dbe4aa0..9436ad5d53 100644 --- a/lib/compiler/test/error_SUITE.erl +++ b/lib/compiler/test/error_SUITE.erl @@ -270,8 +270,7 @@ maps_warnings(Config) when is_list(Config) -> id(I) -> I. ">>, [return], - {error,[{3,erl_lint,{unbound_var,'K'}}, - {6,erl_lint,illegal_map_key}],[]}} + {error,[{3,erl_lint,{unbound_var,'K'}}],[]}} ], [] = run2(Config, Ts1), ok. diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index a61c56e331..c039da93f0 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -19,7 +19,7 @@ %% -module(guard_SUITE). --include_lib("common_test/include/ct.hrl"). +-include_lib("syntax_tools/include/merl.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, @@ -31,7 +31,8 @@ old_guard_tests/1,complex_guard/1, build_in_guard/1,gbif/1, t_is_boolean/1,is_function_2/1, - tricky/1,rel_ops/1,rel_op_combinations/1,literal_type_tests/1, + tricky/1,rel_ops/1,rel_op_combinations/1, + generated_combinations/1,literal_type_tests/1, basic_andalso_orelse/1,traverse_dcd/1, check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1, bad_constants/1,bad_guards/1, @@ -56,7 +57,7 @@ groups() -> check_qlc_hrl,andalso_semi,t_tuple_size,binary_part, bad_constants,bad_guards,guard_in_catch,beam_bool_SUITE, repeated_type_tests]}, - {slow,[],[literal_type_tests]}]. + {slow,[],[literal_type_tests,generated_combinations]}]. init_per_suite(Config) -> test_lib:recompile(?MODULE), @@ -1222,6 +1223,10 @@ tricky(Config) when is_list(Config) -> error = tricky_3(#{}), error = tricky_3({a,b}), + {'EXIT',_} = (catch tricky_4(x)), + {'EXIT',_} = (catch tricky_4(42)), + {'EXIT',_} = (catch tricky_4(true)), + ok. tricky_1(X, Y) when abs((X == 1) or (Y == 2)) -> ok; @@ -1239,6 +1244,13 @@ tricky_3(X) tricky_3(_) -> error. +tricky_4(X) -> + B = (abs(X) or abs(X)) =:= true, + case B of + true -> ok; + false -> error + end. + %% From dets_v9:read_buckets/11, simplified. rb(Size, ToRead, SoFar) when SoFar + Size < 81920; ToRead == [] -> true; @@ -1589,6 +1601,116 @@ redundant_12(X) when X >= 50, X =< 80 -> 2*X; redundant_12(X) when X < 51 -> 5*X; redundant_12(_) -> none. +%% Exhaustively test all combinations of relational operators +%% to ensure the correctness of the optimizations in beam_ssa_dead. + +generated_combinations(Config) -> + Mod = ?FUNCTION_NAME, + RelOps = ['=:=','=/=','==','/=','<','=<','>=','>'], + Combinations0 = [{Op1,Op2} || Op1 <- RelOps, Op2 <- RelOps], + Combinations1 = gen_lit_combs(Combinations0), + Combinations2 = [{neq,Comb} || + {_Op1,_Lit1,Op2,_Lit2}=Comb <- Combinations1, + Op2 =:= '=/=' orelse Op2 =:= '/='] ++ Combinations1, + Combinations = gen_func_names(Combinations2, 0), + Fs = gen_rel_op_functions(Combinations), + Tree = ?Q(["-module('@Mod@').", + "-compile([export_all,nowarn_export_all])."]) ++ Fs, + %%merl:print(Tree), + Opts = test_lib:opt_opts(?MODULE), + {ok,_Bin} = merl:compile_and_load(Tree, Opts), + test_combinations(Combinations, Mod). + +gen_lit_combs([{Op1,Op2}|T]) -> + [{Op1,7,Op2,6}, + {Op1,7.0,Op2,6}, + {Op1,7,Op2,6.0}, + {Op1,7.0,Op2,6.0}, + + {Op1,7,Op2,7}, + {Op1,7.0,Op2,7}, + {Op1,7,Op2,7.0}, + {Op1,7.0,Op2,7.0}, + + {Op1,6,Op2,7}, + {Op1,6.0,Op2,7}, + {Op1,6,Op2,7.0}, + {Op1,6.0,Op2,7.0}|gen_lit_combs(T)]; +gen_lit_combs([]) -> []. + +gen_func_names([E|Es], I) -> + Name = list_to_atom("f" ++ integer_to_list(I)), + [{Name,E}|gen_func_names(Es, I+1)]; +gen_func_names([], _) -> []. + +gen_rel_op_functions([{Name,{neq,{Op1,Lit1,Op2,Lit2}}}|T]) -> + %% Note that in the translation to SSA, '=/=' will be + %% translated to '=:=' in a guard (with switched success + %% and failure labels). Therefore, to test the optimization, + %% we must use '=/=' (or '/=') in a body context. + %% + %% Here is an example of a generated function: + %% + %% f160(A) when erlang:'>='(A, 7) -> + %% one; + %% f160(A) -> + %% true = erlang:'/='(A, 7), + %% two. + [?Q("'@Name@'(A) when erlang:'@Op1@'(A, _@Lit1@) -> one; + '@Name@'(A) -> true = erlang:'@Op2@'(A, _@Lit2@), two. ")| + gen_rel_op_functions(T)]; +gen_rel_op_functions([{Name,{Op1,Lit1,Op2,Lit2}}|T]) -> + %% Example of a generated function: + %% + %% f721(A) when erlang:'=<'(A, 7.0) -> one; + %% f721(A) when erlang:'<'(A, 6) -> two; + %% f721(_) -> three. + [?Q("'@Name@'(A) when erlang:'@Op1@'(A, _@Lit1@) -> one; + '@Name@'(A) when erlang:'@Op2@'(A, _@Lit2@) -> two; + '@Name@'(_) -> three.")|gen_rel_op_functions(T)]; +gen_rel_op_functions([]) -> []. + +test_combinations([{Name,E}|T], Mod) -> + try + test_combinations_1([5,6,7,8,9], E, fun Mod:Name/1), + test_combination(6.5, E, fun Mod:Name/1) + catch + error:Reason:Stk -> + io:format("~p: ~p\n", [Name,E]), + erlang:raise(error, Reason, Stk) + end, + test_combinations(T, Mod); +test_combinations([], _Mod) -> ok. + +test_combinations_1([V|Vs], E, Fun) -> + test_combination(V, E, Fun), + test_combination(float(V), E, Fun), + test_combinations_1(Vs, E, Fun); +test_combinations_1([], _, _) -> ok. + +test_combination(Val, {neq,Expr}, Fun) -> + Result = eval_combination_expr(Expr, Val), + Result = try + Fun(Val) %Returns 'one' or 'two'. + catch + error:{badmatch,_} -> + three + end; +test_combination(Val, Expr, Fun) -> + Result = eval_combination_expr(Expr, Val), + Result = Fun(Val). + +eval_combination_expr({Op1,Lit1,Op2,Lit2}, Val) -> + case erlang:Op1(Val, Lit1) of + true -> + one; + false -> + case erlang:Op2(Val, Lit2) of + true -> two; + false -> three + end + end. + %% Test type tests on literal values. (From emulator test suites.) literal_type_tests(Config) when is_list(Config) -> %% Generate an Erlang module with all different type of type tests. @@ -1818,6 +1940,15 @@ andalso_semi(Config) when is_list(Config) -> ok = andalso_semi_bar([a,b,c]), ok = andalso_semi_bar(1), fc(catch andalso_semi_bar([a,b])), + + ok = andalso_semi_dispatch(name, fun andalso_semi/1), + ok = andalso_semi_dispatch(name, fun ?MODULE:andalso_semi/1), + ok = andalso_semi_dispatch(name, {?MODULE,andalso_semi,1}), + fc(catch andalso_semi_dispatch(42, fun andalso_semi/1)), + fc(catch andalso_semi_dispatch(name, not_fun)), + fc(catch andalso_semi_dispatch(name, fun andalso_semi_dispatch/2)), + fc(catch andalso_semi_dispatch(42, {a,b})), + ok. andalso_semi_foo(Bar) when is_integer(Bar) andalso Bar =:= 0; Bar =:= 1 -> @@ -1826,6 +1957,10 @@ andalso_semi_foo(Bar) when is_integer(Bar) andalso Bar =:= 0; Bar =:= 1 -> andalso_semi_bar(Bar) when is_list(Bar) andalso length(Bar) =:= 3; Bar =:= 1 -> ok. +andalso_semi_dispatch(Registry, MFAOrFun) when + is_atom(Registry) andalso is_function(MFAOrFun, 1); + is_atom(Registry) andalso tuple_size(MFAOrFun) == 3 -> + ok. t_tuple_size(Config) when is_list(Config) -> 10 = do_tuple_size({1,2,3,4}), @@ -2121,7 +2256,8 @@ do_guard_in_catch_bin(From) -> %%% %%% The beam_bool pass has been eliminated. Here are the tests from -%%% beam_bool_SUITE. +%%% beam_bool_SUITE, as well as new tests to test the new beam_ssa_bool +%%% module. %%% beam_bool_SUITE(_Config) -> @@ -2130,6 +2266,11 @@ beam_bool_SUITE(_Config) -> y_registers(), protected(), maps(), + cover_shortcut_branches(), + wrong_order(), + megaco(), + looks_like_a_guard(), + fail_in_guard(), ok. before_and_inside_if() -> @@ -2267,6 +2408,115 @@ maps() -> evidence(#{0 := Charge}) when 0; #{[] => Charge} == #{[] => 42} -> ok. +cover_shortcut_branches() -> + ok = cover_shortcut_branches({r1}, 0, 42, false), + ok = cover_shortcut_branches({r1}, 42, 42, true), + error = cover_shortcut_branches({r1}, same, same, false), + error = cover_shortcut_branches({r1}, x, y, true), + error = cover_shortcut_branches({r2}, 0, 42, false), + error = cover_shortcut_branches({}, 0, 42, false), + error = cover_shortcut_branches(not_tuple, 0, 42, false), + ok. + +cover_shortcut_branches(St, X, Y, Z) -> + if + %% The ((Y =:= X) =:= Z) part will test handling of a comparison + %% operator followed by a one-way `br`. + ((element(1, St) =:= r1) orelse fail) and ((Y =:= X) =:= Z) -> + ok; + true -> + error + end. + +wrong_order() -> + ok = wrong_order(repeat_until_fail, true), + ok = wrong_order(repeat_until_fail, whatever), + error = wrong_order(repeat_until_fail, false), + error = wrong_order(nope, true), + ok. + +wrong_order(RepeatType, Mode) -> + Parallel = Mode =/= false, + RepeatStop = RepeatType =:= repeat_until_fail, + if + Parallel andalso RepeatStop -> + ok; + true -> + error + end. + +megaco() -> + ok = megaco('NULL', 0), + ok = megaco('NULL', 7), + ok = megaco('NULL', 15), + ok = megaco('NULL', asn1_NOVALUE), + ok = megaco(asn1_NOVALUE, 0), + ok = megaco(asn1_NOVALUE, 7), + ok = megaco(asn1_NOVALUE, 15), + ok = megaco(asn1_NOVALUE, asn1_NOVALUE), + + error = megaco(bad, 0), + error = megaco(bad, 7), + error = megaco(bad, 15), + error = megaco(bad, asn1_NOVALUE), + + error = megaco('NULL', not_integer), + error = megaco('NULL', -1), + error = megaco('NULL', 16), + error = megaco(asn1_NOVALUE, not_integer), + error = megaco(asn1_NOVALUE, -1), + error = megaco(asn1_NOVALUE, 16), + + error = megaco(bad, bad), + error = megaco(bad, -1), + error = megaco(bad, 42), + + ok. + +megaco(Top, SelPrio) + when (Top =:= 'NULL' orelse Top =:= asn1_NOVALUE) andalso + ((is_integer(SelPrio) andalso ((0 =< SelPrio) and (SelPrio =< 15))) orelse + SelPrio =:= asn1_NOVALUE) -> + ok; +megaco(_, _) -> + error. + +%% ERL-1054. +looks_like_a_guard() -> + ok = looks_like_a_guard(0), + ok = looks_like_a_guard(1), + ok. + +looks_like_a_guard(N) -> + GuessPosition = id(42), + %% The matching of `true` would look like a guard to + %% beam_ssa_bool. The optimized code would not be safe. + case {1 >= N, GuessPosition == 0} of + {true, _} -> ok; + {_, true} -> ok; + _ -> looks_like_a_guard(N) + end. + +fail_in_guard() -> + false = struct_or_map(a, "foo"), + false = struct_or_map(a, foo), + false = struct_or_map(#{}, "foo"), + true = struct_or_map(#{}, foo), + ok. + +%% ERL-1183. If Name is not an atom, the `fail` atom must cause the +%% entire guard to fail. +struct_or_map(Arg, Name) when + (is_map(Arg) andalso (is_atom(Name) orelse fail) andalso + is_map_key(struct, Arg)) orelse is_map(Arg) -> true; +struct_or_map(_Arg, _Name) -> + false. + + +%%% +%%% End of beam_bool_SUITE tests. +%%% + repeated_type_tests(_Config) -> binary = repeated_type_test(<<42>>), bitstring = repeated_type_test(<<1:1>>), diff --git a/lib/compiler/test/lfe_andor_SUITE.core b/lib/compiler/test/lfe_andor_SUITE.core index df58b39ae6..e8cb0919a0 100644 --- a/lib/compiler/test/lfe_andor_SUITE.core +++ b/lib/compiler/test/lfe_andor_SUITE.core @@ -34,6 +34,8 @@ module 'lfe_andor_SUITE' ['$handle_undefined_function'/2, 'init_per_suite'/1 = %% Line 48 fun (_config) -> + do + call 'test_lib':'recompile_core'('lfe_andor_SUITE') _config 'end_per_suite'/1 = %% Line 50 diff --git a/lib/compiler/test/lfe_guard_SUITE.core b/lib/compiler/test/lfe_guard_SUITE.core index 920be82f61..9d184ed166 100644 --- a/lib/compiler/test/lfe_guard_SUITE.core +++ b/lib/compiler/test/lfe_guard_SUITE.core @@ -53,6 +53,8 @@ module 'lfe_guard_SUITE' ['$handle_undefined_function'/2, 'init_per_suite'/1 = %% Line 62 fun (_config) -> + do + call 'test_lib':'recompile_core'('lfe_guard_SUITE') _config 'end_per_suite'/1 = %% Line 64 diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index 2bcb6133da..46c1acef4c 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -74,7 +74,10 @@ %% new in OTP 22 t_mixed_clause/1,cover_beam_trim/1, - t_duplicate_keys/1 + t_duplicate_keys/1, + + %% new in OTP 23 + t_key_expressions/1 ]). suite() -> []. @@ -132,7 +135,10 @@ all() -> %% new in OTP 22 t_mixed_clause,cover_beam_trim, - t_duplicate_keys + t_duplicate_keys, + + %% new in OTP 23 + t_key_expressions ]. groups() -> []. @@ -2193,6 +2199,92 @@ do_cover_beam_trim(Id, OldMax, Max, Id, M) -> #{Id:=Val} = id(M), Val. +t_key_expressions(_Config) -> + Int = id(42), + #{{tag,Int} := 42} = id(#{{tag,Int} => 42}), + #{{tag,Int+1} := 42} = id(#{{tag,Int+1} => 42}), + #{{a,b} := x, {tag,Int} := 42, Int := 0} = + id(#{{a,b} => x, {tag,Int} => 42, Int => 0}), + + F1 = fun(#{Int + 1 := Val}) -> Val end, + val = F1(#{43 => val}), + {'EXIT',_} = (catch F1(a)), + + F2 = fun(M, X, Y) -> + case M of + #{element(X, Y) := <<Sz:16,Bin:Sz/binary>>} -> + Bin; + #{} -> + not_found; + {A,B} -> + A + B + end + end, + <<"xyz">> = F2(#{b => <<3:16,"xyz">>}, 2, {a,b,c}), + not_found = F2(#{b => <<3:16,"xyz">>}, 999, {a,b,c}), + 13 = F2({6,7}, 1, 2), + + #{<<"Спутник"/utf8>> := 1} = id(#{<<"Спутник"/utf8>> => 1}), + + F3 = fun(Arg) -> + erase(once), + RunOnce = fun(I) -> + undefined = put(once, twice), + id(I) + end, + case RunOnce(Arg) of + #{{tag,<<Int:42>>} := Value} -> Value; + {X,Y} -> X + Y + end + end, + 10 = F3({7,3}), + whatever = F3(#{{tag,<<Int:42>>} => whatever}), + + F4 = fun(K1, K2, M) -> + case M of + #{K1 div K2 := V} -> V; + #{} -> no_match + end + end, + value = F4(42, 21, #{2 => value}), + no_match = F4(42, 21, #{}), + no_match = F4(42, 0, #{2 => value}), + no_match = F4(42, a, #{2 => value}), + + F5 = fun(Term) -> + self() ! Term, + receive + #{[<<(3 bsr 30 + 2):0,$k:[]/signed-integer>>] := _} -> + ok; + 0.5 -> + error + end + end, + error = F5(0.5), + + F6 = fun(Term) -> + self() ! Term, + receive + #{<<a/utf8>> := {a,b,c}} -> ok; + Other -> {error,Other} + end + end, + {error,any} = F6(any), + + F7 = fun(Term) -> + self() ! Term, + (?MODULE:all()):a(catch + receive + <<1.14:{<<"a":(tuple_size(1))>>}>> -> + 4; + Other -> + Other + end) + end, + {'EXIT',{badarg,_}} = (catch F7(whatever)), + + ok. + t_duplicate_keys(Config) when is_list(Config) -> Map = #{ gurka => gaffel }, Map = dup_keys_1(id(Map)), diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index bc74ec4984..d1da114d3f 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -26,7 +26,7 @@ selectify/1,deselectify/1,underscore/1,match_map/1,map_vars_used/1, coverage/1,grab_bag/1,literal_binary/1, unary_op/1,eq_types/1,match_after_return/1,match_right_tuple/1, - tuple_size_in_try/1]). + tuple_size_in_try/1,match_boolean_list/1]). -include_lib("common_test/include/ct.hrl"). @@ -43,7 +43,7 @@ groups() -> underscore,match_map,map_vars_used,coverage, grab_bag,literal_binary,unary_op,eq_types, match_after_return,match_right_tuple, - tuple_size_in_try]}]. + tuple_size_in_try,match_boolean_list]}]. init_per_suite(Config) -> @@ -260,6 +260,7 @@ non_matching_aliases(_Config) -> none = mixed_aliases(<<6789:16>>), none = mixed_aliases(#{key=>value}), + {'EXIT',{{badmatch,bar},_}} = (catch plus_plus_prefix()), {'EXIT',{{badmatch,42},_}} = (catch nomatch_alias(42)), {'EXIT',{{badmatch,job},_}} = (catch entirely()), {'EXIT',{{badmatch,associates},_}} = (catch printer()), @@ -294,8 +295,12 @@ mixed_aliases([X] = #{key:=X}) -> {k,X}; mixed_aliases(#{key:=X} = [X]) -> {l,X}; mixed_aliases({a,X} = #{key:=X}) -> {m,X}; mixed_aliases(#{key:=X} = {a,X}) -> {n,X}; +mixed_aliases([] ++ (foo = [])) -> o; mixed_aliases(_) -> none. +plus_plus_prefix() -> + [] ++ (foo = []) = bar. + nomatch_alias(I) -> {ok={A,B}} = id(I), {A,B}. @@ -939,4 +944,17 @@ tsit(A) -> _:_ -> ok end. +match_boolean_list(Config) when is_list(Config) -> + BoolList = [N rem 2 =:= 0 || N <- lists:seq(1, 8)], + %% The compiler knows that all list elements are booleans, so it translates + %% the expression below to a #b_br{} on the list head. + %% + %% This is fine, but since the value was only used in that branch, + %% reserve_zregs/3 (pre_codegen) would place the variable in a z register, + %% crashing the compiler in a later pass. + ok = case BoolList of + [true | _] -> error; + [false | _] -> ok + end. + id(I) -> I. diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index 6e81bafd61..883c713a79 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -164,6 +164,11 @@ md5_1(Beam) -> %% Cover some code that handles internal errors. silly_coverage(Config) when is_list(Config) -> + %% v3_core + BadAbstr = [{attribute,0,module,bad_module}, + {function,0,foo,2,[bad_clauses]}], + expect_error(fun() -> v3_core:module(BadAbstr, []) end), + %% sys_core_fold, sys_core_alias, sys_core_bsm, v3_kernel BadCoreErlang = {c_module,[], name,[],[], @@ -184,6 +189,7 @@ silly_coverage(Config) when is_list(Config) -> expect_error(fun() -> beam_kernel_to_ssa:module(BadKernel, []) end), %% beam_ssa_lint + %% beam_ssa_bool %% beam_ssa_recv %% beam_ssa_share %% beam_ssa_pre_codegen @@ -191,6 +197,7 @@ silly_coverage(Config) when is_list(Config) -> BadSSA = {b_module,#{},a,b,c, [{b_function,#{func_info=>{mod,foo,0}},args,bad_blocks,0}]}, expect_error(fun() -> beam_ssa_lint:module(BadSSA, []) end), + expect_error(fun() -> beam_ssa_bool:module(BadSSA, []) end), expect_error(fun() -> beam_ssa_recv:module(BadSSA, []) end), expect_error(fun() -> beam_ssa_share:module(BadSSA, []) end), expect_error(fun() -> beam_ssa_pre_codegen:module(BadSSA, []) end), @@ -198,7 +205,7 @@ silly_coverage(Config) when is_list(Config) -> %% beam_ssa_opt BadSSABlocks = #{0 => {b_blk,#{},[bad_code],{b_ret,#{},arg}}}, - BadSSAOpt = {b_module,#{},a,[],c, + BadSSAOpt = {b_module,#{},a,[],[], [{b_function,#{func_info=>{mod,foo,0}},[], BadSSABlocks,0}]}, expect_error(fun() -> beam_ssa_opt:module(BadSSAOpt, []) end), @@ -230,15 +237,6 @@ silly_coverage(Config) when is_list(Config) -> {label,2}|non_proper_list]}],99}, expect_error(fun() -> beam_block:module(BlockInput, []) end), - %% beam_except - ExceptInput = {?MODULE,[{foo,0}],[], - [{function,foo,0,2, - [{label,1}, - {line,loc}, - {func_info,{atom,?MODULE},{atom,foo},0}, - {label,2}|non_proper_list]}],99}, - expect_error(fun() -> beam_except:module(ExceptInput, []) end), - %% beam_jump JumpInput = BlockInput, expect_error(fun() -> beam_jump:module(JumpInput, []) end), @@ -286,14 +284,34 @@ silly_coverage(Config) when is_list(Config) -> bad_ssa_lint_input() -> {b_module,#{},t, - [{foobar,1},{module_info,0},{module_info,1}], + [{a,1},{b,1},{c,1},{module_info,0},{module_info,1}], [], [{b_function, - #{func_info => {t,foobar,1},location => {"t.erl",4}}, + #{func_info => {t,a,1},location => {"t.erl",4}}, [{b_var,0}], #{0 => {b_blk,#{},[],{b_ret,#{},{b_var,'@undefined_var'}}}}, 3}, {b_function, + #{func_info => {t,b,1},location => {"t.erl",5}}, + [{b_var,0}], + #{0 => + {b_blk,#{}, + [{b_set,#{},{b_var,'@first_var'},first_op,[]}, + {b_set,#{},{b_var,'@second_var'},second_op,[]}, + {b_set,#{},{b_var,'@ret'},succeeded,[{b_var,'@first_var'}]}], + {b_ret,#{},{b_var,'@ret'}}}}, + 3}, + {b_function, + #{func_info => {t,c,1},location => {"t.erl",6}}, + [{b_var,0}], + #{0 => + {b_blk,#{}, + [{b_set,#{},{b_var,'@first_var'},first_op,[]}, + {b_set,#{},{b_var,'@ret'},succeeded,[{b_var,'@first_var'}]}, + {b_set,#{},{b_var,'@second_var'},second_op,[]}], + {b_ret,#{},{b_var,'@ret'}}}}, + 3}, + {b_function, #{func_info => {t,module_info,0}}, [], #{0 => diff --git a/lib/compiler/test/property_test/beam_types_prop.erl b/lib/compiler/test/property_test/beam_types_prop.erl new file mode 100644 index 0000000000..1e5da10aa0 --- /dev/null +++ b/lib/compiler/test/property_test/beam_types_prop.erl @@ -0,0 +1,315 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. 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(beam_types_prop). + +-compile([export_all, nowarn_export_all]). + +%% This module only supports proper, as we don't have an eqc license to test +%% with. + +-proptest([proper]). + +-ifdef(PROPER). + +-define(BEAM_TYPES_INTERNAL, true). +-include_lib("compiler/src/beam_types.hrl"). + +-include_lib("proper/include/proper.hrl"). +-define(MOD_eqc,proper). + +-import(lists, [duplicate/2,foldl/3]). + +%% The default repetitions of 100 is a bit too low to reliably cover all type +%% combinations, so we crank it up a bit. +-define(REPETITIONS, 5000). + +absorption() -> + numtests(?REPETITIONS, absorption_1()). + +absorption_1() -> + ?FORALL({TypeA, TypeB}, + ?LET(TypeA, type(), + ?LET(TypeB, type(), {TypeA, TypeB})), + absorption_check(TypeA, TypeB)). + +absorption_check(A, B) -> + verified_type(A), + verified_type(B), + + %% a ∨ (a ∧ b) = a + A = join(A, meet(A, B)), + + %% a ∧ (a ∨ b) = a + A = meet(A, join(A, B)), + + true. + +associativity() -> + numtests(?REPETITIONS, associativity_1()). + +associativity_1() -> + ?FORALL({TypeA, TypeB, TypeC}, + ?LET(TypeA, type(), + ?LET(TypeB, type(), + ?LET(TypeC, type(), {TypeA, TypeB, TypeC}))), + associativity_check(TypeA, TypeB, TypeC)). + +associativity_check(A, B, C) -> + verified_type(A), + verified_type(B), + verified_type(C), + + %% a ∨ (b ∨ c) = (a ∨ b) ∨ c + LHS_Join = join(A, join(B, C)), + RHS_Join = join(join(A, B), C), + LHS_Join = RHS_Join, + + %% a ∧ (b ∧ c) = (a ∧ b) ∧ c + LHS_Meet = meet(A, meet(B, C)), + RHS_Meet = meet(meet(A, B), C), + LHS_Meet = RHS_Meet, + + true. + +commutativity() -> + numtests(?REPETITIONS, commutativity_1()). + +commutativity_1() -> + ?FORALL({TypeA, TypeB}, + ?LET(TypeA, type(), + ?LET(TypeB, type(), {TypeA, TypeB})), + commutativity_check(TypeA, TypeB)). + +commutativity_check(A, B) -> + verified_type(A), + verified_type(B), + + %% a ∨ b = b ∨ a + true = join(A, B) =:= join(B, A), + + %% a ∧ b = b ∧ a + true = meet(A, B) =:= meet(B, A), + + true. + +idempotence() -> + numtests(?REPETITIONS, idempotence_1()). + +idempotence_1() -> + ?FORALL(Type, type(), idempotence_check(Type)). + +idempotence_check(Type) -> + verified_type(Type), + + %% a ∨ a = a + Type = join(Type, Type), + + %% a ∧ a = a + Type = meet(Type, Type), + + true. + +identity() -> + ?FORALL(Type, type(), identity_check(Type)). + +identity_check(Type) -> + verified_type(Type), + + %% a ∨ [bottom element] = a + Type = join(Type, none), + + %% a ∧ [top element] = a + Type = meet(Type, any), + + true. + +subtraction() -> + numtests(?REPETITIONS, subtraction_1()). + +subtraction_1() -> + ?FORALL({TypeA, TypeB}, + ?LET(TypeA, type(), + ?LET(TypeB, type(), {TypeA, TypeB})), + subtraction_check(TypeA, TypeB)). + +subtraction_check(A, B) -> + verified_type(A), + verified_type(B), + + %% Subtraction can be thought of as `a ∧ ¬b`, so the result must be at + %% least as specific as `a`. + Res = subtract(A, B), + Res = meet(A, Res), + + true. + +meet(A, B) -> beam_types:meet(A, B). +join(A, B) -> beam_types:join(A, B). +subtract(A, B) -> beam_types:subtract(A, B). +verified_type(T) -> beam_types:verified_type(T). + +%%% +%%% Generators +%%% + +type() -> + type(?MAX_TYPE_DEPTH). + +type(Depth) -> + ?SHRINK(?LAZY(oneof([any, none] ++ term_types(Depth))), + [nil, any, none]). + +term_type(Depth) -> + ?SHRINK(?LAZY(oneof([any | term_types(Depth)])), + [nil, any]). + +term_types(Depth) -> + nested_generators(Depth) ++ + numerical_generators() ++ + [gen_atom(), gen_bs_matchable()]. + +numerical_generators() -> + [gen_integer(), gen_float(), number]. + +nested_generators(Depth) when Depth =< 0 -> + [nil]; +nested_generators(Depth) -> + [gen_list(Depth - 1), + gen_fun(Depth - 1), + gen_map(Depth - 1), + ?LAZY(gen_tuple(Depth - 1)), + ?LAZY(gen_union(Depth - 1))]. + +%% Proper's atom generator is far too wide, generating strings like 'û\2144Bò}' +%% which are both hard to read and fill up the atom table really fast. +readable_atom() -> + ?LET(Atom, range($0, $~), list_to_atom([Atom])). + +%% + +gen_atom() -> + ?LET(Size, range(0, ?ATOM_SET_SIZE), + ?LET(Set, duplicate(Size, readable_atom()), + case ordsets:from_list(Set) of + [_|_]=Vs -> #t_atom{elements=ordsets:from_list(Vs)}; + [] -> #t_atom{} + end)). + +gen_bs_matchable() -> + oneof([?LET(Unit, range(1, 16), #t_bs_matchable{tail_unit=Unit}), + ?LET(Unit, range(1, 16), #t_bs_context{tail_unit=Unit}), + ?LET(Unit, range(1, 16), #t_bitstring{size_unit=Unit})]). + +gen_float() -> + oneof([?LET({A, B}, {integer(), integer()}, + begin + Min = float(min(A,B)), + Max = float(max(A,B)), + #t_float{elements={Min,Max}} + end), + #t_float{}]). + +gen_fun(Depth) -> + ?SHRINK(?LET({Type, Arity}, {type(Depth), oneof([any, range(1, 4)])}, + #t_fun{type=Type,arity=Arity}), + [#t_fun{}]). + +gen_integer() -> + oneof([?LET({A, B}, {integer(), integer()}, + #t_integer{elements={min(A,B), max(A,B)}}), + #t_integer{}]). + +gen_list(Depth) -> + ?SHRINK(oneof([?LET({Type, Term}, {term_type(Depth), term_type(Depth)}, + #t_list{type=Type,terminator=Term}), + ?LET({Type, Term}, {term_type(Depth), term_type(Depth)}, + #t_cons{type=Type,terminator=Term}), + nil]), + [nil]). + +gen_map(Depth) -> + ?SHRINK(?LET({SKey, SValue}, {term_type(Depth), term_type(Depth)}, + #t_map{super_key=SKey,super_value=SValue}), + [#t_map{}]). + +gen_tuple(Depth) -> + ?SHRINK(oneof([gen_tuple_plain(Depth), gen_tuple_record(Depth)]), + [#t_tuple{}]). + +gen_tuple_record(Depth) -> + ?LET({Start, Size}, {range(2, ?TUPLE_ELEMENT_LIMIT), + range(1, ?TUPLE_ELEMENT_LIMIT * 2)}, + ?LET({Tag, Es0}, {readable_atom(), + gen_tuple_elements(Start, Size, Depth)}, + begin + Es = Es0#{ 1 => #t_atom{elements=[Tag]} }, + #t_tuple{exact=true,size=Size,elements=Es} + end)). + +gen_tuple_plain(Depth) -> + ?LET({Start, Size}, {range(1, ?TUPLE_ELEMENT_LIMIT), + range(0, ?TUPLE_ELEMENT_LIMIT * 2)}, + ?LET({Exact, Es}, {boolean(), gen_tuple_elements(Start, Size, Depth)}, + #t_tuple{exact=Exact,size=Size,elements=Es})). + +gen_tuple_elements(Start, Size, Depth) -> + End = min(Size, ?TUPLE_ELEMENT_LIMIT), + ?SHRINK(?LET(Types, gen_tuple_elements_1(Start, End, term_type(Depth)), + foldl(fun({Index, Type}, Acc) -> + beam_types:set_tuple_element(Index, Type, Acc) + end, #{}, Types)), + [#{}]). + +gen_tuple_elements_1(Index, End, _Gen) when Index > End -> + []; +gen_tuple_elements_1(Index, End, Gen) -> + case rand:uniform(2) of + 1 -> [{Index, Gen} | gen_tuple_elements_1(Index + 1, End, Gen)]; + 2 -> gen_tuple_elements_1(Index + 1, End, Gen) + end. + +gen_union(Depth) -> + ?SHRINK(oneof([gen_union_wide(Depth), gen_union_record(Depth)]), + [gen_union_record(?MAX_TYPE_DEPTH)]). + +%% Creates a union with most (if not all) slots filled. +gen_union_wide(Depth) -> + ?LET({A, B, C, D, E, F}, {gen_atom(), + gen_bs_matchable(), + gen_list(Depth), + gen_tuple(Depth), + oneof(nested_generators(Depth)), + oneof(numerical_generators())}, + begin + T0 = join(A, B), + T1 = join(T0, C), + T2 = join(T1, D), + T3 = join(T2, E), + join(T3, F) + end). + +%% Creates a union consisting solely of records +gen_union_record(Depth) -> + ?LET(Size, range(2, ?TUPLE_SET_LIMIT), + ?LET(Tuples, duplicate(Size, gen_tuple_record(Depth)), + foldl(fun join/2, none, Tuples))). + +-endif. diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index db84d16b06..b1f1099095 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -27,7 +27,8 @@ export/1,recv/1,coverage/1,otp_7980/1,ref_opt/1, wait/1,recv_in_try/1,double_recv/1,receive_var_zero/1, match_built_terms/1,elusive_common_exit/1, - return_before_receive/1,trapping/1]). + return_before_receive/1,trapping/1, + after_expression/1,in_after/1]). -include_lib("common_test/include/ct.hrl"). @@ -49,7 +50,8 @@ groups() -> [recv,coverage,otp_7980,export,wait, recv_in_try,double_recv,receive_var_zero, match_built_terms,elusive_common_exit, - return_before_receive,trapping]}, + return_before_receive,trapping, + after_expression,in_after]}, {slow,[],[ref_opt]}]. init_per_suite(Config) -> @@ -94,6 +96,8 @@ recv(Config) when is_list(Config) -> io:format("Unexpected extra message: ~p", [X]), ct:fail(unexpected) after 10 -> + unlink(Pid), + exit(Pid, kill), ok end, ok. @@ -136,6 +140,16 @@ coverage(Config) when is_list(Config) -> {'EXIT',{{badmap,[]},_}} = (catch monitor_plus_badmap(self())), + + self() ! {data,no_data}, + ok = receive_sink_tuple({any,pattern}), + {b,a} = receive_sink_tuple({a,b}), + + %% Basically a smoke test of no_clauses_left/0. + NoClausesLeft = spawn(fun no_clauses_left/0), + receive after 1 -> ok end, + exit(NoClausesLeft, kill), + ok. monitor_plus_badmap(Pid) -> @@ -184,6 +198,26 @@ tuple_to_values(Timeout, X) -> end, A+B. +no_clauses_left() -> + receive + %% This clause would be removed because it cannot match... + a = b -> + V = whatever + end, + %% ... leaving a reference to an unbound variable. Crash. + V. + + +%% Cover a help function for beam_ssa_opt:ssa_opt_sink/1. +receive_sink_tuple({Line,Pattern}) -> + receive + {data,_} -> + ok + after 1 -> + id({Pattern,Line}) + end. + + %% OTP-7980. Thanks to Vincent de Phily. The following code would %% be inccorrectly optimized by beam_jump. @@ -401,7 +435,9 @@ receive_var_zero(Config) when is_list(Config) -> end, self() ! w, receive - x -> ok; + x -> + receive y -> ok end, + receive w -> ok end; Other -> ct:fail({bad_message,Other}) end. @@ -541,4 +577,52 @@ do_trapping(N) -> receive Ref -> ok end, receive after 1 -> ok end. +after_expression(_Config) -> + self() ! {a,message}, + {a,message} = after_expr(0), + timeout = after_expr(0), + timeout = after_expr(10), + ok = after_expr_timeout(0), + ok = after_expr_timeout(1), + ok. + +after_expr(Timeout) -> + receive + Msg -> Msg + after id(Timeout) -> + timeout + end. + +after_expr_timeout(Timeout) -> + receive + after id(Timeout) -> + ok + end. + +in_after(_Config) -> + self() ! first, + self() ! message, + do_in_after(fun() -> ok end), + do_in_after(fun() -> ok end), + self() ! message, + catch do_in_after(fun() -> error(bad) end), + catch do_in_after(fun() -> error(bad) end), + self() ! last, + first = receive M1 -> M1 end, + last = receive M2 -> M2 end, + ok. + +do_in_after(E) -> + try + E() + after + receive + message -> + ok + after 1 -> + ok + end + end, + ok. + id(I) -> I. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_19.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_19.erl new file mode 100644 index 0000000000..470bef54ae --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_19.erl @@ -0,0 +1,15 @@ +-module(yes_19). +-export([?MODULE/0,f/2]). + +?MODULE() -> + ok. + +f(Pid, Msg) -> + MyRef = make_ref(), + Pid ! Msg, + receive + {Ref,Reply} when Ref == MyRef -> + Reply + after 0 -> + ok + end. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_20.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_20.erl new file mode 100644 index 0000000000..e85f1b99ca --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_20.erl @@ -0,0 +1,16 @@ +-module(yes_20). +-compile(export_all). + +?MODULE() -> + ok. + +f() -> + Ref = spawn_request(fun () -> ok end), + Pid = receive + {spawn_reply, Ref, _, P} -> + P + end, + receive + {'DOWN', Ref, process, Pid, normal} -> + ok + end. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_21.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_21.erl new file mode 100644 index 0000000000..5e0a92b10d --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_21.erl @@ -0,0 +1,16 @@ +-module(yes_21). +-compile(export_all). + +?MODULE() -> + ok. + +f() -> + Ref = spawn_request(fun () -> ok end), + receive + {spawn_reply, Ref, _, _} -> + ok + end, + receive + {'DOWN', Ref, _, _, _} -> + ok + end. diff --git a/lib/compiler/test/record_SUITE.erl b/lib/compiler/test/record_SUITE.erl index 94804529b6..e272d95f2d 100644 --- a/lib/compiler/test/record_SUITE.erl +++ b/lib/compiler/test/record_SUITE.erl @@ -589,6 +589,7 @@ nested_access(Config) when is_list(Config) -> ok. -record(rr, {a,b,c}). +-record(fileheader, {read_md5,md5,eof,trailer}). coverage(Config) when is_list(Config) -> %% There should only remain one record test in the code below. @@ -600,8 +601,23 @@ coverage(Config) when is_list(Config) -> ok end, #rr{a=1,b=2,c=42} = id(R), %Test for correctness. + + %% Cover beam_ssa_opt:ssa_opt_element/1 and friends. + error1 = check_file_header(#fileheader{read_md5=1,md5=2}), + error2 = check_file_header(#fileheader{trailer=true,eof=false}), + error3 = check_file_header(#fileheader{}), + ok. +check_file_header(FH) -> + if + FH#fileheader.read_md5 =/= FH#fileheader.md5 -> + error1; + FH#fileheader.trailer =/= FH#fileheader.eof -> + error2; + true -> + error3 + end. -record(default_fun, {a = fun(X) -> X*X end}). @@ -609,8 +625,9 @@ coverage(Config) when is_list(Config) -> -record(gb_nil, {}). -record(gb_foo, {hello=1}). -record(gb_bar, {hello=2,there=3}). +-record(gb_rh, {mod,mid}). -%% Taken from compilation_SUITE. +%% Taken from compilation_SUITE and other places. grab_bag(_Config) -> T1 = fun() -> X = #foo{}, @@ -654,6 +671,23 @@ grab_bag(_Config) -> end, T4(), + %% Used to crash beam_ssa_bool during its development. + T5 = fun(RH) -> + if + is_record(RH, gb_rh) andalso + is_atom(RH#gb_rh.mod) andalso + RH#gb_rh.mid /= 42 -> ok; + true -> error + end + end, + ok = T5(#gb_rh{}), + ok = T5(#gb_rh{mod=atom,mid=0}), + error = T5(#gb_rh{mod=100,mid=0}), + error = T5(#gb_rh{mod=atom,mid=42}), + error = T5(#gb_nil{}), + error = T5(#gb_bar{}), + error = T5(atom), + ok. %% ERIERL-436; the following code used to be very slow to compile. diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl index 34410e4b2a..f3eeae9ccd 100644 --- a/lib/compiler/test/test_lib.erl +++ b/lib/compiler/test/test_lib.erl @@ -21,7 +21,8 @@ -include_lib("common_test/include/ct.hrl"). -compile({no_auto_import,[binary_part/2]}). --export([id/1,recompile/1,parallel/0,uniq/0,opt_opts/1,get_data_dir/1, +-export([id/1,recompile/1,recompile_core/1,parallel/0, + uniq/0,opt_opts/1,get_data_dir/1, is_cloned_mod/1,smoke_disasm/1,p_run/2, highest_opcode/1]). @@ -45,6 +46,21 @@ recompile(Mod) when is_atom(Mod) -> %% Smoke-test of beam disassembler. smoke_disasm(Mod). +recompile_core(Mod) when is_atom(Mod) -> + case whereis(cover_server) of + undefined -> ok; + _ -> + %% Re-compile the test suite if the cover server is running. + Beam = code:which(Mod), + Src = filename:rootname(Beam, ".beam"), + Opts = [bin_opt_info|opt_opts(Mod)], + io:format("Recompiling ~p (~p)\n", [Mod,Opts]), + c:c(Src, [from_core,{outdir,filename:dirname(Src)}|Opts]) + end, + + %% Smoke-test of beam disassembler. + smoke_disasm(Mod). + smoke_disasm(Mod) when is_atom(Mod) -> smoke_disasm(code:which(Mod)); smoke_disasm(File) when is_list(File) -> @@ -69,6 +85,7 @@ opt_opts(Mod) -> {options,Opts} = lists:keyfind(options, 1, Comp), lists:filter(fun (debug_info) -> true; + (dialyzer) -> true; (inline) -> true; (no_bsm3) -> true; (no_bsm_opt) -> true; @@ -79,9 +96,11 @@ opt_opts(Mod) -> (no_put_tuple2) -> true; (no_recv_opt) -> true; (no_share_opt) -> true; + (no_shared_fun_wrappers) -> true; (no_ssa_float) -> true; (no_ssa_opt) -> true; (no_stack_trimming) -> true; + (no_swap) -> true; (no_type_opt) -> true; (_) -> false end, Opts). diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl index 539f9d69fa..4cff129d1f 100644 --- a/lib/compiler/test/trycatch_SUITE.erl +++ b/lib/compiler/test/trycatch_SUITE.erl @@ -1079,7 +1079,7 @@ stacktrace(_Config) -> error:{badmatch,_}:Stk2 -> [{?MODULE,stacktrace_2,0,_}, {?MODULE,stacktrace,1,_}|_] = Stk2, - Stk2 = erlang:get_stacktrace(), + [] = erlang:get_stacktrace(), ok end, @@ -1087,7 +1087,7 @@ stacktrace(_Config) -> stacktrace_3(a, b) catch error:function_clause:Stk3 -> - Stk3 = erlang:get_stacktrace(), + [] = erlang:get_stacktrace(), case lists:module_info(native) of false -> [{lists,prefix,[a,b],_}|_] = Stk3; @@ -1108,14 +1108,16 @@ stacktrace_1(X, C1, Y) -> C1 -> value1 catch C1:D1:Stk1 -> - Stk1 = erlang:get_stacktrace(), + [] = erlang:get_stacktrace(), {caught1,D1,Stk1} after foo(Y) end of V2 -> {value2,V2} catch - C2:D2:Stk2 -> {caught2,{C2,D2},Stk2=erlang:get_stacktrace()} + C2:D2:Stk2 -> + [] = erlang:get_stacktrace(), + {caught2,{C2,D2},Stk2} end. stacktrace_2() -> @@ -1160,12 +1162,10 @@ nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) -> V1 -> value1 catch C1:V1:S1 -> - S1 = erlang:get_stacktrace(), T2 = try foo(X2) of V2 -> value2 catch C2:V2:S2 -> - S2 = erlang:get_stacktrace(), {caught2,S2} end, {caught1,S1,T2} diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index 70b7100451..a91d8399ff 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -121,7 +121,7 @@ pattern2(Config) when is_list(Config) -> Ts = [{pattern2, Source, [nowarn_unused_vars], - {warnings,[{2,sys_core_fold,{nomatch_shadow,1}}, + {warnings,[{2,sys_core_fold,{nomatch_shadow,1,{f,1}}}, {4,sys_core_fold,no_clause_match}, {5,sys_core_fold,nomatch_clause_type}, {6,sys_core_fold,nomatch_clause_type}]}}], @@ -786,7 +786,7 @@ latin1_fallback(Conf) when is_list(Conf) -> ">>, [], {warnings,[{1,compile,reparsing_invalid_unicode}, - {3,sys_core_fold,{nomatch_shadow,2}}]}}], + {3,sys_core_fold,{nomatch_shadow,2,{t,1}}}]}}], [] = run(Conf, Ts1), Ts2 = [{latin1_fallback2, |