summaryrefslogtreecommitdiff
path: root/compiler/PureMicroPasses.ml
blob: ec64df21219925f1d59d3290a3aec171f3b10729 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
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
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
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
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
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
(** The following module defines micro-passes which operate on the pure AST *)

open Pure
open PureUtils
open TranslateCore

(** The local logger *)
let log = Logging.pure_micro_passes_log

let fun_decl_to_string (ctx : trans_ctx) (def : Pure.fun_decl) : string =
  let fmt = trans_ctx_to_pure_fmt_env ctx in
  PrintPure.fun_decl_to_string fmt def

let fun_sig_to_string (ctx : trans_ctx) (sg : Pure.fun_sig) : string =
  let fmt = trans_ctx_to_pure_fmt_env ctx in
  PrintPure.fun_sig_to_string fmt sg

(** Small utility.

    We sometimes have to insert new fresh variables in a function body, in which
    case we need to make their indices greater than the indices of all the variables
    in the body.
    TODO: things would be simpler if we used a better representation of the
    variables indices...
 *)
let get_body_min_var_counter (body : fun_body) : VarId.generator =
  (* Find the max id in the input variables - some of them may have been
   * filtered from the body *)
  let min_input_id =
    List.fold_left
      (fun id (var : var) -> VarId.max id var.id)
      VarId.zero body.inputs
  in
  let obj =
    object
      inherit [_] reduce_expression
      method zero _ = min_input_id
      method plus id0 id1 _ = VarId.max (id0 ()) (id1 ())
      (* Get the maximum *)

      (** For the patterns *)
      method! visit_var _ v _ = v.id

      (** For the rvalues *)
      method! visit_Var _ vid _ = vid
    end
  in
  (* Find the max counter in the body *)
  let id = obj#visit_expression () body.body.e () in
  VarId.generator_from_incr_id id

(** "Pretty-Name context": see {!compute_pretty_names} *)
type pn_ctx = {
  pure_vars : string VarId.Map.t;
      (** Information about the pure variables used in the synthesized program *)
  llbc_vars : string E.VarId.Map.t;
      (** Information about the LLBC variables used in the original program *)
}

(** This function computes pretty names for the variables in the pure AST. It
    relies on the "meta"-place information in the AST to generate naming
    constraints, and then uses those to compute the names.
    
    The way it works is as follows:
    - we only modify the names of the unnamed variables
    - whenever we see an rvalue/pattern which is exactly an unnamed variable,
      and this value is linked to some meta-place information which contains
      a name and an empty path, we consider we should use this name
    - we try to propagate naming constraints on the pure variables use in the
      synthesized programs, and also on the LLBC variables from the original
      program (information about the LLBC variables is stored in the meta-places)
      
      
    Something important is that, for every variable we find, the name of this
    variable can be influenced by the information we find *below* in the AST.

    For instance, the following situations happen:
    
    - let's say we evaluate:
      {[
        match (ls : List<T>) {
          List::Cons(x, hd) => {
            ...
          }
        }
      ]}
      
      Actually, in MIR, we get:
      {[
        tmp := discriminant(ls);
        switch tmp {
          0 => {
            x := (ls as Cons).0; // (i)
            hd := (ls as Cons).1; // (ii)
            ...
          }
        }
      ]}
      If [ls] maps to a symbolic value [s0] upon evaluating the match in symbolic
      mode, we expand this value upon evaluating [tmp = discriminant(ls)].
      However, at this point, we don't know which should be the names of
      the symbolic values we introduce for the fields of [Cons]!

      Let's imagine we have (for the [Cons] branch): [s0 ~~> Cons s1 s2].
      The assigments at (i) and (ii) lead to the following binding in the
      evaluation context:
      {[
        x -> s1
        hd -> s2
      ]}
      
      When generating the symbolic AST, we save as meta-information that we
      assign [s1] to the place [x] and [s2] to the place [hd]. This way,
      we learn we can use the names [x] and [hd] for the variables which are
      introduced by the match:
      {[
        match ls with
        | Cons x hd -> ...
        | ...
      ]}
   - Assignments:
     [let x [@mplace=lp] = v [@mplace = rp] in ...]
     
     We propagate naming information across the assignments. This is important
     because many reassignments using temporary, anonymous variables are
     introduced during desugaring.
   
   - Given back values (introduced by backward functions):
     Let's say we have the following Rust code:
     {[
       let py = id(&mut x);
       *py = 2;
       assert!(x = 2);
     ]}
     
     After desugaring, we get the following MIR:
     {[
       ^0 = &mut x; // anonymous variable
       py = id(move ^0);
       *py += 2;
       assert!(x = 2);
     ]}
     
     We want this to be translated as:
     {[
       let py = id_fwd x in
       let py1 = py + 2 in
       let x1 = id_back x py1 in // <-- x1 is "given back": doesn't appear in the original MIR
       assert(x1 = 2);
     ]}

     We want to notice that the value given back by [id_back] is given back for "x",
     so we should use "x" as the basename (hence the resulting name "x1"). However,
     this is non-trivial, because after desugaring the input argument given to [id]
     is not [&mut x] but [move ^0] (i.e., it comes from a temporary, anonymous
     variable). For this reason, we use the meta-place [&mut x] as the meta-place
     for the given back value (this is done during the synthesis), and propagate
     naming information *also* on the LLBC variables (which are referenced by the
     meta-places).

     This way, because of [^0 = &mut x], we can propagate the name "x" to the place
     [^0], then to the given back variable across the function call.
   
 *)
