aboutsummaryrefslogblamecommitdiffstats
path: root/lib/compiler/src/cerl_inline.erl
blob: cbcacf9e8e799f3285c4b9d3dcb391828eb1c3bf (plain) (tree)
1
2
3
4
5
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826

                   
  
                                                        
  










                                                                           
  



























                                                                        
                                                                         







                                                                     
                                                                           
                                                                  









                                                                        
                                               
                                                   


                                                            
 






























































                                                                        

                                                                 







































































                                                                        


                                                                     

































































































































                                                                        

                                                







































































































                                                                        

                                  


                                                                       


                                                   































































































































































































































































































































































































































































































































































































                                                                           



                                                                              

                                                             




                                                  






















































































                                                                        

                                              











                                                                        


                  






































































































































                                                                        
                               
                                                       
                                                         











                                                                      




















                                                                         

























                                                                      
                              
                                    
                                                  




                                               
 




                                                        
                        

                                             

 


























































                                                                        

                                             
                                                                      
                                   
                                             
                                                  
































                                                                        

                                                                  


                                                                     
                                                     

                                             
 

































                                                                        
                                                                    
                                                                       










                                                                     

                                                          
                                                     


                                                                          
                                            











































































































                                                                        
                                                 
















































                                                                       





                                                                               














                                                                       





















                                                                               













                                                                        




                                                            















                                                                        

                                                     
                                                        


                                                      


                                                                     
                                         
























                                                                        

                                                    
                                              


                                             











                                                                        
                                  













































































































































































































































































































































































































































































































































































































































































                                                                              












                                                                      
























































































































































































































































































































































                                                                        
%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2001-2012. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%%     http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
%% %CopyrightEnd%
%%
%% Core Erlang inliner.

%% =====================================================================
%%
%% This is an implementation of the algorithm by Waddell and Dybvig
%% ("Fast and Effective Procedure Inlining", International Static
%% Analysis Symposium 1997), adapted to the Core Erlang language.
%%
%% Instead of always renaming variables and function variables, this
%% implementation uses the "no-shadowing strategy" of Peyton Jones and
%% Marlow ("Secrets of the Glasgow Haskell Compiler Inliner", 1999).
%%
%% =====================================================================

%% TODO: inline single-source-reference operands without size limit.

-module(cerl_inline).

-export([core_transform/2, transform/1, transform/2]).

-import(cerl, [abstract/1, alias_pat/1, alias_var/1, apply_args/1,
	       apply_op/1, atom_name/1, atom_val/1, bitstr_val/1,
	       bitstr_size/1, bitstr_unit/1, bitstr_type/1,
	       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, 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,
	       c_values/1, c_var/1, call_args/1, call_module/1,
	       call_name/1, case_arity/1, case_arg/1, case_clauses/1,
	       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,
	       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,
	       let_body/1, let_vars/1, letrec_body/1, letrec_defs/1,
	       list_length/1, list_elements/1, update_data/3,
	       make_list/1, make_data_skel/2, module_attrs/1,
	       module_defs/1, module_exports/1, module_name/1,
	       primop_args/1, primop_name/1, receive_action/1,
	       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,
	       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]).

%%
%% Constants
%%

debug_runtime() -> false.
debug_counters() -> false.

