Add the new operator ^ for pinning pattern variables

This allows you to annotate already-bound pattern variables as ^X, like
in Elixir. This is less error prone when code is being refactored and
moved around so that variables previously new in a pattern may become
bound, or vice versa, and makes it easier for the reader to see the intent
of the code. An new compiler flag 'warn_unpinned_vars' (disabled by default)
provides warnings for all uses of already bound variables in patterns that
have not been marked with ^.

lib/compiler/src/v3_core.erl

@@ -121,6 +121,7 @@
 -record(igen,      {anno=#a{},acc_pat,acc_guard,
 		    skip_pat,tail,tail_pat,arg}).
 -record(isimple,   {anno=#a{},term :: cerl:cerl()}).
+-record(ipin,      {anno=#a{},arg}).
 
 -type iapply()    :: #iapply{}.
 -type ibinary()   :: #ibinary{}.
@@ -141,11 +142,12 @@
 -type ifilter()   :: #ifilter{}.
 -type igen()      :: #igen{}.
 -type isimple()   :: #isimple{}.
+-type ipin()      :: #ipin{}.
 
 -type i() :: iapply()    | ibinary()   | icall()     | icase()  | icatch()
            | iclause()   | ifun()      | iletrec()   | imatch() | imap()
            | iprimop()   | iprotect()  | ireceive1() | ireceive2()
-           | iset()      | itry()      | ifilter()
+           | iset()      | itry()      | ifilter()   | ipin()
            | igen()      | isimple().
 
 -type warning() :: {file:filename(), [{integer(), module(), term()}]}.
@@ -1833,6 +1835,9 @@ pattern({match,_,P1,P2}, St) ->
     {Cp1,St1} = pattern(P1, St),
     {Cp2,St2} = pattern(P2, St1),
     {pat_alias(Cp1, Cp2),St2};
+pattern({op,_,'^',P}, St) ->
+    {P1, St1} = pattern(P, St),
+    {#ipin{arg=P1},St1};
 %% Evaluate compile-time expressions.
 pattern({op,_,'++',{nil,_},R}, St) ->
     pattern(R, St);
@@ -2346,6 +2351,8 @@ upattern(#c_var{name='_'}, _, St0) ->
 upattern(#c_var{name=V}=Var, Ks, St0) ->
     case is_element(V, Ks) of
 	true ->
+            %% Use of an existing variable - use a new variable in the
+            %% pattern and add a guard test to ensure the values are equal.
 	    {N,St1} = new_var_name(St0),
 	    New = #c_var{name=N},
 	    LA = get_lineno_anno(Var),
@@ -2357,6 +2364,13 @@ upattern(#c_var{name=V}=Var, Ks, St0) ->
 	    {New,[Test],[N],[],St1};
 	false -> {Var,[],[V],[],St0}
     end;
+upattern(#ipin{arg=#c_var{}=Var}, Ks, St0) ->
+    %% We know the var should be in Ks here, so it will become a new var in
+    %% the above clause. (If pinning becomes required, there is no need to
+    %% check if V is in Ks in the #c_var{} case, and that code can be moved
+    %% here instead. Furthermore, pinning could be generalized to any guard
+    %% expression, not just variables.)
+    upattern(Var, Ks, St0);
 upattern(#c_cons{hd=H0,tl=T0}=Cons, Ks, St0) ->
     {H1,Hg,Hv,Hu,St1} = upattern(H0, Ks, St0),
     {T1,Tg,Tv,Tu,St2} = upattern(T0, union(Hv, Ks), St1),
@@ -2532,6 +2546,8 @@ ren_pat(#c_var{name=V}=Old, Ks, {Isub0,Osub0}=Subs, St0) ->
         false ->
             {Old,Subs,St0}
     end;
+ren_pat(#ipin{}=P, _Ks, Subs, St) ->
+    {P,Subs,St};
 ren_pat(#c_literal{}=P, _Ks, {_,_}=Subs, St) ->
     {P,Subs,St};
 ren_pat(#c_alias{var=Var0,pat=Pat0}=Alias, Ks, {_,_}=Subs0, St0) ->
@@ -3168,6 +3184,8 @@ split_pat(#c_map{es=Es}=Map, St) ->
     split_map_pat(Es, Map, St, []);
 split_pat(#c_var{}, _) ->
     none;
+split_pat(#ipin{}, _) ->
+    none;
 split_pat(#c_alias{pat=Pat}=Alias0, St0) ->
     case split_pat(Pat, St0) of
         none ->

lib/stdlib/src/erl_lint.erl

@@ -273,6 +273,7 @@ format_error({too_many_arguments,Arity}) ->
 		  "maximum allowed is ~w", [Arity,?MAX_ARGUMENTS]);
 %% --- patterns and guards ---
 format_error(illegal_pattern) -> "illegal pattern";
+format_error(illegal_caret) -> "operator ^ is only allowed in patterns";
 format_error(illegal_map_key) -> "illegal map key in pattern";
 format_error(illegal_bin_pattern) ->
     "binary patterns cannot be matched in parallel using '='";
@@ -314,6 +315,9 @@ format_error({unsafe_var,V,{What,Where}}) ->
 format_error({exported_var,V,{What,Where}}) ->
     io_lib:format("variable ~w exported from ~w ~s",
                   [V,What,format_where(Where)]);
+format_error({unpinned_var,V}) ->
+    io_lib:format("variable ~w is already bound - write '^~s' to use its value in a pattern without a warning",
+                  [V, V]);
 format_error({shadowed_var,V,In}) ->
     io_lib:format("variable ~w shadowed in ~w", [V,In]);
 format_error({unused_var, V}) ->
@@ -324,6 +328,10 @@ format_error({stacktrace_guard,V}) ->
     io_lib:format("stacktrace variable ~w must not be used in a guard", [V]);
 format_error({stacktrace_bound,V}) ->
     io_lib:format("stacktrace variable ~w must not be previously bound", [V]);
+format_error(illegal_catch_kind) ->
+    "only variables and atoms throw, exit, and error are allowed in kind position of catch clauses";
+format_error(illegal_catch_stack) ->
+    "only unbound variables are allowed in stacktrace position of catch clauses";
 %% --- binaries ---
 format_error({undefined_bittype,Type}) ->
     io_lib:format("bit type ~tw undefined", [Type]);
@@ -569,6 +577,9 @@ start(File, Opts) ->
 	[{unused_vars,
 	  bool_option(warn_unused_vars, nowarn_unused_vars,
 		      true, Opts)},
+         {unpinned_vars,
+	  bool_option(warn_unpinned_vars, nowarn_unpinned_vars,
+		      false, Opts)},
 	 {export_all,
 	  bool_option(warn_export_all, nowarn_export_all,
 		      true, Opts)},
@@ -1628,6 +1639,11 @@ pattern({var,_Line,'_'}, _Vt, _Old, St) ->
     {[],[],St}; %Ignore anonymous variable
 pattern({var,Line,V}, _Vt, Old, St) ->
     pat_var(V, Line, Old, [], St);
+pattern({op,_,'^',{var,Line,V}}, Vt, _Old, St) when V =/= '_' ->
+    %% this is checked like a normal expression variable,
+    %% since it will actually become a guard test
+    {Vt1,St1} = expr_var(V, Line, Vt, St),
+    {Vt1,[],St1};
 pattern({char,_Line,_C}, _Vt, _Old, St) -> {[],[],St};
 pattern({integer,_Line,_I}, _Vt, _Old, St) -> {[],[],St};
 pattern({float,_Line,_F}, _Vt, _Old, St) -> {[],[],St};
@@ -1859,7 +1875,7 @@ pattern_element(Be, Vt, Old, Acc) ->
     pattern_element_1(Be, Vt, Old, Acc).
 
 pattern_element_1({bin_element,Line,E,Sz0,Ts}, Vt, Old, {Size0,Esvt,Esnew,St0}) ->
-    {Pevt,Penew,St1} = pat_bit_expr(E, Old, Esnew, St0),
+    {Pevt,Penew,St1} = pat_bit_expr(E, Vt, Old, Esnew, St0),
     {Sz1,Szvt,Sznew,St2} = pat_bit_size(Sz0, Vt, Esnew, St1),
     {Sz2,Bt,St3} = bit_type(Line, Sz1, Ts, St2),
     {Sz3,St4} = bit_size_check(Line, Sz2, Bt, St3),
@@ -1881,16 +1897,21 @@ good_string_size_type(default, Ts) ->
 	      end, Ts);
 good_string_size_type(_, _) -> false.
 
-%% pat_bit_expr(Pattern, OldVarTable, NewVars, State) ->
+%% pat_bit_expr(Pattern, VarTable, OldVarTable, NewVars, State) ->
 %%              {UpdVarTable,UpdNewVars,State}.
 %%  Check pattern bit expression, only allow really valid patterns!
 
-pat_bit_expr({var,_,'_'}, _Old, _New, St) -> {[],[],St};
-pat_bit_expr({var,Ln,V}, Old, New, St) -> pat_var(V, Ln, Old, New, St);
-pat_bit_expr({string,_,_}, _Old, _new, St) -> {[],[],St};
-pat_bit_expr({bin,L,_}, _Old, _New, St) ->
+pat_bit_expr({op, _, '^', {var, Ln, V}}, Vt, _Old, _New, St) when V =/= '_' ->
+    %% this is checked like a normal expression variable,
+    %% since it will actually become a guard test
+    {Vt1, St1} = expr_var(V, Ln, Vt, St),
+    {Vt1, [], St1};
+pat_bit_expr({var,_,'_'}, _Vt, _Old, _New, St) -> {[],[],St};
+pat_bit_expr({var,Ln,V}, _Vt, Old, New, St) -> pat_var(V, Ln, Old, New, St);
+pat_bit_expr({string,_,_}, _Vt, _Old, _New, St) -> {[],[],St};
+pat_bit_expr({bin,L,_}, _Vt, _Old, _New, St) ->
     {[],[],add_error(L, illegal_pattern, St)};
-pat_bit_expr(P, _Old, _New, St) ->
+pat_bit_expr(P, _Vt, _Old, _New, St) ->
     case is_pattern_expr(P) of
         true -> {[],[],St};
         false -> {[],[],add_error(element(2, P), illegal_pattern, St)}
@@ -2541,9 +2562,13 @@ expr({'catch',Line,E}, Vt, St0) ->
 expr({match,_Line,P,E}, Vt, St0) ->
     {Evt,St1} = expr(E, Vt, St0),
     {Pvt,Pnew,St2} = pattern(P, vtupdate(Evt, Vt), St1),
-    St = reject_invalid_alias_expr(P, E, Vt, St2),
+    St3 = shadow_vars(Pnew, Vt, 'match', St2),  %% FIXME: remove?
+    St = reject_invalid_alias_expr(P, E, Vt, St3),
     {vtupdate(Pnew, vtmerge(Evt, Pvt)),St};
 %% No comparison or boolean operators yet.
+expr({op,Line,'^',A}, Vt, St) ->
+    {Vt1,St1} = expr(A, Vt, St),
+    {Vt1,add_error(Line, illegal_caret, St1)};
 expr({op,_Line,_Op,A}, Vt, St) ->
     expr(A, Vt, St);
 expr({op,Line,Op,L,R}, Vt, St0) when Op =:= 'orelse'; Op =:= 'andalso' ->
@@ -3619,18 +3644,21 @@ pat_var(V, Line, Vt, New, St) ->
     case orddict:find(V, New) of
         {ok, {bound,_Usage,Ls}} ->
             %% variable already in NewVars, mark as used
-            {[],[{V,{bound,used,Ls}}],St};
+            St1 = warn_unpinned(V, Line, St),
+            {[],[{V,{bound,used,Ls}}],St1};
         error ->
             case orddict:find(V, Vt) of
                 {ok,{bound,_Usage,Ls}} ->
-                    {[{V,{bound,used,Ls}}],[],St};
+                    St1 = warn_unpinned(V, Line, St),
+                    {[{V,{bound,used,Ls}}],[],St1};
                 {ok,{{unsafe,In},_Usage,Ls}} ->
                     {[{V,{bound,used,Ls}}],[],
                      add_error(Line, {unsafe_var,V,In}, St)};
                 {ok,{{export,From},_Usage,Ls}} ->
+                    St1 = warn_unpinned(V, Line, St),
                     {[{V,{bound,used,Ls}}],[],
                      %% As this is matching, exported vars are risky.
-                     add_warning(Line, {exported_var,V,From}, St)};
+                     add_warning(Line, {exported_var,V,From}, St1)};
                 error when St#lint.recdef_top ->
                     {[],[{V,{bound,unused,[Line]}}],
                      add_error(Line, {variable_in_record_def,V}, St)};
@@ -3640,6 +3668,14 @@ pat_var(V, Line, Vt, New, St) ->
             end
     end.
 
+warn_unpinned(V, L, St) ->
+    case is_warn_enabled(unpinned_vars, St) of
+        true ->
+            add_warning(L, {unpinned_var,V}, St);
+        false ->
+            St
+    end.
+
 %% pat_binsize_var(Variable, LineNo, VarTable, NewVars, State) ->
 %%      {UpdVarTable,UpdNewVars,State'}
 %% Special case of pat_var/expr_var for variables in binary size expressions

lib/stdlib/src/erl_parse.yrl

@@ -53,7 +53,7 @@ bin_base_type bin_unit_type.
 Terminals
 char integer float atom string var
 
-'(' ')' ',' '->' '{' '}' '[' ']' '|' '||' '<-' ';' ':' '#' '.'
+'(' ')' ',' '->' '{' '}' '[' ']' '|' '||' '<-' ';' ':' '#' '.' '^'
 'after' 'begin' 'case' 'try' 'catch' 'end' 'fun' 'if' 'of' 'receive' 'when'
 'andalso' 'orelse'
 'bnot' 'not'
@@ -505,6 +505,7 @@ prefix_op -> '+' : '$1'.
 prefix_op -> '-' : '$1'.
 prefix_op -> 'bnot' : '$1'.
 prefix_op -> 'not' : '$1'.
+prefix_op -> '^' : '$1'.
 
 mult_op -> '/' : '$1'.
 mult_op -> '*' : '$1'.
@@ -952,7 +953,7 @@ Erlang code.
 
 -type af_unary_op(T) :: {'op', anno(), unary_op(), T}.
 
--type unary_op() :: '+' | '-' | 'bnot' | 'not'.
+-type unary_op() :: '+' | '-' | 'bnot' | 'not' | '^'.
 
 %% See also lib/stdlib/{src/erl_bits.erl,include/erl_bits.hrl}.
 -type type_specifier_list() :: 'default' | [type_specifier(), ...].
@@ -1547,7 +1548,7 @@ inop_prec('#') -> {800,700,800};
 inop_prec(':') -> {900,800,900};
 inop_prec('.') -> {900,900,1000}.
 
--type pre_op() :: 'catch' | '+' | '-' | 'bnot' | 'not' | '#'.
+-type pre_op() :: 'catch' | '+' | '-' | 'bnot' | 'not' | '#' | '^'.
 
 -spec preop_prec(pre_op()) -> {0 | 600 | 700, 100 | 700 | 800}.
 
@@ -1556,6 +1557,7 @@ preop_prec('+') -> {600,700};
 preop_prec('-') -> {600,700};
 preop_prec('bnot') -> {600,700};
 preop_prec('not') -> {600,700};
+preop_prec('^') -> {600,700};
 preop_prec('#') -> {700,800}.
 
 -spec func_prec() -> {800,700}.
@@ -1571,7 +1573,7 @@ max_prec() -> 900.
 -type type_inop() :: '::' | '|' | '..' | '+' | '-' | 'bor' | 'bxor'
                    | 'bsl' | 'bsr' | '*' | '/' | 'div' | 'rem' | 'band'.
 
--type type_preop() :: '+' | '-' | 'bnot' | '#'.
+-type type_preop() :: '+' | '-' | 'bnot' | '#' | '^'.
 
 -spec type_inop_prec(type_inop()) -> {prec(), prec(), prec()}.
 
@@ -1597,6 +1599,7 @@ type_inop_prec('#') -> {800,700,800}.
 type_preop_prec('+') -> {600,700};
 type_preop_prec('-') -> {600,700};
 type_preop_prec('bnot') -> {600,700};
+type_preop_prec('^') -> {600,700};
 type_preop_prec('#') -> {700,800}.
 
 -type erl_parse_tree() :: abstract_clause()

lib/stdlib/src/erl_pp.erl

@@ -682,6 +682,12 @@ lexpr({match,_,Lhs,Rhs}, Prec, Opts) ->
     Rl = lexpr(Rhs, R, Opts),
     El = {list,[{cstep,[Pl,' ='],Rl}]},
     maybe_paren(P, Prec, El);
+lexpr({op,_,'^'=Op,Arg}, Prec, Opts) ->
+    %% no space after caret
+    {P,R} = preop_prec(Op),
+    Ol = {reserved, leaf(format("~s", [Op]))},
+    El = [Ol,lexpr(Arg, R, Opts)],
+    maybe_paren(P, Prec, El);
 lexpr({op,_,Op,Arg}, Prec, Opts) ->
     {P,R} = preop_prec(Op),
     Ol = {reserved, leaf(format("~s ", [Op]))},