~ubuntu-branches/debian/squeeze/erlang/squeeze

« back to all changes in this revision

Viewing changes to lib/compiler/src/sys_core_fold.erl

  • Committer: Bazaar Package Importer
  • Author(s): Erlang Packagers, Sergei Golovan
  • Date: 2006-12-03 17:07:44 UTC
  • mfrom: (2.1.11 feisty)
  • Revision ID: james.westby@ubuntu.com-20061203170744-rghjwupacqlzs6kv
Tags: 1:11.b.2-4
[ Sergei Golovan ]
Fixed erlang-base and erlang-base-hipe prerm scripts.

Show diffs side-by-side

added added

removed removed

Lines of Context:
66
66
 
67
67
-module(sys_core_fold).
68
68
 
69
 
-export([module/2,function/1]).
 
69
-export([module/2,format_error/1]).
70
70
 
71
 
-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,all/2,any/2,reverse/1]).
 
71
-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,all/2,any/2,reverse/1,member/2]).
72
72
-include("core_parse.hrl").
73
73
 
 
74
%%-define(DEBUG, 1).
 
75
 
 
76
-ifdef(DEBUG).
 
77
-define(ASSERT(E),
 
78
        case E of
 
79
            true -> ok;
 
80
            false -> 
 
81
                io:format("~p, line ~p: assertion failed\n", [?MODULE,?LINE]),
 
82
                exit(assertion_failed)
 
83
        end).
 
84
-else.
 
85
-define(ASSERT(E), ignore).
 
86
-endif.
 
87
 
74
88
%% Variable value info.
75
 
-record(sub, {v=[],cexpr=none,t=[]}).           %Variable substitutions
76
 
 
77
 
