mirror of
https://github.com/leanprover/lean4.git
synced 2026-03-31 01:04:07 +00:00
Compare commits
727 Commits
issue2327
...
withtrace-
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
f1f693fcd5 | ||
|
|
a75fc1d756 | ||
|
|
b4f08799fb | ||
|
|
53477089fe | ||
|
|
132f655736 | ||
|
|
978a5b2528 | ||
|
|
96c59ccced | ||
|
|
073c8fed86 | ||
|
|
808bb9b579 | ||
|
|
3b6bc4a87d | ||
|
|
dd313c6894 | ||
|
|
7809d49a62 | ||
|
|
544b704a25 | ||
|
|
d991f5efe0 | ||
|
|
e2fbfb5731 | ||
|
|
8999ef067b | ||
|
|
6407197e54 | ||
|
|
367b38701f | ||
|
|
e1b3f10250 | ||
|
|
d10e3da673 | ||
|
|
d62fca4e9c | ||
|
|
634193328b | ||
|
|
daae36d44d | ||
|
|
c35e41ce15 | ||
|
|
90aab46071 | ||
|
|
bf76eca0cd | ||
|
|
9a3657df3f | ||
|
|
f46c792206 | ||
|
|
538ed26ca4 | ||
|
|
331c4c39b8 | ||
|
|
68800cdcf8 | ||
|
|
a0626a9334 | ||
|
|
01b3e70a8d | ||
|
|
8f3468b82c | ||
|
|
5190c7fcc3 | ||
|
|
337891c9eb | ||
|
|
3f9a867469 | ||
|
|
abdbc39403 | ||
|
|
1292819f64 | ||
|
|
3fb146fad2 | ||
|
|
462d306184 | ||
|
|
13d5e6f542 | ||
|
|
cf216ecd16 | ||
|
|
c0edda1373 | ||
|
|
3f49861ee1 | ||
|
|
b74d9c09d5 | ||
|
|
a32c3e0140 | ||
|
|
72487e5650 | ||
|
|
eb157000a4 | ||
|
|
0656482b91 | ||
|
|
312960820c | ||
|
|
98a55105ff | ||
|
|
a1a30aac1c | ||
|
|
c49a7d84e9 | ||
|
|
346da2c29c | ||
|
|
227a350747 | ||
|
|
caa4494cb7 | ||
|
|
a45f808da4 | ||
|
|
7648ec57b5 | ||
|
|
620587fc42 | ||
|
|
57fea2d8e3 | ||
|
|
276bf837e2 | ||
|
|
421e73f6c5 | ||
|
|
83dffbc2f8 | ||
|
|
16af1dddf4 | ||
|
|
5080b08922 | ||
|
|
05c2ac5f3c | ||
|
|
7055f953f1 | ||
|
|
e1887fa510 | ||
|
|
55fa486ce6 | ||
|
|
15d656bd9a | ||
|
|
4f505cd056 | ||
|
|
8c793eaae5 | ||
|
|
cee959078d | ||
|
|
148b067724 | ||
|
|
479fe81894 | ||
|
|
47b4eae9a6 | ||
|
|
c60ccdc974 | ||
|
|
25ab266a2e | ||
|
|
b8c4ed5a83 | ||
|
|
93f1d05e2a | ||
|
|
b813197b36 | ||
|
|
b76bfcac91 | ||
|
|
7603e49169 | ||
|
|
8fbb866798 | ||
|
|
dc937cb1f9 | ||
|
|
733f015c65 | ||
|
|
42a8e0f190 | ||
|
|
1949285fdb | ||
|
|
2808cc2744 | ||
|
|
031d9712d5 | ||
|
|
716fe7abb8 | ||
|
|
c614ffa2f7 | ||
|
|
837eec5d9a | ||
|
|
8e6abd7c56 | ||
|
|
ddd7581ee4 | ||
|
|
855a655033 | ||
|
|
0bf59a5921 | ||
|
|
d3d526d43f | ||
|
|
0b1d2956a4 | ||
|
|
9544a0572e | ||
|
|
f40dbbcf02 | ||
|
|
fc65f6e73e | ||
|
|
17a4bcb3e1 | ||
|
|
56d0fbd537 | ||
|
|
783a61ab76 | ||
|
|
3ad183e502 | ||
|
|
25fe4a6f4d | ||
|
|
39feeaab74 | ||
|
|
96acc7269d | ||
|
|
7da0dd2fcf | ||
|
|
1742c79afe | ||
|
|
37811b2104 | ||
|
|
4811ba7850 | ||
|
|
ebdbc77631 | ||
|
|
3c6c1c25e4 | ||
|
|
48688da4b1 | ||
|
|
e55589cc7f | ||
|
|
032dc4bc8f | ||
|
|
024a298eb7 | ||
|
|
21262e5dca | ||
|
|
f4bae4cd2a | ||
|
|
f0c79f0954 | ||
|
|
1c5ec65260 | ||
|
|
a7e0e5b50a | ||
|
|
70172158a4 | ||
|
|
5ae0b979e8 | ||
|
|
4fba6ae385 | ||
|
|
c6327e66ca | ||
|
|
ecadca6902 | ||
|
|
db39141034 | ||
|
|
a889a7387c | ||
|
|
350e1b810a | ||
|
|
f0ae7bff1e | ||
|
|
9121c4dfa8 | ||
|
|
5558ad89a1 | ||
|
|
f2bcba7c73 | ||
|
|
b8ed74e89f | ||
|
|
19afb95dd7 | ||
|
|
5b81042614 | ||
|
|
56cec0b41c | ||
|
|
99a0a1ee1f | ||
|
|
93c0b44623 | ||
|
|
65825e4210 | ||
|
|
b022a99027 | ||
|
|
59585d2374 | ||
|
|
d5b6a49054 | ||
|
|
f4734e35ff | ||
|
|
c0a04de055 | ||
|
|
aed23307b0 | ||
|
|
3cfc0d9f68 | ||
|
|
a0400cbe97 | ||
|
|
2d2bed90aa | ||
|
|
6bb5101256 | ||
|
|
bc8c809d66 | ||
|
|
dd30925ba6 | ||
|
|
1c916b755a | ||
|
|
226def8b82 | ||
|
|
6709a795df | ||
|
|
8b402c4ee0 | ||
|
|
5e3282347e | ||
|
|
33e05e16be | ||
|
|
a05e35c783 | ||
|
|
97100dcd02 | ||
|
|
f843d29f72 | ||
|
|
1d2ca29f2a | ||
|
|
90ba1a6556 | ||
|
|
afe18ac02e | ||
|
|
48b1ed711a | ||
|
|
b784f8c3af | ||
|
|
dc8097dae6 | ||
|
|
10940bf07b | ||
|
|
ff23465a04 | ||
|
|
09e05cc1a9 | ||
|
|
ac5d83ca15 | ||
|
|
67775edd18 | ||
|
|
abe8e8b1f8 | ||
|
|
d68029092a | ||
|
|
1256453ad5 | ||
|
|
fc34cd2b8e | ||
|
|
6caea9306c | ||
|
|
a6cc5f3a9d | ||
|
|
aaf3c1e959 | ||
|
|
695b8f9b5d | ||
|
|
ab528009ee | ||
|
|
5f9166c621 | ||
|
|
f93a47de69 | ||
|
|
23a578c37c | ||
|
|
32f870a994 | ||
|
|
f76b488fd5 | ||
|
|
5cd2d85515 | ||
|
|
e498ff1aa8 | ||
|
|
68b81ca065 | ||
|
|
2e38df619c | ||
|
|
fe5d95e7e3 | ||
|
|
62bdde1548 | ||
|
|
03da79a603 | ||
|
|
1ea2a52448 | ||
|
|
b33aa09384 | ||
|
|
25d3860823 | ||
|
|
b57ca74794 | ||
|
|
49a025889a | ||
|
|
a45d86cb96 | ||
|
|
958e3fc4da | ||
|
|
ca04bf9b43 | ||
|
|
0fbd7a866a | ||
|
|
185e10f6f3 | ||
|
|
c45088b2ea | ||
|
|
ee59d66268 | ||
|
|
adc6317e7b | ||
|
|
958f38b31e | ||
|
|
0a53ecb768 | ||
|
|
44f8e27a29 | ||
|
|
3229d5084c | ||
|
|
df8085b7c2 | ||
|
|
9e87958312 | ||
|
|
b6dc189f0a | ||
|
|
0875473b13 | ||
|
|
7049a8da5f | ||
|
|
66e807146b | ||
|
|
bee7e5d323 | ||
|
|
a6d6ae01a0 | ||
|
|
4f8c51f102 | ||
|
|
83b9404d02 | ||
|
|
5eb591092d | ||
|
|
c7075f3f99 | ||
|
|
2355ce06e7 | ||
|
|
f0c9b74540 | ||
|
|
906bc3c9c2 | ||
|
|
8c46d7439a | ||
|
|
b9beeff3ad | ||
|
|
a81994871a | ||
|
|
2e43c1b6cf | ||
|
|
2f9eefd35a | ||
|
|
989b5666c9 | ||
|
|
72f555dd5b | ||
|
|
48d595b722 | ||
|
|
2ccd41ac82 | ||
|
|
24fd2e37e1 | ||
|
|
74f3e963ff | ||
|
|
6035ed56ea | ||
|
|
5dd9042a2c | ||
|
|
e33b5a2095 | ||
|
|
7955d0f73c | ||
|
|
c6f7a0d654 | ||
|
|
49384a69bf | ||
|
|
17a36f89aa | ||
|
|
7ea0ea3393 | ||
|
|
f62b017654 | ||
|
|
85f6d1a402 | ||
|
|
4d118062b8 | ||
|
|
a2e39659f9 | ||
|
|
5f1eca5954 | ||
|
|
a4174a560b | ||
|
|
0e99494611 | ||
|
|
62815168c6 | ||
|
|
c0bc0344b0 | ||
|
|
a8d1ff5fdc | ||
|
|
6812bae11a | ||
|
|
c4580839b5 | ||
|
|
3200b43371 | ||
|
|
45ff2dbc9d | ||
|
|
961a328bfd | ||
|
|
4f739572c9 | ||
|
|
241665dc27 | ||
|
|
0655233dd2 | ||
|
|
36fe59f687 | ||
|
|
d842158172 | ||
|
|
d3c373478e | ||
|
|
f7451e025c | ||
|
|
aa4b82c53f | ||
|
|
dad47195da | ||
|
|
7447cb444c | ||
|
|
f5126bc82a | ||
|
|
4ffe900d93 | ||
|
|
8d854900fd | ||
|
|
4b7188e0ce | ||
|
|
61926bbb32 | ||
|
|
eb7979b332 | ||
|
|
02ee011a0e | ||
|
|
8dc3133244 | ||
|
|
38fc7192ed | ||
|
|
8faafb7ef6 | ||
|
|
4ff44fb050 | ||
|
|
854b154a5f | ||
|
|
1996d6710b | ||
|
|
7bbe6cfce8 | ||
|
|
7cd0107ae1 | ||
|
|
8646aa142d | ||
|
|
22ecda20c7 | ||
|
|
2f7825e06b | ||
|
|
bf5c89352d | ||
|
|
7ea84c5961 | ||
|
|
05b4a8fc76 | ||
|
|
e6e2c2ab72 | ||
|
|
144fbaf642 | ||
|
|
c77d6680a7 | ||
|
|
1523e2d729 | ||
|
|
66797c4232 | ||
|
|
e5782adeff | ||
|
|
8428ef7cd7 | ||
|
|
6f38ebebe9 | ||
|
|
1f017deaa0 | ||
|
|
049259b47f | ||
|
|
5fdf97db20 | ||
|
|
964eb5ef10 | ||
|
|
108d9852ca | ||
|
|
d28cb121b5 | ||
|
|
9dadf7e0b1 | ||
|
|
cb6db07bb9 | ||
|
|
1be19f0ebd | ||
|
|
318b12c710 | ||
|
|
5ea07ae20e | ||
|
|
427ad67d79 | ||
|
|
9c20cad9d8 | ||
|
|
76383dfccc | ||
|
|
18b6bf3cf8 | ||
|
|
18eef56322 | ||
|
|
b6bce412a9 | ||
|
|
431cdbb6b7 | ||
|
|
4bb5b407be | ||
|
|
a815d29630 | ||
|
|
1c512bdf20 | ||
|
|
cf5fe7e478 | ||
|
|
81ea5049af | ||
|
|
c19417b86a | ||
|
|
94c48d2d29 | ||
|
|
b50f80c393 | ||
|
|
55a2395db5 | ||
|
|
85e3385aaa | ||
|
|
c1b4074d54 | ||
|
|
e8d59a7a6e | ||
|
|
10c444e5ef | ||
|
|
e24d6f1181 | ||
|
|
9f333147f5 | ||
|
|
7a499ee09b | ||
|
|
c03b388d6f | ||
|
|
a28c1da704 | ||
|
|
be570305fc | ||
|
|
712b22b46f | ||
|
|
0fe9930d67 | ||
|
|
2a4684a9ae | ||
|
|
bdd5185a7f | ||
|
|
65d00098c7 | ||
|
|
926a253680 | ||
|
|
8c40a31573 | ||
|
|
0869780376 | ||
|
|
17ac0d7f94 | ||
|
|
a9793b0a50 | ||
|
|
1c4b5ff3ac | ||
|
|
985bdcb4d0 | ||
|
|
30e3f10c6c | ||
|
|
e6894c058b | ||
|
|
bffcfde602 | ||
|
|
705962847d | ||
|
|
df1c1cde12 | ||
|
|
6d7fc7216c | ||
|
|
2be2466f78 | ||
|
|
4ac34f4cd5 | ||
|
|
f3d8fcc85d | ||
|
|
e880dd52a4 | ||
|
|
752bc24f78 | ||
|
|
2680e1c66f | ||
|
|
5029f30b27 | ||
|
|
5102d21cc5 | ||
|
|
2b0989ea28 | ||
|
|
c9128d1ce6 | ||
|
|
d4e7e33652 | ||
|
|
1b96c466ca | ||
|
|
9ac989f0c9 | ||
|
|
adcf2df9b5 | ||
|
|
8fb9dd8478 | ||
|
|
34bf090300 | ||
|
|
d781c3411a | ||
|
|
f9e789af45 | ||
|
|
a23c5feec4 | ||
|
|
e37cde0def | ||
|
|
7199eea687 | ||
|
|
50a84fcd55 | ||
|
|
ac47b4fb01 | ||
|
|
8f4b203b2f | ||
|
|
e054596cfa | ||
|
|
99bd215dcb | ||
|
|
56bae17924 | ||
|
|
8b66dbf285 | ||
|
|
197b8e5c1d | ||
|
|
f0ad325e09 | ||
|
|
bec311bf48 | ||
|
|
0555e29808 | ||
|
|
1210589771 | ||
|
|
5edbd6cf59 | ||
|
|
50fa9a0b53 | ||
|
|
8e728b1159 | ||
|
|
052d6623f0 | ||
|
|
b996117482 | ||
|
|
fcc3e3d93e | ||
|
|
a7a980c12d | ||
|
|
1284616296 | ||
|
|
a1368df5c9 | ||
|
|
4b062543ec | ||
|
|
c830953ded | ||
|
|
aa524e977c | ||
|
|
a727a3de5c | ||
|
|
91620481a5 | ||
|
|
ca6c5b8c5c | ||
|
|
2092850b02 | ||
|
|
63bd325b3b | ||
|
|
ec8b351445 | ||
|
|
bb2c720411 | ||
|
|
8a1e413d5a | ||
|
|
0422c0d019 | ||
|
|
2be3a23b46 | ||
|
|
40b6ca82b3 | ||
|
|
36b0d7b60c | ||
|
|
8d96c2cbe8 | ||
|
|
94d899ad95 | ||
|
|
4c9c0cae30 | ||
|
|
445f0db973 | ||
|
|
331bf0f7f2 | ||
|
|
ce7779890b | ||
|
|
7bc00f9b29 | ||
|
|
f48d9fccd9 | ||
|
|
8dfd7fccfc | ||
|
|
eb73594ec0 | ||
|
|
8babf3fc70 | ||
|
|
57c7e42752 | ||
|
|
ffcf715f30 | ||
|
|
50dd829d90 | ||
|
|
0b0afef09a | ||
|
|
763ac9a2e8 | ||
|
|
182409e0f4 | ||
|
|
8a20cafebf | ||
|
|
ae43e5b2fb | ||
|
|
d518e3df5b | ||
|
|
781672e935 | ||
|
|
b0991cf96b | ||
|
|
29f6c0fb5a | ||
|
|
333a86ef5f | ||
|
|
e006f8534d | ||
|
|
168ec3d178 | ||
|
|
20788e8237 | ||
|
|
74276dd024 | ||
|
|
521311292d | ||
|
|
738425b0b1 | ||
|
|
29975edb0e | ||
|
|
7cbde2c852 | ||
|
|
c6f6eec4c5 | ||
|
|
aa3f453ebf | ||
|
|
ffd5bc0f69 | ||
|
|
bfedab0f9b | ||
|
|
4d66b6e4e2 | ||
|
|
44cc860c82 | ||
|
|
53ad51e984 | ||
|
|
e9443705d5 | ||
|
|
d9f53dfec9 | ||
|
|
b558536129 | ||
|
|
4eec17c876 | ||
|
|
1074aaa5fa | ||
|
|
b8b3f01c96 | ||
|
|
15a2981804 | ||
|
|
88af2ca4b7 | ||
|
|
d494626de6 | ||
|
|
ae01b5d586 | ||
|
|
8635ce279b | ||
|
|
b2822ffab1 | ||
|
|
427cb0fc7c | ||
|
|
85efdb159a | ||
|
|
8a06d4f529 | ||
|
|
7a3aadd005 | ||
|
|
b3b7aa02d1 | ||
|
|
2e5c7c02f1 | ||
|
|
1d20cbd3d6 | ||
|
|
9700208501 | ||
|
|
6cfbd90426 | ||
|
|
e171925991 | ||
|
|
0e7a2bae8e | ||
|
|
429386c4c0 | ||
|
|
0f2d6c7fdd | ||
|
|
c32cd22504 | ||
|
|
0196cbe6a3 | ||
|
|
93cc196b10 | ||
|
|
3bcd18a1c6 | ||
|
|
4c0734b5f1 | ||
|
|
ae144112be | ||
|
|
e906f39201 | ||
|
|
a9b87adbeb | ||
|
|
b2acab81d4 | ||
|
|
3ab3b69293 | ||
|
|
5b0e264f8c | ||
|
|
583b534e6c | ||
|
|
0ede8f2c4c | ||
|
|
8852c5e236 | ||
|
|
50f70712a8 | ||
|
|
3b28d24319 | ||
|
|
d533606a86 | ||
|
|
557adf9ffc | ||
|
|
0f5dd30880 | ||
|
|
7197f60d9c | ||
|
|
3d76e48181 | ||
|
|
cfc8a2538d | ||
|
|
83ccf8a15d | ||
|
|
f187761c2e | ||
|
|
a8d5348f4f | ||
|
|
fe87b064a2 | ||
|
|
a21274c302 | ||
|
|
526e6e223e | ||
|
|
8cd7efb2d8 | ||
|
|
cadc812608 | ||
|
|
2b8f0f768c | ||
|
|
628e5e2818 | ||
|
|
3abf53d196 | ||
|
|
3b78652547 | ||
|
|
032be7ee2e | ||
|
|
a093a38459 | ||
|
|
6a9997c7ad | ||
|
|
ff1e63c719 | ||
|
|
3f534e1155 | ||
|
|
2e5b4d2221 | ||
|
|
63ad2d7765 | ||
|
|
a9c0210ef3 | ||
|
|
efadebd5ef | ||
|
|
1d052a1b39 | ||
|
|
4af8135172 | ||
|
|
ba8067f3bd | ||
|
|
0f0ea57ef5 | ||
|
|
5b37f1c5c5 | ||
|
|
5007ceae69 | ||
|
|
6d4360a04d | ||
|
|
194247bb32 | ||
|
|
abd617b9a5 | ||
|
|
dfa959ba30 | ||
|
|
9b80f69e54 | ||
|
|
b4150f61c7 | ||
|
|
1432bd91bb | ||
|
|
9bdd0202b7 | ||
|
|
1c0c5a84a4 | ||
|
|
06a6b9a88c | ||
|
|
9f90c9bb66 | ||
|
|
fdb9915bcc | ||
|
|
4b7a98bc38 | ||
|
|
b158f1fd8b | ||
|
|
50a23a3aa5 | ||
|
|
6a3d299378 | ||
|
|
8b83d80956 | ||
|
|
bf4db86bdd | ||
|
|
b4dcad59fa | ||
|
|
3c1185dc9c | ||
|
|
f39b1b8378 | ||
|
|
dd120dbc5a | ||
|
|
276163afd7 | ||
|
|
c97eac1e82 | ||
|
|
9285fb6f1d | ||
|
|
58eff66799 | ||
|
|
ce46960416 | ||
|
|
8e8ea4da33 | ||
|
|
eca73809e6 | ||
|
|
e3ec2b9e39 | ||
|
|
4e61320225 | ||
|
|
e441c40a3d | ||
|
|
60c749ab1d | ||
|
|
0188eb84df | ||
|
|
5caa12c0b0 | ||
|
|
69102b1812 | ||
|
|
8d3e72d742 | ||
|
|
f1865d4290 | ||
|
|
22ee974ac8 | ||
|
|
103e8ab61c | ||
|
|
f92afee9b4 | ||
|
|
d6d395619f | ||
|
|
09af870b71 | ||
|
|
8601c0fe78 | ||
|
|
6863bb8095 | ||
|
|
4b9a765cfb | ||
|
|
d4ba706198 | ||
|
|
92696d48f6 | ||
|
|
720ecbd568 | ||
|
|
7129433066 | ||
|
|
3e1cdda87e | ||
|
|
0a3457e973 | ||
|
|
dba37698c8 | ||
|
|
80416677d8 | ||
|
|
2d3bec2209 | ||
|
|
1825e095e1 | ||
|
|
332af4c262 | ||
|
|
4ce8716b99 | ||
|
|
ac1cc9e62c | ||
|
|
80a9685164 | ||
|
|
ce1ee3c36d | ||
|
|
43d1dfe72c | ||
|
|
c843f0b112 | ||
|
|
64634dbc32 | ||
|
|
d12c4241bf | ||
|
|
56a78f6eeb | ||
|
|
8f7e32d09a | ||
|
|
a371e181d5 | ||
|
|
8b74108f6e | ||
|
|
28320f80ee | ||
|
|
0bfebc1975 | ||
|
|
f9d6f57725 | ||
|
|
66a6246136 | ||
|
|
81a84d21de | ||
|
|
dd6634544d | ||
|
|
31abd420ad | ||
|
|
d49c64453d | ||
|
|
f977ee8b34 | ||
|
|
2757e844dd | ||
|
|
c8b558a2d1 | ||
|
|
ddf02cb339 | ||
|
|
23dd052dc9 | ||
|
|
c1f61d6716 | ||
|
|
4f75dd99d1 | ||
|
|
d0fbc93143 | ||
|
|
609ee22971 | ||
|
|
81d7511792 | ||
|
|
859b04bf7f | ||
|
|
aa1ca9c4b7 | ||
|
|
a541f2054e | ||
|
|
ba52b36ef8 | ||
|
|
3643b8e424 | ||
|
|
6a6afcd7c0 | ||
|
|
b8e85f40cd | ||
|
|
2d78f4db36 | ||
|
|
a52d95b575 | ||
|
|
1f51241a8e | ||
|
|
293c19d24f | ||
|
|
448cac6804 | ||
|
|
ce1f2f4964 | ||
|
|
d8ac18a807 | ||
|
|
cce0b3cce5 | ||
|
|
f06b1bbb5c | ||
|
|
38b260d60f | ||
|
|
1b5b4edec6 | ||
|
|
29e75cedc6 | ||
|
|
91d3df58cd | ||
|
|
bc8c39e802 | ||
|
|
4ae14ac849 | ||
|
|
1dabd00d4c | ||
|
|
bea059796f | ||
|
|
b730aacbc8 | ||
|
|
0dfd07ed9d | ||
|
|
54bdf64d25 | ||
|
|
0d288b9bd3 | ||
|
|
5770529e09 | ||
|
|
c3e602cedf | ||
|
|
67341f478d | ||
|
|
53b95fb455 | ||
|
|
81cb2f6ca8 | ||
|
|
e99d7aab95 | ||
|
|
9e5505b6ca | ||
|
|
93c9543976 | ||
|
|
b14eef6e06 | ||
|
|
3b2c91f396 | ||
|
|
f8a31011a6 | ||
|
|
31fa37dbfe | ||
|
|
e040804678 | ||
|
|
3ef381bb6c | ||
|
|
758021f03a | ||
|
|
115fdbea98 | ||
|
|
4844f8c459 | ||
|
|
511f34fd53 | ||
|
|
c08812e9e1 | ||
|
|
3b3beec0d4 | ||
|
|
d4e3a4f79e | ||
|
|
3ad82dcc42 | ||
|
|
b290c1ad28 | ||
|
|
70d258049e | ||
|
|
6161d7f2d9 | ||
|
|
9ce5fa6a6d | ||
|
|
1ccebe9b89 | ||
|
|
d1674a6ba0 | ||
|
|
9da32ce7eb | ||
|
|
042353d862 | ||
|
|
16534d3be6 | ||
|
|
ea4cbfae73 | ||
|
|
f97f69b749 | ||
|
|
a4622f61ca | ||
|
|
981db940e8 | ||
|
|
9034b6b79b | ||
|
|
22dc542445 | ||
|
|
9aa78a5361 | ||
|
|
f7a858c0de | ||
|
|
b7b0217241 | ||
|
|
2aa3c1e0cb | ||
|
|
4532901112 | ||
|
|
9138d37781 | ||
|
|
c0d9917f7c | ||
|
|
f512a9a934 | ||
|
|
ecfd65ffb7 | ||
|
|
93f5368162 | ||
|
|
9b1d958f9c | ||
|
|
68f0eb16bd | ||
|
|
6fad405294 | ||
|
|
7791b49be9 | ||
|
|
96870779a2 | ||
|
|
af7e167dea | ||
|
|
8c39a65609 | ||
|
|
c5c46798fb | ||
|
|
6fc398133d | ||
|
|
12537427c2 | ||
|
|
7770d4b421 | ||
|
|
76183aa6d1 | ||
|
|
0f6b07e434 | ||
|
|
2ba39f56f0 | ||
|
|
6317ab22e7 | ||
|
|
99d458c646 | ||
|
|
d066872549 | ||
|
|
8efd56d131 | ||
|
|
6b999dcb21 | ||
|
|
3cc0c3e370 | ||
|
|
07e804ad16 | ||
|
|
3ca6b0bf51 | ||
|
|
bf15f71568 | ||
|
|
158838bf63 | ||
|
|
9544f3dad8 | ||
|
|
f2041789b7 | ||
|
|
d5d8ff588a | ||
|
|
a462864d78 | ||
|
|
436d3213de | ||
|
|
543656c24b | ||
|
|
ef0135ac9e | ||
|
|
44b9ad2a30 | ||
|
|
ea9382643e | ||
|
|
82b368e838 | ||
|
|
84ae7466a4 | ||
|
|
93732bc7db | ||
|
|
404d32c730 | ||
|
|
a24d7d593a |
4
.gitmodules
vendored
4
.gitmodules
vendored
@@ -1,4 +0,0 @@
|
||||
[submodule "lake"]
|
||||
path = src/lake
|
||||
url = https://github.com/leanprover/lake.git
|
||||
ignore = untracked
|
||||
@@ -1,5 +1,5 @@
|
||||
{ src, debug ? false, stage0debug ? false, extraCMakeFlags ? [],
|
||||
stdenv, lib, cmake, gmp, gnumake, bash, buildLeanPackage, writeShellScriptBin, runCommand, symlinkJoin, lndir, perl, gnused, darwin, llvmPackages, linkFarmFromDrvs,
|
||||
stdenv, lib, cmake, gmp, git, gnumake, bash, buildLeanPackage, writeShellScriptBin, runCommand, symlinkJoin, lndir, perl, gnused, darwin, llvmPackages, linkFarmFromDrvs,
|
||||
... } @ args:
|
||||
with builtins;
|
||||
rec {
|
||||
@@ -88,7 +88,7 @@ rec {
|
||||
src = src + "/src";
|
||||
roots = [ { mod = args.name; glob = "andSubmodules"; } ];
|
||||
fullSrc = src;
|
||||
srcPrefix = "src";
|
||||
srcPath = "$PWD/src:$PWD/src/lake";
|
||||
inherit debug;
|
||||
} // args);
|
||||
Init' = build { name = "Init"; deps = []; };
|
||||
@@ -101,13 +101,25 @@ rec {
|
||||
inherit (Lean) emacs-dev emacs-package vscode-dev vscode-package;
|
||||
Init = attachSharedLib leanshared Init';
|
||||
Lean = attachSharedLib leanshared Lean' // { allExternalDeps = [ Init ]; };
|
||||
stdlib = [ Init Lean ];
|
||||
Lake = build {
|
||||
name = "Lake";
|
||||
src = src + "/src/lake";
|
||||
deps = [ Init Lean ];
|
||||
};
|
||||
Lake-Main = build {
|
||||
name = "Lake.Main";
|
||||
roots = [ "Lake.Main" ];
|
||||
executableName = "lake";
|
||||
deps = [ Lake ];
|
||||
linkFlags = lib.optional stdenv.isLinux "-rdynamic";
|
||||
src = src + "/src/lake";
|
||||
};
|
||||
stdlib = [ Init Lean Lake ];
|
||||
modDepsFiles = symlinkJoin { name = "modDepsFiles"; paths = map (l: l.modDepsFile) (stdlib ++ [ Leanc ]); };
|
||||
depRoots = symlinkJoin { name = "depRoots"; paths = map (l: l.depRoots) stdlib; };
|
||||
iTree = symlinkJoin { name = "ileans"; paths = map (l: l.iTree) stdlib; };
|
||||
extlib = stdlib; # TODO: add Lake
|
||||
Leanc = build { name = "Leanc"; src = lean-bin-tools-unwrapped.leanc_src; deps = stdlib; roots = [ "Leanc" ]; };
|
||||
stdlibLinkFlags = "-L${Init.staticLib} -L${Lean.staticLib} -L${leancpp}/lib/lean";
|
||||
stdlibLinkFlags = "-L${Init.staticLib} -L${Lean.staticLib} -L${Lake.staticLib} -L${leancpp}/lib/lean";
|
||||
leanshared = runCommand "leanshared" { buildInputs = [ stdenv.cc ]; libName = "libleanshared${stdenv.hostPlatform.extensions.sharedLibrary}"; } ''
|
||||
mkdir $out
|
||||
LEAN_CC=${stdenv.cc}/bin/cc ${lean-bin-tools-unwrapped}/bin/leanc -shared ${lib.optionalString stdenv.isLinux "-Wl,-Bsymbolic"} \
|
||||
@@ -116,7 +128,8 @@ rec {
|
||||
$(${llvmPackages.libllvm.dev}/bin/llvm-config --ldflags --libs) \
|
||||
-o $out/$libName
|
||||
'';
|
||||
mods = Init.mods // Lean.mods;
|
||||
mods = foldl' (mods: pkg: mods // pkg.mods) {} stdlib;
|
||||
print-paths = Lean.makePrintPathsFor [] mods;
|
||||
leanc = writeShellScriptBin "leanc" ''
|
||||
LEAN_CC=${stdenv.cc}/bin/cc ${Leanc.executable}/bin/leanc -I${lean-bin-tools-unwrapped}/include ${stdlibLinkFlags} -L${leanshared} "$@"
|
||||
'';
|
||||
@@ -129,9 +142,9 @@ rec {
|
||||
name = "lean-${desc}";
|
||||
buildCommand = ''
|
||||
mkdir -p $out/bin $out/lib/lean
|
||||
ln -sf ${leancpp}/lib/lean/* ${lib.concatMapStringsSep " " (l: "${l.modRoot}/* ${l.staticLib}/*") (lib.reverseList extlib)} ${leanshared}/* $out/lib/lean/
|
||||
ln -sf ${leancpp}/lib/lean/* ${lib.concatMapStringsSep " " (l: "${l.modRoot}/* ${l.staticLib}/*") (lib.reverseList stdlib)} ${leanshared}/* $out/lib/lean/
|
||||
# put everything in a single final derivation so `IO.appDir` references work
|
||||
cp ${lean}/bin/lean ${leanc}/bin/leanc $out/bin
|
||||
cp ${lean}/bin/lean ${leanc}/bin/leanc ${Lake-Main.executable}/bin/lake $out/bin
|
||||
# NOTE: `lndir` will not override existing `bin/leanc`
|
||||
${lndir}/bin/lndir -silent ${lean-bin-tools-unwrapped} $out
|
||||
'';
|
||||
@@ -140,30 +153,30 @@ rec {
|
||||
cacheRoots = linkFarmFromDrvs "cacheRoots" [
|
||||
stage0 lean leanc lean-all iTree modDepsFiles depRoots Leanc.src
|
||||
# .o files are not a runtime dependency on macOS because of lack of thin archives
|
||||
Lean.oTree
|
||||
Lean.oTree Lake.oTree
|
||||
];
|
||||
test = buildCMake {
|
||||
name = "lean-test-${desc}";
|
||||
realSrc = lib.sourceByRegex src [ "src.*" "tests.*" ];
|
||||
buildInputs = [ gmp perl ];
|
||||
buildInputs = [ gmp perl git ];
|
||||
preConfigure = ''
|
||||
cd src
|
||||
'';
|
||||
extraCMakeFlags = [ "-DLLVM=OFF" ];
|
||||
postConfigure = ''
|
||||
patchShebangs ../../tests
|
||||
patchShebangs ../../tests ../lake
|
||||
rm -r bin lib include share
|
||||
ln -sf ${lean-all}/* .
|
||||
'';
|
||||
buildPhase = ''
|
||||
ctest --output-on-failure -E 'leancomptest_(doc_example|foreign)|laketest|leanpkgtest' -j$NIX_BUILD_CORES
|
||||
ctest --output-on-failure -E 'leancomptest_(doc_example|foreign)' -j$NIX_BUILD_CORES
|
||||
'';
|
||||
installPhase = ''
|
||||
touch $out
|
||||
'';
|
||||
};
|
||||
update-stage0 =
|
||||
let cTree = symlinkJoin { name = "cs"; paths = map (l: l.cTree) stdlib; }; in
|
||||
let cTree = symlinkJoin { name = "cs"; paths = [ Init.cTree Lean.cTree ]; }; in
|
||||
writeShellScriptBin "update-stage0" ''
|
||||
CSRCS=${cTree} CP_C_PARAMS="--dereference --no-preserve=all" ${src + "/script/update-stage0"}
|
||||
'';
|
||||
|
||||
@@ -3,7 +3,7 @@
|
||||
runCommand, darwin, mkShell, ... }:
|
||||
let lean-final' = lean-final; in
|
||||
lib.makeOverridable (
|
||||
{ name, src, fullSrc ? src, srcPrefix ? "",
|
||||
{ name, src, fullSrc ? src, srcPrefix ? "", srcPath ? "$PWD/${srcPrefix}",
|
||||
# Lean dependencies. Each entry should be an output of buildLeanPackage.
|
||||
deps ? [ lean.Lean ],
|
||||
# Static library dependencies. Each derivation `static` should contain a static library in the directory `${static}`.
|
||||
@@ -210,7 +210,6 @@ with builtins; let
|
||||
loadDynlibPaths = map pathOfSharedLib (loadDynlibsOfDeps deps);
|
||||
}}'
|
||||
'';
|
||||
makePrintPathsFor = deps: mods: printPaths deps // mapAttrs (_: mod: makePrintPathsFor (deps ++ [mod]) mods) mods;
|
||||
expandGlob = g:
|
||||
if typeOf g == "string" then [g]
|
||||
else if g.glob == "one" then [g.mod]
|
||||
@@ -270,6 +269,7 @@ in rec {
|
||||
ln -sf ${iTree}/* $dest/build/lib
|
||||
'';
|
||||
|
||||
makePrintPathsFor = deps: mods: printPaths deps // mapAttrs (_: mod: makePrintPathsFor (deps ++ [mod]) mods) mods;
|
||||
print-paths = makePrintPathsFor [] (mods' // externalModMap);
|
||||
# `lean` wrapper that dynamically runs Nix for the actual `lean` executable so the same editor can be
|
||||
# used for multiple projects/after upgrading the `lean` input/for editing both stage 1 and the tests
|
||||
@@ -297,7 +297,7 @@ in rec {
|
||||
devShell = mkShell {
|
||||
buildInputs = [ nix ];
|
||||
shellHook = ''
|
||||
export LEAN_SRC_PATH="$PWD/${srcPrefix}"
|
||||
export LEAN_SRC_PATH="${srcPath}"
|
||||
'';
|
||||
};
|
||||
})
|
||||
|
||||
@@ -34,8 +34,11 @@ $CP llvm/lib/clang/*/include/{std*,__std*,limits}.h stage1/include/clang
|
||||
(cd llvm; $CP --parents lib/clang/*/lib/*/libclang_rt.osx.a ../stage1)
|
||||
# libSystem stub, includes libc
|
||||
cp $SDK/usr/lib/libSystem.tbd stage1/lib/libc
|
||||
# use for linking, use system libs for running
|
||||
gcp llvm/lib/lib{c++,c++abi,unwind}.dylib stage1/lib/libc
|
||||
# use for linking, use system lib for running
|
||||
gcp llvm/lib/libc++.dylib stage1/lib/libc
|
||||
# make sure we search for the library in /usr/lib instead of the rpath, which should not contain `/usr/lib`
|
||||
# and apparently since Sonoma does not do so implicitly either
|
||||
install_name_tool -id /usr/lib/libc++.dylib stage1/lib/libc/libc++.dylib
|
||||
echo -n " -DLLVM=ON -DLLVM_CONFIG=$PWD/llvm-host/bin/llvm-config" # manually point to `llvm-config` location
|
||||
echo -n " -DLEAN_STANDALONE=ON"
|
||||
# do not change C++ compiler; libc++ etc. being system libraries means there's no danger of conflicts,
|
||||
|
||||
@@ -3,8 +3,8 @@ set -euo pipefail
|
||||
|
||||
rm -r stage0 || true
|
||||
# don't copy untracked files
|
||||
for f in $(git ls-files src); do
|
||||
[[ $f != src/lake && $f != src/Leanc.lean ]] || continue
|
||||
# `:!` is git glob flavor for exclude patterns
|
||||
for f in $(git ls-files src ':!:src/lake/*' ':!:src/Leanc.lean'); do
|
||||
if [[ $f == *.lean ]]; then
|
||||
f=${f#src/}
|
||||
f=${f%.lean}.c
|
||||
|
||||
@@ -293,7 +293,7 @@ if(${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
|
||||
find_package(ZLIB REQUIRED)
|
||||
message(STATUS "ZLIB_LIBRARY: ${ZLIB_LIBRARY}")
|
||||
cmake_path(GET ZLIB_LIBRARY PARENT_PATH ZLIB_LIBRARY_PARENT_PATH)
|
||||
string(APPEND LEAN_EXTRA_LINKER_FLAGS " -L ${ZLIB_LIBRARY_PARENT_PATH}")
|
||||
string(APPEND LEANSHARED_LINKER_FLAGS " -L ${ZLIB_LIBRARY_PARENT_PATH}")
|
||||
endif()
|
||||
string(APPEND LEANC_STATIC_LINKER_FLAGS " -lleancpp -lInit -lLean -lleanrt")
|
||||
elseif(${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
|
||||
@@ -301,6 +301,7 @@ elseif(${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
|
||||
else()
|
||||
string(APPEND LEANC_STATIC_LINKER_FLAGS " -Wl,--start-group -lleancpp -lLean -Wl,--end-group -Wl,--start-group -lInit -lleanrt -Wl,--end-group")
|
||||
endif()
|
||||
string(APPEND LEANC_STATIC_LINKER_FLAGS " -lLake")
|
||||
|
||||
set(LEAN_CXX_STDLIB "-lstdc++" CACHE STRING "C++ stdlib linker flags")
|
||||
|
||||
|
||||
@@ -1480,7 +1480,7 @@ end
|
||||
|
||||
section Exact
|
||||
|
||||
variable {α : Sort u}
|
||||
variable {α : Sort u}
|
||||
|
||||
private def rel {s : Setoid α} (q₁ q₂ : Quotient s) : Prop :=
|
||||
Quotient.liftOn₂ q₁ q₂
|
||||
|
||||
@@ -247,7 +247,7 @@ termination_by _ => s.endPos.1 - i.1
|
||||
|
||||
def splitOnAux (s sep : String) (b : Pos) (i : Pos) (j : Pos) (r : List String) : List String :=
|
||||
if h : s.atEnd i then
|
||||
let r := if sep.atEnd j then ""::(s.extract b (i - j))::r else (s.extract b i)::r
|
||||
let r := (s.extract b i)::r
|
||||
r.reverse
|
||||
else
|
||||
have := Nat.sub_lt_sub_left (Nat.gt_of_not_le (mt decide_eq_true h)) (lt_next s _)
|
||||
|
||||
@@ -608,7 +608,7 @@ parameter.
|
||||
|
||||
For example, the `Coe` class is defined as:
|
||||
```
|
||||
class Coe (α : semiOutParam (Type u)) (β : Type v)
|
||||
class Coe (α : semiOutParam (Sort u)) (β : Sort v)
|
||||
```
|
||||
This means that all `Coe` instances should provide a concrete value for `α`
|
||||
(i.e., not an assignable metavariable). An instance like `Coe Nat Int` or `Coe
|
||||
|
||||
@@ -8,26 +8,26 @@ import Init.Meta
|
||||
import Init.SizeOf
|
||||
import Init.Data.Nat.Linear
|
||||
|
||||
@[simp] theorem Fin.sizeOf (a : Fin n) : sizeOf a = a.val + 1 := by
|
||||
@[simp] protected theorem Fin.sizeOf (a : Fin n) : sizeOf a = a.val + 1 := by
|
||||
cases a; simp_arith
|
||||
|
||||
@[simp] theorem UInt8.sizeOf (a : UInt8) : sizeOf a = a.toNat + 2 := by
|
||||
@[simp] protected theorem UInt8.sizeOf (a : UInt8) : sizeOf a = a.toNat + 2 := by
|
||||
cases a; simp_arith [UInt8.toNat]
|
||||
|
||||
@[simp] theorem UInt16.sizeOf (a : UInt16) : sizeOf a = a.toNat + 2 := by
|
||||
@[simp] protected theorem UInt16.sizeOf (a : UInt16) : sizeOf a = a.toNat + 2 := by
|
||||
cases a; simp_arith [UInt16.toNat]
|
||||
|
||||
@[simp] theorem UInt32.sizeOf (a : UInt32) : sizeOf a = a.toNat + 2 := by
|
||||
@[simp] protected theorem UInt32.sizeOf (a : UInt32) : sizeOf a = a.toNat + 2 := by
|
||||
cases a; simp_arith [UInt32.toNat]
|
||||
|
||||
@[simp] theorem UInt64.sizeOf (a : UInt64) : sizeOf a = a.toNat + 2 := by
|
||||
@[simp] protected theorem UInt64.sizeOf (a : UInt64) : sizeOf a = a.toNat + 2 := by
|
||||
cases a; simp_arith [UInt64.toNat]
|
||||
|
||||
@[simp] theorem USize.sizeOf (a : USize) : sizeOf a = a.toNat + 2 := by
|
||||
@[simp] protected theorem USize.sizeOf (a : USize) : sizeOf a = a.toNat + 2 := by
|
||||
cases a; simp_arith [USize.toNat]
|
||||
|
||||
@[simp] theorem Char.sizeOf (a : Char) : sizeOf a = a.toNat + 3 := by
|
||||
@[simp] protected theorem Char.sizeOf (a : Char) : sizeOf a = a.toNat + 3 := by
|
||||
cases a; simp_arith [Char.toNat]
|
||||
|
||||
@[simp] theorem Subtype.sizeOf {α : Sort u_1} {p : α → Prop} (s : Subtype p) : sizeOf s = sizeOf s.val + 1 := by
|
||||
@[simp] protected theorem Subtype.sizeOf {α : Sort u_1} {p : α → Prop} (s : Subtype p) : sizeOf s = sizeOf s.val + 1 := by
|
||||
cases s; simp_arith
|
||||
|
||||
@@ -294,6 +294,14 @@ end Handle
|
||||
@[extern "lean_io_remove_dir"] opaque removeDir : @& FilePath → IO Unit
|
||||
@[extern "lean_io_create_dir"] opaque createDir : @& FilePath → IO Unit
|
||||
|
||||
/--
|
||||
Moves a file or directory `old` to the new location `new`.
|
||||
|
||||
This function coincides with the [POSIX `rename` function](https://pubs.opengroup.org/onlinepubs/9699919799/functions/rename.html),
|
||||
see there for more information.
|
||||
-/
|
||||
@[extern "lean_io_rename"] opaque rename (old new : @& FilePath) : IO Unit
|
||||
|
||||
end FS
|
||||
|
||||
@[extern "lean_io_getenv"] opaque getEnv (var : @& String) : BaseIO (Option String)
|
||||
|
||||
@@ -415,24 +415,38 @@ def emitFnDeclAux (mod : LLVM.Module llvmctx)
|
||||
let env ← getEnv
|
||||
-- bollu: if we have a declaration with no parameters, then we emit it as a global pointer.
|
||||
-- bollu: Otherwise, we emit it as a function
|
||||
let global ←
|
||||
if ps.isEmpty then
|
||||
let retty ← (toLLVMType decl.resultType)
|
||||
let global ← LLVM.getOrAddGlobal mod cppBaseName retty
|
||||
if !isExternal then
|
||||
LLVM.setInitializer global (← LLVM.getUndef retty)
|
||||
pure global
|
||||
else
|
||||
let retty ← (toLLVMType decl.resultType)
|
||||
let mut argtys := #[]
|
||||
for p in ps do
|
||||
-- if it is extern, then we must not add irrelevant args
|
||||
if !(isExternC env decl.name) || !p.ty.isIrrelevant then
|
||||
argtys := argtys.push (← toLLVMType p.ty)
|
||||
-- TODO (bollu): simplify this API, this code of `closureMaxArgs` is duplicated in multiple places.
|
||||
if argtys.size > closureMaxArgs && isBoxedName decl.name then
|
||||
argtys := #[← LLVM.pointerType (← LLVM.voidPtrType llvmctx)]
|
||||
let fnty ← LLVM.functionType retty argtys (isVarArg := false)
|
||||
LLVM.getOrAddFunction mod cppBaseName fnty
|
||||
-- we must now set symbol visibility for global.
|
||||
if ps.isEmpty then
|
||||
let retty ← (toLLVMType decl.resultType)
|
||||
let global ← LLVM.getOrAddGlobal mod cppBaseName retty
|
||||
if !isExternal then
|
||||
LLVM.setInitializer global (← LLVM.getUndef retty)
|
||||
return global
|
||||
else
|
||||
let retty ← (toLLVMType decl.resultType)
|
||||
let mut argtys := #[]
|
||||
for p in ps do
|
||||
-- if it is extern, then we must not add irrelevant args
|
||||
if !(isExternC env decl.name) || !p.ty.isIrrelevant then
|
||||
argtys := argtys.push (← toLLVMType p.ty)
|
||||
-- TODO (bollu): simplify this API, this code of `closureMaxArgs` is duplicated in multiple places.
|
||||
if argtys.size > closureMaxArgs && isBoxedName decl.name then
|
||||
argtys := #[← LLVM.pointerType (← LLVM.voidPtrType llvmctx)]
|
||||
let fnty ← LLVM.functionType retty argtys (isVarArg := false)
|
||||
LLVM.getOrAddFunction mod cppBaseName fnty
|
||||
if isClosedTermName env decl.name then LLVM.setVisibility global LLVM.Visibility.hidden -- static
|
||||
else if isExternal then pure () -- extern (Recall that C/LLVM funcs are extern linkage by default.)
|
||||
else LLVM.setDLLStorageClass global LLVM.DLLStorageClass.export -- LEAN_EXPORT
|
||||
else if !isExternal
|
||||
-- An extern decl might be linked in from a different translation unit.
|
||||
-- Thus, we cannot export an external declaration as we do not define it,
|
||||
-- only declare its presence.
|
||||
-- So, we only export non-external definitions.
|
||||
then LLVM.setDLLStorageClass global LLVM.DLLStorageClass.export
|
||||
return global
|
||||
|
||||
|
||||
def emitFnDecl (decl : Decl) (isExternal : Bool) : M llvmctx Unit := do
|
||||
let cppBaseName ← toCName decl.name
|
||||
@@ -1137,6 +1151,14 @@ def emitDeclAux (mod : LLVM.Module llvmctx) (builder : LLVM.Builder llvmctx) (d
|
||||
argtys := argtys.push (← toLLVMType x.ty)
|
||||
let fnty ← LLVM.functionType retty argtys (isVarArg := false)
|
||||
let llvmfn ← LLVM.getOrAddFunction mod name fnty
|
||||
-- set linkage and visibility
|
||||
-- TODO: consider refactoring these into a separate concept (e.g. 'setLinkageAndVisibility')
|
||||
-- Find the spots where this refactor needs to happen by grepping for 'LEAN_EXPORT'
|
||||
-- in the C backend
|
||||
if xs.size == 0 then
|
||||
LLVM.setVisibility llvmfn LLVM.Visibility.hidden -- "static "
|
||||
else
|
||||
LLVM.setDLLStorageClass llvmfn LLVM.DLLStorageClass.export -- LEAN_EXPORT: make symbol visible to the interpreter
|
||||
withReader (fun llvmctx => { llvmctx with mainFn := f, mainParams := xs }) do
|
||||
set { var2val := default, jp2bb := default : EmitLLVM.State llvmctx } -- flush variable map
|
||||
let bb ← LLVM.appendBasicBlockInContext llvmctx llvmfn "entry"
|
||||
@@ -1247,10 +1269,12 @@ def emitInitFn (mod : LLVM.Module llvmctx) (builder : LLVM.Builder llvmctx) : M
|
||||
|
||||
let initFnTy ← LLVM.functionType (← LLVM.voidPtrType llvmctx) #[ (← LLVM.i8Type llvmctx), (← LLVM.voidPtrType llvmctx)] (isVarArg := false)
|
||||
let initFn ← LLVM.getOrAddFunction mod (mkModuleInitializationFunctionName modName) initFnTy
|
||||
LLVM.setDLLStorageClass initFn LLVM.DLLStorageClass.export -- LEAN_EXPORT
|
||||
let entryBB ← LLVM.appendBasicBlockInContext llvmctx initFn "entry"
|
||||
LLVM.positionBuilderAtEnd builder entryBB
|
||||
let ginit?ty := ← LLVM.i1Type llvmctx
|
||||
let ginit?slot ← LLVM.getOrAddGlobal mod (modName.mangle ++ "_G_initialized") ginit?ty
|
||||
LLVM.setVisibility ginit?slot LLVM.Visibility.hidden -- static
|
||||
LLVM.setInitializer ginit?slot (← LLVM.constFalse llvmctx)
|
||||
let ginit?v ← LLVM.buildLoad2 builder ginit?ty ginit?slot "init_v"
|
||||
buildIfThen_ builder "isGInitialized" ginit?v
|
||||
|
||||
@@ -294,6 +294,28 @@ opaque disposeTargetMachine (tm : TargetMachine ctx) : BaseIO Unit
|
||||
opaque disposeModule (m : Module ctx) : BaseIO Unit
|
||||
|
||||
|
||||
-- https://github.com/llvm/llvm-project/blob/c3e073bcbdc523b0f758d44a89a6333e38bff863/llvm/include/llvm-c/Core.h#L198
|
||||
structure Visibility where
|
||||
private mk :: val : UInt64
|
||||
|
||||
def Visibility.default : Visibility := { val := 0 }
|
||||
def Visibility.hidden : Visibility := { val := 1 }
|
||||
def Visibility.protected : Visibility := { val := 2 }
|
||||
|
||||
@[extern "lean_llvm_set_visibility"]
|
||||
opaque setVisibility {ctx : Context} (value : Value ctx) (visibility : Visibility) : BaseIO Unit
|
||||
|
||||
-- https://github.com/llvm/llvm-project/blob/c3e073bcbdc523b0f758d44a89a6333e38bff863/llvm/include/llvm-c/Core.h#L210
|
||||
structure DLLStorageClass where
|
||||
private mk :: val : UInt64
|
||||
|
||||
def DLLStorageClass.default : DLLStorageClass := { val := 0 }
|
||||
def DLLStorageClass.import : DLLStorageClass := { val := 1 }
|
||||
def DLLStorageClass.export : DLLStorageClass := { val := 2 }
|
||||
|
||||
@[extern "lean_llvm_set_dll_storage_class"]
|
||||
opaque setDLLStorageClass {ctx : Context} (value : Value ctx) (dllStorageClass : DLLStorageClass) : BaseIO Unit
|
||||
|
||||
-- Helper to add a function if it does not exist, and to return the function handle if it does.
|
||||
def getOrAddFunction(m : Module ctx) (name : String) (type : LLVMType ctx) : BaseIO (Value ctx) := do
|
||||
match (← getNamedFunction m name) with
|
||||
|
||||
@@ -11,20 +11,16 @@ import Lean.Elab.Tactic.Config
|
||||
namespace Lean.Elab.Tactic
|
||||
open Meta
|
||||
|
||||
def rewriteTarget (stx : Syntax) (symm : Bool) (config : Rewrite.Config) : TacticM Unit := do
|
||||
Term.withSynthesize <| withMainContext do
|
||||
let e ← elabTerm stx none true
|
||||
let r ← (← getMainGoal).rewrite (← getMainTarget) e symm (config := config)
|
||||
let mvarId' ← (← getMainGoal).replaceTargetEq r.eNew r.eqProof
|
||||
replaceMainGoal (mvarId' :: r.mvarIds)
|
||||
def rewriteTarget (e : Expr) (symm : Bool) (config : Rewrite.Config) : TacticM Unit := do
|
||||
let r ← (← getMainGoal).rewrite (← getMainTarget) e symm (config := config)
|
||||
let mvarId' ← (← getMainGoal).replaceTargetEq r.eNew r.eqProof
|
||||
replaceMainGoal (mvarId' :: r.mvarIds)
|
||||
|
||||
def rewriteLocalDecl (stx : Syntax) (symm : Bool) (fvarId : FVarId) (config : Rewrite.Config) : TacticM Unit := do
|
||||
Term.withSynthesize <| withMainContext do
|
||||
let e ← elabTerm stx none true
|
||||
let localDecl ← fvarId.getDecl
|
||||
let rwResult ← (← getMainGoal).rewrite localDecl.type e symm (config := config)
|
||||
let replaceResult ← (← getMainGoal).replaceLocalDecl fvarId rwResult.eNew rwResult.eqProof
|
||||
replaceMainGoal (replaceResult.mvarId :: rwResult.mvarIds)
|
||||
def rewriteLocalDecl (e : Expr) (symm : Bool) (fvarId : FVarId) (config : Rewrite.Config) : TacticM Unit := do
|
||||
let localDecl ← fvarId.getDecl
|
||||
let rwResult ← (← getMainGoal).rewrite localDecl.type e symm (config := config)
|
||||
let replaceResult ← (← getMainGoal).replaceLocalDecl fvarId rwResult.eNew rwResult.eqProof
|
||||
replaceMainGoal (replaceResult.mvarId :: rwResult.mvarIds)
|
||||
|
||||
def withRWRulesSeq (token : Syntax) (rwRulesSeqStx : Syntax) (x : (symm : Bool) → (term : Syntax) → TacticM Unit) : TacticM Unit := do
|
||||
let lbrak := rwRulesSeqStx[0]
|
||||
@@ -62,9 +58,11 @@ declare_config_elab elabRewriteConfig Rewrite.Config
|
||||
let cfg ← elabRewriteConfig stx[1]
|
||||
let loc := expandOptLocation stx[3]
|
||||
withRWRulesSeq stx[0] stx[2] fun symm term => do
|
||||
withLocation loc
|
||||
(rewriteLocalDecl term symm · cfg)
|
||||
(rewriteTarget term symm cfg)
|
||||
(throwTacticEx `rewrite · "did not find instance of the pattern in the current goal")
|
||||
Term.withSynthesize <| withMainContext do
|
||||
let e ← elabTerm term none true
|
||||
withLocation loc
|
||||
(rewriteLocalDecl e symm · cfg)
|
||||
(rewriteTarget e symm cfg)
|
||||
(throwTacticEx `rewrite · "did not find instance of the pattern in the current goal")
|
||||
|
||||
end Lean.Elab.Tactic
|
||||
|
||||
@@ -314,7 +314,7 @@ end
|
||||
| .lam .. => return e
|
||||
| .sort .. => return e
|
||||
| .lit .. => return e
|
||||
| .bvar .. => unreachable!
|
||||
| .bvar .. => panic! "loose bvar in expression"
|
||||
| .letE .. => k e
|
||||
| .const .. => k e
|
||||
| .app .. => k e
|
||||
|
||||
@@ -11,7 +11,13 @@ namespace Lean
|
||||
|
||||
/-- A position of a subexpression in an expression.
|
||||
|
||||
See docstring of `SubExpr` for more detail.-/
|
||||
We use a simple encoding scheme for expression positions `Pos`:
|
||||
every `Expr` constructor has at most 3 direct expression children. Considering an expression's type
|
||||
to be one extra child as well, we can injectively map a path of `childIdxs` to a natural number
|
||||
by computing the value of the 4-ary representation `1 :: childIdxs`, since n-ary representations
|
||||
without leading zeros are unique. Note that `pos` is initialized to `1` (case `childIdxs == []`).
|
||||
|
||||
See also `SubExpr`. -/
|
||||
def SubExpr.Pos := Nat
|
||||
|
||||
namespace SubExpr.Pos
|
||||
@@ -145,18 +151,12 @@ instance : FromJson Pos := ⟨fun j => fromJson? j >>= Pos.fromString?⟩
|
||||
|
||||
end SubExpr.Pos
|
||||
|
||||
/-- An expression and the position of a subexpression within this expression.
|
||||
|
||||
Subexpressions are encoded as the current subexpression `e` and a
|
||||
position `p : Pos` denoting `e`'s position with respect to the root expression.
|
||||
|
||||
We use a simple encoding scheme for expression positions `Pos`:
|
||||
every `Expr` constructor has at most 3 direct expression children. Considering an expression's type
|
||||
to be one extra child as well, we can injectively map a path of `childIdxs` to a natural number
|
||||
by computing the value of the 4-ary representation `1 :: childIdxs`, since n-ary representations
|
||||
without leading zeros are unique. Note that `pos` is initialized to `1` (case `childIdxs == []`).-/
|
||||
/-- A subexpression of some root expression. Both its value and its position
|
||||
within the root are stored. -/
|
||||
structure SubExpr where
|
||||
/-- The subexpression. -/
|
||||
expr : Expr
|
||||
/-- The position of the subexpression within the root expression. -/
|
||||
pos : SubExpr.Pos
|
||||
deriving Inhabited
|
||||
|
||||
@@ -164,7 +164,7 @@ namespace SubExpr
|
||||
|
||||
def mkRoot (e : Expr) : SubExpr := ⟨e, Pos.root⟩
|
||||
|
||||
/-- Returns true if the selected subexpression is the topmost one.-/
|
||||
/-- Returns true if the selected subexpression is the topmost one. -/
|
||||
def isRoot (s : SubExpr) : Bool := s.pos.isRoot
|
||||
|
||||
/-- Map from subexpr positions to values. -/
|
||||
|
||||
@@ -193,7 +193,7 @@ def withTraceNode [MonadExcept ε m] [MonadLiftT BaseIO m] (cls : Name) (msg : E
|
||||
modifyTraces (oldTraces ++ ·)
|
||||
return (← MonadExcept.ofExcept res)
|
||||
let ref ← getRef
|
||||
let mut m ← msg res
|
||||
let mut m ← try msg res catch _ => pure m!"<exception thrown while producing trace node message>"
|
||||
if profiler.get opts || aboveThresh then
|
||||
m := m!"[{secs}s] {m}"
|
||||
addTraceNode oldTraces cls ref m collapsed
|
||||
|
||||
1
src/lake
1
src/lake
Submodule src/lake deleted from 9919b5efc4
1
src/lake/.gitattributes
vendored
Normal file
1
src/lake/.gitattributes
vendored
Normal file
@@ -0,0 +1 @@
|
||||
*.sh text eol=lf
|
||||
72
src/lake/.github/workflows/ci.yml
vendored
Normal file
72
src/lake/.github/workflows/ci.yml
vendored
Normal file
@@ -0,0 +1,72 @@
|
||||
name: CI
|
||||
|
||||
on: [ push, pull_request ]
|
||||
|
||||
jobs:
|
||||
skip_check:
|
||||
name: Skip Check
|
||||
continue-on-error: true
|
||||
runs-on: ubuntu-latest
|
||||
outputs:
|
||||
should_skip: ${{ steps.skip_check.outputs.should_skip }}
|
||||
steps:
|
||||
- id: skip_check
|
||||
uses: fkirc/skip-duplicate-actions@v4
|
||||
with:
|
||||
concurrent_skipping: 'same_content_newer'
|
||||
paths_ignore: '["README.md", "LICENSE"]'
|
||||
|
||||
build:
|
||||
needs: skip_check
|
||||
name: ${{ matrix.name || 'Build' }}
|
||||
if: ${{ needs.skip_check.outputs.should_skip != 'true' }}
|
||||
runs-on: ${{ matrix.os }}
|
||||
defaults:
|
||||
run:
|
||||
shell: ${{ matrix.shell || 'sh' }}
|
||||
strategy:
|
||||
matrix:
|
||||
include:
|
||||
- name: Ubuntu
|
||||
os: ubuntu-latest
|
||||
- name: MacOS
|
||||
os: macos-latest
|
||||
- name: Windows
|
||||
os: windows-latest
|
||||
shell: msys2 {0}
|
||||
# complete all jobs
|
||||
fail-fast: false
|
||||
steps:
|
||||
- name: Install MSYS2 (Windows)
|
||||
if: matrix.os == 'windows-latest'
|
||||
uses: msys2/setup-msys2@v2
|
||||
with:
|
||||
path-type: inherit
|
||||
install: curl unzip make diffutils mingw-w64-x86_64-gcc mingw-w64-x86_64-gmp
|
||||
- name: Install Elan
|
||||
shell: bash -euo pipefail {0}
|
||||
run: |
|
||||
curl -sSfL https://raw.githubusercontent.com/leanprover/elan/master/elan-init.sh | sh -s -- -y --default-toolchain none
|
||||
echo "$HOME/.elan/bin" >> $GITHUB_PATH
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v2
|
||||
- name: Check Lean
|
||||
run: lean --version
|
||||
- name: Build & Time
|
||||
run: ./time.sh -j4
|
||||
- name: Upload Build
|
||||
continue-on-error: true
|
||||
uses: actions/upload-artifact@v2
|
||||
with:
|
||||
name: ${{ matrix.os }}
|
||||
path: build
|
||||
- name: Check Lake
|
||||
run: make check-lake
|
||||
- name: Test Lake
|
||||
run: make test-ci
|
||||
- name: Time Bootstrap
|
||||
run: make time-bootstrap
|
||||
- name: Check Bootstrap
|
||||
run: make check-bootstrap
|
||||
- name: Test Bootstrapped Lake
|
||||
run: make test-bootstrapped -j4
|
||||
5
src/lake/.gitignore
vendored
Normal file
5
src/lake/.gitignore
vendored
Normal file
@@ -0,0 +1,5 @@
|
||||
/build
|
||||
produced.out
|
||||
result*
|
||||
# Do not commit the flake lockfile to avoid having to maintain it
|
||||
flake.lock
|
||||
70
src/lake/LICENSE
Normal file
70
src/lake/LICENSE
Normal file
@@ -0,0 +1,70 @@
|
||||
Apache License 2.0 (Apache)
|
||||
Apache License
|
||||
Version 2.0, January 2004
|
||||
http://www.apache.org/licenses/
|
||||
|
||||
TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
|
||||
|
||||
1. Definitions.
|
||||
|
||||
"License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document.
|
||||
|
||||
"Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License.
|
||||
|
||||
"Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity.
|
||||
|
||||
"You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License.
|
||||
|
||||
"Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files.
|
||||
|
||||
"Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types.
|
||||
|
||||
"Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below).
|
||||
|
||||
"Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof.
|
||||
|
||||
"Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution."
|
||||
|
||||
"Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work.
|
||||
|
||||
2. Grant of Copyright License.
|
||||
|
||||
Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form.
|
||||
|
||||
3. Grant of Patent License.
|
||||
|
||||
Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed.
|
||||
|
||||
4. Redistribution.
|
||||
|
||||
You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions:
|
||||
|
||||
1. You must give any other recipients of the Work or Derivative Works a copy of this License; and
|
||||
|
||||
2. You must cause any modified files to carry prominent notices stating that You changed the files; and
|
||||
|
||||
3. You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and
|
||||
|
||||
4. If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License.
|
||||
|
||||
You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License.
|
||||
|
||||
5. Submission of Contributions.
|
||||
|
||||
Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions.
|
||||
|
||||
6. Trademarks.
|
||||
|
||||
This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file.
|
||||
|
||||
7. Disclaimer of Warranty.
|
||||
|
||||
Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License.
|
||||
|
||||
8. Limitation of Liability.
|
||||
|
||||
In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages.
|
||||
|
||||
9. Accepting Warranty or Additional Liability.
|
||||
|
||||
While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability.
|
||||
10
src/lake/Lake.lean
Normal file
10
src/lake/Lake.lean
Normal file
@@ -0,0 +1,10 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Build
|
||||
import Lake.Config
|
||||
import Lake.DSL
|
||||
import Lake.Version
|
||||
import Lake.CLI.Actions
|
||||
12
src/lake/Lake/Build.lean
Normal file
12
src/lake/Lake/Build.lean
Normal file
@@ -0,0 +1,12 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Build.Monad
|
||||
import Lake.Build.Actions
|
||||
import Lake.Build.Index
|
||||
import Lake.Build.Module
|
||||
import Lake.Build.Package
|
||||
import Lake.Build.Library
|
||||
import Lake.Build.Imports
|
||||
123
src/lake/Lake/Build/Actions.lean
Normal file
123
src/lake/Lake/Build/Actions.lean
Normal file
@@ -0,0 +1,123 @@
|
||||
/-
|
||||
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Gabriel Ebner, Sebastian Ullrich, Mac Malone
|
||||
-/
|
||||
import Lake.Util.Proc
|
||||
import Lake.Util.NativeLib
|
||||
import Lake.Build.Context
|
||||
|
||||
namespace Lake
|
||||
open System
|
||||
|
||||
def createParentDirs (path : FilePath) : IO Unit := do
|
||||
if let some dir := path.parent then IO.FS.createDirAll dir
|
||||
|
||||
def compileLeanModule (name : String) (leanFile : FilePath)
|
||||
(oleanFile? ileanFile? cFile? : Option FilePath)
|
||||
(leanPath : SearchPath := []) (rootDir : FilePath := ".")
|
||||
(dynlibs : Array FilePath := #[]) (dynlibPath : SearchPath := {})
|
||||
(leanArgs : Array String := #[]) (lean : FilePath := "lean")
|
||||
: BuildM Unit := do
|
||||
logStep s!"Building {name}"
|
||||
let mut args := leanArgs ++
|
||||
#[leanFile.toString, "-R", rootDir.toString]
|
||||
if let some oleanFile := oleanFile? then
|
||||
createParentDirs oleanFile
|
||||
args := args ++ #["-o", oleanFile.toString]
|
||||
if let some ileanFile := ileanFile? then
|
||||
createParentDirs ileanFile
|
||||
args := args ++ #["-i", ileanFile.toString]
|
||||
if let some cFile := cFile? then
|
||||
createParentDirs cFile
|
||||
args := args ++ #["-c", cFile.toString]
|
||||
for dynlib in dynlibs do
|
||||
args := args.push s!"--load-dynlib={dynlib}"
|
||||
proc {
|
||||
args
|
||||
cmd := lean.toString
|
||||
env := #[
|
||||
("LEAN_PATH", leanPath.toString),
|
||||
(sharedLibPathEnvVar, (← getSearchPath sharedLibPathEnvVar) ++ dynlibPath |>.toString)
|
||||
]
|
||||
}
|
||||
|
||||
def compileO (name : String) (oFile srcFile : FilePath)
|
||||
(moreArgs : Array String := #[]) (compiler : FilePath := "cc") : BuildM Unit := do
|
||||
logStep s!"Compiling {name}"
|
||||
createParentDirs oFile
|
||||
proc {
|
||||
cmd := compiler.toString
|
||||
args := #["-c", "-o", oFile.toString, srcFile.toString] ++ moreArgs
|
||||
}
|
||||
|
||||
def compileStaticLib (name : String) (libFile : FilePath)
|
||||
(oFiles : Array FilePath) (ar : FilePath := "ar") : BuildM Unit := do
|
||||
logStep s!"Creating {name}"
|
||||
createParentDirs libFile
|
||||
proc {
|
||||
cmd := ar.toString
|
||||
args := #["rcs", libFile.toString] ++ oFiles.map toString
|
||||
}
|
||||
|
||||
def compileSharedLib (name : String) (libFile : FilePath)
|
||||
(linkArgs : Array String) (linker : FilePath := "cc") : BuildM Unit := do
|
||||
logStep s!"Linking {name}"
|
||||
createParentDirs libFile
|
||||
proc {
|
||||
cmd := linker.toString
|
||||
args := #["-shared", "-o", libFile.toString] ++ linkArgs
|
||||
}
|
||||
|
||||
def compileExe (name : String) (binFile : FilePath) (linkFiles : Array FilePath)
|
||||
(linkArgs : Array String := #[]) (linker : FilePath := "cc") : BuildM Unit := do
|
||||
logStep s!"Linking {name}"
|
||||
createParentDirs binFile
|
||||
proc {
|
||||
cmd := linker.toString
|
||||
args := #["-o", binFile.toString] ++ linkFiles.map toString ++ linkArgs
|
||||
}
|
||||
|
||||
/-- Download a file using `curl`, clobbering any existing file. -/
|
||||
def download (name : String) (url : String) (file : FilePath) : LogIO PUnit := do
|
||||
logInfo s!"Downloading {name}"
|
||||
if (← file.pathExists) then
|
||||
IO.FS.removeFile file
|
||||
else
|
||||
createParentDirs file
|
||||
let args :=
|
||||
if (← getIsVerbose) then #[] else #["-s"]
|
||||
proc (quiet := true) {
|
||||
cmd := "curl"
|
||||
args := args ++ #["-f", "-o", file.toString, "-L", url]
|
||||
}
|
||||
|
||||
/-- Unpack an archive `file` using `tar` into the directory `dir`. -/
|
||||
def untar (name : String) (file : FilePath) (dir : FilePath) (gzip := true) : LogIO PUnit := do
|
||||
logInfo s!"Unpacking {name}"
|
||||
let mut opts := "-x"
|
||||
if (← getIsVerbose) then
|
||||
opts := opts.push 'v'
|
||||
if gzip then
|
||||
opts := opts.push 'z'
|
||||
proc {
|
||||
cmd := "tar",
|
||||
args := #[opts, "-f", file.toString, "-C", dir.toString]
|
||||
}
|
||||
|
||||
/-- Pack a directory `dir` using `tar` into the archive `file`. -/
|
||||
def tar (name : String) (dir : FilePath) (file : FilePath)
|
||||
(gzip := true) (excludePaths : Array FilePath := #[]) : LogIO PUnit := do
|
||||
logInfo s!"Packing {name}"
|
||||
createParentDirs file
|
||||
let mut args := #["-c"]
|
||||
if gzip then
|
||||
args := args.push "-z"
|
||||
if (← getIsVerbose) then
|
||||
args := args.push "-v"
|
||||
for path in excludePaths do
|
||||
args := args.push s!"--exclude={path}"
|
||||
proc {
|
||||
cmd := "tar"
|
||||
args := args ++ #["-f", file.toString, "-C", dir.toString, "."]
|
||||
}
|
||||
118
src/lake/Lake/Build/Common.lean
Normal file
118
src/lake/Lake/Build/Common.lean
Normal file
@@ -0,0 +1,118 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Build.Job
|
||||
import Lake.Build.Actions
|
||||
import Lake.Build.Monad
|
||||
|
||||
open System
|
||||
namespace Lake
|
||||
|
||||
/-! # General Utilities -/
|
||||
|
||||
@[inline] def inputFile (path : FilePath) : SchedulerM (BuildJob FilePath) :=
|
||||
Job.async <| (path, ·) <$> computeTrace path
|
||||
|
||||
@[inline] def buildUnlessUpToDate [CheckExists ι] [GetMTime ι] (info : ι)
|
||||
(depTrace : BuildTrace) (traceFile : FilePath) (build : JobM PUnit) : JobM PUnit := do
|
||||
let isOldMode ← getIsOldMode
|
||||
let upToDate ←
|
||||
if isOldMode then
|
||||
depTrace.checkAgainstTime info
|
||||
else
|
||||
depTrace.checkAgainstFile info traceFile
|
||||
unless upToDate do
|
||||
build
|
||||
unless isOldMode do
|
||||
depTrace.writeToFile traceFile
|
||||
|
||||
@[inline] def buildFileUnlessUpToDate (file : FilePath)
|
||||
(depTrace : BuildTrace) (build : BuildM PUnit) : BuildM BuildTrace := do
|
||||
let traceFile := FilePath.mk <| file.toString ++ ".trace"
|
||||
buildUnlessUpToDate file depTrace traceFile build
|
||||
computeTrace file
|
||||
|
||||
@[inline] def buildFileAfterDep
|
||||
(file : FilePath) (dep : BuildJob α) (build : α → BuildM PUnit)
|
||||
(extraDepTrace : BuildM _ := pure BuildTrace.nil) : SchedulerM (BuildJob FilePath) :=
|
||||
dep.bindSync fun depInfo depTrace => do
|
||||
let depTrace := depTrace.mix (← extraDepTrace)
|
||||
let trace ← buildFileUnlessUpToDate file depTrace <| build depInfo
|
||||
return (file, trace)
|
||||
|
||||
@[inline] def buildFileAfterDepList
|
||||
(file : FilePath) (deps : List (BuildJob α)) (build : List α → BuildM PUnit)
|
||||
(extraDepTrace : BuildM _ := pure BuildTrace.nil) : SchedulerM (BuildJob FilePath) := do
|
||||
buildFileAfterDep file (← BuildJob.collectList deps) build extraDepTrace
|
||||
|
||||
@[inline] def buildFileAfterDepArray
|
||||
(file : FilePath) (deps : Array (BuildJob α)) (build : Array α → BuildM PUnit)
|
||||
(extraDepTrace : BuildM _ := pure BuildTrace.nil) : SchedulerM (BuildJob FilePath) := do
|
||||
buildFileAfterDep file (← BuildJob.collectArray deps) build extraDepTrace
|
||||
|
||||
/-! # Common Builds -/
|
||||
|
||||
def buildO (name : String)
|
||||
(oFile : FilePath) (srcJob : BuildJob FilePath)
|
||||
(args : Array String := #[]) (compiler : FilePath := "cc") : SchedulerM (BuildJob FilePath) :=
|
||||
buildFileAfterDep oFile srcJob (extraDepTrace := computeHash args) fun srcFile => do
|
||||
compileO name oFile srcFile args compiler
|
||||
|
||||
def buildLeanO (name : String)
|
||||
(oFile : FilePath) (srcJob : BuildJob FilePath)
|
||||
(args : Array String := #[]) : SchedulerM (BuildJob FilePath) :=
|
||||
buildFileAfterDep oFile srcJob (extraDepTrace := computeHash args) fun srcFile => do
|
||||
compileO name oFile srcFile args (← getLeanc)
|
||||
|
||||
def buildStaticLib (libFile : FilePath)
|
||||
(oFileJobs : Array (BuildJob FilePath)) : SchedulerM (BuildJob FilePath) :=
|
||||
let name := libFile.fileName.getD libFile.toString
|
||||
buildFileAfterDepArray libFile oFileJobs fun oFiles => do
|
||||
compileStaticLib name libFile oFiles (← getLeanAr)
|
||||
|
||||
def buildLeanSharedLib
|
||||
(libFile : FilePath) (linkJobs : Array (BuildJob FilePath))
|
||||
(linkArgs : Array String := #[]) : SchedulerM (BuildJob FilePath) :=
|
||||
let name := libFile.fileName.getD libFile.toString
|
||||
buildFileAfterDepArray libFile linkJobs
|
||||
(extraDepTrace := computeHash linkArgs) fun links => do
|
||||
compileSharedLib name libFile (links.map toString ++ linkArgs) (← getLeanc)
|
||||
|
||||
def buildLeanExe
|
||||
(exeFile : FilePath) (linkJobs : Array (BuildJob FilePath))
|
||||
(linkArgs : Array String := #[]) : SchedulerM (BuildJob FilePath) :=
|
||||
let name := exeFile.fileName.getD exeFile.toString
|
||||
buildFileAfterDepArray exeFile linkJobs
|
||||
(extraDepTrace := computeHash linkArgs) fun links => do
|
||||
compileExe name exeFile links linkArgs (← getLeanc)
|
||||
|
||||
def buildLeanSharedLibOfStatic (staticLibJob : BuildJob FilePath)
|
||||
(linkArgs : Array String := #[]) : SchedulerM (BuildJob FilePath) :=
|
||||
staticLibJob.bindSync fun staticLib staticTrace => do
|
||||
let dynlib := staticLib.withExtension sharedLibExt
|
||||
let baseArgs :=
|
||||
if System.Platform.isOSX then
|
||||
#[s!"-Wl,-force_load,{staticLib}"]
|
||||
else
|
||||
#["-Wl,--whole-archive", staticLib.toString, "-Wl,--no-whole-archive"]
|
||||
let args := baseArgs ++ linkArgs
|
||||
let depTrace := staticTrace.mix (← computeHash args)
|
||||
let trace ← buildFileUnlessUpToDate dynlib depTrace do
|
||||
let name := dynlib.fileName.getD dynlib.toString
|
||||
compileSharedLib name dynlib args (← getLeanc)
|
||||
return (dynlib, trace)
|
||||
|
||||
def computeDynlibOfShared
|
||||
(sharedLibTarget : BuildJob FilePath) : SchedulerM (BuildJob Dynlib) :=
|
||||
sharedLibTarget.bindSync fun sharedLib trace => do
|
||||
if let some stem := sharedLib.fileStem then
|
||||
if Platform.isWindows then
|
||||
return ({path := sharedLib, name := stem}, trace)
|
||||
else if stem.startsWith "lib" then
|
||||
return ({path := sharedLib, name := stem.drop 3}, trace)
|
||||
else
|
||||
error s!"shared library `{sharedLib}` does not start with `lib`; this is not supported on Unix"
|
||||
else
|
||||
error s!"shared library `{sharedLib}` has no file name"
|
||||
58
src/lake/Lake/Build/Context.lean
Normal file
58
src/lake/Lake/Build/Context.lean
Normal file
@@ -0,0 +1,58 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Util.Log
|
||||
import Lake.Util.Task
|
||||
import Lake.Util.Error
|
||||
import Lake.Util.OptionIO
|
||||
import Lake.Config.Context
|
||||
import Lake.Build.Trace
|
||||
import Lake.Build.Store
|
||||
import Lake.Build.Topological
|
||||
|
||||
open System
|
||||
namespace Lake
|
||||
|
||||
/-- A Lake context with some additional caching for builds. -/
|
||||
structure BuildContext extends Context where
|
||||
leanTrace : BuildTrace
|
||||
oldMode : Bool := false
|
||||
startedBuilds : IO.Ref Nat
|
||||
finishedBuilds : IO.Ref Nat
|
||||
|
||||
/-- A transformer to equip a monad with a `BuildContext`. -/
|
||||
abbrev BuildT := ReaderT BuildContext
|
||||
|
||||
/-- The monad for the Lake build manager. -/
|
||||
abbrev SchedulerM := BuildT <| LogT BaseIO
|
||||
|
||||
/-- The core monad for Lake builds. -/
|
||||
abbrev BuildM := BuildT LogIO
|
||||
|
||||
/-- A transformer to equip a monad with a Lake build store. -/
|
||||
abbrev BuildStoreT := StateT BuildStore
|
||||
|
||||
/-- A Lake build cycle. -/
|
||||
abbrev BuildCycle := Cycle BuildKey
|
||||
|
||||
/-- A transformer for monads that may encounter a build cycle. -/
|
||||
abbrev BuildCycleT := CycleT BuildKey
|
||||
|
||||
/-- A recursive build of a Lake build store that may encounter a cycle. -/
|
||||
abbrev RecBuildM := BuildCycleT <| BuildStoreT BuildM
|
||||
|
||||
instance [Pure m] : MonadLift LakeM (BuildT m) where
|
||||
monadLift x := fun ctx => pure <| x.run ctx.toContext
|
||||
|
||||
@[inline] def BuildM.run (ctx : BuildContext) (self : BuildM α) : LogIO α :=
|
||||
self ctx
|
||||
|
||||
def BuildM.catchFailure (f : Unit → BaseIO α) (self : BuildM α) : SchedulerM α :=
|
||||
fun ctx logMethods => self ctx logMethods |>.catchFailure f
|
||||
|
||||
def logStep (message : String) : BuildM Unit := do
|
||||
let done ← (← read).finishedBuilds.get
|
||||
let started ← (← read).startedBuilds.get
|
||||
logInfo s!"[{done}/{started}] {message}"
|
||||
131
src/lake/Lake/Build/Data.lean
Normal file
131
src/lake/Lake/Build/Data.lean
Normal file
@@ -0,0 +1,131 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Build.Key
|
||||
import Lake.Util.Family
|
||||
|
||||
open Lean
|
||||
namespace Lake
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! ## Build Data Subtypes -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
/--
|
||||
The open type family which maps a module facet's name to its build data
|
||||
in the Lake build store. For example, a transitive × direct import pair
|
||||
for the `lean.imports` facet or an active build target for `lean.c`.
|
||||
|
||||
It is an open type, meaning additional mappings can be add lazily
|
||||
as needed (via `module_data`).
|
||||
-/
|
||||
opaque ModuleData (facet : Name) : Type
|
||||
|
||||
/--
|
||||
The open type family which maps a package facet's name to its build data
|
||||
in the Lake build store. For example, a transitive dependencies of the package
|
||||
for the facet `deps`.
|
||||
|
||||
It is an open type, meaning additional mappings can be add lazily
|
||||
as needed (via `package_data`).
|
||||
-/
|
||||
opaque PackageData (facet : Name) : Type
|
||||
|
||||
/--
|
||||
The open type family which maps a (builtin) Lake target's (e.g., `extern_lib`)
|
||||
facet to its associated build data. For example, an active build target for
|
||||
the `externLib.static` facet.
|
||||
|
||||
It is an open type, meaning additional mappings can be add lazily
|
||||
as needed (via `target_data`).
|
||||
-/
|
||||
opaque TargetData (facet : Name) : Type
|
||||
|
||||
/-
|
||||
The open type family which maps a library facet's name to its build data
|
||||
in the Lake build store. For example, an active build target for the `static`
|
||||
facet.
|
||||
|
||||
It is an open type, meaning additional mappings can be add lazily
|
||||
as needed (via `library_data`).
|
||||
-/
|
||||
abbrev LibraryData (facet : Name) := TargetData (`leanLib ++ facet)
|
||||
|
||||
instance [h : FamilyOut LibraryData facet α] : FamilyDef TargetData (`leanLib ++ facet) α :=
|
||||
⟨by simp [h.family_key_eq_type]⟩
|
||||
|
||||
instance [h : FamilyOut TargetData (`leanLib ++ facet) α] : FamilyDef LibraryData facet α :=
|
||||
⟨h.family_key_eq_type⟩
|
||||
|
||||
/--
|
||||
The open type family which maps a custom target (package × target name) to
|
||||
its build data in the Lake build store.
|
||||
|
||||
It is an open type, meaning additional mappings can be add lazily
|
||||
as needed (via `custom_data`).
|
||||
-/
|
||||
opaque CustomData (target : Name × Name) : Type
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! ## Build Data -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
/--
|
||||
A mapping between a build key and its associated build data in the store.
|
||||
It is a simple type function composed of the separate open type families for
|
||||
modules facets, package facets, Lake target facets, and custom targets.
|
||||
-/
|
||||
abbrev BuildData : BuildKey → Type
|
||||
| .moduleFacet _ f => ModuleData f
|
||||
| .packageFacet _ f => PackageData f
|
||||
| .targetFacet _ _ f => TargetData f
|
||||
| .customTarget p t => CustomData (p, t)
|
||||
|
||||
instance (priority := low) : FamilyDef BuildData (.moduleFacet m f) (ModuleData f) := ⟨rfl⟩
|
||||
instance (priority := low) : FamilyDef BuildData (.packageFacet p f) (PackageData f) := ⟨rfl⟩
|
||||
instance (priority := low) : FamilyDef BuildData (.targetFacet p t f) (TargetData f) := ⟨rfl⟩
|
||||
instance (priority := low) : FamilyDef BuildData (.customTarget p t) (CustomData (p,t)) := ⟨rfl⟩
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! ## Macros for Declaring Build Data -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
/-- Macro for declaring new `PackageData`. -/
|
||||
scoped macro (name := packageDataDecl) doc?:optional(Parser.Command.docComment)
|
||||
"package_data " id:ident " : " ty:term : command => do
|
||||
let dty := mkCIdentFrom (← getRef) ``PackageData
|
||||
let key := Name.quoteFrom id id.getId
|
||||
`($[$doc?]? family_def $id : $dty $key := $ty)
|
||||
|
||||
/-- Macro for declaring new `ModuleData`. -/
|
||||
scoped macro (name := moduleDataDecl) doc?:optional(Parser.Command.docComment)
|
||||
"module_data " id:ident " : " ty:term : command => do
|
||||
let dty := mkCIdentFrom (← getRef) ``ModuleData
|
||||
let key := Name.quoteFrom id id.getId
|
||||
`($[$doc?]? family_def $id : $dty $key := $ty)
|
||||
|
||||
/-- Macro for declaring new `TargetData` for libraries. -/
|
||||
scoped macro (name := libraryDataDecl) doc?:optional(Parser.Command.docComment)
|
||||
"library_data " id:ident " : " ty:term : command => do
|
||||
let dty := mkCIdentFrom (← getRef) ``TargetData
|
||||
let key := Name.quoteFrom id id.getId
|
||||
let id := mkIdentFrom id <| id.getId.modifyBase (`leanLib ++ ·)
|
||||
`($[$doc?]? family_def $id : $dty (`leanLib ++ $key) := $ty)
|
||||
|
||||
/-- Macro for declaring new `TargetData`. -/
|
||||
scoped macro (name := targetDataDecl) doc?:optional(Parser.Command.docComment)
|
||||
"target_data " id:ident " : " ty:term : command => do
|
||||
let dty := mkCIdentFrom (← getRef) ``TargetData
|
||||
let key := Name.quoteFrom id id.getId
|
||||
`($[$doc?]? family_def $id : $dty $key := $ty)
|
||||
|
||||
/-- Macro for declaring new `CustomData`. -/
|
||||
scoped macro (name := customDataDecl) doc?:optional(Parser.Command.docComment)
|
||||
"custom_data " pkg:ident tgt:ident " : " ty:term : command => do
|
||||
let dty := mkCIdentFrom (← getRef) ``CustomData
|
||||
let id := mkIdentFrom tgt (pkg.getId ++ tgt.getId)
|
||||
let pkg := Name.quoteFrom pkg pkg.getId
|
||||
let tgt := Name.quoteFrom pkg tgt.getId
|
||||
`($[$doc?]? family_def $id : $dty ($pkg, $tgt) := $ty)
|
||||
34
src/lake/Lake/Build/Executable.lean
Normal file
34
src/lake/Lake/Build/Executable.lean
Normal file
@@ -0,0 +1,34 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Build.Common
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-- Get the Lean executable in the workspace with the configuration's name. -/
|
||||
@[inline] def LeanExeConfig.get (self : LeanExeConfig)
|
||||
[Monad m] [MonadError m] [MonadLake m] : m LeanExe := do
|
||||
let some exe ← findLeanExe? self.name
|
||||
| error "Lean executable '{self.name}' does not exist in the workspace"
|
||||
return exe
|
||||
|
||||
|
||||
/-- Fetch the build of the Lean executable. -/
|
||||
@[inline] def LeanExeConfig.fetch
|
||||
(self : LeanExeConfig) : IndexBuildM (BuildJob FilePath) := do
|
||||
(← self.get).exe.fetch
|
||||
|
||||
/-! # Build Executable -/
|
||||
|
||||
protected def LeanExe.recBuildExe
|
||||
(self : LeanExe) : IndexBuildM (BuildJob FilePath) := do
|
||||
let imports ← self.root.transImports.fetch
|
||||
let mut linkJobs := #[← self.root.o.fetch]
|
||||
for mod in imports do for facet in mod.nativeFacets do
|
||||
linkJobs := linkJobs.push <| ← fetch <| mod.facet facet.name
|
||||
let deps := (← fetch <| self.pkg.facet `deps).push self.pkg
|
||||
for dep in deps do for lib in dep.externLibs do
|
||||
linkJobs := linkJobs.push <| ← lib.static.fetch
|
||||
buildLeanExe self.file linkJobs self.linkArgs
|
||||
126
src/lake/Lake/Build/Facets.lean
Normal file
126
src/lake/Lake/Build/Facets.lean
Normal file
@@ -0,0 +1,126 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Build.Job
|
||||
import Lake.Build.Data
|
||||
|
||||
/-!
|
||||
# Simple Builtin Facet Declarations
|
||||
|
||||
This module contains the definitions of most of the builtin facets.
|
||||
The others are defined `Build.Info`. The facets there require configuration
|
||||
definitions (e.g., `Module`), and some of the facets here are used in said
|
||||
definitions.
|
||||
-/
|
||||
|
||||
namespace Lake
|
||||
export System (SearchPath FilePath)
|
||||
|
||||
/-- A dynamic/shared library for linking. -/
|
||||
structure Dynlib where
|
||||
/-- Library file path. -/
|
||||
path : FilePath
|
||||
/-- Library name without platform-specific prefix/suffix (for `-l`). -/
|
||||
name : String
|
||||
|
||||
/-- Optional library directory (for `-L`). -/
|
||||
def Dynlib.dir? (self : Dynlib) : Option FilePath :=
|
||||
self.path.parent
|
||||
|
||||
/-! ## Module Facets -/
|
||||
|
||||
/-- A module facet name along with proof of its data type. -/
|
||||
structure ModuleFacet (α) where
|
||||
/-- The name of the module facet. -/
|
||||
name : Name
|
||||
/-- Proof that module's facet build result is of type α. -/
|
||||
data_eq : ModuleData name = α
|
||||
deriving Repr
|
||||
|
||||
instance (facet : ModuleFacet α) : FamilyDef ModuleData facet.name α :=
|
||||
⟨facet.data_eq⟩
|
||||
|
||||
instance [FamilyOut ModuleData facet α] : CoeDep Name facet (ModuleFacet α) :=
|
||||
⟨facet, FamilyOut.family_key_eq_type⟩
|
||||
|
||||
/--
|
||||
The facet which builds all of a module's dependencies
|
||||
(i.e., transitive local imports and `--load-dynlib` shared libraries).
|
||||
Returns the list of shared libraries to load along with their search path.
|
||||
-/
|
||||
abbrev Module.depsFacet := `deps
|
||||
module_data deps : BuildJob (SearchPath × Array FilePath)
|
||||
|
||||
/--
|
||||
The core compilation / elaboration of the Lean file via `lean`,
|
||||
which produce the Lean binaries of the module (i.e., `olean`, `ilean`, `c`).
|
||||
Its trace just includes its dependencies.
|
||||
-/
|
||||
abbrev Module.leanBinFacet := `bin
|
||||
module_data bin : BuildJob Unit
|
||||
|
||||
/--
|
||||
The `leanBinFacet` combined with the module's trace
|
||||
(i.e., the trace of its `olean` and `ilean`).
|
||||
It is the facet used for building a Lean import of a module.
|
||||
-/
|
||||
abbrev Module.importBinFacet := `importBin
|
||||
module_data importBin : BuildJob Unit
|
||||
|
||||
/-- The `olean` file produced by `lean` -/
|
||||
abbrev Module.oleanFacet := `olean
|
||||
module_data olean : BuildJob FilePath
|
||||
|
||||
/-- The `ilean` file produced by `lean` -/
|
||||
abbrev Module.ileanFacet := `ilean
|
||||
module_data ilean : BuildJob FilePath
|
||||
|
||||
/-- The C file built from the Lean file via `lean` -/
|
||||
abbrev Module.cFacet := `c
|
||||
module_data c : BuildJob FilePath
|
||||
|
||||
/-- The object file built from `lean.c` -/
|
||||
abbrev Module.oFacet := `o
|
||||
module_data o : BuildJob FilePath
|
||||
|
||||
/-! ## Package Facets -/
|
||||
|
||||
/-- The package's cloud build release. -/
|
||||
abbrev Package.releaseFacet := `release
|
||||
package_data release : BuildJob Unit
|
||||
|
||||
/-- The package's `extraDepTarget` mixed with its transitive dependencies'. -/
|
||||
abbrev Package.extraDepFacet := `extraDep
|
||||
package_data extraDep : BuildJob Unit
|
||||
|
||||
/-! ## Target Facets -/
|
||||
|
||||
/-- A Lean library's Lean libraries. -/
|
||||
abbrev LeanLib.leanFacet := `lean
|
||||
library_data lean : BuildJob Unit
|
||||
|
||||
/-- A Lean library's static binary. -/
|
||||
abbrev LeanLib.staticFacet := `static
|
||||
library_data static : BuildJob FilePath
|
||||
|
||||
/-- A Lean library's shared binary. -/
|
||||
abbrev LeanLib.sharedFacet := `shared
|
||||
library_data shared : BuildJob FilePath
|
||||
|
||||
/-- A Lean binary executable. -/
|
||||
abbrev LeanExe.exeFacet := `leanExe
|
||||
target_data leanExe : BuildJob FilePath
|
||||
|
||||
/-- A external library's static binary. -/
|
||||
abbrev ExternLib.staticFacet := `externLib.static
|
||||
target_data externLib.static : BuildJob FilePath
|
||||
|
||||
/-- A external library's shared binary. -/
|
||||
abbrev ExternLib.sharedFacet := `externLib.shared
|
||||
target_data externLib.shared : BuildJob FilePath
|
||||
|
||||
/-- A external library's dynlib. -/
|
||||
abbrev ExternLib.dynlibFacet := `externLib.dynlib
|
||||
target_data externLib.dynlib : BuildJob Dynlib
|
||||
70
src/lake/Lake/Build/Imports.lean
Normal file
70
src/lake/Lake/Build/Imports.lean
Normal file
@@ -0,0 +1,70 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Build.Index
|
||||
|
||||
/-!
|
||||
Definitions to support `lake print-paths` builds.
|
||||
-/
|
||||
|
||||
open System
|
||||
namespace Lake
|
||||
|
||||
/--
|
||||
Construct an `Array` of `Module`s for the workspace-local modules of
|
||||
a `List` of import strings.
|
||||
-/
|
||||
def Workspace.processImportList
|
||||
(imports : List String) (self : Workspace) : Array Module := Id.run do
|
||||
let mut localImports := #[]
|
||||
for imp in imports do
|
||||
if let some mod := self.findModule? imp.toName then
|
||||
localImports := localImports.push mod
|
||||
return localImports
|
||||
|
||||
/--
|
||||
Recursively build a set of imported modules and return their build jobs,
|
||||
the build jobs of their precompiled modules and the build jobs of said modules'
|
||||
external libraries.
|
||||
-/
|
||||
def recBuildImports (imports : Array Module)
|
||||
: IndexBuildM (Array (BuildJob Unit) × Array (BuildJob Dynlib) × Array (BuildJob Dynlib)) := do
|
||||
let mut modJobs := #[]
|
||||
let mut precompileImports := OrdModuleSet.empty
|
||||
for mod in imports do
|
||||
if mod.shouldPrecompile then
|
||||
precompileImports := precompileImports.appendArray (← mod.transImports.fetch) |>.insert mod
|
||||
else
|
||||
precompileImports := precompileImports.appendArray (← mod.precompileImports.fetch)
|
||||
modJobs := modJobs.push <| ← mod.leanBin.fetch
|
||||
let pkgs := precompileImports.foldl (·.insert ·.pkg) OrdPackageSet.empty |>.toArray
|
||||
let externJobs ← pkgs.concatMapM (·.externLibs.mapM (·.dynlib.fetch))
|
||||
let precompileJobs ← precompileImports.toArray.mapM (·.dynlib.fetch)
|
||||
return (modJobs, precompileJobs, externJobs)
|
||||
|
||||
/--
|
||||
Builds the workspace-local modules of list of imports.
|
||||
Used by `lake print-paths` to build modules for the Lean server.
|
||||
Returns the set of module dynlibs built (so they can be loaded by the server).
|
||||
|
||||
Builds only module `.olean` and `.ilean` files if the package is configured
|
||||
as "Lean-only". Otherwise, also builds `.c` files.
|
||||
-/
|
||||
def buildImportsAndDeps (imports : List String) : BuildM (Array FilePath) := do
|
||||
let ws ← getWorkspace
|
||||
if imports.isEmpty then
|
||||
-- build the package's (and its dependencies') `extraDepTarget`
|
||||
ws.root.extraDep.build >>= (·.materialize)
|
||||
return #[]
|
||||
else
|
||||
-- build local imports from list
|
||||
let mods := ws.processImportList imports
|
||||
let (modJobs, precompileJobs, externLibJobs) ←
|
||||
recBuildImports mods |>.run.run
|
||||
modJobs.forM (·.await)
|
||||
let modLibs ← precompileJobs.mapM (·.await <&> (·.path))
|
||||
let externLibs ← externLibJobs.mapM (·.await <&> (·.path))
|
||||
-- NOTE: Lean wants the external library symbols before module symbols
|
||||
return externLibs ++ modLibs
|
||||
108
src/lake/Lake/Build/Index.lean
Normal file
108
src/lake/Lake/Build/Index.lean
Normal file
@@ -0,0 +1,108 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Build.Executable
|
||||
import Lake.Build.Topological
|
||||
|
||||
/-!
|
||||
# The Lake Build Index
|
||||
|
||||
The Lake build index is the complete map of Lake build keys to
|
||||
Lake build functions, which is used by Lake to build any Lake build info.
|
||||
|
||||
This module leverages the index to perform topologically-based recursive builds.
|
||||
-/
|
||||
|
||||
open Lean
|
||||
namespace Lake
|
||||
|
||||
/--
|
||||
Converts a conveniently typed target facet build function into its
|
||||
dynamically typed equivalent.
|
||||
-/
|
||||
@[macro_inline] def mkTargetFacetBuild (facet : Name) (build : IndexBuildM α)
|
||||
[h : FamilyOut TargetData facet α] : IndexBuildM (TargetData facet) :=
|
||||
cast (by rw [← h.family_key_eq_type]) build
|
||||
|
||||
def ExternLib.recBuildStatic (lib : ExternLib) : IndexBuildM (BuildJob FilePath) := do
|
||||
lib.config.getJob <$> fetch (lib.pkg.target lib.staticTargetName)
|
||||
|
||||
def ExternLib.recBuildShared (lib : ExternLib) : IndexBuildM (BuildJob FilePath) := do
|
||||
buildLeanSharedLibOfStatic (← lib.static.fetch) lib.linkArgs
|
||||
|
||||
def ExternLib.recComputeDynlib (lib : ExternLib) : IndexBuildM (BuildJob Dynlib) := do
|
||||
computeDynlibOfShared (← lib.shared.fetch)
|
||||
|
||||
/-!
|
||||
## Topologically-based Recursive Build Using the Index
|
||||
-/
|
||||
|
||||
/-- Recursive build function for anything in the Lake build index. -/
|
||||
def recBuildWithIndex : (info : BuildInfo) → IndexBuildM (BuildData info.key)
|
||||
| .moduleFacet mod facet => do
|
||||
if let some config := (← getWorkspace).findModuleFacetConfig? facet then
|
||||
config.build mod
|
||||
else
|
||||
error s!"do not know how to build module facet `{facet}`"
|
||||
| .packageFacet pkg facet => do
|
||||
if let some config := (← getWorkspace).findPackageFacetConfig? facet then
|
||||
config.build pkg
|
||||
else
|
||||
error s!"do not know how to build package facet `{facet}`"
|
||||
| .target pkg target =>
|
||||
if let some config := pkg.findTargetConfig? target then
|
||||
config.build pkg
|
||||
else
|
||||
error s!"could not build `{target}` of `{pkg.name}` -- target not found"
|
||||
| .libraryFacet lib facet => do
|
||||
if let some config := (← getWorkspace).findLibraryFacetConfig? facet then
|
||||
config.build lib
|
||||
else
|
||||
error s!"do not know how to build library facet `{facet}`"
|
||||
| .leanExe exe =>
|
||||
mkTargetFacetBuild LeanExe.exeFacet exe.recBuildExe
|
||||
| .staticExternLib lib =>
|
||||
mkTargetFacetBuild ExternLib.staticFacet lib.recBuildStatic
|
||||
| .sharedExternLib lib =>
|
||||
mkTargetFacetBuild ExternLib.sharedFacet lib.recBuildShared
|
||||
| .dynlibExternLib lib =>
|
||||
mkTargetFacetBuild ExternLib.dynlibFacet lib.recComputeDynlib
|
||||
|
||||
/--
|
||||
Run the given recursive build using the Lake build index
|
||||
and a topological / suspending scheduler.
|
||||
-/
|
||||
def IndexBuildM.run (build : IndexBuildM α) : RecBuildM α :=
|
||||
build <| recFetchMemoize BuildInfo.key recBuildWithIndex
|
||||
|
||||
/--
|
||||
Recursively build the given info using the Lake build index
|
||||
and a topological / suspending scheduler.
|
||||
-/
|
||||
def buildIndexTop' (info : BuildInfo) : RecBuildM (BuildData info.key) :=
|
||||
recFetchMemoize BuildInfo.key recBuildWithIndex info
|
||||
|
||||
/--
|
||||
Recursively build the given info using the Lake build index
|
||||
and a topological / suspending scheduler and return the dynamic result.
|
||||
-/
|
||||
@[macro_inline] def buildIndexTop (info : BuildInfo)
|
||||
[FamilyOut BuildData info.key α] : RecBuildM α := do
|
||||
cast (by simp) <| buildIndexTop' info
|
||||
|
||||
/-- Build the given Lake target in a fresh build store. -/
|
||||
@[inline] def BuildInfo.build
|
||||
(self : BuildInfo) [FamilyOut BuildData self.key α] : BuildM α :=
|
||||
buildIndexTop self |>.run
|
||||
|
||||
export BuildInfo (build)
|
||||
|
||||
/-! ### Lean Executable Builds -/
|
||||
|
||||
@[inline] protected def LeanExe.build (self : LeanExe) : BuildM (BuildJob FilePath) :=
|
||||
self.exe.build
|
||||
|
||||
@[inline] protected def LeanExe.fetch (self : LeanExe) : IndexBuildM (BuildJob FilePath) :=
|
||||
self.exe.fetch
|
||||
269
src/lake/Lake/Build/Info.lean
Normal file
269
src/lake/Lake/Build/Info.lean
Normal file
@@ -0,0 +1,269 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Config.LeanExe
|
||||
import Lake.Config.ExternLib
|
||||
import Lake.Build.Facets
|
||||
import Lake.Util.EquipT
|
||||
|
||||
/-!
|
||||
# Build Info
|
||||
|
||||
This module defines the Lake build info type and related utilities.
|
||||
Build info is what is the data passed to a Lake build function to facilitate
|
||||
the build.
|
||||
-/
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-- The type of Lake's build info. -/
|
||||
inductive BuildInfo
|
||||
| moduleFacet (module : Module) (facet : Name)
|
||||
| packageFacet (package : Package) (facet : Name)
|
||||
| libraryFacet (lib : LeanLib) (facet : Name)
|
||||
| leanExe (exe : LeanExe)
|
||||
| staticExternLib (lib : ExternLib)
|
||||
| sharedExternLib (lib : ExternLib)
|
||||
| dynlibExternLib (lib : ExternLib)
|
||||
| target (package : Package) (target : Name)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! ## Build Info & Keys -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
/-! ### Build Key Helper Constructors -/
|
||||
|
||||
abbrev Module.facetBuildKey (facet : Name) (self : Module) : BuildKey :=
|
||||
.moduleFacet self.keyName facet
|
||||
|
||||
abbrev Package.facetBuildKey (facet : Name) (self : Package) : BuildKey :=
|
||||
.packageFacet self.name facet
|
||||
|
||||
abbrev Package.targetBuildKey (target : Name) (self : Package) : BuildKey :=
|
||||
.customTarget self.name target
|
||||
|
||||
abbrev LeanLib.facetBuildKey (self : LeanLib) (facet : Name) : BuildKey :=
|
||||
.targetFacet self.pkg.name self.name (`leanLib ++ facet)
|
||||
|
||||
abbrev LeanExe.buildKey (self : LeanExe) : BuildKey :=
|
||||
.targetFacet self.pkg.name self.name exeFacet
|
||||
|
||||
abbrev ExternLib.staticBuildKey (self : ExternLib) : BuildKey :=
|
||||
.targetFacet self.pkg.name self.name staticFacet
|
||||
|
||||
abbrev ExternLib.sharedBuildKey (self : ExternLib) : BuildKey :=
|
||||
.targetFacet self.pkg.name self.name sharedFacet
|
||||
|
||||
abbrev ExternLib.dynlibBuildKey (self : ExternLib) : BuildKey :=
|
||||
.targetFacet self.pkg.name self.name dynlibFacet
|
||||
|
||||
/-! ### Build Info to Key -/
|
||||
|
||||
/-- The key that identifies the build in the Lake build store. -/
|
||||
abbrev BuildInfo.key : (self : BuildInfo) → BuildKey
|
||||
| moduleFacet m f => m.facetBuildKey f
|
||||
| packageFacet p f => p.facetBuildKey f
|
||||
| libraryFacet l f => l.facetBuildKey f
|
||||
| leanExe x => x.buildKey
|
||||
| staticExternLib l => l.staticBuildKey
|
||||
| sharedExternLib l => l.sharedBuildKey
|
||||
| dynlibExternLib l => l.dynlibBuildKey
|
||||
| target p t => p.targetBuildKey t
|
||||
|
||||
/-! ### Instances for deducing data types of `BuildInfo` keys -/
|
||||
|
||||
instance [FamilyOut ModuleData f α]
|
||||
: FamilyDef BuildData (BuildInfo.key (.moduleFacet m f)) α where
|
||||
family_key_eq_type := by unfold BuildData; simp
|
||||
|
||||
instance [FamilyOut PackageData f α]
|
||||
: FamilyDef BuildData (BuildInfo.key (.packageFacet p f)) α where
|
||||
family_key_eq_type := by unfold BuildData; simp
|
||||
|
||||
instance (priority := low) {p : NPackage n} : FamilyDef BuildData
|
||||
(.customTarget p.toPackage.name t) (CustomData (n,t)) := ⟨by simp⟩
|
||||
|
||||
instance {p : NPackage n} [FamilyOut CustomData (n, t) α]
|
||||
: FamilyDef BuildData (BuildInfo.key (.target p.toPackage t)) α where
|
||||
family_key_eq_type := by unfold BuildData; simp
|
||||
|
||||
instance [FamilyOut TargetData (`leanLib ++ f) α]
|
||||
: FamilyDef BuildData (BuildInfo.key (.libraryFacet l f)) α where
|
||||
family_key_eq_type := by unfold BuildData; simp
|
||||
|
||||
instance [FamilyOut TargetData LeanExe.exeFacet α]
|
||||
: FamilyDef BuildData (BuildInfo.key (.leanExe x)) α where
|
||||
family_key_eq_type := by unfold BuildData; simp
|
||||
|
||||
instance [FamilyOut TargetData ExternLib.staticFacet α]
|
||||
: FamilyDef BuildData (BuildInfo.key (.staticExternLib l)) α where
|
||||
family_key_eq_type := by unfold BuildData; simp
|
||||
|
||||
instance [FamilyOut TargetData ExternLib.sharedFacet α]
|
||||
: FamilyDef BuildData (BuildInfo.key (.sharedExternLib l)) α where
|
||||
family_key_eq_type := by unfold BuildData; simp
|
||||
|
||||
instance [FamilyOut TargetData ExternLib.dynlibFacet α]
|
||||
: FamilyDef BuildData (BuildInfo.key (.dynlibExternLib l)) α where
|
||||
family_key_eq_type := by unfold BuildData; simp
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! ## Recursive Building -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
/-- A build function for any element of the Lake build index. -/
|
||||
abbrev IndexBuildFn (m : Type → Type v) :=
|
||||
-- `DBuildFn BuildInfo (BuildData ·.key) m` with less imports
|
||||
(info : BuildInfo) → m (BuildData info.key)
|
||||
|
||||
/-- A transformer to equip a monad with a build function for the Lake index. -/
|
||||
abbrev IndexT (m : Type → Type v) := EquipT (IndexBuildFn m) m
|
||||
|
||||
/-- The monad for build functions that are part of the index. -/
|
||||
abbrev IndexBuildM := IndexT RecBuildM
|
||||
|
||||
/-- Fetch the result associated with the info using the Lake build index. -/
|
||||
@[inline] def BuildInfo.fetch (self : BuildInfo) [FamilyOut BuildData self.key α] : IndexBuildM α :=
|
||||
fun build => cast (by simp) <| build self
|
||||
|
||||
export BuildInfo (fetch)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! ## Build Info & Facets -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
/-!
|
||||
### Complex Builtin Facet Declarations
|
||||
|
||||
Additional builtin facets missing from `Build.Facets`.
|
||||
These are defined here because they need configuration definitions
|
||||
(e.g., `Module`), whereas the facets there are needed by the configuration
|
||||
definitions.
|
||||
-/
|
||||
|
||||
/-- The direct local imports of the Lean module. -/
|
||||
abbrev Module.importsFacet := `lean.imports
|
||||
module_data lean.imports : Array Module
|
||||
|
||||
/-- The transitive local imports of the Lean module. -/
|
||||
abbrev Module.transImportsFacet := `lean.transImports
|
||||
module_data lean.transImports : Array Module
|
||||
|
||||
/-- The transitive local imports of the Lean module. -/
|
||||
abbrev Module.precompileImportsFacet := `lean.precompileImports
|
||||
module_data lean.precompileImports : Array Module
|
||||
|
||||
/-- Shared library for `--load-dynlib`. -/
|
||||
abbrev Module.dynlibFacet := `dynlib
|
||||
module_data dynlib : BuildJob Dynlib
|
||||
|
||||
/-- A Lean library's Lean modules. -/
|
||||
abbrev LeanLib.modulesFacet := `modules
|
||||
library_data modules : Array Module
|
||||
|
||||
/-- The package's complete array of transitive dependencies. -/
|
||||
abbrev Package.depsFacet := `deps
|
||||
package_data deps : Array Package
|
||||
|
||||
|
||||
/-!
|
||||
### Facet Build Info Helper Constructors
|
||||
|
||||
Definitions to easily construct `BuildInfo` values for module, package,
|
||||
and target facets.
|
||||
-/
|
||||
|
||||
namespace Module
|
||||
|
||||
/-- Build info for the module's specified facet. -/
|
||||
abbrev facet (facet : Name) (self : Module) : BuildInfo :=
|
||||
.moduleFacet self facet
|
||||
|
||||
@[inherit_doc importsFacet] abbrev imports (self : Module) :=
|
||||
self.facet importsFacet
|
||||
|
||||
@[inherit_doc transImportsFacet] abbrev transImports (self : Module) :=
|
||||
self.facet transImportsFacet
|
||||
|
||||
@[inherit_doc precompileImportsFacet] abbrev precompileImports (self : Module) :=
|
||||
self.facet precompileImportsFacet
|
||||
|
||||
@[inherit_doc depsFacet] abbrev deps (self : Module) :=
|
||||
self.facet depsFacet
|
||||
|
||||
@[inherit_doc leanBinFacet] abbrev leanBin (self : Module) :=
|
||||
self.facet leanBinFacet
|
||||
|
||||
@[inherit_doc importBinFacet] abbrev importBin (self : Module) :=
|
||||
self.facet importBinFacet
|
||||
|
||||
@[inherit_doc oleanFacet] abbrev olean (self : Module) :=
|
||||
self.facet oleanFacet
|
||||
|
||||
@[inherit_doc ileanFacet] abbrev ilean (self : Module) :=
|
||||
self.facet ileanFacet
|
||||
|
||||
@[inherit_doc cFacet] abbrev c (self : Module) :=
|
||||
self.facet cFacet
|
||||
|
||||
@[inherit_doc oFacet] abbrev o (self : Module) :=
|
||||
self.facet oFacet
|
||||
|
||||
@[inherit_doc dynlibFacet] abbrev dynlib (self : Module) :=
|
||||
self.facet dynlibFacet
|
||||
|
||||
end Module
|
||||
|
||||
/-- Build info for the package's specified facet. -/
|
||||
abbrev Package.facet (facet : Name) (self : Package) : BuildInfo :=
|
||||
.packageFacet self facet
|
||||
|
||||
@[inherit_doc releaseFacet]
|
||||
abbrev Package.release (self : Package) : BuildInfo :=
|
||||
self.facet releaseFacet
|
||||
|
||||
@[inherit_doc extraDepFacet]
|
||||
abbrev Package.extraDep (self : Package) : BuildInfo :=
|
||||
self.facet extraDepFacet
|
||||
|
||||
/-- Build info for a custom package target. -/
|
||||
abbrev Package.target (target : Name) (self : Package) : BuildInfo :=
|
||||
.target self target
|
||||
|
||||
/-- Build info of the Lean library's Lean binaries. -/
|
||||
abbrev LeanLib.facet (self : LeanLib) (facet : Name) : BuildInfo :=
|
||||
.libraryFacet self facet
|
||||
|
||||
@[inherit_doc modulesFacet]
|
||||
abbrev LeanLib.modules (self : LeanLib) : BuildInfo :=
|
||||
self.facet modulesFacet
|
||||
|
||||
@[inherit_doc leanFacet]
|
||||
abbrev LeanLib.lean (self : LeanLib) : BuildInfo :=
|
||||
self.facet leanFacet
|
||||
|
||||
@[inherit_doc staticFacet]
|
||||
abbrev LeanLib.static (self : LeanLib) : BuildInfo :=
|
||||
self.facet staticFacet
|
||||
|
||||
@[inherit_doc sharedFacet]
|
||||
abbrev LeanLib.shared (self : LeanLib) : BuildInfo :=
|
||||
self.facet sharedFacet
|
||||
|
||||
/-- Build info of the Lean executable. -/
|
||||
abbrev LeanExe.exe (self : LeanExe) : BuildInfo :=
|
||||
.leanExe self
|
||||
|
||||
/-- Build info of the external library's static binary. -/
|
||||
abbrev ExternLib.static (self : ExternLib) : BuildInfo :=
|
||||
.staticExternLib self
|
||||
|
||||
/-- Build info of the external library's shared binary. -/
|
||||
abbrev ExternLib.shared (self : ExternLib) : BuildInfo :=
|
||||
.sharedExternLib self
|
||||
|
||||
/-- Build info of the external library's dynlib. -/
|
||||
abbrev ExternLib.dynlib (self : ExternLib) : BuildInfo :=
|
||||
.dynlibExternLib self
|
||||
112
src/lake/Lake/Build/Job.lean
Normal file
112
src/lake/Lake/Build/Job.lean
Normal file
@@ -0,0 +1,112 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Util.Async
|
||||
import Lake.Build.Trace
|
||||
import Lake.Build.Context
|
||||
|
||||
open System
|
||||
namespace Lake
|
||||
|
||||
/-- A Lake job. -/
|
||||
abbrev Job α := OptionIOTask α
|
||||
|
||||
/-- The monad of Lake jobs. -/
|
||||
abbrev JobM := BuildM
|
||||
|
||||
/-- The monad of a finished Lake job. -/
|
||||
abbrev ResultM := OptionIO
|
||||
|
||||
namespace Job
|
||||
|
||||
@[inline] def nil : Job Unit :=
|
||||
pure ()
|
||||
|
||||
@[inline] protected def async (act : JobM α) : SchedulerM (Job α) :=
|
||||
async act
|
||||
|
||||
@[inline] protected def await (self : Job α) : ResultM α :=
|
||||
await self
|
||||
|
||||
@[inline] protected def bindSync
|
||||
(self : Job α) (f : α → JobM β) (prio := Task.Priority.default) : SchedulerM (Job β) :=
|
||||
bindSync prio self f
|
||||
|
||||
@[inline] protected def bindAsync
|
||||
(self : Job α) (f : α → SchedulerM (Job β)) : SchedulerM (Job β) :=
|
||||
bindAsync self f
|
||||
|
||||
end Job
|
||||
|
||||
/-- A Lake build job. -/
|
||||
abbrev BuildJob α := Job (α × BuildTrace)
|
||||
|
||||
namespace BuildJob
|
||||
|
||||
@[inline] def mk (job : Job (α × BuildTrace)) : BuildJob α :=
|
||||
job
|
||||
|
||||
@[inline] def ofJob (self : Job BuildTrace) : BuildJob Unit :=
|
||||
mk <| ((), ·) <$> self
|
||||
|
||||
@[inline] def toJob (self : BuildJob α) : Job (α × BuildTrace) :=
|
||||
self
|
||||
|
||||
@[inline] def nil : BuildJob Unit :=
|
||||
mk <| pure ((), nilTrace)
|
||||
|
||||
@[inline] protected def pure (a : α) : BuildJob α :=
|
||||
mk <| pure (a, nilTrace)
|
||||
|
||||
instance : Pure BuildJob := ⟨BuildJob.pure⟩
|
||||
|
||||
@[inline] protected def map (f : α → β) (self : BuildJob α) : BuildJob β :=
|
||||
mk <| (fun (a,t) => (f a,t)) <$> self.toJob
|
||||
|
||||
instance : Functor BuildJob where
|
||||
map := BuildJob.map
|
||||
|
||||
@[inline] def mapWithTrace (f : α → BuildTrace → β × BuildTrace) (self : BuildJob α) : BuildJob β :=
|
||||
mk <| (fun (a,t) => f a t) <$> self.toJob
|
||||
|
||||
@[inline] protected def bindSync
|
||||
(self : BuildJob α) (f : α → BuildTrace → JobM β)
|
||||
(prio : Task.Priority := .default) : SchedulerM (Job β) :=
|
||||
self.toJob.bindSync (prio := prio) fun (a, t) => f a t
|
||||
|
||||
@[inline] protected def bindAsync
|
||||
(self : BuildJob α) (f : α → BuildTrace → SchedulerM (Job β)) : SchedulerM (Job β) :=
|
||||
self.toJob.bindAsync fun (a, t) => f a t
|
||||
|
||||
@[inline] protected def await (self : BuildJob α) : ResultM α :=
|
||||
(·.1) <$> await self.toJob
|
||||
|
||||
instance : Await BuildJob ResultM := ⟨BuildJob.await⟩
|
||||
|
||||
@[inline] def materialize (self : BuildJob α) : ResultM Unit :=
|
||||
discard <| await self.toJob
|
||||
|
||||
def mix (t1 : BuildJob α) (t2 : BuildJob β) : BaseIO (BuildJob Unit) :=
|
||||
mk <$> seqWithAsync (fun (_,t) (_,t') => ((), mixTrace t t')) t1.toJob t2.toJob
|
||||
|
||||
def mixList (jobs : List (BuildJob α)) : BaseIO (BuildJob Unit) := ofJob <$> do
|
||||
jobs.foldrM (init := pure nilTrace) fun j a =>
|
||||
seqWithAsync (fun (_,t') t => mixTrace t t') j.toJob a
|
||||
|
||||
def mixArray (jobs : Array (BuildJob α)) : BaseIO (BuildJob Unit) := ofJob <$> do
|
||||
jobs.foldlM (init := pure nilTrace) fun a j =>
|
||||
seqWithAsync (fun t (_,t') => mixTrace t t') a j.toJob
|
||||
|
||||
protected def seqWithAsync
|
||||
(f : α → β → γ) (t1 : BuildJob α) (t2 : BuildJob β) : BaseIO (BuildJob γ) :=
|
||||
mk <$> seqWithAsync (fun (a,t) (b,t') => (f a b, mixTrace t t')) t1.toJob t2.toJob
|
||||
|
||||
instance : SeqWithAsync BaseIO BuildJob := ⟨BuildJob.seqWithAsync⟩
|
||||
|
||||
def collectList (jobs : List (BuildJob α)) : BaseIO (BuildJob (List α)) :=
|
||||
jobs.foldrM (seqWithAsync List.cons) (pure [])
|
||||
|
||||
def collectArray (jobs : Array (BuildJob α)) : BaseIO (BuildJob (Array α)) :=
|
||||
jobs.foldlM (seqWithAsync Array.push) (pure #[])
|
||||
104
src/lake/Lake/Build/Key.lean
Normal file
104
src/lake/Lake/Build/Key.lean
Normal file
@@ -0,0 +1,104 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Util.Name
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-- The type of keys in the Lake build store. -/
|
||||
inductive BuildKey
|
||||
| moduleFacet (module : Name) (facet : Name)
|
||||
| packageFacet (package : Name) (facet : Name)
|
||||
| targetFacet (package : Name) (target : Name) (facet : Name)
|
||||
| customTarget (package : Name) (target : Name)
|
||||
deriving Inhabited, Repr, DecidableEq, Hashable
|
||||
|
||||
namespace BuildKey
|
||||
|
||||
def toString : (self : BuildKey) → String
|
||||
| moduleFacet m f => s!"+{m}:{f}"
|
||||
| packageFacet p f => s!"@{p}:{f}"
|
||||
| targetFacet p t f => s!"{p}/{t}:{f}"
|
||||
| customTarget p t => s!"{p}/{t}"
|
||||
|
||||
instance : ToString BuildKey := ⟨(·.toString)⟩
|
||||
|
||||
def quickCmp (k k' : BuildKey) : Ordering :=
|
||||
match k with
|
||||
| moduleFacet m f =>
|
||||
match k' with
|
||||
| moduleFacet m' f' =>
|
||||
match m.quickCmp m' with
|
||||
| .eq => f.quickCmp f'
|
||||
| ord => ord
|
||||
| _ => .lt
|
||||
| packageFacet p f =>
|
||||
match k' with
|
||||
| moduleFacet .. => .gt
|
||||
| packageFacet p' f' =>
|
||||
match p.quickCmp p' with
|
||||
| .eq => f.quickCmp f'
|
||||
| ord => ord
|
||||
| _ => .lt
|
||||
| targetFacet p t f =>
|
||||
match k' with
|
||||
| customTarget .. => .lt
|
||||
| targetFacet p' t' f' =>
|
||||
match p.quickCmp p' with
|
||||
| .eq =>
|
||||
match t.quickCmp t' with
|
||||
| .eq => f.quickCmp f'
|
||||
| ord => ord
|
||||
| ord => ord
|
||||
| _=> .gt
|
||||
| customTarget p t =>
|
||||
match k' with
|
||||
| customTarget p' t' =>
|
||||
match p.quickCmp p' with
|
||||
| .eq => t.quickCmp t'
|
||||
| ord => ord
|
||||
| _ => .gt
|
||||
|
||||
theorem eq_of_quickCmp {k k' : BuildKey} :
|
||||
quickCmp k k' = Ordering.eq → k = k' := by
|
||||
unfold quickCmp
|
||||
cases k with
|
||||
| moduleFacet m f =>
|
||||
cases k'
|
||||
case moduleFacet m' f' =>
|
||||
dsimp only; split
|
||||
next m_eq => intro f_eq; rw [eq_of_cmp m_eq, eq_of_cmp f_eq]
|
||||
next => intro; contradiction
|
||||
all_goals (intro; contradiction)
|
||||
| packageFacet p f =>
|
||||
cases k'
|
||||
case packageFacet p' f' =>
|
||||
dsimp only; split
|
||||
next p_eq => intro f_eq; rw [eq_of_cmp p_eq, eq_of_cmp f_eq]
|
||||
next => intro; contradiction
|
||||
all_goals (intro; contradiction)
|
||||
| targetFacet p t f =>
|
||||
cases k'
|
||||
case targetFacet p' t' f' =>
|
||||
dsimp only; split
|
||||
next p_eq =>
|
||||
split
|
||||
next t_eq =>
|
||||
intro f_eq
|
||||
rw [eq_of_cmp p_eq, eq_of_cmp t_eq, eq_of_cmp f_eq]
|
||||
next => intro; contradiction
|
||||
next => intro; contradiction
|
||||
all_goals (intro; contradiction)
|
||||
| customTarget p t =>
|
||||
cases k'
|
||||
case customTarget p' t' =>
|
||||
dsimp only; split
|
||||
next p_eq => intro t_eq; rw [eq_of_cmp p_eq, eq_of_cmp t_eq]
|
||||
next => intro; contradiction
|
||||
all_goals (intro; contradiction)
|
||||
|
||||
instance : LawfulCmpEq BuildKey quickCmp where
|
||||
eq_of_cmp := eq_of_quickCmp
|
||||
cmp_rfl {k} := by cases k <;> simp [quickCmp]
|
||||
111
src/lake/Lake/Build/Library.lean
Normal file
111
src/lake/Lake/Build/Library.lean
Normal file
@@ -0,0 +1,111 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Build.Common
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-- Get the Lean library in the workspace with the configuration's name. -/
|
||||
@[inline] def LeanLibConfig.get (self : LeanLibConfig)
|
||||
[Monad m] [MonadError m] [MonadLake m] : m LeanLib := do
|
||||
let some lib ← findLeanLib? self.name
|
||||
| error "Lean library '{self.name}' does not exist in the workspace"
|
||||
return lib
|
||||
|
||||
/-- Fetch the build result of a library facet. -/
|
||||
@[inline] protected def LibraryFacetDecl.fetch (lib : LeanLib)
|
||||
(self : LibraryFacetDecl) [FamilyOut LibraryData self.name α] : IndexBuildM α := do
|
||||
fetch <| lib.facet self.name
|
||||
|
||||
/-- Fetch the build job of a library facet. -/
|
||||
def LibraryFacetConfig.fetchJob (lib : LeanLib)
|
||||
(self : LibraryFacetConfig name) : IndexBuildM (BuildJob Unit) := do
|
||||
let some getJob := self.getJob?
|
||||
| error "library facet '{self.name}' has no associated build job"
|
||||
return getJob <| ← fetch <| lib.facet self.name
|
||||
|
||||
/-- Fetch the build job of a library facet. -/
|
||||
def LeanLib.fetchFacetJob
|
||||
(name : Name) (self : LeanLib) : IndexBuildM (BuildJob Unit) := do
|
||||
let some config := (← getWorkspace).libraryFacetConfigs.find? name
|
||||
| error "library facet '{name}' does not exist in workspace"
|
||||
inline <| config.fetchJob self
|
||||
|
||||
/-! # Build Lean & Static Lib -/
|
||||
|
||||
/--
|
||||
Collect the local modules of a library.
|
||||
That is, the modules from `getModuleArray` plus their local transitive imports.
|
||||
-/
|
||||
partial def LeanLib.recCollectLocalModules (self : LeanLib) : IndexBuildM (Array Module) := do
|
||||
let mut mods := #[]
|
||||
let mut modSet := ModuleSet.empty
|
||||
for mod in (← self.getModuleArray) do
|
||||
(mods, modSet) ← go mod mods modSet
|
||||
return mods
|
||||
where
|
||||
go root mods modSet := do
|
||||
let mut mods := mods
|
||||
let mut modSet := modSet
|
||||
unless modSet.contains root do
|
||||
modSet := modSet.insert root
|
||||
let imps ← root.imports.fetch
|
||||
for mod in imps do
|
||||
if self.isLocalModule mod.name then
|
||||
(mods, modSet) ← go mod mods modSet
|
||||
mods := mods.push root
|
||||
return (mods, modSet)
|
||||
|
||||
/-- The `LibraryFacetConfig` for the builtin `modulesFacet`. -/
|
||||
def LeanLib.modulesFacetConfig : LibraryFacetConfig modulesFacet :=
|
||||
mkFacetConfig LeanLib.recCollectLocalModules
|
||||
|
||||
protected def LeanLib.recBuildLean
|
||||
(self : LeanLib) : IndexBuildM (BuildJob Unit) := do
|
||||
let mods ← self.modules.fetch
|
||||
mods.foldlM (init := BuildJob.nil) fun job mod => do
|
||||
job.mix <| ← mod.leanBin.fetch
|
||||
|
||||
/-- The `LibraryFacetConfig` for the builtin `leanFacet`. -/
|
||||
def LeanLib.leanFacetConfig : LibraryFacetConfig leanFacet :=
|
||||
mkFacetJobConfigSmall LeanLib.recBuildLean
|
||||
|
||||
protected def LeanLib.recBuildStatic
|
||||
(self : LeanLib) : IndexBuildM (BuildJob FilePath) := do
|
||||
let mods ← self.modules.fetch
|
||||
let oJobs ← mods.concatMapM fun mod =>
|
||||
mod.nativeFacets.mapM fun facet => fetch <| mod.facet facet.name
|
||||
buildStaticLib self.staticLibFile oJobs
|
||||
|
||||
/-- The `LibraryFacetConfig` for the builtin `staticFacet`. -/
|
||||
def LeanLib.staticFacetConfig : LibraryFacetConfig staticFacet :=
|
||||
mkFacetJobConfig LeanLib.recBuildStatic
|
||||
|
||||
/-! # Build Shared Lib -/
|
||||
|
||||
protected def LeanLib.recBuildShared
|
||||
(self : LeanLib) : IndexBuildM (BuildJob FilePath) := do
|
||||
let mods ← self.modules.fetch
|
||||
let oJobs ← mods.concatMapM fun mod =>
|
||||
mod.nativeFacets.mapM fun facet => fetch <| mod.facet facet.name
|
||||
let pkgs := mods.foldl (·.insert ·.pkg) OrdPackageSet.empty |>.toArray
|
||||
let externJobs ← pkgs.concatMapM (·.externLibs.mapM (·.shared.fetch))
|
||||
buildLeanSharedLib self.sharedLibFile (oJobs ++ externJobs) self.linkArgs
|
||||
|
||||
/-- The `LibraryFacetConfig` for the builtin `sharedFacet`. -/
|
||||
def LeanLib.sharedFacetConfig : LibraryFacetConfig sharedFacet :=
|
||||
mkFacetJobConfig LeanLib.recBuildShared
|
||||
|
||||
open LeanLib in
|
||||
/--
|
||||
A library facet name to build function map that contains builders for
|
||||
the initial set of Lake library facets (e.g., `lean`, `static`, and `shared`).
|
||||
-/
|
||||
def initLibraryFacetConfigs : DNameMap LibraryFacetConfig :=
|
||||
DNameMap.empty
|
||||
|>.insert modulesFacet modulesFacetConfig
|
||||
|>.insert leanFacet leanFacetConfig
|
||||
|>.insert staticFacet staticFacetConfig
|
||||
|>.insert sharedFacet sharedFacetConfig
|
||||
255
src/lake/Lake/Build/Module.lean
Normal file
255
src/lake/Lake/Build/Module.lean
Normal file
@@ -0,0 +1,255 @@
|
||||
/-
|
||||
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Sebastian Ullrich, Mac Malone
|
||||
-/
|
||||
import Lake.Util.OrdHashSet
|
||||
import Lean.Elab.ParseImportsFast
|
||||
import Lake.Build.Common
|
||||
|
||||
open System
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-- Fetch the build result of a module facet. -/
|
||||
@[inline] protected def ModuleFacetDecl.fetch (mod : Module)
|
||||
(self : ModuleFacetDecl) [FamilyOut ModuleData self.name α] : IndexBuildM α := do
|
||||
fetch <| mod.facet self.name
|
||||
|
||||
/-- Fetch the build job of a module facet. -/
|
||||
def ModuleFacetConfig.fetchJob (mod : Module)
|
||||
(self : ModuleFacetConfig name) : IndexBuildM (BuildJob Unit) := do
|
||||
let some getJob := self.getJob?
|
||||
| error "module facet '{self.name}' has no associated build job"
|
||||
return getJob <| ← fetch <| mod.facet self.name
|
||||
|
||||
/-- Fetch the build job of a module facet. -/
|
||||
def Module.fetchFacetJob
|
||||
(name : Name) (self : Module) : IndexBuildM (BuildJob Unit) := do
|
||||
let some config := (← getWorkspace).moduleFacetConfigs.find? name
|
||||
| error "library facet '{name}' does not exist in workspace"
|
||||
inline <| config.fetchJob self
|
||||
|
||||
def Module.buildUnlessUpToDate (mod : Module)
|
||||
(dynlibPath : SearchPath) (dynlibs : Array FilePath)
|
||||
(depTrace : BuildTrace) : BuildM PUnit := do
|
||||
let isOldMode ← getIsOldMode
|
||||
let argTrace : BuildTrace := pureHash mod.leanArgs
|
||||
let srcTrace : BuildTrace ← computeTrace { path := mod.leanFile : TextFilePath }
|
||||
let modTrace := (← getLeanTrace).mix <| argTrace.mix <| srcTrace.mix depTrace
|
||||
let modUpToDate ← do
|
||||
if isOldMode then
|
||||
srcTrace.checkAgainstTime mod
|
||||
else
|
||||
modTrace.checkAgainstFile mod mod.traceFile
|
||||
let name := mod.name.toString
|
||||
unless modUpToDate do
|
||||
compileLeanModule name mod.leanFile mod.oleanFile mod.ileanFile mod.cFile
|
||||
(← getLeanPath) mod.rootDir dynlibs dynlibPath (mod.leanArgs ++ mod.weakLeanArgs) (← getLean)
|
||||
unless isOldMode do
|
||||
modTrace.writeToFile mod.traceFile
|
||||
|
||||
/-- Compute library directories and build external library Jobs of the given packages. -/
|
||||
def recBuildExternDynlibs (pkgs : Array Package)
|
||||
: IndexBuildM (Array (BuildJob Dynlib) × Array FilePath) := do
|
||||
let mut libDirs := #[]
|
||||
let mut jobs : Array (BuildJob Dynlib) := #[]
|
||||
for pkg in pkgs do
|
||||
libDirs := libDirs.push pkg.nativeLibDir
|
||||
jobs := jobs.append <| ← pkg.externLibs.mapM (·.dynlib.fetch)
|
||||
return (jobs, libDirs)
|
||||
|
||||
/--
|
||||
Build the dynlibs of the transitive imports that want precompilation
|
||||
and the dynlibs of *their* imports.
|
||||
-/
|
||||
partial def recBuildPrecompileDynlibs (imports : Array Module)
|
||||
: IndexBuildM (Array (BuildJob Dynlib) × Array (BuildJob Dynlib) × Array FilePath) := do
|
||||
let (pkgs, _, jobs) ←
|
||||
go imports OrdPackageSet.empty ModuleSet.empty #[] false
|
||||
return (jobs, ← recBuildExternDynlibs pkgs.toArray)
|
||||
where
|
||||
go imports pkgs modSet jobs shouldPrecompile := do
|
||||
let mut pkgs := pkgs
|
||||
let mut modSet := modSet
|
||||
let mut jobs := jobs
|
||||
for mod in imports do
|
||||
if modSet.contains mod then
|
||||
continue
|
||||
modSet := modSet.insert mod
|
||||
let shouldPrecompile := shouldPrecompile || mod.shouldPrecompile
|
||||
if shouldPrecompile then
|
||||
pkgs := pkgs.insert mod.pkg
|
||||
jobs := jobs.push <| (← mod.dynlib.fetch)
|
||||
let recImports ← mod.imports.fetch
|
||||
(pkgs, modSet, jobs) ← go recImports pkgs modSet jobs shouldPrecompile
|
||||
return (pkgs, modSet, jobs)
|
||||
|
||||
variable [MonadLiftT BuildM m]
|
||||
|
||||
/--
|
||||
Recursively parse the Lean files of a module and its imports
|
||||
building an `Array` product of its direct local imports.
|
||||
-/
|
||||
def Module.recParseImports (mod : Module) : IndexBuildM (Array Module) := do
|
||||
let contents ← IO.FS.readFile mod.leanFile
|
||||
let imports ← Lean.parseImports' contents mod.leanFile.toString
|
||||
let mods ← imports.foldlM (init := OrdModuleSet.empty) fun set imp =>
|
||||
findModule? imp.module <&> fun | some mod => set.insert mod | none => set
|
||||
return mods.toArray
|
||||
|
||||
/-- The `ModuleFacetConfig` for the builtin `importsFacet`. -/
|
||||
def Module.importsFacetConfig : ModuleFacetConfig importsFacet :=
|
||||
mkFacetConfig (·.recParseImports)
|
||||
|
||||
/-- Recursively compute a module's transitive imports. -/
|
||||
def Module.recComputeTransImports (mod : Module) : IndexBuildM (Array Module) := do
|
||||
(·.toArray) <$> (← mod.imports.fetch).foldlM (init := OrdModuleSet.empty) fun set imp => do
|
||||
return set.appendArray (← imp.transImports.fetch) |>.insert imp
|
||||
|
||||
/-- The `ModuleFacetConfig` for the builtin `transImportsFacet`. -/
|
||||
def Module.transImportsFacetConfig : ModuleFacetConfig transImportsFacet :=
|
||||
mkFacetConfig (·.recComputeTransImports)
|
||||
|
||||
/-- Recursively compute a module's precompiled imports. -/
|
||||
def Module.recComputePrecompileImports (mod : Module) : IndexBuildM (Array Module) := do
|
||||
(·.toArray) <$> (← mod.imports.fetch).foldlM (init := OrdModuleSet.empty) fun set imp => do
|
||||
if imp.shouldPrecompile then
|
||||
return set.appendArray (← imp.transImports.fetch) |>.insert imp
|
||||
else
|
||||
return set.appendArray (← imp.precompileImports.fetch)
|
||||
|
||||
/-- The `ModuleFacetConfig` for the builtin `precompileImportsFacet`. -/
|
||||
def Module.precompileImportsFacetConfig : ModuleFacetConfig precompileImportsFacet :=
|
||||
mkFacetConfig (·.recComputePrecompileImports)
|
||||
|
||||
/-- Recursively build a module's transitive local imports and shared library dependencies. -/
|
||||
def Module.recBuildDeps (mod : Module) : IndexBuildM (BuildJob (SearchPath × Array FilePath)) := do
|
||||
let imports ← mod.imports.fetch
|
||||
let extraDepJob ← mod.pkg.extraDep.fetch
|
||||
let precompileImports ← mod.precompileImports.fetch
|
||||
let modJobs ← precompileImports.mapM (·.dynlib.fetch)
|
||||
let pkgs := precompileImports.foldl (·.insert ·.pkg)
|
||||
OrdPackageSet.empty |>.insert mod.pkg |>.toArray
|
||||
let (externJobs, libDirs) ← recBuildExternDynlibs pkgs
|
||||
let importJob ← BuildJob.mixArray <| ← imports.mapM (·.importBin.fetch)
|
||||
let externDynlibsJob ← BuildJob.collectArray externJobs
|
||||
let modDynlibsJob ← BuildJob.collectArray modJobs
|
||||
|
||||
extraDepJob.bindAsync fun _ _ => do
|
||||
importJob.bindAsync fun _ importTrace => do
|
||||
modDynlibsJob.bindAsync fun modDynlibs modTrace => do
|
||||
return externDynlibsJob.mapWithTrace fun externDynlibs externTrace =>
|
||||
let depTrace := importTrace.mix <| modTrace.mix externTrace
|
||||
/-
|
||||
Requirements:
|
||||
* Lean wants the external library symbols before module symbols.
|
||||
* Unix requires the file extension of the dynlib.
|
||||
* For some reason, building from the Lean server requires full paths.
|
||||
Everything else loads fine with just the augmented library path.
|
||||
* Linux still needs the augmented path to resolve nested dependencies in dynlibs.
|
||||
-/
|
||||
let dynlibPath := libDirs ++ externDynlibs.filterMap (·.dir?) |>.toList
|
||||
let dynlibs := externDynlibs.map (·.path) ++ modDynlibs.map (·.path)
|
||||
((dynlibPath, dynlibs), depTrace)
|
||||
|
||||
/-- The `ModuleFacetConfig` for the builtin `depsFacet`. -/
|
||||
def Module.depsFacetConfig : ModuleFacetConfig depsFacet :=
|
||||
mkFacetJobConfigSmall (·.recBuildDeps)
|
||||
|
||||
/-- Recursively build a module and its dependencies. -/
|
||||
def Module.recBuildLeanCore (mod : Module) : IndexBuildM (BuildJob Unit) := do
|
||||
(← mod.deps.fetch).bindSync fun (dynlibPath, dynlibs) depTrace => do
|
||||
mod.buildUnlessUpToDate dynlibPath dynlibs depTrace
|
||||
return ((), depTrace)
|
||||
|
||||
/-- The `ModuleFacetConfig` for the builtin `leanBinFacet`. -/
|
||||
def Module.leanBinFacetConfig : ModuleFacetConfig leanBinFacet :=
|
||||
mkFacetJobConfig (·.recBuildLeanCore)
|
||||
|
||||
/-- The `ModuleFacetConfig` for the builtin `importBinFacet`. -/
|
||||
def Module.importBinFacetConfig : ModuleFacetConfig importBinFacet :=
|
||||
mkFacetJobConfigSmall fun mod => do
|
||||
(← mod.leanBin.fetch).bindSync fun _ depTrace =>
|
||||
return ((), mixTrace (← computeTrace mod) depTrace)
|
||||
|
||||
/-- The `ModuleFacetConfig` for the builtin `oleanFacet`. -/
|
||||
def Module.oleanFacetConfig : ModuleFacetConfig oleanFacet :=
|
||||
mkFacetJobConfigSmall fun mod => do
|
||||
(← mod.leanBin.fetch).bindSync fun _ depTrace =>
|
||||
return (mod.oleanFile, mixTrace (← computeTrace mod.oleanFile) depTrace)
|
||||
|
||||
/-- The `ModuleFacetConfig` for the builtin `ileanFacet`. -/
|
||||
def Module.ileanFacetConfig : ModuleFacetConfig ileanFacet :=
|
||||
mkFacetJobConfigSmall fun mod => do
|
||||
(← mod.leanBin.fetch).bindSync fun _ depTrace =>
|
||||
return (mod.ileanFile, mixTrace (← computeTrace mod.ileanFile) depTrace)
|
||||
|
||||
/-- The `ModuleFacetConfig` for the builtin `cFacet`. -/
|
||||
def Module.cFacetConfig : ModuleFacetConfig cFacet :=
|
||||
mkFacetJobConfigSmall fun mod => do
|
||||
(← mod.leanBin.fetch).bindSync fun _ _ =>
|
||||
-- do content-aware hashing so that we avoid recompiling unchanged C files
|
||||
return (mod.cFile, ← computeTrace mod.cFile)
|
||||
|
||||
/-- Recursively build the module's object file from its C file produced by `lean`. -/
|
||||
def Module.recBuildLeanO (self : Module) : IndexBuildM (BuildJob FilePath) := do
|
||||
buildLeanO self.name.toString self.oFile (← self.c.fetch) self.leancArgs
|
||||
|
||||
/-- The `ModuleFacetConfig` for the builtin `oFacet`. -/
|
||||
def Module.oFacetConfig : ModuleFacetConfig oFacet :=
|
||||
mkFacetJobConfig Module.recBuildLeanO
|
||||
|
||||
-- TODO: Return `BuildJob OrdModuleSet × OrdPackageSet` or `OrdRBSet Dynlib`
|
||||
/-- Recursively build the shared library of a module (e.g., for `--load-dynlib`). -/
|
||||
def Module.recBuildDynlib (mod : Module) : IndexBuildM (BuildJob Dynlib) := do
|
||||
|
||||
-- Compute dependencies
|
||||
let transImports ← mod.transImports.fetch
|
||||
let modJobs ← transImports.mapM (·.dynlib.fetch)
|
||||
let pkgs := transImports.foldl (·.insert ·.pkg)
|
||||
OrdPackageSet.empty |>.insert mod.pkg |>.toArray
|
||||
let (externJobs, pkgLibDirs) ← recBuildExternDynlibs pkgs
|
||||
let linkJobs ← mod.nativeFacets.mapM (fetch <| mod.facet ·.name)
|
||||
|
||||
-- Collect Jobs
|
||||
let linksJob ← BuildJob.collectArray linkJobs
|
||||
let modDynlibsJob ← BuildJob.collectArray modJobs
|
||||
let externDynlibsJob ← BuildJob.collectArray externJobs
|
||||
|
||||
-- Build dynlib
|
||||
show SchedulerM _ from do
|
||||
linksJob.bindAsync fun links oTrace => do
|
||||
modDynlibsJob.bindAsync fun modDynlibs libTrace => do
|
||||
externDynlibsJob.bindSync fun externDynlibs externTrace => do
|
||||
let libNames := modDynlibs.map (·.name) ++ externDynlibs.map (·.name)
|
||||
let libDirs := pkgLibDirs ++ externDynlibs.filterMap (·.dir?)
|
||||
let depTrace := oTrace.mix <| libTrace.mix externTrace
|
||||
let trace ← buildFileUnlessUpToDate mod.dynlibFile depTrace do
|
||||
let args := links.map toString ++
|
||||
libDirs.map (s!"-L{·}") ++ libNames.map (s!"-l{·}")
|
||||
compileSharedLib mod.name.toString mod.dynlibFile args (← getLeanc)
|
||||
return (⟨mod.dynlibFile, mod.dynlibName⟩, trace)
|
||||
|
||||
/-- The `ModuleFacetConfig` for the builtin `dynlibFacet`. -/
|
||||
def Module.dynlibFacetConfig : ModuleFacetConfig dynlibFacet :=
|
||||
mkFacetJobConfig Module.recBuildDynlib
|
||||
|
||||
open Module in
|
||||
/--
|
||||
A name-configuration map for the initial set of
|
||||
Lake module facets (e.g., `lean.{imports, c, o, dynlib]`).
|
||||
-/
|
||||
def initModuleFacetConfigs : DNameMap ModuleFacetConfig :=
|
||||
DNameMap.empty
|
||||
|>.insert importsFacet importsFacetConfig
|
||||
|>.insert transImportsFacet transImportsFacetConfig
|
||||
|>.insert precompileImportsFacet precompileImportsFacetConfig
|
||||
|>.insert depsFacet depsFacetConfig
|
||||
|>.insert leanBinFacet leanBinFacetConfig
|
||||
|>.insert importBinFacet importBinFacetConfig
|
||||
|>.insert oleanFacet oleanFacetConfig
|
||||
|>.insert ileanFacet ileanFacetConfig
|
||||
|>.insert cFacet cFacetConfig
|
||||
|>.insert oFacet oFacetConfig
|
||||
|>.insert dynlibFacet dynlibFacetConfig
|
||||
57
src/lake/Lake/Build/Monad.lean
Normal file
57
src/lake/Lake/Build/Monad.lean
Normal file
@@ -0,0 +1,57 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Config.Monad
|
||||
import Lake.Build.Context
|
||||
import Lake.Util.EStateT
|
||||
|
||||
open System
|
||||
|
||||
namespace Lake
|
||||
|
||||
def mkBuildContext (ws : Workspace) (oldMode : Bool) : IO BuildContext := do
|
||||
let lean := ws.lakeEnv.lean
|
||||
let leanTrace := Hash.ofString lean.githash
|
||||
return {
|
||||
opaqueWs := ws, leanTrace, oldMode
|
||||
startedBuilds := ← IO.mkRef 0
|
||||
finishedBuilds := ← IO.mkRef 0
|
||||
}
|
||||
|
||||
@[inline] def getLeanTrace : BuildM BuildTrace :=
|
||||
(·.leanTrace) <$> readThe BuildContext
|
||||
|
||||
@[inline] def getIsOldMode : BuildM Bool :=
|
||||
(·.oldMode) <$> readThe BuildContext
|
||||
|
||||
def failOnBuildCycle [ToString k] : Except (List k) α → BuildM α
|
||||
| Except.ok a => pure a
|
||||
| Except.error cycle => do
|
||||
let cycle := cycle.map (s!" {·}")
|
||||
error s!"build cycle detected:\n{"\n".intercalate cycle}"
|
||||
|
||||
/--
|
||||
Run the recursive build in the given build store.
|
||||
If a cycle is encountered, log it and then fail.
|
||||
-/
|
||||
@[inline] def RecBuildM.runIn (store : BuildStore) (build : RecBuildM α) : BuildM (α × BuildStore) := do
|
||||
let (res, store) ← EStateT.run store <| ReaderT.run build []
|
||||
return (← failOnBuildCycle res, store)
|
||||
|
||||
/--
|
||||
Run the recursive build in a fresh build store.
|
||||
If a cycle is encountered, log it and then fail.
|
||||
-/
|
||||
@[inline] def RecBuildM.run (build : RecBuildM α) : BuildM α := do
|
||||
(·.1) <$> build.runIn {}
|
||||
|
||||
/-- Run the given build function in the Workspace's context. -/
|
||||
@[inline] def Workspace.runBuild (ws : Workspace) (build : BuildM α) (oldMode := false) : LogIO α := do
|
||||
let ctx ← mkBuildContext ws oldMode
|
||||
build.run ctx
|
||||
|
||||
/-- Run the given build function in the Lake monad's workspace. -/
|
||||
@[inline] def runBuild (build : BuildM α) (oldMode := false) : LakeT LogIO α := do
|
||||
(← getWorkspace).runBuild build oldMode
|
||||
122
src/lake/Lake/Build/Package.lean
Normal file
122
src/lake/Lake/Build/Package.lean
Normal file
@@ -0,0 +1,122 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Util.Sugar
|
||||
import Lake.Build.Common
|
||||
|
||||
open System
|
||||
namespace Lake
|
||||
|
||||
/-- Fetch the build job of the specified package target. -/
|
||||
def Package.fetchTargetJob (self : Package)
|
||||
(target : Name) : IndexBuildM (Option (BuildJob Unit)) := do
|
||||
let some config := self.findTargetConfig? target
|
||||
| error s!"package '{self.name}' has no target '{target}'"
|
||||
return config.getJob (← fetch <| self.target target)
|
||||
|
||||
/-- Fetch the build result of a target. -/
|
||||
protected def TargetDecl.fetch (self : TargetDecl)
|
||||
[FamilyDef CustomData (self.pkg, self.name) α] : IndexBuildM α := do
|
||||
let some pkg ← findPackage? self.pkg
|
||||
| error s!"package '{self.pkg}' of target '{self.name}' does not exist in workspace"
|
||||
fetch <| pkg.target self.name
|
||||
|
||||
/-- Fetch the build job of the target. -/
|
||||
def TargetDecl.fetchJob (self : TargetDecl) : IndexBuildM (BuildJob Unit) := do
|
||||
let some pkg ← findPackage? self.pkg
|
||||
| error s!"package '{self.pkg}' of target '{self.name}' does not exist in workspace"
|
||||
return self.config.getJob (← fetch <| pkg.target self.name)
|
||||
|
||||
/-- Fetch the build result of a package facet. -/
|
||||
@[inline] protected def PackageFacetDecl.fetch (pkg : Package)
|
||||
(self : PackageFacetDecl) [FamilyOut PackageData self.name α] : IndexBuildM α := do
|
||||
fetch <| pkg.facet self.name
|
||||
|
||||
/-- Fetch the build job of a package facet. -/
|
||||
def PackageFacetConfig.fetchJob (pkg : Package)
|
||||
(self : PackageFacetConfig name) : IndexBuildM (BuildJob Unit) := do
|
||||
let some getJob := self.getJob?
|
||||
| error "package facet '{pkg.name}' has no associated build job"
|
||||
return getJob <| ← fetch <| pkg.facet self.name
|
||||
|
||||
/-- Fetch the build job of a library facet. -/
|
||||
def Package.fetchFacetJob
|
||||
(name : Name) (self : Package) : IndexBuildM (BuildJob Unit) := do
|
||||
let some config := (← getWorkspace).packageFacetConfigs.find? name
|
||||
| error "package facet '{name}' does not exist in workspace"
|
||||
inline <| config.fetchJob self
|
||||
|
||||
/-- Compute a topological ordering of the package's transitive dependencies. -/
|
||||
def Package.recComputeDeps (self : Package) : IndexBuildM (Array Package) := do
|
||||
let mut deps := #[]
|
||||
let mut depSet := PackageSet.empty
|
||||
for dep in self.deps do
|
||||
for depDep in (← fetch <| dep.facet `deps) do
|
||||
unless depSet.contains depDep do
|
||||
deps := deps.push depDep
|
||||
depSet := depSet.insert depDep
|
||||
unless depSet.contains dep do
|
||||
deps := deps.push dep
|
||||
depSet := depSet.insert dep
|
||||
return deps
|
||||
|
||||
/-- The `PackageFacetConfig` for the builtin `depsFacet`. -/
|
||||
def Package.depsFacetConfig : PackageFacetConfig depsFacet :=
|
||||
mkFacetConfig Package.recComputeDeps
|
||||
|
||||
/--
|
||||
Build the `extraDepTarget` for the package and its transitive dependencies.
|
||||
Also fetch pre-built releases for the package's' dependencies.
|
||||
-/
|
||||
def Package.recBuildExtraDepTargets (self : Package) : IndexBuildM (BuildJob Unit) := do
|
||||
let mut job := BuildJob.nil
|
||||
-- Build dependencies' extra dep targets
|
||||
for dep in self.deps do
|
||||
job ← job.mix <| ← dep.extraDep.fetch
|
||||
-- Fetch pre-built release if desired and this package is a dependency
|
||||
if self.name ≠ (← getWorkspace).root.name ∧ self.preferReleaseBuild then
|
||||
job ← job.mix <| ← self.release.fetch
|
||||
-- Build this package's extra dep targets
|
||||
for target in self.extraDepTargets do
|
||||
if let some config := self.findTargetConfig? target then
|
||||
job ← job.mix <| config.getJob <| ← fetch <| self.target target
|
||||
else
|
||||
error s!"unknown target `{target}`"
|
||||
return job
|
||||
|
||||
/-- The `PackageFacetConfig` for the builtin `dynlibFacet`. -/
|
||||
def Package.extraDepFacetConfig : PackageFacetConfig extraDepFacet :=
|
||||
mkFacetJobConfigSmall Package.recBuildExtraDepTargets
|
||||
|
||||
/-- Download and unpack the package's prebuilt release archive (from GitHub). -/
|
||||
def Package.fetchRelease (self : Package) : SchedulerM (BuildJob Unit) := Job.async do
|
||||
let some (repoUrl, tag) := self.release? | do
|
||||
logWarning "wanted prebuilt release, but release repository and tag was not known"
|
||||
return ((), .nil)
|
||||
let url := s!"{repoUrl}/releases/download/{tag}/{self.buildArchive}"
|
||||
let logName := s!"{self.name}/{tag}/{self.buildArchive}"
|
||||
try
|
||||
let depTrace := Hash.ofString url
|
||||
let trace ← buildFileUnlessUpToDate self.buildArchiveFile depTrace do
|
||||
download logName url self.buildArchiveFile
|
||||
untar logName self.buildArchiveFile self.buildDir
|
||||
return ((), trace)
|
||||
else
|
||||
return ((), .nil)
|
||||
|
||||
/-- The `PackageFacetConfig` for the builtin `releaseFacet`. -/
|
||||
def Package.releaseFacetConfig : PackageFacetConfig releaseFacet :=
|
||||
mkFacetJobConfig (·.fetchRelease)
|
||||
|
||||
open Package in
|
||||
/--
|
||||
A package facet name to build function map that contains builders for
|
||||
the initial set of Lake package facets (e.g., `extraDep`).
|
||||
-/
|
||||
def initPackageFacetConfigs : DNameMap PackageFacetConfig :=
|
||||
DNameMap.empty
|
||||
|>.insert depsFacet depsFacetConfig
|
||||
|>.insert extraDepFacet extraDepFacetConfig
|
||||
|>.insert releaseFacet releaseFacetConfig
|
||||
88
src/lake/Lake/Build/Store.lean
Normal file
88
src/lake/Lake/Build/Store.lean
Normal file
@@ -0,0 +1,88 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Build.Data
|
||||
import Lake.Util.StoreInsts
|
||||
|
||||
/-!
|
||||
# The Lake Build Store
|
||||
|
||||
The Lake build store is the map of Lake build keys to build task and/or
|
||||
build results that is slowly filled during a recursive build (e.g., via
|
||||
topological-based build of an initial key's dependencies).
|
||||
-/
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-- A monad equipped with a Lake build store. -/
|
||||
abbrev MonadBuildStore (m) := MonadDStore BuildKey BuildData m
|
||||
|
||||
/-- The type of the Lake build store. -/
|
||||
abbrev BuildStore :=
|
||||
DRBMap BuildKey BuildData BuildKey.quickCmp
|
||||
|
||||
@[inline] def BuildStore.empty : BuildStore := DRBMap.empty
|
||||
|
||||
namespace BuildStore
|
||||
|
||||
-- Linter reports false positives on the `v` variables below
|
||||
set_option linter.unusedVariables false
|
||||
|
||||
/-- Derive an array of built module facets from the store. -/
|
||||
def collectModuleFacetArray (self : BuildStore)
|
||||
(facet : Name) [FamilyOut ModuleData facet α] : Array α := Id.run do
|
||||
let mut res : Array α := #[]
|
||||
for ⟨k, v⟩ in self do
|
||||
match k with
|
||||
| .moduleFacet m f =>
|
||||
if h : f = facet then
|
||||
have of_data := by unfold BuildData; simp [h]
|
||||
res := res.push <| cast of_data v
|
||||
| _ => pure ()
|
||||
return res
|
||||
|
||||
/-- Derive a map of module names to built facets from the store. -/
|
||||
def collectModuleFacetMap (self : BuildStore)
|
||||
(facet : Name) [FamilyOut ModuleData facet α] : NameMap α := Id.run do
|
||||
let mut res := Lean.mkNameMap α
|
||||
for ⟨k, v⟩ in self do
|
||||
match k with
|
||||
| .moduleFacet m f =>
|
||||
if h : f = facet then
|
||||
have of_data := by unfold BuildData; simp [h]
|
||||
res := res.insert m <| cast of_data v
|
||||
| _ => pure ()
|
||||
return res
|
||||
|
||||
/-- Derive an array of built package facets from the store. -/
|
||||
def collectPackageFacetArray (self : BuildStore)
|
||||
(facet : Name) [FamilyOut PackageData facet α] : Array α := Id.run do
|
||||
let mut res : Array α := #[]
|
||||
for ⟨k, v⟩ in self do
|
||||
match k with
|
||||
| .packageFacet _ f =>
|
||||
if h : f = facet then
|
||||
have of_data := by unfold BuildData; simp [h]
|
||||
res := res.push <| cast of_data v
|
||||
| _ => pure ()
|
||||
return res
|
||||
|
||||
/-- Derive an array of built target facets from the store. -/
|
||||
def collectTargetFacetArray (self : BuildStore)
|
||||
(facet : Name) [FamilyOut TargetData facet α] : Array α := Id.run do
|
||||
let mut res : Array α := #[]
|
||||
for ⟨k, v⟩ in self do
|
||||
match k with
|
||||
| .targetFacet _ _ f =>
|
||||
if h : f = facet then
|
||||
have of_data := by unfold BuildData; simp [h]
|
||||
res := res.push <| cast of_data v
|
||||
| _ => pure ()
|
||||
return res
|
||||
|
||||
/-- Derive an array of built external shared libraries from the store. -/
|
||||
def collectSharedExternLibs (self : BuildStore)
|
||||
[FamilyOut TargetData `externLib.shared α] : Array α :=
|
||||
self.collectTargetFacetArray `externLib.shared
|
||||
139
src/lake/Lake/Build/Topological.lean
Normal file
139
src/lake/Lake/Build/Topological.lean
Normal file
@@ -0,0 +1,139 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Util.Cycle
|
||||
import Lake.Util.Store
|
||||
import Lake.Util.EquipT
|
||||
|
||||
/-!
|
||||
# Topological / Suspending Recursive Builder
|
||||
|
||||
This module defines a recursive build function that topologically
|
||||
(ι.e., via a depth-first search with memoization) builds the elements of
|
||||
a build store.
|
||||
|
||||
This is called a suspending scheduler in *Build systems à la carte*.
|
||||
-/
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-!
|
||||
## Recursive Fetching
|
||||
|
||||
In this section, we define the primitives that make up a builder.
|
||||
-/
|
||||
|
||||
/--
|
||||
A dependently typed monadic *fetch* function.
|
||||
|
||||
That is, a function within the monad `m` and takes an input `a : α`
|
||||
describing what to fetch and and produces some output `b : β a` (dependently
|
||||
typed) or `b : B` (not) describing what was fetched. All build functions are
|
||||
fetch functions, but not all fetch functions need build something.
|
||||
-/
|
||||
abbrev DFetchFn (α : Type u) (β : α → Type v) (m : Type v → Type w) :=
|
||||
(a : α) → m (β a)
|
||||
|
||||
/-!
|
||||
In order to nest builds / fetches within one another,
|
||||
we equip the monad `m` with a fetch function of its own.
|
||||
-/
|
||||
|
||||
/-- A transformer that equips a monad with a `DFetchFn`. -/
|
||||
abbrev DFetchT (α : Type u) (β : α → Type v) (m : Type v → Type w) :=
|
||||
EquipT (DFetchFn α β m) m
|
||||
|
||||
/-- A `DFetchT` that is not dependently typed. -/
|
||||
abbrev FetchT (α : Type u) (β : Type v) (m : Type v → Type w) :=
|
||||
DFetchT α (fun _ => β) m
|
||||
|
||||
/-!
|
||||
We can then use the such a monad as the basis for a fetch function itself.
|
||||
-/
|
||||
|
||||
/-
|
||||
A `DFetchFn` that utilizes another `DFetchFn` equipped to the monad to
|
||||
fetch values. It is thus usually implemented recursively via some variation
|
||||
of the `recFetch` function below, hence the "rec" in both names.
|
||||
-/
|
||||
abbrev DRecFetchFn (α : Type u) (β : α → Type v) (m : Type v → Type w) :=
|
||||
DFetchFn α β (DFetchT α β m)
|
||||
|
||||
/-- A `DRecFetchFn` that is not dependently typed. -/
|
||||
abbrev RecFetchFn (α : Type u) (β : Type v) (m : Type v → Type w) :=
|
||||
α → FetchT α β m β
|
||||
|
||||
/-- A `DFetchFn` that provides its base `DRecFetchFn` with itself. -/
|
||||
@[specialize] partial def recFetch
|
||||
[(α : Type u) → Nonempty (m α)] (fetch : DRecFetchFn α β m) : DFetchFn α β m :=
|
||||
fun a => fetch a (recFetch fetch)
|
||||
|
||||
/-!
|
||||
The basic `recFetch` can fail to terminate in a variety of ways,
|
||||
it can even cycle (i.e., `a` fetches `b` which fetches `a`). Thus, we
|
||||
define the `acyclicRecFetch` below to guard against such cases.
|
||||
-/
|
||||
|
||||
/--
|
||||
A `recFetch` augmented by a `CycleT` to guard against recursive cycles.
|
||||
If the set of visited keys is finite, this function should provably terminate.
|
||||
|
||||
We use `keyOf` to the derive the unique key of a fetch from its descriptor
|
||||
`a : α`. We do this because descriptors may not be comparable and/or contain
|
||||
more information than necessary to determine uniqueness.
|
||||
-/
|
||||
@[inline] partial def recFetchAcyclic [BEq κ] [Monad m]
|
||||
(keyOf : α → κ) (fetch : DRecFetchFn α β (CycleT κ m)) : DFetchFn α β (CycleT κ m) :=
|
||||
recFetch fun a recurse =>
|
||||
/-
|
||||
NOTE: We provide the stack directly to `recurse` rather than
|
||||
get it through `ReaderT` to prevent it being overridden by the `fetch`
|
||||
function (and thereby potentially produce a cycle).
|
||||
-/
|
||||
guardCycle (keyOf a) fun stack => fetch a (recurse · stack) stack
|
||||
|
||||
/-!
|
||||
When building, we usually do not want to build the same thing twice during
|
||||
a single build pass. At the same time, separate builds may both wish to fetch
|
||||
the same thing. Thus, we need to store past build results to return them upon
|
||||
future fetches. This is what `recFetchMemoize` below does.
|
||||
-/
|
||||
|
||||
/--
|
||||
`recFetchAcyclic` augmented with a `MonadDStore` to
|
||||
memoize fetch results and thus avoid computing the same result twice.
|
||||
-/
|
||||
@[inline] def recFetchMemoize [BEq κ] [Monad m] [MonadDStore κ β m]
|
||||
(keyOf : α → κ) (fetch : DRecFetchFn α (fun a => β (keyOf a)) (CycleT κ m))
|
||||
: DFetchFn α (fun a => β (keyOf a)) (CycleT κ m) :=
|
||||
recFetchAcyclic keyOf fun a recurse =>
|
||||
fetchOrCreate (keyOf a) do fetch a recurse
|
||||
|
||||
/-!
|
||||
## Building
|
||||
|
||||
In this section, we use the abstractions we have just created to define
|
||||
the desired topological recursive build function (a.k.a. a suspending scheduler).
|
||||
-/
|
||||
|
||||
/-- Recursively builds objects for the keys `κ`, avoiding cycles. -/
|
||||
@[inline] def buildAcyclic [BEq κ] [Monad m]
|
||||
(keyOf : α → κ) (a : α) (build : RecFetchFn α β (CycleT κ m)) : ExceptT (Cycle κ) m β :=
|
||||
recFetchAcyclic (β := fun _ => β) keyOf build a []
|
||||
|
||||
/-- Dependently typed version of `buildTop`. -/
|
||||
@[inline] def buildDTop (β) [BEq κ] [Monad m] [MonadDStore κ β m]
|
||||
(keyOf : α → κ) (a : α) (build : DRecFetchFn α (fun a => β (keyOf a)) (CycleT κ m))
|
||||
: ExceptT (Cycle κ) m (β (keyOf a)) :=
|
||||
recFetchMemoize keyOf build a []
|
||||
|
||||
/--
|
||||
Recursively fills a `MonadStore` of key-object pairs by
|
||||
building objects topologically (ι.e., depth-first with memoization).
|
||||
If a cycle is detected, the list of keys traversed is thrown.
|
||||
-/
|
||||
@[inline] def buildTop [BEq κ] [Monad m] [MonadStore κ β m]
|
||||
(keyOf : α → κ) (a : α) (build : RecFetchFn α β (CycleT κ m)) : ExceptT (Cycle κ) m β :=
|
||||
recFetchMemoize (β := fun _ => β) keyOf build a []
|
||||
273
src/lake/Lake/Build/Trace.lean
Normal file
273
src/lake/Lake/Build/Trace.lean
Normal file
@@ -0,0 +1,273 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
|
||||
open System
|
||||
namespace Lake
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! # Utilities -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
class CheckExists.{u} (i : Type u) where
|
||||
/-- Check whether there already exists an artifact for the given target info. -/
|
||||
checkExists : i → BaseIO Bool
|
||||
|
||||
export CheckExists (checkExists)
|
||||
|
||||
instance : CheckExists FilePath where
|
||||
checkExists := FilePath.pathExists
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! # Trace Abstraction -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
class ComputeTrace.{u,v,w} (i : Type u) (m : outParam $ Type v → Type w) (t : Type v) where
|
||||
/-- Compute the trace of some target info using information from the monadic context. -/
|
||||
computeTrace : i → m t
|
||||
|
||||
def computeTrace [ComputeTrace i m t] [MonadLiftT m n] (info : i) : n t :=
|
||||
liftM <| ComputeTrace.computeTrace info
|
||||
|
||||
class NilTrace.{u} (t : Type u) where
|
||||
/-- The nil trace. Should not unduly clash with a proper trace. -/
|
||||
nilTrace : t
|
||||
|
||||
export NilTrace (nilTrace)
|
||||
|
||||
instance [NilTrace t] : Inhabited t := ⟨nilTrace⟩
|
||||
|
||||
class MixTrace.{u} (t : Type u) where
|
||||
/-- Combine two traces. The result should be dirty if either of the inputs is dirty. -/
|
||||
mixTrace : t → t → t
|
||||
|
||||
export MixTrace (mixTrace)
|
||||
|
||||
def mixTraceM [MixTrace t] [Pure m] (t1 t2 : t) : m t :=
|
||||
pure <| mixTrace t1 t2
|
||||
|
||||
section
|
||||
variable [MixTrace t] [NilTrace t]
|
||||
|
||||
def mixTraceList (traces : List t) : t :=
|
||||
traces.foldl mixTrace nilTrace
|
||||
|
||||
def mixTraceArray (traces : Array t) : t :=
|
||||
traces.foldl mixTrace nilTrace
|
||||
|
||||
variable [ComputeTrace i m t]
|
||||
|
||||
def computeListTrace [MonadLiftT m n] [Monad n] (artifacts : List i) : n t :=
|
||||
mixTraceList <$> artifacts.mapM computeTrace
|
||||
|
||||
instance [Monad m] : ComputeTrace (List i) m t := ⟨computeListTrace⟩
|
||||
|
||||
def computeArrayTrace [MonadLiftT m n] [Monad n] (artifacts : Array i) : n t :=
|
||||
mixTraceArray <$> artifacts.mapM computeTrace
|
||||
|
||||
instance [Monad m] : ComputeTrace (Array i) m t := ⟨computeArrayTrace⟩
|
||||
end
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! # Hash Trace -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
/--
|
||||
A content hash.
|
||||
TODO: Use a secure hash rather than the builtin Lean hash function.
|
||||
-/
|
||||
structure Hash where
|
||||
val : UInt64
|
||||
deriving BEq, DecidableEq, Repr
|
||||
|
||||
namespace Hash
|
||||
|
||||
def ofNat (n : Nat) :=
|
||||
mk n.toUInt64
|
||||
|
||||
def loadFromFile (hashFile : FilePath) : IO (Option Hash) :=
|
||||
return (← IO.FS.readFile hashFile).toNat?.map ofNat
|
||||
|
||||
def nil : Hash :=
|
||||
mk <| 1723 -- same as Name.anonymous
|
||||
|
||||
instance : NilTrace Hash := ⟨nil⟩
|
||||
|
||||
def mix (h1 h2 : Hash) : Hash :=
|
||||
mk <| mixHash h1.val h2.val
|
||||
|
||||
instance : MixTrace Hash := ⟨mix⟩
|
||||
|
||||
protected def toString (self : Hash) : String :=
|
||||
toString self.val
|
||||
|
||||
instance : ToString Hash := ⟨Hash.toString⟩
|
||||
|
||||
def ofString (str : String) :=
|
||||
mix nil <| mk <| hash str -- same as Name.mkSimple
|
||||
|
||||
def ofByteArray (bytes : ByteArray) : Hash :=
|
||||
⟨hash bytes⟩
|
||||
|
||||
end Hash
|
||||
|
||||
class ComputeHash (α : Type u) (m : outParam $ Type → Type v) where
|
||||
computeHash : α → m Hash
|
||||
|
||||
instance [ComputeHash α m] : ComputeTrace α m Hash := ⟨ComputeHash.computeHash⟩
|
||||
|
||||
def pureHash [ComputeHash α Id] (a : α) : Hash :=
|
||||
ComputeHash.computeHash a
|
||||
|
||||
def computeHash [ComputeHash α m] [MonadLiftT m n] (a : α) : n Hash :=
|
||||
liftM <| ComputeHash.computeHash a
|
||||
|
||||
instance : ComputeHash String Id := ⟨Hash.ofString⟩
|
||||
|
||||
def computeFileHash (file : FilePath) : IO Hash :=
|
||||
Hash.ofByteArray <$> IO.FS.readBinFile file
|
||||
|
||||
instance : ComputeHash FilePath IO := ⟨computeFileHash⟩
|
||||
|
||||
/--
|
||||
A wrapper around `FilePath` that adjusts its `ComputeHash` implementation
|
||||
to normalize `\r\n` sequences to `\n` for cross-platform compatibility. -/
|
||||
structure TextFilePath where
|
||||
path : FilePath
|
||||
|
||||
instance : ComputeHash TextFilePath IO where
|
||||
computeHash file := do
|
||||
let text ← IO.FS.readFile file.path
|
||||
let text := text.replace "\r\n" "\n"
|
||||
return Hash.ofString text
|
||||
|
||||
instance [ComputeHash α m] [Monad m] : ComputeHash (Array α) m where
|
||||
computeHash ar := ar.foldlM (fun b a => Hash.mix b <$> computeHash a) Hash.nil
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! # Modification Time (MTime) Trace -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
open IO.FS (SystemTime)
|
||||
|
||||
/-- A modification time. -/
|
||||
def MTime := SystemTime
|
||||
|
||||
namespace MTime
|
||||
|
||||
instance : OfNat MTime (nat_lit 0) := ⟨⟨0,0⟩⟩
|
||||
|
||||
instance : BEq MTime := inferInstanceAs (BEq SystemTime)
|
||||
instance : Repr MTime := inferInstanceAs (Repr SystemTime)
|
||||
|
||||
instance : Ord MTime := inferInstanceAs (Ord SystemTime)
|
||||
instance : LT MTime := ltOfOrd
|
||||
instance : LE MTime := leOfOrd
|
||||
instance : Min MTime := minOfLe
|
||||
instance : Max MTime := maxOfLe
|
||||
|
||||
instance : NilTrace MTime := ⟨0⟩
|
||||
instance : MixTrace MTime := ⟨max⟩
|
||||
|
||||
end MTime
|
||||
|
||||
class GetMTime (α) where
|
||||
getMTime : α → IO MTime
|
||||
|
||||
export GetMTime (getMTime)
|
||||
instance [GetMTime α] : ComputeTrace α IO MTime := ⟨getMTime⟩
|
||||
|
||||
def getFileMTime (file : FilePath) : IO MTime :=
|
||||
return (← file.metadata).modified
|
||||
|
||||
instance : GetMTime FilePath := ⟨getFileMTime⟩
|
||||
instance : GetMTime TextFilePath := ⟨(getFileMTime ·.path)⟩
|
||||
|
||||
/-- Check if the info's `MTIme` is at least `depMTime`. -/
|
||||
def checkIfNewer [GetMTime i] (info : i) (depMTime : MTime) : BaseIO Bool :=
|
||||
(do pure ((← getMTime info) >= depMTime : Bool)).catchExceptions fun _ => pure false
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! # Lake Build Trace (Hash + MTIme) -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
/-- Trace used for common Lake targets. Combines `Hash` and `MTime`. -/
|
||||
structure BuildTrace where
|
||||
hash : Hash
|
||||
mtime : MTime
|
||||
deriving Repr
|
||||
|
||||
namespace BuildTrace
|
||||
|
||||
def withHash (hash : Hash) (self : BuildTrace) : BuildTrace :=
|
||||
{self with hash}
|
||||
|
||||
def withoutHash (self : BuildTrace) : BuildTrace :=
|
||||
{self with hash := Hash.nil}
|
||||
|
||||
def withMTime (mtime : MTime) (self : BuildTrace) : BuildTrace :=
|
||||
{self with mtime}
|
||||
|
||||
def withoutMTime (self : BuildTrace) : BuildTrace :=
|
||||
{self with mtime := 0}
|
||||
|
||||
def fromHash (hash : Hash) : BuildTrace :=
|
||||
mk hash 0
|
||||
|
||||
instance : Coe Hash BuildTrace := ⟨fromHash⟩
|
||||
|
||||
def fromMTime (mtime : MTime) : BuildTrace :=
|
||||
mk Hash.nil mtime
|
||||
|
||||
instance : Coe MTime BuildTrace := ⟨fromMTime⟩
|
||||
|
||||
def nil : BuildTrace :=
|
||||
mk Hash.nil 0
|
||||
|
||||
instance : NilTrace BuildTrace := ⟨nil⟩
|
||||
|
||||
def compute [ComputeHash i m] [MonadLiftT m IO] [GetMTime i] (info : i) : IO BuildTrace :=
|
||||
return mk (← computeHash info) (← getMTime info)
|
||||
|
||||
instance [ComputeHash i m] [MonadLiftT m IO] [GetMTime i] : ComputeTrace i IO BuildTrace := ⟨compute⟩
|
||||
|
||||
def mix (t1 t2 : BuildTrace) : BuildTrace :=
|
||||
mk (Hash.mix t1.hash t2.hash) (max t1.mtime t2.mtime)
|
||||
|
||||
instance : MixTrace BuildTrace := ⟨mix⟩
|
||||
|
||||
/--
|
||||
Check the build trace against the given target info and hash
|
||||
to see if the target is up-to-date.
|
||||
-/
|
||||
def checkAgainstHash [CheckExists i]
|
||||
(info : i) (hash : Hash) (self : BuildTrace) : BaseIO Bool :=
|
||||
pure (hash == self.hash) <&&> checkExists info
|
||||
|
||||
/--
|
||||
Check the build trace against the given target info and its modification time
|
||||
to see if the target is up-to-date.
|
||||
-/
|
||||
def checkAgainstTime [CheckExists i] [GetMTime i]
|
||||
(info : i) (self : BuildTrace) : BaseIO Bool :=
|
||||
checkIfNewer info self.mtime
|
||||
|
||||
/--
|
||||
Check the build trace against the given target info and its trace file
|
||||
to see if the target is up-to-date.
|
||||
-/
|
||||
def checkAgainstFile [CheckExists i] [GetMTime i]
|
||||
(info : i) (traceFile : FilePath) (self : BuildTrace) : BaseIO Bool := do
|
||||
let act : IO _ := do
|
||||
if let some hash ← Hash.loadFromFile traceFile then
|
||||
self.checkAgainstHash info hash
|
||||
else
|
||||
return self.mtime < (← getMTime info)
|
||||
act.catchExceptions fun _ => pure false
|
||||
|
||||
def writeToFile (traceFile : FilePath) (self : BuildTrace) : IO PUnit :=
|
||||
IO.FS.writeFile traceFile self.hash.toString
|
||||
|
||||
end BuildTrace
|
||||
6
src/lake/Lake/CLI.lean
Normal file
6
src/lake/Lake/CLI.lean
Normal file
@@ -0,0 +1,6 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.CLI.Main
|
||||
29
src/lake/Lake/CLI/Actions.lean
Normal file
29
src/lake/Lake/CLI/Actions.lean
Normal file
@@ -0,0 +1,29 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Build.Index
|
||||
|
||||
namespace Lake
|
||||
|
||||
def env (cmd : String) (args : Array String := #[]) : LakeT IO UInt32 := do
|
||||
IO.Process.spawn {cmd, args, env := ← getAugmentedEnv} >>= (·.wait)
|
||||
|
||||
def exe (name : Name) (args : Array String := #[]) (oldMode := false) : LakeT LogIO UInt32 := do
|
||||
let ws ← getWorkspace
|
||||
if let some exe := ws.findLeanExe? name then
|
||||
let exeFile ← ws.runBuild (exe.build >>= (·.await)) oldMode
|
||||
env exeFile.toString args
|
||||
else
|
||||
error s!"unknown executable `{name}`"
|
||||
|
||||
def uploadRelease (pkg : Package) (tag : String) : LogIO Unit := do
|
||||
let mut args :=
|
||||
#["release", "upload", tag, pkg.buildArchiveFile.toString, "--clobber"]
|
||||
if let some repo := pkg.releaseRepo? then
|
||||
args := args.append #["-R", repo]
|
||||
tar pkg.buildArchive pkg.buildDir pkg.buildArchiveFile
|
||||
(excludePaths := #["*.tar.gz", "*.tar.gz.trace"])
|
||||
logInfo s!"Uploading {tag}/{pkg.buildArchive}"
|
||||
proc {cmd := "gh", args}
|
||||
187
src/lake/Lake/CLI/Build.lean
Normal file
187
src/lake/Lake/CLI/Build.lean
Normal file
@@ -0,0 +1,187 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Build.Index
|
||||
import Lake.CLI.Error
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-! ## Build Target Specifiers -/
|
||||
|
||||
structure BuildSpec where
|
||||
info : BuildInfo
|
||||
getBuildJob : BuildData info.key → BuildJob Unit
|
||||
|
||||
@[inline] def BuildSpec.getJob (self : BuildSpec) (data : BuildData self.info.key) : Job Unit :=
|
||||
discard <| self.getBuildJob data
|
||||
|
||||
@[inline] def BuildData.toBuildJob
|
||||
[FamilyOut BuildData k (BuildJob α)] (data : BuildData k) : BuildJob Unit :=
|
||||
discard <| ofFamily data
|
||||
|
||||
@[inline] def mkBuildSpec (info : BuildInfo)
|
||||
[FamilyOut BuildData info.key (BuildJob α)] : BuildSpec :=
|
||||
{info, getBuildJob := BuildData.toBuildJob}
|
||||
|
||||
@[inline] def mkConfigBuildSpec (facetType : String)
|
||||
(info : BuildInfo) (config : FacetConfig Fam ι facet) (h : BuildData info.key = Fam facet)
|
||||
: Except CliError BuildSpec := do
|
||||
let some getJob := config.getJob?
|
||||
| throw <| CliError.nonCliFacet facetType facet
|
||||
return {info, getBuildJob := h ▸ getJob}
|
||||
|
||||
def BuildSpec.build (self : BuildSpec) : RecBuildM (Job Unit) :=
|
||||
self.getJob <$> buildIndexTop' self.info
|
||||
|
||||
def buildSpecs (specs : Array BuildSpec) : BuildM PUnit := do
|
||||
let jobs ← RecBuildM.run do specs.mapM (·.build)
|
||||
jobs.forM (discard <| ·.await)
|
||||
|
||||
/-! ## Parsing CLI Build Target Specifiers -/
|
||||
|
||||
def parsePackageSpec (ws : Workspace) (spec : String) : Except CliError Package :=
|
||||
if spec.isEmpty then
|
||||
return ws.root
|
||||
else
|
||||
match ws.findPackage? <| stringToLegalOrSimpleName spec with
|
||||
| some pkg => return pkg
|
||||
| none => throw <| CliError.unknownPackage spec
|
||||
|
||||
open Module in
|
||||
def resolveModuleTarget (ws : Workspace) (mod : Module) (facet : Name) : Except CliError BuildSpec :=
|
||||
if facet.isAnonymous then
|
||||
return mkBuildSpec <| mod.facet leanBinFacet
|
||||
else if let some config := ws.findModuleFacetConfig? facet then do
|
||||
mkConfigBuildSpec "module" (mod.facet facet) config rfl
|
||||
else
|
||||
throw <| CliError.unknownFacet "module" facet
|
||||
|
||||
def resolveLibTarget (ws : Workspace) (lib : LeanLib) (facet : Name) : Except CliError (Array BuildSpec) :=
|
||||
if facet.isAnonymous then
|
||||
lib.defaultFacets.mapM (resolveFacet ·)
|
||||
else
|
||||
Array.singleton <$> resolveFacet facet
|
||||
where
|
||||
resolveFacet facet :=
|
||||
if let some config := ws.findLibraryFacetConfig? facet then do
|
||||
mkConfigBuildSpec "library" (lib.facet facet) config rfl
|
||||
else
|
||||
throw <| CliError.unknownFacet "library" facet
|
||||
|
||||
def resolveExeTarget (exe : LeanExe) (facet : Name) : Except CliError BuildSpec :=
|
||||
if facet.isAnonymous || facet == `exe then
|
||||
return mkBuildSpec exe.exe
|
||||
else
|
||||
throw <| CliError.unknownFacet "executable" facet
|
||||
|
||||
def resolveExternLibTarget (lib : ExternLib) (facet : Name) : Except CliError BuildSpec :=
|
||||
if facet.isAnonymous || facet = `static then
|
||||
return mkBuildSpec lib.static
|
||||
else if facet = `shared then
|
||||
return mkBuildSpec lib.shared
|
||||
else
|
||||
throw <| CliError.unknownFacet "external library" facet
|
||||
|
||||
def resolveCustomTarget (pkg : Package)
|
||||
(name facet : Name) (config : TargetConfig pkg.name name) : Except CliError BuildSpec :=
|
||||
if !facet.isAnonymous then
|
||||
throw <| CliError.invalidFacet name facet
|
||||
else do
|
||||
let info := pkg.target name
|
||||
have h : BuildData info.key = CustomData (pkg.name, name) := rfl
|
||||
return {info, getBuildJob := h ▸ config.getJob}
|
||||
|
||||
def resolveTargetInPackage (ws : Workspace)
|
||||
(pkg : Package) (target facet : Name) : Except CliError (Array BuildSpec) :=
|
||||
if let some config := pkg.findTargetConfig? target then
|
||||
Array.singleton <$> resolveCustomTarget pkg target facet config
|
||||
else if let some exe := pkg.findLeanExe? target then
|
||||
Array.singleton <$> resolveExeTarget exe facet
|
||||
else if let some lib := pkg.findExternLib? target then
|
||||
Array.singleton <$> resolveExternLibTarget lib facet
|
||||
else if let some lib := pkg.findLeanLib? target then
|
||||
resolveLibTarget ws lib facet
|
||||
else if let some mod := pkg.findModule? target then
|
||||
Array.singleton <$> resolveModuleTarget ws mod facet
|
||||
else
|
||||
throw <| CliError.missingTarget pkg.name (target.toString false)
|
||||
|
||||
def resolveDefaultPackageTarget (ws : Workspace) (pkg : Package) : Except CliError (Array BuildSpec) :=
|
||||
pkg.defaultTargets.concatMapM (resolveTargetInPackage ws pkg · .anonymous)
|
||||
|
||||
def resolvePackageTarget (ws : Workspace) (pkg : Package) (facet : Name) : Except CliError (Array BuildSpec) :=
|
||||
if facet.isAnonymous then
|
||||
resolveDefaultPackageTarget ws pkg
|
||||
else if let some config := ws.findPackageFacetConfig? facet then do
|
||||
Array.singleton <$> mkConfigBuildSpec "package" (pkg.facet facet) config rfl
|
||||
else
|
||||
throw <| CliError.unknownFacet "package" facet
|
||||
|
||||
def resolveTargetInWorkspace (ws : Workspace)
|
||||
(target : Name) (facet : Name) : Except CliError (Array BuildSpec) :=
|
||||
if let some ⟨pkg, config⟩ := ws.findTargetConfig? target then
|
||||
Array.singleton <$> resolveCustomTarget pkg target facet config
|
||||
else if let some exe := ws.findLeanExe? target then
|
||||
Array.singleton <$> resolveExeTarget exe facet
|
||||
else if let some lib := ws.findExternLib? target then
|
||||
Array.singleton <$> resolveExternLibTarget lib facet
|
||||
else if let some lib := ws.findLeanLib? target then
|
||||
resolveLibTarget ws lib facet
|
||||
else if let some pkg := ws.findPackage? target then
|
||||
resolvePackageTarget ws pkg facet
|
||||
else if let some mod := ws.findModule? target then
|
||||
Array.singleton <$> resolveModuleTarget ws mod facet
|
||||
else
|
||||
throw <| CliError.unknownTarget target
|
||||
|
||||
def resolveTargetBaseSpec
|
||||
(ws : Workspace) (spec : String) (facet : Name) : Except CliError (Array BuildSpec) := do
|
||||
match spec.splitOn "/" with
|
||||
| [spec] =>
|
||||
if spec.isEmpty then
|
||||
resolvePackageTarget ws ws.root facet
|
||||
else if spec.startsWith "@" then
|
||||
let pkg ← parsePackageSpec ws <| spec.drop 1
|
||||
resolvePackageTarget ws pkg facet
|
||||
else if spec.startsWith "+" then
|
||||
let mod := spec.drop 1 |>.toName
|
||||
if let some mod := ws.findModule? mod then
|
||||
Array.singleton <$> resolveModuleTarget ws mod facet
|
||||
else
|
||||
throw <| CliError.unknownModule mod
|
||||
else
|
||||
resolveTargetInWorkspace ws (stringToLegalOrSimpleName spec) facet
|
||||
| [pkgSpec, targetSpec] =>
|
||||
let pkgSpec := if pkgSpec.startsWith "@" then pkgSpec.drop 1 else pkgSpec
|
||||
let pkg ← parsePackageSpec ws pkgSpec
|
||||
if targetSpec.isEmpty then
|
||||
resolvePackageTarget ws pkg facet
|
||||
else if targetSpec.startsWith "+" then
|
||||
let mod := targetSpec.drop 1 |>.toName
|
||||
if let some mod := pkg.findModule? mod then
|
||||
Array.singleton <$> resolveModuleTarget ws mod facet
|
||||
else
|
||||
throw <| CliError.unknownModule mod
|
||||
else
|
||||
resolveTargetInPackage ws pkg targetSpec facet
|
||||
| _ =>
|
||||
throw <| CliError.invalidTargetSpec spec '/'
|
||||
|
||||
def parseTargetSpec (ws : Workspace) (spec : String) : Except CliError (Array BuildSpec) := do
|
||||
match spec.splitOn ":" with
|
||||
| [spec] =>
|
||||
resolveTargetBaseSpec ws spec .anonymous
|
||||
| [rootSpec, facet] =>
|
||||
resolveTargetBaseSpec ws rootSpec facet.toName
|
||||
| _ =>
|
||||
throw <| CliError.invalidTargetSpec spec ':'
|
||||
|
||||
def parseTargetSpecs (ws : Workspace) (specs : List String) : Except CliError (Array BuildSpec) := do
|
||||
let mut results := #[]
|
||||
for spec in specs do
|
||||
results := results ++ (← parseTargetSpec ws spec)
|
||||
if results.isEmpty then
|
||||
results ← resolveDefaultPackageTarget ws ws.root
|
||||
return results
|
||||
70
src/lake/Lake/CLI/Error.lean
Normal file
70
src/lake/Lake/CLI/Error.lean
Normal file
@@ -0,0 +1,70 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
|
||||
namespace Lake
|
||||
open Lean (Name)
|
||||
|
||||
inductive CliError
|
||||
/- CLI Errors -/
|
||||
| missingCommand
|
||||
| unknownCommand (cmd : String)
|
||||
| missingArg (arg : String)
|
||||
| missingOptArg (opt arg : String)
|
||||
| unknownShortOption (opt : Char)
|
||||
| unknownLongOption (opt : String)
|
||||
| unexpectedArguments (args : List String)
|
||||
/- Init CLI Errors -/
|
||||
| unknownTemplate (spec : String)
|
||||
/- Build CLI Errors -/
|
||||
| unknownModule (mod : Name)
|
||||
| unknownPackage (spec : String)
|
||||
| unknownFacet (type : String) (facet : Name)
|
||||
| unknownTarget (target : Name)
|
||||
| missingModule (pkg : Name) (mod : Name)
|
||||
| missingTarget (pkg : Name) (spec : String)
|
||||
| nonCliTarget (target : Name)
|
||||
| nonCliFacet (type : String) (facet : Name)
|
||||
| invalidTargetSpec (spec : String) (tooMany : Char)
|
||||
| invalidFacet (target : Name) (facet : Name)
|
||||
/- Script CLI Error -/
|
||||
| unknownScript (script : String)
|
||||
| missingScriptDoc (script : String)
|
||||
| invalidScriptSpec (spec : String)
|
||||
/- Config Errors -/
|
||||
| unknownLeanInstall
|
||||
| unknownLakeInstall
|
||||
| leanRevMismatch (expected actual : String)
|
||||
deriving Inhabited, Repr
|
||||
|
||||
namespace CliError
|
||||
|
||||
def toString : CliError → String
|
||||
| missingCommand => "missing command"
|
||||
| unknownCommand cmd => s!"unknown command '{cmd}'"
|
||||
| missingArg arg => s!"missing {arg}"
|
||||
| missingOptArg opt arg => s!"missing {arg} after {opt}"
|
||||
| unknownShortOption opt => s!"unknown short option '-{opt}'"
|
||||
| unknownLongOption opt => s!"unknown long option '{opt}'"
|
||||
| unexpectedArguments as => s!"unexpected arguments: {" ".intercalate as}"
|
||||
| unknownTemplate spec => s!"unknown package template `{spec}`"
|
||||
| unknownModule mod => s!"unknown module `{mod.toString false}`"
|
||||
| unknownPackage spec => s!"unknown package `{spec}`"
|
||||
| unknownFacet ty f => s!"unknown {ty} facet `{f.toString false}`"
|
||||
| unknownTarget t => s!"unknown target `{t.toString false}`"
|
||||
| missingModule pkg mod => s!"package '{pkg.toString false}' has no module '{mod.toString false}'"
|
||||
| missingTarget pkg spec => s!"package '{pkg.toString false}' has no target '{spec}'"
|
||||
| nonCliTarget t => s!"target `{t.toString false}` is not a buildable via `lake`"
|
||||
| nonCliFacet t f => s!"{t} facet `{f.toString false}` is not a buildable via `lake`"
|
||||
| invalidTargetSpec s c => s!"invalid script spec '{s}' (too many '{c}')"
|
||||
| invalidFacet t f => s!"invalid facet `{f.toString false}`; target {t.toString false} has no facets"
|
||||
| unknownScript s => s!"unknown script {s}"
|
||||
| missingScriptDoc s => s!"no documentation provided for `{s}`"
|
||||
| invalidScriptSpec s => s!"invalid script spec '{s}' (too many '/')"
|
||||
| unknownLeanInstall => "could not detect a Lean installation"
|
||||
| unknownLakeInstall => "could not detect the configuration of the Lake installation"
|
||||
| leanRevMismatch e a => s!"expected Lean commit {e}, but got {if a.isEmpty then "nothing" else a}"
|
||||
|
||||
instance : ToString CliError := ⟨toString⟩
|
||||
242
src/lake/Lake/CLI/Help.lean
Normal file
242
src/lake/Lake/CLI/Help.lean
Normal file
@@ -0,0 +1,242 @@
|
||||
/-
|
||||
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Gabriel Ebner, Sebastian Ullrich, Mac Malone
|
||||
-/
|
||||
import Lake.Version
|
||||
|
||||
namespace Lake
|
||||
|
||||
def usage :=
|
||||
uiVersionString ++ "
|
||||
|
||||
USAGE:
|
||||
lake [OPTIONS] <COMMAND>
|
||||
|
||||
OPTIONS:
|
||||
--version print version and exit
|
||||
--help, -h print help of the program or a command and exit
|
||||
--dir, -d=file use the package configuration in a specific directory
|
||||
--file, -f=file use a specific file for the package configuration
|
||||
--quiet, -q hide progress messages
|
||||
--verbose, -v show verbose information (command invocations)
|
||||
--lean=cmd specify the `lean` command used by Lake
|
||||
-K key[=value] set the configuration file option named key
|
||||
--old only rebuild modified modules (ignore transitive deps)
|
||||
--update, -U update manifest before building
|
||||
|
||||
COMMANDS:
|
||||
new <name> [<temp>] create a Lean package in a new directory
|
||||
init <name> [<temp>] create a Lean package in the current directory
|
||||
build [<targets>...] build targets
|
||||
update update dependencies
|
||||
upload <tag> upload build artifacts to a GitHub release
|
||||
clean remove build outputs
|
||||
script manage and run workspace scripts
|
||||
scripts shorthand for `lake script list`
|
||||
run <script> shorthand for `lake script run`
|
||||
serve start the Lean language server
|
||||
env <cmd> [<args>...] execute a command in the workspace's environment
|
||||
exe <exe> [<args>...] build an exe and run it in the workspace's environment
|
||||
|
||||
See `lake help <command>` for more information on a specific command."
|
||||
|
||||
def templateHelp :=
|
||||
s!"The initial configuration and starter files are based on the template:
|
||||
|
||||
std library and executable; default
|
||||
exe executable only
|
||||
lib library only
|
||||
math library only with a mathlib dependency"
|
||||
|
||||
def helpNew :=
|
||||
s!"Create a Lean package in a new directory
|
||||
|
||||
USAGE:
|
||||
lake new <name> [<template>]
|
||||
|
||||
{templateHelp}"
|
||||
|
||||
def helpInit :=
|
||||
s!"Create a Lean package in the current directory
|
||||
|
||||
USAGE:
|
||||
lake init <name> [<template>]
|
||||
|
||||
{templateHelp}"
|
||||
|
||||
def helpBuild :=
|
||||
"Build targets
|
||||
|
||||
USAGE:
|
||||
lake build [<targets>...]
|
||||
|
||||
A target is specified with a string of the form:
|
||||
|
||||
[[@]<package>/][<target>|[+]<module>][:<facet>]
|
||||
|
||||
The optional `@` and `+` markers can be used to disambiguate packages
|
||||
and modules from other kinds of targets (i.e., executables and libraries).
|
||||
|
||||
LIBRARY FACETS: build the library's ...
|
||||
lean (default) Lean binaries (*.olean, *.ilean files)
|
||||
static static binary (*.a file)
|
||||
shared shared binary (*.so, *.dll, or *.dylib file)
|
||||
|
||||
MODULE FACETS: build the module's ...
|
||||
deps transitive local imports & shared library dependencies
|
||||
bin (default) Lean binaries (*.olean, *.ilean files) and *.c file
|
||||
o *.o object file (of its C file)
|
||||
dynlib shared library (e.g., for `--load-dynlib`)
|
||||
|
||||
TARGET EXAMPLES: build the ...
|
||||
a default facet of target `a`
|
||||
@a default target(s) of package `a`
|
||||
+A olean and .ilean files of module `A`
|
||||
a/b default facet of target `b` of package `a`
|
||||
a/+A:c C file of module `A` of package `a`
|
||||
:foo facet `foo` of the root package
|
||||
|
||||
A bare `build` command will build the default facet of the root package.
|
||||
Package dependencies are not updated during a build."
|
||||
|
||||
def helpUpdate :=
|
||||
"Update dependencies
|
||||
|
||||
USAGE:
|
||||
lake update
|
||||
|
||||
This command sets up the directory with the package's dependencies
|
||||
(i.e., `packagesDir`, which is, by default, `lake-packages`).
|
||||
|
||||
For each (transitive) git dependency, the specified commit is checked out
|
||||
into a sub-directory of `packagesDir`. Already checked out dependencies are
|
||||
updated to the latest version compatible with the package's configuration.
|
||||
If there are dependencies on multiple versions of the same package, the
|
||||
version materialized is undefined. The specific revision of the resolved
|
||||
packages are cached in the `manifest.json` file of the `packagesDir`.
|
||||
|
||||
No copy is made of local dependencies."
|
||||
|
||||
def helpUpload :=
|
||||
"Upload build artifacts to a GitHub release
|
||||
|
||||
USAGE:
|
||||
lake upload <tag>
|
||||
|
||||
Packs the root package's `buildDir` into a `tar.gz` archive using `tar` and
|
||||
then uploads the asset to the pre-existing GitHub release `tag` using `gh`."
|
||||
|
||||
def helpClean :=
|
||||
"Remove build outputs
|
||||
|
||||
USAGE:
|
||||
lake clean
|
||||
|
||||
Deletes the build directory of the package."
|
||||
|
||||
def helpScriptCli :=
|
||||
"Manage Lake scripts
|
||||
|
||||
USAGE:
|
||||
lake script <COMMAND>
|
||||
|
||||
COMMANDS:
|
||||
list list available scripts
|
||||
run <script> run a script
|
||||
doc <script> print the docstring of a given script
|
||||
|
||||
See `lake help <command>` for more information on a specific command."
|
||||
|
||||
def helpScriptList :=
|
||||
"List available scripts
|
||||
|
||||
USAGE:
|
||||
lake script list
|
||||
|
||||
This command prints the list of all available scripts in the workspace."
|
||||
|
||||
def helpScriptRun :=
|
||||
"Run a script
|
||||
|
||||
USAGE:
|
||||
lake script run [<package>/]<script> [<args>...]
|
||||
|
||||
This command runs the given `script` from `package`, passing `args` to it.
|
||||
Defaults to the root package.
|
||||
|
||||
A bare `run` command will run the default script(s) of the root package
|
||||
(with no arguments)."
|
||||
|
||||
def helpScriptDoc :=
|
||||
"Print a script's docstring
|
||||
|
||||
USAGE:
|
||||
lake script doc [<package>/]<script>
|
||||
|
||||
Print the docstring of `script` in `package`. Defaults to the root package."
|
||||
|
||||
def helpServe :=
|
||||
"Start the Lean language server
|
||||
|
||||
USAGE:
|
||||
lake serve [-- <args>...]
|
||||
|
||||
Run the language server of the Lean installation (i.e., via `lean --server`)
|
||||
with the package configuration's `moreServerArgs` field and `args`.
|
||||
"
|
||||
|
||||
def helpEnv :=
|
||||
"Execute a command in the workspace's environment
|
||||
|
||||
USAGE:
|
||||
lake env <cmd> [<args>...]
|
||||
|
||||
Spawns a new process executing `cmd` with the given `args` and with
|
||||
the environment set based on the workspace configuration and the detected
|
||||
Lean/Lake installations.
|
||||
|
||||
Specifically, this command sets the following environment variables:
|
||||
|
||||
LAKE set to the detected Lake executable
|
||||
LAKE_HOME set to the detected Lake home
|
||||
LEAN_SYSROOT set to the detected Lean sysroot
|
||||
LEAN_AR set to the detected Lean `ar` binary
|
||||
LEAN_CC set to the detected `cc` (if not using bundled one)
|
||||
LEAN_PATH adds the workspace's library directories
|
||||
LEAN_SRC_PATH adds the workspace's source directories
|
||||
PATH adds the workspace's library directories (Windows)
|
||||
DYLD_LIBRARY_PATH adds the workspace's library directories (MacOS)
|
||||
LD_LIBRARY_PATH adds the workspace's library directories (other Unix)"
|
||||
|
||||
def helpExe :=
|
||||
"Build an executable target and run it in the workspace's environment
|
||||
|
||||
USAGE:
|
||||
lake exe <exe-target> [<args>...]
|
||||
|
||||
Looks for the executable target in the workspace (see `lake help build` to
|
||||
learn how to specify targets), builds it if it is out of date, and then runs
|
||||
it with the given `args` in the workspace's environment (see `lake help env`
|
||||
for how the environment is set)."
|
||||
|
||||
def helpScript : (cmd : String) → String
|
||||
| "list" => helpScriptList
|
||||
| "run" => helpScriptRun
|
||||
| "doc" => helpScriptDoc
|
||||
| _ => helpScriptCli
|
||||
|
||||
def help : (cmd : String) → String
|
||||
| "new" => helpNew
|
||||
| "init" => helpInit
|
||||
| "build" => helpBuild
|
||||
| "update" => helpUpdate
|
||||
| "upload" => helpUpload
|
||||
| "clean" => helpClean
|
||||
| "script" => helpScriptCli
|
||||
| "scripts" => helpScriptList
|
||||
| "run" => helpScriptRun
|
||||
| "serve" => helpServe
|
||||
| "env" => helpEnv
|
||||
| "exe" => helpExe
|
||||
| _ => usage
|
||||
205
src/lake/Lake/CLI/Init.lean
Normal file
205
src/lake/Lake/CLI/Init.lean
Normal file
@@ -0,0 +1,205 @@
|
||||
/-
|
||||
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Gabriel Ebner, Sebastian Ullrich, Mac Malone
|
||||
-/
|
||||
import Lake.Util.Git
|
||||
import Lake.Util.Sugar
|
||||
import Lake.Config.Package
|
||||
import Lake.Config.Workspace
|
||||
import Lake.Load.Config
|
||||
import Lake.Build.Actions
|
||||
|
||||
namespace Lake
|
||||
open Git System
|
||||
|
||||
/-- The default module of an executable in `std` package. -/
|
||||
def defaultExeRoot : Name := `Main
|
||||
|
||||
/-- `elan` toolchain file name -/
|
||||
def toolchainFileName : FilePath :=
|
||||
"lean-toolchain"
|
||||
|
||||
def gitignoreContents :=
|
||||
s!"/{defaultBuildDir}
|
||||
/{defaultPackagesDir}/*
|
||||
"
|
||||
|
||||
def libFileContents :=
|
||||
s!"def hello := \"world\""
|
||||
|
||||
def mainFileName : FilePath :=
|
||||
s!"{defaultExeRoot}.lean"
|
||||
|
||||
def mainFileContents (libRoot : String) :=
|
||||
s!"import {libRoot}
|
||||
|
||||
def main : IO Unit :=
|
||||
IO.println s!\"Hello, \{hello}!\"
|
||||
"
|
||||
|
||||
def exeFileContents :=
|
||||
s!"def main : IO Unit :=
|
||||
IO.println s!\"Hello, world!\"
|
||||
"
|
||||
|
||||
def stdConfigFileContents (pkgName libRoot : String) :=
|
||||
s!"import Lake
|
||||
open Lake DSL
|
||||
|
||||
package {pkgName} \{
|
||||
-- add package configuration options here
|
||||
}
|
||||
|
||||
lean_lib {libRoot} \{
|
||||
-- add library configuration options here
|
||||
}
|
||||
|
||||
@[default_target]
|
||||
lean_exe {pkgName} \{
|
||||
root := `Main
|
||||
}
|
||||
"
|
||||
|
||||
def exeConfigFileContents (pkgName exeRoot : String) :=
|
||||
s!"import Lake
|
||||
open Lake DSL
|
||||
|
||||
package {pkgName} \{
|
||||
-- add package configuration options here
|
||||
}
|
||||
|
||||
@[default_target]
|
||||
lean_exe {exeRoot} \{
|
||||
-- add executable configuration options here
|
||||
}
|
||||
"
|
||||
|
||||
def libConfigFileContents (pkgName libRoot : String) :=
|
||||
s!"import Lake
|
||||
open Lake DSL
|
||||
|
||||
package {pkgName} \{
|
||||
-- add package configuration options here
|
||||
}
|
||||
|
||||
@[default_target]
|
||||
lean_lib {libRoot} \{
|
||||
-- add library configuration options here
|
||||
}
|
||||
"
|
||||
|
||||
def mathConfigFileContents (pkgName libRoot : String) :=
|
||||
s!"import Lake
|
||||
open Lake DSL
|
||||
|
||||
package {pkgName} \{
|
||||
-- add any package configuration options here
|
||||
}
|
||||
|
||||
require mathlib from git
|
||||
\"https://github.com/leanprover-community/mathlib4.git\"
|
||||
|
||||
@[default_target]
|
||||
lean_lib {libRoot} \{
|
||||
-- add any library configuration options here
|
||||
}
|
||||
"
|
||||
|
||||
def mathToolchainUrl : String :=
|
||||
"https://raw.githubusercontent.com/leanprover-community/mathlib4/master/lean-toolchain"
|
||||
|
||||
/-- The options for the template argument to `initPkg`. -/
|
||||
inductive InitTemplate
|
||||
| std | exe | lib | math
|
||||
deriving Repr, DecidableEq
|
||||
|
||||
instance : Inhabited InitTemplate := ⟨.std⟩
|
||||
|
||||
def InitTemplate.parse? : String → Option InitTemplate
|
||||
| "std" => some .std
|
||||
| "exe" => some .exe
|
||||
| "lib" => some .lib
|
||||
| "math" => some .math
|
||||
| _ => none
|
||||
|
||||
def InitTemplate.configFileContents (pkgName root : String) : InitTemplate → String
|
||||
| .std => stdConfigFileContents pkgName root
|
||||
| .lib => libConfigFileContents pkgName root
|
||||
| .exe => exeConfigFileContents pkgName root
|
||||
| .math => mathConfigFileContents pkgName root
|
||||
|
||||
def escapeName! : Name → String
|
||||
| .anonymous => "[anonymous]"
|
||||
| .str .anonymous s => escape s
|
||||
| .str n s => escapeName! n ++ "." ++ escape s
|
||||
| _ => unreachable!
|
||||
where
|
||||
escape s := Lean.idBeginEscape.toString ++ s ++ Lean.idEndEscape.toString
|
||||
|
||||
/-- Initialize a new Lake package in the given directory with the given name. -/
|
||||
def initPkg (dir : FilePath) (name : String) (tmp : InitTemplate) : LogIO PUnit := do
|
||||
let pkgName := stringToLegalOrSimpleName name
|
||||
|
||||
-- determine the name to use for the root
|
||||
-- use upper camel case unless the specific module name already exists
|
||||
let (root, rootFile, rootExists) ← do
|
||||
let root := pkgName
|
||||
let rootFile := Lean.modToFilePath dir root "lean"
|
||||
let rootExists ← rootFile.pathExists
|
||||
if tmp = .exe || rootExists then
|
||||
pure (root, rootFile, rootExists)
|
||||
else
|
||||
let root := toUpperCamelCase (toUpperCamelCaseString name |>.toName)
|
||||
let rootFile := Lean.modToFilePath dir root "lean"
|
||||
pure (root, rootFile, ← rootFile.pathExists)
|
||||
|
||||
-- write default configuration file
|
||||
let configFile := dir / defaultConfigFile
|
||||
if (← configFile.pathExists) then
|
||||
error "package already initialized"
|
||||
let rootNameStr := escapeName! root
|
||||
let contents := tmp.configFileContents (escapeName! pkgName) rootNameStr
|
||||
IO.FS.writeFile configFile contents
|
||||
|
||||
-- write example code if the files do not already exist
|
||||
if tmp = .exe then
|
||||
unless (← rootFile.pathExists) do
|
||||
IO.FS.writeFile rootFile exeFileContents
|
||||
else
|
||||
if !rootExists then
|
||||
IO.FS.createDirAll rootFile.parent.get!
|
||||
IO.FS.writeFile rootFile libFileContents
|
||||
if tmp = .std then
|
||||
let mainFile := dir / mainFileName
|
||||
unless (← mainFile.pathExists) do
|
||||
IO.FS.writeFile mainFile <| mainFileContents rootNameStr
|
||||
|
||||
-- write Lean's toolchain to file (if it has one) for `elan`
|
||||
if Lean.toolchain ≠ "" then
|
||||
if tmp = .math then
|
||||
download "lean-toolchain" mathToolchainUrl (dir / toolchainFileName)
|
||||
else
|
||||
IO.FS.writeFile (dir / toolchainFileName) <| Lean.toolchain ++ "\n"
|
||||
|
||||
-- update `.gitignore` with additional entries for Lake
|
||||
let h ← IO.FS.Handle.mk (dir / ".gitignore") IO.FS.Mode.append
|
||||
h.putStr gitignoreContents
|
||||
|
||||
-- initialize a `.git` repository if none already
|
||||
unless (← FilePath.isDir <| dir / ".git") do
|
||||
let repo := GitRepo.mk dir
|
||||
try
|
||||
repo.quietInit
|
||||
unless upstreamBranch = "master" do
|
||||
repo.checkoutBranch upstreamBranch
|
||||
else
|
||||
logWarning "failed to initialize git repository"
|
||||
|
||||
def init (pkgName : String) (tmp : InitTemplate) : LogIO PUnit :=
|
||||
initPkg "." pkgName tmp
|
||||
|
||||
def new (pkgName : String) (tmp : InitTemplate) : LogIO PUnit := do
|
||||
let dirName := pkgName.map fun chr => if chr == '.' then '-' else chr
|
||||
IO.FS.createDir dirName
|
||||
initPkg dirName pkgName tmp
|
||||
384
src/lake/Lake/CLI/Main.lean
Normal file
384
src/lake/Lake/CLI/Main.lean
Normal file
@@ -0,0 +1,384 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Load
|
||||
import Lake.Build.Imports
|
||||
import Lake.Util.Error
|
||||
import Lake.Util.MainM
|
||||
import Lake.Util.Cli
|
||||
import Lake.CLI.Init
|
||||
import Lake.CLI.Help
|
||||
import Lake.CLI.Build
|
||||
import Lake.CLI.Error
|
||||
import Lake.CLI.Actions
|
||||
import Lake.CLI.Serve
|
||||
|
||||
-- # CLI
|
||||
|
||||
open System
|
||||
open Lean (Json toJson fromJson? LeanPaths)
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-! ## General options for top-level `lake` -/
|
||||
|
||||
structure LakeOptions where
|
||||
rootDir : FilePath := "."
|
||||
configFile : FilePath := defaultConfigFile
|
||||
leanInstall? : Option LeanInstall := none
|
||||
lakeInstall? : Option LakeInstall := none
|
||||
configOpts : NameMap String := {}
|
||||
subArgs : List String := []
|
||||
wantsHelp : Bool := false
|
||||
verbosity : Verbosity := .normal
|
||||
oldMode : Bool := false
|
||||
updateDeps : Bool := false
|
||||
|
||||
/-- Get the Lean installation. Error if missing. -/
|
||||
def LakeOptions.getLeanInstall (opts : LakeOptions) : Except CliError LeanInstall :=
|
||||
match opts.leanInstall? with
|
||||
| none => .error CliError.unknownLeanInstall
|
||||
| some lean => .ok lean
|
||||
|
||||
/-- Get the Lake installation. Error if missing. -/
|
||||
def LakeOptions.getLakeInstall (opts : LakeOptions) : Except CliError LakeInstall :=
|
||||
match opts.lakeInstall? with
|
||||
| none => .error CliError.unknownLakeInstall
|
||||
| some lake => .ok lake
|
||||
|
||||
/-- Get the Lean and Lake installation. Error if either is missing. -/
|
||||
def LakeOptions.getInstall (opts : LakeOptions) : Except CliError (LeanInstall × LakeInstall) := do
|
||||
return (← opts.getLeanInstall, ← opts.getLakeInstall)
|
||||
|
||||
/-- Compute the Lake environment based on `opts`. Error if an install is missing. -/
|
||||
def LakeOptions.computeEnv (opts : LakeOptions) : EIO CliError Lake.Env := do
|
||||
Env.compute (← opts.getLakeInstall) (← opts.getLeanInstall)
|
||||
|
||||
/-- Make a `LoadConfig` from a `LakeOptions`. -/
|
||||
def LakeOptions.mkLoadConfig (opts : LakeOptions) : EIO CliError LoadConfig :=
|
||||
return {
|
||||
env := ← opts.computeEnv
|
||||
rootDir := opts.rootDir
|
||||
configFile := opts.rootDir / opts.configFile
|
||||
configOpts := opts.configOpts
|
||||
leanOpts := Lean.Options.empty
|
||||
}
|
||||
|
||||
export LakeOptions (mkLoadConfig)
|
||||
|
||||
/-! ## Monad -/
|
||||
|
||||
abbrev CliMainM := ExceptT CliError MainM
|
||||
abbrev CliStateM := StateT LakeOptions CliMainM
|
||||
abbrev CliM := ArgsT CliStateM
|
||||
|
||||
def CliM.run (self : CliM α) (args : List String) : BaseIO ExitCode := do
|
||||
let (leanInstall?, lakeInstall?) ← findInstall?
|
||||
let main := self args |>.run' {leanInstall?, lakeInstall?}
|
||||
let main := main.run >>= fun | .ok a => pure a | .error e => error e.toString
|
||||
main.run
|
||||
|
||||
instance : MonadLift LogIO CliStateM :=
|
||||
⟨fun x => do MainM.runLogIO x (← get).verbosity⟩
|
||||
|
||||
instance : MonadLift OptionIO MainM where
|
||||
monadLift x := x.adaptExcept (fun _ => 1)
|
||||
|
||||
/-! ## Argument Parsing -/
|
||||
|
||||
def takeArg (arg : String) : CliM String := do
|
||||
match (← takeArg?) with
|
||||
| none => throw <| CliError.missingArg arg
|
||||
| some arg => pure arg
|
||||
|
||||
def takeOptArg (opt arg : String) : CliM String := do
|
||||
match (← takeArg?) with
|
||||
| none => throw <| CliError.missingOptArg opt arg
|
||||
| some arg => pure arg
|
||||
|
||||
/--
|
||||
Verify that there are no CLI arguments remaining
|
||||
before running the given action.
|
||||
-/
|
||||
def noArgsRem (act : CliStateM α) : CliM α := do
|
||||
let args ← getArgs
|
||||
if args.isEmpty then act else
|
||||
throw <| CliError.unexpectedArguments args
|
||||
|
||||
/-! ## Option Parsing -/
|
||||
|
||||
def getWantsHelp : CliStateM Bool :=
|
||||
(·.wantsHelp) <$> get
|
||||
|
||||
def setLean (lean : String) : CliStateM PUnit := do
|
||||
let leanInstall? ← findLeanCmdInstall? lean
|
||||
modify ({· with leanInstall?})
|
||||
|
||||
def setConfigOpt (kvPair : String) : CliM PUnit :=
|
||||
let pos := kvPair.posOf '='
|
||||
let (key, val) :=
|
||||
if pos = kvPair.endPos then
|
||||
(kvPair.toName, "")
|
||||
else
|
||||
(kvPair.extract 0 pos |>.toName, kvPair.extract (kvPair.next pos) kvPair.endPos)
|
||||
modifyThe LakeOptions fun opts =>
|
||||
{opts with configOpts := opts.configOpts.insert key val}
|
||||
|
||||
def lakeShortOption : (opt : Char) → CliM PUnit
|
||||
| 'q' => modifyThe LakeOptions ({· with verbosity := .quiet})
|
||||
| 'v' => modifyThe LakeOptions ({· with verbosity := .verbose})
|
||||
| 'd' => do let rootDir ← takeOptArg "-d" "path"; modifyThe LakeOptions ({· with rootDir})
|
||||
| 'f' => do let configFile ← takeOptArg "-f" "path"; modifyThe LakeOptions ({· with configFile})
|
||||
| 'K' => do setConfigOpt <| ← takeOptArg "-K" "key-value pair"
|
||||
| 'U' => modifyThe LakeOptions ({· with updateDeps := true})
|
||||
| 'h' => modifyThe LakeOptions ({· with wantsHelp := true})
|
||||
| opt => throw <| CliError.unknownShortOption opt
|
||||
|
||||
def lakeLongOption : (opt : String) → CliM PUnit
|
||||
| "--quiet" => modifyThe LakeOptions ({· with verbosity := .quiet})
|
||||
| "--verbose" => modifyThe LakeOptions ({· with verbosity := .verbose})
|
||||
| "--update" => modifyThe LakeOptions ({· with updateDeps := true})
|
||||
| "--old" => modifyThe LakeOptions ({· with oldMode := true})
|
||||
| "--dir" => do let rootDir ← takeOptArg "--dir" "path"; modifyThe LakeOptions ({· with rootDir})
|
||||
| "--file" => do let configFile ← takeOptArg "--file" "path"; modifyThe LakeOptions ({· with configFile})
|
||||
| "--lean" => do setLean <| ← takeOptArg "--lean" "path or command"
|
||||
| "--help" => modifyThe LakeOptions ({· with wantsHelp := true})
|
||||
| "--" => do let subArgs ← takeArgs; modifyThe LakeOptions ({· with subArgs})
|
||||
| opt => throw <| CliError.unknownLongOption opt
|
||||
|
||||
def lakeOption :=
|
||||
option {
|
||||
short := lakeShortOption
|
||||
long := lakeLongOption
|
||||
longShort := shortOptionWithArg lakeShortOption
|
||||
}
|
||||
|
||||
/-! ## Actions -/
|
||||
|
||||
/-- Verify the Lean version Lake was built with matches that of the give Lean installation. -/
|
||||
def verifyLeanVersion (leanInstall : LeanInstall) : Except CliError PUnit := do
|
||||
unless leanInstall.githash == Lean.githash do
|
||||
throw <| CliError.leanRevMismatch Lean.githash leanInstall.githash
|
||||
|
||||
/-- Output the detected installs and verify the Lean version. -/
|
||||
def verifyInstall (opts : LakeOptions) : ExceptT CliError MainM PUnit := do
|
||||
IO.println s!"Lean:\n{repr <| opts.leanInstall?}"
|
||||
IO.println s!"Lake:\n{repr <| opts.lakeInstall?}"
|
||||
let (leanInstall, _) ← opts.getInstall
|
||||
verifyLeanVersion leanInstall
|
||||
|
||||
def parseScriptSpec (ws : Workspace) (spec : String) : Except CliError (Package × String) :=
|
||||
match spec.splitOn "/" with
|
||||
| [script] => return (ws.root, script)
|
||||
| [pkg, script] => return (← parsePackageSpec ws pkg, script)
|
||||
| _ => throw <| CliError.invalidScriptSpec spec
|
||||
|
||||
def parseTemplateSpec (spec : String) : Except CliError InitTemplate :=
|
||||
if spec.isEmpty then
|
||||
pure default
|
||||
else if let some tmp := InitTemplate.parse? spec then
|
||||
pure tmp
|
||||
else
|
||||
throw <| CliError.unknownTemplate spec
|
||||
|
||||
/-! ## Commands -/
|
||||
|
||||
namespace lake
|
||||
|
||||
/-! ### `lake script` CLI -/
|
||||
|
||||
namespace script
|
||||
|
||||
protected def list : CliM PUnit := do
|
||||
processOptions lakeOption
|
||||
let config ← mkLoadConfig (← getThe LakeOptions)
|
||||
noArgsRem do
|
||||
let ws ← loadWorkspace config
|
||||
ws.packageMap.forM fun _ pkg => do
|
||||
let pkgName := pkg.name.toString (escape := false)
|
||||
pkg.scripts.forM fun name _ =>
|
||||
let scriptName := name.toString (escape := false)
|
||||
IO.println s!"{pkgName}/{scriptName}"
|
||||
|
||||
protected nonrec def run : CliM PUnit := do
|
||||
processOptions lakeOption
|
||||
let config ← mkLoadConfig (← getThe LakeOptions)
|
||||
let ws ← loadWorkspace config
|
||||
if let some spec ← takeArg? then
|
||||
let args ← takeArgs
|
||||
let (pkg, scriptName) ← parseScriptSpec ws spec
|
||||
if let some script := pkg.scripts.find? scriptName then
|
||||
exit <| ← script.run args |>.run {opaqueWs := ws}
|
||||
else do
|
||||
throw <| CliError.unknownScript scriptName
|
||||
else
|
||||
for script in ws.root.defaultScripts do
|
||||
exitIfErrorCode <| ← script.run [] |>.run {opaqueWs := ws}
|
||||
exit 0
|
||||
|
||||
protected def doc : CliM PUnit := do
|
||||
processOptions lakeOption
|
||||
let spec ← takeArg "script name"
|
||||
let config ← mkLoadConfig (← getThe LakeOptions)
|
||||
noArgsRem do
|
||||
let ws ← loadWorkspace config
|
||||
let (pkg, scriptName) ← parseScriptSpec ws spec
|
||||
if let some script := pkg.scripts.find? scriptName then
|
||||
match script.doc? with
|
||||
| some doc => IO.println doc
|
||||
| none => throw <| CliError.missingScriptDoc scriptName
|
||||
else
|
||||
throw <| CliError.unknownScript scriptName
|
||||
|
||||
protected def help : CliM PUnit := do
|
||||
IO.println <| helpScript <| (← takeArg?).getD ""
|
||||
|
||||
end script
|
||||
|
||||
def scriptCli : (cmd : String) → CliM PUnit
|
||||
| "list" => script.list
|
||||
| "run" => script.run
|
||||
| "doc" => script.doc
|
||||
| "help" => script.help
|
||||
| cmd => throw <| CliError.unknownCommand cmd
|
||||
|
||||
/-! ### `lake` CLI -/
|
||||
|
||||
protected def new : CliM PUnit := do
|
||||
processOptions lakeOption
|
||||
let pkgName ← takeArg "package name"
|
||||
let template ← parseTemplateSpec <| (← takeArg?).getD ""
|
||||
noArgsRem do MainM.runLogIO (new pkgName template) (← getThe LakeOptions).verbosity
|
||||
|
||||
protected def init : CliM PUnit := do
|
||||
processOptions lakeOption
|
||||
let pkgName ← takeArg "package name"
|
||||
let template ← parseTemplateSpec <| (← takeArg?).getD ""
|
||||
noArgsRem do MainM.runLogIO (init pkgName template) (← getThe LakeOptions).verbosity
|
||||
|
||||
protected def build : CliM PUnit := do
|
||||
processOptions lakeOption
|
||||
let opts ← getThe LakeOptions
|
||||
let config ← mkLoadConfig opts
|
||||
let ws ← loadWorkspace config opts.updateDeps
|
||||
let targetSpecs ← takeArgs
|
||||
let specs ← parseTargetSpecs ws targetSpecs
|
||||
ws.runBuild (buildSpecs specs) opts.oldMode |>.run (MonadLog.io opts.verbosity)
|
||||
|
||||
protected def resolveDeps : CliM PUnit := do
|
||||
processOptions lakeOption
|
||||
let opts ← getThe LakeOptions
|
||||
let config ← mkLoadConfig opts
|
||||
noArgsRem do
|
||||
liftM <| discard <| (loadWorkspace config opts.updateDeps).run (MonadLog.io opts.verbosity)
|
||||
|
||||
protected def update : CliM PUnit := do
|
||||
processOptions lakeOption
|
||||
let opts ← getThe LakeOptions
|
||||
let config ← mkLoadConfig opts
|
||||
noArgsRem do
|
||||
liftM <| (updateManifest config).run (MonadLog.io opts.verbosity)
|
||||
|
||||
protected def upload : CliM PUnit := do
|
||||
processOptions lakeOption
|
||||
let tag ← takeArg "release tag"
|
||||
let opts ← getThe LakeOptions
|
||||
let config ← mkLoadConfig opts
|
||||
let ws ← loadWorkspace config
|
||||
noArgsRem do
|
||||
liftM <| uploadRelease ws.root tag |>.run (MonadLog.io opts.verbosity)
|
||||
|
||||
protected def printPaths : CliM PUnit := do
|
||||
processOptions lakeOption
|
||||
let opts ← getThe LakeOptions
|
||||
let config ← mkLoadConfig opts
|
||||
printPaths config (← takeArgs) opts.oldMode opts.verbosity
|
||||
|
||||
protected def clean : CliM PUnit := do
|
||||
processOptions lakeOption
|
||||
let config ← mkLoadConfig (← getThe LakeOptions)
|
||||
noArgsRem do (← loadWorkspace config).clean
|
||||
|
||||
protected def script : CliM PUnit := do
|
||||
if let some cmd ← takeArg? then
|
||||
processLeadingOptions lakeOption -- between `lake script <cmd>` and args
|
||||
if (← getWantsHelp) then
|
||||
IO.println <| helpScript cmd
|
||||
else
|
||||
scriptCli cmd
|
||||
else
|
||||
throw <| CliError.missingCommand
|
||||
|
||||
protected def serve : CliM PUnit := do
|
||||
processOptions lakeOption
|
||||
let opts ← getThe LakeOptions
|
||||
let args := opts.subArgs.toArray
|
||||
let config ← mkLoadConfig opts
|
||||
noArgsRem do exit <| ← serve config args
|
||||
|
||||
protected def env : CliM PUnit := do
|
||||
let cmd ← takeArg "command"; let args ← takeArgs
|
||||
let config ← mkLoadConfig (← getThe LakeOptions)
|
||||
let ws ← loadWorkspace config
|
||||
let ctx := mkLakeContext ws
|
||||
exit <| ← (env cmd args.toArray).run ctx
|
||||
|
||||
protected def exe : CliM PUnit := do
|
||||
let exeName ← takeArg "executable name"
|
||||
let args ← takeArgs
|
||||
let opts ← getThe LakeOptions
|
||||
let config ← mkLoadConfig opts
|
||||
let ws ← loadWorkspace config
|
||||
let ctx := mkLakeContext ws
|
||||
exit <| ← (exe exeName args.toArray opts.oldMode).run ctx
|
||||
|
||||
protected def selfCheck : CliM PUnit := do
|
||||
processOptions lakeOption
|
||||
noArgsRem do verifyInstall (← getThe LakeOptions)
|
||||
|
||||
protected def help : CliM PUnit := do
|
||||
IO.println <| help <| (← takeArg?).getD ""
|
||||
|
||||
end lake
|
||||
|
||||
def lakeCli : (cmd : String) → CliM PUnit
|
||||
| "new" => lake.new
|
||||
| "init" => lake.init
|
||||
| "build" => lake.build
|
||||
| "update" => lake.update
|
||||
| "resolve-deps" => lake.resolveDeps
|
||||
| "upload" => lake.upload
|
||||
| "print-paths" => lake.printPaths
|
||||
| "clean" => lake.clean
|
||||
| "script" => lake.script
|
||||
| "scripts" => lake.script.list
|
||||
| "run" => lake.script.run
|
||||
| "serve" => lake.serve
|
||||
| "env" => lake.env
|
||||
| "exe" => lake.exe
|
||||
| "self-check" => lake.selfCheck
|
||||
| "help" => lake.help
|
||||
| cmd => throw <| CliError.unknownCommand cmd
|
||||
|
||||
def lake : CliM PUnit := do
|
||||
match (← getArgs) with
|
||||
| [] => IO.println usage
|
||||
| ["--version"] => IO.println uiVersionString
|
||||
| _ => -- normal CLI
|
||||
processLeadingOptions lakeOption -- between `lake` and command
|
||||
if let some cmd ← takeArg? then
|
||||
processLeadingOptions lakeOption -- between `lake <cmd>` and args
|
||||
if (← getWantsHelp) then
|
||||
IO.println <| help cmd
|
||||
else
|
||||
lakeCli cmd
|
||||
else
|
||||
if (← getWantsHelp) then
|
||||
IO.println usage
|
||||
else
|
||||
throw <| CliError.missingCommand
|
||||
|
||||
def cli (args : List String) : BaseIO ExitCode :=
|
||||
(lake).run args
|
||||
67
src/lake/Lake/CLI/Serve.lean
Normal file
67
src/lake/Lake/CLI/Serve.lean
Normal file
@@ -0,0 +1,67 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Load
|
||||
import Lake.Build
|
||||
import Lake.Util.MainM
|
||||
|
||||
namespace Lake
|
||||
open Lean (Json toJson fromJson? LeanPaths)
|
||||
|
||||
/-- Exit code to return if `print-paths` cannot find the config file. -/
|
||||
def noConfigFileCode : ExitCode := 2
|
||||
|
||||
/--
|
||||
Environment variable that is set when `lake serve` cannot parse the Lake configuration file
|
||||
and falls back to plain `lean --server`.
|
||||
-/
|
||||
def invalidConfigEnvVar := "LAKE_INVALID_CONFIG"
|
||||
|
||||
/--
|
||||
Build a list of imports of the package
|
||||
and print the `.olean` and source directories of every used package.
|
||||
If no configuration file exists, exit silently with `noConfigFileCode` (i.e, 2).
|
||||
|
||||
The `print-paths` command is used internally by Lean 4 server.
|
||||
-/
|
||||
def printPaths (config : LoadConfig) (imports : List String := [])
|
||||
(oldMode : Bool := false) (verbosity : Verbosity := .normal) : MainM PUnit := do
|
||||
let configFile := config.rootDir / config.configFile
|
||||
if (← configFile.pathExists) then
|
||||
if let some errLog := (← IO.getEnv invalidConfigEnvVar) then
|
||||
IO.eprint errLog
|
||||
IO.eprintln s!"Invalid Lake configuration. Please restart the server after fixing the Lake configuration file."
|
||||
exit 1
|
||||
let ws ← MainM.runLogIO (loadWorkspace config) verbosity
|
||||
let dynlibs ← ws.runBuild (buildImportsAndDeps imports) oldMode
|
||||
|>.run (MonadLog.eio verbosity)
|
||||
IO.println <| Json.compress <| toJson {
|
||||
oleanPath := ws.leanPath
|
||||
srcPath := ws.leanSrcPath
|
||||
loadDynlibPaths := dynlibs
|
||||
: LeanPaths
|
||||
}
|
||||
else
|
||||
exit noConfigFileCode
|
||||
|
||||
/--
|
||||
Start the Lean LSP for the `Workspace` loaded from `config`
|
||||
with the given additional `args`.
|
||||
-/
|
||||
def serve (config : LoadConfig) (args : Array String) : IO UInt32 := do
|
||||
let (extraEnv, moreServerArgs) ← do
|
||||
let (log, ws?) ← loadWorkspace config |>.captureLog
|
||||
IO.eprint log
|
||||
if let some ws := ws? then
|
||||
let ctx := mkLakeContext ws
|
||||
pure (← LakeT.run ctx getAugmentedEnv, ws.root.moreServerArgs)
|
||||
else
|
||||
IO.eprint "warning: package configuration has errors, falling back to plain `lean --server`"
|
||||
pure (config.env.installVars.push (invalidConfigEnvVar, log), #[])
|
||||
(← IO.Process.spawn {
|
||||
cmd := config.env.lean.lean.toString
|
||||
args := #["--server"] ++ moreServerArgs ++ args
|
||||
env := extraEnv
|
||||
}).wait
|
||||
6
src/lake/Lake/Config.lean
Normal file
6
src/lake/Lake/Config.lean
Normal file
@@ -0,0 +1,6 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Config.Monad
|
||||
26
src/lake/Lake/Config/Context.lean
Normal file
26
src/lake/Lake/Config/Context.lean
Normal file
@@ -0,0 +1,26 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Config.Opaque
|
||||
import Lake.Config.InstallPath
|
||||
|
||||
open System
|
||||
namespace Lake
|
||||
|
||||
/-- A Lake configuration. -/
|
||||
structure Context where
|
||||
opaqueWs : OpaqueWorkspace
|
||||
|
||||
/-- A transformer to equip a monad with a `Lake.Context`. -/
|
||||
abbrev LakeT := ReaderT Context
|
||||
|
||||
@[inline] def LakeT.run (ctx : Context) (self : LakeT m α) : m α :=
|
||||
ReaderT.run self ctx
|
||||
|
||||
/-- A monad equipped with a `Lake.Context`. -/
|
||||
abbrev LakeM := LakeT Id
|
||||
|
||||
@[inline] def LakeM.run (ctx : Context) (self : LakeM α) : α :=
|
||||
ReaderT.run self ctx |>.run
|
||||
41
src/lake/Lake/Config/Dependency.lean
Normal file
41
src/lake/Lake/Config/Dependency.lean
Normal file
@@ -0,0 +1,41 @@
|
||||
/-
|
||||
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Gabriel Ebner, Sebastian Ullrich, Mac Malone
|
||||
-/
|
||||
import Lean.Data.NameMap
|
||||
|
||||
namespace Lake
|
||||
open Lean System
|
||||
|
||||
/--
|
||||
The `src` of a `Dependency`.
|
||||
|
||||
In Lake, dependency sources currently come into flavors:
|
||||
* Local `path`s relative to the package's directory.
|
||||
* Remote `git` repositories that are download from a given `url`
|
||||
into the workspace's `packagesDir`.
|
||||
-/
|
||||
inductive Source where
|
||||
| path (dir : FilePath)
|
||||
| git (url : String) (rev : Option String) (subDir : Option FilePath)
|
||||
deriving Inhabited, Repr
|
||||
|
||||
/-- A `Dependency` of a package. -/
|
||||
structure Dependency where
|
||||
/--
|
||||
A `Name` for the dependency.
|
||||
The names of a package's dependencies cannot clash.
|
||||
-/
|
||||
name : Name
|
||||
/--
|
||||
The source of a dependency.
|
||||
See the documentation of `Source` for more information.
|
||||
-/
|
||||
src : Source
|
||||
/--
|
||||
Arguments to pass to the dependency's package configuration.
|
||||
-/
|
||||
options : NameMap String := {}
|
||||
|
||||
deriving Inhabited
|
||||
72
src/lake/Lake/Config/Env.lean
Normal file
72
src/lake/Lake/Config/Env.lean
Normal file
@@ -0,0 +1,72 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Util.NativeLib
|
||||
import Lake.Config.InstallPath
|
||||
|
||||
open System
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-- The detected Lake environment. -/
|
||||
structure Env where
|
||||
lake : LakeInstall
|
||||
lean : LeanInstall
|
||||
leanPath : SearchPath
|
||||
leanSrcPath : SearchPath
|
||||
sharedLibPath : SearchPath
|
||||
deriving Inhabited, Repr
|
||||
|
||||
namespace Env
|
||||
|
||||
/-- Compute an `Lake.Env` object from the given installs and set environment variables. -/
|
||||
def compute (lake : LakeInstall) (lean : LeanInstall) : BaseIO Env :=
|
||||
return {
|
||||
lake, lean
|
||||
leanPath := ← getSearchPath "LEAN_PATH",
|
||||
leanSrcPath := ← getSearchPath "LEAN_SRC_PATH",
|
||||
sharedLibPath := ← getSearchPath sharedLibPathEnvVar
|
||||
}
|
||||
|
||||
/-- Environment variable settings based only on the given Lean and Lake installations. -/
|
||||
def installVars (env : Env) : Array (String × Option String) :=
|
||||
#[
|
||||
("LAKE", env.lake.lake.toString),
|
||||
("LAKE_HOME", env.lake.home.toString),
|
||||
("LEAN_SYSROOT", env.lean.sysroot.toString),
|
||||
("LEAN_AR", env.lean.ar.toString),
|
||||
("LEAN_CC", env.lean.leanCc?)
|
||||
]
|
||||
|
||||
/-- Environment variable settings for the `Lake.Env`. -/
|
||||
def vars (env : Env) : Array (String × Option String) :=
|
||||
env.installVars ++ #[
|
||||
("LEAN_PATH", some env.leanPath.toString),
|
||||
("LEAN_SRC_PATH", some env.leanSrcPath.toString),
|
||||
(sharedLibPathEnvVar, some env.sharedLibPath.toString)
|
||||
]
|
||||
|
||||
/--
|
||||
The default search path the Lake executable
|
||||
uses when interpreting package configuration files.
|
||||
|
||||
In order to use the Lean stdlib (e.g., `Init`),
|
||||
the executable needs the search path to include the directory
|
||||
with the stdlib's `.olean` files (e.g., from `<lean-sysroot>/lib/lean`).
|
||||
In order to use Lake's modules as well, the search path also
|
||||
needs to include Lake's `.olean` files (e.g., from `build`).
|
||||
|
||||
While this can be done by having the user augment `LEAN_PATH` with
|
||||
the necessary directories, Lake also intelligently augments the initial
|
||||
search path with the `.olean` directories of the provided Lean and Lake
|
||||
installations.
|
||||
|
||||
See `findInstall?` for more information on how Lake determines those
|
||||
directories. If everything is configured as expected, the user will not
|
||||
need to augment `LEAN_PATH`. Otherwise, they will need to provide Lake
|
||||
with more information (either through `LEAN_PATH` or through other options).
|
||||
-/
|
||||
def leanSearchPath (env : Lake.Env) : SearchPath :=
|
||||
env.lake.libDir :: env.lean.leanLibDir :: env.leanPath
|
||||
38
src/lake/Lake/Config/ExternLib.lean
Normal file
38
src/lake/Lake/Config/ExternLib.lean
Normal file
@@ -0,0 +1,38 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Config.Package
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-- An external library -- its package plus its configuration. -/
|
||||
structure ExternLib where
|
||||
/-- The package the library belongs to. -/
|
||||
pkg : Package
|
||||
/-- The external library's name. -/
|
||||
name : Name
|
||||
/-- The library's user-defined configuration. -/
|
||||
config : ExternLibConfig pkg.name name
|
||||
|
||||
/-- The external libraries of the package (as an Array). -/
|
||||
@[inline] def Package.externLibs (self : Package) : Array ExternLib :=
|
||||
self.externLibConfigs.fold (fun a n v => a.push (⟨self, n, v⟩)) #[]
|
||||
|
||||
/-- Try to find a external library in the package with the given name. -/
|
||||
@[inline] def Package.findExternLib? (name : Name) (self : Package) : Option ExternLib :=
|
||||
self.externLibConfigs.find? name |>.map (⟨self, name, ·⟩)
|
||||
|
||||
namespace ExternLib
|
||||
|
||||
/--
|
||||
The arguments to pass to `leanc` when linking the external library.
|
||||
That is, the package's `moreLinkArgs`.
|
||||
-/
|
||||
@[inline] def linkArgs (self : ExternLib) : Array String :=
|
||||
self.pkg.moreLinkArgs
|
||||
|
||||
/-- The name of the package target used to build the external library's static binary. -/
|
||||
@[inline] def staticTargetName (self : ExternLib) : Name :=
|
||||
.str self.name "static"
|
||||
21
src/lake/Lake/Config/ExternLibConfig.lean
Normal file
21
src/lake/Lake/Config/ExternLibConfig.lean
Normal file
@@ -0,0 +1,21 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Build.Job
|
||||
|
||||
namespace Lake
|
||||
open Lean System
|
||||
|
||||
/-- A external library's declarative configuration. -/
|
||||
structure ExternLibConfig (pkgName name : Name) where
|
||||
/-- The library's build data. -/
|
||||
getJob : CustomData (pkgName, .str name "static") → BuildJob FilePath
|
||||
deriving Inhabited
|
||||
|
||||
/-- A dependently typed configuration based on its registered package and name. -/
|
||||
structure ExternLibDecl where
|
||||
pkg : Name
|
||||
name : Name
|
||||
config : ExternLibConfig pkg name
|
||||
68
src/lake/Lake/Config/FacetConfig.lean
Normal file
68
src/lake/Lake/Config/FacetConfig.lean
Normal file
@@ -0,0 +1,68 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone, Mario Carneiro
|
||||
-/
|
||||
import Lake.Build.Info
|
||||
import Lake.Build.Store
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-- A facet's declarative configuration. -/
|
||||
structure FacetConfig (DataFam : Name → Type) (ι : Type) (name : Name) : Type where
|
||||
/-- The facet's build (function). -/
|
||||
build : ι → IndexBuildM (DataFam name)
|
||||
/-- Does this facet produce an associated asynchronous job? -/
|
||||
getJob? : Option (DataFam name → BuildJob Unit)
|
||||
deriving Inhabited
|
||||
|
||||
protected abbrev FacetConfig.name (_ : FacetConfig DataFam ι name) := name
|
||||
|
||||
/-- A smart constructor for facet configurations that are not known to generate targets. -/
|
||||
@[inline] def mkFacetConfig (build : ι → IndexBuildM α)
|
||||
[h : FamilyOut Fam facet α] : FacetConfig Fam ι facet where
|
||||
build := cast (by rw [← h.family_key_eq_type]) build
|
||||
getJob? := none
|
||||
|
||||
/--
|
||||
A smart constructor for facet configurations that generate jobs for the CLI.
|
||||
This is for small jobs that do not the increase the progress counter.
|
||||
-/
|
||||
@[inline] def mkFacetJobConfigSmall (build : ι → IndexBuildM (BuildJob α))
|
||||
[h : FamilyOut Fam facet (BuildJob α)] : FacetConfig Fam ι facet where
|
||||
build := cast (by rw [← h.family_key_eq_type]) build
|
||||
getJob? := some fun data => discard <| ofFamily data
|
||||
|
||||
/-- A smart constructor for facet configurations that generate jobs for the CLI. -/
|
||||
@[inline] def mkFacetJobConfig (build : ι → IndexBuildM (BuildJob α))
|
||||
[FamilyOut Fam facet (BuildJob α)] : FacetConfig Fam ι facet :=
|
||||
mkFacetJobConfigSmall fun i => do
|
||||
let ctx ← readThe BuildContext
|
||||
ctx.startedBuilds.modify (·+1)
|
||||
let job ← build i
|
||||
job.bindSync (prio := .default + 1) fun a trace => do
|
||||
ctx.finishedBuilds.modify (·+1)
|
||||
return (a, trace)
|
||||
|
||||
/-- A dependently typed configuration based on its registered name. -/
|
||||
structure NamedConfigDecl (β : Name → Type u) where
|
||||
name : Name
|
||||
config : β name
|
||||
|
||||
/-- A module facet's declarative configuration. -/
|
||||
abbrev ModuleFacetConfig := FacetConfig ModuleData Module
|
||||
|
||||
/-- A module facet declaration from a configuration file. -/
|
||||
abbrev ModuleFacetDecl := NamedConfigDecl ModuleFacetConfig
|
||||
|
||||
/-- A package facet's declarative configuration. -/
|
||||
abbrev PackageFacetConfig := FacetConfig PackageData Package
|
||||
|
||||
/-- A package facet declaration from a configuration file. -/
|
||||
abbrev PackageFacetDecl := NamedConfigDecl PackageFacetConfig
|
||||
|
||||
/-- A library facet's declarative configuration. -/
|
||||
abbrev LibraryFacetConfig := FacetConfig LibraryData LeanLib
|
||||
|
||||
/-- A library facet declaration from a configuration file. -/
|
||||
abbrev LibraryFacetDecl := NamedConfigDecl LibraryFacetConfig
|
||||
50
src/lake/Lake/Config/Glob.lean
Normal file
50
src/lake/Lake/Config/Glob.lean
Normal file
@@ -0,0 +1,50 @@
|
||||
/-
|
||||
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mario Carneiro, Mac Malone
|
||||
-/
|
||||
import Lean.Util.Path
|
||||
import Lake.Util.Name
|
||||
|
||||
open Lean (Name)
|
||||
open System (FilePath)
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-- A specification of a set of module names. -/
|
||||
inductive Glob
|
||||
/-- Selects just the specified module name. -/
|
||||
| one : Name → Glob
|
||||
/-- Selects all submodules of the specified module, but not the module itself. -/
|
||||
| submodules : Name → Glob
|
||||
/-- Selects the specified module and all submodules. -/
|
||||
| andSubmodules : Name → Glob
|
||||
deriving Inhabited, Repr
|
||||
|
||||
instance : Coe Name Glob := ⟨Glob.one⟩
|
||||
|
||||
partial def forEachModuleIn [Monad m] [MonadLiftT IO m]
|
||||
(dir : FilePath) (f : Name → m PUnit) (ext := "lean") : m PUnit := do
|
||||
for entry in (← dir.readDir) do
|
||||
if (← liftM (m := IO) <| entry.path.isDir) then
|
||||
let n := Name.mkSimple entry.fileName
|
||||
let r := FilePath.withExtension entry.fileName ext
|
||||
if (← liftM (m := IO) r.pathExists) then f n
|
||||
forEachModuleIn entry.path (f <| n ++ ·)
|
||||
else if entry.path.extension == some ext then
|
||||
f <| Name.mkSimple <| FilePath.withExtension entry.fileName "" |>.toString
|
||||
|
||||
namespace Glob
|
||||
|
||||
def «matches» (m : Name) : (self : Glob) → Bool
|
||||
| one n => n == m
|
||||
| submodules n => n.isPrefixOf m && n != m
|
||||
| andSubmodules n => n.isPrefixOf m
|
||||
|
||||
@[inline] nonrec def forEachModuleIn [Monad m] [MonadLiftT IO m]
|
||||
(dir : FilePath) (f : Name → m PUnit) : (self : Glob) → m PUnit
|
||||
| one n => f n
|
||||
| submodules n =>
|
||||
forEachModuleIn (Lean.modToFilePath dir n "") (f <| n ++ ·)
|
||||
| andSubmodules n =>
|
||||
f n *> forEachModuleIn (Lean.modToFilePath dir n "") (f <| n ++ ·)
|
||||
226
src/lake/Lake/Config/InstallPath.lean
Normal file
226
src/lake/Lake/Config/InstallPath.lean
Normal file
@@ -0,0 +1,226 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Util.NativeLib
|
||||
|
||||
open System
|
||||
namespace Lake
|
||||
|
||||
/-- Standard path of `lean` in a Lean installation. -/
|
||||
def leanExe (sysroot : FilePath) :=
|
||||
sysroot / "bin" / "lean" |>.withExtension FilePath.exeExtension
|
||||
|
||||
/-- Standard path of `leanc` in a Lean installation. -/
|
||||
def leancExe (sysroot : FilePath) :=
|
||||
sysroot / "bin" / "leanc" |>.withExtension FilePath.exeExtension
|
||||
|
||||
/-- Standard path of `llvm-ar` in a Lean installation. -/
|
||||
def leanArExe (sysroot : FilePath) :=
|
||||
sysroot / "bin" / "llvm-ar" |>.withExtension FilePath.exeExtension
|
||||
|
||||
/-- Standard path of `clang` in a Lean installation. -/
|
||||
def leanCcExe (sysroot : FilePath) :=
|
||||
sysroot / "bin" / "clang" |>.withExtension FilePath.exeExtension
|
||||
|
||||
/-- Standard path of `libleanshared` in a Lean installation. -/
|
||||
def leanSharedLib (sysroot : FilePath) :=
|
||||
let dir :=
|
||||
if Platform.isWindows then
|
||||
sysroot / "bin"
|
||||
else
|
||||
sysroot / "lib" / "lean"
|
||||
dir / "libleanshared" |>.withExtension sharedLibExt
|
||||
|
||||
/-- Path information about the local Lean installation. -/
|
||||
structure LeanInstall where
|
||||
sysroot : FilePath
|
||||
githash : String
|
||||
srcDir := sysroot / "src" / "lean"
|
||||
leanLibDir := sysroot / "lib" / "lean"
|
||||
includeDir := sysroot / "include"
|
||||
systemLibDir := sysroot / "lib"
|
||||
lean := leanExe sysroot
|
||||
leanc := leancExe sysroot
|
||||
sharedLib := leanSharedLib sysroot
|
||||
ar : FilePath
|
||||
cc : FilePath
|
||||
customCc : Bool
|
||||
deriving Inhabited, Repr
|
||||
|
||||
/-- The `LEAN_CC` of the Lean installation. -/
|
||||
def LeanInstall.leanCc? (self : LeanInstall) : Option String :=
|
||||
if self.customCc then self.cc.toString else none
|
||||
|
||||
/-- Standard path of `lake` in a Lake installation. -/
|
||||
def lakeExe (buildHome : FilePath) :=
|
||||
buildHome / "bin" / "lake" |>.withExtension FilePath.exeExtension
|
||||
|
||||
/-- Path information about the local Lake installation. -/
|
||||
structure LakeInstall where
|
||||
home : FilePath
|
||||
srcDir := home
|
||||
libDir := home / "build" / "lib"
|
||||
lake := lakeExe <| home / "build"
|
||||
deriving Inhabited, Repr
|
||||
|
||||
/--
|
||||
Try to find the sysroot of the given `lean` command (if it exists)
|
||||
by calling `lean --print-prefix` and returning the path it prints.
|
||||
Defaults to trying the `lean` in `PATH`.
|
||||
-/
|
||||
def findLeanSysroot? (lean := "lean") : BaseIO (Option FilePath) := do
|
||||
let act : IO _ := do
|
||||
let out ← IO.Process.output {
|
||||
cmd := lean,
|
||||
args := #["--print-prefix"]
|
||||
}
|
||||
if out.exitCode == 0 then
|
||||
pure <| some <| FilePath.mk <| out.stdout.trim
|
||||
else
|
||||
pure <| none
|
||||
act.catchExceptions fun _ => pure none
|
||||
|
||||
/--
|
||||
Construct the `LeanInstall` object for the given Lean sysroot.
|
||||
|
||||
Does the following:
|
||||
1. Invokes `lean` to find out its `githash`.
|
||||
2. Finds the `ar` and `cc` to use with Lean.
|
||||
3. Computes the sub-paths of the Lean install.
|
||||
|
||||
For (1), if the invocation fails, `githash` is set to the empty string.
|
||||
|
||||
For (2), if `LEAN_AR` or `LEAN_CC` are defined, it uses those paths.
|
||||
Otherwise, if Lean is packaged with an `llvm-ar` and/or `clang`, use them.
|
||||
If not, use the `ar` and/or `cc` in the system's `PATH`. This last step is
|
||||
needed because internal builds of Lean do not bundle these tools
|
||||
(unlike user-facing releases).
|
||||
|
||||
We also track whether `LEAN_CC` was set to determine whether it should
|
||||
be set in the future for `lake env`. This is because if `LEAN_CC` was not set,
|
||||
it needs to remain not set for `leanc` to work.
|
||||
Even setting it to the bundled compiler will break `leanc` -- see
|
||||
[leanprover/lean4#1281](https://github.com/leanprover/lean4/issues/1281).
|
||||
|
||||
For (3), it assumes that the Lean installation is organized the normal way.
|
||||
That is, with its binaries located in `<lean-sysroot>/bin`, its
|
||||
Lean libraries in `<lean-sysroot>/lib/lean`, and its system libraries in
|
||||
`<lean-sysroot>/lib`.
|
||||
-/
|
||||
def LeanInstall.get (sysroot : FilePath) : BaseIO LeanInstall := do
|
||||
let (cc, customCc) ← findCc
|
||||
return {
|
||||
sysroot,
|
||||
githash := ← getGithash
|
||||
ar := ← findAr
|
||||
cc, customCc
|
||||
}
|
||||
where
|
||||
getGithash := do
|
||||
let act : IO _ := do
|
||||
let out ← IO.Process.output {
|
||||
cmd := leanExe sysroot |>.toString,
|
||||
args := #["--githash"]
|
||||
}
|
||||
pure <| out.stdout.trim
|
||||
act.catchExceptions fun _ => pure ""
|
||||
findAr := do
|
||||
if let some ar ← IO.getEnv "LEAN_AR" then
|
||||
return ar
|
||||
else
|
||||
let ar := leanArExe sysroot
|
||||
if (← ar.pathExists) then pure ar else pure "ar"
|
||||
findCc := do
|
||||
if let some cc ← IO.getEnv "LEAN_CC" then
|
||||
return (FilePath.mk cc, true)
|
||||
else
|
||||
let cc := leanCcExe sysroot
|
||||
let cc := if (← cc.pathExists) then cc else "cc"
|
||||
return (cc, false)
|
||||
|
||||
/--
|
||||
Try to find the installation of the given `lean` command
|
||||
by calling `findLeanCmdHome?`. See `LeanInstall.get` for how it assumes the
|
||||
Lean install is organized.
|
||||
-/
|
||||
def findLeanCmdInstall? (lean := "lean") : BaseIO (Option LeanInstall) :=
|
||||
OptionT.run do LeanInstall.get (← findLeanSysroot? lean)
|
||||
|
||||
/--
|
||||
Check if Lake's executable is co-located with Lean, and, if so,
|
||||
try to return their joint home by assuming they are both located at `<home>/bin`.
|
||||
-/
|
||||
def findLakeLeanJointHome? : BaseIO (Option FilePath) := do
|
||||
if let Except.ok appPath ← IO.appPath.toBaseIO then
|
||||
if let some appDir := appPath.parent then
|
||||
let leanExe := appDir / "lean" |>.withExtension FilePath.exeExtension
|
||||
if (← leanExe.pathExists) then
|
||||
return appDir.parent
|
||||
return none
|
||||
|
||||
/--
|
||||
Try to get Lake's home by assuming
|
||||
the executable is located at `<lake-home>/build/bin/lake`.
|
||||
-/
|
||||
def lakePackageHome? (lake : FilePath) : Option FilePath := do
|
||||
(← (← lake.parent).parent).parent
|
||||
|
||||
/--
|
||||
Try to find Lean's installation by first checking the
|
||||
`LEAN_SYSROOT` environment variable and then by trying `findLeanCmdHome?`.
|
||||
See `LeanInstall.get` for how it assumes the Lean install is organized.
|
||||
-/
|
||||
def findLeanInstall? : BaseIO (Option LeanInstall) := do
|
||||
if let some sysroot ← IO.getEnv "LEAN_SYSROOT" then
|
||||
return some <| ← LeanInstall.get sysroot
|
||||
if let some sysroot ← findLeanSysroot? then
|
||||
return some <| ← LeanInstall.get sysroot
|
||||
return none
|
||||
|
||||
/--
|
||||
Try to find Lake's installation by
|
||||
first checking the `LAKE_HOME` environment variable
|
||||
and then by trying the `lakePackageHome?` of the running executable.
|
||||
|
||||
It assumes that the Lake installation is organized the same way it is built.
|
||||
That is, with its binary located at `<lake-home>/build/bin/lake` and its static
|
||||
library and `.olean` files in `<lake-home>/build/lib`, and its source files
|
||||
located directly in `<lake-home>`.
|
||||
-/
|
||||
def findLakeInstall? : BaseIO (Option LakeInstall) := do
|
||||
if let some home ← IO.getEnv "LAKE_HOME" then
|
||||
return some {home}
|
||||
if let Except.ok lake ← IO.appPath.toBaseIO then
|
||||
if let some home := lakePackageHome? lake then
|
||||
return some {home, lake}
|
||||
return none
|
||||
|
||||
/--
|
||||
Try to get Lake's install path by first trying `findLakeLeanHome?`
|
||||
then by running `findLeanInstall?` and `findLakeInstall?`.
|
||||
|
||||
If Lake is co-located with `lean` (i.e., there is `lean` executable
|
||||
in the same directory as itself), it will assume it was installed with
|
||||
Lean and that both Lake's and Lean's files are all located their shared
|
||||
sysroot.
|
||||
In particular, their binaries are located in `<sysroot>/bin`,
|
||||
their Lean libraries in `<sysroot>/lib/lean`,
|
||||
Lean's source files in `<sysroot>/src/lean`,
|
||||
and Lake's source files in `<sysroot>/src/lean/lake`.
|
||||
-/
|
||||
def findInstall? : BaseIO (Option LeanInstall × Option LakeInstall) := do
|
||||
if let some home ← findLakeLeanJointHome? then
|
||||
let lean ← LeanInstall.get home
|
||||
return (
|
||||
some lean,
|
||||
some {
|
||||
home,
|
||||
srcDir := lean.srcDir / "lake",
|
||||
libDir := lean.leanLibDir,
|
||||
lake := lakeExe home
|
||||
}
|
||||
)
|
||||
else
|
||||
return (← findLeanInstall?, ← findLakeInstall?)
|
||||
83
src/lake/Lake/Config/LeanConfig.lean
Normal file
83
src/lake/Lake/Config/LeanConfig.lean
Normal file
@@ -0,0 +1,83 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
namespace Lake
|
||||
|
||||
/--
|
||||
Lake equivalent of CMake's
|
||||
[`CMAKE_BUILD_TYPE`](https://stackoverflow.com/a/59314670).
|
||||
-/
|
||||
inductive BuildType
|
||||
/--
|
||||
Debug optimization, asserts enabled, custom debug code enabled, and
|
||||
debug info included in executable (so you can step through the code with a
|
||||
debugger and have address to source-file:line-number translation).
|
||||
For example, passes `-Og -g` when compiling C code.
|
||||
-/
|
||||
| debug
|
||||
/--
|
||||
Optimized, *with* debug info, but no debug code or asserts
|
||||
(e.g., passes `-O3 -g -DNDEBUG` when compiling C code).
|
||||
-/
|
||||
| relWithDebInfo
|
||||
/--
|
||||
Same as `release` but optimizing for size rather than speed
|
||||
(e.g., passes `-Os -DNDEBUG` when compiling C code).
|
||||
-/
|
||||
| minSizeRel
|
||||
/--
|
||||
High optimization level and no debug info, code, or asserts
|
||||
(e.g., passes `-O3 -DNDEBUG` when compiling C code).
|
||||
-/
|
||||
| release
|
||||
deriving Inhabited, Repr, DecidableEq, Ord
|
||||
|
||||
instance : LT BuildType := ltOfOrd
|
||||
instance : LE BuildType := leOfOrd
|
||||
instance : Min BuildType := minOfLe
|
||||
instance : Max BuildType := maxOfLe
|
||||
|
||||
/-- The arguments to pass to `leanc` based on the build type. -/
|
||||
def BuildType.leancArgs : BuildType → Array String
|
||||
| debug => #["-Og", "-g"]
|
||||
| relWithDebInfo => #["-O3", "-g", "-DNDEBUG"]
|
||||
| minSizeRel => #["-Os", "-DNDEBUG"]
|
||||
| release => #["-O3", "-DNDEBUG"]
|
||||
|
||||
/-- Configuration options common to targets that build modules. -/
|
||||
structure LeanConfig where
|
||||
/--
|
||||
The mode in which the modules should be built (e.g., `debug`, `release`).
|
||||
Defaults to `release`.
|
||||
-/
|
||||
buildType : BuildType := .release
|
||||
/--
|
||||
Additional arguments to pass to `lean`
|
||||
when compiling a module's Lean source files.
|
||||
-/
|
||||
moreLeanArgs : Array String := #[]
|
||||
/--
|
||||
Additional arguments to pass to `lean`
|
||||
when compiling a module's Lean source files.
|
||||
|
||||
Unlike `moreLeanArgs`, these arguments do not affect the trace
|
||||
of the build result, so they can be changed without triggering a rebuild.
|
||||
-/
|
||||
weakLeanArgs : Array String := #[]
|
||||
/--
|
||||
Additional arguments to pass to `leanc`
|
||||
when compiling a module's C source files generated by `lean`.
|
||||
|
||||
Lake already passes some flags based on the `buildType`,
|
||||
but you can change this by, for example, adding `-O0` and `-UNDEBUG`.
|
||||
-/
|
||||
moreLeancArgs : Array String := #[]
|
||||
/--
|
||||
Additional arguments to pass to `leanc` when linking (e.g., for shared
|
||||
libraries or binary executables). These will come *after* the paths of
|
||||
external libraries.
|
||||
-/
|
||||
moreLinkArgs : Array String := #[]
|
||||
deriving Inhabited, Repr
|
||||
84
src/lake/Lake/Config/LeanExe.lean
Normal file
84
src/lake/Lake/Config/LeanExe.lean
Normal file
@@ -0,0 +1,84 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Config.Module
|
||||
|
||||
namespace Lake
|
||||
open Lean System
|
||||
|
||||
/-- A Lean executable -- its package plus its configuration. -/
|
||||
structure LeanExe where
|
||||
/-- The package the executable belongs to. -/
|
||||
pkg : Package
|
||||
/-- The executable's user-defined configuration. -/
|
||||
config : LeanExeConfig
|
||||
|
||||
/-- The Lean executables of the package (as an Array). -/
|
||||
@[inline] def Package.leanExes (self : Package) : Array LeanExe :=
|
||||
self.leanExeConfigs.fold (fun a _ v => a.push (⟨self, v⟩)) #[]
|
||||
|
||||
/-- Try to find a Lean executable in the package with the given name. -/
|
||||
@[inline] def Package.findLeanExe? (name : Name) (self : Package) : Option LeanExe :=
|
||||
self.leanExeConfigs.find? name |>.map (⟨self, ·⟩)
|
||||
|
||||
/--
|
||||
Converts the executable configuration into a library
|
||||
with a single module (the root).
|
||||
-/
|
||||
def LeanExeConfig.toLeanLibConfig (self : LeanExeConfig) : LeanLibConfig where
|
||||
name := self.name
|
||||
roots := #[]
|
||||
libName := self.exeName
|
||||
toLeanConfig := self.toLeanConfig
|
||||
|
||||
namespace LeanExe
|
||||
|
||||
/-- The executable's well-formed name. -/
|
||||
@[inline] def name (self : LeanExe) : Name :=
|
||||
self.config.name
|
||||
|
||||
/-- Converts the executable into a library with a single module (the root). -/
|
||||
@[inline] def toLeanLib (self : LeanExe) : LeanLib :=
|
||||
⟨self.pkg, self.config.toLeanLibConfig⟩
|
||||
|
||||
/-- The executable's root module. -/
|
||||
@[inline] def root (self : LeanExe) : Module where
|
||||
lib := self.toLeanLib
|
||||
name := self.config.root
|
||||
keyName := self.pkg.name ++ self.config.root
|
||||
|
||||
/-- Return the the root module if the name matches, otherwise return none. -/
|
||||
def isRoot? (name : Name) (self : LeanExe) : Option Module :=
|
||||
if name == self.config.root then some self.root else none
|
||||
|
||||
/--
|
||||
The file name of binary executable
|
||||
(i.e., `exeName` plus the platform's `exeExtension`).
|
||||
-/
|
||||
@[inline] def fileName (self : LeanExe) : FilePath :=
|
||||
FilePath.withExtension self.config.exeName FilePath.exeExtension
|
||||
|
||||
/-- The path to the executable in the package's `binDir`. -/
|
||||
@[inline] def file (self : LeanExe) : FilePath :=
|
||||
self.pkg.binDir / self.fileName
|
||||
|
||||
/--
|
||||
The arguments to pass to `leanc` when linking the binary executable.
|
||||
|
||||
That is, `-rdynamic` (if non-Windows and `supportInterpreter`) plus the
|
||||
package's and then the executable's `moreLinkArgs`.
|
||||
-/
|
||||
def linkArgs (self : LeanExe) : Array String :=
|
||||
if self.config.supportInterpreter && !Platform.isWindows then
|
||||
#["-rdynamic"] ++ self.pkg.moreLinkArgs ++ self.config.moreLinkArgs
|
||||
else
|
||||
self.pkg.moreLinkArgs ++ self.config.moreLinkArgs
|
||||
|
||||
end LeanExe
|
||||
|
||||
/-- Locate the named module in the package (if it is buildable and local to it). -/
|
||||
def Package.findModule? (mod : Name) (self : Package) : Option Module :=
|
||||
self.leanLibs.findSome? (·.findModule? mod) <|>
|
||||
self.leanExes.findSome? (·.isRoot? mod)
|
||||
46
src/lake/Lake/Config/LeanExeConfig.lean
Normal file
46
src/lake/Lake/Config/LeanExeConfig.lean
Normal file
@@ -0,0 +1,46 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Config.LeanConfig
|
||||
|
||||
namespace Lake
|
||||
open Lean System
|
||||
|
||||
/-- A Lean executable's declarative configuration. -/
|
||||
structure LeanExeConfig extends LeanConfig where
|
||||
/-- The name of the target. -/
|
||||
name : Name
|
||||
|
||||
/--
|
||||
The root module of the binary executable.
|
||||
Should include a `main` definition that will serve
|
||||
as the entry point of the program.
|
||||
|
||||
The root is built by recursively building its
|
||||
local imports (i.e., fellow modules of the workspace).
|
||||
|
||||
Defaults to the name of the target.
|
||||
-/
|
||||
root : Name := name
|
||||
|
||||
/--
|
||||
The name of the binary executable.
|
||||
Defaults to the target name with any `.` replaced with a `-`.
|
||||
-/
|
||||
exeName : String := name.toStringWithSep "-" (escape := false)
|
||||
|
||||
/--
|
||||
Whether to expose symbols within the executable to the Lean interpreter.
|
||||
This allows the executable to interpret Lean files (e.g., via
|
||||
`Lean.Elab.runFrontend`).
|
||||
|
||||
Implementation-wise, this passes `-rdynamic` to the linker when building
|
||||
on non-Windows systems.
|
||||
|
||||
Defaults to `false`.
|
||||
-/
|
||||
supportInterpreter : Bool := false
|
||||
|
||||
deriving Inhabited, Repr
|
||||
120
src/lake/Lake/Config/LeanLib.lean
Normal file
120
src/lake/Lake/Config/LeanLib.lean
Normal file
@@ -0,0 +1,120 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Config.Package
|
||||
|
||||
namespace Lake
|
||||
open Lean System
|
||||
|
||||
/-- A Lean library -- its package plus its configuration. -/
|
||||
structure LeanLib where
|
||||
/-- The package the library belongs to. -/
|
||||
pkg : Package
|
||||
/-- The library's user-defined configuration. -/
|
||||
config : LeanLibConfig
|
||||
|
||||
/-- The Lean libraries of the package (as an Array). -/
|
||||
@[inline] def Package.leanLibs (self : Package) : Array LeanLib :=
|
||||
self.leanLibConfigs.fold (fun a _ v => a.push (⟨self, v⟩)) #[]
|
||||
|
||||
/-- Try to find a Lean library in the package with the given name. -/
|
||||
@[inline] def Package.findLeanLib? (name : Name) (self : Package) : Option LeanLib :=
|
||||
self.leanLibConfigs.find? name |>.map (⟨self, ·⟩)
|
||||
|
||||
namespace LeanLib
|
||||
|
||||
/-- The library's well-formed name. -/
|
||||
@[inline] def name (self : LeanLib) : Name :=
|
||||
self.config.name
|
||||
|
||||
/-- The package's `srcDir` joined with the library's `srcDir`. -/
|
||||
@[inline] def srcDir (self : LeanLib) : FilePath :=
|
||||
self.pkg.srcDir / self.config.srcDir
|
||||
|
||||
/-- The library's root directory for `lean` (i.e., `srcDir`). -/
|
||||
@[inline] def rootDir (self : LeanLib) : FilePath :=
|
||||
self.srcDir
|
||||
|
||||
/--
|
||||
The names of the library's root modules
|
||||
(i.e., the library's `roots` configuration).
|
||||
-/
|
||||
@[inline] def roots (self : LeanLib) : Array Name :=
|
||||
self.config.roots
|
||||
|
||||
/-- Whether the given module is considered local to the library. -/
|
||||
@[inline] def isLocalModule (mod : Name) (self : LeanLib) : Bool :=
|
||||
self.config.isLocalModule mod
|
||||
|
||||
/-- Whether the given module is a buildable part of the library. -/
|
||||
@[inline] def isBuildableModule (mod : Name) (self : LeanLib) : Bool :=
|
||||
self.config.isBuildableModule mod
|
||||
|
||||
/-- The file name of the library's static binary (i.e., its `.a`) -/
|
||||
@[inline] def staticLibFileName (self : LeanLib) : FilePath :=
|
||||
nameToStaticLib self.config.libName
|
||||
|
||||
/-- The path to the static library in the package's `libDir`. -/
|
||||
@[inline] def staticLibFile (self : LeanLib) : FilePath :=
|
||||
self.pkg.nativeLibDir / self.staticLibFileName
|
||||
|
||||
/-- The file name of the library's shared binary (i.e., its `dll`, `dylib`, or `so`) . -/
|
||||
@[inline] def sharedLibFileName (self : LeanLib) : FilePath :=
|
||||
nameToSharedLib self.config.libName
|
||||
|
||||
/-- The path to the shared library in the package's `libDir`. -/
|
||||
@[inline] def sharedLibFile (self : LeanLib) : FilePath :=
|
||||
self.pkg.nativeLibDir / self.sharedLibFileName
|
||||
|
||||
/--
|
||||
Whether to precompile the library's modules.
|
||||
Is true if either the package or the library have `precompileModules` set.
|
||||
-/
|
||||
@[inline] def precompileModules (self : LeanLib) : Bool :=
|
||||
self.pkg.precompileModules || self.config.precompileModules
|
||||
|
||||
/-- The library's `defaultFacets` configuration. -/
|
||||
@[inline] def defaultFacets (self : LeanLib) : Array Name :=
|
||||
self.config.defaultFacets
|
||||
|
||||
/-- The library's `nativeFacets` configuration. -/
|
||||
@[inline] def nativeFacets (self : LeanLib) : Array (ModuleFacet (BuildJob FilePath)) :=
|
||||
self.config.nativeFacets
|
||||
|
||||
/--
|
||||
The build type for modules of this library.
|
||||
That is, the minimum of package's `buildType` and the library's `buildType`.
|
||||
-/
|
||||
@[inline] def buildType (self : LeanLib) : BuildType :=
|
||||
min self.pkg.buildType self.config.buildType
|
||||
|
||||
/--
|
||||
The arguments to pass to `lean` when compiling the library's Lean files.
|
||||
That is, the package's `moreLeanArgs` plus the library's `moreLeanArgs`.
|
||||
-/
|
||||
@[inline] def leanArgs (self : LeanLib) : Array String :=
|
||||
self.pkg.moreLeanArgs ++ self.config.moreLeanArgs
|
||||
|
||||
/--
|
||||
The arguments to weakly pass to `lean` when compiling the library's Lean files.
|
||||
That is, the package's `weakLeanArgs` plus the library's `weakLeanArgs`.
|
||||
-/
|
||||
@[inline] def weakLeanArgs (self : LeanLib) : Array String :=
|
||||
self.pkg.weakLeanArgs ++ self.config.weakLeanArgs
|
||||
|
||||
/--
|
||||
The arguments to pass to `leanc` when compiling the library's C files.
|
||||
That is, the build type's `leancArgs`, the package's `moreLeancArgs`,
|
||||
and then the library's `moreLeancArgs`.
|
||||
-/
|
||||
@[inline] def leancArgs (self : LeanLib) : Array String :=
|
||||
self.buildType.leancArgs ++ self.pkg.moreLeancArgs ++ self.config.moreLeancArgs
|
||||
|
||||
/--
|
||||
The arguments to pass to `leanc` when linking the shared library.
|
||||
That is, the package's `moreLinkArgs` plus the library's `moreLinkArgs`.
|
||||
-/
|
||||
@[inline] def linkArgs (self : LeanLib) : Array String :=
|
||||
self.pkg.moreLinkArgs ++ self.config.moreLinkArgs
|
||||
89
src/lake/Lake/Config/LeanLibConfig.lean
Normal file
89
src/lake/Lake/Config/LeanLibConfig.lean
Normal file
@@ -0,0 +1,89 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Util.Casing
|
||||
import Lake.Build.Facets
|
||||
import Lake.Config.InstallPath
|
||||
import Lake.Config.LeanConfig
|
||||
import Lake.Config.Glob
|
||||
|
||||
namespace Lake
|
||||
open Lean System
|
||||
|
||||
/-- A Lean library's declarative configuration. -/
|
||||
structure LeanLibConfig extends LeanConfig where
|
||||
/-- The name of the target. -/
|
||||
name : Name
|
||||
|
||||
/--
|
||||
The subdirectory of the package's source directory containing the library's
|
||||
Lean source files. Defaults simply to said `srcDir`.
|
||||
|
||||
(This will be passed to `lean` as the `-R` option.)
|
||||
-/
|
||||
srcDir : FilePath := "."
|
||||
|
||||
/--
|
||||
The root module(s) of the library.
|
||||
|
||||
Submodules of these roots (e.g., `Lib.Foo` of `Lib`) are considered
|
||||
part of the package.
|
||||
|
||||
Defaults to a single root of the library's upper camel case name.
|
||||
-/
|
||||
roots : Array Name := #[toUpperCamelCase name]
|
||||
|
||||
/--
|
||||
An `Array` of module `Glob`s to build for the library.
|
||||
Defaults to a `Glob.one` of each of the library's `roots`.
|
||||
|
||||
Submodule globs build every source file within their directory.
|
||||
Local imports of glob'ed files (i.e., fellow modules of the workspace) are
|
||||
also recursively built.
|
||||
-/
|
||||
globs : Array Glob := roots.map Glob.one
|
||||
|
||||
/--
|
||||
The name of the library.
|
||||
Used as a base for the file names of its static and dynamic binaries.
|
||||
Defaults to the upper camel case name of the target.
|
||||
-/
|
||||
libName := toUpperCamelCase name |>.toString (escape := false)
|
||||
|
||||
/--
|
||||
Whether to compile each of the library's modules into a native shared library
|
||||
that is loaded whenever the module is imported. This speeds up evaluation of
|
||||
metaprograms and enables the interpreter to run functions marked `@[extern]`.
|
||||
|
||||
Defaults to `false`.
|
||||
-/
|
||||
precompileModules : Bool := false
|
||||
|
||||
/--
|
||||
An `Array` of library facets to build on a bare `lake build` of the library.
|
||||
For example, `#[LeanLib.sharedLib]` will build the shared library facet.
|
||||
-/
|
||||
defaultFacets : Array Name := #[LeanLib.leanFacet]
|
||||
|
||||
/--
|
||||
An `Array` of module facets to build and combine into the library's static
|
||||
and shared libraries. Defaults to ``#[Module.oFacet]`` (i.e., the object file
|
||||
compiled from the Lean source).
|
||||
-/
|
||||
nativeFacets : Array (ModuleFacet (BuildJob FilePath)) := #[Module.oFacet]
|
||||
|
||||
deriving Inhabited
|
||||
|
||||
namespace LeanLibConfig
|
||||
|
||||
/-- Whether the given module is considered local to the library. -/
|
||||
def isLocalModule (mod : Name) (self : LeanLibConfig) : Bool :=
|
||||
self.roots.any (fun root => root.isPrefixOf mod) ||
|
||||
self.globs.any (fun glob => glob.matches mod)
|
||||
|
||||
/-- Whether the given module is a buildable part of the library. -/
|
||||
def isBuildableModule (mod : Name) (self : LeanLibConfig) : Bool :=
|
||||
self.globs.any (fun glob => glob.matches mod) ||
|
||||
self.roots.any (fun root => root.isPrefixOf mod && self.globs.any (·.matches root))
|
||||
131
src/lake/Lake/Config/Module.lean
Normal file
131
src/lake/Lake/Config/Module.lean
Normal file
@@ -0,0 +1,131 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Build.Trace
|
||||
import Lake.Config.LeanLib
|
||||
import Lake.Util.OrdHashSet
|
||||
|
||||
namespace Lake
|
||||
open Lean System
|
||||
|
||||
/-- A buildable Lean module of a `LeanLib`. -/
|
||||
structure Module where
|
||||
lib : LeanLib
|
||||
name : Name
|
||||
/--
|
||||
The name of the module as a key.
|
||||
Used to create private modules (e.g., executable roots).
|
||||
-/
|
||||
keyName : Name := name
|
||||
|
||||
instance : Hashable Module where hash m := hash m.keyName
|
||||
instance : BEq Module where beq m n := m.keyName == n.keyName
|
||||
|
||||
abbrev ModuleSet := HashSet Module
|
||||
@[inline] def ModuleSet.empty : ModuleSet := HashSet.empty
|
||||
|
||||
abbrev OrdModuleSet := OrdHashSet Module
|
||||
@[inline] def OrdModuleSet.empty : OrdModuleSet := OrdHashSet.empty
|
||||
|
||||
abbrev ModuleMap (α) := RBMap Module α (·.name.quickCmp ·.name)
|
||||
@[inline] def ModuleMap.empty : ModuleMap α := RBMap.empty
|
||||
|
||||
/-- Locate the named module in the library (if it is buildable and local to it). -/
|
||||
def LeanLib.findModule? (mod : Name) (self : LeanLib) : Option Module :=
|
||||
if self.isBuildableModule mod then some {lib := self, name := mod} else none
|
||||
|
||||
/-- Get an `Array` of the library's modules (as specified by its globs). -/
|
||||
def LeanLib.getModuleArray (self : LeanLib) : IO (Array Module) :=
|
||||
(·.2) <$> StateT.run (s := #[]) do
|
||||
self.config.globs.forM fun glob => do
|
||||
glob.forEachModuleIn self.srcDir fun mod => do
|
||||
modify (·.push {lib := self, name := mod})
|
||||
|
||||
/-- The library's buildable root modules. -/
|
||||
def LeanLib.rootModules (self : LeanLib) : Array Module :=
|
||||
self.config.roots.filterMap self.findModule?
|
||||
|
||||
namespace Module
|
||||
|
||||
abbrev pkg (self : Module) : Package :=
|
||||
self.lib.pkg
|
||||
|
||||
@[inline] def rootDir (self : Module) : FilePath :=
|
||||
self.lib.rootDir
|
||||
|
||||
@[inline] def filePath (dir : FilePath) (ext : String) (self : Module) : FilePath :=
|
||||
Lean.modToFilePath dir self.name ext
|
||||
|
||||
@[inline] def srcPath (ext : String) (self : Module) : FilePath :=
|
||||
self.filePath self.lib.srcDir ext
|
||||
|
||||
@[inline] def leanFile (self : Module) : FilePath :=
|
||||
self.srcPath "lean"
|
||||
|
||||
@[inline] def leanLibPath (ext : String) (self : Module) : FilePath :=
|
||||
self.filePath self.pkg.leanLibDir ext
|
||||
|
||||
@[inline] def oleanFile (self : Module) : FilePath :=
|
||||
self.leanLibPath "olean"
|
||||
|
||||
@[inline] def ileanFile (self : Module) : FilePath :=
|
||||
self.leanLibPath "ilean"
|
||||
|
||||
@[inline] def traceFile (self : Module) : FilePath :=
|
||||
self.leanLibPath "trace"
|
||||
|
||||
@[inline] def irPath (ext : String) (self : Module) : FilePath :=
|
||||
self.filePath self.pkg.irDir ext
|
||||
|
||||
@[inline] def cFile (self : Module) : FilePath :=
|
||||
self.irPath "c"
|
||||
|
||||
@[inline] def oFile (self : Module) : FilePath :=
|
||||
self.irPath "o"
|
||||
|
||||
@[inline] def dynlibName (self : Module) : String :=
|
||||
-- NOTE: file name MUST be unique on Windows
|
||||
self.name.toStringWithSep "-" (escape := true)
|
||||
|
||||
@[inline] def dynlibFile (self : Module) : FilePath :=
|
||||
self.pkg.nativeLibDir / nameToSharedLib self.dynlibName
|
||||
|
||||
@[inline] def buildType (self : Module) : BuildType :=
|
||||
self.lib.buildType
|
||||
|
||||
@[inline] def leanArgs (self : Module) : Array String :=
|
||||
self.lib.leanArgs
|
||||
|
||||
@[inline] def weakLeanArgs (self : Module) : Array String :=
|
||||
self.lib.weakLeanArgs
|
||||
|
||||
@[inline] def leancArgs (self : Module) : Array String :=
|
||||
self.lib.leancArgs
|
||||
|
||||
@[inline] def linkArgs (self : Module) : Array String :=
|
||||
self.lib.linkArgs
|
||||
|
||||
@[inline] def shouldPrecompile (self : Module) : Bool :=
|
||||
self.lib.precompileModules
|
||||
|
||||
@[inline] def nativeFacets (self : Module) : Array (ModuleFacet (BuildJob FilePath)) :=
|
||||
self.lib.nativeFacets
|
||||
|
||||
/-! ## Trace Helpers -/
|
||||
|
||||
protected def getMTime (self : Module) : IO MTime := do
|
||||
return mixTrace (← getMTime self.oleanFile) (← getMTime self.ileanFile)
|
||||
|
||||
instance : GetMTime Module := ⟨Module.getMTime⟩
|
||||
|
||||
protected def computeHash (self : Module) : IO Hash := do
|
||||
return mixTrace (← computeHash self.oleanFile) (← computeHash self.ileanFile)
|
||||
|
||||
instance : ComputeHash Module IO := ⟨Module.computeHash⟩
|
||||
|
||||
protected def checkExists (self : Module) : BaseIO Bool := do
|
||||
return (← checkExists self.oleanFile) && (← checkExists self.ileanFile)
|
||||
|
||||
instance : CheckExists Module := ⟨Module.checkExists⟩
|
||||
202
src/lake/Lake/Config/Monad.lean
Normal file
202
src/lake/Lake/Config/Monad.lean
Normal file
@@ -0,0 +1,202 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Config.Context
|
||||
import Lake.Config.Workspace
|
||||
|
||||
open System
|
||||
open Lean (Name)
|
||||
|
||||
/-! # Lake Configuration Monads
|
||||
Definitions and helpers for interacting with the Lake configuration monads.
|
||||
-/
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-- A monad equipped with a (read-only) detected environment for Lake. -/
|
||||
abbrev MonadLakeEnv (m : Type → Type u) :=
|
||||
MonadReaderOf Lake.Env m
|
||||
|
||||
/-- A monad equipped with a (read-only) Lake `Workspace`. -/
|
||||
abbrev MonadWorkspace (m : Type → Type u) :=
|
||||
MonadReaderOf Workspace m
|
||||
|
||||
/-- A monad equipped with a (read-only) Lake context. -/
|
||||
abbrev MonadLake (m : Type → Type u) :=
|
||||
MonadReaderOf Context m
|
||||
|
||||
/-- Make a `Lake.Context` from a `Workspace`. -/
|
||||
def mkLakeContext (ws : Workspace) : Context where
|
||||
opaqueWs := ws
|
||||
|
||||
@[inline] def Context.workspace (self : Context) :=
|
||||
self.opaqueWs.get
|
||||
|
||||
instance [MonadLake m] [Functor m] : MonadWorkspace m where
|
||||
read := (·.workspace) <$> read
|
||||
|
||||
instance [MonadWorkspace m] [Functor m] : MonadLakeEnv m where
|
||||
read := (·.lakeEnv) <$> read
|
||||
|
||||
section
|
||||
variable [MonadWorkspace m]
|
||||
|
||||
/-! ## Workspace Helpers -/
|
||||
|
||||
/-- Get the workspace of the context. -/
|
||||
@[inline] def getWorkspace : m Workspace :=
|
||||
read
|
||||
|
||||
variable [Functor m]
|
||||
|
||||
/-- Get the root package of the context's workspace. -/
|
||||
@[inline] def getRootPackage : m Package :=
|
||||
(·.root) <$> read
|
||||
|
||||
@[inherit_doc Workspace.findPackage?, inline]
|
||||
def findPackage? (name : Name) : m (Option (NPackage name)) :=
|
||||
(·.findPackage? name) <$> getWorkspace
|
||||
|
||||
@[inherit_doc Workspace.findModule?, inline]
|
||||
def findModule? (name : Name) : m (Option Module) :=
|
||||
(·.findModule? name) <$> getWorkspace
|
||||
|
||||
@[inherit_doc Workspace.findLeanExe?, inline]
|
||||
def findLeanExe? (name : Name) : m (Option LeanExe) :=
|
||||
(·.findLeanExe? name) <$> getWorkspace
|
||||
|
||||
@[inherit_doc Workspace.findLeanLib?, inline]
|
||||
def findLeanLib? (name : Name) : m (Option LeanLib) :=
|
||||
(·.findLeanLib? name) <$> getWorkspace
|
||||
|
||||
@[inherit_doc Workspace.findExternLib?, inline]
|
||||
def findExternLib? (name : Name) : m (Option ExternLib) :=
|
||||
(·.findExternLib? name) <$> getWorkspace
|
||||
|
||||
/-- Get the paths added to `LEAN_PATH` by the context's workspace. -/
|
||||
@[inline] def getLeanPath : m SearchPath :=
|
||||
(·.leanPath) <$> getWorkspace
|
||||
|
||||
/-- Get the paths added to `LEAN_SRC_PATH` by the context's workspace. -/
|
||||
@[inline] def getLeanSrcPath : m SearchPath :=
|
||||
(·.leanSrcPath) <$> getWorkspace
|
||||
|
||||
/-- Get the paths added to the shared library path by the context's workspace. -/
|
||||
@[inline] def getSharedLibPath : m SearchPath :=
|
||||
(·.sharedLibPath) <$> getWorkspace
|
||||
|
||||
/-- Get the augmented `LEAN_PATH` set by the context's workspace. -/
|
||||
@[inline] def getAugmentedLeanPath : m SearchPath :=
|
||||
(·.augmentedLeanPath) <$> getWorkspace
|
||||
|
||||
/-- Get the augmented `LEAN_SRC_PATH` set by the context's workspace. -/
|
||||
@[inline] def getAugmentedLeanSrcPath : m SearchPath :=
|
||||
(·.augmentedLeanSrcPath) <$> getWorkspace
|
||||
|
||||
/-- Get the augmented shared library path set by the context's workspace. -/
|
||||
@[inline] def getAugmentedSharedLibPath : m SearchPath :=
|
||||
(·.augmentedSharedLibPath) <$> getWorkspace
|
||||
|
||||
/-- Get the augmented environment variables set by the context's workspace. -/
|
||||
@[inline] def getAugmentedEnv : m (Array (String × Option String)) :=
|
||||
(·.augmentedEnvVars) <$> getWorkspace
|
||||
|
||||
end
|
||||
|
||||
section
|
||||
variable [MonadLakeEnv m] [Functor m]
|
||||
|
||||
/-! ## Environment Helpers -/
|
||||
|
||||
@[inline] def getLakeEnv : m Lake.Env :=
|
||||
read
|
||||
|
||||
/-! ### Search Path Helpers -/
|
||||
|
||||
/-- Get the detected `LEAN_PATH` value of the Lake environment. -/
|
||||
@[inline] def getEnvLeanPath : m SearchPath :=
|
||||
(·.leanPath) <$> getLakeEnv
|
||||
|
||||
/-- Get the detected `LEAN_SRC_PATH` value of the Lake environment. -/
|
||||
@[inline] def getEnvLeanSrcPath : m SearchPath :=
|
||||
(·.leanSrcPath) <$> getLakeEnv
|
||||
|
||||
/-- Get the detected `sharedLibPathEnvVar` value of the Lake environment. -/
|
||||
@[inline] def getEnvSharedLibPath : m SearchPath :=
|
||||
(·.sharedLibPath) <$> getLakeEnv
|
||||
|
||||
/-! ### Lean Install Helpers -/
|
||||
|
||||
/-- Get the detected Lean installation. -/
|
||||
@[inline] def getLeanInstall : m LeanInstall :=
|
||||
(·.lean) <$> getLakeEnv
|
||||
|
||||
/-- Get the root directory of the detected Lean installation. -/
|
||||
@[inline] def getLeanSysroot : m FilePath :=
|
||||
(·.sysroot) <$> getLeanInstall
|
||||
|
||||
/-- Get the Lean source directory of the detected Lean installation. -/
|
||||
@[inline] def getLeanSrcDir : m FilePath :=
|
||||
(·.srcDir) <$> getLeanInstall
|
||||
|
||||
/-- Get the Lean library directory of the detected Lean installation. -/
|
||||
@[inline] def getLeanLibDir : m FilePath :=
|
||||
(·.leanLibDir) <$> getLeanInstall
|
||||
|
||||
/-- Get the C include directory of the detected Lean installation. -/
|
||||
@[inline] def getLeanIncludeDir : m FilePath :=
|
||||
(·.includeDir) <$> getLeanInstall
|
||||
|
||||
/-- Get the system library directory of the detected Lean installation. -/
|
||||
@[inline] def getLeanSystemLibDir : m FilePath :=
|
||||
(·.systemLibDir) <$> getLeanInstall
|
||||
|
||||
/-- Get the path of the `lean` binary in the detected Lean installation. -/
|
||||
@[inline] def getLean : m FilePath :=
|
||||
(·.lean) <$> getLeanInstall
|
||||
|
||||
/-- Get the path of the `leanc` binary in the detected Lean installation. -/
|
||||
@[inline] def getLeanc : m FilePath :=
|
||||
(·.leanc) <$> getLeanInstall
|
||||
|
||||
/-- Get the path of the `libleanshared` library in the detected Lean installation. -/
|
||||
@[inline] def getLeanSharedLib : m FilePath :=
|
||||
(·.sharedLib) <$> getLeanInstall
|
||||
|
||||
/-- Get the path of the `ar` binary in the detected Lean installation. -/
|
||||
@[inline] def getLeanAr : m FilePath :=
|
||||
(·.ar) <$> getLeanInstall
|
||||
|
||||
/-- Get the path of C compiler in the detected Lean installation. -/
|
||||
@[inline] def getLeanCc : m FilePath :=
|
||||
(·.cc) <$> getLeanInstall
|
||||
|
||||
/-- Get the optional `LEAN_CC` compiler override of the detected Lean installation. -/
|
||||
@[inline] def getLeanCc? : m (Option String) :=
|
||||
(·.leanCc?) <$> getLeanInstall
|
||||
|
||||
/-! ### Lake Install Helpers -/
|
||||
|
||||
/-- Get the detected Lake installation. -/
|
||||
@[inline] def getLakeInstall : m LakeInstall :=
|
||||
(·.lake) <$> getLakeEnv
|
||||
|
||||
/-- Get the root directory of the detected Lake installation (e.g., `LAKE_HOME`). -/
|
||||
@[inline] def getLakeHome : m FilePath :=
|
||||
(·.home) <$> getLakeInstall
|
||||
|
||||
/-- Get the source directory of the detected Lake installation. -/
|
||||
@[inline] def getLakeSrcDir : m FilePath :=
|
||||
(·.srcDir) <$> getLakeInstall
|
||||
|
||||
/-- Get the Lean library directory of the detected Lake installation. -/
|
||||
@[inline] def getLakeLibDir : m FilePath :=
|
||||
(·.libDir) <$> getLakeInstall
|
||||
|
||||
/-- Get the path of the `lake` binary in the detected Lake installation. -/
|
||||
@[inline] def getLake : m FilePath :=
|
||||
(·.lake) <$> getLakeInstall
|
||||
|
||||
end
|
||||
18
src/lake/Lake/Config/Opaque.lean
Normal file
18
src/lake/Lake/Config/Opaque.lean
Normal file
@@ -0,0 +1,18 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Util.Name
|
||||
import Lake.Util.Opaque
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-- Opaque reference to a `Package` used for forward declaration. -/
|
||||
declare_opaque_type OpaquePackage
|
||||
|
||||
/-- Opaque reference to a `Workspace` used for forward declaration. -/
|
||||
declare_opaque_type OpaqueWorkspace
|
||||
|
||||
/-- Opaque reference to a `TargetConfig` used for forward declaration. -/
|
||||
declare_opaque_type OpaqueTargetConfig (pkgName name : Name)
|
||||
367
src/lake/Lake/Config/Package.lean
Normal file
367
src/lake/Lake/Config/Package.lean
Normal file
@@ -0,0 +1,367 @@
|
||||
/-
|
||||
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Gabriel Ebner, Sebastian Ullrich, Mac Malone
|
||||
-/
|
||||
import Lake.Config.Opaque
|
||||
import Lake.Config.LeanLibConfig
|
||||
import Lake.Config.LeanExeConfig
|
||||
import Lake.Config.ExternLibConfig
|
||||
import Lake.Config.WorkspaceConfig
|
||||
import Lake.Config.Dependency
|
||||
import Lake.Config.Script
|
||||
import Lake.Util.DRBMap
|
||||
import Lake.Util.OrdHashSet
|
||||
|
||||
open System Lean
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-- A string descriptor of the `System.Platform` OS (`windows`, `macOS`, or `linux`). -/
|
||||
def osDescriptor : String :=
|
||||
if Platform.isWindows then
|
||||
"windows"
|
||||
else if Platform.isOSX then
|
||||
"macOS"
|
||||
else
|
||||
"linux"
|
||||
|
||||
/--
|
||||
A `tar.gz` file name suffix encoding the the current Platform.
|
||||
(i.e, `osDescriptor` joined with `System.Platform.numBits`).
|
||||
-/
|
||||
def archiveSuffix :=
|
||||
s!"{osDescriptor}-{Platform.numBits}.tar.gz"
|
||||
|
||||
/-- If `name?`, `{name}-{archiveSuffix}`, otherwise just `archiveSuffix`. -/
|
||||
def nameToArchive (name? : Option String) : String :=
|
||||
match name? with
|
||||
| none => archiveSuffix
|
||||
| some name => s!"{name}-{archiveSuffix}"
|
||||
|
||||
/--
|
||||
First tries to convert a string into a legal name.
|
||||
If that fails, defaults to making it a simple name (e.g., `Lean.Name.mkSimple`).
|
||||
Currently used for package and target names taken from the CLI.
|
||||
-/
|
||||
def stringToLegalOrSimpleName (s : String) : Name :=
|
||||
if s.toName.isAnonymous then Lean.Name.mkSimple s else s.toName
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! # Defaults -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
/-- The default setting for a `PackageConfig`'s `manifestFile` option. -/
|
||||
def defaultManifestFile := "lake-manifest.json"
|
||||
|
||||
/-- The default setting for a `PackageConfig`'s `buildDir` option. -/
|
||||
def defaultBuildDir : FilePath := "build"
|
||||
|
||||
/-- The default setting for a `PackageConfig`'s `leanLibDir` option. -/
|
||||
def defaultLeanLibDir : FilePath := "lib"
|
||||
|
||||
/-- The default setting for a `PackageConfig`'s `nativeLibDir` option. -/
|
||||
def defaultNativeLibDir : FilePath := "lib"
|
||||
|
||||
/-- The default setting for a `PackageConfig`'s `binDir` option. -/
|
||||
def defaultBinDir : FilePath := "bin"
|
||||
|
||||
/-- The default setting for a `PackageConfig`'s `irDir` option. -/
|
||||
def defaultIrDir : FilePath := "ir"
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! # PackageConfig -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
/-- A `Package`'s declarative configuration. -/
|
||||
structure PackageConfig extends WorkspaceConfig, LeanConfig where
|
||||
|
||||
/-- The `Name` of the package. -/
|
||||
name : Name
|
||||
|
||||
/--
|
||||
The path of a package's manifest file, which stores the exact versions
|
||||
of its resolved dependencies.
|
||||
|
||||
Defaults to `defaultManifestFile` (i.e., `lake-manifest.json`).
|
||||
-/
|
||||
manifestFile := defaultManifestFile
|
||||
|
||||
/-- An `Array` of target names to build whenever the package is used. -/
|
||||
extraDepTargets : Array Name := #[]
|
||||
|
||||
/--
|
||||
Whether to compile each of the package's module into a native shared library
|
||||
that is loaded whenever the module is imported. This speeds up evaluation of
|
||||
metaprograms and enables the interpreter to run functions marked `@[extern]`.
|
||||
|
||||
Defaults to `false`.
|
||||
-/
|
||||
precompileModules : Bool := false
|
||||
|
||||
/--
|
||||
Additional arguments to pass to the Lean language server
|
||||
(i.e., `lean --server`) launched by `lake server`.
|
||||
-/
|
||||
moreServerArgs : Array String := #[]
|
||||
|
||||
/--
|
||||
The directory containing the package's Lean source files.
|
||||
Defaults to the package's directory.
|
||||
|
||||
(This will be passed to `lean` as the `-R` option.)
|
||||
-/
|
||||
srcDir : FilePath := "."
|
||||
|
||||
/--
|
||||
The directory to which Lake should output the package's build results.
|
||||
Defaults to `defaultBuildDir` (i.e., `build`).
|
||||
-/
|
||||
buildDir : FilePath := defaultBuildDir
|
||||
|
||||
/--
|
||||
The build subdirectory to which Lake should output the package's
|
||||
binary Lean libraries (e.g., `.olean`, `.ilean` files).
|
||||
Defaults to `defaultLeanLibDir` (i.e., `lib`).
|
||||
-/
|
||||
leanLibDir : FilePath := defaultLeanLibDir
|
||||
|
||||
/--
|
||||
The build subdirectory to which Lake should output the package's
|
||||
native libraries (e.g., `.a`, `.so`, `.dll` files).
|
||||
Defaults to `defaultNativeLibDir` (i.e., `lib`).
|
||||
-/
|
||||
nativeLibDir : FilePath := defaultNativeLibDir
|
||||
|
||||
/--
|
||||
The build subdirectory to which Lake should output the package's binary executable.
|
||||
Defaults to `defaultBinDir` (i.e., `bin`).
|
||||
-/
|
||||
binDir : FilePath := defaultBinDir
|
||||
|
||||
/--
|
||||
The build subdirectory to which Lake should output
|
||||
the package's intermediary results (e.g., `.c` and `.o` files).
|
||||
Defaults to `defaultIrDir` (i.e., `ir`).
|
||||
-/
|
||||
irDir : FilePath := defaultIrDir
|
||||
|
||||
/--
|
||||
The URL of the GitHub repository to upload and download releases of this package.
|
||||
If `none` (the default), for downloads, Lake uses the URL the package was download
|
||||
from (if it is a dependency) and for uploads, uses `gh`'s default.
|
||||
-/
|
||||
releaseRepo? : Option String := none
|
||||
|
||||
/--
|
||||
The name of the build archive on GitHub. Defaults to `none`.
|
||||
The archive's full file name will be `nameToArchive buildArchive?`.
|
||||
-/
|
||||
buildArchive? : Option String := none
|
||||
|
||||
/--
|
||||
Whether to prefer downloading a prebuilt release (from GitHub) rather than
|
||||
building this package from the source when this package is used as a dependency.
|
||||
-/
|
||||
preferReleaseBuild : Bool := false
|
||||
|
||||
deriving Inhabited
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! # Package -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
abbrev DNameMap α := DRBMap Name α Name.quickCmp
|
||||
@[inline] def DNameMap.empty : DNameMap α := DRBMap.empty
|
||||
|
||||
/-- A Lake package -- its location plus its configuration. -/
|
||||
structure Package where
|
||||
/-- The path to the package's directory. -/
|
||||
dir : FilePath
|
||||
/-- The package's user-defined configuration. -/
|
||||
config : PackageConfig
|
||||
/-- The elaboration environment of the package's configuration file. -/
|
||||
configEnv : Environment
|
||||
/-- The Lean `Options` the package configuration was elaborated with. -/
|
||||
leanOpts : Options
|
||||
/-- The URL to this package's Git remote. -/
|
||||
remoteUrl? : Option String := none
|
||||
/-- The Git tag of this package. -/
|
||||
gitTag? : Option String := none
|
||||
/-- (Opaque references to) the package's direct dependencies. -/
|
||||
opaqueDeps : Array OpaquePackage := #[]
|
||||
/-- Lean library configurations for the package. -/
|
||||
leanLibConfigs : NameMap LeanLibConfig := {}
|
||||
/-- Lean binary executable configurations for the package. -/
|
||||
leanExeConfigs : NameMap LeanExeConfig := {}
|
||||
/-- External library targets for the package. -/
|
||||
externLibConfigs : DNameMap (ExternLibConfig config.name) := {}
|
||||
/-- (Opaque references to) targets defined in the package. -/
|
||||
opaqueTargetConfigs : DNameMap (OpaqueTargetConfig config.name) := {}
|
||||
/--
|
||||
The names of the package's targets to build by default
|
||||
(i.e., on a bare `lake build` of the package).
|
||||
-/
|
||||
defaultTargets : Array Name := #[]
|
||||
/-- Scripts for the package. -/
|
||||
scripts : NameMap Script := {}
|
||||
/--
|
||||
The names of the package's scripts run by default
|
||||
(i.e., on a bare `lake run` of the package).
|
||||
-/
|
||||
defaultScripts : Array Script := #[]
|
||||
|
||||
instance : Nonempty Package :=
|
||||
have : Inhabited Environment := Classical.inhabited_of_nonempty inferInstance
|
||||
by refine' ⟨{..}⟩ <;> exact default
|
||||
|
||||
hydrate_opaque_type OpaquePackage Package
|
||||
|
||||
instance : Hashable Package where hash pkg := hash pkg.config.name
|
||||
instance : BEq Package where beq p1 p2 := p1.config.name == p2.config.name
|
||||
|
||||
abbrev PackageSet := HashSet Package
|
||||
@[inline] def PackageSet.empty : PackageSet := HashSet.empty
|
||||
|
||||
abbrev OrdPackageSet := OrdHashSet Package
|
||||
@[inline] def OrdPackageSet.empty : OrdPackageSet := OrdHashSet.empty
|
||||
|
||||
/-- The package's name. -/
|
||||
abbrev Package.name (self : Package) : Name :=
|
||||
self.config.name
|
||||
|
||||
/-- A package with a name known at type-level. -/
|
||||
structure NPackage (name : Name) extends Package where
|
||||
name_eq : toPackage.name = name
|
||||
|
||||
attribute [simp] NPackage.name_eq
|
||||
|
||||
instance : CoeOut (NPackage name) Package := ⟨NPackage.toPackage⟩
|
||||
instance : CoeDep Package pkg (NPackage pkg.name) := ⟨⟨pkg, rfl⟩⟩
|
||||
|
||||
/-- The package's name. -/
|
||||
abbrev NPackage.name (_ : NPackage n) := n
|
||||
|
||||
namespace Package
|
||||
|
||||
/-- The package's direct dependencies. -/
|
||||
@[inline] def deps (self : Package) : Array Package :=
|
||||
self.opaqueDeps.map (·.get)
|
||||
|
||||
/--
|
||||
The directory for storing the package's remote dependencies.
|
||||
Either its `packagesDir` configuration or `defaultPackagesDir`.
|
||||
-/
|
||||
def relPkgsDir (self : Package) : FilePath :=
|
||||
self.config.packagesDir.getD defaultPackagesDir
|
||||
|
||||
/-- The package's `dir` joined with its `relPkgsDir` -/
|
||||
def pkgsDir (self : Package) : FilePath :=
|
||||
self.dir / self.relPkgsDir
|
||||
|
||||
/-- The package's JSON manifest of remote dependencies. -/
|
||||
def manifestFile (self : Package) : FilePath :=
|
||||
self.dir / self.config.manifestFile
|
||||
|
||||
/-- The package's `dir` joined with its `buildDir` configuration. -/
|
||||
@[inline] def buildDir (self : Package) : FilePath :=
|
||||
self.dir / self.config.buildDir
|
||||
|
||||
/-- The package's `extraDepTargets` configuration. -/
|
||||
@[inline] def extraDepTargets (self : Package) : Array Name :=
|
||||
self.config.extraDepTargets
|
||||
|
||||
/-- The package's `releaseRepo?` configuration. -/
|
||||
@[inline] def releaseRepo? (self : Package) : Option String :=
|
||||
self.config.releaseRepo?
|
||||
|
||||
/--
|
||||
The package's URL × tag release.
|
||||
Tries `releaseRepo?` first and then falls back to `remoteUrl?`.
|
||||
-/
|
||||
def release? (self : Package) : Option (String × String) := do
|
||||
let url ← self.releaseRepo? <|> self.remoteUrl?
|
||||
let tag ← self.gitTag?
|
||||
return (url, tag)
|
||||
|
||||
/-- The package's `buildArchive?` configuration. -/
|
||||
@[inline] def buildArchive? (self : Package) : Option String :=
|
||||
self.config.buildArchive?
|
||||
|
||||
/-- The file name of the package's build archive derived from `buildArchive?`. -/
|
||||
@[inline] def buildArchive (self : Package) : String :=
|
||||
nameToArchive self.buildArchive?
|
||||
|
||||
/-- The package's `buildDir` joined with its `buildArchive` configuration. -/
|
||||
@[inline] def buildArchiveFile (self : Package) : FilePath :=
|
||||
self.buildDir / self.buildArchive
|
||||
|
||||
/-- The package's `preferReleaseBuild` configuration. -/
|
||||
@[inline] def preferReleaseBuild (self : Package) : Bool :=
|
||||
self.config.preferReleaseBuild
|
||||
|
||||
/-- The package's `precompileModules` configuration. -/
|
||||
@[inline] def precompileModules (self : Package) : Bool :=
|
||||
self.config.precompileModules
|
||||
|
||||
/-- The package's `moreServerArgs` configuration. -/
|
||||
@[inline] def moreServerArgs (self : Package) : Array String :=
|
||||
self.config.moreServerArgs
|
||||
|
||||
/-- The package's `buildType` configuration. -/
|
||||
@[inline] def buildType (self : Package) : BuildType :=
|
||||
self.config.buildType
|
||||
|
||||
/-- The package's `moreLeanArgs` configuration. -/
|
||||
@[inline] def moreLeanArgs (self : Package) : Array String :=
|
||||
self.config.moreLeanArgs
|
||||
|
||||
/-- The package's `weakLeanArgs` configuration. -/
|
||||
@[inline] def weakLeanArgs (self : Package) : Array String :=
|
||||
self.config.weakLeanArgs
|
||||
|
||||
/-- The package's `moreLeancArgs` configuration. -/
|
||||
@[inline] def moreLeancArgs (self : Package) : Array String :=
|
||||
self.config.moreLeancArgs
|
||||
|
||||
/-- The package's `moreLinkArgs` configuration. -/
|
||||
@[inline] def moreLinkArgs (self : Package) : Array String :=
|
||||
self.config.moreLinkArgs
|
||||
|
||||
/-- The package's `dir` joined with its `srcDir` configuration. -/
|
||||
@[inline] def srcDir (self : Package) : FilePath :=
|
||||
self.dir / self.config.srcDir
|
||||
|
||||
/-- The package's root directory for `lean` (i.e., `srcDir`). -/
|
||||
@[inline] def rootDir (self : Package) : FilePath :=
|
||||
self.srcDir
|
||||
|
||||
/-- The package's `buildDir` joined with its `leanLibDir` configuration. -/
|
||||
@[inline] def leanLibDir (self : Package) : FilePath :=
|
||||
self.buildDir / self.config.leanLibDir
|
||||
|
||||
/-- The package's `buildDir` joined with its `nativeLibDir` configuration. -/
|
||||
@[inline] def nativeLibDir (self : Package) : FilePath :=
|
||||
self.buildDir / self.config.nativeLibDir
|
||||
|
||||
/-- The package's `buildDir` joined with its `binDir` configuration. -/
|
||||
@[inline] def binDir (self : Package) : FilePath :=
|
||||
self.buildDir / self.config.binDir
|
||||
|
||||
/-- The package's `buildDir` joined with its `irDir` configuration. -/
|
||||
@[inline] def irDir (self : Package) : FilePath :=
|
||||
self.buildDir / self.config.irDir
|
||||
|
||||
/-- Whether the given module is considered local to the package. -/
|
||||
def isLocalModule (mod : Name) (self : Package) : Bool :=
|
||||
self.leanLibConfigs.any (fun _ lib => lib.isLocalModule mod)
|
||||
|
||||
/-- Whether the given module is in the package (i.e., can build it). -/
|
||||
def isBuildableModule (mod : Name) (self : Package) : Bool :=
|
||||
self.leanLibConfigs.any (fun _ lib => lib.isBuildableModule mod) ||
|
||||
self.leanExeConfigs.any (fun _ exe => exe.root == mod)
|
||||
|
||||
/-- Remove the package's build outputs (i.e., delete its build directory). -/
|
||||
def clean (self : Package) : IO PUnit := do
|
||||
if (← self.buildDir.pathExists) then
|
||||
IO.FS.removeDirAll self.buildDir
|
||||
34
src/lake/Lake/Config/Script.lean
Normal file
34
src/lake/Lake/Config/Script.lean
Normal file
@@ -0,0 +1,34 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Util.Exit
|
||||
import Lake.Config.Context
|
||||
|
||||
namespace Lake
|
||||
|
||||
/--
|
||||
The type of a `Script`'s monad.
|
||||
`IO` equipped information about the Lake configuration.
|
||||
-/
|
||||
abbrev ScriptM := LakeT IO
|
||||
|
||||
/--
|
||||
The type of a `Script`'s function.
|
||||
Similar to the `main` function's signature, except that its monad is
|
||||
also equipped with information about the Lake configuration.
|
||||
-/
|
||||
abbrev ScriptFn := (args : List String) → ScriptM ExitCode
|
||||
|
||||
/--
|
||||
A package `Script` is a `ScriptFn` definition that is
|
||||
indexed by a `String` key and can be be run by `lake run <key> [-- <args>]`.
|
||||
-/
|
||||
structure Script where
|
||||
fn : ScriptFn
|
||||
doc? : Option String
|
||||
deriving Inhabited
|
||||
|
||||
def Script.run (args : List String) (self : Script) : ScriptM ExitCode :=
|
||||
self.fn args
|
||||
36
src/lake/Lake/Config/TargetConfig.lean
Normal file
36
src/lake/Lake/Config/TargetConfig.lean
Normal file
@@ -0,0 +1,36 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Build.Info
|
||||
import Lake.Build.Store
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-- A custom target's declarative configuration. -/
|
||||
structure TargetConfig (pkgName name : Name) : Type where
|
||||
/-- The target's build function. -/
|
||||
build : (pkg : NPackage pkgName) → IndexBuildM (CustomData (pkgName, name))
|
||||
/-- The target's resulting build job. -/
|
||||
getJob : CustomData (pkgName, name) → BuildJob Unit
|
||||
deriving Inhabited
|
||||
|
||||
/-- A smart constructor for target configurations that generate CLI targets. -/
|
||||
@[inline] def mkTargetJobConfig
|
||||
(build : (pkg : NPackage pkgName) → IndexBuildM (BuildJob α))
|
||||
[h : FamilyOut CustomData (pkgName, name) (BuildJob α)] : TargetConfig pkgName name where
|
||||
build := cast (by rw [← h.family_key_eq_type]) build
|
||||
getJob := fun data => discard <| ofFamily data
|
||||
|
||||
/-- A dependently typed configuration based on its registered package and name. -/
|
||||
structure TargetDecl where
|
||||
pkg : Name
|
||||
name : Name
|
||||
config : TargetConfig pkg name
|
||||
|
||||
hydrate_opaque_type OpaqueTargetConfig TargetConfig pkgName name
|
||||
|
||||
/-- Try to find a target configuration in the package with the given name . -/
|
||||
def Package.findTargetConfig? (name : Name) (self : Package) : Option (TargetConfig self.name name) :=
|
||||
self.opaqueTargetConfigs.find? name |>.map (·.get)
|
||||
184
src/lake/Lake/Config/Workspace.lean
Normal file
184
src/lake/Lake/Config/Workspace.lean
Normal file
@@ -0,0 +1,184 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lean.Util.Paths
|
||||
import Lake.Config.FacetConfig
|
||||
import Lake.Config.TargetConfig
|
||||
import Lake.Config.Env
|
||||
import Lake.Util.Log
|
||||
|
||||
open System
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-- A Lake workspace -- the top-level package directory. -/
|
||||
structure Workspace : Type where
|
||||
/-- The root package of the workspace. -/
|
||||
root : Package
|
||||
/-- The detect `Lake.Env` of the workspace. -/
|
||||
lakeEnv : Lake.Env
|
||||
/-- Name-package map of packages within the workspace. -/
|
||||
packageMap : DNameMap NPackage := {}
|
||||
/-- Name-configuration map of module facets defined in the workspace. -/
|
||||
moduleFacetConfigs : DNameMap ModuleFacetConfig
|
||||
/-- Name-configuration map of package facets defined in the workspace. -/
|
||||
packageFacetConfigs : DNameMap PackageFacetConfig
|
||||
/-- Name-configuration map of library facets defined in the workspace. -/
|
||||
libraryFacetConfigs : DNameMap LibraryFacetConfig
|
||||
|
||||
instance : Nonempty Workspace :=
|
||||
have : Inhabited Package := Classical.inhabited_of_nonempty inferInstance
|
||||
by refine' ⟨{..}⟩ <;> exact default
|
||||
|
||||
hydrate_opaque_type OpaqueWorkspace Workspace
|
||||
|
||||
namespace Workspace
|
||||
|
||||
/-- The path to the workspace's directory (i.e., the directory of the root package). -/
|
||||
@[inline] def dir (self : Workspace) : FilePath :=
|
||||
self.root.dir
|
||||
|
||||
/-- The workspace's configuration. -/
|
||||
@[inline] def config (self : Workspace) : WorkspaceConfig :=
|
||||
self.root.config.toWorkspaceConfig
|
||||
|
||||
/-- The workspace's remote packages directory. -/
|
||||
@[inline] def relPkgsDir (self : Workspace) : FilePath :=
|
||||
self.root.relPkgsDir
|
||||
|
||||
/-- The workspace's `dir` joined with its `relPkgsDir`. -/
|
||||
@[inline] def pkgsDir (self : Workspace) : FilePath :=
|
||||
self.root.pkgsDir
|
||||
|
||||
/-- The workspace's Lake manifest. -/
|
||||
@[inline] def manifestFile (self : Workspace) : FilePath :=
|
||||
self.root.manifestFile
|
||||
|
||||
/-- The `List` of packages to the workspace. -/
|
||||
def packageList (self : Workspace) : List Package :=
|
||||
self.packageMap.revFold (fun pkgs _ pkg => pkg.toPackage :: pkgs) []
|
||||
|
||||
/-- The `Array` of packages to the workspace. -/
|
||||
def packageArray (self : Workspace) : Array Package :=
|
||||
self.packageMap.fold (fun pkgs _ pkg => pkgs.push pkg.toPackage) #[]
|
||||
|
||||
/-- Add a package to the workspace. -/
|
||||
def addPackage (pkg : Package) (self : Workspace) : Workspace :=
|
||||
{self with packageMap := self.packageMap.insert pkg.name pkg}
|
||||
|
||||
/-- Try to find a package within the workspace with the given name. -/
|
||||
@[inline] def findPackage? (name : Name) (self : Workspace) : Option (NPackage name) :=
|
||||
self.packageMap.find? name
|
||||
|
||||
/-- Check if the module is local to any package in the workspace. -/
|
||||
def isLocalModule (mod : Name) (self : Workspace) : Bool :=
|
||||
self.packageMap.any fun _ pkg => pkg.isLocalModule mod
|
||||
|
||||
/-- Check if the module is buildable by any package in the workspace. -/
|
||||
def isBuildableModule (mod : Name) (self : Workspace) : Bool :=
|
||||
self.packageMap.any fun _ pkg => pkg.isBuildableModule mod
|
||||
|
||||
/-- Locate the named module in the workspace (if it is local to it). -/
|
||||
def findModule? (mod : Name) (self : Workspace) : Option Module :=
|
||||
self.packageArray.findSome? (·.findModule? mod)
|
||||
|
||||
/-- Try to find a Lean library in the workspace with the given name. -/
|
||||
def findLeanLib? (name : Name) (self : Workspace) : Option LeanLib :=
|
||||
self.packageArray.findSome? fun pkg => pkg.findLeanLib? name
|
||||
|
||||
/-- Try to find a Lean executable in the workspace with the given name. -/
|
||||
def findLeanExe? (name : Name) (self : Workspace) : Option LeanExe :=
|
||||
self.packageArray.findSome? fun pkg => pkg.findLeanExe? name
|
||||
|
||||
/-- Try to find an external library in the workspace with the given name. -/
|
||||
def findExternLib? (name : Name) (self : Workspace) : Option ExternLib :=
|
||||
self.packageArray.findSome? fun pkg => pkg.findExternLib? name
|
||||
|
||||
/-- Try to find a target configuration in the workspace with the given name. -/
|
||||
def findTargetConfig? (name : Name) (self : Workspace) : Option ((pkg : Package) × TargetConfig pkg.name name) :=
|
||||
self.packageArray.findSome? fun pkg => pkg.findTargetConfig? name <&> (⟨pkg, ·⟩)
|
||||
|
||||
/-- Add a module facet to the workspace. -/
|
||||
def addModuleFacetConfig (cfg : ModuleFacetConfig name) (self : Workspace) : Workspace :=
|
||||
{self with moduleFacetConfigs := self.moduleFacetConfigs.insert name cfg}
|
||||
|
||||
/-- Try to find a module facet configuration in the workspace with the given name. -/
|
||||
@[inline] def findModuleFacetConfig? (name : Name) (self : Workspace) : Option (ModuleFacetConfig name) :=
|
||||
self.moduleFacetConfigs.find? name
|
||||
|
||||
/-- Add a package facet to the workspace. -/
|
||||
def addPackageFacetConfig (cfg : PackageFacetConfig name) (self : Workspace) : Workspace :=
|
||||
{self with packageFacetConfigs := self.packageFacetConfigs.insert name cfg}
|
||||
|
||||
/-- Try to find a package facet configuration in the workspace with the given name. -/
|
||||
@[inline] def findPackageFacetConfig? (name : Name) (self : Workspace) : Option (PackageFacetConfig name) :=
|
||||
self.packageFacetConfigs.find? name
|
||||
|
||||
/-- Add a library facet to the workspace. -/
|
||||
def addLibraryFacetConfig (cfg : LibraryFacetConfig name) (self : Workspace) : Workspace :=
|
||||
{self with libraryFacetConfigs := self.libraryFacetConfigs.insert cfg.name cfg}
|
||||
|
||||
/-- Try to find a library facet configuration in the workspace with the given name. -/
|
||||
@[inline] def findLibraryFacetConfig? (name : Name) (self : Workspace) : Option (LibraryFacetConfig name) :=
|
||||
self.libraryFacetConfigs.find? name
|
||||
|
||||
/-- The workspace's binary Lean library paths (which are added to `LEAN_PATH`). -/
|
||||
def leanPath (self : Workspace) : SearchPath :=
|
||||
self.packageList.map (·.leanLibDir)
|
||||
|
||||
/-- The workspace's source directories (which are added to `LEAN_SRC_PATH`). -/
|
||||
def leanSrcPath (self : Workspace) : SearchPath :=
|
||||
self.packageList.map (·.srcDir)
|
||||
|
||||
/--
|
||||
The workspace's shared library path (e.g., for `--load-dynlib`).
|
||||
This is added to the `sharedLibPathEnvVar` by `lake env`.
|
||||
-/
|
||||
def sharedLibPath (self : Workspace) : SearchPath :=
|
||||
self.packageList.map (·.nativeLibDir)
|
||||
|
||||
/--
|
||||
The detected `LEAN_PATH` of the environment
|
||||
augmented with the workspace's `leanPath` and Lake's `libDir`.
|
||||
|
||||
We include Lake's `oleanDir` at the end to ensure that same Lake package being
|
||||
used to build is available to the environment (and thus, e.g., the Lean server).
|
||||
Otherwise, it may fall back on whatever the default Lake instance is.
|
||||
-/
|
||||
def augmentedLeanPath (self : Workspace) : SearchPath :=
|
||||
self.lakeEnv.leanPath ++ self.leanPath ++ [self.lakeEnv.lake.libDir]
|
||||
|
||||
/--
|
||||
The detected `LEAN_SRC_PATH` of the environment
|
||||
augmented with the workspace's `leanSrcPath` and Lake's `srcDir`.
|
||||
|
||||
We include Lake's `srcDir` at the end to ensure that same Lake package being
|
||||
used to build is available to the environment (and thus, e.g., the Lean server).
|
||||
Otherwise, it may fall back on whatever the default Lake instance is.
|
||||
-/
|
||||
def augmentedLeanSrcPath (self : Workspace) : SearchPath :=
|
||||
self.lakeEnv.leanSrcPath ++ self.leanSrcPath ++ [self.lakeEnv.lake.srcDir]
|
||||
|
||||
/-
|
||||
The detected `sharedLibPathEnv` value of the environment
|
||||
augmented with the workspace's `libPath`.
|
||||
-/
|
||||
def augmentedSharedLibPath (self : Workspace) : SearchPath :=
|
||||
self.lakeEnv.sharedLibPath ++ self.sharedLibPath
|
||||
|
||||
/--
|
||||
The detected environment augmented with the Workspace's paths.
|
||||
These are the settings use by `lake env` / `Lake.env` to run executables.
|
||||
-/
|
||||
def augmentedEnvVars (self : Workspace) : Array (String × Option String) :=
|
||||
self.lakeEnv.installVars ++ #[
|
||||
("LEAN_PATH", some self.augmentedLeanPath.toString),
|
||||
("LEAN_SRC_PATH", some self.augmentedLeanSrcPath.toString),
|
||||
(sharedLibPathEnvVar, some self.augmentedSharedLibPath.toString)
|
||||
]
|
||||
|
||||
/-- Remove all packages' build outputs (i.e., delete their build directories). -/
|
||||
def clean (self : Workspace) : IO Unit := do
|
||||
self.packageMap.forM fun _ pkg => pkg.clean
|
||||
20
src/lake/Lake/Config/WorkspaceConfig.lean
Normal file
20
src/lake/Lake/Config/WorkspaceConfig.lean
Normal file
@@ -0,0 +1,20 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
|
||||
open System
|
||||
namespace Lake
|
||||
|
||||
/-- The default setting for a `WorkspaceConfig`'s `packagesDir` option. -/
|
||||
def defaultPackagesDir : FilePath := "lake-packages"
|
||||
|
||||
/-- A `Workspace`'s declarative configuration. -/
|
||||
structure WorkspaceConfig where
|
||||
/--
|
||||
The directory to which Lake should download remote dependencies.
|
||||
Defaults to `defaultPackagesDir` (i.e., `lake-packages`).
|
||||
-/
|
||||
packagesDir : Option FilePath := none
|
||||
deriving Inhabited, Repr
|
||||
15
src/lake/Lake/DSL.lean
Normal file
15
src/lake/Lake/DSL.lean
Normal file
@@ -0,0 +1,15 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.DSL.DeclUtil
|
||||
import Lake.DSL.Attributes
|
||||
import Lake.DSL.Extensions
|
||||
import Lake.DSL.Config
|
||||
import Lake.DSL.Package
|
||||
import Lake.DSL.Script
|
||||
import Lake.DSL.Require
|
||||
import Lake.DSL.Targets
|
||||
import Lake.DSL.Facets
|
||||
import Lake.DSL.Meta
|
||||
56
src/lake/Lake/DSL/Attributes.lean
Normal file
56
src/lake/Lake/DSL/Attributes.lean
Normal file
@@ -0,0 +1,56 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Util.OrderedTagAttribute
|
||||
|
||||
open Lean
|
||||
namespace Lake
|
||||
|
||||
initialize packageAttr : OrderedTagAttribute ←
|
||||
registerOrderedTagAttribute `package "mark a definition as a Lake package configuration"
|
||||
|
||||
initialize packageDepAttr : OrderedTagAttribute ←
|
||||
registerOrderedTagAttribute `package_dep "mark a definition as a Lake package dependency"
|
||||
|
||||
initialize scriptAttr : OrderedTagAttribute ←
|
||||
registerOrderedTagAttribute `script "mark a definition as a Lake script"
|
||||
|
||||
initialize defaultScriptAttr : OrderedTagAttribute ←
|
||||
registerOrderedTagAttribute `default_script "mark a Lake script as the package's default"
|
||||
fun name => do
|
||||
unless (← getEnv <&> (scriptAttr.hasTag · name)) do
|
||||
throwError "attribute `default_script` can only be used on a `script`"
|
||||
|
||||
initialize leanLibAttr : OrderedTagAttribute ←
|
||||
registerOrderedTagAttribute `lean_lib "mark a definition as a Lake Lean library target configuration"
|
||||
|
||||
initialize leanExeAttr : OrderedTagAttribute ←
|
||||
registerOrderedTagAttribute `lean_exe "mark a definition as a Lake Lean executable target configuration"
|
||||
|
||||
initialize externLibAttr : OrderedTagAttribute ←
|
||||
registerOrderedTagAttribute `extern_lib "mark a definition as a Lake external library target"
|
||||
|
||||
initialize targetAttr : OrderedTagAttribute ←
|
||||
registerOrderedTagAttribute `target "mark a definition as a custom Lake target"
|
||||
|
||||
initialize defaultTargetAttr : OrderedTagAttribute ←
|
||||
registerOrderedTagAttribute `default_target "mark a Lake target as the package's default"
|
||||
fun name => do
|
||||
let valid ← getEnv <&> fun env =>
|
||||
leanLibAttr.hasTag env name ||
|
||||
leanExeAttr.hasTag env name ||
|
||||
externLibAttr.hasTag env name ||
|
||||
targetAttr.hasTag env name
|
||||
unless valid do
|
||||
throwError "attribute `default_target` can only be used on a target (e.g., `lean_lib`, `lean_exe`)"
|
||||
|
||||
initialize moduleFacetAttr : OrderedTagAttribute ←
|
||||
registerOrderedTagAttribute `module_facet "mark a definition as a Lake module facet"
|
||||
|
||||
initialize packageFacetAttr : OrderedTagAttribute ←
|
||||
registerOrderedTagAttribute `package_facet "mark a definition as a Lake package facet"
|
||||
|
||||
initialize libraryFacetAttr : OrderedTagAttribute ←
|
||||
registerOrderedTagAttribute `library_facet "mark a definition as a Lake library facet"
|
||||
65
src/lake/Lake/DSL/Config.lean
Normal file
65
src/lake/Lake/DSL/Config.lean
Normal file
@@ -0,0 +1,65 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lean.Elab.ElabRules
|
||||
import Lake.DSL.Extensions
|
||||
|
||||
namespace Lake.DSL
|
||||
open Lean Elab Term
|
||||
|
||||
/--
|
||||
A dummy default constant for `__dir__` to make it type check
|
||||
outside Lakefile elaboration (e.g., when editing).
|
||||
-/
|
||||
opaque dummyDir : System.FilePath
|
||||
|
||||
/--
|
||||
A dummy default constant for `get_config` to make it type check
|
||||
outside Lakefile elaboration (e.g., when editing).
|
||||
-/
|
||||
opaque dummyGetConfig? : Name → Option String
|
||||
|
||||
/--
|
||||
A macro that expands to the path of package's directory
|
||||
during the Lakefile's elaboration.
|
||||
-/
|
||||
scoped syntax (name := dirConst) "__dir__" : term
|
||||
|
||||
@[term_elab dirConst]
|
||||
def elabDirConst : TermElab := fun stx expectedType? => do
|
||||
let exp :=
|
||||
if let some dir := dirExt.getState (← getEnv) then
|
||||
let str := Syntax.mkStrLit dir.toString (SourceInfo.fromRef stx)
|
||||
Syntax.mkApp (mkCIdentFrom stx ``System.FilePath.mk) #[str]
|
||||
else
|
||||
-- `id` app forces Lean to show macro's doc rather than the constant's
|
||||
Syntax.mkApp (mkCIdentFrom stx ``id) #[mkCIdentFrom stx ``dummyDir]
|
||||
withMacroExpansion stx exp <| elabTerm exp expectedType?
|
||||
|
||||
/--
|
||||
A macro that expands to the specified configuration option (or `none`,
|
||||
if not the option has not been set) during the Lakefile's elaboration.
|
||||
|
||||
Configuration arguments are set either via the Lake CLI (by the `-K` option)
|
||||
or via the `with` clause in a `require` statement.
|
||||
-/
|
||||
scoped syntax (name := getConfig) "get_config? " ident :term
|
||||
|
||||
@[term_elab getConfig]
|
||||
def elabGetConfig : TermElab := fun stx expectedType? => do
|
||||
tryPostponeIfNoneOrMVar expectedType?
|
||||
match stx with
|
||||
| `(getConfig| get_config? $key) => do
|
||||
let exp : Term ← show TermElabM Term from do
|
||||
if let some opts := optsExt.getState (← getEnv) then
|
||||
if let some val := opts.find? key.getId then
|
||||
`(some $(Syntax.mkStrLit val <| SourceInfo.fromRef (← getRef)))
|
||||
else
|
||||
-- Make sure `none` is properly typed
|
||||
`((none : Option String))
|
||||
else
|
||||
return Syntax.mkApp (mkCIdentFrom stx ``dummyGetConfig?) #[quote key.getId]
|
||||
withMacroExpansion stx exp <| elabTerm exp expectedType?
|
||||
| _ => throwUnsupportedSyntax
|
||||
86
src/lake/Lake/DSL/DeclUtil.lean
Normal file
86
src/lake/Lake/DSL/DeclUtil.lean
Normal file
@@ -0,0 +1,86 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Util.Binder
|
||||
import Lean.Parser.Command
|
||||
|
||||
namespace Lake.DSL
|
||||
open Lean Parser Command
|
||||
|
||||
abbrev DocComment := TSyntax ``docComment
|
||||
abbrev Attributes := TSyntax ``Term.attributes
|
||||
abbrev AttrInstance := TSyntax ``Term.attrInstance
|
||||
abbrev WhereDecls := TSyntax ``Term.whereDecls
|
||||
|
||||
---
|
||||
|
||||
def expandAttrs (attrs? : Option Attributes) : Array AttrInstance :=
|
||||
if let some attrs := attrs? then
|
||||
match attrs with
|
||||
| `(Term.attributes| @[$attrs,*]) => attrs
|
||||
| _ => #[]
|
||||
else
|
||||
#[]
|
||||
|
||||
syntax structVal :=
|
||||
"{" manyIndent(group(Term.structInstField ", "?)) "}"
|
||||
|
||||
syntax declValDo :=
|
||||
ppSpace Term.do (Term.whereDecls)?
|
||||
|
||||
syntax declValStruct :=
|
||||
ppSpace structVal (Term.whereDecls)?
|
||||
|
||||
syntax declValTyped :=
|
||||
Term.typeSpec declValSimple
|
||||
|
||||
syntax declValOptTyped :=
|
||||
(Term.typeSpec)? declValSimple
|
||||
|
||||
syntax simpleDeclSig :=
|
||||
ident Term.typeSpec declValSimple
|
||||
|
||||
syntax structDeclSig :=
|
||||
ident (Command.whereStructInst <|> declValOptTyped <|> declValStruct)?
|
||||
|
||||
syntax bracketedSimpleBinder :=
|
||||
"(" ident (" : " term)? ")"
|
||||
|
||||
syntax simpleBinder :=
|
||||
ident <|> bracketedSimpleBinder
|
||||
|
||||
abbrev SimpleBinder := TSyntax ``simpleBinder
|
||||
open Lean.Parser.Term in
|
||||
def expandOptSimpleBinder (stx? : Option SimpleBinder) : MacroM FunBinder := do
|
||||
match stx? with
|
||||
| some stx =>
|
||||
match stx with
|
||||
| `(simpleBinder| $id:ident) =>
|
||||
`(funBinder| $id)
|
||||
| `(simpleBinder| ($id $[: $ty?]?)) =>
|
||||
let ty := ty?.getD (← `(_))
|
||||
`(funBinder| ($id : $ty))
|
||||
| _ => `(funBinder| _)
|
||||
| none => `(funBinder| _)
|
||||
|
||||
def fixName (id : Ident) : Option Name → Ident
|
||||
| some n => mkIdentFrom id n
|
||||
| none => id
|
||||
|
||||
def mkConfigStructDecl (name? : Option Name)
|
||||
(doc? : Option DocComment) (attrs : Array AttrInstance) (ty : Term)
|
||||
: (spec : Syntax) → MacroM Syntax.Command
|
||||
| `(structDeclSig| $id:ident) =>
|
||||
`($[$doc?]? @[$attrs,*] abbrev $(fixName id name?) : $ty :=
|
||||
{name := $(quote id.getId)})
|
||||
| `(structDeclSig| $id:ident where $ds;* $[$wds?]?) =>
|
||||
`($[$doc?]? @[$attrs,*] abbrev $(fixName id name?) : $ty where
|
||||
name := $(quote id.getId); $ds;* $[$wds?]?)
|
||||
| `(structDeclSig| $id:ident $[: $ty?]? := $defn $[$wds?]?) =>
|
||||
`($[$doc?]? @[$attrs,*] abbrev $(fixName id name?) : $(ty?.getD ty) := $defn $[$wds?]?)
|
||||
| `(structDeclSig| $id:ident { $[$fs $[,]?]* } $[$wds?]?) => do
|
||||
let defn ← `({ name := $(quote id.getId), $fs,* })
|
||||
`($[$doc?]? @[$attrs,*] abbrev $(fixName id name?) : $ty := $defn $[$wds?]?)
|
||||
| stx => Macro.throwErrorAt stx "ill-formed configuration syntax"
|
||||
17
src/lake/Lake/DSL/Extensions.lean
Normal file
17
src/lake/Lake/DSL/Extensions.lean
Normal file
@@ -0,0 +1,17 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lean.Environment
|
||||
import Lake.Config.Dependency
|
||||
|
||||
open Lean
|
||||
|
||||
namespace Lake
|
||||
|
||||
initialize dirExt : EnvExtension (Option System.FilePath) ←
|
||||
registerEnvExtension (pure none)
|
||||
|
||||
initialize optsExt : EnvExtension (Option (NameMap String)) ←
|
||||
registerEnvExtension (pure none)
|
||||
173
src/lake/Lake/DSL/Facets.lean
Normal file
173
src/lake/Lake/DSL/Facets.lean
Normal file
@@ -0,0 +1,173 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.DSL.DeclUtil
|
||||
import Lake.Config.FacetConfig
|
||||
import Lake.Config.TargetConfig
|
||||
import Lake.Build.Index
|
||||
|
||||
/-!
|
||||
Macros for declaring custom facets and targets.
|
||||
-/
|
||||
|
||||
namespace Lake.DSL
|
||||
open Lean Parser Command
|
||||
|
||||
syntax buildDeclSig :=
|
||||
ident (ppSpace simpleBinder)? Term.typeSpec declValSimple
|
||||
|
||||
/--
|
||||
Define a new module facet. Has one form:
|
||||
|
||||
```lean
|
||||
module_facet «facet-name» (mod : Module) : α :=
|
||||
/- build function term -/
|
||||
```
|
||||
|
||||
The `mod` parameter (and its type specifier) is optional.
|
||||
The term should be of type `IndexBuildM (BuildJob α)`.
|
||||
-/
|
||||
scoped macro (name := moduleFacetDecl)
|
||||
doc?:optional(docComment) attrs?:optional(Term.attributes)
|
||||
kw:"module_facet " sig:buildDeclSig : command => do
|
||||
match sig with
|
||||
| `(buildDeclSig| $id:ident $[$mod?]? : $ty := $defn $[$wds?]?) =>
|
||||
let attr ← withRef kw `(Term.attrInstance| module_facet)
|
||||
let attrs := #[attr] ++ expandAttrs attrs?
|
||||
let name := Name.quoteFrom id id.getId
|
||||
let facetId := mkIdentFrom id <| id.getId.modifyBase (.str · "_modFacet")
|
||||
let mod ← expandOptSimpleBinder mod?
|
||||
`(module_data $id : BuildJob $ty
|
||||
$[$doc?:docComment]? @[$attrs,*] abbrev $facetId : ModuleFacetDecl := {
|
||||
name := $name
|
||||
config := Lake.mkFacetJobConfig
|
||||
fun $mod => ($defn : IndexBuildM (BuildJob $ty))
|
||||
} $[$wds?]?)
|
||||
| stx => Macro.throwErrorAt stx "ill-formed module facet declaration"
|
||||
|
||||
/--
|
||||
Define a new package facet. Has one form:
|
||||
|
||||
```lean
|
||||
package_facet «facet-name» (pkg : Package) : α :=
|
||||
/- build function term -/
|
||||
```
|
||||
|
||||
The `pkg` parameter (and its type specifier) is optional.
|
||||
The term should be of type `IndexBuildM (BuildJob α)`.
|
||||
-/
|
||||
scoped macro (name := packageFacetDecl)
|
||||
doc?:optional(docComment) attrs?:optional(Term.attributes)
|
||||
kw:"package_facet " sig:buildDeclSig : command => do
|
||||
match sig with
|
||||
| `(buildDeclSig| $id:ident $[$pkg?]? : $ty := $defn $[$wds?]?) =>
|
||||
let attr ← withRef kw `(Term.attrInstance| package_facet)
|
||||
let attrs := #[attr] ++ expandAttrs attrs?
|
||||
let name := Name.quoteFrom id id.getId
|
||||
let facetId := mkIdentFrom id <| id.getId.modifyBase (.str · "_pkgFacet")
|
||||
let pkg ← expandOptSimpleBinder pkg?
|
||||
`(package_data $id : BuildJob $ty
|
||||
$[$doc?]? @[$attrs,*] abbrev $facetId : PackageFacetDecl := {
|
||||
name := $name
|
||||
config := Lake.mkFacetJobConfig
|
||||
fun $pkg => ($defn : IndexBuildM (BuildJob $ty))
|
||||
} $[$wds?]?)
|
||||
| stx => Macro.throwErrorAt stx "ill-formed package facet declaration"
|
||||
|
||||
/--
|
||||
Define a new library facet. Has one form:
|
||||
|
||||
```lean
|
||||
library_facet «facet-name» (lib : LeanLib) : α :=
|
||||
/- build function term -/
|
||||
```
|
||||
|
||||
The `lib` parameter (and its type specifier) is optional.
|
||||
The term should be of type `IndexBuildM (BuildJob α)`.
|
||||
-/
|
||||
scoped macro (name := libraryFacetDecl)
|
||||
doc?:optional(docComment) attrs?:optional(Term.attributes)
|
||||
kw:"library_facet " sig:buildDeclSig : command => do
|
||||
match sig with
|
||||
| `(buildDeclSig| $id:ident $[$lib?]? : $ty := $defn $[$wds?]?) =>
|
||||
let attr ← withRef kw `(Term.attrInstance| library_facet)
|
||||
let attrs := #[attr] ++ expandAttrs attrs?
|
||||
let name := Name.quoteFrom id id.getId
|
||||
let facetId := mkIdentFrom id <| id.getId.modifyBase (.str · "_libFacet")
|
||||
let lib ← expandOptSimpleBinder lib?
|
||||
`(library_data $id : BuildJob $ty
|
||||
$[$doc?]? @[$attrs,*] abbrev $facetId : LibraryFacetDecl := {
|
||||
name := $name
|
||||
config := Lake.mkFacetJobConfig
|
||||
fun $lib => ($defn : IndexBuildM (BuildJob $ty))
|
||||
} $[$wds?]?)
|
||||
| stx => Macro.throwErrorAt stx "ill-formed library facet declaration"
|
||||
|
||||
/--
|
||||
Define a new custom target for the package. Has one form:
|
||||
|
||||
```lean
|
||||
target «target-name» (pkg : Package) : α :=
|
||||
/- build function term -/
|
||||
```
|
||||
|
||||
The `pkg` parameter (and its type specifier) is optional.
|
||||
The term should be of type `IndexBuildM (BuildJob α)`.
|
||||
-/
|
||||
scoped macro (name := targetDecl)
|
||||
doc?:optional(docComment) attrs?:optional(Term.attributes)
|
||||
kw:"target " sig:buildDeclSig : command => do
|
||||
match sig with
|
||||
| `(buildDeclSig| $id:ident $[$pkg?]? : $ty := $defn $[$wds?]?) =>
|
||||
let attr ← withRef kw `(Term.attrInstance| target)
|
||||
let attrs := #[attr] ++ expandAttrs attrs?
|
||||
let name := Name.quoteFrom id id.getId
|
||||
let pkgName := mkIdentFrom id `_package.name
|
||||
let pkg ← expandOptSimpleBinder pkg?
|
||||
`(family_def $id : CustomData ($pkgName, $name) := BuildJob $ty
|
||||
$[$doc?]? @[$attrs,*] abbrev $id : TargetDecl := {
|
||||
pkg := $pkgName
|
||||
name := $name
|
||||
config := Lake.mkTargetJobConfig
|
||||
fun $pkg => ($defn : IndexBuildM (BuildJob $ty))
|
||||
} $[$wds?]?)
|
||||
| stx => Macro.throwErrorAt stx "ill-formed target declaration"
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! # External Library Target -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
syntax externLibDeclSpec :=
|
||||
ident (ppSpace simpleBinder)? declValSimple
|
||||
|
||||
/--
|
||||
Define a new external library target for the package. Has one form:
|
||||
|
||||
```lean
|
||||
extern_lib «target-name» (pkg : Package) :=
|
||||
/- build function term -/
|
||||
```
|
||||
|
||||
The `pkg` parameter (and its type specifier) is optional.
|
||||
The term should be of type `IndexBuildM (BuildJob FilePath)` and
|
||||
build the external library's **static** library.
|
||||
-/
|
||||
scoped macro (name := externLibDecl)
|
||||
doc?:optional(docComment) attrs?:optional(Term.attributes)
|
||||
"extern_lib " spec:externLibDeclSpec : command => do
|
||||
match spec with
|
||||
| `(externLibDeclSpec| $id:ident $[$pkg?]? := $defn $[$wds?]?) =>
|
||||
let attr ← `(Term.attrInstance| extern_lib)
|
||||
let attrs := #[attr] ++ expandAttrs attrs?
|
||||
let pkgName := mkIdentFrom id `_package.name
|
||||
let targetId := mkIdentFrom id <| id.getId.modifyBase (· ++ `static)
|
||||
let name := Name.quoteFrom id id.getId
|
||||
`(target $targetId $[$pkg?]? : FilePath := $defn $[$wds?]?
|
||||
$[$doc?:docComment]? @[$attrs,*] def $id : ExternLibDecl := {
|
||||
pkg := $pkgName
|
||||
name := $name
|
||||
config := {getJob := ofFamily}
|
||||
})
|
||||
| stx => Macro.throwErrorAt stx "ill-formed external library declaration"
|
||||
61
src/lake/Lake/DSL/Meta.lean
Normal file
61
src/lake/Lake/DSL/Meta.lean
Normal file
@@ -0,0 +1,61 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Util.EvalTerm
|
||||
import Lean.Elab.ElabRules
|
||||
|
||||
/-!
|
||||
Syntax for elaboration time control flow.
|
||||
-/
|
||||
|
||||
namespace Lake.DSL
|
||||
open Lean Elab Command
|
||||
|
||||
/--
|
||||
The `do` command syntax groups multiple similarly indented commands together.
|
||||
The group can then be passed to another command that usually only accepts a
|
||||
single command (e.g., `meta if`).
|
||||
-/
|
||||
syntax cmdDo := ("do" many1Indent(command)) <|> command
|
||||
|
||||
def expandCmdDo : TSyntax ``cmdDo → Array Command
|
||||
| `(cmdDo|do $cmds*) => cmds
|
||||
| `(cmdDo|$cmd:command) => #[cmd]
|
||||
| _ => #[]
|
||||
|
||||
/--
|
||||
The `meta if` command has two forms:
|
||||
|
||||
```lean
|
||||
meta if <c:term> then <a:command>
|
||||
meta if <c:term> then <a:command> else <b:command>
|
||||
```
|
||||
|
||||
It expands to the command `a` if the term `c` evaluates to true
|
||||
(at elaboration time). Otherwise, it expands to command `b` (if an `else`
|
||||
clause is provided).
|
||||
|
||||
One can use this command to specify, for example, external library targets
|
||||
only available on specific platforms:
|
||||
|
||||
```lean
|
||||
meta if System.Platform.isWindows then
|
||||
extern_lib winOnlyLib := ...
|
||||
else meta if System.Platform.isOSX then
|
||||
extern_lib macOnlyLib := ...
|
||||
else
|
||||
extern_lib linuxOnlyLib := ...
|
||||
```
|
||||
-/
|
||||
scoped syntax (name := metaIf)
|
||||
"meta " "if " term " then " cmdDo (" else " cmdDo)? : command
|
||||
|
||||
elab_rules : command | `(meta if $c then $t $[else $e?]?) => do
|
||||
if (← withRef c <| runTermElabM fun _ => evalTerm Bool c) then
|
||||
let cmd := mkNullNode (expandCmdDo t)
|
||||
withMacroExpansion (← getRef) cmd <| elabCommand cmd
|
||||
else if let some e := e? then
|
||||
let cmd := mkNullNode (expandCmdDo e)
|
||||
withMacroExpansion (← getRef) cmd <| elabCommand cmd
|
||||
35
src/lake/Lake/DSL/Package.lean
Normal file
35
src/lake/Lake/DSL/Package.lean
Normal file
@@ -0,0 +1,35 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Config.Package
|
||||
import Lake.DSL.Attributes
|
||||
import Lake.DSL.DeclUtil
|
||||
|
||||
namespace Lake.DSL
|
||||
open Lean Parser Command
|
||||
|
||||
/-- The name given to the definition created by the `package` syntax. -/
|
||||
def packageDeclName := `_package
|
||||
|
||||
/--
|
||||
Defines the configuration of a Lake package. Has many forms:
|
||||
|
||||
```lean
|
||||
package «pkg-name»
|
||||
package «pkg-name» { /- config opts -/ }
|
||||
package «pkg-name» where /- config opts -/
|
||||
package «pkg-name» : PackageConfig := /- config -/
|
||||
```
|
||||
|
||||
There can only be one `package` declaration per Lake configuration file.
|
||||
The defined package configuration will be available for reference as `_package`.
|
||||
-/
|
||||
scoped macro (name := packageDecl)
|
||||
doc?:optional(docComment) attrs?:optional(Term.attributes)
|
||||
"package " sig:structDeclSig : command => do
|
||||
let attr ← `(Term.attrInstance| «package»)
|
||||
let ty := mkCIdentFrom (← getRef) ``PackageConfig
|
||||
let attrs := #[attr] ++ expandAttrs attrs?
|
||||
mkConfigStructDecl packageDeclName doc? attrs ty sig
|
||||
57
src/lake/Lake/DSL/Require.lean
Normal file
57
src/lake/Lake/DSL/Require.lean
Normal file
@@ -0,0 +1,57 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lean.Parser.Command
|
||||
import Lake.DSL.Extensions
|
||||
|
||||
namespace Lake.DSL
|
||||
open Lean Parser Command
|
||||
|
||||
syntax fromPath :=
|
||||
term
|
||||
|
||||
syntax fromGit :=
|
||||
&" git " term:max ("@" term:max)? ("/" term)?
|
||||
|
||||
syntax depSpec :=
|
||||
ident " from " (fromGit <|> fromPath) (" with " term)?
|
||||
|
||||
def expandDepSpec : TSyntax ``depSpec → MacroM Command
|
||||
| `(depSpec| $name:ident from git $url $[@ $rev?]? $[/ $path?]? $[with $opts?]?) => do
|
||||
let rev ← match rev? with | some rev => `(some $rev) | none => `(none)
|
||||
let path ← match path? with | some path => `(some $path) | none => `(none)
|
||||
let opts := opts?.getD <| ← `({})
|
||||
`(@[package_dep] def $name : Dependency := {
|
||||
name := $(quote name.getId),
|
||||
src := Source.git $url $rev $path,
|
||||
options := $opts
|
||||
})
|
||||
| `(depSpec| $name:ident from $path:term $[with $opts?]?) => do
|
||||
let opts := opts?.getD <| ← `({})
|
||||
`(@[package_dep] def $name : Dependency := {
|
||||
name := $(quote name.getId),
|
||||
src := Source.path $path,
|
||||
options := $opts
|
||||
})
|
||||
| _ => Macro.throwUnsupported
|
||||
|
||||
/--
|
||||
Adds a mew package dependency to the workspace. Has two forms:
|
||||
|
||||
```lean
|
||||
require foo from "path"/"to"/"local"/"package" with NameMap.empty
|
||||
require bar from git "url.git"@"rev"/"optional"/"path-to"/"dir-with-pkg"
|
||||
```
|
||||
|
||||
Either form supports the optional `with` clause.
|
||||
The `@"rev"` and `/"path"/"dir"` parts of the git form of `require`
|
||||
are optional.
|
||||
|
||||
The elements of both the `from` and `with` clauses are proper terms so
|
||||
normal computation is supported within them (though parentheses made be
|
||||
required to disambiguate the syntax).
|
||||
-/
|
||||
scoped macro (name := requireDecl) "require " spec:depSpec : command =>
|
||||
expandDepSpec spec
|
||||
35
src/lake/Lake/DSL/Script.lean
Normal file
35
src/lake/Lake/DSL/Script.lean
Normal file
@@ -0,0 +1,35 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Config.Package
|
||||
import Lake.DSL.Attributes
|
||||
import Lake.DSL.DeclUtil
|
||||
|
||||
namespace Lake.DSL
|
||||
open Lean Parser Command
|
||||
|
||||
syntax scriptDeclSpec :=
|
||||
ident (ppSpace simpleBinder)? (declValSimple <|> declValDo)
|
||||
|
||||
/--
|
||||
Define a new Lake script for the package. Has two forms:
|
||||
|
||||
```lean
|
||||
script «script-name» (args) do /- ... -/
|
||||
script «script-name» (args) := ...
|
||||
```
|
||||
-/
|
||||
scoped syntax (name := scriptDecl)
|
||||
(docComment)? optional(Term.attributes) "script " scriptDeclSpec : command
|
||||
|
||||
@[macro scriptDecl]
|
||||
def expandScriptDecl : Macro
|
||||
| `($[$doc?]? $[$attrs?]? script $id:ident $[$args?]? do $seq $[$wds?]?) => do
|
||||
`($[$doc?]? $[$attrs?]? script $id:ident $[$args?]? := do $seq $[$wds?]?)
|
||||
| `($[$doc?]? $[$attrs?]? script $id:ident $[$args?]? := $defn $[$wds?]?) => do
|
||||
let args ← expandOptSimpleBinder args?
|
||||
let attrs := #[← `(Term.attrInstance| «script»)] ++ expandAttrs attrs?
|
||||
`($[$doc?]? @[$attrs,*] def $id : ScriptFn := fun $args => $defn $[$wds?]?)
|
||||
| stx => Macro.throwErrorAt stx "ill-formed script declaration"
|
||||
57
src/lake/Lake/DSL/Targets.lean
Normal file
57
src/lake/Lake/DSL/Targets.lean
Normal file
@@ -0,0 +1,57 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.DSL.DeclUtil
|
||||
import Lake.DSL.Attributes
|
||||
import Lake.Config.LeanExeConfig
|
||||
import Lake.Config.LeanLibConfig
|
||||
import Lake.Config.ExternLibConfig
|
||||
|
||||
namespace Lake.DSL
|
||||
open Lean Parser Command
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! # Lean Library & Executable Targets -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
/--
|
||||
Define a new Lean library target for the package.
|
||||
Can optionally be provided with a configuration of type `LeanLibConfig`.
|
||||
Has many forms:
|
||||
|
||||
```lean
|
||||
lean_lib «target-name»
|
||||
lean_lib «target-name» { /- config opts -/ }
|
||||
lean_lib «target-name» where /- config opts -/
|
||||
lean_lib «target-name» := /- config -/
|
||||
```
|
||||
-/
|
||||
scoped macro (name := leanLibDecl)
|
||||
doc?:optional(docComment) attrs?:optional(Term.attributes)
|
||||
"lean_lib " sig:structDeclSig : command => do
|
||||
let attr ← `(Term.attrInstance| lean_lib)
|
||||
let ty := mkCIdentFrom (← getRef) ``LeanLibConfig
|
||||
let attrs := #[attr] ++ expandAttrs attrs?
|
||||
mkConfigStructDecl none doc? attrs ty sig
|
||||
|
||||
/--
|
||||
Define a new Lean binary executable target for the package.
|
||||
Can optionally be provided with a configuration of type `LeanExeConfig`.
|
||||
Has many forms:
|
||||
|
||||
```lean
|
||||
lean_exe «target-name»
|
||||
lean_exe «target-name» { /- config opts -/ }
|
||||
lean_exe «target-name» where /- config opts -/
|
||||
lean_exe «target-name» := /- config -/
|
||||
```
|
||||
-/
|
||||
scoped macro (name := leanExeDecl)
|
||||
doc?:optional(docComment) attrs?:optional(Term.attributes)
|
||||
"lean_exe " sig:structDeclSig : command => do
|
||||
let attr ← `(Term.attrInstance| lean_exe)
|
||||
let ty := mkCIdentFrom (← getRef) ``LeanExeConfig
|
||||
let attrs := #[attr] ++ expandAttrs attrs?
|
||||
mkConfigStructDecl none doc? attrs ty sig
|
||||
6
src/lake/Lake/Load.lean
Normal file
6
src/lake/Lake/Load.lean
Normal file
@@ -0,0 +1,6 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Load.Main
|
||||
28
src/lake/Lake/Load/Config.lean
Normal file
28
src/lake/Lake/Load/Config.lean
Normal file
@@ -0,0 +1,28 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lean.Data.Name
|
||||
import Lean.Data.Options
|
||||
import Lake.Config.Env
|
||||
import Lake.Util.Log
|
||||
|
||||
namespace Lake
|
||||
open System Lean
|
||||
|
||||
/-- The default name of the Lake configuration file (i.e., `lakefile.lean`). -/
|
||||
def defaultConfigFile : FilePath := "lakefile.lean"
|
||||
|
||||
/-- Context for loading a Lake configuration. -/
|
||||
structure LoadConfig where
|
||||
/-- The Lake environment of the load process. -/
|
||||
env : Lake.Env
|
||||
/-- The root directory of the loaded package (and its workspace). -/
|
||||
rootDir : FilePath
|
||||
/-- The Lean file with the package's Lake configuration (e.g., `lakefile.lean`) -/
|
||||
configFile : FilePath := rootDir / defaultConfigFile
|
||||
/-- A set of key-value Lake configuration options (i.e., `-K` settings). -/
|
||||
configOpts : NameMap String := {}
|
||||
/-- The Lean options with which to elaborate the configuration file. -/
|
||||
leanOpts : Options := {}
|
||||
67
src/lake/Lake/Load/Elab.lean
Normal file
67
src/lake/Lake/Load/Elab.lean
Normal file
@@ -0,0 +1,67 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lean.Elab.Frontend
|
||||
import Lake.DSL.Extensions
|
||||
import Lake.Load.Config
|
||||
import Lake.Util.Log
|
||||
|
||||
namespace Lake
|
||||
open Lean System
|
||||
|
||||
deriving instance BEq, Hashable for Import
|
||||
|
||||
/- Cache for the imported header environment of Lake configuration files. -/
|
||||
initialize importEnvCache : IO.Ref (HashMap (List Import) Environment) ← IO.mkRef {}
|
||||
|
||||
/-- Like `Lean.Elab.processHeader`, but using `importEnvCache`. -/
|
||||
def processHeader (header : Syntax) (opts : Options) (trustLevel : UInt32)
|
||||
(inputCtx : Parser.InputContext) : StateT MessageLog IO Environment := do
|
||||
try
|
||||
let imports := Elab.headerToImports header
|
||||
if let some env := (← importEnvCache.get).find? imports then
|
||||
return env
|
||||
let env ← importModules imports opts trustLevel
|
||||
importEnvCache.modify (·.insert imports env)
|
||||
return env
|
||||
catch e =>
|
||||
let pos := inputCtx.fileMap.toPosition <| header.getPos?.getD 0
|
||||
modify (·.add { fileName := inputCtx.fileName, data := toString e, pos })
|
||||
mkEmptyEnvironment
|
||||
|
||||
/-- Main module `Name` of a Lake configuration file. -/
|
||||
def configModuleName : Name := `lakefile
|
||||
|
||||
/-- Elaborate `configFile` with the given package directory and options. -/
|
||||
def elabConfigFile (pkgDir : FilePath) (configOpts : NameMap String)
|
||||
(leanOpts := Options.empty) (configFile := pkgDir / defaultConfigFile) : LogIO Environment := do
|
||||
|
||||
-- Read file and initialize environment
|
||||
let input ← IO.FS.readFile configFile
|
||||
let inputCtx := Parser.mkInputContext input configFile.toString
|
||||
let (header, parserState, messages) ← Parser.parseHeader inputCtx
|
||||
let (env, messages) ← processHeader header leanOpts 1024 inputCtx messages
|
||||
let env := env.setMainModule configModuleName
|
||||
|
||||
-- Configure extensions
|
||||
let env := dirExt.setState env pkgDir
|
||||
let env := optsExt.setState env configOpts
|
||||
|
||||
-- Elaborate File
|
||||
let commandState := Elab.Command.mkState env messages leanOpts
|
||||
let s ← Elab.IO.processCommands inputCtx parserState commandState
|
||||
|
||||
-- Log messages
|
||||
for msg in s.commandState.messages.toList do
|
||||
match msg.severity with
|
||||
| MessageSeverity.information => logInfo (← msg.toString)
|
||||
| MessageSeverity.warning => logWarning (← msg.toString)
|
||||
| MessageSeverity.error => logError (← msg.toString)
|
||||
|
||||
-- Check result
|
||||
if s.commandState.messages.hasErrors then
|
||||
error s!"{configFile}: package configuration has errors"
|
||||
else
|
||||
return s.commandState.env
|
||||
189
src/lake/Lake/Load/Main.lean
Normal file
189
src/lake/Lake/Load/Main.lean
Normal file
@@ -0,0 +1,189 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone, Gabriel Ebner
|
||||
-/
|
||||
import Lake.Util.EStateT
|
||||
import Lake.Util.StoreInsts
|
||||
import Lake.Config.Workspace
|
||||
import Lake.Build.Topological
|
||||
import Lake.Build.Module
|
||||
import Lake.Build.Package
|
||||
import Lake.Build.Library
|
||||
import Lake.Load.Materialize
|
||||
import Lake.Load.Package
|
||||
import Lake.Load.Elab
|
||||
|
||||
open System Lean
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-- Load the tagged `Dependency` definitions from a package configuration environment. -/
|
||||
def loadDepsFromEnv (env : Environment) (opts : Options) : Except String (Array Dependency) := do
|
||||
(packageDepAttr.ext.getState env).mapM (evalConstCheck env opts Dependency ``Dependency)
|
||||
|
||||
def loadDepPackage (parentPkg : Package) (result : MaterializeResult)
|
||||
(dep : Dependency) : LogIO Package := do
|
||||
let dir := result.pkgDir
|
||||
let configEnv ← elabConfigFile dir dep.options parentPkg.leanOpts (dir / defaultConfigFile)
|
||||
let config ← IO.ofExcept <| PackageConfig.loadFromEnv configEnv parentPkg.leanOpts
|
||||
return {
|
||||
dir, config, configEnv
|
||||
remoteUrl? := result.remoteUrl?
|
||||
gitTag? := result.gitTag?
|
||||
leanOpts := parentPkg.leanOpts
|
||||
}
|
||||
|
||||
def buildUpdatedManifest (ws : Workspace) : LogIO Manifest := do
|
||||
let res ← StateT.run (s := mkNameMap MaterializeResult) do
|
||||
EStateT.run' (mkNameMap Package) do
|
||||
buildAcyclic (·.name) ws.root fun pkg resolve => do
|
||||
let topLevel := pkg.name = ws.root.name
|
||||
let relPkgDir :=
|
||||
if let some {relPkgDir, ..} := ((← getThe (NameMap MaterializeResult)).find? pkg.name) then
|
||||
relPkgDir
|
||||
else
|
||||
"." -- topLevel
|
||||
unless topLevel do
|
||||
for entry in (← Manifest.loadOrEmpty pkg.manifestFile) do
|
||||
unless (← getThe (NameMap MaterializeResult)).contains entry.name do
|
||||
let entry := entry.inDirectory relPkgDir
|
||||
let result ← materializePackageEntry ws.dir ws.relPkgsDir entry
|
||||
modifyThe (NameMap MaterializeResult) (·.insert entry.name result)
|
||||
let deps ← IO.ofExcept <| loadDepsFromEnv pkg.configEnv pkg.leanOpts
|
||||
let deps ← deps.mapM fun dep => do
|
||||
if let some result := (← getThe (NameMap MaterializeResult)).find? dep.name then
|
||||
return (dep, result)
|
||||
else
|
||||
let depName := dep.name.toString (escape := false)
|
||||
let entry ← updateSource relPkgDir ws.relPkgsDir depName dep.src
|
||||
let result ← materializePackageEntry ws.dir ws.relPkgsDir entry
|
||||
modifyThe (NameMap MaterializeResult) (·.insert entry.name result)
|
||||
return (dep, result)
|
||||
let depPkgs ← deps.mapM fun (dep, result) => do
|
||||
if let .some pkg := (← getThe (NameMap Package)).find? dep.name then
|
||||
return pkg
|
||||
else
|
||||
let pkg ← loadDepPackage pkg result dep
|
||||
modifyThe (NameMap Package) (·.insert dep.name pkg)
|
||||
return pkg
|
||||
return {pkg with opaqueDeps := ← depPkgs.mapM (.mk <$> resolve ·)}
|
||||
match res with
|
||||
| (.ok _, results) =>
|
||||
let mut manifest : Manifest := {packagesDir? := ws.relPkgsDir}
|
||||
for (_, result) in results do
|
||||
manifest := manifest.insert result.manifestEntry
|
||||
return manifest
|
||||
| (.error cycle, _) =>
|
||||
let cycle := cycle.map (s!" {·}")
|
||||
error s!"dependency cycle detected:\n{"\n".intercalate cycle}"
|
||||
|
||||
/--
|
||||
Load a `Workspace` for a Lake package by elaborating its configuration file.
|
||||
Does not resolve dependencies.
|
||||
-/
|
||||
def loadWorkspaceRoot (config : LoadConfig) : LogIO Workspace := do
|
||||
Lean.searchPathRef.set config.env.leanSearchPath
|
||||
let configEnv ← elabConfigFile config.rootDir config.configOpts config.leanOpts config.configFile
|
||||
let pkgConfig ← IO.ofExcept <| PackageConfig.loadFromEnv configEnv config.leanOpts
|
||||
let repo := GitRepo.mk config.rootDir
|
||||
let root := {
|
||||
configEnv, leanOpts := config.leanOpts
|
||||
dir := config.rootDir, config := pkgConfig
|
||||
remoteUrl? := ← repo.getFilteredRemoteUrl?
|
||||
gitTag? := ← repo.findTag?
|
||||
}
|
||||
return {
|
||||
root, lakeEnv := config.env
|
||||
moduleFacetConfigs := initModuleFacetConfigs
|
||||
packageFacetConfigs := initPackageFacetConfigs
|
||||
libraryFacetConfigs := initLibraryFacetConfigs
|
||||
}
|
||||
|
||||
/--
|
||||
Finalize the workspace's root and its transitive dependencies
|
||||
and add them to the workspace.
|
||||
-/
|
||||
def Workspace.finalize (ws : Workspace) : LogIO Workspace := do
|
||||
have : MonadStore Name Package (StateT Workspace LogIO) := {
|
||||
fetch? := fun name => return (← get).findPackage? name
|
||||
store := fun _ pkg => modify (·.addPackage pkg)
|
||||
}
|
||||
let (res, ws) ← EStateT.run ws do
|
||||
buildTop (·.name) ws.root fun pkg load => do
|
||||
let depPkgs ← pkg.deps.mapM load
|
||||
set <| ← IO.ofExcept <| (← get).addFacetsFromEnv pkg.configEnv pkg.leanOpts
|
||||
let pkg ← pkg.finalize depPkgs
|
||||
return pkg
|
||||
match res with
|
||||
| Except.ok root =>
|
||||
return {ws with root}
|
||||
| Except.error cycle => do
|
||||
let cycle := cycle.map (s!" {·}")
|
||||
error <|
|
||||
s!"oops! dependency load cycle detected (this likely indicates a bug in Lake):\n" ++
|
||||
"\n".intercalate cycle
|
||||
|
||||
/--
|
||||
Resolving a workspace's dependencies using a manifest,
|
||||
downloading and/or updating them as necessary.
|
||||
-/
|
||||
def Workspace.materializeDeps (ws : Workspace) (manifest : Manifest) : LogIO Workspace := do
|
||||
if !manifest.isEmpty && manifest.packagesDir? != some ws.relPkgsDir then
|
||||
logWarning <|
|
||||
"manifest out of date: package directory changed, " ++
|
||||
"use `lake update` to update"
|
||||
let relPkgsDir := manifest.packagesDir?.getD ws.relPkgsDir
|
||||
let res ← EStateT.run' (mkNameMap Package) do
|
||||
buildAcyclic (·.name) ws.root fun pkg resolve => do
|
||||
let topLevel := pkg.name = ws.root.name
|
||||
let deps ← IO.ofExcept <| loadDepsFromEnv pkg.configEnv pkg.leanOpts
|
||||
if topLevel then
|
||||
for dep in deps do
|
||||
let warnOutOfDate (what : String) :=
|
||||
logWarning <|
|
||||
s!"manifest out of date: {what} of dependency {dep.name} changed, " ++
|
||||
"use `lake update` to update"
|
||||
if let .some entry := manifest.find? dep.name then
|
||||
match dep.src, entry with
|
||||
| .git url rev _, .git _ url' _ rev' _ =>
|
||||
if url ≠ url' then warnOutOfDate "git url"
|
||||
if rev ≠ rev' then warnOutOfDate "git revision"
|
||||
| .path .., .path .. => pure ()
|
||||
| _, _ => warnOutOfDate "source kind (git/path)"
|
||||
let depPkgs ← deps.mapM fun dep => do
|
||||
fetchOrCreate dep.name do
|
||||
let .some entry := manifest.find? dep.name
|
||||
| error <| s!"dependency {dep.name} of {pkg.name} not in manifest, " ++
|
||||
"use `lake update` to update"
|
||||
let result ← materializePackageEntry ws.dir relPkgsDir entry
|
||||
loadDepPackage pkg result dep
|
||||
return { pkg with opaqueDeps := ← depPkgs.mapM (.mk <$> resolve ·) }
|
||||
match res with
|
||||
| Except.ok root =>
|
||||
({ws with root}).finalize
|
||||
| Except.error cycle =>
|
||||
let cycle := cycle.map (s!" {·}")
|
||||
error s!"dependency cycle detected:\n{"\n".intercalate cycle}"
|
||||
|
||||
/--
|
||||
Load a `Workspace` for a Lake package by
|
||||
elaborating its configuration file and resolving its dependencies.
|
||||
If `updateDeps` is true, updates the manifest before resolving dependencies.
|
||||
-/
|
||||
def loadWorkspace (config : LoadConfig) (updateDeps := false) : LogIO Workspace := do
|
||||
let ws ← loadWorkspaceRoot config
|
||||
let manifest ← do
|
||||
if updateDeps then
|
||||
let manifest ← buildUpdatedManifest ws
|
||||
manifest.saveToFile ws.manifestFile
|
||||
pure manifest
|
||||
else
|
||||
Manifest.loadOrEmpty ws.manifestFile
|
||||
ws.materializeDeps manifest
|
||||
|
||||
/-- Updates the manifest for a Lake package. -/
|
||||
def updateManifest (config : LoadConfig) : LogIO Unit := do
|
||||
let ws ← loadWorkspaceRoot config
|
||||
let manifest ← buildUpdatedManifest ws
|
||||
manifest.saveToFile ws.manifestFile
|
||||
110
src/lake/Lake/Load/Manifest.lean
Normal file
110
src/lake/Lake/Load/Manifest.lean
Normal file
@@ -0,0 +1,110 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone, Gabriel Ebner
|
||||
-/
|
||||
import Lean.Data.Json
|
||||
import Lake.Util.Log
|
||||
|
||||
open System Lean
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-- Current version of the manifest format. -/
|
||||
def Manifest.version : Nat := 4
|
||||
|
||||
/-- An entry for a package stored in the manifest. -/
|
||||
inductive PackageEntry
|
||||
| path (name : String) (dir : FilePath)
|
||||
-- `dir` is relative to the package directory
|
||||
-- of the package containing the manifest
|
||||
| git (name : String) (url : String) (rev : String)
|
||||
(inputRev? : Option String) (subDir? : Option FilePath)
|
||||
deriving FromJson, ToJson, Repr, Inhabited
|
||||
|
||||
def PackageEntry.name : PackageEntry → String
|
||||
| path name .. | git name .. => name
|
||||
|
||||
def PackageEntry.inDirectory (pkgDir : FilePath) : PackageEntry → PackageEntry
|
||||
| path name dir => path name (pkgDir / dir)
|
||||
| entry => entry
|
||||
|
||||
/-- Manifest file format. -/
|
||||
structure Manifest where
|
||||
packagesDir? : Option FilePath := none
|
||||
entryMap : NameMap PackageEntry := {}
|
||||
|
||||
namespace Manifest
|
||||
|
||||
def empty : Manifest := {}
|
||||
|
||||
def isEmpty (self : Manifest) : Bool :=
|
||||
self.entryMap.isEmpty
|
||||
|
||||
def entryArray (self : Manifest) : Array PackageEntry :=
|
||||
self.entryMap.fold (fun a _ v => a.push v) #[]
|
||||
|
||||
def contains (packageName : Name) (self : Manifest) : Bool :=
|
||||
self.entryMap.contains packageName
|
||||
|
||||
def find? (packageName : Name) (self : Manifest) : Option PackageEntry :=
|
||||
self.entryMap.find? packageName
|
||||
|
||||
def insert (entry : PackageEntry) (self : Manifest) : Manifest :=
|
||||
{self with entryMap := self.entryMap.insert entry.name entry}
|
||||
|
||||
instance : ForIn m Manifest PackageEntry where
|
||||
forIn self init f := self.entryMap.forIn init (f ·.2)
|
||||
|
||||
protected def toJson (self : Manifest) : Json :=
|
||||
Json.mkObj [
|
||||
("version", version),
|
||||
("packagesDir", toJson self.packagesDir?),
|
||||
("packages", toJson self.entryArray)
|
||||
]
|
||||
|
||||
instance : ToJson Manifest := ⟨Manifest.toJson⟩
|
||||
|
||||
protected def fromJson? (json : Json) : Except String Manifest := do
|
||||
let ver ← (← json.getObjVal? "version").getNat?
|
||||
match ver with
|
||||
| 3 | 4 =>
|
||||
let packagesDir? ← do
|
||||
match json.getObjVal? "packagesDir" with
|
||||
| .ok path => fromJson? path
|
||||
| .error _ => pure none
|
||||
let entries : Array PackageEntry ← fromJson? (← json.getObjVal? "packages")
|
||||
return {
|
||||
packagesDir?,
|
||||
entryMap := entries.foldl (fun map entry => map.insert entry.name entry) {}
|
||||
}
|
||||
| 1 | 2 =>
|
||||
throw s!"incompatible manifest version `{ver}`"
|
||||
| _ =>
|
||||
throw s!"unknown manifest version `{ver}`"
|
||||
|
||||
instance : FromJson Manifest := ⟨Manifest.fromJson?⟩
|
||||
|
||||
def loadFromFile (file : FilePath) : IO Manifest := do
|
||||
let contents ← IO.FS.readFile file
|
||||
match Json.parse contents with
|
||||
| .ok json =>
|
||||
match fromJson? json with
|
||||
| .ok manifest =>
|
||||
return manifest
|
||||
| .error e =>
|
||||
throw <| IO.userError <| s!"improperly formatted manifest: {e}"
|
||||
| .error e =>
|
||||
throw <| IO.userError <| s!"invalid JSON in manifest: {e}"
|
||||
|
||||
def loadOrEmpty (file : FilePath) : LogIO Manifest := do
|
||||
match (← loadFromFile file |>.toBaseIO) with
|
||||
| .ok a => return a
|
||||
| .error e =>
|
||||
unless e matches .noFileOrDirectory .. do
|
||||
logWarning (toString e)
|
||||
return {}
|
||||
|
||||
def saveToFile (self : Manifest) (manifestFile : FilePath) : IO PUnit := do
|
||||
let jsonString := Json.pretty self.toJson
|
||||
IO.FS.writeFile manifestFile <| jsonString.push '\n'
|
||||
102
src/lake/Lake/Load/Materialize.lean
Normal file
102
src/lake/Lake/Load/Materialize.lean
Normal file
@@ -0,0 +1,102 @@
|
||||
/-
|
||||
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Gabriel Ebner, Sebastian Ullrich, Mac Malone
|
||||
-/
|
||||
import Lake.Util.Git
|
||||
import Lake.Load.Manifest
|
||||
import Lake.Config.Dependency
|
||||
import Lake.Config.Package
|
||||
|
||||
open System Lean
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-- Update the Git package in `repo` to `rev` if not already at it. -/
|
||||
def updateGitPkg (repo : GitRepo) (rev? : Option String) : LogIO PUnit := do
|
||||
let rev ← repo.findRemoteRevision rev?
|
||||
if (← repo.headRevision) == rev then return
|
||||
logInfo s!"updating {repo} to revision {rev}"
|
||||
repo.checkoutDetach rev
|
||||
|
||||
/-- Clone the Git package as `repo`. -/
|
||||
def cloneGitPkg (repo : GitRepo) (url : String) (rev? : Option String) : LogIO PUnit := do
|
||||
logInfo s!"cloning {url} to {repo}"
|
||||
repo.clone url
|
||||
if let some rev := rev? then
|
||||
let hash ← repo.resolveRemoteRevision rev
|
||||
repo.checkoutDetach hash
|
||||
|
||||
def updateGitRepo (repo : GitRepo) (url : String)
|
||||
(rev? : Option String) (name : String) : LogIO Unit := do
|
||||
if (← repo.dirExists) then
|
||||
if (← repo.getRemoteUrl?) = url then
|
||||
updateGitPkg repo rev?
|
||||
else
|
||||
-- TODO: git resolves local file paths so we always hit this case for local repos
|
||||
if System.Platform.isWindows then
|
||||
-- Deleting git repositories via IO.FS.removeDirAll does not work reliably on windows
|
||||
logInfo s!"{name}: URL has changed; you might need to delete {repo.dir} manually"
|
||||
updateGitPkg repo rev?
|
||||
else
|
||||
logInfo s!"{name}: URL has changed; deleting {repo.dir} and cloning again"
|
||||
IO.FS.removeDirAll repo.dir
|
||||
cloneGitPkg repo url rev?
|
||||
else
|
||||
cloneGitPkg repo url rev?
|
||||
|
||||
def updateSource (relParentDir packagesDir : FilePath) (name : String) (source : Source) : LogIO PackageEntry :=
|
||||
match source with
|
||||
| .path dir => return .path name (relParentDir / dir)
|
||||
| .git url inputRev? subDir? => do
|
||||
let dir := packagesDir / name
|
||||
let repo := GitRepo.mk dir
|
||||
updateGitRepo repo url inputRev? name
|
||||
let rev ← repo.headRevision
|
||||
return .git name url rev inputRev? subDir?
|
||||
|
||||
structure MaterializeResult where
|
||||
pkgDir : FilePath
|
||||
relPkgDir : FilePath
|
||||
remoteUrl? : Option String
|
||||
gitTag? : Option String
|
||||
manifestEntry : PackageEntry
|
||||
deriving Repr, Inhabited
|
||||
|
||||
/--
|
||||
Materializes a package entry, cloning and/or checkout it out as necessary.
|
||||
-/
|
||||
def materializePackageEntry (wsDir relPkgsDir : FilePath) (manifestEntry : PackageEntry) : LogIO MaterializeResult :=
|
||||
match manifestEntry with
|
||||
| .path _name pkgDir =>
|
||||
return {
|
||||
pkgDir := wsDir / pkgDir
|
||||
relPkgDir := pkgDir
|
||||
remoteUrl? := none
|
||||
gitTag? := none
|
||||
manifestEntry
|
||||
}
|
||||
| .git name url rev _inputRev? subDir? => do
|
||||
let relGitDir := relPkgsDir / name
|
||||
let gitDir := wsDir / relGitDir
|
||||
let repo := GitRepo.mk gitDir
|
||||
/-
|
||||
Do not update (fetch remote) if already on revision
|
||||
Avoids errors when offline e.g. [leanprover/lake#104][104]
|
||||
|
||||
[104]: https://github.com/leanprover/lake/issues/104
|
||||
-/
|
||||
let updateNecessary ← id do
|
||||
if (← repo.dirExists) then
|
||||
return (← repo.headRevision?) != rev
|
||||
return true
|
||||
if updateNecessary then
|
||||
updateGitRepo repo url rev name
|
||||
let relPkgDir := match subDir? with | .some subDir => relGitDir / subDir | .none => relGitDir
|
||||
return {
|
||||
pkgDir := wsDir / relPkgDir
|
||||
relPkgDir
|
||||
remoteUrl? := Git.filterUrl? url
|
||||
gitTag? := ← repo.findTag?
|
||||
manifestEntry
|
||||
}
|
||||
122
src/lake/Lake/Load/Package.lean
Normal file
122
src/lake/Lake/Load/Package.lean
Normal file
@@ -0,0 +1,122 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.DSL.Attributes
|
||||
import Lake.Config.Workspace
|
||||
|
||||
/-!
|
||||
This module contains definitions to load configuration objects from
|
||||
a package configuration file (e.g., `lakefile.lean`).
|
||||
-/
|
||||
|
||||
namespace Lake
|
||||
open Lean System
|
||||
|
||||
/-- Unsafe implementation of `evalConstCheck`. -/
|
||||
unsafe def unsafeEvalConstCheck (env : Environment) (opts : Options) (α) (type : Name) (const : Name) : Except String α :=
|
||||
match env.find? const with
|
||||
| none => throw s!"unknown constant '{const}'"
|
||||
| some info =>
|
||||
match info.type with
|
||||
| Expr.const c _ =>
|
||||
if c != type then
|
||||
throwUnexpectedType
|
||||
else
|
||||
env.evalConst α opts const
|
||||
| _ => throwUnexpectedType
|
||||
where
|
||||
throwUnexpectedType : Except String α :=
|
||||
throw s!"unexpected type at '{const}', `{type}` expected"
|
||||
|
||||
/-- Like `Lean.Environment.evalConstCheck`, but with plain universe-polymorphic `Except`. -/
|
||||
@[implemented_by unsafeEvalConstCheck] opaque evalConstCheck
|
||||
(env : Environment) (opts : Options) (α) (type : Name) (const : Name) : Except String α
|
||||
|
||||
/-- Construct a `NameMap` from the declarations tagged with `attr`. -/
|
||||
def mkTagMap
|
||||
(env : Environment) (attr : OrderedTagAttribute)
|
||||
[Monad m] (f : Name → m α) : m (NameMap α) :=
|
||||
attr.ext.getState env |>.foldlM (init := {}) fun map declName =>
|
||||
return map.insert declName <| ← f declName
|
||||
|
||||
/-- Construct a `DNameMap` from the declarations tagged with `attr`. -/
|
||||
def mkDTagMap
|
||||
(env : Environment) (attr : OrderedTagAttribute)
|
||||
[Monad m] (f : (n : Name) → m (β n)) : m (DNameMap β) :=
|
||||
attr.ext.getState env |>.foldlM (init := {}) fun map declName =>
|
||||
return map.insert declName <| ← f declName
|
||||
|
||||
/-- Load a `PackageConfig` from a configuration environment. -/
|
||||
def PackageConfig.loadFromEnv
|
||||
(env : Environment) (opts := Options.empty) : Except String PackageConfig := do
|
||||
let declName ←
|
||||
match packageAttr.ext.getState env |>.toList with
|
||||
| [] => error s!"configuration file is missing a `package` declaration"
|
||||
| [name] => pure name
|
||||
| _ => error s!"configuration file has multiple `package` declarations"
|
||||
evalConstCheck env opts _ ``PackageConfig declName
|
||||
|
||||
/--
|
||||
Load the remainder of a `Package`
|
||||
from its configuration environment after resolving its dependencies.
|
||||
-/
|
||||
def Package.finalize (self : Package) (deps : Array Package) : LogIO Package := do
|
||||
let env := self.configEnv; let opts := self.leanOpts
|
||||
|
||||
-- Load Script, Facet, & Target Configurations
|
||||
let scripts : NameMap Script ← mkTagMap env scriptAttr fun name => do
|
||||
let fn ← IO.ofExcept <| evalConstCheck env opts ScriptFn ``ScriptFn name
|
||||
return {fn, doc? := (← findDocString? env name)}
|
||||
let defaultScripts ← defaultScriptAttr.ext.getState env |>.mapM fun name =>
|
||||
if let some script := scripts.find? name then pure script else
|
||||
error s!"package is missing script `{name}` marked as a default"
|
||||
let leanLibConfigs ← IO.ofExcept <| mkTagMap env leanLibAttr fun name =>
|
||||
evalConstCheck env opts LeanLibConfig ``LeanLibConfig name
|
||||
let leanExeConfigs ← IO.ofExcept <| mkTagMap env leanExeAttr fun name =>
|
||||
evalConstCheck env opts LeanExeConfig ``LeanExeConfig name
|
||||
let externLibConfigs ← mkDTagMap env externLibAttr fun name =>
|
||||
match evalConstCheck env opts ExternLibDecl ``ExternLibDecl name with
|
||||
| .ok decl =>
|
||||
if h : decl.pkg = self.config.name ∧ decl.name = name then
|
||||
return h.1 ▸ h.2 ▸ decl.config
|
||||
else
|
||||
error s!"target was defined as `{decl.pkg}/{decl.name}`, but was registered as `{self.name}/{name}`"
|
||||
| .error e => error e
|
||||
let opaqueTargetConfigs ← mkDTagMap env targetAttr fun name =>
|
||||
match evalConstCheck env opts TargetDecl ``TargetDecl name with
|
||||
| .ok decl =>
|
||||
if h : decl.pkg = self.config.name ∧ decl.name = name then
|
||||
return OpaqueTargetConfig.mk <| h.1 ▸ h.2 ▸ decl.config
|
||||
else
|
||||
error s!"target was defined as `{decl.pkg}/{decl.name}`, but was registered as `{self.name}/{name}`"
|
||||
| .error e => error e
|
||||
let defaultTargets := defaultTargetAttr.ext.getState env
|
||||
|
||||
-- Fill in the Package
|
||||
return {self with
|
||||
opaqueDeps := deps.map (.mk ·)
|
||||
leanLibConfigs, leanExeConfigs, externLibConfigs
|
||||
opaqueTargetConfigs, defaultTargets, scripts, defaultScripts
|
||||
}
|
||||
|
||||
/--
|
||||
Load module/package facets into a `Workspace` from a configuration environment.
|
||||
-/
|
||||
def Workspace.addFacetsFromEnv
|
||||
(env : Environment) (opts : Options) (self : Workspace) : Except String Workspace := do
|
||||
let mut ws := self
|
||||
for name in moduleFacetAttr.ext.getState env do
|
||||
match evalConstCheck env opts ModuleFacetDecl ``ModuleFacetDecl name with
|
||||
| .ok decl => ws := ws.addModuleFacetConfig <| decl.config
|
||||
| .error e => error e
|
||||
for name in packageFacetAttr.ext.getState env do
|
||||
match evalConstCheck env opts PackageFacetDecl ``PackageFacetDecl name with
|
||||
| .ok decl => ws := ws.addPackageFacetConfig <| decl.config
|
||||
| .error e => error e
|
||||
for name in libraryFacetAttr.ext.getState env do
|
||||
match evalConstCheck env opts LibraryFacetDecl ``LibraryFacetDecl name with
|
||||
| .ok decl => ws := ws.addLibraryFacetConfig <| decl.config
|
||||
| .error e => error e
|
||||
return ws
|
||||
10
src/lake/Lake/Main.lean
Normal file
10
src/lake/Lake/Main.lean
Normal file
@@ -0,0 +1,10 @@
|
||||
/-
|
||||
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Gabriel Ebner, Sebastian Ullrich, Mac Malone
|
||||
-/
|
||||
import Lake
|
||||
import Lake.CLI
|
||||
|
||||
def main (args : List String) : IO UInt32 := do
|
||||
Lake.cli args -- should not throw errors (outside user code)
|
||||
267
src/lake/Lake/Util/Async.lean
Normal file
267
src/lake/Lake/Util/Async.lean
Normal file
@@ -0,0 +1,267 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Util.Task
|
||||
import Lake.Util.OptionIO
|
||||
import Lake.Util.Lift
|
||||
|
||||
/-!
|
||||
This module Defines the asynchronous monadic interface for Lake.
|
||||
The interface is composed of three major abstract monadic types:
|
||||
|
||||
* `m`: The monad of the synchronous action (e.g., `IO`).
|
||||
* `n`: The monad of the (a)synchronous task manager (e.g., `BaseIO`).
|
||||
* `k`: The monad of the (a)synchronous task (e.g., `IOTask`).
|
||||
|
||||
The definitions within this module provide the basic utilities for converting
|
||||
between these monads and combining them in different ways.
|
||||
-/
|
||||
|
||||
namespace Lake
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! # Async / Await Abstraction -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
class Sync (m : Type u → Type v) (n : outParam $ Type u' → Type w) (k : outParam $ Type u → Type u') where
|
||||
/-- Run the monadic action as a synchronous task. -/
|
||||
sync : m α → n (k α)
|
||||
|
||||
export Sync (sync)
|
||||
|
||||
class Async (m : Type u → Type v) (n : outParam $ Type u' → Type w) (k : outParam $ Type u → Type u') where
|
||||
/-- Run the monadic action as an asynchronous task. -/
|
||||
async : m α → n (k α)
|
||||
|
||||
export Async (async)
|
||||
|
||||
class Await (k : Type u → Type v) (m : outParam $ Type u → Type w) where
|
||||
/-- Wait for an (a)synchronous task to finish. -/
|
||||
await : k α → m α
|
||||
|
||||
export Await (await)
|
||||
|
||||
/-! ## Standard Instances -/
|
||||
|
||||
instance : Sync Id Id Task := ⟨Task.pure⟩
|
||||
instance : Sync BaseIO BaseIO BaseIOTask := ⟨Functor.map Task.pure⟩
|
||||
|
||||
instance [Sync m n k] : Sync (ReaderT ρ m) (ReaderT ρ n) k where
|
||||
sync x := fun r => sync (x r)
|
||||
|
||||
instance [Sync m n k] : Sync (ExceptT ε m) n (ExceptT ε k) where
|
||||
sync x := cast (by delta ExceptT; rfl) <| sync (n := n) x.run
|
||||
|
||||
instance [Sync m n k] : Sync (OptionT m) n (OptionT k) where
|
||||
sync x := cast (by delta OptionT; rfl) <| sync (n := n) x.run
|
||||
|
||||
instance : Sync (EIO ε) BaseIO (EIOTask ε) where
|
||||
sync x := sync <| ExceptT.mk x.toBaseIO
|
||||
|
||||
instance : Sync OptionIO BaseIO OptionIOTask where
|
||||
sync x := sync <| OptionT.mk x.toBaseIO
|
||||
|
||||
instance : Async Id Id Task := ⟨Task.pure⟩
|
||||
instance : Async BaseIO BaseIO BaseIOTask := ⟨BaseIO.asTask⟩
|
||||
|
||||
instance [Async m n k] : Async (ReaderT ρ m) (ReaderT ρ n) k where
|
||||
async x := fun r => async (x r)
|
||||
|
||||
instance [Async m n k] : Async (ExceptT ε m) n (ExceptT ε k) where
|
||||
async x := cast (by delta ExceptT; rfl) <| async (n := n) x.run
|
||||
|
||||
instance [Async m n k] : Async (OptionT m) n (OptionT k) where
|
||||
async x := cast (by delta OptionT; rfl) <| async (n := n) x.run
|
||||
|
||||
instance : Async (EIO ε) BaseIO (EIOTask ε) where
|
||||
async x := async <| ExceptT.mk x.toBaseIO
|
||||
|
||||
instance : Async OptionIO BaseIO OptionIOTask where
|
||||
async x := async <| OptionT.mk x.toBaseIO
|
||||
|
||||
instance : Await Task Id := ⟨Task.get⟩
|
||||
|
||||
instance : Await (EIOTask ε) (EIO ε) where
|
||||
await x := IO.wait x >>= liftM
|
||||
|
||||
instance : Await OptionIOTask OptionIO where
|
||||
await x := IO.wait x >>= liftM
|
||||
|
||||
instance [Await k m] : Await (ExceptT ε k) (ExceptT ε m) where
|
||||
await x := ExceptT.mk <| await x.run
|
||||
|
||||
instance [Await k m] : Await (OptionT k) (OptionT m) where
|
||||
await x := OptionT.mk <| await x.run
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! # Combinators -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
class BindSync (m : Type u → Type v) (n : outParam $ Type u' → Type w) (k : outParam $ Type u → Type u') where
|
||||
/-- Perform a synchronous action after another (a)synchronous task completes successfully. -/
|
||||
bindSync {α β : Type u} : Task.Priority → k α → (α → m β) → n (k β)
|
||||
|
||||
export BindSync (bindSync)
|
||||
|
||||
class BindAsync (n : Type u → Type v) (k : Type u → Type u) where
|
||||
/-- Perform a asynchronous task after another (a)synchronous task completes successfully. -/
|
||||
bindAsync {α β : Type u} : k α → (α → n (k β)) → n (k β)
|
||||
|
||||
export BindAsync (bindAsync)
|
||||
|
||||
class SeqAsync (n : outParam $ Type u → Type v) (k : Type u → Type u) where
|
||||
/-- Combine two (a)synchronous tasks, applying the result of the second one ot the first one. -/
|
||||
seqAsync {α β : Type u} : k (α → β) → k α → n (k β)
|
||||
|
||||
export SeqAsync (seqAsync)
|
||||
|
||||
class SeqLeftAsync (n : outParam $ Type u → Type v) (k : Type u → Type u) where
|
||||
/-- Combine two (a)synchronous tasks, returning the result of the first one. -/
|
||||
seqLeftAsync {α β : Type u} : k α → k β → n (k α)
|
||||
|
||||
export SeqLeftAsync (seqLeftAsync)
|
||||
|
||||
class SeqRightAsync (n : outParam $ Type u → Type v) (k : Type u → Type u) where
|
||||
/-- Combine two (a)synchronous tasks, returning the result of the second one. -/
|
||||
seqRightAsync {α β : Type u} : k α → k β → n (k β)
|
||||
|
||||
export SeqRightAsync (seqRightAsync)
|
||||
|
||||
class SeqWithAsync (n : outParam $ Type u → Type v) (k : Type u → Type u) where
|
||||
/-- Combine two (a)synchronous tasks using `f`. -/
|
||||
seqWithAsync {α β : Type u} : (f : α → β → γ) → k α → k β → n (k γ)
|
||||
|
||||
export SeqWithAsync (seqWithAsync)
|
||||
|
||||
class ApplicativeAsync (n : outParam $ Type u → Type v) (k : Type u → Type u)
|
||||
extends SeqAsync n k, SeqLeftAsync n k, SeqRightAsync n k, SeqWithAsync n k where
|
||||
seqAsync := seqWithAsync fun f a => f a
|
||||
seqLeftAsync := seqWithAsync fun a _ => a
|
||||
seqRightAsync := seqWithAsync fun _ b => b
|
||||
|
||||
/-! ## Standard Instances -/
|
||||
|
||||
instance : BindSync Id Id Task := ⟨fun _ => flip Task.map⟩
|
||||
instance : BindSync BaseIO BaseIO BaseIOTask := ⟨fun _ => flip BaseIO.mapTask⟩
|
||||
|
||||
instance : BindSync (EIO ε) BaseIO (ETask ε) where
|
||||
bindSync prio ka f := ka.run |> BaseIO.mapTask (prio := prio) fun
|
||||
| Except.ok a => f a |>.toBaseIO
|
||||
| Except.error e => pure <| Except.error e
|
||||
|
||||
instance : BindSync OptionIO BaseIO OptionIOTask where
|
||||
bindSync prio ka f := ka.run |> BaseIO.mapTask (prio := prio) fun
|
||||
| some a => f a |>.toBaseIO
|
||||
| none => pure none
|
||||
|
||||
instance [BindSync m n k] : BindSync (ReaderT ρ m) (ReaderT ρ n) k where
|
||||
bindSync prio ka f := fun r => bindSync prio ka fun a => f a r
|
||||
|
||||
instance [BindSync m n k] [Pure m] : BindSync (ExceptT ε m) n (ExceptT ε k) where
|
||||
bindSync prio ka f := cast (by delta ExceptT; rfl) <| bindSync prio (n := n) ka.run fun
|
||||
| Except.ok a => f a |>.run
|
||||
| Except.error e => pure <| Except.error e
|
||||
|
||||
instance [BindSync m n k] [Pure m] : BindSync (OptionT m) n (OptionT k) where
|
||||
bindSync prio ka f := cast (by delta OptionT; rfl) <| bindSync prio ka.run fun
|
||||
| some a => f a |>.run
|
||||
| none => pure none
|
||||
|
||||
instance : BindAsync Id Task := ⟨Task.bind⟩
|
||||
instance : BindAsync BaseIO BaseIOTask := ⟨BaseIO.bindTask⟩
|
||||
|
||||
instance : BindAsync BaseIO (EIOTask ε) where
|
||||
bindAsync ka f := BaseIO.bindTask ka.run fun
|
||||
| Except.ok a => f a
|
||||
| Except.error e => pure <| pure (Except.error e)
|
||||
|
||||
instance : BindAsync BaseIO OptionIOTask where
|
||||
bindAsync ka f := BaseIO.bindTask ka.run fun
|
||||
| some a => f a
|
||||
| none => pure (pure none)
|
||||
|
||||
instance [BindAsync n k] : BindAsync (ReaderT ρ n) k where
|
||||
bindAsync ka f := fun r => bindAsync ka fun a => f a r
|
||||
|
||||
instance [BindAsync n k] [Pure n] [Pure k] : BindAsync n (ExceptT ε k) where
|
||||
bindAsync ka f := cast (by delta ExceptT; rfl) <| bindAsync ka.run fun
|
||||
| Except.ok a => f a
|
||||
| Except.error e => pure <| pure <| Except.error e
|
||||
|
||||
instance [BindAsync n k] [Pure n] [Pure k] : BindAsync n (OptionT k) where
|
||||
bindAsync ka f := cast (by delta OptionT; rfl) <| bindAsync ka.run fun
|
||||
| some a => f a
|
||||
| none => pure (pure none)
|
||||
|
||||
instance : ApplicativeAsync Id Task where
|
||||
seqWithAsync f ka kb := ka.bind fun a => kb.bind fun b => pure <| f a b
|
||||
|
||||
instance : ApplicativeAsync BaseIO BaseIOTask where
|
||||
seqWithAsync f ka kb := BaseIO.bindTask ka fun a => BaseIO.bindTask kb fun b => pure <| pure <| f a b
|
||||
|
||||
instance [ApplicativeAsync n k] : ApplicativeAsync n (ExceptT ε k) where
|
||||
seqWithAsync f ka kb :=
|
||||
let h xa xb : Except ε _ := return f (← xa) (← xb)
|
||||
cast (by delta ExceptT; rfl) <| seqWithAsync (n := n) h ka kb
|
||||
|
||||
instance [ApplicativeAsync n k] : ApplicativeAsync n (OptionT k) where
|
||||
seqWithAsync f ka kb :=
|
||||
let h xa xb : Option _ := return f (← xa) (← xb)
|
||||
cast (by delta OptionT; rfl) <| seqWithAsync (n := n) h ka kb
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! # List/Array Utilities -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
/-! ## Sequencing (A)synchronous Tasks -/
|
||||
|
||||
/-- Combine all (a)synchronous tasks in a `List` from right to left into a single task ending `last`. -/
|
||||
def seqLeftList1Async [SeqLeftAsync n k] [Monad n] (last : (k α)) : (tasks : List (k α)) → n (k α)
|
||||
| [] => return last
|
||||
| t::ts => seqLeftList1Async t ts >>= (seqLeftAsync last ·)
|
||||
|
||||
/-- Combine all (a)synchronous tasks in a `List` from right to left into a single task. -/
|
||||
def seqLeftListAsync [SeqLeftAsync n k] [Monad n] [Pure k] : (tasks : List (k PUnit)) → n (k PUnit)
|
||||
| [] => return (pure ())
|
||||
| t::ts => seqLeftList1Async t ts
|
||||
|
||||
/-- Combine all (a)synchronous tasks in a `List` from left to right into a single task. -/
|
||||
def seqRightListAsync [SeqRightAsync n k] [Monad n] [Pure k] : (tasks : List (k PUnit)) → n (k PUnit)
|
||||
| [] => return (pure ())
|
||||
| t::ts => ts.foldlM seqRightAsync t
|
||||
|
||||
/-- Combine all (a)synchronous tasks in a `Array` from right to left into a single task. -/
|
||||
def seqLeftArrayAsync [SeqLeftAsync n k] [Monad n] [Pure k] (tasks : Array (k PUnit)) : n (k PUnit) :=
|
||||
if h : 0 < tasks.size then
|
||||
tasks.pop.foldrM seqLeftAsync (tasks.get ⟨tasks.size - 1, Nat.sub_lt h (by decide)⟩)
|
||||
else
|
||||
return (pure ())
|
||||
|
||||
/-- Combine all (a)synchronous tasks in a `Array` from left to right into a single task. -/
|
||||
def seqRightArrayAsync [SeqRightAsync n k] [Monad n] [Pure k] (tasks : Array (k PUnit)) : n (k PUnit) :=
|
||||
if h : 0 < tasks.size then
|
||||
tasks.foldlM seqRightAsync (tasks.get ⟨0, h⟩)
|
||||
else
|
||||
return (pure ())
|
||||
|
||||
/-! ## Folding (A)synchronous Tasks -/
|
||||
|
||||
variable [SeqWithAsync n k] [Monad n] [Pure k]
|
||||
|
||||
/-- Fold a `List` of (a)synchronous tasks from right to left (i.e., a right fold) into a single task. -/
|
||||
def foldLeftListAsync (f : α → β → β) (init : β) (tasks : List (k α)) : n (k β) :=
|
||||
tasks.foldrM (seqWithAsync f) (pure init)
|
||||
|
||||
/-- Fold an `Array` of (a)synchronous tasks from right to left (i.e., a right fold) into a single task. -/
|
||||
def foldLeftArrayAsync (f : α → β → β) (init : β) (tasks : Array (k α)) : n (k β) :=
|
||||
tasks.foldrM (seqWithAsync f) (pure init)
|
||||
|
||||
/-- Fold a `List` of (a)synchronous tasks from left to right (i.e., a left fold) into a single task. -/
|
||||
def foldRightListAsync (f : β → α → β) (init : β) (tasks : List (k α)) : n (k β) :=
|
||||
tasks.foldlM (seqWithAsync f) (pure init)
|
||||
|
||||
/-- Fold an `Array` of (a)synchronous tasks from left to right (i.e., a left fold) into a single task. -/
|
||||
def foldRightArrayAsync (f : β → α → β) (init : β) (tasks : Array (k α)) : n (k β) :=
|
||||
tasks.foldlM (seqWithAsync f) (pure init)
|
||||
160
src/lake/Lake/Util/Binder.lean
Normal file
160
src/lake/Lake/Util/Binder.lean
Normal file
@@ -0,0 +1,160 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lean.Parser.Term
|
||||
import Lean.Elab.Term
|
||||
import Lean.Expr
|
||||
|
||||
namespace Lake
|
||||
open Lean Parser
|
||||
|
||||
abbrev Ellipsis := TSyntax ``Term.ellipsis
|
||||
abbrev NamedArgument := TSyntax ``Term.namedArgument
|
||||
abbrev Argument := TSyntax ``Term.argument
|
||||
|
||||
instance : Coe Term Argument where
|
||||
coe s := ⟨s.raw⟩
|
||||
|
||||
instance : Coe Ellipsis Argument where
|
||||
coe s := ⟨s.raw⟩
|
||||
|
||||
instance : Coe NamedArgument Argument where
|
||||
coe s := ⟨s.raw⟩
|
||||
|
||||
abbrev Hole := TSyntax ``Term.hole
|
||||
abbrev BinderIdent := TSyntax ``Term.binderIdent
|
||||
abbrev TypeSpec := TSyntax ``Term.typeSpec
|
||||
|
||||
def mkHoleFrom (ref : Syntax) : Hole :=
|
||||
mkNode ``Term.hole #[mkAtomFrom ref "_"]
|
||||
|
||||
instance : Coe Hole Term where
|
||||
coe s := ⟨s.raw⟩
|
||||
|
||||
instance : Coe Hole BinderIdent where
|
||||
coe s := ⟨s.raw⟩
|
||||
|
||||
instance : Coe Ident BinderIdent where
|
||||
coe s := ⟨s.raw⟩
|
||||
|
||||
abbrev BracketedBinder := TSyntax ``Term.bracketedBinder
|
||||
abbrev FunBinder := TSyntax ``Term.funBinder
|
||||
|
||||
instance : Coe BinderIdent FunBinder where
|
||||
coe s := ⟨s.raw⟩
|
||||
|
||||
@[run_parser_attribute_hooks]
|
||||
def binder := Term.binderIdent <|> Term.bracketedBinder
|
||||
|
||||
abbrev Binder := TSyntax ``binder
|
||||
instance : Coe Binder (TSyntax [identKind, ``Term.hole, ``Term.bracketedBinder]) where
|
||||
coe stx := ⟨stx.raw⟩
|
||||
|
||||
abbrev BinderModifier := TSyntax [``Term.binderTactic, ``Term.binderDefault]
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Adapted from the private utilities in `Lean.Elab.Binders`
|
||||
|
||||
structure BinderSyntaxView where
|
||||
id : Ident
|
||||
type : Term
|
||||
info : BinderInfo
|
||||
modifier? : Option BinderModifier := none
|
||||
|
||||
def expandOptType (ref : Syntax) (optType : Syntax) : Term :=
|
||||
if optType.isNone then
|
||||
mkHoleFrom ref
|
||||
else
|
||||
⟨optType[0][1]⟩
|
||||
|
||||
def getBinderIds (ids : Syntax) : MacroM (Array BinderIdent) :=
|
||||
ids.getArgs.mapM fun id =>
|
||||
let k := id.getKind
|
||||
if k == identKind || k == `Lean.Parser.Term.hole then
|
||||
return ⟨id⟩
|
||||
else
|
||||
Macro.throwErrorAt id "identifier or `_` expected"
|
||||
|
||||
def expandBinderIdent (stx : Syntax) : MacroM Ident :=
|
||||
match stx with
|
||||
| `(_) => (⟨·⟩) <$> Elab.Term.mkFreshIdent stx
|
||||
| _ => pure ⟨stx⟩
|
||||
|
||||
def expandOptIdent (stx : Syntax) : BinderIdent :=
|
||||
if stx.isNone then mkHoleFrom stx else ⟨stx[0]⟩
|
||||
|
||||
def expandBinderType (ref : Syntax) (stx : Syntax) : Term :=
|
||||
if stx.getNumArgs == 0 then mkHoleFrom ref else ⟨stx[1]⟩
|
||||
|
||||
def expandBinderModifier (optBinderModifier : Syntax) : Option BinderModifier :=
|
||||
if optBinderModifier.isNone then
|
||||
none
|
||||
else
|
||||
some ⟨optBinderModifier[0]⟩
|
||||
|
||||
def matchBinder (stx : Syntax) : MacroM (Array BinderSyntaxView) := do
|
||||
let k := stx.getKind
|
||||
if stx.isIdent || k == ``Term.hole then
|
||||
-- binderIdent
|
||||
return #[{ id := (← expandBinderIdent stx), type := mkHoleFrom stx, info := .default }]
|
||||
else if k == ``Lean.Parser.Term.explicitBinder then
|
||||
-- `(` binderIdent+ binderType (binderDefault <|> binderTactic)? `)`
|
||||
let ids ← getBinderIds stx[1]
|
||||
let type := stx[2]
|
||||
let modifier? := expandBinderModifier stx[3]
|
||||
ids.mapM fun id => return {
|
||||
id := ← expandBinderIdent id,
|
||||
type := expandBinderType id type,
|
||||
info := .default,
|
||||
modifier?
|
||||
}
|
||||
else if k == ``Lean.Parser.Term.implicitBinder then
|
||||
-- `{` binderIdent+ binderType `}`
|
||||
let ids ← getBinderIds stx[1]
|
||||
let type := stx[2]
|
||||
ids.mapM fun id => return {
|
||||
id := ← expandBinderIdent id,
|
||||
type := expandBinderType id type,
|
||||
info := .implicit
|
||||
}
|
||||
else if k == ``Lean.Parser.Term.strictImplicitBinder then
|
||||
-- `⦃` binderIdent+ binderType `⦄`
|
||||
let ids ← getBinderIds stx[1]
|
||||
let type := stx[2]
|
||||
ids.mapM fun id => do pure {
|
||||
id := ← expandBinderIdent id,
|
||||
type := expandBinderType id type,
|
||||
info := .strictImplicit
|
||||
}
|
||||
else if k == ``Lean.Parser.Term.instBinder then
|
||||
-- `[` optIdent type `]`
|
||||
let id := expandOptIdent stx[1]
|
||||
let type := stx[2]
|
||||
return #[{id := ← expandBinderIdent id, type := ⟨type⟩, info := .instImplicit}]
|
||||
else
|
||||
Macro.throwUnsupported
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
def BinderSyntaxView.mkBinder : BinderSyntaxView → MacroM Binder
|
||||
| {id, type, info, modifier?} => do
|
||||
match info with
|
||||
| .default => `(binder| ($id : $type $[$modifier?]?))
|
||||
| .implicit => `(binder| {$id : $type})
|
||||
| .strictImplicit => `(binder| ⦃$id : $type⦄)
|
||||
| .instImplicit => `(binder| [$id : $type])
|
||||
|
||||
def BinderSyntaxView.mkArgument : BinderSyntaxView → MacroM NamedArgument
|
||||
| {id, ..} => `(Term.namedArgument| ($id := $id))
|
||||
|
||||
def expandBinders (dbs : Array Binder) : MacroM (Array Binder × Array Term) := do
|
||||
let mut bs := #[]
|
||||
let mut args : Array Term := #[]
|
||||
for db in dbs do
|
||||
let views ← matchBinder db.raw
|
||||
for view in views do
|
||||
bs := bs.push (← view.mkBinder)
|
||||
args := args.push ⟨(← view.mkArgument).raw⟩
|
||||
return (bs, args)
|
||||
19
src/lake/Lake/Util/Casing.lean
Normal file
19
src/lake/Lake/Util/Casing.lean
Normal file
@@ -0,0 +1,19 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
namespace Lake
|
||||
open Lean (Name)
|
||||
|
||||
/-- Converts a snake case, kebab case, or lower camel case `String` to upper camel case. -/
|
||||
def toUpperCamelCaseString (str : String) : String :=
|
||||
let parts := str.split fun chr => chr == '_' || chr == '-'
|
||||
String.join <| parts.map (·.capitalize)
|
||||
|
||||
/-- Converts a snake case, kebab case, or lower camel case `Name` to upper camel case. -/
|
||||
def toUpperCamelCase (name : Name) : Name :=
|
||||
if let Name.str p s := name then
|
||||
Name.mkStr (toUpperCamelCase p) <| toUpperCamelCaseString s
|
||||
else
|
||||
name
|
||||
165
src/lake/Lake/Util/Cli.lean
Normal file
165
src/lake/Lake/Util/Cli.lean
Normal file
@@ -0,0 +1,165 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-!
|
||||
Defines the abstract CLI interface for Lake.
|
||||
-/
|
||||
|
||||
/-! # Types -/
|
||||
|
||||
def ArgList := List String
|
||||
|
||||
@[inline] def ArgList.mk (args : List String) : ArgList :=
|
||||
args
|
||||
|
||||
abbrev ArgsT := StateT ArgList
|
||||
|
||||
@[inline] def ArgsT.run (args : List String) (self : ArgsT m α) : m (α × List String) :=
|
||||
StateT.run self args
|
||||
|
||||
@[inline] def ArgsT.run' [Functor m] (args : List String) (self : ArgsT m α) : m α :=
|
||||
StateT.run' self args
|
||||
|
||||
structure OptionHandlers (m : Type u → Type v) (α : Type u) where
|
||||
/-- Process a long option (ex. `--long` or `"--long foo bar"`). -/
|
||||
long : String → m α
|
||||
/-- Process a short option (ex. `-x` or `--`). -/
|
||||
short : Char → m α
|
||||
/-- Process a long short option (ex. `-long`, `-xarg`, `-xyz`). -/
|
||||
longShort : String → m α
|
||||
|
||||
/-! # Utilities -/
|
||||
|
||||
variable [Monad m] [MonadStateOf ArgList m]
|
||||
|
||||
/-- Get the remaining argument list. -/
|
||||
@[inline] def getArgs : m (List String) :=
|
||||
get
|
||||
|
||||
/-- Replace the argument list. -/
|
||||
@[inline] def setArgs (args : List String) : m PUnit :=
|
||||
set (ArgList.mk args)
|
||||
|
||||
/-- Take the head of the remaining argument list (or none if empty). -/
|
||||
@[inline] def takeArg? : m (Option String) :=
|
||||
modifyGet fun | [] => (none, []) | arg :: args => (some arg, args)
|
||||
|
||||
/-- Take the remaining argument list, leaving only an empty list. -/
|
||||
@[inline] def takeArgs : m (List String) :=
|
||||
modifyGet fun args => (args, [])
|
||||
|
||||
/-- Add a string to the head of the remaining argument list. -/
|
||||
@[inline] def consArg (arg : String) : m PUnit :=
|
||||
modify fun args => arg :: args
|
||||
|
||||
/-- Process a short option of the form `-x=arg`. -/
|
||||
@[inline] def shortOptionWithEq (handle : Char → m α) (opt : String) : m α := do
|
||||
consArg (opt.drop 3); handle (opt.get ⟨1⟩)
|
||||
|
||||
/-- Process a short option of the form `"-x arg"`. -/
|
||||
@[inline] def shortOptionWithSpace (handle : Char → m α) (opt : String) : m α := do
|
||||
consArg <| opt.drop 2 |>.trimLeft; handle (opt.get ⟨1⟩)
|
||||
|
||||
/-- Process a short option of the form `-xarg`. -/
|
||||
@[inline] def shortOptionWithArg (handle : Char → m α) (opt : String) : m α := do
|
||||
consArg (opt.drop 2); handle (opt.get ⟨1⟩)
|
||||
|
||||
/-- Process a multiple short options grouped together (ex. `-xyz` as `x`, `y`, `z`). -/
|
||||
@[inline] def multiShortOption (handle : Char → m PUnit) (opt : String) : m PUnit := do
|
||||
-- TODO: this code is assuming all characters are ASCII.
|
||||
for i in [1:opt.length] do handle (opt.get ⟨i⟩)
|
||||
|
||||
/-- Splits a long option of the form `"--long foo bar"` into `--long` and `"foo bar"`. -/
|
||||
@[inline] def longOptionOrSpace (handle : String → m α) (opt : String) : m α :=
|
||||
let pos := opt.posOf ' '
|
||||
if pos = opt.endPos then
|
||||
handle opt
|
||||
else do
|
||||
consArg <| opt.extract (opt.next pos) opt.endPos
|
||||
handle <| opt.extract 0 pos
|
||||
|
||||
/-- Splits a long option of the form `--long=arg` into `--long` and `arg`. -/
|
||||
@[inline] def longOptionOrEq (handle : String → m α) (opt : String) : m α :=
|
||||
let pos := opt.posOf '='
|
||||
if pos = opt.endPos then
|
||||
handle opt
|
||||
else do
|
||||
consArg <| opt.extract (opt.next pos) opt.endPos
|
||||
handle <| opt.extract 0 pos
|
||||
|
||||
/-- Process a long option of the form `--long`, `--long=arg`, `"--long arg"`. -/
|
||||
@[inline] def longOption (handle : String → m α) : String → m α :=
|
||||
longOptionOrEq <| longOptionOrSpace handle
|
||||
|
||||
/-- Process a short option of the form `-x`, `-x=arg`, `-x arg`, or `-long`. -/
|
||||
@[inline] def shortOption
|
||||
(shortHandle : Char → m α) (longHandle : String → m α)
|
||||
(opt : String) : m α :=
|
||||
if opt.length == 2 then -- `-x`
|
||||
shortHandle (opt.get ⟨1⟩)
|
||||
else -- `-c(.+)`
|
||||
match opt.get ⟨2⟩ with
|
||||
| '=' => -- `-x=arg`
|
||||
shortOptionWithEq shortHandle opt
|
||||
| ' ' => -- `"-x arg"`
|
||||
shortOptionWithSpace shortHandle opt
|
||||
| _ => -- `-long`
|
||||
longHandle opt
|
||||
|
||||
/--
|
||||
Process an option, short or long, using the given handlers.
|
||||
An option is an argument of length > 1 starting with a dash (`-`).
|
||||
An option may consume additional elements of the argument list.
|
||||
-/
|
||||
@[inline] def option (handlers : OptionHandlers m α) (opt : String) : m α :=
|
||||
if opt.get ⟨1⟩ == '-' then -- `--(.*)`
|
||||
longOption handlers.long opt
|
||||
else
|
||||
shortOption handlers.short handlers.longShort opt
|
||||
|
||||
/-- Process the head argument of the list using `handle` if it is an option. -/
|
||||
def processLeadingOption (handle : String → m PUnit) : m PUnit := do
|
||||
match (← getArgs) with
|
||||
| [] => pure ()
|
||||
| arg :: args =>
|
||||
if arg.length > 1 && arg.get 0 == '-' then -- `-(.+)`
|
||||
setArgs args
|
||||
handle arg
|
||||
|
||||
/--
|
||||
Process the leading options of the remaining argument list.
|
||||
Consumes empty leading arguments in the argument list.
|
||||
-/
|
||||
partial def processLeadingOptions (handle : String → m PUnit) : m PUnit := do
|
||||
if let arg :: args ← getArgs then
|
||||
let len := arg.length
|
||||
if len > 1 && arg.get 0 == '-' then -- `-(.+)`
|
||||
setArgs args
|
||||
handle arg
|
||||
processLeadingOptions handle
|
||||
else if len == 0 then -- skip empty leading args
|
||||
setArgs args
|
||||
processLeadingOptions handle
|
||||
|
||||
/-- Process every option and collect the remaining arguments into an `Array`. -/
|
||||
partial def collectArgs (option : String → m PUnit) (args : Array String := #[]) : m (Array String) := do
|
||||
if let some arg ← takeArg? then
|
||||
let len := arg.length
|
||||
if len > 1 && arg.get 0 == '-' then -- `-(.+)`
|
||||
option arg
|
||||
collectArgs option args
|
||||
else if len == 0 then -- skip empty args
|
||||
collectArgs option args
|
||||
else
|
||||
collectArgs option (args.push arg)
|
||||
else
|
||||
pure args
|
||||
|
||||
/-- Process every option in the argument list. -/
|
||||
@[inline] def processOptions (handle : String → m PUnit) : m PUnit := do
|
||||
setArgs (← collectArgs handle).toList
|
||||
126
src/lake/Lake/Util/Compare.lean
Normal file
126
src/lake/Lake/Util/Compare.lean
Normal file
@@ -0,0 +1,126 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
|
||||
namespace Lake
|
||||
|
||||
/--
|
||||
Proof that the equality of a compare function corresponds
|
||||
to propositional equality.
|
||||
-/
|
||||
class EqOfCmp (α : Type u) (cmp : α → α → Ordering) where
|
||||
eq_of_cmp {a a' : α} : cmp a a' = .eq → a = a'
|
||||
|
||||
export EqOfCmp (eq_of_cmp)
|
||||
|
||||
/--
|
||||
Proof that the equality of a compare function corresponds
|
||||
to propositional equality and vice versa.
|
||||
-/
|
||||
class LawfulCmpEq (α : Type u) (cmp : α → α → Ordering) extends EqOfCmp α cmp where
|
||||
cmp_rfl {a : α} : cmp a a = .eq
|
||||
|
||||
export LawfulCmpEq (cmp_rfl)
|
||||
|
||||
attribute [simp] cmp_rfl
|
||||
|
||||
@[simp] theorem cmp_iff_eq [LawfulCmpEq α cmp] : cmp a a' = .eq ↔ a = a' :=
|
||||
Iff.intro eq_of_cmp fun a_eq => a_eq ▸ cmp_rfl
|
||||
|
||||
/--
|
||||
Proof that the equality of a compare function corresponds
|
||||
to propositional equality with respect to a given function.
|
||||
-/
|
||||
class EqOfCmpWrt (α : Type u) {β : Type v} (f : α → β) (cmp : α → α → Ordering) where
|
||||
eq_of_cmp_wrt {a a' : α} : cmp a a' = .eq → f a = f a'
|
||||
|
||||
export EqOfCmpWrt (eq_of_cmp_wrt)
|
||||
|
||||
instance : EqOfCmpWrt α (fun _ => α) cmp := ⟨fun _ => rfl⟩
|
||||
|
||||
instance [EqOfCmp α cmp] : EqOfCmpWrt α f cmp where
|
||||
eq_of_cmp_wrt h := by rw [eq_of_cmp h]
|
||||
|
||||
instance [EqOfCmpWrt α (fun a => a) cmp] : EqOfCmp α cmp where
|
||||
eq_of_cmp h := eq_of_cmp_wrt (f := fun a => a) h
|
||||
|
||||
-- ## Basic Instances
|
||||
|
||||
theorem eq_of_compareOfLessAndEq [LT α] [DecidableEq α] {a a' : α}
|
||||
[Decidable (a < a')] (h : compareOfLessAndEq a a' = .eq) : a = a' := by
|
||||
unfold compareOfLessAndEq at h
|
||||
split at h; case inl => exact False.elim h
|
||||
split at h; case inr => exact False.elim h
|
||||
assumption
|
||||
|
||||
theorem compareOfLessAndEq_rfl [LT α] [DecidableEq α] {a : α}
|
||||
[Decidable (a < a)] (lt_irrefl : ¬ a < a) : compareOfLessAndEq a a = .eq := by
|
||||
simp [compareOfLessAndEq, lt_irrefl]
|
||||
|
||||
instance : LawfulCmpEq Nat compare where
|
||||
eq_of_cmp := eq_of_compareOfLessAndEq
|
||||
cmp_rfl := compareOfLessAndEq_rfl <| Nat.lt_irrefl _
|
||||
|
||||
theorem Fin.eq_of_compare {n n' : Fin m} (h : compare n n' = .eq) : n = n' := by
|
||||
dsimp only [compare] at h
|
||||
have h' := eq_of_compareOfLessAndEq h
|
||||
exact Fin.eq_of_val_eq h'
|
||||
|
||||
instance : LawfulCmpEq (Fin n) compare where
|
||||
eq_of_cmp := Fin.eq_of_compare
|
||||
cmp_rfl := compareOfLessAndEq_rfl <| Nat.lt_irrefl _
|
||||
|
||||
instance : LawfulCmpEq UInt64 compare where
|
||||
eq_of_cmp h := eq_of_compareOfLessAndEq h
|
||||
cmp_rfl := compareOfLessAndEq_rfl <| Nat.lt_irrefl _
|
||||
|
||||
theorem List.lt_irrefl [LT α] (irrefl_α : ∀ a : α, ¬ a < a)
|
||||
: (a : List α) → ¬ a < a
|
||||
| _, .head _ _ h => irrefl_α _ h
|
||||
| _, .tail _ _ h3 => lt_irrefl irrefl_α _ h3
|
||||
|
||||
@[simp] theorem String.lt_irrefl (s : String) : ¬ s < s :=
|
||||
List.lt_irrefl (fun c => Nat.lt_irrefl c.1.1) _
|
||||
|
||||
instance : LawfulCmpEq String compare where
|
||||
eq_of_cmp := eq_of_compareOfLessAndEq
|
||||
cmp_rfl := compareOfLessAndEq_rfl <| String.lt_irrefl _
|
||||
|
||||
@[macro_inline]
|
||||
def Option.compareWith (cmp : α → α → Ordering) : Option α → Option α → Ordering
|
||||
| none, none => .eq
|
||||
| none, some _ => .lt
|
||||
| some _, none => .gt
|
||||
| some x, some y => cmp x y
|
||||
|
||||
instance [EqOfCmp α cmp] : EqOfCmp (Option α) (Option.compareWith cmp) where
|
||||
eq_of_cmp := by
|
||||
intro o o'
|
||||
unfold Option.compareWith
|
||||
cases o <;> cases o' <;> simp
|
||||
exact eq_of_cmp
|
||||
|
||||
instance [LawfulCmpEq α cmp] : LawfulCmpEq (Option α) (Option.compareWith cmp) where
|
||||
cmp_rfl := by
|
||||
intro o
|
||||
unfold Option.compareWith
|
||||
cases o <;> simp
|
||||
|
||||
def Prod.compareWith
|
||||
(cmpA : α → α → Ordering) (cmpB : β → β → Ordering)
|
||||
: (α × β) → (α × β) → Ordering :=
|
||||
fun (a, b) (a', b') => match cmpA a a' with | .eq => cmpB b b' | ord => ord
|
||||
|
||||
instance [EqOfCmp α cmpA] [EqOfCmp β cmpB]
|
||||
: EqOfCmp (α × β) (Prod.compareWith cmpA cmpB) where
|
||||
eq_of_cmp := by
|
||||
intro (a, b) (a', b')
|
||||
dsimp only [Prod.compareWith]
|
||||
split; next ha => intro hb; rw [eq_of_cmp ha, eq_of_cmp hb]
|
||||
intros; contradiction
|
||||
|
||||
instance [LawfulCmpEq α cmpA] [LawfulCmpEq β cmpB]
|
||||
: LawfulCmpEq (α × β) (Prod.compareWith cmpA cmpB) where
|
||||
cmp_rfl := by simp [Prod.compareWith]
|
||||
28
src/lake/Lake/Util/Cycle.lean
Normal file
28
src/lake/Lake/Util/Cycle.lean
Normal file
@@ -0,0 +1,28 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-- A sequence of calls donated by the key type `κ`. -/
|
||||
abbrev CallStack κ := List κ
|
||||
|
||||
/-- A `CallStack` ending in a cycle. -/
|
||||
abbrev Cycle κ := CallStack κ
|
||||
|
||||
/-- A transformer that equips a monad with a `CallStack` to detect cycles. -/
|
||||
abbrev CycleT κ m := ReaderT (CallStack κ) <| ExceptT (Cycle κ) m
|
||||
|
||||
/--
|
||||
Add `key` to the monad's `CallStack` before invoking `act`.
|
||||
If adding `key` produces a cycle, the cyclic call stack is thrown.
|
||||
-/
|
||||
@[inline] def guardCycle [BEq κ] [Monad m]
|
||||
(key : κ) (act : CycleT κ m α) : CycleT κ m α := do
|
||||
let parents ← read
|
||||
if parents.contains key then
|
||||
throw <| key :: (parents.partition (· != key)).1 ++ [key]
|
||||
else
|
||||
act (key :: parents)
|
||||
149
src/lake/Lake/Util/DRBMap.lean
Normal file
149
src/lake/Lake/Util/DRBMap.lean
Normal file
@@ -0,0 +1,149 @@
|
||||
/-
|
||||
Copyright (c) 2022 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura, Mac Malone
|
||||
-/
|
||||
import Lean.Data.RBMap
|
||||
import Lake.Util.Compare
|
||||
|
||||
namespace Lake
|
||||
open Lean RBNode
|
||||
|
||||
/-!
|
||||
This module includes a dependently typed adaption of the `Lean.RBMap`
|
||||
defined in `Lean.Data.RBMap` module of the Lean core. Most of the code is
|
||||
copied directly from there with only minor edits.
|
||||
-/
|
||||
|
||||
instance inhabitedOfEmptyCollection [EmptyCollection α] : Inhabited α where
|
||||
default := {}
|
||||
|
||||
@[specialize] def RBNode.dFind {α : Type u} {β : α → Type v}
|
||||
(cmp : α → α → Ordering) [h : EqOfCmpWrt α β cmp] : RBNode α β → (k : α) → Option (β k)
|
||||
| leaf, _ => none
|
||||
| node _ a ky vy b, x =>
|
||||
match ho:cmp x ky with
|
||||
| Ordering.lt => dFind cmp a x
|
||||
| Ordering.gt => dFind cmp b x
|
||||
| Ordering.eq => some <| cast (by rw [eq_of_cmp_wrt (f := β) ho]) vy
|
||||
|
||||
/-- A Dependently typed `RBMap`. -/
|
||||
def DRBMap (α : Type u) (β : α → Type v) (cmp : α → α → Ordering) : Type (max u v) :=
|
||||
{t : RBNode α β // t.WellFormed cmp }
|
||||
|
||||
@[inline] def mkDRBMap (α : Type u) (β : α → Type v) (cmp : α → α → Ordering) : DRBMap α β cmp :=
|
||||
⟨leaf, WellFormed.leafWff⟩
|
||||
|
||||
@[inline] def DRBMap.empty {α : Type u} {β : α → Type v} {cmp : α → α → Ordering} : DRBMap α β cmp :=
|
||||
mkDRBMap ..
|
||||
|
||||
instance (α : Type u) (β : α → Type v) (cmp : α → α → Ordering) : EmptyCollection (DRBMap α β cmp) :=
|
||||
⟨DRBMap.empty⟩
|
||||
|
||||
namespace DRBMap
|
||||
variable {α : Type u} {β : α → Type v} {σ : Type w} {cmp : α → α → Ordering}
|
||||
|
||||
def depth (f : Nat → Nat → Nat) (t : DRBMap α β cmp) : Nat :=
|
||||
t.val.depth f
|
||||
|
||||
@[inline] def fold (f : σ → (k : α) → β k → σ) : (init : σ) → DRBMap α β cmp → σ
|
||||
| b, ⟨t, _⟩ => t.fold f b
|
||||
|
||||
@[inline] def revFold (f : σ → (k : α) → β k → σ) : (init : σ) → DRBMap α β cmp → σ
|
||||
| b, ⟨t, _⟩ => t.revFold f b
|
||||
|
||||
@[inline] def foldM [Monad m] (f : σ → (k : α) → β k → m σ) : (init : σ) → DRBMap α β cmp → m σ
|
||||
| b, ⟨t, _⟩ => t.foldM f b
|
||||
|
||||
@[inline] def forM [Monad m] (f : (k : α) → β k → m PUnit) (t : DRBMap α β cmp) : m PUnit :=
|
||||
t.foldM (fun _ k v => f k v) ⟨⟩
|
||||
|
||||
@[inline] protected def forIn [Monad m] (t : DRBMap α β cmp) (init : σ) (f : ((k : α) × β k) → σ → m (ForInStep σ)) : m σ :=
|
||||
t.val.forIn init (fun a b acc => f ⟨a, b⟩ acc)
|
||||
|
||||
instance : ForIn m (DRBMap α β cmp) ((k : α) × β k) where
|
||||
forIn := DRBMap.forIn
|
||||
|
||||
@[inline] def isEmpty : DRBMap α β cmp → Bool
|
||||
| ⟨leaf, _⟩ => true
|
||||
| _ => false
|
||||
|
||||
@[specialize] def toList : DRBMap α β cmp → List ((k : α) × β k)
|
||||
| ⟨t, _⟩ => t.revFold (fun ps k v => ⟨k, v⟩::ps) []
|
||||
|
||||
@[inline] protected def min : DRBMap α β cmp → Option ((k : α) × β k)
|
||||
| ⟨t, _⟩ =>
|
||||
match t.min with
|
||||
| some ⟨k, v⟩ => some ⟨k, v⟩
|
||||
| none => none
|
||||
|
||||
@[inline] protected def max : DRBMap α β cmp → Option ((k : α) × β k)
|
||||
| ⟨t, _⟩ =>
|
||||
match t.max with
|
||||
| some ⟨k, v⟩ => some ⟨k, v⟩
|
||||
| none => none
|
||||
|
||||
instance [Repr ((k : α) × β k)] : Repr (DRBMap α β cmp) where
|
||||
reprPrec m prec := Repr.addAppParen ("Lake.drbmapOf " ++ repr m.toList) prec
|
||||
|
||||
@[inline] def insert : DRBMap α β cmp → (k : α) → β k → DRBMap α β cmp
|
||||
| ⟨t, w⟩, k, v => ⟨t.insert cmp k v, WellFormed.insertWff w rfl⟩
|
||||
|
||||
@[inline] def erase : DRBMap α β cmp → α → DRBMap α β cmp
|
||||
| ⟨t, w⟩, k => ⟨t.erase cmp k, WellFormed.eraseWff w rfl⟩
|
||||
|
||||
@[specialize] def ofList : List ((k : α) × β k) → DRBMap α β cmp
|
||||
| [] => mkDRBMap ..
|
||||
| ⟨k,v⟩::xs => (ofList xs).insert k v
|
||||
|
||||
@[inline] def findCore? : DRBMap α β cmp → α → Option ((k : α) × β k)
|
||||
| ⟨t, _⟩, x => t.findCore cmp x
|
||||
|
||||
@[inline] def find? [EqOfCmpWrt α β cmp] : DRBMap α β cmp → (k : α) → Option (β k)
|
||||
| ⟨t, _⟩, x => RBNode.dFind cmp t x
|
||||
|
||||
@[inline] def findD [EqOfCmpWrt α β cmp] (t : DRBMap α β cmp) (k : α) (v₀ : β k) : β k :=
|
||||
(t.find? k).getD v₀
|
||||
|
||||
/-- (lowerBound k) retrieves the kv pair of the largest key smaller than or equal to `k`,
|
||||
if it exists. -/
|
||||
@[inline] def lowerBound : DRBMap α β cmp → α → Option ((k : α) × β k)
|
||||
| ⟨t, _⟩, x => t.lowerBound cmp x none
|
||||
|
||||
@[inline] def contains [EqOfCmpWrt α β cmp] (t : DRBMap α β cmp) (k : α) : Bool :=
|
||||
(t.find? k).isSome
|
||||
|
||||
@[inline] def fromList (l : List ((k : α) × β k)) (cmp : α → α → Ordering) : DRBMap α β cmp :=
|
||||
l.foldl (fun r p => r.insert p.1 p.2) (mkDRBMap α β cmp)
|
||||
|
||||
@[inline] def all : DRBMap α β cmp → ((k : α) → β k → Bool) → Bool
|
||||
| ⟨t, _⟩, p => t.all p
|
||||
|
||||
@[inline] def any : DRBMap α β cmp → ((k : α) → β k → Bool) → Bool
|
||||
| ⟨t, _⟩, p => t.any p
|
||||
|
||||
def size (m : DRBMap α β cmp) : Nat :=
|
||||
m.fold (fun sz _ _ => sz+1) 0
|
||||
|
||||
def maxDepth (t : DRBMap α β cmp) : Nat :=
|
||||
t.val.depth Nat.max
|
||||
|
||||
@[inline] def min! [Inhabited ((k : α) × β k)] (t : DRBMap α β cmp) : (k : α) × β k :=
|
||||
match t.min with
|
||||
| some p => p
|
||||
| none => panic! "map is empty"
|
||||
|
||||
@[inline] def max! [Inhabited ((k : α) × β k)] (t : DRBMap α β cmp) : (k : α) × β k :=
|
||||
match t.max with
|
||||
| some p => p
|
||||
| none => panic! "map is empty"
|
||||
|
||||
@[inline] def find! [EqOfCmpWrt α β cmp] (t : DRBMap α β cmp) (k : α) [Inhabited (β k)] : β k :=
|
||||
match t.find? k with
|
||||
| some b => b
|
||||
| none => panic! "key is not in the map"
|
||||
|
||||
end DRBMap
|
||||
|
||||
def drbmapOf {α : Type u} {β : α → Type v} (l : List ((k : α) × (β k))) (cmp : α → α → Ordering) : DRBMap α β cmp :=
|
||||
DRBMap.fromList l cmp
|
||||
22
src/lake/Lake/Util/EStateT.lean
Normal file
22
src/lake/Lake/Util/EStateT.lean
Normal file
@@ -0,0 +1,22 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-- An exception plus state monad transformer (ι.e., `ExceptT` + `StateT`). -/
|
||||
abbrev EStateT.{u,v} (ε : Type u) (σ : Type u) (m : Type u → Type v) :=
|
||||
ExceptT ε <| StateT σ m
|
||||
|
||||
namespace EStateT
|
||||
variable {ε : Type u} {σ : Type u} {m : Type u → Type v}
|
||||
|
||||
@[inline] def run (init : σ) (self : EStateT ε σ m α) : m (Except ε α × σ) :=
|
||||
ExceptT.run self |>.run init
|
||||
|
||||
@[inline] def run' [Functor m] (init : σ) (self : EStateT ε σ m α) : m (Except ε α) :=
|
||||
ExceptT.run self |>.run' init
|
||||
|
||||
end EStateT
|
||||
92
src/lake/Lake/Util/EquipT.lean
Normal file
92
src/lake/Lake/Util/EquipT.lean
Normal file
@@ -0,0 +1,92 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
namespace Lake
|
||||
|
||||
/--
|
||||
A monad transformer that equips a monad with a value.
|
||||
This is a generalization of `ReaderT` where the value is not
|
||||
necessarily directly readable through the monad.
|
||||
-/
|
||||
def EquipT (ρ : Type u) (m : Type v → Type w) (α : Type v) :=
|
||||
ρ → m α
|
||||
|
||||
variable {ρ : Type u} {m : Type v → Type w}
|
||||
|
||||
instance {α : Type v} [Inhabited (m α)] : Inhabited (EquipT ρ m α) where
|
||||
default := fun _ => default
|
||||
|
||||
namespace EquipT
|
||||
|
||||
@[inline] protected
|
||||
def run {α : Type v} (self : EquipT ρ m α) (r : ρ) : m α :=
|
||||
self r
|
||||
|
||||
@[inline] protected
|
||||
def map [Functor m] {α β : Type v} (f : α → β) (self : EquipT ρ m α) : EquipT ρ m β :=
|
||||
fun fetch => Functor.map f (self fetch)
|
||||
|
||||
instance [Functor m] : Functor (EquipT ρ m) where
|
||||
map := EquipT.map
|
||||
|
||||
@[inline] protected
|
||||
def pure [Pure m] {α : Type v} (a : α) : EquipT ρ m α :=
|
||||
fun _ => pure a
|
||||
|
||||
instance [Pure m] : Pure (EquipT ρ m) where
|
||||
pure := EquipT.pure
|
||||
|
||||
@[inline] protected
|
||||
def compose {α₁ α₂ β : Type v} (f : m α₁ → (Unit → m α₂) → m β) (x₁ : EquipT ρ m α₁) (x₂ : Unit → EquipT ρ m α₂) : EquipT ρ m β :=
|
||||
fun fetch => f (x₁ fetch) (fun _ => x₂ () fetch)
|
||||
|
||||
@[inline] protected
|
||||
def seq [Seq m] {α β : Type v} : EquipT ρ m (α → β) → (Unit → EquipT ρ m α) → EquipT ρ m β :=
|
||||
EquipT.compose Seq.seq
|
||||
|
||||
instance [Seq m] : Seq (EquipT ρ m) where
|
||||
seq := EquipT.seq
|
||||
|
||||
instance [Applicative m] : Applicative (EquipT ρ m) := {}
|
||||
|
||||
@[inline] protected
|
||||
def bind [Bind m] {α β : Type v} (self : EquipT ρ m α) (f : α → EquipT ρ m β) : EquipT ρ m β :=
|
||||
fun fetch => bind (self fetch) fun a => f a fetch
|
||||
|
||||
instance [Bind m] : Bind (EquipT ρ m) where
|
||||
bind := EquipT.bind
|
||||
|
||||
instance [Monad m] : Monad (EquipT ρ m) := {}
|
||||
|
||||
@[inline] protected
|
||||
def lift {α : Type v} (t : m α) : EquipT ρ m α :=
|
||||
fun _ => t
|
||||
|
||||
instance : MonadLift m (EquipT ρ m) where
|
||||
monadLift := EquipT.lift
|
||||
|
||||
@[inline] protected
|
||||
def failure [Alternative m] {α : Type v} : EquipT ρ m α :=
|
||||
fun _ => failure
|
||||
|
||||
@[inline] protected
|
||||
def orElse [Alternative m] {α : Type v} : EquipT ρ m α → (Unit → EquipT ρ m α) → EquipT ρ m α :=
|
||||
EquipT.compose Alternative.orElse
|
||||
|
||||
instance [Alternative m] : Alternative (EquipT ρ m) where
|
||||
failure := EquipT.failure
|
||||
orElse := EquipT.orElse
|
||||
|
||||
@[inline] protected
|
||||
def throw {ε : Type v} [MonadExceptOf ε m] {α : Type v} (e : ε) : EquipT ρ m α :=
|
||||
fun _ => throw e
|
||||
|
||||
@[inline] protected
|
||||
def tryCatch {ε : Type v} [MonadExceptOf ε m] {α : Type v} (self : EquipT ρ m α) (c : ε → EquipT ρ m α) : EquipT ρ m α :=
|
||||
fun f => tryCatchThe ε (self f) fun e => (c e) f
|
||||
|
||||
instance (ε) [MonadExceptOf ε m] : MonadExceptOf ε (EquipT ρ m) where
|
||||
throw := EquipT.throw
|
||||
tryCatch := EquipT.tryCatch
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user