%% Normal execution times for inlining are between 0.1 and 0.3 seconds
%% (on the author's current equipment). The default effort limit of 150
%% is high enough that most normal programs never hit the limit even
%% once, and for difficult programs, it generally keeps the execution
%% times below 2-5 seconds. Using an effort counter of 1000 will thus
%% have no further effect on most programs, but some programs may take
%% as much as 10 seconds or more. Effort counts larger than 2500 have
%% never been observed even on very ill-conditioned programs.
%%
%% Size limits between 6 and 18 tend to actually shrink the code,
%% because of the simplifications made possible by inlining. A limit of
%% 16 seems to be optimal for this purpose, often shrinking the
%% executable code by up to 10%. Size limits between 18 and 30 generally
%% give the same code size as if no inlining was done (i.e., code
%% duplication balances out the simplifications at these levels). A size
%% limit between 1 and 5 tends to inline small functions and propagate
%% constants, but does not cause much simplifications do be done, so the
%% net effect will be a slight increase in code size. For size limits
%% above 30, the executable code size tends to increase with about 10%
%% per 100 units, with some variations depending on the sizes of
%% functions in the source code.
%%
%% Typically, about 90% of the maximum speedup achievable is already
%% reached using a size limit of 30, and 98% is reached at limits around
%% 100-150; there is rarely any point in letting the code size increase
%% by more than 10-15%. If too large functions are inlined, cache
%% effects will slow the program down.

default_effort() -> 150.
default_size() -> 24.
default_unroll() -> 1.

%% Base costs/weights for different kinds of expressions. If these are
%% modified, the size limits above may have to be adjusted.

weight(var) -> 0;	% We count no cost for variable accesses.
weight(values) -> 0;	% Value aggregates have no cost in themselves.
weight(literal) -> 1;	% We assume efficient handling of constants.
weight(data) -> 1;	% Base cost; add 1 per element.
weight(element) -> 1;   % Cost of storing/fetching an element.
weight(argument) -> 1;  % Cost of passing a function argument.
weight('fun') -> 6;	% Base cost + average number of free vars.
weight('let') -> 0;	% Count no cost for let-bindings.
weight(letrec) -> 0;    % Like a let-binding.
weight('case') -> 0;	% Case switches have no base cost.
weight(clause) -> 1;    % Count one jump at the end of each clause body.
weight('receive') -> 9;	% Initialization/cleanup cost.
weight('try') -> 1;	% Assume efficient implementation.
weight('catch') -> 1;	% See `try'.
weight(apply) -> 3;     % Average base cost: call/return.
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
%% variables. They keep track of the variable name, any bound operand,
%% and the associated store location.

-record(ref, {name, opnd, loc}).

%% Operand structures contain the operand expression, the renaming and
%% environment, the state location, and the effort counter at the call
%% site (cf. `visit').

-record(opnd, {expr, ren, env, loc, effort}).

%% Since expressions are only visited in `effect' context when they are
%% not bound to a referenced variable, only expressions visited in
%% 'value' context are cached.

-record(cache, {expr, size}).

%% The context flags for an application structure are kept separate from
%% the structure itself. Note that the original algorithm had exactly
%% one operand in each application context structure, while we can have
%% several, or none.

-record(app, {opnds, ctxt, loc}).


%%
%% Interface functions
%%

%% Use compile option `{core_transform, inline}' to insert this as a
%% compilation pass.

-spec core_transform(cerl:cerl(), [compile:option()]) -> cerl:cerl().

core_transform(Code, Opts) ->
    cerl:to_records(transform(cerl:from_records(Code), Opts)).

-spec transform(cerl:cerl()) -> cerl:cerl().

transform(Tree) ->
    transform(Tree, []).

-spec transform(cerl:cerl(), [compile:option()]) -> cerl:cerl().

transform(Tree, Opts) ->
    main(Tree, value, Opts).

main(Tree, Ctxt, Opts) ->
    %% We spawn a new process to do the work, so we don't have to worry
    %% about cluttering the process dictionary with debugging info, or
    %% proper deallocation of ets-tables.
    Opts1 = Opts ++ [{inline_size, default_size()},
		     {inline_effort, default_effort()},
		     {inline_unroll, default_unroll()}],
    Reply = self(),
    Pid = spawn_link(fun () -> start(Reply, Tree, Ctxt, Opts1) end),
    receive
        {Pid, Tree1} -> Tree1
    end.

start(Reply, Tree, Ctxt, Opts) ->
    init_debug(),
    case debug_runtime() of
        %% true ->
        %%     put(inline_start_time,
        %%         element(1, erlang:statistics(runtime)));
        false ->
            ok
    end,
    Size = erlang:max(1, proplists:get_value(inline_size, Opts)),
    Effort = erlang:max(1, proplists:get_value(inline_effort, Opts)),
    Unroll = erlang:max(1, proplists:get_value(inline_unroll, Opts)),
    case proplists:get_bool(verbose, Opts) of
	true ->
	    io:fwrite("Inlining: inline_size=~w inline_effort=~w\n",
		      [Size, Effort]);
	false ->
	    ok
    end,

    %% Note that the counters of the new state are passive.
    S = st__new(Effort, Size, Unroll),

%%% Initialization is not needed at present. Note that the code in
%%% `inline_init' is not up-to-date with this module.
%%%     {Tree1, S1} = inline_init:init(Tree, S),
%%%     {Tree2, _S2} = i(Tree1, Ctxt, S1),
    {Tree2, _S2} = i(Tree, Ctxt, S),
    report_debug(),
    Reply ! {self(), Tree2}.

init_debug() ->
    case debug_counters() of
        %% true ->
        %%     put(counter_effort_triggers, 0),
        %%     put(counter_effort_max, 0),
        %%     put(counter_size_triggers, 0),
        %%     put(counter_size_max, 0);
        false ->
            ok
    end.

report_debug() ->
    case debug_runtime() of
        %% true ->
        %%     {Time, _} = erlang:statistics(runtime),
        %%     report("Total run time for inlining: ~.2.0f s.\n",
	%% 	   [(Time - get(inline_start_time))/1000]);
        false ->
            ok
    end,
    case debug_counters() of
        %% true ->
        %%     counter_stats();
        false ->
            ok
    end.

%% counter_stats() ->
%%     T1 = get(counter_effort_triggers),
%%     T2 = get(counter_size_triggers),
%%     E = get(counter_effort_max),
%%     S = get(counter_size_max),
%%     M1 = io_lib:fwrite("\tNumber of triggered "
%%                        "effort counters: ~p.\n", [T1]),
%%     M2 = io_lib:fwrite("\tNumber of triggered "
%%                        "size counters: ~p.\n", [T2]),
%%     M3 = io_lib:fwrite("\tLargest active effort counter: ~p.\n",
%%                        [E]),
%%     M4 = io_lib:fwrite("\tLargest active size counter: ~p.\n",
%%                        [S]),
%%     report("Counter statistics:\n~s", [[M1, M2, M3, M4]]).


%% =====================================================================
%% The main inlining function
%%
%% i(E :: coreErlang(),
%%   Ctxt :: value | effect | #app{}
%%   Ren :: renaming(),
%%   Env :: environment(),
%%   S :: state())
%%   -> {E', S'}
%%
%% Note: It is expected that the input source code ('E') does not
%% contain free variables. If it does, there is a risk of accidental
%% name capture, in case a generated "new" variable name happens to be
%% the same as the name of a variable that is free further below in the
%% tree; the algorithm only consults the current environment to check if
%% a name already exists.
%%
%% The renaming maps names of source-code variable and function
%% variables to new names as necessary to avoid clashes, according to
%% the "no-shadowing" strategy. The environment maps *residual-code*
%% variables and function variables to operands and global information.
%% Separating the renaming from the environment, and using the
%% residual-code variables instead of the source-code variables as its
%% domain, improves the behaviour of the algorithm when code needs to be
%% traversed more than once.
%%
%% Note that there is no such thing as a `test' context for expressions
%% in (Core) Erlang (see `i_case' below for details).

i(E, Ctxt, S) ->
    i(E, Ctxt, ren__identity(), env__empty(), S).

i(E, Ctxt, Ren, Env, S0) ->
    %% Count one unit of effort on each pass.
    S = count_effort(1, S0),
    case is_data(E) of
        true ->
            i_data(E, Ctxt, Ren, Env, S);
        false ->
            case type(E) of
                var ->
                    i_var(E, Ctxt, Ren, Env, S);
                values ->
                    i_values(E, Ctxt, Ren, Env, S);
                'fun' ->
                    i_fun(E, Ctxt, Ren, Env, S);
                seq ->
                    i_seq(E, Ctxt, Ren, Env, S);
                'let' ->
                    i_let(E, Ctxt, Ren, Env, S);
                letrec ->
                    i_letrec(E, Ctxt, Ren, Env, S);
                'case' ->
                    i_case(E, Ctxt, Ren, Env, S);
                'receive' ->
                    i_receive(E, Ctxt, Ren, Env, S);
                apply ->
                    i_apply(E, Ctxt, Ren, Env, S);
                call ->
                    i_call(E, Ctxt, Ren, Env, S);
                primop ->
                    i_primop(E, Ren, Env, S);
                'try' ->
                    i_try(E, Ctxt, Ren, Env, S);
                'catch' ->
                    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
    end.

i_data(E, Ctxt, Ren, Env, S) ->
    case is_literal(E) of
        true ->
            %% This is the `(const c)' case of the original algorithm:
            %% literal terms which (regardless of size) do not need to
            %% be constructed dynamically at runtime - boldly assuming
            %% that the compiler/runtime system can handle this.
            case Ctxt of
                effect ->
                    %% Reduce useless constants to a simple value.
                    {void(), count_size(weight(literal), S)};
                _ ->
                    %% (In Erlang, we cannot set all non-`false'
                    %% constants to `true' in a `test' context, like we
                    %% could do in Lisp or C, so the above is the only
                    %% special case to be handled here.)
                    {E, count_size(weight(literal), S)}
            end;
        false ->
            %% Data constructors are like to calls to safe built-in
            %% functions, for which we can "decide to inline"
            %% immediately; there is no need to create operand
            %% structures. In `effect' context, we can simply make a
            %% sequence of the argument expressions, also visited in
            %% `effect' context. In all other cases, the arguments are
            %% visited for value.
            case Ctxt of
                effect ->
                    %% Note that this will count the sizes of the
                    %% subexpressions, even though some or all of them
                    %% might be discarded by the sequencing afterwards.
                    {Es1, S1} = mapfoldl(fun (E, S) ->
						 i(E, effect, Ren, Env,
						   S)
					 end,
					 S, data_es(E)),
                    E1 = foldl(fun (E1, E2) -> make_seq(E1, E2) end,
			       void(), Es1),
                    {E1, S1};
                _ ->
                    {Es1, S1} = mapfoldl(fun (E, S) ->
						 i(E, value, Ren, Env,
						   S)
					 end,
					 S, data_es(E)),
                    %% The total size/cost is the base cost for a data
                    %% constructor plus the cost for storing each
                    %% element.
                    N = weight(data) + length(Es1) * weight(element),
                    S2 = count_size(N, S1),
                    {update_data(E, data_type(E), Es1), S2}
            end
    end.

%% This is the `(ref x)' (variable use) case of the original algorithm.
%% Note that binding occurrences are always handled in the respective
%% cases of the binding constructs.

i_var(E, Ctxt, Ren, Env, S) ->
    case Ctxt of
        effect ->
            %% Reduce useless variable references to a simple constant.
	    %% This also avoids useless visiting of bound operands.
            {void(), count_size(weight(literal), S)};
        _ ->
	    Name = var_name(E),
            case env__lookup(ren__map(Name, Ren), Env) of
                {ok, R} ->
                    case R#ref.opnd of
                        undefined ->
                            %% The variable is not associated with an
                            %% argument expression; just residualize it.
                            residualize_var(R, S);
                        Opnd ->
			    i_var_1(R, Opnd, Ctxt, Env, S)
                    end;
                error ->
                    %% The variable is unbound. (It has not been
                    %% accidentally captured, however, or it would have
                    %% been in the environment.) We leave it as it is,
                    %% without any warning.
		    {E, count_size(weight(var), S)}
            end
    end.

%% This first visits the bound operand and then does copy propagation.
%% Note that we must first set the "inner-pending" flag, and clear the
%% flag afterwards.

i_var_1(R, Opnd, Ctxt, Env, S) ->
    %% If the operand is already "inner-pending", it is residualised.
    %% (In Lisp/C, if the variable might be assigned to, it should also
    %% be residualised.)
    L = Opnd#opnd.loc,
    case st__test_inner_pending(L, S) of
	true ->
	    residualize_var(R, S);
	false ->
	    S1 = st__mark_inner_pending(L, S),
	    try visit(Opnd, S1) of
		{E, S2} ->
		    %% Note that we pass the current environment and
		    %% context to `copy', but not the current renaming.
		    S3 = st__clear_inner_pending(L, S2),
		    copy(R, Opnd, E, Ctxt, Env, S3)
	    catch
		throw:X ->
 		    %% If we use destructive update for the
 		    %% `inner-pending' flag, we must make sure to clear
 		    %% it also if we make a nonlocal return.
		    _S2 = st__clear_inner_pending(Opnd#opnd.loc, S1),
		    throw(X)
	    end
    end.

%% A multiple-value aggregate `<e1, ..., en>'. This is very much like a
%% tuple data constructor `{e1, ..., en}'; cf. `i_data' for details.

i_values(E, Ctxt, Ren, Env, S) ->
    case values_es(E) of
	[E1] ->
	    %% Single-value aggregates can be dropped; they are simply
	    %% notation.
	    i(E1, Ctxt, Ren, Env, S);
	Es ->
	    %% In `effect' context, we can simply make a sequence of the
	    %% argument expressions, also visited in `effect' context.
	    %% In all other cases, the arguments are visited for value.
	    case Ctxt of
		effect ->
		    {Es1, S1} =
			mapfoldl(fun (E, S) ->
					 i(E, effect, Ren, Env, S)
				 end,
				 S, Es),
		    E1 = foldl(fun (E1, E2) ->
				       make_seq(E1, E2)
			       end,
			       void(), Es1),
		    {E1, S1};    % drop annotations on E
		_ ->
		    {Es1, S1} = mapfoldl(fun (E, S) ->
						 i(E, value, Ren, Env,
						   S)
					 end,
					 S, Es),
		    %% Aggregating values does not write them to memory,
		    %% so we count no extra cost per element.
		    S2 = count_size(weight(values), S1),
		    {update_c_values(E, Es1), S2}
	    end
    end.

%% A let-expression `let <v1,...,vn> = e0 in e1' is semantically
%% equivalent to a case-expression `case e0 of <v1,...,vn> when 'true'
%% -> e1 end'. As a special case, `let <v> = e0 in e1' is also
%% equivalent to `apply fun (v) -> e0 (e1)'. However, for efficiency,
%% and in order to allow the handling of `case' clauses to introduce new
%% let-expressions without entering an infinite rewrite loop, we handle
%% these directly.

%%% %% Rewriting a `let' to an equivalent expression.
%%% i_let(E, Ctxt, Ren, Env, S) ->
%%%     case let_vars(E) of
%%% 	[V] ->
%%%  	    E1 = update_c_apply(E, c_fun([V], let_body(E)), [let_arg(E)]),
%%%  	    i(E1, Ctxt, Ren, Env, S);
%%% 	Vs ->
%%%  	    C = c_clause(Vs, abstract(true), let_body(E)),
%%%  	    E1 = update_c_case(E, let_arg(E), [C]),
%%%  	    i(E1, Ctxt, Ren, Env, S)
%%%     end.

i_let(E, Ctxt, Ren, Env, S) ->
    case let_vars(E) of
 	[V] ->
 	    i_let_1(V, E, Ctxt, Ren, Env, S);
	Vs ->
	    %% Visit the argument expression in `value' context, to
	    %% simplify it as far as possible.
	    {A, S1} = i(let_arg(E), value, Ren, Env, S),
	    case get_components(length(Vs), result(A)) of
		{true, As} ->
		    %% Note that only the components of the result of
		    %% `A' are passed on; any effects are hoisted.
		    {E1, S2} = i_let_2(Vs, As, E, Ctxt, Ren, Env, S1),
		    {hoist_effects(A, E1), S2};
		false ->
		    %% We cannot do anything with this `let', since the
		    %% variables cannot be matched against the argument
		    %% components. Just visit the variables for renaming
		    %% and visit the body for value (cf. `i_fun').
		    {_, Ren1, Env1, S2} = bind_locals(Vs, Ren, Env, S1),
		    Vs1 = i_params(Vs, Ren1, Env1),
		    %% The body is always visited for value here.
		    {B, S3} = i(let_body(E), value, Ren1, Env1, S2),
		    S4 = count_size(weight('let'), S3),
		    {update_c_let(E, Vs1, A, B), S4}
	    end
    end.

%% Single-variable `let' binding.

i_let_1(V, E, Ctxt, Ren, Env, S) ->
    %% Make an operand structure for the argument expression, create a
    %% local binding from the parameter to the operand structure, and
    %% visit the body. Finally create necessary bindings and/or set
    %% flags.
    {Opnd, S1} = make_opnd(let_arg(E), Ren, Env, S),
    {[R], Ren1, Env1, S2} = bind_locals([V], [Opnd], Ren, Env, S1),
    {E1, S3} = i(let_body(E), Ctxt, Ren1, Env1, S2),
    i_let_3([R], [Opnd], E1, S3).

%% Multi-variable `let' binding.

i_let_2(Vs, As, E, Ctxt, Ren, Env, S) ->
    %% Make operand structures for the argument components. Note that
    %% since the argument has already been visited at this point, we use
    %% the identity renaming for the operands.
    {Opnds, S1} = mapfoldl(fun (E, S) ->
                                   make_opnd(E, ren__identity(), Env, S)
                           end,
                           S, As),
    %% Create local bindings from the parameters to their respective
    %% operand structures, and visit the body.
    {Rs, Ren1, Env1, S2} = bind_locals(Vs, Opnds, Ren, Env, S1),
    {E1, S3} = i(let_body(E), Ctxt, Ren1, Env1, S2),
    i_let_3(Rs, Opnds, E1, S3).

i_let_3(Rs, Opnds, E, S) ->
    %% Create necessary bindings and/or set flags.
    {E1, S1} = make_let_bindings(Rs, E, S),
    
    %% We must also create evaluation for effect, for any unused
    %% operands, as after an application expression.
    residualize_operands(Opnds, E1, S1).

%% A sequence `do e1 e2', written `(seq e1 e2)' in the original
%% algorithm, where `e1' is evaluated for effect only (since its value
%% is not used), and `e2' yields the final value. Note that we use
%% `make_seq' to recompose the sequence after visiting the parts.

i_seq(E, Ctxt, Ren, Env, S) ->
    {E1, S1} = i(seq_arg(E), effect, Ren, Env, S),
    {E2, S2} = i(seq_body(E), Ctxt, Ren, Env, S1),
    %% A sequence has no cost in itself.
    {make_seq(E1, E2), S2}.


%% The `case' switch of Core Erlang is rather different from the boolean
%% `(if e1 e2 e3)' case of the original algorithm, but the central idea
%% is the same: if, given the simplified switch expression (which is
%% visited in `value' context - a boolean `test' context would not be
%% generally useful), there is a clause which could definitely be
%% selected, such that no clause before it can possibly be selected,
%% then we can eliminate all other clauses. (And even if this is not the
%% case, some clauses can often be eliminated.) Furthermore, if a clause
%% can be selected, we can replace the case-expression (including the
%% switch expression) with the body of the clause and a set of zero or
%% more let-bindings of subexpressions of the switch expression. (In the
%% simplest case, the switch expression is evaluated only for effect.)

i_case(E, Ctxt, Ren, Env, S) ->
    %% First visit the switch expression in `value' context, to simplify
    %% it as far as possible. Note that only the result part is passed
    %% on to the clause matching below; any effects are hoisted.
    {A, S1} = i(case_arg(E), value, Ren, Env, S),
    A1 = result(A),

    %% Propagating an application context into the branches could cause
    %% the arguments of the application to be evaluated *after* the
    %% switch expression, but *before* the body of the selected clause.
    %% Such interleaving is not allowed in general, and it does not seem
    %% worthwile to make a more powerful transformation here. Therefore,
    %% the clause bodies are conservatively visited for value if the
    %% context is `application'.
    Ctxt1 = safe_context(Ctxt),
    {E1, S2} = case get_components(case_arity(E), A1) of
		   {true, As} ->
		       i_case_1(As, E, Ctxt1, Ren, Env, S1);
		   false ->
		       i_case_1([], E, Ctxt1, Ren, Env, S1)
	       end,
    {hoist_effects(A, E1), S2}.

i_case_1(As, E, Ctxt, Ren, Env, S) ->
    case i_clauses(As, case_clauses(E), Ctxt, Ren, Env, S) of
        {false, {As1, Vs, Env1, Cs}, S1} ->
            %% We still have a list of clauses. Sanity check:
            if Cs =:= [] ->
                    report_warning("empty list of clauses "
				   "in residual program!.\n");
               true ->
                    ok
            end,
	    {A, S2} = i(c_values(As1), value, ren__identity(), Env1,
			S1),
	    {E1, S3} = i_case_2(Cs, A, E, S2),
	    i_case_3(Vs, Env1, E1, S3);
        {true, {_, Vs, Env1, [C]}, S1} ->
            %% A single clause was selected; we just take the body.
	    i_case_3(Vs, Env1, clause_body(C), S1)
    end.

%% Check if all clause bodies are actually equivalent expressions that
%% do not depent on pattern variables (this sometimes occurs as a
%% consequence of inlining, e.g., all branches might yield 'true'), and
%% if so, replace the `case' with a sequence, first evaluating the
%% clause selection for effect, then evaluating one of the clause bodies
%% for its value. (Unless the switch contains a catch-all clause, the
%% clause selection must be evaluated for effect, since there is no
%% guarantee that any of the clauses will actually match. Assuming that
%% some clause always matches could make an undefined program produce a
%% value.) This makes the final size less than what was accounted for
%% when visiting the clauses, but currently we don't try to adjust for
%% this.

i_case_2(Cs, A, E, S) ->
    case equivalent_clauses(Cs) of
	false ->
	    %% Count the base sizes for the remaining clauses; pattern
	    %% and guard sizes are already counted.
	    N = weight('case') + weight(clause) * length(Cs),
	    S1 = count_size(N, S),
	    {update_c_case(E, A, Cs), S1};
	true ->
	    case cerl_clauses:any_catchall(Cs) of
		true ->
		    %% We know that some clause must be selected, so we
		    %% can drop all the testing as well.
		    E1 = make_seq(A, clause_body(hd(Cs))),
		    {E1, S};
		false ->
		    %% The clause selection must be performed for
		    %% effect.
		    E1 = update_c_case(E, A,
				       set_clause_bodies(Cs, void())),
		    {make_seq(E1, clause_body(hd(Cs))), S}
	    end
    end.

i_case_3(Vs, Env, E, S) ->
    %% For the variables bound to the switch expression subexpressions,
    %% make let bindings or create evaluation for effect.
    Rs = [env__get(var_name(V), Env) || V <- Vs],
    {E1, S1} = make_let_bindings(Rs, E, S),
    Opnds = [R#ref.opnd || R <- Rs],
    residualize_operands(Opnds, E1, S1).

%% This function takes a sequence of switch expressions `Es' (which can
%% be the empty list if these are unknown) and a list `Cs' of clauses,
%% and returns `{Match, {As, Vs, Env1, Cs1}, S1}' where `As' is a list
%% of residual switch expressions, `Vs' the list of variables used in
%% the templates, `Env1' the environment for the templates, and `Cs1'
%% the list of residual clauses. `Match' is `true' if some clause could
%% be shown to definitely match (in this case, `Cs1' contains exactly
%% one element), and `false' otherwise. `S1' is the new state. The given
%% `Ctxt' is the context to be used for visiting the body of clauses.
%%
%% Visiting a clause basically amounts to extending the environment for
%% all variables in the pattern, as for a `fun' (cf. `i_fun'),
%% propagating match information if possible, and visiting the guard and
%% body in the new environment.
%%
%% To make it cheaper to do handle a set of clauses, and to avoid
%% unnecessarily exceeding the size limit, we avoid visiting the bodies
%% of clauses which are subsequently removed, by dividing the visiting
%% of a clause into two stages: first construct the environment(s) and
%% visit the pattern (for renaming) and the guard (for value), then
%% reduce the switch as much as possible, and lastly visit the body.

i_clauses(Cs, Ctxt, Ren, Env, S) ->
    i_clauses([], Cs, Ctxt, Ren, Env, S).

i_clauses(Es, Cs, Ctxt, Ren, Env, S) ->
    %% Create templates for the switch expressions.
    {Ts, {Vs, Env0}} = mapfoldl(fun (E, {Vs, Env}) ->
					{T, Vs1, Env1} =
					    make_template(E, Env),
					{T, {Vs1 ++ Vs, Env1}}
				end,
				{[], Env}, Es),
    
    %% Make operand structures for the switch subexpression templates
    %% (found in `Env0') and add proper ref-structure bindings to the
    %% environment. Since the subexpressions in general can be
    %% interdependent (Vs is in reverse-dependency order), the
    %% environment (and renaming) must be created incrementally. Note
    %% that since the switch expressions have been visited already, the
    %% identity renaming is used for the operands.
    Vs1 = lists:reverse(Vs),
    {Ren1, Env1, S1} =
	foldl(fun (V, {Ren, Env, S}) ->
		      E = env__get(var_name(V), Env0),
		      {Opnd, S_1} = make_opnd(E, ren__identity(), Env,
					      S),
		      {_, Ren1, Env1, S_2} = bind_locals([V], [Opnd],
							 Ren, Env, S_1),
		      {Ren1, Env1, S_2}
	      end,
	      {Ren, Env, S}, Vs1),
    
    %% First we visit the head of each individual clause, renaming
    %% pattern variables, inserting let-bindings in the guard and body,
    %% and visiting the guard. The information used for visiting the
    %% clause body will be prefixed to the clause annotations.
    {Cs1, S2} = mapfoldl(fun (C, S) ->
				 i_clause_head(C, Ts, Ren1, Env1, S)
			 end,
			 S1, Cs),
    
    %% Now that the clause guards have been reduced as far as possible,
    %% we can attempt to reduce the clauses.
    As = [hd(get_ann(T)) || T <- Ts],
    case cerl_clauses:reduce(Cs1, Ts) of
        {false, Cs2} ->
            %% We still have one or more clauses (with associated
            %% extended environments). Their bodies have not yet been
            %% visited, so we do that (in the respective safe
            %% environments, adding the sizes of the visited heads to
            %% the current size counter) and return the final list of
            %% clauses.
            {Cs3, S3} = mapfoldl(
                          fun (C, S) ->
                                  i_clause_body(C, Ctxt, S)
                          end,
                          S2, Cs2),
            {false, {As, Vs1, Env1, Cs3}, S3};
        {true, {C, _}} ->
            %% A clause C could be selected (the bindings have already
            %% been added to the guard/body). Note that since the clause
            %% head will probably be discarded, its size is not counted.
	    {C1, Ren2, Env2, _} = get_clause_extras(C),
	    {B, S3} = i(clause_body(C), Ctxt, Ren2, Env2, S2),
	    C2 = update_c_clause(C1, clause_pats(C1), clause_guard(C1), B),
	    {true, {As, Vs1, Env1, [C2]}, S3}
    end.

%% This visits the head of a clause, renames pattern variables, inserts
%% let-bindings in the guard and body, and does inlining on the guard
%% expression. Returns a list of pairs `{NewClause, Data}', where `Data'
%% is `{Renaming, Environment, Size}' used for visiting the body of the
%% new clause.

i_clause_head(C, Ts, Ren, Env, S) ->
    %% Match the templates against the (non-renamed) patterns to get the
    %% available information about matching subexpressions. We don't
    %% care at this point whether an exact match/nomatch is detected.
    Ps = clause_pats(C),
    Bs = case cerl_clauses:match_list(Ps, Ts) of
	     {_, Bs1} -> Bs1;
	     none -> []
	 end,

    %% The patterns must be visited for renaming; cf. `i_pattern'. We
    %% use a passive size counter for visiting the patterns and the
    %% guard (cf. `visit'), because we do not know at this stage whether
    %% the clause will be kept or not; the final value of the counter is
    %% included in the returned value below.
    {_, Ren1, Env1, S1} = bind_locals(clause_vars(C), Ren, Env, S),
    S2 = new_passive_size(get_size_limit(S1), S1),
    {Ps1, S3} = mapfoldl(fun (P, S) ->
				 i_pattern(P, Ren1, Env1, Ren, Env, S)
			 end,
			 S2, Ps),
    
    %% Rewrite guard and body and visit the guard for value. Discard the
    %% latter size count if the guard turns out to be a constant.
    G = add_match_bindings(Bs, clause_guard(C)),
    B = add_match_bindings(Bs, clause_body(C)),
    {G1, S4} = i(G, value, Ren1, Env1, S3),
    S5 = case is_literal(G1) of
	     true ->
		 revert_size(S3, S4);
	     false ->
		 S4
	 end,

    %% Revert to the size counter we had on entry to this function. The
    %% environment and renaming, together with the size of the clause
    %% head, are prefixed to the annotations for later use.
    Size = get_size_value(S5),
    C1 = update_c_clause(C, Ps1, G1, B),
    {set_clause_extras(C1, Ren1, Env1, Size), revert_size(S, S5)}.

add_match_bindings(Bs, E) ->
    %% Don't waste time if the variables definitely cannot be used.
    %% (Most guards are simply `true'.)
    case is_literal(E) of
	true ->
	    E;
	false ->
	    Vs = [V || {V, E} <- Bs, E =/= any],
	    Es = [hd(get_ann(E)) || {_V, E} <- Bs, E =/= any],
	    c_let(Vs, c_values(Es), E)
    end.

i_clause_body(C0, Ctxt, S) ->
    {C, Ren, Env, Size} = get_clause_extras(C0),
    S1 = count_size(Size, S),
    {B, S2} = i(clause_body(C), Ctxt, Ren, Env, S1),
    C1 = update_c_clause(C, clause_pats(C), clause_guard(C), B),
    {C1, S2}.

get_clause_extras(C) ->
    [{Ren, Env, Size} | As] = get_ann(C),
    {set_ann(C, As), Ren, Env, Size}.

set_clause_extras(C, Ren, Env, Size) ->
    As = [{Ren, Env, Size} | get_ann(C)],
    set_ann(C, As).

%% This is the `(lambda x e)' case of the original algorithm. A
%% `fun' is like a lambda expression, but with a varying number of
%% parameters; possibly zero.

i_fun(E, Ctxt, Ren, Env, S) ->
    case Ctxt of
        effect ->
            %% Reduce useless `fun' expressions to a simple constant;
	    %% visiting the body would be a waste of time, and could
	    %% needlessly mark variables as referenced.
            {void(), count_size(weight(literal), S)};
        value ->
            %% Note that the variables are visited as patterns.
            Vs = fun_vars(E),
            {_, Ren1, Env1, S1} = bind_locals(Vs, Ren, Env, S),
            Vs1 = i_params(Vs, Ren1, Env1),

            %% The body is always visited for value.
            {B, S2} = i(fun_body(E), value, Ren1, Env1, S1),

	    %% We don't bother to include the exact number of free
	    %% variables in the cost for creating a fun-value.
            S3 = count_size(weight('fun'), S2),

	    %% Inlining might have duplicated code, so we must remove
	    %% any 'id'-annotations from the original fun-expression.
	    %% (This forces a later stage to invent new id:s.) This is
	    %% necessary as long as fun:s may still need to be
	    %% identified the old way. Function variables that are not
	    %% in application context also have such annotations, but
	    %% the inlining will currently lose all annotations on
	    %% variable references (I think), so that's not a problem.
            {set_ann(c_fun(Vs1, B), kill_id_anns(get_ann(E))), S3};
        #app{} ->
            %% An application of a fun-expression (in the original
            %% source code) is handled by going directly to `inline'.
            %% This is never residualised unless there is an arity
            %% mismatch, so we don't set up new counters here. Note that
            %% inlining of copy-propagated fun-expressions is done in
            %% `copy'; not here!
            inline(E, Ctxt, Ren, Env, S)
    end.

%% A `letrec' requires a circular environment, but is otherwise like a
%% `let', i.e. like a direct lambda application. Note that only
%% fun-expressions (lambda abstractions) may occur in the right-hand
%% side of each definition.

i_letrec(E, Ctxt, Ren, Env, S) ->
    %% Note that we pass an empty list for the auto-referenced
    %% (exported) functions here.
    {Es, B, _, S1} = i_letrec(letrec_defs(E), letrec_body(E), [], Ctxt,
			      Ren, Env, S),

    %% If no bindings remain, only the body is returned.
    case Es of
        [] ->
            {B, S1};    % drop annotations on E
        _ ->
            S2 = count_size(weight(letrec), S1),
            {update_c_letrec(E, Es, B), S2}
    end.

%% The major part of this is shared by letrec-expressions and module
%% definitions alike.

i_letrec(Es, B, Xs, Ctxt, Ren, Env, S) ->
    %% First, we create operands with dummy renamings and environments,
    %% and with fresh store locations for cached expressions and operand
    %% info.
    {Opnds, S1} = mapfoldl(fun ({_, E}, S) ->
                                   make_opnd(E, undefined, undefined, S)
                           end,
                           S, Es),

    %% Then we make recursive bindings for the definitions.
    {Rs, Ren1, Env1, S2} = bind_recursive([F || {F, _} <- Es],
                                          Opnds, Ren, Env, S1),
    
    %% For the function variables listed in Xs (none for a
    %% letrec-expression), we must make sure that the corresponding
    %% operand expressions are visited and that the definitions are
    %% marked as referenced; we also need to return the possibly renamed
    %% function variables.
    {Xs1, S3} =
        mapfoldl(
          fun (X, S) ->
                  Name = ren__map(var_name(X), Ren1),
                  case env__lookup(Name, Env1) of
                      {ok, R} ->
                          S_1 = i_letrec_export(R, S),
                          {ref_to_var(R), S_1};
                      error ->
                          %% We just skip any exports that are not
                          %% actually defined here, and generate a
                          %% warning message.
                          {N, A} = var_name(X),
                          report_warning("export `~w'/~w "
					 "not defined.\n", [N, A]),
                          {X, S}
                  end
          end,
          S2, Xs),

    %% At last, we can then visit the body.
    {B1, S4} = i(B, Ctxt, Ren1, Env1, S3),

    %% Finally, we create new letrec-bindings for any and all
    %% residualised definitions. All referenced functions should have
    %% been visited; the call to `visit' below is expected to retreive a
    %% cached expression.
    Rs1 = keep_referenced(Rs, S4),
    {Es1, S5} = mapfoldl(fun (R, S) ->
				 {E_1, S_1} = visit(R#ref.opnd, S),
				 {{ref_to_var(R), E_1}, S_1}
			 end,
			 S4, Rs1),
    {Es1, B1, Xs1, S5}.

%% This visits the operand for a function definition exported by a
%% `letrec' (which is really a `module' module definition, since normal
%% letrecs have no export declarations). Only the updated state is
%% returned. We must handle the "inner-pending" flag when doing this;
%% cf. `i_var'.

i_letrec_export(R, S) ->
    Opnd = R#ref.opnd,
    S1 = st__mark_inner_pending(Opnd#opnd.loc, S),
    {_, S2} = visit(Opnd, S1),
    {_, S3} = residualize_var(R, st__clear_inner_pending(Opnd#opnd.loc,
							 S2)),
    S3.

%% This is the `(call e1 e2)' case of the original algorithm. The only
%% difference is that we must handle multiple (or no) operand
%% expressions.

