diff options
Diffstat (limited to 'lib/compiler')
75 files changed, 4086 insertions, 934 deletions
diff --git a/lib/compiler/doc/src/book.xml b/lib/compiler/doc/src/book.xml index fc56a837d5..45b49fe46d 100644 --- a/lib/compiler/doc/src/book.xml +++ b/lib/compiler/doc/src/book.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE book SYSTEM "book.dtd"> <book xmlns:xi="http://www.w3.org/2001/XInclude"> <header titlestyle="normal"> <copyright> - <year>1997</year><year>2009</year> + <year>1997</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml index f1238f27a6..5fccdcdcb5 100644 --- a/lib/compiler/doc/src/compile.xml +++ b/lib/compiler/doc/src/compile.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE erlref SYSTEM "erlref.dtd"> <erlref> <header> <copyright> - <year>1996</year><year>2012</year> + <year>1996</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -350,12 +350,18 @@ module.beam: module.erl \ parsed code before the code is checked for errors.</p> </item> - <tag><c>asm</c></tag> + <tag><c>from_asm</c></tag> <item> <p>The input file is expected to be assembler code (default file suffix ".S"). Note that the format of assembler files - is not documented, and may change between releases - this - option is primarily for internal debugging use.</p> + is not documented, and may change between releases.</p> + </item> + + <tag><c>from_core</c></tag> + <item> + <p>The input file is expected to be core code (default + file suffix ".core"). Note that the format of core files + is not documented, and may change between releases.</p> </item> <tag><c>no_strict_record_tests</c></tag> @@ -402,6 +408,11 @@ module.beam: module.erl \ <code>-compile({no_auto_import,[error/1]}).</code> </item> + <tag><c>no_auto_import</c></tag> + <item> + <p>Do not auto import any functions from the module <c>erlang</c>.</p> + </item> + <tag><c>no_line_info</c></tag> <item> @@ -540,6 +551,14 @@ module.beam: module.erl \ <c>{Module,Name,Arity}</c> or a list of such tuples.</p> </item> + <tag><c>nowarn_deprecated_type</c></tag> + <item> + <p>Turns off warnings for uses of deprecated types. By + default (<c>warn_deprecated_type</c>), warnings are + emitted for every use of a type known by the compiler + to be deprecated.</p> + </item> + <tag><c>warn_obsolete_guard</c></tag> <item> <p>Causes warnings to be emitted for calls to old type diff --git a/lib/compiler/doc/src/fascicules.xml b/lib/compiler/doc/src/fascicules.xml index 43090b4aed..fadd37eefb 100644 --- a/lib/compiler/doc/src/fascicules.xml +++ b/lib/compiler/doc/src/fascicules.xml @@ -1,4 +1,4 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE fascicules SYSTEM "fascicules.dtd"> <fascicules> diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml index cb39b28d3d..84ebd2f210 100644 --- a/lib/compiler/doc/src/notes.xml +++ b/lib/compiler/doc/src/notes.xml @@ -31,6 +31,301 @@ <p>This document describes the changes made to the Compiler application.</p> +<section><title>Compiler 5.0.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Named funs with the same name and arity could get mixed + up with each other.</p> + <p> + Own Id: OTP-12262</p> + </item> + <item> + <p> + Coalesce map keys in dialyzer mode</p> + <p> + This fixes a regression introduced in commit + 805f9c89fc01220bc1bb0f27e1b68fd4eca688ba The problem + occurred with compounded map keys compiled with dialyzer + option turned on, '+dialyzer'.</p> + <p> + Reported by: Ivan Uemlianin</p> + <p> + Own Id: OTP-12347</p> + </item> + </list> + </section> + +</section> + +<section><title>Compiler 5.0.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Corrected a bug with incorrect code generation when + inlining was turned on.</p> + <p> + Own Id: OTP-12132</p> + </item> + </list> + </section> + +</section> + +<section><title>Compiler 5.0.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A Dialyzer crash involving analysis of Map types has now + been fixed.</p> + <p> + Own Id: OTP-11947</p> + </item> + <item> + <p>The compiler would fail to compile a file with a + latin-1 character in the false branch of an <c>-ifdef</c> + or <c>-indef</c>.</p> + <p> + Own Id: OTP-11987</p> + </item> + </list> + </section> + +</section> + +<section><title>Compiler 5.0</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Line numbers would not be correct when a binary + construction such as + '<c><<Bin/binary,...>></c>' fails. (Thanks to + Stanislav Seletskiy for reporting this bug.)</p> + <p> + Own Id: OTP-11572</p> + </item> + <item> + <p> + The compiler now properly annotates the code in value in + the '<c>after</c>' clause for a '<c>try</c>' so that + Dialyzer no longer generates a false warning for an + unmatched return.</p> + <p> + Own Id: OTP-11580</p> + </item> + <item> + <p> + Some case statements where no clause would match could + cause an internal error in the compiler. (Thanks to Erik + Soe Sorensen for reporting this bug.)</p> + <p> + Own Id: OTP-11610</p> + </item> + <item> + <p> + With <c>--Wunmatched_returns</c>, dialyzer will no longer + warn when the value of a list comprehension is ignored, + provided that the each value in the list would be an + atomic value (such as integer or atoms, as opposed to + tuples and lists). Example: ignoring '<c>[io:format(...) + || ...]</c>' will not cause a warning, while ignoring + '<c>[file:close(Fd) || ...]</c>' will.</p> + <p> + Own Id: OTP-11626</p> + </item> + <item> + <p> + Matching out a binary and applying the binary as if it + were a fun would crash the run-time system. (Thanks to + Loïc Hoguin.)</p> + <p> + Own Id: OTP-11672</p> + </item> + <item> + <p> + Some local implementations of removing the last element + from a list are replaced by <c>lists:droplast/1</c>. Note + that this requires at least <c>stdlib-2.0</c>, which is + the stdlib version delivered in OTP 17.0. (Thanks to Hans + Svensson)</p> + <p> + Own Id: OTP-11678</p> + </item> + <item> + <p> + Allow all auto imports to be suppressed at once. + Introducing the no_auto_import attribute: + -compile(no_auto_import). Useful for code generation + tools that always use the qualified function names and + want to avoid the auto imported functions clashing with + local ones. (Thanks to José Valim.)</p> + <p> + Own Id: OTP-11682</p> + </item> + <item> + <p> + Application upgrade (appup) files are corrected for the + following applications: </p> + <p> + <c>asn1, common_test, compiler, crypto, debugger, + dialyzer, edoc, eldap, erl_docgen, et, eunit, gs, hipe, + inets, observer, odbc, os_mon, otp_mibs, parsetools, + percept, public_key, reltool, runtime_tools, ssh, + syntax_tools, test_server, tools, typer, webtool, wx, + xmerl</c></p> + <p> + A new test utility for testing appup files is added to + test_server. This is now used by most applications in + OTP.</p> + <p> + (Thanks to Tobias Schlager)</p> + <p> + Own Id: OTP-11744</p> + </item> + <item> + <p> + Adapt 'asm' deprecation message to new version scheme. + (Thanks to Tuncer Ayaz)</p> + <p> + Own Id: OTP-11751</p> + </item> + <item> + <p> + A number of compiler errors where unusual or nonsensical + code would crash the compiler have been reported by Ulf + Norell and corrected by Anthony Ramine.</p> + <p> + Own Id: OTP-11770</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Compilation times for modules with a huge number for + record accesses using the dot operator has been improved.</p> + <p> + Own Id: OTP-10652</p> + </item> + <item> + <p> + The compiler can generate somewhat better code by moving + let expressions into sequences. (Thanks to Anthony + Ramine.)</p> + <p> + Own Id: OTP-11056</p> + </item> + <item> + <p> + Forbid unsized fields in patterns of binary generators + and simplified v3_core's translation of bit string + generators. (Thanks to Anthony Ramine.)</p> + <p> + Own Id: OTP-11186</p> + </item> + <item> + <p> + Funs can now be a given a name. Thanks to to Richard + O'Keefe for the idea (EEP37) and to Anthony Ramine for + the implementation.</p> + <p> + Own Id: OTP-11537</p> + </item> + <item> + <p> + Using the <c>from_asm</c> option to produce a BEAM file + starting from BEAM assembly code would often fail because + early optimization passes would not understand + instructions that later optimization passes would + introduce. (Thanks to Anthony Ramine.)</p> + <p> + Own Id: OTP-11544</p> + </item> + <item> + <p> + The <c>.core</c> and <c>.S</c> extensions are now + documented in the <c>erlc</c> documentation, and the + '<c>from_core</c>' and '<c>from_asm</c>' options are now + documented in the compiler documentation. (Thanks to + Tuncer Ayaz.)</p> + <p> + Own Id: OTP-11547</p> + </item> + <item> + <p>Optimization of case expressions that build tuples or + lists have been improved.</p> + <p> + Own Id: OTP-11584</p> + </item> + <item> + <p> + EEP43: New data type - Maps</p> + <p> + With Maps you may for instance: <taglist> <item><c>M0 = + #{ a => 1, b => 2}, % create + associations</c></item> <item><c>M1 = M0#{ a := 10 }, % + update values</c></item> <item><c>M2 = M1#{ "hi" => + "hello"}, % add new associations</c></item> <item><c>#{ + "hi" := V1, a := V2, b := V3} = M2. % match keys with + values</c></item> </taglist></p> + <p> + For information on how to use Maps please see Map Expressions in the + <seealso marker="doc/reference_manual:expressions#map_expressions"> + Reference Manual</seealso>.</p> + <p> + The current implementation is without the following + features: <taglist> <item>No variable keys</item> + <item>No single value access</item> <item>No map + comprehensions</item> </taglist></p> + <p> + Note that Maps is <em>experimental</em> during OTP 17.0.</p> + <p> + Own Id: OTP-11616</p> + </item> + <item> + <p> + Some function specs are corrected or moved and some edoc + comments are corrected in order to allow use of edoc. + (Thanks to Pierre Fenoll)</p> + <p> + Own Id: OTP-11702</p> + </item> + <item> + <p> + Thanks to Anthony Ramine for several improvements to the + optimizations in the BEAM compiler and for cleaning up + the code the code that transforms list and binary + comprehensions to Core Erlang.</p> + <p> + Own Id: OTP-11720</p> + </item> + <item> + <p> + The default encoding for Erlang source files is now + UTF-8. As a temporary measure to ease the transition from + the old default of latin-1, if the compiler encounters + byte sequences that are not valid UTF-8 sequences, the + compiler will re-try the compilation in latin-1 mode. + This workaround will be removed in a future release.</p> + <p> + Own Id: OTP-11791</p> + </item> + </list> + </section> + +</section> + <section><title>Compiler 4.9.4</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/compiler/doc/src/notes_history.xml b/lib/compiler/doc/src/notes_history.xml index db0dc2f683..9e8934f416 100644 --- a/lib/compiler/doc/src/notes_history.xml +++ b/lib/compiler/doc/src/notes_history.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE chapter SYSTEM "chapter.dtd"> <chapter> <header> <copyright> - <year>2006</year><year>2009</year> + <year>2006</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/compiler/doc/src/part_notes.xml b/lib/compiler/doc/src/part_notes.xml index e730e3f7e2..0c1fdd567d 100644 --- a/lib/compiler/doc/src/part_notes.xml +++ b/lib/compiler/doc/src/part_notes.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE part SYSTEM "part.dtd"> <part xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>2004</year><year>2009</year> + <year>2004</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/compiler/doc/src/part_notes_history.xml b/lib/compiler/doc/src/part_notes_history.xml index 12366f0006..a4909f156e 100644 --- a/lib/compiler/doc/src/part_notes_history.xml +++ b/lib/compiler/doc/src/part_notes_history.xml @@ -1,11 +1,11 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE part SYSTEM "part.dtd"> <part> <header> <copyright> <year>2006</year> - <year>2011</year> + <year>2013</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> diff --git a/lib/compiler/doc/src/ref_man.xml b/lib/compiler/doc/src/ref_man.xml index 74fe45aa77..6478ad4b11 100644 --- a/lib/compiler/doc/src/ref_man.xml +++ b/lib/compiler/doc/src/ref_man.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE application SYSTEM "application.dtd"> <application xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>1996</year><year>2009</year> + <year>1996</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index c590c5e35b..fe4f473846 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -88,6 +88,12 @@ rename_instr({bs_private_append=I,F,Sz,U,Src,Flags,Dst}) -> {bs_init,F,{I,U,Flags},none,[Sz,Src],Dst}; rename_instr(bs_init_writable=I) -> {bs_init,{f,0},I,1,[{x,0}],{x,0}}; +rename_instr({put_map_assoc,Fail,S,D,R,L}) -> + {put_map,Fail,assoc,S,D,R,L}; +rename_instr({put_map_exact,Fail,S,D,R,L}) -> + {put_map,Fail,exact,S,D,R,L}; +rename_instr({test,has_map_fields,Fail,Src,{list,List}}) -> + {test,has_map_fields,Fail,[Src|List]}; rename_instr({select_val=I,Reg,Fail,{list,List}}) -> {select,I,Reg,Fail,List}; rename_instr({select_tuple_arity=I,Reg,Fail,{list,List}}) -> diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index 112b087f3c..f8cf178d2e 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -324,6 +324,8 @@ make_op({gc_bif,Bif,Fail,Live,Args,Dest}, Dict) -> encode_op(BifOp, [Fail,Live,{extfunc,erlang,Bif,Arity}|Args++[Dest]],Dict); make_op({bs_add=Op,Fail,[Src1,Src2,Unit],Dest}, Dict) -> encode_op(Op, [Fail,Src1,Src2,Unit,Dest], Dict); +make_op({test,Cond,Fail,Src,{list,_}=Ops}, Dict) -> + encode_op(Cond, [Fail,Src,Ops], Dict); make_op({test,Cond,Fail,Ops}, Dict) when is_list(Ops) -> encode_op(Cond, [Fail|Ops], Dict); make_op({test,Cond,Fail,Live,[Op|Ops],Dst}, Dict) when is_list(Ops) -> diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index cf5244e1ce..7a30c68593 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -123,15 +123,24 @@ is_last_bool([], _) -> false. collect_block(Is) -> collect_block(Is, []). +collect_block([{allocate,N,R}|Is0], Acc) -> + {Inits,Is} = lists:splitwith(fun ({init,{y,_}}) -> true; + (_) -> false + end, Is0), + collect_block(Is, [{set,[],[],{alloc,R,{nozero,N,0,Inits}}}|Acc]); collect_block([{allocate_zero,Ns,R},{test_heap,Nh,R}|Is], Acc) -> - collect_block(Is, [{set,[],[],{alloc,R,{no_opt,Ns,Nh,[]}}}|Acc]); + collect_block(Is, [{set,[],[],{alloc,R,{zero,Ns,Nh,[]}}}|Acc]); collect_block([I|Is]=Is0, Acc) -> case collect(I) of error -> {reverse(Acc),Is0}; Instr -> collect_block(Is, [Instr|Acc]) end. +collect({allocate,N,R}) -> {set,[],[],{alloc,R,{nozero,N,0,[]}}}; collect({allocate_zero,N,R}) -> {set,[],[],{alloc,R,{zero,N,0,[]}}}; +collect({allocate_heap,Ns,Nh,R}) -> {set,[],[],{alloc,R,{nozero,Ns,Nh,[]}}}; +collect({allocate_heap_zero,Ns,Nh,R}) -> {set,[],[],{alloc,R,{zero,Ns,Nh,[]}}}; +collect({init,D}) -> {set,[D],[],init}; collect({test_heap,N,R}) -> {set,[],[],{alloc,R,{nozero,nostack,N,[]}}}; collect({bif,N,F,As,D}) -> {set,[D],As,{bif,N,F}}; collect({gc_bif,N,F,R,As,D}) -> {set,[D],As,{alloc,R,{gc_bif,N,F}}}; @@ -143,7 +152,15 @@ collect({get_tuple_element,S,I,D}) -> {set,[D],[S],{get_tuple_element,I}}; collect({set_tuple_element,S,D,I}) -> {set,[],[S,D],{set_tuple_element,I}}; collect({get_list,S,D1,D2}) -> {set,[D1,D2],[S],get_list}; collect(remove_message) -> {set,[],[],remove_message}; +collect({put_map,F,Op,S,D,R,{list,Puts}}) -> + {set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}}; +collect({get_map_elements,F,S,{list,Gets}}) -> + {set,Gets,[S],{get_map_elements,F}}; collect({'catch',R,L}) -> {set,[R],[],{'catch',L}}; +collect(fclearerror) -> {set,[],[],fclearerror}; +collect({fcheckerror,{f,0}}) -> {set,[],[],fcheckerror}; +collect({fmove,S,D}) -> {set,[D],[S],fmove}; +collect({fconv,S,D}) -> {set,[D],[S],fconv}; collect(_) -> error. %% embed_lines([Instruction]) -> [Instruction] @@ -223,6 +240,7 @@ move_allocates_2(Alloc, [], Acc) -> alloc_may_pass({set,_,_,{alloc,_,_}}) -> false; alloc_may_pass({set,_,_,{set_tuple_element,_}}) -> false; +alloc_may_pass({set,_,_,{get_map_elements,_}}) -> false; alloc_may_pass({set,_,_,put_list}) -> false; alloc_may_pass({set,_,_,put}) -> false; alloc_may_pass({set,_,_,_}) -> true. @@ -273,7 +291,11 @@ opt_moves([X0,Y0], Is0) -> not_possible -> {[X,Y0],Is2}; {X,_} -> {[X,Y0],Is2}; {Y,Is} -> {[X,Y],Is} - end. + end; +opt_moves(Ds, Is) -> + %% multiple destinations -> pass through + {Ds,Is}. + %% opt_move(Dest, [Instruction]) -> {UpdatedDest,[Instruction]} | not_possible %% If there is a {move,Dest,FinalDest} instruction @@ -370,6 +392,7 @@ gen_init(Fs, Regs, Y, Acc) -> init_yreg([{set,_,_,{bif,_,_}}|_], Reg) -> Reg; init_yreg([{set,_,_,{alloc,_,{gc_bif,_,_}}}|_], Reg) -> Reg; +init_yreg([{set,_,_,{alloc,_,{put_map,_,_}}}|_], Reg) -> Reg; init_yreg([{set,Ds,_,_}|Is], Reg) -> init_yreg(Is, add_yregs(Ds, Reg)); init_yreg(_Is, Reg) -> Reg. diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index 124abd13c1..a452d30b61 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -126,44 +126,53 @@ bopt_block(Reg, Fail, OldIs, [{block,Bl0}|Acc0], St0) -> %% There was a reference to a boolean expression %% from inside a protected block (try/catch), to %% a boolean expression outside. - throw:protected_barrier -> + throw:protected_barrier -> failed; - %% The 'xor' operator was used. We currently don't - %% find it worthwile to translate 'xor' operators - %% (the code would be clumsy). - throw:'xor' -> + %% The 'xor' operator was used. We currently don't + %% find it worthwile to translate 'xor' operators + %% (the code would be clumsy). + throw:'xor' -> failed; - %% The block does not contain a boolean expression, - %% but only a call to a guard BIF. - %% For instance: ... when element(1, T) -> - throw:not_boolean_expr -> + %% The block does not contain a boolean expression, + %% but only a call to a guard BIF. + %% For instance: ... when element(1, T) -> + throw:not_boolean_expr -> failed; - %% The block contains a 'move' instruction that could - %% not be handled. - throw:move -> + %% The block contains a 'move' instruction that could + %% not be handled. + throw:move -> failed; - %% The optimization is not safe. (A register - %% used by the instructions following the - %% optimized code is either not assigned a - %% value at all or assigned a different value.) - throw:all_registers_not_killed -> + %% The optimization is not safe. (A register + %% used by the instructions following the + %% optimized code is either not assigned a + %% value at all or assigned a different value.) + throw:all_registers_not_killed -> failed; - throw:registers_used -> + throw:registers_used -> failed; - %% A protected block refered to the value - %% returned by another protected block, - %% probably because the Core Erlang code - %% used nested try/catches in the guard. - %% (v3_core never produces nested try/catches - %% in guards, so it must have been another - %% Core Erlang translator.) - throw:protected_violation -> + %% A protected block refered to the value + %% returned by another protected block, + %% probably because the Core Erlang code + %% used nested try/catches in the guard. + %% (v3_core never produces nested try/catches + %% in guards, so it must have been another + %% Core Erlang translator.) + throw:protected_violation -> + failed; + + %% Failed to work out the live registers for a GC + %% BIF. For example, if the number of live registers + %% needed to be 4 because {x,3} was a source register, + %% but {x,2} was not known to be initialized, this + %% exception would be thrown. + throw:gc_bif_alloc_failure -> failed + end end. @@ -318,6 +327,8 @@ split_block_label_used([{set,[_],_,{bif,_,{f,Fail}}}|_], Fail) -> true; split_block_label_used([{set,[_],_,{alloc,_,{gc_bif,_,{f,Fail}}}}|_], Fail) -> true; +split_block_label_used([{set,[_],_,{alloc,_,{put_map,_,{f,Fail}}}}|_], Fail) -> + true; split_block_label_used([_|Is], Fail) -> split_block_label_used(Is, Fail); split_block_label_used([], _) -> false. @@ -391,10 +402,14 @@ bopt_tree([{set,_,_,{bif,'xor',_}}|_], _, _) -> throw('xor'); bopt_tree([{protected,[Dst],Code,_}|Is], Forest0, Pre) -> ProtForest0 = gb_trees:from_orddict([P || {_,any}=P <- gb_trees:to_list(Forest0)]), - {ProtPre,[{_,ProtTree}]} = bopt_tree(Code, ProtForest0, []), - Prot = {prot,ProtPre,ProtTree}, - Forest = gb_trees:enter(Dst, Prot, Forest0), - bopt_tree(Is, Forest, Pre); + case bopt_tree(Code, ProtForest0, []) of + {ProtPre,[{_,ProtTree}]} -> + Prot = {prot,ProtPre,ProtTree}, + Forest = gb_trees:enter(Dst, Prot, Forest0), + bopt_tree(Is, Forest, Pre); + _Res -> + throw(not_boolean_expr) + end; bopt_tree([{set,[Dst],[Src],move}=Move|Is], Forest, Pre) -> case {Src,Dst} of {{tmp,_},_} -> throw(move); @@ -432,9 +447,10 @@ bopt_bool_args(As, Forest) -> mapfoldl(fun bopt_bool_arg/2, Forest, As). bopt_bool_arg({T,_}=R, Forest) when T =:= x; T =:= y; T =:= tmp -> - Val = case gb_trees:get(R, Forest) of - any -> {test,is_eq_exact,fail,[R,{atom,true}]}; - Val0 -> Val0 + Val = case gb_trees:lookup(R, Forest) of + {value,any} -> {test,is_eq_exact,fail,[R,{atom,true}]}; + {value,Val0} -> Val0; + none -> throw(mixed) end, {Val,gb_trees:delete(R, Forest)}; bopt_bool_arg(Term, Forest) -> @@ -525,7 +541,9 @@ bopt_cg({prot,Pre0,Tree}, Fail, Rs0, Acc, St0) -> bopt_cg({atom,true}, _Fail, _Rs, Acc, St) -> {Acc,St}; bopt_cg({atom,false}, Fail, _Rs, Acc, St) -> - {[{jump,{f,Fail}}|Acc],St}. + {[{jump,{f,Fail}}|Acc],St}; +bopt_cg(_, _, _, _, _) -> + throw(not_boolean_expr). bopt_cg_not({'and',As0}) -> As = [bopt_cg_not(A) || A <- As0], @@ -538,7 +556,9 @@ bopt_cg_not({'not',Arg}) -> bopt_cg_not({test,Test,Fail,As}) -> {inverted_test,Test,Fail,As}; bopt_cg_not({atom,Bool}) when is_boolean(Bool) -> - {atom,not Bool}. + {atom,not Bool}; +bopt_cg_not(_) -> + throw(not_boolean_expr). bopt_cg_not_not({'and',As}) -> {'and',[bopt_cg_not_not(A) || A <- As]}; @@ -654,10 +674,16 @@ put_reg_1(V, [], I) -> [{I,V}]. fetch_reg(V, [{I,V}|_]) -> {x,I}; fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs). -live_regs(Regs) -> - foldl(fun ({I,_}, _) -> - I - end, -1, Regs)+1. +live_regs([{_,reserved}|_]) -> + %% We are not sure that this register is initialized, so we must + %% abort the optimization. + throw(gc_bif_alloc_failure); +live_regs([{I,_}]) -> + I+1; +live_regs([{_,_}|Regs]) -> + live_regs(Regs); +live_regs([]) -> + 0. %%% diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index fdfcb08125..d54c2a9fde 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -209,6 +209,7 @@ btb_reaches_match_2([{call,Arity,{f,Lbl}}|Is], Regs, D) -> btb_reaches_match_2([{apply,Arity}|Is], Regs, D) -> btb_call(Arity+2, apply, Regs, Is, D); btb_reaches_match_2([{call_fun,Live}=I|Is], Regs, D) -> + btb_ensure_not_used([{x,Live}], I, Regs), btb_call(Live, I, Regs, Is, D); btb_reaches_match_2([{make_fun2,_,_,_,Live}|Is], Regs, D) -> btb_call(Live, make_fun2, Regs, Is, D); diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index 9d89e21a4e..b653998252 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -234,6 +234,36 @@ replace([{bs_init,{f,Lbl},Info,Live,Ss,Dst}|Is], Acc, D) when Lbl =/= 0 -> replace(Is, [{bs_init,{f,label(Lbl, D)},Info,Live,Ss,Dst}|Acc], D); replace([{bs_put,{f,Lbl},Info,Ss}|Is], Acc, D) when Lbl =/= 0 -> replace(Is, [{bs_put,{f,label(Lbl, D)},Info,Ss}|Acc], D); +replace([{bs_init2,{f,Lbl},Sz,Words,R,F,Dst}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{bs_init2,{f,label(Lbl, D)},Sz,Words,R,F,Dst}|Acc], D); +replace([{bs_init_bits,{f,Lbl},Sz,Words,R,F,Dst}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{bs_init_bits,{f,label(Lbl, D)},Sz,Words,R,F,Dst}|Acc], D); +replace([{bs_put_integer,{f,Lbl},Bits,Unit,Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{bs_put_integer,{f,label(Lbl, D)},Bits,Unit,Fl,Val}|Acc], D); +replace([{bs_put_utf8=I,{f,Lbl},Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{I,{f,label(Lbl, D)},Fl,Val}|Acc], D); +replace([{bs_put_utf16=I,{f,Lbl},Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{I,{f,label(Lbl, D)},Fl,Val}|Acc], D); +replace([{bs_put_utf32=I,{f,Lbl},Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{I,{f,label(Lbl, D)},Fl,Val}|Acc], D); +replace([{bs_put_binary,{f,Lbl},Bits,Unit,Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{bs_put_binary,{f,label(Lbl, D)},Bits,Unit,Fl,Val}|Acc], D); +replace([{bs_put_float,{f,Lbl},Bits,Unit,Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{bs_put_float,{f,label(Lbl, D)},Bits,Unit,Fl,Val}|Acc], D); +replace([{bs_add,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{bs_add,{f,label(Lbl, D)},Src,Dst}|Acc], D); +replace([{bs_append,{f,Lbl},_,_,_,_,_,_,_}=I0|Is], Acc, D) when Lbl =/= 0 -> + I = setelement(2, I0, {f,label(Lbl, D)}), + replace(Is, [I|Acc], D); +replace([{bs_utf8_size=I,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{I,{f,label(Lbl, D)},Src,Dst}|Acc], D); +replace([{bs_utf16_size=I,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{I,{f,label(Lbl, D)},Src,Dst}|Acc], D); +replace([{put_map=I,{f,Lbl},Op,Src,Dst,Live,List}|Is], Acc, D) + when Lbl =/= 0 -> + replace(Is, [{I,{f,label(Lbl, D)},Op,Src,Dst,Live,List}|Acc], D); +replace([{get_map_elements=I,{f,Lbl},Src,List}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{I,{f,label(Lbl, D)},Src,List}|Acc], D); replace([I|Is], Acc, D) -> replace(Is, [I|Acc], D); replace([], Acc, _) -> Acc. diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index 212b9fb03a..ea51673fa3 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -29,16 +29,24 @@ -type label() :: non_neg_integer(). +-type index() :: non_neg_integer(). + +-type atom_tab() :: gb_trees:tree(atom(), index()). +-type import_tab() :: gb_trees:tree(mfa(), index()). +-type fname_tab() :: gb_trees:tree(Name :: term(), index()). +-type line_tab() :: gb_trees:tree({Fname :: index(), Line :: term()}, index()). +-type literal_tab() :: dict:dict(Literal :: term(), index()). + -record(asm, - {atoms = gb_trees:empty() :: gb_tree(), %{Atom,Index} + {atoms = gb_trees:empty() :: atom_tab(), exports = [] :: [{label(), arity(), label()}], locals = [] :: [{label(), arity(), label()}], - imports = gb_trees:empty() :: gb_tree(), %{{M,F,A},Index} + imports = gb_trees:empty() :: import_tab(), strings = <<>> :: binary(), %String pool lambdas = [], %[{...}] - literals = dict:new() :: dict(), %Format: {Literal,Number} - fnames = gb_trees:empty() :: gb_tree(), %{Name,Index} - lines = gb_trees:empty() :: gb_tree(), %{{Fname,Line},Index} + literals = dict:new() :: literal_tab(), + fnames = gb_trees:empty() :: fname_tab(), + lines = gb_trees:empty() :: line_tab(), num_lines = 0 :: non_neg_integer(), %Number of line instructions next_import = 0 :: non_neg_integer(), string_offset = 0 :: non_neg_integer(), diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index 1a8bbcee22..c45596f236 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2013. All Rights Reserved. +%% Copyright Ericsson AB 2000-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -37,7 +37,8 @@ %%----------------------------------------------------------------------- --type literals() :: 'none' | gb_tree(). +-type index() :: non_neg_integer(). +-type literals() :: 'none' | gb_trees:tree(index(), term()). -type symbolic_tag() :: 'a' | 'f' | 'h' | 'i' | 'u' | 'x' | 'y' | 'z'. -type disasm_tag() :: symbolic_tag() | 'fr' | 'atom' | 'float' | 'literal'. -type disasm_term() :: 'nil' | {disasm_tag(), _}. @@ -216,7 +217,8 @@ optional_chunk(F, ChunkTag) -> %%----------------------------------------------------------------------- -type l_info() :: {non_neg_integer(), {_,_,_,_,_,_}}. --spec beam_disasm_lambdas('none' | binary(), gb_tree()) -> 'none' | [l_info()]. +-spec beam_disasm_lambdas('none' | binary(), gb_trees:tree(index(), _)) -> + 'none' | [l_info()]. beam_disasm_lambdas(none, _) -> none; beam_disasm_lambdas(<<_:32,Tab/binary>>, Atoms) -> @@ -365,6 +367,14 @@ disasm_instr(B, Bs, Atoms, Literals) -> disasm_select_inst(select_val, Bs, Atoms, Literals); select_tuple_arity -> disasm_select_inst(select_tuple_arity, Bs, Atoms, Literals); + put_map_assoc -> + disasm_map_inst(put_map_assoc, Arity, Bs, Atoms, Literals); + put_map_exact -> + disasm_map_inst(put_map_exact, Arity, Bs, Atoms, Literals); + get_map_elements -> + disasm_map_inst(get_map_elements, Arity, Bs, Atoms, Literals); + has_map_fields -> + disasm_map_inst(has_map_fields, Arity, Bs, Atoms, Literals); _ -> try decode_n_args(Arity, Bs, Atoms, Literals) of {Args, RestBs} -> @@ -395,6 +405,16 @@ disasm_select_inst(Inst, Bs, Atoms, Literals) -> {List, RestBs} = decode_n_args(Len, Bs4, Atoms, Literals), {{Inst, [X,F,{Z,U,List}]}, RestBs}. +disasm_map_inst(Inst, Arity, Bs0, Atoms, Literals) -> + {Args0,Bs1} = decode_n_args(Arity, Bs0, Atoms, Literals), + %% no droplast .. + [Z|Args1] = lists:reverse(Args0), + Args = lists:reverse(Args1), + {U, Bs2} = decode_arg(Bs1, Atoms, Literals), + {u, Len} = U, + {List, RestBs} = decode_n_args(Len, Bs2, Atoms, Literals), + {{Inst, Args ++ [{Z,U,List}]}, RestBs}. + %%----------------------------------------------------------------------- %% decode_arg([Byte]) -> {Arg, [Byte]} %% @@ -417,11 +437,12 @@ decode_arg([B|Bs]) -> decode_int(Tag, B, Bs) end. --spec decode_arg([byte(),...], gb_tree(), literals()) -> {disasm_term(), [byte()]}. +-spec decode_arg([byte(),...], gb_trees:tree(index(), _), literals()) -> + {disasm_term(), [byte()]}. decode_arg([B|Bs0], Atoms, Literals) -> Tag = decode_tag(B band 2#111), - ?NO_DEBUG('Tag = ~p, B = ~p, Bs = ~p~n', [Tag, B, Bs]), + ?NO_DEBUG('Tag = ~p, B = ~p, Bs = ~p~n', [Tag, B, Bs0]), case Tag of z -> decode_z_tagged(Tag, B, Bs0, Literals); @@ -1009,6 +1030,7 @@ resolve_inst({gc_bif2,Args},Imports,_,_) -> [F,Live,Bif,A1,A2,Reg] = resolve_args(Args), {extfunc,_Mod,BifName,_Arity} = lookup(Bif+1,Imports), {gc_bif,BifName,F,Live,[A1,A2],Reg}; + %% %% New instruction in R14, gc_bif with 3 arguments %% @@ -1119,6 +1141,29 @@ resolve_inst({line,[Index]},_,_,_) -> {line,resolve_arg(Index)}; %% +%% 17.0 +%% +resolve_inst({put_map_assoc,Args},_,_,_) -> + [FLbl,Src,Dst,{u,N},{{z,1},{u,_Len},List0}] = Args, + List = resolve_args(List0), + {put_map_assoc,FLbl,Src,Dst,N,{list,List}}; +resolve_inst({put_map_exact,Args},_,_,_) -> + [FLbl,Src,Dst,{u,N},{{z,1},{u,_Len},List0}] = Args, + List = resolve_args(List0), + {put_map_exact,FLbl,Src,Dst,N,{list,List}}; +resolve_inst({is_map=I,Args0},_,_,_) -> + [FLbl|Args] = resolve_args(Args0), + {test,I,FLbl,Args}; +resolve_inst({has_map_fields,Args0},_,_,_) -> + [FLbl,Src,{{z,1},{u,_Len},List0}] = Args0, + List = resolve_args(List0), + {test,has_map_fields,FLbl,Src,{list,List}}; +resolve_inst({get_map_elements,Args0},_,_,_) -> + [FLbl,Src,{{z,1},{u,_Len},List0}] = Args0, + List = resolve_args(List0), + {get_map_elements,FLbl,Src,{list,List}}; + +%% %% 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 index e5ec1bd904..d261809765 100644 --- a/lib/compiler/src/beam_except.erl +++ b/lib/compiler/src/beam_except.erl @@ -131,9 +131,13 @@ translate_exception(_, _, _, _) -> no. fix_block(Is, 0) -> reverse(Is); -fix_block(Is0, Words) -> - [{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is] = reverse(Is0), - [{set,[],[],{alloc,Live,{F1,F2,Needed-Words,F3}}}|Is]. +fix_block(Is, Words) -> + fix_block_1(reverse(Is), Words). + +fix_block_1([{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is], Words) -> + [{set,[],[],{alloc,Live,{F1,F2,Needed-Words,F3}}}|Is]; +fix_block_1([I|Is], Words) -> + [I|fix_block_1(Is, Words)]. dig_out_block_fc([{set,[],[],{alloc,Live,_}}|Bl]) -> case dig_out_fc(Bl, Live-1, nil) of diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl index 25428c0c10..46835bece1 100644 --- a/lib/compiler/src/beam_flatten.erl +++ b/lib/compiler/src/beam_flatten.erl @@ -51,6 +51,7 @@ norm_block([], Acc) -> Acc. norm({set,[D],As,{bif,N,F}}) -> {bif,N,F,As,D}; norm({set,[D],As,{alloc,R,{gc_bif,N,F}}}) -> {gc_bif,N,F,R,As,D}; +norm({set,[D],[],init}) -> {init,D}; norm({set,[D],[S],move}) -> {move,S,D}; norm({set,[D],[S],fmove}) -> {fmove,S,D}; norm({set,[D],[S],fconv}) -> {fconv,S,D}; @@ -60,6 +61,10 @@ norm({set,[],[S],put}) -> {put,S}; norm({set,[D],[S],{get_tuple_element,I}}) -> {get_tuple_element,S,I,D}; norm({set,[],[S,D],{set_tuple_element,I}}) -> {set_tuple_element,S,D,I}; norm({set,[D1,D2],[S],get_list}) -> {get_list,S,D1,D2}; +norm({set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}}) -> + {put_map,F,Op,S,D,R,{list,Puts}}; +norm({set,Gets,[S],{get_map_elements,F}}) -> + {get_map_elements,F,S,{list,Gets}}; norm({set,[],[],remove_message}) -> remove_message; norm({set,[],[],fclearerror}) -> fclearerror; norm({set,[],[],fcheckerror}) -> {fcheckerror,{f,0}}. diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index b29a3565e4..b952139f2c 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -202,19 +202,19 @@ is_label(_) -> false. move(Is) -> move_1(Is, [], []). -move_1([I|Is], End0, Acc0) -> +move_1([I|Is], Ends, Acc0) -> case is_exit_instruction(I) of false -> - move_1(Is, End0, [I|Acc0]); + move_1(Is, Ends, [I|Acc0]); true -> - case extract_seq(Acc0, [I|End0]) of + case extract_seq(Acc0, [I]) of no -> - move_1(Is, End0, [I|Acc0]); + move_1(Is, Ends, [I|Acc0]); {yes,End,Acc} -> - move_1(Is, End, Acc) + move_1(Is, [End|Ends], Acc) end end; -move_1([], End, Acc) -> reverse(Acc, End). +move_1([], Ends, Acc) -> reverse(Acc, lists:append(reverse(Ends))). extract_seq([{line,_}=Line|Is], Acc) -> extract_seq(Is, [Line|Acc]); @@ -446,11 +446,13 @@ is_label_used_in_2({set,_,_,Info}, Lbl) -> case Info of {bif,_,{f,F}} -> F =:= Lbl; {alloc,_,{gc_bif,_,{f,F}}} -> F =:= Lbl; + {alloc,_,{put_map,_,{f,F}}} -> F =:= Lbl; {'catch',{f,F}} -> F =:= Lbl; {alloc,_,_} -> false; {put_tuple,_} -> false; {get_tuple_element,_} -> false; {set_tuple_element,_} -> false; + {get_map_elements,{f,F}} -> F =:= Lbl; {line,_} -> false; _ when is_atom(Info) -> false end. @@ -527,6 +529,10 @@ ulbl({bs_init,Lbl,_,_,_,_}, Used) -> mark_used(Lbl, Used); ulbl({bs_put,Lbl,_,_}, Used) -> mark_used(Lbl, Used); +ulbl({put_map,Lbl,_Op,_Src,_Dst,_Live,_List}, Used) -> + mark_used(Lbl, Used); +ulbl({get_map_elements,Lbl,_Src,_List}, Used) -> + mark_used(Lbl, Used); ulbl(_, Used) -> Used. mark_used({f,0}, Used) -> Used; diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl index cacaaebffe..688bba9a94 100644 --- a/lib/compiler/src/beam_split.erl +++ b/lib/compiler/src/beam_split.erl @@ -49,6 +49,13 @@ split_block([{set,[R],As,{bif,N,{f,Lbl}=Fail}}|Is], Bl, Acc) when Lbl =/= 0 -> split_block([{set,[R],As,{alloc,Live,{gc_bif,N,{f,Lbl}=Fail}}}|Is], Bl, Acc) when Lbl =/= 0 -> split_block(Is, [], [{gc_bif,N,Fail,Live,As,R}|make_block(Bl, Acc)]); +split_block([{set,[D],[S|Puts],{alloc,R,{put_map,Op,{f,Lbl}=Fail}}}|Is], + Bl, Acc) when Lbl =/= 0 -> + split_block(Is, [], [{put_map,Fail,Op,S,D,R,{list,Puts}}| + make_block(Bl, Acc)]); +split_block([{set,Gets,[S],{get_map_elements,{f,Lbl}=Fail}}|Is], Bl, Acc) + when Lbl =/= 0 -> + split_block(Is, [], [{get_map_elements,Fail,S,{list,Gets}}|make_block(Bl, Acc)]); split_block([{set,[R],[],{'catch',L}}|Is], Bl, Acc) -> split_block(Is, [], [{'catch',R,L}|make_block(Bl, Acc)]); split_block([{set,[],[],{line,_}=Line}|Is], Bl, Acc) -> diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 3ec57a67da..58c0f765ae 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -142,6 +142,12 @@ simplify_float(Is0, Ts0) -> throw:not_possible -> not_possible end. +simplify_float_1([{set,[],[],fclearerror}|Is], Ts, Rs, Acc) -> + simplify_float_1(Is, Ts, Rs, clearerror(Acc)); +simplify_float_1([{set,[],[],fcheckerror}|Is], Ts, Rs, Acc) -> + simplify_float_1(Is, Ts, Rs, checkerror(Acc)); +simplify_float_1([{set,[{fr,_}],_,_}=I|Is], Ts, Rs, Acc) -> + simplify_float_1(Is, Ts, Rs, [I|Acc]); simplify_float_1([{set,[D0],[A0],{alloc,_,{gc_bif,'-',{f,0}}}}=I|Is]=Is0, Ts0, Rs0, Acc0) -> case tdb_find(A0, Ts0) of diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index e9911fefd9..8ca368c167 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -152,6 +152,7 @@ bif_to_test(is_function, [_]=Ops, Fail) -> {test,is_function,Fail,Ops}; bif_to_test(is_function, [_,_]=Ops, Fail) -> {test,is_function2,Fail,Ops}; bif_to_test(is_integer, [_]=Ops, Fail) -> {test,is_integer,Fail,Ops}; bif_to_test(is_list, [_]=Ops, Fail) -> {test,is_list,Fail,Ops}; +bif_to_test(is_map, [_]=Ops, Fail) -> {test,is_map,Fail,Ops}; bif_to_test(is_number, [_]=Ops, Fail) -> {test,is_number,Fail,Ops}; bif_to_test(is_pid, [_]=Ops, Fail) -> {test,is_pid,Fail,Ops}; bif_to_test(is_port, [_]=Ops, Fail) -> {test,is_port,Fail,Ops}; @@ -184,6 +185,7 @@ is_pure_test({test,is_lt,_,[_,_]}) -> true; is_pure_test({test,is_nil,_,[_]}) -> true; is_pure_test({test,is_nonempty_list,_,[_]}) -> true; is_pure_test({test,test_arity,_,[_,_]}) -> true; +is_pure_test({test,has_map_fields,_,[_,{list,_}]}) -> true; is_pure_test({test,Op,_,Ops}) -> erl_internal:new_type_test(Op, length(Ops)). @@ -746,6 +748,8 @@ live_opt([{try_end,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{loop_rec_end,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); +live_opt([{wait_timeout,_,nil}=I|Is], Regs, D, Acc) -> + live_opt(Is, Regs, D, [I|Acc]); live_opt([{wait_timeout,_,{Tag,_}}=I|Is], Regs, D, Acc) when Tag =/= x -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{line,_}=I|Is], Regs, D, Acc) -> @@ -759,6 +763,12 @@ live_opt([{allocate,_,Live}=I|Is], _, D, Acc) -> live_opt(Is, live_call(Live), D, [I|Acc]); live_opt([{allocate_heap,_,_,Live}=I|Is], _, D, Acc) -> live_opt(Is, live_call(Live), D, [I|Acc]); +live_opt([{'%',_}=I|Is], Regs, D, Acc) -> + live_opt(Is, Regs, D, [I|Acc]); +live_opt([{recv_set,_}=I|Is], Regs, D, Acc) -> + live_opt(Is, Regs, D, [I|Acc]); +live_opt([{recv_mark,_}=I|Is], Regs, D, Acc) -> + live_opt(Is, Regs, D, [I|Acc]); live_opt([], _, _, Acc) -> Acc. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 48f5135aca..9d5563d13b 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -213,9 +213,12 @@ validate_error_1(Error, Module, Name, Ar) -> {{Module,Name,Ar}, {internal_error,'_',{Error,erlang:get_stacktrace()}}}. +-type index() :: non_neg_integer(). +-type reg_tab() :: gb_trees:tree(index(), 'none' | {'value', _}). + -record(st, %Emulation state - {x=init_regs(0, term) :: gb_tree(), %x register info. - y=init_regs(0, initialized) :: gb_tree(), %y register info. + {x=init_regs(0, term) :: reg_tab(),%x register info. + y=init_regs(0, initialized) :: reg_tab(),%y register info. f=init_fregs(), % numy=none, %Number of y registers. h=0, %Available heap size. @@ -227,11 +230,16 @@ validate_error_1(Error, Module, Name, Ar) -> setelem=false %Previous instruction was setelement/3. }). +-type label() :: integer(). +-type label_set() :: gb_sets:set(label()). +-type branched_tab() :: gb_trees:tree(label(), #st{}). +-type ft_tab() :: gb_trees:tree(). + -record(vst, %Validator state {current=none :: #st{} | 'none', %Current state - branched=gb_trees:empty() :: gb_tree(), %States at jumps - labels=gb_sets:empty() :: gb_set(), %All defined labels - ft=gb_trees:empty() :: gb_tree() %Some other functions + branched=gb_trees:empty() :: branched_tab(), %States at jumps + labels=gb_sets:empty() :: label_set(), %All defined labels + ft=gb_trees:empty() :: ft_tab() %Some other functions % in the module (those that start with bs_start_match2). }). @@ -574,6 +582,7 @@ valfun_4({apply,Live}, 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); @@ -769,6 +778,10 @@ valfun_4({test,is_nonempty_list,{f,Lbl},[Cons]}, Vst) -> valfun_4({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) -> assert_type(tuple, Tuple, Vst), set_type_reg({tuple,Sz}, Tuple, branch_state(Lbl, Vst)); +valfun_4({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) -> + validate_src([Src], Vst), + assert_strict_literal_termorder(List), + branch_state(Lbl, Vst); valfun_4({test,_Op,{f,Lbl},Src}, Vst) -> validate_src(Src, Vst), branch_state(Lbl, Vst); @@ -865,9 +878,38 @@ valfun_4({bs_final,{f,Fail},Dst}, Vst0) -> valfun_4({bs_final2,Src,Dst}, Vst0) -> assert_term(Src, Vst0), set_type_reg(binary, Dst, Vst0); +%% Map instructions. +valfun_4({put_map_assoc,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> + verify_put_map(Fail, Src, Dst, Live, List, Vst); +valfun_4({put_map_exact,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> + verify_put_map(Fail, Src, Dst, Live, List, Vst); +valfun_4({get_map_elements,{f,Fail},Src,{list,List}}, Vst) -> + verify_get_map(Fail, Src, List, Vst); valfun_4(_, _) -> error(unknown_instruction). +verify_get_map(Fail, Src, List, Vst0) -> + assert_term(Src, Vst0), + Vst1 = branch_state(Fail, Vst0), + Lits = mmap(fun(L,_R) -> [L] end, List), + assert_strict_literal_termorder(Lits), + verify_get_map_pair(List,Vst0,Vst1). + +verify_get_map_pair([],_,Vst) -> Vst; +verify_get_map_pair([Src,Dst|Vs],Vst0,Vsti) -> + assert_term(Src, Vst0), + verify_get_map_pair(Vs,Vst0,set_type_reg(term,Dst,Vsti)). + +verify_put_map(Fail, Src, Dst, Live, List, Vst0) -> + verify_live(Live, Vst0), + verify_y_init(Vst0), + foreach(fun (Term) -> assert_term(Term, Vst0) end, List), + assert_term(Src, Vst0), + Vst1 = heap_alloc(0, Vst0), + Vst2 = branch_state(Fail, Vst1), + Vst = prune_x_regs(Live, Vst2), + set_type_reg(term, Dst, Vst). + %% %% Common code for validating bs_get* instructions. %% @@ -888,7 +930,7 @@ validate_bs_skip_utf(Fail, Ctx, Live, Vst0) -> branch_state(Fail, Vst). %% -%% Special state handling for setelement/3 and the set_tuple_element/3 instruction. +%% Special state handling for setelement/3 and set_tuple_element/3 instructions. %% A possibility for garbage collection must not occur between setelement/3 and %% set_tuple_element/3. %% @@ -1078,6 +1120,39 @@ assert_freg_set({fr,Fr}=Freg, #vst{current=#st{f=Fregs}}) end; assert_freg_set(Fr, _) -> error({bad_source,Fr}). +%%% Maps + +%% ensure that a list of literals has a strict +%% ascending term order (also meaning unique literals) +assert_strict_literal_termorder(Ls) -> + Vs = lists:map(fun (L) -> get_literal(L) end, Ls), + case check_strict_value_termorder(Vs) of + true -> ok; + false -> error({not_strict_order, Ls}) + end. + +%% usage: +%% mmap(fun(A,B) -> [{A,B}] end, [1,2,3,4]), +%% [{1,2},{3,4}] + +mmap(F,List) -> + {arity,Ar} = erlang:fun_info(F,arity), + mmap(F,Ar,List). +mmap(_F,_,[]) -> []; +mmap(F,Ar,List) -> + {Hd,Tl} = lists:split(Ar,List), + apply(F,Hd) ++ mmap(F,Ar,Tl). + +check_strict_value_termorder([]) -> true; +check_strict_value_termorder([_]) -> true; +check_strict_value_termorder([V1,V2]) -> + erts_internal:cmp_term(V1,V2) < 0; +check_strict_value_termorder([V1,V2|Vs]) -> + case erts_internal:cmp_term(V1,V2) < 0 of + true -> check_strict_value_termorder([V2|Vs]); + false -> false + end. + %%% %%% Binary matching. %%% @@ -1313,6 +1388,7 @@ assert_term(Src, Vst) -> %% number Integer or Float of unknown value %% + assert_type(WantedType, Term, Vst) -> assert_type(WantedType, get_term_type(Term, Vst)). @@ -1328,7 +1404,6 @@ assert_type({tuple_element,I}, {tuple,Sz}) assert_type(Needed, Actual) -> error({bad_type,{needed,Needed},{actual,Actual}}). - %% upgrade_tuple_type(NewTupleType, OldType) -> TupleType. %% upgrade_tuple_type/2 is used when linear code finds out more and %% more information about a tuple type, so that the type gets more @@ -1409,6 +1484,15 @@ get_term_type_1({y,Y}=Reg, #vst{current=#st{y=Ys}}) when is_integer(Y) -> get_term_type_1(Src, _) -> error({bad_source,Src}). +%% get_literal(Src) -> literal_value(). +get_literal(nil) -> []; +get_literal({atom,A}) when is_atom(A) -> A; +get_literal({float,F}) when is_float(F) -> F; +get_literal({integer,I}) when is_integer(I) -> I; +get_literal({literal,L}) -> L; +get_literal(T) -> error({not_literal,T}). + + branch_arities([], _, #vst{}=Vst) -> Vst; branch_arities([Sz,{f,L}|T], Tuple, #vst{current=St}=Vst0) when is_integer(Sz) -> diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl index 8c6b0c916d..c2a6ef604e 100644 --- a/lib/compiler/src/beam_z.erl +++ b/lib/compiler/src/beam_z.erl @@ -74,6 +74,22 @@ undo_rename({bs_init,F,{I,Extra,U,Flags},Live,[Sz,Src],Dst}) -> {I,F,Sz,Extra,Live,U,Src,Flags,Dst}; undo_rename({bs_init,_,bs_init_writable=I,_,_,_}) -> I; +undo_rename({put_map,Fail,assoc,S,D,R,L}) -> + {put_map_assoc,Fail,S,D,R,L}; +undo_rename({put_map,Fail,exact,S,D,R,L}) -> + {put_map_exact,Fail,S,D,R,L}; +undo_rename({test,has_map_fields,Fail,[Src|List]}) -> + {test,has_map_fields,Fail,Src,{list,[to_typed_literal(V)||V<-List]}}; +undo_rename({get_map_elements,Fail,Src,{list, List}}) -> + {get_map_elements,Fail,Src,{list,[to_typed_literal(V)||V<-List]}}; undo_rename({select,I,Reg,Fail,List}) -> {I,Reg,Fail,{list,List}}; undo_rename(I) -> I. + +%% to_typed_literal(Arg) +%% transform Arg to specific literal i.e. float | integer | atom if applicable +to_typed_literal({literal, V}) when is_float(V) -> {float, V}; +to_typed_literal({literal, V}) when is_atom(V) -> {atom, V}; +to_typed_literal({literal, V}) when is_integer(V) -> {integer, V}; +to_typed_literal({literal, []}) -> nil; +to_typed_literal(V) -> V. diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 4b74d60e9f..9d6768b157 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -120,15 +120,23 @@ update_c_bitstr/5, update_c_bitstr/6, ann_c_bitstr/5, ann_c_bitstr/6, is_c_bitstr/1, bitstr_val/1, bitstr_size/1, bitstr_bitsize/1, bitstr_unit/1, bitstr_type/1, - bitstr_flags/1]). - --export_type([c_binary/0, c_call/0, c_clause/0, c_cons/0, c_fun/0, c_literal/0, - c_module/0, c_tuple/0, c_values/0, c_var/0, cerl/0, var_name/0]). - -%% -%% needed by the include file below -- do not move -%% --type var_name() :: integer() | atom() | {atom(), integer()}. + bitstr_flags/1, + + %% keep map exports here for now + map_es/1, + map_arg/1, + update_c_map/3, + c_map/1, is_c_map_empty/1, + ann_c_map/2, ann_c_map/3, + map_pair_op/1,map_pair_key/1,map_pair_val/1, + update_c_map_pair/4, + c_map_pair/2, + ann_c_map_pair/4 + ]). + +-export_type([c_binary/0, c_bitstr/0, c_call/0, c_clause/0, c_cons/0, c_fun/0, + c_literal/0, c_map/0, c_map_pair/0, c_module/0, c_tuple/0, + c_values/0, c_var/0, cerl/0, var_name/0]). -include("core_parse.hrl"). @@ -145,6 +153,8 @@ -type c_let() :: #c_let{}. -type c_letrec() :: #c_letrec{}. -type c_literal() :: #c_literal{}. +-type c_map() :: #c_map{}. +-type c_map_pair() :: #c_map_pair{}. -type c_module() :: #c_module{}. -type c_primop() :: #c_primop{}. -type c_receive() :: #c_receive{}. @@ -155,11 +165,14 @@ -type c_var() :: #c_var{}. -type cerl() :: c_alias() | c_apply() | c_binary() | c_bitstr() - | c_call() | c_case() | c_catch() | c_clause() | c_cons() + | c_call() | c_case() | c_catch() | c_clause() | c_cons() | c_fun() | c_let() | c_letrec() | c_literal() - | c_module() | c_primop() | c_receive() | c_seq() + | c_map() | c_map_pair() + | c_module() | c_primop() | c_receive() | c_seq() | c_try() | c_tuple() | c_values() | c_var(). +-type var_name() :: integer() | atom() | {atom(), integer()}. + %% ===================================================================== %% Representation (general) %% @@ -191,13 +204,15 @@ %% <td>call</td> %% <td>case</td> %% <td>catch</td> -%% </tr><tr> %% <td>clause</td> +%% </tr><tr> %% <td>cons</td> %% <td>fun</td> %% <td>let</td> %% <td>letrec</td> %% <td>literal</td> +%% <td>map</td> +%% <td>map_pair</td> %% <td>module</td> %% </tr><tr> %% <td>primop</td> @@ -248,10 +263,10 @@ %% @see subtrees/1 %% @see meta/1 --type ctype() :: 'alias' | 'apply' | 'binary' | 'bitrst' | 'call' | 'case' - | 'catch' | 'clause' | 'cons' | 'fun' | 'let' | 'letrec' - | 'literal' | 'module' | 'primop' | 'receive' | 'seq' | 'try' - | 'tuple' | 'values' | 'var'. +-type ctype() :: 'alias' | 'apply' | 'binary' | 'bitrst' | 'call' | 'case' + | 'catch' | 'clause' | 'cons' | 'fun' | 'let' | 'letrec' + | 'literal' | 'map' | 'map_pair' | 'module' | 'primop' + | 'receive' | 'seq' | 'try' | 'tuple' | 'values' | 'var'. -spec type(cerl()) -> ctype(). @@ -268,6 +283,8 @@ type(#c_fun{}) -> 'fun'; type(#c_let{}) -> 'let'; type(#c_letrec{}) -> letrec; type(#c_literal{}) -> literal; +type(#c_map{}) -> map; +type(#c_map_pair{}) -> map_pair; type(#c_module{}) -> module; type(#c_primop{}) -> primop; type(#c_receive{}) -> 'receive'; @@ -1558,6 +1575,104 @@ ann_make_list(_, [], Node) -> %% --------------------------------------------------------------------- +%% maps + +-spec map_es(c_map()) -> [c_map_pair()]. + +map_es(#c_map{es = Es}) -> + Es. + +-spec map_arg(c_map()) -> c_map() | c_literal(). + +map_arg(#c_map{arg=M}) -> + M. + +-spec c_map([c_map_pair()]) -> c_map(). + +c_map(Pairs) -> + #c_map{es=Pairs}. + +-spec is_c_map_empty(c_map() | c_literal()) -> boolean(). + +is_c_map_empty(#c_map{ es=[] }) -> true; +is_c_map_empty(#c_literal{val=M}) when is_map(M),map_size(M) =:= 0 -> true; +is_c_map_empty(_) -> false. + +-spec ann_c_map([term()], [cerl()]) -> c_map() | c_literal(). + +ann_c_map(As,Es) -> + ann_c_map(As, #c_literal{val=#{}}, Es). + +-spec ann_c_map([term()], c_map() | c_literal(), [c_map_pair()]) -> c_map() | c_literal(). + +ann_c_map(As,#c_literal{val=Mval}=M,Es) when is_map(Mval), map_size(Mval) =:= 0 -> + Pairs = [[Ck,Cv]||#c_map_pair{key=Ck,val=Cv}<-Es], + IsLit = lists:foldl(fun(Pair,Res) -> + Res andalso is_lit_list(Pair) + end, true, Pairs), + Fun = fun(Pair) -> [K,V] = lit_list_vals(Pair), {K,V} end, + case IsLit of + false -> + #c_map{arg=M, es=Es, anno=As }; + true -> + #c_literal{anno=As, val=maps:from_list(lists:map(Fun, Pairs))} + end; +ann_c_map(As,#c_literal{val=M},Es) when is_map(M) -> + fold_map_pairs(As,Es,M); +ann_c_map(As,M,Es) -> + #c_map{arg=M, es=Es, anno=As }. + +fold_map_pairs(As,[],M) -> #c_literal{anno=As,val=M}; +%% M#{ K => V} +fold_map_pairs(As,[#c_map_pair{op=#c_literal{val=assoc},key=Ck,val=Cv}=E|Es],M) -> + case is_lit_list([Ck,Cv]) of + true -> + [K,V] = lit_list_vals([Ck,Cv]), + fold_map_pairs(As,Es,maps:put(K,V,M)); + false -> + #c_map{arg=#c_literal{val=M,anno=As}, es=[E|Es], anno=As } + end; +%% M#{ K := V} +fold_map_pairs(As,[#c_map_pair{op=#c_literal{val=exact},key=Ck,val=Cv}=E|Es],M) -> + case is_lit_list([Ck,Cv]) of + true -> + [K,V] = lit_list_vals([Ck,Cv]), + case maps:is_key(K,M) of + true -> fold_map_pairs(As,Es,maps:put(K,V,M)); + false -> + #c_map{arg=#c_literal{val=M,anno=As}, es=[E|Es], anno=As } + end; + false -> + #c_map{arg=#c_literal{val=M,anno=As}, es=[E|Es], anno=As } + end; +fold_map_pairs(As,Es,M) -> + #c_map{arg=#c_literal{val=M,anno=As}, es=Es, anno=As }. + +%-spec update_c_map(c_map() | c_literal(), [c_map_pair()]) -> c_map() | c_literal(). + +update_c_map(Old,M,Es) -> + #c_map{arg=M, es = Es, anno = get_ann(Old)}. + +map_pair_key(#c_map_pair{key=K}) -> K. +map_pair_val(#c_map_pair{val=V}) -> V. +map_pair_op(#c_map_pair{op=Op}) -> Op. + +-spec c_map_pair(cerl(), cerl()) -> c_map_pair(). + +c_map_pair(Key,Val) -> + #c_map_pair{op=#c_literal{val=assoc},key=Key,val=Val}. + +-spec ann_c_map_pair([term()], cerl(), cerl(), cerl()) -> + c_map_pair(). + +ann_c_map_pair(As,Op,K,V) -> + #c_map_pair{op=Op, key = K, val=V, anno = As}. + +update_c_map_pair(Old,Op,K,V) -> + #c_map_pair{op=Op, key=K, val=V, anno = get_ann(Old)}. + + +%% --------------------------------------------------------------------- %% @spec c_tuple(Elements::[cerl()]) -> cerl() %% @@ -2945,6 +3060,10 @@ pat_vars(Node, Vs) -> pat_vars(cons_hd(Node), pat_vars(cons_tl(Node), Vs)); tuple -> pat_list_vars(tuple_es(Node), Vs); + map -> + pat_list_vars(map_es(Node), Vs); + map_pair -> + pat_list_vars([map_pair_op(Node),map_pair_key(Node),map_pair_val(Node)],Vs); binary -> pat_list_vars(binary_segments(Node), Vs); bitstr -> @@ -3803,7 +3922,6 @@ data_type(#c_cons{}) -> data_type(#c_tuple{}) -> tuple. - %% @spec data_es(Node::cerl()) -> [cerl()] %% %% @doc Returns the list of subtrees of a data constructor node. If @@ -3835,7 +3953,6 @@ data_es(#c_cons{hd = H, tl = T}) -> data_es(#c_tuple{es = Es}) -> Es. - %% @spec data_arity(Node::cerl()) -> integer() %% %% @doc Returns the number of subtrees of a data constructor @@ -3892,7 +4009,6 @@ ann_make_data(As, {atomic, V}, []) -> #c_literal{val = V, anno = As}; ann_make_data(As, cons, [H, T]) -> ann_c_cons(As, H, T); ann_make_data(As, tuple, Es) -> ann_c_tuple(As, Es). - %% @spec update_data(Old::cerl(), Type::dtype(), %% Elements::[cerl()]) -> cerl() %% @see make_data/2 @@ -4022,6 +4138,10 @@ subtrees(T) -> [[cons_hd(T)], [cons_tl(T)]]; tuple -> [tuple_es(T)]; + map -> + [map_es(T)]; + map_pair -> + [[map_pair_op(T)],[map_pair_key(T)],[map_pair_val(T)]]; 'let' -> [let_vars(T), [let_arg(T)], [let_body(T)]]; seq -> @@ -4143,6 +4263,9 @@ ann_make_tree(As, bitstr, [[V],[S],[U],[T],[Fs]]) -> ann_c_bitstr(As, V, S, U, T, Fs); ann_make_tree(As, cons, [[H], [T]]) -> ann_c_cons(As, H, T); ann_make_tree(As, tuple, [Es]) -> ann_c_tuple(As, Es); +ann_make_tree(As, map, [Es]) -> ann_c_map(As, Es); +ann_make_tree(As, map, [[A], Es]) -> ann_c_map(As, A, Es); +ann_make_tree(As, map_pair, [[Op], [K], [V]]) -> ann_c_map_pair(As, Op, K, V); ann_make_tree(As, 'let', [Vs, [A], [B]]) -> ann_c_let(As, Vs, A, B); ann_make_tree(As, seq, [[A], [B]]) -> ann_c_seq(As, A, B); ann_make_tree(As, apply, [[Op], Es]) -> ann_c_apply(As, Op, Es); @@ -4272,12 +4395,8 @@ meta_1(cons, Node) -> %% we get exactly one element, we generate a 'c_cons' call %% instead of 'make_list' to reconstruct the node. case split_list(Node) of - {[H], none} -> - meta_call(c_cons, [meta(H), meta(c_nil())]); {[H], Node1} -> meta_call(c_cons, [meta(H), meta(Node1)]); - {L, none} -> - meta_call(make_list, [make_list(meta_list(L))]); {L, Node1} -> meta_call(make_list, [make_list(meta_list(L)), meta(Node1)]) @@ -4364,8 +4483,6 @@ split_list(Node, L) -> case type(Node) of cons when A =:= [] -> split_list(cons_tl(Node), [cons_hd(Node) | L]); - nil when A =:= [] -> - {lists:reverse(L), none}; _ -> {lists:reverse(L), Node} end. diff --git a/lib/compiler/src/cerl_clauses.erl b/lib/compiler/src/cerl_clauses.erl index 99fa8dd9d5..87bd47c08b 100644 --- a/lib/compiler/src/cerl_clauses.erl +++ b/lib/compiler/src/cerl_clauses.erl @@ -354,6 +354,29 @@ match(P, E, Bs) -> {false, Bs} end end; + map -> + %% The most we can do is to say "definitely no match" if a + %% map pattern is matched against non-map data. + case E of + any -> + {false, Bs}; + _ -> + case type(E) of + literal -> + case is_map(concrete(E)) of + false -> + none; + true -> + {false, Bs} + end; + cons -> + none; + tuple -> + none; + _ -> + {false, Bs} + end + end; _ -> match_1(P, E, Bs) end. diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl index c6de63c69f..75740e8b9d 100644 --- a/lib/compiler/src/cerl_inline.erl +++ b/lib/compiler/src/cerl_inline.erl @@ -42,7 +42,7 @@ bitstr_flags/1, binary_segments/1, update_c_alias/3, update_c_apply/3, update_c_binary/2, update_c_bitstr/6, update_c_call/4, update_c_case/3, update_c_catch/2, - update_c_clause/4, c_fun/2, c_int/1, c_let/3, + update_c_clause/4, c_fun/2, c_int/1, c_let/3, ann_c_let/4, update_c_let/4, update_c_letrec/3, update_c_module/5, update_c_primop/3, update_c_receive/4, update_c_seq/3, c_seq/2, update_c_try/6, c_tuple/1, update_c_values/2, @@ -51,7 +51,7 @@ catch_body/1, clause_body/1, clause_guard/1, clause_pats/1, clause_vars/1, concrete/1, cons_hd/1, cons_tl/1, data_arity/1, data_es/1, data_type/1, - fun_body/1, fun_vars/1, get_ann/1, int_val/1, + fname_arity/1, fun_body/1, fun_vars/1, get_ann/1, int_val/1, is_c_atom/1, is_c_cons/1, is_c_fname/1, is_c_int/1, is_c_list/1, is_c_seq/1, is_c_tuple/1, is_c_var/1, is_data/1, is_literal/1, is_literal_term/1, let_arg/1, @@ -63,7 +63,11 @@ receive_clauses/1, receive_timeout/1, seq_arg/1, seq_body/1, set_ann/2, try_arg/1, try_body/1, try_vars/1, try_evars/1, try_handler/1, tuple_es/1, tuple_arity/1, - type/1, values_es/1, var_name/1]). + type/1, values_es/1, var_name/1, + map_arg/1, map_es/1, update_c_map/3, + update_c_map_pair/4, + map_pair_op/1, map_pair_key/1, map_pair_val/1 + ]). -import(lists, [foldl/3, foldr/3, mapfoldl/3, reverse/1]). @@ -128,6 +132,8 @@ weight(call) -> 3; % Assume remote-calls as efficient as `apply'. weight(primop) -> 2; % Assume more efficient than `apply'. weight(binary) -> 4; % Initialisation base cost. weight(bitstr) -> 3; % Coding/decoding a value; like a primop. +weight(map) -> 4; % Initialisation base cost. +weight(map_pair) -> 3; % Coding/decoding a value; like a primop. weight(module) -> 1. % Like a letrec with a constant body %% These "reference" structures are used for variables and function @@ -333,6 +339,8 @@ i(E, Ctxt, Ren, Env, S0) -> i_catch(E, Ctxt, Ren, Env, S); binary -> i_binary(E, Ren, Env, S); + map -> + i_map(E, Ctxt, Ren, Env, S); module -> i_module(E, Ctxt, Ren, Env, S) end @@ -1022,8 +1030,17 @@ i_apply(E, Ctxt, Ren, Env, S) -> visit_and_count_size(Opnd, S) end, S3, Opnds), - N = apply_size(length(Es)), - {update_c_apply(E, E1, Es), count_size(N, S4)} + Arity = length(Es), + E2 = case is_c_fname(E1) andalso length(Es) =/= fname_arity(E1) of + true -> + V = new_var(Env), + ann_c_let(get_ann(E), [V], E1, + update_c_apply(E, V, Es)); + false -> + update_c_apply(E, E1, Es) + end, + N = apply_size(Arity), + {E2, count_size(N, S4)} end. apply_size(A) -> @@ -1324,6 +1341,25 @@ i_bitstr(E, Ren, Env, S) -> S3 = count_size(weight(bitstr), S2), {update_c_bitstr(E, Val, Size, Unit, Type, Flags), S3}. +i_map(E, Ctx, Ren, Env, S) -> + %% Visit the segments for value. + {M1, S1} = i(map_arg(E), value, Ren, Env, S), + {Es, S2} = mapfoldl(fun (E, S) -> + i_map_pair(E, Ctx, Ren, Env, S) + end, S1, map_es(E)), + S3 = count_size(weight(map), S2), + {update_c_map(E, M1,Es), S3}. + +i_map_pair(E, Ctx, Ren, Env, S) -> + %% It is not necessary to visit the Op and Key fields, + %% since these are always literals. + {Val, S1} = i(map_pair_val(E), Ctx, Ren, Env, S), + Op = map_pair_op(E), + Key = map_pair_key(E), + S2 = count_size(weight(map_pair), S1), + {update_c_map_pair(E, Op, Key, Val), S2}. + + %% This is a simplified version of `i_pattern', for lists of parameter %% variables only. It does not modify the state. @@ -1383,6 +1419,16 @@ i_pattern(E, Ren, Env, Ren0, Env0, S) -> S, binary_segments(E)), S2 = count_size(weight(binary), S1), {update_c_binary(E, Es), S2}; + map -> + %% map patterns should not have args + M = map_arg(E), + + {Es, S1} = mapfoldl(fun (E, S) -> + i_map_pair_pattern(E, Ren, Env, Ren0, Env0, S) + end, + S, map_es(E)), + S2 = count_size(weight(map), S1), + {update_c_map(E, M, Es), S2}; _ -> case is_literal(E) of true -> @@ -1416,6 +1462,15 @@ i_bitstr_pattern(E, Ren, Env, Ren0, Env0, S) -> S3 = count_size(weight(bitstr), S2), {update_c_bitstr(E, Val, Size, Unit, Type, Flags), S3}. +i_map_pair_pattern(E, Ren, Env, Ren0, Env0, S) -> + %% It is not necessary to visit the Op it is always a literal. + %% Same goes for Key + {Val, S1} = i_pattern(map_pair_val(E), Ren, Env, Ren0, Env0, S), + Op = map_pair_op(E), %% should be 'exact' literal + Key = map_pair_key(E), + S2 = count_size(weight(map_pair), S1), + {update_c_map_pair(E, Op, Key, Val), S2}. + %% --------------------------------------------------------------------- %% Other central inlining functions diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl index 1e3755025f..e53bdd4efb 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -55,7 +55,15 @@ update_c_let/4, update_c_letrec/3, update_c_module/5, update_c_primop/3, update_c_receive/4, update_c_seq/3, update_c_try/6, update_c_tuple/2, update_c_tuple_skel/2, - update_c_values/2, values_es/1, var_name/1]). + update_c_values/2, values_es/1, var_name/1, + + map_arg/1, map_es/1, + ann_c_map/3, + update_c_map/3, + map_pair_key/1,map_pair_val/1,map_pair_op/1, + ann_c_map_pair/4, + update_c_map_pair/4 + ]). %% --------------------------------------------------------------------- @@ -129,6 +137,12 @@ map_1(F, T) -> map(F, cons_tl(T))); tuple -> update_c_tuple_skel(T, map_list(F, tuple_es(T))); + map -> + update_c_map(T, map(F, map_arg(T)), map_list(F, map_es(T))); + map_pair -> + update_c_map_pair(T, map(F, map_pair_op(T)), + map(F, map_pair_key(T)), + map(F, map_pair_val(T))); 'let' -> update_c_let(T, map_list(F, let_vars(T)), map(F, let_arg(T)), @@ -235,6 +249,14 @@ fold_1(F, S, T) -> fold(F, fold(F, S, cons_hd(T)), cons_tl(T)); tuple -> fold_list(F, S, tuple_es(T)); + map -> + fold_list(F, S, map_es(T)); + map_pair -> + fold(F, + fold(F, + fold(F, S, map_pair_op(T)), + map_pair_key(T)), + map_pair_val(T)); 'let' -> fold(F, fold(F, fold_list(F, S, let_vars(T)), let_arg(T)), @@ -349,6 +371,15 @@ mapfold(F, S0, T) -> tuple -> {Ts, S1} = mapfold_list(F, S0, tuple_es(T)), F(update_c_tuple_skel(T, Ts), S1); + map -> + {M , S1} = mapfold(F, S0, map_arg(T)), + {Ts, S2} = mapfold_list(F, S1, map_es(T)), + F(update_c_map(T, M, Ts), S2); + map_pair -> + {Op, S1} = mapfold(F, S0, map_pair_op(T)), + {Key, S2} = mapfold(F, S1, map_pair_key(T)), + {Val, S3} = mapfold(F, S2, map_pair_val(T)), + F(update_c_map_pair(T,Op,Key,Val), S3); 'let' -> {Vs, S1} = mapfold_list(F, S0, let_vars(T)), {A, S2} = mapfold(F, S1, let_arg(T)), @@ -488,6 +519,10 @@ variables(T, S) -> variables(cons_tl(T), S)); tuple -> vars_in_list(tuple_es(T), S); + map -> + vars_in_list(map_es(T), S); + map_pair -> + vars_in_list([map_pair_op(T),map_pair_key(T), map_pair_val(T)], S); 'let' -> Vs = variables(let_body(T), S), Vs1 = var_list_names(let_vars(T)), @@ -688,6 +723,17 @@ label(T, N, Env) -> {Ts, N1} = label_list(tuple_es(T), N, Env), {As, N2} = label_ann(T, N1), {ann_c_tuple_skel(As, Ts), N2}; + map -> + {M, N1} = label(map_arg(T), N, Env), + {Ts, N2} = label_list(map_es(T), N1, Env), + {As, N3} = label_ann(T, N2), + {ann_c_map(As, M, Ts), N3}; + map_pair -> + {Op, N1} = label(map_pair_op(T), N, Env), + {Val, N2} = label(map_pair_key(T), N1, Env), + {Key, N3} = label(map_pair_val(T), N2, Env), + {As, N4} = label_ann(T, N3), + {ann_c_map_pair(As,Op,Key,Val), N4}; 'let' -> {A, N1} = label(let_arg(T), N, Env), {Vs, N2, Env1} = label_vars(let_vars(T), N1, Env), diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 47d446273b..c7d91070f6 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -230,12 +230,27 @@ format_error({undef_parse_transform,M}) -> format_error({core_transform,M,R}) -> io_lib:format("error in core transform '~s': ~tp", [M, R]); format_error({crash,Pass,Reason}) -> - io_lib:format("internal error in ~p;\ncrash reason: ~tp", [Pass,Reason]); + io_lib:format("internal error in ~p;\ncrash reason: ~ts", [Pass,format_error_reason(Reason)]); format_error({bad_return,Pass,Reason}) -> - io_lib:format("internal error in ~p;\nbad return value: ~tp", [Pass,Reason]); + io_lib:format("internal error in ~p;\nbad return value: ~ts", [Pass,format_error_reason(Reason)]); format_error({module_name,Mod,Filename}) -> - io_lib:format("Module name '~s' does not match file name '~ts'", - [Mod,Filename]). + io_lib:format("Module name '~s' does not match file name '~ts'", [Mod,Filename]); +format_error(reparsing_invalid_unicode) -> + "Non-UTF-8 character(s) detected, but no encoding declared. Encode the file in UTF-8 or add \"%% coding: latin-1\" at the beginning of the file. Retrying with latin-1 encoding.". + +format_error_reason({Reason, Stack}) when is_list(Stack) -> + StackFun = fun + (escript, run, 2) -> true; + (escript, start, 1) -> true; + (init, start_it, 1) -> true; + (init, start_em, 1) -> true; + (_Mod, _Fun, _Arity) -> false + end, + FormatFun = fun (Term, _) -> io_lib:format("~tp", [Term]) end, + [io_lib:format("~tp", [Reason]),"\n\n", + lib:format_stacktrace(1, Stack, StackFun, FormatFun)]; +format_error_reason(Reason) -> + io_lib:format("~tp", [Reason]). %% The compile state record. -record(compile, {filename="" :: file:filename(), @@ -417,6 +432,9 @@ pass(from_core) -> pass(from_asm) -> {".S",[?pass(beam_consult_asm)|asm_passes()]}; pass(asm) -> + %% TODO: remove 'asm' in 18.0 + io:format("compile:file/2 option 'asm' has been deprecated and will be~n" + "removed in the 18.0 release. Use 'from_asm' instead.~n"), pass(from_asm); pass(from_beam) -> {".beam",[?pass(read_beam_file)|binary_passes()]}; @@ -606,9 +624,11 @@ core_passes() -> [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/1}, {iff,doldinline,{listing,"oldinline"}}, ?pass(core_fold_module), + {iff,dcorefold,{listing,"corefold"}}, {core_inline_module,fun test_core_inliner/1,fun core_inline_module/1}, {iff,dinline,{listing,"inline"}}, - {core_fold_after_inline,fun test_core_inliner/1,fun core_fold_module/1}, + {core_fold_after_inlining,fun test_any_inliner/1, + fun core_fold_module_after_inlining/1}, ?pass(core_transforms)]}, {iff,dcopt,{listing,"copt"}}, {iff,'to_core',{done,"core"}}]} @@ -774,20 +794,59 @@ no_native_compilation(BeamFile, #compile{options=Opts0}) -> _ -> false end. -parse_module(St) -> - Opts = St#compile.options, - Cwd = ".", - IncludePath = [Cwd, St#compile.dir|inc_paths(Opts)], - R = epp:parse_file(St#compile.ifile, IncludePath, pre_defs(Opts)), +parse_module(St0) -> + case do_parse_module(utf8, St0) of + {ok,_}=Ret -> + Ret; + {error,_}=Ret -> + Ret; + {invalid_unicode,File,Line} -> + case do_parse_module(latin1, St0) of + {ok,St} -> + Es = [{File,[{Line,?MODULE,reparsing_invalid_unicode}]}], + {ok,St#compile{warnings=Es++St#compile.warnings}}; + {error,St} -> + Es = [{File,[{Line,?MODULE,reparsing_invalid_unicode}]}], + {error,St#compile{errors=Es++St#compile.errors}} + end + end. + +do_parse_module(DefEncoding, #compile{ifile=File,options=Opts,dir=Dir}=St) -> + R = epp:parse_file(File, + [{includes,[".",Dir|inc_paths(Opts)]}, + {macros,pre_defs(Opts)}, + {default_encoding,DefEncoding}, + extra]), case R of - {ok,Forms} -> - Encoding = epp:read_encoding(St#compile.ifile), - {ok,St#compile{code=Forms,encoding=Encoding}}; + {ok,Forms,Extra} -> + Encoding = proplists:get_value(encoding, Extra), + case find_invalid_unicode(Forms, File) of + none -> + {ok,St#compile{code=Forms,encoding=Encoding}}; + {invalid_unicode,_,_}=Ret -> + case Encoding of + none -> + Ret; + _ -> + {ok,St#compile{code=Forms,encoding=Encoding}} + end + end; {error,E} -> Es = [{St#compile.ifile,[{none,?MODULE,{epp,E}}]}], {error,St#compile{errors=St#compile.errors ++ Es}} end. +find_invalid_unicode([H|T], File0) -> + case H of + {attribute,_,file,{File,_}} -> + find_invalid_unicode(T, File); + {error,{Line,file_io_server,invalid_unicode}} -> + {invalid_unicode,File0,Line}; + _Other -> + find_invalid_unicode(T, File0) + end; +find_invalid_unicode([], _) -> none. + parse_core(St) -> case file:read_file(St#compile.ifile) of {ok,Bin} -> @@ -1130,6 +1189,12 @@ core_fold_module(#compile{code=Code0,options=Opts,warnings=Warns}=St) -> {ok,Code,Ws} = sys_core_fold:module(Code0, Opts), {ok,St#compile{code=Code,warnings=Warns ++ Ws}}. +core_fold_module_after_inlining(#compile{code=Code0,options=Opts}=St) -> + %% Inlining may produce code that generates spurious warnings. + %% Ignore all warnings. + {ok,Code,_Ws} = sys_core_fold:module(Code0, Opts), + {ok,St#compile{code=Code}}. + test_old_inliner(#compile{options=Opts}) -> %% The point of this test is to avoid loading the old inliner %% if we know that it will not be used. @@ -1148,6 +1213,9 @@ test_core_inliner(#compile{options=Opts}) -> end, Opts) end. +test_any_inliner(St) -> + test_old_inliner(St) orelse test_core_inliner(St). + core_old_inliner(#compile{code=Code0,options=Opts}=St) -> {ok,Code} = sys_core_inline:module(Code0, Opts), {ok,St#compile{code=Code}}. @@ -1613,7 +1681,7 @@ compile_beam(File0, _OutFile, Opts) -> compile_asm(File0, _OutFile, Opts) -> File = shorten_filename(File0), - case file(File, [asm|make_erl_options(Opts)]) of + case file(File, [from_asm|make_erl_options(Opts)]) of {ok,_Mod} -> ok; Other -> Other end. diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index 8775c84698..8f68915f8e 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -67,4 +67,6 @@ ]}, {registered, []}, {applications, [kernel, stdlib]}, - {env, []}]}. + {env, []}, + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","hipe-3.10.3","erts-6.0", + "crypto-3.3"]}]}. diff --git a/lib/compiler/src/compiler.appup.src b/lib/compiler/src/compiler.appup.src index 54a63833e6..fe273b269c 100644 --- a/lib/compiler/src/compiler.appup.src +++ b/lib/compiler/src/compiler.appup.src @@ -1 +1,21 @@ -{"%VSN%",[],[]}. +%% -*- erlang -*- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +{"%VSN%", + [{<<".*">>,[{restart_application, compiler}]}], + [{<<".*">>,[{restart_application, compiler}]}] +}. diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl index 824be9ff7f..0d95971f91 100644 --- a/lib/compiler/src/core_lib.erl +++ b/lib/compiler/src/core_lib.erl @@ -59,7 +59,7 @@ is_lit_bin(Es) -> %% Return the value of LitExpr. -spec literal_value(cerl:c_literal() | cerl:c_binary() | - cerl:c_cons() | cerl:c_tuple()) -> term(). + cerl:c_map() | cerl:c_cons() | cerl:c_tuple()) -> term(). literal_value(#c_literal{val=V}) -> V; literal_value(#c_binary{segments=Es}) -> @@ -67,7 +67,14 @@ literal_value(#c_binary{segments=Es}) -> literal_value(#c_cons{hd=H,tl=T}) -> [literal_value(H)|literal_value(T)]; literal_value(#c_tuple{es=Es}) -> - list_to_tuple(literal_value_list(Es)). + list_to_tuple(literal_value_list(Es)); +literal_value(#c_map{arg=Cm,es=Cmps}) -> + M = literal_value(Cm), + lists:foldl(fun(#c_map_pair{ key=Ck, val=Cv },Mi) -> + K = literal_value(Ck), + V = literal_value(Cv), + maps:put(K,V,Mi) + end, M, Cmps). literal_value_list(Vals) -> [literal_value(V) || V <- Vals]. @@ -105,6 +112,10 @@ vu_expr(V, #c_cons{hd=H,tl=T}) -> vu_expr(V, H) orelse vu_expr(V, T); vu_expr(V, #c_tuple{es=Es}) -> vu_expr_list(V, Es); +vu_expr(V, #c_map{arg=M,es=Es}) -> + vu_expr(V, M) orelse vu_expr_list(V, Es); +vu_expr(V, #c_map_pair{key=Key,val=Val}) -> + vu_expr_list(V, [Key,Val]); vu_expr(V, #c_binary{segments=Ss}) -> vu_seg_list(V, Ss); vu_expr(V, #c_fun{vars=Vs,body=B}) -> @@ -201,6 +212,8 @@ 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; @@ -223,6 +236,13 @@ vu_pat_seg_list(V, Ss, St) -> end end, St, Ss). +vu_map_pairs(V, [#c_map_pair{val=Pat}|T], St0) -> + case vu_pattern(V, Pat, St0) of + {true,_}=St -> St; + St -> vu_map_pairs(V, T, St) + end; +vu_map_pairs(_, [], St) -> St. + -spec vu_var_list(cerl:var_name(), [cerl:c_var()]) -> boolean(). vu_var_list(V, Vs) -> diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl index 67d37ff1fc..25df33a287 100644 --- a/lib/compiler/src/core_lint.erl +++ b/lib/compiler/src/core_lint.erl @@ -254,6 +254,10 @@ gexpr(#c_cons{hd=H,tl=T}, Def, _Rt, St) -> gexpr_list([H,T], Def, St); gexpr(#c_tuple{es=Es}, Def, _Rt, St) -> gexpr_list(Es, Def, St); +gexpr(#c_map{es=Es}, Def, _Rt, St) -> + gexpr_list(Es, Def, St); +gexpr(#c_map_pair{key=K,val=V}, Def, _Rt, St) -> + gexpr_list([K,V], Def, St); gexpr(#c_binary{segments=Ss}, Def, _Rt, St) -> gbitstr_list(Ss, Def, St); gexpr(#c_seq{arg=Arg,body=B}, Def, Rt, St0) -> @@ -263,10 +267,21 @@ gexpr(#c_let{vars=Vs,arg=Arg,body=B}, Def, Rt, St0) -> St1 = gbody(Arg, Def, let_varcount(Vs), St0), %This is a guard body {Lvs,St2} = variable_list(Vs, St1), gbody(B, union(Lvs, Def), Rt, St2); -gexpr(#c_call{module=#c_literal{val=erlang}, - name=#c_literal{}, - args=As}, Def, 1, St) -> - gexpr_list(As, Def, St); +gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=is_record}, + args=[Arg,#c_literal{val=Tag},#c_literal{val=Size}]}, + Def, 1, St) when is_atom(Tag), is_integer(Size) -> + gexpr(Arg, Def, 1, St); +gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=is_record}}, + _Def, 1, St) -> + add_error({illegal_guard,St#lint.func}, St); +gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=Name},args=As}, + Def, 1, St) when is_atom(Name) -> + case is_guard_bif(Name, length(As)) of + true -> + gexpr_list(As, Def, St); + false -> + add_error({illegal_guard,St#lint.func}, St) + end; gexpr(#c_primop{name=#c_literal{val=A},args=As}, Def, _Rt, St0) when is_atom(A) -> gexpr_list(As, Def, St0); gexpr(#c_try{arg=E,vars=[#c_var{name=X}],body=#c_var{name=X}, @@ -278,6 +293,7 @@ gexpr(#c_case{arg=Arg,clauses=Cs}, Def, Rt, St0) -> St1 = gbody(Arg, Def, PatCount, St0), clauses(Cs, Def, PatCount, Rt, St1); gexpr(_Core, _, _, St) -> + %%io:fwrite("clint gexpr: ~p~n", [_Core]), add_error({illegal_guard,St#lint.func}, St). %% gexpr_list([Expr], Defined, State) -> State. @@ -293,6 +309,14 @@ gbitstr_list(Es, Def, St0) -> gbitstr(#c_bitstr{val=V,size=S}, Def, St) -> gexpr_list([V,S], Def, St). +%% is_guard_bif(Name, Arity) -> Boolean. + +is_guard_bif(Name, Arity) -> + erl_internal:guard_bif(Name, Arity) + orelse erl_internal:arith_op(Name, Arity) + orelse erl_internal:bool_op(Name, Arity) + orelse erl_internal:comp_op(Name, Arity). + %% expr(Expr, Defined, RetCount, State) -> State. expr(#c_var{name={_,_}=FA}, Def, _Rt, St) -> @@ -303,6 +327,10 @@ expr(#c_cons{hd=H,tl=T}, Def, _Rt, St) -> expr_list([H,T], Def, St); expr(#c_tuple{es=Es}, Def, _Rt, St) -> expr_list(Es, Def, St); +expr(#c_map{es=Es}, Def, _Rt, St) -> + expr_list(Es, Def, St); +expr(#c_map_pair{key=K,val=V},Def,_Rt,St) -> + expr_list([K,V],Def,St); expr(#c_binary{segments=Ss}, Def, _Rt, St) -> bitstr_list(Ss, Def, St); expr(#c_fun{vars=Vs,body=B}, Def, Rt, St0) -> @@ -355,7 +383,7 @@ expr(#c_try{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Def, Rt, St0) -> {Ens,St5} = variable_list(Evs, St4), body(H, union(Ens, Def), Rt, St5); expr(_Other, _, _, St) -> - %%io:fwrite("clint: ~p~n", [_Other]), + %%io:fwrite("clint expr: ~p~n", [_Other]), add_error({illegal_expr,St#lint.func}, St). %% expr_list([Expr], Defined, State) -> State. @@ -454,13 +482,19 @@ pattern(#c_cons{hd=H,tl=T}, Def, Ps, St) -> pattern_list([H,T], Def, Ps, St); pattern(#c_tuple{es=Es}, Def, Ps, St) -> pattern_list(Es, Def, Ps, St); +pattern(#c_map{es=Es}, Def, Ps, St) -> + pattern_list(Es, Def, Ps, St); +pattern(#c_map_pair{op=#c_literal{val=exact},key=K,val=V},Def,Ps,St) -> + pattern_list([K,V],Def,Ps,St); pattern(#c_binary{segments=Ss}, Def, Ps, St0) -> St = pat_bin_tail_check(Ss, St0), pat_bin(Ss, Def, Ps, St); pattern(#c_alias{var=V,pat=P}, Def, Ps, St0) -> {Vvs,St1} = variable(V, Ps, St0), pattern(P, Def, union(Vvs, Ps), St1); -pattern(_, _, Ps, St) -> {Ps,add_error({not_pattern,St#lint.func}, St)}. +pattern(_Other, _, Ps, St) -> + %%io:fwrite("clint pattern: ~p~n", [_Other]), + {Ps,add_error({not_pattern,St#lint.func}, St)}. pat_var(N, _Def, Ps, St) -> case is_element(N, Ps) of diff --git a/lib/compiler/src/core_parse.hrl b/lib/compiler/src/core_parse.hrl index 0b8f4d8895..4a00535360 100644 --- a/lib/compiler/src/core_parse.hrl +++ b/lib/compiler/src/core_parse.hrl @@ -34,7 +34,7 @@ -record(c_apply, {anno=[], op, % op :: Tree, args}). % args :: [Tree] --record(c_binary, {anno=[], segments}). % segments :: [#c_bitstr{}] +-record(c_binary, {anno=[], segments :: [cerl:c_bitstr()]}). -record(c_bitstr, {anno=[], val, % val :: Tree, size, % size :: Tree, @@ -70,6 +70,15 @@ -record(c_literal, {anno=[], val}). % val :: literal() +-record(c_map, {anno=[], + arg=#c_literal{val=#{}} :: cerl:c_var() | cerl:c_literal(), + es :: [cerl:c_map_pair()]}). + +-record(c_map_pair, {anno=[], + op :: #c_literal{val::'assoc'} | #c_literal{val::'exact'}, + key, + val}). + -record(c_module, {anno=[], name, % name :: Tree, exports, % exports :: [Tree], attrs, % attrs :: [#c_def{}], diff --git a/lib/compiler/src/core_parse.yrl b/lib/compiler/src/core_parse.yrl index 4e98a8c2da..a66ad4235f 100644 --- a/lib/compiler/src/core_parse.yrl +++ b/lib/compiler/src/core_parse.yrl @@ -21,6 +21,8 @@ %% Have explicit productions for annotated phrases named anno_XXX. %% This just does an XXX and adds the annotation. +Expect 0. + Nonterminals module_definition module_export module_attribute module_defs @@ -44,6 +46,9 @@ receive_expr timeout try_expr sequence catch_expr variable clause clause_pattern +map_expr map_pairs map_pair map_pair_assoc map_pair_exact +map_pattern map_pair_patterns map_pair_pattern + annotation anno_fun anno_expression anno_expressions anno_variable anno_variables anno_pattern anno_patterns anno_function_name @@ -53,7 +58,7 @@ Terminals %% Separators -'(' ')' '{' '}' '[' ']' '|' ',' '->' '=' '/' '<' '>' ':' '-|' '#' +'(' ')' '{' '}' '[' ']' '|' ',' '->' '=' '/' '<' '>' ':' '-|' '#' '~' '::' %% Keywords (atoms are assumed to always be single-quoted). @@ -166,6 +171,7 @@ anno_patterns -> anno_pattern : ['$1']. other_pattern -> atomic_pattern : '$1'. other_pattern -> tuple_pattern : '$1'. +other_pattern -> map_pattern : '$1'. other_pattern -> cons_pattern : '$1'. other_pattern -> binary_pattern : '$1'. other_pattern -> anno_variable '=' anno_pattern : @@ -176,6 +182,16 @@ atomic_pattern -> atomic_literal : '$1'. tuple_pattern -> '{' '}' : c_tuple([]). tuple_pattern -> '{' anno_patterns '}' : c_tuple('$2'). +map_pattern -> '~' '{' '}' '~' : #c_map{es=[]}. +map_pattern -> '~' '{' map_pair_patterns '}' '~' : + #c_map{es=lists:sort('$3')}. + +map_pair_patterns -> map_pair_pattern : ['$1']. +map_pair_patterns -> map_pair_pattern ',' map_pair_patterns : ['$1' | '$3']. + +map_pair_pattern -> '~' '<' anno_pattern ',' anno_pattern '>' : + #c_map_pair{op=#c_literal{val=exact},key='$3',val='$5'}. + cons_pattern -> '[' anno_pattern tail_pattern : #c_cons{hd='$2',tl='$3'}. @@ -240,6 +256,7 @@ single_expression -> primop_expr : '$1'. single_expression -> try_expr : '$1'. single_expression -> sequence : '$1'. single_expression -> catch_expr : '$1'. +single_expression -> map_expr : '$1'. literal -> atomic_literal : '$1'. literal -> tuple_literal : '$1'. @@ -267,6 +284,22 @@ tail_literal -> ',' literal tail_literal : #c_cons{hd='$2',tl='$3'}. tuple -> '{' '}' : c_tuple([]). tuple -> '{' anno_expressions '}' : c_tuple('$2'). +map_expr -> '~' '{' '}' '~' : #c_map{es=[]}. +map_expr -> '~' '{' map_pairs '}' '~' : #c_map{es='$3'}. +map_expr -> '~' '{' map_pairs '|' variable '}' '~' : #c_map{arg='$5',es='$3'}. +map_expr -> '~' '{' map_pairs '|' map_expr '}' '~' : #c_map{arg='$5',es='$3'}. + +map_pairs -> map_pair : ['$1']. +map_pairs -> map_pair ',' map_pairs : ['$1' | '$3']. + +map_pair -> map_pair_assoc : '$1'. +map_pair -> map_pair_exact : '$1'. + +map_pair_assoc -> '::' '<' anno_expression ',' anno_expression'>' : + #c_map_pair{op=#c_literal{val=assoc},key='$3',val='$5'}. +map_pair_exact -> '~' '<' anno_expression ',' anno_expression'>' : + #c_map_pair{op=#c_literal{val=exact},key='$3',val='$5'}. + cons -> '[' anno_expression tail : c_cons('$2', '$3'). tail -> ']' : #c_literal{val=[]}. @@ -381,3 +414,5 @@ Erlang code. tok_val(T) -> element(3, T). tok_line(T) -> element(2, T). + +%% vim: syntax=erlang diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl index 1f91a52be3..83412ecdd7 100644 --- a/lib/compiler/src/core_pp.erl +++ b/lib/compiler/src/core_pp.erl @@ -118,6 +118,16 @@ format_1(#c_literal{val=Tuple}, Ctxt) when is_tuple(Tuple) -> format_1(#c_literal{anno=A,val=Bitstring}, Ctxt) when is_bitstring(Bitstring) -> Segs = segs_from_bitstring(Bitstring), format_1(#c_binary{anno=A,segments=Segs}, Ctxt); +format_1(#c_literal{anno=A,val=M},Ctxt) when is_map(M) -> + Pairs = maps:to_list(M), + Op = case Ctxt of + #ctxt{ class = clause } -> exact; + _ -> assoc + end, + Cpairs = [#c_map_pair{op=#c_literal{val=Op}, + key=#c_literal{val=V}, + val=#c_literal{val=K}} || {K,V} <- Pairs], + format_1(#c_map{anno=A,arg=#c_literal{val=#{}},es=Cpairs},Ctxt); format_1(#c_var{name={I,A}}, _) -> [core_atom(I),$/,integer_to_list(A)]; format_1(#c_var{name=V}, _) -> @@ -161,6 +171,27 @@ format_1(#c_tuple{es=Es}, Ctxt) -> format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2), $} ]; +format_1(#c_map{arg=#c_literal{val=M},es=Es}, Ctxt) when is_map(M),map_size(M)=:=0 -> + ["~{", + format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2), + "}~" + ]; +format_1(#c_map{arg=Var,es=Es}, Ctxt) -> + ["~{", + format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2), + "|",format(Var, add_indent(Ctxt, 1)), + "}~" + ]; +format_1(#c_map_pair{op=#c_literal{val=assoc},key=K,val=V}, Ctxt) -> + ["::<", + format_hseq([K,V], ",", add_indent(Ctxt, 1), fun format/2), + ">" + ]; +format_1(#c_map_pair{op=#c_literal{val=exact},key=K,val=V}, Ctxt) -> + ["~<", + format_hseq([K,V], ",", add_indent(Ctxt, 1), fun format/2), + ">" + ]; format_1(#c_cons{hd=H,tl=T}, Ctxt) -> Txt = ["["|format(H, add_indent(Ctxt, 1))], [Txt|format_list_tail(T, add_indent(Ctxt, width(Txt, Ctxt)))]; diff --git a/lib/compiler/src/core_scan.erl b/lib/compiler/src/core_scan.erl index c0dfecd1dc..b7799b373a 100644 --- a/lib/compiler/src/core_scan.erl +++ b/lib/compiler/src/core_scan.erl @@ -1,8 +1,7 @@ -%% -*- coding: utf-8 -*- %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2012. All Rights Reserved. +%% Copyright Ericsson AB 2000-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -272,6 +271,8 @@ scan1("->" ++ Cs, Toks, Pos) -> scan1(Cs, [{'->',Pos}|Toks], Pos); scan1("-|" ++ Cs, Toks, Pos) -> scan1(Cs, [{'-|',Pos}|Toks], Pos); +scan1("::" ++ Cs, Toks, Pos) -> + scan1(Cs, [{'::',Pos}|Toks], Pos); scan1([C|Cs], Toks, Pos) -> %Punctuation character P = list_to_atom([C]), scan1(Cs, [{P,Pos}|Toks], Pos); diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index 3ad3c8c690..6c75538194 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -91,6 +91,7 @@ is_pure(erlang, is_float, 1) -> true; is_pure(erlang, is_function, 1) -> true; is_pure(erlang, is_integer, 1) -> true; is_pure(erlang, is_list, 1) -> true; +is_pure(erlang, is_map, 1) -> true; is_pure(erlang, is_number, 1) -> true; is_pure(erlang, is_pid, 1) -> true; is_pure(erlang, is_port, 1) -> true; diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index ebc9b1c85b..7d6bf56ccb 100755 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -528,3 +528,11 @@ BEAM_FORMAT_NUMBER=0 # R15A 153: line/1 + +# R17 + +154: put_map_assoc/5 +155: put_map_exact/5 +156: is_map/2 +157: has_map_fields/3 +158: get_map_elements/3 diff --git a/lib/compiler/src/rec_env.erl b/lib/compiler/src/rec_env.erl index 31a1f8b0b7..555a331bd7 100644 --- a/lib/compiler/src/rec_env.erl +++ b/lib/compiler/src/rec_env.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -72,6 +72,7 @@ test_1({custom, F} = Type, N, Env) when is_integer(N), N > 0 -> test_1(_,0, Env) -> Env. -endif. +%%@clear %% Representation: @@ -95,7 +96,7 @@ test_1(_,0, Env) -> %% ===================================================================== %% @type environment(). An abstract environment. --type mapping() :: {'map', dict()} | {'rec', dict(), dict()}. +-type mapping() :: {'map', dict:dict()} | {'rec', dict:dict(), dict:dict()}. -type environment() :: [mapping(),...]. %% ===================================================================== diff --git a/lib/compiler/src/sys_core_dsetel.erl b/lib/compiler/src/sys_core_dsetel.erl index f6696992b9..60d83763f8 100644 --- a/lib/compiler/src/sys_core_dsetel.erl +++ b/lib/compiler/src/sys_core_dsetel.erl @@ -102,6 +102,13 @@ visit(Env, #c_literal{}=R) -> visit(Env0, #c_tuple{es=Es0}=R) -> {Es1,Env1} = visit_list(Env0, Es0), {R#c_tuple{es=Es1}, Env1}; +visit(Env0, #c_map{es=Es0}=R) -> + {Es1,Env1} = visit_list(Env0, Es0), + {R#c_map{es=Es1}, Env1}; +visit(Env0, #c_map_pair{key=K0,val=V0}=R) -> + {K,Env1} = visit(Env0, K0), + {V,Env2} = visit(Env1, V0), + {R#c_map_pair{key=K,val=V}, Env2}; visit(Env0, #c_cons{hd=H0,tl=T0}=R) -> {H1,Env1} = visit(Env0, H0), {T1,Env2} = visit(Env1, T0), @@ -212,6 +219,11 @@ visit_pat(Env0, #c_var{name=V}, Vs) -> {[V|Vs], dict:store(V, 0, Env0)}; visit_pat(Env0, #c_tuple{es=Es}, Vs) -> visit_pats(Es, Env0, Vs); +visit_pat(Env0, #c_map{es=Es}, Vs) -> + visit_pats(Es, Env0, Vs); +visit_pat(Env0, #c_map_pair{op=#c_literal{val=exact},key=V,val=K}, Vs0) -> + {Vs1, Env1} = visit_pat(Env0, V, Vs0), + visit_pat(Env1, K, Vs1); visit_pat(Env0, #c_cons{hd=H,tl=T}, Vs0) -> {Vs1, Env1} = visit_pat(Env0, H, Vs0), visit_pat(Env1, T, Vs1); diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index cda3f7d81e..09716d0866 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -70,9 +70,9 @@ -export([module/2,format_error/1]). -import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,all/2,any/2, - reverse/1,reverse/2,member/2,nth/2,flatten/1]). + reverse/1,reverse/2,member/2,nth/2,flatten/1,unzip/1]). --import(cerl, [ann_c_cons/3,ann_c_tuple/2]). +-import(cerl, [ann_c_cons/3,ann_c_map/3,ann_c_tuple/2]). -include("core_parse.hrl"). @@ -246,6 +246,16 @@ expr(#c_tuple{anno=Anno,es=Es0}=Tuple, Ctxt, Sub) -> value -> ann_c_tuple(Anno, Es) end; +expr(#c_map{anno=Anno,arg=V0,es=Es0}=Map, Ctxt, Sub) -> + Es = pair_list(Es0, Ctxt, Sub), + case Ctxt of + effect -> + add_warning(Map, useless_building), + expr(make_effect_seq(Es, Sub), Ctxt, Sub); + value -> + V = expr(V0, Ctxt, Sub), + ann_c_map(Anno,V,Es) + end; expr(#c_binary{segments=Ss}=Bin0, Ctxt, Sub) -> %% Warn for useless building, but always build the binary %% anyway to preserve a possible exception. @@ -295,6 +305,10 @@ expr(#c_let{}=Let, Ctxt, Sub) -> %% Now recursively re-process the new expression. expr(Expr, Ctxt, sub_new_preserve_types(Sub)) end; +expr(#c_letrec{body=#c_var{}}=Letrec, effect, _Sub) -> + %% This is named fun in an 'effect' context. Warn and ignore. + add_warning(Letrec, useless_building), + void(); expr(#c_letrec{defs=Fs0,body=B0}=Letrec, Ctxt, Sub) -> Fs1 = map(fun ({Name,Fb}) -> {Name,expr(Fb, {letrec,Ctxt}, Sub)} @@ -302,18 +316,54 @@ expr(#c_letrec{defs=Fs0,body=B0}=Letrec, Ctxt, Sub) -> B1 = body(B0, value, Sub), Letrec#c_letrec{defs=Fs1,body=B1}; expr(#c_case{}=Case0, Ctxt, Sub) -> + %% Ideally, the compiler should only emit warnings when there is + %% a real mistake in the code being compiled. We use the follow + %% heuristics in an attempt to approach that ideal: + %% + %% * If the guard for a clause always fails, we will emit a + %% warning. + %% + %% * If a case expression is a literal, we will emit no warnings + %% for clauses that will not match or for clauses that are + %% shadowed after a clause that will always match. That means + %% that code such as: + %% + %% case ?DEBUG of + %% false -> ok; + %% true -> ... + %% end + %% + %% (where ?DEBUG expands to either 'true' or 'false') will not + %% produce any warnings. + %% + %% * If the case expression is not literal, warnings will be + %% emitted for every clause that don't match and for all + %% clauses following a clause that will always match. + %% + %% * If no clause will ever match, there will be a warning + %% (in addition to any warnings that may have been emitted + %% according to the rules above). + %% case opt_bool_case(Case0) of #c_case{arg=Arg0,clauses=Cs0}=Case1 -> Arg1 = body(Arg0, value, Sub), - {Arg2,Cs1} = case_opt(Arg1, Cs0), - Cs2 = clauses(Arg2, Cs1, Case1, Ctxt, Sub), - Case = eval_case(Case1#c_case{arg=Arg2,clauses=Cs2}, Sub), - bsm_an(Case); + LitExpr = cerl:is_literal(Arg1), + {Arg2,Cs1} = case_opt(Arg1, Cs0, Sub), + Cs2 = clauses(Arg2, Cs1, Ctxt, Sub, LitExpr), + Case = Case1#c_case{arg=Arg2,clauses=Cs2}, + warn_no_clause_match(Case1, Case), + Expr = eval_case(Case, Sub), + case move_case_into_arg(Case, Sub) of + impossible -> + bsm_an(Expr); + Other -> + expr(Other, Ctxt, sub_new_preserve_types(Sub)) + end; Other -> expr(Other, Ctxt, Sub) end; expr(#c_receive{clauses=Cs0,timeout=T0,action=A0}=Recv, Ctxt, Sub) -> - Cs1 = clauses(#c_var{name='_'}, Cs0, Recv, Ctxt, Sub), %This is all we know + 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}; @@ -377,6 +427,16 @@ expr(#c_try{anno=A,arg=E0,vars=Vs0,body=B0,evars=Evs0,handler=H0}=Try, _, Sub0) expr_list(Es, Ctxt, Sub) -> [expr(E, Ctxt, Sub) || E <- Es]. +pair_list(Es, Ctxt, Sub) -> + [pair(E, Ctxt, Sub) || E <- Es]. + +pair(#c_map_pair{key=K,val=V}, effect, Sub) -> + make_effect_seq([K,V], Sub); +pair(#c_map_pair{key=K0,val=V0}=Pair, value=Ctxt, Sub) -> + K = expr(K0, Ctxt, Sub), + V = expr(V0, Ctxt, Sub), + Pair#c_map_pair{key=K,val=V}. + bitstr_list(Es, Sub) -> [bitstr(E, Sub) || E <- Es]. @@ -547,6 +607,14 @@ eval_binary_1([#c_bitstr{val=#c_literal{val=Val},size=#c_literal{val=Sz}, error:_ -> throw(impossible) end; +eval_binary_1([#c_bitstr{val=#c_literal{},size=#c_literal{}, + unit=#c_literal{},type=#c_literal{}, + flags=#c_cons{}=Flags}=Bitstr|Ss], Acc0) -> + case cerl:fold_literal(Flags) of + #c_literal{} = Flags1 -> + eval_binary_1([Bitstr#c_bitstr{flags=Flags1}|Ss], Acc0); + _ -> throw(impossible) + end; eval_binary_1([], Acc) -> Acc; eval_binary_1(_, _) -> throw(impossible). @@ -646,7 +714,7 @@ useless_call(effect, #c_call{anno=Anno, useless_call(_, _) -> no. %% make_effect_seq([Expr], Sub) -> #c_seq{}|void() -%% Convert a list of epressions evaluated in effect context to a chain of +%% Convert a list of expressions evaluated in effect context to a chain of %% #c_seq{}. The body in the innermost #c_seq{} will be void(). %% Anything that will not have any effect will be thrown away. @@ -1310,6 +1378,7 @@ eval_is_record(Call, _, _, _, _) -> Call. is_not_integer(#c_literal{val=Val}) when not is_integer(Val) -> true; is_not_integer(#c_tuple{}) -> true; is_not_integer(#c_cons{}) -> true; +is_not_integer(#c_map{}) -> true; is_not_integer(_) -> false. %% is_not_tuple(Core) -> true | false. @@ -1317,6 +1386,7 @@ is_not_integer(_) -> false. is_not_tuple(#c_literal{val=Val}) when not is_tuple(Val) -> true; is_not_tuple(#c_cons{}) -> true; +is_not_tuple(#c_map{}) -> true; is_not_tuple(_) -> false. %% eval_setelement(Call, Pos, Tuple, NewVal) -> Core. @@ -1452,14 +1522,14 @@ let_subst_list([], [], _) -> {[],[],[]}. %%pattern(Pat, Sub) -> pattern(Pat, Sub, Sub). -pattern(#c_var{name=V0}=Pat, Isub, Osub) -> +pattern(#c_var{}=Pat, Isub, Osub) -> case sub_is_val(Pat, Isub) of true -> V1 = make_var_name(), Pat1 = #c_var{name=V1}, {Pat1,sub_set_var(Pat, Pat1, scope_add([V1], Osub))}; false -> - {Pat,sub_del_var(Pat, scope_add([V0], Osub))} + {Pat,sub_del_var(Pat, Osub)} end; pattern(#c_literal{}=Pat, _, Osub) -> {Pat,Osub}; pattern(#c_cons{anno=Anno,hd=H0,tl=T0}, Isub, Osub0) -> @@ -1469,6 +1539,9 @@ pattern(#c_cons{anno=Anno,hd=H0,tl=T0}, Isub, Osub0) -> pattern(#c_tuple{anno=Anno,es=Es0}, Isub, Osub0) -> {Es1,Osub1} = pattern_list(Es0, Isub, Osub0), {ann_c_tuple(Anno, Es1),Osub1}; +pattern(#c_map{anno=Anno,es=Es0}=Map, Isub, Osub0) -> + {Es1,Osub1} = map_pair_pattern_list(Es0, Isub, Osub0), + {Map#c_map{anno=Anno,es=Es1},Osub1}; pattern(#c_binary{segments=V0}=Pat, Isub, Osub0) -> {V1,Osub1} = bin_pattern_list(V0, Isub, Osub0), {Pat#c_binary{segments=V1},Osub1}; @@ -1478,6 +1551,15 @@ pattern(#c_alias{var=V0,pat=P0}=Pat, Isub, Osub0) -> Osub = update_types(V1, [P1], Osub2), {Pat#c_alias{var=V1,pat=P1},Osub}. +map_pair_pattern_list(Ps0, Isub, Osub0) -> + {Ps,{_,Osub}} = mapfoldl(fun map_pair_pattern/2, {Isub,Osub0}, Ps0), + {Ps,Osub}. + +map_pair_pattern(#c_map_pair{op=#c_literal{val=exact},key=K0,val=V0}=Pair,{Isub,Osub0}) -> + K = expr(K0, 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}. @@ -1522,6 +1604,9 @@ is_subst(_) -> false. %% chains so we never have to search more than once. Use orddict so %% we know the format. %% +%% In addition to the list of substitutions, we also keep track of +%% all variable currently live (the scope). +%% %% sub_subst_scope/1 adds dummy substitutions for all variables %% in the scope in order to force renaming if variables in the %% scope occurs as pattern variables. @@ -1548,8 +1633,17 @@ sub_set_name(V, Val, #sub{v=S,s=Scope,t=Tdb0}=Sub) -> Tdb = copy_type(V, Val, Tdb1), Sub#sub{v=orddict:store(V, Val, S),s=gb_sets:add(V, Scope),t=Tdb}. -sub_del_var(#c_var{name=V}, #sub{v=S,t=Tdb}=Sub) -> - Sub#sub{v=orddict:erase(V, S),t=kill_types(V, Tdb)}. +sub_del_var(#c_var{name=V}, #sub{v=S,s=Scope,t=Tdb}=Sub) -> + %% Profiling shows that for programs with many record operations, + %% sub_del_var/2 is a bottleneck. Since the scope contains all + %% variables that are live, we know that V cannot be present in S + %% if it is not in the scope. + case gb_sets:is_member(V, Scope) of + false -> + Sub#sub{s=gb_sets:insert(V, Scope)}; + true -> + Sub#sub{v=orddict:erase(V, S),t=kill_types(V, Tdb)} + end. sub_subst_var(#c_var{name=V}, Val, #sub{v=S0}) -> %% Fold chained substitutions. @@ -1559,47 +1653,50 @@ sub_subst_scope(#sub{v=S0,s=Scope}=Sub) -> S = [{-1,#c_var{name=Sv}} || Sv <- gb_sets:to_list(Scope)]++S0, Sub#sub{v=S}. -sub_is_val(#c_var{name=V}, #sub{v=S}) -> - v_is_value(V, S). - -v_is_value(Var, Sub) -> - any(fun ({_,#c_var{name=Val}}) when Val =:= Var -> true; - (_) -> false - end, Sub). - -%% clauses(E, [Clause], TopLevel, Context, Sub) -> [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, Cs0, TopLevel, Ctxt, Sub) -> - Cs = clauses_1(E, Cs0, Ctxt, Sub), - - %% Here we want to warn if no clauses whatsoever will ever - %% match, because that is probably a mistake. - case all(fun is_compiler_generated/1, Cs) andalso - any(fun(C) -> not is_compiler_generated(C) end, Cs0) of +sub_is_val(#c_var{name=V}, #sub{v=S,s=Scope}) -> + %% When the bottleneck in sub_del_var/2 was eliminated, this + %% became the new bottleneck. Since the scope contains all + %% live variables, a variable V can only be the target for + %% a substitution if it is in the scope. + gb_sets:is_member(V, Scope) andalso v_is_value(V, S). + +v_is_value(Var, [{_,#c_var{name=Var}}|_]) -> true; +v_is_value(Var, [_|T]) -> v_is_value(Var, T); +v_is_value(_, []) -> false. + +%% warn_no_clause_match(CaseOrig, CaseOpt) -> ok +%% Generate a warning if none of the user-specified clauses +%% will match. + +warn_no_clause_match(CaseOrig, CaseOpt) -> + OrigCs = cerl:case_clauses(CaseOrig), + OptCs = cerl:case_clauses(CaseOpt), + case any(fun(C) -> not is_compiler_generated(C) end, OrigCs) andalso + all(fun is_compiler_generated/1, OptCs) of true -> %% The original list of clauses did contain at least one %% user-specified clause, but none of them will match. %% That is probably a mistake. - add_warning(TopLevel, no_clause_match); + add_warning(CaseOrig, no_clause_match); false -> %% Either there were user-specified clauses left in %% the transformed clauses, or else none of the original %% clauses were user-specified to begin with (as in 'andalso'). ok - end, + end. - Cs. +%% clauses(E, [Clause], TopLevel, Context, Sub) -> [Clause]. +%% Trim the clauses by removing all clauses AFTER the first one which +%% is guaranteed to match. Also remove all trivially false clauses. -clauses_1(E, [C0|Cs], Ctxt, Sub) -> +clauses(E, [C0|Cs], Ctxt, Sub, LitExpr) -> #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 {yes,yes} -> - Line = get_line(core_lib:get_anno(C1)), - case core_lib:is_literal(E) of + case LitExpr of false -> + Line = get_line(core_lib:get_anno(C1)), shadow_warning(Cs, Line); true -> %% If the case expression is a literal, @@ -1608,15 +1705,13 @@ clauses_1(E, [C0|Cs], Ctxt, Sub) -> ok end, [C1]; %Skip the rest - {no,_Suc} -> - clauses_1(E, Cs, Ctxt, Sub); %Skip this clause - {_Mat,no} -> + {_Mat,no} -> %Guard fails. add_warning(C1, nomatch_guard), - clauses_1(E, Cs, Ctxt, Sub); %Skip this clause + clauses(E, Cs, Ctxt, Sub, LitExpr); %Skip this clause {_Mat,_Suc} -> - [C1|clauses_1(E, Cs, Ctxt, Sub)] + [C1|clauses(E, Cs, Ctxt, Sub, LitExpr)] end; -clauses_1(_, [], _, _) -> []. +clauses(_, [], _, _, _) -> []. shadow_warning([C|Cs], none) -> add_warning(C, nomatch_shadow), @@ -1634,69 +1729,18 @@ will_succeed(#c_literal{val=true}) -> yes; will_succeed(#c_literal{val=false}) -> no; will_succeed(_Guard) -> maybe. -%% will_match(Expr, [Pattern]) -> yes | maybe | no. -%% Test if we know whether a match will succeed/fail or just don't -%% know. Be conservative. +%% will_match(Expr, [Pattern]) -> yes | maybe. +%% We KNOW that this function is only used after optimizations +%% in case_opt/4. Therefore clauses that can definitely not match +%% have already been pruned. will_match(#c_values{es=Es}, Ps) -> - will_match_list(Es, Ps, yes); + will_match_1(cerl_clauses:match_list(Ps, Es)); will_match(E, [P]) -> - will_match_1(E, P). - -will_match_1(_E, #c_var{}) -> yes; %Will always match -will_match_1(E, #c_alias{pat=P}) -> %Pattern decides - will_match_1(E, P); -will_match_1(#c_var{}, _P) -> maybe; -will_match_1(#c_tuple{es=Es}, #c_tuple{es=Ps}) -> - will_match_list(Es, Ps, yes); -will_match_1(#c_literal{val=Lit}, P) -> - will_match_lit(Lit, P); -will_match_1(_, _) -> maybe. - -will_match_list([E|Es], [P|Ps], M) -> - case will_match_1(E, P) of - yes -> will_match_list(Es, Ps, M); - maybe -> will_match_list(Es, Ps, maybe); - no -> no - end; -will_match_list([], [], M) -> M. - -will_match_lit(Cons, #c_cons{hd=Hp,tl=Tp}) -> - case Cons of - [H|T] -> - case will_match_lit(H, Hp) of - yes -> will_match_lit(T, Tp); - Other -> Other - end; - _ -> - no - end; -will_match_lit(Tuple, #c_tuple{es=Es}) -> - case is_tuple(Tuple) andalso tuple_size(Tuple) =:= length(Es) of - true -> will_match_lit_list(tuple_to_list(Tuple), Es); - false -> no - end; -will_match_lit(Bin, #c_binary{}) -> - case is_bitstring(Bin) of - true -> maybe; - false -> no - end; -will_match_lit(_, #c_var{}) -> - yes; -will_match_lit(Lit, #c_alias{pat=P}) -> - will_match_lit(Lit, P); -will_match_lit(Lit1, #c_literal{val=Lit2}) -> - case Lit1 =:= Lit2 of - true -> yes; - false -> no - end. + will_match_1(cerl_clauses:match(P, E)). -will_match_lit_list([H|T], [P|Ps]) -> - case will_match_lit(H, P) of - yes -> will_match_lit_list(T, Ps); - Other -> Other - end; -will_match_lit_list([], []) -> yes. +will_match_1({false,_}) -> maybe; +will_match_1({true,_}) -> yes. %% opt_bool_case(CoreExpr) - CoreExpr'. %% Do various optimizations to case statement that has a @@ -1760,9 +1804,14 @@ opt_bool_clauses([#c_clause{pats=[#c_literal{val=Lit}], true -> %% This clause will match. C = C0#c_clause{body=opt_bool_case(B)}, - case Lit of - false -> [C|opt_bool_clauses(Cs, SeenT, true)]; - true -> [C|opt_bool_clauses(Cs, true, SeenF)] + case {Lit,SeenT,SeenF} of + {false,_,false} -> + [C|opt_bool_clauses(Cs, SeenT, true)]; + {true,false,_} -> + [C|opt_bool_clauses(Cs, true, SeenF)]; + _ -> + add_warning(C, nomatch_shadow), + opt_bool_clauses(Cs, SeenT, SeenF) end end; opt_bool_clauses([#c_clause{pats=Ps,guard=#c_literal{val=true}}=C|Cs], SeenT, SeenF) -> @@ -1895,166 +1944,313 @@ opt_bool_case_guard(Arg, [#c_clause{pats=[#c_literal{val=false}]}=Fc,Tc]) -> %% last clause is guaranteed to match so if there is only one clause %% with a pattern containing only variables then rewrite to a let. -eval_case(#c_case{arg=#c_var{name=V}, - clauses=[#c_clause{pats=[P],guard=G,body=B}|_]}=Case, - #sub{t=Tdb}=Sub) -> - case orddict:find(V, Tdb) of - {ok,Type} -> - case {will_match_type(P, Type),will_succeed(G)} of - {yes,yes} -> - {Ps,Es} = remove_non_vars(P, Type), - expr(#c_let{vars=Ps,arg=#c_values{es=Es},body=B}, - sub_new(Sub)); - {_,_} -> - eval_case_1(Case, Sub) - end; - error -> eval_case_1(Case, Sub) - end; -eval_case(Case, Sub) -> eval_case_1(Case, Sub). - -eval_case_1(#c_case{arg=E,clauses=[#c_clause{pats=Ps,body=B}]}=Case, Sub) -> - case is_var_pat(Ps) of - true -> expr(#c_let{vars=Ps,arg=E,body=B}, sub_new(Sub)); - false -> eval_case_2(E, Ps, B, Case) - end; -eval_case_1(Case, _) -> Case. - -eval_case_2(E, [P], B, Case) -> - %% Recall that there is only one clause and that it is guaranteed to match. - %% If E and P are literals, they must be the same literal and the body - %% can be used directly as there are no variables that need to be bound. - %% Otherwise, P could be an alias meaning that two or more variables - %% would be bound to E. We don't bother to optimize that case as it - %% is rather uncommon. - case core_lib:is_literal(E) andalso core_lib:is_literal(P) of - false -> Case; - true -> B - end; -eval_case_2(_, _, _, Case) -> Case. - -is_var_pat(Ps) -> - all(fun (#c_var{}) -> true; - (_Pat) -> false - end, Ps). - -will_match_type(#c_tuple{es=Es}, #c_tuple{es=Ps}) -> - will_match_list_type(Es, Ps); -will_match_type(#c_literal{val=Atom}, #c_literal{val=Atom}) -> yes; -will_match_type(#c_var{}, #c_var{}) -> yes; -will_match_type(#c_var{}, #c_alias{}) -> yes; -will_match_type(_, _) -> no. - -will_match_list_type([E|Es], [P|Ps]) -> - case will_match_type(E, P) of - yes -> will_match_list_type(Es, Ps); - no -> no - end; -will_match_list_type([], []) -> yes; -will_match_list_type(_, _) -> no. %Different length - -remove_non_vars(Ps0, Es0) -> - {Ps,Es} = remove_non_vars(Ps0, Es0, [], []), - {reverse(Ps),reverse(Es)}. - -remove_non_vars(#c_tuple{es=Ps}, #c_tuple{es=Es}, Pacc, Eacc) -> - remove_non_vars_list(Ps, Es, Pacc, Eacc); -remove_non_vars(#c_var{}=Var, #c_alias{var=Evar}, Pacc, Eacc) -> - {[Var|Pacc],[Evar|Eacc]}; -remove_non_vars(#c_var{}=Var, #c_var{}=Evar, Pacc, Eacc) -> - {[Var|Pacc],[Evar|Eacc]}; -remove_non_vars(P, E, Pacc, Eacc) -> - true = core_lib:is_literal(P) andalso core_lib:is_literal(E), %Assertion. - {Pacc,Eacc}. - -remove_non_vars_list([P|Ps], [E|Es], Pacc0, Eacc0) -> - {Pacc,Eacc} = remove_non_vars(P, E, Pacc0, Eacc0), - remove_non_vars_list(Ps, Es, Pacc, Eacc); -remove_non_vars_list([], [], Pacc, Eacc) -> - {Pacc,Eacc}. +eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0, + guard=#c_literal{val=true}, + body=B}]}=Case, Sub) -> + Es = case cerl:is_c_values(E) of + true -> cerl:values_es(E); + false -> [E] + end, + %% Consider: + %% + %% case SomeSideEffect() of + %% X=Y -> ... + %% end + %% + %% We must not rewrite it to: + %% + %% let <X,Y> = <SomeSideEffect(),SomeSideEffect()> in ... + %% + %% because SomeSideEffect() would be evaluated twice. + %% + %% Instead we must evaluate the case expression in an outer let + %% like this: + %% + %% let NewVar = SomeSideEffect() in + %% let <X,Y> = <NewVar,NewVar> in ... + %% + Vs = make_vars([], length(Es)), + case cerl_clauses:match_list(Ps0, Vs) of + {false,_} -> + %% This can only happen if the Core Erlang code is + %% handwritten or generated by another code generator + %% than v3_core. Assuming that the Core Erlang program + %% is correct, the clause will always match at run-time. + Case; + {true,Bs} -> + {Ps,As} = unzip(Bs), + InnerLet = cerl:c_let(Ps, core_lib:make_values(As), B), + Let = cerl:c_let(Vs, E, InnerLet), + expr(Let, sub_new(Sub)) + end; +eval_case(Case, _) -> Case. %% case_opt(CaseArg, [Clause]) -> {CaseArg,[Clause]}. -%% Try and optimise case by avoid building a tuple in -%% the case expression. Instead of building a tuple -%% in the case expression, combine the elements into -%% multiple "values". If a clause refers to the tuple -%% in the case expression (that was not built), introduce -%% a let into the guard and/or body to build the tuple. +%% Try and optimise a case by avoid building tuples or lists +%% in the case expression. Instead combine the variable parts +%% of the case expression to multiple "values". If a clause +%% refers to the constructed term in the case expression (which +%% was not built), introduce a let into the guard and/or body to +%% build the term. %% -%% case {Expr1,Expr2} of case <Expr1,Expr2> of -%% {P1,P2} -> ... <P1,P2> -> ... +%% case {ok,[Expr1,Expr2]} of case <Expr1,Expr2> of +%% {ok,[P1,P2]} -> ... <P1,P2> -> ... %% . ==> . %% . . %% . . -%% Var -> <Var1,Var2> -> -%% ... Var ... let <Var> = {Var1,Var2} -%% in ... Var ... +%% Var -> <Var1,Var2> -> +%% ... Var ... let <Var> = {ok,[Var1,Var2]} +%% in ... Var ... %% . . %% . . %% . . -%% end. end. +%% end. end. %% -case_opt(#c_tuple{anno=A,es=Es}, Cs0) -> - Cs1 = case_opt_cs(Cs0, length(Es)), - {core_lib:set_anno(core_lib:make_values(Es), A),Cs1}; -case_opt(Arg, Cs) -> {Arg,Cs}. - -case_opt_cs([#c_clause{pats=Ps0,guard=G,body=B}=C|Cs], Arity) -> - case case_tuple_pat(Ps0, Arity) of - {ok,Ps1,Avs} -> - Flet = fun ({V,Pat}, Body) -> letify(V, Pat, Body) end, - [C#c_clause{pats=Ps1, - guard=foldl(Flet, G, Avs), - body=foldl(Flet, B, Avs)}|case_opt_cs(Cs, Arity)]; - error -> %Can't match - add_warning(C, nomatch_clause_type), - case_opt_cs(Cs, Arity) +case_opt(Arg, Cs0, Sub) -> + Cs1 = [{cerl:clause_pats(C),C,[],[]} || C <- Cs0], + Args0 = case cerl:is_c_values(Arg) of + false -> [Arg]; + true -> cerl:values_es(Arg) + end, + LitExpr = cerl:is_literal(Arg), + {Args,Cs2} = case_opt_args(Args0, Cs1, Sub, LitExpr, []), + Cs = [cerl:update_c_clause(C, + reverse(Ps), + letify(Bs, cerl:clause_guard(C)), + letify(Bs, cerl:clause_body(C))) || + {[],C,Ps,Bs} <- Cs2], + {core_lib:make_values(Args),Cs}. + +case_opt_args([A0|As0], Cs0, Sub, LitExpr, Acc) -> + case case_opt_arg(A0, Sub, Cs0, LitExpr) of + {error,Cs1} -> + %% Nothing to be done. Move on to the next argument. + Cs = [{Ps,C,[P|PsAcc],Bs} || {[P|Ps],C,PsAcc,Bs} <- Cs1], + case_opt_args(As0, Cs, Sub, LitExpr, [A0|Acc]); + {ok,As1,Cs} -> + %% The argument was either expanded (from tuple/list) or + %% removed (literal). + case_opt_args(As1++As0, Cs, Sub, LitExpr, Acc) + end; +case_opt_args([], Cs, _Sub, _LitExpr, Acc) -> + {reverse(Acc),Cs}. + +%% case_opt_arg(Expr, Sub, Clauses0, LitExpr) -> +%% {ok,Args,Clauses} | error +%% Try to expand one argument to several arguments (if tuple/list) +%% or to remove a literal argument. +%% +case_opt_arg(E0, Sub, Cs, LitExpr) -> + E = maybe_replace_var(E0, Sub), + case cerl:is_data(E) of + false -> + {error,Cs}; + true -> + case cerl:data_type(E) of + {atomic,_} -> + case_opt_lit(E, Cs, LitExpr); + _ -> + case_opt_data(E, Cs, LitExpr) + end + end. + +%% maybe_replace_var(Expr0, Sub) -> Expr +%% If Expr0 is a variable that has been previously matched and +%% is known to be a tuple, return the tuple instead. Otherwise +%% return Expr0 unchanged. +%% +maybe_replace_var(E, Sub) -> + case cerl:is_c_var(E) of + false -> E; + true -> maybe_replace_var_1(E, Sub) + end. + +maybe_replace_var_1(E, #sub{t=Tdb}) -> + case orddict:find(cerl:var_name(E), Tdb) of + {ok,T0} -> + case cerl:is_c_tuple(T0) of + false -> + E; + true -> + %% The pattern was a tuple. Now we must make sure + %% that the elements of the tuple are suitable. In + %% particular, we don't want binary or map + %% construction here, since that means that the + %% binary or map will be constructed in the 'case' + %% argument. That is wasteful for binaries. Even + %% worse is that any map pattern that use the ':=' + %% operator will fail when used in map + %% construction (only the '=>' operator is allowed + %% when constructing a map from scratch). + ToData = fun coerce_to_data/1, + try + cerl_trees:map(ToData, T0) + catch + throw:impossible -> + %% Something unsuitable was found (map or + %% or binary). Keep the variable. + E + end + end; + error -> + E + end. + +%% coerce_to_data(Core) -> Core' +%% Coerce an element originally from a pattern to an data item or or +%% variable. Throw an 'impossible' exception if non-data Core Erlang +%% terms such as binary construction or map construction are +%% encountered. + +coerce_to_data(C) -> + case cerl:is_c_alias(C) of + false -> + case cerl:is_data(C) orelse cerl:is_c_var(C) of + true -> C; + false -> throw(impossible) + end; + true -> + coerce_to_data(cerl:alias_pat(C)) + end. + +%% case_opt_lit(Literal, Clauses0, LitExpr) -> +%% {ok,[],Clauses} | error +%% The current part of the case expression is a literal. That +%% means that we will know at compile-time whether a clause +%% will match, and we can remove the corresponding pattern from +%% each clause. +%% +%% The only complication is if the literal is a binary. Binary +%% pattern matching is tricky, so we will give up in that case. + +case_opt_lit(Lit, Cs0, LitExpr) -> + Cs1 = case_opt_lit_1(Lit, Cs0, LitExpr), + try case_opt_lit_2(Lit, Cs1) of + Cs -> + {ok,[],Cs} + catch + throw:impossible -> + {error,Cs1} + end. + +case_opt_lit_1(E, [{[P|_],C,_,_}=Current|Cs], LitExpr) -> + case cerl_clauses:match(P, E) of + none -> + %% The pattern will not match the literal. Remove the clause. + %% Unless the entire case expression is a literal, also + %% emit a warning. + case LitExpr of + false -> add_warning(C, nomatch_clause_type); + true -> ok + end, + case_opt_lit_1(E, Cs, LitExpr); + _ -> + [Current|case_opt_lit_1(E, Cs, LitExpr)] + end; +case_opt_lit_1(_, [], _) -> []. + +case_opt_lit_2(E, [{[P|Ps],C,PsAcc,Bs0}|Cs]) -> + %% Non-matching clauses have already been removed in case_opt_lit_1/3. + case cerl_clauses:match(P, E) of + {true,Bs} -> + %% The pattern matches the literal. Remove the pattern + %% and update the bindings. + [{Ps,C,PsAcc,Bs++Bs0}|case_opt_lit_2(E, Cs)]; + {false,_} -> + %% Binary literal and pattern. We are not sure whether + %% the pattern will match. + throw(impossible) + end; +case_opt_lit_2(_, []) -> []. + +%% case_opt_data(Expr, Clauses0, LitExpr) -> {ok,Exprs,Clauses} + +case_opt_data(E, Cs0, LitExpr) -> + Es = cerl:data_es(E), + Cs = case_opt_data_1(Cs0, Es, + {cerl:data_type(E),cerl:data_arity(E)}, + LitExpr), + {ok,Es,Cs}. + +case_opt_data_1([{[P|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig, LitExpr) -> + case case_data_pat(P, TypeSig) of + {ok,Ps1,Bs1} -> + [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}| + case_opt_data_1(Cs, Es, TypeSig,LitExpr)]; + error -> + case LitExpr of + false -> add_warning(C, nomatch_clause_type); + true -> ok + end, + case_opt_data_1(Cs, Es, TypeSig, LitExpr) end; -case_opt_cs([], _) -> []. +case_opt_data_1([], _, _, _) -> []. -%% case_tuple_pat([Pattern], Arity) -> {ok,[Pattern],[{AliasVar,Pat}]} | error. +%% case_data_pat(Pattern, Type, Arity) -> {ok,[Pattern],[{AliasVar,Pat}]} | error. -case_tuple_pat([#c_tuple{es=Ps}], Arity) when length(Ps) =:= Arity -> - {ok,Ps,[]}; -case_tuple_pat([#c_literal{val=T}], Arity) when tuple_size(T) =:= Arity -> - Ps = [#c_literal{val=E} || E <- tuple_to_list(T)], - {ok,Ps,[]}; -case_tuple_pat([#c_var{anno=Anno0}=V], Arity) -> - Vars = make_vars(Anno0, 1, Arity), +case_data_pat(P, TypeSig) -> + case cerl:is_data(P) of + false -> + case_data_pat_var(P, TypeSig); + true -> + case {cerl:data_type(P),cerl:data_arity(P)} of + TypeSig -> + {ok,cerl:data_es(P),[]}; + {_,_} -> + error + end + end. + +%% case_data_pat_var(Pattern, {DataType,ArityType}) -> +%% {ok,[Pattern],[{AliasVar,Pat}]} +case_data_pat_var(P, {Type,Arity}=TypeSig) -> %% If the entire case statement is evaluated in an effect %% context (e.g. "case {A,B} of ... end, ok"), there will %% be a warning that a term is constructed but never used. - %% To avoid that warning, we must annotate the tuple as - %% compiler generated. - - Anno = [compiler_generated|Anno0], - {ok,Vars,[{V,#c_tuple{anno=Anno,es=Vars}}]}; -case_tuple_pat([#c_alias{var=V,pat=P}], Arity) -> - case case_tuple_pat([P], Arity) of - {ok,Ps,Avs} -> - Anno0 = core_lib:get_anno(P), - Anno = [compiler_generated|Anno0], - {ok,Ps,[{V,#c_tuple{anno=Anno,es=unalias_pat_list(Ps)}}|Avs]}; - error -> + %% To avoid that warning, we must annotate the data + %% constructor as compiler generated. + Ann = [compiler_generated|cerl:get_ann(P)], + case cerl:type(P) of + var -> + Vars = make_vars(cerl:get_ann(P), Arity), + {ok,Vars,[{P,cerl:ann_make_data(Ann, Type, Vars)}]}; + alias -> + V = cerl:alias_var(P), + Apat = cerl:alias_pat(P), + case case_data_pat(Apat, TypeSig) of + {ok,Ps,Bs} -> + {ok,Ps,[{V,cerl:ann_make_data(Ann, Type, unalias_pat_list(Ps))}|Bs]}; + error -> + error + end; + _ -> error - end; -case_tuple_pat(_, _) -> error. + end. %% unalias_pat(Pattern) -> Pattern. %% Remove all the aliases in a pattern but using the alias variables %% instead of the values. We KNOW they will be bound. -unalias_pat(#c_alias{var=V}) -> V; -unalias_pat(#c_cons{anno=Anno,hd=H0,tl=T0}) -> - H1 = unalias_pat(H0), - T1 = unalias_pat(T0), - ann_c_cons(Anno, H1, T1); -unalias_pat(#c_tuple{anno=Anno,es=Ps}) -> - ann_c_tuple(Anno, unalias_pat_list(Ps)); -unalias_pat(Atomic) -> Atomic. +unalias_pat(P) -> + case cerl:is_c_alias(P) of + true -> + cerl:alias_var(P); + false -> + case cerl:is_data(P) of + false -> + P; + true -> + Es = unalias_pat_list(cerl:data_es(P)), + cerl:update_data(P, cerl:data_type(P), Es) + end + end. unalias_pat_list(Ps) -> [unalias_pat(P) || P <- Ps]. +make_vars(A, Max) -> + make_vars(A, 1, Max). + make_vars(A, I, Max) when I =< Max -> [make_var(A)|make_vars(A, I+1, Max)]; make_vars(_, _, _) -> []. @@ -2067,6 +2263,11 @@ make_var_name() -> put(new_var_num, N+1), list_to_atom("fol"++integer_to_list(N)). +letify(Bs, Body) -> + foldr(fun({V,Val}, B) -> + letify(V, Val, B) + end, Body, Bs). + letify(#c_var{name=Vname}=Var, Val, Body) -> case core_lib:is_var_used(Vname, Body) of true -> @@ -2077,23 +2278,23 @@ letify(#c_var{name=Vname}=Var, Val, Body) -> %% opt_case_in_let(LetExpr) -> LetExpr' -opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let) -> - opt_case_in_let_0(Vs, Arg, B, Let). +opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) -> + opt_case_in_let_0(Vs, Arg, B, Let, Sub). opt_case_in_let_0([#c_var{name=V}], Arg, - #c_case{arg=#c_var{name=V},clauses=Cs}=Case, Let) -> + #c_case{arg=#c_var{name=V},clauses=Cs}=Case, Let, Sub) -> case opt_case_in_let_1(V, Arg, Cs) of impossible -> case is_simple_case_arg(Arg) andalso not core_lib:is_var_used(V, Case#c_case{arg=#c_literal{val=nil}}) of true -> - opt_bool_case(Case#c_case{arg=Arg}); + expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new(Sub)); false -> Let end; Expr -> Expr end; -opt_case_in_let_0(_, _, _, Let) -> Let. +opt_case_in_let_0(_, _, _, Let, _) -> Let. opt_case_in_let_1(V, Arg, Cs) -> try @@ -2183,16 +2384,31 @@ is_safe_bool_expr(Core, Sub) -> is_safe_bool_expr_1(Core, Sub, gb_sets:empty()). is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_record}, - args=[_,_]}, - _Sub, _BoolVars) -> + 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); +is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}}, + _Sub, _BoolVars) -> + false; +is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=Name},args=Args}, Sub, BoolVars) -> NumArgs = length(Args), @@ -2342,6 +2558,25 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, Case#c_case{arg=Cexpr,clauses=[Ca,Cb]}; {_,_,_} -> impossible end; +move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, + #c_seq{arg=Sarg0,body=Sbody0}=Seq, Sub0) -> + %% + %% let <Lvars> = do <Seq-arg> + %% <Seq-body> + %% in <Let-body> + %% + %% ==> + %% + %% do <Seq-arg> + %% let <Lvars> = <Seq-body> + %% in <Let-body> + %% + Sarg = body(Sarg0, Sub0), + Sbody1 = body(Sbody0, Sub0), + {Lvs,Sbody,Sub} = let_substs(Lvs0, Sbody1, Sub0), + Lbody = body(Lbody0, Sub), + Seq#c_seq{arg=Sarg,body=Let#c_let{vars=Lvs,arg=core_lib:make_values(Sbody), + body=Lbody}}; move_let_into_expr(_Let, _Expr, _Sub) -> impossible. is_failing_clause(#c_clause{body=B}) -> @@ -2402,7 +2637,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body0, effect, Sub) -> expr(#c_seq{arg=Arg,body=Body}, effect, sub_new_preserve_types(Sub)); true -> Let = Let0#c_let{vars=Vs,arg=Arg,body=Body}, - opt_case_in_let_arg(opt_case_in_let(Let), effect, Sub) + opt_case_in_let_arg(opt_case_in_let(Let, Sub), effect, Sub) end end; opt_simple_let_2(Let, Vs0, Arg0, Body, value, Sub) -> @@ -2425,10 +2660,81 @@ opt_simple_let_2(Let, Vs0, Arg0, Body, value, Sub) -> expr(#c_seq{arg=Arg,body=Body}, value, sub_new_preserve_types(Sub)); {Vs,Arg,Body} -> opt_case_in_let_arg( - opt_case_in_let(Let#c_let{vars=Vs,arg=Arg,body=Body}), + opt_case_in_let(Let#c_let{vars=Vs,arg=Arg,body=Body}, Sub), value, Sub) end. +move_case_into_arg(#c_case{arg=#c_let{vars=OuterVars0,arg=OuterArg, + body=InnerArg0}=Outer, + clauses=InnerClauses}=Inner, Sub) -> + %% + %% case let <OuterVars> = <OuterArg> in <InnerArg> of + %% <InnerClauses> + %% end + %% + %% ==> + %% + %% let <OuterVars> = <OuterArg> + %% in case <InnerArg> of <InnerClauses> end + %% + ScopeSub0 = sub_subst_scope(Sub#sub{t=[]}), + {OuterVars,ScopeSub} = pattern_list(OuterVars0, ScopeSub0), + InnerArg = body(InnerArg0, ScopeSub), + Outer#c_let{vars=OuterVars,arg=OuterArg, + body=Inner#c_case{arg=InnerArg,clauses=InnerClauses}}; +move_case_into_arg(#c_case{arg=#c_case{arg=OuterArg, + clauses=[OuterCa0,OuterCb]}=Outer, + clauses=InnerClauses}=Inner0, Sub) -> + case is_failing_clause(OuterCb) of + true -> + #c_clause{pats=OuterPats0,guard=OuterGuard0, + body=InnerArg0} = OuterCa0, + %% + %% case case <OuterArg> of + %% <OuterPats> when <OuterGuard> -> <InnerArg> + %% <OuterCb> + %% ... + %% end of + %% <InnerClauses> + %% end + %% + %% ==> + %% + %% case <OuterArg> of + %% <OuterPats> when <OuterGuard> -> + %% case <InnerArg> of <InnerClauses> end + %% <OuterCb> + %% end + %% + ScopeSub0 = sub_subst_scope(Sub#sub{t=[]}), + {OuterPats,ScopeSub} = pattern_list(OuterPats0, ScopeSub0), + OuterGuard = guard(OuterGuard0, ScopeSub), + InnerArg = body(InnerArg0, ScopeSub), + Inner = Inner0#c_case{arg=InnerArg,clauses=InnerClauses}, + OuterCa = OuterCa0#c_clause{pats=OuterPats,guard=OuterGuard, + body=Inner}, + Outer#c_case{arg=OuterArg, + clauses=[OuterCa,OuterCb]}; + false -> + impossible + end; +move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer, + clauses=InnerClauses}=Inner, _Sub) -> + %% + %% case do <OuterArg> <InnerArg> of + %% <InnerClauses> + %% end + %% + %% ==> + %% + %% do <OuterArg> + %% case <InnerArg> of <InerClauses> end + %% + Outer#c_seq{arg=OuterArg, + body=Inner#c_case{arg=InnerArg,clauses=InnerClauses}}; +move_case_into_arg(_, _) -> + impossible. + %% In guards only, rewrite a case in a let argument like %% %% let <Var> = case <> of diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index 7d918a55ed..761ae8409c 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -228,6 +228,13 @@ pattern({cons,Line,H,T}, St0) -> pattern({tuple,Line,Ps}, St0) -> {TPs,St1} = pattern_list(Ps, St0), {{tuple,Line,TPs},St1}; +pattern({map,Line,Ps}, St0) -> + {TPs,St1} = pattern_list(Ps, St0), + {{map,Line,TPs},St1}; +pattern({map_field_exact,Line,K0,V0}, St0) -> + {K,St1} = expr(K0, St0), + {V,St2} = pattern(V0, St1), + {{map_field_exact,Line,K,V},St2}; %%pattern({struct,Line,Tag,Ps}, St0) -> %% {TPs,TPsvs,St1} = pattern_list(Ps, St0), %% {{tuple,Line,[{atom,Line,Tag}|TPs]},TPsvs,St1}; @@ -321,6 +328,21 @@ expr({tuple,Line,Es0}, St0) -> %%expr({struct,Line,Tag,Es0}, Vs, St0) -> %% {Es1,Esvs,Esus,St1} = expr_list(Es0, Vs, St0), %% {{tuple,Line,[{atom,Line,Tag}|Es1]},Esvs,Esus,St1}; +expr({map,Line,Es0}, St0) -> + {Es1,St1} = expr_list(Es0, St0), + {{map,Line,Es1},St1}; +expr({map,Line,E0,Es0}, St0) -> + {E1,St1} = expr(E0, St0), + {Es1,St2} = expr_list(Es0, St1), + {{map,Line,E1,Es1},St2}; +expr({map_field_assoc,Line,K0,V0}, St0) -> + {K,St1} = expr(K0, St0), + {V,St2} = expr(V0, St1), + {{map_field_assoc,Line,K,V},St2}; +expr({map_field_exact,Line,K0,V0}, St0) -> + {K,St1} = expr(K0, St0), + {V,St2} = expr(V0, St1), + {{map_field_exact,Line,K,V},St2}; expr({bin,Line,Es0}, St0) -> {Es1,St1} = expr_bin(Es0, St0), {{bin,Line,Es1},St1}; @@ -344,6 +366,8 @@ expr({'receive',Line,Cs0,To0,ToEs0}, St0) -> {{'receive',Line,Cs,To,ToEs},St3}; expr({'fun',Line,Body}, St) -> fun_tq(Line, Body, St); +expr({named_fun,Line,Name,Cs}, St) -> + fun_tq(Line, Cs, St, Name); expr({call,Line,{atom,La,N}=Atom,As0}, St0) -> {As,St1} = expr_list(As0, St0), Ar = length(As), @@ -475,6 +499,11 @@ fun_tq(Lf, {clauses,Cs0}, St0) -> Index = Uniq = 0, {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}},St2}. +fun_tq(Line, Cs0, St0, Name) -> + {Cs1,St1} = fun_clauses(Cs0, St0), + {Fname,St2} = new_fun_name(St1, Name), + {{named_fun,Line,Name,Cs1,{0,0,Fname}},St2}. + fun_clauses([{clause,L,H0,G0,B0}|Cs0], St0) -> {H,St1} = head(H0, St0), {G,St2} = guard(G0, St1), @@ -485,9 +514,12 @@ fun_clauses([], St) -> {[],St}. %% new_fun_name(State) -> {FunName,State}. -new_fun_name(#expand{func=F,arity=A,fcount=I}=St) -> +new_fun_name(St) -> + new_fun_name(St, 'fun'). + +new_fun_name(#expand{func=F,arity=A,fcount=I}=St, FName) -> Name = "-" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A) - ++ "-fun-" ++ integer_to_list(I) ++ "-", + ++ "-" ++ atom_to_list(FName) ++ "-" ++ integer_to_list(I) ++ "-", {list_to_atom(Name),St#expand{fcount=I+1}}. %% pattern_bin([Element], State) -> {[Element],[Variable],[UsedVar],State}. diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 6a13495523..47a357c23d 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -210,6 +210,8 @@ need_heap_0([], H, Acc) -> need_heap_1(#l{ke={set,_,{binary,_}},i=I}, H) -> {need_heap_need(I, H),0}; +need_heap_1(#l{ke={set,_,{map,_,_}},i=I}, H) -> + {need_heap_need(I, H),0}; need_heap_1(#l{ke={set,_,Val}}, H) -> %% Just pass through adding to needed heap. {[],H + case Val of @@ -453,8 +455,11 @@ basic_block([Le|Les], Acc) -> end; no_block -> {reverse(Acc, [Le]),Les} end. + +%% sets that may garbage collect are not allowed in basic blocks. collect_block({set,_,{binary,_}}) -> no_block; +collect_block({set,_,{map,_,_,_}}) -> no_block; collect_block({set,_,_}) -> include; collect_block({call,{var,_}=Var,As,_Rs}) -> {block_end,As++[Var]}; collect_block({call,Func,As,_Rs}) -> {block_end,As++func_vars(Func)}; @@ -594,14 +599,13 @@ top_level_block(Keis, Bef, MaxRegs, _St) -> %% number to the outer catch, which is wrong. turn_yregs(0, Tp, _) -> Tp; -turn_yregs(El, Tp, MaxY) when element(1, element(El, Tp)) =:= yy -> - turn_yregs(El-1, setelement(El, Tp, {y,MaxY-element(2, element(El, Tp))}), MaxY); -turn_yregs(El, Tp, MaxY) when is_list(element(El, Tp)) -> - New = map(fun ({yy,YY}) -> {y,MaxY-YY}; - (Other) -> Other end, element(El, Tp)), - turn_yregs(El-1, setelement(El, Tp, New), MaxY); turn_yregs(El, Tp, MaxY) -> - turn_yregs(El-1, Tp, MaxY). + turn_yregs(El-1,setelement(El,Tp,turn_yreg(element(El,Tp),MaxY)),MaxY). + +turn_yreg({yy,YY},MaxY) -> {y,MaxY-YY}; +turn_yreg({list,Ls},MaxY) -> {list, turn_yreg(Ls,MaxY)}; +turn_yreg(Ts,MaxY) when is_list(Ts) -> [turn_yreg(T,MaxY)||T<-Ts]; +turn_yreg(Other,_MaxY) -> Other. %% select_cg(Sclause, V, TypeFail, ValueFail, StackReg, State) -> %% {Is,StackReg,State}. @@ -623,6 +627,8 @@ select_cg(#l{ke={type_clause,bin_int,S}}, {var,V}, Tf, _Vf, Bef, St) -> select_bin_segs(S, V, Tf, Bef, St); select_cg(#l{ke={type_clause,bin_end,[S]}}, {var,V}, Tf, _Vf, Bef, St) -> select_bin_end(S, V, Tf, Bef, St); +select_cg(#l{ke={type_clause,map,S}}, {var,V}, Tf, Vf, Bef, St) -> + select_map(S, V, Tf, Vf, Bef, St); select_cg(#l{ke={type_clause,Type,Scs}}, {var,V}, Tf, Vf, Bef, St0) -> {Vis,{Aft,St1}} = mapfoldl(fun (S, {Int,Sta}) -> @@ -637,6 +643,10 @@ select_val_cg(tuple, R, [Arity,{f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) -> [{test,is_tuple,{f,Tf},[R]},{test,test_arity,{f,Vf},[R,Arity]}|Sis]; select_val_cg(tuple, R, Vls, Tf, Vf, Sis) -> [{test,is_tuple,{f,Tf},[R]},{select_tuple_arity,R,{f,Vf},{list,Vls}}|Sis]; +select_val_cg(map, R, [_Val,{f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) -> + [{test,is_map,{f,Fail},[R]}|Sis]; +select_val_cg(map, R, [_Val,{f,Lbl}|_], Tf, _Vf, [{label,Lbl}|Sis]) -> + [{test,is_map,{f,Tf},[R]}|Sis]; select_val_cg(Type, R, [Val, {f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) -> [{test,is_eq_exact,{f,Fail},[R,{Type,Val}]}|Sis]; select_val_cg(Type, R, [Val, {f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) -> @@ -915,6 +925,52 @@ select_extract_tuple(Src, Vs, I, Vdb, Bef, St) -> {Es,{Aft,_}} = flatmapfoldl(F, {Bef,0}, Vs), {Es,Aft,St}. +select_map(Scs, V, Tf, Vf, Bef, St0) -> + Reg = fetch_var(V, Bef), + {Is,Aft,St1} = + match_fmf(fun(#l{ke={val_clause,{map,_,Es},B},i=I,vdb=Vdb}, Fail, St1) -> + select_map_val(V, Es, B, Fail, I, Vdb, Bef, St1) + end, Vf, St0, Scs), + {[{test,is_map,{f,Tf},[Reg]}|Is],Aft,St1}. + +select_map_val(V, Es, B, Fail, I, Vdb, Bef, St0) -> + {Eis,Int,St1} = select_extract_map(V, Es, Fail, I, Vdb, Bef, St0), + {Bis,Aft,St2} = match_cg(B, Fail, Int, St1), + {Eis++Bis,Aft,St2}. + +select_extract_map(_, [], _, _, _, Bef, St) -> {[],Bef,St}; +select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) -> + %% First split the instruction flow + %% We want one set of each + %% 1) has_map_fields (no target registers) + %% 2) get_map_elements (with target registers) + %% Assume keys are term-sorted + Rsrc = fetch_var(Src, Bef), + + {{HasKs,GetVs},Aft} = lists:foldr(fun + ({map_pair,Key,{var,V}},{{HasKsi,GetVsi},Int0}) -> + case vdb_find(V, Vdb) of + {V,_,L} when L =< I -> + {{[Key|HasKsi],GetVsi},Int0}; + _Other -> + Reg1 = put_reg(V, Int0#sr.reg), + Int1 = Int0#sr{reg=Reg1}, + {{HasKsi,[Key,fetch_reg(V, Reg1)|GetVsi]},Int1} + end + end, {{[],[]},Bef}, Vs), + + Code = case {HasKs,GetVs} of + {HasKs,[]} -> + [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}}]; + {[],GetVs} -> + [{get_map_elements, {f,Fail},Rsrc,{list,GetVs}}]; + {HasKs,GetVs} -> + [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}}, + {get_map_elements, {f,Fail},Rsrc,{list,GetVs}}] + end, + {Code, Aft, St}. + + select_extract_cons(Src, [{var,Hd}, {var,Tl}], I, Vdb, Bef, St) -> {Es,Aft} = case {vdb_find(Hd, Vdb), vdb_find(Tl, Vdb)} of {{_,_,Lhd}, {_,_,Ltl}} when Lhd =< I, Ltl =< I -> @@ -1408,7 +1464,7 @@ catch_cg(C, {var,R}, Le, Vdb, Bef, St0) -> %% annotation must reflect this and make sure that the return %% variable is allocated first. %% -%% put_list for constructing a cons is an atomic instruction +%% put_list and put_map are atomic instructions, both of %% which can safely resuse one of the source registers as target. set_cg([{var,R}], {cons,Es}, Le, Vdb, Bef, St) -> @@ -1448,6 +1504,35 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, %% Now generate the complete code for constructing the binary. Code = cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Le#l.a), {Sis++Code,Aft,St}; +set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, + #cg{in_catch=InCatch,bfail=Bfail}=St) -> + + Fail = {f,Bfail}, + {Sis,Int0} = + case InCatch of + true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); + false -> {[],Bef} + end, + SrcReg = cg_reg_arg(Map,Int0), + Line = line(Le#l.a), + + %% The instruction needs to store keys in term sorted order + %% All keys has to be unique here + Pairs = map_pair_strip_and_termsort(Es), + + %% fetch registers for values to be put into the map + List = flatmap(fun({K,V}) -> [K,cg_reg_arg(V,Int0)] end, Pairs), + + Live = max_reg(Bef#sr.reg), + Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)}, + Aft = clear_dead(Int1, Le#l.i, Vdb), + Target = fetch_reg(R, Int1#sr.reg), + + I = case Op of + assoc -> put_map_assoc; + exact -> put_map_exact + end, + {Sis++[Line]++[{I,Fail,SrcReg,Target,Live,{list,List}}],Aft,St}; set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> %% Find a place for the return register first. Int = Bef#sr{reg=put_reg(R, Bef#sr.reg)}, @@ -1460,16 +1545,27 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> end, {Ais,clear_dead(Int, Le#l.i, Vdb),St}. +map_pair_strip_and_termsort(Es) -> + %% format in + %% [{map_pair,K,V}] + %% where K is for example {integer, 1} and we want to sort on 1. + Ls = [{K,V}||{_,K,V}<-Es], + lists:sort(fun ({{_,A},_}, {{_,B},_}) -> erts_internal:cmp_term(A,B) =< 0; + ({nil,_}, {{_,B},_}) -> [] =< B; + ({{_,A},_}, {nil,_}) -> A =< [] + end, Ls). + %%% %%% Code generation for constructing binaries. %%% cg_binary([{bs_put_binary,Fail,{atom,all},U,_Flags,Src}|PutCode], Target, Temp, Fail, MaxRegs, Anno) -> + Line = line(Anno), Live = cg_live(Target, MaxRegs), SzCode = cg_bitstr_size(PutCode, Target, Temp, Fail, Live), BinFlags = {field_flags,[]}, - Code = SzCode ++ + Code = [Line|SzCode] ++ [case member(single_use, Anno) of true -> {bs_private_append,Fail,Target,U,Src,BinFlags,Target}; @@ -1930,7 +2026,7 @@ load_vars(Vs, Regs) -> foldl(fun ({var,V}, Rs) -> put_reg(V, Rs) end, Regs, Vs). %% put_reg(Val, Regs) -> Regs. -%% find_reg(Val, Regs) -> ok{r{R}} | error. +%% find_reg(Val, Regs) -> {ok,r{R}} | error. %% fetch_reg(Val, Regs) -> r{R}. %% Functions to interface the registers. diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 01bb8635cd..59ec0d4199 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -74,13 +74,16 @@ -export([module/2,format_error/1]). -import(lists, [reverse/1,reverse/2,map/2,member/2,foldl/3,foldr/3,mapfoldl/3, - splitwith/2,keyfind/3,sort/1,foreach/2]). + splitwith/2,keyfind/3,sort/1,foreach/2,droplast/1,last/1]). -import(ordsets, [add_element/2,del_element/2,is_element/2, union/1,union/2,intersection/2,subtract/2]). --import(cerl, [ann_c_cons/3,ann_c_cons_skel/3,ann_c_tuple/2,c_tuple/1]). +-import(cerl, [ann_c_cons/3,ann_c_cons_skel/3,ann_c_tuple/2,c_tuple/1, + ann_c_map/2, ann_c_map/3]). -include("core_parse.hrl"). +-define(REC_OFFSET, 100000000). % Also in erl_expand_records. + %% Internal core expressions and help functions. %% N.B. annotations fields in place as normal Core expressions. @@ -92,7 +95,7 @@ -record(icase, {anno=#a{},args,clauses,fc}). -record(icatch, {anno=#a{},body}). -record(iclause, {anno=#a{},pats,pguard=[],guard,body}). --record(ifun, {anno=#a{},id,vars,clauses,fc}). +-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(iprimop, {anno=#a{},name,args}). @@ -101,6 +104,8 @@ -record(ireceive2, {anno=#a{},clauses,timeout,action}). -record(iset, {anno=#a{},var,arg}). -record(itry, {anno=#a{},args,vars,body,evars,handler}). +-record(ifilter, {anno=#a{},arg}). +-record(igen, {anno=#a{},acc_pat,acc_guard,skip_pat,tail,tail_pat,arg}). -type iapply() :: #iapply{}. -type ibinary() :: #ibinary{}. @@ -117,10 +122,13 @@ -type ireceive2() :: #ireceive2{}. -type iset() :: #iset{}. -type itry() :: #itry{}. +-type ifilter() :: #ifilter{}. +-type igen() :: #igen{}. -type i() :: iapply() | ibinary() | icall() | icase() | icatch() | iclause() | ifun() | iletrec() | imatch() | iprimop() - | iprotect() | ireceive1() | ireceive2() | iset() | itry(). + | iprotect() | ireceive1() | ireceive2() | iset() | itry() + | ifilter() | igen(). -type warning() :: {file:filename(), [{integer(), module(), term()}]}. @@ -226,13 +234,13 @@ guard(Gs0, St0) -> Gt1 = guard_tests(Gt0), L = element(2, Gt1), {op,L,'or',Gt1,Rhs} - end, guard_tests(last(Gs0)), first(Gs0)), + end, guard_tests(last(Gs0)), droplast(Gs0)), {Gs,St} = gexpr_top(Gs1, St0#core{in_guard=true}), {Gs,St#core{in_guard=false}}. guard_tests(Gs) -> L = element(2, hd(Gs)), - {protect,L,foldr(fun (G, Rhs) -> {op,L,'and',G,Rhs} end, last(Gs), first(Gs))}. + {protect,L,foldr(fun (G, Rhs) -> {op,L,'and',G,Rhs} end, last(Gs), droplast(Gs))}. %% gexpr_top(Expr, State) -> {Cexpr,State}. %% Generate an internal core expression of a guard test. Explicitly @@ -269,51 +277,67 @@ gexpr({op,L,'orelse',E1,E2}, Bools, St0) -> True = {atom,L,true}, E = make_bool_switch_guard(L, E1, V, True, E2), gexpr(E, Bools, St); -gexpr({op,Line,Op,L,R}=Call, Bools0, St0) -> +gexpr({op,Line,Op,L,R}=E, Bools, St) -> case erl_internal:bool_op(Op, 2) of - true -> - {Le,Lps,Bools1,St1} = gexpr(L, Bools0, St0), - {Ll,Llps,St2} = force_safe(Le, St1), - {Re,Rps,Bools,St3} = gexpr(R, Bools1, St2), - {Rl,Rlps,St4} = force_safe(Re, St3), - Anno = lineno_anno(Line, St4), - {#icall{anno=#a{anno=Anno}, %Must have an #a{} - module=#c_literal{anno=Anno,val=erlang}, - name=#c_literal{anno=Anno,val=Op}, - args=[Ll,Rl]},Lps ++ Llps ++ Rps ++ Rlps,Bools,St4}; - false -> - gexpr_test(Call, Bools0, St0) + true -> + gexpr_bool(Op, L, R, Bools, St, Line); + false -> + gexpr_test(E, Bools, St) end; -gexpr({op,Line,Op,A}=Call, Bools0, St0) -> - case Op of - 'not' -> - {Ae0,Aps,Bools,St1} = gexpr(A, Bools0, St0), - case Ae0 of - #icall{module=#c_literal{val=erlang}, - name=#c_literal{val='=:='}, - args=[E,#c_literal{val=true}]}=EqCall -> - %% - %% Doing the following transformation - %% not(Expr =:= true) ==> Expr =:= false - %% will help eliminating redundant is_boolean/1 tests. - %% - Ae = EqCall#icall{args=[E,#c_literal{val=false}]}, - {Al,Alps,St2} = force_safe(Ae, St1), - {Al,Aps ++ Alps,Bools,St2}; - Ae -> - {Al,Alps,St2} = force_safe(Ae, St1), - Anno = lineno_anno(Line, St2), - {#icall{anno=#a{anno=Anno}, %Must have an #a{} - module=#c_literal{anno=Anno,val=erlang}, - name=#c_literal{anno=Anno,val=Op}, - args=[Al]},Aps ++ Alps,Bools,St2} - end; - _ -> - gexpr_test(Call, Bools0, St0) +gexpr({call,Line,{remote,_,{atom,_,erlang},{atom,_,Op}},[L,R]}=E, Bools, St) -> + case erl_internal:bool_op(Op, 2) of + true -> + gexpr_bool(Op, L, R, Bools, St, Line); + false -> + gexpr_test(E, Bools, St) end; +gexpr({op,Line,'not',A}, Bools, St) -> + gexpr_not(A, Bools, St, Line); +gexpr({call,Line,{remote,_,{atom,_,erlang},{atom,_,'not'}},[A]}, Bools, St) -> + gexpr_not(A, Bools, St, Line); gexpr(E0, Bools, St0) -> gexpr_test(E0, Bools, St0). +%% gexpr_not(L, R, Bools, State) -> {Cexpr,[PreExp],Bools,State}. +%% Generate a guard for boolean operators + +gexpr_bool(Op, L, R, Bools0, St0, Line) -> + {Le,Lps,Bools1,St1} = gexpr(L, Bools0, St0), + {Ll,Llps,St2} = force_safe(Le, St1), + {Re,Rps,Bools,St3} = gexpr(R, Bools1, St2), + {Rl,Rlps,St4} = force_safe(Re, St3), + Anno = lineno_anno(Line, St4), + {#icall{anno=#a{anno=Anno}, %Must have an #a{} + module=#c_literal{anno=Anno,val=erlang}, + name=#c_literal{anno=Anno,val=Op}, + args=[Ll,Rl]},Lps ++ Llps ++ Rps ++ Rlps,Bools,St4}. + +%% gexpr_not(Expr, Bools, State) -> {Cexpr,[PreExp],Bools,State}. +%% Generate an erlang:'not'/1 guard test. + +gexpr_not(A, Bools0, St0, Line) -> + {Ae0,Aps,Bools,St1} = gexpr(A, Bools0, St0), + case Ae0 of + #icall{module=#c_literal{val=erlang}, + name=#c_literal{val='=:='}, + args=[E,#c_literal{val=true}]}=EqCall -> + %% + %% Doing the following transformation + %% not(Expr =:= true) ==> Expr =:= false + %% will help eliminating redundant is_boolean/1 tests. + %% + Ae = EqCall#icall{args=[E,#c_literal{val=false}]}, + {Al,Alps,St2} = force_safe(Ae, St1), + {Al,Aps ++ Alps,Bools,St2}; + Ae -> + {Al,Alps,St2} = force_safe(Ae, St1), + Anno = lineno_anno(Line, St2), + {#icall{anno=#a{anno=Anno}, %Must have an #a{} + module=#c_literal{anno=Anno,val=erlang}, + name=#c_literal{anno=Anno,val='not'}, + args=[Al]},Aps ++ Alps,Bools,St2} + end. + %% gexpr_test(Expr, Bools, State) -> {Cexpr,[PreExp],Bools,State}. %% Generate a guard test. At this stage we must be sure that we have %% a proper boolean value here so wrap things with an true test if we @@ -330,7 +354,8 @@ gexpr_test(E0, Bools0, St0) -> #icall{anno=Anno,module=#c_literal{val=erlang},name=#c_literal{val=N},args=As} -> Ar = length(As), case erl_internal:type_test(N, Ar) orelse - erl_internal:comp_op(N, Ar) of + erl_internal:comp_op(N, Ar) orelse + erl_internal:bool_op(N, Ar) of true -> {E1,Eps0,Bools0,St1}; false -> Lanno = Anno#a.anno, @@ -478,15 +503,46 @@ expr({cons,L,H0,T0}, St0) -> {H1,Hps,St1} = safe(H0, St0), {T1,Tps,St2} = safe(T0, St1), A = lineno_anno(L, St2), - {ann_c_cons(A, H1, T1),Hps ++ Tps,St2}; -expr({lc,L,E,Qs}, St) -> - lc_tq(L, E, Qs, #c_literal{anno=lineno_anno(L, St),val=[]}, St); + {annotate_cons(A, H1, T1, St2),Hps ++ Tps,St2}; +expr({lc,L,E,Qs0}, St0) -> + {Qs1,St1} = preprocess_quals(L, Qs0, St0), + lc_tq(L, E, Qs1, #c_literal{anno=lineno_anno(L, St1),val=[]}, St1); expr({bc,L,E,Qs}, St) -> bc_tq(L, E, Qs, {nil,L}, St); expr({tuple,L,Es0}, St0) -> {Es1,Eps,St1} = safe_list(Es0, St0), - A = lineno_anno(L, St1), - {ann_c_tuple(A, Es1),Eps,St1}; + A = record_anno(L, St1), + {annotate_tuple(A, Es1, St1),Eps,St1}; +expr({map,L,Es0}, St0) -> + % erl_lint should make sure only #{ K => V } are allowed + % in map construction. + try map_pair_list(Es0, St0) of + {Es1,Eps,St1} -> + A = lineno_anno(L, St1), + {ann_c_map(A,Es1),Eps,St1} + catch + throw:{bad_map,Warning} -> + St = add_warning(L, Warning, St0), + 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} + end; +expr({map,L,M0,Es0}, St0) -> + try expr_map(M0,Es0,lineno_anno(L, St0),St0) of + {_,_,_}=Res -> Res + catch + throw:{bad_map,Warning} -> + St = add_warning(L, Warning, St0), + 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} + end; expr({bin,L,Es0}, St0) -> try expr_bin(Es0, lineno_anno(L, St0), St0) of {_,_,_}=Res -> Res @@ -502,7 +558,7 @@ expr({bin,L,Es0}, St0) -> end; expr({block,_,Es0}, St0) -> %% Inline the block directly. - {Es1,St1} = exprs(first(Es0), St0), + {Es1,St1} = exprs(droplast(Es0), St0), {E1,Eps,St2} = expr(last(Es0), St1), {E1,Es1 ++ Eps,St2}; expr({'if',L,Cs0}, St0) -> @@ -553,16 +609,23 @@ expr({'try',L,Es0,[],[],As0}, St0) -> %% 'try ... after ... end' {Es1,St1} = exprs(Es0, St0), {As1,St2} = exprs(As0, St1), - {Evs,Hs0,St3} = try_after(As1, St2), - %% We must kill the id for any funs in the duplicated after body, - %% to avoid getting two local functions having the same name. - Hs = kill_id_anns(Hs0), + {Name,St3} = new_fun_name("after", St2), {V,St4} = new_var(St3), % (must not exist in As1) - %% TODO: this duplicates the 'after'-code; should lift to function. - Lanno = lineno_anno(L, St4), - {#itry{anno=#a{anno=Lanno},args=Es1,vars=[V],body=As1++[V], - evars=Evs,handler=Hs}, - [],St4}; + LA = lineno_anno(L, St4), + Lanno = #a{anno=LA}, + Fc = function_clause([], LA, {Name,0}), + Fun = #ifun{anno=Lanno,id=[],vars=[], + clauses=[#iclause{anno=Lanno,pats=[], + guard=[#c_literal{val=true}], + body=As1}], + fc=Fc}, + App = #iapply{anno=#a{anno=[compiler_generated|LA]}, + op=#c_var{anno=LA,name={Name,0}},args=[]}, + {Evs,Hs,St5} = try_after([App], St4), + Try = #itry{anno=Lanno,args=Es1,vars=[V],body=[App,V],evars=Evs,handler=Hs}, + Letrec = #iletrec{anno=Lanno,defs=[{{Name,0},Fun}], + body=[Try]}, + {Letrec,[],St5}; expr({'try',L,Es,Cs,Ecs,As}, St0) -> %% 'try ... [of ...] [catch ...] after ... end' expr({'try',L,[{'try',L,Es,Cs,Ecs,[]}],[],[],As}, St0); @@ -581,7 +644,11 @@ expr({'fun',L,{function,M,F,A}}, St0) -> name=#c_literal{val=make_fun}, args=As},Aps,St1}; expr({'fun',L,{clauses,Cs},Id}, St) -> - fun_tq(Id, Cs, L, St); + fun_tq(Id, Cs, L, St, unnamed); +expr({named_fun,L,'_',Cs,Id}, St) -> + fun_tq(Id, Cs, L, St, unnamed); +expr({named_fun,L,Name,Cs,Id}, St) -> + fun_tq(Id, Cs, L, St, {named,Name}); expr({call,L,{remote,_,M,F},As0}, #core{wanted=Wanted}=St0) -> {[M1,F1|As1],Aps,St1} = safe_list([M,F|As0], St0), Lanno = lineno_anno(L, St1), @@ -595,7 +662,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(FunExp, St0), + {Fun,Fps,St1} = safe_fun(length(As0), 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}; @@ -625,7 +692,7 @@ expr({match,L,P0,E0}, St0) -> Other when not is_atom(Other) -> {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps,St4} end; -expr({op,_,'++',{lc,Llc,E,Qs},More}, St0) -> +expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) -> %% Optimise '++' here because of the list comprehension algorithm. %% %% To avoid achieving quadratic complexity if there is a chain of @@ -633,7 +700,8 @@ expr({op,_,'++',{lc,Llc,E,Qs},More}, St0) -> %% evaluation of More now. Evaluating More here could also reduce the %% number variables in the environment for letrec. {Mc,Mps,St1} = safe(More, St0), - {Y,Yps,St} = lc_tq(Llc, E, Qs, Mc, St1), + {Qs,St2} = preprocess_quals(Llc, Qs0, St1), + {Y,Yps,St} = lc_tq(Llc, E, Qs, Mc, St2), {Y,Mps++Yps,St}; expr({op,L,'andalso',E1,E2}, St0) -> {#c_var{name=V0},St} = new_var(L, St0), @@ -684,6 +752,76 @@ make_bool_switch_guard(L, E, V, T, F) -> {clause,NegL,[V],[],[V]} ]}. +expr_map(M0,Es0,A,St0) -> + {M1,Mps,St1} = safe(M0, St0), + case is_valid_map_src(M1) of + true -> + case {M1,Es0} of + {#c_var{}, []} -> + %% transform M#{} to is_map(M) + {Vpat,St2} = new_var(St1), + {Fpat,St3} = new_var(St2), + Cs = [#iclause{ + anno=A, + pats=[Vpat], + guard=[#icall{anno=#a{anno=A}, + module=#c_literal{anno=A,val=erlang}, + name=#c_literal{anno=A,val=is_map}, + args=[Vpat]}], + body=[Vpat]}], + Fc = fail_clause([Fpat], A, #c_literal{val=badarg}), + {#icase{anno=#a{anno=A},args=[M1],clauses=Cs,fc=Fc},Mps,St3}; + {_,_} -> + {Es1,Eps,St2} = map_pair_list(Es0, St1), + {ann_c_map(A,M1,Es1),Mps++Eps,St2} + end; + false -> throw({bad_map,bad_map}) + end. + +is_valid_map_src(#c_literal{val = M}) when is_map(M) -> true; +is_valid_map_src(#c_map{}) -> true; +is_valid_map_src(#c_var{}) -> true; +is_valid_map_src(_) -> false. + +map_pair_list(Es, St) -> + foldr(fun + ({map_field_assoc,L,K0,V0}, {Ces,Esp,St0}) -> + {K1,Ep0,St1} = safe(K0, St0), + K = ensure_valid_map_key(K1), + {V,Ep1,St2} = safe(V0, St1), + A = lineno_anno(L, St2), + Pair = #c_map_pair{op=#c_literal{val=assoc},anno=A,key=K,val=V}, + {[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2}; + ({map_field_exact,L,K0,V0}, {Ces,Esp,St0}) -> + {K1,Ep0,St1} = safe(K0, St0), + K = ensure_valid_map_key(K1), + {V,Ep1,St2} = safe(V0, St1), + A = lineno_anno(L, St2), + Pair = #c_map_pair{op=#c_literal{val=exact},anno=A,key=K,val=V}, + {[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2} + end, {[],[],St}, Es). + +ensure_valid_map_key(K0) -> + case coalesced_map_key(K0) of + {ok,K1} -> K1; + error -> throw({bad_map,bad_map_key}) + end. + +coalesced_map_key(#c_literal{}=K) -> {ok,K}; +%% Dialyzer hack redux +%% DO coalesce tuples and list in maps for dialyzer +%% Dialyzer tries to break this apart, don't let it +coalesced_map_key(#c_tuple{}=K) -> + case core_lib:is_literal(K) of + true -> {ok,cerl:fold_literal(K)}; + false -> error + end; +coalesced_map_key(#c_cons{}=K) -> + case core_lib:is_literal(K) of + true -> {ok,cerl:fold_literal(K)}; + false -> error + end; +coalesced_map_key(_) -> error. %% try_exception([ExcpClause], St) -> {[ExcpVar],Handler,St}. @@ -836,9 +974,9 @@ bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) -> flags=#c_literal{val=Flags}}, Eps ++ Eps2,St2}. -%% fun_tq(Id, [Clauses], Line, State) -> {Fun,[PreExp],State}. +%% fun_tq(Id, [Clauses], Line, State, NameInfo) -> {Fun,[PreExp],State}. -fun_tq({_,_,Name}=Id, Cs0, L, St0) -> +fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) -> Arity = clause_arity(hd(Cs0)), {Cs1,St1} = clauses(Cs0, St0), {Args,St2} = new_vars(Arity, St1), @@ -847,138 +985,50 @@ fun_tq({_,_,Name}=Id, Cs0, L, St0) -> Fc = function_clause(Ps, Anno, {Name,Arity}), Fun = #ifun{anno=#a{anno=Anno}, id=[{id,Id}], %We KNOW! - vars=Args,clauses=Cs1,fc=Fc}, + vars=Args,clauses=Cs1,fc=Fc,name=NameInfo}, {Fun,[],St3}. %% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}. %% This TQ from Simon PJ pp 127-138. -%% This gets a bit messy as we must transform all directly here. We -%% recognise guard tests and try to fold them together and join to a -%% preceding generators, this should give us better and more compact -%% code. -lc_tq(Line, E, [{generate,Lg,P,G}|Qs0], Mc, St0) -> - {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0), +lc_tq(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) -> {Name,St1} = new_fun_name("lc", St0), - {Head,St2} = new_var(St1), - {Tname,St3} = new_var_name(St2), - LA = lineno_anno(Line, St3), - LAnno = #a{anno=LA}, - Tail = #c_var{anno=LA,name=Tname}, - {Arg,St4} = new_var(St3), - {Nc,[],St5} = expr({call,Lg,{atom,Lg,Name},[{var,Lg,Tname}]}, St4), - {Guardc,St6} = lc_guard_tests(Gs, St5), %These are always flat! - {Lc,Lps,St7} = lc_tq(Line, E, Qs1, Nc, St6), - {Pc,St8} = list_gen_pattern(P, Line, St7), - {Gc,Gps,St9} = safe(G, St8), %Will be a function argument! - Fc = function_clause([Arg], LA, {Name,1}), - - %% Avoid constructing a default clause if the list comprehension - %% only has a variable as generator and there are no guard - %% tests. In other words, if the comprehension is equivalent to - %% lists:map/2. - Cs0 = case {Guardc, Pc} of - {[], #c_var{}} -> - [#iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=[]}],guard=[], - body=[Mc]}]; - _ -> - [#iclause{anno=#a{anno=[compiler_generated|LA]}, - pats=[ann_c_cons(LA, Head, Tail)], - guard=[], - body=[Nc]}, - #iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=[]}],guard=[], - body=[Mc]}] - end, - Cs = case Pc of - nomatch -> Cs0; - _ -> - [#iclause{anno=LAnno, - pats=[ann_c_cons(LA, Pc, Tail)], - guard=Guardc, - body=Lps ++ [Lc]}|Cs0] - end, - Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc}, - {#iletrec{anno=LAnno,defs=[{{Name,1},Fun}], - body=Gps ++ [#iapply{anno=LAnno, - op=#c_var{anno=LA,name={Name,1}}, - args=[Gc]}]}, - [],St9}; -lc_tq(Line, E, [{b_generate,Lg,P,G}|Qs0], Mc, St0) -> - {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0), - {Name,St1} = new_fun_name("blc", St0), LA = lineno_anno(Line, St1), LAnno = #a{anno=LA}, - HeadBinPattern = pattern(P, St1), - #c_binary{segments=Ps0} = HeadBinPattern, - {Ps,Tail,St2} = append_tail_segment(Ps0, St1), - {EPs,St3} = emasculate_segments(Ps, St2), - Pattern = HeadBinPattern#c_binary{segments=Ps}, - EPattern = HeadBinPattern#c_binary{segments=EPs}, - {Arg,St4} = new_var(St3), - {Guardc,St5} = lc_guard_tests(Gs, St4), %These are always flat! - Tname = Tail#c_var.name, - {Nc,[],St6} = expr({call,Lg,{atom,Lg,Name},[{var,Lg,Tname}]}, St5), - {Bc,Bps,St7} = lc_tq(Line, E, Qs1, Nc, St6), - {Gc,Gps,St10} = safe(G, St7), %Will be a function argument! - Fc = function_clause([Arg], LA, {Name,1}), - {TailSegList,_,St} = append_tail_segment([], St10), - Cs = [#iclause{anno=#a{anno=[compiler_generated|LA]}, - pats=[Pattern], - guard=Guardc, - body=Bps ++ [Bc]}, - #iclause{anno=#a{anno=[compiler_generated|LA]}, - pats=[EPattern], - guard=[], - body=[#iapply{anno=LAnno, - op=#c_var{anno=LA,name={Name,1}}, - args=[Tail]}]}, - #iclause{anno=LAnno, - pats=[#c_binary{anno=LA,segments=TailSegList}],guard=[], - body=[Mc]}], - Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc}, - {#iletrec{anno=LAnno,defs=[{{Name,1},Fun}], - body=Gps ++ [#iapply{anno=LAnno, - op=#c_var{anno=LA,name={Name,1}}, - args=[Gc]}]}, - [],St}; -lc_tq(Line, E, [Fil0|Qs0], Mc, St0) -> - %% Special case sequences guard tests. - LA = lineno_anno(element(2, Fil0), St0), - LAnno = #a{anno=LA}, - case is_guard_test(Fil0) of - true -> - {Gs0,Qs1} = splitwith(fun is_guard_test/1, Qs0), - {Lc,Lps,St1} = lc_tq(Line, E, Qs1, Mc, St0), - {Gs,St2} = lc_guard_tests([Fil0|Gs0], St1), %These are always flat! - {#icase{anno=LAnno, - args=[], - clauses=[#iclause{anno=LAnno,pats=[], - guard=Gs,body=Lps ++ [Lc]}], - fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, - pats=[],guard=[],body=[Mc]}}, - [],St2}; - false -> - {Lc,Lps,St1} = lc_tq(Line, E, Qs0, Mc, St0), - {Fpat,St2} = new_var(St1), - Fc = fail_clause([Fpat], LA, - c_tuple([#c_literal{val=case_clause},Fpat])), - %% Do a novars little optimisation here. - {Filc,Fps,St3} = novars(Fil0, St2), - {#icase{anno=LAnno, - args=[Filc], - clauses=[#iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=true}], - guard=[], - body=Lps ++ [Lc]}, - #iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, - pats=[#c_literal{anno=LA,val=false}], - guard=[], - body=[Mc]}], - fc=Fc}, - Fps,St3} - end; + 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], LA, {Name,1}), + TailClause = #iclause{anno=LAnno,pats=[TailPat],guard=[],body=[Mc]}, + Cs0 = case {AccPat,AccGuard} of + {SkipPat,[]} -> + %% Skip and accumulator patterns are the same and there is + %% no guard, no need to generate a skip clause. + [TailClause]; + _ -> + [#iclause{anno=#a{anno=[compiler_generated|LA]}, + pats=[SkipPat],guard=[],body=[Nc]}, + TailClause] + end, + {Cs,St4} = case AccPat of + nomatch -> + %% The accumulator pattern never matches, no need + %% for an accumulator clause. + {Cs0,St2}; + _ -> + {Lc,Lps,St3} = lc_tq(Line, E, Qs, Nc, St2), + {[#iclause{anno=LAnno,pats=[AccPat],guard=AccGuard, + body=Lps ++ [Lc]}|Cs0], + St3} + end, + Fun = #ifun{anno=LAnno,id=[],vars=[Var],clauses=Cs,fc=Fc}, + {#iletrec{anno=LAnno#a{anno=[list_comprehension|LA]},defs=[{{Name,1},Fun}], + body=Pre ++ [#iapply{anno=LAnno,op=F,args=[Arg]}]}, + [],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) -> {H1,Hps,St1} = safe(E0, St0), {T1,Tps,St} = force_safe(Mc0, St1), @@ -988,143 +1038,60 @@ lc_tq(Line, E0, [], Mc0, St0) -> %% bc_tq(Line, Exp, [Qualifier], More, State) -> {LetRec,[PreExp],State}. %% This TQ from Gustafsson ERLANG'05. -%% This gets a bit messy as we must transform all directly here. We -%% recognise guard tests and try to fold them together and join to a -%% preceding generators, this should give us better and more compact -%% code. %% More could be transformed before calling bc_tq. -bc_tq(Line, Exp, Qualifiers, _, St0) -> +bc_tq(Line, Exp, Qs0, _, St0) -> {BinVar,St1} = new_var(St0), - {Sz,SzPre,St2} = bc_initial_size(Exp, Qualifiers, St1), - {E,BcPre,St} = bc_tq1(Line, Exp, Qualifiers, BinVar, St2), + {Sz,SzPre,St2} = bc_initial_size(Exp, Qs0, St1), + {Qs,St3} = preprocess_quals(Line, Qs0, St2), + {E,BcPre,St} = bc_tq1(Line, Exp, Qs, BinVar, St3), Pre = SzPre ++ [#iset{var=BinVar, arg=#iprimop{name=#c_literal{val=bs_init_writable}, args=[Sz]}}] ++ BcPre, {E,Pre,St}. -bc_tq1(Line, E, [{generate,Lg,P,G}|Qs0], AccExpr, St0) -> - {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0), +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) -> {Name,St1} = new_fun_name("lbc", St0), LA = lineno_anno(Line, St1), - {[Head,Tail,AccVar],St2} = new_vars(LA, 3, St1), LAnno = #a{anno=LA}, - {Arg,St3} = new_var(St2), - NewMore = {call,Lg,{atom,Lg,Name},[{var,Lg,Tail#c_var.name}, - {var,Lg,AccVar#c_var.name}]}, - {Guardc,St4} = lc_guard_tests(Gs, St3), %These are always flat! - {Lc,Lps,St5} = bc_tq1(Line, E, Qs1, AccVar, St4), - {Nc,Nps,St6} = expr(NewMore, St5), - {Pc,St7} = list_gen_pattern(P, Line, St6), - {Gc,Gps,St8} = safe(G, St7), %Will be a function argument! - Fc = function_clause([Arg,AccVar], LA, {Name,2}), - Cs0 = case {Guardc, Pc} of - {[], #c_var{}} -> - [#iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=[]},AccVar],guard=[], - body=[AccVar]}]; - _ -> - [#iclause{anno=#a{anno=[compiler_generated|LA]}, - pats=[ann_c_cons(LA, Head, Tail),AccVar], - guard=[], - body=Nps ++ [Nc]}, - #iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=[]},AccVar],guard=[], - body=[AccVar]}] - end, - Cs = case Pc of - nomatch -> Cs0; - _ -> - Body = Lps ++ Nps ++ [#iset{var=AccVar,arg=Lc},Nc], - [#iclause{anno=LAnno, - pats=[ann_c_cons(LA,Pc,Tail),AccVar], - guard=Guardc, - body=Body}|Cs0] - end, - Fun = #ifun{anno=LAnno,id=[],vars=[Arg,AccVar],clauses=Cs,fc=Fc}, - {#iletrec{anno=LAnno,defs=[{{Name,2},Fun}], - body=Gps ++ [#iapply{anno=LAnno, - op=#c_var{anno=LA,name={Name,2}}, - args=[Gc,AccExpr]}]}, - [],St8}; -bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) -> - {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0), - {Name,St1} = new_fun_name("lbc", St0), - LA = lineno_anno(Line, St1), - {AccVar,St2} = new_var(LA, St1), - LAnno = #a{anno=LA}, - HeadBinPattern = pattern(P, St2), - #c_binary{segments=Ps0} = HeadBinPattern, - {Ps,Tail,St3} = append_tail_segment(Ps0, St2), - {EPs,St4} = emasculate_segments(Ps, St3), - Pattern = HeadBinPattern#c_binary{segments=Ps}, - EPattern = HeadBinPattern#c_binary{segments=EPs}, - {Arg,St5} = new_var(St4), - NewMore = {call,Lg,{atom,Lg,Name},[{var,Lg,Tail#c_var.name}, - {var,Lg,AccVar#c_var.name}]}, - {Guardc,St6} = lc_guard_tests(Gs, St5), %These are always flat! - {Bc,Bps,St7} = bc_tq1(Line, E, Qs1, AccVar, St6), - {Nc,Nps,St8} = expr(NewMore, St7), - {Gc,Gps,St9} = safe(G, St8), %Will be a function argument! - Fc = function_clause([Arg,AccVar], LA, {Name,2}), - Body = Bps ++ Nps ++ [#iset{var=AccVar,arg=Bc},Nc], - {TailSegList,_,St} = append_tail_segment([], St9), - Cs = [#iclause{anno=LAnno, - pats=[Pattern,AccVar], - guard=Guardc, - body=Body}, - #iclause{anno=#a{anno=[compiler_generated|LA]}, - pats=[EPattern,AccVar], - guard=[], - body=Nps ++ [Nc]}, - #iclause{anno=LAnno, - pats=[#c_binary{anno=LA,segments=TailSegList},AccVar], - guard=[], - body=[AccVar]}], - Fun = #ifun{anno=LAnno,id=[],vars=[Arg,AccVar],clauses=Cs,fc=Fc}, - {#iletrec{anno=LAnno,defs=[{{Name,2},Fun}], - body=Gps ++ [#iapply{anno=LAnno, - op=#c_var{anno=LA,name={Name,2}}, - args=[Gc,AccExpr]}]}, - [],St}; -bc_tq1(Line, E, [Fil0|Qs0], AccVar, St0) -> - %% Special case sequences guard tests. - LA = lineno_anno(element(2, Fil0), St0), - LAnno = #a{anno=LA}, - case is_guard_test(Fil0) of - true -> - {Gs0,Qs1} = splitwith(fun is_guard_test/1, Qs0), - {Bc,Bps,St1} = bc_tq1(Line, E, Qs1, AccVar, St0), - {Gs,St} = lc_guard_tests([Fil0|Gs0], St1), %These are always flat! - {#icase{anno=LAnno, - args=[], - clauses=[#iclause{anno=LAnno, - pats=[], - guard=Gs,body=Bps ++ [Bc]}], - fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, - pats=[],guard=[],body=[AccVar]}}, - [],St}; - false -> - {Bc,Bps,St1} = bc_tq1(Line, E, Qs0, AccVar, St0), - {Fpat,St2} = new_var(St1), - Fc = fail_clause([Fpat], LA, - c_tuple([#c_literal{val=case_clause},Fpat])), - %% Do a novars little optimisation here. - {Filc,Fps,St} = novars(Fil0, St2), - {#icase{anno=LAnno, - args=[Filc], - clauses=[#iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=true}], - guard=[], - body=Bps ++ [Bc]}, - #iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, - pats=[#c_literal{anno=LA,val=false}], - guard=[], - body=[AccVar]}], - fc=Fc}, - Fps,St} - end; + {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}), + TailClause = #iclause{anno=LAnno,pats=[TailPat,AccVar],guard=[], + body=[AccVar]}, + Cs0 = case {AccPat,AccGuard} of + {SkipPat,[]} -> + %% Skip and accumulator patterns are the same and there is + %% no guard, no need to generate a skip clause. + [TailClause]; + _ -> + [#iclause{anno=#a{anno=[compiler_generated|LA]}, + pats=[SkipPat,AccVar],guard=[],body=[Nc]}, + TailClause] + end, + {Cs,St4} = case AccPat of + nomatch -> + %% The accumulator pattern never matches, no need + %% for an accumulator clause. + {Cs0,St2}; + _ -> + {Bc,Bps,St3} = bc_tq1(Line, E, Qs, AccVar, St2), + Body = Bps ++ [#iset{var=AccVar,arg=Bc},Nc], + {[#iclause{anno=LAnno, + pats=[AccPat,AccVar],guard=AccGuard, + body=Body}|Cs0], + St3} + end, + 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]}]}, + [],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) -> {E,Pre,St} = expr({bin,Bl,[{bin_element,Bl, {var,Bl,AccVar#c_var.name}, @@ -1132,31 +1099,154 @@ bc_tq1(_, {bin,Bl,Elements}, [], AccVar, St0) -> [binary,{unit,1}]}|Elements]}, St0), #a{anno=A} = Anno0 = get_anno(E), Anno = Anno0#a{anno=[compiler_generated,single_use|A]}, - %%Anno = Anno0#a{anno=[compiler_generated|A]}, {set_anno(E, Anno),Pre,St}. -append_tail_segment(Segs, St) -> - app_tail_seg(Segs, St, []). - -app_tail_seg([#c_bitstr{val=Var0,size=#c_literal{val=all}}=Seg0]=L, - St0, Acc) -> - case Var0 of - #c_var{name='_'} -> - {Var,St} = new_var(St0), - Seg = Seg0#c_bitstr{val=Var}, - {reverse(Acc, [Seg]),Var,St}; - #c_var{} -> - {reverse(Acc, L),Var0,St0} +%% filter_tq(Line, Expr, Filter, Mc, State, [Qualifier], TqFun) -> +%% {Case,[PreExpr],State}. +%% Transform an intermediate comprehension filter to its intermediate case +%% representation. + +filter_tq(Line, E, #ifilter{anno=#a{anno=LA}=LAnno,arg={Pre,Arg}}, + Mc, St0, Qs, TqFun) -> + %% The filter is an expression, it is compiled to a case of degree 1 with + %% 3 clauses, one accumulating, one skipping and the final one throwing + %% {case_clause,Value} where Value is the result of the filter and is not a + %% boolean. + {Lc,Lps,St1} = TqFun(Line, E, Qs, Mc, St0), + {FailPat,St2} = new_var(St1), + Fc = fail_clause([FailPat], LA, + c_tuple([#c_literal{val=case_clause},FailPat])), + {#icase{anno=LAnno#a{anno=[list_comprehension|LA]},args=[Arg], + clauses=[#iclause{anno=LAnno, + pats=[#c_literal{val=true}],guard=[], + body=Lps ++ [Lc]}, + #iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, + pats=[#c_literal{val=false}],guard=[], + body=[Mc]}], + fc=Fc}, + Pre,St2}; +filter_tq(Line, E, #ifilter{anno=#a{anno=LA}=LAnno,arg=Guard}, + Mc, St0, Qs, TqFun) when is_list(Guard) -> + %% Otherwise it is a guard, compiled to a case of degree 0 with 2 clauses, + %% the first matches if the guard succeeds and the comprehension continues + %% or the second one is selected and the current element is skipped. + {Lc,Lps,St1} = TqFun(Line, E, Qs, Mc, St0), + {#icase{anno=LAnno#a{anno=[list_comprehension|LA]},args=[], + clauses=[#iclause{anno=LAnno,pats=[],guard=Guard,body=Lps ++ [Lc]}], + fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, + pats=[],guard=[],body=[Mc]}}, + [],St1}. + +%% preprocess_quals(Line, [Qualifier], State) -> {[Qualifier'],State}. +%% Preprocess a list of Erlang qualifiers into its intermediate representation, +%% represented as a list of #igen{} and #ifilter{} records. We recognise guard +%% tests and try to fold them together and join to a preceding generators, this +%% should give us better and more compact code. + +preprocess_quals(Line, Qs, St) -> + preprocess_quals(Line, Qs, St, []). + +preprocess_quals(Line, [Q|Qs0], St0, Acc) -> + case is_generator(Q) of + true -> + {Gs,Qs} = splitwith(fun is_guard_test/1, Qs0), + {Gen,St} = generator(Line, Q, Gs, St0), + preprocess_quals(Line, Qs, St, [Gen|Acc]); + false -> + LAnno = #a{anno=lineno_anno(get_anno(Q), St0)}, + case is_guard_test(Q) of + true -> + %% When a filter is a guard test, its argument in the + %% #ifilter{} record is a list as returned by + %% lc_guard_tests/2. + {Gs,Qs} = splitwith(fun is_guard_test/1, Qs0), + {Cg,St} = lc_guard_tests([Q|Gs], St0), + Filter = #ifilter{anno=LAnno,arg=Cg}, + preprocess_quals(Line, Qs, St, [Filter|Acc]); + false -> + %% Otherwise, it is a pair {Pre,Arg} as in a generator + %% input. + {Ce,Pre,St} = novars(Q, St0), + Filter = #ifilter{anno=LAnno,arg={Pre,Ce}}, + preprocess_quals(Line, Qs0, St, [Filter|Acc]) + end end; -app_tail_seg([H|T], St, Acc) -> - app_tail_seg(T, St, [H|Acc]); -app_tail_seg([], St0, Acc) -> +preprocess_quals(_, [], St, Acc) -> + {reverse(Acc),St}. + +is_generator({generate,_,_,_}) -> true; +is_generator({b_generate,_,_,_}) -> true; +is_generator(_) -> false. + +%% +%% Generators are abstracted as sextuplets: +%% - acc_pat is the accumulator pattern, e.g. [Pat|Tail] for Pat <- Expr. +%% - acc_guard is the list of guards immediately following the current +%% generator in the qualifier list input. +%% - skip_pat is the skip pattern, e.g. <<X,_:X,Tail/bitstring>> for +%% <<X,1:X>> <= Expr. +%% - tail is the variable used in AccPat and SkipPat bound to the rest of the +%% generator input. +%% - tail_pat is the tail pattern, respectively [] and <<_/bitstring>> for list +%% and bit string generators. +%% - arg is a pair {Pre,Arg} where Pre is the list of expressions to be +%% inserted before the comprehension function and Arg is the expression +%% that it should be passed. +%% + +%% generator(Line, Generator, Guard, State) -> {Generator',State}. +%% Transform a given generator into its #igen{} representation. + +generator(Line, {generate,Lg,P0,E}, Gs, St0) -> + LA = lineno_anno(Line, St0), + GA = lineno_anno(Lg, 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 + #c_var{} -> + %% If the generator pattern is a variable, the + %% pattern from the accumulator clause can be + %% reused in the skip one. lc_tq and bc_tq1 takes + %% care of dismissing the latter in that case. + Cons = ann_c_cons(LA, Head, Tail), + {Cons,Cons}; + nomatch -> + %% If it never matches, there is no need for + %% an accumulator clause. + {nomatch,ann_c_cons(LA, Skip, Tail)}; + _ -> + {ann_c_cons(LA, Head, Tail), + ann_c_cons(LA, Skip, Tail)} + end, + {Ce,Pre,St4} = safe(E, St3), + 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} = 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,St1} = append_tail_segment(Segs, St0), + AccPat = Cp#c_binary{segments=AccSegs}, + {Cg,St2} = lc_guard_tests(Gs, St1), + {SkipSegs,St3} = emasculate_segments(AccSegs, St2), + SkipPat = Cp#c_binary{segments=SkipSegs}, + {Ce,Pre,St4} = safe(E, St3), + 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,St4}. + +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]}}, - {reverse(Acc, [Tail]),Var,St}. + {Segs++[Tail],Var,Tail,St}. emasculate_segments(Segs, St) -> emasculate_segments(Segs, St, []). @@ -1167,7 +1257,7 @@ emasculate_segments([B|Rest], St0, Acc) -> {Var,St1} = new_var(St0), emasculate_segments(Rest, St1, [B#c_bitstr{val=Var}|Acc]); emasculate_segments([], St, Acc) -> - {lists:reverse(Acc),St}. + {reverse(Acc),St}. lc_guard_tests([], St) -> {[],St}; lc_guard_tests(Gs0, St0) -> @@ -1412,6 +1502,15 @@ 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), @@ -1479,9 +1578,11 @@ pattern({atom,L,A}, St) -> #c_literal{anno=lineno_anno(L, St),val=A}; pattern({string,L,S}, St) -> #c_literal{anno=lineno_anno(L, St),val=S}; pattern({nil,L}, St) -> #c_literal{anno=lineno_anno(L, St),val=[]}; pattern({cons,L,H,T}, St) -> - ann_c_cons(lineno_anno(L, St), pattern(H, St), pattern(T, St)); + annotate_cons(lineno_anno(L, St), pattern(H, St), pattern(T, St), St); pattern({tuple,L,Ps}, St) -> - ann_c_tuple(lineno_anno(L, St), pattern_list(Ps, St)); + annotate_tuple(record_anno(L, St), pattern_list(Ps, St), St); +pattern({map,L,Ps}, St) -> + #c_map{anno=lineno_anno(L, St), es=pattern_map_pairs(Ps, St)}; 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. @@ -1489,6 +1590,60 @@ pattern({bin,L,Ps}, St) -> pattern({match,_,P1,P2}, St) -> pat_alias(pattern(P1, St), pattern(P2, St)). +%% pattern_map_pairs([MapFieldExact],State) -> [#c_map_pairs{}] +pattern_map_pairs(Ps, St) -> + %% check literal key uniqueness (dict is needed) + %% pattern all pairs + {CMapPairs, Kdb} = lists:mapfoldl(fun + (P,Kdbi) -> + #c_map_pair{key=Ck,val=Cv} = CMapPair = pattern_map_pair(P,St), + K = core_lib:literal_value(Ck), + case dict:find(K,Kdbi) of + {ok, Vs} -> + {CMapPair, dict:store(K,[Cv|Vs],Kdbi)}; + _ -> + {CMapPair, dict:store(K,[Cv],Kdbi)} + end + end, dict:new(), Ps), + pattern_alias_map_pairs(CMapPairs,Kdb,dict:new(),St). + +pattern_alias_map_pairs([],_,_,_) -> []; +pattern_alias_map_pairs([#c_map_pair{key=Ck}=Pair|Pairs],Kdb,Kset,St) -> + %% alias same keys if needed + K = core_lib:literal_value(Ck), + case dict:find(K,Kset) of + {ok,processed} -> + pattern_alias_map_pairs(Pairs,Kdb,Kset,St); + _ -> + Cvs = dict:fetch(K,Kdb), + Cv = pattern_alias_map_pair_patterns(Cvs), + Kset1 = dict:store(K, processed, Kset), + [Pair#c_map_pair{val=Cv}|pattern_alias_map_pairs(Pairs,Kdb,Kset1,St)] + end. + +pattern_alias_map_pair_patterns([Cv]) -> Cv; +pattern_alias_map_pair_patterns([Cv1,Cv2|Cvs]) -> + pattern_alias_map_pair_patterns([pat_alias(Cv1,Cv2)|Cvs]). + +pattern_map_pair({map_field_exact,L,K,V},St) -> + #c_map_pair{anno=lineno_anno(L, St), + op=#c_literal{val=exact}, + key=pattern_map_key(K,St), + val=pattern(V, St)}. + +pattern_map_key(K,St) -> + %% Throws 'nomatch' if the key can't be a literal + %% this will be a cryptic error message but it is better than nothing + case expr(K,St) of + {Key0,[],_} -> + %% Dialyzer hack redux + case coalesced_map_key(Key0) of + {ok,Key1} -> Key1; + error -> throw(nomatch) + end; + _ -> throw(nomatch) + end. + %% pat_bin([BinElement], State) -> [BinSeg]. pat_bin(Ps, St) -> [pat_segment(P, St) || P <- Ps]. @@ -1546,15 +1701,6 @@ pat_alias_list(_, _) -> throw(nomatch). pattern_list(Ps, St) -> [pattern(P, St) || P <- Ps]. -%% first([A]) -> [A]. -%% last([A]) -> A. - -first([_]) -> []; -first([H|T]) -> [H|first(T)]. - -last([L]) -> L; -last([_|T]) -> last(T). - %% make_vars([Name]) -> [{Var,Name}]. make_vars(Vs) -> [ #c_var{name=V} || V <- Vs ]. @@ -1602,6 +1748,26 @@ fail_clause(Pats, Anno, Arg) -> body=[#iprimop{anno=#a{anno=Anno},name=#c_literal{val=match_fail}, args=[Arg]}]}. +annotate_tuple(A, Es, St) -> + case member(dialyzer, St#core.opts) of + true -> + %% Do not coalesce constant tuple elements. A Hack. + Node = cerl:ann_c_tuple(A, [cerl:c_var(any)]), + cerl:update_c_tuple_skel(Node, Es); + false -> + ann_c_tuple(A, Es) + end. + +annotate_cons(A, H, T, St) -> + case member(dialyzer, St#core.opts) of + true -> + %% Do not coalesce constant conses. A Hack. + Node= cerl:ann_c_cons(A, cerl:c_var(any), cerl:c_var(any)), + cerl:update_c_cons_skel(Node, H, T); + false -> + ann_c_cons(A, H, T) + end. + ubody(B, St) -> uexpr(B, [], St). %% uclauses([Lclause], [KnownVar], State) -> {[Lclause],State}. @@ -1637,13 +1803,13 @@ uclause(#iclause{anno=Anno,pats=Ps0,guard=G0,body=B0}, Pks, Ks0, St0) -> uguard([], [], _, St) -> {[],St}; uguard(Pg, [], Ks, St) -> %% No guard, so fold together equality tests. - uguard(first(Pg), [last(Pg)], Ks, St); + uguard(droplast(Pg), [last(Pg)], Ks, St); uguard(Pg, Gs0, Ks, St0) -> %% Gs0 must contain at least one element here. {Gs3,St5} = foldr(fun (T, {Gs1,St1}) -> {L,St2} = new_var(St1), {R,St3} = new_var(St2), - {[#iset{var=L,arg=T}] ++ first(Gs1) ++ + {[#iset{var=L,arg=T}] ++ droplast(Gs1) ++ [#iset{var=R,arg=last(Gs1)}, #icall{anno=#a{}, %Must have an #a{} module=#c_literal{val=erlang}, @@ -1712,21 +1878,29 @@ uexpr(#iletrec{anno=A,defs=Fs0,body=B0}, Ks, St0) -> {B1,St2} = uexprs(B0, Ks, St1), Used = used_in_any(map(fun ({_,F}) -> F end, Fs1) ++ B1), {#iletrec{anno=A#a{us=Used,ns=[]},defs=Fs1,body=B1},St2}; -uexpr(#icase{anno=A,args=As0,clauses=Cs0,fc=Fc0}, Ks, St0) -> +uexpr(#icase{anno=#a{anno=Anno}=A,args=As0,clauses=Cs0,fc=Fc0}, Ks, St0) -> %% As0 will never generate new variables. {As1,St1} = uexpr_list(As0, Ks, St0), {Cs1,St2} = uclauses(Cs0, Ks, St1), {Fc1,St3} = uclause(Fc0, Ks, St2), Used = union(used_in_any(As1), used_in_any(Cs1)), - New = new_in_all(Cs1), + New = case member(list_comprehension, Anno) of + true -> []; + false -> new_in_all(Cs1) + end, {#icase{anno=A#a{us=Used,ns=New},args=As1,clauses=Cs1,fc=Fc1},St3}; -uexpr(#ifun{anno=A,id=Id,vars=As,clauses=Cs0,fc=Fc0}, Ks0, St0) -> +uexpr(#ifun{anno=A0,id=Id,vars=As,clauses=Cs0,fc=Fc0,name=Name}, Ks0, St0) -> Avs = lit_list_vars(As), - Ks1 = union(Avs, Ks0), - {Cs1,St1} = ufun_clauses(Cs0, Ks1, St0), - {Fc1,St2} = ufun_clause(Fc0, Ks1, St1), - Used = subtract(intersection(used_in_any(Cs1), Ks0), Avs), - {#ifun{anno=A#a{us=Used,ns=[]},id=Id,vars=As,clauses=Cs1,fc=Fc1},St2}; + 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), + A1 = A0#a{us=Used,ns=[]}, + {#ifun{anno=A1,id=Id,vars=As,clauses=Cs1,fc=Fc1,name=Name},St2}; 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}; @@ -1822,6 +1996,12 @@ 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) -> + {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},val=V0}=MapPair, Ks, St0) -> + {V,Vg,Vv,Vu,St1} = upattern(V0, Ks, St0), + {MapPair#c_map_pair{val=V},Vg,Vv,Vu,St1}; upattern(#c_binary{segments=Es0}=Bin, Ks, St0) -> {Es1,Esg,Esv,Eus,St1} = upat_bin(Es0, Ks, St0), {Bin#c_binary{segments=Es1},Esg,Esv,Eus,St1}; @@ -2021,15 +2201,25 @@ cexpr(#itry{anno=A,args=La,vars=Vs,body=Lb,evars=Evs,handler=Lh}, As, St0) -> cexpr(#icatch{anno=A,body=Les}, _As, St0) -> {Ces,_Us1,St1} = cexprs(Les, [], St0), %Never export! {#c_catch{body=Ces},[],A#a.us,St1}; -cexpr(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) -> - {Ccs,St1} = cclauses(Lcs, [], St0), %NEVER export! - {Cfc,St2} = cclause(Lfc, [], St1), - Anno = A#a.anno, - {#c_fun{anno=Id++Anno,vars=Args, - body=#c_case{anno=Anno, - arg=set_anno(core_lib:make_values(Args), Anno), - clauses=Ccs ++ [Cfc]}}, - [],A#a.us,St2}; +cexpr(#ifun{name=unnamed}=Fun, As, St0) -> + cfun(Fun, As, St0); +cexpr(#ifun{anno=#a{us=Us0}=A0,name={named,Name},fc=#iclause{pats=Ps}}=Fun0, + As, St0) -> + case is_element(Name, Us0) of + false -> + cfun(Fun0, As, St0); + true -> + A1 = A0#a{us=del_element(Name, Us0)}, + Fun1 = Fun0#ifun{anno=A1}, + {#c_fun{body=Body}=CFun0,[],Us1,St1} = cfun(Fun1, As, St0), + RecVar = #c_var{name={Name,length(Ps)}}, + Let = #c_let{vars=[#c_var{name=Name}],arg=RecVar,body=Body}, + CFun1 = CFun0#c_fun{body=Let}, + Letrec = #c_letrec{anno=A0#a.anno, + defs=[{RecVar,CFun1}], + body=RecVar}, + {Letrec,[],Us1,St1} + end; cexpr(#iapply{anno=A,op=Op,args=Args}, _As, St) -> {#c_apply{anno=A#a.anno,op=Op,args=Args},[],A#a.us,St}; cexpr(#icall{anno=A,module=Mod,name=Name,args=Args}, _As, St) -> @@ -2056,23 +2246,15 @@ cexpr(Lit, _As, St) -> %%Vs = lit_vars(Lit), {set_anno(Lit, Anno#a.anno),[],Vs,St}. -%% Kill the id annotations for any fun inside the expression. -%% Necessary when duplicating code in try ... after. - -kill_id_anns(#ifun{clauses=Cs0}=Fun) -> - Cs = kill_id_anns(Cs0), - Fun#ifun{clauses=Cs,id=[]}; -kill_id_anns(#a{}=A) -> - %% Optimization: Don't waste time searching for funs inside annotations. - A; -kill_id_anns([H|T]) -> - [kill_id_anns(H)|kill_id_anns(T)]; -kill_id_anns([]) -> []; -kill_id_anns(Tuple) when is_tuple(Tuple) -> - L0 = tuple_to_list(Tuple), - L = kill_id_anns(L0), - list_to_tuple(L); -kill_id_anns(Other) -> Other. +cfun(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) -> + {Ccs,St1} = cclauses(Lcs, [], St0), %NEVER export! + {Cfc,St2} = cclause(Lfc, [], St1), + Anno = A#a.anno, + {#c_fun{anno=Id++Anno,vars=Args, + body=#c_case{anno=Anno, + arg=set_anno(core_lib:make_values(Args), Anno), + clauses=Ccs ++ [Cfc]}}, + [],A#a.us,St2}. %% lit_vars(Literal) -> [Var]. @@ -2080,6 +2262,8 @@ lit_vars(Lit) -> lit_vars(Lit, []). lit_vars(#c_cons{hd=H,tl=T}, Vs) -> lit_vars(H, lit_vars(T, Vs)); lit_vars(#c_tuple{es=Es}, Vs) -> lit_list_vars(Es, Vs); +lit_vars(#c_map{arg=V,es=Es}, Vs) -> lit_vars(V, lit_list_vars(Es, Vs)); +lit_vars(#c_map_pair{key=K,val=V}, Vs) -> lit_vars(K, lit_vars(V, Vs)); lit_vars(#c_var{name=V}, Vs) -> add_element(V, Vs); lit_vars(_, Vs) -> Vs. %These are atomic @@ -2101,6 +2285,23 @@ bitstr_vars(Segs, Vs) -> lit_vars(V, lit_vars(S, Vs0)) end, Vs, Segs). +record_anno(L, St) when L >= ?REC_OFFSET -> + case member(dialyzer, St#core.opts) of + true -> + [record | lineno_anno(L - ?REC_OFFSET, St)]; + false -> + lineno_anno(L, St) + end; +record_anno(L, St) when L < -?REC_OFFSET -> + case member(dialyzer, St#core.opts) of + true -> + [record | lineno_anno(L + ?REC_OFFSET, St)]; + false -> + lineno_anno(L, St) + end; +record_anno(L, St) -> + lineno_anno(L, St). + lineno_anno(L, St) -> {line, Line} = erl_parse:get_attribute(L, line), if @@ -2150,6 +2351,9 @@ is_simple(#c_literal{}) -> true; is_simple(#c_cons{hd=H,tl=T}) -> is_simple(H) andalso is_simple(T); is_simple(#c_tuple{es=Es}) -> is_simple_list(Es); +is_simple(#c_map{es=Es}) -> is_simple_list(Es); +is_simple(#c_map_pair{key=K,val=V}) -> + is_simple(K) andalso is_simple(V); is_simple(_) -> false. -spec is_simple_list([cerl:cerl()]) -> boolean(). @@ -2167,7 +2371,11 @@ is_simple_list(Es) -> lists:all(fun is_simple/1, Es). format_error(nomatch) -> "pattern cannot possibly match"; format_error(bad_binary) -> - "binary construction will fail because of a type mismatch". + "binary construction will fail because of a type mismatch"; +format_error(bad_map_key) -> + "map construction will fail because of none literal key (large binaries are not literals)"; +format_error(bad_map) -> + "map construction will fail because of a type mismatch". add_warning(Line, Term, #core{ws=Ws,file=[{file,File}]}=St) when Line >= 0 -> St#core{ws=[{File,[{location(Line),?MODULE,Term}]}|Ws]}; diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 65f1251099..40d2f72b4c 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -81,7 +81,7 @@ -export([module/2,format_error/1]). -import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2, - keymember/3,keyfind/3,partition/2]). + keymember/3,keyfind/3,partition/2,droplast/1,last/1]). -import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]). -import(cerl, [c_tuple/1]). @@ -272,6 +272,18 @@ expr(#c_cons{anno=A,hd=Ch,tl=Ct}, Sub, St0) -> expr(#c_tuple{anno=A,es=Ces}, Sub, St0) -> {Kes,Ep,St1} = atomic_list(Ces, Sub, St0), {#k_tuple{anno=A,es=Kes},Ep,St1}; +expr(#c_map{anno=A,arg=Var,es=Ces}, Sub, St0) -> + try expr_map(A,Var,Ces,Sub,St0) of + {_,_,_}=Res -> Res + catch + throw:bad_map -> + St1 = add_warning(get_line(A), bad_map, A, St0), + Erl = #c_literal{val=erlang}, + Name = #c_literal{val=error}, + Args = [#c_literal{val=badarg}], + Error = #c_call{anno=A,module=Erl,name=Name,args=Args}, + expr(Error, Sub, St1) + end; expr(#c_binary{anno=A,segments=Cv}, Sub, St0) -> try atomic_bin(Cv, Sub, St0) of {Kv,Ep,St1} -> @@ -347,7 +359,7 @@ expr(#c_case{arg=Ca,clauses=Ccs}, Sub, St0) -> {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)), - {last(Match),Pa ++ Pv ++ first(Match),St3}; + {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), @@ -493,6 +505,85 @@ translate_match_fail_1(Anno, As, Sub, #kern{ff=FF}) -> translate_fc(Args) -> [#c_literal{val=function_clause},make_list(Args)]. +expr_map(A,Var0,Ces,Sub,St0) -> + %% An extra pass of validation of Map src because of inlining + {Var,Mps,St1} = expr(Var0, Sub, St0), + case is_valid_map_src(Var) of + true -> + {Km,Eps,St2} = map_split_pairs(A, Var, Ces, Sub, St1), + {Km,Eps++Mps,St2}; + false -> throw(bad_map) + end. + +is_valid_map_src(#k_map{}) -> true; +is_valid_map_src(#k_literal{val=M}) when is_map(M) -> true; +is_valid_map_src(#k_var{}) -> true; +is_valid_map_src(_) -> false. + +map_split_pairs(A, Var, Ces, Sub, St0) -> + %% two steps + %% 1. force variables + %% 2. remove multiples + Pairs0 = [{Op,K,V} || #c_map_pair{op=#c_literal{val=Op},key=K,val=V} <- Ces], + {Pairs,Esp,St1} = foldr(fun + ({Op,K0,V0}, {Ops,Espi,Sti0}) when Op =:= assoc; Op =:= exact -> + {K,[],Sti1} = expr(K0, Sub, Sti0), + {V,Ep,Sti2} = atomic(V0, Sub, Sti1), + {[{Op,K,V}|Ops],Ep ++ Espi,Sti2} + end, {[],[],St0}, Pairs0), + + case map_group_pairs(Pairs) of + {Assoc,[]} -> + Kes = [#k_map_pair{key=K,val=V}||{_,{assoc,K,V}} <- Assoc], + {#k_map{anno=A,op=assoc,var=Var,es=Kes},Esp,St1}; + {[],Exact} -> + Kes = [#k_map_pair{key=K,val=V}||{_,{exact,K,V}} <- Exact], + {#k_map{anno=A,op=exact,var=Var,es=Kes},Esp,St1}; + {Assoc,Exact} -> + Kes1 = [#k_map_pair{key=K,val=V}||{_,{assoc,K,V}} <- Assoc], + {Mvar,Em,St2} = force_atomic(#k_map{anno=A,op=assoc,var=Var,es=Kes1},St1), + Kes2 = [#k_map_pair{key=K,val=V}||{_,{exact,K,V}} <- Exact], + {#k_map{anno=A,op=exact,var=Mvar,es=Kes2},Esp ++ Em,St2} + + end. + +%% Group map by Assoc operations and Exact operations + +map_group_pairs(Es) -> + Groups = dict:to_list(map_group_pairs(Es,dict:new())), + partition(fun({_,{Op,_,_}}) -> Op =:= assoc end, Groups). + +map_group_pairs([{assoc,K,V}|Es0],Used0) -> + Used1 = case map_key_is_used(K,Used0) of + {ok, {assoc,_,_}} -> map_key_set_used(K,{assoc,K,V},Used0); + {ok, {exact,_,_}} -> map_key_set_used(K,{exact,K,V},Used0); + _ -> map_key_set_used(K,{assoc,K,V},Used0) + end, + map_group_pairs(Es0,Used1); +map_group_pairs([{exact,K,V}|Es0],Used0) -> + Used1 = case map_key_is_used(K,Used0) of + {ok, {assoc,_,_}} -> map_key_set_used(K,{assoc,K,V},Used0); + {ok, {exact,_,_}} -> map_key_set_used(K,{exact,K,V},Used0); + _ -> map_key_set_used(K,{exact,K,V},Used0) + end, + map_group_pairs(Es0,Used1); +map_group_pairs([],Used) -> + Used. + +map_key_set_used(K,How,Used) -> + dict:store(map_key_clean(K),How,Used). + +map_key_is_used(K,Used) -> + dict:find(map_key_clean(K),Used). + +%% Be explicit instead of using set_kanno(K,[]) +map_key_clean(#k_literal{val=V}) -> {k_literal,V}; +map_key_clean(#k_int{val=V}) -> {k_int,V}; +map_key_clean(#k_float{val=V}) -> {k_float,V}; +map_key_clean(#k_atom{val=V}) -> {k_atom,V}; +map_key_clean(#k_nil{}) -> k_nil. + + %% call_type(Module, Function, Arity) -> call | bif | apply | error. %% Classify the call. call_type(#c_literal{val=M}, #c_literal{val=F}, Ar) when is_atom(M), is_atom(F) -> @@ -648,6 +739,9 @@ pattern(#c_cons{anno=A,hd=Ch,tl=Ct}, Isub, Osub0, St0) -> pattern(#c_tuple{anno=A,es=Ces}, Isub, Osub0, St0) -> {Kes,Osub1,St1} = pattern_list(Ces, Isub, Osub0, St0), {#k_tuple{anno=A,es=Kes},Osub1,St1}; +pattern(#c_map{anno=A,es=Ces}, Isub, Osub0, St0) -> + {Kes,Osub1,St1} = pattern_map_pairs(Ces, Isub, Osub0, St0), + {#k_map{anno=A,op=exact,es=Kes},Osub1,St1}; pattern(#c_binary{anno=A,segments=Cv}, Isub, Osub0, St0) -> {Kv,Osub1,St1} = pattern_bin(Cv, Isub, Osub0, St0), {#k_binary{anno=A,segs=Kv},Osub1,St1}; @@ -662,6 +756,25 @@ flatten_alias(#c_alias{var=V,pat=P}) -> {[V|Vs],Pat}; flatten_alias(Pat) -> {[],Pat}. +pattern_map_pairs(Ces0, Isub, Osub0, St0) -> + %% It is assumed that all core keys are literals + %% It is later assumed that these keys are term sorted + %% so we need to sort them here + Ces1 = lists:sort(fun + (#c_map_pair{key=CkA},#c_map_pair{key=CkB}) -> + A = core_lib:literal_value(CkA), + B = core_lib:literal_value(CkB), + erts_internal:cmp_term(A,B) < 0 + end, Ces0), + %% pattern the pair keys and values as normal + {Kes,{Osub1,St1}} = lists:mapfoldl(fun + (#c_map_pair{anno=A,key=Ck,val=Cv},{Osubi0,Sti0}) -> + {Kk,Osubi1,Sti1} = pattern(Ck, Isub, Osubi0, Sti0), + {Kv,Osubi2,Sti2} = pattern(Cv, Isub, Osubi1, Sti1), + {#k_map_pair{anno=A,key=Kk,val=Kv},{Osubi2,Sti2}} + end, {Osub0, St0}, Ces1), + {Kes,Osub1,St1}. + pattern_bin(Es, Isub, Osub0, St0) -> {Kbin,{_,Osub},St} = pattern_bin_1(Es, Isub, Osub0, St0), {Kbin,Osub,St}. @@ -826,15 +939,6 @@ foldr2(Fun, Acc0, [E1|L1], [E2|L2]) -> foldr2(Fun, Acc1, L1, L2); foldr2(_, Acc, [], []) -> Acc. -%% first([A]) -> [A]. -%% last([A]) -> A. - -last([L]) -> L; -last([_|T]) -> last(T). - -first([_]) -> []; -first([H|T]) -> [H|first(T)]. - %% This code implements the algorithm for an optimizing compiler for %% pattern matching given "The Implementation of Functional %% Programming Languages" by Simon Peyton Jones. The code is much @@ -1015,7 +1119,8 @@ match_con_1([U|_Us] = L, Cs, Def, St0) -> %% Extract clauses for different constructors (types). %%ok = io:format("match_con ~p~n", [Cs]), Ttcs = select_types([k_binary], Cs) ++ select_bin_con(Cs) ++ - select_types([k_cons,k_tuple,k_atom,k_float,k_int,k_nil,k_literal], Cs), + select_types([k_cons,k_tuple,k_map,k_atom,k_float,k_int, + k_nil,k_literal], Cs), %%ok = io:format("ttcs = ~p~n", [Ttcs]), {Scs,St1} = mapfoldl(fun ({T,Tcs}, St) -> @@ -1251,10 +1356,9 @@ group_value(k_cons, Cs) -> [Cs]; %These are single valued group_value(k_nil, Cs) -> [Cs]; group_value(k_binary, Cs) -> [Cs]; group_value(k_bin_end, Cs) -> [Cs]; -group_value(k_bin_seg, Cs) -> - group_bin_seg(Cs); -group_value(k_bin_int, Cs) -> - [Cs]; +group_value(k_bin_seg, Cs) -> group_bin_seg(Cs); +group_value(k_bin_int, Cs) -> [Cs]; +group_value(k_map, Cs) -> group_map(Cs); group_value(_, Cs) -> %% group_value(Cs). Cd = foldl(fun (C, Gcs0) -> dict:append(clause_val(C), C, Gcs0) end, @@ -1267,6 +1371,12 @@ group_bin_seg([C1|Cs]) -> [[C1|More]|group_bin_seg(Rest)]; group_bin_seg([]) -> []. +group_map([C1|Cs]) -> + V1 = clause_val(C1), + {More,Rest} = splitwith(fun (C) -> clause_val(C) =:= V1 end, Cs), + [[C1|More]|group_map(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]) -> @@ -1315,6 +1425,13 @@ get_match(#k_bin_int{}=BinInt, St0) -> get_match(#k_tuple{es=Es}, St0) -> {Mes,St1} = new_vars(length(Es), St0), {#k_tuple{es=Mes},Mes,St1}; +get_match(#k_map{op=exact,es=Es0}, St0) -> + {Mes,St1} = new_vars(length(Es0), St0), + {Es,_} = mapfoldl(fun + (#k_map_pair{}=Pair, [V|Vs]) -> + {Pair#k_map_pair{val=V},Vs} + end, Mes, Es0), + {#k_map{op=exact,es=Es},Mes,St1}; get_match(M, St) -> {M,[],St}. @@ -1331,7 +1448,11 @@ new_clauses(Cs0, U, St) -> [S,N|As]; #k_bin_int{next=N} -> [N|As]; - _Other -> As + #k_map{op=exact,es=Es} -> + Vals = [V || #k_map_pair{val=V} <- Es], + Vals ++ As; + _Other -> + As end, Vs = arg_alias(Arg), Osub1 = foldl(fun (#k_var{name=V}, Acc) -> @@ -1406,6 +1527,7 @@ arg_con(Arg) -> #k_nil{} -> k_nil; #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; @@ -1426,7 +1548,15 @@ arg_val(Arg, C) -> {#k_var{name=get_vsub(V, Isub)},U,T,Fs}; _ -> {set_kanno(S, []),U,T,Fs} - end + end; + #k_map{op=exact,es=Es} -> + Keys = [begin + #k_map_pair{key=#k_literal{val=Key}} = Pair, + Key + end || Pair <- Es], + %% multiple keys may have the same name + %% do not use ordsets + lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, Keys) end. %% ubody_used_vars(Expr, State) -> [UsedVar] @@ -1795,6 +1925,10 @@ lit_vars(#k_atom{}) -> []; 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}) -> + lit_list_vars([Var|Es]); +lit_vars(#k_map_pair{key=K,val=V}) -> + union(lit_vars(K), lit_vars(V)); lit_vars(#k_binary{segs=V}) -> lit_vars(V); lit_vars(#k_bin_end{}) -> []; lit_vars(#k_bin_seg{size=Size,seg=S,next=N}) -> @@ -1830,7 +1964,11 @@ pat_vars(#k_bin_int{size=Size}) -> {U,[]}; pat_vars(#k_bin_end{}) -> {[],[]}; pat_vars(#k_tuple{es=Es}) -> - pat_list_vars(Es). + pat_list_vars(Es); +pat_vars(#k_map{es=Es}) -> + pat_list_vars(Es); +pat_vars(#k_map_pair{val=V}) -> + pat_vars(V). pat_list_vars(Ps) -> foldl(fun (P, {Used0,New0}) -> @@ -1871,7 +2009,9 @@ format_error(nomatch_shadow) -> format_error(bad_call) -> "invalid module and/or function name; this call will always fail"; format_error(bad_segment_size) -> - "binary construction will fail because of a type mismatch". + "binary construction will fail because of a type mismatch"; +format_error(bad_map) -> + "map construction will fail because of a type mismatch". add_warning(none, Term, Anno, #kern{ws=Ws}=St) -> File = get_file(Anno), diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl index fb8baf398b..ab66445f73 100644 --- a/lib/compiler/src/v3_kernel.hrl +++ b/lib/compiler/src/v3_kernel.hrl @@ -38,6 +38,8 @@ -record(k_nil, {anno=[]}). -record(k_tuple, {anno=[],es}). +-record(k_map, {anno=[],var,op,es}). +-record(k_map_pair, {anno=[],key,val}). -record(k_cons, {anno=[],hd,tl}). -record(k_binary, {anno=[],segs}). -record(k_bin_seg, {anno=[],size,unit,type,flags,seg,next}). diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl index e363a5387a..b33eba50eb 100644 --- a/lib/compiler/src/v3_kernel_pp.erl +++ b/lib/compiler/src/v3_kernel_pp.erl @@ -104,6 +104,30 @@ format_1(#k_tuple{es=Es}, Ctxt) -> format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), $} ]; +format_1(#k_map{var=#k_literal{val=M},op=assoc,es=Es}, Ctxt) when is_map(M), map_size(M) =:= 0 -> + ["~{", + format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), + "}~" + ]; +format_1(#k_map{var=#k_literal{val=M},op=exact,es=Es}, Ctxt) when is_map(M), map_size(M) =:= 0 -> + ["::{", + format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), + "}::" + ]; +format_1(#k_map{var=Var,op=assoc,es=Es}, Ctxt) -> + ["~{", + format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), + " | ",format_1(Var, Ctxt), + "}~" + ]; +format_1(#k_map{var=Var,op=exact,es=Es}, Ctxt) -> + ["::{", + format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), + " | ",format_1(Var, Ctxt), + "}::" + ]; +format_1(#k_map_pair{key=K,val=V}, Ctxt) -> + ["<",format(K, Ctxt),",",format(V, Ctxt),">"]; format_1(#k_binary{segs=S}, Ctxt) -> ["#<",format(S, ctxt_bump_indent(Ctxt, 2)),">#"]; format_1(#k_bin_seg{next=Next}=S, Ctxt) -> diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index 2cc3493570..cd4b5fd674 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -323,7 +323,8 @@ type(k_tuple) -> tuple; type(k_binary) -> binary; type(k_bin_seg) -> bin_seg; type(k_bin_int) -> bin_int; -type(k_bin_end) -> bin_end. +type(k_bin_end) -> bin_end; +type(k_map) -> map. %% variable(Klit) -> Lit. %% var_list([Klit]) -> [Lit]. @@ -365,6 +366,10 @@ literal(#k_bin_end{}, Ctxt) -> {bin_end,Ctxt}; literal(#k_tuple{es=Es}, Ctxt) -> {tuple,literal_list(Es, Ctxt)}; +literal(#k_map{op=Op,var=Var,es=Es}, Ctxt) -> + {map,Op,literal(Var, Ctxt),literal_list(Es, Ctxt)}; +literal(#k_map_pair{key=K,val=V}, Ctxt) -> + {map_pair,literal(K, Ctxt),literal(V, Ctxt)}; literal(#k_literal{val=V}, _Ctxt) -> {literal,V}. @@ -393,7 +398,11 @@ literal2(#k_bin_int{size=S,unit=U,flags=Fs,val=Int,next=N}, Ctxt) -> literal2(#k_bin_end{}, Ctxt) -> {bin_end,Ctxt}; literal2(#k_tuple{es=Es}, Ctxt) -> - {tuple,literal_list2(Es, Ctxt)}. + {tuple,literal_list2(Es, Ctxt)}; +literal2(#k_map{op=Op,es=Es}, Ctxt) -> + {map,Op,literal_list2(Es, Ctxt)}; +literal2(#k_map_pair{key=K,val=V}, Ctxt) -> + {map_pair,literal2(K, Ctxt),literal2(V, Ctxt)}. literal_list2(Ks, Ctxt) -> [literal2(K, Ctxt) || K <- Ks]. diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 51b3064589..0b56a49cd6 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -26,6 +26,7 @@ MODULES= \ guard_SUITE \ inline_SUITE \ lc_SUITE \ + map_SUITE \ match_SUITE \ misc_SUITE \ num_bif_SUITE \ @@ -47,6 +48,7 @@ NO_OPT= \ fun \ guard \ lc \ + map \ match \ misc \ num_bif \ @@ -67,6 +69,7 @@ INLINE= \ fun \ guard \ lc \ + map \ match \ misc \ num_bif \ diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl index 4ffbe07e32..b5408ecd8f 100644 --- a/lib/compiler/test/andor_SUITE.erl +++ b/lib/compiler/test/andor_SUITE.erl @@ -129,6 +129,10 @@ t_case_y(X, Y, Z) -> Y =:= 100 end. +-define(GUARD(E), if E -> true; + true -> false + end). + t_and_or(Config) when is_list(Config) -> ?line true = true and true, ?line false = true and false, @@ -160,11 +164,16 @@ t_and_or(Config) when is_list(Config) -> ?line true = false or id(true), ?line false = false or id(false), - ok. + True = id(true), --define(GUARD(E), if E -> true; - true -> false - end). + false = ?GUARD(erlang:'and'(bar, True)), + false = ?GUARD(erlang:'or'(bar, True)), + false = ?GUARD(erlang:'not'(erlang:'and'(bar, True))), + false = ?GUARD(erlang:'not'(erlang:'not'(erlang:'and'(bar, True)))), + + true = (fun (X = true) when X or true or X -> true end)(True), + + ok. t_andalso(Config) when is_list(Config) -> Bs = [true,false], @@ -194,6 +203,9 @@ t_andalso(Config) when is_list(Config) -> ?line false = id(false) andalso not id(glurf), ?line false = false andalso not id(glurf), + true = begin (X1 = true) andalso X1, X1 end, + false = false = begin (X2 = false) andalso X2, X2 end, + ok. t_orelse(Config) when is_list(Config) -> @@ -224,6 +236,9 @@ t_orelse(Config) when is_list(Config) -> ?line true = id(true) orelse not id(glurf), ?line true = true orelse not id(glurf), + true = begin (X1 = true) orelse X1, X1 end, + false = begin (X2 = false) orelse X2, X2 end, + ok. t_andalso_1({X,Y}) -> diff --git a/lib/compiler/test/beam_except_SUITE.erl b/lib/compiler/test/beam_except_SUITE.erl index bf67eedd5f..d088863c5c 100644 --- a/lib/compiler/test/beam_except_SUITE.erl +++ b/lib/compiler/test/beam_except_SUITE.erl @@ -57,6 +57,11 @@ coverage(_) -> {'EXIT',{undef,[{erlang,error,[a,b,c],_}|_]}} = (catch erlang:error(a, b, c)), + + {'EXIT',{badarith,[{?MODULE,bar,1,[File,{line,9}]}|_]}} = + (catch bar(x)), + {'EXIT',{{case_clause,{1}},[{?MODULE,bar,1,[File,{line,9}]}|_]}} = + (catch bar(0)), ok. -file("fake.erl", 1). @@ -65,3 +70,8 @@ fc(a) -> %Line 2 fc(L) when length(L) > 2 -> %Line 4 %% Not the same as a "real" function_clause error. error(function_clause, [L]). %Line 6 +%% Would crash the compiler. +bar(X) -> %Line 8 + case {X+1} of %Line 9 + 1 -> ok %Line 10 + end. %Line 11 diff --git a/lib/compiler/test/bs_bincomp_SUITE.erl b/lib/compiler/test/bs_bincomp_SUITE.erl index f6d8b1c532..4450405695 100644 --- a/lib/compiler/test/bs_bincomp_SUITE.erl +++ b/lib/compiler/test/bs_bincomp_SUITE.erl @@ -25,7 +25,7 @@ init_per_group/2,end_per_group/2, byte_aligned/1,bit_aligned/1,extended_byte_aligned/1, extended_bit_aligned/1,mixed/1,filters/1,trim_coverage/1, - nomatch/1,sizes/1,tail/1]). + nomatch/1,sizes/1]). -include_lib("test_server/include/test_server.hrl"). @@ -35,7 +35,7 @@ all() -> test_lib:recompile(?MODULE), [byte_aligned, bit_aligned, extended_byte_aligned, extended_bit_aligned, mixed, filters, trim_coverage, - nomatch, sizes, tail]. + nomatch, sizes]. groups() -> []. @@ -290,40 +290,6 @@ sizes(Config) when is_list(Config) -> ?line cs_end(), ok. -tail(Config) when is_list(Config) -> - ?line [] = tail_1(<<0:7>>), - ?line [0] = tail_1(<<0>>), - ?line [0] = tail_1(<<0:12>>), - ?line [0,0] = tail_1(<<0:20>>), - - ?line [] = tail_2(<<0:7>>), - ?line [42] = tail_2(<<0>>), - ?line [] = tail_2(<<0:12>>), - ?line [42,42] = tail_2(<<0,1>>), - - ?line <<>> = tail_3(<<0:7>>), - ?line <<42>> = tail_3(<<0>>), - ?line <<42>> = tail_3(<<0:12>>), - ?line <<42,42>> = tail_3(<<0:20>>), - - ?line [] = tail_4(<<0:15>>), - ?line [7] = tail_4(<<7,8>>), - ?line [9] = tail_4(<<9,17:12>>), - ok. - -tail_1(Bits) -> - [X || <<X:8/integer, _/bits>> <= Bits]. - -tail_2(Bits) -> - [42 || <<_:8/integer, _/bytes>> <= Bits]. - -tail_3(Bits) -> - << <<42>> || <<_:8/integer, _/bits>> <= Bits >>. - -tail_4(Bits) -> - [X || <<X:8/integer, Tail/bits>> <= Bits, bit_size(Tail) >= 8]. - - cs_init() -> erts_debug:set_internal_state(available_internal_state, true), ok. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 9f15845d33..10e3451e8f 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -34,7 +34,7 @@ otp_7188/1,otp_7233/1,otp_7240/1,otp_7498/1, match_string/1,zero_width/1,bad_size/1,haystack/1, cover_beam_bool/1,matched_out_size/1,follow_fail_branch/1, - no_partition/1]). + no_partition/1,calling_a_binary/1,binary_in_map/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -59,7 +59,7 @@ groups() -> matching_and_andalso,otp_7188,otp_7233,otp_7240, otp_7498,match_string,zero_width,bad_size,haystack, cover_beam_bool,matched_out_size,follow_fail_branch, - no_partition]}]. + no_partition,calling_a_binary,binary_in_map]}]. init_per_suite(Config) -> @@ -1178,6 +1178,37 @@ no_partition_2([], a5) -> no_partition_2(42.0, a6) -> six. +calling_a_binary(Config) when is_list(Config) -> + [] = call_binary(<<>>, []), + {'EXIT',{badarg,_}} = (catch call_binary(<<1>>, [])), + {'EXIT',{badarg,_}} = (catch call_binary(<<1,2,3>>, [])), + ok. + +call_binary(<<>>, Acc) -> + Acc; +call_binary(<<H,T/bits>>, Acc) -> + T(<<Acc/binary,H>>). + +binary_in_map(Config) when is_list(Config) -> + ok = match_binary_in_map(#{key => <<42:8>>}), + {'EXIT',{{badmatch,#{key := 1}},_}} = + (catch match_binary_in_map(#{key => 1})), + {'EXIT',{{badmatch,#{key := <<1023:16>>}},_}} = + (catch match_binary_in_map(#{key => <<1023:16>>})), + {'EXIT',{{badmatch,#{key := <<1:8>>}},_}} = + (catch match_binary_in_map(#{key => <<1:8>>})), + {'EXIT',{{badmatch,not_a_map},_}} = + (catch match_binary_in_map(not_a_map)), + ok. + +match_binary_in_map(Map) -> + case 8 of + N -> + #{key := <<42:N>>} = Map, + ok + end. + + check(F, R) -> R = F(). diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index d517029b1b..f7b1dbdddf 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -196,7 +196,7 @@ redundant_case_1(_) -> d. failure(Module, Conf) -> ?line Src = filename:join(?config(data_dir, Conf), atom_to_list(Module)), ?line Out = ?config(priv_dir,Conf), - ?line io:format("Compiling: ~s\n", [Src]), + ?line io:format("Compiling: ~ts\n", [Src]), ?line CompRc = compile:file(Src, [{outdir,Out},return,time]), ?line io:format("Result: ~p\n",[CompRc]), ?line case CompRc of @@ -278,6 +278,16 @@ try_it(StartNode, Module, Conf) -> ?line ok = rpc:call(Node, ?MODULE, load_and_call, [Out, Module]), ?line test_server:timetrap_cancel(LastDog), + AsmDog = test_server:timetrap(test_server:minutes(10)), + io:format("Compiling (from assembly): ~s\n", [Src]), + {ok,_} = compile:file(Src, [to_asm,{outdir,Out},report|OtherOpts]), + Asm = filename:join(Out, lists:concat([Module, ".S"])), + CompRc3 = compile:file(Asm, [from_asm,{outdir,Out},report|OtherOpts]), + io:format("Result: ~p\n",[CompRc3]), + {ok,_} = CompRc3, + ok = rpc:call(Node, ?MODULE, load_and_call, [Out, Module]), + test_server:timetrap_cancel(AsmDog), + case StartNode of false -> ok; true -> ?line test_server:stop_node(Node) @@ -466,8 +476,8 @@ self_compile_node(CompilerDir, OutDir, Version, Opts) -> ok. compile_compiler(Files, OutDir, Version, InlineOpts) -> - io:format("~s", [code:which(compile)]), - io:format("Compiling ~s into ~s", [Version,OutDir]), + io:format("~ts", [code:which(compile)]), + io:format("Compiling ~s into ~ts", [Version,OutDir]), Opts = [report, bin_opt_info, {outdir,OutDir}, diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index be01ea713d..8cb7d1b55b 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_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, - app_test/1, + app_test/1,appup_test/1, file_1/1, forms_2/1, module_mismatch/1, big_file/1, outdir/1, binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1, other_output/1, encrypted_abstr/1, @@ -42,7 +42,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [app_test, file_1, forms_2, module_mismatch, big_file, outdir, + [app_test, appup_test, file_1, forms_2, module_mismatch, big_file, outdir, binary, makedep, cond_and_ifdef, listings, listings_big, other_output, encrypted_abstr, {group, bad_record_use}, strict_record, @@ -71,6 +71,10 @@ end_per_group(_GroupName, Config) -> app_test(Config) when is_list(Config) -> ?line ?t:app_test(compiler). +%% Test that the Application upgrade file has no `basic' errors."; +appup_test(Config) when is_list(Config) -> + ok = ?t:appup_test(compiler). + %% Tests that we can compile and run a simple Erlang program, %% using compile:file/1. @@ -286,57 +290,67 @@ cond_and_ifdef(Config) when is_list(Config) -> ok. listings(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(8)), - ?line DataDir = ?config(data_dir, Config), - ?line PrivDir = ?config(priv_dir, Config), - ?line Simple = filename:join(DataDir, simple), - ?line TargetDir = filename:join(PrivDir, listings), - ?line ok = file:make_dir(TargetDir), + Dog = test_server:timetrap(test_server:minutes(8)), + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + ok = do_file_listings(DataDir, PrivDir, [ + "simple", + "small", + "small_maps" + ]), + test_server:timetrap_cancel(Dog), + ok. + +do_file_listings(_, _, []) -> ok; +do_file_listings(DataDir, PrivDir, [File|Files]) -> + Simple = filename:join(DataDir, File), + TargetDir = filename:join(PrivDir, listings), + ok = file:make_dir(TargetDir), %% Test all dedicated listing options. - ?line do_listing(Simple, TargetDir, 'S'), - ?line do_listing(Simple, TargetDir, 'E'), - ?line do_listing(Simple, TargetDir, 'P'), - ?line do_listing(Simple, TargetDir, dpp, ".pp"), - ?line do_listing(Simple, TargetDir, dabstr, ".abstr"), - ?line do_listing(Simple, TargetDir, dexp, ".expand"), - ?line do_listing(Simple, TargetDir, dcore, ".core"), - ?line do_listing(Simple, TargetDir, doldinline, ".oldinline"), - ?line do_listing(Simple, TargetDir, dinline, ".inline"), - ?line do_listing(Simple, TargetDir, dcore, ".core"), - ?line do_listing(Simple, TargetDir, dcopt, ".copt"), - ?line do_listing(Simple, TargetDir, dsetel, ".dsetel"), - ?line do_listing(Simple, TargetDir, dkern, ".kernel"), - ?line do_listing(Simple, TargetDir, dlife, ".life"), - ?line do_listing(Simple, TargetDir, dcg, ".codegen"), - ?line do_listing(Simple, TargetDir, dblk, ".block"), - ?line do_listing(Simple, TargetDir, dbool, ".bool"), - ?line do_listing(Simple, TargetDir, dtype, ".type"), - ?line do_listing(Simple, TargetDir, ddead, ".dead"), - ?line do_listing(Simple, TargetDir, djmp, ".jump"), - ?line do_listing(Simple, TargetDir, dclean, ".clean"), - ?line do_listing(Simple, TargetDir, dpeep, ".peep"), - ?line do_listing(Simple, TargetDir, dopt, ".optimize"), + do_listing(Simple, TargetDir, 'S'), + do_listing(Simple, TargetDir, 'E'), + do_listing(Simple, TargetDir, 'P'), + do_listing(Simple, TargetDir, dpp, ".pp"), + do_listing(Simple, TargetDir, dabstr, ".abstr"), + do_listing(Simple, TargetDir, dexp, ".expand"), + do_listing(Simple, TargetDir, dcore, ".core"), + do_listing(Simple, TargetDir, doldinline, ".oldinline"), + do_listing(Simple, TargetDir, dinline, ".inline"), + do_listing(Simple, TargetDir, dcore, ".core"), + do_listing(Simple, TargetDir, dcopt, ".copt"), + do_listing(Simple, TargetDir, dsetel, ".dsetel"), + do_listing(Simple, TargetDir, dkern, ".kernel"), + do_listing(Simple, TargetDir, dlife, ".life"), + do_listing(Simple, TargetDir, dcg, ".codegen"), + do_listing(Simple, TargetDir, dblk, ".block"), + do_listing(Simple, TargetDir, dbool, ".bool"), + do_listing(Simple, TargetDir, dtype, ".type"), + do_listing(Simple, TargetDir, ddead, ".dead"), + do_listing(Simple, TargetDir, djmp, ".jump"), + do_listing(Simple, TargetDir, dclean, ".clean"), + do_listing(Simple, TargetDir, dpeep, ".peep"), + do_listing(Simple, TargetDir, dopt, ".optimize"), %% First clean up. - ?line Listings = filename:join(PrivDir, listings), - ?line lists:foreach(fun(F) -> ok = file:delete(F) end, - filelib:wildcard(filename:join(Listings, "*"))), + Listings = filename:join(PrivDir, listings), + lists:foreach(fun(F) -> ok = file:delete(F) end, + filelib:wildcard(filename:join(Listings, "*"))), %% Test options that produce a listing file if 'binary' is not given. - ?line do_listing(Simple, TargetDir, to_pp, ".P"), - ?line do_listing(Simple, TargetDir, to_exp, ".E"), - ?line do_listing(Simple, TargetDir, to_core0, ".core"), - ?line ok = file:delete(filename:join(Listings, "simple.core")), - ?line do_listing(Simple, TargetDir, to_core, ".core"), - ?line do_listing(Simple, TargetDir, to_kernel, ".kernel"), + do_listing(Simple, TargetDir, to_pp, ".P"), + do_listing(Simple, TargetDir, to_exp, ".E"), + do_listing(Simple, TargetDir, to_core0, ".core"), + ok = file:delete(filename:join(Listings, File ++ ".core")), + do_listing(Simple, TargetDir, to_core, ".core"), + do_listing(Simple, TargetDir, to_kernel, ".kernel"), %% Final clean up. - ?line lists:foreach(fun(F) -> ok = file:delete(F) end, - filelib:wildcard(filename:join(Listings, "*"))), - ?line ok = file:del_dir(Listings), - ?line test_server:timetrap_cancel(Dog), - ok. + lists:foreach(fun(F) -> ok = file:delete(F) end, + filelib:wildcard(filename:join(Listings, "*"))), + ok = file:del_dir(Listings), + + do_file_listings(DataDir,PrivDir,Files). listings_big(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:minutes(10)), @@ -415,11 +429,11 @@ encrypted_abstr(Config) when is_list(Config) -> ?line {Simple,Target} = files(Config, "encrypted_abstr"), Res = case has_crypto() of - no -> + false -> %% No crypto. ?line encrypted_abstr_no_crypto(Simple, Target), {comment,"The crypto application is missing or broken"}; - yes -> + true -> %% Simulate not having crypto by removing %% the crypto application from the path. ?line OldPath = code:get_path(), @@ -511,6 +525,7 @@ write_crypt_file(Contents0) -> ok = file:write_file(".erlang.crypt", Contents). encrypted_abstr_no_crypto(Simple, Target) -> + io:format("simpe: ~p~n", [Simple]), ?line TargetDir = filename:dirname(Target), ?line Key = "ablurf123BX#$;3", ?line error = compile:file(Simple, @@ -525,11 +540,11 @@ verify_abstract(Target) -> has_crypto() -> try crypto:start(), - crypto:info(), + <<_,_,_,_,_>> = crypto:rand_bytes(5), crypto:stop(), - yes + true catch - error:_ -> no + error:_ -> false end. install_crypto_key(Key) -> @@ -769,8 +784,8 @@ do_core({M,A}, Outdir) -> error end. -%% Compile to Beam assembly language (.S) and the try to -%% run .S throught the compiler again. +%% Compile to Beam assembly language (.S) and then try to +%% run .S through the compiler again. asm(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:minutes(20)), @@ -791,10 +806,10 @@ do_asm(Beam, Outdir) -> try {ok,M,Asm} = compile:forms(A, ['S']), AsmFile = filename:join(Outdir, atom_to_list(M)++".S"), - {ok,Fd} = file:open(AsmFile, [write]), + {ok,Fd} = file:open(AsmFile, [write,{encoding,utf8}]), beam_listing:module(Fd, Asm), ok = file:close(Fd), - case compile:file(AsmFile, [from_asm,no_postopt,binary,report]) of + case compile:file(AsmFile, [from_asm,binary,report]) of {ok,M,_} -> ok = file:delete(AsmFile); Other -> diff --git a/lib/compiler/test/compile_SUITE_data/small.erl b/lib/compiler/test/compile_SUITE_data/small.erl new file mode 100644 index 0000000000..37cd270e50 --- /dev/null +++ b/lib/compiler/test/compile_SUITE_data/small.erl @@ -0,0 +1,48 @@ +-module(small). + +-export([go/0,go/2]). + + +-small_attribute({value,3}). + +go() -> go(3, 3.0). +go(A,B) -> + V1 = A + B, + V2 = A * B, + V3 = V1 / V2, + V4 = V3 / 0.3, + V5 = V1 + V2 + V3 + V4, + try + R = call(<<"wazzup">>, A), + {A,B,V5,R,t(),recv()} + catch + C:E -> + {error, C, E} + end. + +-spec call(binary(), term()) -> binary(). + +call(<<"wa", B/binary>>,V) when is_integer(V) -> B; +call(B,_) -> B. + +t() -> + <<23:32, V:14, _:2, B/binary>> = id(<<"wazzup world">>), + {V,B}. + +recv() -> + F = fun() -> + receive + 1 -> ok; + 2 -> ok; + 3 -> ok; + a -> ok; + _ -> none + after 0 -> tmo + end + end, + tmo = F(), + ok. + + +id(I) -> I. + diff --git a/lib/compiler/test/compile_SUITE_data/small_maps.erl b/lib/compiler/test/compile_SUITE_data/small_maps.erl new file mode 100644 index 0000000000..a17a136a7d --- /dev/null +++ b/lib/compiler/test/compile_SUITE_data/small_maps.erl @@ -0,0 +1,16 @@ +-module(small_maps). + +-export([go/0,go/1]). + +go() -> + go(1337). + +go(V0) -> + M0 = #{ a => 1, val => V0}, + V1 = get_val(M0), + M1 = M0#{ val := [V0,V1] }, + {some_val,[1337,{some_val,1337}]} = get_val(M1), + ok. + +get_val(#{ "wazzup" := _, val := V}) -> V; +get_val(#{ val := V }) -> {some_val, V}. diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl index a40dc32d59..428ad65364 100644 --- a/lib/compiler/test/core_SUITE.erl +++ b/lib/compiler/test/core_SUITE.erl @@ -23,7 +23,8 @@ init_per_testcase/2,end_per_testcase/2, dehydrated_itracer/1,nested_tries/1, seq_in_guard/1,make_effect_seq/1,eval_is_boolean/1, - unsafe_case/1,nomatch_shadow/1,reversed_annos/1]). + unsafe_case/1,nomatch_shadow/1,reversed_annos/1, + map_core_test/1,eval_case/1,bad_boolean_guard/1]). -include_lib("test_server/include/test_server.hrl"). @@ -48,7 +49,9 @@ all() -> groups() -> [{p,test_lib:parallel(), [dehydrated_itracer,nested_tries,seq_in_guard,make_effect_seq, - eval_is_boolean,unsafe_case,nomatch_shadow,reversed_annos]}]. + eval_is_boolean,unsafe_case,nomatch_shadow,reversed_annos, + map_core_test,eval_case,bad_boolean_guard + ]}]. init_per_suite(Config) -> @@ -72,6 +75,9 @@ end_per_group(_GroupName, Config) -> ?comp(unsafe_case). ?comp(nomatch_shadow). ?comp(reversed_annos). +?comp(map_core_test). +?comp(eval_case). +?comp(bad_boolean_guard). try_it(Mod, Conf) -> Src = filename:join(?config(data_dir, Conf), atom_to_list(Mod)), diff --git a/lib/compiler/test/core_SUITE_data/bad_boolean_guard.core b/lib/compiler/test/core_SUITE_data/bad_boolean_guard.core new file mode 100644 index 0000000000..318f8e3dc7 --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/bad_boolean_guard.core @@ -0,0 +1,32 @@ +module 'bad_boolean_guard' ['bad_boolean_guard'/0, + 'module_info'/0, + 'module_info'/1] + attributes [] +'bad_boolean_guard'/0 = + fun () -> + apply 'f'/1 + ('true') +'f'/1 = + fun (_X_cor0) -> + case _X_cor0 of + <X> + when try + call 'erlang':'and' + ('bad', _X_cor0) + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'not_ok' + <_X_cor3> when 'true' -> + 'ok' + end +'module_info'/0 = + fun () -> + call 'erlang':'get_module_info' + ('bad_boolean_guard') +'module_info'/1 = + fun (_X_cor0) -> + call 'erlang':'get_module_info' + ('bad_boolean_guard', _X_cor0) +end
\ No newline at end of file diff --git a/lib/compiler/test/core_SUITE_data/eval_case.core b/lib/compiler/test/core_SUITE_data/eval_case.core new file mode 100644 index 0000000000..f2776e2b1f --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/eval_case.core @@ -0,0 +1,34 @@ +module 'eval_case' ['eval_case'/0] + attributes [] +'eval_case'/0 = + fun () -> + case <> of + <> when 'true' -> + case apply 'do_case'/0() of + <'ok'> when 'true' -> + 'ok' + ( <_cor0> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor0}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + ( primop 'match_fail' + ({'function_clause'}) + -| [{'function_name',{'eval_case',0}}] ) + -| ['compiler_generated'] ) + end +'do_case'/0 = + fun () -> + case let <_cor0> = + apply 'id'/1(42) + in let <_cor1> = + call 'erlang':'+' + (_cor0, 7) + in {'x',_cor1} of + <{'x',49}> when 'true' -> + 'ok' + end +'id'/1 = + fun (_cor0) -> _cor0 +end diff --git a/lib/compiler/test/core_SUITE_data/map_core_test.core b/lib/compiler/test/core_SUITE_data/map_core_test.core new file mode 100644 index 0000000000..2aa853d450 --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/map_core_test.core @@ -0,0 +1,95 @@ +module 'map_core_test' ['map_core_test'/0, + 'module_info'/0, + 'module_info'/1] + attributes [] +'map_core_test'/0 = + %% Line 14 + fun () -> + let <_cor0> = + %% Line 15 + ~{::<'check','ok'>,::<1337,#{#<104>(8,1,'integer',['unsigned'|['big']]), + #<101>(8,1,'integer',['unsigned'|['big']]), + #<108>(8,1,'integer',['unsigned'|['big']]), + #<108>(8,1,'integer',['unsigned'|['big']]), + #<111>(8,1,'integer',['unsigned'|['big']])}#>,::<'val',0>}~ + in let <M> = + %% Line 15 + apply 'id'/1 + (_cor0) + in let <_cor2> = + %% Line 16 + apply 'id'/1 + ([1|[2|[3|[4|[5|[6]]]]]]) + in %% Line 16 + case apply 'call'/2 + (M, _cor2) of + <~{~<1337,#{#<104>(8,1,'integer',['unsigned'|['big']]), + #<101>(8,1,'integer',['unsigned'|['big']]), + #<108>(8,1,'integer',['unsigned'|['big']]), + #<108>(8,1,'integer',['unsigned'|['big']]), + #<111>(8,1,'integer',['unsigned'|['big']]), + #<32>(8,1,'integer',['unsigned'|['big']]), + #<49>(8,1,'integer',['unsigned'|['big']]), + #<32>(8,1,'integer',['unsigned'|['big']]), + #<50>(8,1,'integer',['unsigned'|['big']]), + #<32>(8,1,'integer',['unsigned'|['big']]), + #<51>(8,1,'integer',['unsigned'|['big']]), + #<32>(8,1,'integer',['unsigned'|['big']]), + #<52>(8,1,'integer',['unsigned'|['big']]), + #<32>(8,1,'integer',['unsigned'|['big']]), + #<53>(8,1,'integer',['unsigned'|['big']]), + #<32>(8,1,'integer',['unsigned'|['big']]), + #<54>(8,1,'integer',['unsigned'|['big']])}#>,~<'check','ok'>,~<'val',21>}~> when 'true' -> + %% Line 17 + 'ok' + ( <_cor3> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor3}) + -| ['compiler_generated'] ) + end +'call'/2 = + %% Line 20 + fun (_cor1,_cor0) -> + case <_cor1,_cor0> of + <M = ~{~<1337,Bin>,~<'check',_cor8>,~<'val',Val>}~,[V|Vs]> when 'true' -> + let <_cor3> = + %% Line 21 + call 'erlang':'+' + (V, 48) + in let <_cor4> = + %% Line 21 + #{#<Bin>('all',8,'binary',['unsigned'|['big']]), + #<32>(8,1,'integer',['unsigned'|['big']]), + #<_cor3>(8,1,'integer',['unsigned'|['big']])}# + in let <_cor2> = + %% Line 21 + call 'erlang':'+' + (Val, V) + in let <_cor5> = + %% Line 21 + ~{~<1337,_cor4>,~<'val',_cor2>|M}~ + in %% Line 21 + apply 'call'/2 + (_cor5, Vs) + %% Line 22 + <M,[]> when 'true' -> + M + ( <_cor7,_cor6> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_cor7,_cor6}) + -| [{'function_name',{'call',2}}] ) + -| ['compiler_generated'] ) + end +'id'/1 = + %% Line 24 + fun (_cor0) -> + _cor0 +'module_info'/0 = + fun () -> + call 'erlang':'get_module_info' + ('map_core_test') +'module_info'/1 = + fun (_cor0) -> + call 'erlang':'get_module_info' + ('map_core_test', _cor0) +end diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index a5a4e62a42..6a7036d728 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -22,7 +22,8 @@ init_per_group/2,end_per_group/2, t_element/1,setelement/1,t_length/1,append/1,t_apply/1,bifs/1, eq/1,nested_call_in_case/1,guard_try_catch/1,coverage/1, - unused_multiple_values_error/1,unused_multiple_values/1]). + unused_multiple_values_error/1,unused_multiple_values/1, + multiple_aliases/1,redundant_boolean_clauses/1,mixed_matching_clauses/1]). -export([foo/0,foo/1,foo/2,foo/3]). @@ -38,7 +39,8 @@ groups() -> [{p,test_lib:parallel(), [t_element,setelement,t_length,append,t_apply,bifs, eq,nested_call_in_case,guard_try_catch,coverage, - unused_multiple_values_error,unused_multiple_values]}]. + unused_multiple_values_error,unused_multiple_values, + multiple_aliases,redundant_boolean_clauses,mixed_matching_clauses]}]. init_per_suite(Config) -> @@ -249,6 +251,12 @@ coverage(Config) when is_list(Config) -> case list_to_pid("<0.42.0>") of Pid when is_pid(Pid) -> ok end, + + %% Cover the non-variable case in bsm_do_an/4. + ok = bsm_an_inlined(<<1>>, Config), + error = bsm_an_inlined(<<1,2,3>>, Config), + error = bsm_an_inlined([], Config), + ok. cover_will_match_list_type(A) -> @@ -290,7 +298,8 @@ cover_is_safe_bool_expr(X) -> false end. -id(I) -> I. +bsm_an_inlined(<<_:8>>, _) -> ok; +bsm_an_inlined(_, _) -> error. unused_multiple_values_error(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), @@ -329,3 +338,50 @@ do_something(I) -> put(unused_multiple_values, [I|get(unused_multiple_values)]), I. + + +%% Make sure that multiple aliases does not cause +%% the case expression to be evaluated twice. +multiple_aliases(Config) when is_list(Config) -> + do_ma(fun() -> + X = Y = run_once(), + {X,Y} + end, {ok,ok}), + do_ma(fun() -> + case {true,run_once()} of + {true=A=B,ok=X=Y} -> + {A,B,X,Y} + end + end, {true,true,ok,ok}), + ok. + +do_ma(Fun, Expected) when is_function(Fun, 0) -> + Expected = Fun(), + ran_once = erase(run_once), + ok. + +run_once() -> + undefined = put(run_once, ran_once), + ok. + + +redundant_boolean_clauses(Config) when is_list(Config) -> + X = id(0), + yes = case X == 0 of + false -> no; + false -> no; + true -> yes + end. + +mixed_matching_clauses(Config) when is_list(Config) -> + 0 = case #{} of + #{} -> 0; + a -> 1 + end, + 0 = case <<>> of + <<>> -> 0; + a -> 1 + end, + ok. + +id(I) -> I. diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl index 859c4571ea..bd877bb528 100644 --- a/lib/compiler/test/error_SUITE.erl +++ b/lib/compiler/test/error_SUITE.erl @@ -23,7 +23,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, head_mismatch_line/1,warnings_as_errors/1, bif_clashes/1, - transforms/1]). + transforms/1,forbidden_maps/1,bad_utf8/1]). %% Used by transforms/1 test case. -export([parse_transform/2]). @@ -36,7 +36,8 @@ all() -> groups() -> [{p,test_lib:parallel(), - [head_mismatch_line,warnings_as_errors,bif_clashes,transforms]}]. + [head_mismatch_line,warnings_as_errors,bif_clashes, + transforms,forbidden_maps,bad_utf8]}]. init_per_suite(Config) -> Config. @@ -240,6 +241,38 @@ parse_transform(_, _) -> error(too_bad). +forbidden_maps(Config) when is_list(Config) -> + Ts1 = [{map_illegal_use_of_pattern, + <<" + -export([t/0]). + t() -> + V = 32, + #{<<\"hi\",V,\"all\">> := 1} = id(#{<<\"hi all\">> => 1}). + id(I) -> I. + ">>, + [return], + {error,[{5,erl_lint,{illegal_map_key_variable,'V'}}], []}}], + [] = run2(Config, Ts1), + ok. + +bad_utf8(Config) -> + Ts = [{bad_utf8, + %% If coding is specified explicitly as utf-8, there should be + %% a compilation error; we must not fallback to parsing the + %% file in latin-1 mode. + <<"%% coding: utf-8 + %% Bj",246,"rn + t() -> \"",246,"\". + ">>, + [], + {error,[{2,epp,cannot_parse}, + {2,file_io_server,invalid_unicode}], + []} + }], + [] = run2(Config, Ts), + ok. + + run(Config, Tests) -> ?line File = test_filename(Config), run(Tests, File, dont_write_beam). @@ -303,6 +336,7 @@ run_test(Test0, File, Warnings, WriteBeam) -> ?line compile:file(File, [binary,report|Warnings]), %% Test result of compilation. + io:format("~p\n", [Opts]), ?line Res = case compile:file(File, Opts) of {ok,Mod,_,[{_File,Ws}]} -> %io:format("compile:file(~s,~p) ->~n~p~n", @@ -320,6 +354,11 @@ run_test(Test0, File, Warnings, WriteBeam) -> %io:format("compile:file(~s,~p) ->~n~p~n", % [File,Opts,_ZZ]), {error,Es,Ws}; + {error,[{XFile,Es1},{XFile,Es2}],Ws} = _ZZ + when is_list(XFile) -> + %io:format("compile:file(~s,~p) ->~n~p~n", + % [File,Opts,_ZZ]), + {error,Es1++Es2,Ws}; {error,Es,[{_File,Ws}]} = _ZZ-> %io:format("compile:file(~s,~p) ->~n~p~n", % [File,Opts,_ZZ]), diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl index 6067ee8e06..a3e9b7fe4e 100644 --- a/lib/compiler/test/fun_SUITE.erl +++ b/lib/compiler/test/fun_SUITE.erl @@ -21,10 +21,10 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, test1/1,overwritten_fun/1,otp_7202/1,bif_fun/1, - external/1]). + external/1,eep37/1,eep37_dup/1,badarity/1]). -%% Internal export. --export([call_me/1]). +%% Internal exports. +-export([call_me/1,dup1/0,dup2/0]). -include_lib("test_server/include/test_server.hrl"). @@ -32,7 +32,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [test1,overwritten_fun,otp_7202,bif_fun,external]. + [test1,overwritten_fun,otp_7202,bif_fun,external,eep37,eep37_dup,badarity]. groups() -> []. @@ -197,5 +197,29 @@ external(Config) when is_list(Config) -> call_me(I) -> {ok,I}. +eep37(Config) when is_list(Config) -> + F = fun Fact(N) when N > 0 -> N * Fact(N - 1); Fact(0) -> 1 end, + Add = fun _(N) -> N + 1 end, + UnusedName = fun BlackAdder(N) -> N + 42 end, + 720 = F(6), + 10 = Add(9), + 50 = UnusedName(8), + ok. + +eep37_dup(Config) when is_list(Config) -> + dup1 = (dup1())(), + dup2 = (dup2())(), + ok. + +dup1() -> + fun _F() -> dup1 end. + +dup2() -> + fun _F() -> dup2 end. + +badarity(Config) when is_list(Config) -> + {'EXIT',{{badarity,{_,[]}},_}} = (catch (fun badarity/1)()), + ok. + id(I) -> I. diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index a0a9bb7ddd..34bfdeb1e5 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -33,7 +33,7 @@ tricky/1,rel_ops/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_constants/1,bad_guards/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -50,7 +50,7 @@ groups() -> t_is_boolean,is_function_2,tricky,rel_ops, literal_type_tests,basic_andalso_orelse,traverse_dcd, check_qlc_hrl,andalso_semi,t_tuple_size,binary_part, - bad_constants]}]. + bad_constants,bad_guards]}]. init_per_suite(Config) -> Config. @@ -1023,6 +1023,10 @@ is_function_2(Config) when is_list(Config) -> true = is_function(id(fun() -> ok end), 0), false = is_function(id(fun ?MODULE:all/1), 0), false = is_function(id(fun() -> ok end), 1), + {'EXIT',{badarg,_}} = + (catch is_function(id(fun() -> ok end), -1) orelse error), + {'EXIT',{badarg,_}} = + (catch is_function(id(fun() -> ok end), '') orelse error), F = fun(_) -> ok end, if @@ -1550,6 +1554,28 @@ bad_constants(Config) when is_list(Config) -> ?line ?FAILING(3.14), ok. +bad_guards(Config) when is_list(Config) -> + if erlang:float(self()); true -> ok end, + + fc(catch bad_guards_1(1, [])), + fc(catch bad_guards_1(1, [2])), + fc(catch bad_guards_1(atom, [2])), + + fc(catch bad_guards_2(#{a=>0,b=>0}, [])), + fc(catch bad_guards_2(#{a=>0,b=>0}, [x])), + fc(catch bad_guards_2(not_a_map, [x])), + fc(catch bad_guards_2(42, [x])), + ok. + +%% beam_bool used to produce GC BIF instructions whose +%% Live operands included uninitialized registers. + +bad_guards_1(X, [_]) when {{X}}, -X -> + ok. + +bad_guards_2(M, [_]) when M#{a := 0, b => 0}, map_size(M) -> + ok. + %% Call this function to turn off constant propagation. id(I) -> I. diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl index e5c2d4f73a..47851e680b 100644 --- a/lib/compiler/test/inline_SUITE.erl +++ b/lib/compiler/test/inline_SUITE.erl @@ -37,7 +37,7 @@ all() -> groups() -> [{p,test_lib:parallel(), [attribute,bsdecode,bsdes,barnes2,decode1,smith,fname, - itracer,pseudoknot,comma_splitter,lists,really_inlined,otp_7223, + itracer,pseudoknot,maps_inline_test,comma_splitter,lists,really_inlined,otp_7223, coverage]}]. init_per_suite(Config) -> @@ -85,6 +85,7 @@ attribute(Config) when is_list(Config) -> ?comp(pseudoknot). ?comp(comma_splitter). ?comp(fname). +?comp(maps_inline_test). try_inline(Mod, Config) -> Node = ?config(testing_node, Config), diff --git a/lib/compiler/test/inline_SUITE_data/maps_inline_test.erl b/lib/compiler/test/inline_SUITE_data/maps_inline_test.erl new file mode 100644 index 0000000000..d9762e2647 --- /dev/null +++ b/lib/compiler/test/inline_SUITE_data/maps_inline_test.erl @@ -0,0 +1,70 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(maps_inline_test). + +-export([?MODULE/0]). + +?MODULE() -> + 21 = mval(#{val => 1}) + + mval(#{val => 2}) + + mval(#{val => 3}) + + mval(#{val => 4}) + + mval(#{val => 5}) + + mval(#{val => 6}), + + 21 = gval(#{id => 1}) + + gval(#{id => 2}) + + gval(#{id => 3}) + + gval(#{id => 4}) + + gval(#{id => 5}) + + gval(#{id => 6}), + + 21 = sval(#{id => 1}) + + sval(#{id => 2}) + + sval(#{id => 3}) + + sval(#{id => 4}) + + sval(#{id => 5}) + + sval(#{id => 6}), + + M = #{v => 1, m => #{v => 21, m => #{v => 7, m => 13}}}, + + 42 = decompose(M). + +% switch key orders +decompose(#{ m := M, v := V}) when is_map(M) -> + V + decompose(M); +decompose(#{ v := V, m := M}) -> V + M. + + +mval(#{val := V}) -> V. + +sval(#{id := 1}) -> 6; +sval(#{id := 2}) -> 5; +sval(#{id := 3}) -> 4; +sval(#{id := 4}) -> 3; +sval(#{id := 5}) -> 2; +sval(#{id := 6}) -> 1. + +gval(M) when is_map(M) andalso M =:= #{ id => 1} -> 1; +gval(M) when is_map(M) andalso M =:= #{ id => 2} -> 4; +gval(M) when is_map(M) andalso M =:= #{ id => 3} -> 2; +gval(M) when is_map(M) andalso M =:= #{ id => 4} -> 5; +gval(M) when is_map(M) andalso M =:= #{ id => 5} -> 3; +gval(M) when is_map(M) andalso M =:= #{ id => 6} -> 6. diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl index f5948504b3..398398a397 100644 --- a/lib/compiler/test/lc_SUITE.erl +++ b/lib/compiler/test/lc_SUITE.erl @@ -23,7 +23,7 @@ init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, basic/1,deeply_nested/1,no_generator/1, - empty_generator/1]). + empty_generator/1,no_export/1]). -include_lib("test_server/include/test_server.hrl"). @@ -31,7 +31,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [basic, deeply_nested, no_generator, empty_generator]. + [basic, deeply_nested, no_generator, empty_generator, no_export]. groups() -> []. @@ -177,6 +177,10 @@ empty_generator(Config) when is_list(Config) -> ?line [] = [X || {X} <- [], (false or (X/0 > 3))], ok. +no_export(Config) when is_list(Config) -> + [] = [ _X = a || false ] ++ [ _X = a || false ], + ok. + id(I) -> I. fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Args,_}|_]}}) -> ok; diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl new file mode 100644 index 0000000000..403b7e8405 --- /dev/null +++ b/lib/compiler/test/map_SUITE.erl @@ -0,0 +1,605 @@ +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(map_SUITE). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2 + ]). + +-export([ + t_build_and_match_literals/1, + t_update_literals/1,t_match_and_update_literals/1, + t_update_map_expressions/1, + t_update_assoc/1,t_update_exact/1, + t_guard_bifs/1, t_guard_sequence/1, t_guard_update/1, + t_guard_receive/1, t_guard_fun/1, + t_list_comprehension/1, + t_map_sort_literals/1, + t_map_size/1, + t_build_and_match_aliasing/1, + + %% warnings + t_warn_useless_build/1, + t_warn_pair_key_overloaded/1, + + %% not covered in 17.0-rc1 + t_build_and_match_over_alloc/1, + t_build_and_match_empty_val/1, + t_build_and_match_val/1, + t_build_and_match_nil/1, + t_build_and_match_structure/1, + + %% errors in 17.0-rc1 + t_update_values/1, + t_expand_map_update/1, + t_export/1 + ]). + +suite() -> []. + +all() -> [ + t_build_and_match_literals, + t_update_literals, t_match_and_update_literals, + t_update_map_expressions, + t_update_assoc,t_update_exact, + t_guard_bifs, t_guard_sequence, t_guard_update, + t_guard_receive,t_guard_fun, t_list_comprehension, + t_map_sort_literals, + t_map_size, + t_build_and_match_aliasing, + + %% warnings + t_warn_useless_build, + t_warn_pair_key_overloaded, + + %% not covered in 17.0-rc1 + t_build_and_match_over_alloc, + t_build_and_match_empty_val, + t_build_and_match_val, + t_build_and_match_nil, + t_build_and_match_structure, + + %% errors in 17.0-rc1 + t_update_values, + t_expand_map_update, + t_export + ]. + +groups() -> []. + +init_per_suite(Config) -> Config. +end_per_suite(_Config) -> ok. + +init_per_group(_GroupName, Config) -> Config. +end_per_group(_GroupName, Config) -> Config. + +%% tests + +t_build_and_match_literals(Config) when is_list(Config) -> + #{} = id(#{}), + #{1:=a} = id(#{1=>a}), + #{1:=a,2:=b} = id(#{1=>a,2=>b}), + #{1:=a,2:=b,3:="c"} = id(#{1=>a,2=>b,3=>"c"}), + #{1:=a,2:=b,3:="c","4":="d"} = id(#{1=>a,2=>b,3=>"c","4"=>"d"}), + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>} = + id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>}), + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f"} = + id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f"}), + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f",8:=g} = + id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f",8=>g}), + + #{<<"hi all">> := 1} = id(#{<<"hi",32,"all">> => 1}), + + #{a:=X,a:=X=3,b:=4} = id(#{a=>3,b=>4}), % weird but ok =) + + #{ a:=#{ b:=#{c := third, b:=second}}, b:=first} = + id(#{ b=>first, a=>#{ b=>#{c => third, b=> second}}}), + + M = #{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}, + M = #{ map_1:=#{ map_2:=#{value_3 := third}, value_2:= second}, value_1:=first} = + id(#{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}), + + %% map key + #{ #{} := 42 } = id(#{ #{} => 42 }), + #{ #{ "a" => 3 } := 42 } = id(#{ #{ "a" => 3} => 42 }), + + %% nil key + #{[]:=ok,1:=2} = id(#{[]=>ok,1=>2}), + + %% error case + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3,x:=2} = id(#{x=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=2} = id(#{x=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id({a,b,c}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{y=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))), + {'EXIT',{badarg,_}} = (catch id(#{<<0:258>> =>"three"})), + {'EXIT',{{badmatch,_},_}} = (catch (#{#{"a"=>42} := 3}=id(#{#{"a"=>3}=>42}))), + ok. + +t_build_and_match_aliasing(Config) when is_list(Config) -> + M1 = id(#{a=>1,b=>2,c=>3,d=>4}), + #{c:=C1=_=_=C2} = M1, + true = C1 =:= C2, + #{a:=A,a:=A,a:=A,b:=B,b:=B} = M1, + #{a:=A,a:=A,a:=A,b:=B,b:=B,b:=2} = M1, + #{a:=A=1,a:=A,a:=A,b:=B=2,b:=B,b:=2} = M1, + #{c:=C1, c:=_, c:=3, c:=_, c:=C2} = M1, + #{c:=C=_=3=_=C} = M1, + + M2 = id(#{"a"=>1,"b"=>2,"c"=>3,"d"=>4}), + #{"a":=A2,"a":=A2,"a":=A2,"b":=B2,"b":=B2,"b":=2} = M2, + #{"a":=_,"a":=_,"a":=_,"b":=_,"b":=_,"b":=2} = M2, + ok. + +t_map_size(Config) when is_list(Config) -> + 0 = map_size(id(#{})), + 1 = map_size(id(#{a=>1})), + 1 = map_size(id(#{a=>"wat"})), + 2 = map_size(id(#{a=>1, b=>2})), + 3 = map_size(id(#{a=>1, b=>2, b=>"3","33"=><<"n">>})), + + true = map_is_size(#{a=>1}, 1), + true = map_is_size(#{a=>1, a=>2}, 1), + M = #{ "a" => 1, "b" => 2}, + true = map_is_size(M, 2), + false = map_is_size(M, 3), + true = map_is_size(M#{ "a" => 2}, 2), + false = map_is_size(M#{ "c" => 2}, 2), + + %% Error cases. + {'EXIT',{badarg,_}} = (catch map_size([])), + {'EXIT',{badarg,_}} = (catch map_size(<<1,2,3>>)), + {'EXIT',{badarg,_}} = (catch map_size(1)), + ok. + +map_is_size(M,N) when map_size(M) =:= N -> true; +map_is_size(_,_) -> false. + +% test map updates without matching +t_update_literals(Config) when is_list(Config) -> + Map = #{x=>1,y=>2,z=>3,q=>4}, + #{x:="d",q:="4"} = loop_update_literals_x_q(Map, [ + {"a","1"},{"b","2"},{"c","3"},{"d","4"} + ]), + ok. + +loop_update_literals_x_q(Map, []) -> Map; +loop_update_literals_x_q(Map, [{X,Q}|Vs]) -> + loop_update_literals_x_q(Map#{q=>Q,x=>X},Vs). + +% test map updates with matching +t_match_and_update_literals(Config) when is_list(Config) -> + Map = #{x=>0,y=>"untouched",z=>"also untouched",q=>1}, + #{x:=16,q:=21,y:="untouched",z:="also untouched"} = loop_match_and_update_literals_x_q(Map, [ + {1,2},{3,4},{5,6},{7,8} + ]), + M0 = id(#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}), + M1 = id(#{}), + M2 = M1#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + M0 = M2, + + #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number }, + ok. + +loop_match_and_update_literals_x_q(Map, []) -> Map; +loop_match_and_update_literals_x_q(#{q:=Q0,x:=X0} = Map, [{X,Q}|Vs]) -> + loop_match_and_update_literals_x_q(Map#{q=>Q0+Q,x=>X0+X},Vs). + + +t_update_map_expressions(Config) when is_list(Config) -> + M = maps:new(), + X = id(fondue), + M1 = #{ a := 1 } = M#{a => 1}, + #{ b := {X} } = M1#{ a := 1, b => {X} }, + + #{ b := 2 } = (maps:new())#{ b => 2 }, + + #{ a :=42, b:=42, c:=42 } = (maps:from_list([{a,1},{b,2},{c,3}]))#{ a := 42, b := 42, c := 42 }, + #{ "a" :=1, "b":=42, "c":=42 } = (maps:from_list([{"a",1},{"b",2}]))#{ "b" := 42, "c" => 42 }, + + %% Test need to be in a fun. + %% This tests that let expr optimisation in sys_core_fold + %% covers maps correctly. + F = fun() -> + M0 = id(#{ "a" => [1,2,3] }), + #{ "a" := _ } = M0, + M0#{ "a" := b } + end, + + #{ "a" := b } = F(), + + %% Error cases, FIXME: should be 'badmap'? + {'EXIT',{badarg,_}} = (catch (id(<<>>))#{ a := 42, b => 2 }), + {'EXIT',{badarg,_}} = (catch (id([]))#{ a := 42, b => 2 }), + ok. + + +t_update_assoc(Config) when is_list(Config) -> + M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}), + + M1 = M0#{1=>42,2=>100,4=>[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + #{1:=42,2:=b,4:=d,5:=e,2.0:=100,3.0:=c,4.0:=[a,b,c]} = M0#{1.0=>float,1:=42,2.0=>wrong,2.0=>100,4.0=>[a,b,c]}, + + M2 = M0#{3.0=>new}, + #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0:=wrong,3.0=>new}, + + %% Errors cases. + BadMap = id(badmap), + {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}), + {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting=>val}), + {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> => val}), %% limitation + ok. + +t_update_exact(Config) when is_list(Config) -> + M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}), + + M1 = M0#{1:=42,2:=100,4:=[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + M1 = M0#{1:=wrong,1=>42,2=>wrong,2:=100,4:=[a,b,c]}, + + M2 = M0#{3.0:=new}, + #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0=>wrong,3.0:=new}, + true = M2 =/= M0#{3=>right,3.0:=new}, + #{ 3 := right, 3.0 := new } = M0#{3=>right,3.0:=new}, + + M3 = id(#{ 1 => val}), + #{1 := update2,1.0 := new_val4} = M3#{ + 1.0 => new_val1, 1 := update, 1=> update3, + 1 := update2, 1.0 := new_val2, 1.0 => new_val3, + 1.0 => new_val4 }, + + %% Errors cases. + {'EXIT',{badarg,_}} = (catch ((id(nil))#{ a := b })), + {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting:=val}), + {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> := val}), %% limitation + ok. + +t_update_values(Config) when is_list(Config) -> + V0 = id(1337), + M0 = #{ a => 1, val => V0}, + V1 = get_val(M0), + M1 = M0#{ val := [V0,V1], "wazzup" => 42 }, + [1337, {some_val, 1337}] = get_val(M1), + + N = 110, + List = [{[I,1,2,3,I],{1,2,3,"wat",I}}|| I <- lists:seq(1,N)], + + {_,_,#{val2 := {1,2,3,"wat",N}, val1 := [N,1,2,3,N]}} = lists:foldl(fun + ({V2,V3},{Old2,Old3,Mi}) -> + ok = check_val(Mi,Old2,Old3), + #{ val1 := Old2, val2 := Old3 } = Mi, + {V2,V3, Mi#{ val1 := id(V2), val2 := V1, val2 => id(V3)}} + end, {none, none, #{val1=>none,val2=>none}},List), + ok. + +t_expand_map_update(Config) when is_list(Config) -> + M = #{<<"hello">> => <<"world">>}#{<<"hello">> := <<"les gens">>}, + #{<<"hello">> := <<"les gens">>} = M, + ok. + +t_export(Config) when is_list(Config) -> + Raclette = id(#{}), + case brie of brie -> Fromage = Raclette end, + Raclette = Fromage#{}, + ok. + +check_val(#{val1:=V1, val2:=V2},V1,V2) -> ok. + +get_val(#{ "wazzup" := _, val := V}) -> V; +get_val(#{ val := V }) -> {some_val, V}. + +t_guard_bifs(Config) when is_list(Config) -> + true = map_guard_empty(), + true = map_guard_empty_2(), + true = map_guard_head(#{a=>1}), + false = map_guard_head([]), + true = map_guard_body(#{a=>1}), + false = map_guard_body({}), + true = map_guard_pattern(#{a=>1, <<"hi">> => "hi" }), + false = map_guard_pattern("list"), + true = map_guard_tautology(), + true = map_guard_ill_map_size(), + ok. + +map_guard_empty() when is_map(#{}); false -> true. + +map_guard_empty_2() when true; #{} andalso false -> true. + +map_guard_head(M) when is_map(M) -> true; +map_guard_head(_) -> false. + +map_guard_body(M) -> is_map(M). + +map_guard_pattern(#{}) -> true; +map_guard_pattern(_) -> false. + +map_guard_tautology() when #{} =:= #{}; true -> true. + +map_guard_ill_map_size() when true; map_size(0) -> true. + +t_guard_sequence(Config) when is_list(Config) -> + {1, "a"} = map_guard_sequence_1(#{seq=>1,val=>id("a")}), + {2, "b"} = map_guard_sequence_1(#{seq=>2,val=>id("b")}), + {3, "c"} = map_guard_sequence_1(#{seq=>3,val=>id("c")}), + {4, "d"} = map_guard_sequence_1(#{seq=>4,val=>id("d")}), + {5, "e"} = map_guard_sequence_1(#{seq=>5,val=>id("e")}), + + {1,M1} = map_guard_sequence_2(M1 = id(#{a=>3})), + {2,M2} = map_guard_sequence_2(M2 = id(#{a=>4, b=>4})), + {3,gg,M3} = map_guard_sequence_2(M3 = id(#{a=>gg, b=>4})), + {4,sc,sc,M4} = map_guard_sequence_2(M4 = id(#{a=>sc, b=>3, c=>sc2})), + {5,kk,kk,M5} = map_guard_sequence_2(M5 = id(#{a=>kk, b=>other, c=>sc2})), + + %% error case + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(#{seq=>6,val=>id("e")})), + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(#{b=>5})), + ok. + +map_guard_sequence_1(#{seq:=1=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=2=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=3=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=4=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=5=Seq, val:=Val}) -> {Seq,Val}. + +map_guard_sequence_2(#{ a:=3 }=M) -> {1, M}; +map_guard_sequence_2(#{ a:=4 }=M) -> {2, M}; +map_guard_sequence_2(#{ a:=X, a:=X, b:=4 }=M) -> {3,X,M}; +map_guard_sequence_2(#{ a:=X, a:=Y, b:=3 }=M) when X =:= Y -> {4,X,Y,M}; +map_guard_sequence_2(#{ a:=X, a:=Y }=M) when X =:= Y -> {5,X,Y,M}. + + +t_guard_update(Config) when is_list(Config) -> + error = map_guard_update(#{},#{}), + first = map_guard_update(#{}, #{x=>first}), + second = map_guard_update(#{y=>old}, #{x=>second,y=>old}), + third = map_guard_update(#{x=>old,y=>old}, #{x=>third,y=>old}), + ok. + +map_guard_update(M1, M2) when M1#{x=>first} =:= M2 -> first; +map_guard_update(M1, M2) when M1#{x=>second} =:= M2 -> second; +map_guard_update(M1, M2) when M1#{x:=third} =:= M2 -> third; +map_guard_update(_, _) -> error. + +t_guard_receive(Config) when is_list(Config) -> + M0 = #{ id => 0 }, + Pid = spawn_link(fun() -> guard_receive_loop() end), + Big = 36893488147419103229, + B1 = <<"some text">>, + B2 = <<"was appended">>, + B3 = <<B1/binary, B2/binary>>, + + #{id:=1, res:=Big} = M1 = call(Pid, M0#{op=>sub,in=>{1 bsl 65, 3}}), + #{id:=2, res:=26} = M2 = call(Pid, M1#{op=>idiv,in=>{53,2}}), + #{id:=3, res:=832} = M3 = call(Pid, M2#{op=>imul,in=>{26,32}}), + #{id:=4, res:=4} = M4 = call(Pid, M3#{op=>add,in=>{1,3}}), + #{id:=5, res:=Big} = M5 = call(Pid, M4#{op=>sub,in=>{1 bsl 65, 3}}), + #{id:=6, res:=B3} = M6 = call(Pid, M5#{op=>"append",in=>{B1,B2}}), + #{id:=7, res:=4} = _ = call(Pid, M6#{op=>add,in=>{1,3}}), + + + %% update old maps and check id update + #{id:=2, res:=B3} = call(Pid, M1#{op=>"append",in=>{B1,B2}}), + #{id:=5, res:=99} = call(Pid, M4#{op=>add,in=>{33, 66}}), + + %% cleanup + done = call(Pid, done), + ok. + +call(Pid, M) -> + Pid ! {self(), M}, receive {Pid, Res} -> Res end. + +guard_receive_loop() -> + receive + {Pid, #{ id:=Id, op:="append", in:={X,Y}}=M} when is_binary(X), is_binary(Y) -> + Pid ! {self(), M#{ id=>Id+1, res=><<X/binary,Y/binary>>}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=add, in:={X,Y}}} -> + Pid ! {self(), #{ id=>Id+1, res=>X+Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=sub, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X-Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=idiv, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X div Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=imul, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X * Y}}, + guard_receive_loop(); + {Pid, done} -> + Pid ! {self(), done}; + {Pid, Other} -> + Pid ! {error, Other}, + guard_receive_loop() + end. + + +t_list_comprehension(Config) when is_list(Config) -> + [#{k:=1},#{k:=2},#{k:=3}] = [#{k=>I} || I <- [1,2,3]], + ok. + +t_guard_fun(Config) when is_list(Config) -> + F1 = fun + (#{s:=v,v:=V}) -> {v,V}; + (#{s:=t,v:={V,V}}) -> {t,V}; + (#{s:=l,v:=[V,V]}) -> {l,V} + end, + + F2 = fun + (#{s:=T,v:={V,V}}) -> {T,V}; + (#{s:=T,v:=[V,V]}) -> {T,V}; + (#{s:=T,v:=V}) -> {T,V} + end, + V = <<"hi">>, + + {v,V} = F1(#{s=>v,v=>V}), + {t,V} = F1(#{s=>t,v=>{V,V}}), + {l,V} = F1(#{s=>l,v=>[V,V]}), + + {v,V} = F2(#{s=>v,v=>V}), + {t,V} = F2(#{s=>t,v=>{V,V}}), + {l,V} = F2(#{s=>l,v=>[V,V]}), + + %% error case + case (catch F1(#{s=>none,v=>none})) of + {'EXIT', {function_clause,[{?MODULE,_,[#{s:=none,v:=none}],_}|_]}} -> ok; + {'EXIT', {{case_clause,_},_}} -> {comment,inlined}; + Other -> + test_server:fail({no_match, Other}) + end. + + +t_map_sort_literals(Config) when is_list(Config) -> + % test relation + + %% size order + true = #{ a => 1, b => 2} < id(#{ a => 1, b => 1, c => 1}), + true = #{ b => 1, a => 1} < id(#{ c => 1, a => 1, b => 1}), + false = #{ c => 1, b => 1, a => 1} < id(#{ c => 1, a => 1}), + + %% key order + true = id(#{ a => 1 }) < id(#{ b => 1}), + false = id(#{ b => 1 }) < id(#{ a => 1}), + true = id(#{ a => 1, b => 1, c => 1 }) < id(#{ b => 1, c => 1, d => 1}), + true = id(#{ b => 1, c => 1, d => 1 }) > id(#{ a => 1, b => 1, c => 1}), + true = id(#{ c => 1, b => 1, a => 1 }) < id(#{ b => 1, c => 1, d => 1}), + true = id(#{ "a" => 1 }) < id(#{ <<"a">> => 1}), + false = id(#{ <<"a">> => 1 }) < id(#{ "a" => 1}), + false = id(#{ 1 => 1 }) < id(#{ 1.0 => 1}), + false = id(#{ 1.0 => 1 }) < id(#{ 1 => 1}), + + %% value order + true = id(#{ a => 1 }) < id(#{ a => 2}), + false = id(#{ a => 2 }) < id(#{ a => 1}), + false = id(#{ a => 2, b => 1 }) < id(#{ a => 1, b => 3}), + true = id(#{ a => 1, b => 1 }) < id(#{ a => 1, b => 3}), + + true = id(#{ "a" => "hi", b => 134 }) == id(#{ b => 134,"a" => "hi"}), + + %% lists:sort + + SortVs = [#{"a"=>1},#{a=>2},#{1=>3},#{<<"a">>=>4}], + [#{1:=ok},#{a:=ok},#{"a":=ok},#{<<"a">>:=ok}] = lists:sort([#{"a"=>ok},#{a=>ok},#{1=>ok},#{<<"a">>=>ok}]), + [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(SortVs), + [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(lists:reverse(SortVs)), + + ok. + +t_warn_pair_key_overloaded(Config) when is_list(Config) -> + #{ "hi1" := 42 } = id(#{ "hi1" => 1, "hi1" => 42 }), + + #{ "hi1" := 1337, "hi2" := [2], "hi3" := 3 } = id(#{ + "hi1" => erlang:atom_to_binary(?MODULE,utf8), + "hi1" => erlang:binary_to_atom(<<"wazzup">>,utf8), + "hi1" => erlang:binary_to_float(<<"3.1416">>), + "hi1" => erlang:float_to_binary(3.1416), + "hi2" => erlang:pid_to_list(self()), + "hi3" => erlang:float_to_binary(3.1416), + "hi2" => lists:subtract([1,2],[1]), + "hi3" => +3, + "hi1" => erlang:min(1,2), + "hi1" => erlang:hash({1,2},35), + "hi1" => erlang:phash({1,2},33), + "hi1" => erlang:phash2({1,2},34), + "hi1" => erlang:integer_to_binary(1337), + "hi1" => erlang:binary_to_integer(<<"1337">>), + "hi4" => erlang:float_to_binary(3.1416) + }), + ok. + +t_warn_useless_build(Config) when is_list(Config) -> + [#{ a => id(I)} || I <- [1,2,3]], + ok. + +t_build_and_match_over_alloc(Config) when is_list(Config) -> + Ls = id([1,2,3]), + V0 = [a|Ls], + M0 = id(#{ "a" => V0 }), + #{ "a" := V1 } = M0, + V2 = id([c|Ls]), + M2 = id(#{ "a" => V2 }), + #{ "a" := V3 } = M2, + {[a,1,2,3],[c,1,2,3]} = id({V1,V3}), + ok. + +t_build_and_match_empty_val(Config) when is_list(Config) -> + F = fun(#{ "hi":=_,{1,2}:=_,1337:=_}) -> ok end, + ok = F(id(#{"hi"=>ok,{1,2}=>ok,1337=>ok})), + + %% error case + case (catch (F(id(#{"hi"=>ok})))) of + {'EXIT',{function_clause,_}} -> ok; + {'EXIT', {{case_clause,_},_}} -> {comment,inlined}; + Other -> + test_server:fail({no_match, Other}) + end. + +t_build_and_match_val(Config) when is_list(Config) -> + F = fun + (#{ "hi" := first, v := V}) -> {1,V}; + (#{ "hi" := second, v := V}) -> {2,V} + end, + + + {1,"hello"} = F(id(#{"hi"=>first,v=>"hello"})), + {2,"second"} = F(id(#{"hi"=>second,v=>"second"})), + + %% error case + case (catch (F(id(#{"hi"=>ok})))) of + {'EXIT',{function_clause,_}} -> ok; + {'EXIT', {{case_clause,_},_}} -> {comment,inlined}; + Other -> + test_server:fail({no_match, Other}) + end. + +t_build_and_match_nil(Config) when is_list(Config) -> + %% literals removed the coverage + V1 = id(cookie), + V2 = id(cake), + V3 = id(crisps), + + #{ [] := V1, "treat" := V2, {your,treat} := V3 } = id(#{ + {your,treat} => V3, + "treat" => V2, + [] => V1 }), + #{ [] := V3, [] := V3 } = id(#{ [] => V1, [] => V3 }), + ok. + +t_build_and_match_structure(Config) when is_list(Config) -> + V2 = id("it"), + S = id([42,{"hi", "=)", #{ "a" => 42, any => any, val => "get_" ++ V2}}]), + + %% match deep map values + V2 = case S of + [42,{"hi",_, #{ "a" := 42, val := "get_" ++ V1, any := _ }}] -> V1 + end, + %% match deep map + ok = case S of + [42,{"hi",_, #{ }}] -> ok + end, + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index ae7d764535..e5aaf49d6f 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -22,7 +22,7 @@ init_per_group/2,end_per_group/2, pmatch/1,mixed/1,aliases/1,match_in_call/1, untuplify/1,shortcut_boolean/1,letify_guard/1, - selectify/1,underscore/1,coverage/1]). + selectify/1,underscore/1,match_map/1,coverage/1]). -include_lib("test_server/include/test_server.hrl"). @@ -35,7 +35,8 @@ all() -> groups() -> [{p,test_lib:parallel(), [pmatch,mixed,aliases,match_in_call,untuplify, - shortcut_boolean,letify_guard,selectify,underscore,coverage]}]. + shortcut_boolean,letify_guard,selectify, + underscore,match_map,coverage]}]. init_per_suite(Config) -> @@ -400,6 +401,17 @@ underscore(Config) when is_list(Config) -> _ = is_list(Config), ok. +-record(s, {map,t}). + +match_map(Config) when is_list(Config) -> + Map = #{key=>{x,y},ignore=>anything}, + #s{map=Map,t={x,y}} = do_match_map(#s{map=Map}), + ok. + +do_match_map(#s{map=#{key:=Val}}=S) -> + %% Would crash with a 'badarg' exception. + S#s{t=Val}. + coverage(Config) when is_list(Config) -> %% Cover beam_dead. ok = coverage_1(x, a), diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index ec49267ded..00a6e900d4 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -257,6 +257,7 @@ wait(Config) when is_list(Config) -> self() ! <<42>>, <<42>> = wait_1(r, 1, 2), {1,2,3} = wait_1(1, 2, 3), + {'EXIT',{timeout_value,_}} = (catch receive after [] -> timeout end), ok. wait_1(r, _, _) -> diff --git a/lib/compiler/test/record_SUITE.erl b/lib/compiler/test/record_SUITE.erl index c9f5a2053e..f736e14bf6 100644 --- a/lib/compiler/test/record_SUITE.erl +++ b/lib/compiler/test/record_SUITE.erl @@ -369,6 +369,14 @@ record_test_3(Config) when is_list(Config) -> ?line false = is_record(id(#barf{}), id(barf), id(42)), ?line false = is_record(id(#barf{}), id(foo), id(6)), + Rec = id(#barf{}), + Good = id(barf), + Bad = id(foo), + Size = id(6), + + true = is_record(Rec, Good, Size) orelse error, + error = is_record(Rec, Bad, Size) orelse error, + ok. record_access_in_guards(Config) when is_list(Config) -> diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index 810b2b48c9..0637041873 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -37,7 +37,9 @@ -export([pattern/1,pattern2/1,pattern3/1,pattern4/1, guard/1,bad_arith/1,bool_cases/1,bad_apply/1, - files/1,effect/1,bin_opt_info/1,bin_construction/1, comprehensions/1]). + files/1,effect/1,bin_opt_info/1,bin_construction/1, + comprehensions/1,maps/1,redundant_boolean_clauses/1, + latin1_fallback/1]). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(2)). @@ -61,7 +63,8 @@ groups() -> [{p,test_lib:parallel(), [pattern,pattern2,pattern3,pattern4,guard, bad_arith,bool_cases,bad_apply,files,effect, - bin_opt_info,bin_construction,comprehensions]}]. + bin_opt_info,bin_construction,comprehensions,maps, + redundant_boolean_clauses,latin1_fallback]}]. init_per_suite(Config) -> Config. @@ -117,6 +120,7 @@ pattern2(Config) when is_list(Config) -> Source, [nowarn_unused_vars], {warnings,[{2,sys_core_fold,{nomatch_shadow,1}}, + {4,sys_core_fold,no_clause_match}, {5,sys_core_fold,nomatch_clause_type}, {6,sys_core_fold,nomatch_clause_type}]}}], ?line [] = run(Config, Ts), @@ -199,6 +203,8 @@ pattern4(Config) when is_list(Config) -> [nowarn_unused_vars], {warnings, [{9,sys_core_fold,no_clause_match}, + {11,sys_core_fold,nomatch_shadow}, + {15,sys_core_fold,nomatch_shadow}, {18,sys_core_fold,no_clause_match}, {23,sys_core_fold,no_clause_match}, {33,sys_core_fold,no_clause_match} @@ -389,6 +395,10 @@ effect(Config) when is_list(Config) -> <<X:8>>; unused_fun -> fun() -> {ok,X} end; + unused_named_fun -> + fun F(0) -> 1; + F(N) -> N*F(N-1) + end; unused_atom -> ignore; %no warning unused_nil -> @@ -483,8 +493,9 @@ effect(Config) when is_list(Config) -> {22,sys_core_fold,{no_effect,{erlang,is_integer,1}}}, {24,sys_core_fold,useless_building}, {26,sys_core_fold,useless_building}, - {32,sys_core_fold,{no_effect,{erlang,'=:=',2}}}, - {34,sys_core_fold,{no_effect,{erlang,get_cookie,0}}}]}}], + {28,sys_core_fold,useless_building}, + {36,sys_core_fold,{no_effect,{erlang,'=:=',2}}}, + {38,sys_core_fold,{no_effect,{erlang,get_cookie,0}}}]}}], ?line [] = run(Config, Ts), ok. @@ -546,6 +557,127 @@ comprehensions(Config) when is_list(Config) -> run(Config, Ts), ok. +maps(Config) when is_list(Config) -> + Ts = [{bad_map, + <<" + t() -> + case maybe_map of + #{} -> ok; + not_map -> error + end. + x() -> + case true of + #{} -> error; + true -> ok + end. + ">>, + [], + {warnings,[{3,sys_core_fold,no_clause_match}, + {9,sys_core_fold,nomatch_clause_type}]}}, + {bad_map_src1, + <<" + t() -> + M = {a,[]}, + {'EXIT',{badarg,_}} = (catch(M#{ a => 1})), + ok. + ">>, + [], + {warnings,[{4,v3_kernel,bad_map}]}}, + {bad_map_src2, + <<" + t() -> + M = id({a,[]}), + {'EXIT',{badarg,_}} = (catch(M#{ a => 1})), + ok. + id(I) -> I. + ">>, + [inline], + {warnings,[{4,v3_kernel,bad_map}]}}, + {bad_map_src3, + <<" + t() -> + {'EXIT',{badarg,_}} = (catch <<>>#{ a := 1}), + ok. + ">>, + [], + {warnings,[{3,v3_core,bad_map}]}}, + {bad_map_literal_key, + <<" + t() -> + V = id(1), + M = id(#{ <<$h,$i>> => V }), + V = case M of + #{ <<0:257>> := Val } -> Val; + #{ <<$h,$i>> := Val } -> Val + end, + ok. + id(I) -> I. + ">>, + [], + {warnings,[{6,v3_core,nomatch}]}}], + run(Config, Ts), + ok. + +redundant_boolean_clauses(Config) when is_list(Config) -> + Ts = [{redundant_boolean_clauses, + <<" + t(X) -> + case X == 0 of + false -> no; + false -> no; + true -> yes + end. + ">>, + [], + {warnings,[{5,sys_core_fold,nomatch_shadow}]}}], + run(Config, Ts), + ok. + +latin1_fallback(Conf) when is_list(Conf) -> + DataDir = ?privdir, + IncFile = filename:join(DataDir, "include_me.hrl"), + file:write_file(IncFile, <<"%% ",246," in include file\n">>), + Ts1 = [{latin1_fallback1, + %% Test that the compiler fall backs to latin-1 with + %% a warning if a file has no encoding and does not + %% contain correct UTF-8 sequences. + <<"%% Bj",246,"rn + t(_) -> \"",246,"\"; + t(x) -> ok. + ">>, + [], + {warnings,[{1,compile,reparsing_invalid_unicode}, + {3,sys_core_fold,{nomatch_shadow,2}}]}}], + [] = run(Conf, Ts1), + + Ts2 = [{latin1_fallback2, + %% Test that the compiler fall backs to latin-1 with + %% a warning if a file has no encoding and does not + %% contain correct UTF-8 sequences. + <<" + + -include(\"include_me.hrl\"). + ">>, + [], + {warnings,[{1,compile,reparsing_invalid_unicode}]} + }], + [] = run(Conf, Ts2), + + Ts3 = [{latin1_fallback3, + %% Test that the compiler fall backs to latin-1 with + %% a warning if a file has no encoding and does not + %% contain correct UTF-8 sequences. + <<"-ifdef(NOTDEFINED). + t(_) -> \"",246,"\"; + t(x) -> ok. + -endif. + ">>, + [], + {warnings,[{2,compile,reparsing_invalid_unicode}]}}], + [] = run(Conf, Ts3), + + ok. + %%% %%% End of test cases. %%% diff --git a/lib/compiler/vsn.mk b/lib/compiler/vsn.mk index cbdf57f177..b1a6c15ac9 100644 --- a/lib/compiler/vsn.mk +++ b/lib/compiler/vsn.mk @@ -1 +1 @@ -COMPILER_VSN = 4.9.4 +COMPILER_VSN = 5.0.3 |