module(#c_module{defs=Ds0}=Mod, _Opts) ->
78
 
    %% Use the compiler process dictionary to propagate this option.
79
 
    Ds1 = map(fun function/1, Ds0),
80
 
    {ok,Mod#c_module{defs=Ds1}}.
81
 
 
82
 
function(#c_def{val=B0}=Def) ->
83
 
    %%ok = io:fwrite("~w:~p~n", [?LINE,{Def#c_def.func}]),
 
89
-record(sub, {v=[],                             %Variable substitutions
 
90
              s=[],                             %Variables in scope
 
91
              t=[]}).                           %Types
 
92
 
 
93
module(#c_module{defs=Ds0}=Mod, Opts) ->
 
94
    put(no_inline_list_funcs, not member(inline_list_funcs, Opts)),
 
95
    case get(new_var_num) of
 
96
        undefined -> put(new_var_num, 0);
 
97
        _ -> ok
 
98
    end,
 
99
    init_warnings(),
 
100
    Ds1 = map(fun function_1/1, Ds0),
 
101
    erase(no_inline_list_funcs),
 
102
    {ok,Mod#c_module{defs=Ds1},get_warnings()}.
 
103
 
 
104
function_1(#c_def{val=B0}=Def) ->
 
105
    %%ok = io:fwrite("~w:~p~n", [?LINE,{Def#c_def.name}]),
 
106
    ?ASSERT([] =:= core_lib:free_vars(B0)),
84
107
    B1 = expr(B0, sub_new()),                   %This must be a fun!
85
108
    Def#c_def{val=B1}.
86
109
 
87
110
%% body(Expr, Sub) -> Expr.
88
 
%%  No special handling of anything except valuess.
 
111
%%  No special handling of anything except values.
89
112
 
90
113
body(#c_values{anno=A,es=Es0}, Sub) ->
91
114
    Es1 = expr_list(Es0, Sub),
92
115
    #c_values{anno=A,es=Es1};
93
 
body(E, Sub) -> expr(E, Sub).
 
116
body(E, Sub) ->
 
117
    ?ASSERT(verify_scope(E, Sub)),
 
118
    expr(E, Sub).
94
119
 
95
120
%% guard(Expr, Sub) -> Expr.
96
121
%%  Do guard expression.  These are boolean expressions with values
97
122
%%  which are tests.  These may be wrapped in a protected.  Seeing
98
 
%%  guards are side-effect free we can optimise the boolean
 
123
%%  that guards are side-effect free we can optimise the boolean
99
124
%%  expressions.
100
125
 
101
 
guard(#c_call{module=#c_atom{val=erlang},
 
126
guard(Expr, Sub) ->
 
127
    ?ASSERT(verify_scope(Expr, Sub)),
 
128
    guard_1(Expr, Sub).
 
129
 
 
130
guard_1(#c_call{module=#c_atom{val=erlang},
102
131
              name=#c_atom{val='not'},
103
132
              args=[A]}=Call, Sub) ->
104
 
    case guard(A, Sub) of
 
133
    case guard_1(A, Sub) of
105
134
        #c_atom{val=true} -> #c_atom{val=false};
106
135
        #c_atom{val=false} -> #c_atom{val=true};
107
136
        Arg -> Call#c_call{args=[Arg]}
108
137
    end;
109
 
guard(#c_call{module=#c_atom{val=erlang},
 
138
guard_1(#c_call{module=#c_atom{val=erlang},
110
139
              name=#c_atom{val='and'},
111
140
              args=[A1,A2]}=Call, Sub) ->
112
 
    case {guard(A1, Sub),guard(A2, Sub)} of
 
141
    case {guard_1(A1, Sub),guard_1(A2, Sub)} of
113
142
        {#c_atom{val=true},Arg2} -> Arg2;
114
143
        {#c_atom{val=false},_} -> #c_atom{val=false};
115
144
        {Arg1,#c_atom{val=true}} -> Arg1;
116
145
        {_,#c_atom{val=false}} -> #c_atom{val=false};
117
146
        {Arg1,Arg2} -> Call#c_call{args=[Arg1,Arg2]}
118
147
    end;
119
 
guard(#c_call{module=#c_atom{val=erlang},
 
148
guard_1(#c_call{module=#c_atom{val=erlang},
120
149
              name=#c_atom{val='or'},
121
150
              args=[A1,A2]}=Call, Sub) ->
122
 
    case {guard(A1, Sub),guard(A2, Sub)} of
 
151
    case {guard_1(A1, Sub),guard_1(A2, Sub)} of
123
152
        {#c_atom{val=true},_} -> #c_atom{val=true};
124
153
        {#c_atom{val=false},Arg2} -> Arg2;
125
154
        {_,#c_atom{val=true}} -> #c_atom{val=true};
126
155
        {Arg1,#c_atom{val=false}} -> Arg1;
127
156
        {Arg1,Arg2} -> Call#c_call{args=[Arg1,Arg2]}
128
157
    end;
129
 
guard(#c_seq{arg=Arg0,body=B0}=Seq, Sub) ->
130
 
    case {guard(Arg0, Sub),guard(B0, Sub)} of
131
 
        {#c_atom{val=true},B1} -> B1;
132
 
        {#c_atom{val=false}=False,_} -> False;
133
 
        {Arg,#c_atom{val=true}} -> Arg;
134
 
        {_,#c_atom{val=false}=False} -> False;
135
 
        {Arg,B1} -> Seq#c_seq{arg=Arg,body=B1}
136
 
    end;
137
 
guard(#c_try{arg=E0,vars=[#c_var{name=X}],body=#c_var{name=X},
138
 
             handler=#c_atom{val=false}}=Prot, Sub) ->
139
 
    %% We can remove protected if value a simple.
 
158
guard_1(#c_try{arg=E0,vars=[#c_var{name=X}],body=#c_var{name=X},
 
159
             handler=#c_atom{val=false}=False}=Prot, Sub) ->
140
160
    E1 = body(E0, Sub),
141
 
    case core_lib:is_simple(E1) of
142
 
        true -> E1;
143
 
        false -> Prot#c_try{arg=E1}
 
161
    case will_fail(E1) of
 
162
        false ->
 
163
            %% We can remove try/catch if value is a simple.
 
164
            case core_lib:is_simple(E1) of
 
165
                true -> E1;
 
166
                false -> Prot#c_try{arg=E1}
 
167
            end;
 
168
        true ->
 
169
            %% Expression will always fail.
 
170
            False
144
171
    end;
145
 
guard(E, Sub) -> expr(E, Sub).
 
172
guard_1(E0, Sub) ->
 
173
    E = expr(E0, Sub),
 
174
    case will_fail(E) of
 
175
        true -> #c_atom{val=false};
 
176
        false -> E
 
177
    end.
146
178
 
147
179
%% expr(Expr, Sub) -> Expr.
148
180
 
160
192
    eval_cons(Cons#c_cons{hd=H1,tl=T1}, H1, T1);
161
193
expr(#c_tuple{anno=A,es=Es}, Sub) ->
162
194
    #c_tuple{anno=A,es=expr_list(Es, Sub)};
163
 
expr(#c_binary{segs=Ss}=Bin, Sub) ->
164
 
    Bin#c_binary{segs=bin_seg_list(Ss, Sub)};
 
195
expr(#c_binary{segments=Ss}=Bin, Sub) ->
 
196
    Bin#c_binary{segments=bitstr_list(Ss, Sub)};
165
197
expr(#c_fname{}=Fname, _) -> Fname;
166
198
expr(#c_fun{vars=Vs0,body=B0}=Fun, Sub0) ->
167
199
    {Vs1,Sub1} = pattern_list(Vs0, Sub0),
182
214
                false -> Seq#c_seq{arg=Arg1,body=B1}
183
215
            end
184
216
    end;
185
 
expr(#c_let{vars=Vs0,arg=Arg0,body=B0}=Let, Sub0) ->
186
 
    Arg1 = body(Arg0, Sub0),                    %This is a body
187
 
    %% Optimise let and add new substitutions.
188
 
    {Vs1,Args,Sub1} = let_substs(Vs0, Arg1, Sub0),
189
 
    B1 = body(B0, Sub1),
190
 
    %% Optimise away let if the body consists of a single variable or
191
 
    %% if no values remain to be set.
192
 
    case {Vs1,Args,B1} of
193
 
        {[#c_var{name=Vname}],Args,#c_var{name=Vname}} ->
194
 
            core_lib:make_values(Args);
195
 
        {[],[],Body} ->
196
 
            Body;
197
 
        _Other ->
198
 
            opt_case_in_let(Let#c_let{vars=Vs1,
199
 
                                      arg=core_lib:make_values(Args),
200
 
                                      body=B1})
 
217
expr(#c_let{}=Let, Sub) ->
 
218
    case simplify_let(Let, Sub) of
 
219
        impossible ->
 
220
            %% The argument for the let is "simple", i.e. has no
 
221
            %% complex structures such as let or seq that can be entered.
 
222
            opt_simple_let(Let, Sub);
 
223
        Expr ->
 
224
            %% The let body was successfully moved into the let argument.
 
225
            %% Now recursively re-process the new expression.
 
226
            expr(Expr, sub_new(Sub))
201
227
    end;
202
228
expr(#c_letrec{defs=Fs0,body=B0}=Letrec, Sub) ->
203
229
    Fs1 = map(fun (#c_def{val=Fb}=Fd) ->
205
231
              end, Fs0),
206
232
    B1 = body(B0, Sub),
207
233
    Letrec#c_letrec{defs=Fs1,body=B1};
208
 
expr(#c_case{arg=Arg0,clauses=Cs0}=Case, Sub) ->
209
 
    Arg1 = body(Arg0, Sub),
210
 
    {Arg2,Cs1} = case_opt(Arg1, Cs0),
211
 
    Cs2 = clauses(Arg2, Cs1, Sub),
212
 
    eval_case(Case#c_case{arg=Arg2,clauses=Cs2}, Sub);
 
234
expr(#c_case{}=Case0, Sub) ->
 
235
    case move_to_guard(Case0) of
 
236
        #c_case{arg=Arg0,clauses=Cs0}=Case ->
 
237
            Arg1 = body(Arg0, Sub),
 
238
            {Arg2,Cs1} = case_opt(Arg1, Cs0),
 
239
            Cs2 = clauses(Arg2, Cs1, Case, Sub),
 
240
            eval_case(Case#c_case{arg=Arg2,clauses=Cs2}, Sub);
 
241
        Other ->
 
242
            expr(Other, Sub)
 
243
    end;
213
244
expr(#c_receive{clauses=Cs0,timeout=T0,action=A0}=Recv, Sub) ->
214
 
    Cs1 = clauses(#c_var{name='_'}, Cs0, Sub),  %This is all we know
 
245
    Cs1 = clauses(#c_var{name='_'}, Cs0, Recv, Sub),    %This is all we know
215
246
    T1 = expr(T0, Sub),
216
247
    A1 = body(A0, Sub),
217
248
    Recv#c_receive{clauses=Cs1,timeout=T1,action=A1};
233
264
        true -> B1;
234
265
        false -> Catch#c_catch{body=B1}
235
266
    end;
 
267
expr(#c_try{arg=E0,vars=[#c_var{name=X}],body=#c_var{name=X},
 
268
            handler=#c_atom{val=false}=False}=Prot, Sub) ->
 
269
    %% Since guard may call expr/2, we must do some optimization of
 
270
    %% the kind of try's that occur in guards.
 
271
    E1 = body(E0, Sub),
 
272
    case will_fail(E1) of
 
273
        false ->
 
274
            %% We can remove try/catch if value is a simple.
 
275
            case core_lib:is_simple(E1) of
 
276
                true -> E1;
 
277
                false -> Prot#c_try{arg=E1}
 
278
            end;
 
279
        true ->
 
280
            %% Expression will always fail.
 
281
            False
 
282
    end;
236
283
expr(#c_try{anno=A,arg=E0,vars=Vs0,body=B0,evars=Evs0,handler=H0}=Try, Sub0) ->
 
284
    %% Here is the general try/catch construct outside of guards.
237
285
    %% We can remove try if the value is simple and replace it with a let.
238
286
    E1 = body(E0, Sub0),
239
287
    {Vs1,Sub1} = pattern_list(Vs0, Sub0),
250
298
expr_list(Es, Sub) ->
251
299
    map(fun (E) -> expr(E, Sub) end, Es).
252
300
 
253
 
bin_seg_list(Es, Sub) ->
254
 
    map(fun (E) -> bin_segment(E, Sub) end, Es).
 
301
bitstr_list(Es, Sub) ->
 
302
    map(fun (E) -> bitstr(E, Sub) end, Es).
255
303
 
256
 
bin_segment(#c_bin_seg{val=Val,size=Size}=BinSeg, Sub) ->
257
 
    BinSeg#c_bin_seg{val=expr(Val, Sub),size=expr(Size, Sub)}.
 
304
bitstr(#c_bitstr{val=Val,size=Size}=BinSeg, Sub) ->
 
305
    BinSeg#c_bitstr{val=expr(Val, Sub),size=expr(Size, Sub)}.
258
306
 
259
307
%% is_safe_simple(Expr) -> true | false.
260
308
%%  A safe simple cannot fail with badarg.  Binaries are difficult to
261
 
%%  check so be very conservative here.
 
309
%%  check so we consider them unsafe.
262
310
 
263
311
is_safe_simple(#c_var{}) -> true;               %Not atomic
264
312
is_safe_simple(#c_cons{hd=H,tl=T}) ->
265
 
    case is_safe_simple(H) of
266
 
        true -> is_safe_simple(T); 
267
 
        false -> false
268
 
    end;
 
313
    is_safe_simple(H) andalso is_safe_simple(T);
269
314
is_safe_simple(#c_tuple{es=Es}) -> is_safe_simple_list(Es);
270
315
is_safe_simple(#c_binary{}) -> false;
271
 
% is_safe_simple(#c_binary{segs=Ss}) ->
272
 
%     is_safe_lit_bin(Ss);
273
316
is_safe_simple(E) -> core_lib:is_atomic(E).
274
317
 
275
318
is_safe_simple_list(Es) -> all(fun is_safe_simple/1, Es).
276
319
 
277
 
% is_safe_lit_bin(Ss) ->
278
 
%     {Bits,Safe} = foldl(fun (#c_bin_seg{val=#c_int{},size=#c_int{val=S},
279
 
%                                       unit=U,type=integer}, {Bits,Safe}) ->
280
 
%                               Sb = S*U,
281
 
%                               {Bits + Sb,Safe};
282
 
%                           (#c_bin_seg{val=#c_float{},size=#c_int{val=S},
283
 
%                                       unit=U,type=float}, {Bits,Safe}) ->
284
 
%                               Sb = S*U,
285
 
%                               {Bits + Sb, Safe and (Sb == 64)};
286
 
%                           (_Seg, {Bits,_Safe}) -> {Bits,false}
287
 
%                       end, {0,true}, Ss),
288
 
%     Safe and ((Bits rem 8) == 0).
 
320
%% will_fail(Expr) -> true|false.
 
321
%%  Checks whether the expression will fail with an exception
 
322
%%  (returning false if not sure).
 
323
 
 
324
will_fail(#c_let{arg=A,body=B}) ->
 
325
    will_fail(A) orelse will_fail(B);
 
326
will_fail(#c_call{module=#c_atom{val=erlang},name=#c_atom{val=exit},args=[_]}) ->
 
327
    true;
 
328
will_fail(#c_call{module=#c_atom{val=erlang},name=#c_atom{val=throw},args=[_]}) ->
 
329
    true;
 
330
will_fail(#c_call{module=#c_atom{val=erlang},name=#c_atom{val=error},args=[_]}) ->
 
331
    true;
 
332
will_fail(#c_call{module=#c_atom{val=erlang},name=#c_atom{val=error},args=[_,_]}) ->
 
333
    true;
 
334
will_fail(#c_call{module=#c_atom{val=erlang},name=#c_atom{val=fault},args=[_]}) ->
 
335
    true;
 
336
will_fail(#c_call{module=#c_atom{val=erlang},name=#c_atom{val=fault},args=[_,_]}) ->
 
337
    true;
 
338
will_fail(#c_primop{name=#c_atom{val=match_fail},args=[_]}) ->
 
339
    true;
 
340
will_fail(_) -> false.
289
341
 
290
342
%% eval_cons(Cons, Head, Tail) -> Expr.
291
343
%%  Evaluate constant part of a cons expression.
531
583
    F = #c_var{name='F'},
532
584
    Xs = #c_var{name='Xs'},
533
585
    X = #c_var{name='X'},
534
 
    A = #c_var{name='A'},
 
586
    Avar = #c_var{name='A'},
535
587
    Match =
536
588
        fun (A, P, E) ->
537
589
                C1 = #c_clause{pats=[P], guard=#c_atom{val=true}, body=E},
542
594
                #c_case{arg=A, clauses=[C1, C2]}
543
595
        end,
544
596
    C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_atom{val=true},
545
 
                   body=Match(#c_apply{op=F, args=[X, A]},
546
 
                              #c_tuple{es=[X, A]},
 
597
                   body=Match(#c_apply{op=F, args=[X, Avar]},
 
598
                              #c_tuple{es=[X, Avar]},
547
599
%%% Tuple passing version
548
 
                              Match(#c_apply{op=Loop, args=[Xs, A]},
549
 
                                    #c_tuple{es=[Xs, A]},
550
 
                                    #c_tuple{es=[#c_cons{hd=X, tl=Xs}, A]})
 
600
                              Match(#c_apply{op=Loop, args=[Xs, Avar]},
 
601
                                    #c_tuple{es=[Xs, Avar]},
 
602
                                    #c_tuple{es=[#c_cons{hd=X, tl=Xs}, Avar]})
551
603
%%% Multiple-value version
552
604
%%%                           #c_let{vars=[Xs,A],
553
605
%%%                                  %% The tuple here will be optimised
558
610
                             )},
559
611
    C2 = #c_clause{pats=[#c_nil{}], guard=#c_atom{val=true},
560
612
%%% Tuple passing version
561
 
                   body=#c_tuple{es=[#c_nil{}, A]}},
 
613
                   body=#c_tuple{es=[#c_nil{}, Avar]}},
562
614
%%% Multiple-value version
563
615
%%%                body=#c_values{es=[#c_nil{}, A]}},
564
616
    Err = #c_tuple{es=[#c_atom{val='function_clause'}, Xs]},
565
617
    C3 = #c_clause{pats=[Xs], guard=#c_atom{val=true},
566
618
                   body=#c_primop{name=#c_atom{val='match_fail'},
567
619
                                  args=[Err]}},
568
 
    Fun = #c_fun{vars=[Xs, A],
 
620
    Fun = #c_fun{vars=[Xs, Avar],
569
621
                 body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
570
622
    L = #c_var{name='L'},
571
 
    expr(#c_let{vars=[F, A, L], arg=#c_values{es=[Arg1, Arg2, Arg3]},
 
623
    expr(#c_let{vars=[F, Avar, L], arg=#c_values{es=[Arg1, Arg2, Arg3]},
572
624
                body=#c_letrec{defs=[#c_def{name=Loop, val=Fun}],
573
625
%%% Tuple passing version
574
 
                               body=#c_apply{op=Loop, args=[L, A]}}},
 
626
                               body=#c_apply{op=Loop, args=[L, Avar]}}},
575
627
%%% Multiple-value version
576
628
%%%                            body=#c_let{vars=[Xs, A],
577
629
%%%                                        arg=#c_apply{op=Loop,
583
635
    F = #c_var{name='F'},
584
636
    Xs = #c_var{name='Xs'},
585
637
    X = #c_var{name='X'},
586
 
    A = #c_var{name='A'},
 
638
    Avar = #c_var{name='A'},
587
639
    Match =
588
640
        fun (A, P, E) ->
589
641
                C1 = #c_clause{pats=[P], guard=#c_atom{val=true}, body=E},
595
647
        end,
596
648
    C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_atom{val=true},
597
649
%%% Tuple passing version
598
 
                   body=Match(#c_apply{op=Loop, args=[Xs, A]},
599
 
                              #c_tuple{es=[Xs, A]},
600
 
                              Match(#c_apply{op=F, args=[X, A]},
601
 
                                    #c_tuple{es=[X, A]},
602
 
                                    #c_tuple{es=[#c_cons{hd=X, tl=Xs}, A]}))
 
650
                   body=Match(#c_apply{op=Loop, args=[Xs, Avar]},
 
651
                              #c_tuple{es=[Xs, Avar]},
 
652
                              Match(#c_apply{op=F, args=[X, Avar]},
 
653
                                    #c_tuple{es=[X, Avar]},
 
654
                                    #c_tuple{es=[#c_cons{hd=X, tl=Xs}, Avar]}))
603
655
%%% Multiple-value version
604
656
%%%                body=#c_let{vars=[Xs,A],
605
657
%%%                            %% The tuple will be optimised away
611
663
                  },
612
664
    C2 = #c_clause{pats=[#c_nil{}], guard=#c_atom{val=true},
613
665
%%% Tuple passing version
614
 
                   body=#c_tuple{es=[#c_nil{}, A]}},
 
666
                   body=#c_tuple{es=[#c_nil{}, Avar]}},
615
667
%%% Multiple-value version
616
668
%%%                body=#c_values{es=[#c_nil{}, A]}},
617
669
    Err = #c_tuple{es=[#c_atom{val='function_clause'}, Xs]},
618
670
    C3 = #c_clause{pats=[Xs], guard=#c_atom{val=true},
619
671
                   body=#c_primop{name=#c_atom{val='match_fail'},
620
672
                                  args=[Err]}},
621
 
    Fun = #c_fun{vars=[Xs, A],
 
673
    Fun = #c_fun{vars=[Xs, Avar],
622
674
                 body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
623
675
    L = #c_var{name='L'},
624
 
    expr(#c_let{vars=[F, A, L], arg=#c_values{es=[Arg1, Arg2, Arg3]},
 
676
    expr(#c_let{vars=[F, Avar, L], arg=#c_values{es=[Arg1, Arg2, Arg3]},
625
677
                body=#c_letrec{defs=[#c_def{name=Loop, val=Fun}],
626
678
%%% Tuple passing version
627
 
                               body=#c_apply{op=Loop, args=[L, A]}}},
 
679
                               body=#c_apply{op=Loop, args=[L, Avar]}}},
628
680
%%% Multiple-value version
629
681
%%%                            body=#c_let{vars=[Xs, A],
630
682
%%%                                        arg=#c_apply{op=Loop,
645
697
%%  We evaluate element/2 and setelement/3 if the position is constant and
646
698
%%  the shape of the tuple is known.
647
699
%%
648
 
%%  We evalute '++' if the first operand is as literal (or partly literal).
 
700
%%  We evalute '++' if the first operand is a literal (or partly literal).
649
701
 
650
702
fold_call(Call, #c_atom{val=M}, #c_atom{val=F}, Args) ->
651
703
    fold_call_1(Call, M, F, Args);
652
704
fold_call(Call, _M, _N, _Args) -> Call.
653
705
 
 
706
fold_call_1(Call, lists, append, [Arg1,Arg2]) ->
 
707
    eval_append(Call, Arg1, Arg2);
654
708
fold_call_1(Call, erlang, length, [Arg]) ->
655
709
    eval_length(Call, Arg);
656
710
fold_call_1(Call, erlang, '++', [Arg1,Arg2]) ->
657
711
    eval_append(Call, Arg1, Arg2);
658
712
fold_call_1(Call, erlang, element, [Arg1,Arg2]) ->
659
 
    Ref = make_ref(),
660
 
    case catch {Ref,eval_element(Arg1, Arg2)} of
661
 
        {Ref,Val} -> Val;
662
 
        _Other -> Call
663
 
    end;
 
713
    eval_element(Call, Arg1, Arg2);
664
714
fold_call_1(Call, erlang, setelement, [Arg1,Arg2,Arg3]) ->
665
715
    Ref = make_ref(),
666
716
    case catch {Ref,eval_setelement(Arg1, Arg2, Arg3)} of
667
717
        {Ref,Val} -> Val;
668
718
        _Other -> Call
669
719
    end;
670
 
fold_call_1(Call, erlang, N, [Arg]) ->
671
 
    case catch begin
672
 
                   LitA = core_lib:literal_value(Arg),
673
 
                   {ok,core_lib:make_literal(eval_call(N, LitA))}
674
 
               end of
675
 
        {ok,Val} -> Val;
676
 
        _Other -> Call
677
 
    end;
678
 
fold_call_1(Call, erlang, N, [Arg1,Arg2]) ->
679
 
    case catch begin
680
 
                   LitA1 = core_lib:literal_value(Arg1),
681
 
                   LitA2 = core_lib:literal_value(Arg2),
682
 
                   {ok,core_lib:make_literal(eval_call(N, LitA1, LitA2))}
683
 
               end of
684
 
        {ok,Val} -> Val;
685
 
        _Other -> Call
686
 
    end;
 
720
fold_call_1(Call, erlang, apply, [Mod,Func,Args]) ->
 
721
    simplify_apply(Call, Mod, Func, Args);
 
722
fold_call_1(Call, erlang, N, Args) ->
 
723
    eval_erlang_call(Call, N, Args);
687
724
fold_call_1(Call, _Mod, _Name, _Args) -> Call.
688
725
 
689
 
%% eval_call(Op, Arg) -> Value.
690
 
%% eval_call(Op, Arg1, Arg2) -> Value.
691
 
%%  Evaluate safe calls.  We only do arithmetic and logical operators,
692
 
%%  there are more but these are the ones that are probably
693
 
%%  worthwhile.  It would be MUCH easier if we could apply these!
694
 
 
695
 
eval_call('+', X) -> 0 + X;
696
 
eval_call('-', X) -> 0 - X;
697
 
eval_call('bnot', X) -> bnot X;
698
 
eval_call(abs, A) -> abs(A);
699
 
eval_call(float, A) -> float(A);
700
 
eval_call(round, A) -> round(A);
701
 
eval_call(trunc, A) -> trunc(A);
702
 
eval_call('not', X) -> not X;
703
 
eval_call(hd, L) -> hd(L);
704
 
eval_call(tl, L) -> tl(L);
705
 
eval_call(length, L) -> length(L);
706
 
eval_call(size, T) -> size(T);
707
 
eval_call(integer_to_list, I) -> integer_to_list(I);
708
 
eval_call(list_to_integer, L) -> list_to_integer(L);
709
 
eval_call(float_to_list, F) -> float_to_list(F);
710
 
eval_call(list_to_float, L) -> list_to_float(L);
711
 
eval_call(atom_to_list, A) -> atom_to_list(A);
712
 
eval_call(list_to_atom, L) -> list_to_atom(L);
713
 
eval_call(tuple_to_list, T) -> tuple_to_list(T);
714
 
eval_call(list_to_tuple, L) -> list_to_tuple(L);
715
 
eval_call(is_atom, I) -> erlang:is_atom(I);
716
 
eval_call(is_constant, I) -> erlang:is_constant(I);
717
 
eval_call(is_float, I) -> erlang:is_float(I);
718
 
eval_call(is_integer, I) -> erlang:is_integer(I);
719
 
eval_call(is_list, I) -> erlang:is_list(I);
720
 
eval_call(is_number, I) -> erlang:is_number(I);
721
 
eval_call(is_tuple, I) -> erlang:is_tuple(I).
722
 
 
723
 
eval_call('*', X, Y) -> X * Y;
724
 
eval_call('/', X, Y) -> X / Y;
725
 
eval_call('+', X, Y) -> X + Y;
726
 
eval_call('-', X, Y) -> X - Y;
727
 
eval_call('div', X, Y) -> X div Y;
728
 
eval_call('rem', X, Y) -> X rem Y;
729
 
eval_call('band', X, Y) -> X band Y;
730
 
eval_call('bor', X, Y) -> X bor Y;
731
 
eval_call('bxor', X, Y) -> X bxor Y;
732
 
eval_call('bsl', X, Y) -> X bsl Y;
733
 
eval_call('bsr', X, Y) -> X bsr Y;
734
 
eval_call('and', X, Y) -> X and Y;
735
 
eval_call('or',  X, Y) -> X or Y;
736
 
eval_call('xor', X, Y) -> X xor Y;
737
 
eval_call('=:=',  X, Y) -> X =:= Y;
738
 
eval_call('=/=',  X, Y) -> X =/= Y;
739
 
eval_call('==',  X, Y) -> X == Y;
740
 
eval_call('/=',  X, Y) -> X /= Y;
741
 
eval_call('=<',  X, Y) -> X =< Y;
742
 
eval_call('<',   X, Y) -> X < Y;
743
 
eval_call('>=',  X, Y) -> X >= Y;
744
 
eval_call('>',   X, Y) -> X > Y;
745
 
eval_call('++', X, Y) -> X ++ Y;
746
 
eval_call('--', X, Y) -> X -- Y;
747
 
eval_call(element, X, Y) -> element(X, Y).
 
726
eval_erlang_call(Call, N, Args0) ->
 
727
    NumArgs = length(Args0),
 
728
    case erl_bifs:is_pure(erlang, N, NumArgs) of
 
729
        false -> Call;                          %Not pure - keep call.
 
730
        true ->
 
731
            case catch begin
 
732
                           Args = [core_lib:literal_value(A) || A <- Args0],
 
733
                           eval_erlang_call_1(Call, N, Args)
 
734
                       end of
 
735
                {ok,Val} -> Val;
 
736
                _Other ->
 
737
                    case erl_internal:comp_op(N, NumArgs) of
 
738
                        false -> Call;
 
739
                        true -> eval_rel_op(Call, N, Args0)
 
740
                    end
 
741
            end
 
742
    end.
 
743
 
 
744
eval_erlang_call_1(Call, N, Args) ->
 
745
    case catch apply(erlang, N, Args) of
 
746
        {'EXIT',{Reason,_}} ->
 
747
            eval_failure(Call, Reason);
 
748
        Val ->
 
749
            {ok,core_lib:make_literal(Val)}
 
750
    end.
 
751
 
 
752
eval_rel_op(Call, Op, [#c_var{name=V},#c_var{name=V}]) ->
 
753
    Bool = erlang:Op(same, same),
 
754
    #c_atom{anno=core_lib:get_anno(Call),val=Bool};
 
755
eval_rel_op(Call, _, _) -> Call.
748
756
 
749
757
%% eval_length(Call, List) -> Val.
750
758
%%  Evaluates the length for the prefix of List which has a known
781
789
%% eval_element(Pos, Tuple) -> Val.
782
790
%%  Evaluates element/2 if Pos and Tuple are literals.
783
791
 
784
 
eval_element(#c_int{val=Pos}, #c_tuple{es=Es}) ->
785
 
    lists:nth(Pos, Es).
 
792
eval_element(Call, #c_int{val=Pos}, #c_tuple{es=Es}) ->
 
793
    if
 
794
        1 =< Pos, Pos =< length(Es) ->
 
795
            lists:nth(Pos, Es);
 
796
        true ->
 
797
            eval_failure(Call, badarg)
 
798
    end;
 
799
eval_element(Call, Pos, Tuple) ->
 
800
    case {Pos,Tuple} of
 
801
        {#c_int{},#c_var{}} -> Call;
 
802
        {#c_var{},#c_tuple{}} -> Call;
 
803
        {#c_var{},#c_var{}} -> Call;
 
804
        {_,_} -> eval_failure(Call, badarg)
 
805
    end.
786
806
 
787
807
%% eval_setelement(Pos, Tuple, NewVal) -> Val.
788
808
%%  Evaluates setelement/3 if Pos and Tuple are literals.
795
815
eval_setelement1(Pos, [H|T], NewVal) when Pos > 1 ->
796
816
    [H|eval_setelement1(Pos-1, T, NewVal)].
797
817
 
 
818
eval_failure(Call, Reason) ->
 
819
    add_warning(Call, {eval_failure,Reason}),
 
820
    #c_call{module=#c_atom{val=erlang},
 
821
            name=#c_atom{val=error},
 
822
            args=[core_lib:make_literal(Reason)]}.
 
823
 
 
824
%% simplify_apply(Call0, Mod, Func, Args) -> Call
 
825
%%  Simplify an apply/3 to a call if the number of arguments
 
826
%%  are known at compile time.
 
827
 
 
828
simplify_apply(Call, Mod, Func, Args) ->
 
829
    case is_atom_or_var(Mod) andalso is_atom_or_var(Func) of
 
830
        true -> simplify_apply_1(Args, Call, Mod, Func, []);
 
831
        false -> Call
 
832
    end.
 
833
 
 
834
simplify_apply_1(#c_nil{}, Call, Mod, Func, Args) ->
 
835
    Call#c_call{module=Mod,name=Func,args=reverse(Args)};
 
836
simplify_apply_1(#c_cons{hd=Arg,tl=T}, Call, Mod, Func, Args) ->
 
837
    simplify_apply_1(T, Call, Mod, Func, [Arg|Args]);
 
838
simplify_apply_1(_, Call, _, _, _) -> Call.
 
839
 
 
840
is_atom_or_var(#c_atom{}) -> true;
 
841
is_atom_or_var(#c_var{}) -> true;
 
842
is_atom_or_var(_) -> false.
 
843
 
798
844
%% clause(Clause, Sub) -> Clause.
799
845
 
800
 
clause(#c_clause{pats=Ps0,guard=G0,body=B0}=Cl, #sub{cexpr=Cexpr,t=Types}=Sub0) ->
 
846
clause(#c_clause{pats=Ps0,guard=G0,body=B0}=Cl, Cexpr, Sub0) ->
801
847
    {Ps1,Sub1} = pattern_list(Ps0, Sub0),
802
 
    Sub2 = Sub1#sub{cexpr=none,t=update_types(Cexpr, Ps1, Types)},
803
 
    G1 = guard(G0, Sub2),
 
848
    Sub2 = update_types(Cexpr, Ps1, Sub1),
 
849
    GSub = case {Cexpr,Ps1} of
 
850
               {#c_var{name='_'},_} ->
 
851
                   %% In a 'receive', Cexpr is the variable '_', which represents the
 
852
                   %% message being matched. We must NOT do any extra substiutions.
 
853
                   Sub2;
 
854
               {#c_var{},[#c_var{}=Var]} ->
 
855
                   %% The idea here is to optimize expressions such as
 
856
                   %%
 
857
                   %%   case A of A -> ...
 
858
                   %%
 
859
                   %% to get rid of the extra guard test that the compiler
 
860
                   %% added when converting to the Core Erlang representation:
 
861
                   %%
 
862
                   %%   case A of NewVar when A =:= NewVar -> ...
 
863
                   %%
 
864
                   %% By replacing NewVar with A everywhere in the guard
 
865
                   %% expression, we get
 
866
                   %%
 
867
                   %%   case A of NewVar when A =:= A -> ...
 
868
                   %%
 
869
                   %% which by constant-expression evaluation is reduced to
 
870
                   %%
 
871
                   %%   case A of NewVar when true -> ...
 
872
                   %%
 
873
                   sub_set_var(Var, Cexpr, Sub2);
 
874
               _ ->
 
875
                   Sub2
 
876
           end,
 
877
    G1 = guard(G0, GSub),
804
878
    B1 = body(B0, Sub2),
805
879
    Cl#c_clause{pats=Ps1,guard=G1,body=B1}.
806
880
 
807
881
%% let_substs(LetVars, LetArg, Sub) -> {[Var],[Val],Sub}.
808
882
%%  Add suitable substitutions to Sub of variables in LetVars.  First
809
883
%%  remove variables in LetVars from Sub, then fix subs.  N.B. must
810
 
%%  work out new subs in parallel and then apply then to subs.  Return
 
884
%%  work out new subs in parallel and then apply them to subs.  Return
811
885
%%  the unsubstituted variables and values.
812
886
 
813
887
let_substs(Vs0, As0, Sub0) ->
814
888
    {Vs1,Sub1} = pattern_list(Vs0, Sub0),
815
889
    {Vs2,As1,Ss} = let_substs_1(Vs1, As0, Sub1),
816
 
    {Vs2,As1,
817
 
     foldl(fun ({V,S}, Sub) -> sub_set_name(V, S, Sub) end, Sub1, Ss)}.
 
890
    Sub2 = scope_add([V || #c_var{name=V} <- Vs2], Sub1),
 
891
    {Vs2,As1, 
 
892
     foldl(fun ({V,S}, Sub) -> sub_set_name(V, S, Sub) end, Sub2, Ss)}.
818
893
 
819
894
let_substs_1(Vs, #c_values{es=As}, Sub) ->
820
895
    let_subst_list(Vs, As, Sub);
845
920
pattern(#c_var{name=V0}=Pat, Isub, Osub) ->
846
921
    case sub_is_val(Pat, Isub) of
847
922
        true ->
848
 
            %% Nesting saves us from using unique variable names.
849
 
            V1 = list_to_atom("fol" ++ atom_to_list(V0)),
 
923
            V1 = make_var_name(),
850
924
            Pat1 = #c_var{name=V1},
851
 
            {Pat1,sub_set_var(Pat, Pat1, Osub)};
852
 
        false -> {Pat,sub_del_var(Pat, Osub)}
 
925
            {Pat1,sub_set_var(Pat, Pat1, scope_add([V1], Osub))};
 
926
        false ->
 
927
            {Pat,sub_del_var(Pat, scope_add([V0], Osub))}
853
928
    end;
854
929
pattern(#c_char{}=Pat, _, Osub) -> {Pat,Osub};
855
 
pattern(#c_int{}=Pat, Osub, _) -> {Pat,Osub};
 
930
pattern(#c_int{}=Pat, _, Osub) -> {Pat,Osub};
856
931
pattern(#c_float{}=Pat, _, Osub) -> {Pat,Osub};
857
932
pattern(#c_atom{}=Pat, _, Osub) -> {Pat,Osub};
858
933
pattern(#c_string{}=Pat, _, Osub) -> {Pat,Osub};
864
939
pattern(#c_tuple{es=Es0}=Pat, Isub, Osub0) ->
865
940
    {Es1,Osub1} = pattern_list(Es0, Isub, Osub0),
866
941
    {Pat#c_tuple{es=Es1},Osub1};
867
 
pattern(#c_binary{segs=V0}=Pat, Isub, Osub0) ->
 
942
pattern(#c_binary{segments=V0}=Pat, Isub, Osub0) ->
868
943
    {V1,Osub1} = bin_pattern_list(V0, Isub, Osub0),
869
 
    {Pat#c_binary{segs=V1},Osub1};
 
944
    {Pat#c_binary{segments=V1},Osub1};
870
945
pattern(#c_alias{var=V0,pat=P0}=Pat, Isub, Osub0) ->
871
946
    {V1,Osub1} = pattern(V0, Isub, Osub0),
872
947
    {P1,Osub2} = pattern(P0, Isub, Osub1),
873
948
    {Pat#c_alias{var=V1,pat=P1},Osub2}.
874
949
 
875
950
bin_pattern_list(Ps0, Isub, Osub0) ->
876
 
    mapfoldl(fun (P, Osub) -> bin_pattern(P, Isub, Osub) end, Osub0, Ps0).
 
951
    {Ps,{_,Osub}} = mapfoldl(fun bin_pattern/2, {Isub,Osub0}, Ps0),
 
952
    {Ps,Osub}.
877
953
 
878
 
bin_pattern(#c_bin_seg{val=E0,size=Size0}=Pat, Isub, Osub0) ->
879
 
    Size1 = expr(Size0, Isub),
880
 
    {E1,Osub1} = pattern(E0, Isub, Osub0),
881
 
    {Pat#c_bin_seg{val=E1,size=Size1},Osub1}.
 
954
bin_pattern(#c_bitstr{val=E0,size=Size0}=Pat, {Isub0,Osub0}) ->
 
955
    Size1 = expr(Size0, Isub0),
 
956
    {E1,Osub} = pattern(E0, Isub0, Osub0),
 
957
    Isub = case E0 of
 
958
               #c_var{} -> sub_del_var(E0, Isub0);
 
959
               _ -> Isub0
 
960
           end,
 
961
    {Pat#c_bitstr{val=E1,size=Size1},{Isub,Osub}}.
882
962
 
883
963
pattern_list(Ps, Sub) -> pattern_list(Ps, Sub, Sub).
884
964
 
890
970
 
891
971
is_subst(#c_tuple{es=[]}) -> true;              %The empty tuple
892
972
is_subst(#c_fname{}) -> false;                  %Fun implementaion needs this
 
973
is_subst(#c_string{}) -> false;                 %Better not.
893
974
is_subst(#c_var{}) -> true;
894
975
is_subst(E) -> core_lib:is_atomic(E).
895
976
 
900
981
%% sub_del_var(Var, #sub{}) -> #sub{}.
901
982
%% sub_subst_var(Var, Value, #sub{}) -> [{Name,Value}].
902
983
%% sub_is_val(Var, #sub{}) -> bool().
 
984
%% sub_subst_scope(#sub{}) -> #sub{}
 
985
%%
903
986
%%  We use the variable name as key so as not have problems with
904
987
%%  annotations.  When adding a new substitute we fold substitute
905
988
%%  chains so we never have to search more than once.  Use orddict so
906
989
%%  we know the format.
907
 
 
908
 
sub_new() -> #sub{v=[],t=[]}.
 
990
%%
 
991
%%  sub_subst_scope/1 adds dummy substitutions for all variables
 
992
%%  in the scope in order to force renaming if variables in the
 
993
%%  scope occurs as pattern variables.
 
994
 
 
995
sub_new() -> #sub{v=orddict:new(),s=gb_trees:empty(),t=[]}.
 
996
 
 
997
%%sub_new(#sub{}=Sub) -> Sub#sub{v=orddict:new()}.
 
998
sub_new(#sub{}=Sub) -> Sub#sub{v=orddict:new(),t=[]}.
909
999
 
910
1000
sub_get_var(#c_var{name=V}=Var, #sub{v=S}) ->
911
 
    case v_find(V, S) of
 
1001
    case orddict:find(V, S) of
912
1002
        {ok,Val} -> Val;
913
1003
        error -> Var
914
1004
    end.
916
1006
sub_set_var(#c_var{name=V}, Val, Sub) ->
917
1007
    sub_set_name(V, Val, Sub).
918
1008
 
919
 
sub_set_name(V, Val, #sub{v=S,t=Tdb}=Sub) ->
920
 
    Sub#sub{v=v_store(V, Val, S),t=kill_types(V, Tdb)}.
 
1009
sub_set_name(V, Val, #sub{v=S,s=Scope,t=Tdb}=Sub) ->
 
1010
    Sub#sub{v=orddict:store(V, Val, S),s=gb_sets:add(V, Scope),
 
1011
            t=kill_types(V, Tdb)}.
921
1012
 
922
1013
sub_del_var(#c_var{name=V}, #sub{v=S,t=Tdb}=Sub) ->
923
 
    Sub#sub{v=v_erase(V, S),t=kill_types(V, Tdb)}.
 
1014
    Sub#sub{v=orddict:erase(V, S),t=kill_types(V, Tdb)}.
924
1015
 
925
1016
sub_subst_var(#c_var{name=V}, Val, #sub{v=S0}) ->
926
1017
    %% Fold chained substitutions.
927
 
    [{V,Val}] ++ [ {K,Val} || {K,#c_var{name=V1}} <- S0, V1 =:= V ].
 
1018
    [{V,Val}] ++ [ {K,Val} || {K,#c_var{name=V1}} <- S0, V1 =:= V].
 
1019
 
 
1020
sub_subst_scope(#sub{v=S0,s=Scope}=Sub) ->
 
1021
    S = [{-1,#c_var{name=Sv}} || Sv <- gb_sets:to_list(Scope)]++S0,
 
1022
    Sub#sub{v=S}.
928
1023
 
929
1024
sub_is_val(#c_var{name=V}, #sub{v=S}) ->
930
1025
    v_is_value(V, S).
931
1026
 
932
 
v_find(Key, [{K,_}|_]) when Key < K -> error;
933
 
v_find(Key, [{K,Value}|_]) when Key == K -> {ok,Value};
934
 
v_find(Key, [{K,_}|D]) when Key > K -> v_find(Key, D);
935
 
v_find(_, []) -> error.
936
 
 
937
 
v_store(Key, New, [{K,_Old}=Pair|Dict]) when Key < K ->
938
 
    [{Key,New},Pair|Dict];
939
 
v_store(Key, New, [{K,_Old}|Dict]) when Key == K ->
940
 
    [{Key,New}|Dict];
941
 
v_store(Key, New, [{K,_Old}=Pair|Dict]) when Key > K ->
942
 
    [Pair|v_store(Key, New, Dict)];
943
 
v_store(Key, New, []) -> [{Key,New}].
944
 
 
945
 
v_erase(Key, [{K,Value}|Dict]) when Key < K -> [{K,Value}|Dict];
946
 
v_erase(Key, [{K,_}|Dict]) when Key == K -> Dict;
947
 
v_erase(Key, [{K,Value}|Dict]) when Key > K ->
948
 
    [{K,Value}|v_erase(Key, Dict)];
949
 
v_erase(_, []) -> [].
950
 
 
951
1027
v_is_value(Var, Sub) ->
952
1028
    any(fun ({_,#c_var{name=Val}}) when Val == Var -> true;
953
1029
            (_) -> false
954
1030
        end, Sub).
955
1031
 
956
 
%% clauses(E, [Clause], Sub) -> [Clause].
 
1032
%% clauses(E, [Clause], TopLevel, Sub) -> [Clause].
957
1033
%%  Trim the clauses by removing all clauses AFTER the first one which
958
1034
%%  is guaranteed to match.  Also remove all trivially false clauses.
959
1035
 
960
 
clauses(E, [C0|Cs], Sub) ->
961
 
    #c_clause{pats=Ps,guard=G}=C1 = clause(C0, Sub#sub{cexpr=E}),
 
1036
clauses(E, Cs0, TopLevel, Sub) ->
 
1037
    Cs = clauses_1(E, Cs0, Sub),
 
1038
 
 
1039
    %% Here we want to warn if no clauses whatsoever will ever
 
1040
    %% match, because that is probably a mistake.
 
1041
    case all(fun is_compiler_generated/1, Cs) andalso
 
1042
        any(fun(C) -> not is_compiler_generated(C) end, Cs0) of
 
1043
        true ->
 
1044
            %% The original list of clauses did contain at least one
 
1045
            %% user-specified clause, but none of them will match.
 
1046
            %% That is probably a mistake.
 
1047
            add_warning(TopLevel, no_clause_match);
 
1048
        false ->
 
1049
            %% Either there were user-specified clauses left in
 
1050
            %% the transformed clauses, or else none of the original
 
1051
            %% clauses were user-specified to begin with (as in 'andalso').
 
1052
            ok
 
1053
    end,
 
1054
 
 
1055
    Cs.
 
1056
 
 
1057
clauses_1(E, [C0|Cs], Sub) ->
 
1058
    #c_clause{pats=Ps,guard=G} = C1 = clause(C0, E, Sub),
962
1059
    %%ok = io:fwrite("~w: ~p~n", [?LINE,{E,Ps}]),
963
1060
    case {will_match(E, Ps),will_succeed(G)} of
964
 
        {yes,yes} -> [C1];                      %Skip the rest
965
 
        {no,_Suc} -> clauses(E, Cs, Sub);       %Skip this clause
966
 
        {_Mat,no} -> clauses(E, Cs, Sub);       %Skip this clause
967
 
        {_Mat,_Suc} -> [C1|clauses(E, Cs, Sub)]
 
1061
        {yes,yes} ->
 
1062
            Line = get_line(core_lib:get_anno(C1)),
 
1063
            case core_lib:is_literal(E) of
 
1064
                false ->
 
1065
                    shadow_warning(Cs, Line);
 
1066
                true ->
 
1067
                    %% If the constant expression is a literal,
 
1068
                    %% it is probably OK that some clauses don't match.
 
1069
                    %% It is a proably some sort of debug macro.
 
1070
                    ok
 
1071
            end,
 
1072
            [C1];                               %Skip the rest
 
1073
        {no,_Suc} ->
 
1074
            clauses_1(E, Cs, Sub);              %Skip this clause
 
1075
        {_Mat,no} ->
 
1076
            add_warning(C1, nomatch_guard),
 
1077
            clauses_1(E, Cs, Sub);              %Skip this clause
 
1078
        {_Mat,_Suc} ->
 
1079
            [C1|clauses_1(E, Cs, Sub)]
968
1080
    end;
969
 
clauses(_, [], _) -> [].
 
1081
clauses_1(_, [], _) -> [].
 
1082
 
 
1083
shadow_warning([C|Cs], none) ->
 
1084
    add_warning(C, nomatch_shadow),
 
1085
    shadow_warning(Cs, none);
 
1086
shadow_warning([C|Cs], Line) ->
 
1087
    add_warning(C, {nomatch_shadow, Line}),
 
1088
    shadow_warning(Cs, Line);
 
1089
shadow_warning([], _) -> ok.
970
1090
 
971
1091
%% will_succeed(Guard) -> yes | maybe | no.
972
1092
%%  Test if we know whether a guard will succeed/fail or just don't
978
1098
 
979
1099
%% will_match(Expr, [Pattern]) -> yes | maybe | no.
980
1100
%%  Test if we know whether a match will succeed/fail or just don't
981
 
%%  know.  Be VERY conservative!
 
1101
%%  know.  Be conservative.
982
1102
 
983
1103
will_match(#c_values{es=Es}, Ps) ->
984
1104
    will_match_list(Es, Ps, yes);
992
1112
will_match_1(#c_var{}, _P) -> maybe;
993
1113
will_match_1(#c_tuple{es=Es}, #c_tuple{es=Ps}) ->
994
1114
    will_match_list(Es, Ps, yes);
995
 
will_match_1(_, _) -> maybe.
 
1115
will_match_1(#c_binary{}, _P) ->
 
1116
    maybe;                                      %Binaries are tricky to compare.
 
1117
will_match_1(_E, #c_binary{}) ->
 
1118
    maybe;
 
1119
will_match_1(E, P) ->
 
1120
    case core_lib:is_literal(E) andalso core_lib:is_literal(P) of
 
1121
        false -> maybe;
 
1122
        true ->
 
1123
            %% Both are literals (not binaries); compare them.
 
1124
            case core_lib:literal_value(E) =:= core_lib:literal_value(P) of
 
1125
                false -> no;
 
1126
                true -> yes
 
1127
            end
 
1128
    end.
996
1129
 
997
1130
will_match_list([E|Es], [P|Ps], M) ->
998
1131
    case will_match_1(E, P) of
1003
1136
will_match_list([], [], M) -> M;
1004
1137
will_match_list(_, _, _) -> no.                 %Different length
1005
1138
 
 
1139
%% move_to_guard(Case0) -> Case.
 
1140
%%  Relational operators in cases like
 
1141
%% 
 
1142
%%    case A > B of
 
1143
%%      true -> TrueClause;
 
1144
%%      false -> FalseClause
 
1145
%%    end.
 
1146
%%
 
1147
%%  can be moved to the guard like this
 
1148
%%
 
1149
%%    case <> of
 
1150
%%      <> when A > B -> TrueClause;
 
1151
%%      <> when true -> FalseClause
 
1152
%%    end
 
1153
%%
 
1154
%%  If the sole purpose of the guard is to verify that
 
1155
%%  the relational expression indeed returns true or false like
 
1156
%%
 
1157
%%    case A =:= B of
 
1158
%%      true -> true
 
1159
%%      false -> false
 
1160
%%    end.
 
1161
%%
 
1162
%%  we can remove the case but keep the expression
 
1163
%%
 
1164
%%    A =:= B.
 
1165
%%
 
1166
 
 
1167
move_to_guard(#c_case{arg=#c_call{module=#c_atom{val=erlang}}=Call}=Case) ->
 
1168
     case Call of
 
1169
         #c_call{name=#c_atom{val=Name},args=Args} ->
 
1170
             NumArgs = length(Args),
 
1171
             case erl_internal:comp_op(Name, NumArgs) orelse
 
1172
                 erl_internal:new_type_test(Name, NumArgs) of
 
1173
                 false -> Case;
 
1174
                 true -> move_to_guard_1(Call, Case)
 
1175
             end;
 
1176
         _ -> Case
 
1177
     end;
 
1178
move_to_guard(Case) -> Case.
 
1179
 
 
1180
move_to_guard_1(Call, #c_case{clauses=[_,_|Cs]=Cs0}=Case) ->
 
1181
    case is_bool_case(Cs0) of
 
1182
        true ->
 
1183
            %% The case is not needed. Warn if there
 
1184
            %% are any (non-compiler generated) clauses following
 
1185
            %% the true and false clauses because they will
 
1186
            %% certainly not be reached.
 
1187
            shadow_warning(Cs, none),
 
1188
            Call;                               %The case is not needed.
 
1189
        false -> move_to_guard_2(Call, Case)
 
1190
    end;
 
1191
move_to_guard_1(_, Case) -> Case.
 
1192
 
 
1193
move_to_guard_2(Call, #c_case{clauses=[A,B|Cs]}=Case) ->
 
1194
    case {A,B} of
 
1195
        {#c_clause{pats=[#c_atom{val=true}],guard=#c_atom{val=true}},
 
1196
         #c_clause{pats=[#c_atom{val=false}],guard=#c_atom{val=true}}} ->
 
1197
            True = A#c_clause{pats=[],guard=Call},
 
1198
            False = B#c_clause{pats=[]},
 
1199
            Case#c_case{arg=#c_values{anno=core_lib:get_anno(Call),es=[]},
 
1200
                        clauses=[True,False|Cs]};
 
1201
        {#c_clause{pats=[#c_atom{val=false}],guard=#c_atom{val=true}},
 
1202
         #c_clause{pats=[#c_atom{val=true}],guard=#c_atom{val=true}}} ->
 
1203
            True = B#c_clause{pats=[],guard=Call},
 
1204
            False = A#c_clause{pats=[]},
 
1205
            Case#c_case{arg=#c_values{anno=core_lib:get_anno(Call),es=[]},
 
1206
                        clauses=[True,False|Cs]};
 
1207
        _ -> Case
 
1208
    end.
 
1209
 
1006
1210
%% eval_case(Case) -> #c_case{} | #c_let{}.
1007
1211
%%  If possible, evaluate a case at compile time.  We know that the
1008
1212
%%  last clause is guaranteed to match so if there is only one clause
1009
1213
%%  with a pattern containing only variables then rewrite to a let.
1010
1214
 
1011
1215
eval_case(#c_case{arg=#c_var{name=V},
1012
 
                  clauses=[#c_clause{pats=[P],guard=G,body=B}|_]}=Cases,
1013
 
          #sub{t=Tdb}) ->
 
1216
                  clauses=[#c_clause{pats=[P],guard=G,body=B}|_]}=Case,
 
1217
          #sub{t=Tdb}=Sub) ->
1014
1218
    case orddict:find(V, Tdb) of
1015
1219
        {ok,Type} ->
1016
1220
            case {will_match_type(P, Type),will_succeed(G)} of
1017
1221
                {yes,yes} ->
1018
 
                    {Ps,Es} = remove_non_vars(P, Type, [], []),
1019
 
                    expr(#c_let{vars=Ps,arg=#c_values{es=Es},body=B}, sub_new());
1020
 
                {_,_} -> eval_case(Cases)
 
1222
                    {Ps,Es} = remove_non_vars(P, Type),
 
1223
                    expr(#c_let{vars=Ps,arg=#c_values{es=Es},body=B}, sub_new(Sub));
 
1224
                {_,_} -> eval_case_1(Case, Sub)
1021
1225
            end;
1022
 
        error -> eval_case(Cases)
 
1226
        error -> eval_case_1(Case, Sub)
1023
1227
    end;
1024
 
eval_case(Cases, _) -> eval_case(Cases).
 
1228
eval_case(Case, Sub) -> eval_case_1(Case, Sub).
1025
1229
 
1026
 
eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps,body=B}]}=Case) ->
 
1230
eval_case_1(#c_case{arg=E,clauses=[#c_clause{pats=Ps,body=B}]}=Case, Sub) ->
1027
1231
    case is_var_pat(Ps) of
1028
 
        true -> expr(#c_let{vars=Ps,arg=E,body=B}, sub_new());
1029
 
        false -> Case
1030
 
    end;
1031
 
eval_case(Case) -> Case.
1032
 
 
1033
 
is_var_pat(Ps) -> all(fun (#c_var{}) -> true;
1034
 
                          (_Pat) -> false
1035
 
                      end, Ps).
 
1232
        true -> expr(#c_let{vars=Ps,arg=E,body=B}, sub_new(Sub));
 
1233
        false -> eval_case_2(E, Ps, B, Case)
 
1234
    end;
 
1235
eval_case_1(Case, _) -> Case.
 
1236
 
 
1237
eval_case_2(E, [P], B, Case) ->
 
1238
    %% Recall that there is only one clause and that it is guaranteed to match.
 
1239
    %%   If E and P are literals, they must be the same literal and the body
 
1240
    %% can be used directly as there are no variables that need to be bound.
 
1241
    %%   Otherwise, P could be an alias meaning that two or more variables
 
1242
    %% would be bound to E. We don't bother to optimize that case as it
 
1243
    %% is rather uncommon.
 
1244
    case core_lib:is_literal(E) andalso core_lib:is_literal(P) of
 
1245
        false -> Case;
 
1246
        true -> B
 
1247
    end;
 
1248
eval_case_2(_, _, _, Case) -> Case.
 
1249
 
 
1250
is_var_pat(Ps) ->
 
1251
    all(fun (#c_var{}) -> true;
 
1252
            (_Pat) -> false
 
1253
        end, Ps).
1036
1254
 
1037
1255
will_match_type(#c_tuple{es=Es}, #c_tuple{es=Ps}) ->
1038
1256
    will_match_list_type(Es, Ps);
1039
 
will_match_type(#c_atom{}=Atom, #c_atom{}=Atom) -> yes;
 
1257
will_match_type(#c_atom{val=Atom}, #c_atom{val=Atom}) -> yes;
1040
1258
will_match_type(#c_var{}, _) -> yes;
1041
1259
will_match_type(_, _) -> no.
1042
1260
 
1048
1266
will_match_list_type([], []) -> yes;
1049
1267
will_match_list_type(_, _) -> no.               %Different length
1050
1268
 
 
1269
remove_non_vars(Ps0, Es0) ->
 
1270
    {Ps,Es} = remove_non_vars(Ps0, Es0, [], []),
 
1271
    {reverse(Ps),reverse(Es)}.
 
1272
 
1051
1273
remove_non_vars(#c_tuple{es=Ps}, #c_tuple{es=Es}, Pacc, Eacc) ->
1052
 
    remove_non_vars(Ps, Es, Pacc, Eacc);
1053
 
remove_non_vars([#c_var{}=Var|Ps], [#c_alias{var=Evar}|Es], Pacc, Eacc) ->
1054
 
    remove_non_vars(Ps, Es, [Var|Pacc], [Evar|Eacc]);
1055
 
remove_non_vars([#c_var{}=Var|Ps], [E|Es], Pacc, Eacc) ->
1056
 
    remove_non_vars(Ps, Es, [Var|Pacc], [E|Eacc]);
1057
 
remove_non_vars([_|Ps], [_|Es], Pacc, Eacc) ->
1058
 
    remove_non_vars(Ps, Es, Pacc, Eacc);
1059
 
remove_non_vars([], [], Pacc, Eacc) -> {reverse(Pacc),reverse(Eacc)}.
 
1274
    remove_non_vars_list(Ps, Es, Pacc, Eacc);
 
1275
remove_non_vars(#c_var{}=Var, #c_alias{var=Evar}, Pacc, Eacc) ->
 
1276
    {[Var|Pacc],[Evar|Eacc]};
 
1277
remove_non_vars(#c_var{}=Var, E, Pacc, Eacc) ->
 
1278
    {[Var|Pacc],[E|Eacc]};
 
1279
remove_non_vars(P, E, Pacc, Eacc) ->
 
1280
    true = core_lib:is_literal(P) andalso core_lib:is_literal(E), %Assertion.
 
1281
    {Pacc,Eacc}.
 
1282
 
 
1283
remove_non_vars_list([P|Ps], [E|Es], Pacc0, Eacc0) ->
 
1284
    {Pacc,Eacc} = remove_non_vars(P, E, Pacc0, Eacc0),
 
1285
    remove_non_vars_list(Ps, Es, Pacc, Eacc);
 
1286
remove_non_vars_list([], [], Pacc, Eacc) ->
 
1287
    {Pacc,Eacc}.
1060
1288
 
1061
1289
%% case_opt(CaseArg, [Clause]) -> {CaseArg,[Clause]}.
1062
1290
%%  Try and optimise case by removing building argument terms.
1074
1302
                        guard=letify_guard(Flet, Avs, G),
1075
1303
                        body=foldl(Flet, B, Avs)}|case_opt_cs(Cs, Arity)];
1076
1304
        error ->                                %Can't match
 
1305
            add_warning(C, no_match_clause_type),
1077
1306
            case_opt_cs(Cs, Arity)
1078
1307
    end;
1079
1308
case_opt_cs([], _) -> [].
1131
1360
unalias_pat_list(Ps) -> map(fun unalias_pat/1, Ps).
1132
1361
 
1133
1362
make_vars(A, I, Max) when I =< Max ->
1134
 
    [make_var(A, I)|make_vars(A, I+1, Max)];
 
1363
    [make_var(A)|make_vars(A, I+1, Max)];
1135
1364
make_vars(_, _, _) -> [].
1136
1365
    
1137
 
make_var(A, N) ->
1138
 
    #c_var{anno=A,name=list_to_atom("fol" ++ integer_to_list(N))}.
 
1366
make_var(A) ->
 
1367
    #c_var{anno=A,name=make_var_name()}.
 
1368
 
 
1369
make_var_name() ->
 
1370
    N = get(new_var_num),
 
1371
    put(new_var_num, N+1),
 
1372
    list_to_atom("fol"++integer_to_list(N)).
1139
1373
 
1140
1374
letify(#c_var{name=Vname}=Var, Val, Body) ->
1141
1375
    case core_lib:is_var_used(Vname, Body) of
1146
1380
    end.
1147
1381
 
1148
1382
%% opt_case_in_let(LetExpr) -> LetExpr'
1149
 
%%  In {V1,V2,...} = case E of P -> ... {Val1,Val2,...}; ... end.
1150
 
%%  avoid building tuples, by converting tuples to multiple values.
1151
 
%%  (The optimisation is not done if the built tuple is used or returned.)
1152
1383
 
1153
1384
opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let) ->
 
1385
%%    Let.
1154
1386
    case catch opt_case_in_let(Vs, Arg, B) of
1155
1387
        {'EXIT',_} -> Let;                      %Optimisation not possible.
1156
1388
        Other -> Other
1157
 
    end;
1158
 
opt_case_in_let(Other) -> Other.
1159
 
 
1160
 
opt_case_in_let([#c_var{name=V}], Arg0,
1161
 
                #c_case{arg=#c_var{name=V},clauses=[C1|_]}) ->
1162
 
    #c_clause{pats=[#c_tuple{es=Es}],guard=#c_atom{val=true},body=B} = C1,
 
1389
    end.
 
1390
 
 
1391
opt_case_in_let([#c_var{name=V}], Arg,
 
1392
                #c_case{arg=#c_var{name=V},clauses=Cs}) ->
 
1393
    opt_case_in_let_1(V, Arg, Cs).
 
1394
 
 
1395
opt_case_in_let_1(V, Arg0,
 
1396
                  [#c_clause{pats=[#c_tuple{es=Es}],
 
1397
                             guard=#c_atom{val=true},body=B}|_]) ->
 
1398
 
 
1399
    %%  In {V1,V2,...} = case E of P -> ... {Val1,Val2,...}; ... end.
 
1400
    %%  avoid building tuples, by converting tuples to multiple values.
 
1401
    %%  (The optimisation is not done if the built tuple is used or returned.)
 
1402
 
1163
1403
    true = all(fun (#c_var{}) -> true;
1164
1404
                   (_) -> false end, Es),       %Only variables in tuple
1165
1405
    false = core_lib:is_var_used(V, B),         %Built tuple must not be used.
1166
1406
    Arg1 = tuple_to_values(Arg0, length(Es)),   %Might fail.
1167
 
    #c_let{vars=Es,arg=Arg1,body=B}.
 
1407
    #c_let{vars=Es,arg=Arg1,body=B};
 
1408
opt_case_in_let_1(_, Arg, Cs) ->
 
1409
    %% simplify_bool_case(Case0) -> Case
 
1410
    %%  Remove unecessary cases like
 
1411
    %% 
 
1412
    %%     case BoolExpr of
 
1413
    %%       true -> true;
 
1414
    %%       false -> false;
 
1415
    %%       ....
 
1416
    %%     end
 
1417
    %%
 
1418
    %%  where BoolExpr is an expression that can only return true
 
1419
    %%  or false (or throw an exception).
 
1420
 
 
1421
    true = is_bool_case(Cs) andalso is_bool_expr(Arg),
 
1422
    Arg.
 
1423
 
 
1424
is_bool_case([A,B|_]) ->
 
1425
    (is_bool_clause(true, A) andalso is_bool_clause(false, B))
 
1426
        orelse (is_bool_clause(false, A) andalso is_bool_clause(true, B)).
 
1427
 
 
1428
is_bool_clause(Bool, #c_clause{pats=[#c_atom{val=Bool}],
 
1429
                               guard=#c_atom{val=true},
 
1430
                               body=#c_atom{val=Bool}}) ->
 
1431
    true;
 
1432
is_bool_clause(_, _) -> false.
 
1433
 
 
1434
%% is_bool_expr(Core) -> true|false
 
1435
%%  Check whether the Core expression only can return a boolean
 
1436
%%  (or throw an exception).
 
1437
 
 
1438
is_bool_expr(#c_call{module=#c_atom{val=erlang},
 
1439
                     name=#c_atom{val=Name},args=Args}=Call) ->
 
1440
    NumArgs = length(Args),
 
1441
    erl_internal:comp_op(Name, NumArgs) orelse
 
1442
        erl_internal:new_type_test(Name, NumArgs) orelse
 
1443
        will_fail(Call);
 
1444
is_bool_expr(#c_case{clauses=Cs}) ->
 
1445
    is_bool_expr_list(Cs);
 
1446
is_bool_expr(#c_clause{body=B}) ->
 
1447
    is_bool_expr(B);
 
1448
is_bool_expr(#c_let{body=B}) ->
 
1449
    is_bool_expr(B);
 
1450
is_bool_expr(#c_atom{val=false}) ->
 
1451
    true;
 
1452
is_bool_expr(#c_atom{val=true}) ->
 
1453
    true;
 
1454
is_bool_expr(_) -> false.
 
1455
 
 
1456
is_bool_expr_list([C|Cs]) ->
 
1457
    is_bool_expr(C) andalso is_bool_expr_list(Cs);
 
1458
is_bool_expr_list([]) -> true.
1168
1459
 
1169
1460
%% tuple_to_values(Expr, TupleArity) -> Expr' | exception
1170
1461
%%  Convert tuples in return position of arity TupleArity to values.
1178
1469
                _Arity) when length(Args) == 1 ->
1179
1470
    Call;
1180
1471
tuple_to_values(#c_call{module=#c_atom{val=erlang},
 
1472
                        name=#c_atom{val=throw},
 
1473
                        args=Args}=Call,
 
1474
                _Arity) when length(Args) == 1 ->
 
1475
    Call;
 
1476
tuple_to_values(#c_call{module=#c_atom{val=erlang},
 
1477
                        name=#c_atom{val=error},
 
1478
                        args=Args}=Call,
 
1479
                _Arity) when length(Args) == 1 ->
 
1480
    Call;
 
1481
tuple_to_values(#c_call{module=#c_atom{val=erlang},
 
1482
                        name=#c_atom{val=error},
 
1483
                        args=Args}=Call,
 
1484
                _Arity) when length(Args) == 2 ->
 
1485
    Call;
 
1486
tuple_to_values(#c_call{module=#c_atom{val=erlang},
1181
1487
                        name=#c_atom{val=fault},
1182
1488
                        args=Args}=Call,
1183
1489
                _Arity) when length(Args) == 1 ->
1206
1512
    B = tuple_to_values(B0, Arity),
1207
1513
    Clause#c_clause{body=B}.
1208
1514
 
1209
 
%% update_types(Expr, Pattern, Types) -> Types'
1210
 
%%  Updates the type database.
1211
 
update_types(#c_var{name=V}, [#c_tuple{}=P], Types) ->
 
1515
%% simplify_let(Let, Sub) -> Expr | impossible
 
1516
%%  If the argument part of an let contains a complex expression, such
 
1517
%%  as a let or a sequence, move the original let body into the complex
 
1518
%%  expression.
 
1519
 
 
1520
simplify_let(#c_let{arg=Arg}=Let, Sub) ->
 
1521
    move_let_into_expr(Let, Arg, Sub).
 
1522
 
 
1523
move_let_into_expr(#c_let{vars=InnerVs0,body=InnerBody0}=Inner,
 
1524
                   #c_let{vars=OuterVs0,arg=Arg0,body=OuterBody0}=Outer, Sub0) ->
 
1525
    %%
 
1526
    %% let <InnerVars> = let <OuterVars> = <Arg>
 
1527
    %%                   in <OuterBody>
 
1528
    %% in <InnerBody>
 
1529
    %%
 
1530
    %%       ==>
 
1531
    %%
 
1532
    %% let <OuterVars> = <Arg>
 
1533
    %% in let <InnerVars> = <OuterBody>
 
1534
    %%    in <InnerBody>
 
1535
    %%
 
1536
    Arg = body(Arg0, Sub0),
 
1537
    ScopeSub0 = sub_subst_scope(Sub0#sub{t=[]}),
 
1538
    {OuterVs,ScopeSub} = pattern_list(OuterVs0, ScopeSub0),
 
1539
    OuterBody = body(OuterBody0, ScopeSub),
 
1540
 
 
1541
    {InnerVs,Sub} = pattern_list(InnerVs0, Sub0),
 
1542
    InnerBody = body(InnerBody0, Sub),
 
1543
    Outer#c_let{vars=OuterVs,arg=Arg,
 
1544
                body=Inner#c_let{vars=InnerVs,arg=OuterBody,body=InnerBody}};
 
1545
move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let,
 
1546
                   #c_case{arg=Cexpr0,clauses=[Ca0,Cb0]}=Case, Sub0) ->
 
1547
    case {is_failing_clause(Ca0),is_failing_clause(Cb0)} of
 
1548
        {false,true} ->
 
1549
            %% let <Lvars> = case <Case-expr> of
 
1550
            %%                  <Cvars> -> <Clause-body>;
 
1551
            %%                  <OtherCvars> -> erlang:error(...)
 
1552
            %%               end
 
1553
            %% in <Let-body>
 
1554
            %%
 
1555
            %%     ==>
 
1556
            %%
 
1557
            %% case <Case-expr> of
 
1558
            %%   <Cvars> ->
 
1559
            %%       let <Lvars> = <Clause-body>
 
1560
            %%       in <Let-body>;
 
1561
            %%   <OtherCvars> -> erlang:error(...)
 
1562
            %% end
 
1563
 
 
1564
            Cexpr = body(Cexpr0, Sub0),
 
1565
            CaVars0 = Ca0#c_clause.pats,
 
1566
            G0 = Ca0#c_clause.guard,
 
1567
            B0 = Ca0#c_clause.body,
 
1568
            ScopeSub0 = sub_subst_scope(Sub0#sub{t=[]}),
 
1569
            {CaVars,ScopeSub} = pattern_list(CaVars0, ScopeSub0),
 
1570
            G = guard(G0, ScopeSub),
 
1571
            B1 = body(B0, ScopeSub),
 
1572
 
 
1573
            {Lvs,B2,Sub1} = let_substs(Lvs0, B1, Sub0),
 
1574
            Lbody = body(Lbody0, Sub1),
 
1575
            B = Let#c_let{vars=Lvs,arg=core_lib:make_values(B2),body=Lbody},
 
1576
 
 
1577
            Ca = Ca0#c_clause{pats=CaVars,guard=G,body=B},
 
1578
            Cb = clause(Cb0, Cexpr, Sub0),
 
1579
            Case#c_case{arg=Cexpr,clauses=[Ca,Cb]};
 
1580
        {_,_} -> impossible
 
1581
    end;
 
1582
%% move_let_into_expr(#c_let{}=Let, #c_seq{body=B}=Seq, Sub0) ->
 
1583
%%     io:format("~p\n", [?LINE]),
 
1584
%%     Seq#c_seq{body=Let#c_let{arg=B}};
 
1585
move_let_into_expr(_Let, _Expr, _Sub) -> impossible.
 
1586
 
 
1587
is_failing_clause(#c_clause{body=B}) ->
 
1588
    will_fail(B).
 
1589
 
 
1590
scope_add(Vs, #sub{s=Scope0}=Sub) ->
 
1591
    Scope = foldl(fun(V, S) when is_integer(V); is_atom(V) ->
 
1592
                          gb_sets:add(V, S)
 
1593
                  end, Scope0, Vs),
 
1594
    Sub#sub{s=Scope}.
 
1595
 
 
1596
opt_simple_let(#c_let{vars=Vs0,arg=Arg0,body=B0}=Let, Sub0) ->
 
1597
    Arg1 = body(Arg0, Sub0),                    %This is a body
 
1598
    case will_fail(Arg1) of
 
1599
        true -> Arg1;
 
1600
        false ->
 
1601
            %% Optimise let and add new substitutions.
 
1602
            {Vs1,Args,Sub1} = let_substs(Vs0, Arg1, Sub0),
 
1603
            B1 = body(B0, Sub1),
 
1604
 
 
1605
            %% Optimise away let if the body consists of a single variable or
 
1606
            %% if no values remain to be set.
 
1607
            case {Vs1,Args,B1} of
 
1608
                {[#c_var{name=Vname}],Args,#c_var{name=Vname}} ->
 
1609
                    core_lib:make_values(Args);
 
1610
                {[],[],Body} ->
 
1611
                    Body;
 
1612
                _Other ->
 
1613
                    opt_case_in_let(Let#c_let{vars=Vs1,
 
1614
                                              arg=core_lib:make_values(Args),
 
1615
                                              body=B1})
 
1616
            end
 
1617
    end.
 
1618
 
 
1619
%% update_types(Expr, Pattern, Sub) -> Sub'
 
1620
%%  Update the type database.
 
1621
update_types(Expr, Pat, #sub{t=Tdb0}=Sub) ->
 
1622
    Tdb = update_types_1(Expr, Pat, Tdb0),
 
1623
    Sub#sub{t=Tdb}.
 
1624
 
 
1625
update_types_1(#c_var{name=V}, [#c_tuple{}=P], Types) ->
1212
1626
    orddict:store(V, P, Types);
1213
 
update_types(_, _, Types) -> Types.
 
1627
update_types_1(_, _, Types) -> Types.
1214
1628
 
1215
1629
%% update_types(V, Tdb) -> Tdb'
1216
1630
%%  Kill any entries that references the variable,
1217
1631
%%  either in the key or in the value.
1218
1632
kill_types(V, [{V,_}|Tdb]) ->
1219
1633
    kill_types(V, Tdb);
1220
 
kill_types(V, [{_,#c_tuple{es=Vars}}=Entry|Tdb]) ->
1221
 
    case v_is_value(V, Vars) of
1222
 
        true -> kill_types(V, Tdb);
1223
 
        false -> [Entry|kill_types(V, Tdb)]
 
1634
kill_types(V, [{_,#c_tuple{}=Tuple}=Entry|Tdb]) ->
 
1635
    case core_lib:is_var_used(V, Tuple) of
 
1636
        false -> [Entry|kill_types(V, Tdb)];
 
1637
        true -> kill_types(V, Tdb)
1224
1638
    end;
1225
1639
kill_types(_, []) -> [].
 
1640
 
 
1641
%%%
 
1642
%%% Handling of warnings.
 
1643
%%%
 
1644
 
 
1645
init_warnings() ->
 
1646
    put({?MODULE,warnings}, []).
 
1647
 
 
1648
add_warning(Core, Term) ->
 
1649
    Anno = core_lib:get_anno(Core),
 
1650
    case lists:member(compiler_generated, Anno) of
 
1651
        true -> ok;
 
1652
        false ->
 
1653
            case get_line(Anno) of
 
1654
                Line when Line >= 0 ->          %Must be positive.
 
1655
                    File = get_file(Anno),
 
1656
                    Key = {?MODULE,warnings},
 
1657
                    Ws = get(Key),
 
1658
                    put(Key, [{File,[{Line,?MODULE,Term}]}|Ws]);
 
1659
                _ -> ok                         %Compiler-generated code.
 
1660
            end
 
1661
    end.
 
1662
 
 
1663
get_line([Line|_]) when is_integer(Line) -> Line;
 
1664
get_line([_|T]) -> get_line(T);
 
1665
get_line([]) -> none.
 
1666
 
 
1667
get_file([{file,File}|_]) -> File;
 
1668
get_file([_|T]) -> get_file(T);
 
1669
get_file([]) -> "no_file". % should not happen
 
1670
 
 
1671
is_compiler_generated(Core) ->
 
1672
    Anno = core_lib:get_anno(Core),
 
1673
    case lists:member(compiler_generated, Anno) of
 
1674
        true -> true;
 
1675
        false ->
 
1676
            case get_line(Anno) of
 
1677
                Line when Line >= 0 -> false;
 
1678
                _ -> true
 
1679
            end
 
1680
    end.
 
1681
 
 
1682
get_warnings() ->
 
1683
    ordsets:from_list((erase({?MODULE,warnings}))).
 
1684
 
 
1685
format_error({eval_failure,Reason}) ->
 
1686
    lists:flatten(io_lib:format("this expression would cause a '~p' exception at run-time",
 
1687
                                [Reason]));
 
1688
format_error({nomatch_shadow,Line}) ->
 
1689
    M = io_lib:format("this clause cannot match because a previous clause at line ~p "
 
1690
                      "always matches", [Line]),
 
1691
    lists:flatten(M);
 
1692
format_error(nomatch_shadow) ->
 
1693
    "this clause cannot match because a previous clause always matches";
 
1694
format_error(nomatch_guard) ->
 
1695
    "the guard for this clause evaluates to 'false'";
 
1696
format_error(no_clause_match) ->
 
1697
    "no clause will ever match";
 
1698
format_error(no_match_clause_type) ->
 
1699
    "this clause cannot match because of different types/sizes".
 
1700
 
 
1701
-ifdef(DEBUG).
 
1702
%% In order for simplify_let/2 to work correctly, the list of
 
1703
%% in-scope variables must always be a superset of the free variables
 
1704
%% in the current expression (otherwise we might fail to rename a variable
 
1705
%% when needed and get a name capture bug).
 
1706
 
 
1707
verify_scope(E, #sub{s=Scope}) ->
 
1708
    Free = core_lib:free_vars(E),
 
1709
    case ordsets:is_subset(core_lib:free_vars(E), gb_sets:to_list(Scope)) of
 
1710
        true -> true;
 
1711
        false ->
 
1712
            io:format("~p\n", [E]),
 
1713
            io:format("~p\n", [Free]),
 
1714
            io:format("~p\n", [gb_sets:to_list(Scope)]),
 
1715
            false
 
1716
    end.
 
1717
-endif.