i_apply(E, Ctxt, Ren, Env, S) ->
    {Opnds, S1} = mapfoldl(fun (E, S) ->
                                   make_opnd(E, Ren, Env, S)
                           end,
                           S, apply_args(E)),

    %% Allocate a new app-context location and set up an application
    %% context structure containing the surrounding context.
    {L, S2} = st__new_app_loc(S1),
    Ctxt1 = #app{opnds = Opnds, ctxt = Ctxt, loc = L},

    %% Visit the operator expression in the new call context.
    {E1, S3} = i(apply_op(E), Ctxt1, Ren, Env, S2),

    %% Check the "inlined" flag to find out what to do next. (The store
    %% location could be recycled after the flag has been tested, but
    %% there is no real advantage to that, because in practice, only
    %% 4-5% of all created store locations will ever be reused, while
    %% there will be a noticable overhead for managing the free list.)
    case st__get_app_inlined(L, S3) of
        true ->
            %% The application was inlined, so we have the final
            %% expression in `E1'. We just have to handle any operands
            %% that need to be residualized for effect only (i.e., those
            %% the values of which are not used).
            residualize_operands(Opnds, E1, S3);
        false ->
            %% Otherwise, `E1' is the residual operator expression. We
            %% make sure all operands are visited, and rebuild the
            %% application.
            {Es, S4} = mapfoldl(fun (Opnd, S) ->
					visit_and_count_size(Opnd, S)
				end,
				S3, Opnds),
            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) ->
    weight(apply) + weight(argument) * A.