let compute_pretty_names (def : fun_decl) : fun_decl =
  (* Small helpers *)
  (* 
   * When we do branchings, we need to merge (the constraints saved in) the
   * contexts returned by the different branches.
   *
   * Note that by doing so, some mappings from var id to name
   * in one context may be overriden by the ones in the other context.
   *
   * This should be ok because:
   * - generally, the overriden variables should have been introduced *inside*
   *   the branches, in which case we don't care
   * - or they were introduced before, in which case the naming should generally
   *   be consistent? In the worse case, it isn't, but it leads only to less
   *   readable code, not to unsoundness. This case should be pretty rare,
   *   also.
   *)
  let merge_ctxs (ctx0 : pn_ctx) (ctx1 : pn_ctx) : pn_ctx =
    let pure_vars =
      VarId.Map.fold
        (fun id name ctx -> VarId.Map.add id name ctx)
        ctx0.pure_vars ctx1.pure_vars
    in
    let llbc_vars =
      E.VarId.Map.fold
        (fun id name ctx -> E.VarId.Map.add id name ctx)
        ctx0.llbc_vars ctx1.llbc_vars
    in
    { pure_vars; llbc_vars }
  in
  let empty_ctx =
    { pure_vars = VarId.Map.empty; llbc_vars = E.VarId.Map.empty }
  in
  let merge_ctxs_ls (ctxs : pn_ctx list) : pn_ctx =
    List.fold_left (fun ctx0 ctx1 -> merge_ctxs ctx0 ctx1) empty_ctx ctxs
  in

  (*
   * The way we do is as follows:
   * - we explore the expressions
   * - we register the variables introduced by the let-bindings
   * - we use the naming information we find (through the variables and the
   *   meta-places) to update our context (i.e., maps from variable ids to
   *   names)
   * - we use this information to update the names of the variables used in the
   *   expressions
   *)

  (* Register a variable for constraints propagation - used when an variable is
   * introduced (left-hand side of a left binding) *)
  let register_var (ctx : pn_ctx) (v : var) : pn_ctx =
    assert (not (VarId.Map.mem v.id ctx.pure_vars));
    match v.basename with
    | None -> ctx
    | Some name ->
        let pure_vars = VarId.Map.add v.id name ctx.pure_vars in
        { ctx with pure_vars }
  in
  (* Update a variable - used to update an expression after we computed constraints *)
  let update_var (ctx : pn_ctx) (v : var) (mp : mplace option) : var =
    match v.basename with
    | Some _ -> v
    | None -> (
        match VarId.Map.find_opt v.id ctx.pure_vars with
        | Some basename -> { v with basename = Some basename }
        | None ->
            if Option.is_some mp then
              match
                E.VarId.Map.find_opt (Option.get mp).var_id ctx.llbc_vars
              with
              | None -> v
              | Some basename -> { v with basename = Some basename }
            else v)
  in
  (* Update an pattern - used to update an expression after we computed constraints *)
  let update_typed_pattern ctx (lv : typed_pattern) : typed_pattern =
    let obj =
      object
        inherit [_] map_typed_pattern
        method! visit_PatVar _ v mp = PatVar (update_var ctx v mp, mp)
      end
    in
    obj#visit_typed_pattern () lv
  in

  (* Register an mplace the first time we find one *)
  let register_mplace (mp : mplace) (ctx : pn_ctx) : pn_ctx =
    match (E.VarId.Map.find_opt mp.var_id ctx.llbc_vars, mp.name) with
    | None, Some name ->
        let llbc_vars = E.VarId.Map.add mp.var_id name ctx.llbc_vars in
        { ctx with llbc_vars }
    | _ -> ctx
  in

  (* Register the fact that [name] can be used for the pure variable identified
   * by [var_id] (will add this name in the map if the variable is anonymous) *)
  let add_pure_var_constraint (var_id : VarId.id) (name : string) (ctx : pn_ctx)
      : pn_ctx =
    let pure_vars =
      if VarId.Map.mem var_id ctx.pure_vars then ctx.pure_vars
      else VarId.Map.add var_id name ctx.pure_vars
    in
    { ctx with pure_vars }
  in
  (* Similar to [add_pure_var_constraint], but for LLBC variables *)
  let add_llbc_var_constraint (var_id : E.VarId.id) (name : string)
      (ctx : pn_ctx) : pn_ctx =
    let llbc_vars =
      if E.VarId.Map.mem var_id ctx.llbc_vars then ctx.llbc_vars
      else E.VarId.Map.add var_id name ctx.llbc_vars
    in
    { ctx with llbc_vars }
  in
  (* Add a constraint: given a variable id and an associated meta-place, try to
   * extract naming information from the meta-place and save it *)
  let add_constraint (mp : mplace) (var_id : VarId.id) (ctx : pn_ctx) : pn_ctx =
    (* Register the place *)
    let ctx = register_mplace mp ctx in
    (* Update the variable name *)
    match (mp.name, mp.projection) with
    | Some name, [] ->
        (* Check if the variable already has a name - if not: insert the new name *)
        let ctx = add_pure_var_constraint var_id name ctx in
        let ctx = add_llbc_var_constraint mp.var_id name ctx in
        ctx
    | _ -> ctx
  in
  (* Specific case of constraint on rvalues *)
  let add_right_constraint (mp : mplace) (rv : texpression) (ctx : pn_ctx) :
      pn_ctx =
    (* Register the place *)
    let ctx = register_mplace mp ctx in
    (* Add the constraint *)
    match (unmeta rv).e with Var vid -> add_constraint mp vid ctx | _ -> ctx
  in
  let add_pure_var_value_constraint (var_id : VarId.id) (rv : texpression)
      (ctx : pn_ctx) : pn_ctx =
    (* Add the constraint *)
    match (unmeta rv).e with
    | Var vid -> (
        (* Try to find a name for the vid *)
        match VarId.Map.find_opt vid ctx.pure_vars with
        | None -> ctx
        | Some name -> add_pure_var_constraint var_id name ctx)
    | _ -> ctx
  in
  (* Specific case of constraint on left values *)
  let add_left_constraint (lv : typed_pattern) (ctx : pn_ctx) : pn_ctx =
    let obj =
      object (self)
        inherit [_] reduce_typed_pattern
        method zero _ = empty_ctx
        method plus ctx0 ctx1 _ = merge_ctxs (ctx0 ()) (ctx1 ())

        method! visit_PatVar _ v mp () =
          (* Register the variable *)
          let ctx = register_var (self#zero ()) v in
          (* Register the mplace information if there is such information *)
          match mp with Some mp -> add_constraint mp v.id ctx | None -> ctx
      end
    in
    let ctx1 = obj#visit_typed_pattern () lv () in
    merge_ctxs ctx ctx1
  in

  (* This is used to propagate constraint information about places in case of
   * variable reassignments: we try to propagate the information from the
   * rvalue to the left *)
  let add_left_right_constraint (lv : typed_pattern) (re : texpression)
      (ctx : pn_ctx) : pn_ctx =
    (* We propagate constraints across variable reassignments: [^0 = x],
     * if the destination doesn't have naming information *)
    match lv.value with
    | PatVar (({ id = _; basename = None; ty = _ } as lvar), lmp) ->
        if
          (* Check that there is not already a name for the variable *)
          VarId.Map.mem lvar.id ctx.pure_vars
        then ctx
        else
          (* We ignore the left meta-place information: it should have been taken
           * care of by [add_left_constraint]. We try to use the right meta-place
           * information *)
          let add (name : string) (ctx : pn_ctx) : pn_ctx =
            (* Add the constraint for the pure variable *)
            let ctx = add_pure_var_constraint lvar.id name ctx in
            (* Add the constraint for the LLBC variable *)
            match lmp with
            | None -> ctx
            | Some lmp -> add_llbc_var_constraint lmp.var_id name ctx
          in
          (* We try to use the right-place information *)
          let rmp, re = opt_unmeta_mplace re in
          let ctx =
            match rmp with
            | Some { var_id; name; projection = [] } -> (
                if Option.is_some name then add (Option.get name) ctx
                else
                  match E.VarId.Map.find_opt var_id ctx.llbc_vars with
                  | None -> ctx
                  | Some name -> add name ctx)
            | _ -> ctx
          in
          (* We try to use the rvalue information, if it is a variable *)
          let ctx =
            match (unmeta re).e with
            | Var rvar_id -> (
                match VarId.Map.find_opt rvar_id ctx.pure_vars with
                | None -> ctx
                | Some name -> add name ctx)
            | _ -> ctx
          in
          ctx
    | _ -> ctx
  in

  (* *)
  let rec update_texpression (e : texpression) (ctx : pn_ctx) :
      pn_ctx * texpression =
    let ty = e.ty in
    let ctx, e =
      match e.e with
      | Var _ | CVar _ | Const _ -> (* Nothing to do *) (ctx, e.e)
      | App (app, arg) ->
          let ctx, app = update_texpression app ctx in
          let ctx, arg = update_texpression arg ctx in
          let e = App (app, arg) in
          (ctx, e)
      | Qualif _ -> (* nothing to do *) (ctx, e.e)
      | Let (monadic, lb, re, e) -> update_let monadic lb re e ctx
      | Switch (scrut, body) -> update_switch_body scrut body ctx
      | Loop loop -> update_loop loop ctx
      | StructUpdate supd -> update_struct_update supd ctx
      | Lambda (lb, e) -> update_lambda lb e ctx
      | Meta (meta, e) -> update_emeta meta e ctx
    in
    (ctx, { e; ty })
  (* *)
  and update_lambda (x : typed_pattern) (e : texpression) (ctx : pn_ctx) :
      pn_ctx * expression =
    (* We first add the left-constraint *)
    let ctx = add_left_constraint x ctx in
    (* Update the expression, and add additional constraints *)
    let ctx, e = update_texpression e ctx in
    (* Update the abstracted value *)
    let x = update_typed_pattern ctx x in
    (* Put together *)
    (ctx, Lambda (x, e))
  (* *)
  and update_let (monadic : bool) (lv : typed_pattern) (re : texpression)
      (e : texpression) (ctx : pn_ctx) : pn_ctx * expression =
    (* We first add the left-constraint *)
    let ctx = add_left_constraint lv ctx in
    (* Then we try to propagate the right-constraints to the left, in case
     * the left constraints didn't give naming information *)
    let ctx = add_left_right_constraint lv re ctx in
    let ctx, re = update_texpression re ctx in
    let ctx, e = update_texpression e ctx in
    let lv = update_typed_pattern ctx lv in
    (ctx, Let (monadic, lv, re, e))
  (* *)
  and update_switch_body (scrut : texpression) (body : switch_body)
      (ctx : pn_ctx) : pn_ctx * expression =
    let ctx, scrut = update_texpression scrut ctx in

    let ctx, body =
      match body with
      | If (e_true, e_false) ->
          let ctx1, e_true = update_texpression e_true ctx in
          let ctx2, e_false = update_texpression e_false ctx in
          let ctx = merge_ctxs ctx1 ctx2 in
          (ctx, If (e_true, e_false))
      | Match branches ->
          let ctx_branches_ls =
            List.map
              (fun br ->
                let ctx = add_left_constraint br.pat ctx in
                let ctx, branch = update_texpression br.branch ctx in
                let pat = update_typed_pattern ctx br.pat in
                (ctx, { pat; branch }))
              branches
          in
          let ctxs, branches = List.split ctx_branches_ls in
          let ctx = merge_ctxs_ls ctxs in
          (ctx, Match branches)
    in
    (ctx, Switch (scrut, body))
  (* *)
  and update_loop (loop : loop) (ctx : pn_ctx) : pn_ctx * expression =
    let {
      fun_end;
      loop_id;
      meta;
      fuel0;
      fuel;
      input_state;
      inputs;
      inputs_lvs;
      output_ty;
      loop_body;
    } =
      loop
    in
    let ctx, fun_end = update_texpression fun_end ctx in
    let ctx, loop_body = update_texpression loop_body ctx in
    let inputs = List.map (fun v -> update_var ctx v None) inputs in
    let inputs_lvs = List.map (update_typed_pattern ctx) inputs_lvs in
    let loop =
      {
        fun_end;
        loop_id;
        meta;
        fuel0;
        fuel;
        input_state;
        inputs;
        inputs_lvs;
        output_ty;
        loop_body;
      }
    in
    (ctx, Loop loop)
  and update_struct_update (supd : struct_update) (ctx : pn_ctx) :
      pn_ctx * expression =
    let { struct_id; init; updates } = supd in
    let ctx, updates =
      List.fold_left_map
        (fun ctx (fid, fe) ->
          let ctx, fe = update_texpression fe ctx in
          (ctx, (fid, fe)))
        ctx updates
    in
    let supd = { struct_id; init; updates } in
    (ctx, StructUpdate supd)
  (* *)
  and update_emeta (meta : emeta) (e : texpression) (ctx : pn_ctx) :
      pn_ctx * expression =
    let ctx =
      match meta with
      | Assignment (mp, rvalue, rmp) ->
          let ctx = add_right_constraint mp rvalue ctx in
          let ctx =
            match (mp.projection, rmp) with
            | [], Some { var_id; name; projection = [] } -> (
                let name =
                  match name with
                  | Some name -> Some name
                  | None -> E.VarId.Map.find_opt var_id ctx.llbc_vars
                in
                match name with
                | None -> ctx
                | Some name -> add_llbc_var_constraint mp.var_id name ctx)
            | _ -> ctx
          in
          ctx
      | SymbolicAssignment (var_id, rvalue) ->
          add_pure_var_value_constraint var_id rvalue ctx
      | MPlace mp -> add_right_constraint mp e ctx
      | Tag _ -> ctx
    in
    let ctx, e = update_texpression e ctx in
    let e = mk_emeta meta e in
    (ctx, e.e)
  in

  let body =
    match def.body with
    | None -> None
    | Some body ->
        let input_names =
          List.filter_map
            (fun (v : var) ->
              match v.basename with
              | None -> None
              | Some name -> Some (v.id, name))
            body.inputs
        in
        let ctx =
          {
            pure_vars = VarId.Map.of_list input_names;
            llbc_vars = E.VarId.Map.empty;
          }
        in
        let _, body_exp = update_texpression body.body ctx in
        Some { body with body = body_exp }
  in
  { def with body }

(** Remove the meta-information *)
let remove_meta (def : fun_decl) : fun_decl =
  match def.body with
  | None -> def
  | Some body ->
      let body = { body with body = PureUtils.remove_meta body.body } in
      { def with body = Some body }

(** Introduce the special structure create/update expressions.

    Upon generating the pure code, we introduce structure values by using
    the structure constructors:
    {[
      Cons x0 ... xn
    ]}

    This micro-pass turns those into expressions which use structure syntax:
    {[
      type struct = { f0 : nat; f1 : nat; f2 : nat }

      Mkstruct x.f0 x.f1 y ~~> { x with f2 = y }
    ]}

    Note however that we do not apply this transformation if the
    structure is to be extracted as a tuple.
 *)
let intro_struct_updates (ctx : trans_ctx) (def : fun_decl) : fun_decl =
  let obj =
    object (self)
      inherit [_] map_expression as super

      method! visit_texpression env (e : texpression) =
        match e.e with
        | App _ -> (
            let app, args = destruct_apps e in
            let ignore () =
              mk_apps
                (self#visit_texpression env app)
                (List.map (self#visit_texpression env) args)
            in
            match app.e with
            | Qualif
                {
                  id = AdtCons { adt_id = TAdtId adt_id; variant_id = None };
                  generics = _;
                } ->
                (* Lookup the def *)
                let decl = TypeDeclId.Map.find adt_id ctx.type_ctx.type_decls in
                (* Check if the def will be extracted as a tuple *)
                if
                  TypesUtils.type_decl_from_decl_id_is_tuple_struct
                    ctx.type_ctx.type_infos adt_id
                then ignore ()
                else
                  (* Check that there are as many arguments as there are fields - note
                     that the def should have a body (otherwise we couldn't use the
                     constructor) *)
                  let fields = TypesUtils.type_decl_get_fields decl None in
                  if List.length fields = List.length args then
                    (* Check if the definition is recursive *)
                    let is_rec =
                      match
                        TypeDeclId.Map.find adt_id
                          ctx.type_ctx.type_decls_groups
                      with
                      | NonRecGroup _ -> false
                      | RecGroup _ -> true
                    in
                    (* Convert, if possible - note that for now for Lean and Coq
                       we don't support the structure syntax on recursive structures *)
                    if
                      (!Config.backend <> Lean && !Config.backend <> Coq)
                      || not is_rec
                    then
                      let struct_id = TAdtId adt_id in
                      let init = None in
                      let updates =
                        FieldId.mapi
                          (fun fid fe -> (fid, self#visit_texpression env fe))
                          args
                      in
                      let ne = { struct_id; init; updates } in
                      let nty = e.ty in
                      { e = StructUpdate ne; ty = nty }
                    else ignore ()
                  else ignore ()
            | _ -> ignore ())
        | _ -> super#visit_texpression env e
    end
  in
  match def.body with
  | None -> def
  | Some body ->
      let body = { body with body = obj#visit_texpression () body.body } in
      { def with body = Some body }

(** Simplify the let-bindings by performing the following rewritings:

    Move inner let-bindings outside. This is especially useful to simplify
    the backward expressions, when we merge the forward/backward functions.
    Note that the rule is also applied with monadic let-bindings.
    {[
      let x :=
        let y := ... in
        e

        ~~>

      let y := ... in
      let x := e
    ]}

    Simplify panics and returns:
    {[
      let x ← fail
      ...
        ~~>
      fail

      let x ← return y
      ...
        ~~>
      let x := y
      ...
    ]}

    Simplify tuples:
    {[
      let (y0, y1) := (x0, x1) in
      ...
        ~~>
      let y0 = x0 in
      let y1 = x1 in
      ...
    ]}

    Simplify arrows:
    {[
      let f := fun x => g x in
      ...
        ~~>
      let f := g in
      ...
    ]}
 *)
let simplify_let_bindings (_ctx : trans_ctx) (def : fun_decl) : fun_decl =
  let obj =
    object (self)
      inherit [_] map_expression as super

      method! visit_Let env monadic lv rv next =
        match rv.e with
        | Let (rmonadic, rlv, rrv, rnext) ->
            (* Case 1: move the inner let outside then re-visit *)
            let rnext1 = Let (monadic, lv, rnext, next) in
            let rnext1 = { ty = next.ty; e = rnext1 } in
            self#visit_Let env rmonadic rlv rrv rnext1
        | App
            ( {
                e =
                  Qualif
                    {
                      id =
                        AdtCons
                          {
                            adt_id = TAssumed TResult;
                            variant_id = Some variant_id;
                          };
                      generics = _;
                    };
                ty = _;
              },
              x ) ->
            (* return/fail case *)
            if variant_id = result_return_id then
              (* Return case - note that the simplification we just perform
                 might have unlocked the tuple simplification below *)
              self#visit_Let env false lv x next
            else if variant_id = result_fail_id then
              (* Fail case *)
              self#visit_expression env rv.e
            else raise (Failure "Unexpected")
        | App _ ->
            (* This might be the tuple case *)
            if not monadic then
              match
                (opt_dest_struct_pattern lv, opt_dest_tuple_texpression rv)
              with
              | Some pats, Some vals ->
                  (* Tuple case *)
                  let pat_vals = List.combine pats vals in
                  let e =
                    List.fold_right
                      (fun (pat, v) next -> mk_let false pat v next)
                      pat_vals next
                  in
                  super#visit_expression env e.e
              | _ -> super#visit_Let env monadic lv rv next
            else super#visit_Let env monadic lv rv next
        | Lambda _ ->
            if not monadic then
              (* Arrow case *)
              let pats, e = destruct_lambdas rv in
              let g, args = destruct_apps e in
              if List.length pats = List.length args then
                (* Check if the arguments are exactly the lambdas *)
                let check_pat_arg ((pat, arg) : typed_pattern * texpression) =
                  match (pat.value, arg.e) with
                  | PatVar (v, _), Var vid -> v.id = vid
                  | _ -> false
                in
                if List.for_all check_pat_arg (List.combine pats args) then
                  self#visit_Let env monadic lv g next
                else super#visit_Let env monadic lv rv next
              else super#visit_Let env monadic lv rv next
            else super#visit_Let env monadic lv rv next
        | _ -> super#visit_Let env monadic lv rv next
    end
  in
  match def.body with
  | None -> def
  | Some body ->
      let body = { body with body = obj#visit_texpression () body.body } in
      { def with body = Some body }

(** Inline the useless variable (re-)assignments:

    A lot of intermediate variable assignments are introduced through the
    compilation to MIR and by the translation itself (and the variable used
    on the left is often unnamed).

    Note that many of them are just variable "reassignments": [let x = y in ...].
    Some others come from ??
    
    TODO: how do we call that when we introduce intermediate variable assignments
    for the arguments of a function call?

    [inline_named]: if [true], inline all the assignments of the form
    [let VAR = VAR in ...], otherwise inline only the ones where the variable
    on the left is anonymous.
    
    [inline_pure]: if [true], inline all the pure assignments where the variable
    on the left is anonymous, but the assignments where the r-expression is
    a non-primitive function call (i.e.: inline the binops, ADT constructions,
    etc.).

    TODO: we have a smallish issue which is that rvalues should be merged with
    expressions... For now, this forces us to substitute whenever we can, but
    leave the let-bindings where they are, and eliminated them in a subsequent
    pass (if they are useless).
 *)
let inline_useless_var_reassignments (ctx : trans_ctx) ~(inline_named : bool)
    ~(inline_const : bool) ~(inline_pure : bool) (def : fun_decl) : fun_decl =
  let obj =
    object (self)
      inherit [_] map_expression as super

      (** Visit the let-bindings to filter the useless ones (and update
          the substitution map while doing so *)
      method! visit_Let (env : texpression VarId.Map.t) monadic lv re e =
        (* In order to filter, we need to check first that:
           - the let-binding is not monadic
           - the left-value is a variable

           We also inline if the binding decomposes a structure that is to be
           extracted as a tuple, and the right value is a variable.
        *)
        match (monadic, lv.value) with
        | false, PatVar (lv_var, _) ->
            (* We can filter if: *)
            (* 1. the left variable is unnamed or [inline_named] is true *)
            let filter_left =
              match (inline_named, lv_var.basename) with
              | true, _ | _, None -> true
              | _ -> false
            in
            (* And either:
               2.1 the right-expression is a variable, a global or a const generic var *)
            let var_or_global = is_var re || is_cvar re || is_global re in
            (* Or:
               2.2 the right-expression is a constant-value and we inline constant values,
                   *or* it is a qualif with no arguments (we consider this as a const) *)
            let const_re =
              inline_const
              &&
              let is_const_adt =
                let app, args = destruct_apps re in
                if args = [] then
                  match app.e with
                  | Qualif _ -> true
                  | StructUpdate upd -> upd.updates = []
                  | _ -> false
                else false
              in
              is_const re || is_const_adt
            in
            (* Or:
               2.3 the right-expression is an ADT value, a projection or a
                   primitive function call *and* the flag [inline_pure] is set *)
            let pure_re =
              inline_pure
              &&
              let app, _ = destruct_apps re in
              match app.e with
              | Qualif qualif -> (
                  match qualif.id with
                  | AdtCons _ -> true (* ADT constructor *)
                  | Proj _ -> true (* Projector *)
                  | FunOrOp (Unop _ | Binop _) ->
                      true (* primitive function call *)
                  | FunOrOp (Fun _) -> false (* non-primitive function call *)
                  | _ -> false)
              | StructUpdate _ -> true (* ADT constructor *)
              | _ -> false
            in
            let filter =
              filter_left && (var_or_global || const_re || pure_re)
            in

            (* Update the rhs (we may perform substitutions inside, and it is
             * better to do them *before* we inline it *)
            let re = self#visit_texpression env re in
            (* Update the substitution environment *)
            let env = if filter then VarId.Map.add lv_var.id re env else env in
            (* Update the next expression *)
            let e = self#visit_texpression env e in
            (* Reconstruct the [let], only if the binding is not filtered *)
            if filter then e.e else Let (monadic, lv, re, e)
        | ( false,
            PatAdt
              {
                variant_id = None;
                field_values = [ { value = PatVar (lv_var, _); ty = _ } ];
              } ) ->
            (* Second case: we deconstruct a structure with one field that we will
               extract as tuple. *)
            let adt_id, _ = PureUtils.ty_as_adt re.ty in
            (* Update the rhs (we may perform substitutions inside, and it is
             * better to do them *before* we inline it *)
            let re = self#visit_texpression env re in
            if
              PureUtils.is_var re
              && type_decl_from_type_id_is_tuple_struct ctx.type_ctx.type_infos
                   adt_id
            then
              (* Update the substitution environment *)
              let env = VarId.Map.add lv_var.id re env in
              (* Update the next expression *)
              let e = self#visit_texpression env e in
              (* We filter the [let], and thus do not reconstruct it *)
              e.e
            else (* Nothing to do *)
              super#visit_Let env monadic lv re e
        | _ -> super#visit_Let env monadic lv re e

      (** Substitute the variables *)
      method! visit_Var (env : texpression VarId.Map.t) (vid : VarId.id) =
        match VarId.Map.find_opt vid env with
        | None -> (* No substitution *) super#visit_Var env vid
        | Some ne ->
            (* Substitute - note that we need to reexplore, because
             * there may be stacked substitutions, if we have:
             * var0 --> var1
             * var1 --> var2.
             *)
            self#visit_expression env ne.e
    end
  in
  match def.body with
  | None -> def
  | Some body ->
      let body =
        { body with body = obj#visit_texpression VarId.Map.empty body.body }
      in
      { def with body = Some body }

(** For the cases where we split the forward/backward functions.

    Given a forward or backward function call, is there, for every execution
    path, a child backward function called later with exactly the same input
    list prefix. We use this to filter useless function calls: if there are
    such child calls, we can remove this one (in case its outputs are not
    used).
    We do this check because we can't simply remove function calls whose
    outputs are not used, as they might fail. However, if a function fails,
    its children backward functions then fail on the same inputs (ignoring
    the additional inputs those receive).
    
    For instance, if we have:
    {[
      fn f<'a>(x : &'a mut T);
    ]}
    
    We often have things like this in the synthesized code:
    {[
      _ <-- f@fwd x;
      ...
      nx <-- f@back'a x y;
      ...
    ]}

    If [f@back'a x y] fails, then necessarily [f@fwd x] also fails.
    In this situation, we can remove the call [f@fwd x].
 *)
let expression_contains_child_call_in_all_paths (ctx : trans_ctx)
    (id0 : fun_id_or_trait_method_ref) (lp_id0 : LoopId.id option)
    (rg_id0 : T.RegionGroupId.id option) (generics0 : generic_args)
    (args0 : texpression list) (e : texpression) : bool =
  let check_call (fun_id1 : fun_or_op_id) (generics1 : generic_args)
      (args1 : texpression list) : bool =
    (* Check the fun_ids, to see if call1's function is a child of call0's function *)
    match fun_id1 with
    | Fun (FromLlbc (id1, lp_id1, rg_id1)) ->
        (* Both are "regular" calls: check if they come from the same rust function *)
        if id0 = id1 && lp_id0 = lp_id1 then
          (* Same rust functions: check the regions hierarchy *)
          let call1_is_child =
            match (rg_id0, rg_id1) with
            | None, _ ->
                (* The function used in call0 is the forward function: the one
                 * used in call1 is necessarily a child *)
                true
            | Some _, None ->
                (* Opposite of previous case *)
                false
            | Some rg_id0, Some rg_id1 ->
                if rg_id0 = rg_id1 then true
                else
                  (* We need to use the regions hierarchy *)
                  let regions_hierarchy =
                    let id0 =
                      match id0 with
                      | FunId fun_id -> fun_id
                      | TraitMethod (_, _, fun_decl_id) -> FRegular fun_decl_id
                    in
                    LlbcAstUtils.FunIdMap.find id0
                      ctx.fun_ctx.regions_hierarchies
                  in
                  (* Compute the set of ancestors of the function in call1 *)
                  let call1_ancestors =
                    LlbcAstUtils.list_ancestor_region_groups regions_hierarchy
                      rg_id1
                  in
                  (* Check if the function used in call0 is inside *)
                  T.RegionGroupId.Set.mem rg_id0 call1_ancestors
          in
          (* If call1 is a child, then we need to check if the input arguments
           * used in call0 are a prefix of the input arguments used in call1
           * (note call1 being a child, it will likely consume strictly more
           * given back values).
           * *)
          if call1_is_child then
            let call1_args =
              Collections.List.prefix (List.length args0) args1
            in
            let args = List.combine args0 call1_args in
            (* Note that the input values are expressions, *which may contain
             * meta-values* (which we need to ignore). *)
            let input_eq (v0, v1) =
              PureUtils.remove_meta v0 = PureUtils.remove_meta v1
            in
            (* Compare the generics and the prefix of the input arguments *)
            generics0 = generics1 && List.for_all input_eq args
          else (* Not a child *)
            false
        else (* Not the same function *)
          false
    | _ -> false
  in

  let visitor =
    object (self)
      inherit [_] reduce_expression
      method zero _ = false
      method plus b0 b1 _ = b0 () && b1 ()

      method! visit_texpression env e =
        match e.e with
        | Var _ | CVar _ | Const _ -> fun _ -> false
        | StructUpdate _ ->
            (* There shouldn't be monadic calls in structure updates - also
               note that by returning [false] we are conservative: we might
               *prevent* possible optimisations (i.e., filtering some function
               calls), which is sound. *)
            fun _ -> false
        | Let (_, _, re, e) -> (
            match opt_destruct_function_call re with
            | None -> fun () -> self#visit_texpression env e ()
            | Some (func1, generics1, args1) ->
                let call_is_child = check_call func1 generics1 args1 in
                if call_is_child then fun () -> true
                else fun () -> self#visit_texpression env e ())
        | Lambda (_, e) -> self#visit_texpression env e
        | App _ -> (
            fun () ->
              match opt_destruct_function_call e with
              | Some (func1, tys1, args1) -> check_call func1 tys1 args1
              | None -> false)
        | Qualif _ ->
            (* Note that this case includes functions without arguments *)
            fun () -> false
        | Meta (_, e) -> self#visit_texpression env e
        | Loop loop ->
            (* We only visit the *function end* *)
            self#visit_texpression env loop.fun_end
        | Switch (_, body) -> self#visit_switch_body env body

      method! visit_switch_body env body =
        match body with
        | If (e1, e2) ->
            fun () ->
              self#visit_texpression env e1 ()
              && self#visit_texpression env e2 ()
        | Match branches ->
            fun () ->
              List.for_all
                (fun br -> self#visit_texpression env br.branch ())
                branches
    end
  in
  visitor#visit_texpression () e ()

(** Filter the useless assignments (removes the useless variables, filters
    the function calls) *)
let filter_useless (filter_monadic_calls : bool) (ctx : trans_ctx)
    (def : fun_decl) : fun_decl =
  (* We first need a transformation on *left-values*, which filters the useless
   * variables and tells us whether the value contains any variable which has
   * not been replaced by [_] (in which case we need to keep the assignment,
   * etc.).
   * 
   * This is implemented as a map-reduce.
   *
   * Returns: ( filtered_left_value, *all_dummies* )
   *
   * [all_dummies]:
   * If the returned boolean is true, it means that all the variables appearing
   * in the filtered left-value are *dummies* (meaning that if this left-value
   * appears at the left of a let-binding, this binding might potentially be
   * removed).
   *)
  let lv_visitor =
    object
      inherit [_] mapreduce_typed_pattern
      method zero _ = true
      method plus b0 b1 _ = b0 () && b1 ()

      method! visit_PatVar env v mp =
        if VarId.Set.mem v.id env then (PatVar (v, mp), fun _ -> false)
        else (PatDummy, fun _ -> true)
    end
  in
  let filter_typed_pattern (used_vars : VarId.Set.t) (lv : typed_pattern) :
      typed_pattern * bool =
    let lv, all_dummies = lv_visitor#visit_typed_pattern used_vars lv in
    (lv, all_dummies ())
  in

  (* We then implement the transformation on *expressions* through a mapreduce.
   * Note that the transformation is bottom-up.
   * The map filters the useless assignments, the reduce computes the set of
   * used variables.
   *)
  let expr_visitor =
    object (self)
      inherit [_] mapreduce_expression as super
      method zero _ = VarId.Set.empty
      method plus s0 s1 _ = VarId.Set.union (s0 ()) (s1 ())

      (** Whenever we visit a variable, we need to register the used variable *)
      method! visit_Var _ vid = (Var vid, fun _ -> VarId.Set.singleton vid)

      method! visit_expression env e =
        match e with
        | Var _ | CVar _ | Const _ | App _ | Qualif _
        | Meta (_, _)
        | StructUpdate _ | Lambda _ ->
            super#visit_expression env e
        | Switch (scrut, switch) -> (
            match switch with
            | If (_, _) -> super#visit_expression env e
            | Match branches ->
                (* Simplify the branches *)
                let simplify_branch (br : match_branch) =
                  (* Compute the set of values used inside the branch *)
                  let branch, used = self#visit_texpression env br.branch in
                  (* Simplify the pattern *)
                  let pat, _ = filter_typed_pattern (used ()) br.pat in
                  { pat; branch }
                in
                super#visit_expression env
                  (Switch (scrut, Match (List.map simplify_branch branches))))
        | Let (monadic, lv, re, e) ->
            (* Compute the set of values used in the next expression *)
            let e, used = self#visit_texpression env e in
            let used = used () in
            (* Filter the left values *)
            let lv, all_dummies = filter_typed_pattern used lv in
            (* Small utility - called if we can't filter the let-binding *)
            let dont_filter () =
              let re, used_re = self#visit_texpression env re in
              let used = VarId.Set.union used (used_re ()) in
              (* Simplify the left pattern if it only contains dummy variables *)
              let lv =
                if all_dummies then
                  let ty = lv.ty in
                  let value = PatDummy in
                  { value; ty }
                else lv
              in
              (Let (monadic, lv, re, e), fun _ -> used)
            in
            (* Potentially filter the let-binding *)
            if all_dummies then
              if not monadic then
                (* Not a monadic let-binding: simple case *)
                (e.e, fun _ -> used)
              else
                (* Monadic let-binding: trickier.
                 * We can filter if the right-expression is a function call,
                 * under some conditions. *)
                match (filter_monadic_calls, opt_destruct_function_call re) with
                | true, Some (Fun (FromLlbc (fid, lp_id, rg_id)), tys, args) ->
                    (* If we split the forward/backward functions.

                       We need to check if there is a child call - see
                       the comments for:
                       [expression_contains_child_call_in_all_paths] *)
                    if not !Config.return_back_funs then
                      let has_child_call =
                        expression_contains_child_call_in_all_paths ctx fid
                          lp_id rg_id tys args e
                      in
                      if has_child_call then (* Filter *)
                        (e.e, fun _ -> used)
                      else (* No child call: don't filter *)
                        dont_filter ()
                    else dont_filter ()
                | _ ->
                    (* Not an LLBC function call or not allowed to filter: we can't filter *)
                    dont_filter ()
            else (* There are used variables: don't filter *)
              dont_filter ()
        | Loop loop ->
            (* We take care to ignore the varset computed on the *loop body* *)
            let fun_end, s = self#visit_texpression () loop.fun_end in
            let loop_body, _ = self#visit_texpression () loop.loop_body in
            (Loop { loop with fun_end; loop_body }, s)
    end
  in
  (* We filter only inside of transparent (i.e., non-opaque) definitions *)
  match def.body with
  | None -> def
  | Some body ->
      (* Visit the body *)
      let body_exp, used_vars = expr_visitor#visit_texpression () body.body in
      (* Visit the parameters - TODO: update: we can filter only if the definition
       * is not recursive (otherwise it might mess up with the decrease clauses:
       * the decrease clauses uses all the inputs given to the function, if some
       * inputs are replaced by '_' we can't give it to the function used in the
       * decreases clause).
       * For now we deactivate the filtering. *)
      let used_vars = used_vars () in
      let inputs_lvs =
        if false then
          List.map
            (fun lv -> fst (filter_typed_pattern used_vars lv))
            body.inputs_lvs
        else body.inputs_lvs
      in
      (* Return *)
      let body = { body with body = body_exp; inputs_lvs } in
      { def with body = Some body }

(** Simplify the lets immediately followed by a return.

    Ex.:
    {[
      x <-- f y;
      Return x

        ~~>

      f y
    ]}
 *)
let simplify_let_then_return _ctx def =
  let expr_visitor =
    object (self)
      inherit [_] map_expression

      method! visit_Let env monadic lv rv next_e =
        (* We do a bottom up traversal (simplifying in the children nodes
           can allow to simplify in the parent nodes) *)
        let rv = self#visit_texpression env rv in
        let next_e = self#visit_texpression env next_e in
        let not_simpl_e = Let (monadic, lv, rv, next_e) in
        match next_e.e with
        | Switch _ | Loop _ | Let _ ->
            (* Small shortcut to avoid doing the check on every let-binding *)
            not_simpl_e
        | _ -> (
            match typed_pattern_to_texpression lv with
            | None -> not_simpl_e
            | Some lv_v ->
                let lv_v =
                  if monadic then mk_result_return_texpression lv_v else lv_v
                in
                if lv_v = next_e then rv.e else not_simpl_e)
    end
  in

  match def.body with
  | None -> def
  | Some body ->
      (* Visit the body *)
      let body_exp = expr_visitor#visit_texpression () body.body in
      (* Return *)
      let body = { body with body = body_exp } in
      { def with body = Some body }

(** Simplify the aggregated ADTs.
    Ex.:
    {[
      type struct = { f0 : nat; f1 : nat; f2 : nat }

      Mkstruct x.f0 x.f1 x.f2 ~~> x
    ]}
 *)
let simplify_aggregates (ctx : trans_ctx) (def : fun_decl) : fun_decl =
  let expr_visitor =
    object
      inherit [_] map_expression as super

      (* Look for a type constructor applied to arguments *)
      method! visit_texpression env e =
        match e.e with
        | App _ -> (
            (* TODO: we should remove this case, which dates from before the
               introduction of [StructUpdate] *)
            let app, args = destruct_apps e in
            match app.e with
            | Qualif
                {
                  id = AdtCons { adt_id = TAdtId adt_id; variant_id = None };
                  generics;
                } ->
                (* This is a struct *)
                (* Retrieve the definiton, to find how many fields there are *)
                let adt_decl =
                  TypeDeclId.Map.find adt_id ctx.type_ctx.type_decls
                in
                let fields =
                  match adt_decl.kind with
                  | Enum _ | Opaque -> raise (Failure "Unreachable")
                  | Struct fields -> fields
                in
                let num_fields = List.length fields in
                (* In order to simplify, there must be as many arguments as
                 * there are fields *)
                assert (num_fields > 0);
                if num_fields = List.length args then
                  (* We now need to check that all the arguments are of the form:
                   * [x.field] for some variable [x], and where the projection
                   * is for the proper ADT *)
                  let to_var_proj (i : int) (arg : texpression) :
                      (generic_args * var_id) option =
                    match arg.e with
                    | App (proj, x) -> (
                        match (proj.e, x.e) with
                        | ( Qualif
                              {
                                id =
                                  Proj { adt_id = TAdtId proj_adt_id; field_id };
                                generics = proj_generics;
                              },
                            Var v ) ->
                            (* We check that this is the proper ADT, and the proper field *)
                            if
                              proj_adt_id = adt_id
                              && FieldId.to_int field_id = i
                            then Some (proj_generics, v)
                            else None
                        | _ -> None)
                    | _ -> None
                  in
                  let args = List.mapi to_var_proj args in
                  let args = List.filter_map (fun x -> x) args in
                  (* Check that all the arguments are of the expected form *)
                  if List.length args = num_fields then
                    (* Check that this is the same variable we project from -
                     * note that we checked above that there is at least one field *)
                    let (_, x), end_args = Collections.List.pop args in
                    if List.for_all (fun (_, y) -> y = x) end_args then (
                      (* We can substitute *)
                      (* Sanity check: all types correct *)
                      assert (
                        List.for_all
                          (fun (generics1, _) -> generics1 = generics)
                          args);
                      { e with e = Var x })
                    else super#visit_texpression env e
                  else super#visit_texpression env e
                else super#visit_texpression env e
            | _ -> super#visit_texpression env e)
        | StructUpdate { struct_id; init = None; updates } ->
            let adt_ty = e.ty in
            (* Attempt to convert all the field updates to projections
               of fields from an ADT with the same type *)
            let to_var_proj ((fid, arg) : FieldId.id * texpression) :
                var_id option =
              match arg.e with
              | App (proj, x) -> (
                  match (proj.e, x.e) with
                  | ( Qualif
                        {
                          id = Proj { adt_id = TAdtId proj_adt_id; field_id };
                          generics = _;
                        },
                      Var v ) ->
                      (* We check that this is the proper ADT, and the proper field *)
                      if
                        TAdtId proj_adt_id = struct_id
                        && field_id = fid && x.ty = adt_ty
                      then Some v
                      else None
                  | _ -> None)
              | _ -> None
            in
            let var_projs = List.map to_var_proj updates in
            let filt_var_projs = List.filter_map (fun x -> x) var_projs in
            if filt_var_projs = [] then super#visit_texpression env e
            else
              (* If all the projections are from the same variable [x], we
                 simply replace the whole expression with [x] *)
              let x = List.hd filt_var_projs in
              if
                List.length filt_var_projs = List.length updates
                && List.for_all (fun y -> y = x) filt_var_projs
              then { e with e = Var x }
              else if
                (* Attempt to create an "update" expression (i.e., of
                   the shape [{ x with f := v }]).

                   This is not supported by Coq *)
                !Config.backend <> Coq
              then (
                (* Compute the number of occurrences of each variable *)
                let occurs = ref VarId.Map.empty in
                List.iter
                  (fun x ->
                    let num =
                      match VarId.Map.find_opt x !occurs with
                      | None -> 1
                      | Some n -> n + 1
                    in
                    occurs := VarId.Map.add x num !occurs)
                  filt_var_projs;
                (* Find the max - note that we can initialize the max at 0,
                   because there is at least one variable *)
                let max = ref 0 in
                let x = ref x in
                List.iter
                  (fun (y, n) ->
                    if n > !max then (
                      max := n;
                      x := y))
                  (VarId.Map.bindings !occurs);
                (* Create the update expression *)
                let updates =
                  List.filter_map
                    (fun ((fid, fe), y_opt) ->
                      if y_opt = Some !x then None else Some (fid, fe))
                    (List.combine updates var_projs)
                in
                let supd =
                  StructUpdate { struct_id; init = Some !x; updates }
                in
                let e = { e with e = supd } in
                super#visit_texpression env e)
              else super#visit_texpression env e
        | _ -> super#visit_texpression env e
    end
  in
  match def.body with
  | None -> def
  | Some body ->
      (* Visit the body *)
      let body_exp = expr_visitor#visit_texpression () body.body in
      (* Return *)
      let body = { body with body = body_exp } in
      { def with body = Some body }

(** Return [None] if the function is a backward function with no outputs (so
    that we eliminate the definition which is useless).

    Note that the calls to such functions are filtered when translating from
    symbolic to pure. Here, we remove the definitions altogether, because they
    are now useless
  *)
let filter_if_backward_with_no_outputs (def : fun_decl) : fun_decl option =
  if
    !Config.filter_useless_functions
    && Option.is_some def.back_id
    && def.signature.output = mk_result_ty mk_unit_ty
    || def.signature.output = mk_unit_ty
  then None
  else Some def

(** Retrieve the loop definitions from the function definition.

    {!SymbolicToPure} generates an AST in which the loop bodies are part of
    the function body (see the {!Pure.Loop} node). This function extracts
    those function bodies into independent definitions while removing
    occurrences of the {!Pure.Loop} node.
 *)
let decompose_loops (_ctx : trans_ctx) (def : fun_decl) :
    fun_decl * fun_decl list =
  match def.body with
  | None -> (def, [])
  | Some body ->
      (* Count the number of loops *)
      let loops = ref LoopId.Set.empty in
      let expr_visitor =
        object
          inherit [_] iter_expression as super

          method! visit_Loop env loop =
            loops := LoopId.Set.add loop.loop_id !loops;
            super#visit_Loop env loop
        end
      in
      expr_visitor#visit_texpression () body.body;
      let num_loops = LoopId.Set.cardinal !loops in

      (* Store the loops here *)
      let loops = ref LoopId.Map.empty in
      let expr_visitor =
        object (self)
          inherit [_] map_expression

          method! visit_Loop env loop =
            let fun_sig = def.signature in
            let fwd_info = fun_sig.fwd_info in
            let fwd_effect_info = fwd_info.effect_info in
            let ignore_output = fwd_info.ignore_output in

            (* Generate the loop definition *)
            let loop_fwd_effect_info = fwd_effect_info in

            let loop_fwd_sig_info : fun_sig_info =
              let fuel = if !Config.use_fuel then 1 else 0 in
              let num_inputs = List.length loop.inputs in
              let fwd_info : inputs_info =
                let info = fwd_info.fwd_info in
                let fwd_state =
                  info.num_inputs_with_fuel_with_state
                  - info.num_inputs_with_fuel_no_state
                in
                {
                  has_fuel = !Config.use_fuel;
                  num_inputs_no_fuel_no_state = num_inputs;
                  num_inputs_with_fuel_no_state = num_inputs + fuel;
                  num_inputs_with_fuel_with_state =
                    num_inputs + fuel + fwd_state;
                }
              in

              { fwd_info; effect_info = loop_fwd_effect_info; ignore_output }
            in
            assert (fun_sig_info_is_wf loop_fwd_sig_info);

            let inputs_tys =
              let fuel = if !Config.use_fuel then [ mk_fuel_ty ] else [] in
              let fwd_inputs = List.map (fun (v : var) -> v.ty) loop.inputs in
              let info = fwd_info.fwd_info in
              let fwd_state =
                Collections.List.subslice fun_sig.inputs
                  info.num_inputs_with_fuel_no_state
                  info.num_inputs_with_fuel_with_state
              in
              let back_inputs =
                if !Config.return_back_funs then []
                else
                  snd
                    (Collections.List.split_at fun_sig.inputs
                       info.num_inputs_with_fuel_with_state)
              in
              List.concat [ fuel; fwd_inputs; fwd_state; back_inputs ]
            in

            let output = loop.output_ty in

            let loop_sig =
              {
                generics = fun_sig.generics;
                llbc_generics = fun_sig.llbc_generics;
                preds = fun_sig.preds;
                inputs = inputs_tys;
                output;
                fwd_info = loop_fwd_sig_info;
                back_effect_info = fun_sig.back_effect_info;
              }
            in

            let fuel_vars, inputs, inputs_lvs =
              (* Introduce the fuel input *)
              let fuel_vars, fuel0_var, fuel_lvs =
                if !Config.use_fuel then
                  let fuel0_var = mk_fuel_var loop.fuel0 in
                  let fuel_lvs = mk_typed_pattern_from_var fuel0_var None in
                  (Some (loop.fuel0, loop.fuel), [ fuel0_var ], [ fuel_lvs ])
                else (None, [], [])
              in

              (* Introduce the forward input state *)
              let fwd_state_var, fwd_state_lvs =
                assert (
                  loop_fwd_effect_info.stateful
                  = Option.is_some loop.input_state);
                match loop.input_state with
                | None -> ([], [])
                | Some input_state ->
                    let state_var = mk_state_var input_state in
                    let state_lvs = mk_typed_pattern_from_var state_var None in
                    ([ state_var ], [ state_lvs ])
              in

              (* Introduce the additional backward inputs, if necessary *)
              let fun_body = Option.get def.body in
              let info = fwd_info.fwd_info in
              let _, back_inputs =
                Collections.List.split_at fun_body.inputs
                  info.num_inputs_with_fuel_with_state
              in
              let _, back_inputs_lvs =
                Collections.List.split_at fun_body.inputs_lvs
                  info.num_inputs_with_fuel_with_state
              in

              let inputs =
                List.concat
                  [ fuel0_var; fwd_state_var; loop.inputs; back_inputs ]
              in
              let inputs_lvs =
                List.concat
                  [ fuel_lvs; fwd_state_lvs; loop.inputs_lvs; back_inputs_lvs ]
              in
              (fuel_vars, inputs, inputs_lvs)
            in

            (* Wrap the loop body in a match over the fuel *)
            let loop_body =
              match fuel_vars with
              | None -> loop.loop_body
              | Some (fuel0, fuel) ->
                  SymbolicToPure.wrap_in_match_fuel fuel0 fuel loop.loop_body
            in

            let loop_body = { inputs; inputs_lvs; body = loop_body } in

            let loop_def : fun_decl =
              {
                def_id = def.def_id;
                is_local = def.is_local;
                meta = loop.meta;
                kind = def.kind;
                num_loops;
                loop_id = Some loop.loop_id;
                back_id = def.back_id;
                llbc_name = def.llbc_name;
                name = def.name;
                signature = loop_sig;
                is_global_decl_body = def.is_global_decl_body;
                body = Some loop_body;
              }
            in
            (* Store the loop definition *)
            loops := LoopId.Map.add_strict loop.loop_id loop_def !loops;

            (* Update the current expression to remove the [Loop] node, and continue *)
            (self#visit_texpression env loop.fun_end).e
        end
      in

      let body_expr = expr_visitor#visit_texpression () body.body in
      let body = { body with body = body_expr } in
      let def = { def with body = Some body; num_loops } in
      let loops = List.map snd (LoopId.Map.bindings !loops) in
      (def, loops)

(** Return [false] if the forward function is useless and should be filtered.

    - a forward function with no output (comes from a Rust function with
      unit return type)
    - the function has mutable borrows as inputs (which is materialized
      by the fact we generated backward functions which were not filtered).

    In such situation, every call to the Rust function will be translated to:
    - a call to the forward function which returns nothing
    - calls to the backward functions
    As a failing backward function implies the forward function also fails,
    we can filter the calls to the forward function, which thus becomes
    useless.
    In such situation, we can remove the forward function definition
    altogether.
  *)
let keep_forward (fwd : fun_and_loops) (backs : fun_and_loops list) : bool =
  (* The question of filtering the forward functions arises only if we split
     the forward/backward functions *)
  if !Config.return_back_funs then true
  else if
    (* Note that at this point, the output types are no longer seen as tuples:
     * they should be lists of length 1. *)
    !Config.filter_useless_functions
    && fwd.f.signature.output = mk_result_ty mk_unit_ty
    && backs <> []
  then false
  else true

(** Convert the unit variables to [()] if they are used as right-values or
    [_] if they are used as left values in patterns. *)
let unit_vars_to_unit (def : fun_decl) : fun_decl =
  (* The map visitor *)
  let obj =
    object
      inherit [_] map_expression as super

      (** Replace in patterns *)
      method! visit_PatVar _ v mp =
        if v.ty = mk_unit_ty then PatDummy else PatVar (v, mp)

      (** Replace in "regular" expressions - note that we could limit ourselves
          to variables, but this is more powerful
       *)
      method! visit_texpression env e =
        if e.ty = mk_unit_ty then mk_unit_rvalue
        else super#visit_texpression env e
    end
  in
  (* Update the body *)
  match def.body with
  | None -> def
  | Some body ->
      let body_exp = obj#visit_texpression () body.body in
      (* Update the input parameters *)
      let inputs_lvs = List.map (obj#visit_typed_pattern ()) body.inputs_lvs in
      (* Return *)
      let body = Some { body with body = body_exp; inputs_lvs } in
      { def with body }

(** Eliminate the box functions like [Box::new] (which is translated to the
    identity) and [Box::free] (which is translated to [()]).

    Note that the box types have already been eliminated during the translation
    from symbolic to pure.
    The reason why we don't eliminate the box functions at the same time is
    that we would need to eliminate them in two different places: when translating
    function calls, and when translating end abstractions. Here, we can do
    something simpler, in one micro-pass.
 *)
let eliminate_box_functions (_ctx : trans_ctx) (def : fun_decl) : fun_decl =
  (* The map visitor *)
  let obj =
    object
      inherit [_] map_expression as super

      method! visit_texpression env e =
        match opt_destruct_function_call e with
        | Some (fun_id, _tys, args) -> (
            (* Below, when dealing with the arguments: we consider the very
             * general case, where functions could be boxed (meaning we
             * could have: [box_new f x])
             * *)
            match fun_id with
            | Fun (FromLlbc (FunId (FAssumed aid), _lp_id, rg_id)) -> (
                match (aid, rg_id) with
                | BoxNew, _ ->
                    assert (rg_id = None);
                    let arg, args = Collections.List.pop args in
                    mk_apps arg args
                | BoxFree, _ ->
                    assert (args = []);
                    mk_unit_rvalue
                | ( ( SliceIndexShared | SliceIndexMut | ArrayIndexShared
                    | ArrayIndexMut | ArrayToSliceShared | ArrayToSliceMut
                    | ArrayRepeat ),
                    _ ) ->
                    super#visit_texpression env e)
            | _ -> super#visit_texpression env e)
        | _ -> super#visit_texpression env e
    end
  in
  (* Update the body *)
  match def.body with
  | None -> def
  | Some body ->
      let body = Some { body with body = obj#visit_texpression () body.body } in
      { def with body }

(** Decompose let-bindings by introducing intermediate let-bindings.

    This is a utility function: see {!decompose_monadic_let_bindings} and
    {!decompose_nested_let_patterns}.

    [decompose_monadic]: always decompose a monadic let-binding
    [decompose_nested_pats]: decompose the nested patterns
 *)
let decompose_let_bindings (decompose_monadic : bool)
    (decompose_nested_pats : bool) (_ctx : trans_ctx) (def : fun_decl) :
    fun_decl =
  match def.body with
  | None -> def
  | Some body ->
      (* Set up the var id generator *)
      let cnt = get_body_min_var_counter body in
      let _, fresh_id = VarId.mk_stateful_generator cnt in
      let mk_fresh (ty : ty) : typed_pattern * texpression =
        let vid = fresh_id () in
        let tmp : var = { id = vid; basename = None; ty } in
        let ltmp = mk_typed_pattern_from_var tmp None in
        let rtmp = mk_texpression_from_var tmp in
        (ltmp, rtmp)
      in

      (* Utility function - returns the patterns to introduce, from the last to
         the first.

         For instance, if it returns:
         {[
           ([
              ((x3, x4), x1);
              ((x1, x2), tmp)
            ],
            (x0, tmp))
         ]}
         then we need to introduce:
         {[
           let (x0, tmp) = original_term in
           let (x1, x2) = tmp in
           let (x3, x4) = x1 in
           ...
         }]
      *)
      let decompose_pat (lv : typed_pattern) :
          (typed_pattern * texpression) list * typed_pattern =
        let patterns = ref [] in

        (* We decompose patterns *inside* other patterns.
           The boolean [inside] allows us to remember if we dived into a
           pattern already *)
        let visit_pats =
          object
            inherit [_] map_typed_pattern as super

            method! visit_typed_pattern (inside : bool) (pat : typed_pattern)
                : typed_pattern =
              match pat.value with
              | PatConstant _ | PatVar _ | PatDummy -> pat
              | PatAdt _ ->
                  if not inside then super#visit_typed_pattern true pat
                  else
                    let ltmp, rtmp = mk_fresh pat.ty in
                    let pat = super#visit_typed_pattern false pat in
                    patterns := (pat, rtmp) :: !patterns;
                    ltmp
          end
        in

        let inside = false in
        let lv = visit_pats#visit_typed_pattern inside lv in
        (!patterns, lv)
      in

      (* It is a very simple map *)
      let visit_lets =
        object (self)
          inherit [_] map_expression as super

          method! visit_Let env monadic lv re next_e =
            (* Decompose the monadic let-bindings *)
            let monadic, lv, re, next_e =
              if (not monadic) || not decompose_monadic then
                (monadic, lv, re, next_e)
              else
                (* If monadic, we need to check if the left-value is a variable:
                 * - if yes, don't decompose
                 * - if not, make the decomposition in two steps
                 *)
                match lv.value with
                | PatVar _ | PatDummy ->
                    (* Variable: nothing to do *)
                    (monadic, lv, re, next_e)
                | _ ->
                    (* Not a variable: decompose if required *)
                    (* Introduce a temporary variable to receive the value of the
                     * monadic binding *)
                    let ltmp, rtmp = mk_fresh lv.ty in
                    (* Visit the next expression *)
                    let next_e = self#visit_texpression env next_e in
                    (* Create the let-bindings *)
                    (monadic, ltmp, re, mk_let false lv rtmp next_e)
            in
            (* Decompose the nested let-patterns *)
            let lv, next_e =
              if not decompose_nested_pats then (lv, next_e)
              else
                let pats, first_pat = decompose_pat lv in
                let e =
                  List.fold_left
                    (fun next_e (lpat, rv) -> mk_let false lpat rv next_e)
                    next_e pats
                in
                (first_pat, e)
            in
            (* Continue *)
            super#visit_Let env monadic lv re next_e
        end
      in
      (* Update the body *)
      let body =
        Some { body with body = visit_lets#visit_texpression () body.body }
      in
      (* Return *)
      { def with body }

(** Decompose monadic let-bindings.

    See the explanations in {!val:Config.decompose_monadic_let_bindings}
 *)
let decompose_monadic_let_bindings (ctx : trans_ctx) (def : fun_decl) : fun_decl
    =
  decompose_let_bindings true false ctx def

(** Decompose the nested let patterns.

    See the explanations in {!val:Config.decompose_nested_let_patterns}
 *)
let decompose_nested_let_patterns (ctx : trans_ctx) (def : fun_decl) : fun_decl
    =
  decompose_let_bindings false true ctx def

(** Unfold the monadic let-bindings to explicit matches. *)
let unfold_monadic_let_bindings (_ctx : trans_ctx) (def : fun_decl) : fun_decl =
  match def.body with
  | None -> def
  | Some body ->
      let cnt = get_body_min_var_counter body in
      let _, fresh_id = VarId.mk_stateful_generator cnt in

      (* It is a very simple map *)
      let obj =
        object (_self)
          inherit [_] map_expression as super

          method! visit_Let env monadic lv re e =
            (* We simply do the following transformation:
               {[
                 pat <-- re; e

                     ~~>

                 match re with
                 | Fail err -> Fail err
                 | Return pat -> e
               ]}
            *)
            (* TODO: we should use a monad "kind" instead of a boolean *)
            if not monadic then super#visit_Let env monadic lv re e
            else
              (* We don't do the same thing if we use a state-error monad or simply
                 an error monad.
                 Note that some functions always live in the error monad (arithmetic
                 operations, for instance).
              *)
              (* TODO: this information should be computed in SymbolicToPure and
               * store in an enum ("monadic" should be an enum, not a bool). *)
              let re_ty = Option.get (opt_destruct_result re.ty) in
              assert (lv.ty = re_ty);
              let err_vid = fresh_id () in
              let err_var : var =
                {
                  id = err_vid;
                  basename = Some ConstStrings.error_basename;
                  ty = mk_error_ty;
                }
              in
              let err_pat = mk_typed_pattern_from_var err_var None in
              let fail_pat = mk_result_fail_pattern err_pat.value lv.ty in
              let err_v = mk_texpression_from_var err_var in
              let fail_value = mk_result_fail_texpression err_v e.ty in
              let fail_branch = { pat = fail_pat; branch = fail_value } in
              let success_pat = mk_result_return_pattern lv in
              let success_branch = { pat = success_pat; branch = e } in
              let switch_body = Match [ fail_branch; success_branch ] in
              let e = Switch (re, switch_body) in
              (* Continue *)
              super#visit_expression env e
        end
      in
      (* Update the body *)
      let body_e = obj#visit_texpression () body.body in
      let body = { body with body = body_e } in
      (* Return *)
      { def with body = Some body }

(** Auxiliary function for {!apply_passes_to_def} *)
let apply_end_passes_to_def (ctx : trans_ctx) (def : fun_decl) : fun_decl =
  (* Convert the unit variables to [()] if they are used as right-values or
   * [_] if they are used as left values. *)
  let def = unit_vars_to_unit def in
  log#ldebug
    (lazy ("unit_vars_to_unit:\n\n" ^ fun_decl_to_string ctx def ^ "\n"));

  (* Introduce the special structure create/update expressions *)
  let def = intro_struct_updates ctx def in
  log#ldebug
    (lazy ("intro_struct_updates:\n\n" ^ fun_decl_to_string ctx def ^ "\n"));

  (* Simplify the let-bindings *)
  let def = simplify_let_bindings ctx def in
  log#ldebug
    (lazy ("simplify_let_bindings:\n\n" ^ fun_decl_to_string ctx def ^ "\n"));

  (* Inline the useless variable reassignments *)
  let def =
    inline_useless_var_reassignments ctx ~inline_named:true ~inline_const:true
      ~inline_pure:true def
  in
  log#ldebug
    (lazy
      ("inline_useless_var_assignments:\n\n" ^ fun_decl_to_string ctx def ^ "\n"));

  (* Eliminate the box functions - note that the "box" types were eliminated
   * during the symbolic to pure phase: see the comments for [eliminate_box_functions] *)
  let def = eliminate_box_functions ctx def in
  log#ldebug
    (lazy ("eliminate_box_functions:\n\n" ^ fun_decl_to_string ctx def ^ "\n"));

  (* Filter the useless variables, assignments, function calls, etc. *)
  let def = filter_useless !Config.filter_useless_monadic_calls ctx def in
  log#ldebug (lazy ("filter_useless:\n\n" ^ fun_decl_to_string ctx def ^ "\n"));

  (* Simplify the lets immediately followed by a return.

     Ex.:
     {[
       x <-- f y;
       Return x

         ~~>

       f y
     ]}
  *)
  let def = simplify_let_then_return ctx def in
  log#ldebug
    (lazy ("simplify_let_then_return:\n\n" ^ fun_decl_to_string ctx def ^ "\n"));

  (* Simplify the aggregated ADTs.

     Ex.:
     {[
       (* type struct = { f0 : nat; f1 : nat; f2 : nat } *)

       Mkstruct x.f0 x.f1 x.f2                 ~~> x
       { f0 := x.f0; f1 := x.f1; f2 := x.f2 }  ~~> x
       { f0 := x.f0; f1 := x.f1; f2 := v }     ~~> { x with f2 = v }
     ]}
  *)
  let def = simplify_aggregates ctx def in
  log#ldebug
    (lazy ("simplify_aggregates:\n\n" ^ fun_decl_to_string ctx def ^ "\n"));

  (* Simplify the let-bindings - some simplifications may have been unlocked by
     the pass above (for instance, the lambda simplification) *)
  let def = simplify_let_bindings ctx def in
  log#ldebug
    (lazy
      ("simplify_let_bindings (pass 2):\n\n" ^ fun_decl_to_string ctx def ^ "\n"));

  (* Inline the useless vars again *)
  let def =
    inline_useless_var_reassignments ctx ~inline_named:true ~inline_const:true
      ~inline_pure:false def
  in
  log#ldebug
    (lazy
      ("inline_useless_var_assignments (pass 2):\n\n"
     ^ fun_decl_to_string ctx def ^ "\n"));

  (* Decompose the monadic let-bindings - used by Coq *)
  let def =
    if !Config.decompose_monadic_let_bindings then (
      let def = decompose_monadic_let_bindings ctx def in
      log#ldebug
        (lazy
          ("decompose_monadic_let_bindings:\n\n" ^ fun_decl_to_string ctx def
         ^ "\n"));
      def)
    else (
      log#ldebug
        (lazy
          "ignoring decompose_monadic_let_bindings due to the configuration\n");
      def)
  in

  (* Decompose nested let-patterns *)
  let def =
    if !Config.decompose_nested_let_patterns then (
      let def = decompose_nested_let_patterns ctx def in
      log#ldebug
        (lazy
          ("decompose_nested_let_patterns:\n\n" ^ fun_decl_to_string ctx def
         ^ "\n"));
      def)
    else (
      log#ldebug
        (lazy
          "ignoring decompose_nested_let_patterns due to the configuration\n");
      def)
  in

  (* Unfold the monadic let-bindings *)
  let def =
    if !Config.unfold_monadic_let_bindings then (
      let def = unfold_monadic_let_bindings ctx def in
      log#ldebug
        (lazy
          ("unfold_monadic_let_bindings:\n\n" ^ fun_decl_to_string ctx def
         ^ "\n"));
      def)
    else (
      log#ldebug
        (lazy "ignoring unfold_monadic_let_bindings due to the configuration\n");
      def)
  in

  (* We are done *)
  def

(** Small utility for {!filter_loop_inputs} *)
let filter_prefix (keep : bool list) (ls : 'a list) : 'a list =
  let ls0, ls1 = Collections.List.split_at ls (List.length keep) in
  let ls0 =
    List.filter_map
      (fun (b, x) -> if b then Some x else None)
      (List.combine keep ls0)
  in
  List.append ls0 ls1

type fun_loop_id = A.fun_id * LoopId.id option [@@deriving show, ord]

module FunLoopIdOrderedType = struct
  type t = fun_loop_id

  let compare = compare_fun_loop_id
  let to_string = show_fun_loop_id
  let pp_t = pp_fun_loop_id
  let show_t = show_fun_loop_id
end

module FunLoopIdMap = Collections.MakeMap (FunLoopIdOrderedType)

(** Filter the useless loop input parameters. *)
let filter_loop_inputs (transl : pure_fun_translation list) :
    pure_fun_translation list =
  (* We need to explore groups of mutually recursive functions. In order
     to compute which parameters are useless, we need to explore the
     functions by groups of mutually recursive definitions.

     Because every Rust function is translated to a list of functions (forward
     function, backward functions, loop functions, etc.), and those functions
     might depend on each others in different ways, we recompute the SCCs of
     the whole module.

     Rem.: we also redo this computation, on a smaller scale, in {!Translate}.
     Maybe we can factor out the two.
  *)
  let all_decls =
    List.concat
      (List.concat
         (List.concat
            (List.map
               (fun { fwd; backs; _ } ->
                 [ fwd.f :: fwd.loops ]
                 :: List.map
                      (fun { f = back; loops = loops_back } ->
                        [ back :: loops_back ])
                      backs)
               transl)))
  in
  let subgroups = ReorderDecls.group_reorder_fun_decls all_decls in

  (* Explore the subgroups one by one.

     For now, we only filter the parameters of loop functions which are simply
     recursive.

     Rem.: there is a bit of redundancy in computing the useless parameters
     for the loop forward *and* the loop backward functions.
  *)
  (* The [filtered] map: maps function identifiers to filtering information.

     Note that we ignore the backward id:
     - we filter the forward inputs only
     - we want the filtering to be the same for the forward and the backward
       functions
     The reason is that for now we want to preserve the fact that a backward
     function takes the same inputs as its associated forward function, with
     additional parameters.
  *)
  let used_map = ref FunLoopIdMap.empty in

  (* We start by computing the filtering information, for each function *)
  let compute_one_filter_info (decl : fun_decl) =
    (* There should be a body *)
    let body = Option.get decl.body in
    (* We only look at the forward inputs, without the state *)
    let inputs_prefix, _ =
      Collections.List.split_at body.inputs
        decl.signature.fwd_info.fwd_info.num_inputs_with_fuel_no_state
    in
    let used = ref (List.map (fun v -> (var_get_id v, false)) inputs_prefix) in
    let inputs_prefix_length = List.length inputs_prefix in
    let inputs =
      List.map
        (fun v -> (var_get_id v, mk_texpression_from_var v))
        inputs_prefix
    in
    let inputs_set = VarId.Set.of_list (List.map var_get_id inputs_prefix) in
    assert (Option.is_some decl.loop_id);

    let fun_id = (E.FRegular decl.def_id, decl.loop_id) in

    let set_used vid =
      used := List.map (fun (vid', b) -> (vid', b || vid = vid')) !used
    in

    (* Set the fuel as used *)
    let sg_info = decl.signature.fwd_info in
    if sg_info.fwd_info.has_fuel then
      set_used (fst (Collections.List.nth inputs 0));

    let visitor =
      object (self : 'self)
        inherit [_] iter_expression as super

        (** Override the expression visitor, to look for loop function calls *)
        method! visit_texpression env e =
          match e.e with
          | App _ -> (
              (* If this is an app: destruct all the arguments, and check if
                 the leftmost expression is the loop function call *)
              let e_app, args = destruct_apps e in
              match e_app.e with
              | Qualif qualif -> (
                  match qualif.id with
                  | FunOrOp (Fun (FromLlbc (FunId fun_id', loop_id', _))) ->
                      if (fun_id', loop_id') = fun_id then (
                        (* For each argument, check if it is exactly the original
                           input parameter. Note that there shouldn't be partial
                           applications of loop functions: the number of arguments
                           should be exactly the number of input parameters (i.e.,
                           we can use [combine])
                        *)
                        let beg_args, end_args =
                          Collections.List.split_at args inputs_prefix_length
                        in
                        let used_args = List.combine inputs beg_args in
                        List.iter
                          (fun ((vid, var), arg) ->
                            if var <> arg then (
                              self#visit_texpression env arg;
                              set_used vid))
                          used_args;
                        List.iter (self#visit_texpression env) end_args)
                      else super#visit_texpression env e
                  | _ -> super#visit_texpression env e)
              | _ -> super#visit_texpression env e)
          | _ -> super#visit_texpression env e

        (** If we visit a variable which is actually an input parameter, we
            set it as used. Note that we take care of ignoring some of those
            input parameters given in [visit_texpression].
          *)
        method! visit_var_id _ id =
          if VarId.Set.mem id inputs_set then set_used id
      end
    in
    visitor#visit_texpression () body.body;

    (* Save the filtering information, if there is anything to filter *)
    if List.exists snd !used then
      let used = List.map snd !used in
      let used =
        match FunLoopIdMap.find_opt fun_id !used_map with
        | None -> used
        | Some used0 ->
            List.map (fun (b0, b1) -> b0 || b1) (List.combine used0 used)
      in
      used_map := FunLoopIdMap.add fun_id used !used_map
  in
  List.iter
    (fun (_, fl) ->
      match fl with
      | [ f ] ->
          (* Group made of one function: check if it is a loop. If it is the
             case, explore it. *)
          if Option.is_some f.loop_id then compute_one_filter_info f else ()
      | _ ->
          (* Group of mutually recursive functions: ignore for now *)
          ())
    subgroups;

  (* We then apply the filtering to all the function definitions at once *)
  let filter_in_one (decl : fun_decl) : fun_decl =
    (* Filter the function signature *)
    let fun_id = (E.FRegular decl.def_id, decl.loop_id) in
    let decl =
      match FunLoopIdMap.find_opt fun_id !used_map with
      | None -> (* Nothing to filter *) decl
      | Some used_info ->
          let num_filtered =
            List.length (List.filter (fun b -> not b) used_info)
          in
          let {
            generics;
            llbc_generics;
            preds;
            inputs;
            output;
            fwd_info;
            back_effect_info;
          } =
            decl.signature
          in
          let { fwd_info; effect_info; ignore_output } = fwd_info in

          let {
            has_fuel;
            num_inputs_no_fuel_no_state;
            num_inputs_with_fuel_no_state;
            num_inputs_with_fuel_with_state;
          } =
            fwd_info
          in

          let inputs = filter_prefix used_info inputs in

          let fwd_info =
            {
              has_fuel;
              num_inputs_no_fuel_no_state =
                num_inputs_no_fuel_no_state - num_filtered;
              num_inputs_with_fuel_no_state =
                num_inputs_with_fuel_no_state - num_filtered;
              num_inputs_with_fuel_with_state =
                num_inputs_with_fuel_with_state - num_filtered;
            }
          in

          let fwd_info = { fwd_info; effect_info; ignore_output } in
          assert (fun_sig_info_is_wf fwd_info);
          let signature =
            {
              generics;
              llbc_generics;
              preds;
              inputs;
              output;
              fwd_info;
              back_effect_info;
            }
          in

          { decl with signature }
    in

    (* Filter the function body *)
    let body =
      match decl.body with
      | None -> None
      | Some body ->
          (* Update the list of vars *)
          let { inputs; inputs_lvs; body } = body in

          let inputs, inputs_lvs =
            match FunLoopIdMap.find_opt fun_id !used_map with
            | None -> (* Nothing to filter *) (inputs, inputs_lvs)
            | Some used_info ->
                let inputs = filter_prefix used_info inputs in
                let inputs_lvs = filter_prefix used_info inputs_lvs in
                (inputs, inputs_lvs)
          in

          (* Update the body expression *)
          let visitor =
            object (self)
              inherit [_] map_expression as super

              method! visit_texpression env e =
                match e.e with
                | App _ -> (
                    let e_app, args = destruct_apps e in
                    match e_app.e with
                    | Qualif qualif -> (
                        match qualif.id with
                        | FunOrOp (Fun (FromLlbc (FunId fun_id, loop_id, _)))
                          -> (
                            match
                              FunLoopIdMap.find_opt (fun_id, loop_id) !used_map
                            with
                            | None -> super#visit_texpression env e
                            | Some used_info ->
                                (* Filter the types in the arrow type *)
                                let tys, ret_ty = destruct_arrows e_app.ty in
                                let tys = filter_prefix used_info tys in
                                let ty = mk_arrows tys ret_ty in
                                let e_app = { e_app with ty } in

                                (* Filter the arguments *)
                                let args = filter_prefix used_info args in

                                (* Explore the arguments *)
                                let args =
                                  List.map (self#visit_texpression env) args
                                in

                                (* Rebuild *)
                                mk_apps e_app args)
                        | _ ->
                            let e_app = self#visit_texpression env e_app in
                            let args =
                              List.map (self#visit_texpression env) args
                            in
                            mk_apps e_app args)
                    | _ ->
                        let e_app = self#visit_texpression env e_app in
                        let args = List.map (self#visit_texpression env) args in
                        mk_apps e_app args)
                | _ -> super#visit_texpression env e
            end
          in
          let body = visitor#visit_texpression () body in
          Some { inputs; inputs_lvs; body }
    in
    { decl with body }
  in
  let transl =
    List.map
      (fun trans ->
        let filter_fun_and_loops f =
          { f = filter_in_one f.f; loops = List.map filter_in_one f.loops }
        in
        let fwd = filter_fun_and_loops trans.fwd in
        let backs = List.map filter_fun_and_loops trans.backs in
        { trans with fwd; backs })
      transl
  in

  (* Return *)
  transl

(** Apply all the micro-passes to a function.

    As loops are initially directly integrated into the function definition,
    {!apply_passes_to_def} extracts those loops definitions from the body;
    it thus returns the pair: (function def, loop defs). See {!decompose_loops}
    for more information.

    Will return [None] if the function is a backward function with no outputs.

    [ctx]: used only for printing.
 *)
let apply_passes_to_def (ctx : trans_ctx) (def : fun_decl) :
    fun_and_loops option =
  (* Debug *)
  log#ldebug
    (lazy
      ("PureMicroPasses.apply_passes_to_def: " ^ def.name ^ " ("
      ^ Print.option_to_string T.RegionGroupId.to_string def.back_id
      ^ ")"));

  log#ldebug (lazy ("original decl:\n\n" ^ fun_decl_to_string ctx def ^ "\n"));

  (* First, find names for the variables which are unnamed *)
  let def = compute_pretty_names def in
  log#ldebug
    (lazy ("compute_pretty_name:\n\n" ^ fun_decl_to_string ctx def ^ "\n"));

  (* TODO: we might want to leverage more the assignment meta-data, for
   * aggregates for instance. *)

  (* TODO: reorder the branches of the matches/switches *)

  (* The meta-information is now useless: remove it.
   * Rk.: some passes below use the fact that we removed the meta-data
   * (otherwise we would have to "unmeta" expressions before matching) *)
  let def = remove_meta def in
  log#ldebug (lazy ("remove_meta:\n\n" ^ fun_decl_to_string ctx def ^ "\n"));

  (* Remove the backward functions with no outputs.

     Note that the *calls* to those functions should already have been removed,
     when translating from symbolic to pure. Here, we remove the definitions
     altogether, because they are now useless *)
  let name = def.name ^ PrintPure.fun_suffix def.loop_id def.back_id in
  let opt_def = filter_if_backward_with_no_outputs def in

  match opt_def with
  | None ->
      log#ldebug (lazy ("filtered (backward with no outputs): " ^ name ^ "\n"));
      None
  | Some def ->
      log#ldebug
        (lazy ("not filtered (not backward with no outputs): " ^ name ^ "\n"));

      (* Extract the loop definitions by removing the {!Loop} node *)
      let def, loops = decompose_loops ctx def in

      (* Apply the remaining passes *)
      let f = apply_end_passes_to_def ctx def in
      let loops = List.map (apply_end_passes_to_def ctx) loops in
      Some { f; loops }

(** Apply the micro-passes to a list of forward/backward translations.

    This function also extracts the loop definitions from the function body
    (see {!decompose_loops}).

    It also returns a boolean indicating whether the forward function should be kept
    or not at extraction time ([true] means we need to keep the forward function).

    Note that we don't "filter" the forward function and return a boolean instead,
    because this function contains useful information to extract the backward
    functions. Note that here, keeping the forward function it is not *necessary*
    but convenient.
 *)
let apply_passes_to_pure_fun_translations (ctx : trans_ctx)
    (transl : (fun_decl * fun_decl list) list) : pure_fun_translation list =
  let apply_to_one (trans : fun_decl * fun_decl list) : pure_fun_translation =
    (* Apply the passes to the individual functions *)
    let fwd, backs = trans in
    let fwd = Option.get (apply_passes_to_def ctx fwd) in
    let backs = List.filter_map (apply_passes_to_def ctx) backs in
    (* Compute whether we need to filter the forward function or not *)
    let keep_fwd = keep_forward fwd backs in
    { keep_fwd; fwd; backs }
  in

  let transl = List.map apply_to_one transl in

  (* Filter the useless inputs in the loop functions *)
  filter_loop_inputs transl