~technomancy/fnlfmt

ref: 87c5ad517ecd75669b0b9ce82da72096a59700c8 fnlfmt/fnlfmt -rwxr-xr-x 159.2 KiB
87c5ad51Phil Hagelberg Support adding line breaks in, not just indentation. 8 months ago
                                                                                
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
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
#!/usr/bin/env lua
package.preload["fnlfmt"] = package.preload["fnlfmt"] or function(...)
  local view = require("fennelview")
  local function identify_line(line, pos, stack)
    local closers = {[")"] = "(", ["\""] = "\"", ["]"] = "[", ["}"] = "{"}
    local char = line:sub(pos, pos)
    local looking_for = stack[#stack]
    local continue = nil
    local function _0_()
      return identify_line(line, (pos - 1), stack)
    end
    continue = _0_
    if (0 == pos) then
      return nil
    elseif (line:sub((pos - 1), (pos - 1)) == "\\") then
      return continue()
    elseif (looking_for == char) then
      table.remove(stack)
      return continue()
    elseif (closers[char] and (looking_for ~= "\"")) then
      table.insert(stack, closers[char])
      return continue()
    elseif looking_for then
      return continue()
    elseif (("[" == char) or ("{" == char)) then
      return "table", pos
    elseif ("(" == char) then
      return "call", pos, line
    elseif "else" then
      return continue()
    end
  end
  local function symbol_at(line, pos)
    return line:sub(pos):match("[^%s]+")
  end
  local body_specials = {["\206\187"] = true, ["do"] = true, ["eval-compiler"] = true, ["for"] = true, ["while"] = true, doto = true, each = true, fn = true, lambda = true, let = true, macro = true, match = true, when = true}
  local function remove_comment(line, in_string_3f, pos)
    if (#line < pos) then
      return line
    elseif (line:sub(pos, pos) == "\"") then
      return remove_comment(line, not in_string_3f, (pos + 1))
    elseif ((line:sub(pos, pos) == ";") and not in_string_3f) then
      return line:sub(1, (pos - 1))
    else
      return remove_comment(line, in_string_3f, (pos + 1))
    end
  end
  local function identify_indent_type(lines, last, stack)
    local line = remove_comment((lines[last] or ""), false, 1)
    local _0_0, _1_0, _2_0 = identify_line(line, #line, stack)
    if ((_0_0 == "table") and (nil ~= _1_0)) then
      local pos = _1_0
      return "table", pos
    elseif ((_0_0 == "call") and (nil ~= _1_0) and (_2_0 == line)) then
      local pos = _1_0
      local function_name = symbol_at(line, (pos + 1))
      if body_specials[function_name] then
        return "body-special", (pos - 1)
      else
        return "call", (pos - 1), function_name
      end
    else
      local _3_
      do
        local _ = _0_0
        _3_ = (true and (1 < last))
      end
      if _3_ then
        local _ = _0_0
        return identify_indent_type(lines, (last - 1), stack)
      end
    end
  end
  local function indentation(lines, prev_line_num)
    local _0_0, _1_0, _2_0 = identify_indent_type(lines, prev_line_num, {})
    if ((_0_0 == "table") and (nil ~= _1_0)) then
      local opening = _1_0
      return opening
    elseif ((_0_0 == "body-special") and (nil ~= _1_0)) then
      local prev_indent = _1_0
      return (prev_indent + 2)
    elseif ((_0_0 == "call") and (nil ~= _1_0) and (nil ~= _2_0)) then
      local prev_indent = _1_0
      local function_name = _2_0
      return (prev_indent + #function_name + 2)
    else
      local _ = _0_0
      return 0
    end
  end
  local function indent_line(line, lines, prev_line_num)
    local without_indentation = line:match("[^%s]+.*")
    if without_indentation then
      return ((" "):rep(indentation(lines, prev_line_num)) .. without_indentation)
    else
      return ""
    end
  end
  local function indent(code)
    local lines = {}
    for line in code:gmatch("([^\n]*)\n") do
      table.insert(lines, indent_line(line, lines, #lines))
    end
    return table.concat(lines, "\n")
  end
  local newline = nil
  local function _0_()
    return "\n"
  end
  newline = setmetatable({}, {__fennelview = _0_})
  local function nospace_concat(tbl, sep, start, _end)
    local out = ""
    for i = start, _end do
      local val = tbl[i]
      if ((i == start) or (val == "\n")) then
        out = (out .. val)
      else
        out = (out .. " " .. val)
      end
    end
    return out
  end
  local nil_sym = nil
  local function _1_()
    return "nil"
  end
  nil_sym = setmetatable({}, {__fennelview = _1_})
  local function view_list(self, tostring2)
    local safe, max = {}, 0
    for k in pairs(self) do
      if ((type(k) == "number") and (k > max)) then
        max = k
      end
    end
    do
      local ts = (tostring2 or tostring)
      for i = 1, max, 1 do
        local function _2_()
          if (self[i] == nil) then
            return nil_sym
          else
            return self[i]
          end
        end
        safe[i] = ts(_2_())
      end
    end
    return ("(" .. nospace_concat(safe, " ", 1, max) .. ")")
  end
  local list_mt = {__fennelview = view_list}
  local function walk_tree(root, f, iterator)
    local function walk(iterfn, parent, idx, node)
      if f(idx, node, parent) then
        for k, v in iterfn(node) do
          walk(iterfn, node, k, v)
        end
        return nil
      end
    end
    walk((iterator or pairs), nil, nil, root)
    return root
  end
  local function step_for(_2_0)
    local _3_ = _2_0
    local callee = _3_[1]
    if ({match = true})[tostring(callee)] then
      return -2
    else
      return -1
    end
  end
  local function end_for(node)
    if (tostring(node[1]) == "match") then
      return (#node - 1)
    else
      return #node
    end
  end
  local function start_for(_3_0)
    local _4_ = _3_0
    local callee = _4_[1]
    return ({["do"] = 2, ["for"] = 3, ["if"] = 3, ["while"] = 3, each = 3, fn = 4, let = 3, match = 3, when = 3})[tostring(callee)]
  end
  local function add_newlines(idx, node, parent)
    if ("table" == type(node)) then
      do
        local mt = (getmetatable(node) or {})
        local _4_0 = mt
        if ((type(_4_0) == "table") and (_4_0[1] == "LIST")) then
          setmetatable(node, list_mt)
          if start_for(node) then
            for i = end_for(node), start_for(node), step_for(node) do
              table.insert(node, i, newline)
            end
          end
        elseif ((type(_4_0) == "table") and (nil ~= _4_0.sequence)) then
          local sequence = _4_0.sequence
          if ("let" == tostring(parent[1])) then
            for i = (#node - 1), 2, -2 do
              table.insert(node, i, newline)
            end
          end
        end
      end
      return true
    end
  end
  local function fnlfmt(ast, options)
    return indent((view(walk_tree(ast, add_newlines), {["empty-as-square"] = true, ["table-edges"] = false}) .. "\n\n"))
  end
  return {["indent-line"] = indent_line, fnlfmt = fnlfmt, indent = indent}
end
package.preload["fennelview"] = package.preload["fennelview"] or function(...)
  local function view_quote(str)
    return ("\"" .. str:gsub("\"", "\\\"") .. "\"")
  end
  local short_control_char_escapes = {["\11"] = "\\v", ["\12"] = "\\f", ["\13"] = "\\r", ["\7"] = "\\a", ["\8"] = "\\b", ["\9"] = "\\t", ["\n"] = "\\n"}
  local long_control_char_escapes = nil
  do
    local long = {}
    for i = 0, 31 do
      local ch = string.char(i)
      if not short_control_char_escapes[ch] then
        short_control_char_escapes[ch] = ("\\" .. i)
        long[ch] = ("\\%03d"):format(i)
      end
    end
    long_control_char_escapes = long
  end
  local function escape(str)
    return str:gsub("\\", "\\\\"):gsub("(%c)%f[0-9]", long_control_char_escapes):gsub("%c", short_control_char_escapes)
  end
  local function sequence_key_3f(k, len)
    return ((type(k) == "number") and (1 <= k) and (k <= len) and (math.floor(k) == k))
  end
  local type_order = {["function"] = 5, boolean = 2, number = 1, string = 3, table = 4, thread = 7, userdata = 6}
  local function sort_keys(a, b)
    local ta = type(a)
    local tb = type(b)
    if ((ta == tb) and (ta ~= "boolean") and ((ta == "string") or (ta == "number"))) then
      return (a < b)
    else
      local dta = type_order[a]
      local dtb = type_order[b]
      if (dta and dtb) then
        return (dta < dtb)
      elseif dta then
        return true
      elseif dtb then
        return false
      elseif "else" then
        return (ta < tb)
      end
    end
  end
  local function get_sequence_length(t)
    local len = 1
    for i in ipairs(t) do
      len = i
    end
    return len
  end
  local function get_nonsequential_keys(t)
    local keys = {}
    local sequence_length = get_sequence_length(t)
    for k in pairs(t) do
      if not sequence_key_3f(k, sequence_length) then
        table.insert(keys, k)
      end
    end
    table.sort(keys, sort_keys)
    return keys, sequence_length
  end
  local function count_table_appearances(t, appearances)
    if (type(t) == "table") then
      if not appearances[t] then
        appearances[t] = 1
        for k, v in pairs(t) do
          count_table_appearances(k, appearances)
          count_table_appearances(v, appearances)
        end
      end
    else
      if (t and (t == t)) then
        appearances[t] = ((appearances[t] or 0) + 1)
      end
    end
    return appearances
  end
  local put_value = nil
  local function puts(self, ...)
    for _, v in ipairs({...}) do
      table.insert(self.buffer, v)
    end
    return nil
  end
  local function tabify(self)
    return puts(self, "\n", (self.indent):rep(self.level))
  end
  local function already_visited_3f(self, v)
    return (self.ids[v] ~= nil)
  end
  local function get_id(self, v)
    local id = self.ids[v]
    if not id then
      local tv = type(v)
      id = ((self["max-ids"][tv] or 0) + 1)
      self["max-ids"][tv] = id
      self.ids[v] = id
    end
    return tostring(id)
  end
  local function put_sequential_table(self, t, len)
    puts(self, "[")
    self.level = (self.level + 1)
    for i = 1, len do
      local _0_ = (1 + len)
      if ((1 < i) and (i < _0_)) then
        puts(self, " ")
      end
      put_value(self, t[i])
    end
    self.level = (self.level - 1)
    return puts(self, "]")
  end
  local function put_key(self, k)
    if ((type(k) == "string") and k:find("^[-%w?\\^_!$%&*+./@:|<=>]+$")) then
      return puts(self, ":", k)
    else
      return put_value(self, k)
    end
  end
  local function put_kv_table(self, t, ordered_keys)
    puts(self, "{")
    self.level = (self.level + 1)
    for i, k in ipairs(ordered_keys) do
      if (self["table-edges"] or (i ~= 1)) then
        tabify(self)
      end
      put_key(self, k)
      puts(self, " ")
      put_value(self, t[k])
    end
    for i, v in ipairs(t) do
      tabify(self)
      put_key(self, i)
      puts(self, " ")
      put_value(self, v)
    end
    self.level = (self.level - 1)
    if self["table-edges"] then
      tabify(self)
    end
    return puts(self, "}")
  end
  local function put_table(self, t)
    local metamethod = nil
    local function _1_()
      local _0_0 = t
      if _0_0 then
        local _2_0 = getmetatable(_0_0)
        if _2_0 then
          return _2_0.__fennelview
        else
          return _2_0
        end
      else
        return _0_0
      end
    end
    metamethod = (self["metamethod?"] and _1_())
    if (already_visited_3f(self, t) and self["detect-cycles?"]) then
      return puts(self, "#<table ", get_id(self, t), ">")
    elseif (self.level >= self.depth) then
      return puts(self, "{...}")
    elseif metamethod then
      return puts(self, metamethod(t, self.fennelview))
    elseif "else" then
      local non_seq_keys, len = get_nonsequential_keys(t)
      local id = get_id(self, t)
      if ((1 < (self.appearances[t] or 0)) and self["detect-cycles?"]) then
        return puts(self, "#<table", id, ">")
      elseif ((#non_seq_keys == 0) and (#t == 0)) then
        local function _2_()
          if self["empty-as-square"] then
            return "[]"
          else
            return "{}"
          end
        end
        return puts(self, _2_())
      elseif (#non_seq_keys == 0) then
        return put_sequential_table(self, t, len)
      elseif "else" then
        return put_kv_table(self, t, non_seq_keys)
      end
    end
  end
  local function _0_(self, v)
    local tv = type(v)
    if (tv == "string") then
      return puts(self, view_quote(escape(v)))
    elseif ((tv == "number") or (tv == "boolean") or (tv == "nil")) then
      return puts(self, tostring(v))
    elseif (tv == "table") then
      return put_table(self, v)
    elseif "else" then
      return puts(self, "#<", tostring(v), ">")
    end
  end
  put_value = _0_
  local function one_line(str)
    local ret = str:gsub("\n", " "):gsub("%[ ", "["):gsub(" %]", "]"):gsub("%{ ", "{"):gsub(" %}", "}"):gsub("%( ", "("):gsub(" %)", ")")
    return ret
  end
  local function fennelview(x, options)
    local options0 = (options or {})
    local inspector = nil
    local function _1_(_241)
      return fennelview(_241, options0)
    end
    local function _2_()
      if options0["one-line"] then
        return ""
      else
        return "  "
      end
    end
    inspector = {["detect-cycles?"] = not (false == options0["detect-cycles?"]), ["empty-as-square"] = options0["empty-as-square"], ["max-ids"] = {}, ["metamethod?"] = not (false == options0["metamethod?"]), ["table-edges"] = (options0["table-edges"] ~= false), appearances = count_table_appearances(x, {}), buffer = {}, depth = (options0.depth or 128), fennelview = _1_, ids = {}, indent = (options0.indent or _2_()), level = 0}
    put_value(inspector, x)
    local str = table.concat(inspector.buffer)
    if options0["one-line"] then
      return one_line(str)
    else
      return str
    end
  end
  return fennelview
end
local fennel = nil
package.preload["fennel"] = package.preload["fennel"] or function(...)
local view = nil
  --[[
  Copyright (c) 2016-2019 Calvin Rose and contributors
  Permission is hereby granted, free of charge, to any person obtaining a copy of
  this software and associated documentation files (the "Software"), to deal in
  the Software without restriction, including without limitation the rights to
  use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
  the Software, and to permit persons to whom the Software is furnished to do so,
  subject to the following conditions:
  The above copyright notice and this permission notice shall be included in all
  copies or substantial portions of the Software.
  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
  FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
  COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
  IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
  CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
  ]]
  
  -- Make global variables local.
  local setmetatable = setmetatable
  local getmetatable = getmetatable
  local type = type
  local assert = assert
  local pairs = pairs
  local ipairs = ipairs
  local tostring = tostring
  local unpack = unpack or table.unpack
  
  --
  -- Main Types and support functions
  --
  
  local utils = (function()
      -- Like pairs, but gives consistent ordering every time. On 5.1, 5.2, and LuaJIT
      -- pairs is already stable, but on 5.3 every run gives different ordering.
      local function stablepairs(t)
          local keys, succ = {}, {}
          for k in pairs(t) do table.insert(keys, k) end
          table.sort(keys, function(a, b) return tostring(a) < tostring(b) end)
          for i,k in ipairs(keys) do succ[k] = keys[i+1] end
          local function stablenext(tbl, idx)
              if idx == nil then return keys[1], tbl[keys[1]] end
              return succ[idx], tbl[succ[idx]]
          end
          return stablenext, t, nil
      end
  
      -- Map function f over sequential table t, removing values where f returns nil.
      -- Optionally takes a target table to insert the mapped values into.
      local function map(t, f, out)
          out = out or {}
          if type(f) ~= "function" then local s = f f = function(x) return x[s] end end
          for _,x in ipairs(t) do
              local v = f(x)
              if v then table.insert(out, v) end
          end
          return out
      end
  
      -- Map function f over key/value table t, similar to above, but it can return a
      -- sequential table if f returns a single value or a k/v table if f returns two.
      -- Optionally takes a target table to insert the mapped values into.
      local function kvmap(t, f, out)
          out = out or {}
          if type(f) ~= "function" then local s = f f = function(x) return x[s] end end
          for k,x in stablepairs(t) do
              local korv, v = f(k, x)
              if korv and not v then table.insert(out, korv) end
              if korv and v then out[korv] = v end
          end
          return out
      end
  
      -- Returns a shallow copy of its table argument. Returns an empty table on nil.
      local function copy(from)
         local to = {}
         for k, v in pairs(from or {}) do to[k] = v end
         return to
      end
  
      -- Like pairs, but if the table has an __index metamethod, it will recurisvely
      -- traverse upwards, skipping duplicates, to iterate all inherited properties
      local function allpairs(t)
          assert(type(t) == 'table', 'allpairs expects a table')
          local seen = {}
          local function allpairsNext(_, state)
              local nextState, value = next(t, state)
              if seen[nextState] then
                  return allpairsNext(nil, nextState)
              elseif nextState then
                  seen[nextState] = true
                  return nextState, value
              end
              local meta = getmetatable(t)
              if meta and meta.__index then
                  t = meta.__index
                  return allpairsNext(t)
              end
          end
          return allpairsNext
      end
  
      local function deref(self) return self[1] end
  
      local nilSym -- haven't defined sym yet; create this later
  
      local function listToString(self, tostring2)
          local safe, max = {}, 0
          for k in pairs(self) do if type(k) == "number" and k>max then max=k end end
          for i=1,max do -- table.maxn was removed from Lua 5.3 for some reason???
              safe[i] = self[i] == nil and nilSym or self[i]
          end
          return '(' .. table.concat(map(safe, tostring2 or tostring), ' ', 1, max) .. ')'
      end
  
      local SYMBOL_MT = { 'SYMBOL', __tostring = deref, __fennelview = deref }
      local EXPR_MT = { 'EXPR', __tostring = deref }
      local VARARG = setmetatable({ '...' },
          { 'VARARG', __tostring = deref, __fennelview = deref })
      local LIST_MT = { 'LIST', __tostring = listToString, __fennelview = listToString }
      local SEQUENCE_MARKER = { 'SEQUENCE' }
  
      -- Safely load an environment variable
      local getenv = os and os.getenv or function() return nil end
  
      local pathTable = {"./?.fnl", "./?/init.fnl"}
      table.insert(pathTable, getenv("FENNEL_PATH"))
  
      local function debugOn(flag)
          local level = getenv("FENNEL_DEBUG") or ""
          return level == "all" or level:find(flag)
      end
  
      -- Create a new list. Lists are a compile-time construct in Fennel; they are
      -- represented as tables with a special marker metatable. They only come from
      -- the parser, and they represent code which comes from reading a paren form;
      -- they are specifically not cons cells.
      local function list(...)
          return setmetatable({...}, LIST_MT)
      end
  
      -- Create a new symbol. Symbols are a compile-time construct in Fennel and are
      -- not exposed outside the compiler. Symbols have source data describing what
      -- file, line, etc that they came from.
      local function sym(str, scope, source)
          local s = {str, scope = scope}
          for k, v in pairs(source or {}) do
              if type(k) == 'string' then s[k] = v end
          end
          return setmetatable(s, SYMBOL_MT)
      end
  
      nilSym = sym("nil")
  
      -- Create a new sequence. Sequences are tables that come from the parser when
      -- it encounters a form with square brackets. They are treated as regular tables
      -- except when certain macros need to look for binding forms, etc specifically.
      local function sequence(...)
          -- can't use SEQUENCE_MT directly as the sequence metatable like we do with
          -- the other types without giving up the ability to set source metadata
          -- on a sequence, (which we need for error reporting) so embed a marker
          -- value in the metatable instead.
          return setmetatable({...}, {sequence=SEQUENCE_MARKER})
      end
  
      -- Create a new expr
      -- etype should be one of
      --   "literal": literals like numbers, strings, nil, true, false
      --   "expression": Complex strings of Lua code, may have side effects, etc
      --                 but is an expression
      --   "statement": Same as expression, but is also a valid statement
      --                (function calls).
      --   "vargs": varargs symbol
      --   "sym": symbol reference
      local function expr(strcode, etype)
          return setmetatable({ strcode, type = etype }, EXPR_MT)
      end
  
      local function varg()
          return VARARG
      end
  
      local function isExpr(x)
          return type(x) == 'table' and getmetatable(x) == EXPR_MT and x
      end
  
      local function isVarg(x)
          return x == VARARG and x
      end
  
      -- Checks if an object is a List. Returns the object if is a List.
      local function isList(x)
          return type(x) == 'table' and getmetatable(x) == LIST_MT and x
      end
  
      -- Checks if an object is a symbol. Returns the object if it is a symbol.
      local function isSym(x)
          return type(x) == 'table' and getmetatable(x) == SYMBOL_MT and x
      end
  
      -- Checks if an object any kind of table, EXCEPT list or symbol
      local function isTable(x)
          return type(x) == 'table' and
              x ~= VARARG and
              getmetatable(x) ~= LIST_MT and getmetatable(x) ~= SYMBOL_MT and x
      end
  
      -- Checks if an object is a sequence (created with a [] literal)
      local function isSequence(x)
          local mt = type(x) == "table" and getmetatable(x)
          return mt and mt.sequence == SEQUENCE_MARKER and x
      end
  
      -- A multi symbol is a symbol that is actually composed of
      -- two or more symbols using the dot syntax. The main differences
      -- from normal symbols is that they cannot be declared local, and
      -- they may have side effects on invocation (metatables)
      local function isMultiSym(str)
          if isSym(str) then
              return isMultiSym(tostring(str))
          end
          if type(str) ~= 'string' then return end
          local parts = {}
          for part in str:gmatch('[^%.%:]+[%.%:]?') do
              local lastChar = part:sub(-1)
              if lastChar == ":" then
                  parts.multiSymMethodCall = true
              end
              if lastChar == ":" or lastChar == "." then
                  parts[#parts + 1] = part:sub(1, -2)
              else
                  parts[#parts + 1] = part
              end
          end
          return #parts > 0 and
              (str:match('%.') or str:match(':')) and
              (not str:match('%.%.')) and
              str:byte() ~= string.byte '.' and
              str:byte(-1) ~= string.byte '.' and
              parts
      end
  
      local function isQuoted(symbol) return symbol.quoted end
  
      local luaKeywords = {
          'and', 'break', 'do', 'else', 'elseif', 'end', 'false', 'for',
          'function', 'if', 'in', 'local', 'nil', 'not', 'or', 'repeat', 'return',
          'then', 'true', 'until', 'while'
      }
  
      for i, v in ipairs(luaKeywords) do luaKeywords[v] = i end
  
      local function isValidLuaIdentifier(str)
          return (str:match('^[%a_][%w_]*$') and not luaKeywords[str])
      end
  
      -- Certain options should always get propagated onwards when a function that
      -- has options calls down into compile.
      local propagatedOptions = {"allowedGlobals", "indent", "correlate",
                                 "useMetadata", "env"}
      local function propagateOptions(options, subopts)
          for _,name in ipairs(propagatedOptions) do subopts[name] = options[name] end
          return subopts
      end
  
      local root = {
          -- Top level compilation bindings.
          chunk=nil, scope=nil, options=nil,
  
          -- The root.reset function needs to be called at every exit point of the
          -- compiler including when there's a parse error or compiler
          -- error. This would be better done using dynamic scope, but we don't
          -- have dynamic scope, so we fake it by ensuring we call this at every
          -- exit point, including errors.
          reset=function() end,
  
          setReset=function(root)
              local chunk, scope, options = root.chunk, root.scope, root.options
              local oldResetRoot = root.reset -- this needs to nest!
              root.reset = function()
                  root.chunk, root.scope, root.options = chunk, scope, options
                  root.reset = oldResetRoot
              end
          end,
      }
  
      return {
          -- basic general table functions:
          stablepairs=stablepairs, allpairs=allpairs, map=map, kvmap=kvmap,
          copy=copy,
  
          -- AST functions:
          list=list, sym=sym, sequence=sequence, expr=expr, varg=varg,
          isVarg=isVarg, isList=isList, isSym=isSym, isTable=isTable,
          isSequence=isSequence, isMultiSym=isMultiSym, isQuoted=isQuoted,
          isExpr=isExpr, deref=deref,
  
          -- other functions:
          isValidLuaIdentifier=isValidLuaIdentifier, luaKeywords=luaKeywords,
          propagateOptions=propagateOptions, debugOn=debugOn,
          root=root, path=table.concat(pathTable, ";"),}
  end)()
  
  --
  -- Parser
  --
  
  local parser = (function()
      -- Convert a stream of chunks to a stream of bytes.
      -- Also returns a second function to clear the buffer in the byte stream
      local function granulate(getchunk)
          local c = ''
          local index = 1
          local done = false
          return function (parserState)
              if done then return nil end
              if index <= #c then
                  local b = c:byte(index)
                  index = index + 1
                  return b
              else
                  c = getchunk(parserState)
                  if not c or c == '' then
                      done = true
                      return nil
                  end
                  index = 2
                  return c:byte(1)
              end
          end, function ()
              c = ''
          end
      end
  
      -- Convert a string into a stream of bytes
      local function stringStream(str)
          str=str:gsub("^#![^\n]*\n", "") -- remove shebang
          local index = 1
          return function()
              local r = str:byte(index)
              index = index + 1
              return r
          end
      end
  
      -- Table of delimiter bytes - (, ), [, ], {, }
      -- Opener keys have closer as the value, and closers keys
      -- have true as their value.
      local delims = {
          [40] = 41,        -- (
          [41] = true,      -- )
          [91] = 93,        -- [
          [93] = true,      -- ]
          [123] = 125,      -- {
          [125] = true      -- }
      }
  
      local function iswhitespace(b)
          return b == 32 or (b >= 9 and b <= 13)
      end
  
      local function issymbolchar(b)
          return b > 32 and
              not delims[b] and
              b ~= 127 and -- "<BS>"
              b ~= 34 and -- "\""
              b ~= 39 and -- "'"
              b ~= 126 and -- "~"
              b ~= 59 and -- ";"
              b ~= 44 and -- ","
              b ~= 64 and -- "@"
              b ~= 96 -- "`"
      end
  
      local prefixes = { -- prefix chars substituted while reading
          [96] = 'quote', -- `
          [44] = 'unquote', -- ,
          [39] = 'quote', -- '
          [35] = 'hashfn' -- #
      }
  
      -- Parse one value given a function that
      -- returns sequential bytes. Will throw an error as soon
      -- as possible without getting more bytes on bad input. Returns
      -- if a value was read, and then the value read. Will return nil
      -- when input stream is finished.
      local function parser(getbyte, filename, options)
  
          -- Stack of unfinished values
          local stack = {}
  
          -- Provide one character buffer and keep
          -- track of current line and byte index
          local line = 1
          local byteindex = 0
          local lastb
          local function ungetb(ub)
              if ub == 10 then line = line - 1 end
              byteindex = byteindex - 1
              lastb = ub
          end
          local function getb()
              local r
              if lastb then
                  r, lastb = lastb, nil
              else
                  r = getbyte({ stackSize = #stack })
              end
              byteindex = byteindex + 1
              if r == 10 then line = line + 1 end
              return r
          end
  
          -- If you add new calls to this function, please update fenneldfriend.fnl
          -- as well to add suggestions for how to fix the new error.
          local function parseError(msg)
              local source = utils.root.options and utils.root.options.source
              utils.root.reset()
              local override = options and options["parse-error"]
              if override then override(msg, filename or "unknown", line or "?",
                                        byteindex, source) end
              return error(("Parse error in %s:%s: %s"):
                      format(filename or "unknown", line or "?", msg), 0)
          end
  
          -- Parse stream
          return function()
  
              -- Dispatch when we complete a value
              local done, retval
              local whitespaceSinceDispatch = true
              local function dispatch(v)
                  if #stack == 0 then
                      retval = v
                      done = true
                  elseif stack[#stack].prefix then
                      local stacktop = stack[#stack]
                      stack[#stack] = nil
                      return dispatch(utils.list(utils.sym(stacktop.prefix), v))
                  else
                      table.insert(stack[#stack], v)
                  end
                  whitespaceSinceDispatch = false
              end
  
              -- Throw nice error when we expect more characters
              -- but reach end of stream.
              local function badend()
                  local accum = utils.map(stack, "closer")
                  parseError(('expected closing delimiter%s %s'):format(
                      #stack == 1 and "" or "s",
                      string.char(unpack(accum))))
              end
  
              -- The main parse loop
              repeat
                  local b
  
                  -- Skip whitespace
                  repeat
                      b = getb()
                      if b and iswhitespace(b) then
                          whitespaceSinceDispatch = true
                      end
                  until not b or not iswhitespace(b)
                  if not b then
                      if #stack > 0 then badend() end
                      return nil
                  end
  
                  if b == 59 then -- ; Comment
                      repeat
                          b = getb()
                      until not b or b == 10 -- newline
                  elseif type(delims[b]) == 'number' then -- Opening delimiter
                      if not whitespaceSinceDispatch then
                          parseError('expected whitespace before opening delimiter '
                                         .. string.char(b))
                      end
                      table.insert(stack, setmetatable({
                          closer = delims[b],
                          line = line,
                          filename = filename,
                          bytestart = byteindex
                      }, getmetatable(utils.list())))
                  elseif delims[b] then -- Closing delimiter
                      if #stack == 0 then parseError('unexpected closing delimiter '
                                                         .. string.char(b)) end
                      local last = stack[#stack]
                      local val
                      if last.closer ~= b then
                          parseError('mismatched closing delimiter ' .. string.char(b) ..
                                     ', expected ' .. string.char(last.closer))
                      end
                      last.byteend = byteindex -- Set closing byte index
                      if b == 41 then -- ; )
                          val = last
                      elseif b == 93 then -- ; ]
                          val = utils.sequence(unpack(last))
                          -- for table literals we can store file/line/offset source
                          -- data in fields on the table itself, because the AST node
                          -- *is* the table, and the fields would show up in the
                          -- compiled output. keep them on the metatable instead.
                          for k,v in pairs(last) do getmetatable(val)[k]=v end
                      else -- ; }
                          if #last % 2 ~= 0 then
                              byteindex = byteindex - 1
                              parseError('expected even number of values in table literal')
                          end
                          val = {}
                          setmetatable(val, last) -- see note above about source data
                          for i = 1, #last, 2 do
                              if(tostring(last[i]) == ":" and utils.isSym(last[i + 1])
                                 and utils.isSym(last[i])) then
                                  last[i] = tostring(last[i + 1])
                              end
                              val[last[i]] = last[i + 1]
                          end
                      end
                      stack[#stack] = nil
                      dispatch(val)
                  elseif b == 34 then -- Quoted string
                      local state = "base"
                      local chars = {34}
                      stack[#stack + 1] = {closer = 34}
                      repeat
                          b = getb()
                          chars[#chars + 1] = b
                          if state == "base" then
                              if b == 92 then
                                  state = "backslash"
                              elseif b == 34 then
                                  state = "done"
                              end
                          else
                              -- state == "backslash"
                              state = "base"
                          end
                      until not b or (state == "done")
                      if not b then badend() end
                      stack[#stack] = nil
                      local raw = string.char(unpack(chars))
                      local formatted = raw:gsub("[\1-\31]", function (c)
                                                     return '\\' .. c:byte() end)
                      local loadFn = (loadstring or load)(('return %s'):format(formatted))
                      dispatch(loadFn())
                  elseif prefixes[b] then
                      -- expand prefix byte into wrapping form eg. '`a' into '(quote a)'
                      table.insert(stack, {
                          prefix = prefixes[b]
                      })
                      local nextb = getb()
                      if iswhitespace(nextb) then
                          if b == 35 then
                              stack[#stack] = nil
                              dispatch(utils.sym('#'))
                          else
                              parseError('invalid whitespace after quoting prefix')
                          end
                      end
                      ungetb(nextb)
                  elseif issymbolchar(b) or b == string.byte("~") then -- Try sym
                      local chars = {}
                      local bytestart = byteindex
                      repeat
                          chars[#chars + 1] = b
                          b = getb()
                      until not b or not issymbolchar(b)
                      if b then ungetb(b) end
                      local rawstr = string.char(unpack(chars))
                      if rawstr == 'true' then dispatch(true)
                      elseif rawstr == 'false' then dispatch(false)
                      elseif rawstr == '...' then dispatch(utils.varg())
                      elseif rawstr:match('^:.+$') then -- colon style strings
                          dispatch(rawstr:sub(2))
                      elseif rawstr:match("^~") and rawstr ~= "~=" then
                          -- for backwards-compatibility, special-case allowance
                          -- of ~= but all other uses of ~ are disallowed
                          parseError("illegal character: ~")
                      else
                          local forceNumber = rawstr:match('^%d')
                          local numberWithStrippedUnderscores = rawstr:gsub("_", "")
                          local x
                          if forceNumber then
                              x = tonumber(numberWithStrippedUnderscores) or
                                  parseError('could not read number "' .. rawstr .. '"')
                          else
                              x = tonumber(numberWithStrippedUnderscores)
                              if not x then
                                  if(rawstr:match("%.[0-9]")) then
                                      byteindex = (byteindex - #rawstr +
                                                       rawstr:find("%.[0-9]") + 1)
                                      parseError("can't start multisym segment " ..
                                                     "with a digit: ".. rawstr)
                                  elseif(rawstr:match("[%.:][%.:]") and
                                         rawstr ~= "..") then
                                      byteindex = (byteindex - #rawstr +
                                                       rawstr:find("[%.:][%.:]") + 1)
                                      parseError("malformed multisym: " .. rawstr)
                                  elseif(rawstr:match(":.+[%.:]")) then
                                      byteindex = (byteindex - #rawstr +
                                                       rawstr:find(":.+[%.:]"))
                                      parseError("method must be last component "
                                                     .. "of multisym: " .. rawstr)
                                  else
                                      x = utils.sym(rawstr, nil, {line = line,
                                                            filename = filename,
                                                            bytestart = bytestart,
                                                            byteend = byteindex,})
                                  end
                              end
                          end
                          dispatch(x)
                      end
                  else
                      parseError("illegal character: " .. string.char(b))
                  end
              until done
              return true, retval
          end, function ()
              stack = {}
          end
      end
      return { granulate=granulate, stringStream=stringStream, parser=parser }
  end)()
  
  --
  -- Compilation
  --
  
  local compiler = (function()
      local scopes = {}
  
      -- Create a new Scope, optionally under a parent scope. Scopes are compile time
      -- constructs that are responsible for keeping track of local variables, name
      -- mangling, and macros.  They are accessible to user code via the
      -- 'eval-compiler' special form (may change). They use metatables to implement
      -- nesting.
      local function makeScope(parent)
          if not parent then parent = scopes.global end
          return {
              unmanglings = setmetatable({}, {
                  __index = parent and parent.unmanglings
              }),
              manglings = setmetatable({}, {
                  __index = parent and parent.manglings
              }),
              specials = setmetatable({}, {
                  __index = parent and parent.specials
              }),
              macros = setmetatable({}, {
                  __index = parent and parent.macros
              }),
              symmeta = setmetatable({}, {
                  __index = parent and parent.symmeta
              }),
              includes = setmetatable({}, {
                  __index = parent and parent.includes
              }),
              refedglobals = setmetatable({}, {
                  __index = parent and parent.refedglobals
              }),
              autogensyms = {},
              parent = parent,
              vararg = parent and parent.vararg,
              depth = parent and ((parent.depth or 0) + 1) or 0,
              hashfn = parent and parent.hashfn
          }
      end
  
      -- Assert a condition and raise a compile error with line numbers. The ast arg
      -- should be unmodified so that its first element is the form being called.
      -- If you add new calls to this function, please update fenneldfriend.fnl
      -- as well to add suggestions for how to fix the new error.
      local function assertCompile(condition, msg, ast)
          local override = utils.root.options and utils.root.options["assert-compile"]
          if override then
              local source = utils.root.options and utils.root.options.source
              -- don't make custom handlers deal with resetting root; it's error-prone
              if not condition then utils.root.reset() end
              override(condition, msg, ast, source)
              -- should we fall thru to the default check, or should we allow the
              -- override to swallow the error?
          end
          if not condition then
              utils.root.reset()
              local m = getmetatable(ast)
              local filename = m and m.filename or ast.filename or "unknown"
              local line = m and m.line or ast.line or "?"
              -- if we use regular `assert' we can't provide the `level' argument of 0
              error(string.format("Compile error in '%s' %s:%s: %s",
                                  tostring(utils.isSym(ast[1]) and ast[1][1] or
                                               ast[1] or '()'),
                                  filename, line, msg), 0)
          end
          return condition
      end
  
      scopes.global = makeScope()
      scopes.global.vararg = true
      scopes.compiler = makeScope(scopes.global)
      scopes.macro = scopes.global -- used by gensym, in-scope?, etc
  
      -- Allow printing a string to Lua, also keep as 1 line.
      local serializeSubst = {
          ['\a'] = '\\a',
          ['\b'] = '\\b',
          ['\f'] = '\\f',
          ['\n'] = 'n',
          ['\t'] = '\\t',
          ['\v'] = '\\v'
      }
      local function serializeString(str)
          local s = ("%q"):format(str)
          s = s:gsub('.', serializeSubst):gsub("[\128-\255]", function(c)
              return "\\" .. c:byte()
          end)
          return s
      end
  
      -- Mangler for global symbols. Does not protect against collisions,
      -- but makes them unlikely. This is the mangling that is exposed to
      -- to the world.
      local function globalMangling(str)
          if utils.isValidLuaIdentifier(str) then
              return str
          end
          -- Use underscore as escape character
          return '__fnl_global__' .. str:gsub('[^%w]', function (c)
              return ('_%02x'):format(c:byte())
          end)
      end
  
      -- Reverse a global mangling. Takes a Lua identifier and
      -- returns the fennel symbol string that created it.
      local function globalUnmangling(identifier)
          local rest = identifier:match('^__fnl_global__(.*)$')
          if rest then
              local r = rest:gsub('_[%da-f][%da-f]', function (code)
                  return string.char(tonumber(code:sub(2), 16))
              end)
              return r -- don't return multiple values
          else
              return identifier
          end
      end
  
      -- If there's a provided list of allowed globals, don't let references thru that
      -- aren't on the list. This list is set at the compiler entry points of compile
      -- and compileStream.
      local allowedGlobals
  
      local function globalAllowed(name)
          if not allowedGlobals then return true end
          for _, g in ipairs(allowedGlobals) do
              if g == name then return true end
          end
      end
  
      -- Creates a symbol from a string by mangling it.
      -- ensures that the generated symbol is unique
      -- if the input string is unique in the scope.
      local function localMangling(str, scope, ast, tempManglings)
          local append = 0
          local mangling = str
          assertCompile(not utils.isMultiSym(str), 'unexpected multi symbol ' .. str, ast)
  
          -- Mapping mangling to a valid Lua identifier
          if utils.luaKeywords[mangling] or mangling:match('^%d') then
              mangling = '_' .. mangling
          end
          mangling = mangling:gsub('-', '_')
          mangling = mangling:gsub('[^%w_]', function (c)
              return ('_%02x'):format(c:byte())
          end)
  
          -- Prevent name collisions with existing symbols
          local raw = mangling
          while scope.unmanglings[mangling] do
              mangling = raw .. append
              append = append + 1
          end
  
          scope.unmanglings[mangling] = str
          local manglings = tempManglings or scope.manglings
          manglings[str] = mangling
          return mangling
      end
  
      -- Calling this function will mean that further
      -- compilation in scope will use these new manglings
      -- instead of the current manglings.
      local function applyManglings(scope, newManglings, ast)
          for raw, mangled in pairs(newManglings) do
              assertCompile(not scope.refedglobals[mangled],
              "use of global " .. raw .. " is aliased by a local", ast)
              scope.manglings[raw] = mangled
          end
      end
  
      -- Combine parts of a symbol
      local function combineParts(parts, scope)
          local ret = scope.manglings[parts[1]] or globalMangling(parts[1])
          for i = 2, #parts do
              if utils.isValidLuaIdentifier(parts[i]) then
                  if parts.multiSymMethodCall and i == #parts then
                      ret = ret .. ':' .. parts[i]
                  else
                      ret = ret .. '.' .. parts[i]
                  end
              else
                  ret = ret .. '[' .. serializeString(parts[i]) .. ']'
              end
          end
          return ret
      end
  
      -- Generates a unique symbol in the scope.
      local function gensym(scope, base)
          local mangling
          local append = 0
          repeat
              mangling = (base or '') .. '_' .. append .. '_'
              append = append + 1
          until not scope.unmanglings[mangling]
          scope.unmanglings[mangling] = true
          return mangling
      end
  
      -- Generates a unique symbol in the scope based on the base name. Calling
      -- repeatedly with the same base and same scope will return existing symbol
      -- rather than generating new one.
      local function autogensym(base, scope)
          local parts = utils.isMultiSym(base)
          if(parts) then
              parts[1] = autogensym(parts[1], scope)
              return table.concat(parts, parts.multiSymMethodCall and ":" or ".")
          end
  
          if scope.autogensyms[base] then return scope.autogensyms[base] end
          local mangling = gensym(scope, base:sub(1, -2))
          scope.autogensyms[base] = mangling
          return mangling
      end
  
      -- Check if a binding is valid
      local function checkBindingValid(symbol, scope, ast)
          -- Check if symbol will be over shadowed by special
          local name = symbol[1]
          assertCompile(not scope.specials[name] and not scope.macros[name],
                        ("local %s was overshadowed by a special form or macro")
                            :format(name), ast)
          assertCompile(not utils.isQuoted(symbol),
                        ("macro tried to bind %s without gensym"):format(name), symbol)
  
      end
  
      -- Declare a local symbol
      local function declareLocal(symbol, meta, scope, ast, tempManglings)
          checkBindingValid(symbol, scope, ast)
          local name = symbol[1]
          assertCompile(not utils.isMultiSym(name),
                        "unexpected multi symbol " .. name, ast)
          local mangling = localMangling(name, scope, ast, tempManglings)
          scope.symmeta[name] = meta
          return mangling
      end
  
      -- Convert symbol to Lua code. Will only work for local symbols
      -- if they have already been declared via declareLocal
      local function symbolToExpression(symbol, scope, isReference)
          local name = symbol[1]
          local multiSymParts = utils.isMultiSym(name)
          if scope.hashfn then
             if name == '$' then name = '$1' end
             if multiSymParts then
                if multiSymParts[1] == "$" then
                   multiSymParts[1] = "$1"
                   name = table.concat(multiSymParts, ".")
                end
             end
          end
          local parts = multiSymParts or {name}
          local etype = (#parts > 1) and "expression" or "sym"
          local isLocal = scope.manglings[parts[1]]
          if isLocal and scope.symmeta[parts[1]] then scope.symmeta[parts[1]].used = true end
          -- if it's a reference and not a symbol which introduces a new binding
          -- then we need to check for allowed globals
          assertCompile(not isReference or isLocal or globalAllowed(parts[1]),
                        'unknown global in strict mode: ' .. parts[1], symbol)
          if not isLocal then
              utils.root.scope.refedglobals[parts[1]] = true
          end
          return utils.expr(combineParts(parts, scope), etype)
      end
  
  
      -- Emit Lua code
      local function emit(chunk, out, ast)
          if type(out) == 'table' then
              table.insert(chunk, out)
          else
              table.insert(chunk, {leaf = out, ast = ast})
          end
      end
  
      -- Do some peephole optimization.
      local function peephole(chunk)
          if chunk.leaf then return chunk end
          -- Optimize do ... end in some cases.
          if #chunk >= 3 and
              chunk[#chunk - 2].leaf == 'do' and
              not chunk[#chunk - 1].leaf and
              chunk[#chunk].leaf == 'end' then
              local kid = peephole(chunk[#chunk - 1])
              local newChunk = {ast = chunk.ast}
              for i = 1, #chunk - 3 do table.insert(newChunk, peephole(chunk[i])) end
              for i = 1, #kid do table.insert(newChunk, kid[i]) end
              return newChunk
          end
          -- Recurse
          return utils.map(chunk, peephole)
      end
  
      -- correlate line numbers in input with line numbers in output
      local function flattenChunkCorrelated(mainChunk)
          local function flatten(chunk, out, lastLine, file)
              if chunk.leaf then
                  out[lastLine] = (out[lastLine] or "") .. " " .. chunk.leaf
              else
                  for _, subchunk in ipairs(chunk) do
                      -- Ignore empty chunks
                      if subchunk.leaf or #subchunk > 0 then
                          -- don't increase line unless it's from the same file
                          if subchunk.ast and file == subchunk.ast.file then
                              lastLine = math.max(lastLine, subchunk.ast.line or 0)
                          end
                          lastLine = flatten(subchunk, out, lastLine, file)
                      end
                  end
              end
              return lastLine
          end
          local out = {}
          local last = flatten(mainChunk, out, 1, mainChunk.file)
          for i = 1, last do
              if out[i] == nil then out[i] = "" end
          end
          return table.concat(out, "\n")
      end
  
      -- Flatten a tree of indented Lua source code lines.
      -- Tab is what is used to indent a block.
      local function flattenChunk(sm, chunk, tab, depth)
          if type(tab) == 'boolean' then tab = tab and '  ' or '' end
          if chunk.leaf then
              local code = chunk.leaf
              local info = chunk.ast
              -- Just do line info for now to save memory
              if sm then sm[#sm + 1] = info and info.line or -1 end
              return code
          else
              local parts = utils.map(chunk, function(c)
                  if c.leaf or #c > 0 then -- Ignore empty chunks
                      local sub = flattenChunk(sm, c, tab, depth + 1)
                      if depth > 0 then sub = tab .. sub:gsub('\n', '\n' .. tab) end
                      return sub
                  end
              end)
              return table.concat(parts, '\n')
          end
      end
  
      -- Some global state for all fennel sourcemaps. For the time being,
      -- this seems the easiest way to store the source maps.
      -- Sourcemaps are stored with source being mapped as the key, prepended
      -- with '@' if it is a filename (like debug.getinfo returns for source).
      -- The value is an array of mappings for each line.
      local fennelSourcemap = {}
      -- TODO: loading, unloading, and saving sourcemaps?
  
      local function makeShortSrc(source)
          source = source:gsub('\n', ' ')
          if #source <= 49 then
              return '[fennel "' .. source .. '"]'
          else
              return '[fennel "' .. source:sub(1, 46) .. '..."]'
          end
      end
  
      -- Return Lua source and source map table
      local function flatten(chunk, options)
          chunk = peephole(chunk)
          if(options.correlate) then
              return flattenChunkCorrelated(chunk), {}
          else
              local sm = {}
              local ret = flattenChunk(sm, chunk, options.indent, 0)
              if sm then
                  local key, short_src
                  if options.filename then
                      short_src = options.filename
                      key = '@' .. short_src
                  else
                      key = ret
                      short_src = makeShortSrc(options.source or ret)
                  end
                  sm.short_src = short_src
                  sm.key = key
                  fennelSourcemap[key] = sm
              end
              return ret, sm
          end
      end
  
      -- module-wide state for metadata
      -- create metadata table with weakly-referenced keys
      local function makeMetadata()
          return setmetatable({}, {
              __mode = 'k',
              __index = {
                  get = function(self, tgt, key)
                      if self[tgt] then return self[tgt][key] end
                  end,
                  set = function(self, tgt, key, value)
                      self[tgt] = self[tgt] or {}
                      self[tgt][key] = value
                      return tgt
                  end,
                  setall = function(self, tgt, ...)
                      local kvLen, kvs = select('#', ...), {...}
                      if kvLen % 2 ~= 0 then
                          error('metadata:setall() expected even number of k/v pairs')
                      end
                      self[tgt] = self[tgt] or {}
                      for i = 1, kvLen, 2 do self[tgt][kvs[i]] = kvs[i + 1] end
                      return tgt
                  end,
              }})
      end
  
      -- Convert expressions to Lua string
      local function exprs1(exprs)
          return table.concat(utils.map(exprs, 1), ', ')
      end
  
      -- Compile side effects for a chunk
      local function keepSideEffects(exprs, chunk, start, ast)
          start = start or 1
          for j = start, #exprs do
              local se = exprs[j]
              -- Avoid the rogue 'nil' expression (nil is usually a literal,
              -- but becomes an expression if a special form
              -- returns 'nil'.)
              if se.type == 'expression' and se[1] ~= 'nil' then
                  emit(chunk, ('do local _ = %s end'):format(tostring(se)), ast)
              elseif se.type == 'statement' then
                  local code = tostring(se)
                  emit(chunk, code:byte() == 40 and ("do end " .. code) or code , ast)
              end
          end
      end
  
      -- Does some common handling of returns and register
      -- targets for special forms. Also ensures a list expression
      -- has an acceptable number of expressions if opts contains the
      -- "nval" option.
      local function handleCompileOpts(exprs, parent, opts, ast)
          if opts.nval then
              local n = opts.nval
              if n ~= #exprs then
                  local len = #exprs
                  if len > n then
                      -- Drop extra
                      keepSideEffects(exprs, parent, n + 1, ast)
                      for i = n + 1, len do
                          exprs[i] = nil
                      end
                  else
                      -- Pad with nils
                      for i = #exprs + 1, n do
                          exprs[i] = utils.expr('nil', 'literal')
                      end
                  end
              end
          end
          if opts.tail then
              emit(parent, ('return %s'):format(exprs1(exprs)), ast)
          end
          if opts.target then
              local result = exprs1(exprs)
              if result == '' then result = 'nil' end
              emit(parent, ('%s = %s'):format(opts.target, result), ast)
          end
          if opts.tail or opts.target then
              -- Prevent statements and expression from being used twice if they
              -- have side-effects. Since if the target or tail options are set,
              -- the expressions are already emitted, we should not return them. This
              -- is fine, as when these options are set, the caller doesn't need the result
              -- anyways.
              exprs = {}
          end
          return exprs
      end
  
      local function macroexpand(ast, scope, once)
          if not utils.isList(ast) then return ast end -- bail early if not a list form
          local multiSymParts = utils.isMultiSym(ast[1])
          local macro = utils.isSym(ast[1]) and scope.macros[utils.deref(ast[1])]
          if not macro and multiSymParts then
              local inMacroModule
              macro = scope.macros
              for i = 1, #multiSymParts do
                  macro = utils.isTable(macro) and macro[multiSymParts[i]]
                  if macro then inMacroModule = true end
              end
              assertCompile(not inMacroModule or type(macro) == 'function',
                  'macro not found in imported macro module', ast)
          end
          if not macro then return ast end
          local oldScope = scopes.macro
          scopes.macro = scope
          local ok, transformed = pcall(macro, unpack(ast, 2))
          scopes.macro = oldScope
          assertCompile(ok, transformed, ast)
          if once or not transformed then return transformed end -- macroexpand-1
          return macroexpand(transformed, scope)
      end
  
      -- Compile an AST expression in the scope into parent, a tree
      -- of lines that is eventually compiled into Lua code. Also
      -- returns some information about the evaluation of the compiled expression,
      -- which can be used by the calling function. Macros
      -- are resolved here, as well as special forms in that order.
      -- the 'ast' param is the root AST to compile
      -- the 'scope' param is the scope in which we are compiling
      -- the 'parent' param is the table of lines that we are compiling into.
      -- add lines to parent by appending strings. Add indented blocks by appending
      -- tables of more lines.
      -- the 'opts' param contains info about where the form is being compiled.
      -- Options include:
      --   'target' - mangled name of symbol(s) being compiled to.
      --      Could be one variable, 'a', or a list, like 'a, b, _0_'.
      --   'tail' - boolean indicating tail position if set. If set, form will generate a return
      --   instruction.
      --   'nval' - The number of values to compile to if it is known to be a fixed value.
  
      -- In Lua, an expression can evaluate to 0 or more values via multiple
      -- returns. In many cases, Lua will drop extra values and convert a 0 value
      -- expression to nil. In other cases, Lua will use all of the values in an
      -- expression, such as in the last argument of a function call. Nval is an
      -- option passed to compile1 to say that the resulting expression should have
      -- at least n values. It lets us generate better code, because if we know we
      -- are only going to use 1 or 2 values from an expression, we can create 1 or 2
      -- locals to store intermediate results rather than turn the expression into a
      -- closure that is called immediately, which we have to do if we don't know.
  
      local function compile1(ast, scope, parent, opts)
          opts = opts or {}
          local exprs = {}
          -- expand any top-level macros before parsing and emitting Lua
          ast = macroexpand(ast, scope)
          -- Compile the form
          if utils.isList(ast) then -- Function call or special form
              assertCompile(#ast > 0, "expected a function, macro, or special to call", ast)
              -- Test for special form
              local len, first = #ast, ast[1]
              local multiSymParts = utils.isMultiSym(first)
              local special = utils.isSym(first) and scope.specials[utils.deref(first)]
              if special then -- Special form
                  exprs = special(ast, scope, parent, opts) or utils.expr('nil', 'literal')
                  -- Be very accepting of strings or expression
                  -- as well as lists or expressions
                  if type(exprs) == 'string' then exprs = utils.expr(exprs, 'expression') end
                  if utils.isExpr(exprs) then exprs = {exprs} end
                  -- Unless the special form explicitly handles the target, tail, and
                  -- nval properties, (indicated via the 'returned' flag), handle
                  -- these options.
                  if not exprs.returned then
                      exprs = handleCompileOpts(exprs, parent, opts, ast)
                  elseif opts.tail or opts.target then
                      exprs = {}
                  end
                  exprs.returned = true
                  return exprs
              elseif multiSymParts and multiSymParts.multiSymMethodCall then
                  local tableWithMethod = table.concat({
                          unpack(multiSymParts, 1, #multiSymParts - 1)
                                                       }, '.')
                  local methodToCall = multiSymParts[#multiSymParts]
                  local newAST = utils.list(utils.sym(':', scope), utils.sym(tableWithMethod, scope),
                                            methodToCall)
                  for i = 2, len do
                      newAST[#newAST + 1] = ast[i]
                  end
                  local compiled = compile1(newAST, scope, parent, opts)
                  exprs = compiled
              else -- Function call
                  local fargs = {}
                  local fcallee = compile1(ast[1], scope, parent, {
                      nval = 1
                  })[1]
                  assertCompile(fcallee.type ~= 'literal',
                                'cannot call literal value', ast)
                  fcallee = tostring(fcallee)
                  for i = 2, len do
                      local subexprs = compile1(ast[i], scope, parent, {
                          nval = i ~= len and 1 or nil
                      })
                      fargs[#fargs + 1] = subexprs[1] or utils.expr('nil', 'literal')
                      if i == len then
                          -- Add sub expressions to function args
                          for j = 2, #subexprs do
                              fargs[#fargs + 1] = subexprs[j]
                          end
                      else
                          -- Emit sub expression only for side effects
                          keepSideEffects(subexprs, parent, 2, ast[i])
                      end
                  end
                  local call = ('%s(%s)'):format(tostring(fcallee), exprs1(fargs))
                  exprs = handleCompileOpts({utils.expr(call, 'statement')}, parent, opts, ast)
              end
          elseif utils.isVarg(ast) then
              assertCompile(scope.vararg, "unexpected vararg", ast)
              exprs = handleCompileOpts({utils.expr('...', 'varg')}, parent, opts, ast)
          elseif utils.isSym(ast) then
              local e
              local multiSymParts = utils.isMultiSym(ast)
              assertCompile(not (multiSymParts and multiSymParts.multiSymMethodCall),
                            "multisym method calls may only be in call position", ast)
              -- Handle nil as special symbol - it resolves to the nil literal rather than
              -- being unmangled. Alternatively, we could remove it from the lua keywords table.
              if ast[1] == 'nil' then
                  e = utils.expr('nil', 'literal')
              else
                  e = symbolToExpression(ast, scope, true)
              end
              exprs = handleCompileOpts({e}, parent, opts, ast)
          elseif type(ast) == 'nil' or type(ast) == 'boolean' then
              exprs = handleCompileOpts({utils.expr(tostring(ast), 'literal')}, parent, opts)
          elseif type(ast) == 'number' then
              local n = ('%.17g'):format(ast)
              exprs = handleCompileOpts({utils.expr(n, 'literal')}, parent, opts)
          elseif type(ast) == 'string' then
              local s = serializeString(ast)
              exprs = handleCompileOpts({utils.expr(s, 'literal')}, parent, opts)
          elseif type(ast) == 'table' then
              local buffer = {}
              for i = 1, #ast do -- Write numeric keyed values.
                  local nval = i ~= #ast and 1
                  buffer[#buffer + 1] = exprs1(compile1(ast[i], scope,
                                                        parent, {nval = nval}))
              end
              local function writeOtherValues(k)
                  if type(k) ~= 'number' or math.floor(k) ~= k or k < 1 or k > #ast then
                      if type(k) == 'string' and utils.isValidLuaIdentifier(k) then
                          return {k, k}
                      else
                          local kstr = '[' .. tostring(compile1(k, scope, parent,
                                                                {nval = 1})[1]) .. ']'
                          return { kstr, k }
                      end
                  end
              end
              local keys = utils.kvmap(ast, writeOtherValues)
              table.sort(keys, function (a, b) return a[1] < b[1] end)
              utils.map(keys, function(k)
                      local v = tostring(compile1(ast[k[2]], scope, parent, {nval = 1})[1])
                      return ('%s = %s'):format(k[1], v) end,
                  buffer)
              local tbl = '{' .. table.concat(buffer, ', ') ..'}'
              exprs = handleCompileOpts({utils.expr(tbl, 'expression')}, parent, opts, ast)
          else
              assertCompile(false, 'could not compile value of type ' .. type(ast), ast)
          end
          exprs.returned = true
          return exprs
      end
  
      -- Implements destructuring for forms like let, bindings, etc.
      -- Takes a number of options to control behavior.
      -- var: Whether or not to mark symbols as mutable
      -- declaration: begin each assignment with 'local' in output
      -- nomulti: disallow multisyms in the destructuring. Used for (local) and (global).
      -- noundef: Don't set undefined bindings. (set)
      -- forceglobal: Don't allow local bindings
      local function destructure(to, from, ast, scope, parent, opts)
          opts = opts or {}
          local isvar = opts.isvar
          local declaration = opts.declaration
          local nomulti = opts.nomulti
          local noundef = opts.noundef
          local forceglobal = opts.forceglobal
          local forceset = opts.forceset
          local setter = declaration and "local %s = %s" or "%s = %s"
  
          local newManglings = {}
  
          -- Get Lua source for symbol, and check for errors
          local function getname(symbol, up1)
              local raw = symbol[1]
              assertCompile(not (nomulti and utils.isMultiSym(raw)),
                  'unexpected multi symbol ' .. raw, up1)
              if declaration then
                  return declareLocal(symbol, {var = isvar}, scope,
                                      symbol, newManglings)
              else
                  local parts = utils.isMultiSym(raw) or {raw}
                  local meta = scope.symmeta[parts[1]]
                  if #parts == 1 and not forceset then
                      assertCompile(not(forceglobal and meta),
                          ("global %s conflicts with local"):format(tostring(symbol)), symbol)
                      assertCompile(not (meta and not meta.var),
                          'expected var ' .. raw, symbol)
                      assertCompile(meta or not noundef,
                          'expected local ' .. parts[1], symbol)
                  end
                  if forceglobal then
                      assertCompile(not scope.symmeta[scope.unmanglings[raw]],
                                    "global " .. raw .. " conflicts with local", symbol)
                      scope.manglings[raw] = globalMangling(raw)
                      scope.unmanglings[globalMangling(raw)] = raw
                      if allowedGlobals then
                          table.insert(allowedGlobals, raw)
                      end
                  end
  
                  return symbolToExpression(symbol, scope)[1]
              end
          end
  
          -- Compile the outer most form. We can generate better Lua in this case.
          local function compileTopTarget(lvalues)
              -- Calculate initial rvalue
              local inits = utils.map(lvalues, function(x)
                                    return scope.manglings[x] and x or 'nil' end)
              local init = table.concat(inits, ', ')
              local lvalue = table.concat(lvalues, ', ')
  
              local plen = #parent
              local ret = compile1(from, scope, parent, {target = lvalue})
              if declaration then
                  if #parent == plen + 1 and parent[#parent].leaf then
                      -- A single leaf emitted means an simple assignment a = x was emitted
                      parent[#parent].leaf = 'local ' .. parent[#parent].leaf
                  else
                      table.insert(parent, plen + 1, { leaf = 'local ' .. lvalue ..
                                                           ' = ' .. init, ast = ast})
                  end
              end
              return ret
          end
  
          -- Recursive auxiliary function
          local function destructure1(left, rightexprs, up1, top)
              if utils.isSym(left) and left[1] ~= "nil" then
                  checkBindingValid(left, scope, left)
                  local lname = getname(left, up1)
                  if top then
                      compileTopTarget({lname})
                  else
                      emit(parent, setter:format(lname, exprs1(rightexprs)), left)
                  end
              elseif utils.isTable(left) then -- table destructuring
                  if top then rightexprs = compile1(from, scope, parent) end
                  local s = gensym(scope)
                  local right = exprs1(rightexprs)
                  if right == '' then right = 'nil' end
                  emit(parent, ("local %s = %s"):format(s, right), left)
                  for k, v in utils.stablepairs(left) do
                      if utils.isSym(left[k]) and left[k][1] == "&" then
                          assertCompile(type(k) == "number" and not left[k+2],
                              "expected rest argument before last parameter", left)
                          local subexpr = utils.expr(('{(table.unpack or unpack)(%s, %s)}')
                                  :format(s, k), 'expression')
                          destructure1(left[k+1], {subexpr}, left)
                          return
                      else
                          if utils.isSym(k) and tostring(k) == ":" and utils.isSym(v) then
                              k = tostring(v)
                          end
                          if type(k) ~= "number" then k = serializeString(k) end
                          local subexpr = utils.expr(('%s[%s]'):format(s, k), 'expression')
                          destructure1(v, {subexpr}, left)
                      end
                  end
              elseif utils.isList(left) then -- values destructuring
                  local leftNames, tables = {}, {}
                  for i, name in ipairs(left) do
                      local symname
                      if utils.isSym(name) then -- binding directly to a name
                          symname = getname(name, up1)
                      else -- further destructuring of tables inside values
                          symname = gensym(scope)
                          tables[i] = {name, utils.expr(symname, 'sym')}
                      end
                      table.insert(leftNames, symname)
                  end
                  if top then
                      compileTopTarget(leftNames)
                  else
                      local lvalue = table.concat(leftNames, ', ')
                      emit(parent, setter:format(lvalue, exprs1(rightexprs)), left)
                  end
                  for _, pair in utils.stablepairs(tables) do -- recurse if left-side tables found
                      destructure1(pair[1], {pair[2]}, left)
                  end
              else
                  assertCompile(false, ("unable to bind %s %s"):
                                    format(type(left), tostring(left)),
                                type(up1[2]) == "table" and up1[2] or up1)
              end
              if top then return {returned = true} end
          end
  
          local ret = destructure1(to, nil, ast, true)
          applyManglings(scope, newManglings, ast)
          return ret
      end
  
      local function requireInclude(ast, scope, parent, opts)
          opts.fallback = function(e)
              return utils.expr(('require(%s)'):format(tostring(e)), 'statement')
          end
          return scopes.global.specials['include'](ast, scope, parent, opts)
      end
  
      local function compileStream(strm, options)
          local opts = utils.copy(options)
          local oldGlobals = allowedGlobals
          utils.root:setReset()
          allowedGlobals = opts.allowedGlobals
          if opts.indent == nil then opts.indent = '  ' end
          local scope = opts.scope or makeScope(scopes.global)
          if opts.requireAsInclude then scope.specials.require = requireInclude end
          local vals = {}
          for ok, val in parser.parser(strm, opts.filename, opts) do
              if not ok then break end
              vals[#vals + 1] = val
          end
          local chunk = {}
          utils.root.chunk, utils.root.scope, utils.root.options = chunk, scope, opts
          for i = 1, #vals do
              local exprs = compile1(vals[i], scope, chunk, {
                  tail = i == #vals,
                  nval = i < #vals and 0 or nil
              })
              keepSideEffects(exprs, chunk, nil, vals[i])
          end
          allowedGlobals = oldGlobals
          utils.root.reset()
          return flatten(chunk, opts)
      end
  
      local function compileString(str, options)
          options = options or {}
          local oldSource = options.source
          options.source = str -- used by fennelfriend
          local ast = compileStream(parser.stringStream(str), options)
          options.source = oldSource
          return ast
      end
  
      local function compile(ast, options)
          local opts = utils.copy(options)
          local oldGlobals = allowedGlobals
          utils.root:setReset()
          allowedGlobals = opts.allowedGlobals
          if opts.indent == nil then opts.indent = '  ' end
          local chunk = {}
          local scope = opts.scope or makeScope(scopes.global)
          utils.root.chunk, utils.root.scope, utils.root.options = chunk, scope, opts
          if opts.requireAsInclude then scope.specials.require = requireInclude end
          local exprs = compile1(ast, scope, chunk, {tail = true})
          keepSideEffects(exprs, chunk, nil, ast)
          allowedGlobals = oldGlobals
          utils.root.reset()
          return flatten(chunk, opts)
      end
  
      -- A custom traceback function for Fennel that looks similar to
      -- the Lua's debug.traceback.
      -- Use with xpcall to produce fennel specific stacktraces.
      local function traceback(msg, start)
          local level = start or 2 -- Can be used to skip some frames
          local lines = {}
          if msg then
              if msg:find("^Compile error") or msg:find("^Parse error") then
                  -- End users don't want to see compiler stack traces, but when
                  -- you're hacking on the compiler, export FENNEL_DEBUG=trace
                  if not utils.debugOn("trace") then return msg end
                  table.insert(lines, msg)
              else
                  local newmsg = msg:gsub('^[^:]*:%d+:%s+', 'runtime error: ')
                  table.insert(lines, newmsg)
              end
          end
          table.insert(lines, 'stack traceback:')
          while true do
              local info = debug.getinfo(level, "Sln")
              if not info then break end
              local line
              if info.what == "C" then
                  if info.name then
                      line = ('  [C]: in function \'%s\''):format(info.name)
                  else
                      line = '  [C]: in ?'
                  end
              else
                  local remap = fennelSourcemap[info.source]
                  if remap and remap[info.currentline] then
                      -- And some global info
                      info.short_src = remap.short_src
                      local mapping = remap[info.currentline]
                      -- Overwrite info with values from the mapping (mapping is now
                      -- just integer, but may eventually be a table)
                      info.currentline = mapping
                  end
                  if info.what == 'Lua' then
                      local n = info.name and ("'" .. info.name .. "'") or '?'
                      line = ('  %s:%d: in function %s'):format(info.short_src, info.currentline, n)
                  elseif info.short_src == '(tail call)' then
                      line = '  (tail call)'
                  else
                      line = ('  %s:%d: in main chunk'):format(info.short_src, info.currentline)
                  end
              end
              table.insert(lines, line)
              level = level + 1
          end
          return table.concat(lines, '\n')
      end
  
      -- make a transformer for key / value table pairs, preserving all numeric keys
      local function entryTransform(fk,fv)
          return function(k, v)
              if type(k) == 'number' then
                  return k,fv(v)
              else
                  return fk(k),fv(v)
              end
          end
      end
  
      -- consume everything return nothing
      local function no() end
  
      local function mixedConcat(t, joiner)
          local ret = ""
          local s = ""
          local seen = {}
          for k,v in ipairs(t) do
              table.insert(seen, k)
              ret = ret .. s .. v
              s = joiner
          end
          for k,v in utils.stablepairs(t) do
              if not(seen[k]) then
                  ret = ret .. s .. '[' .. k .. ']' .. '=' .. v
                  s = joiner
              end
          end
          return ret
      end
  
      -- expand a quoted form into a data literal, evaluating unquote
      local function doQuote (form, scope, parent, runtime)
          local q = function (x) return doQuote(x, scope, parent, runtime) end
          -- vararg
          if utils.isVarg(form) then
              assertCompile(not runtime, "quoted ... may only be used at compile time", form)
              return "_VARARG"
          -- symbol
          elseif utils.isSym(form) then
              assertCompile(not runtime, "symbols may only be used at compile time", form)
              -- We should be able to use "%q" for this but Lua 5.1 throws an error
              -- when you try to format nil, because it's extremely bad.
              local filename = form.filename and ('%q'):format(form.filename) or "nil"
              if utils.deref(form):find("#$") or utils.deref(form):find("#[:.]") then -- autogensym
                  return ("sym('%s', nil, {filename=%s, line=%s})"):
                      format(autogensym(utils.deref(form), scope), filename, form.line or "nil")
              else -- prevent non-gensymmed symbols from being bound as an identifier
                  return ("sym('%s', nil, {quoted=true, filename=%s, line=%s})"):
                      format(utils.deref(form), filename, form.line or "nil")
              end
          -- unquote
          elseif(utils.isList(form) and utils.isSym(form[1]) and
                 (utils.deref(form[1]) == 'unquote')) then
              local payload = form[2]
              local res = unpack(compile1(payload, scope, parent))
              return res[1]
          -- list
          elseif utils.isList(form) then
              assertCompile(not runtime, "lists may only be used at compile time", form)
              local mapped = utils.kvmap(form, entryTransform(no, q))
              local filename = form.filename and ('%q'):format(form.filename) or "nil"
              -- Constructing a list and then adding file/line data to it triggers a
              -- bug where it changes the value of # for lists that contain nils in
              -- them; constructing the list all in one go with the source data and
              -- contents is how we construct lists in the parser and works around
              -- this problem; allowing # to work in a way that lets us see the nils.
              return ("setmetatable({filename=%s, line=%s, bytestart=%s, %s}" ..
                          ", getmetatable(list()))")
                  :format(filename, form.line or "nil", form.bytestart or "nil",
                          mixedConcat(mapped, ", "))
          -- table
          elseif type(form) == 'table' then
              local mapped = utils.kvmap(form, entryTransform(q, q))
              local source = getmetatable(form)
              local filename = source.filename and ('%q'):format(source.filename) or "nil"
              return ("setmetatable({%s}, {filename=%s, line=%s})"):
                  format(mixedConcat(mapped, ", "), filename, source and source.line or "nil")
          -- string
          elseif type(form) == 'string' then
              return serializeString(form)
          else
              return tostring(form)
          end
      end
      return {
          -- compiling functions:
          compileString=compileString, compileStream=compileStream,
          compile=compile, compile1=compile1, emit=emit, destructure=destructure,
  
          -- AST functions:
          gensym=gensym, autogensym=autogensym, doQuote=doQuote,
          macroexpand=macroexpand, globalUnmangling=globalUnmangling,
          applyManglings=applyManglings, globalMangling=globalMangling,
  
          -- scope functions:
          makeScope=makeScope, keepSideEffects=keepSideEffects,
          declareLocal=declareLocal, symbolToExpression=symbolToExpression,
  
          -- general functions:
          assert=assertCompile, metadata=makeMetadata(), traceback=traceback,
          scopes=scopes,
      }
  end)()
  
  --
  -- Specials and macros
  --
  
  local specials = (function()
      local SPECIALS = compiler.scopes.global.specials
  
      -- Convert a fennel environment table to a Lua environment table.
      -- This means automatically unmangling globals when getting a value,
      -- and mangling values when setting a value. This means the original env
      -- will see its values updated as expected, regardless of mangling rules.
      local function wrapEnv(env)
          return setmetatable({}, {
              __index = function(_, key)
                  if type(key) == 'string' then
                      key = compiler.globalUnmangling(key)
                  end
                  return env[key]
              end,
              __newindex = function(_, key, value)
                  if type(key) == 'string' then
                      key = compiler.globalMangling(key)
                  end
                  env[key] = value
              end,
              -- checking the __pairs metamethod won't work automatically in Lua 5.1
              -- sadly, but it's important for 5.2+ and can be done manually in 5.1
              __pairs = function()
                  local function putenv(k, v)
                      return type(k) == 'string' and compiler.globalUnmangling(k) or k, v
                  end
                  local pt = utils.kvmap(env, putenv)
                  return next, pt, nil
              end,
          })
      end
  
      local function currentGlobalNames(env)
          return utils.kvmap(env or _G, compiler.globalUnmangling)
      end
  
      -- Load code with an environment in all recent Lua versions
      local function loadCode(code, environment, filename)
          environment = environment or _ENV or _G
          if setfenv and loadstring then
              local f = assert(loadstring(code, filename))
              setfenv(f, environment)
              return f
          else
              return assert(load(code, filename, "t", environment))
          end
      end
  
      -- Return a docstring
      local doc = function(tgt, name)
          if(not tgt) then return name .. " not found" end
          local docstring = (compiler.metadata:get(tgt, 'fnl/docstring') or
                                 '#<undocumented>'):gsub('\n$', ''):gsub('\n', '\n  ')
          if type(tgt) == "function" then
              local arglist = table.concat(compiler.metadata:get(tgt, 'fnl/arglist') or
                                               {'#<unknown-arguments>'}, ' ')
              return string.format("(%s%s%s)\n  %s", name, #arglist > 0 and ' ' or '',
                                   arglist, docstring)
          else
              return string.format("%s\n  %s", name, docstring)
          end
      end
  
      local function docSpecial(name, arglist, docstring)
          compiler.metadata[SPECIALS[name]] =
              { ["fnl/docstring"] = docstring, ["fnl/arglist"] = arglist }
      end
  
      -- Compile a list of forms for side effects
      local function compileDo(ast, scope, parent, start)
          start = start or 2
          local len = #ast
          local subScope = compiler.makeScope(scope)
          for i = start, len do
              compiler.compile1(ast[i], subScope, parent, {
                  nval = 0
              })
          end
      end
  
      -- Implements a do statement, starting at the 'start' element. By default, start is 2.
      local function doImpl(ast, scope, parent, opts, start, chunk, subScope, preSyms)
          start = start or 2
          subScope = subScope or compiler.makeScope(scope)
          chunk = chunk or {}
          local len = #ast
          local outerTarget = opts.target
          local outerTail = opts.tail
          local retexprs = {returned = true}
  
          -- See if we need special handling to get the return values
          -- of the do block
          if not outerTarget and opts.nval ~= 0 and not outerTail then
              if opts.nval then
                  -- Generate a local target
                  local syms = {}
                  for i = 1, opts.nval do
                      local s = preSyms and preSyms[i] or compiler.gensym(scope)
                      syms[i] = s
                      retexprs[i] = utils.expr(s, 'sym')
                  end
                  outerTarget = table.concat(syms, ', ')
                  compiler.emit(parent, ('local %s'):format(outerTarget), ast)
                  compiler.emit(parent, 'do', ast)
              else
                  -- We will use an IIFE for the do
                  local fname = compiler.gensym(scope)
                  local fargs = scope.vararg and '...' or ''
                  compiler.emit(parent, ('local function %s(%s)'):format(fname, fargs), ast)
                  retexprs = utils.expr(fname .. '(' .. fargs .. ')', 'statement')
                  outerTail = true
                  outerTarget = nil
              end
          else
              compiler.emit(parent, 'do', ast)
          end
          -- Compile the body
          if start > len then
              -- In the unlikely case we do a do with no arguments.
              compiler.compile1(nil, subScope, chunk, {
                  tail = outerTail,
                  target = outerTarget
              })
              -- There will be no side effects
          else
              for i = start, len do
                  local subopts = {
                      nval = i ~= len and 0 or opts.nval,
                      tail = i == len and outerTail or nil,
                      target = i == len and outerTarget or nil
                  }
                  utils.propagateOptions(opts, subopts)
                  local subexprs = compiler.compile1(ast[i], subScope, chunk, subopts)
                  if i ~= len then
                      compiler.keepSideEffects(subexprs, parent, nil, ast[i])
                  end
              end
          end
          compiler.emit(parent, chunk, ast)
          compiler.emit(parent, 'end', ast)
          return retexprs
      end
  
      SPECIALS["do"] = doImpl
      docSpecial("do", {"..."}, "Evaluate multiple forms; return last value.")
  
      -- Unlike most expressions and specials, 'values' resolves with multiple
      -- values, one for each argument, allowing multiple return values. The last
      -- expression can return multiple arguments as well, allowing for more than
      -- the number of expected arguments.
      SPECIALS["values"] = function(ast, scope, parent)
          local len = #ast
          local exprs = {}
          for i = 2, len do
              local subexprs = compiler.compile1(ast[i], scope, parent, {
                  nval = (i ~= len) and 1
              })
              exprs[#exprs + 1] = subexprs[1]
              if i == len then
                  for j = 2, #subexprs do
                      exprs[#exprs + 1] = subexprs[j]
                  end
              end
          end
          return exprs
      end
      docSpecial("values", {"..."},
                 "Return multiple values from a function.  Must be in tail position.")
  
      -- The fn special declares a function. Syntax is similar to other lisps;
      -- (fn optional-name [arg ...] (body))
      -- Further decoration such as docstrings, meta info, and multibody functions a possibility.
      SPECIALS["fn"] = function(ast, scope, parent)
          local fScope = compiler.makeScope(scope)
          local fChunk = {}
          local index = 2
          local fnName = utils.isSym(ast[index])
          local isLocalFn
          local docstring
          fScope.vararg = false
          local multi = fnName and utils.isMultiSym(fnName[1])
          compiler.assert(not multi or not multi.multiSymMethodCall,
                        "unexpected multi symbol " .. tostring(fnName), ast[index])
          if fnName and fnName[1] ~= 'nil' then
              isLocalFn = not multi
              if isLocalFn then
                  fnName = compiler.declareLocal(fnName, {}, scope, ast)
              else
                  fnName = compiler.symbolToExpression(fnName, scope)[1]
              end
              index = index + 1
          else
              isLocalFn = true
              fnName = compiler.gensym(scope)
          end
          local argList = compiler.assert(utils.isTable(ast[index]),
                                        "expected parameters",
                                        type(ast[index]) == "table" and ast[index] or ast)
          local function getArgName(i, name)
              if utils.isVarg(name) then
                  compiler.assert(i == #argList, "expected vararg as last parameter", ast[2])
                  fScope.vararg = true
                  return "..."
              elseif(utils.isSym(name) and utils.deref(name) ~= "nil"
                     and not utils.isMultiSym(utils.deref(name))) then
                  return compiler.declareLocal(name, {}, fScope, ast)
              elseif utils.isTable(name) then
                  local raw = utils.sym(compiler.gensym(scope))
                  local declared = compiler.declareLocal(raw, {}, fScope, ast)
                  compiler.destructure(name, raw, ast, fScope, fChunk,
                                       { declaration = true, nomulti = true })
                  return declared
              else
                  compiler.assert(false, ("expected symbol for function parameter: %s"):
                                    format(tostring(name)), ast[2])
              end
          end
          local argNameList = utils.kvmap(argList, getArgName)
          if type(ast[index + 1]) == 'string' and index + 1 < #ast then
              index = index + 1
              docstring = ast[index]
          end
          for i = index + 1, #ast do
              compiler.compile1(ast[i], fScope, fChunk, {
                  tail = i == #ast,
                  nval = i ~= #ast and 0 or nil,
              })
          end
          if isLocalFn then
              compiler.emit(parent, ('local function %s(%s)')
                       :format(fnName, table.concat(argNameList, ', ')), ast)
          else
              compiler.emit(parent, ('%s = function(%s)')
                       :format(fnName, table.concat(argNameList, ', ')), ast)
          end
  
          compiler.emit(parent, fChunk, ast)
          compiler.emit(parent, 'end', ast)
  
          if utils.root.options.useMetadata then
              local args = utils.map(argList, function(v)
                  -- TODO: show destructured args properly instead of replacing
                  return utils.isTable(v) and '"#<table>"' or string.format('"%s"', tostring(v))
              end)
  
              local metaFields = {
                  '"fnl/arglist"', '{' .. table.concat(args, ', ') .. '}',
              }
              if docstring then
                  table.insert(metaFields, '"fnl/docstring"')
                  table.insert(metaFields, '"' .. docstring:gsub('%s+$', '')
                                   :gsub('\\', '\\\\'):gsub('\n', '\\n')
                                   :gsub('"', '\\"') .. '"')
              end
              local metaStr = ('require("%s").metadata'):
                  format(utils.root.options.moduleName or "fennel")
              compiler.emit(parent, string.format('pcall(function() %s:setall(%s, %s) end)',
                                         metaStr, fnName, table.concat(metaFields, ', ')))
          end
  
          return utils.expr(fnName, 'sym')
      end
      docSpecial("fn", {"name?", "args", "docstring?", "..."},
                 "Function syntax. May optionally include a name and docstring."
                     .."\nIf a name is provided, the function will be bound in the current scope."
                     .."\nWhen called with the wrong number of args, excess args will be discarded"
                     .."\nand lacking args will be nil, use lambda for arity-checked functions.")
  
      -- (lua "print('hello!')") -> prints hello, evaluates to nil
      -- (lua "print 'hello!'" "10") -> prints hello, evaluates to the number 10
      -- (lua nil "{1,2,3}") -> Evaluates to a table literal
      SPECIALS['lua'] = function(ast, _, parent)
          compiler.assert(#ast == 2 or #ast == 3, "expected 1 or 2 arguments", ast)
          if ast[2] ~= nil then
              table.insert(parent, {leaf = tostring(ast[2]), ast = ast})
          end
          if #ast == 3 then
              return tostring(ast[3])
          end
      end
  
      SPECIALS['doc'] = function(ast, scope, parent)
          assert(utils.root.options.useMetadata, "can't look up doc with metadata disabled.")
          compiler.assert(#ast == 2, "expected one argument", ast)
  
          local target = utils.deref(ast[2])
          local specialOrMacro = scope.specials[target] or scope.macros[target]
          if specialOrMacro then
              return ("print([[%s]])"):format(doc(specialOrMacro, target))
          else
              local value = tostring(compiler.compile1(ast[2], scope, parent, {nval = 1})[1])
              -- need to require here since the metadata is stored in the module
              -- and we need to make sure we look it up in the same module it was
              -- declared from.
              return ("print(require('%s').doc(%s, '%s'))")
                  :format(utils.root.options.moduleName or "fennel", value, tostring(ast[2]))
          end
      end
      docSpecial("doc", {"x"},
                 "Print the docstring and arglist for a function, macro, or special form.")
  
      -- Table lookup
      SPECIALS["."] = function(ast, scope, parent)
          local len = #ast
          compiler.assert(len > 1, "expected table argument", ast)
          local lhs = compiler.compile1(ast[2], scope, parent, {nval = 1})
          if len == 2 then
              return tostring(lhs[1])
          else
              local indices = {}
              for i = 3, len do
                  local index = ast[i]
                  if type(index) == 'string' and utils.isValidLuaIdentifier(index) then
                      table.insert(indices, '.' .. index)
                  else
                      index = compiler.compile1(index, scope, parent, {nval = 1})[1]
                      table.insert(indices, '[' .. tostring(index) .. ']')
                  end
              end
              -- extra parens are needed for table literals
              if utils.isTable(ast[2]) then
                  return '(' .. tostring(lhs[1]) .. ')' .. table.concat(indices)
              else
                  return tostring(lhs[1]) .. table.concat(indices)
              end
          end
      end
      docSpecial(".", {"tbl", "key1", "..."},
                 "Look up key1 in tbl table. If more args are provided, do a nested lookup.")
  
      SPECIALS["global"] = function(ast, scope, parent)
          compiler.assert(#ast == 3, "expected name and value", ast)
          compiler.destructure(ast[2], ast[3], ast, scope, parent, {
              nomulti = true,
              forceglobal = true
          })
      end
      docSpecial("global", {"name", "val"}, "Set name as a global with val.")
  
      SPECIALS["set"] = function(ast, scope, parent)
          compiler.assert(#ast == 3, "expected name and value", ast)
          compiler.destructure(ast[2], ast[3], ast, scope, parent, {
              noundef = true
          })
      end
      docSpecial("set", {"name", "val"},
                 "Set a local variable to a new value. Only works on locals using var.")
  
      SPECIALS["set-forcibly!"] = function(ast, scope, parent)
          compiler.assert(#ast == 3, "expected name and value", ast)
          compiler.destructure(ast[2], ast[3], ast, scope, parent, {
              forceset = true
          })
      end
  
      SPECIALS["local"] = function(ast, scope, parent)
          compiler.assert(#ast == 3, "expected name and value", ast)
          compiler.destructure(ast[2], ast[3], ast, scope, parent, {
              declaration = true,
              nomulti = true
          })
      end
      docSpecial("local", {"name", "val"},
                 "Introduce new top-level immutable local.")
  
      SPECIALS["var"] = function(ast, scope, parent)
          compiler.assert(#ast == 3, "expected name and value", ast)
          compiler.destructure(ast[2], ast[3], ast, scope, parent, {
                                   declaration = true, nomulti = true, isvar = true })
      end
      docSpecial("var", {"name", "val"},
                 "Introduce new mutable local.")
  
      SPECIALS["let"] = function(ast, scope, parent, opts)
          local bindings = ast[2]
          compiler.assert(utils.isList(bindings) or utils.isTable(bindings),
                        "expected binding table", ast)
          compiler.assert(#bindings % 2 == 0,
                        "expected even number of name/value bindings", ast[2])
          compiler.assert(#ast >= 3, "expected body expression", ast[1])
          -- we have to gensym the binding for the let body's return value before
          -- compiling the binding vector, otherwise there's a possibility to conflict
          local preSyms = {}
          for _ = 1, (opts.nval or 0) do table.insert(preSyms, compiler.gensym(scope)) end
          local subScope = compiler.makeScope(scope)
          local subChunk = {}
          for i = 1, #bindings, 2 do
              compiler.destructure(bindings[i], bindings[i + 1], ast, subScope, subChunk, {
                                       declaration = true, nomulti = true })
          end
          return doImpl(ast, scope, parent, opts, 3, subChunk, subScope, preSyms)
      end
      docSpecial("let", {"[name1 val1 ... nameN valN]", "..."},
                 "Introduces a new scope in which a given set of local bindings are used.")
  
      -- For setting items in a table
      SPECIALS["tset"] = function(ast, scope, parent)
          compiler.assert(#ast > 3, ("expected table, key, and value arguments"), ast)
          local root = compiler.compile1(ast[2], scope, parent, {nval = 1})[1]
          local keys = {}
          for i = 3, #ast - 1 do
              local key = compiler.compile1(ast[i], scope, parent, {nval = 1})[1]
              keys[#keys + 1] = tostring(key)
          end
          local value = compiler.compile1(ast[#ast], scope, parent, {nval = 1})[1]
          local rootstr = tostring(root)
          -- Prefix 'do end ' so parens are not ambiguous (grouping or function call?)
          local fmtstr = (rootstr:match("^{")) and "do end (%s)[%s] = %s" or "%s[%s] = %s"
          compiler.emit(parent, fmtstr:format(tostring(root),
                                     table.concat(keys, ']['),
                                     tostring(value)), ast)
      end
      docSpecial("tset", {"tbl", "key1", "...", "keyN", "val"},
                 "Set the value of a table field. Can take additional keys to set"
              .. "nested values,\nbut all parents must contain an existing table.")
  
      -- The if special form behaves like the cond form in
      -- many languages
      SPECIALS["if"] = function(ast, scope, parent, opts)
          local doScope = compiler.makeScope(scope)
          local branches = {}
          local elseBranch = nil
  
          -- Calculate some external stuff. Optimizes for tail calls and what not
          local wrapper, innerTail, innerTarget, targetExprs
          if opts.tail or opts.target or opts.nval then
              if opts.nval and opts.nval ~= 0 and not opts.target then
                  -- We need to create a target
                  targetExprs = {}
                  local accum = {}
                  for i = 1, opts.nval do
                      local s = compiler.gensym(scope)
                      accum[i] = s
                      targetExprs[i] = utils.expr(s, 'sym')
                  end
                  wrapper = 'target'
                  innerTail = opts.tail
                  innerTarget = table.concat(accum, ', ')
              else
                  wrapper = 'none'
                  innerTail = opts.tail
                  innerTarget = opts.target
              end
          else
              wrapper = 'iife'
              innerTail = true
              innerTarget = nil
          end
  
          -- Compile bodies and conditions
          local bodyOpts = {
              tail = innerTail,
              target = innerTarget,
              nval = opts.nval
          }
          local function compileBody(i)
              local chunk = {}
              local cscope = compiler.makeScope(doScope)
              compiler.keepSideEffects(compiler.compile1(ast[i], cscope, chunk, bodyOpts),
              chunk, nil, ast[i])
              return {
                  chunk = chunk,
                  scope = cscope
              }
          end
          for i = 2, #ast - 1, 2 do
              local condchunk = {}
              local res = compiler.compile1(ast[i], doScope, condchunk, {nval = 1})
              local cond = res[1]
              local branch = compileBody(i + 1)
              branch.cond = cond
              branch.condchunk = condchunk
              branch.nested = i ~= 2 and next(condchunk, nil) == nil
              table.insert(branches, branch)
          end
          local hasElse = #ast > 3 and #ast % 2 == 0
          if hasElse then elseBranch = compileBody(#ast) end
  
          -- Emit code
          local s = compiler.gensym(scope)
          local buffer = {}
          local lastBuffer = buffer
          for i = 1, #branches do
              local branch = branches[i]
              local fstr = not branch.nested and 'if %s then' or 'elseif %s then'
              local cond = tostring(branch.cond)
              local condLine = (cond == "true" and branch.nested and i == #branches)
                  and "else"
                  or fstr:format(cond)
              if branch.nested then
                  compiler.emit(lastBuffer, branch.condchunk, ast)
              else
                  for _, v in ipairs(branch.condchunk) do compiler.emit(lastBuffer, v, ast) end
              end
              compiler.emit(lastBuffer, condLine, ast)
              compiler.emit(lastBuffer, branch.chunk, ast)
              if i == #branches then
                  if hasElse then
                      compiler.emit(lastBuffer, 'else', ast)
                      compiler.emit(lastBuffer, elseBranch.chunk, ast)
                  -- TODO: Consolidate use of condLine ~= "else" with hasElse
                  elseif(innerTarget and condLine ~= 'else') then
                      compiler.emit(lastBuffer, 'else', ast)
                      compiler.emit(lastBuffer, ("%s = nil"):format(innerTarget), ast)
                  end
                  compiler.emit(lastBuffer, 'end', ast)
              elseif not branches[i + 1].nested then
                  compiler.emit(lastBuffer, 'else', ast)
                  local nextBuffer = {}
                  compiler.emit(lastBuffer, nextBuffer, ast)
                  compiler.emit(lastBuffer, 'end', ast)
                  lastBuffer = nextBuffer
              end
          end
  
          if wrapper == 'iife' then
              local iifeargs = scope.vararg and '...' or ''
              compiler.emit(parent, ('local function %s(%s)'):format(tostring(s), iifeargs), ast)
              compiler.emit(parent, buffer, ast)
              compiler.emit(parent, 'end', ast)
              return utils.expr(('%s(%s)'):format(tostring(s), iifeargs), 'statement')
          elseif wrapper == 'none' then
              -- Splice result right into code
              for i = 1, #buffer do
                  compiler.emit(parent, buffer[i], ast)
              end
              return {returned = true}
          else -- wrapper == 'target'
              compiler.emit(parent, ('local %s'):format(innerTarget), ast)
              for i = 1, #buffer do
                  compiler.emit(parent, buffer[i], ast)
              end
              return targetExprs
          end
      end
      docSpecial("if", {"cond1", "body1", "...", "condN", "bodyN"},
                 "Conditional form.\n" ..
                     "Takes any number of condition/body pairs and evaluates the first body where"
                     .. "\nthe condition evaluates to truthy. Similar to cond in other lisps.")
  
      -- (each [k v (pairs t)] body...) => []
      SPECIALS["each"] = function(ast, scope, parent)
          local binding = compiler.assert(utils.isTable(ast[2]), "expected binding table", ast)
          compiler.assert(#ast >= 3, "expected body expression", ast[1])
          local iter = table.remove(binding, #binding) -- last item is iterator call
          local destructures = {}
          local newManglings = {}
          local subScope = compiler.makeScope(scope)
          local function destructureBinding(v)
              if utils.isSym(v) then
                  return compiler.declareLocal(v, {}, subScope, ast, newManglings)
              else
                  local raw = utils.sym(compiler.gensym(subScope))
                  destructures[raw] = v
                  return compiler.declareLocal(raw, {}, subScope, ast)
              end
          end
          local bindVars = utils.map(binding, destructureBinding)
          local vals = compiler.compile1(iter, subScope, parent)
          local valNames = utils.map(vals, tostring)
  
          compiler.emit(parent, ('for %s in %s do'):format(table.concat(bindVars, ', '),
                                                  table.concat(valNames, ", ")), ast)
          local chunk = {}
          for raw, args in utils.stablepairs(destructures) do
              compiler.destructure(args, raw, ast, subScope, chunk,
                                   { declaration = true, nomulti = true })
          end
          compiler.applyManglings(subScope, newManglings, ast)
          compileDo(ast, subScope, chunk, 3)
          compiler.emit(parent, chunk, ast)
          compiler.emit(parent, 'end', ast)
      end
      docSpecial("each", {"[key value (iterator)]", "..."},
                 "Runs the body once for each set of values provided by the given iterator."
                 .."\nMost commonly used with ipairs for sequential tables or pairs for"
                     .." undefined\norder, but can be used with any iterator.")
  
      -- (while condition body...) => []
      SPECIALS["while"] = function(ast, scope, parent)
          local len1 = #parent
          local condition = compiler.compile1(ast[2], scope, parent, {nval = 1})[1]
          local len2 = #parent
          local subChunk = {}
          if len1 ~= len2 then
              -- Compound condition
              -- Move new compilation to subchunk
              for i = len1 + 1, len2 do
                  subChunk[#subChunk + 1] = parent[i]
                  parent[i] = nil
              end
              compiler.emit(parent, 'while true do', ast)
              compiler.emit(subChunk, ('if not %s then break end'):format(condition[1]), ast)
          else
              -- Simple condition
              compiler.emit(parent, 'while ' .. tostring(condition) .. ' do', ast)
          end
          compileDo(ast, compiler.makeScope(scope), subChunk, 3)
          compiler.emit(parent, subChunk, ast)
          compiler.emit(parent, 'end', ast)
      end
      docSpecial("while", {"condition", "..."},
                 "The classic while loop. Evaluates body until a condition is non-truthy.")
  
      SPECIALS["for"] = function(ast, scope, parent)
          local ranges = compiler.assert(utils.isTable(ast[2]), "expected binding table", ast)
          local bindingSym = table.remove(ast[2], 1)
          local subScope = compiler.makeScope(scope)
          compiler.assert(utils.isSym(bindingSym),
                        ("unable to bind %s %s"):
                            format(type(bindingSym), tostring(bindingSym)), ast[2])
          compiler.assert(#ast >= 3, "expected body expression", ast[1])
          local rangeArgs = {}
          for i = 1, math.min(#ranges, 3) do
              rangeArgs[i] = tostring(compiler.compile1(ranges[i], subScope, parent, {nval = 1})[1])
          end
          compiler.emit(parent, ('for %s = %s do'):format(
                   compiler.declareLocal(bindingSym, {}, subScope, ast),
                   table.concat(rangeArgs, ', ')), ast)
          local chunk = {}
          compileDo(ast, subScope, chunk, 3)
          compiler.emit(parent, chunk, ast)
          compiler.emit(parent, 'end', ast)
      end
      docSpecial("for", {"[index start stop step?]", "..."}, "Numeric loop construct." ..
                     "\nEvaluates body once for each value between start and stop (inclusive).")
  
      -- For statements and expressions, put the value in a local to avoid
      -- double-evaluating it.
      local function once(val, ast, scope, parent)
          if val.type == 'statement' or val.type == 'expression' then
              local s = compiler.gensym(scope)
              compiler.emit(parent, ('local %s = %s'):format(s, tostring(val)), ast)
              return utils.expr(s, 'sym')
          else
              return val
          end
      end
  
      SPECIALS[":"] = function(ast, scope, parent)
          compiler.assert(#ast >= 3, "expected at least 2 arguments", ast)
          -- Compile object
          local objectexpr = compiler.compile1(ast[2], scope, parent, {nval = 1})[1]
          -- Compile method selector
          local methodstring
          local methodident = false
          if type(ast[3]) == 'string' and utils.isValidLuaIdentifier(ast[3]) then
              methodident = true
              methodstring = ast[3]
          else
              methodstring = tostring(compiler.compile1(ast[3], scope, parent, {nval = 1})[1])
              objectexpr = once(objectexpr, ast[2], scope, parent)
          end
          -- Compile arguments
          local args = {}
          for i = 4, #ast do
              local subexprs = compiler.compile1(ast[i], scope, parent, {
                  nval = i ~= #ast and 1 or nil
              })
              utils.map(subexprs, tostring, args)
          end
          local fstring
          if not methodident then
              -- Make object first argument
              table.insert(args, 1, tostring(objectexpr))
              fstring = objectexpr.type == 'sym'
                  and '%s[%s](%s)'
                  or '(%s)[%s](%s)'
          elseif(objectexpr.type == 'literal' or objectexpr.type == 'expression') then
              fstring = '(%s):%s(%s)'
          else
              fstring = '%s:%s(%s)'
          end
          return utils.expr(fstring:format(
              tostring(objectexpr),
              methodstring,
              table.concat(args, ', ')), 'statement')
      end
      docSpecial(":", {"tbl", "method-name", "..."},
                 "Call the named method on tbl with the provided args."..
                 "\nMethod name doesn\"t have to be known at compile-time; if it is, use"
                     .."\n(tbl:method-name ...) instead.")
  
      SPECIALS["comment"] = function(ast, _, parent)
          local els = {}
          for i = 2, #ast do
              els[#els + 1] = tostring(ast[i]):gsub('\n', ' ')
          end
          compiler.emit(parent, '-- ' .. table.concat(els, ' '), ast)
      end
      docSpecial("comment", {"..."}, "Comment which will be emitted in Lua output.")
  
      SPECIALS["hashfn"] = function(ast, scope, parent)
          compiler.assert(#ast == 2, "expected one argument", ast)
          local fScope = compiler.makeScope(scope)
          local fChunk = {}
          local name = compiler.gensym(scope)
          local symbol = utils.sym(name)
          compiler.declareLocal(symbol, {}, scope, ast)
          fScope.vararg = false
          fScope.hashfn = true
          local args = {}
          for i = 1, 9 do args[i] = compiler.declareLocal(utils.sym('$' .. i), {}, fScope, ast) end
          -- Compile body
          compiler.compile1(ast[2], fScope, fChunk, {tail = true})
          local maxUsed = 0
          for i = 1, 9 do if fScope.symmeta['$' .. i].used then maxUsed = i end end
          local argStr = table.concat(args, ', ', 1, maxUsed)
          compiler.emit(parent, ('local function %s(%s)'):format(name, argStr), ast)
          compiler.emit(parent, fChunk, ast)
          compiler.emit(parent, 'end', ast)
          return utils.expr(name, 'sym')
      end
      docSpecial("hashfn", {"..."}, "Function literal shorthand; args are $1, $2, etc.")
  
      local function defineArithmeticSpecial(name, zeroArity, unaryPrefix, luaName)
          local paddedOp = ' ' .. (luaName or name) .. ' '
          SPECIALS[name] = function(ast, scope, parent)
              local len = #ast
              if len == 1 then
                  compiler.assert(zeroArity ~= nil, 'Expected more than 0 arguments', ast)
                  return utils.expr(zeroArity, 'literal')
              else
                  local operands = {}
                  for i = 2, len do
                      local subexprs = compiler.compile1(ast[i], scope, parent, {
                          nval = (i == 1 and 1 or nil)
                      })
                      utils.map(subexprs, tostring, operands)
                  end
                  if #operands == 1 then
                      if unaryPrefix then
                          return '(' .. unaryPrefix .. paddedOp .. operands[1] .. ')'
                      else
                          return operands[1]
                      end
                  else
                      return '(' .. table.concat(operands, paddedOp) .. ')'
                  end
              end
          end
          docSpecial(name, {"a", "b", "..."},
                     "Arithmetic operator; works the same as Lua but accepts more arguments.")
      end
  
      defineArithmeticSpecial('+', '0')
      defineArithmeticSpecial('..', "''")
      defineArithmeticSpecial('^')
      defineArithmeticSpecial('-', nil, '')
      defineArithmeticSpecial('*', '1')
      defineArithmeticSpecial('%')
      defineArithmeticSpecial('/', nil, '1')
      defineArithmeticSpecial('//', nil, '1')
  
      defineArithmeticSpecial("lshift", nil, "1", "<<")
      defineArithmeticSpecial("rshift", nil, "1", ">>")
      defineArithmeticSpecial("band", "0", "0", "&")
      defineArithmeticSpecial("bor", "0", "0", "|")
      defineArithmeticSpecial("bxor", "0", "0", "~")
  
      docSpecial("lshift", {"x", "n"},
                 "Bitwise logical left shift of x by n bits; only works in Lua 5.3+.")
      docSpecial("rshift", {"x", "n"},
                 "Bitwise logical right shift of x by n bits; only works in Lua 5.3+.")
      docSpecial("band", {"x1", "x2"}, "Bitwise AND of arguments; only works in Lua 5.3+.")
      docSpecial("bor", {"x1", "x2"}, "Bitwise OR of arguments; only works in Lua 5.3+.")
      docSpecial("bxor", {"x1", "x2"}, "Bitwise XOR of arguments; only works in Lua 5.3+.")
  
      defineArithmeticSpecial('or', 'false')
      defineArithmeticSpecial('and', 'true')
  
      docSpecial("and", {"a", "b", "..."},
                 "Boolean operator; works the same as Lua but accepts more arguments.")
      docSpecial("or", {"a", "b", "..."},
                 "Boolean operator; works the same as Lua but accepts more arguments.")
      docSpecial("..", {"a", "b", "..."},
                 "String concatenation operator; works the same as Lua but accepts more arguments.")
  
      local function defineComparatorSpecial(name, realop, chainOp)
          local op = realop or name
          SPECIALS[name] = function(ast, scope, parent)
              local len = #ast
              compiler.assert(len > 2, "expected at least two arguments", ast)
              local lhs = compiler.compile1(ast[2], scope, parent, {nval = 1})[1]
              local lastval = compiler.compile1(ast[3], scope, parent, {nval = 1})[1]
              -- avoid double-eval by introducing locals for possible side-effects
              if len > 3 then lastval = once(lastval, ast[3], scope, parent) end
              local out = ('(%s %s %s)'):
                  format(tostring(lhs), op, tostring(lastval))
              if len > 3 then
                  for i = 4, len do -- variadic comparison
                      local nextval = once(compiler.compile1(ast[i], scope, parent, {nval = 1})[1],
                                           ast[i], scope, parent)
                      out = (out .. " %s (%s %s %s)"):
                          format(chainOp or 'and', tostring(lastval), op, tostring(nextval))
                      lastval = nextval
                  end
                  out = '(' .. out .. ')'
              end
              return out
          end
          docSpecial(name, {"a", "b", "..."},
                     "Comparison operator; works the same as Lua but accepts more arguments.")
      end
  
      defineComparatorSpecial('>')
      defineComparatorSpecial('<')
      defineComparatorSpecial('>=')
      defineComparatorSpecial('<=')
      defineComparatorSpecial('=', '==')
      defineComparatorSpecial('not=', '~=', 'or')
      SPECIALS["~="] = SPECIALS["not="] -- backwards-compatibility alias
  
      local function defineUnarySpecial(op, realop)
          SPECIALS[op] = function(ast, scope, parent)
              compiler.assert(#ast == 2, 'expected one argument', ast)
              local tail = compiler.compile1(ast[2], scope, parent, {nval = 1})
              return (realop or op) .. tostring(tail[1])
          end
      end
  
      defineUnarySpecial("not", "not ")
      docSpecial("not", {"x"}, "Logical operator; works the same as Lua.")
  
      defineUnarySpecial("bnot", "~")
      docSpecial("bnot", {"x"}, "Bitwise negation; only works in Lua 5.3+.")
  
      defineUnarySpecial("length", "#")
      docSpecial("length", {"x"}, "Returns the length of a table or string.")
      SPECIALS["#"] = SPECIALS["length"]
  
      SPECIALS['quote'] = function(ast, scope, parent)
          compiler.assert(#ast == 2, "expected one argument")
          local runtime, thisScope = true, scope
          while thisScope do
              thisScope = thisScope.parent
              if thisScope == compiler.scopes.compiler then runtime = false end
          end
          return compiler.doQuote(ast[2], scope, parent, runtime)
      end
      docSpecial('quote', {'x'}, 'Quasiquote the following form. Only works in macro/compiler scope.')
  
      local function makeCompilerEnv(ast, scope, parent)
          return setmetatable({
              -- State of compiler if needed
              _SCOPE = scope,
              _CHUNK = parent,
              _AST = ast,
              _IS_COMPILER = true,
              _SPECIALS = compiler.scopes.global.specials,
              _VARARG = utils.varg(),
              -- Expose the module in the compiler
              fennel = utils.fennelModule,
              unpack = unpack,
  
              -- Useful for macros and meta programming. All of Fennel can be accessed
              -- via fennel.myfun, for example (fennel.eval "(print 1)").
              list = utils.list,
              sym = utils.sym,
              sequence = utils.sequence,
              gensym = function()
                  return utils.sym(compiler.gensym(compiler.scopes.macro or scope))
              end,
              ["list?"] = utils.isList,
              ["multi-sym?"] = utils.isMultiSym,
              ["sym?"] = utils.isSym,
              ["table?"] = utils.isTable,
              ["sequence?"] = utils.isSequence,
              ["varg?"] = utils.isVarg,
              ["get-scope"] = function() return compiler.scopes.macro end,
              ["in-scope?"] = function(symbol)
                  compiler.assert(compiler.scopes.macro, "must call from macro", ast)
                  return compiler.scopes.macro.manglings[tostring(symbol)]
              end,
              ["macroexpand"] = function(form)
                  compiler.assert(compiler.scopes.macro, "must call from macro", ast)
                  return compiler.macroexpand(form, compiler.scopes.macro)
              end,
          }, { __index = _ENV or _G })
      end
  
      -- have searchModule use package.config to process package.path (windows compat)
      local cfg = string.gmatch(package.config, "([^\n]+)")
      local dirsep, pathsep, pathmark = cfg() or '/', cfg() or ';', cfg() or '?'
      local pkgConfig = {dirsep = dirsep, pathsep = pathsep, pathmark = pathmark}
  
      -- Escape a string for safe use in a Lua pattern
      local function escapepat(str)
          return string.gsub(str, "[^%w]", "%%%1")
      end
  
      local function searchModule(modulename, pathstring)
          local pathsepesc = escapepat(pkgConfig.pathsep)
          local pathsplit = string.format("([^%s]*)%s", pathsepesc,
                                          escapepat(pkgConfig.pathsep))
          local nodotModule = modulename:gsub("%.", pkgConfig.dirsep)
          for path in string.gmatch((pathstring or utils.path) ..
                                    pkgConfig.pathsep, pathsplit) do
              local filename = path:gsub(escapepat(pkgConfig.pathmark), nodotModule)
              local filename2 = path:gsub(escapepat(pkgConfig.pathmark), modulename)
              local file = io.open(filename) or io.open(filename2)
              if(file) then
                  file:close()
                  return filename
              end
          end
      end
  
      local function macroGlobals(env, globals)
          local allowed = currentGlobalNames(env)
          for _, k in pairs(globals or {}) do table.insert(allowed, k) end
          return allowed
      end
  
      local function addMacros(macros, ast, scope)
          compiler.assert(utils.isTable(macros), 'expected macros to be table', ast)
          for k,v in pairs(macros) do
              compiler.assert(type(v) == 'function', 'expected each macro to be function', ast)
              scope.macros[k] = v
          end
      end
  
      local function loadMacros(modname, ast, scope, parent)
          local filename = compiler.assert(searchModule(modname),
                                         modname .. " module not found.", ast)
          local env = makeCompilerEnv(ast, scope, parent)
          local globals = macroGlobals(env, currentGlobalNames())
          return compiler.dofileFennel(filename,
                                       { env = env, allowedGlobals = globals,
                                         useMetadata = utils.root.options.useMetadata,
                                         scope = compiler.scopes.compiler })
      end
  
      local macroLoaded = {}
  
      SPECIALS['require-macros'] = function(ast, scope, parent)
          compiler.assert(#ast == 2, "Expected one module name argument", ast)
          local modname = ast[2]
          if not macroLoaded[modname] then
              macroLoaded[modname] = loadMacros(modname, ast, scope, parent)
          end
          addMacros(macroLoaded[modname], ast, scope, parent)
      end
      docSpecial('require-macros', {'macro-module-name'},
                 'Load given module and use its contents as macro definitions in current scope.'
                     ..'\nMacro module should return a table of macro functions with string keys.'
                     ..'\nConsider using import-macros instead as it is more flexible.')
  
      SPECIALS['include'] = function(ast, scope, parent, opts)
          compiler.assert(#ast == 2, 'expected one argument', ast)
  
          -- Compile mod argument
          local modexpr = compiler.compile1(ast[2], scope, parent, {nval = 1})[1]
          if modexpr.type ~= 'literal' or modexpr[1]:byte() ~= 34 then
              if opts.fallback then
                  return opts.fallback(modexpr)
              else
                  compiler.assert(false, 'module name must resolve to a string literal', ast)
              end
          end
          local code = 'return ' .. modexpr[1]
          local mod = loadCode(code)()
  
          -- Check cache
          if utils.root.scope.includes[mod] then return utils.root.scope.includes[mod] end
  
          -- Find path to source
          local path = searchModule(mod)
          local isFennel = true
          if not path then
              isFennel = false
              path = searchModule(mod, package.path)
              if not path then
                  if opts.fallback then
                      return opts.fallback(modexpr)
                  else
                      compiler.assert(false, 'module not found ' .. mod, ast)
                  end
              end
          end
  
          -- Read source
          local f = io.open(path)
          local s = f:read('*all'):gsub('[\r\n]*$', '')
          f:close()
  
          -- splice in source and memoize it in compiler AND package.preload
          -- so we can include it again without duplication, even in runtime
          local ret = utils.expr('require("' .. mod .. '")', 'statement')
          local target = ('package.preload[%q]'):format(mod)
          local preloadStr = target .. ' = ' .. target .. ' or function(...)'
  
          local tempChunk, subChunk = {}, {}
          compiler.emit(tempChunk, preloadStr, ast)
          compiler.emit(tempChunk, subChunk)
          compiler.emit(tempChunk, 'end', ast)
          -- Splice tempChunk to begining of root chunk
          for i, v in ipairs(tempChunk) do table.insert(utils.root.chunk, i, v) end
  
          -- For fnl source, compile subChunk AFTER splicing into start of root chunk.
          if isFennel then
              local subscope = compiler.makeScope(utils.root.scope.parent)
              if utils.root.options.requireAsInclude then
                  subscope.specials.require = compiler.requireInclude
              end
              -- parse Fennel src into table of exprs to know which expr is the tail
              local forms, p = {}, parser.parser(parser.stringStream(s), path)
              for _, val in p do table.insert(forms, val) end
              -- Compile the forms into subChunk; compiler.compile1 is necessary for all nested
              -- includes to be emitted in the same root chunk in the top-level module
              for i = 1, #forms do
                  local subopts = i == #forms and {nval=1, tail=true} or {}
                  utils.propagateOptions(opts, subopts)
                  compiler.compile1(forms[i], subscope, subChunk, subopts)
              end
          else -- for Lua source, simply emit the src into the loader's body
              compiler.emit(subChunk, s, ast)
          end
  
          -- Put in cache and return
          utils.root.scope.includes[mod] = ret
          return ret
      end
      docSpecial('include', {'module-name-literal'},
                 'Like require, but load the target module during compilation and embed it in the\n'
              .. 'Lua output. The module must be a string literal and resolvable at compile time.')
  
      local function evalCompiler(ast, scope, parent)
          local luaSource =
              compiler.compile(ast, { scope = compiler.makeScope(compiler.scopes.compiler),
                                      useMetadata = utils.root.options.useMetadata })
          local loader = loadCode(luaSource, wrapEnv(makeCompilerEnv(ast, scope, parent)))
          return loader()
      end
  
      SPECIALS['macros'] = function(ast, scope, parent)
          compiler.assert(#ast == 2, "Expected one table argument", ast)
          local macros = evalCompiler(ast[2], scope, parent)
          addMacros(macros, ast, scope, parent)
      end
      docSpecial('macros', {'{:macro-name-1 (fn [...] ...) ... :macro-name-N macro-body-N}'},
                 'Define all functions in the given table as macros local to the current scope.')
  
      SPECIALS['eval-compiler'] = function(ast, scope, parent)
          local oldFirst = ast[1]
          ast[1] = utils.sym('do')
          local val = evalCompiler(ast, scope, parent)
          ast[1] = oldFirst
          return val
      end
      docSpecial('eval-compiler', {'...'}, 'Evaluate the body at compile-time.'
                     .. ' Use the macro system instead if possible.')
  
      -- A few things that aren't specials, but are needed to define specials, but
      -- are also needed for the following code.
      return { wrapEnv=wrapEnv,
               currentGlobalNames=currentGlobalNames,
               loadCode=loadCode,
               doc=doc,
               macroLoaded=macroLoaded,
               searchModule=searchModule,
               makeCompilerEnv=makeCompilerEnv, }
  end)()
  
  ---
  --- Evaluation, repl, public API, and macros
  ---
  
  local function eval(str, options, ...)
      local opts = utils.copy(options)
      -- eval and dofile are considered "live" entry points, so we can assume
      -- that the globals available at compile time are a reasonable allowed list
      -- UNLESS there's a metatable on env, in which case we can't assume that
      -- pairs will return all the effective globals; for instance openresty
      -- sets up _G in such a way that all the globals are available thru
      -- the __index meta method, but as far as pairs is concerned it's empty.
      if opts.allowedGlobals == nil and not getmetatable(opts.env) then
          opts.allowedGlobals = specials.currentGlobalNames(opts.env)
      end
      local env = opts.env and specials.wrapEnv(opts.env)
      local luaSource = compiler.compileString(str, opts)
      local loader = specials.loadCode(luaSource, env, opts.filename and
                                           ('@' .. opts.filename) or str)
      opts.filename = nil
      return loader(...)
  end
  
  -- This is bad; we have a circular dependency between the specials section and
  -- the evaluation section due to require-macros/import-macros needing to be able
  -- to do this. For now stash it in the compiler table, but we should untangle it
  compiler.dofileFennel = function(filename, options, ...)
      local opts = utils.copy(options)
      if opts.allowedGlobals == nil then
          opts.allowedGlobals = specials.currentGlobalNames(opts.env)
      end
      local f = assert(io.open(filename, "rb"))
      local source = f:read("*all")
      f:close()
      opts.filename = filename
      return eval(source, opts, ...)
  end
  
  -- Everything exported by the module
  local module = {
      parser = parser.parser,
      granulate = parser.granulate,
      stringStream = parser.stringStream,
  
      compile = compiler.compile,
      compileString = compiler.compileString,
      compileStream = compiler.compileStream,
      compile1 = compiler.compile1,
      traceback = compiler.traceback,
      mangle = compiler.globalMangling,
      unmangle = compiler.globalUnmangling,
      metadata = compiler.metadata,
      scope = compiler.makeScope,
      gensym = compiler.gensym,
  
      list = utils.list,
      sym = utils.sym,
      varg = utils.varg,
      path = utils.path,
  
      loadCode = specials.loadCode,
      macroLoaded = specials.macroLoaded,
      doc = specials.doc,
  
      eval = eval,
      dofile = compiler.dofileFennel,
      version = "0.5.0-dev",
  }
  
  utils.fennelModule = module -- yet another circular dependency =(
  
  -- In order to make this more readable, you can switch your editor to treating
  -- this file as if it were Fennel for the purposes of this section
  local replsource = [===[(local (fennel internals) ...)
  
  (fn default-read-chunk [parser-state]
    (io.write (if (< 0 parser-state.stackSize) ".." ">> "))
    (io.flush)
    (let [input (io.read)]
      (and input (.. input "\n"))))
  
  (fn default-on-values [xs]
    (io.write (table.concat xs "\t"))
    (io.write "\n"))
  
  (fn default-on-error [errtype err lua-source]
    (io.write
     (match errtype
       "Lua Compile" (.. "Bad code generated - likely a bug with the compiler:\n"
                         "--- Generated Lua Start ---\n"
                         lua-source
                         "--- Generated Lua End ---\n")
       "Runtime" (.. (fennel.traceback err 4) "\n")
       _ (: "%s error: %s\n" :format errtype (tostring err)))))
  
  (local save-source
         (table.concat ["local ___i___ = 1"
                        "while true do"
                        " local name, value = debug.getlocal(1, ___i___)"
                        " if(name and name ~= \"___i___\") then"
                        " ___replLocals___[name] = value"
                        " ___i___ = ___i___ + 1"
                        " else break end end"] "\n"))
  
  (fn splice-save-locals [env lua-source]
    (set env.___replLocals___ (or env.___replLocals___ {}))
    (let [spliced-source []
          bind "local %s = ___replLocals___['%s']"]
      (each [line (lua-source:gmatch "([^\n]+)\n?")]
        (table.insert spliced-source line))
      (each [name (pairs env.___replLocals___)]
        (table.insert spliced-source 1 (bind:format name name)))
      (when (and (< 1 (# spliced-source))
                 (: (. spliced-source (# spliced-source)) :match "^ *return .*$"))
        (table.insert spliced-source (# spliced-source) save-source))
      (table.concat spliced-source "\n")))
  
  (fn completer [env scope text]
    (let [matches []
          input-fragment (text:gsub ".*[%s)(]+" "")]
      (fn add-partials [input tbl prefix] ; add partial key matches in tbl
        (each [k (internals.allpairs tbl)]
          (let [k (if (or (= tbl env) (= tbl env.___replLocals___))
                      (. scope.unmanglings k)
                      k)]
            (when (and (< (# matches) 2000) ; stop explosion on too many items
                       (= (type k) "string")
                       (= input (k:sub 0 (# input))))
              (table.insert matches (.. prefix k))))))
      (fn add-matches [input tbl prefix] ; add matches, descending into tbl fields
        (let [prefix (if prefix (.. prefix ".") "")]
          (if (not (input:find "%.")) ; no more dots, so add matches
              (add-partials input tbl prefix)
              (let [(head tail) (input:match "^([^.]+)%.(.*)")
                    raw-head (if (or (= tbl env) (= tbl env.___replLocals___))
                                 (. scope.manglings head)
                                 head)]
                (when (= (type (. tbl raw-head)) "table")
                  (add-matches tail (. tbl raw-head) (.. prefix head)))))))
  
      (add-matches input-fragment (or scope.specials []))
      (add-matches input-fragment (or scope.macros []))
      (add-matches input-fragment (or env.___replLocals___ []))
      (add-matches input-fragment env)
      (add-matches input-fragment (or env._ENV env._G []))
      matches))
  
  (fn repl [options]
    (let [old-root-options internals.rootOptions
          env (if options.env
                  (internals.wrapEnv options.env)
                  (setmetatable {} {:__index (or _G._ENV _G)}))
          save-locals? (and (not= options.saveLocals false)
                            env.debug env.debug.getlocal)
          opts {}
          _ (each [k v (pairs options)] (tset opts k v))
          read-chunk (or opts.readChunk default-read-chunk)
          on-values (or opts.onValues default-on-values)
          on-error (or opts.onError default-on-error)
          pp (or opts.pp tostring)
          ;; make parser
          (byte-stream clear-stream) (fennel.granulate read-chunk)
          chars []
          (read reset) (fennel.parser (fn [parser-state]
                                        (let [c (byte-stream parser-state)]
                                          (tset chars (+ (# chars) 1) c)
                                          c)))
          scope (fennel.scope)]
  
      ;; use metadata unless we've specifically disabled it
      (set opts.useMetadata (not= options.useMetadata false))
      (when (= opts.allowedGlobals nil)
        (set opts.allowedGlobals (internals.currentGlobalNames opts.env)))
  
      (when opts.registerCompleter
        (opts.registerCompleter (partial completer env scope)))
  
      (fn loop []
        (each [k (pairs chars)] (tset chars k nil))
        (let [(ok parse-ok? x) (pcall read)
              src-string (string.char ((or _G.unpack table.unpack) chars))]
          (internals.setRootOptions opts)
          (if (not ok)
              (do (on-error "Parse" parse-ok?)
                  (clear-stream)
                  (reset)
                  (loop))
              (when parse-ok? ; if this is false, we got eof
                (match (pcall fennel.compile x {:correlate opts.correlate
                                                :source src-string
                                                :scope scope
                                                :useMetadata opts.useMetadata
                                                :moduleName opts.moduleName
                                                :assert-compile opts.assert-compile
                                                :parse-error opts.parse-error})
                  (false msg) (do (clear-stream)
                                  (on-error "Compile" msg))
                  (true source) (let [source (if save-locals?
                                                 (splice-save-locals env source)
                                                 source)
                                      (lua-ok? loader) (pcall fennel.loadCode
                                                              source env)]
                                  (if (not lua-ok?)
                                      (do (clear-stream)
                                          (on-error "Lua Compile" loader source))
                                      (match (xpcall #[(loader)]
                                                     (partial on-error "Runtime"))
                                        (true ret)
                                        (do (set env._ (. ret 1))
                                            (set env.__ ret)
                                            (on-values (internals.map ret pp)))))))
                (internals.setRootOptions old-root-options)
                (loop)))))
      (loop)))]===]
  
  module.repl = function(options)
      -- functionality the repl needs that isn't part of the public API yet
      local internals = { rootOptions = utils.root.options,
                          setRootOptions = function(r) utils.root.options = r end,
                          currentGlobalNames = specials.currentGlobalNames,
                          wrapEnv = specials.wrapEnv,
                          allpairs = utils.allpairs,
                          map = utils.map }
      return eval(replsource, { correlate = true }, module, internals)(options)
  end
  
  module.searchModule = specials.searchModule
  
  module.makeSearcher = function(options)
      return function(modulename)
        -- this will propagate options from the repl but not from eval, because
        -- eval unsets utils.root.options after compiling but before running the actual
        -- calls to require.
        local opts = utils.copy(utils.root.options)
        for k,v in pairs(options or {}) do opts[k] = v end
        local filename = specials.searchModule(modulename)
        if filename then
           return function(modname)
              return compiler.dofileFennel(filename, opts, modname)
           end
        end
     end
  end
  
  -- This will allow regular `require` to work with Fennel:
  -- table.insert(package.loaders, fennel.searcher)
  module.searcher = module.makeSearcher()
  module.make_searcher = module.makeSearcher -- oops backwards compatibility
  
  -- Load standard macros
  local stdmacros = [===[
  {"->" (fn [val ...]
          "Thread-first macro.
  Take the first value and splice it into the second form as its first argument.
  The value of the second form is spliced into the first arg of the third, etc."
          (var x val)
          (each [_ e (ipairs [...])]
            (let [elt (if (list? e) e (list e))]
              (table.insert elt 2 x)
              (set x elt)))
          x)
   "->>" (fn [val ...]
           "Thread-last macro.
  Same as ->, except splices the value into the last position of each form
  rather than the first."
           (var x val)
           (each [_ e (pairs [...])]
             (let [elt (if (list? e) e (list e))]
               (table.insert elt x)
               (set x elt)))
           x)
   "-?>" (fn [val ...]
           "Nil-safe thread-first macro.
  Same as -> except will short-circuit with nil when it encounters a nil value."
           (if (= 0 (select "#" ...))
               val
               (let [els [...]
                     e (table.remove els 1)
                     el (if (list? e) e (list e))
                     tmp (gensym)]
                 (table.insert el 2 tmp)
                 `(let [,tmp ,val]
                    (if ,tmp
                        (-?> ,el ,(unpack els))
                        ,tmp)))))
   "-?>>" (fn [val ...]
           "Nil-safe thread-last macro.
  Same as ->> except will short-circuit with nil when it encounters a nil value."
            (if (= 0 (select "#" ...))
                val
                (let [els [...]
                      e (table.remove els 1)
                      el (if (list? e) e (list e))
                      tmp (gensym)]
                  (table.insert el tmp)
                  `(let [,tmp ,val]
                     (if ,tmp
                         (-?>> ,el ,(unpack els))
                         ,tmp)))))
   :doto (fn [val ...]
           "Evaluates val and splices it into the first argument of subsequent forms."
           (let [name (gensym)
                 form `(let [,name ,val])]
             (each [_ elt (pairs [...])]
               (table.insert elt 2 name)
               (table.insert form elt))
             (table.insert form name)
             form))
   :when (fn [condition body1 ...]
           "Evaluate body for side-effects only when condition is truthy."
           (assert body1 "expected body")
           `(if ,condition
                (do ,body1 ,...)))
   :with-open (fn [closable-bindings ...]
                "Like `let`, but invokes (v:close) on every binding after evaluating the body.
  The body is evaluated inside `xpcall` so that bound values will be closed upon
  encountering an error before propagating it."
                (let [bodyfn    `(fn [] ,...)
                      closer    `(fn close-handlers# [ok# ...] (if ok# ... (error ... 0)))
                      traceback `(. (or package.loaded.fennel debug) :traceback)]
                  (for [i 1 (# closable-bindings) 2]
                    (assert (sym? (. closable-bindings i))
                      "with-open only allows symbols in bindings")
                    (table.insert closer 4 `(: ,(. closable-bindings i) :close)))
                  `(let ,closable-bindings ,closer
                     (close-handlers# (xpcall ,bodyfn ,traceback)))))
   :partial (fn [f ...]
              "Returns a function with all arguments partially applied to f."
              (let [body (list f ...)]
                (table.insert body _VARARG)
                `(fn [,_VARARG] ,body)))
   :pick-args (fn [n f]
                 "Creates a function of arity n that applies its arguments to f.
  For example,\n\t(pick-args 2 func)
  expands to\n\t(fn [_0_ _1_] (func _0_ _1_))"
                 (assert (and (= (type n) :number) (= n (math.floor n)) (>= n 0))
                   "Expected n to be an integer literal >= 0.")
                 (let [bindings []]
                   (for [i 1 n] (tset bindings i (gensym)))
                   `(fn ,bindings (,f ,(unpack bindings)))))
   :pick-values (fn [n ...]
                   "Like the `values` special, but emits exactly n values.\nFor example,
  \t(pick-values 2 ...)\nexpands to\n\t(let [(_0_ _1_) ...] (values _0_ _1_))"
                   (assert (and (= :number (type n)) (>= n 0) (= n (math.floor n)))
                           "Expected n to be an integer >= 0")
                   (let [let-syms   (list)
                         let-values (if (= 1 (select :# ...)) ... `(values ,...))]
                     (for [i 1 n] (table.insert let-syms (gensym)))
                     (if (= n 0) `(values)
                         `(let [,let-syms ,let-values] (values ,(unpack let-syms))))))
   :lambda (fn [...]
             "Function literal with arity checking.
  Will throw an exception if a declared argument is passed in as nil, unless
  that argument name begins with ?."
             (let [args [...]
                   has-internal-name? (sym? (. args 1))
                   arglist (if has-internal-name? (. args 2) (. args 1))
                   docstring-position (if has-internal-name? 3 2)
                   has-docstring? (and (> (# args) docstring-position)
                                       (= :string (type (. args docstring-position))))
                   arity-check-position (- 4 (if has-internal-name? 0 1) (if has-docstring? 0 1))]
               (fn check! [a]
                 (if (table? a)
                     (each [_ a (pairs a)]
                       (check! a))
                     (and (not (: (tostring a) :match "^?"))
                          (not= (tostring a) "&")
                          (not= (tostring a) "..."))
                     (table.insert args arity-check-position
                                   `(assert (not= nil ,a)
                                            (: "Missing argument %s on %s:%s"
                                               :format ,(tostring a)
                                               ,(or a.filename "unknown")
                                               ,(or a.line "?"))))))
               (assert (> (length args) 1) "expected body expression")
               (each [_ a (ipairs arglist)]
                 (check! a))
               `(fn ,(unpack args))))
   :macro (fn macro [name ...]
            "Define a single macro."
            (assert (sym? name) "expected symbol for macro name")
            (local args [...])
            `(macros { ,(tostring name) (fn ,name ,(unpack args))}))
   :macrodebug (fn macrodebug [form return?]
                "Print the resulting form after performing macroexpansion.
  With a second argument, returns expanded form as a string instead of printing."
                (let [(ok view) (pcall require :fennelview)
                      handle (if return? `do `print)]
                  `(,handle ,((if ok view tostring) (macroexpand form _SCOPE)))))
   :import-macros (fn import-macros [binding1 module-name1 ...]
                    "Binds a table of macros from each macro module according to its binding form.
  Each binding form can be either a symbol or a k/v destructuring table.
  Example:\n  (import-macros mymacros                 :my-macros    ; bind to symbol
                   {:macro1 alias : macro2} :proj.macros) ; import by name"
                    (assert (and binding1 module-name1 (= 0 (% (select :# ...) 2)))
                            "expected even number of binding/modulename pairs")
                    (for [i 1 (select :# binding1 module-name1 ...) 2]
                      (local (binding modname) (select i binding1 module-name1 ...))
                      ;; generate a subscope of current scope, use require-macros to bring in macro
                      ;; module. after that, we just copy the macros from subscope to scope.
                      (local scope (get-scope))
                      (local subscope (fennel.scope scope))
                      (fennel.compileString (string.format "(require-macros %q)" modname)
                                            {:scope subscope})
                      (if (sym? binding)
                        ;; bind whole table of macros to table bound to symbol
                        (do (tset scope.macros (. binding 1) {})
                            (each [k v (pairs subscope.macros)]
                              (tset (. scope.macros (. binding 1)) k v)))
  
                        ;; 1-level table destructuring for importing individual macros
                        (table? binding)
                        (each [macro-name [import-key] (pairs binding)]
                          (assert (= :function (type (. subscope.macros macro-name)))
                                  (.. "macro " macro-name " not found in module " modname))
                          (tset scope.macros import-key (. subscope.macros macro-name)))))
                    ;; TODO: replace with `nil` once we fix macros being able to return nil
                    `(do nil))
   :match
  (fn match [val ...]
    "Perform pattern matching on val. See reference for details."
    ;; this function takes the AST of values and a single pattern and returns a
    ;; condition to determine if it matches as well as a list of bindings to
    ;; introduce for the duration of the body if it does match.
    (fn match-pattern [vals pattern unifications]
      ;; we have to assume we're matching against multiple values here until we
      ;; know we're either in a multi-valued clause (in which case we know the #
      ;; of vals) or we're not, in which case we only care about the first one.
      (let [[val] vals]
        (if (or (and (sym? pattern) ; unification with outer locals (or nil)
                     (not= :_ (tostring pattern)) ; never unify _
                     (or (in-scope? pattern)
                         (= :nil (tostring pattern))))
                (and (multi-sym? pattern)
                     (in-scope? (. (multi-sym? pattern) 1))))
            (values `(= ,val ,pattern) [])
            ;; unify a local we've seen already
            (and (sym? pattern)
                 (. unifications (tostring pattern)))
            (values `(= ,(. unifications (tostring pattern)) ,val) [])
            ;; bind a fresh local
            (sym? pattern)
            (let [wildcard? (= (tostring pattern) "_")]
              (if (not wildcard?) (tset unifications (tostring pattern) val))
              (values (if (or wildcard? (: (tostring pattern) :find "^?"))
                          true `(not= ,(sym :nil) ,val))
                      [pattern val]))
            ;; guard clause
            (and (list? pattern) (sym? (. pattern 2)) (= :? (tostring (. pattern 2))))
            (let [(pcondition bindings) (match-pattern vals (. pattern 1)
                                                       unifications)
                  condition `(and ,pcondition)]
              (for [i 3 (# pattern)] ; splice in guard clauses
                (table.insert condition (. pattern i)))
              (values `(let ,bindings ,condition) bindings))
  
            ;; multi-valued patterns (represented as lists)
            (list? pattern)
            (let [condition `(and)
                  bindings []]
              (each [i pat (ipairs pattern)]
                (let [(subcondition subbindings) (match-pattern [(. vals i)] pat
                                                                unifications)]
                  (table.insert condition subcondition)
                  (each [_ b (ipairs subbindings)]
                    (table.insert bindings b))))
              (values condition bindings))
            ;; table patterns)
            (= (type pattern) :table)
            (let [condition `(and (= (type ,val) :table))
                  bindings []]
              (each [k pat (pairs pattern)]
                (if (and (sym? pat) (= "&" (tostring pat)))
                    (do (assert (not (. pattern (+ k 2)))
                                "expected rest argument before last parameter")
                        (table.insert bindings (. pattern (+ k 1)))
                        (table.insert bindings [`(select ,k ((or _G.unpack table.unpack)
                                                             ,val))]))
                    (and (= :number (type k))
                         (= "&" (tostring (. pattern (- k 1)))))
                    nil ; don't process the pattern right after &; already got it
                    (let [subval `(. ,val ,k)
                          (subcondition subbindings) (match-pattern [subval] pat
                                                                    unifications)]
                      (table.insert condition subcondition)
                      (each [_ b (ipairs subbindings)]
                        (table.insert bindings b)))))
              (values condition bindings))
            ;; literal value
            (values `(= ,val ,pattern) []))))
    (fn match-condition [vals clauses]
      (let [out `(if)]
        (for [i 1 (length clauses) 2]
          (let [pattern (. clauses i)
                body (. clauses (+ i 1))
                (condition bindings) (match-pattern vals pattern {})]
            (table.insert out condition)
            (table.insert out `(let ,bindings ,body))))
        out))
    ;; how many multi-valued clauses are there? return a list of that many gensyms
    (fn val-syms [clauses]
      (let [syms (list (gensym))]
        (for [i 1 (length clauses) 2]
          (if (list? (. clauses i))
              (each [valnum (ipairs (. clauses i))]
                (if (not (. syms valnum))
                    (tset syms valnum (gensym))))))
        syms))
    ;; wrap it in a way that prevents double-evaluation of the matched value
    (let [clauses [...]
          vals (val-syms clauses)]
      (if (not= 0 (% (length clauses) 2)) ; treat odd final clause as default
          (table.insert clauses (length clauses) (sym :_)))
      ;; protect against multiple evaluation of the value, bind against as
      ;; many values as we ever match against in the clauses.
      (list (sym :let) [vals val]
            (match-condition vals clauses))))
   }
  ]===]
  do
      -- docstrings rely on having a place to "put" metadata; we use the module
      -- system for that. but if you try to require the module while it's being
      -- loaded, you get a stack overflow. so we fake out the module for the
      -- purposes of boostrapping the built-in macros here.
      local moduleName = "__fennel-bootstrap__"
      package.preload[moduleName] = function() return module end
      local env = specials.makeCompilerEnv(nil, compiler.scopes.compiler, {})
      local macros = eval(stdmacros, {
                              env = env,
                              scope = compiler.makeScope(compiler.scopes.compiler),
                              -- assume the code to load globals doesn't have any
                              -- mistaken globals, otherwise this can be
                              -- problematic when loading fennel in contexts
                              -- where _G is an empty table with an __index
                              -- metamethod. (openresty)
                              allowedGlobals = false,
                              useMetadata = true,
                              filename = "built-ins",
                              moduleName = moduleName })
      for k,v in pairs(macros) do compiler.scopes.global.macros[k] = v end
      package.preload[moduleName] = nil
  end
  compiler.scopes.global.macros['λ'] = compiler.scopes.global.macros['lambda']
  
  return module
end
fennel = require("fennel")
view = require("fennelview")
local _0_ = require("fnlfmt")
local fnlfmt = _0_["fnlfmt"]
local function format(filename)
  local f = nil
  do
    local _1_0 = filename
    if (_1_0 == "-") then
      f = io.stdin
    else
      local _ = _1_0
      f = assert(io.open(filename, "r"), "File not found.")
    end
  end
  local parser = fennel.parser(fennel.stringStream(f:read("*all")))
  local out = {}
  f:close()
  for ok_3f, value in parser do
    table.insert(out, fnlfmt(value))
  end
  return table.concat(out, "\n")
end
local function help()
  print("Usage: fnlfmt [--fix] FILENAME")
  print("With the --fix argument, updates the file in-place; otherwise")
  return print("prints the formatted file to stdout.")
end
local _1_0 = arg
if ((type(_1_0) == "table") and (_1_0[1] == "--fix") and (nil ~= _1_0[2])) then
  local filename = _1_0[2]
  local new = format(filename)
  local f = assert(io.open(filename, "w"))
  f:write(new)
  return f:close()
elseif ((type(_1_0) == "table") and (nil ~= _1_0[1])) then
  local filename = _1_0[1]
  return print(format(filename))
else
  local _ = _1_0
  return help()
end