%% Since it is not the task of this transformation to handle
%% cross-module inlining, all inter-module calls are handled by visiting
%% the components (the module and function name, and the arguments of
%% the call) for value. In `effect' context, if the function itself is
%% known to be completely effect free, the call can be discarded and the
%% arguments evaluated for effect. Otherwise, if all the visited
%% arguments are to constants, and the function is known to be safe to
%% execute at compile time, then we try to evaluate the call. If
%% evaluation completes normally, the call is replaced by the result;
%% otherwise the call is residualised.

i_call(E, Ctxt, Ren, Env, S) ->
    {M, S1} = i(call_module(E), value, Ren, Env, S),
    {F, S2} = i(call_name(E), value, Ren, Env, S1),
    As = call_args(E),
    Arity = length(As),

    %% Check if the name of the called function is static. If so,
    %% discard the size counts performed above, since the values will
    %% not cause any runtime cost.
    Static =  is_c_atom(M) and is_c_atom(F),
    S3 = case Static of
	     true ->
		 revert_size(S, S2);
	     false ->
		 S2
	 end,
    case Ctxt of
        effect when Static =:= true ->
            case is_safe_call(atom_val(M), atom_val(F), Arity) of
                true ->
                    %% The result will not be used, and the call is
                    %% effect free, so we create a multiple-value
                    %% aggregate containing the (not yet visited)
                    %% arguments and process that instead.
                    i(c_values(As), effect, Ren, Env, S3);
                false ->
                    %% We are not allowed to simply discard the call,
                    %% but we can try to evaluate it.
                    i_call_1(Static, M, F, Arity, As, E, Ctxt, Ren, Env,
                             S3)
            end;
        _ ->
	    i_call_1(Static, M, F, Arity, As, E, Ctxt, Ren, Env, S3)
    end.

i_call_1(Static, M, F, Arity, As, E, Ctxt, Ren, Env, S) ->
    %% Visit the arguments for value.
    {As1, S1} = mapfoldl(fun (X, A) -> i(X, value, Ren, Env, A) end, 
			 S, As),
    case Static of
	true ->
	    case erl_bifs:is_pure(atom_val(M), atom_val(F), Arity) of
		true ->
		    %% It is allowed to evaluate this at compile time.
		    case all_static(As1) of
			true ->
			    i_call_3(M, F, As1, E, Ctxt, Env, S1);
			false ->
			    %% See if the call can be rewritten instead.
			    i_call_4(M, F, As1, E, Ctxt, Env, S1)
		    end;
		false ->
		    i_call_2(M, F, As1, E, S1)
	    end;
	false ->
	    i_call_2(M, F, As1, E, S1)
    end.

%% Residualise the call.

i_call_2(M, F, As, E, S) ->
    N = weight(call) + weight(argument) * length(As),
    {update_c_call(E, M, F, As), count_size(N, S)}.

%% Attempt to evaluate the call to yield a literal; if that fails, try
%% to rewrite the expression.

i_call_3(M, F, As, E, Ctxt, Env, S) ->
    %% Note that we extract the results of argument expessions here; the
    %% expressions could still be sequences with side effects.
    Vs = [concrete(result(A)) || A <- As],
    try apply(atom_val(M), atom_val(F), Vs) of
	V ->
	    %% Evaluation completed normally - try to turn the result
	    %% back into a syntax tree (representing a literal).
	    case is_literal_term(V) of
		true ->
		    %% Make a sequence of the arguments (as a
		    %% multiple-value aggregate) and the final value.
		    S1 = count_size(weight(values), S),
		    S2 = count_size(weight(literal), S1),
		    {make_seq(c_values(As), abstract(V)), S2};
		false ->
		    %% The result could not be represented as a literal.
		    i_call_4(M, F, As, E, Ctxt, Env, S)
	    end
    catch
	error:_ ->
	    %% The evaluation attempt did not complete normally.
	    i_call_4(M, F, As, E, Ctxt, Env, S)
    end.

%% Rewrite the expression, if possible, otherwise residualise it.

i_call_4(M, F, As, E, Ctxt, Env, S) ->
    case reduce_bif_call(atom_val(M), atom_val(F), As, Env) of
        false ->
            %% Nothing more to be done - residualise the call.
            i_call_2(M, F, As, E, S);
        {true, E1} ->
            %% We revisit the result, because the rewriting might have
            %% opened possibilities for further inlining. Since the
            %% parts have already been visited once, we use the identity
            %% renaming here.
            i(E1, Ctxt, ren__identity(), Env, S)
    end.

%% For now, we assume that primops cannot be evaluated at compile time,
%% probably being too special. Also, we have no knowledge about their
%% side effects.

i_primop(E, Ren, Env, S) ->
    %% Visit the arguments for value.
    {As, S1} = mapfoldl(fun (E, S) ->
				i(E, value, Ren, Env, S)
			end,
			S, primop_args(E)),
    N = weight(primop) + weight(argument) * length(As),
    {update_c_primop(E, primop_name(E), As), count_size(N, S1)}.

%% This is like having an expression with an extra fun-expression
%% attached for "exceptional cases"; actually, there are exactly two
%% parameter variables for the body, but they are easiest handled as if
%% their number might vary, just as for a `fun'.

i_try(E, Ctxt, Ren, Env, S) ->
    %% The argument expression is evaluated in `value' context, and the
    %% surrounding context is propagated into both branches. We do not
    %% try to recognize cases when the protected expression will
    %% actually raise an exception. Note that the variables are visited
    %% as patterns.
    {A, S1} = i(try_arg(E), value, Ren, Env, S),
    Vs = try_vars(E),
    {_, Ren1, Env1, S2} = bind_locals(Vs, Ren, Env, S1),
    Vs1 = i_params(Vs, Ren1, Env1),
    {B, S3} = i(try_body(E), Ctxt, Ren1, Env1, S2),
    case is_safe(A) of
	true ->
	    %% The `try' wrapper can be dropped in this case. Since the
	    %% expressions have been visited already, the identity
	    %% renaming is used when we revisit the new let-expression.
	    i(c_let(Vs1, A, B), Ctxt, ren__identity(), Env, S3);
	false ->
	    Evs = try_evars(E),
	    {_, Ren2, Env2, S4} = bind_locals(Evs, Ren, Env, S3),
	    Evs1 = i_params(Evs, Ren2, Env2),
	    {H, S5} = i(try_handler(E), Ctxt, Ren2, Env2, S4),
	    S6 = count_size(weight('try'), S5),
	    {update_c_try(E, A, Vs1, B, Evs1, H), S6}
    end.

%% A special case of try-expressions:

i_catch(E, Ctxt, Ren, Env, S) ->
    %% We cannot propagate application contexts into the catch.
    {E1, S1} = ES1 = i(catch_body(E), safe_context(Ctxt), Ren, Env, S),
    case is_safe(E1) of
	true ->
	    %% The `catch' wrapper can be dropped in this case.
	    ES1;
	false ->
	    S2 = count_size(weight('catch'), S1),
	    {update_c_catch(E, E1), S2}
    end.

%% A receive-expression is very much like a case-expression, with the
%% difference that we do not have access to a switch expression, since
%% the value being switched on is taken from the mailbox. The fact that
%% the receive-expression may iterate over an arbitrary number of
%% messages is not of interest to us. All we can do here is to visit its
%% subexpressions, and possibly eliminate definitely unselectable
%% clauses.

i_receive(E, Ctxt, Ren, Env, S) ->
    %% We first visit the expiry expression (for value) and the expiry
    %% body (in the surrounding context).
    {T, S1} = i(receive_timeout(E), value, Ren, Env, S),
    {B, S2} = i(receive_action(E), Ctxt, Ren, Env, S1),

    %% Then we visit the clauses. Note that application contexts may not
    %% in general be propagated into the branches (and the expiry body),
    %% because the execution of the `receive' may remove a message from
    %% the mailbox as a side effect; the situation is thus analogous to
    %% that in a `case' expression.
    Ctxt1 = safe_context(Ctxt),
    case i_clauses(receive_clauses(E), Ctxt1, Ren, Env, S2) of
        {false, {[], _, _, Cs}, S3} ->
            %% We still have a list of clauses. If the list is empty,
            %% and the expiry expression is the integer zero, the
            %% expression reduces to the expiry body.
	    if Cs =:= [] ->
		    case is_c_int(T) andalso (int_val(T) =:= 0) of
			true ->
			    {B, S3};
			false ->
			    i_receive_1(E, Cs, T, B, S3)
		    end;
	       true ->
		    i_receive_1(E, Cs, T, B, S3)
	    end;
        {true, {_, _, _, Cs}, S3} ->
	    %% Cs is a single clause that will always be matched (if a
	    %% message exists), but we must keep the `receive' statement
	    %% in order to fetch the message from the mailbox.
	    i_receive_1(E, Cs, T, B, S3)
    end.

i_receive_1(E, Cs, T, B, S) ->
    %% Here, we just add the base sizes for the receive-expression
    %% itself and for each remaining clause; cf. `case'.
    N = weight('receive') + weight(clause) * length(Cs),
    {update_c_receive(E, Cs, T, B), count_size(N, S)}.

%% A module definition is like a `letrec', with some add-ons (export and
%% attribute declarations) but without an explicit body. Actually, the
%% exporting of function names has the same effect as if there was a
%% body consisting of the list of references to the exported functions.
%% Thus, the exported functions are exactly those which can be
%% referenced from outside the module.

i_module(E, Ctxt, Ren, Env, S) ->
    %% Cf. `i_letrec'. Note that we pass a dummy constant value for the
    %% "body" parameter.
    Exps = i_module_exports(E),
    {Es, _, Xs1, S1} = i_letrec(module_defs(E), void(),
                                Exps, Ctxt, Ren, Env, S),
    %% Sanity check:
    case Es of
        [] ->
            report_warning("no function definitions remaining "
			   "in module `~s'.\n",
			   [atom_name(module_name(E))]);
        _ ->
            ok
    end,
    E1 = update_c_module(E, module_name(E), Xs1, module_attrs(E), Es),
    {E1, count_size(weight(module), S1)}.

i_module_exports(E) ->
    %% If a function is named in an `on_load' attribute, we will
    %% pretend that it is exported to ensure that it will not be removed.
    Exps = module_exports(E),
    Attrs = module_attrs(E),
    case i_module_on_load(Attrs) of
	none ->
	    Exps;
	[{_,_}=FA] ->
	    ordsets:add_element(c_var(FA), Exps)
    end.

i_module_on_load([{Key,Val}|T]) ->    
    case concrete(Key) of
	on_load ->
	    concrete(Val);
	_ ->
	    i_module_on_load(T)
    end;
i_module_on_load([]) -> none.

%% Binary-syntax expressions are too complicated to do anything
%% interesting with here - that is beyond the scope of this program;
%% also, their construction could have side effects, so even in effect
%% context we can't remove them. (We don't bother to identify cases of
%% "safe" unused binaries which could be removed.)

i_binary(E, Ren, Env, S) ->
    %% Visit the segments for value.
    {Es, S1} = mapfoldl(fun (E, S) ->
				i_bitstr(E, Ren, Env, S)
			end,
			S, binary_segments(E)),
    S2 = count_size(weight(binary), S1),
    {update_c_binary(E, Es), S2}.

i_bitstr(E, Ren, Env, S) ->
    %% It is not necessary to visit the Unit, Type and Flags fields,
    %% since these are always literals.
    {Val, S1} = i(bitstr_val(E), value, Ren, Env, S),
    {Size, S2} = i(bitstr_size(E), value, Ren, Env, S1),
    Unit = bitstr_unit(E),
    Type = bitstr_type(E),
    Flags = bitstr_flags(E),
    S3 = count_size(weight(bitstr), S2),
    {update_c_bitstr(E, Val, Size, Unit, Type, Flags), S3}.

i_map(E, Ctx, Ren, Env, S0) ->
    %% Visit the segments for value.
    {M1, S1} = i(map_arg(E), value, Ren, Env, S0),
    {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, S0) ->
    %% It is not necessary to visit the Op field
    %% since it is always a literal.
    {Key, S1} = i(map_pair_key(E), value, Ren, Env, S0),
    {Val, S2} = i(map_pair_val(E), Ctx, Ren, Env, S1),
    Op = map_pair_op(E),
    S3 = count_size(weight(map_pair), S2),
    {update_c_map_pair(E, Op, Key, Val), S3}.


%% This is a simplified version of `i_pattern', for lists of parameter
%% variables only. It does not modify the state.

i_params([V | Vs], Ren, Env) ->
    Name = ren__map(var_name(V), Ren),
    case env__lookup(Name, Env) of
	{ok, R} ->
	    [ref_to_var(R) | i_params(Vs, Ren, Env)];
	error ->
	    report_internal_error("variable `~w' not bound "
				  "in pattern.\n", [Name]),
	    exit(error)
    end;
i_params([], _, _) ->
    [].

%% For ordinary patterns, we just visit to rename variables and count
%% the size/cost. All occurring binding instances of variables should
%% already have been added to the renaming and environment; however, to
%% handle the size expressions of binary-syntax patterns, we must pass
%% the renaming and environment of the containing expression

i_pattern(E, Ren, Env, Ren0, Env0, S) ->
    case type(E) of
	var ->
	    %% Count no size.
            Name = ren__map(var_name(E), Ren),
            case env__lookup(Name, Env) of
                {ok, R} ->
                    {ref_to_var(R), S};
                error ->
                    report_internal_error("variable `~w' not bound "
					  "in pattern.\n", [Name]),
		    exit(error)
            end;
	alias ->
	    %% Count no size.
	    V = alias_var(E),
	    Name = ren__map(var_name(V), Ren),
	    case env__lookup(Name, Env) of
		{ok, R} ->
		    %% Visit the subpattern and recompose.
		    V1 = ref_to_var(R),
		    {P, S1} = i_pattern(alias_pat(E), Ren, Env, Ren0,
					Env0, S),
		    {update_c_alias(E, V1, P), S1};
		error ->
		    report_internal_error("variable `~w' not bound "
					  "in pattern.\n", [Name]),
		    exit(error)
	    end;
	binary ->
	    {Es, S1} = mapfoldl(fun (E, S) ->
					i_bitstr_pattern(E, Ren, Env,
							  Ren0, Env0, S)
				end,
				S, binary_segments(E)),
	    S2 = count_size(weight(binary), S1),
	    {update_c_binary(E, Es), S2};
	map ->
	    {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, map_arg(E), Es), S2};
	_ ->
	    case is_literal(E) of
		true ->
                    {E, count_size(weight(literal), S)};
		false ->
		    {Es1, S1} = mapfoldl(fun (E, S) ->
						 i_pattern(E, Ren, Env,
							   Ren0, Env0,
							   S)
					 end,
					 S, data_es(E)),
		    %% We assume that in general, the elements of the
		    %% constructor will all be fetched.
		    N = weight(data) + length(Es1) * weight(element),
		    S2 = count_size(N, S1),
		    {update_data(E, data_type(E), Es1), S2}
	    end
    end.

i_bitstr_pattern(E, Ren, Env, Ren0, Env0, S) ->
    %% It is not necessary to visit the Unit, Type and Flags fields,
    %% since these are always literals. The Value field is a limited
    %% pattern - either a literal or an unbound variable. The Size field
    %% is a limited expression - either a literal or a variable bound in
    %% the environment of the containing expression.
    {Val, S1} = i_pattern(bitstr_val(E), Ren, Env, Ren0, Env0, S),
    {Size, S2} = i(bitstr_size(E), value, Ren0, Env0, S1),
    Unit = bitstr_unit(E),
    Type = bitstr_type(E),
    Flags = bitstr_flags(E),
    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.
    %% Key is an expression
    {Key, S1} = i(map_pair_key(E), value, Ren0, Env0, S),
    {Val, S2} = i_pattern(map_pair_val(E), Ren, Env, Ren0, Env0, S1),
    Op = map_pair_op(E), %% should be 'exact' literal
    S3 = count_size(weight(map_pair), S2),
    {update_c_map_pair(E, Op, Key, Val), S3}.


%% ---------------------------------------------------------------------
%% Other central inlining functions

%% The following function assumes that `E' is a fun-expression and the
%% context is an app-structure. If the inlining could be aborted, a
%% corresponding catch should be set up before entering the function.
%%
%% Note: if the inlined body is some lambda abstraction, and the
%% surrounding context of the app-context is also an app-context, the
%% `inlined' flag of the outermost context will be set before that of
%% the inner context is set. E.g.: `let F = fun (X) -> fun (Y) -> E in
%% apply apply F(A)(B)' will propagate the body of F, which is a lambda
%% abstraction, into the outer application context, which will be
%% inlined to produce expression `E', and the flag of the outer context
%% will be set. Upon return, the flag of the inner context will also be
%% set. However, the flags are then tested in innermost-first order.
%% Thus, if some inlining attempt is aborted, the `inlined' flags of any
%% nested app-contexts must be cleared.
%%
%% This implementation does nothing to handle inlining of calls to
%% recursive functions in a smart way. This means that as long as the
%% size and effort counters do not prevent it, the function body will be
%% inlined (i.e., the first iteration will be unrolled), and the
%% recursive calls will be residualized.

inline(E, #app{opnds = Opnds, ctxt = Ctxt, loc = L}, Ren, Env, S) ->
    %% Check that the arities match:
    Vs = fun_vars(E),
    if length(Opnds) =/= length(Vs) ->
	    %% Arity mismatch: the call will be residualized
	    {E, S};
       true ->
	    %% Create local bindings for the parameters to their
	    %% respective operand structures from the app-structure.
	    {Rs, Ren1, Env1, S1} = bind_locals(Vs, Opnds, Ren, Env, S),

	    %% function_clause exceptions that have been inlined
	    %% into another function (or even into the same function)
	    %% will not work properly. The v3_kernel pass will
	    %% take care of it, but we will need to help it by
	    %% removing any function_name annotations on match_fail
	    %% primops that we inline.
	    E1 = kill_function_name_anns(fun_body(E)),

	    %% Visit the body in the context saved in the structure.
	    {E2, S2} = i(E1, Ctxt, Ren1, Env1, S1),

	    %% Create necessary bindings and/or set flags.
	    {E3, S3} = make_let_bindings(Rs, E2, S2),

	    %% Lastly, flag the application as inlined, since the inlining
	    %% attempt was not aborted before we reached this point.
	    {E3, st__set_app_inlined(L, S3)}
    end.

%% For the (possibly renamed) argument variables to an inlined call,
%% either create `let' bindings for them, if they are still referenced
%% in the residual expression (in C/Lisp, also if they are assigned to),
%% or otherwise (if they are not referenced or assigned) mark them for
%% evaluation for side effects.

make_let_bindings([R | Rs], E, S) ->
    {E1, S1} = make_let_bindings(Rs, E, S),
    make_let_binding(R, E1, S1);
make_let_bindings([], E, S) ->
    {E, S}.

make_let_binding(R, E, S) ->
    %% The `referenced' flag is conservatively computed. We therefore
    %% first check some simple cases where parameter R is definitely not
    %% referenced in the resulting body E.
    case is_literal(E) of
        true ->
            %% A constant contains no variable references.
            make_let_binding_1(R, E, S);
        false ->
            case is_c_var(E) of
                true ->
                    case var_name(E) =:= R#ref.name of
                        true ->
                            %% The body is simply the parameter variable
                            %% itself. Visit the operand for value and
                            %% substitute the result for the body.
                            visit_and_count_size(R#ref.opnd, S);
                        false ->
                            %% Not the same variable, so the parameter
                            %% is not referenced at all.
                            make_let_binding_1(R, E, S)
                    end;
                false ->
		    %% Proceed to check the `referenced' flag.
		    case st__get_var_referenced(R#ref.loc, S) of
			true ->
			    %% The parameter is probably referenced in
			    %% the residual code (although it might not
			    %% be). Visit the operand for value and
			    %% create a let-binding.
			    {E1, S1} = visit_and_count_size(R#ref.opnd,
							    S),
			    S2 = count_size(weight('let'), S1),
			    {c_let([ref_to_var(R)], E1, E), S2};
			false ->
			    %% The parameter is definitely not
			    %% referenced.
			    make_let_binding_1(R, E, S)
		    end
	    end
    end.

%% This marks the operand for evaluation for effect.

make_let_binding_1(R, E, S) ->
    Opnd = R#ref.opnd,
    {E, st__set_opnd_effect(Opnd#opnd.loc, S)}.

%% Here, `R' is the ref-structure which is the target of the copy
%% propagation, and `Opnd' is a visited operand structure, to be
%% propagated through `R' if possible - if not, `R' is residualised.
%% `Opnd' is normally the operand that `R' is bound to, and `E' is the
%% result of visiting `Opnd' for value; we pass this as an argument so
%% we don't have to fetch it multiple times (because we don't have
%% constant time access).
%%
%% We also pass the environment of the site of the variable reference,
%% for use when inlining a propagated fun-expression. In the original
%% algorithm by Waddell, the environment used for inlining such cases is
%% the identity mapping, because the fun-expression body has already
%% been visited for value, and their algorithm combines renaming of
%% source-code variables with the looking up of information about
%% residual-code variables. We, however, need to check the environment
%% of the call site when creating new non-shadowed variables, but we
%% must avoid repeated renaming. We therefore separate the renaming and
%% the environment (as in the renaming algorithm of Peyton-Jones and
%% Marlow). This also makes our implementation more general, compared to
%% the original algorithm, because we do not give up on propagating
%% variables that were free in the fun-body.
%%
%%  Example:
%%
%%	let F = fun (X) -> {'foo', X} in
%%	let G = fun (H) -> apply H(F)        % F is free in the fun G
%%	in apply G(fun (F) -> apply F(42))
%%	  =>
%%	let F = fun (X) -> {'foo', X} in
%%	apply (fun (H) -> apply H(F))(fun (F) -> apply F(42))
%%	  =>
%%	let F = fun (X) -> {'foo', X} in
%%	apply (fun (F) -> apply F(42))(F)
%%	  =>
%%	let F = fun (X) -> {'foo', X} in
%%	apply F(42)
%%	  =>
%%	apply (fun (X) -> {'foo', X})(2)
%%	  =>
%%	{'foo', 42}
%%
%%  The original algorithm would give up at stage 4, because F was free
%%  in the propagated fun-expression. Our version inlines this example
%%  completely.

copy(R, Opnd, E, Ctxt, Env, S) ->
    case is_c_var(E) andalso not is_c_fname(E) of
        true ->
	    %% The operand reduces to another variable - get its
	    %% ref-structure and attempt to propagate further.
            copy_var(env__get(var_name(E), Opnd#opnd.env), Ctxt, Env,
                     S);
        false ->
            %% Apart from variables and functional values (the latter
            %% are handled by `copy_1' below), only constant literals
            %% are copyable in general; other things, including e.g.
            %% tuples `{foo, X}', could cause duplication of work, and
            %% are not copy propagated.
            case is_literal(E) of
                true ->
                    {E, count_size(weight(literal), S)};
                false ->
                    copy_1(R, Opnd, E, Ctxt, Env, S)
            end
    end.

copy_var(R, Ctxt, Env, S) ->
    %% (In Lisp or C, if this other variable might be assigned to, we
    %% should residualize the "parent" instead, so we don't bypass any
    %% destructive updates.)
    case R#ref.opnd of
        undefined ->
            %% This variable is not bound to an expression, so just
            %% residualize it.
            residualize_var(R, S);
        Opnd ->
	    %% Note that because operands are always visited before
	    %% copied, all copyable operand expressions will be
	    %% propagated through any number of bindings. If `R' was
	    %% bound to a constant literal, we would never have reached
	    %% this point.
            case st__lookup_opnd_cache(Opnd#opnd.loc, S) of
                error ->
                    %% The result for this operand is not yet ready
                    %% (which should mean that it is a recursive
                    %% reference). Thus, we must residualise the
                    %% variable.
                    residualize_var(R, S);
                {ok, #cache{expr = E1}} ->
                    %% The result for the operand is ready, so we can
                    %% proceed to propagate it.
                    copy_1(R, Opnd, E1, Ctxt, Env, S)
            end
    end.

copy_1(R, Opnd, E, Ctxt, Env, S) ->
    case type(E) of
        'fun' ->
            %% Fun-expression (lambdas) are a bit special; they are copyable,
            %% but should preferably not be duplicated, so they should not be
            %% copy propagated except into application contexts, where they can
            %% be inlined.
            case Ctxt of
                #app{} ->
                    %% First test if the operand is "outer-pending"; if
                    %% so, don't inline.
                    case st__test_outer_pending(Opnd#opnd.loc, S) of
                        false ->
                            copy_inline(R, Opnd, E, Ctxt, Env, S);
                        true ->
                            %% Cyclic reference forced inlining to stop
                            %% (avoiding infinite unfolding).
                            residualize_var(R, S)
                    end;
                _ ->
                    residualize_var(R, S)
            end;
        var ->
            %% Variables at this point only refer to local functions; they are
            %% copyable but can't appear in guards, so they should not be
            %% copy propagated except into application contexts, where they can
            %% be inlined.
            case Ctxt of
                #app{} ->
                    %% First test if the operand is "outer-pending"; if
                    %% so, don't inline.
                    case st__test_outer_pending(Opnd#opnd.loc, S) of
                        false ->
                            R1 = env__get(var_name(E), Opnd#opnd.env),
                            copy_var(R1, Ctxt, Env, S);
                        true ->
                            %% Cyclic reference forced inlining to stop
                            %% (avoiding infinite unfolding).
                            residualize_var(R, S)
                    end;
                _ ->
                    residualize_var(R, S)
            end;
        _ ->
            %% We have no other cases to handle here
            residualize_var(R, S)
    end.

%% This inlines a function value that was propagated to an application
%% context. The inlining is done with an identity renaming (since the
%% expression is already visited) but in the environment of the call
%% site (which is OK because of the no-shadowing strategy for renaming,
%% and because the domain of our environments are the residual-program
%% variables instead of the source-program variables). Note that we must
%% first set the "outer-pending" flag, and clear it afterwards.

copy_inline(R, Opnd, E, Ctxt, Env, S) ->
    S1 = st__mark_outer_pending(Opnd#opnd.loc, S),
    try copy_inline_1(R, E, Ctxt, Env, S1) of
        {E1, S2} ->
            {E1, st__clear_outer_pending(Opnd#opnd.loc, S2)}
    catch
        throw:X ->
 	    %% If we use destructive update for the `outer-pending'
 	    %% flag, we must make sure to clear it upon a nonlocal
 	    %% return.
	    _S2 = st__clear_outer_pending(Opnd#opnd.loc, S1),
            throw(X)
    end.

%% If the current effort counter was passive, we use a new active effort
%% counter with the inherited limit for this particular inlining.

copy_inline_1(R, E, Ctxt, Env, S) ->
    case effort_is_active(S) of
        true ->
            copy_inline_2(R, E, Ctxt, Env, S);
        false ->
            S1 = new_active_effort(get_effort_limit(S), S),
            try copy_inline_2(R, E, Ctxt, Env, S1) of
                {E1, S2} ->
                    %% Revert to the old effort counter.
                    {E1, revert_effort(S, S2)}
	    catch
                throw:{counter_exceeded, effort, _} ->
                    %% Aborted this inlining attempt because too much
                    %% effort was spent. Residualize the variable and
                    %% revert to the previous state.
                    residualize_var(R, S)
            end
    end.

%% Regardless of whether the current size counter is active or not, we
%% use a new active size counter for each inlining. If the current
%% counter was passive, the new counter gets the inherited size limit;
%% if it was active, the size limit of the new counter will be equal to
%% the remaining budget of the current counter (which itself is not
%% affected by the inlining). This distributes the size budget more
%% evenly over "inlinings within inlinings", so that the whole size
%% budget is not spent on the first few call sites (in an inlined
%% function body) forcing the remaining call sites to be residualised.

copy_inline_2(R, E, Ctxt, Env, S) ->
    Limit = case size_is_active(S) of
                true ->
                    get_size_limit(S) - get_size_value(S);
                false ->
                    get_size_limit(S)
            end,
    %% Add the cost of the application to the new size limit, so we
    %% always inline functions that are small enough, even if `Limit' is
    %% close to zero at this point. (This is an extension to the
    %% original algorithm.)
    S1 = new_active_size(Limit + apply_size(length(Ctxt#app.opnds)), S),
    try inline(E, Ctxt, ren__identity(), Env, S1) of
        {E1, S2} ->
            %% Revert to the old size counter.
            {E1, revert_size(S, S2)}
    catch
        throw:{counter_exceeded, size, S2} ->
            %% Aborted this inlining attempt because it got too big.
            %% Residualize the variable and revert to the old size
            %% counter. (It is important that we do not also revert the
            %% effort counter here. Because the effort and size counters
            %% are always set up together, we know that the effort
            %% counter returned in S2 is the same that was passed to
            %% `inline'.)
	    S3 = revert_size(S, S2),
  	    %% If we use destructive update for the `inlined' flag, we
  	    %% must make sure to clear the flags of any nested
  	    %% app-contexts upon aborting; see `inline' for details.
 	    S4 = reset_nested_apps(Ctxt, S3),    % for effect
            residualize_var(R, S4)
    end.

reset_nested_apps(#app{ctxt = Ctxt, loc = L}, S) ->
    reset_nested_apps(Ctxt, st__clear_app_inlined(L, S));
reset_nested_apps(_, S) ->
    S.


%% ---------------------------------------------------------------------
%%	Support functions

new_var(Env) ->
    Name = env__new_vname(Env),
    c_var(Name).

residualize_var(R, S) ->
    S1 = count_size(weight(var), S),
    {ref_to_var(R), st__set_var_referenced(R#ref.loc, S1)}.

%% This function returns the value-producing subexpression of any
%% expression. (Except for sequencing expressions, this is the
%% expression itself.)

result(E) ->
    case is_c_seq(E) of
        true ->
            %% Also see `make_seq', which is used in all places to build
            %% sequences so that they are always nested in the first
            %% position.
            seq_body(E);
        false ->
            E
    end.

%% This function rewrites E to `do A1 E' if A is `do A1 A2', and
%% otherwise returns E unchanged.

hoist_effects(A, E) ->
    case type(A) of
	seq -> make_seq(seq_arg(A), E);
	_ -> E
    end.

%% This "build sequencing expression" operation assures that sequences
%% are always nested in the first position, which makes it easy to find
%% the actual value-producing expression of a sequence (cf. `result').

make_seq(E1, E2) ->
    case is_safe(E1) of
        true ->
            %% The first expression can safely be dropped.
            E2;
        false ->
            %% If `E1' is a sequence whose final expression has no side
            %% effects, then we can lose *that* expression when we
            %% compose the new sequence, since its value will not be
            %% used.
            E3 = case is_c_seq(E1) of
                     true ->
                         case is_safe(seq_body(E1)) of
                             true ->
                                 %% Drop the final expression.
                                 seq_arg(E1);
                             false ->
                                 E1
                         end;
                     false ->
                         E1
                 end,
            case is_c_seq(E2) of
                true ->
                    %% `E2' is a sequence (E2' E2''), so we must
                    %% rearrange the nesting to ((E1, E2') E2''), to
                    %% preserve the invariant. Annotations on `E2' are
                    %% lost.
                    c_seq(c_seq(E3, seq_arg(E2)), seq_body(E2));
                false ->
                    c_seq(E3, E2)
            end
    end.

%% Currently, safe expressions include variables, lambda expressions,
%% constructors with safe subexpressions (this includes atoms, integers,
%% empty lists, etc.), seq-, let- and letrec-expressions with safe
%% subexpressions, try- and catch-expressions with safe subexpressions
%% and calls to safe functions with safe argument subexpressions.
%% Binaries seem too tricky to be considered.

is_safe(E) ->
    case is_data(E) of
        true ->
	    is_safe_list(data_es(E));
        false ->
            case type(E) of
                var ->
                    true;
                'fun' ->
                    true;
		values ->
		    is_safe_list(values_es(E));
                'seq' ->
                    is_safe(seq_arg(E)) andalso is_safe(seq_body(E));
                'let' ->
                    is_safe(let_arg(E)) andalso is_safe(let_body(E));
                letrec ->
                    is_safe(letrec_body(E));
		'try' ->
		    %% If the argument expression is not safe, it could
		    %% be modifying the state; thus, even if the body is
		    %% safe, the try-expression as a whole would not be.
		    %% If the argument is safe, the handler is not used.
                    is_safe(try_arg(E)) andalso is_safe(try_body(E));
		'catch' ->
                    is_safe(catch_body(E));
		call ->
		    M = call_module(E),
		    F = call_name(E),
		    case is_c_atom(M) andalso is_c_atom(F) of
			true ->
			    As = call_args(E),
			    is_safe_list(As) andalso
				is_safe_call(atom_val(M),
					     atom_val(F),
					     length(As));
			false ->
			    false
		    end;
                _ ->
                    false
            end
    end.

is_safe_list([E | Es]) ->
    case is_safe(E) of
	true ->
	    is_safe_list(Es); 
	false ->
	    false
    end;
is_safe_list([]) ->
    true.

is_safe_call(M, F, A) ->
    erl_bifs:is_safe(M, F, A).

%% When setting up local variables, we only create new names if we have
%% to, according to the "no-shadowing" strategy.

make_locals(Vs, Ren, Env) ->
    make_locals(Vs, [], Ren, Env).

make_locals([V | Vs], As, Ren, Env) ->
    Name = var_name(V),
    case env__is_defined(Name, Env) of
        false ->
            %% The variable need not be renamed. Just make sure that the
            %% renaming will map it to itself.
            Name1 = Name,
            Ren1 = ren__add_identity(Name, Ren);
        true ->
            %% The variable must be renamed to maintain the no-shadowing
            %% invariant. Do the right thing for function variables.
            Name1 = case Name of
			{A, N} ->
			    env__new_fname(A, N, Env);
			_ ->
			    env__new_vname(Env)
		    end,
            Ren1 = ren__add(Name, Name1, Ren)
    end,
    %% This temporary binding is added for correct new-key generation.
    Env1 = env__bind(Name1, dummy, Env),
    make_locals(Vs, [Name1 | As], Ren1, Env1);
make_locals([], As, Ren, Env) ->
    {reverse(As), Ren, Env}.

%% This adds let-bindings for the source code variables in `Es' to the
%% environment `Env'.
%%
%% Note that we always assign a new state location for the
%% residual-program variable, since we cannot know when a location for a
%% particular variable in the source code can be reused.

bind_locals(Vs, Ren, Env, S) ->
    Opnds = [undefined || _ <- Vs],
    bind_locals(Vs, Opnds, Ren, Env, S).

bind_locals(Vs, Opnds, Ren, Env, S) ->
    {Ns, Ren1, Env1} = make_locals(Vs, Ren, Env),
    {Rs, Env2, S1} = bind_locals_1(Ns, Opnds, [], Env1, S),
    {Rs, Ren1, Env2, S1}.

%% Note that the `Vs' are currently not used for anything except the
%% number of variables. If we were maintaining "source-referenced"
%% flags, then the flag in the new variable should be initialized to the
%% current value of the (residual-) referenced-flag of the "parent".

bind_locals_1([N | Ns], [Opnd | Opnds], Rs, Env, S) ->
    {R, S1} = new_ref(N, Opnd, S),
    Env1 = env__bind(N, R, Env),
    bind_locals_1(Ns, Opnds, [R | Rs], Env1, S1);
bind_locals_1([], [], Rs, Env, S) ->
    {lists:reverse(Rs), Env, S}.

new_refs(Ns, Opnds, S) ->
    new_refs(Ns, Opnds, [], S).

new_refs([N | Ns], [Opnd | Opnds], Rs, S) ->
    {R, S1} = new_ref(N, Opnd, S),
    new_refs(Ns, Opnds, [R | Rs], S1);
new_refs([], [], Rs, S) ->
    {lists:reverse(Rs), S}.

new_ref(N, Opnd, S) ->
    {L, S1} = st__new_ref_loc(S),
    {#ref{name = N, opnd = Opnd, loc = L}, S1}.

%% This adds recursive bindings for the source code variables in `Es' to
%% the environment `Env'. Note that recursive binding of a set of
%% variables is an atomic operation on the environment - they cannot be
%% added one at a time.

bind_recursive(Vs, Opnds, Ren, Env, S) ->
    {Ns, Ren1, Env1} = make_locals(Vs, Ren, Env),
    {Rs, S1} = new_refs(Ns, Opnds, S),

    %% When this fun-expression is evaluated, it updates the operand
    %% structure in the ref-structure to contain the recursively defined
    %% environment and the correct renaming.
    Fun = fun (R, Env) ->
		  Opnd = R#ref.opnd,
		  R#ref{opnd = Opnd#opnd{ren = Ren1, env = Env}}
	  end,
    {Rs, Ren1, env__bind_recursive(Ns, Rs, Fun, Env1), S1}.

safe_context(Ctxt) ->
    case Ctxt of
        #app{} ->
            value;
        _ ->
            Ctxt
    end.

%% Note that the name of a variable encodes its type: a "plain" variable
%% or a function variable. The latter kind also contains an arity number
%% which should be preserved upon renaming.

ref_to_var(#ref{name = Name}) ->
    %% If we were maintaining "source-referenced" flags, the annotation
    %% `add_ann([#source_ref{loc = L}], E)' should also be done here, to
    %% make the algorithm reapplicable. This is however not necessary
    %% since there are no destructive variable assignments in Erlang.
    c_var(Name).

%% Including the effort counter of the call site assures that the cost
%% of processing an operand via `visit' is charged to the correct
%% counter. In particular, if the effort counter of the call site was
%% passive, the operands will also be processed with a passive counter.

make_opnd(E, Ren, Env, S) ->
    {L, S1} = st__new_opnd_loc(S),
    C = st__get_effort(S1),
    Opnd = #opnd{expr = E, ren = Ren, env = Env, loc = L, effort = C},
    {Opnd, S1}.

keep_referenced(Rs, S) ->
    [R || R <- Rs, st__get_var_referenced(R#ref.loc, S)].

residualize_operands(Opnds, E, S) ->
    foldr(fun (Opnd, {E, S}) -> residualize_operand(Opnd, E, S) end,
          {E, S}, Opnds).

%% This is the only case where an operand expression can be visited in
%% `effect' context instead of `value' context.

residualize_operand(Opnd, E, S) ->
    case st__get_opnd_effect(Opnd#opnd.loc, S) of
        true ->
            %% The operand has not been visited, so we do that now, but
            %% in `effect' context. (Waddell's algoritm does some stuff
            %% here to account specially for the operand size, which
            %% appears unnecessary.)
            {E1, S1} = i(Opnd#opnd.expr, effect, Opnd#opnd.ren,
                         Opnd#opnd.env, S),
            {make_seq(E1, E), S1};
        false ->
            {E, S}
    end.

%% The `visit' function always visits the operand expression in `value'
%% context (`residualize_operand' visits an unreferenced operand
%% expression in `effect' context when necessary). A new passive size
%% counter is used for visiting the operand, the final value of which is
%% then cached along with the resulting expression.
%%
%% Note that the effort counter of the call site, included in the
%% operand structure, is not a shared object. Thus, the effort budget is
%% actually reused over all occurrences of the operands of a single
%% application. This does not appear to be a problem; just a
%% modification of the algorithm.

visit(Opnd, S) ->
    {C, S1} = visit_1(Opnd, S),
    {C#cache.expr, S1}.

visit_and_count_size(Opnd, S) ->
    {C, S1} = visit_1(Opnd, S),
    {C#cache.expr, count_size(C#cache.size, S1)}.

visit_1(Opnd, S) ->
    case st__lookup_opnd_cache(Opnd#opnd.loc, S) of
        error ->
            %% Use a new, passive, size counter for visiting operands,
            %% and use the effort counter of the context of the operand.
            %% It turns out that if the latter is active, it must be the
            %% same object as the one currently used, and if it is
            %% passive, it does not matter if it is the same object as
            %% any other counter.
	    Effort = Opnd#opnd.effort,
	    Active = counter__is_active(Effort),
	    S1 = case Active of
		     true ->
			 S;    % don't change effort counter
		     false ->
			 st__set_effort(Effort, S)
		 end,
	    S2 = new_passive_size(get_size_limit(S1), S1),
	    
            %% Visit the expression and cache the result, along with the
            %% final value of the size counter.
            {E, S3} = i(Opnd#opnd.expr, value, Opnd#opnd.ren,
                        Opnd#opnd.env, S2),
            Size = get_size_value(S3),
            C = #cache{expr = E, size = Size},
            S4 = revert_size(S, st__set_opnd_cache(Opnd#opnd.loc, C,
						   S3)),
	    case Active of
		true ->
		    {C, S4};  % keep using the same effort counter
		false ->
		    {C, revert_effort(S, S4)}
	    end;
	{ok, C} ->
            {C, S}
    end.

%% Create a pattern matching template for an expression. A template
%% contains only data constructors (including atomic ones) and
%% variables, and compound literals are not folded into a single node.
%% Each node in the template is annotated with the variable which holds
%% the corresponding subexpression; these are new, unique variables not
%% existing in the given `Env'. Returns `{Template, Variables, NewEnv}',
%% where `Variables' is the list of all variables corresponding to nodes
%% in the template *listed in reverse dependency order*, and `NewEnv' is
%% `Env' augmented with mappings from the variable names to
%% subexpressions of `E' (not #ref{} structures!) rewritten so that no
%% computations are duplicated. `Variables' is guaranteed to be nonempty
%% - at least the root node will always be bound to a new variable.

make_template(E, Env) ->
    make_template(E, [], Env).

make_template(E, Vs0, Env0) ->
    case is_data(E) of
	true ->
	    {Ts, {Vs1, Env1}} = mapfoldl(
				  fun (E, {Vs0, Env0}) ->
					  {T, Vs1, Env1} =
					      make_template(E, Vs0,
							    Env0),
					  {T, {Vs1, Env1}}
				  end,
				  {Vs0, Env0}, data_es(E)),
	    T = make_data_skel(data_type(E), Ts),
	    E1 = update_data(E, data_type(E),
			     [hd(get_ann(T)) || T <- Ts]),
	    V = new_var(Env1),
	    Env2 = env__bind(var_name(V), E1, Env1),
	    {set_ann(T, [V]), [V | Vs1], Env2};
	false ->
	    case type(E) of
		seq ->
		    %% For a sequencing, we can rebind the variable used
		    %% for the body, and pass on the template as it is.
		    {T, Vs1, Env1} = make_template(seq_body(E), Vs0,
						   Env0),
		    V = var_name(hd(get_ann(T))),
		    E1 = update_c_seq(E, seq_arg(E), env__get(V, Env1)),
		    Env2 = env__bind(V, E1, Env1),
		    {T, Vs1, Env2};
		_ ->
		    V = new_var(Env0),
		    Env1 = env__bind(var_name(V), E, Env0),
		    {set_ann(V, [V]), [V | Vs0], Env1}
	    end
    end.

%% Two clauses are equivalent if their bodies are equivalent expressions
%% given that the respective pattern variables are local.

equivalent_clauses([]) ->
    true;
equivalent_clauses([C | Cs]) ->
    Env = cerl_trees:variables(c_values(clause_pats(C))),
    equivalent_clauses_1(clause_body(C), Cs, Env).

equivalent_clauses_1(E, [C | Cs], Env) ->
    Env1 = cerl_trees:variables(c_values(clause_pats(C))),
    case equivalent(E, clause_body(C), ordsets:union(Env, Env1)) of
	true ->
	    equivalent_clauses_1(E, Cs, Env);
	false ->
	    false
    end;
equivalent_clauses_1(_, [], _Env) ->
    true.

%% Two expressions are equivalent if and only if they yield the same
%% value and has the same side effects in the same order. Currently, we
%% only accept equality between constructors (constants) and nonlocal
%% variables, since this should cover most cases of interest. If a
%% variable is locally bound in one expression, it cannot be equivalent
%% to one with the same name in the other expression, so we need not
%% keep track of two environments.

equivalent(E1, E2, Env) ->
    case is_data(E1) of
        true ->
            case is_data(E2) of
                true ->
                    T1 = {data_type(E1), data_arity(E1)},
                    T2 = {data_type(E2), data_arity(E2)},
                    %% Note that we must test for exact equality.
                    T1 =:= T2 andalso
			equivalent_lists(data_es(E1), data_es(E2), Env);
                false ->
                    false
            end;
        false ->
	    case type(E1) of
		var ->
		    case is_c_var(E2) of
			true ->
			    N1 = var_name(E1),
			    N2 = var_name(E2),
			    N1 =:= N2 andalso not ordsets:is_element(N1, Env);
			false ->
			    false
		    end;
		_ ->
		    %% Other constructs are not being considered.
		    false
	    end
    end.

equivalent_lists([E1 | Es1], [E2 | Es2], Env) ->
    equivalent(E1, E2, Env) and equivalent_lists(Es1, Es2, Env);
equivalent_lists([], [], _) ->
    true;
equivalent_lists(_, _, _) ->
    false.

%% Return `false' or `{true, EffectExpr, ValueExpr}'. The environment is
%% passed for new-variable generation.

reduce_bif_call(M, F, As, Env) ->
    reduce_bif_call_1(M, F, length(As), As, Env).

reduce_bif_call_1(erlang, element, 2, [X, Y], _Env) ->
    case is_c_int(X) and is_c_tuple(Y) of
	true ->
	    %% We are free to change the relative evaluation order of
	    %% the elements, so lifting out a particular element is OK.
	    T = list_to_tuple(tuple_es(Y)),
	    N = int_val(X),
	    if is_integer(N), N > 0, N =< tuple_size(T) ->
		    E = element(N, T),
		    Es = tuple_to_list(setelement(N, T, void())),
		    {true, make_seq(c_tuple(Es), E)};
	       true ->
		    false
	    end;
	false ->
	    false
    end;
reduce_bif_call_1(erlang, hd, 1, [X], _Env) ->
    case is_c_cons(X) of
	true ->
	    %% Cf. `element/2' above.
	    {true, make_seq(cons_tl(X), cons_hd(X))};
	false ->
	    false
    end;
reduce_bif_call_1(erlang, length, 1, [X], _Env) ->
    case is_c_list(X) of
	true ->
	    %% Cf. `erlang:size/1' below.
	    {true, make_seq(X, c_int(list_length(X)))};
	false ->
	    false
    end;
reduce_bif_call_1(erlang, list_to_tuple, 1, [X], _Env) ->
    case is_c_list(X) of
	true ->
	    %% This does not actually preserve all the evaluation order
	    %% constraints of the list, but I don't imagine that it will
	    %% be a problem.
	    {true, c_tuple(list_elements(X))};
	false ->
	    false
    end;
reduce_bif_call_1(erlang, setelement, 3, [X, Y, Z], Env) ->
    case is_c_int(X) and is_c_tuple(Y) of
	true ->
	    %% Here, unless `Z' is a simple expression, we must bind it
	    %% to a new variable, because in that case, `Z' must be
	    %% evaluated before any part of `Y'.
	    T = list_to_tuple(tuple_es(Y)),
	    N = int_val(X),
	    if is_integer(N), N > 0, N =< tuple_size(T) ->
		    E = element(N, T),
		    case is_simple(Z) of
			true ->
			    Es = tuple_to_list(setelement(N, T, Z)),
			    {true, make_seq(E, c_tuple(Es))};
			false ->
			    V = new_var(Env),
			    Es = tuple_to_list(setelement(N, T, V)),
			    E1 = make_seq(E, c_tuple(Es)),
			    {true, c_let([V], Z, E1)}
		    end;
	       true ->
		    false
	    end;
	false ->
	    false
    end;
reduce_bif_call_1(erlang, size, 1, [X], Env) ->
    case is_c_tuple(X) of
	true ->
	    reduce_bif_call_1(erlang, tuple_size, 1, [X], Env);
	false ->
	    false
    end;
reduce_bif_call_1(erlang, tl, 1, [X], _Env) ->
    case is_c_cons(X) of
	true ->
	    %% Cf. `element/2' above.
	    {true, make_seq(cons_hd(X), cons_tl(X))};
	false ->
	    false
    end;
reduce_bif_call_1(erlang, tuple_size, 1, [X], _Env) ->
    case is_c_tuple(X) of
	true ->
	    %% Just evaluate the tuple for effect and use the size (the
	    %% arity) as the result.
	    {true, make_seq(X, c_int(tuple_arity(X)))};
	false ->
	    false
    end;
reduce_bif_call_1(erlang, tuple_to_list, 1, [X], _Env) ->
    case is_c_tuple(X) of
	true ->
	    %% This actually introduces slightly stronger constraints on
	    %% the evaluation order of the subexpressions.
	    {true, make_list(tuple_es(X))};
	false ->
	    false
    end;
reduce_bif_call_1(_M, _F, _A, _As, _Env) ->
    false.

effort_is_active(S) ->
    counter__is_active(st__get_effort(S)).

size_is_active(S) ->
    counter__is_active(st__get_size(S)).

get_effort_limit(S) ->
    counter__limit(st__get_effort(S)).

new_active_effort(Limit, S) ->
    st__set_effort(counter__new_active(Limit), S).

revert_effort(S1, S2) ->
    st__set_effort(st__get_effort(S1), S2).

new_active_size(Limit, S) ->
    st__set_size(counter__new_active(Limit), S).

new_passive_size(Limit, S) ->
    st__set_size(counter__new_passive(Limit), S).

revert_size(S1, S2) ->
    st__set_size(st__get_size(S1), S2).

count_effort(N, S) ->
    C = st__get_effort(S),
    C1 = counter__add(N, C, effort, S),
    case debug_counters() of
        %% true ->
        %%     case counter__is_active(C1) of
        %%         true ->
        %%             V = counter__value(C1),
        %%             case V > get(counter_effort_max) of
        %%                 true ->
        %%                     put(counter_effort_max, V);
        %%                 false ->
        %%                     ok
        %%             end;
        %%         false ->
        %%             ok
        %%     end;
        false ->
            ok
    end,
    st__set_effort(C1, S).

count_size(N, S) ->
    C = st__get_size(S),
    C1 = counter__add(N, C, size, S),
    case debug_counters() of
        %% true ->
        %%     case counter__is_active(C1) of
        %%         true ->
        %%             V = counter__value(C1),
        %%             case V > get(counter_size_max) of
        %%                 true ->
        %%                     put(counter_size_max, V);
        %%                 false ->
        %%                     ok
        %%             end;
        %%         false ->
        %%             ok
        %%     end;
        false ->
            ok
    end,
    st__set_size(C1, S).

get_size_value(S) ->
    counter__value(st__get_size(S)).

get_size_limit(S) ->
    counter__limit(st__get_size(S)).

kill_id_anns([{'id',_} | As]) ->
    kill_id_anns(As);
kill_id_anns([A | As]) ->
    [A | kill_id_anns(As)];
kill_id_anns([]) ->
    [].

kill_function_name_anns(Body) ->
    F = fun(P) ->
		case type(P) of
		    primop ->
			Ann = get_ann(P),
			Ann1 = lists:keydelete(function_name, 1, Ann),
			set_ann(P, Ann1);
		    _ ->
			P
		end
	end,
    cerl_trees:map(F, Body).


%% =====================================================================
%% General utilities

%% The atom `ok', is widely used in Erlang for "void" values.

void() -> abstract(ok).

is_simple(E) ->
    case type(E) of
	literal -> true;
	var -> true;
	'fun' -> true;
	_ -> false
    end.

get_components(N, E) ->
    case type(E) of
	values ->
	    Es = values_es(E),
	    if length(Es) =:= N ->
		    {true, Es};
	       true ->
		    false
	    end;
	_ when N =:= 1 ->
	    {true, [E]};
	_ ->
	    false
    end.

all_static(Es) ->
    lists:all(fun (E) -> is_literal(result(E)) end, Es).

set_clause_bodies([C | Cs], B) ->
    [update_c_clause(C, clause_pats(C), clause_guard(C), B)
     | set_clause_bodies(Cs, B)];
set_clause_bodies([], _) ->
    [].

%% =====================================================================
%% Abstract datatype: renaming()

ren__identity() ->
    dict:new().

ren__add(X, Y, Ren) ->
    dict:store(X, Y, Ren).

ren__map(X, Ren) ->
    case dict:find(X, Ren) of
	{ok, Y} ->
	    Y;
	error ->
	    X
    end.

ren__add_identity(X, Ren) ->
    dict:erase(X, Ren).


%% =====================================================================
%% Abstract datatype: environment()

env__empty() ->
    rec_env:empty().

env__bind(Key, Val, Env) ->
    rec_env:bind(Key, Val, Env).

%% `Es' should have type `[{Key, Val}]', and `Fun' should have type
%% `(Val, Env) -> T', mapping a value together with the recursive
%% environment itself to some term `T' to be returned when the entry is
%% looked up.

env__bind_recursive(Ks, Vs, F, Env) ->
    rec_env:bind_recursive(Ks, Vs, F, Env).

env__lookup(Key, Env) ->
    rec_env:lookup(Key, Env).

env__get(Key, Env) ->
    rec_env:get(Key, Env).

env__is_defined(Key, Env) ->
    rec_env:is_defined(Key, Env).

env__new_vname(Env) ->
    rec_env:new_key(Env).

env__new_fname(A, N, Env) ->
    rec_env:new_key(fun (X) ->
			S = integer_to_list(X),
			{list_to_atom(atom_to_list(A) ++ "_" ++ S),
			 N}
		    end, Env).


%% =====================================================================
%% Abstract datatype: state()

-record(state, {free,		% next free location
		size,		% size counter
		effort,		% effort counter
		unroll,		% inner/outer-pending initial value
		cache,		% operand expression cache
		var_flags,	% flags for variables (#ref-structures)
		opnd_flags,	% flags for operands
		app_flags}).	% flags for #app-structures

%% Note that we do not have a `var_assigned' flag, since there is no
%% destructive assignment in Erlang. In the original algorithm, the
%% "residual-referenced"-flags of the previous inlining pass (or
%% initialization pass) are used as the "source-referenced"-flags for
%% the subsequent pass. The latter may then be used as a safe
%% approximation whenever we need to base a decision on whether or not a
%% particular variable or function variable could be referenced in the
%% program being generated, and computation of the new
%% "residual-referenced" flag for that variable is not yet finished. In
%% the present algorithm, this can only happen in the presence of
%% variable assignments, which do not exist in Erlang. Therefore, we do
%% not keep "source-referenced" flags for residual-code references in
%% our implementation.
%%
%% The "inner-pending" flag tells us whether we are already in the
%% process of visiting a particular operand, and the "outer-pending"
%% flag whether we are in the process of inlining a propagated
%% functional value. The "pending flags" are really counters limiting
%% the number of times an operand may be inlined recursively, causing
%% loop unrolling. Note that the initial value must be greater than zero
%% in order for any inlining at all to be done.

%% Flags are stored in ETS-tables, one table for each class. The second
%% element in each stored tuple is the key (the "label").

-record(var_flags, {lab, referenced = false}).
-record(opnd_flags, {lab, inner_pending = 1, outer_pending = 1,
		     effect = false}).
-record(app_flags, {lab, inlined = false}).

st__new(Effort, Size, Unroll) ->
    EtsOpts = [set, private, {keypos, 2}],
    #state{free = 0,
	   size = counter__new_passive(Size),
	   effort = counter__new_passive(Effort),
	   unroll = Unroll,
	   cache = dict:new(),
 	   var_flags = ets:new(var, EtsOpts),
	   opnd_flags = ets:new(opnd, EtsOpts),
	   app_flags = ets:new(app, EtsOpts)}.

st__new_loc(S) ->
    N = S#state.free,
    {N, S#state{free = N + 1}}.

st__get_effort(S) ->
    S#state.effort.

st__set_effort(C, S) ->
    S#state{effort = C}.

st__get_size(S) ->
    S#state.size.

st__set_size(C, S) ->
    S#state{size = C}.

st__set_var_referenced(L, S) ->
    T = S#state.var_flags,
    [F] = ets:lookup(T, L),
    ets:insert(T, F#var_flags{referenced = true}),
    S.

st__get_var_referenced(L, S) ->
    ets:lookup_element(S#state.var_flags, L, #var_flags.referenced).

st__lookup_opnd_cache(L, S) ->
    dict:find(L, S#state.cache).

%% Note that setting the cache should only be done once.

st__set_opnd_cache(L, C, S) ->
    S#state{cache = dict:store(L, C, S#state.cache)}.

st__set_opnd_effect(L, S) ->
    T = S#state.opnd_flags,
    [F] = ets:lookup(T, L),
    ets:insert(T, F#opnd_flags{effect = true}),
    S.

st__get_opnd_effect(L, S) ->
    ets:lookup_element(S#state.opnd_flags, L, #opnd_flags.effect).

st__set_app_inlined(L, S) ->
    T = S#state.app_flags,
    [F] = ets:lookup(T, L),
    ets:insert(T, F#app_flags{inlined = true}),
    S.

st__clear_app_inlined(L, S) ->
    T = S#state.app_flags,
    [F] = ets:lookup(T, L),
    ets:insert(T, F#app_flags{inlined = false}),
    S.

st__get_app_inlined(L, S) ->
    ets:lookup_element(S#state.app_flags, L, #app_flags.inlined).

%% The pending-flags are initialized by `st__new_opnd_loc' below.

st__test_inner_pending(L, S) ->
    T = S#state.opnd_flags,
    P = ets:lookup_element(T, L, #opnd_flags.inner_pending),
    P =< 0.

st__mark_inner_pending(L, S) ->
    ets:update_counter(S#state.opnd_flags, L,
		       {#opnd_flags.inner_pending, -1}),
    S.

st__clear_inner_pending(L, S) ->
    ets:update_counter(S#state.opnd_flags, L,
		       {#opnd_flags.inner_pending, 1}),
    S.

st__test_outer_pending(L, S) ->
    T = S#state.opnd_flags,
    P = ets:lookup_element(T, L, #opnd_flags.outer_pending),
    P =< 0.

st__mark_outer_pending(L, S) ->
    ets:update_counter(S#state.opnd_flags, L,
		       {#opnd_flags.outer_pending, -1}),
    S.

st__clear_outer_pending(L, S) ->
    ets:update_counter(S#state.opnd_flags, L,
		       {#opnd_flags.outer_pending, 1}),
    S.

st__new_app_loc(S) ->
    V = {L, _S1} = st__new_loc(S),
    ets:insert(S#state.app_flags, #app_flags{lab = L}),
    V.

st__new_ref_loc(S) ->
    V = {L, _S1} = st__new_loc(S),
    ets:insert(S#state.var_flags, #var_flags{lab = L}),
    V.

st__new_opnd_loc(S) ->
    V = {L, _S1} = st__new_loc(S),
    N = S#state.unroll,
    ets:insert(S#state.opnd_flags,
	       #opnd_flags{lab = L,
			   inner_pending = N,
			   outer_pending = N}),
    V.


%% =====================================================================
%% Abstract datatype: counter()
%%
%% `counter__add' throws `{counter_exceeded, Type, Data}' if the
%% resulting counter value would exceed the limit for the counter in
%% question (`Type' and `Data' are given by the user).

counter__new_passive(Limit) when Limit > 0 ->
    {0, Limit}.

counter__new_active(Limit) when Limit > 0 ->
    {Limit, Limit}.

%% Active counters have values > 0 internally; passive counters start at
%% zero. The 'limit' field is only accessed by the 'counter__limit'
%% function.

counter__is_active({C, _}) ->
    C > 0.

counter__limit({_, L}) ->
    L.

counter__value({N, L}) ->
    if N > 0 ->
	    L - N;
       true ->
            -N
    end.

counter__add(N, {V, L}, Type, Data) ->
    N1 = V - N,
    if V > 0, N1 =< 0 ->
	    case debug_counters() of
		%% true ->
		%%     case Type of
		%% 	effort ->
		%% 	    put(counter_effort_triggers,
		%% 		get(counter_effort_triggers) + 1);
		%% 	size ->
		%% 	    put(counter_size_triggers,
		%% 		get(counter_size_triggers) + 1)
		%%     end;
		false ->
		    ok
	    end,
	    throw({counter_exceeded, Type, Data});
       true ->
	    {N1, L}
    end.


%% =====================================================================
%% Reporting

% report_internal_error(S) ->
%     report_internal_error(S, []).

report_internal_error(S, Vs) ->
    report_error("internal error: " ++ S, Vs).

%% report_error(D) ->
%%     report_error(D, []).
    
report_error(D, Vs) ->
    report({error, D}, Vs).

report_warning(D) ->
    report_warning(D, []).

report_warning(D, Vs) ->
    report({warning, D}, Vs).

report(D, Vs) ->
    io:put_chars(format(D, Vs)).

format({error, D}, Vs) ->
    ["error: ", format(D, Vs)];
format({warning, D}, Vs) ->
    ["warning: ", format(D, Vs)];
format(S, Vs) when is_list(S) ->
    [io_lib:fwrite(S, Vs), $\n].


%% =====================================================================