Compare commits
623 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
888d844ec5 | ||
|
|
3a7eb9fc0c | ||
|
|
46276aacd9 | ||
|
|
3a7a29868f | ||
|
|
0060c8988a | ||
|
|
458f482c2a | ||
|
|
dadf1b6ff9 | ||
|
|
db56bb92f0 | ||
|
|
e82e36f51e | ||
|
|
f9aad34d28 | ||
|
|
b2d720b853 | ||
|
|
c10c05e924 | ||
|
|
8909246725 | ||
|
|
48c0b0ab3c | ||
|
|
cbbed310c5 | ||
|
|
9e9c3b6342 | ||
|
|
fefd262c2e | ||
|
|
1108c99688 | ||
|
|
93da831ef0 | ||
|
|
72bf45912e | ||
|
|
5d94276c4f | ||
|
|
b43f27030e | ||
|
|
2845f55157 | ||
|
|
e254d84710 | ||
|
|
0ef7b5488d | ||
|
|
56b04f8df8 | ||
|
|
2d036c6b25 | ||
|
|
ad3be5c848 | ||
|
|
a0544cc345 | ||
|
|
3245261162 | ||
|
|
21b7348c6a | ||
|
|
54d4dc6e1e | ||
|
|
e00d864199 | ||
|
|
ad6fc89a24 | ||
|
|
fc4823ce8e | ||
|
|
0bd9831eec | ||
|
|
dec2ef70c7 | ||
|
|
d19d8ea770 | ||
|
|
34f7752c0f | ||
|
|
da4d061067 | ||
|
|
85155439be | ||
|
|
dd32e69061 | ||
|
|
1c0c660c32 | ||
|
|
2eac902c33 | ||
|
|
9f5322d309 | ||
|
|
f5c2f6f9e9 | ||
|
|
e0e3b180e7 | ||
|
|
041dc039d4 | ||
|
|
ac755b0ada | ||
|
|
c14259060c | ||
|
|
a423eb5323 | ||
|
|
fd732550d8 | ||
|
|
fac7ba70c8 | ||
|
|
e9f8b35918 | ||
|
|
23034dd4f5 | ||
|
|
70ad44adfd | ||
|
|
95ca8a2630 | ||
|
|
a7fd3c50e5 | ||
|
|
5639f40994 | ||
|
|
33a8262334 | ||
|
|
9b4f7ad696 | ||
|
|
eecd809d9a | ||
|
|
240d3cb8f1 | ||
|
|
5720b7b94c | ||
|
|
3855d7ea02 | ||
|
|
9f3351469d | ||
|
|
2c4a0cf65b | ||
|
|
a8f360c8fd | ||
|
|
b3cff6555f | ||
|
|
69706ecab0 | ||
|
|
05d3b97eae | ||
|
|
a38fb41e37 | ||
|
|
204ae377e3 | ||
|
|
3e5a652874 | ||
|
|
862ae26631 | ||
|
|
9e0208ec71 | ||
|
|
510530973c | ||
|
|
4e69301562 | ||
|
|
df06d4b9a2 | ||
|
|
b60561c3bb | ||
|
|
fffa503968 | ||
|
|
8754157810 | ||
|
|
0763686892 | ||
|
|
50776748a7 | ||
|
|
c07274a6fa | ||
|
|
4084005ee7 | ||
|
|
40fce574cf | ||
|
|
fd761735d4 | ||
|
|
9cb98bdcdc | ||
|
|
b5b1f7ff8a | ||
|
|
a86019d53b | ||
|
|
8cd7d08573 | ||
|
|
6d6f6ed8fc | ||
|
|
c9aed1381f | ||
|
|
49ba5f30c5 | ||
|
|
3c6149fd27 | ||
|
|
23f804eda3 | ||
|
|
4e321db189 | ||
|
|
716fde5784 | ||
|
|
c70b873397 | ||
|
|
4c0da691b8 | ||
|
|
d1d36f9af0 | ||
|
|
56efb4ffba | ||
|
|
540bc71873 | ||
|
|
c1df7ead1a | ||
|
|
d170c807e3 | ||
|
|
50c0abc786 | ||
|
|
c5057127ee | ||
|
|
ea7b1a9592 | ||
|
|
26d483f2d7 | ||
|
|
67fce58708 | ||
|
|
ea5771c442 | ||
|
|
fa8a1faeb3 | ||
|
|
d60a000af6 | ||
|
|
3d68e2b74f | ||
|
|
42f6d48abf | ||
|
|
5587957602 | ||
|
|
1d313ebf25 | ||
|
|
cf92349c1d | ||
|
|
b0ae44bc25 | ||
|
|
0c94124fdf | ||
|
|
22298ddb41 | ||
|
|
6f927b9941 | ||
|
|
dc5626f34d | ||
|
|
2717ec2759 | ||
|
|
d75449ea63 | ||
|
|
034f5b16bd | ||
|
|
ff420f1e67 | ||
|
|
5be771842f | ||
|
|
a131c93a14 | ||
|
|
3da3546ef8 | ||
|
|
47f5223c37 | ||
|
|
b8c50eb0fe | ||
|
|
fe05082ddc | ||
|
|
414acda9e0 | ||
|
|
47e3a5e75a | ||
|
|
573df892bc | ||
|
|
bfced59949 | ||
|
|
9a63b1751b | ||
|
|
53ae8b9bd1 | ||
|
|
bf3cc5a367 | ||
|
|
ac00bc6b70 | ||
|
|
ab62603c5a | ||
|
|
dd247cd541 | ||
|
|
0d7a9f32d6 | ||
|
|
0d85ef4404 | ||
|
|
8e9273a96a | ||
|
|
2dfdaaa4ba | ||
|
|
407094cdcb | ||
|
|
0111db6744 | ||
|
|
a49230c0e1 | ||
|
|
d04abc2021 | ||
|
|
b5368207d6 | ||
|
|
b8400e0c92 | ||
|
|
ef6b6cd279 | ||
|
|
e5903d8d6e | ||
|
|
e2a3db1b82 | ||
|
|
9e220e8416 | ||
|
|
605c233753 | ||
|
|
aafe18c2b5 | ||
|
|
262e8af813 | ||
|
|
75aa4ce8a0 | ||
|
|
a494cdaf92 | ||
|
|
848425418b | ||
|
|
989bed88fe | ||
|
|
99f66200f7 | ||
|
|
b642bd2cfd | ||
|
|
c062b7c9da | ||
|
|
7df7901532 | ||
|
|
9dabce819a | ||
|
|
a019109857 | ||
|
|
46cdf14ecc | ||
|
|
fd5ff20b68 | ||
|
|
81f9666e82 | ||
|
|
aa8659d5c7 | ||
|
|
9df2df0f9f | ||
|
|
98d38d763b | ||
|
|
319a4622b3 | ||
|
|
59b4c6dacb | ||
|
|
ec6d725587 | ||
|
|
6f19649186 | ||
|
|
6a583b9b5b | ||
|
|
6617b79cd8 | ||
|
|
46b695d093 | ||
|
|
de8a017e80 | ||
|
|
b71ec91f57 | ||
|
|
1b7c226779 | ||
|
|
ca5a5b4392 | ||
|
|
6ae7ae0210 | ||
|
|
b911d2fda4 | ||
|
|
847a92f580 | ||
|
|
a346493de1 | ||
|
|
efd5d6efab | ||
|
|
b6df5a4b7f | ||
|
|
34ae56e319 | ||
|
|
5870824d01 | ||
|
|
1dbadbfc35 | ||
|
|
d3f1cd7411 | ||
|
|
a821daadd3 | ||
|
|
a39f4b4487 | ||
|
|
f7b401b9b6 | ||
|
|
c342d18f92 | ||
|
|
e0e52a3090 | ||
|
|
6f92480315 | ||
|
|
490d008edf | ||
|
|
ccee17c573 | ||
|
|
dd4832e40b | ||
|
|
ff5b870a9f | ||
|
|
a371580201 | ||
|
|
b499c575bc | ||
|
|
f5a6268cef | ||
|
|
2df4083602 | ||
|
|
2495fb796d | ||
|
|
f7b49740c1 | ||
|
|
7e765fe726 | ||
|
|
1d339f74d1 | ||
|
|
a3bb288f01 | ||
|
|
0e1226573a | ||
|
|
8151b65d12 | ||
|
|
eefd36b50d | ||
|
|
6f4d769187 | ||
|
|
20b76a703a | ||
|
|
dcc09b7bb5 | ||
|
|
4ea0dee90a | ||
|
|
e61116d35a | ||
|
|
f7256c75d5 | ||
|
|
2696fd1291 | ||
|
|
b139620fba | ||
|
|
97115a9c1c | ||
|
|
36134c61b2 | ||
|
|
77cf0fd87b | ||
|
|
ab77a1cbc0 | ||
|
|
8490892493 | ||
|
|
5f35dffa34 | ||
|
|
89a4b5a6ff | ||
|
|
931de7e39c | ||
|
|
ff41d6aef9 | ||
|
|
8e1ba58551 | ||
|
|
2b1692a860 | ||
|
|
7a2981e21c | ||
|
|
f8717359d7 | ||
|
|
fe395e3a8c | ||
|
|
eb9fe851af | ||
|
|
d61851ad02 | ||
|
|
de7a408903 | ||
|
|
4b0f60fe71 | ||
|
|
a167bcff5e | ||
|
|
fb812e6335 | ||
|
|
3fd557c74a | ||
|
|
9b1272da51 | ||
|
|
ae2402f4a7 | ||
|
|
c98e869564 | ||
|
|
e1a019ec56 | ||
|
|
2d7fcbf23d | ||
|
|
b604177ca1 | ||
|
|
f27597cab5 | ||
|
|
40619c8184 | ||
|
|
b0a5df2838 | ||
|
|
ae9232a2cb | ||
|
|
ad28d0025a | ||
|
|
d6772c5ca5 | ||
|
|
a2400767ed | ||
|
|
1873b655a8 | ||
|
|
e27c2b59c8 | ||
|
|
4b50608642 | ||
|
|
e3a7f9eb7a | ||
|
|
c130b3a92e | ||
|
|
20fb6d6669 | ||
|
|
caf20cd43d | ||
|
|
608d661355 | ||
|
|
31c868818b | ||
|
|
443c4b6cd0 | ||
|
|
ee425bb7f0 | ||
|
|
9d1c026231 | ||
|
|
6d7612ead6 | ||
|
|
b3e31094ff | ||
|
|
c9750fab2c | ||
|
|
5a1348e4d1 | ||
|
|
b64d45a74e | ||
|
|
ba5a4c3945 | ||
|
|
9ba37a932b | ||
|
|
8ce377d033 | ||
|
|
a7f3dafd81 | ||
|
|
fb38b4b906 | ||
|
|
f0a1a90b0e | ||
|
|
fb331d39a6 | ||
|
|
7a3e6e19b1 | ||
|
|
5a063c541d | ||
|
|
eef25ec638 | ||
|
|
7141fb18c1 | ||
|
|
2c92be5e3d | ||
|
|
cae0733149 | ||
|
|
5d6ca7a88e | ||
|
|
23b8a4d364 | ||
|
|
c0df8cb578 | ||
|
|
4693c23a49 | ||
|
|
86364ff278 | ||
|
|
60f1f1cb3d | ||
|
|
ab3c520006 | ||
|
|
3798dcb98d | ||
|
|
9daf290432 | ||
|
|
3438f88c1e | ||
|
|
2c8858ff2d | ||
|
|
45ed9405b0 | ||
|
|
075ca78dd2 | ||
|
|
1d964ef921 | ||
|
|
0c6d9b1d3b | ||
|
|
1713f1222b | ||
|
|
450591d5a9 | ||
|
|
5c4863dfb1 | ||
|
|
c6a82cbc07 | ||
|
|
cc8f074d33 | ||
|
|
196d74c3a0 | ||
|
|
f28e87b240 | ||
|
|
2d77ef4245 | ||
|
|
3f578e24b5 | ||
|
|
fb5ee5e190 | ||
|
|
63e8378310 | ||
|
|
c24ebaf506 | ||
|
|
d3a1f11dfe | ||
|
|
f96e694ff8 | ||
|
|
d5d635e50f | ||
|
|
1ad4ce9822 | ||
|
|
3f971174e4 | ||
|
|
16e257ea32 | ||
|
|
37f1f8ac14 | ||
|
|
474fa9b3ec | ||
|
|
6d7b14ceb5 | ||
|
|
af14832b6c | ||
|
|
9ef185978f | ||
|
|
38bb44664c | ||
|
|
124d924ff5 | ||
|
|
e8091d8add | ||
|
|
500bd53b6a | ||
|
|
6996ca832d | ||
|
|
2e15ab44ab | ||
|
|
2ae5472872 | ||
|
|
98a32790cd | ||
|
|
6dcefcfb71 | ||
|
|
988366e37f | ||
|
|
98a37905b8 | ||
|
|
bd832d0fbb | ||
|
|
1f7e18f2a9 | ||
|
|
105e9c8e88 | ||
|
|
99e1a5f117 | ||
|
|
b35b49f7b3 | ||
|
|
5d064b18e6 | ||
|
|
11ea92288d | ||
|
|
1ea6ae9fd9 | ||
|
|
57d739673a | ||
|
|
4d8f76e922 | ||
|
|
fb41d4ab0f | ||
|
|
023ee688d3 | ||
|
|
5f8f0d8573 | ||
|
|
f56e0a6586 | ||
|
|
2c96420bc4 | ||
|
|
8d95eb57fa | ||
|
|
a9a5e79e85 | ||
|
|
2b720b8d0b | ||
|
|
93a0ab7f0a | ||
|
|
18dd55d1f4 | ||
|
|
c9074d8d96 | ||
|
|
f6c995157e | ||
|
|
a059a9fbdc | ||
|
|
2ac6596ba9 | ||
|
|
2d1f57e839 | ||
|
|
7799ed36f0 | ||
|
|
db5ed345bc | ||
|
|
082c6a9e64 | ||
|
|
b74a4d5225 | ||
|
|
16a572c250 | ||
|
|
6a8a2d6f56 | ||
|
|
237c855f10 | ||
|
|
15d18484e3 | ||
|
|
378e9b5539 | ||
|
|
7a135bd87c | ||
|
|
9e907e36e2 | ||
|
|
9ac71f304d | ||
|
|
ab9b604d02 | ||
|
|
155645307a | ||
|
|
4ca7ac4851 | ||
|
|
02eb24cd57 | ||
|
|
787fbe1bb6 | ||
|
|
7678858bab | ||
|
|
bf7a28f07c | ||
|
|
9e54b1406c | ||
|
|
f52c9772a7 | ||
|
|
ea5203d8c3 | ||
|
|
0fad2f9953 | ||
|
|
d3a9392421 | ||
|
|
208927544d | ||
|
|
7621155a89 | ||
|
|
4ddc4ebf46 | ||
|
|
786f0b5ca2 | ||
|
|
b4ff429bfa | ||
|
|
f2cf0ec459 | ||
|
|
0380d70a46 | ||
|
|
28099b9812 | ||
|
|
2ce4f602c0 | ||
|
|
5e81fb4754 | ||
|
|
c9f1a95343 | ||
|
|
97d8d07947 | ||
|
|
4f0adad78e | ||
|
|
0499005db5 | ||
|
|
aedffb3cfe | ||
|
|
fff96e69db | ||
|
|
abc99c9dd8 | ||
|
|
6e4b76a3b4 | ||
|
|
92d8642133 | ||
|
|
184124586b | ||
|
|
4d32b6976a | ||
|
|
45a99e576d | ||
|
|
fac6d54986 | ||
|
|
036c35729c | ||
|
|
e442fddc66 | ||
|
|
a3c3afba48 | ||
|
|
794ceac440 | ||
|
|
6299d41cda | ||
|
|
2e5ce0249e | ||
|
|
560298655b | ||
|
|
4086df27b2 | ||
|
|
d76ae413c4 | ||
|
|
8b1df2e9ca | ||
|
|
c8855f97e8 | ||
|
|
bbf1aa1668 | ||
|
|
141f3bcec3 | ||
|
|
8f11fd7c62 | ||
|
|
9f960c25a5 | ||
|
|
11a616917a | ||
|
|
a89f03f27d | ||
|
|
3faf36440c | ||
|
|
45d4f46024 | ||
|
|
896f2aeb74 | ||
|
|
7de39611f3 | ||
|
|
7e6be23287 | ||
|
|
cac76d4739 | ||
|
|
194e5dc94e | ||
|
|
f7629362d7 | ||
|
|
ea0c396114 | ||
|
|
057e2d8056 | ||
|
|
487fe21e25 | ||
|
|
54dce9b60e | ||
|
|
f09a3142a6 | ||
|
|
121c8d8a48 | ||
|
|
b9561ec8db | ||
|
|
b1d8eff019 | ||
|
|
f9c4a40d60 | ||
|
|
8e318f76a7 | ||
|
|
7d21ea93a6 | ||
|
|
8630ba4a2d | ||
|
|
17a448e045 | ||
|
|
7ff11dce35 | ||
|
|
e2a4854bcf | ||
|
|
bef96e231d | ||
|
|
325df8a6e3 | ||
|
|
3620f72b6c | ||
|
|
42a90b2d40 | ||
|
|
97aab6950c | ||
|
|
31258247b3 | ||
|
|
beed4e8aa8 | ||
|
|
c60a0bc062 | ||
|
|
733c2d4152 | ||
|
|
79b5857f72 | ||
|
|
7260eba26a | ||
|
|
7e7a1b2caf | ||
|
|
99181e3302 | ||
|
|
d57d2b96d6 | ||
|
|
24bed8c548 | ||
|
|
6c9e704aa8 | ||
|
|
d3eb31e4c3 | ||
|
|
698b01f85a | ||
|
|
4c88e97330 | ||
|
|
25babff827 | ||
|
|
23e833c69e | ||
|
|
22bb3fe876 | ||
|
|
eee10d3ee7 | ||
|
|
c7591045af | ||
|
|
6ddfef6383 | ||
|
|
9852e30b39 | ||
|
|
2d3ce32314 | ||
|
|
d8e0bea110 | ||
|
|
b2cf6a6ea8 | ||
|
|
2ebcd673c8 | ||
|
|
aa5f186a96 | ||
|
|
934f73f696 | ||
|
|
993c6f0e7b | ||
|
|
1d79e22468 | ||
|
|
8ba92d8b99 | ||
|
|
af23258152 | ||
|
|
b2e50b42a3 | ||
|
|
003b4d0218 | ||
|
|
545472f9c4 | ||
|
|
8f781c27f9 | ||
|
|
589dc34b99 | ||
|
|
564622e38b | ||
|
|
d3744d6f66 | ||
|
|
2613ef0633 | ||
|
|
be3cdcd71a | ||
|
|
d48ac09e25 | ||
|
|
e5a0ba7bf3 | ||
|
|
eb1980d286 | ||
|
|
424af312e5 | ||
|
|
a2a4c78c9a | ||
|
|
0457b38e41 | ||
|
|
617f803355 | ||
|
|
d3da2683cb | ||
|
|
d97c670fcd | ||
|
|
8902bcb5ab | ||
|
|
5f51e264f2 | ||
|
|
1c4e2c0ed6 | ||
|
|
5a6333129b | ||
|
|
969bd8f82c | ||
|
|
a732bc9dc4 | ||
|
|
1b5cf493d6 | ||
|
|
0be8abd38c | ||
|
|
b71e8082d2 | ||
|
|
034af296ff | ||
|
|
554b08a7d2 | ||
|
|
00b38549f5 | ||
|
|
62b41ddb93 | ||
|
|
d83c5cf5f1 | ||
|
|
740bd528c4 | ||
|
|
668c9489c9 | ||
|
|
dcf2eadcf2 | ||
|
|
9c1064c1a3 | ||
|
|
40bf5bc75f | ||
|
|
6be2d8ccf2 | ||
|
|
9958ad6f34 | ||
|
|
728be8c259 | ||
|
|
9a80d398e8 | ||
|
|
242c47bb92 | ||
|
|
85e37a9977 | ||
|
|
dded56af78 | ||
|
|
3bf1cbbe6c | ||
|
|
4ef8ab6e76 | ||
|
|
837ae4cb17 | ||
|
|
a4e352ba0d | ||
|
|
02d8b1441d | ||
|
|
196784bd09 | ||
|
|
b0fa45cd33 | ||
|
|
923c9d4ad8 | ||
|
|
2be7070e1a | ||
|
|
f16c2a6e99 | ||
|
|
d6e75110a5 | ||
|
|
3d2c4f0801 | ||
|
|
5ccd334555 | ||
|
|
90e1c990e5 | ||
|
|
018b076835 | ||
|
|
9ae029b04d | ||
|
|
43b39538ff | ||
|
|
738ea59e23 | ||
|
|
33c60d3434 | ||
|
|
607673ddcb | ||
|
|
fc8e55c582 | ||
|
|
943e5eeb35 | ||
|
|
52488b875a | ||
|
|
c362cc6d34 | ||
|
|
406d3520f1 | ||
|
|
9b71866b54 | ||
|
|
e48f87fcf0 | ||
|
|
77e83a390c | ||
|
|
27b659c401 | ||
|
|
a4cacaeab2 | ||
|
|
0eb20a5d8e | ||
|
|
3e49db1a29 | ||
|
|
2d719ab6b7 | ||
|
|
34745f6242 | ||
|
|
9c9c484ee4 | ||
|
|
335202b9d9 | ||
|
|
f998d6a99f | ||
|
|
5723edd765 | ||
|
|
7eb0de7f52 | ||
|
|
9ae901bd0d | ||
|
|
1dec482e22 | ||
|
|
0a665b79f2 | ||
|
|
c3c53017f9 | ||
|
|
834c57466f | ||
|
|
4e887e3a87 | ||
|
|
7bf6a230f3 | ||
|
|
24ffdc2724 | ||
|
|
6899f051ac | ||
|
|
d9d77b3022 | ||
|
|
b31b23e41c | ||
|
|
16418a47a8 | ||
|
|
1139b3b4c1 | ||
|
|
3277ecd13d | ||
|
|
37ff4a821c | ||
|
|
f82c6f3fed | ||
|
|
d3842bb070 | ||
|
|
2ab745016a | ||
|
|
5aaba8534f | ||
|
|
2b625b1094 | ||
|
|
17f9695ab2 | ||
|
|
c0a49b6a66 | ||
|
|
66bebff01e | ||
|
|
6f9477f0bb | ||
|
|
de88fdc4dc | ||
|
|
17b2510480 | ||
|
|
bcfd7cbf8d | ||
|
|
cee3dbc453 | ||
|
|
c219d9ad5f | ||
|
|
15927d7054 | ||
|
|
ed985c3cfe | ||
|
|
4ad62e4606 | ||
|
|
d34811aa36 | ||
|
|
b90d69a45b | ||
|
|
81f220a4d2 | ||
|
|
e594ade84d | ||
|
|
0dcd9e5805 | ||
|
|
67a00e4deb | ||
|
|
e656e7fbae | ||
|
|
0fdf0d8d06 | ||
|
|
7cdbd2f16c | ||
|
|
ccfcc654a5 | ||
|
|
2eea0528b1 | ||
|
|
a358431d30 | ||
|
|
e9c1556c32 | ||
|
|
1b1879a6fa | ||
|
|
24e5e39c28 | ||
|
|
ab9a14cc6a | ||
|
|
a641822a1b | ||
|
|
145fee0d36 | ||
|
|
567af2648c |
6
.dockerignore
Executable file
6
.dockerignore
Executable file
@@ -0,0 +1,6 @@
|
||||
target
|
||||
Dockerfile
|
||||
README.md
|
||||
.git
|
||||
.gitignore
|
||||
.gitmodules
|
||||
1
.gitignore
vendored
1
.gitignore
vendored
@@ -1,4 +1,3 @@
|
||||
target/
|
||||
Cargo.lock
|
||||
|
||||
|
||||
|
||||
40
.travis.yml
40
.travis.yml
@@ -1,13 +1,31 @@
|
||||
language: rust
|
||||
rust:
|
||||
- stable
|
||||
- beta
|
||||
- nightly
|
||||
matrix:
|
||||
allow_failures:
|
||||
- rust: nightly
|
||||
fast_finish: true
|
||||
cache: cargo
|
||||
os: linux
|
||||
dist: xenial
|
||||
|
||||
script:
|
||||
- cargo build --verbose --all
|
||||
- cargo test --verbose --all
|
||||
before_script:
|
||||
- cargo fetch
|
||||
|
||||
jobs:
|
||||
allow_failures:
|
||||
env:
|
||||
- CAN_FAIL=true
|
||||
include:
|
||||
- stage: "Stable: Build"
|
||||
rust: stable
|
||||
script: cargo rustc --verbose -- -D warnings
|
||||
name: "Build Stable"
|
||||
- stage: "Stable: Tests"
|
||||
rust: stable
|
||||
script: cargo test --verbose --all
|
||||
name: "Tests Stable"
|
||||
- stage: "Features"
|
||||
rust: stable
|
||||
script: cargo test --verbose --all --no-default-features --features num
|
||||
name: "num Tests"
|
||||
env: CAN_FAIL=true
|
||||
- stage: "Beta: Build"
|
||||
# - #
|
||||
rust: beta
|
||||
script: cargo rustc --verbose -- -D warnings
|
||||
name: "Build Beta"
|
||||
|
||||
1069
Cargo.lock
generated
Normal file
1069
Cargo.lock
generated
Normal file
File diff suppressed because it is too large
Load Diff
37
Cargo.toml
37
Cargo.toml
@@ -1,28 +1,43 @@
|
||||
[package]
|
||||
name = "scryer-prolog"
|
||||
version = "0.8.112"
|
||||
version = "0.8.123"
|
||||
authors = ["Mark Thom <markjordanthom@gmail.com>"]
|
||||
build = "build.rs"
|
||||
repository = "https://github.com/mthom/scryer-prolog"
|
||||
description = "A modern Prolog implementation written mostly in Rust."
|
||||
license = "BSD-3-Clause"
|
||||
edition = "2018"
|
||||
description = "A modern Prolog implementation written mostly in Rust."
|
||||
readme = "README.md"
|
||||
repository = "https://github.com/mthom/scryer-prolog"
|
||||
license = "BSD-3-Clause"
|
||||
keywords = ["prolog", "prolog-interpreter", "prolog-implementation"]
|
||||
categories = ["command-line-utilities"]
|
||||
build = "build.rs"
|
||||
|
||||
[build-dependencies]
|
||||
indexmap = "1.0.2"
|
||||
|
||||
[features]
|
||||
default = ["rug", "prolog_parser/rug"]
|
||||
num = ["num-rug-adapter", "prolog_parser/num"]
|
||||
|
||||
[dependencies]
|
||||
cpu-time = "1.0.0"
|
||||
crossterm = "0.16.0"
|
||||
dirs = "2.0.2"
|
||||
divrem = "0.1.0"
|
||||
downcast = "0.10.0"
|
||||
git-version = "0.3.4"
|
||||
hostname = "0.3.1"
|
||||
indexmap = "1.0.2"
|
||||
lazy_static = "1.4.0"
|
||||
libc = "0.2.62"
|
||||
nix = "0.15.0"
|
||||
num-rug-adapter = { optional = true, version = "0.1.3" }
|
||||
ordered-float = "0.5.0"
|
||||
prolog_parser = "0.8.33"
|
||||
prolog_parser = { version = "0.8.59", default-features = false }
|
||||
ref_thread_local = "0.0.0"
|
||||
rug = "1.4.0"
|
||||
rustyline = "5.0.3"
|
||||
|
||||
[dependencies.termion]
|
||||
version = "1.4.0"
|
||||
rug = { version = "1.4.0", optional = true }
|
||||
rustyline = "6.0.0"
|
||||
unicode_reader = "1.0.0"
|
||||
ring = "0.16.13"
|
||||
ripemd160 = "0.8.0"
|
||||
sha3 = "0.8.2"
|
||||
blake2 = "0.8.1"
|
||||
|
||||
30
Dockerfile
Executable file
30
Dockerfile
Executable file
@@ -0,0 +1,30 @@
|
||||
# Based on https://hub.docker.com/_/rust?tab=description and https://blog.sedrik.se/posts/my-docker-setup-for-rust/
|
||||
|
||||
# The first container is for build purposes only.
|
||||
FROM rust as builder
|
||||
|
||||
WORKDIR /usr/src/scryer-prolog
|
||||
|
||||
# Using a dummy build.rs and src/main.rs with your Cargo.toml lets Docker cache your Rust dependencies and not rebuild
|
||||
# them every time.
|
||||
COPY Cargo.toml .
|
||||
COPY Cargo.lock .
|
||||
RUN mkdir -p src
|
||||
RUN echo "fn main() {}" > src/main.rs
|
||||
RUN echo "fn main() {}" > build.rs
|
||||
RUN cargo build --release
|
||||
|
||||
# We need to touch our real main.rs and build.rs files or else
|
||||
# docker will use the cached ones.
|
||||
COPY . .
|
||||
RUN touch src/main.rs
|
||||
RUN touch build.rs
|
||||
|
||||
RUN cargo build --release
|
||||
|
||||
RUN ls ./target/release
|
||||
|
||||
# Finally, copy the scryer-prolog executable to a slimmer container.
|
||||
FROM debian:buster-slim
|
||||
COPY --from=builder /usr/src/scryer-prolog/target/release/scryer-prolog /usr/local/bin/scryer-prolog
|
||||
CMD ["scryer-prolog"]
|
||||
498
README.md
498
README.md
@@ -30,10 +30,8 @@ Extend Scryer Prolog to include the following, among other features:
|
||||
- [x] Built-in predicates for list processing and top-level declarative
|
||||
control (`setup_call_cleanup/3`, `call_with_inference_limit/3`,
|
||||
etc.)
|
||||
- [x] Default representation of strings as list of chars, using a packed
|
||||
internal representation.
|
||||
- A representation of 'partial strings' as difference lists
|
||||
of characters.
|
||||
- [x] ~~Default representation of strings as lists of characters, using a packed
|
||||
internal representation.~~
|
||||
- [x] `term_expansion/2` and `goal_expansion/2`.
|
||||
- [x] Definite Clause Grammars.
|
||||
- [x] Attributed variables using the SICStus Prolog interface and
|
||||
@@ -42,7 +40,7 @@ Extend Scryer Prolog to include the following, among other features:
|
||||
- [x] Support for `verify_attributes/3`
|
||||
- [x] Support for `attribute_goals/2` and `project_attributes/2`
|
||||
- [x] `call_residue_vars/2`
|
||||
- [x] `if_` and related predicates, following the developments of the
|
||||
- [x] `if_/3` and related predicates, following the developments of the
|
||||
paper "Indexing `dif/2`".
|
||||
- [x] All-solutions predicates (`findall/{3,4}`, `bagof/3`, `setof/3`, `forall/2`).
|
||||
- [x] Clause creation and destruction (`asserta/1`, `assertz/1`,
|
||||
@@ -50,11 +48,20 @@ Extend Scryer Prolog to include the following, among other features:
|
||||
- [x] Backtrackable and non-backtrackable global variables via `bb_get/2`
|
||||
`bb_put/2` (non-backtrackable) and `bb_b_put/2`
|
||||
(backtrackable).
|
||||
- [ ] Streams and predicates for stream control (_in progress_).
|
||||
- [ ] An incremental compacting garbage collector satisfying the five
|
||||
- [x] Delimited continuations based on reset/3, shift/1 (documented in
|
||||
"Delimited Continuations for Prolog").
|
||||
- [x] Tabling library based on delimited continuations
|
||||
(documented in "Tabling as a Library with Delimited Control").
|
||||
- [x] A _redone_ representation of strings as difference lists of
|
||||
characters, using a packed internal representation.
|
||||
- [x] clp(B) and clp(ℤ) as builtin libraries.
|
||||
- [x] Streams and predicates for stream control.
|
||||
- [x] A simple sockets library representing TCP connections as streams.
|
||||
- [ ] Incremental compilation and loading process, newly written,
|
||||
primarily in Prolog. (_in progress_)
|
||||
- [ ] A compacting garbage collector satisfying the five
|
||||
properties of "Precise Garbage Collection in Prolog."
|
||||
- [ ] Mode declarations.
|
||||
- [ ] Extensions for clp(FD).
|
||||
|
||||
## Phase 3
|
||||
|
||||
@@ -79,218 +86,127 @@ Programming?"
|
||||
unum implementation or an ad hoc one. Unums are described in
|
||||
Gustafson's book "The End of Error."
|
||||
|
||||
3. Add support for shift/reset delimited continuations, see "Delimited
|
||||
Continuations for Prolog."
|
||||
|
||||
4. Add concurrent tables to manage shared references to atoms and
|
||||
3. Add concurrent tables to manage shared references to atoms and
|
||||
strings.
|
||||
|
||||
5. Add optional SLG resolution for fast memoization of predicates.
|
||||
|
||||
6. Add some form of JIT predicate indexing.
|
||||
4. Add some form of JIT predicate indexing.
|
||||
|
||||
## Installing Scryer Prolog
|
||||
|
||||
### Native Install (Unix Only)
|
||||
|
||||
First, install the latest stable version of
|
||||
[Rust](https://www.rust-lang.org/en-US/install.html) using your
|
||||
preferred method. Then install the latest Scryer Prolog with cargo,
|
||||
like so:
|
||||
preferred method. Scryer tends to use features from newer Rust
|
||||
releases, whereas Rust packages in Linux distributions, Macports,
|
||||
etc. tend to lag behind. [rustup](http://rustup.rs) will keep your
|
||||
Rust updated to the latest stable release; any existing Rust
|
||||
distribution should be uninstalled from your system before rustup is
|
||||
used.
|
||||
|
||||
Scryer Prolog can be installed with cargo, like so:
|
||||
|
||||
```
|
||||
$> cargo install scryer-prolog
|
||||
```
|
||||
|
||||
cargo will download and install the libraries Scryer Prolog uses
|
||||
automatically. You can find the `scryer-prolog` executable in
|
||||
`~/.cargo/bin`.
|
||||
automatically from crates.io. You can find the `scryer-prolog`
|
||||
executable in `~/.cargo/bin`.
|
||||
|
||||
Note on compatibility: Scryer Prolog should work on Linux, Mac OS X,
|
||||
and BSD variants on which Rust runs. Windows support hinges on
|
||||
rustyline and Termion being functional in that environment, which to
|
||||
my knowledge is not currently the case.
|
||||
Publishing Rust crates to crates.io and pushing to git are entirely
|
||||
distinct, independent processes, so to be sure you have the latest
|
||||
commit, it is recommended to clone directly from this git repository,
|
||||
which can be done as follows:
|
||||
|
||||
## Built-in predicates
|
||||
```
|
||||
$> git clone https://github.com/mthom/scryer-prolog
|
||||
$> cd scryer-prolog
|
||||
$> cargo run [--release]
|
||||
```
|
||||
|
||||
The following predicates are built-in to Scryer.
|
||||
The optional `--release` flag will perform various optimizations,
|
||||
producing a faster executable.
|
||||
|
||||
* Arithmetic support:
|
||||
* `is/2` works for `(+)/{1,2}`, `(-)/{1,2}`, `(*)/2`, `(//)/2`, `(**)/2`,
|
||||
`(^)/2`, `(div)/2`, `(/)/2`, `(rdiv)/2`, `(xor)/2`, `(rem)/2`,
|
||||
`(mod)/2`, `(/\)/2`, `(\/)/2`, `(>>)/2`,`(<<)/2`, `(\)/1`,
|
||||
`abs/1`, `sin/1`, `cos/1`, `tan/1`, `asin/1`, `acos/1`,
|
||||
`atan/1`, `atan2/2`, `log/1`, `exp/1`, `sqrt/1`, `float/1`,
|
||||
`truncate/1`, `round/1`, `floor/1`, `ceiling/1`, `pi/0`,
|
||||
`min/1`, `max/1`
|
||||
* Comparison operators: `>`, `<`, `=<`, `>=`, `=:=`, `=\=`.
|
||||
* `(:)/2`
|
||||
* `(@>)/2`
|
||||
* `(@>=)/2`
|
||||
* `(@=<)/2`
|
||||
* `(@<)/2`
|
||||
* `(\+)/1`
|
||||
* `(==)/2`
|
||||
* `(\==)/2`
|
||||
* `(=)/2`
|
||||
* `(\=)/2`
|
||||
* `(=..)/2`
|
||||
* `(->)/2`
|
||||
* `(;)/2`
|
||||
* `abolish/1`
|
||||
* `acyclic_term/2`
|
||||
* `append/3`
|
||||
* `arg/3`
|
||||
* `asserta/1`
|
||||
* `assertz/1`
|
||||
* `atom/1`
|
||||
* `atomic/1`
|
||||
* `atom_chars/2`
|
||||
* `atom_codes/2`
|
||||
* `atom_concat/3`
|
||||
* `atom_length/2`
|
||||
* `bagof/3`
|
||||
* `bb_b_put/2`
|
||||
* `bb_get/2`
|
||||
* `bb_put/2`
|
||||
* `between/3`
|
||||
* `call/1..62`
|
||||
* `call_cleanup/2`
|
||||
* `call_with_inference_limit/3`
|
||||
* `call_residue_vars/2`
|
||||
* `can_be/2`
|
||||
* `catch/3`
|
||||
* `clause/2`
|
||||
* `compare/3`
|
||||
* `compound/1`
|
||||
* `copy_term/2`
|
||||
* `current_predicate/1`
|
||||
* `current_op/3`
|
||||
* `cyclic_term/1`
|
||||
* `dif/2`
|
||||
* `expand_goal/2`
|
||||
* `expand_term/2`
|
||||
* `fail/0`
|
||||
* `false/0`
|
||||
* `findall/{3,4}`
|
||||
* `float/1`
|
||||
* `forall/2`
|
||||
* `freeze/2`
|
||||
* `functor/3`
|
||||
* `gen_int/1`
|
||||
* `gen_nat/1`
|
||||
* `get_char/1`
|
||||
* `goal_expansion/2`
|
||||
* `ground/1`
|
||||
* `halt/0`
|
||||
* `integer/1`
|
||||
* `is_list/1`
|
||||
* `is_partial_string/1`
|
||||
* `keysort/2`
|
||||
* `length/2`
|
||||
* `maplist/2..9`
|
||||
* `member/2`
|
||||
* `memberchk/2`
|
||||
* `must_be/2`
|
||||
* `nl/0`
|
||||
* `nonvar/1`
|
||||
* `number_chars/2`
|
||||
* `number_codes/2`
|
||||
* `numbervars/2`
|
||||
* `numlist/{2,3}`
|
||||
* `once/1`
|
||||
* `op/3`
|
||||
* `partial_string/2`
|
||||
* `phrase/{2,3}`
|
||||
* `rational/1`
|
||||
* `read/1`
|
||||
* `repeat/{0,1}`
|
||||
* `retract/1`
|
||||
* `reverse/2`
|
||||
* `select/3`
|
||||
* `setof/3`
|
||||
* `setup_call_cleanup/3`
|
||||
* `sort/2`
|
||||
* `string/1`
|
||||
* `sub_atom/5`
|
||||
* `subsumes_term/2`
|
||||
* `term_expansion/2`
|
||||
* `term_variables/2`
|
||||
* `throw/1`
|
||||
* `true/0`
|
||||
* `unify_with_occurs_check/2`
|
||||
* `use_module/{1,2}`
|
||||
* `user:goal_expansion/2`
|
||||
* `user:term_expansion/2`
|
||||
* `var/1`
|
||||
* `variant/2`
|
||||
* `wam_instructions/2`
|
||||
* `write/1`
|
||||
* `write_canonical/1`
|
||||
* `writeq/1`
|
||||
* `write_term/2`
|
||||
### Docker Install (All Platforms)
|
||||
|
||||
First, install [Docker](https://docs.docker.com/get-docker/) on Linux,
|
||||
Windows, or Mac.
|
||||
|
||||
Once Docker is installed, you can download and run Scryer Prolog with a single
|
||||
command:
|
||||
```
|
||||
$> docker run -it mjt128/scryer-prolog
|
||||
```
|
||||
|
||||
To consult your Prolog files, bind mount your programs folder as a
|
||||
[Docker volume](https://docs.docker.com/storage/volumes/):
|
||||
|
||||
```
|
||||
$> docker run -v /home/user/prolog:/mnt -it mjt128/scryer-prolog
|
||||
?- consult('/mnt/program.pl').
|
||||
true.
|
||||
```
|
||||
|
||||
This works on Windows too:
|
||||
|
||||
```
|
||||
$> docker run -v C:\Users\user\Documents\prolog:/mnt -it mjt128/scryer-prolog
|
||||
?- consult('/mnt/program.pl').
|
||||
true.
|
||||
```
|
||||
|
||||
## Tutorial
|
||||
To enter a multi-clause predicate, the directive "[user]" is used.
|
||||
|
||||
For example,
|
||||
```
|
||||
?- [user].
|
||||
(type Enter + Ctrl-D to terminate the stream when finished)
|
||||
p(f(f(X)), h(W), Y) :- g(W), h(W), f(X).
|
||||
p(X, Y, Z) :- h(Y), z(Z).
|
||||
?- [user].
|
||||
(type Enter + Ctrl-D to terminate the stream when finished)
|
||||
h(x). h(y).
|
||||
h(z).
|
||||
```
|
||||
In the example, `Enter + Ctrl-D` is used to terminate the standard
|
||||
input stream. The instructive message is always printed.
|
||||
Prolog files are loaded by specifying them as arguments on the command
|
||||
line. For example, to load `program.pl`, use:
|
||||
|
||||
Queries are issued as
|
||||
```
|
||||
?- p(X, Y, Z).
|
||||
$> scryer-prolog program.pl
|
||||
```
|
||||
|
||||
Pressing `SPACE` will backtrack through other possible answers, if any exist.
|
||||
Pressing `.` will abort the search and return to the prompt.
|
||||
Loading a Prolog file is also called “consulting” it. The built-in
|
||||
predicate `consult/1` can be used to consult a file from within
|
||||
Prolog:
|
||||
|
||||
Wildcards work as well:
|
||||
```
|
||||
?- consult('program.pl').
|
||||
```
|
||||
|
||||
As an abbreviation for `consult/1`, you can specify a *list* of
|
||||
program files, given as *atoms*:
|
||||
|
||||
```
|
||||
?- ['program.pl'].
|
||||
```
|
||||
|
||||
The special notation `[user]` is used to read Prolog text from
|
||||
standard input. For example,
|
||||
|
||||
```
|
||||
?- [user].
|
||||
(type Enter + Ctrl-D to terminate the stream when finished)
|
||||
member(X, [X|_]).
|
||||
member(X, [_|Xs]) :- member(X, Xs).
|
||||
?- member(X, [a, b, c]).
|
||||
true .
|
||||
X = a ;
|
||||
X = b ;
|
||||
X = c ;
|
||||
false.
|
||||
```
|
||||
and so do conjunctive queries:
|
||||
```
|
||||
?- [user].
|
||||
(type Enter + Ctrl-D to terminate the stream when finished)
|
||||
f(X) :- g(X).
|
||||
g(x). g(y). g(z).
|
||||
h(call(f, X)).
|
||||
?- h(X), X.
|
||||
true .
|
||||
X = call(f, x) ;
|
||||
X = call(f, y) ;
|
||||
X = call(f, z).
|
||||
hello(declarative_world).
|
||||
hello(pure_world).
|
||||
```
|
||||
|
||||
Note that the values of variables belonging to successful queries are
|
||||
printed out, on one line each. Uninstantiated variables are denoted by
|
||||
a number preceded by an underscore (`X = _0` in an example above).
|
||||
Pressing `RETURN` followed by `Ctrl-d` stops reading from
|
||||
standard input and consults the entered Prolog text.
|
||||
|
||||
After a program is consulted, you can ask *queries* about the
|
||||
predicates it defines. For example, with the program shown above:
|
||||
|
||||
To clear the database, type
|
||||
```
|
||||
?- [clear].
|
||||
?- hello(What).
|
||||
What = declarative_world
|
||||
; What = pure_world.
|
||||
```
|
||||
|
||||
To quit scryer-prolog, type
|
||||
Press `SPACE` to show further answers, if any exist. Press `RETURN` or
|
||||
`.` to abort the search and return to the toplevel prompt.
|
||||
Press `h` to show a help message.
|
||||
|
||||
To quit Scryer Prolog, use the standard predicate `halt/0`:
|
||||
|
||||
```
|
||||
?- halt.
|
||||
```
|
||||
@@ -301,42 +217,209 @@ Scryer supports dynamic operators. Using the built-in
|
||||
arithmetic operators with the usual precedences,
|
||||
|
||||
```
|
||||
?- write_canonical(-5 + 3 - (2 * 4) // 8).
|
||||
-(+(-(5), 3), //(*(2, 4), 8))
|
||||
true.
|
||||
?- write_canonical(-5 + 3 - (2 * 4) // 8), nl.
|
||||
-(+(-5,3),//(*(2,4),8))
|
||||
true.
|
||||
```
|
||||
|
||||
New operators can be defined using the `op` declaration.
|
||||
|
||||
### Partial strings
|
||||
### Strings and partial strings
|
||||
|
||||
Scryer has two specialized, non-ISO builtin predicates for handling
|
||||
so-called "partial strings". Partial strings imitate difference lists
|
||||
of characters, but are much more space efficient. This efficiency
|
||||
comes at the cost of full generality -- you cannot unify the tail
|
||||
variables of two distinct partial strings, because their buffers will
|
||||
always be distinct.
|
||||
In Scryer Prolog, the default value of the Prolog flag `double_quotes`
|
||||
is `chars`, which is also the recommended setting. This means that
|
||||
double-quoted strings are interpreted as lists of *characters*, in the
|
||||
tradition of Marseille Prolog.
|
||||
|
||||
If `X` is a free variable, the query
|
||||
For example, the following query succeeds:
|
||||
|
||||
`?- partial_string("abc", X), X = [a, b, c | Y], is_partial_string(X),
|
||||
is_partial_string(Y).`
|
||||
```
|
||||
?- "abc" = [a,b,c].
|
||||
true.
|
||||
```
|
||||
|
||||
will succeed. Further, if `Y` a free variable, unifying `Y` against
|
||||
another string, "def" in this case, produces the equations
|
||||
Internally, strings are represented very compactly in packed
|
||||
UTF-8 encoding. A naive representation of strings as lists of
|
||||
characters would use one memory cell per character, one
|
||||
memory cell per list constructor, and one memory cell for
|
||||
each tail that occurs in the list. Since one memory cell takes
|
||||
8 bytes on 64-bit machines, the packed representation used by
|
||||
Scryer Prolog yields an up to **24-fold reduction** of
|
||||
memory usage, and corresponding reduction of memory accesses when
|
||||
creating and processing strings.
|
||||
|
||||
`X = [a, b, c, d, e, f], Y = [d, e, f].`
|
||||
Scryer Prolog uses the same efficient encoding for *partial* strings,
|
||||
which appear to Prolog code as partial lists of characters. The
|
||||
predicate `partial_string/3` from `library(iso_ext)` lets you
|
||||
construct partial strings explicitly. For example:
|
||||
|
||||
```
|
||||
?- partial_string("abc", Ls0, Ls).
|
||||
Ls0 = [a,b,c|Ls].
|
||||
```
|
||||
|
||||
In this case, and as the answer illustrates, `Ls0` is
|
||||
indistinguishable from a partial list with tail `Ls`, while
|
||||
the efficient packed representation is used internally.
|
||||
|
||||
An important design goal of Scryer Prolog is to *automatically* use
|
||||
the efficient string representation whenever possible. Therefore, it
|
||||
is only very rarely necessary to use `partial_string/3` explicitly. In
|
||||
the above example, posting <tt>Ls0 = [a,b,c|Ls]</tt> yields
|
||||
the exact same internal representation, and has the advantage that
|
||||
only the standard predicate `(=)/2` is used.
|
||||
|
||||
Definite clause grammars as provided by `library(dcgs)` are ideally
|
||||
suited for reasoning about strings.
|
||||
|
||||
### Tabling (SLG resolution)
|
||||
|
||||
One of the foremost attractions of Prolog is that logical consequences
|
||||
of pure programs can be derived by various execution strategies
|
||||
that differ regarding essential properties such as termination,
|
||||
completeness and efficiency.
|
||||
|
||||
The default execution strategy of Prolog is depth-first search with
|
||||
chronological backtracking. This strategy is very efficient. Its main
|
||||
drawback is that it is *incomplete*: It may fail to find any solution
|
||||
even if one exists.
|
||||
|
||||
Scryer Prolog supports an alternative execution strategy which is
|
||||
called *tabling* and also known as tabled execution and
|
||||
SLG resolution. To enable tabled execution for a predicate, use
|
||||
[`library(tabling)`](src/prolog/lib/tabling.pl) and add a `(table)/1`
|
||||
directive for the desired predicate indicator. For example, if we
|
||||
write:
|
||||
|
||||
```
|
||||
:- use_module(library(tabling)).
|
||||
:- table a/0.
|
||||
|
||||
a :- a.
|
||||
```
|
||||
|
||||
Then the query `?- a.` *terminates* (and fails), whereas it
|
||||
does not terminate with the default execution strategy.
|
||||
|
||||
Scryer Prolog implements tabling via *delimited continuations* as
|
||||
described in [*Tabling as a Library with Delimited
|
||||
Control*](https://biblio.ugent.be/publication/6880648/file/6885145.pdf)
|
||||
by Desouter et. al.
|
||||
|
||||
### Constraint Logic Programming (CLP)
|
||||
|
||||
Scryer Prolog provides excellent support for Constraint Logic
|
||||
Programming (CLP), which is the amalgamation of
|
||||
Logic Programming (LP) and Constraints.
|
||||
|
||||
In addition to built-in support for [`dif/2`](src/prolog/lib/dif.pl),
|
||||
[`freeze/2`](src/prolog/lib/freeze.pl),
|
||||
[CLP(B)](src/prolog/lib/clpb.pl) and [CLP(ℤ)](src/prolog/lib/clpz.pl),
|
||||
Scryer provides a convenient way to implement new user-defined
|
||||
constraints: *Attributed variables* are available via
|
||||
[`library(atts)`](src/prolog/lib/atts.pl) as in SICStus Prolog,
|
||||
which is one of the most sophisticated and fastest constraint systems
|
||||
in existence. In [`library(iso_ext)`](src/prolog/lib/iso_ext.pl),
|
||||
Scryer provides predicates for backtrackable (`bb_b_put/2`) and
|
||||
non-backtrackable (`bb_put/2`) global variables, which are needed to
|
||||
implement certain types of constraint solvers.
|
||||
|
||||
These features make Scryer Prolog an ideal platform for teaching,
|
||||
learning and developing portable CLP applications.
|
||||
|
||||
### Modules
|
||||
|
||||
Scryer has a simple predicate-based module system. It provides a
|
||||
way to separate units of code into distinct namespaces, for both
|
||||
predicates and operators. See the files `src/prolog/lib/*.pl` for
|
||||
predicates and operators. See the files
|
||||
[`src/prolog/lib/*.pl`](src/prolog/lib) for
|
||||
examples.
|
||||
|
||||
At the time of this writing, several control and list processing
|
||||
operators and predicates are hidden in their own modules that have not
|
||||
been exported to the toplevel. To export them, write
|
||||
At the time of this writing, many predicates reside in their own
|
||||
modules that need to be imported before they can be used.
|
||||
The modules that ship with Scryer Prolog are also called
|
||||
*library* modules or *libraries*, and include:
|
||||
|
||||
* [`lists`](src/prolog/lib/lists.pl)
|
||||
providing `length/2`, `member/2`, `select/3`, `append/[2,3]`,
|
||||
`foldl/[4,5]`, `maplist/[2-9]`, `same_length/2`, `transpose/2` etc.
|
||||
* [`dcgs`](src/prolog/lib/dcgs.pl)
|
||||
Definite Clause Grammars (DCGs), a built-in grammar mechanism
|
||||
that uses the operator `(-->)/2` to define grammar rules,
|
||||
and the predicates `phrase/[2,3]` to invoke them.
|
||||
* [`dif`](src/prolog/lib/dif.pl)
|
||||
The predicate `dif/2` provides declarative disequality:
|
||||
It is true if and only if its arguments are different, and
|
||||
delays the test until a sound decision can be made.
|
||||
* [`reif`](src/prolog/lib/reif.pl)
|
||||
providing `if_/3`, `tfilter/3` and related predicates
|
||||
as described in *Indexing dif/2*.
|
||||
* [`clpz`](src/prolog/lib/clpz.pl)
|
||||
CLP(ℤ): Constraint Logic Programming over Integers,
|
||||
providing declarative integer arithmetic via `(#=)/2`, `(#\=)/2`,
|
||||
`(#>=)/2` etc., and various global constraints and
|
||||
enumeration predicates for solving combinatorial tasks.
|
||||
* [`pairs`](src/prolog/lib/pairs.pl)
|
||||
By convention, *pairs* are Prolog terms with
|
||||
principal functor `(-)/2`, written as `Key-Value`.
|
||||
This library provides `pairs_keys_values/3`,
|
||||
`pairs_keys/2`, and other predicates to reason about pairs.
|
||||
* [`si`](src/prolog/lib/si.pl)
|
||||
The predicates `atom_si/1`, `integer_si/1`, `atomic_si/1`
|
||||
and `list_si/1` implement sound type checks. They raise
|
||||
instantiation errors if no decision can be made.
|
||||
They are declarative replacements for logically flawed
|
||||
lower-level type tests. For instance, instead of `integer(X)`,
|
||||
write `integer_si(X)` to ensure soundness of your programs.
|
||||
"si" stands for *sufficiently instantiated*, and also for
|
||||
*sound inference*.
|
||||
* [`error`](src/prolog/lib/error.pl)
|
||||
`must_be/2` and `can_be/2` complement the type checks provided
|
||||
by `library(si)`, and are especially useful for Prolog library
|
||||
authors.
|
||||
* [`tabling`](src/prolog/lib/tabling.pl)
|
||||
The operator `(table)/1` is used in directives that prepare
|
||||
predicates for tabled execution (SLG resolution).
|
||||
* [`format`](src/prolog/lib/format.pl)
|
||||
The nonterminal `format_//2` is used to describe formatted output,
|
||||
arranging arguments according to a given format string.
|
||||
The predicates `format/[2,3]`, `portray_clause/1` and `listing/1`
|
||||
provide formatted *impure* output.
|
||||
* [`assoc`](src/prolog/lib/assoc.pl)
|
||||
providing `empty_assoc/1`, `get_assoc/3`, `put_assoc/4` etc.
|
||||
to manage elements in AVL trees which ensure
|
||||
*O*(log(*N*)) access.
|
||||
* [`ordsets`](src/prolog/lib/ordsets.pl)
|
||||
represents ordered sets as lists.
|
||||
* [`clpb`](src/prolog/lib/clpb.pl)
|
||||
CLP(B): Constraint Logic Programming over Boolean variables,
|
||||
a BDD-based SAT solver provided via the predicates
|
||||
`sat/1`, `taut/2`, `labeling/1` etc.
|
||||
* [`arithmetic`](src/prolog/lib/arithmetic.pl)
|
||||
Arithmetic predicates such as `lsb/2`, `msb/2` and
|
||||
`number_to_rational/2`.
|
||||
* [`time`](src/prolog/lib/time.pl)
|
||||
`time/1` reports the CPU time of a goal. It is useful
|
||||
for measuring the performance of your code.
|
||||
* [`cont`](src/prolog/lib/cont.pl)
|
||||
Provides *delimited continuations* via `reset/3` and `shift/1`.
|
||||
* [`random`](src/prolog/lib/random.pl)
|
||||
Probabilistic predicates and random number generators.
|
||||
* [`sockets`](src/prolog/lib/sockets.pl)
|
||||
Predicates for opening and accepting TCP connections as streams.
|
||||
* [`crypto`](src/prolog/lib/crypto.pl)
|
||||
Cryptographically secure random numbers and hashes, HMAC-based
|
||||
key derivation (HKDF), password-based key derivation (PBKDF2),
|
||||
public key signatures and signature verification with Ed25519,
|
||||
authenticated encryption, and reasoning about elliptic curves.
|
||||
|
||||
To read contents of external files, use `phrase_from_file/2` from
|
||||
[`library(pio)`](src/prolog/lib/pio.pl) to apply a DCG to
|
||||
file contents. The predicates in
|
||||
[`library(charsio)`](src/prolog/lib/charsio.pl) are also useful for
|
||||
parsing.
|
||||
|
||||
To use predicates provided by the `lists` library, write:
|
||||
|
||||
```
|
||||
?- use_module(library(lists)).
|
||||
@@ -371,7 +454,6 @@ REPL:
|
||||
|
||||
```
|
||||
?- [user].
|
||||
(type Enter + Ctrl-D to terminate the stream when finished)
|
||||
:- module(test, [local_member/2]).
|
||||
:- use_module(library(lists)).
|
||||
|
||||
@@ -379,4 +461,4 @@ local_member(X, Xs) :- member(X, Xs).
|
||||
```
|
||||
|
||||
The user listing can also be terminated by placing `end_of_file.` at
|
||||
the end of the stream.
|
||||
the end of the stream.
|
||||
|
||||
6
build.rs
6
build.rs
@@ -52,5 +52,9 @@ fn main()
|
||||
}
|
||||
|
||||
libraries.write_all(b"\n\n m\n };
|
||||
}").unwrap();
|
||||
}\n").unwrap();
|
||||
|
||||
libraries.write_all(b"\npub static PROJECT_DIR: &'static str = \"").unwrap();
|
||||
libraries.write_all(env::var("CARGO_MANIFEST_DIR").unwrap().as_bytes()).unwrap();
|
||||
libraries.write_all(b"\";\n").unwrap();
|
||||
}
|
||||
|
||||
@@ -1,51 +0,0 @@
|
||||
use std::cell::{Cell};
|
||||
use std::vec::{Vec};
|
||||
|
||||
pub type Var = String;
|
||||
|
||||
pub type Atom = String;
|
||||
|
||||
#[derive(Debug)]
|
||||
pub enum TopLevel {
|
||||
Fact(Term),
|
||||
Query(Term)
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub enum Term {
|
||||
Atom(Cell<usize>, Atom),
|
||||
Clause(Cell<usize>, Atom, Vec<Box<Term>>),
|
||||
Var(Cell<usize>, Var)
|
||||
}
|
||||
|
||||
pub enum FactInstruction {
|
||||
GetStructure(Atom, usize, usize),
|
||||
UnifyVariable(usize),
|
||||
UnifyValue(usize)
|
||||
}
|
||||
|
||||
pub enum QueryInstruction {
|
||||
PutStructure(Atom, usize, usize),
|
||||
SetVariable(usize),
|
||||
SetValue(usize),
|
||||
}
|
||||
|
||||
pub type CompiledFact = Vec<FactInstruction>;
|
||||
|
||||
pub type CompiledQuery = Vec<QueryInstruction>;
|
||||
|
||||
#[derive(Clone, Copy, PartialEq)]
|
||||
pub enum Addr {
|
||||
HeapCell(usize),
|
||||
RegNum(usize)
|
||||
}
|
||||
|
||||
impl Term {
|
||||
pub fn set_cell(&self, cell_num: usize) {
|
||||
match self {
|
||||
&Term::Atom(ref cell, _) => cell.set(cell_num),
|
||||
&Term::Clause(ref cell, _, _) => cell.set(cell_num),
|
||||
&Term::Var(ref cell, _) => cell.set(cell_num)
|
||||
};
|
||||
}
|
||||
}
|
||||
@@ -1,126 +0,0 @@
|
||||
use l0::ast::{Atom, Term, FactInstruction, QueryInstruction, Var};
|
||||
use l0::iterators::{BreadthFirstIterator, PostOrderIterator};
|
||||
|
||||
use std::collections::{HashSet};
|
||||
use std::fmt;
|
||||
use std::vec::{Vec};
|
||||
|
||||
impl fmt::Display for QueryInstruction {
|
||||
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
|
||||
match self {
|
||||
&QueryInstruction::PutStructure(ref a, ref s, ref r) =>
|
||||
write!(f, "put_structure {}/{}, X{}", a, s, r),
|
||||
&QueryInstruction::SetVariable(ref r) =>
|
||||
write!(f, "set_variable X{}", r),
|
||||
&QueryInstruction::SetValue(ref r) =>
|
||||
write!(f, "set_value X{}", r),
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl fmt::Display for FactInstruction {
|
||||
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
|
||||
match self {
|
||||
&FactInstruction::GetStructure(ref a, ref s, ref r) =>
|
||||
write!(f, "get_structure {}/{}, X{}", a, s, r),
|
||||
&FactInstruction::UnifyVariable(ref r) =>
|
||||
write!(f, "unify_variable X{}", r),
|
||||
&FactInstruction::UnifyValue(ref r) =>
|
||||
write!(f, "unify_value X{}", r)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub trait CompilationTarget<'a> {
|
||||
type Iterator : Iterator<Item=&'a Term>;
|
||||
|
||||
fn iter(term: &'a Term) -> Self::Iterator;
|
||||
|
||||
fn to_structure(name: Atom, arity: usize, cell_num: usize) -> Self;
|
||||
fn to_value(cell_num: usize) -> Self;
|
||||
fn to_variable(cell_num: usize) -> Self;
|
||||
}
|
||||
|
||||
impl<'a> CompilationTarget<'a> for FactInstruction {
|
||||
type Iterator = BreadthFirstIterator<'a>;
|
||||
|
||||
fn iter(term: &'a Term) -> Self::Iterator {
|
||||
term.breadth_first_iter()
|
||||
}
|
||||
|
||||
fn to_structure(name: Atom, arity: usize, cell_num: usize) -> Self {
|
||||
FactInstruction::GetStructure(name, arity, cell_num)
|
||||
}
|
||||
|
||||
fn to_value(cell_num: usize) -> Self {
|
||||
FactInstruction::UnifyValue(cell_num)
|
||||
}
|
||||
|
||||
fn to_variable(cell_num: usize) -> Self {
|
||||
FactInstruction::UnifyVariable(cell_num)
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> CompilationTarget<'a> for QueryInstruction {
|
||||
type Iterator = PostOrderIterator<'a>;
|
||||
|
||||
fn iter(term: &'a Term) -> Self::Iterator {
|
||||
term.post_order_iter()
|
||||
}
|
||||
|
||||
fn to_structure(name: Atom, arity: usize, cell_num: usize) -> Self {
|
||||
QueryInstruction::PutStructure(name, arity, cell_num)
|
||||
}
|
||||
|
||||
fn to_value(cell_num: usize) -> Self {
|
||||
QueryInstruction::SetValue(cell_num)
|
||||
}
|
||||
|
||||
fn to_variable(cell_num: usize) -> Self {
|
||||
QueryInstruction::SetVariable(cell_num)
|
||||
}
|
||||
}
|
||||
|
||||
fn subterm_to_instr<'a, Target>(subterm: &'a Term,
|
||||
bindings: &mut HashSet<&'a Var>)
|
||||
-> Target
|
||||
where Target: CompilationTarget<'a>
|
||||
{
|
||||
match subterm {
|
||||
&Term::Atom(ref cell_num, _) =>
|
||||
Target::to_value(cell_num.get()),
|
||||
&Term::Var(ref cell_num, ref atom) if bindings.contains(atom) =>
|
||||
Target::to_value(cell_num.get()),
|
||||
&Term::Var(ref cell_num, ref atom) => {
|
||||
bindings.insert(atom);
|
||||
Target::to_variable(cell_num.get())
|
||||
},
|
||||
&Term::Clause(ref cell_num, _, _) =>
|
||||
Target::to_value(cell_num.get())
|
||||
}
|
||||
}
|
||||
|
||||
pub fn compile_target<'a, Target>(term: &'a Term) -> Vec<Target>
|
||||
where Target: CompilationTarget<'a>
|
||||
{
|
||||
let mut iter = Target::iter(term);
|
||||
let mut target = Vec::<Target>::new();
|
||||
let mut bindings = HashSet::new();
|
||||
|
||||
while let Some(term) = iter.next() {
|
||||
match term {
|
||||
&Term::Atom(ref cell_num, ref atom) =>
|
||||
target.push(Target::to_structure(atom.clone(), 0, cell_num.get())),
|
||||
&Term::Clause(ref cell_num, ref atom, ref terms) => {
|
||||
target.push(Target::to_structure(atom.clone(), 0, cell_num.get()));
|
||||
|
||||
for subterm in terms {
|
||||
target.push(subterm_to_instr(subterm.as_ref(), &mut bindings));
|
||||
}
|
||||
},
|
||||
_ => {},
|
||||
};
|
||||
}
|
||||
|
||||
target
|
||||
}
|
||||
@@ -1,98 +0,0 @@
|
||||
use l0::ast::{Term};
|
||||
|
||||
use std::collections::{VecDeque};
|
||||
use std::vec::{Vec};
|
||||
|
||||
enum DepthFirstIteratorState<'a> {
|
||||
// child no., the containing clause, its vector.
|
||||
Clause(usize, &'a Term, &'a Vec<Box<Term>>),
|
||||
NonClause(&'a Term)
|
||||
}
|
||||
|
||||
pub struct PostOrderIterator<'a> {
|
||||
state_stack: Vec<DepthFirstIteratorState<'a>>
|
||||
}
|
||||
|
||||
impl<'a> PostOrderIterator<'a> {
|
||||
fn push_clause(&mut self,
|
||||
child_num: usize,
|
||||
term: &'a Term,
|
||||
child_terms: &'a Vec<Box<Term>>)
|
||||
{
|
||||
self.state_stack.push(DepthFirstIteratorState::Clause(child_num,
|
||||
term,
|
||||
child_terms));
|
||||
}
|
||||
|
||||
fn render_new_state(term: &'a Term) -> DepthFirstIteratorState<'a> {
|
||||
match term {
|
||||
&Term::Clause(_, _, ref child_terms) =>
|
||||
DepthFirstIteratorState::Clause(0, term, child_terms),
|
||||
_ => DepthFirstIteratorState::NonClause(term)
|
||||
}
|
||||
}
|
||||
|
||||
fn push_term(&mut self, term: &'a Term) {
|
||||
self.state_stack.push(Self::render_new_state(term));
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> Iterator for PostOrderIterator<'a> {
|
||||
type Item = &'a Term;
|
||||
|
||||
fn next(&mut self) -> Option<Self::Item> {
|
||||
while let Some(iter_state) = self.state_stack.pop() {
|
||||
match iter_state {
|
||||
DepthFirstIteratorState::Clause(child_num, term, child_terms) => {
|
||||
if child_num == child_terms.len() {
|
||||
return Some(term);
|
||||
} else {
|
||||
self.push_clause(child_num + 1, term, child_terms);
|
||||
self.push_term(child_terms[child_num].as_ref());
|
||||
}
|
||||
},
|
||||
DepthFirstIteratorState::NonClause(term) => return Some(term),
|
||||
};
|
||||
}
|
||||
|
||||
None
|
||||
}
|
||||
}
|
||||
|
||||
pub struct BreadthFirstIterator<'a> {
|
||||
state_queue : VecDeque<&'a Term>
|
||||
}
|
||||
|
||||
impl<'a> Iterator for BreadthFirstIterator<'a> {
|
||||
type Item = &'a Term;
|
||||
|
||||
fn next(&mut self) -> Option<Self::Item> {
|
||||
if let Some(term) = self.state_queue.pop_front() {
|
||||
if let &Term::Clause(_, _, ref child_terms) = term {
|
||||
for term in child_terms {
|
||||
self.state_queue.push_back(term);
|
||||
}
|
||||
|
||||
return Some(term);
|
||||
}
|
||||
|
||||
return Some(term);
|
||||
}
|
||||
|
||||
None
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> Term {
|
||||
pub fn post_order_iter(&'a self) -> PostOrderIterator<'a> {
|
||||
let initial_state = PostOrderIterator::render_new_state(self);
|
||||
PostOrderIterator { state_stack: vec![initial_state] }
|
||||
}
|
||||
|
||||
pub fn breadth_first_iter(&'a self) -> BreadthFirstIterator<'a> {
|
||||
let mut queue = VecDeque::new();
|
||||
queue.push_back(self);
|
||||
|
||||
BreadthFirstIterator { state_queue: queue }
|
||||
}
|
||||
}
|
||||
@@ -1,31 +0,0 @@
|
||||
use std::cell::{Cell};
|
||||
use l0::ast::{Atom, Term, TopLevel, Var};
|
||||
|
||||
grammar;
|
||||
|
||||
pub TopLevel: TopLevel = {
|
||||
"?-" <t:Term> "." => TopLevel::Query(t),
|
||||
<t:Term> "." => TopLevel::Fact(t),
|
||||
};
|
||||
|
||||
Atom : Atom = {
|
||||
r"[a-z][a-z0-9_]*" => <>.trim().to_string(),
|
||||
};
|
||||
|
||||
Var : Var = {
|
||||
r"[A-Z][a-z0-9_]*" => <>.trim().to_string(),
|
||||
};
|
||||
|
||||
BoxedTerm : Box<Term> = {
|
||||
<t:Term> => Box::new(t),
|
||||
};
|
||||
|
||||
Term : Term = {
|
||||
<a:Atom> "(" <ts: (<BoxedTerm> ",")*> <t:BoxedTerm> ")" => {
|
||||
let mut ts = ts;
|
||||
ts.push(t);
|
||||
Term::Clause(Cell::new(0), a, ts)
|
||||
},
|
||||
<Atom> => Term::Atom(Cell::new(0), <>),
|
||||
<Var> => Term::Var(Cell::new(0), <>),
|
||||
};
|
||||
1595
src/l0/l0_parser.rs
1595
src/l0/l0_parser.rs
File diff suppressed because it is too large
Load Diff
@@ -1,238 +0,0 @@
|
||||
use l0::ast::{Addr, Atom, CompiledFact, FactInstruction, QueryInstruction};
|
||||
|
||||
use std::vec::{Vec};
|
||||
|
||||
#[derive(Clone)]
|
||||
enum HeapCell {
|
||||
NamedStr(usize, Atom),
|
||||
Ref(usize),
|
||||
Str(usize),
|
||||
}
|
||||
|
||||
#[derive(Clone, Copy)]
|
||||
enum MachineMode {
|
||||
Read,
|
||||
Write
|
||||
}
|
||||
|
||||
type Heap = Vec<HeapCell>;
|
||||
|
||||
type Registers = Vec<HeapCell>;
|
||||
|
||||
pub struct Machine {
|
||||
h : usize,
|
||||
s : usize,
|
||||
pub fail : bool,
|
||||
heap : Heap,
|
||||
mode : MachineMode,
|
||||
pub program : Option<CompiledFact>,
|
||||
registers : Registers
|
||||
}
|
||||
|
||||
impl Machine {
|
||||
pub fn new() -> Machine {
|
||||
Machine { h : 0,
|
||||
s : 0,
|
||||
fail : false,
|
||||
heap : Vec::with_capacity(256),
|
||||
mode : MachineMode::Write,
|
||||
program : None,
|
||||
registers : vec![HeapCell::Ref(0); 33] }
|
||||
}
|
||||
|
||||
fn lookup(&self, a: Addr) -> &HeapCell {
|
||||
match a {
|
||||
Addr::HeapCell(hc) => &self.heap[hc],
|
||||
Addr::RegNum(reg) => &self.registers[reg]
|
||||
}
|
||||
}
|
||||
|
||||
fn deref(&self, a: Addr) -> Addr {
|
||||
let mut a = a;
|
||||
|
||||
loop {
|
||||
if let &HeapCell::Ref(value) = self.lookup(a) {
|
||||
if let Addr::HeapCell(av) = a {
|
||||
if value != av {
|
||||
a = Addr::HeapCell(value);
|
||||
continue;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return a;
|
||||
};
|
||||
}
|
||||
|
||||
fn is_unbound(hc: &HeapCell, index: usize) -> bool {
|
||||
match hc {
|
||||
&HeapCell::Ref(r) => r == index,
|
||||
_ => false
|
||||
}
|
||||
}
|
||||
|
||||
//TODO: try to compress this function. currently it is dog shit.
|
||||
fn bind(&mut self, a: Addr, val: usize) {
|
||||
let mut a = a;
|
||||
|
||||
loop {
|
||||
match a {
|
||||
Addr::RegNum(reg) => {
|
||||
if let HeapCell::Ref(hc) = self.registers[reg] {
|
||||
a = Addr::HeapCell(hc);
|
||||
} else if Machine::is_unbound(&self.heap[val], val) {
|
||||
self.heap[val] = self.registers[reg].clone();
|
||||
break;
|
||||
} else {
|
||||
self.fail = true;
|
||||
break;
|
||||
}
|
||||
},
|
||||
Addr::HeapCell(hc) if Machine::is_unbound(&self.heap[hc], hc) => {
|
||||
self.heap[hc] = HeapCell::Ref(val);
|
||||
break;
|
||||
},
|
||||
Addr::HeapCell(hc) if Machine::is_unbound(&self.heap[val], val) => {
|
||||
self.heap[val] = HeapCell::Ref(hc);
|
||||
break;
|
||||
},
|
||||
_ => {
|
||||
self.fail = true;
|
||||
break;
|
||||
}
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
fn unify(&mut self, a1: Addr, a2: Addr) {
|
||||
let mut pdl : Vec<Addr> = vec![a1, a2];
|
||||
|
||||
self.fail = false;
|
||||
|
||||
while !(pdl.is_empty() || self.fail) {
|
||||
let d1 = self.deref(pdl.pop().unwrap());
|
||||
let d2 = self.deref(pdl.pop().unwrap());
|
||||
|
||||
if d1 != d2 {
|
||||
match (self.lookup(d1), self.lookup(d2)) {
|
||||
(&HeapCell::Ref(hc), _) =>
|
||||
self.bind(d2, hc),
|
||||
(_, &HeapCell::Ref(hc)) =>
|
||||
self.bind(d1, hc),
|
||||
(&HeapCell::Str(a1), &HeapCell::Str(a2)) => {
|
||||
let r1 = &self.heap[a1];
|
||||
let r2 = &self.heap[a2];
|
||||
|
||||
if let &HeapCell::NamedStr(n1, ref f1) = r1 {
|
||||
if let &HeapCell::NamedStr(n2, ref f2) = r2 {
|
||||
if n1 == n2 && *f1 == *f2 {
|
||||
for i in 1 .. n1 {
|
||||
pdl.push(Addr::HeapCell(a1 + i));
|
||||
pdl.push(Addr::HeapCell(a2 + i));
|
||||
}
|
||||
|
||||
continue;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
self.fail = true;
|
||||
},
|
||||
_ => self.fail = true,
|
||||
};
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub fn execute_query_instr<'a, 'b : 'a>(&'a mut self, instr: &'b QueryInstruction) {
|
||||
match instr {
|
||||
&QueryInstruction::PutStructure(ref name, arity, reg) => {
|
||||
self.heap.push(HeapCell::Str(self.h + 1));
|
||||
self.heap.push(HeapCell::NamedStr(arity, name.clone()));
|
||||
|
||||
self.registers[reg] = self.heap[self.h].clone();
|
||||
|
||||
self.h += 2;
|
||||
},
|
||||
&QueryInstruction::SetVariable(reg) => {
|
||||
self.heap.push(HeapCell::Ref(self.h));
|
||||
self.registers[reg] = self.heap[self.h].clone();
|
||||
|
||||
self.h += 1;
|
||||
},
|
||||
&QueryInstruction::SetValue(reg) => {
|
||||
self.heap.push(self.registers[reg].clone());
|
||||
self.h += 1;
|
||||
},
|
||||
}
|
||||
}
|
||||
|
||||
pub fn execute_fact_instr<'a, 'b : 'a>(&'a mut self, instr: &'b FactInstruction) {
|
||||
match instr {
|
||||
&FactInstruction::GetStructure(ref name, arity, reg) => {
|
||||
let addr = self.deref(Addr::RegNum(reg));
|
||||
|
||||
match self.lookup(addr) {
|
||||
&HeapCell::Str(a) => {
|
||||
let result = &self.heap[a];
|
||||
|
||||
if let &HeapCell::NamedStr(named_arity, ref named_str) = result {
|
||||
if arity == named_arity && *name == *named_str {
|
||||
self.s = a + 1;
|
||||
self.mode = MachineMode::Read;
|
||||
} else {
|
||||
self.fail = true;
|
||||
}
|
||||
}
|
||||
},
|
||||
&HeapCell::Ref(r) => {
|
||||
self.heap.push(HeapCell::Str(self.h + 1));
|
||||
self.heap.push(HeapCell::NamedStr(arity, name.clone()));
|
||||
|
||||
let h = self.h;
|
||||
|
||||
self.bind(Addr::HeapCell(r), h);
|
||||
|
||||
self.h += 2;
|
||||
self.mode = MachineMode::Write;
|
||||
},
|
||||
_ => {
|
||||
self.fail = true;
|
||||
}
|
||||
};
|
||||
},
|
||||
&FactInstruction::UnifyVariable(reg) => {
|
||||
match self.mode {
|
||||
MachineMode::Read => self.registers[reg] = self.heap[self.s].clone(),
|
||||
MachineMode::Write => {
|
||||
self.heap.push(HeapCell::Ref(self.h));
|
||||
self.registers[reg] = self.heap[self.h].clone();
|
||||
self.h += 1;
|
||||
}
|
||||
};
|
||||
|
||||
self.s += 1;
|
||||
},
|
||||
&FactInstruction::UnifyValue(reg) => {
|
||||
let s = self.s;
|
||||
|
||||
match self.mode {
|
||||
MachineMode::Read => self.unify(Addr::RegNum(reg), Addr::HeapCell(s)),
|
||||
MachineMode::Write => {
|
||||
self.heap.push(self.registers[reg].clone());
|
||||
self.h += 1;
|
||||
}
|
||||
};
|
||||
|
||||
self.s += 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub fn reset_heap(&mut self) {
|
||||
let program = self.program.take();
|
||||
|
||||
*self = Machine::new();
|
||||
self.program = program;
|
||||
}
|
||||
}
|
||||
@@ -1,7 +0,0 @@
|
||||
mod l0_parser;
|
||||
|
||||
pub mod ast;
|
||||
pub mod iterators;
|
||||
pub mod parser;
|
||||
pub mod codegen;
|
||||
pub mod machine;
|
||||
@@ -1,52 +0,0 @@
|
||||
use l0::ast::{Term, TopLevel, Var};
|
||||
use l0::l0_parser::{parse_TopLevel};
|
||||
|
||||
use std::collections::{HashMap};
|
||||
|
||||
extern crate lalrpop_util as __lalrpop_util;
|
||||
|
||||
pub type ParseResult<'a> =
|
||||
Result<TopLevel, __lalrpop_util::ParseError<usize,(usize, &'a str),()>>;
|
||||
|
||||
pub fn parse_top_level<'a>(input: &'a str) -> ParseResult {
|
||||
let result = parse_TopLevel(&*input);
|
||||
|
||||
if let Ok(result) = result {
|
||||
return Ok(mark_cells(result));
|
||||
}
|
||||
|
||||
result
|
||||
}
|
||||
|
||||
#[inline]
|
||||
fn mark_cells(tl: TopLevel) -> TopLevel {
|
||||
match tl {
|
||||
TopLevel::Fact(term) => TopLevel::Fact(mark_term_cells(term)),
|
||||
TopLevel::Query(term) => TopLevel::Query(mark_term_cells(term))
|
||||
}
|
||||
}
|
||||
|
||||
fn mark_term_cells(term: Term) -> Term {
|
||||
let mut cell_num = 1;
|
||||
|
||||
{
|
||||
let mut bindings: HashMap<&Var, usize> = HashMap::new();
|
||||
let mut iter = term.breadth_first_iter();
|
||||
|
||||
while let Some(term) = iter.next() {
|
||||
if let &Term::Var(ref cell, ref var) = term {
|
||||
let cell_num_in_map = bindings.entry(var).or_insert(cell_num);
|
||||
|
||||
if *cell_num_in_map != cell_num {
|
||||
cell.set(*cell_num_in_map);
|
||||
continue;
|
||||
}
|
||||
}
|
||||
|
||||
term.set_cell(cell_num);
|
||||
cell_num += 1;
|
||||
}
|
||||
}
|
||||
|
||||
term
|
||||
}
|
||||
123
src/l1/ast.rs
123
src/l1/ast.rs
@@ -1,123 +0,0 @@
|
||||
use std::cell::Cell;
|
||||
use std::fmt;
|
||||
use std::vec::Vec;
|
||||
|
||||
pub type Var = String;
|
||||
|
||||
pub type Atom = String;
|
||||
|
||||
pub enum TopLevel {
|
||||
Fact(Term),
|
||||
Query(Term)
|
||||
}
|
||||
|
||||
#[derive(Clone, Copy)]
|
||||
pub enum Level {
|
||||
Shallow, Deep
|
||||
}
|
||||
|
||||
impl fmt::Display for Level {
|
||||
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
|
||||
match self {
|
||||
&Level::Shallow => write!(f, "A"),
|
||||
&Level::Deep => write!(f, "X")
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Clone, Copy)]
|
||||
pub enum Reg {
|
||||
ArgAndNorm(usize, usize),
|
||||
Norm(usize)
|
||||
}
|
||||
|
||||
impl Reg {
|
||||
pub fn has_arg(&self) -> bool {
|
||||
match self {
|
||||
&Reg::ArgAndNorm(_, _) => true,
|
||||
_ => false
|
||||
}
|
||||
}
|
||||
|
||||
pub fn norm(&self) -> usize {
|
||||
match self {
|
||||
&Reg::ArgAndNorm(_, norm) | &Reg::Norm(norm) => norm
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub enum Term {
|
||||
Atom(Cell<usize>, Atom),
|
||||
Clause(Cell<usize>, Atom, Vec<Box<Term>>),
|
||||
Var(Cell<Reg>, Var)
|
||||
}
|
||||
|
||||
pub enum TermRef<'a> {
|
||||
Atom(Level, &'a Cell<usize>, &'a Atom),
|
||||
Clause(Level, &'a Cell<usize>, &'a Atom, &'a Vec<Box<Term>>),
|
||||
Var(Level, &'a Cell<Reg>, &'a Var)
|
||||
}
|
||||
|
||||
#[derive(Clone)]
|
||||
pub enum FactInstruction {
|
||||
GetStructure(Level, Atom, usize, usize),
|
||||
GetValue(usize, usize),
|
||||
GetVariable(usize, usize),
|
||||
Proceed,
|
||||
UnifyVariable(usize),
|
||||
UnifyValue(usize)
|
||||
}
|
||||
|
||||
pub enum QueryInstruction {
|
||||
Call(Atom, usize),
|
||||
PutStructure(Level, Atom, usize, usize),
|
||||
PutValue(usize, usize),
|
||||
PutVariable(usize, usize),
|
||||
SetVariable(usize),
|
||||
SetValue(usize),
|
||||
}
|
||||
|
||||
pub type CompiledFact = Vec<FactInstruction>;
|
||||
|
||||
pub type CompiledQuery = Vec<QueryInstruction>;
|
||||
|
||||
#[derive(Clone, Copy, PartialEq)]
|
||||
pub enum Addr {
|
||||
HeapCell(usize),
|
||||
RegNum(usize)
|
||||
}
|
||||
|
||||
#[derive(Clone)]
|
||||
pub enum HeapCellValue {
|
||||
NamedStr(usize, Atom),
|
||||
Ref(usize),
|
||||
Str(usize),
|
||||
}
|
||||
|
||||
pub type Heap = Vec<HeapCellValue>;
|
||||
|
||||
pub type Registers = Vec<HeapCellValue>;
|
||||
|
||||
impl Term {
|
||||
pub fn subterms(&self) -> usize {
|
||||
match self {
|
||||
&Term::Clause(_, _, ref terms) => terms.len(),
|
||||
_ => 1
|
||||
}
|
||||
}
|
||||
|
||||
pub fn name(&self) -> &Atom {
|
||||
match self {
|
||||
&Term::Atom(_, ref atom)
|
||||
| &Term::Var(_, ref atom)
|
||||
| &Term::Clause(_, ref atom, _) => atom
|
||||
}
|
||||
}
|
||||
|
||||
pub fn arity(&self) -> usize {
|
||||
match self {
|
||||
&Term::Atom(_, _) | &Term::Var(_, _) => 0,
|
||||
&Term::Clause(_, _, ref child_terms) => child_terms.len()
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -1,312 +0,0 @@
|
||||
use l1::ast::{Atom, CompiledFact, CompiledQuery, FactInstruction,
|
||||
Level, QueryInstruction, Reg, Term, TermRef, Var};
|
||||
use l1::iterators::{FactIterator, QueryIterator};
|
||||
|
||||
use std::cell::Cell;
|
||||
use std::collections::HashMap;
|
||||
use std::fmt;
|
||||
use std::vec::Vec;
|
||||
|
||||
impl fmt::Display for QueryInstruction {
|
||||
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
|
||||
match self {
|
||||
&QueryInstruction::Call(ref name, ref arity) =>
|
||||
write!(f, "call {}/{}", name, arity),
|
||||
&QueryInstruction::PutStructure(ref lvl, ref a, ref s, ref r) =>
|
||||
write!(f, "put_structure {}/{}, {}{}", a, s, lvl, r),
|
||||
&QueryInstruction::PutValue(ref a, ref x) =>
|
||||
write!(f, "put_value X{}, A{}", x, a),
|
||||
&QueryInstruction::PutVariable(ref a, ref x) =>
|
||||
write!(f, "put_variable X{}, A{}", x, a),
|
||||
&QueryInstruction::SetVariable(ref r) =>
|
||||
write!(f, "set_variable X{}", r),
|
||||
&QueryInstruction::SetValue(ref r) =>
|
||||
write!(f, "set_value X{}", r),
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl fmt::Display for FactInstruction {
|
||||
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
|
||||
match self {
|
||||
&FactInstruction::GetStructure(ref lvl, ref a, ref s, ref r) =>
|
||||
write!(f, "get_structure {}/{}, {}{}", a, s, lvl, r),
|
||||
&FactInstruction::GetValue(ref a, ref x) =>
|
||||
write!(f, "get_value X{}, A{}", x, a),
|
||||
&FactInstruction::GetVariable(ref a, ref x) =>
|
||||
write!(f, "get_variable X{}, A{}", x, a),
|
||||
&FactInstruction::Proceed =>
|
||||
write!(f, "proceed"),
|
||||
&FactInstruction::UnifyVariable(ref r) =>
|
||||
write!(f, "unify_variable X{}", r),
|
||||
&FactInstruction::UnifyValue(ref r) =>
|
||||
write!(f, "unify_value X{}", r)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
struct TermMarker<'a> {
|
||||
bindings: HashMap<&'a Var, Reg>,
|
||||
arg_c: usize,
|
||||
norm_c: usize
|
||||
}
|
||||
|
||||
impl<'a> TermMarker<'a> {
|
||||
fn new(term: &'a Term) -> TermMarker<'a> {
|
||||
TermMarker { bindings: HashMap::new(),
|
||||
arg_c: 1,
|
||||
norm_c: term.subterms() + 1 }
|
||||
}
|
||||
|
||||
fn contains_var(&self, var: &'a Var) -> bool {
|
||||
self.bindings.contains_key(var)
|
||||
}
|
||||
|
||||
fn get(&self, var: &'a Var) -> Reg {
|
||||
*self.bindings.get(var).unwrap()
|
||||
}
|
||||
|
||||
fn insert(&mut self, var: &'a Var, r: Reg) {
|
||||
self.bindings.insert(var, r);
|
||||
}
|
||||
|
||||
fn mark_non_var(&mut self, lvl: Level, cell: &Cell<usize>) {
|
||||
if cell.get() == 0 {
|
||||
match lvl {
|
||||
Level::Deep => {
|
||||
let norm = self.norm_c;
|
||||
self.norm_c += 1;
|
||||
cell.set(norm);
|
||||
},
|
||||
Level::Shallow => {
|
||||
let arg = self.arg_c;
|
||||
self.arg_c += 1;
|
||||
cell.set(arg);
|
||||
}
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
fn mark_var(&mut self, lvl: Level, var: &'a Var) -> Reg {
|
||||
if self.contains_var(var) {
|
||||
let reg = self.get(var);
|
||||
|
||||
match lvl {
|
||||
Level::Deep => Reg::Norm(reg.norm()),
|
||||
Level::Shallow if reg.has_arg() => {
|
||||
let arg = self.arg_c;
|
||||
self.arg_c += 1;
|
||||
|
||||
Reg::ArgAndNorm(arg, reg.norm())
|
||||
},
|
||||
Level::Shallow => {
|
||||
let norm = reg.norm();
|
||||
let reg = Reg::ArgAndNorm(self.arg_c, norm);
|
||||
|
||||
self.arg_c += 1;
|
||||
self.insert(var, reg);
|
||||
|
||||
reg
|
||||
}
|
||||
}
|
||||
} else {
|
||||
let reg = match lvl {
|
||||
Level::Deep => Reg::Norm(self.norm_c),
|
||||
Level::Shallow => {
|
||||
let reg = Reg::ArgAndNorm(self.arg_c, self.norm_c);
|
||||
self.arg_c += 1;
|
||||
reg
|
||||
}
|
||||
};
|
||||
|
||||
self.norm_c += 1;
|
||||
self.insert(var, reg);
|
||||
reg
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
trait CompilationTarget<'a> {
|
||||
type Iterator : Iterator<Item=TermRef<'a>>;
|
||||
|
||||
fn iter(&'a Term) -> Self::Iterator;
|
||||
|
||||
fn to_structure(Level, Atom, usize, usize) -> Self;
|
||||
|
||||
fn argument_to_variable(usize, usize) -> Self;
|
||||
fn argument_to_value(usize, usize) -> Self;
|
||||
fn subterm_to_variable(usize) -> Self;
|
||||
fn subterm_to_value(usize) -> Self;
|
||||
|
||||
fn clause_arg_to_instr(usize) -> Self;
|
||||
}
|
||||
|
||||
impl<'a> CompilationTarget<'a> for FactInstruction {
|
||||
type Iterator = FactIterator<'a>;
|
||||
|
||||
fn iter(term: &'a Term) -> Self::Iterator {
|
||||
term.breadth_first_iter()
|
||||
}
|
||||
|
||||
fn to_structure(lvl: Level, atom: Atom, arity: usize, cell_num: usize) -> Self {
|
||||
FactInstruction::GetStructure(lvl, atom, arity, cell_num)
|
||||
}
|
||||
|
||||
fn argument_to_variable(arg: usize, val: usize) -> Self {
|
||||
FactInstruction::GetVariable(arg, val)
|
||||
}
|
||||
|
||||
fn argument_to_value(arg: usize, val: usize) -> Self {
|
||||
FactInstruction::GetValue(arg, val)
|
||||
}
|
||||
|
||||
fn subterm_to_variable(val: usize) -> Self {
|
||||
FactInstruction::UnifyVariable(val)
|
||||
}
|
||||
|
||||
fn subterm_to_value(val: usize) -> Self {
|
||||
FactInstruction::UnifyValue(val)
|
||||
}
|
||||
|
||||
fn clause_arg_to_instr(val: usize) -> Self {
|
||||
FactInstruction::UnifyVariable(val)
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> CompilationTarget<'a> for QueryInstruction {
|
||||
type Iterator = QueryIterator<'a>;
|
||||
|
||||
fn iter(term: &'a Term) -> Self::Iterator {
|
||||
term.post_order_iter()
|
||||
}
|
||||
|
||||
fn to_structure(lvl: Level, atom: Atom, arity: usize, cell_num: usize) -> Self {
|
||||
QueryInstruction::PutStructure(lvl, atom, arity, cell_num)
|
||||
}
|
||||
|
||||
fn argument_to_variable(arg: usize, val: usize) -> Self {
|
||||
QueryInstruction::PutVariable(arg, val)
|
||||
}
|
||||
|
||||
fn argument_to_value(arg: usize, val: usize) -> Self {
|
||||
QueryInstruction::PutValue(arg, val)
|
||||
}
|
||||
|
||||
fn subterm_to_variable(val: usize) -> Self {
|
||||
QueryInstruction::SetVariable(val)
|
||||
}
|
||||
|
||||
fn subterm_to_value(val: usize) -> Self {
|
||||
QueryInstruction::SetValue(val)
|
||||
}
|
||||
|
||||
fn clause_arg_to_instr(val: usize) -> Self {
|
||||
QueryInstruction::SetValue(val)
|
||||
}
|
||||
}
|
||||
|
||||
fn to_structure<'a, Target>(tm: &mut TermMarker<'a>,
|
||||
lvl: Level,
|
||||
name: &'a Atom,
|
||||
cell: &'a Cell<usize>,
|
||||
arity: usize)
|
||||
-> Target
|
||||
where Target: CompilationTarget<'a>
|
||||
{
|
||||
tm.mark_non_var(lvl, cell);
|
||||
Target::to_structure(lvl, name.clone(), arity, cell.get())
|
||||
}
|
||||
|
||||
fn non_var_subterm<'a, Target>(tm: &mut TermMarker<'a>, cell: &'a Cell<usize>)
|
||||
-> Target
|
||||
where Target: CompilationTarget<'a>
|
||||
{
|
||||
tm.mark_non_var(Level::Deep, cell);
|
||||
Target::clause_arg_to_instr(cell.get())
|
||||
}
|
||||
|
||||
fn var_term<'a, Target>(tm: &mut TermMarker<'a>,
|
||||
lvl: Level,
|
||||
cell: &'a Cell<Reg>,
|
||||
var: &'a Var)
|
||||
-> Target
|
||||
where Target: CompilationTarget<'a>
|
||||
{
|
||||
if !tm.contains_var(var) {
|
||||
let reg = tm.mark_var(lvl, var);
|
||||
cell.set(reg);
|
||||
|
||||
match reg {
|
||||
Reg::ArgAndNorm(arg, norm) =>
|
||||
Target::argument_to_variable(arg, norm),
|
||||
Reg::Norm(norm) =>
|
||||
Target::subterm_to_variable(norm)
|
||||
}
|
||||
} else {
|
||||
let reg = tm.mark_var(lvl, var);
|
||||
cell.set(reg);
|
||||
|
||||
match reg {
|
||||
Reg::ArgAndNorm(arg, norm) =>
|
||||
Target::argument_to_value(arg, norm),
|
||||
Reg::Norm(norm) =>
|
||||
Target::subterm_to_value(norm)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn subterm_to_instr<'a, Target>(tm: &mut TermMarker<'a>, subterm: &'a Term)
|
||||
-> Target
|
||||
where Target: CompilationTarget<'a>
|
||||
{
|
||||
match subterm {
|
||||
&Term::Atom(ref cell, _) | &Term::Clause(ref cell, _, _) =>
|
||||
non_var_subterm(tm, cell),
|
||||
&Term::Var(ref cell, ref var) =>
|
||||
var_term(tm, Level::Deep, cell, var)
|
||||
}
|
||||
}
|
||||
|
||||
fn compile_target<'a, Target>(term: &'a Term) -> Vec<Target>
|
||||
where Target: CompilationTarget<'a>
|
||||
{
|
||||
let iter = Target::iter(term);
|
||||
let mut target = Vec::<Target>::new();
|
||||
let mut marker = TermMarker::new(term);
|
||||
|
||||
for term in iter {
|
||||
match term {
|
||||
TermRef::Atom(lvl, term, atom) =>
|
||||
target.push(to_structure(&mut marker, lvl, atom, term, 0)),
|
||||
TermRef::Clause(lvl, term, atom, terms) => {
|
||||
target.push(to_structure(&mut marker, lvl, atom, term, terms.len()));
|
||||
|
||||
for subterm in terms {
|
||||
target.push(subterm_to_instr(&mut marker, subterm.as_ref()));
|
||||
}
|
||||
},
|
||||
TermRef::Var(lvl @ Level::Shallow, ref cell, ref var) =>
|
||||
target.push(var_term(&mut marker, lvl, cell, var)),
|
||||
_ => {}
|
||||
};
|
||||
}
|
||||
|
||||
target
|
||||
}
|
||||
|
||||
pub fn compile_fact(term: &Term) -> CompiledFact {
|
||||
let mut compiled_fact = compile_target(term);
|
||||
|
||||
compiled_fact.push(FactInstruction::Proceed);
|
||||
compiled_fact
|
||||
}
|
||||
|
||||
pub fn compile_query<'a>(term: &'a Term) -> CompiledQuery {
|
||||
let mut compiled_query = compile_target(term);
|
||||
|
||||
if let &Term::Clause(_, ref atom, ref terms) = term {
|
||||
compiled_query.push(QueryInstruction::Call(atom.clone(), terms.len()));
|
||||
}
|
||||
|
||||
compiled_query
|
||||
}
|
||||
@@ -1,175 +0,0 @@
|
||||
use l1::ast::{Atom, Level, Reg, Term, TermRef, Var};
|
||||
|
||||
use std::cell::Cell;
|
||||
use std::collections::VecDeque;
|
||||
use std::vec::Vec;
|
||||
|
||||
enum IteratorState<'a> {
|
||||
Atom(Level, &'a Cell<usize>, &'a Atom),
|
||||
Clause(Level, usize, &'a Cell<usize>, &'a Atom, &'a Vec<Box<Term>>),
|
||||
IsolatedAtom(&'a Cell<usize>, &'a Atom),
|
||||
IsolatedVar(&'a Cell<Reg>, &'a Var),
|
||||
RootClause(usize, &'a Vec<Box<Term>>),
|
||||
Var(Level, &'a Cell<Reg>, &'a Var)
|
||||
}
|
||||
|
||||
impl<'a> IteratorState<'a> {
|
||||
fn to_state(lvl: Level, term: &'a Term) -> IteratorState<'a>
|
||||
{
|
||||
match term {
|
||||
&Term::Atom(ref cell, ref atom) =>
|
||||
IteratorState::Atom(lvl, cell, atom),
|
||||
&Term::Clause(ref cell, ref atom, ref child_terms) =>
|
||||
IteratorState::Clause(lvl, 0, cell, atom, child_terms),
|
||||
&Term::Var(ref cell, ref var) =>
|
||||
IteratorState::Var(lvl, cell, var)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub struct QueryIterator<'a> {
|
||||
state_stack: Vec<IteratorState<'a>>
|
||||
}
|
||||
|
||||
impl<'a> QueryIterator<'a> {
|
||||
fn push_clause(&mut self,
|
||||
lvl: Level,
|
||||
child_num: usize,
|
||||
cell: &'a Cell<usize>,
|
||||
name: &'a Atom,
|
||||
child_terms: &'a Vec<Box<Term>>)
|
||||
{
|
||||
self.state_stack.push(IteratorState::Clause(lvl,
|
||||
child_num,
|
||||
cell,
|
||||
name,
|
||||
child_terms));
|
||||
}
|
||||
|
||||
fn push_root_clause(&mut self,
|
||||
child_num: usize,
|
||||
child_terms: &'a Vec<Box<Term>>)
|
||||
{
|
||||
self.state_stack.push(IteratorState::RootClause(child_num, child_terms));
|
||||
}
|
||||
|
||||
fn push_subterm(&mut self, lvl: Level, term: &'a Term) {
|
||||
self.state_stack.push(IteratorState::to_state(lvl, term));
|
||||
}
|
||||
|
||||
fn new(term: &'a Term) -> QueryIterator<'a> {
|
||||
let state = match term {
|
||||
&Term::Atom(ref cell, ref atom) =>
|
||||
IteratorState::IsolatedAtom(cell, atom),
|
||||
&Term::Clause(_, _, ref terms) =>
|
||||
IteratorState::RootClause(0, terms),
|
||||
&Term::Var(ref cell, ref var) =>
|
||||
IteratorState::IsolatedVar(cell, var)
|
||||
};
|
||||
|
||||
QueryIterator { state_stack: vec![state] }
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> Iterator for QueryIterator<'a> {
|
||||
type Item = TermRef<'a>;
|
||||
|
||||
fn next(&mut self) -> Option<Self::Item> {
|
||||
while let Some(iter_state) = self.state_stack.pop() {
|
||||
match iter_state {
|
||||
IteratorState::Atom(lvl, cell, atom) =>
|
||||
return Some(TermRef::Atom(lvl, cell, atom)),
|
||||
IteratorState::Clause(lvl, child_num, cell, atom, child_terms) => {
|
||||
if child_num == child_terms.len() {
|
||||
return Some(TermRef::Clause(lvl, cell, atom, child_terms));
|
||||
} else {
|
||||
self.push_clause(lvl, child_num + 1, cell, atom, child_terms);
|
||||
self.push_subterm(Level::Deep, child_terms[child_num].as_ref());
|
||||
}
|
||||
},
|
||||
IteratorState::IsolatedAtom(cell, atom) =>
|
||||
return Some(TermRef::Atom(Level::Shallow, cell, atom)),
|
||||
IteratorState::IsolatedVar(cell, var) =>
|
||||
return Some(TermRef::Var(Level::Shallow, cell, var)),
|
||||
IteratorState::RootClause(child_num, child_terms) => {
|
||||
if child_num == child_terms.len() {
|
||||
return None;
|
||||
} else {
|
||||
self.push_root_clause(child_num + 1, child_terms);
|
||||
self.push_subterm(Level::Shallow, child_terms[child_num].as_ref());
|
||||
}
|
||||
},
|
||||
IteratorState::Var(lvl, cell, var) =>
|
||||
return Some(TermRef::Var(lvl, cell, var))
|
||||
};
|
||||
}
|
||||
|
||||
None
|
||||
}
|
||||
}
|
||||
|
||||
pub struct FactIterator<'a> {
|
||||
state_queue: VecDeque<IteratorState<'a>>,
|
||||
}
|
||||
|
||||
impl<'a> FactIterator<'a> {
|
||||
fn push_subterm(&mut self, lvl: Level, term: &'a Term) {
|
||||
self.state_queue.push_back(IteratorState::to_state(lvl, term));
|
||||
}
|
||||
|
||||
fn new(term: &'a Term) -> FactIterator<'a> {
|
||||
let states = match term {
|
||||
&Term::Atom(ref cell, ref atom) =>
|
||||
vec![IteratorState::IsolatedAtom(cell, atom)],
|
||||
&Term::Clause(_, _, ref terms) =>
|
||||
vec![IteratorState::RootClause(0, terms)],
|
||||
&Term::Var(ref cell, ref var) =>
|
||||
vec![IteratorState::IsolatedVar(cell, var)]
|
||||
};
|
||||
|
||||
FactIterator { state_queue: VecDeque::from(states) }
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> Iterator for FactIterator<'a> {
|
||||
type Item = TermRef<'a>;
|
||||
|
||||
fn next(&mut self) -> Option<Self::Item> {
|
||||
while let Some(state) = self.state_queue.pop_front() {
|
||||
match state {
|
||||
IteratorState::Atom(lvl, cell, atom) =>
|
||||
return Some(TermRef::Atom(lvl, cell, atom)),
|
||||
IteratorState::Clause(lvl, _, cell, atom, child_terms) => {
|
||||
for child_term in child_terms {
|
||||
self.push_subterm(Level::Deep, child_term);
|
||||
}
|
||||
|
||||
return Some(TermRef::Clause(lvl, cell, atom, child_terms));
|
||||
},
|
||||
IteratorState::IsolatedAtom(cell, atom) =>
|
||||
return Some(TermRef::Atom(Level::Shallow, cell, atom)),
|
||||
IteratorState::IsolatedVar(cell, var) =>
|
||||
return Some(TermRef::Var(Level::Shallow, cell, var)),
|
||||
IteratorState::RootClause(_, child_terms) => {
|
||||
for child_term in child_terms {
|
||||
self.push_subterm(Level::Shallow, child_term);
|
||||
}
|
||||
},
|
||||
IteratorState::Var(lvl, cell, var) =>
|
||||
return Some(TermRef::Var(lvl, cell, var))
|
||||
}
|
||||
}
|
||||
|
||||
None
|
||||
}
|
||||
}
|
||||
|
||||
impl Term {
|
||||
pub fn post_order_iter(&self) -> QueryIterator {
|
||||
QueryIterator::new(self)
|
||||
}
|
||||
|
||||
pub fn breadth_first_iter(&self) -> FactIterator {
|
||||
FactIterator::new(self)
|
||||
}
|
||||
}
|
||||
@@ -1,32 +0,0 @@
|
||||
use std::cell::Cell;
|
||||
|
||||
use l1::ast::{Atom, Reg, Term, TopLevel, Var};
|
||||
|
||||
grammar;
|
||||
|
||||
pub TopLevel: TopLevel = {
|
||||
"?-" <t:Term> "." => TopLevel::Query(t),
|
||||
<t:Term> "." => TopLevel::Fact(t),
|
||||
};
|
||||
|
||||
Atom : Atom = {
|
||||
r"[a-z][a-z0-9_]*" => <>.trim().to_string(),
|
||||
};
|
||||
|
||||
Var : Var = {
|
||||
r"[A-Z][a-z0-9_]*" => <>.trim().to_string(),
|
||||
};
|
||||
|
||||
BoxedTerm : Box<Term> = {
|
||||
<t:Term> => Box::new(t),
|
||||
};
|
||||
|
||||
Term : Term = {
|
||||
<a:Atom> "(" <ts: (<BoxedTerm> ",")*> <t:BoxedTerm> ")" => {
|
||||
let mut ts = ts;
|
||||
ts.push(t);
|
||||
Term::Clause(Cell::new(0), a, ts)
|
||||
},
|
||||
<Atom> => Term::Atom(Cell::new(0), <>),
|
||||
<Var> => Term::Var(Cell::new(Reg::Norm(0)), <>)
|
||||
};
|
||||
1595
src/l1/l1_parser.rs
1595
src/l1/l1_parser.rs
File diff suppressed because it is too large
Load Diff
@@ -1,309 +0,0 @@
|
||||
use l1::ast::{Addr, Atom, CompiledFact, CompiledQuery,
|
||||
FactInstruction, Heap, HeapCellValue, QueryInstruction,
|
||||
Registers};
|
||||
|
||||
use std::collections::HashMap;
|
||||
use std::vec::Vec;
|
||||
|
||||
#[derive(Clone, Copy)]
|
||||
enum MachineMode {
|
||||
Read,
|
||||
Write
|
||||
}
|
||||
|
||||
pub struct Machine {
|
||||
h : usize,
|
||||
s : usize,
|
||||
p : usize,
|
||||
code : CompiledFact,
|
||||
code_dir : HashMap<(Atom, usize), usize>,
|
||||
fail : bool,
|
||||
heap : Heap,
|
||||
mode : MachineMode,
|
||||
registers : Registers
|
||||
}
|
||||
|
||||
impl Machine {
|
||||
pub fn new() -> Machine {
|
||||
Machine { h : 0,
|
||||
s : 0,
|
||||
p : 0,
|
||||
code : Vec::new(),
|
||||
code_dir : HashMap::new(),
|
||||
fail : false,
|
||||
heap : Vec::with_capacity(256),
|
||||
mode : MachineMode::Write,
|
||||
registers : vec![HeapCellValue::Ref(0); 32] }
|
||||
}
|
||||
|
||||
pub fn add_fact(&mut self, mut fact: CompiledFact, name: Atom, arity: usize)
|
||||
{
|
||||
let index = self.code.len();
|
||||
|
||||
self.code.append(&mut fact);
|
||||
self.code_dir.insert((name, arity), index);
|
||||
}
|
||||
|
||||
pub fn failed(&self) -> bool {
|
||||
self.fail
|
||||
}
|
||||
|
||||
fn lookup(&self, a: Addr) -> &HeapCellValue {
|
||||
match a {
|
||||
Addr::HeapCell(hc) => &self.heap[hc],
|
||||
Addr::RegNum(reg) => &self.registers[reg]
|
||||
}
|
||||
}
|
||||
|
||||
fn deref(&self, a: Addr) -> Addr {
|
||||
let mut a = a;
|
||||
|
||||
loop {
|
||||
if let &HeapCellValue::Ref(value) = self.lookup(a) {
|
||||
if let Addr::HeapCell(av) = a {
|
||||
if value != av {
|
||||
a = Addr::HeapCell(value);
|
||||
continue;
|
||||
}
|
||||
} else {
|
||||
a = Addr::HeapCell(value);
|
||||
continue;
|
||||
}
|
||||
}
|
||||
|
||||
return a;
|
||||
};
|
||||
}
|
||||
|
||||
fn is_unbound(hc: &HeapCellValue, index: usize) -> bool {
|
||||
match hc {
|
||||
&HeapCellValue::Ref(r) => r == index,
|
||||
_ => false
|
||||
}
|
||||
}
|
||||
|
||||
//TODO: try to compress this function.
|
||||
fn bind(&mut self, a: Addr, val: usize) {
|
||||
let mut a = a;
|
||||
|
||||
loop {
|
||||
match a {
|
||||
Addr::RegNum(reg) => {
|
||||
if let HeapCellValue::Ref(hc) = self.registers[reg] {
|
||||
a = Addr::HeapCell(hc);
|
||||
} else if Machine::is_unbound(&self.heap[val], val) {
|
||||
self.heap[val] = self.registers[reg].clone();
|
||||
break;
|
||||
} else {
|
||||
self.fail = true;
|
||||
break;
|
||||
}
|
||||
},
|
||||
Addr::HeapCell(hc) if Machine::is_unbound(&self.heap[hc], hc) => {
|
||||
self.heap[hc] = HeapCellValue::Ref(val);
|
||||
break;
|
||||
},
|
||||
Addr::HeapCell(hc) if Machine::is_unbound(&self.heap[val], val) => {
|
||||
self.heap[val] = HeapCellValue::Ref(hc);
|
||||
break;
|
||||
},
|
||||
_ => {
|
||||
self.fail = true;
|
||||
break;
|
||||
}
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
fn unify(&mut self, a1: Addr, a2: Addr) {
|
||||
let mut pdl = vec![a1, a2];
|
||||
|
||||
self.fail = false;
|
||||
|
||||
while !(pdl.is_empty() || self.fail) {
|
||||
let d1 = self.deref(pdl.pop().unwrap());
|
||||
let d2 = self.deref(pdl.pop().unwrap());
|
||||
|
||||
if d1 != d2 {
|
||||
match (self.lookup(d1), self.lookup(d2)) {
|
||||
(&HeapCellValue::Ref(hc), _) =>
|
||||
self.bind(d2, hc),
|
||||
(_, &HeapCellValue::Ref(hc)) =>
|
||||
self.bind(d1, hc),
|
||||
(&HeapCellValue::Str(a1), &HeapCellValue::Str(a2)) => {
|
||||
let r1 = &self.heap[a1];
|
||||
let r2 = &self.heap[a2];
|
||||
|
||||
if let &HeapCellValue::NamedStr(n1, ref f1) = r1 {
|
||||
if let &HeapCellValue::NamedStr(n2, ref f2) = r2 {
|
||||
if n1 == n2 && *f1 == *f2 {
|
||||
for i in 1 .. n1 {
|
||||
pdl.push(Addr::HeapCell(a1 + i));
|
||||
pdl.push(Addr::HeapCell(a2 + i));
|
||||
}
|
||||
|
||||
continue;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
self.fail = true;
|
||||
},
|
||||
_ => self.fail = true,
|
||||
};
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub fn execute_fact(&mut self) {
|
||||
loop {
|
||||
if let &FactInstruction::Proceed = &self.code[self.p] {
|
||||
break;
|
||||
} else if self.fail {
|
||||
break;
|
||||
}
|
||||
|
||||
let fact_instr = self.code[self.p].clone();
|
||||
self.execute_fact_instr(fact_instr);
|
||||
}
|
||||
}
|
||||
|
||||
pub fn execute_query(&mut self, query: &CompiledQuery) {
|
||||
for instr in query {
|
||||
self.execute_query_instr(instr);
|
||||
|
||||
if self.fail {
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn execute_query_instr<'a, 'b: 'a>(&'a mut self, instr: &'b QueryInstruction) {
|
||||
match instr {
|
||||
&QueryInstruction::Call(ref name, arity) => {
|
||||
// why is Option<&T> not Deref?!?!?
|
||||
// is it because if the value is None, there's nothing to
|
||||
// dereference?
|
||||
let compiled_fact_index =
|
||||
self.code_dir.get(&(name.clone(), arity))
|
||||
.map(|index| *index);
|
||||
|
||||
match compiled_fact_index {
|
||||
Some(compiled_fact_index) => {
|
||||
self.p = compiled_fact_index;
|
||||
self.execute_fact();
|
||||
},
|
||||
None => self.fail = true,
|
||||
};
|
||||
}
|
||||
&QueryInstruction::PutStructure(_, ref name, arity, reg) => {
|
||||
self.heap.push(HeapCellValue::Str(self.h + 1));
|
||||
self.heap.push(HeapCellValue::NamedStr(arity, name.clone()));
|
||||
|
||||
self.registers[reg] = self.heap[self.h].clone();
|
||||
|
||||
self.h += 2;
|
||||
},
|
||||
&QueryInstruction::PutValue(arg, norm) =>
|
||||
self.registers[arg] = self.registers[norm].clone(),
|
||||
&QueryInstruction::PutVariable(arg, norm) => {
|
||||
self.heap.push(HeapCellValue::Ref(self.h));
|
||||
|
||||
self.registers[norm] = self.heap[self.h].clone();
|
||||
self.registers[arg] = self.heap[self.h].clone();
|
||||
|
||||
self.h += 1;
|
||||
},
|
||||
&QueryInstruction::SetVariable(reg) => {
|
||||
self.heap.push(HeapCellValue::Ref(self.h));
|
||||
self.registers[reg] = self.heap[self.h].clone();
|
||||
|
||||
self.h += 1;
|
||||
},
|
||||
&QueryInstruction::SetValue(reg) => {
|
||||
self.heap.push(self.registers[reg].clone());
|
||||
self.h += 1;
|
||||
},
|
||||
}
|
||||
}
|
||||
|
||||
fn execute_fact_instr(&mut self, instr: FactInstruction) {
|
||||
match instr {
|
||||
FactInstruction::Proceed => return,
|
||||
FactInstruction::GetStructure(_, name, arity, reg) => {
|
||||
let addr = self.deref(Addr::RegNum(reg));
|
||||
|
||||
match self.lookup(addr) {
|
||||
&HeapCellValue::Str(a) => {
|
||||
let result = &self.heap[a];
|
||||
|
||||
if let &HeapCellValue::NamedStr(named_arity, ref named_str) = result {
|
||||
if arity == named_arity && *name == *named_str {
|
||||
self.s = a + 1;
|
||||
self.mode = MachineMode::Read;
|
||||
} else {
|
||||
self.fail = true;
|
||||
}
|
||||
}
|
||||
},
|
||||
&HeapCellValue::Ref(r) => {
|
||||
self.heap.push(HeapCellValue::Str(self.h + 1));
|
||||
self.heap.push(HeapCellValue::NamedStr(arity, name));
|
||||
|
||||
let h = self.h;
|
||||
|
||||
self.bind(Addr::HeapCell(r), h);
|
||||
|
||||
self.h += 2;
|
||||
self.mode = MachineMode::Write;
|
||||
},
|
||||
_ => {
|
||||
self.fail = true;
|
||||
}
|
||||
};
|
||||
},
|
||||
FactInstruction::GetVariable(arg, norm) =>
|
||||
self.registers[norm] = self.registers[arg].clone(),
|
||||
FactInstruction::GetValue(arg, norm) =>
|
||||
self.unify(Addr::RegNum(norm), Addr::RegNum(arg)),
|
||||
FactInstruction::UnifyVariable(reg) => {
|
||||
match self.mode {
|
||||
MachineMode::Read => self.registers[reg] = self.heap[self.s].clone(),
|
||||
MachineMode::Write => {
|
||||
self.heap.push(HeapCellValue::Ref(self.h));
|
||||
self.registers[reg] = self.heap[self.h].clone();
|
||||
self.h += 1;
|
||||
}
|
||||
};
|
||||
|
||||
self.s += 1;
|
||||
},
|
||||
FactInstruction::UnifyValue(reg) => {
|
||||
let s = self.s;
|
||||
|
||||
match self.mode {
|
||||
MachineMode::Read => self.unify(Addr::RegNum(reg), Addr::HeapCell(s)),
|
||||
MachineMode::Write => {
|
||||
self.heap.push(self.registers[reg].clone());
|
||||
self.h += 1;
|
||||
}
|
||||
};
|
||||
|
||||
self.s += 1;
|
||||
}
|
||||
}
|
||||
|
||||
self.p += 1;
|
||||
}
|
||||
|
||||
pub fn reset_machine_state(&mut self) {
|
||||
self.h = 0;
|
||||
self.s = 0;
|
||||
self.p = 0;
|
||||
|
||||
self.fail = false;
|
||||
self.heap = Vec::with_capacity(256);
|
||||
self.mode = MachineMode::Write;
|
||||
self.registers = vec![HeapCellValue::Ref(0); 32];
|
||||
}
|
||||
}
|
||||
@@ -1,5 +0,0 @@
|
||||
pub mod ast;
|
||||
pub mod iterators;
|
||||
pub mod l1_parser;
|
||||
pub mod codegen;
|
||||
pub mod machine;
|
||||
253
src/l2/ast.rs
253
src/l2/ast.rs
@@ -1,253 +0,0 @@
|
||||
use std::cell::Cell;
|
||||
use std::fmt;
|
||||
use std::ops::{Add, AddAssign};
|
||||
use std::vec::Vec;
|
||||
|
||||
pub type Var = String;
|
||||
|
||||
pub type Atom = String;
|
||||
|
||||
pub enum TopLevel {
|
||||
Fact(Term),
|
||||
Rule(Rule),
|
||||
Query(Term)
|
||||
}
|
||||
|
||||
#[derive(Clone, Copy)]
|
||||
pub enum Level {
|
||||
Shallow, Deep
|
||||
}
|
||||
|
||||
impl fmt::Display for Level {
|
||||
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
|
||||
match self {
|
||||
&Level::Shallow => write!(f, "A"),
|
||||
&Level::Deep => write!(f, "X")
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Clone, Copy)]
|
||||
pub enum RegType {
|
||||
Perm(usize),
|
||||
Temp(usize)
|
||||
}
|
||||
|
||||
impl RegType {
|
||||
pub fn reg_num(self) -> usize {
|
||||
match self {
|
||||
RegType::Perm(reg_num) | RegType::Temp(reg_num) => reg_num
|
||||
}
|
||||
}
|
||||
|
||||
pub fn is_perm(self) -> bool {
|
||||
match self {
|
||||
RegType::Perm(_) => true,
|
||||
_ => false
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl fmt::Display for VarReg {
|
||||
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
|
||||
match self {
|
||||
&VarReg::Norm(RegType::Perm(reg)) => write!(f, "Y{}", reg),
|
||||
&VarReg::Norm(RegType::Temp(reg)) => write!(f, "X{}", reg),
|
||||
&VarReg::ArgAndNorm(RegType::Perm(reg), arg) =>
|
||||
write!(f, "Y{} A{}", reg, arg),
|
||||
&VarReg::ArgAndNorm(RegType::Temp(reg), arg) =>
|
||||
write!(f, "X{} A{}", reg, arg)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl From<RegType> for Addr {
|
||||
fn from(reg: RegType) -> Addr {
|
||||
match reg {
|
||||
RegType::Perm(reg) => Addr::StackCell(reg),
|
||||
RegType::Temp(reg) => Addr::RegNum(reg)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl fmt::Display for RegType {
|
||||
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
|
||||
match self {
|
||||
&RegType::Perm(val) => write!(f, "Y{}", val),
|
||||
&RegType::Temp(val) => write!(f, "X{}", val)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Clone, Copy)]
|
||||
pub enum VarReg {
|
||||
ArgAndNorm(RegType, usize),
|
||||
Norm(RegType)
|
||||
}
|
||||
|
||||
impl VarReg {
|
||||
pub fn norm(self) -> RegType {
|
||||
match self {
|
||||
VarReg::ArgAndNorm(reg, _) | VarReg::Norm(reg) => reg
|
||||
}
|
||||
}
|
||||
|
||||
pub fn root_register(self) -> usize {
|
||||
match self {
|
||||
VarReg::ArgAndNorm(_, root) => root,
|
||||
VarReg::Norm(root) => root.reg_num()
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub enum Term {
|
||||
Atom(Cell<RegType>, Atom),
|
||||
Clause(Cell<RegType>, Atom, Vec<Box<Term>>),
|
||||
Var(Cell<VarReg>, Var)
|
||||
}
|
||||
|
||||
pub struct Rule {
|
||||
pub head: (Term, Term),
|
||||
pub clauses: Vec<Term>
|
||||
}
|
||||
|
||||
pub enum TermRef<'a> {
|
||||
Atom(Level, &'a Cell<RegType>, &'a Atom),
|
||||
Clause(Level, &'a Cell<RegType>, &'a Atom, &'a Vec<Box<Term>>),
|
||||
Var(Level, &'a Cell<VarReg>, &'a Var)
|
||||
}
|
||||
|
||||
pub enum FactInstruction {
|
||||
GetStructure(Level, Atom, usize, RegType),
|
||||
GetValue(RegType, usize),
|
||||
GetVariable(RegType, usize),
|
||||
UnifyVariable(RegType),
|
||||
UnifyValue(RegType)
|
||||
}
|
||||
|
||||
pub enum QueryInstruction {
|
||||
PutStructure(Level, Atom, usize, RegType),
|
||||
PutValue(RegType, usize),
|
||||
PutVariable(RegType, usize),
|
||||
SetVariable(RegType),
|
||||
SetValue(RegType)
|
||||
}
|
||||
|
||||
pub enum ControlInstruction {
|
||||
Allocate(usize),
|
||||
Call(Atom, usize),
|
||||
Deallocate,
|
||||
Proceed
|
||||
}
|
||||
|
||||
pub type CompiledFact = Vec<FactInstruction>;
|
||||
|
||||
pub type CompiledQuery = Vec<QueryInstruction>;
|
||||
|
||||
pub enum Line {
|
||||
Control(ControlInstruction),
|
||||
Fact(CompiledFact),
|
||||
Query(CompiledQuery)
|
||||
}
|
||||
|
||||
pub type Code = Vec<Line>;
|
||||
|
||||
#[derive(Clone, Copy, PartialEq)]
|
||||
pub enum Addr {
|
||||
HeapCell(usize),
|
||||
RegNum(usize),
|
||||
StackCell(usize),
|
||||
}
|
||||
|
||||
#[derive(Clone, PartialEq)]
|
||||
pub enum HeapCellValue {
|
||||
NamedStr(usize, Atom),
|
||||
Ref(usize),
|
||||
Str(usize)
|
||||
}
|
||||
|
||||
impl HeapCellValue {
|
||||
pub fn as_ref(&self, focus: usize) -> HeapCellRef {
|
||||
match self {
|
||||
&HeapCellValue::Ref(r) => HeapCellRef::Ref(r),
|
||||
&HeapCellValue::Str(s) => HeapCellRef::Str(s),
|
||||
&HeapCellValue::NamedStr(_, _) => HeapCellRef::Str(focus)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Copy, Clone)]
|
||||
pub enum HeapCellRef {
|
||||
Ref(usize),
|
||||
Str(usize)
|
||||
}
|
||||
|
||||
impl HeapCellRef {
|
||||
pub fn heap_offset(&self) -> usize {
|
||||
match self {
|
||||
&HeapCellRef::Ref(r) | &HeapCellRef::Str(r) => r
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl From<HeapCellRef> for HeapCellValue {
|
||||
fn from(hcr: HeapCellRef) -> HeapCellValue {
|
||||
match hcr {
|
||||
HeapCellRef::Ref(r) => HeapCellValue::Ref(r),
|
||||
HeapCellRef::Str(s) => HeapCellValue::Str(s)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Clone, Copy)]
|
||||
pub enum CodePtr {
|
||||
DirEntry(usize),
|
||||
TopLevel
|
||||
}
|
||||
|
||||
impl Add<usize> for CodePtr {
|
||||
type Output = CodePtr;
|
||||
fn add(self, rhs: usize) -> Self::Output {
|
||||
match self {
|
||||
CodePtr::DirEntry(p) => CodePtr::DirEntry(p + rhs),
|
||||
CodePtr::TopLevel => CodePtr::TopLevel
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl AddAssign<usize> for CodePtr {
|
||||
fn add_assign(&mut self, rhs: usize) {
|
||||
match self {
|
||||
&mut CodePtr::DirEntry(ref mut p) => *p += rhs,
|
||||
_ => {}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub type Heap = Vec<HeapCellValue>;
|
||||
|
||||
pub type Registers = Vec<HeapCellRef>;
|
||||
|
||||
impl Term {
|
||||
pub fn subterms(&self) -> usize {
|
||||
match self {
|
||||
&Term::Clause(_, _, ref terms) => terms.len(),
|
||||
_ => 1
|
||||
}
|
||||
}
|
||||
|
||||
pub fn name(&self) -> &Atom {
|
||||
match self {
|
||||
&Term::Atom(_, ref atom)
|
||||
| &Term::Var(_, ref atom)
|
||||
| &Term::Clause(_, ref atom, _) => atom
|
||||
}
|
||||
}
|
||||
|
||||
pub fn arity(&self) -> usize {
|
||||
match self {
|
||||
&Term::Atom(_, _) | &Term::Var(_, _) => 0,
|
||||
&Term::Clause(_, _, ref child_terms) => child_terms.len()
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -1,469 +0,0 @@
|
||||
use l2::ast::*;
|
||||
use l2::iterators::{FactIterator, QueryIterator};
|
||||
|
||||
use std::cell::Cell;
|
||||
use std::cmp::max;
|
||||
use std::collections::HashMap;
|
||||
use std::fmt;
|
||||
use std::vec::Vec;
|
||||
|
||||
impl fmt::Display for FactInstruction {
|
||||
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
|
||||
match self {
|
||||
&FactInstruction::GetStructure(Level::Deep, ref name, ref arity, ref r) =>
|
||||
write!(f, "get_structure {}/{}, {}", name, arity, r),
|
||||
&FactInstruction::GetStructure(Level::Shallow, ref name, ref arity, ref r) =>
|
||||
write!(f, "get_structure {}/{}, A{}", name, arity, r.reg_num()),
|
||||
&FactInstruction::GetValue(ref x, ref a) =>
|
||||
write!(f, "get_value {}, A{}", x, a),
|
||||
&FactInstruction::GetVariable(ref x, ref a) =>
|
||||
write!(f, "get_variable {}, A{}", x, a),
|
||||
&FactInstruction::UnifyVariable(ref r) =>
|
||||
write!(f, "unify_variable {}", r),
|
||||
&FactInstruction::UnifyValue(ref r) =>
|
||||
write!(f, "unify_value {}", r)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl fmt::Display for QueryInstruction {
|
||||
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
|
||||
match self {
|
||||
&QueryInstruction::PutStructure(Level::Deep, ref name, ref arity, ref r) =>
|
||||
write!(f, "put_structure {}/{}, A{}", name, arity, r.reg_num()),
|
||||
&QueryInstruction::PutStructure(Level::Shallow, ref name, ref arity, ref r) =>
|
||||
write!(f, "put_structure {}/{}, {}", name, arity, r),
|
||||
&QueryInstruction::PutValue(ref x, ref a) =>
|
||||
write!(f, "put_value {}, A{}", x, a),
|
||||
&QueryInstruction::PutVariable(ref x, ref a) =>
|
||||
write!(f, "put_variable {}, A{}", x, a),
|
||||
&QueryInstruction::SetVariable(ref r) =>
|
||||
write!(f, "set_variable {}", r),
|
||||
&QueryInstruction::SetValue(ref r) =>
|
||||
write!(f, "set_value {}", r),
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl fmt::Display for ControlInstruction {
|
||||
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
|
||||
match self {
|
||||
&ControlInstruction::Allocate(num_cells) =>
|
||||
write!(f, "allocate {}", num_cells),
|
||||
&ControlInstruction::Call(ref name, ref arity) =>
|
||||
write!(f, "call {}/{}", name, arity),
|
||||
&ControlInstruction::Deallocate =>
|
||||
write!(f, "deallocate"),
|
||||
&ControlInstruction::Proceed =>
|
||||
write!(f, "proceed")
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
trait CompilationTarget<'a> {
|
||||
type Iterator : Iterator<Item=TermRef<'a>>;
|
||||
|
||||
fn iter(&'a Term) -> Self::Iterator;
|
||||
|
||||
fn to_structure(Level, Atom, usize, RegType) -> Self;
|
||||
|
||||
fn argument_to_variable(RegType, usize) -> Self;
|
||||
fn argument_to_value(RegType, usize) -> Self;
|
||||
fn subterm_to_variable(RegType) -> Self;
|
||||
fn subterm_to_value(RegType) -> Self;
|
||||
|
||||
fn clause_arg_to_instr(RegType) -> Self;
|
||||
}
|
||||
|
||||
impl<'a> CompilationTarget<'a> for FactInstruction {
|
||||
type Iterator = FactIterator<'a>;
|
||||
|
||||
fn iter(term: &'a Term) -> Self::Iterator {
|
||||
term.breadth_first_iter()
|
||||
}
|
||||
|
||||
fn to_structure(lvl: Level, atom: Atom, arity: usize, reg: RegType) -> Self {
|
||||
FactInstruction::GetStructure(lvl, atom, arity, reg)
|
||||
}
|
||||
|
||||
fn argument_to_variable(arg: RegType, val: usize) -> Self {
|
||||
FactInstruction::GetVariable(arg, val)
|
||||
}
|
||||
|
||||
fn argument_to_value(arg: RegType, val: usize) -> Self {
|
||||
FactInstruction::GetValue(arg, val)
|
||||
}
|
||||
|
||||
fn subterm_to_variable(val: RegType) -> Self {
|
||||
FactInstruction::UnifyVariable(val)
|
||||
}
|
||||
|
||||
fn subterm_to_value(val: RegType) -> Self {
|
||||
FactInstruction::UnifyValue(val)
|
||||
}
|
||||
|
||||
fn clause_arg_to_instr(val: RegType) -> Self {
|
||||
FactInstruction::UnifyVariable(val)
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> CompilationTarget<'a> for QueryInstruction {
|
||||
type Iterator = QueryIterator<'a>;
|
||||
|
||||
fn iter(term: &'a Term) -> Self::Iterator {
|
||||
term.post_order_iter()
|
||||
}
|
||||
|
||||
fn to_structure(lvl: Level, atom: Atom, arity: usize, reg: RegType) -> Self {
|
||||
QueryInstruction::PutStructure(lvl, atom, arity, reg)
|
||||
}
|
||||
|
||||
fn argument_to_variable(arg: RegType, val: usize) -> Self {
|
||||
QueryInstruction::PutVariable(arg, val)
|
||||
}
|
||||
|
||||
fn argument_to_value(arg: RegType, val: usize) -> Self {
|
||||
QueryInstruction::PutValue(arg, val)
|
||||
}
|
||||
|
||||
fn subterm_to_variable(val: RegType) -> Self {
|
||||
QueryInstruction::SetVariable(val)
|
||||
}
|
||||
|
||||
fn subterm_to_value(val: RegType) -> Self {
|
||||
QueryInstruction::SetValue(val)
|
||||
}
|
||||
|
||||
fn clause_arg_to_instr(val: RegType) -> Self {
|
||||
QueryInstruction::SetValue(val)
|
||||
}
|
||||
}
|
||||
|
||||
struct TermMarker<'a> {
|
||||
bindings: HashMap<&'a Var, VarReg>,
|
||||
arg_c: usize,
|
||||
perm_c: usize,
|
||||
temp_c: usize
|
||||
}
|
||||
|
||||
impl<'a> TermMarker<'a> {
|
||||
fn new() -> TermMarker<'a> {
|
||||
TermMarker { bindings: HashMap::new(),
|
||||
arg_c: 1,
|
||||
perm_c: 1,
|
||||
temp_c: 1 }
|
||||
}
|
||||
|
||||
fn contains_var(&self, var: &'a Var) -> bool {
|
||||
self.bindings.contains_key(var)
|
||||
}
|
||||
|
||||
fn get(&self, var: &'a Var) -> VarReg {
|
||||
*self.bindings.get(var).unwrap()
|
||||
}
|
||||
|
||||
fn insert(&mut self, var: &'a Var, r: VarReg) {
|
||||
self.bindings.insert(var, r);
|
||||
}
|
||||
|
||||
fn mark_non_var(&mut self, lvl: Level, cell: &Cell<RegType>) {
|
||||
let reg_type = cell.get();
|
||||
|
||||
if reg_type.reg_num() == 0 {
|
||||
match lvl {
|
||||
Level::Deep if reg_type.is_perm() => {
|
||||
let perm = self.perm_c;
|
||||
self.perm_c += 1;
|
||||
cell.set(RegType::Perm(perm));
|
||||
},
|
||||
Level::Deep => {
|
||||
let temp = self.temp_c;
|
||||
self.temp_c += 1;
|
||||
cell.set(RegType::Temp(temp));
|
||||
},
|
||||
Level::Shallow if reg_type.is_perm() => {
|
||||
let arg = self.arg_c;
|
||||
self.arg_c += 1;
|
||||
cell.set(RegType::Perm(arg));
|
||||
},
|
||||
Level::Shallow => {
|
||||
let arg = self.arg_c;
|
||||
self.arg_c += 1;
|
||||
cell.set(RegType::Temp(arg));
|
||||
}
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
fn mark_old_var(&mut self, lvl: Level, var: &'a Var) -> VarReg
|
||||
{
|
||||
let reg = self.get(var);
|
||||
|
||||
match lvl {
|
||||
Level::Deep => VarReg::Norm(reg.norm()),
|
||||
Level::Shallow => {
|
||||
let reg = VarReg::ArgAndNorm(reg.norm(), self.arg_c);
|
||||
|
||||
self.arg_c += 1;
|
||||
self.insert(var, reg);
|
||||
|
||||
reg
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn mark_new_var(&mut self, lvl: Level, var: &'a Var, reg: RegType) -> VarReg
|
||||
{
|
||||
let inner_reg = if reg.is_perm() {
|
||||
let perm = self.perm_c;
|
||||
self.perm_c += 1;
|
||||
RegType::Perm(perm)
|
||||
} else {
|
||||
let temp = self.temp_c;
|
||||
self.temp_c += 1;
|
||||
RegType::Temp(temp)
|
||||
};
|
||||
|
||||
let reg = match lvl {
|
||||
Level::Deep => VarReg::Norm(inner_reg),
|
||||
Level::Shallow => {
|
||||
let reg = VarReg::ArgAndNorm(inner_reg, self.arg_c);
|
||||
self.arg_c += 1;
|
||||
reg
|
||||
}
|
||||
};
|
||||
|
||||
self.insert(var, reg);
|
||||
reg
|
||||
}
|
||||
|
||||
fn advance_at_header(&mut self, term: &'a Term) {
|
||||
self.arg_c = 1;
|
||||
self.temp_c = max(term.subterms(), self.temp_c) + 1;
|
||||
}
|
||||
|
||||
fn advance(&mut self, term: &'a Term) {
|
||||
self.arg_c = 1;
|
||||
self.temp_c = term.subterms() + 1;
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Copy, Clone)]
|
||||
enum TermStatus {
|
||||
New, Old, Recurrent
|
||||
}
|
||||
|
||||
pub struct CodeGenerator<'a> {
|
||||
marker: TermMarker<'a>
|
||||
}
|
||||
|
||||
type VariableFixture<'a> = (TermStatus, Vec<&'a Cell<VarReg>>);
|
||||
type VariableFixtures<'a> = HashMap<&'a Var, VariableFixture<'a>>;
|
||||
|
||||
impl<'a> CodeGenerator<'a> {
|
||||
pub fn new() -> Self {
|
||||
CodeGenerator { marker: TermMarker::new() }
|
||||
}
|
||||
|
||||
pub fn vars(&self) -> &HashMap<&Var, VarReg> {
|
||||
&self.marker.bindings
|
||||
}
|
||||
|
||||
fn to_structure<Target>(&mut self,
|
||||
lvl: Level,
|
||||
name: &'a Atom,
|
||||
cell: &'a Cell<RegType>,
|
||||
arity: usize)
|
||||
-> Target
|
||||
where Target: CompilationTarget<'a>
|
||||
{
|
||||
self.marker.mark_non_var(lvl, cell);
|
||||
Target::to_structure(lvl, name.clone(), arity, cell.get())
|
||||
}
|
||||
|
||||
fn var_term<Target>(&mut self,
|
||||
lvl: Level,
|
||||
cell: &'a Cell<VarReg>,
|
||||
var: &'a Var)
|
||||
-> Target
|
||||
where Target: CompilationTarget<'a>
|
||||
{
|
||||
if !self.marker.contains_var(var) {
|
||||
let reg = self.marker.mark_new_var(lvl, var, cell.get().norm());
|
||||
cell.set(reg);
|
||||
|
||||
match reg {
|
||||
VarReg::ArgAndNorm(arg, norm) =>
|
||||
Target::argument_to_variable(arg, norm),
|
||||
VarReg::Norm(norm) =>
|
||||
Target::subterm_to_variable(norm)
|
||||
}
|
||||
} else {
|
||||
let reg = self.marker.mark_old_var(lvl, var);
|
||||
cell.set(reg);
|
||||
|
||||
match reg {
|
||||
VarReg::ArgAndNorm(arg, norm) =>
|
||||
Target::argument_to_value(arg, norm),
|
||||
VarReg::Norm(norm) =>
|
||||
Target::subterm_to_value(norm)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn non_var_subterm<Target>(&mut self, cell: &'a Cell<RegType>) -> Target
|
||||
where Target: CompilationTarget<'a>
|
||||
{
|
||||
self.marker.mark_non_var(Level::Deep, cell);
|
||||
Target::clause_arg_to_instr(cell.get())
|
||||
}
|
||||
|
||||
fn subterm_to_instr<Target>(&mut self, subterm: &'a Term) -> Target
|
||||
where Target: CompilationTarget<'a>
|
||||
{
|
||||
match subterm {
|
||||
&Term::Atom(ref cell, _) | &Term::Clause(ref cell, _, _) =>
|
||||
self.non_var_subterm(cell),
|
||||
&Term::Var(ref cell, ref var) =>
|
||||
self.var_term(Level::Deep, cell, var)
|
||||
}
|
||||
}
|
||||
|
||||
fn compile_target<Target>(&mut self, term: &'a Term) -> Vec<Target>
|
||||
where Target: CompilationTarget<'a>
|
||||
{
|
||||
let iter = Target::iter(term);
|
||||
let mut target = Vec::new();
|
||||
|
||||
for term in iter {
|
||||
match term {
|
||||
TermRef::Atom(lvl, term, atom) =>
|
||||
target.push(self.to_structure(lvl, atom, term, 0)),
|
||||
TermRef::Clause(lvl, term, atom, terms) => {
|
||||
target.push(self.to_structure(lvl, atom, term, terms.len()));
|
||||
|
||||
for subterm in terms {
|
||||
target.push(self.subterm_to_instr(subterm.as_ref()));
|
||||
}
|
||||
},
|
||||
TermRef::Var(lvl @ Level::Shallow, ref cell, ref var) =>
|
||||
target.push(self.var_term(lvl, cell, var)),
|
||||
_ => {}
|
||||
};
|
||||
}
|
||||
|
||||
target
|
||||
}
|
||||
|
||||
fn mark_vars_in_term<Iter>(iter: Iter, vs: &mut VariableFixtures<'a>)
|
||||
where Iter : Iterator<Item=TermRef<'a>>
|
||||
{
|
||||
for term in iter {
|
||||
if let TermRef::Var(_, reg_cell, var) = term {
|
||||
let mut status = vs.entry(var)
|
||||
.or_insert((TermStatus::New, Vec::new()));
|
||||
|
||||
status.1.push(reg_cell);
|
||||
|
||||
match status.0 {
|
||||
TermStatus::Old => status.0 = TermStatus::Recurrent,
|
||||
_ => {}
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
for &mut (ref mut term_status, ref mut cb) in vs.values_mut() {
|
||||
match *term_status {
|
||||
TermStatus::New => *term_status = TermStatus::Old,
|
||||
TermStatus::Recurrent => {
|
||||
for cell_reg in cb.drain(0..) {
|
||||
cell_reg.set(VarReg::Norm(RegType::Perm(0)));
|
||||
}
|
||||
},
|
||||
_ => {}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn mark_perm_vars(rule: &'a Rule) -> VariableFixtures {
|
||||
let &Rule { head: (ref p0, ref p1), ref clauses } = rule;
|
||||
let mut vfs = HashMap::new();
|
||||
|
||||
let iter = p0.breadth_first_iter().chain(p1.breadth_first_iter());
|
||||
|
||||
Self::mark_vars_in_term(iter, &mut vfs);
|
||||
|
||||
for term in clauses {
|
||||
Self::mark_vars_in_term(term.breadth_first_iter(), &mut vfs);
|
||||
}
|
||||
|
||||
vfs
|
||||
}
|
||||
|
||||
fn add_conditional_call(compiled_query: &mut Code, term: &Term) {
|
||||
match term {
|
||||
&Term::Atom(_, ref atom) => {
|
||||
let call = ControlInstruction::Call(atom.clone(), 0);
|
||||
compiled_query.push(Line::Control(call));
|
||||
},
|
||||
&Term::Clause(_, ref atom, ref terms) => {
|
||||
let call = ControlInstruction::Call(atom.clone(), terms.len());
|
||||
compiled_query.push(Line::Control(call));
|
||||
},
|
||||
_ => {}
|
||||
}
|
||||
}
|
||||
|
||||
pub fn compile_rule(&mut self, rule: &'a Rule) -> Code {
|
||||
let vfs = Self::mark_perm_vars(&rule);
|
||||
let &Rule { head: (ref p0, ref p1), ref clauses } = rule;
|
||||
let mut perm_vars = 0;
|
||||
|
||||
for &(term_status, _) in vfs.values() {
|
||||
if let TermStatus::Recurrent = term_status {
|
||||
perm_vars += 1;
|
||||
}
|
||||
}
|
||||
|
||||
let mut body = Vec::new();
|
||||
|
||||
body.push(Line::Control(ControlInstruction::Allocate(perm_vars)));
|
||||
|
||||
self.marker.advance(p0);
|
||||
body.push(Line::Fact(self.compile_target(p0)));
|
||||
|
||||
self.marker.advance_at_header(p1);
|
||||
body.push(Line::Query(self.compile_target(p1)));
|
||||
Self::add_conditional_call(&mut body, p1);
|
||||
|
||||
body = clauses.iter()
|
||||
.map(|ref term| self.compile_query(term))
|
||||
.fold(body, |mut body, ref mut cqs| {
|
||||
body.append(cqs);
|
||||
body
|
||||
});
|
||||
|
||||
body.push(Line::Control(ControlInstruction::Deallocate));
|
||||
|
||||
body
|
||||
}
|
||||
|
||||
pub fn compile_fact(&mut self, term: &'a Term) -> Code {
|
||||
self.marker.advance(term);
|
||||
|
||||
let mut compiled_fact = vec![Line::Fact(self.compile_target(term))];
|
||||
let proceed = Line::Control(ControlInstruction::Proceed);
|
||||
|
||||
compiled_fact.push(proceed);
|
||||
compiled_fact
|
||||
}
|
||||
|
||||
pub fn compile_query(&mut self, term: &'a Term) -> Code {
|
||||
self.marker.advance(term);
|
||||
|
||||
let mut compiled_query = vec![Line::Query(self.compile_target(term))];
|
||||
Self::add_conditional_call(&mut compiled_query, term);
|
||||
|
||||
compiled_query
|
||||
}
|
||||
}
|
||||
@@ -1,64 +0,0 @@
|
||||
use l2::ast::*;
|
||||
|
||||
use std::vec::Vec;
|
||||
|
||||
#[derive(Clone, Copy)]
|
||||
pub enum HeapCellView<'a> {
|
||||
Str(usize, &'a Atom),
|
||||
Var(usize)
|
||||
}
|
||||
|
||||
pub struct HeapCellViewer<'a> {
|
||||
heap: &'a Heap,
|
||||
state_stack: Vec<(usize, &'a HeapCellValue)>
|
||||
}
|
||||
|
||||
impl<'a> HeapCellViewer<'a> {
|
||||
pub fn new(heap: &'a Heap, focus: usize) -> Self {
|
||||
HeapCellViewer {
|
||||
heap: heap,
|
||||
state_stack: vec![(focus, &heap[focus])]
|
||||
}
|
||||
}
|
||||
|
||||
fn follow(&self, value: &'a HeapCellValue) -> &'a HeapCellValue {
|
||||
match value {
|
||||
&HeapCellValue::NamedStr(_, _) => value,
|
||||
&HeapCellValue::Ref(cell_num) | &HeapCellValue::Str(cell_num) =>
|
||||
&self.heap[cell_num],
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> Iterator for HeapCellViewer<'a> {
|
||||
type Item = HeapCellView<'a>;
|
||||
|
||||
fn next(&mut self) -> Option<Self::Item> {
|
||||
while let Some(hcv) = self.state_stack.pop() {
|
||||
match hcv {
|
||||
(focus, &HeapCellValue::NamedStr(arity, ref name)) => {
|
||||
for i in (1 .. arity + 1).rev() {
|
||||
self.state_stack.push((focus + i, &self.heap[focus + i]));
|
||||
}
|
||||
|
||||
return Some(HeapCellView::Str(arity, name));
|
||||
},
|
||||
(_, &HeapCellValue::Ref(cell_num)) => {
|
||||
let new_hcv = self.follow(hcv.1);
|
||||
|
||||
if hcv.1 == new_hcv {
|
||||
return Some(HeapCellView::Var(cell_num));
|
||||
} else {
|
||||
self.state_stack.push((cell_num, new_hcv));
|
||||
}
|
||||
},
|
||||
(_, &HeapCellValue::Str(cell_num)) => {
|
||||
let new_hcv = self.follow(hcv.1);
|
||||
self.state_stack.push((cell_num, new_hcv));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
None
|
||||
}
|
||||
}
|
||||
@@ -1,175 +0,0 @@
|
||||
use l2::ast::*;
|
||||
|
||||
use std::cell::Cell;
|
||||
use std::collections::VecDeque;
|
||||
use std::vec::Vec;
|
||||
|
||||
enum IteratorState<'a> {
|
||||
Atom(Level, &'a Cell<RegType>, &'a Atom),
|
||||
Clause(Level, usize, &'a Cell<RegType>, &'a Atom, &'a Vec<Box<Term>>),
|
||||
IsolatedAtom(&'a Cell<RegType>, &'a Atom),
|
||||
IsolatedVar(&'a Cell<VarReg>, &'a Var),
|
||||
RootClause(usize, &'a Vec<Box<Term>>),
|
||||
Var(Level, &'a Cell<VarReg>, &'a Var)
|
||||
}
|
||||
|
||||
impl<'a> IteratorState<'a> {
|
||||
fn to_state(lvl: Level, term: &'a Term) -> IteratorState<'a>
|
||||
{
|
||||
match term {
|
||||
&Term::Atom(ref cell, ref atom) =>
|
||||
IteratorState::Atom(lvl, cell, atom),
|
||||
&Term::Clause(ref cell, ref atom, ref child_terms) =>
|
||||
IteratorState::Clause(lvl, 0, cell, atom, child_terms),
|
||||
&Term::Var(ref cell, ref var) =>
|
||||
IteratorState::Var(lvl, cell, var)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub struct QueryIterator<'a> {
|
||||
state_stack: Vec<IteratorState<'a>>
|
||||
}
|
||||
|
||||
impl<'a> QueryIterator<'a> {
|
||||
fn push_clause(&mut self,
|
||||
lvl: Level,
|
||||
child_num: usize,
|
||||
cell: &'a Cell<RegType>,
|
||||
name: &'a Atom,
|
||||
child_terms: &'a Vec<Box<Term>>)
|
||||
{
|
||||
self.state_stack.push(IteratorState::Clause(lvl,
|
||||
child_num,
|
||||
cell,
|
||||
name,
|
||||
child_terms));
|
||||
}
|
||||
|
||||
fn push_root_clause(&mut self,
|
||||
child_num: usize,
|
||||
child_terms: &'a Vec<Box<Term>>)
|
||||
{
|
||||
self.state_stack.push(IteratorState::RootClause(child_num, child_terms));
|
||||
}
|
||||
|
||||
fn push_subterm(&mut self, lvl: Level, term: &'a Term) {
|
||||
self.state_stack.push(IteratorState::to_state(lvl, term));
|
||||
}
|
||||
|
||||
fn new(term: &'a Term) -> QueryIterator<'a> {
|
||||
let state = match term {
|
||||
&Term::Atom(ref cell, ref atom) =>
|
||||
IteratorState::IsolatedAtom(cell, atom),
|
||||
&Term::Clause(_, _, ref terms) =>
|
||||
IteratorState::RootClause(0, terms),
|
||||
&Term::Var(ref cell, ref var) =>
|
||||
IteratorState::IsolatedVar(cell, var)
|
||||
};
|
||||
|
||||
QueryIterator { state_stack: vec![state] }
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> Iterator for QueryIterator<'a> {
|
||||
type Item = TermRef<'a>;
|
||||
|
||||
fn next(&mut self) -> Option<Self::Item> {
|
||||
while let Some(iter_state) = self.state_stack.pop() {
|
||||
match iter_state {
|
||||
IteratorState::Atom(lvl, cell, atom) =>
|
||||
return Some(TermRef::Atom(lvl, cell, atom)),
|
||||
IteratorState::Clause(lvl, child_num, cell, atom, child_terms) => {
|
||||
if child_num == child_terms.len() {
|
||||
return Some(TermRef::Clause(lvl, cell, atom, child_terms));
|
||||
} else {
|
||||
self.push_clause(lvl, child_num + 1, cell, atom, child_terms);
|
||||
self.push_subterm(Level::Deep, child_terms[child_num].as_ref());
|
||||
}
|
||||
},
|
||||
IteratorState::IsolatedAtom(cell, atom) =>
|
||||
return Some(TermRef::Atom(Level::Shallow, cell, atom)),
|
||||
IteratorState::IsolatedVar(cell, var) =>
|
||||
return Some(TermRef::Var(Level::Shallow, cell, var)),
|
||||
IteratorState::RootClause(child_num, child_terms) => {
|
||||
if child_num == child_terms.len() {
|
||||
return None;
|
||||
} else {
|
||||
self.push_root_clause(child_num + 1, child_terms);
|
||||
self.push_subterm(Level::Shallow, child_terms[child_num].as_ref());
|
||||
}
|
||||
},
|
||||
IteratorState::Var(lvl, cell, var) =>
|
||||
return Some(TermRef::Var(lvl, cell, var))
|
||||
};
|
||||
}
|
||||
|
||||
None
|
||||
}
|
||||
}
|
||||
|
||||
pub struct FactIterator<'a> {
|
||||
state_queue: VecDeque<IteratorState<'a>>,
|
||||
}
|
||||
|
||||
impl<'a> FactIterator<'a> {
|
||||
fn push_subterm(&mut self, lvl: Level, term: &'a Term) {
|
||||
self.state_queue.push_back(IteratorState::to_state(lvl, term));
|
||||
}
|
||||
|
||||
fn new(term: &'a Term) -> FactIterator<'a> {
|
||||
let states = match term {
|
||||
&Term::Atom(ref cell, ref atom) =>
|
||||
vec![IteratorState::IsolatedAtom(cell, atom)],
|
||||
&Term::Clause(_, _, ref terms) =>
|
||||
vec![IteratorState::RootClause(0, terms)],
|
||||
&Term::Var(ref cell, ref var) =>
|
||||
vec![IteratorState::IsolatedVar(cell, var)]
|
||||
};
|
||||
|
||||
FactIterator { state_queue: VecDeque::from(states) }
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> Iterator for FactIterator<'a> {
|
||||
type Item = TermRef<'a>;
|
||||
|
||||
fn next(&mut self) -> Option<Self::Item> {
|
||||
while let Some(state) = self.state_queue.pop_front() {
|
||||
match state {
|
||||
IteratorState::Atom(lvl, cell, atom) =>
|
||||
return Some(TermRef::Atom(lvl, cell, atom)),
|
||||
IteratorState::Clause(lvl, _, cell, atom, child_terms) => {
|
||||
for child_term in child_terms {
|
||||
self.push_subterm(Level::Deep, child_term);
|
||||
}
|
||||
|
||||
return Some(TermRef::Clause(lvl, cell, atom, child_terms));
|
||||
},
|
||||
IteratorState::IsolatedAtom(cell, atom) =>
|
||||
return Some(TermRef::Atom(Level::Shallow, cell, atom)),
|
||||
IteratorState::IsolatedVar(cell, var) =>
|
||||
return Some(TermRef::Var(Level::Shallow, cell, var)),
|
||||
IteratorState::RootClause(_, child_terms) => {
|
||||
for child_term in child_terms {
|
||||
self.push_subterm(Level::Shallow, child_term);
|
||||
}
|
||||
},
|
||||
IteratorState::Var(lvl, cell, var) =>
|
||||
return Some(TermRef::Var(lvl, cell, var))
|
||||
}
|
||||
}
|
||||
|
||||
None
|
||||
}
|
||||
}
|
||||
|
||||
impl Term {
|
||||
pub fn post_order_iter(&self) -> QueryIterator {
|
||||
QueryIterator::new(self)
|
||||
}
|
||||
|
||||
pub fn breadth_first_iter(&self) -> FactIterator {
|
||||
FactIterator::new(self)
|
||||
}
|
||||
}
|
||||
@@ -1,45 +0,0 @@
|
||||
use l2::ast::*;
|
||||
|
||||
use std::cell::Cell;
|
||||
|
||||
grammar;
|
||||
|
||||
pub TopLevel: TopLevel = {
|
||||
"?-" <t:Term> "." => TopLevel::Query(t),
|
||||
<r:Rule> "." => TopLevel::Rule(r),
|
||||
<t:Term> "." => TopLevel::Fact(t),
|
||||
};
|
||||
|
||||
Atom : Atom = {
|
||||
r"[a-z][a-z0-9_]*" => <>.trim().to_string(),
|
||||
};
|
||||
|
||||
BoxedTerm : Box<Term> = {
|
||||
<t:Term> => Box::new(t),
|
||||
};
|
||||
|
||||
Clause : Term = {
|
||||
<a:Atom> "(" <ts: (<BoxedTerm> ",")*> <t:BoxedTerm> ")" => {
|
||||
let mut ts = ts;
|
||||
ts.push(t);
|
||||
Term::Clause(Cell::new(RegType::Temp(0)), a, ts)
|
||||
},
|
||||
};
|
||||
|
||||
Rule : Rule = {
|
||||
<c:Clause> ":-" <h:Term> <cs: ("," <Term>)*> =>
|
||||
Rule { head: (c, h), clauses: cs },
|
||||
<a:Atom> ":-" <h:Term> <cs: ("," <Term>)*> =>
|
||||
Rule { head: (Term::Atom(Cell::new(RegType::Temp(0)), a), h),
|
||||
clauses: cs }
|
||||
};
|
||||
|
||||
Term : Term = {
|
||||
<Clause> => <>,
|
||||
<Atom> => Term::Atom(Cell::new(RegType::Temp(0)), <>),
|
||||
<Var> => Term::Var(Cell::new(VarReg::Norm(RegType::Temp(0))), <>),
|
||||
};
|
||||
|
||||
Var : Var = {
|
||||
r"[A-Z][a-z0-9_]*" => <>.trim().to_string(),
|
||||
};
|
||||
1883
src/l2/l2_parser.rs
1883
src/l2/l2_parser.rs
File diff suppressed because it is too large
Load Diff
@@ -1,456 +0,0 @@
|
||||
use l2::ast::*;
|
||||
use l2::codegen::*;
|
||||
use l2::heapview::*;
|
||||
use l2::stack::*;
|
||||
|
||||
use std::collections::HashMap;
|
||||
use std::vec::Vec;
|
||||
|
||||
#[derive(Clone, Copy)]
|
||||
enum MachineMode {
|
||||
Read,
|
||||
Write
|
||||
}
|
||||
|
||||
struct MachineState {
|
||||
h: usize,
|
||||
s: usize,
|
||||
p: CodePtr,
|
||||
cp: CodePtr,
|
||||
fail: bool,
|
||||
heap: Heap,
|
||||
mode: MachineMode,
|
||||
stack: Stack,
|
||||
registers: Registers
|
||||
}
|
||||
|
||||
type CodeDir = HashMap<(Atom, usize), usize>;
|
||||
|
||||
pub struct Machine {
|
||||
ms: MachineState,
|
||||
code: Code,
|
||||
code_dir: CodeDir
|
||||
}
|
||||
|
||||
impl Machine {
|
||||
pub fn new() -> Self {
|
||||
Machine {
|
||||
ms: MachineState::new(),
|
||||
code: Vec::new(),
|
||||
code_dir: HashMap::new()
|
||||
}
|
||||
}
|
||||
|
||||
pub fn failed(&self) -> bool {
|
||||
self.ms.fail
|
||||
}
|
||||
|
||||
pub fn add_fact(&mut self, fact: &Term, mut code: Code) {
|
||||
let p = self.code.len();
|
||||
let name = fact.name().clone();
|
||||
let arity = fact.arity();
|
||||
|
||||
self.code.append(&mut code);
|
||||
self.code_dir.insert((name, arity), p);
|
||||
}
|
||||
|
||||
pub fn add_rule(&mut self, rule: &Rule, mut code: Code) {
|
||||
let p = self.code.len();
|
||||
let name = rule.head.0.name().clone();
|
||||
let arity = rule.head.0.arity();
|
||||
|
||||
self.code.append(&mut code);
|
||||
self.code_dir.insert((name, arity), p);
|
||||
}
|
||||
|
||||
fn execute_instr(&mut self, instr: &Line) -> bool {
|
||||
let mut instr = instr;
|
||||
|
||||
loop {
|
||||
match instr {
|
||||
&Line::Fact(ref fact) => {
|
||||
for fact_instr in fact {
|
||||
self.ms.execute_fact_instr(&fact_instr);
|
||||
}
|
||||
self.ms.p += 1;
|
||||
},
|
||||
&Line::Query(ref query) => {
|
||||
for query_instr in query {
|
||||
self.ms.execute_query_instr(&query_instr);
|
||||
}
|
||||
self.ms.p += 1;
|
||||
},
|
||||
&Line::Control(ref control_instr) =>
|
||||
self.ms.execute_ctrl_instr(&self.code_dir, control_instr),
|
||||
}
|
||||
|
||||
if self.failed() {
|
||||
return false;
|
||||
}
|
||||
|
||||
match self.ms.p {
|
||||
CodePtr::DirEntry(p) if p < self.code.len() =>
|
||||
instr = &self.code[p],
|
||||
_ => break
|
||||
}
|
||||
}
|
||||
|
||||
true
|
||||
}
|
||||
|
||||
fn heap_view(&self, var_dir: HashMap<&Var, HeapCellRef>) -> String {
|
||||
let mut result = String::new();
|
||||
|
||||
for (var, hcr) in var_dir {
|
||||
let mut arities = Vec::new();
|
||||
let viewer = HeapCellViewer::new(&self.ms.heap, hcr.heap_offset());
|
||||
|
||||
if result != "" {
|
||||
result += "\n";
|
||||
}
|
||||
|
||||
result += var.as_str();
|
||||
result += " = ";
|
||||
|
||||
for view in viewer {
|
||||
match arities.pop() {
|
||||
Some(n) => arities.push(n-1),
|
||||
None => {}
|
||||
}
|
||||
|
||||
if !(arities.is_empty() || result.ends_with("(")) {
|
||||
result += ", ";
|
||||
}
|
||||
|
||||
match view {
|
||||
HeapCellView::Str(arity, ref name) => {
|
||||
result += name.as_str();
|
||||
|
||||
if arity > 0 {
|
||||
arities.push(arity);
|
||||
result += "(";
|
||||
}
|
||||
},
|
||||
HeapCellView::Var(cell_num) => {
|
||||
result += "_";
|
||||
result += cell_num.to_string().as_str();
|
||||
}
|
||||
}
|
||||
|
||||
while let Some(&0) = arities.last() {
|
||||
result += ")";
|
||||
arities.pop();
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
result
|
||||
}
|
||||
|
||||
pub fn run_query(&mut self, code: Code, cg: &CodeGenerator) -> Option<String>
|
||||
{
|
||||
let mut succeeded = true;
|
||||
|
||||
for instr in code.iter().take(1) {
|
||||
succeeded = self.execute_instr(&instr);
|
||||
}
|
||||
|
||||
let mut heap_locs = HashMap::new();
|
||||
|
||||
if succeeded {
|
||||
for (var, vr) in cg.vars() {
|
||||
let hcr = self.ms.registers[vr.root_register()];
|
||||
heap_locs.insert(*var, hcr);
|
||||
}
|
||||
|
||||
for instr in code.iter().skip(1) {
|
||||
succeeded = self.execute_instr(&instr);
|
||||
if !succeeded {
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if succeeded {
|
||||
Some(self.heap_view(heap_locs))
|
||||
} else {
|
||||
None
|
||||
}
|
||||
}
|
||||
|
||||
pub fn reset(&mut self) {
|
||||
self.ms.reset();
|
||||
}
|
||||
}
|
||||
|
||||
impl MachineState {
|
||||
fn new() -> MachineState {
|
||||
MachineState { h: 0,
|
||||
s: 0,
|
||||
p: CodePtr::TopLevel,
|
||||
cp: CodePtr::TopLevel,
|
||||
fail: false,
|
||||
heap: Vec::with_capacity(256),
|
||||
mode: MachineMode::Write,
|
||||
stack: Stack::new(),
|
||||
registers: vec![HeapCellRef::Ref(0); 32] }
|
||||
}
|
||||
|
||||
fn register_mut(&mut self, r: RegType) -> &mut HeapCellRef {
|
||||
match r {
|
||||
RegType::Temp(r) => &mut self.registers[r],
|
||||
RegType::Perm(r) => &mut self.stack[r]
|
||||
}
|
||||
}
|
||||
|
||||
fn lookup(&self, a: Addr) -> HeapCellRef {
|
||||
match a {
|
||||
Addr::HeapCell(r) => self.heap[r].as_ref(r),
|
||||
Addr::RegNum(r) => self.registers[r],
|
||||
Addr::StackCell(s) => self.stack[s]
|
||||
}
|
||||
}
|
||||
|
||||
fn deref(&self, a: Addr) -> Addr {
|
||||
let mut a = a;
|
||||
|
||||
loop {
|
||||
if let HeapCellRef::Ref(value) = self.lookup(a) {
|
||||
if let Addr::HeapCell(av) = a {
|
||||
if value != av {
|
||||
a = Addr::HeapCell(value);
|
||||
continue;
|
||||
}
|
||||
} else {
|
||||
a = Addr::HeapCell(value);
|
||||
continue;
|
||||
}
|
||||
}
|
||||
|
||||
return a;
|
||||
};
|
||||
}
|
||||
|
||||
fn is_unbound(hc: &HeapCellValue, index: usize) -> bool {
|
||||
match hc {
|
||||
&HeapCellValue::Ref(r) => r == index,
|
||||
_ => false
|
||||
}
|
||||
}
|
||||
|
||||
fn bind(&mut self, a: Addr, val: usize) {
|
||||
let mut a = a;
|
||||
|
||||
loop {
|
||||
match a {
|
||||
addr @ Addr::RegNum(_) | addr @ Addr::StackCell(_) => {
|
||||
if let HeapCellRef::Ref(hc) = self.lookup(addr) {
|
||||
a = Addr::HeapCell(hc);
|
||||
} else if Self::is_unbound(&self.heap[val], val) {
|
||||
self.heap[val] = HeapCellValue::from(self.lookup(addr));
|
||||
break;
|
||||
} else {
|
||||
self.fail = true;
|
||||
break;
|
||||
}
|
||||
},
|
||||
Addr::HeapCell(hc) => {
|
||||
if Self::is_unbound(&self.heap[hc], hc) {
|
||||
self.heap[hc] = HeapCellValue::Ref(val);
|
||||
break;
|
||||
} else if Self::is_unbound(&self.heap[val], val) {
|
||||
self.heap[val] = HeapCellValue::Ref(hc);
|
||||
break;
|
||||
} else {
|
||||
self.fail = true;
|
||||
break;
|
||||
}
|
||||
}
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
fn unify(&mut self, a1: Addr, a2: Addr) {
|
||||
let mut pdl = vec![a1, a2];
|
||||
|
||||
self.fail = false;
|
||||
|
||||
while !(pdl.is_empty() || self.fail) {
|
||||
let d1 = self.deref(pdl.pop().unwrap());
|
||||
let d2 = self.deref(pdl.pop().unwrap());
|
||||
|
||||
if d1 != d2 {
|
||||
match (self.lookup(d1), self.lookup(d2)) {
|
||||
(HeapCellRef::Ref(hc), _) =>
|
||||
self.bind(d2, hc),
|
||||
(_, HeapCellRef::Ref(hc)) =>
|
||||
self.bind(d1, hc),
|
||||
(HeapCellRef::Str(a1), HeapCellRef::Str(a2)) => {
|
||||
let r1 = &self.heap[a1];
|
||||
let r2 = &self.heap[a2];
|
||||
|
||||
if let &HeapCellValue::NamedStr(n1, ref f1) = r1 {
|
||||
if let &HeapCellValue::NamedStr(n2, ref f2) = r2 {
|
||||
if n1 == n2 && *f1 == *f2 {
|
||||
for i in 1 .. n1 + 1 {
|
||||
pdl.push(Addr::HeapCell(a1 + i));
|
||||
pdl.push(Addr::HeapCell(a2 + i));
|
||||
}
|
||||
|
||||
continue;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
self.fail = true;
|
||||
},
|
||||
};
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn execute_query_instr(&mut self, instr: &QueryInstruction) {
|
||||
match instr {
|
||||
&QueryInstruction::PutStructure(_, ref name, arity, reg) => {
|
||||
self.heap.push(HeapCellValue::Str(self.h + 1));
|
||||
self.heap.push(HeapCellValue::NamedStr(arity, name.clone()));
|
||||
|
||||
*self.register_mut(reg) = HeapCellRef::Str(self.h + 1);
|
||||
|
||||
self.h += 2;
|
||||
},
|
||||
&QueryInstruction::PutValue(norm, arg) =>
|
||||
self.registers[arg] = match norm {
|
||||
RegType::Temp(reg) => self.registers[reg],
|
||||
RegType::Perm(reg) => self.stack[reg]
|
||||
},
|
||||
&QueryInstruction::PutVariable(norm, arg) => {
|
||||
self.heap.push(HeapCellValue::Ref(self.h));
|
||||
|
||||
*self.register_mut(norm) = HeapCellRef::Ref(self.h);
|
||||
self.registers[arg] = HeapCellRef::Ref(self.h);
|
||||
|
||||
self.h += 1;
|
||||
},
|
||||
&QueryInstruction::SetVariable(reg) => {
|
||||
self.heap.push(HeapCellValue::Ref(self.h));
|
||||
*self.register_mut(reg) = HeapCellRef::Ref(self.h);
|
||||
|
||||
self.h += 1;
|
||||
},
|
||||
&QueryInstruction::SetValue(reg) => {
|
||||
let heap_val = self.lookup(Addr::from(reg));
|
||||
self.heap.push(HeapCellValue::from(heap_val));
|
||||
|
||||
self.h += 1;
|
||||
},
|
||||
}
|
||||
}
|
||||
|
||||
fn execute_fact_instr(&mut self, instr: &FactInstruction) {
|
||||
match instr {
|
||||
&FactInstruction::GetStructure(_, ref name, arity, reg) => {
|
||||
let addr = self.deref(Addr::from(reg));
|
||||
|
||||
match self.lookup(addr) {
|
||||
HeapCellRef::Str(a) => {
|
||||
let result = &self.heap[a];
|
||||
|
||||
if let &HeapCellValue::NamedStr(narity, ref str) = result {
|
||||
if narity == arity && *name == *str {
|
||||
self.s = a + 1;
|
||||
self.mode = MachineMode::Read;
|
||||
} else {
|
||||
self.fail = true;
|
||||
}
|
||||
}
|
||||
},
|
||||
HeapCellRef::Ref(_) => {
|
||||
self.heap.push(HeapCellValue::Str(self.h + 1));
|
||||
self.heap.push(HeapCellValue::NamedStr(arity, name.clone()));
|
||||
|
||||
let h = self.h;
|
||||
|
||||
self.bind(addr, h);
|
||||
|
||||
self.h += 2;
|
||||
self.mode = MachineMode::Write;
|
||||
}
|
||||
};
|
||||
},
|
||||
&FactInstruction::GetVariable(norm, arg) =>
|
||||
*self.register_mut(norm) = self.registers[arg],
|
||||
&FactInstruction::GetValue(norm, arg) =>
|
||||
self.unify(Addr::from(norm), Addr::RegNum(arg)),
|
||||
&FactInstruction::UnifyVariable(reg) => {
|
||||
match self.mode {
|
||||
MachineMode::Read =>
|
||||
*self.register_mut(reg) = self.heap[self.s].as_ref(self.s),
|
||||
MachineMode::Write => {
|
||||
self.heap.push(HeapCellValue::Ref(self.h));
|
||||
*self.register_mut(reg) = HeapCellRef::Ref(self.h);
|
||||
self.h += 1;
|
||||
}
|
||||
};
|
||||
|
||||
self.s += 1;
|
||||
},
|
||||
&FactInstruction::UnifyValue(reg) => {
|
||||
let s = self.s;
|
||||
|
||||
match self.mode {
|
||||
MachineMode::Read =>
|
||||
self.unify(Addr::from(reg), Addr::HeapCell(s)),
|
||||
MachineMode::Write => {
|
||||
let heap_val = self.lookup(Addr::from(reg));
|
||||
self.heap.push(HeapCellValue::from(heap_val));
|
||||
self.h += 1;
|
||||
}
|
||||
};
|
||||
|
||||
self.s += 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn execute_ctrl_instr(&mut self, code_dir: &CodeDir, instr: &ControlInstruction)
|
||||
{
|
||||
match instr {
|
||||
&ControlInstruction::Allocate(num_cells) => {
|
||||
self.stack.push(self.cp, num_cells);
|
||||
self.p += 1;
|
||||
},
|
||||
&ControlInstruction::Call(ref name, arity) => {
|
||||
let compiled_tl_index = code_dir.get(&(name.clone(), arity))
|
||||
.map(|index| *index);
|
||||
|
||||
match compiled_tl_index {
|
||||
Some(compiled_tl_index) => {
|
||||
self.cp = self.p + 1;
|
||||
self.p = CodePtr::DirEntry(compiled_tl_index);
|
||||
},
|
||||
None => self.fail = true
|
||||
};
|
||||
},
|
||||
&ControlInstruction::Deallocate => {
|
||||
self.p = self.stack.get_cp();
|
||||
self.stack.pop();
|
||||
},
|
||||
&ControlInstruction::Proceed =>
|
||||
self.p = self.cp,
|
||||
};
|
||||
}
|
||||
|
||||
fn reset(&mut self) {
|
||||
self.h = 0;
|
||||
self.s = 0;
|
||||
self.p = CodePtr::TopLevel;
|
||||
self.cp = CodePtr::TopLevel;
|
||||
|
||||
self.fail = false;
|
||||
self.heap.clear();
|
||||
self.mode = MachineMode::Write;
|
||||
self.stack = Stack::new();
|
||||
self.registers = vec![HeapCellRef::Ref(0); 32];
|
||||
}
|
||||
}
|
||||
@@ -1,7 +0,0 @@
|
||||
pub mod ast;
|
||||
pub mod heapview;
|
||||
pub mod iterators;
|
||||
pub mod l2_parser;
|
||||
pub mod codegen;
|
||||
pub mod machine;
|
||||
pub mod stack;
|
||||
@@ -1,60 +0,0 @@
|
||||
use l2::ast::*;
|
||||
|
||||
use std::ops::{Index, IndexMut};
|
||||
use std::vec::Vec;
|
||||
|
||||
struct Frame {
|
||||
cp: CodePtr,
|
||||
perms: Vec<HeapCellRef>
|
||||
}
|
||||
|
||||
impl Frame {
|
||||
fn new(cp: CodePtr, n: usize) -> Self {
|
||||
Frame {
|
||||
cp: cp,
|
||||
perms: vec![HeapCellRef::Ref(0); n]
|
||||
}
|
||||
}
|
||||
|
||||
fn read_pv(&self, i: usize) -> &HeapCellRef {
|
||||
self.perms.index(i)
|
||||
}
|
||||
|
||||
fn read_pv_mut(&mut self, i: usize) -> &mut HeapCellRef {
|
||||
self.perms.index_mut(i)
|
||||
}
|
||||
}
|
||||
|
||||
pub struct Stack(Vec<Frame>);
|
||||
|
||||
impl Stack {
|
||||
pub fn new() -> Self {
|
||||
Stack(Vec::new())
|
||||
}
|
||||
|
||||
pub fn push(&mut self, cp: CodePtr, n: usize) {
|
||||
self.0.push(Frame::new(cp, n));
|
||||
}
|
||||
|
||||
pub fn get_cp(&self) -> CodePtr {
|
||||
self.0.last().unwrap().cp
|
||||
}
|
||||
|
||||
pub fn pop(&mut self) {
|
||||
self.0.pop();
|
||||
}
|
||||
}
|
||||
|
||||
impl Index<usize> for Stack {
|
||||
type Output = HeapCellRef;
|
||||
|
||||
fn index(&self, index: usize) -> &Self::Output {
|
||||
self.0.last().unwrap().read_pv(index - 1)
|
||||
}
|
||||
}
|
||||
|
||||
impl IndexMut<usize> for Stack {
|
||||
fn index_mut(&mut self, index: usize) -> &mut Self::Output {
|
||||
self.0.last_mut().unwrap().read_pv_mut(index - 1)
|
||||
}
|
||||
}
|
||||
@@ -1,80 +0,0 @@
|
||||
use l3::ast::*;
|
||||
|
||||
use std::ops::{Index, IndexMut};
|
||||
use std::vec::Vec;
|
||||
|
||||
pub struct Frame {
|
||||
pub global_index: usize,
|
||||
pub e: usize,
|
||||
pub cp: CodePtr,
|
||||
perms: Vec<Addr>
|
||||
}
|
||||
|
||||
impl Frame {
|
||||
fn new(global_index: usize, e: usize, cp: CodePtr, n: usize) -> Self {
|
||||
Frame {
|
||||
global_index: global_index,
|
||||
e: e,
|
||||
cp: cp,
|
||||
perms: vec![Addr::HeapCell(0); n]
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub struct AndStack(Vec<Frame>);
|
||||
|
||||
impl AndStack {
|
||||
pub fn new() -> Self {
|
||||
AndStack(Vec::new())
|
||||
}
|
||||
|
||||
pub fn push(&mut self, global_index: usize, e: usize, cp: CodePtr, n: usize) {
|
||||
self.0.push(Frame::new(global_index, e, cp, n));
|
||||
}
|
||||
|
||||
pub fn top(&self) -> Option<&Frame> {
|
||||
self.0.last()
|
||||
}
|
||||
|
||||
pub fn len(&self) -> usize {
|
||||
self.0.len()
|
||||
}
|
||||
|
||||
pub fn clear(&mut self) {
|
||||
self.0.clear()
|
||||
}
|
||||
|
||||
// drop the last n frames.
|
||||
pub fn drop_frames(&mut self, n: usize) {
|
||||
let len = self.0.len();
|
||||
self.0.truncate(len - n);
|
||||
}
|
||||
}
|
||||
|
||||
impl Index<usize> for AndStack {
|
||||
type Output = Frame;
|
||||
|
||||
fn index(&self, index: usize) -> &Self::Output {
|
||||
self.0.index(index)
|
||||
}
|
||||
}
|
||||
|
||||
impl IndexMut<usize> for AndStack {
|
||||
fn index_mut(&mut self, index: usize) -> &mut Self::Output {
|
||||
self.0.index_mut(index)
|
||||
}
|
||||
}
|
||||
|
||||
impl Index<usize> for Frame {
|
||||
type Output = Addr;
|
||||
|
||||
fn index(&self, index: usize) -> &Self::Output {
|
||||
self.perms.index(index - 1)
|
||||
}
|
||||
}
|
||||
|
||||
impl IndexMut<usize> for Frame {
|
||||
fn index_mut(&mut self, index: usize) -> &mut Self::Output {
|
||||
self.perms.index_mut(index - 1)
|
||||
}
|
||||
}
|
||||
303
src/l3/ast.rs
303
src/l3/ast.rs
@@ -1,303 +0,0 @@
|
||||
use std::cell::Cell;
|
||||
use std::collections::HashMap;
|
||||
use std::ops::{Add, AddAssign};
|
||||
use std::vec::Vec;
|
||||
|
||||
pub type Var = String;
|
||||
|
||||
pub type Atom = String;
|
||||
|
||||
pub enum PredicateClause {
|
||||
Fact(Term),
|
||||
Rule(Rule)
|
||||
}
|
||||
|
||||
impl PredicateClause {
|
||||
pub fn name(&self) -> &Atom {
|
||||
match self {
|
||||
&PredicateClause::Fact(ref t) => t.name(),
|
||||
&PredicateClause::Rule(ref rule) => rule.head.0.name()
|
||||
}
|
||||
}
|
||||
|
||||
pub fn arity(&self) -> usize {
|
||||
match self {
|
||||
&PredicateClause::Fact(ref t) => t.arity(),
|
||||
&PredicateClause::Rule(ref rule) => rule.head.0.arity()
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub enum TopLevel {
|
||||
Fact(Term),
|
||||
Predicate(Vec<PredicateClause>),
|
||||
Query(Term),
|
||||
Rule(Rule)
|
||||
}
|
||||
|
||||
#[derive(Clone, Copy)]
|
||||
pub enum Level {
|
||||
Deep, Shallow
|
||||
}
|
||||
|
||||
#[derive(Clone, Copy)]
|
||||
pub enum RegType {
|
||||
Perm(usize),
|
||||
Temp(usize)
|
||||
}
|
||||
|
||||
impl RegType {
|
||||
pub fn reg_num(self) -> usize {
|
||||
match self {
|
||||
RegType::Perm(reg_num) | RegType::Temp(reg_num) => reg_num
|
||||
}
|
||||
}
|
||||
|
||||
pub fn is_perm(self) -> bool {
|
||||
match self {
|
||||
RegType::Perm(_) => true,
|
||||
_ => false
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Clone, Copy)]
|
||||
pub enum VarReg {
|
||||
ArgAndNorm(RegType, usize),
|
||||
Norm(RegType)
|
||||
}
|
||||
|
||||
impl VarReg {
|
||||
pub fn norm(self) -> RegType {
|
||||
match self {
|
||||
VarReg::ArgAndNorm(reg, _) | VarReg::Norm(reg) => reg
|
||||
}
|
||||
}
|
||||
|
||||
pub fn root_register(self) -> usize {
|
||||
match self {
|
||||
VarReg::ArgAndNorm(_, root) => root,
|
||||
VarReg::Norm(root) => root.reg_num()
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub enum Term {
|
||||
Atom(Cell<RegType>, Atom),
|
||||
Clause(Cell<RegType>, Atom, Vec<Box<Term>>),
|
||||
Var(Cell<VarReg>, Var)
|
||||
}
|
||||
|
||||
pub struct Rule {
|
||||
pub head: (Term, Term),
|
||||
pub clauses: Vec<Term>
|
||||
}
|
||||
|
||||
pub enum TermRef<'a> {
|
||||
Atom(Level, &'a Cell<RegType>, &'a Atom),
|
||||
Clause(Level, &'a Cell<RegType>, &'a Atom, &'a Vec<Box<Term>>),
|
||||
Var(Level, &'a Cell<VarReg>, &'a Var)
|
||||
}
|
||||
|
||||
pub enum FactInstruction {
|
||||
GetStructure(Level, Atom, usize, RegType),
|
||||
GetValue(RegType, usize),
|
||||
GetVariable(RegType, usize),
|
||||
UnifyVariable(RegType),
|
||||
UnifyValue(RegType)
|
||||
}
|
||||
|
||||
pub enum QueryInstruction {
|
||||
PutStructure(Level, Atom, usize, RegType),
|
||||
PutValue(RegType, usize),
|
||||
PutVariable(RegType, usize),
|
||||
SetVariable(RegType),
|
||||
SetValue(RegType)
|
||||
}
|
||||
|
||||
pub enum ChoiceInstruction {
|
||||
RetryMeElse(usize),
|
||||
TrustMe,
|
||||
TryMeElse(usize)
|
||||
}
|
||||
|
||||
pub enum ControlInstruction {
|
||||
Allocate(usize),
|
||||
Call(Atom, usize),
|
||||
Deallocate,
|
||||
Proceed
|
||||
}
|
||||
|
||||
pub type CompiledFact = Vec<FactInstruction>;
|
||||
|
||||
pub type CompiledQuery = Vec<QueryInstruction>;
|
||||
|
||||
pub enum Line {
|
||||
Choice(ChoiceInstruction),
|
||||
Control(ControlInstruction),
|
||||
Fact(CompiledFact),
|
||||
Query(CompiledQuery)
|
||||
}
|
||||
|
||||
pub enum LineOrCodeOffset<'a> {
|
||||
Instruction(&'a Line),
|
||||
Offset(usize)
|
||||
}
|
||||
|
||||
impl<'a> From<&'a Line> for LineOrCodeOffset<'a> {
|
||||
fn from(line: &'a Line) -> Self {
|
||||
LineOrCodeOffset::Instruction(line)
|
||||
}
|
||||
}
|
||||
|
||||
pub type Code = Vec<Line>;
|
||||
|
||||
#[derive(Clone, Copy, PartialEq)]
|
||||
pub enum Addr {
|
||||
HeapCell(usize),
|
||||
StackCell(usize, usize),
|
||||
Str(usize)
|
||||
}
|
||||
|
||||
impl Addr {
|
||||
pub fn is_ref(self) -> bool {
|
||||
match self {
|
||||
Addr::HeapCell(_) | Addr::StackCell(_, _) => true,
|
||||
_ => false
|
||||
}
|
||||
}
|
||||
|
||||
pub fn as_ref(self) -> Option<Ref> {
|
||||
match self {
|
||||
Addr::HeapCell(hc) => Some(Ref::HeapCell(hc)),
|
||||
Addr::StackCell(fr, sc) => Some(Ref::StackCell(fr, sc)),
|
||||
_ => None
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl From<Ref> for Addr {
|
||||
fn from(r: Ref) -> Self {
|
||||
match r {
|
||||
Ref::HeapCell(hc) => Addr::HeapCell(hc),
|
||||
Ref::StackCell(fr, sc) => Addr::StackCell(fr, sc)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Clone, Copy, PartialEq)]
|
||||
pub enum Ref {
|
||||
HeapCell(usize),
|
||||
StackCell(usize, usize)
|
||||
}
|
||||
|
||||
#[derive(Clone, PartialEq)]
|
||||
pub enum HeapCellValue {
|
||||
NamedStr(usize, Atom),
|
||||
Ref(Ref),
|
||||
Str(usize)
|
||||
}
|
||||
|
||||
impl From<Addr> for HeapCellValue {
|
||||
fn from(addr: Addr) -> HeapCellValue {
|
||||
match addr {
|
||||
Addr::HeapCell(hc) =>
|
||||
HeapCellValue::Ref(Ref::HeapCell(hc)),
|
||||
Addr::StackCell(fr, sc) =>
|
||||
HeapCellValue::Ref(Ref::StackCell(fr, sc)),
|
||||
Addr::Str(hc) =>
|
||||
HeapCellValue::Str(hc)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl HeapCellValue {
|
||||
pub fn as_addr(&self, focus: usize) -> Addr {
|
||||
match self {
|
||||
&HeapCellValue::Ref(r) => Addr::from(r),
|
||||
&HeapCellValue::Str(s) => Addr::Str(s),
|
||||
&HeapCellValue::NamedStr(_, _) => Addr::Str(focus)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Clone, Copy)]
|
||||
pub enum CodePtr {
|
||||
DirEntry(usize),
|
||||
TopLevel
|
||||
}
|
||||
|
||||
impl Default for CodePtr {
|
||||
fn default() -> Self {
|
||||
CodePtr::TopLevel
|
||||
}
|
||||
}
|
||||
|
||||
impl Add<usize> for CodePtr {
|
||||
type Output = CodePtr;
|
||||
|
||||
fn add(self, rhs: usize) -> Self::Output {
|
||||
match self {
|
||||
CodePtr::DirEntry(p) => CodePtr::DirEntry(p + rhs),
|
||||
CodePtr::TopLevel => CodePtr::TopLevel
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl AddAssign<usize> for CodePtr {
|
||||
fn add_assign(&mut self, rhs: usize) {
|
||||
match self {
|
||||
&mut CodePtr::DirEntry(ref mut p) => *p += rhs,
|
||||
_ => {}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub type Heap = Vec<HeapCellValue>;
|
||||
|
||||
pub type Registers = Vec<Addr>;
|
||||
|
||||
impl Term {
|
||||
pub fn subterms(&self) -> usize {
|
||||
match self {
|
||||
&Term::Clause(_, _, ref terms) => terms.len(),
|
||||
_ => 1
|
||||
}
|
||||
}
|
||||
|
||||
pub fn name(&self) -> &Atom {
|
||||
match self {
|
||||
&Term::Atom(_, ref atom)
|
||||
| &Term::Var(_, ref atom)
|
||||
| &Term::Clause(_, ref atom, _) => atom
|
||||
}
|
||||
}
|
||||
|
||||
pub fn arity(&self) -> usize {
|
||||
match self {
|
||||
&Term::Atom(_, _) | &Term::Var(_, _) => 0,
|
||||
&Term::Clause(_, _, ref child_terms) => child_terms.len()
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub type HeapVarDict = HashMap<Var, Addr>;
|
||||
|
||||
pub enum EvalResult {
|
||||
EntryFailure,
|
||||
EntrySuccess,
|
||||
InitialQuerySuccess(HeapVarDict),
|
||||
QueryFailure,
|
||||
SubsequentQuerySuccess,
|
||||
}
|
||||
|
||||
impl EvalResult {
|
||||
#[allow(dead_code)]
|
||||
pub fn failed_query(&self) -> bool {
|
||||
if let &EvalResult::QueryFailure = self {
|
||||
true
|
||||
} else {
|
||||
false
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -1,447 +0,0 @@
|
||||
use l3::ast::*;
|
||||
use l3::iterators::{FactIterator, QueryIterator};
|
||||
|
||||
use std::cell::Cell;
|
||||
use std::cmp::max;
|
||||
use std::collections::HashMap;
|
||||
use std::vec::Vec;
|
||||
|
||||
trait CompilationTarget<'a> {
|
||||
type Iterator : Iterator<Item=TermRef<'a>>;
|
||||
|
||||
fn iter(&'a Term) -> Self::Iterator;
|
||||
|
||||
fn to_structure(Level, Atom, usize, RegType) -> Self;
|
||||
|
||||
fn argument_to_variable(RegType, usize) -> Self;
|
||||
fn argument_to_value(RegType, usize) -> Self;
|
||||
fn subterm_to_variable(RegType) -> Self;
|
||||
fn subterm_to_value(RegType) -> Self;
|
||||
|
||||
fn clause_arg_to_instr(RegType) -> Self;
|
||||
}
|
||||
|
||||
impl<'a> CompilationTarget<'a> for FactInstruction {
|
||||
type Iterator = FactIterator<'a>;
|
||||
|
||||
fn iter(term: &'a Term) -> Self::Iterator {
|
||||
term.breadth_first_iter()
|
||||
}
|
||||
|
||||
fn to_structure(lvl: Level, atom: Atom, arity: usize, reg: RegType) -> Self {
|
||||
FactInstruction::GetStructure(lvl, atom, arity, reg)
|
||||
}
|
||||
|
||||
fn argument_to_variable(arg: RegType, val: usize) -> Self {
|
||||
FactInstruction::GetVariable(arg, val)
|
||||
}
|
||||
|
||||
fn argument_to_value(arg: RegType, val: usize) -> Self {
|
||||
FactInstruction::GetValue(arg, val)
|
||||
}
|
||||
|
||||
fn subterm_to_variable(val: RegType) -> Self {
|
||||
FactInstruction::UnifyVariable(val)
|
||||
}
|
||||
|
||||
fn subterm_to_value(val: RegType) -> Self {
|
||||
FactInstruction::UnifyValue(val)
|
||||
}
|
||||
|
||||
fn clause_arg_to_instr(val: RegType) -> Self {
|
||||
FactInstruction::UnifyVariable(val)
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> CompilationTarget<'a> for QueryInstruction {
|
||||
type Iterator = QueryIterator<'a>;
|
||||
|
||||
fn iter(term: &'a Term) -> Self::Iterator {
|
||||
term.post_order_iter()
|
||||
}
|
||||
|
||||
fn to_structure(lvl: Level, atom: Atom, arity: usize, reg: RegType) -> Self {
|
||||
QueryInstruction::PutStructure(lvl, atom, arity, reg)
|
||||
}
|
||||
|
||||
fn argument_to_variable(arg: RegType, val: usize) -> Self {
|
||||
QueryInstruction::PutVariable(arg, val)
|
||||
}
|
||||
|
||||
fn argument_to_value(arg: RegType, val: usize) -> Self {
|
||||
QueryInstruction::PutValue(arg, val)
|
||||
}
|
||||
|
||||
fn subterm_to_variable(val: RegType) -> Self {
|
||||
QueryInstruction::SetVariable(val)
|
||||
}
|
||||
|
||||
fn subterm_to_value(val: RegType) -> Self {
|
||||
QueryInstruction::SetValue(val)
|
||||
}
|
||||
|
||||
fn clause_arg_to_instr(val: RegType) -> Self {
|
||||
QueryInstruction::SetValue(val)
|
||||
}
|
||||
}
|
||||
|
||||
struct TermMarker<'a> {
|
||||
bindings: HashMap<&'a Var, VarReg>,
|
||||
arg_c: usize,
|
||||
perm_c: usize,
|
||||
temp_c: usize
|
||||
}
|
||||
|
||||
impl<'a> TermMarker<'a> {
|
||||
fn new() -> TermMarker<'a> {
|
||||
TermMarker { bindings: HashMap::new(),
|
||||
arg_c: 1,
|
||||
perm_c: 1,
|
||||
temp_c: 1 }
|
||||
}
|
||||
|
||||
fn reset(&mut self) {
|
||||
self.bindings.clear();
|
||||
self.perm_c = 1;
|
||||
}
|
||||
|
||||
fn contains_var(&self, var: &'a Var) -> bool {
|
||||
self.bindings.contains_key(var)
|
||||
}
|
||||
|
||||
fn get(&self, var: &'a Var) -> VarReg {
|
||||
*self.bindings.get(var).unwrap()
|
||||
}
|
||||
|
||||
fn insert(&mut self, var: &'a Var, r: VarReg) {
|
||||
self.bindings.insert(var, r);
|
||||
}
|
||||
|
||||
fn mark_non_var(&mut self, lvl: Level, cell: &Cell<RegType>) {
|
||||
let reg_type = cell.get();
|
||||
|
||||
if reg_type.reg_num() == 0 {
|
||||
match lvl {
|
||||
Level::Deep if reg_type.is_perm() => {
|
||||
let perm = self.perm_c;
|
||||
self.perm_c += 1;
|
||||
cell.set(RegType::Perm(perm));
|
||||
},
|
||||
Level::Deep => {
|
||||
let temp = self.temp_c;
|
||||
self.temp_c += 1;
|
||||
cell.set(RegType::Temp(temp));
|
||||
},
|
||||
Level::Shallow if reg_type.is_perm() => {
|
||||
let arg = self.arg_c;
|
||||
self.arg_c += 1;
|
||||
cell.set(RegType::Perm(arg));
|
||||
},
|
||||
Level::Shallow => {
|
||||
let arg = self.arg_c;
|
||||
self.arg_c += 1;
|
||||
cell.set(RegType::Temp(arg));
|
||||
}
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
fn mark_old_var(&mut self, lvl: Level, var: &'a Var) -> VarReg
|
||||
{
|
||||
let reg = self.get(var);
|
||||
|
||||
match lvl {
|
||||
Level::Deep => VarReg::Norm(reg.norm()),
|
||||
Level::Shallow => {
|
||||
let reg = VarReg::ArgAndNorm(reg.norm(), self.arg_c);
|
||||
|
||||
self.arg_c += 1;
|
||||
self.insert(var, reg);
|
||||
|
||||
reg
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn mark_new_var(&mut self, lvl: Level, var: &'a Var, reg: RegType) -> VarReg
|
||||
{
|
||||
let inner_reg = if reg.is_perm() {
|
||||
let perm = self.perm_c;
|
||||
self.perm_c += 1;
|
||||
RegType::Perm(perm)
|
||||
} else {
|
||||
let temp = self.temp_c;
|
||||
self.temp_c += 1;
|
||||
RegType::Temp(temp)
|
||||
};
|
||||
|
||||
let reg = match lvl {
|
||||
Level::Deep => VarReg::Norm(inner_reg),
|
||||
Level::Shallow => {
|
||||
let reg = VarReg::ArgAndNorm(inner_reg, self.arg_c);
|
||||
self.arg_c += 1;
|
||||
reg
|
||||
}
|
||||
};
|
||||
|
||||
self.insert(var, reg);
|
||||
reg
|
||||
}
|
||||
|
||||
fn advance_at_head(&mut self, term: &'a Term) {
|
||||
self.arg_c = 1;
|
||||
self.temp_c = max(term.subterms(), self.temp_c) + 1;
|
||||
}
|
||||
|
||||
fn advance(&mut self, term: &'a Term) {
|
||||
self.arg_c = 1;
|
||||
self.temp_c = term.subterms() + 1;
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Copy, Clone)]
|
||||
enum TermStatus {
|
||||
New, Old, Recurrent
|
||||
}
|
||||
|
||||
pub struct CodeGenerator<'a> {
|
||||
marker: TermMarker<'a>
|
||||
}
|
||||
|
||||
type VariableFixture<'a> = (TermStatus, Vec<&'a Cell<VarReg>>);
|
||||
type VariableFixtures<'a> = HashMap<&'a Var, VariableFixture<'a>>;
|
||||
|
||||
impl<'a> CodeGenerator<'a> {
|
||||
pub fn new() -> Self {
|
||||
CodeGenerator { marker: TermMarker::new() }
|
||||
}
|
||||
|
||||
pub fn vars(&self) -> &HashMap<&Var, VarReg> {
|
||||
&self.marker.bindings
|
||||
}
|
||||
|
||||
fn to_structure<Target>(&mut self,
|
||||
lvl: Level,
|
||||
name: &'a Atom,
|
||||
cell: &'a Cell<RegType>,
|
||||
arity: usize)
|
||||
-> Target
|
||||
where Target: CompilationTarget<'a>
|
||||
{
|
||||
self.marker.mark_non_var(lvl, cell);
|
||||
Target::to_structure(lvl, name.clone(), arity, cell.get())
|
||||
}
|
||||
|
||||
fn var_term<Target>(&mut self,
|
||||
lvl: Level,
|
||||
cell: &'a Cell<VarReg>,
|
||||
var: &'a Var)
|
||||
-> Target
|
||||
where Target: CompilationTarget<'a>
|
||||
{
|
||||
if !self.marker.contains_var(var) {
|
||||
let reg = self.marker.mark_new_var(lvl, var, cell.get().norm());
|
||||
cell.set(reg);
|
||||
|
||||
match reg {
|
||||
VarReg::ArgAndNorm(arg, norm) =>
|
||||
Target::argument_to_variable(arg, norm),
|
||||
VarReg::Norm(norm) =>
|
||||
Target::subterm_to_variable(norm)
|
||||
}
|
||||
} else {
|
||||
let reg = self.marker.mark_old_var(lvl, var);
|
||||
cell.set(reg);
|
||||
|
||||
match reg {
|
||||
VarReg::ArgAndNorm(arg, norm) =>
|
||||
Target::argument_to_value(arg, norm),
|
||||
VarReg::Norm(norm) =>
|
||||
Target::subterm_to_value(norm)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn non_var_subterm<Target>(&mut self, cell: &'a Cell<RegType>) -> Target
|
||||
where Target: CompilationTarget<'a>
|
||||
{
|
||||
self.marker.mark_non_var(Level::Deep, cell);
|
||||
Target::clause_arg_to_instr(cell.get())
|
||||
}
|
||||
|
||||
fn subterm_to_instr<Target>(&mut self, subterm: &'a Term) -> Target
|
||||
where Target: CompilationTarget<'a>
|
||||
{
|
||||
match subterm {
|
||||
&Term::Atom(ref cell, _) | &Term::Clause(ref cell, _, _) =>
|
||||
self.non_var_subterm(cell),
|
||||
&Term::Var(ref cell, ref var) =>
|
||||
self.var_term(Level::Deep, cell, var)
|
||||
}
|
||||
}
|
||||
|
||||
fn compile_target<Target>(&mut self, term: &'a Term) -> Vec<Target>
|
||||
where Target: CompilationTarget<'a>
|
||||
{
|
||||
let iter = Target::iter(term);
|
||||
let mut target = Vec::new();
|
||||
|
||||
for term in iter {
|
||||
match term {
|
||||
TermRef::Atom(lvl, term, atom) =>
|
||||
target.push(self.to_structure(lvl, atom, term, 0)),
|
||||
TermRef::Clause(lvl, term, atom, terms) => {
|
||||
target.push(self.to_structure(lvl, atom, term, terms.len()));
|
||||
|
||||
for subterm in terms {
|
||||
target.push(self.subterm_to_instr(subterm.as_ref()));
|
||||
}
|
||||
},
|
||||
TermRef::Var(lvl @ Level::Shallow, ref cell, ref var) =>
|
||||
target.push(self.var_term(lvl, cell, var)),
|
||||
_ => {}
|
||||
};
|
||||
}
|
||||
|
||||
target
|
||||
}
|
||||
|
||||
fn mark_vars_in_term<Iter>(iter: Iter, vs: &mut VariableFixtures<'a>)
|
||||
where Iter : Iterator<Item=TermRef<'a>>
|
||||
{
|
||||
for term in iter {
|
||||
if let TermRef::Var(_, reg_cell, var) = term {
|
||||
let mut status = vs.entry(var)
|
||||
.or_insert((TermStatus::New, Vec::new()));
|
||||
|
||||
status.1.push(reg_cell);
|
||||
|
||||
match status.0 {
|
||||
TermStatus::Old => status.0 = TermStatus::Recurrent,
|
||||
_ => {}
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
for &mut (ref mut term_status, ref mut cb) in vs.values_mut() {
|
||||
match *term_status {
|
||||
TermStatus::New => *term_status = TermStatus::Old,
|
||||
TermStatus::Recurrent => {
|
||||
for cell_reg in cb.drain(0..) {
|
||||
cell_reg.set(VarReg::Norm(RegType::Perm(0)));
|
||||
}
|
||||
},
|
||||
_ => {}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn mark_perm_vars(rule: &'a Rule) -> VariableFixtures {
|
||||
let &Rule { head: (ref p0, ref p1), ref clauses } = rule;
|
||||
let mut vfs = HashMap::new();
|
||||
|
||||
let iter = p0.breadth_first_iter().chain(p1.breadth_first_iter());
|
||||
|
||||
Self::mark_vars_in_term(iter, &mut vfs);
|
||||
|
||||
for term in clauses {
|
||||
Self::mark_vars_in_term(term.breadth_first_iter(), &mut vfs);
|
||||
}
|
||||
|
||||
vfs
|
||||
}
|
||||
|
||||
fn add_conditional_call(compiled_query: &mut Code, term: &Term) {
|
||||
match term {
|
||||
&Term::Atom(_, ref atom) => {
|
||||
let call = ControlInstruction::Call(atom.clone(), 0);
|
||||
compiled_query.push(Line::Control(call));
|
||||
},
|
||||
&Term::Clause(_, ref atom, ref terms) => {
|
||||
let call = ControlInstruction::Call(atom.clone(), terms.len());
|
||||
compiled_query.push(Line::Control(call));
|
||||
},
|
||||
_ => {}
|
||||
}
|
||||
}
|
||||
|
||||
pub fn compile_rule(&mut self, rule: &'a Rule) -> Code {
|
||||
let vfs = Self::mark_perm_vars(&rule);
|
||||
let &Rule { head: (ref p0, ref p1), ref clauses } = rule;
|
||||
let mut perm_vars = 0;
|
||||
|
||||
for &(term_status, _) in vfs.values() {
|
||||
if let TermStatus::Recurrent = term_status {
|
||||
perm_vars += 1;
|
||||
}
|
||||
}
|
||||
|
||||
let mut body = Vec::new();
|
||||
|
||||
body.push(Line::Control(ControlInstruction::Allocate(perm_vars)));
|
||||
|
||||
self.marker.advance(p0);
|
||||
body.push(Line::Fact(self.compile_target(p0)));
|
||||
|
||||
self.marker.advance_at_head(p1);
|
||||
body.push(Line::Query(self.compile_target(p1)));
|
||||
|
||||
Self::add_conditional_call(&mut body, p1);
|
||||
|
||||
body = clauses.iter()
|
||||
.map(|ref term| self.compile_query(term))
|
||||
.fold(body, |mut body, ref mut cqs| {
|
||||
body.append(cqs);
|
||||
body
|
||||
});
|
||||
|
||||
body.push(Line::Control(ControlInstruction::Deallocate));
|
||||
body
|
||||
}
|
||||
|
||||
pub fn compile_fact(&mut self, term: &'a Term) -> Code {
|
||||
self.marker.advance(term);
|
||||
|
||||
let mut compiled_fact = vec![Line::Fact(self.compile_target(term))];
|
||||
let proceed = Line::Control(ControlInstruction::Proceed);
|
||||
|
||||
compiled_fact.push(proceed);
|
||||
compiled_fact
|
||||
}
|
||||
|
||||
pub fn compile_query(&mut self, term: &'a Term) -> Code {
|
||||
self.marker.advance(term);
|
||||
|
||||
let mut compiled_query = vec![Line::Query(self.compile_target(term))];
|
||||
Self::add_conditional_call(&mut compiled_query, term);
|
||||
|
||||
compiled_query
|
||||
}
|
||||
|
||||
pub fn compile_predicate(&mut self, clauses: &'a Vec<PredicateClause>) -> Code
|
||||
{
|
||||
let mut code = Vec::new();
|
||||
|
||||
for (i, clause) in clauses.iter().enumerate() {
|
||||
self.marker.reset();
|
||||
|
||||
let mut clause_code = match clause {
|
||||
&PredicateClause::Fact(ref fact) =>
|
||||
self.compile_fact(fact),
|
||||
&PredicateClause::Rule(ref rule) =>
|
||||
self.compile_rule(rule)
|
||||
};
|
||||
|
||||
let choice = match i {
|
||||
0 => ChoiceInstruction::TryMeElse(clause_code.len() + 1),
|
||||
_ if i == clauses.len() - 1 => ChoiceInstruction::TrustMe,
|
||||
_ => ChoiceInstruction::RetryMeElse(clause_code.len() + 1)
|
||||
};
|
||||
|
||||
code.push(Line::Choice(choice));
|
||||
code.append(&mut clause_code);
|
||||
}
|
||||
|
||||
code
|
||||
}
|
||||
}
|
||||
@@ -1,86 +0,0 @@
|
||||
use l3::and_stack::*;
|
||||
use l3::ast::*;
|
||||
|
||||
use std::vec::Vec;
|
||||
|
||||
#[derive(Clone, Copy)]
|
||||
pub enum HeapCellView<'a> {
|
||||
Str(usize, &'a Atom),
|
||||
HeapVar(usize),
|
||||
StackVar(usize, usize)
|
||||
}
|
||||
|
||||
pub struct HeapCellViewer<'a> {
|
||||
heap: &'a Heap,
|
||||
and_stack: &'a AndStack,
|
||||
state_stack: Vec<Addr>
|
||||
}
|
||||
|
||||
impl<'a> HeapCellViewer<'a> {
|
||||
pub fn new(heap: &'a Heap, and_stack: &'a AndStack, focus: Addr) -> Self {
|
||||
HeapCellViewer {
|
||||
heap: heap,
|
||||
and_stack: and_stack,
|
||||
state_stack: vec![focus]
|
||||
}
|
||||
}
|
||||
|
||||
fn follow_stack_ref(&mut self, mut fr: usize, mut sc: usize) -> HeapCellView<'a>
|
||||
{
|
||||
loop {
|
||||
match self.and_stack[fr][sc] {
|
||||
Addr::HeapCell(hc) | Addr::Str(hc) =>
|
||||
return self.follow_heap_ref(hc),
|
||||
Addr::StackCell(fr1, sc1) => {
|
||||
if fr1 == fr && sc1 == sc {
|
||||
return HeapCellView::StackVar(fr, sc);
|
||||
}
|
||||
|
||||
fr = fr1; sc = sc1;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn follow_heap_ref(&mut self, mut focus: usize) -> HeapCellView<'a> {
|
||||
loop {
|
||||
match &self.heap[focus] {
|
||||
&HeapCellValue::NamedStr(arity, ref name) => {
|
||||
for i in (1 .. arity + 1).rev() {
|
||||
self.state_stack.push(Addr::HeapCell(focus + i));
|
||||
}
|
||||
|
||||
return HeapCellView::Str(arity, name);
|
||||
},
|
||||
&HeapCellValue::Ref(Ref::HeapCell(hc)) => {
|
||||
if focus == hc {
|
||||
return HeapCellView::HeapVar(hc);
|
||||
} else {
|
||||
focus = hc;
|
||||
}
|
||||
},
|
||||
&HeapCellValue::Ref(Ref::StackCell(fr, sc)) =>
|
||||
return self.follow_stack_ref(fr, sc),
|
||||
&HeapCellValue::Str(cell_num) =>
|
||||
focus = cell_num,
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> Iterator for HeapCellViewer<'a> {
|
||||
type Item = HeapCellView<'a>;
|
||||
|
||||
fn next(&mut self) -> Option<Self::Item> {
|
||||
if let Some(addr) = self.state_stack.pop() {
|
||||
match addr {
|
||||
Addr::HeapCell(hc) | Addr::Str(hc) =>
|
||||
return Some(self.follow_heap_ref(hc)),
|
||||
Addr::StackCell(fr, sc) =>
|
||||
return Some(self.follow_stack_ref(fr, sc))
|
||||
}
|
||||
}
|
||||
|
||||
None
|
||||
}
|
||||
}
|
||||
255
src/l3/io.rs
255
src/l3/io.rs
@@ -1,255 +0,0 @@
|
||||
use l3::ast::*;
|
||||
use l3::codegen::*;
|
||||
use l3::l3_parser::*;
|
||||
use l3::machine::*;
|
||||
|
||||
use termion::raw::IntoRawMode;
|
||||
use termion::input::TermRead;
|
||||
use termion::event::Key;
|
||||
|
||||
use std::io::{Write, stdin, stdout};
|
||||
use std::fmt;
|
||||
|
||||
impl fmt::Display for FactInstruction {
|
||||
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
|
||||
match self {
|
||||
&FactInstruction::GetStructure(Level::Deep, ref name, ref arity, ref r) =>
|
||||
write!(f, "get_structure {}/{}, {}", name, arity, r),
|
||||
&FactInstruction::GetStructure(Level::Shallow, ref name, ref arity, ref r) =>
|
||||
write!(f, "get_structure {}/{}, A{}", name, arity, r.reg_num()),
|
||||
&FactInstruction::GetValue(ref x, ref a) =>
|
||||
write!(f, "get_value {}, A{}", x, a),
|
||||
&FactInstruction::GetVariable(ref x, ref a) =>
|
||||
write!(f, "get_variable {}, A{}", x, a),
|
||||
&FactInstruction::UnifyVariable(ref r) =>
|
||||
write!(f, "unify_variable {}", r),
|
||||
&FactInstruction::UnifyValue(ref r) =>
|
||||
write!(f, "unify_value {}", r)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl fmt::Display for QueryInstruction {
|
||||
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
|
||||
match self {
|
||||
&QueryInstruction::PutStructure(Level::Deep, ref name, ref arity, ref r) =>
|
||||
write!(f, "put_structure {}/{}, {}", name, arity, r.reg_num()),
|
||||
&QueryInstruction::PutStructure(Level::Shallow, ref name, ref arity, ref r) =>
|
||||
write!(f, "put_structure {}/{}, A{}", name, arity, r.reg_num()),
|
||||
&QueryInstruction::PutValue(ref x, ref a) =>
|
||||
write!(f, "put_value {}, A{}", x, a),
|
||||
&QueryInstruction::PutVariable(ref x, ref a) =>
|
||||
write!(f, "put_variable {}, A{}", x, a),
|
||||
&QueryInstruction::SetVariable(ref r) =>
|
||||
write!(f, "set_variable {}", r),
|
||||
&QueryInstruction::SetValue(ref r) =>
|
||||
write!(f, "set_value {}", r),
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl fmt::Display for ControlInstruction {
|
||||
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
|
||||
match self {
|
||||
&ControlInstruction::Allocate(num_cells) =>
|
||||
write!(f, "allocate {}", num_cells),
|
||||
&ControlInstruction::Call(ref name, ref arity) =>
|
||||
write!(f, "call {}/{}", name, arity),
|
||||
&ControlInstruction::Deallocate =>
|
||||
write!(f, "deallocate"),
|
||||
&ControlInstruction::Proceed =>
|
||||
write!(f, "proceed")
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl fmt::Display for ChoiceInstruction {
|
||||
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
|
||||
match self {
|
||||
&ChoiceInstruction::TryMeElse(offset) =>
|
||||
write!(f, "try_me_else {}", offset),
|
||||
&ChoiceInstruction::RetryMeElse(offset) =>
|
||||
write!(f, "retry_me_else {}", offset),
|
||||
&ChoiceInstruction::TrustMe =>
|
||||
write!(f, "trust_me")
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl fmt::Display for Level {
|
||||
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
|
||||
match self {
|
||||
&Level::Shallow => write!(f, "A"),
|
||||
&Level::Deep => write!(f, "X")
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl fmt::Display for VarReg {
|
||||
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
|
||||
match self {
|
||||
&VarReg::Norm(RegType::Perm(reg)) => write!(f, "Y{}", reg),
|
||||
&VarReg::Norm(RegType::Temp(reg)) => write!(f, "X{}", reg),
|
||||
&VarReg::ArgAndNorm(RegType::Perm(reg), arg) =>
|
||||
write!(f, "Y{} A{}", reg, arg),
|
||||
&VarReg::ArgAndNorm(RegType::Temp(reg), arg) =>
|
||||
write!(f, "X{} A{}", reg, arg)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl fmt::Display for RegType {
|
||||
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
|
||||
match self {
|
||||
&RegType::Perm(val) => write!(f, "Y{}", val),
|
||||
&RegType::Temp(val) => write!(f, "X{}", val)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
fn is_consistent(predicate: &Vec<PredicateClause>) -> bool {
|
||||
let name = predicate.first().unwrap().name();
|
||||
let arity = predicate.first().unwrap().arity();
|
||||
|
||||
for clause in predicate.iter().skip(1) {
|
||||
if !(name == clause.name() && arity == clause.arity()) {
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
true
|
||||
}
|
||||
|
||||
#[allow(dead_code)]
|
||||
pub fn print_code(code: &Code) {
|
||||
for clause in code {
|
||||
match clause {
|
||||
&Line::Fact(ref fact) =>
|
||||
for fact_instr in fact {
|
||||
println!("{}", fact_instr);
|
||||
},
|
||||
&Line::Choice(ref choice) =>
|
||||
println!("{}", choice),
|
||||
&Line::Control(ref control) =>
|
||||
println!("{}", control),
|
||||
&Line::Query(ref query) =>
|
||||
for query_instr in query {
|
||||
println!("{}", query_instr);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub fn read() -> String {
|
||||
let _ = stdout().flush();
|
||||
|
||||
let mut buffer = String::new();
|
||||
let mut result = String::new();
|
||||
|
||||
let stdin = stdin();
|
||||
stdin.read_line(&mut buffer).unwrap();
|
||||
|
||||
if &*buffer.trim() == ":{" {
|
||||
buffer.clear();
|
||||
|
||||
stdin.read_line(&mut buffer).unwrap();
|
||||
|
||||
while &*buffer.trim() != "}:" {
|
||||
result += buffer.as_str();
|
||||
buffer.clear();
|
||||
stdin.read_line(&mut buffer).unwrap();
|
||||
}
|
||||
} else {
|
||||
result = buffer;
|
||||
}
|
||||
|
||||
result
|
||||
}
|
||||
|
||||
pub fn eval(wam: &mut Machine, buffer: &str) -> EvalResult
|
||||
{
|
||||
let result = parse_TopLevel(buffer);
|
||||
let mut cg = CodeGenerator::new();
|
||||
|
||||
match &result {
|
||||
&Ok(TopLevel::Predicate(ref clauses)) => {
|
||||
if is_consistent(clauses) {
|
||||
let compiled_pred = cg.compile_predicate(clauses);
|
||||
wam.add_predicate(clauses, compiled_pred);
|
||||
|
||||
EvalResult::EntrySuccess
|
||||
} else {
|
||||
let msg = r"Error: predicate is inconsistent.
|
||||
Each predicate must have the same name and arity.";
|
||||
|
||||
println!("{}", msg);
|
||||
EvalResult::EntryFailure
|
||||
}
|
||||
},
|
||||
&Ok(TopLevel::Fact(ref fact)) => {
|
||||
let compiled_fact = cg.compile_fact(&fact);
|
||||
wam.add_fact(fact, compiled_fact);
|
||||
EvalResult::EntrySuccess
|
||||
},
|
||||
&Ok(TopLevel::Rule(ref rule)) => {
|
||||
let compiled_rule = cg.compile_rule(&rule);
|
||||
wam.add_rule(rule, compiled_rule);
|
||||
EvalResult::EntrySuccess
|
||||
},
|
||||
&Ok(TopLevel::Query(ref query)) => {
|
||||
let compiled_query = cg.compile_query(&query);
|
||||
wam.run_query(compiled_query, &cg)
|
||||
},
|
||||
&Err(_) => {
|
||||
println!("Grammatical error of some kind!");
|
||||
EvalResult::EntryFailure
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub fn print(wam: &mut Machine, result: EvalResult) {
|
||||
match result {
|
||||
EvalResult::InitialQuerySuccess(heap_locs) => {
|
||||
println!("yes");
|
||||
|
||||
'outer: loop {
|
||||
let mut result = EvalResult::QueryFailure;
|
||||
let bindings = wam.heap_view(&heap_locs);
|
||||
|
||||
let stdin = stdin();
|
||||
let mut stdout = stdout().into_raw_mode().unwrap();
|
||||
|
||||
write!(stdout, "{}\n\r", bindings).unwrap();
|
||||
stdout.flush().unwrap();
|
||||
|
||||
if !wam.or_stack_is_empty() {
|
||||
write!(stdout, "Press ; to continue or A to abort.\n\r").unwrap();
|
||||
stdout.flush().unwrap();
|
||||
|
||||
for c in stdin.keys() {
|
||||
match c.unwrap() {
|
||||
Key::Char(';') => {
|
||||
result = wam.continue_query();
|
||||
break;
|
||||
},
|
||||
Key::Char('a') | Key::Char('A') =>
|
||||
break 'outer,
|
||||
_ => {}
|
||||
}
|
||||
};
|
||||
|
||||
if let &EvalResult::QueryFailure = &result {
|
||||
write!(stdout, "no\n\r").unwrap();
|
||||
stdout.flush().unwrap();
|
||||
break;
|
||||
}
|
||||
} else {
|
||||
break;
|
||||
}
|
||||
}
|
||||
},
|
||||
EvalResult::QueryFailure => println!("no"),
|
||||
_ => {}
|
||||
};
|
||||
}
|
||||
@@ -1,175 +0,0 @@
|
||||
use l3::ast::*;
|
||||
|
||||
use std::cell::Cell;
|
||||
use std::collections::VecDeque;
|
||||
use std::vec::Vec;
|
||||
|
||||
enum IteratorState<'a> {
|
||||
Atom(Level, &'a Cell<RegType>, &'a Atom),
|
||||
Clause(Level, usize, &'a Cell<RegType>, &'a Atom, &'a Vec<Box<Term>>),
|
||||
IsolatedAtom(&'a Cell<RegType>, &'a Atom),
|
||||
IsolatedVar(&'a Cell<VarReg>, &'a Var),
|
||||
RootClause(usize, &'a Vec<Box<Term>>),
|
||||
Var(Level, &'a Cell<VarReg>, &'a Var)
|
||||
}
|
||||
|
||||
impl<'a> IteratorState<'a> {
|
||||
fn to_state(lvl: Level, term: &'a Term) -> IteratorState<'a>
|
||||
{
|
||||
match term {
|
||||
&Term::Atom(ref cell, ref atom) =>
|
||||
IteratorState::Atom(lvl, cell, atom),
|
||||
&Term::Clause(ref cell, ref atom, ref child_terms) =>
|
||||
IteratorState::Clause(lvl, 0, cell, atom, child_terms),
|
||||
&Term::Var(ref cell, ref var) =>
|
||||
IteratorState::Var(lvl, cell, var)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub struct QueryIterator<'a> {
|
||||
state_stack: Vec<IteratorState<'a>>
|
||||
}
|
||||
|
||||
impl<'a> QueryIterator<'a> {
|
||||
fn push_clause(&mut self,
|
||||
lvl: Level,
|
||||
child_num: usize,
|
||||
cell: &'a Cell<RegType>,
|
||||
name: &'a Atom,
|
||||
child_terms: &'a Vec<Box<Term>>)
|
||||
{
|
||||
self.state_stack.push(IteratorState::Clause(lvl,
|
||||
child_num,
|
||||
cell,
|
||||
name,
|
||||
child_terms));
|
||||
}
|
||||
|
||||
fn push_root_clause(&mut self,
|
||||
child_num: usize,
|
||||
child_terms: &'a Vec<Box<Term>>)
|
||||
{
|
||||
self.state_stack.push(IteratorState::RootClause(child_num, child_terms));
|
||||
}
|
||||
|
||||
fn push_subterm(&mut self, lvl: Level, term: &'a Term) {
|
||||
self.state_stack.push(IteratorState::to_state(lvl, term));
|
||||
}
|
||||
|
||||
fn new(term: &'a Term) -> QueryIterator<'a> {
|
||||
let state = match term {
|
||||
&Term::Atom(ref cell, ref atom) =>
|
||||
IteratorState::IsolatedAtom(cell, atom),
|
||||
&Term::Clause(_, _, ref terms) =>
|
||||
IteratorState::RootClause(0, terms),
|
||||
&Term::Var(ref cell, ref var) =>
|
||||
IteratorState::IsolatedVar(cell, var)
|
||||
};
|
||||
|
||||
QueryIterator { state_stack: vec![state] }
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> Iterator for QueryIterator<'a> {
|
||||
type Item = TermRef<'a>;
|
||||
|
||||
fn next(&mut self) -> Option<Self::Item> {
|
||||
while let Some(iter_state) = self.state_stack.pop() {
|
||||
match iter_state {
|
||||
IteratorState::Atom(lvl, cell, atom) =>
|
||||
return Some(TermRef::Atom(lvl, cell, atom)),
|
||||
IteratorState::Clause(lvl, child_num, cell, atom, child_terms) => {
|
||||
if child_num == child_terms.len() {
|
||||
return Some(TermRef::Clause(lvl, cell, atom, child_terms));
|
||||
} else {
|
||||
self.push_clause(lvl, child_num + 1, cell, atom, child_terms);
|
||||
self.push_subterm(Level::Deep, child_terms[child_num].as_ref());
|
||||
}
|
||||
},
|
||||
IteratorState::IsolatedAtom(cell, atom) =>
|
||||
return Some(TermRef::Atom(Level::Shallow, cell, atom)),
|
||||
IteratorState::IsolatedVar(cell, var) =>
|
||||
return Some(TermRef::Var(Level::Shallow, cell, var)),
|
||||
IteratorState::RootClause(child_num, child_terms) => {
|
||||
if child_num == child_terms.len() {
|
||||
return None;
|
||||
} else {
|
||||
self.push_root_clause(child_num + 1, child_terms);
|
||||
self.push_subterm(Level::Shallow, child_terms[child_num].as_ref());
|
||||
}
|
||||
},
|
||||
IteratorState::Var(lvl, cell, var) =>
|
||||
return Some(TermRef::Var(lvl, cell, var))
|
||||
};
|
||||
}
|
||||
|
||||
None
|
||||
}
|
||||
}
|
||||
|
||||
pub struct FactIterator<'a> {
|
||||
state_queue: VecDeque<IteratorState<'a>>,
|
||||
}
|
||||
|
||||
impl<'a> FactIterator<'a> {
|
||||
fn push_subterm(&mut self, lvl: Level, term: &'a Term) {
|
||||
self.state_queue.push_back(IteratorState::to_state(lvl, term));
|
||||
}
|
||||
|
||||
fn new(term: &'a Term) -> FactIterator<'a> {
|
||||
let states = match term {
|
||||
&Term::Atom(ref cell, ref atom) =>
|
||||
vec![IteratorState::IsolatedAtom(cell, atom)],
|
||||
&Term::Clause(_, _, ref terms) =>
|
||||
vec![IteratorState::RootClause(0, terms)],
|
||||
&Term::Var(ref cell, ref var) =>
|
||||
vec![IteratorState::IsolatedVar(cell, var)]
|
||||
};
|
||||
|
||||
FactIterator { state_queue: VecDeque::from(states) }
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> Iterator for FactIterator<'a> {
|
||||
type Item = TermRef<'a>;
|
||||
|
||||
fn next(&mut self) -> Option<Self::Item> {
|
||||
while let Some(state) = self.state_queue.pop_front() {
|
||||
match state {
|
||||
IteratorState::Atom(lvl, cell, atom) =>
|
||||
return Some(TermRef::Atom(lvl, cell, atom)),
|
||||
IteratorState::Clause(lvl, _, cell, atom, child_terms) => {
|
||||
for child_term in child_terms {
|
||||
self.push_subterm(Level::Deep, child_term);
|
||||
}
|
||||
|
||||
return Some(TermRef::Clause(lvl, cell, atom, child_terms));
|
||||
},
|
||||
IteratorState::IsolatedAtom(cell, atom) =>
|
||||
return Some(TermRef::Atom(Level::Shallow, cell, atom)),
|
||||
IteratorState::IsolatedVar(cell, var) =>
|
||||
return Some(TermRef::Var(Level::Shallow, cell, var)),
|
||||
IteratorState::RootClause(_, child_terms) => {
|
||||
for child_term in child_terms {
|
||||
self.push_subterm(Level::Shallow, child_term);
|
||||
}
|
||||
},
|
||||
IteratorState::Var(lvl, cell, var) =>
|
||||
return Some(TermRef::Var(lvl, cell, var))
|
||||
}
|
||||
}
|
||||
|
||||
None
|
||||
}
|
||||
}
|
||||
|
||||
impl Term {
|
||||
pub fn post_order_iter(&self) -> QueryIterator {
|
||||
QueryIterator::new(self)
|
||||
}
|
||||
|
||||
pub fn breadth_first_iter(&self) -> FactIterator {
|
||||
FactIterator::new(self)
|
||||
}
|
||||
}
|
||||
@@ -1,59 +0,0 @@
|
||||
use l3::ast::*;
|
||||
|
||||
use std::cell::Cell;
|
||||
|
||||
grammar;
|
||||
|
||||
pub TopLevel: TopLevel = {
|
||||
"?-" <t:Term> "." => TopLevel::Query(t),
|
||||
<Predicate> => TopLevel::Predicate(<>),
|
||||
<Rule> "." => TopLevel::Rule(<>),
|
||||
<Term> "." => TopLevel::Fact(<>)
|
||||
};
|
||||
|
||||
Atom : Atom = {
|
||||
r"[a-z][a-z0-9_]*" => <>.trim().to_string(),
|
||||
};
|
||||
|
||||
BoxedTerm : Box<Term> = {
|
||||
<t:Term> => Box::new(t)
|
||||
};
|
||||
|
||||
Clause : Term = {
|
||||
<a:Atom> "(" <ts: (<BoxedTerm> ",")*> <t:BoxedTerm> ")" => {
|
||||
let mut ts = ts;
|
||||
ts.push(t);
|
||||
Term::Clause(Cell::new(RegType::Temp(0)), a, ts)
|
||||
}
|
||||
};
|
||||
|
||||
Predicate : Vec<PredicateClause> = {
|
||||
<pcs: (<PredicateClause>)+> <pc: PredicateClause> => {
|
||||
let mut pcs = pcs;
|
||||
pcs.push(pc);
|
||||
pcs
|
||||
}
|
||||
};
|
||||
|
||||
PredicateClause : PredicateClause = {
|
||||
<Rule> "." => PredicateClause::Rule(<>),
|
||||
<Term> "." => PredicateClause::Fact(<>)
|
||||
};
|
||||
|
||||
Rule : Rule = {
|
||||
<c:Clause> ":-" <h:Term> <cs: ("," <Term>)*> =>
|
||||
Rule { head: (c, h), clauses: cs },
|
||||
<a:Atom> ":-" <h:Term> <cs: ("," <Term>)*> =>
|
||||
Rule { head: (Term::Atom(Cell::new(RegType::Temp(0)), a), h),
|
||||
clauses: cs }
|
||||
};
|
||||
|
||||
Term : Term = {
|
||||
<Clause> => <>,
|
||||
<Atom> => Term::Atom(Cell::new(RegType::Temp(0)), <>),
|
||||
<Var> => Term::Var(Cell::new(VarReg::Norm(RegType::Temp(0))), <>)
|
||||
};
|
||||
|
||||
Var : Var = {
|
||||
r"[A-Z][a-z0-9_]*" => <>.trim().to_string(),
|
||||
};
|
||||
2177
src/l3/l3_parser.rs
2177
src/l3/l3_parser.rs
File diff suppressed because it is too large
Load Diff
@@ -1,677 +0,0 @@
|
||||
use l3::ast::*;
|
||||
use l3::codegen::*;
|
||||
use l3::heapview::*;
|
||||
use l3::and_stack::*;
|
||||
use l3::or_stack::*;
|
||||
|
||||
use std::collections::HashMap;
|
||||
use std::ops::{Index, IndexMut};
|
||||
use std::vec::Vec;
|
||||
|
||||
#[derive(Clone, Copy)]
|
||||
enum MachineMode {
|
||||
Read,
|
||||
Write
|
||||
}
|
||||
|
||||
struct MachineState {
|
||||
h: usize,
|
||||
s: usize,
|
||||
p: CodePtr,
|
||||
b: usize,
|
||||
e: usize,
|
||||
num_of_args: usize,
|
||||
cp: CodePtr,
|
||||
fail: bool,
|
||||
heap: Heap,
|
||||
mode: MachineMode,
|
||||
and_stack: AndStack,
|
||||
or_stack: OrStack,
|
||||
registers: Registers,
|
||||
trail: Vec<Ref>,
|
||||
tr: usize,
|
||||
hb: usize
|
||||
}
|
||||
|
||||
type CodeDir = HashMap<(Atom, usize), usize>;
|
||||
|
||||
impl Index<RegType> for MachineState {
|
||||
type Output = Addr;
|
||||
|
||||
fn index(&self, reg: RegType) -> &Self::Output {
|
||||
match reg {
|
||||
RegType::Temp(temp) => &self.registers[temp],
|
||||
RegType::Perm(perm) => {
|
||||
let e = self.e;
|
||||
&self.and_stack[e][perm]
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl IndexMut<RegType> for MachineState {
|
||||
fn index_mut(&mut self, reg: RegType) -> &mut Self::Output {
|
||||
match reg {
|
||||
RegType::Temp(temp) => &mut self.registers[temp],
|
||||
RegType::Perm(perm) => {
|
||||
let e = self.e;
|
||||
&mut self.and_stack[e][perm]
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub struct Machine {
|
||||
ms: MachineState,
|
||||
code: Code,
|
||||
code_dir: CodeDir
|
||||
}
|
||||
|
||||
impl Machine {
|
||||
pub fn new() -> Self {
|
||||
Machine {
|
||||
ms: MachineState::new(),
|
||||
code: Vec::new(),
|
||||
code_dir: HashMap::new()
|
||||
}
|
||||
}
|
||||
|
||||
pub fn failed(&self) -> bool {
|
||||
self.ms.fail
|
||||
}
|
||||
|
||||
pub fn add_fact(&mut self, fact: &Term, mut code: Code) {
|
||||
let p = self.code.len();
|
||||
let name = fact.name().clone();
|
||||
let arity = fact.arity();
|
||||
|
||||
self.code.append(&mut code);
|
||||
self.code_dir.insert((name, arity), p);
|
||||
}
|
||||
|
||||
pub fn add_rule(&mut self, rule: &Rule, mut code: Code) {
|
||||
let p = self.code.len();
|
||||
let name = rule.head.0.name().clone();
|
||||
let arity = rule.head.0.arity();
|
||||
|
||||
self.code.append(&mut code);
|
||||
self.code_dir.insert((name, arity), p);
|
||||
}
|
||||
|
||||
pub fn add_predicate(&mut self, pred: &Vec<PredicateClause>, mut code: Code)
|
||||
{
|
||||
let p = self.code.len();
|
||||
let name = pred.first().unwrap().name().clone();
|
||||
let arity = pred.first().unwrap().arity();
|
||||
|
||||
self.code.append(&mut code);
|
||||
self.code_dir.insert((name, arity), p);
|
||||
}
|
||||
|
||||
fn execute_instr<'a>(&mut self, instr_src: LineOrCodeOffset<'a>) -> bool
|
||||
{
|
||||
let mut instr = match instr_src {
|
||||
LineOrCodeOffset::Instruction(instr) => instr,
|
||||
LineOrCodeOffset::Offset(p) => &self.code[p]
|
||||
};
|
||||
|
||||
loop {
|
||||
match instr {
|
||||
&Line::Choice(ref choice_instr) =>
|
||||
self.ms.execute_choice_instr(choice_instr),
|
||||
&Line::Fact(ref fact) => {
|
||||
for fact_instr in fact {
|
||||
self.ms.execute_fact_instr(&fact_instr);
|
||||
}
|
||||
self.ms.p += 1;
|
||||
},
|
||||
&Line::Query(ref query) => {
|
||||
for query_instr in query {
|
||||
self.ms.execute_query_instr(&query_instr);
|
||||
}
|
||||
self.ms.p += 1;
|
||||
},
|
||||
&Line::Control(ref control_instr) =>
|
||||
self.ms.execute_ctrl_instr(&self.code_dir, control_instr),
|
||||
}
|
||||
|
||||
if self.failed() {
|
||||
let p = self.ms
|
||||
.or_stack
|
||||
.top()
|
||||
.map(|fr| fr.bp)
|
||||
.unwrap_or_default();
|
||||
|
||||
if let CodePtr::TopLevel = p {
|
||||
return false;
|
||||
} else {
|
||||
self.ms.fail = false;
|
||||
self.ms.p = p;
|
||||
}
|
||||
}
|
||||
|
||||
match self.ms.p {
|
||||
CodePtr::DirEntry(p) if p < self.code.len() =>
|
||||
instr = &self.code[p],
|
||||
_ => break
|
||||
}
|
||||
}
|
||||
|
||||
true
|
||||
}
|
||||
|
||||
pub fn heap_view(&self, var_dir: &HeapVarDict) -> String {
|
||||
let mut result = String::new();
|
||||
|
||||
for (var, addr) in var_dir {
|
||||
let mut arities = Vec::new();
|
||||
let viewer = HeapCellViewer::new(&self.ms.heap,
|
||||
&self.ms.and_stack,
|
||||
*addr);
|
||||
|
||||
if result != "" {
|
||||
result += "\n\r";
|
||||
}
|
||||
|
||||
result += var.as_str();
|
||||
result += " = ";
|
||||
|
||||
for view in viewer {
|
||||
match arities.pop() {
|
||||
Some(n) => arities.push(n-1),
|
||||
None => {}
|
||||
}
|
||||
|
||||
if !(arities.is_empty() || result.ends_with("(")) {
|
||||
result += ", ";
|
||||
}
|
||||
|
||||
match view {
|
||||
HeapCellView::Str(arity, ref name) => {
|
||||
result += name.as_str();
|
||||
|
||||
if arity > 0 {
|
||||
arities.push(arity);
|
||||
result += "(";
|
||||
}
|
||||
},
|
||||
HeapCellView::HeapVar(cell_num) => {
|
||||
result += "_";
|
||||
result += cell_num.to_string().as_str();
|
||||
},
|
||||
HeapCellView::StackVar(fr, sc) => {
|
||||
result += "_s_";
|
||||
result += fr.to_string().as_str();
|
||||
result += "_";
|
||||
result += sc.to_string().as_str();
|
||||
}
|
||||
}
|
||||
|
||||
while let Some(&0) = arities.last() {
|
||||
result += ")";
|
||||
arities.pop();
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
result
|
||||
}
|
||||
|
||||
pub fn run_query(&mut self, code: Code, cg: &CodeGenerator) -> EvalResult
|
||||
{
|
||||
let mut succeeded = true;
|
||||
let mut heap_locs = HashMap::new();
|
||||
|
||||
for instr in code.iter().take(1) {
|
||||
succeeded = self.execute_instr(LineOrCodeOffset::from(instr));
|
||||
}
|
||||
|
||||
if succeeded {
|
||||
for (var, vr) in cg.vars() {
|
||||
let addr = self.ms.registers[vr.root_register()];
|
||||
heap_locs.insert((*var).clone(), addr);
|
||||
}
|
||||
|
||||
for instr in code.iter().skip(1) {
|
||||
succeeded = self.execute_instr(LineOrCodeOffset::from(instr));
|
||||
if !succeeded {
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if succeeded {
|
||||
EvalResult::InitialQuerySuccess(heap_locs)
|
||||
} else {
|
||||
EvalResult::QueryFailure
|
||||
}
|
||||
}
|
||||
|
||||
pub fn or_stack_is_empty(&self) -> bool {
|
||||
self.ms.or_stack.is_empty()
|
||||
}
|
||||
|
||||
pub fn continue_query(&mut self) -> EvalResult
|
||||
{
|
||||
if !self.or_stack_is_empty() {
|
||||
let b = self.ms.b;
|
||||
self.ms.p = self.ms.or_stack[b].bp;
|
||||
|
||||
let succeeded = if let CodePtr::DirEntry(p) = self.ms.p {
|
||||
self.execute_instr(LineOrCodeOffset::Offset(p))
|
||||
} else {
|
||||
false
|
||||
};
|
||||
|
||||
if succeeded {
|
||||
EvalResult::SubsequentQuerySuccess
|
||||
} else {
|
||||
EvalResult::QueryFailure
|
||||
}
|
||||
} else {
|
||||
EvalResult::QueryFailure
|
||||
}
|
||||
}
|
||||
|
||||
pub fn reset(&mut self) {
|
||||
self.ms.reset();
|
||||
}
|
||||
}
|
||||
|
||||
impl MachineState {
|
||||
fn new() -> MachineState {
|
||||
MachineState { h: 0,
|
||||
s: 0,
|
||||
p: CodePtr::TopLevel,
|
||||
b: 0,
|
||||
e: 0,
|
||||
num_of_args: 0,
|
||||
cp: CodePtr::TopLevel,
|
||||
fail: false,
|
||||
heap: Vec::with_capacity(256),
|
||||
mode: MachineMode::Write,
|
||||
and_stack: AndStack::new(),
|
||||
or_stack: OrStack::new(),
|
||||
registers: vec![Addr::HeapCell(0); 32],
|
||||
trail: Vec::new(),
|
||||
tr: 0,
|
||||
hb: 0
|
||||
}
|
||||
}
|
||||
|
||||
fn num_frames(&self) -> usize {
|
||||
self.and_stack.len() + self.or_stack.len()
|
||||
}
|
||||
|
||||
fn store(&self, a: Addr) -> Addr {
|
||||
match a {
|
||||
Addr::HeapCell(r) => self.heap[r].as_addr(r),
|
||||
Addr::StackCell(fr, sc) => self.and_stack[fr][sc],
|
||||
addr => addr
|
||||
}
|
||||
}
|
||||
|
||||
fn deref(&self, a: Addr) -> Addr {
|
||||
let mut a = a;
|
||||
|
||||
loop {
|
||||
let value = self.store(a);
|
||||
|
||||
if value.is_ref() && value != a {
|
||||
a = value;
|
||||
continue;
|
||||
}
|
||||
|
||||
return a;
|
||||
};
|
||||
}
|
||||
|
||||
fn bind(&mut self, r1: Ref, a2: Addr) {
|
||||
let t2 = self.store(a2);
|
||||
|
||||
match r1 {
|
||||
Ref::StackCell(fr, sc) =>
|
||||
self.and_stack[fr][sc] = t2,
|
||||
Ref::HeapCell(hc) =>
|
||||
self.heap[hc] = HeapCellValue::from(t2)
|
||||
};
|
||||
|
||||
self.trail(r1);
|
||||
}
|
||||
|
||||
fn unify(&mut self, a1: Addr, a2: Addr) {
|
||||
let mut pdl = vec![a1, a2];
|
||||
|
||||
self.fail = false;
|
||||
|
||||
while !(pdl.is_empty() || self.fail) {
|
||||
let d1 = self.deref(pdl.pop().unwrap());
|
||||
let d2 = self.deref(pdl.pop().unwrap());
|
||||
|
||||
if d1 != d2 {
|
||||
match (self.store(d1), self.store(d2)) {
|
||||
(Addr::HeapCell(hc), _) =>
|
||||
self.bind(Ref::HeapCell(hc), d2),
|
||||
(_, Addr::HeapCell(hc)) =>
|
||||
self.bind(Ref::HeapCell(hc), d1),
|
||||
(Addr::StackCell(fr, sc), _) =>
|
||||
self.bind(Ref::StackCell(fr, sc), d2),
|
||||
(_, Addr::StackCell(fr, sc)) =>
|
||||
self.bind(Ref::StackCell(fr, sc), d1),
|
||||
(Addr::Str(a1), Addr::Str(a2)) => {
|
||||
let r1 = &self.heap[a1];
|
||||
let r2 = &self.heap[a2];
|
||||
|
||||
if let &HeapCellValue::NamedStr(n1, ref f1) = r1 {
|
||||
if let &HeapCellValue::NamedStr(n2, ref f2) = r2 {
|
||||
if n1 == n2 && *f1 == *f2 {
|
||||
for i in 1 .. n1 + 1 {
|
||||
pdl.push(Addr::HeapCell(a1 + i));
|
||||
pdl.push(Addr::HeapCell(a2 + i));
|
||||
}
|
||||
|
||||
continue;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
self.fail = true;
|
||||
}
|
||||
};
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn trail(&mut self, r: Ref) {
|
||||
match r {
|
||||
Ref::HeapCell(hc) => {
|
||||
if hc < self.hb {
|
||||
self.trail.push(r);
|
||||
self.tr += 1;
|
||||
}
|
||||
},
|
||||
Ref::StackCell(fr, _) => {
|
||||
let fr_gi = self.and_stack[fr].global_index;
|
||||
let b_gi = if !self.or_stack.is_empty() {
|
||||
self.or_stack[self.b].global_index
|
||||
} else {
|
||||
0
|
||||
};
|
||||
|
||||
if fr_gi < b_gi {
|
||||
self.trail.push(r);
|
||||
self.tr += 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn unwind_trail(&mut self, a1: usize, a2: usize) {
|
||||
for i in a1 .. a2 {
|
||||
match self.trail[i] {
|
||||
Ref::HeapCell(r) =>
|
||||
self.heap[r] = HeapCellValue::Ref(self.trail[i]),
|
||||
Ref::StackCell(fr, sc) =>
|
||||
self.and_stack[fr][sc] = Addr::StackCell(fr, sc)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn execute_query_instr(&mut self, instr: &QueryInstruction) {
|
||||
match instr {
|
||||
&QueryInstruction::PutStructure(_, ref name, arity, reg) => {
|
||||
self.heap.push(HeapCellValue::Str(self.h + 1));
|
||||
self.heap.push(HeapCellValue::NamedStr(arity, name.clone()));
|
||||
|
||||
self[reg] = Addr::Str(self.h + 1);
|
||||
|
||||
self.h += 2;
|
||||
},
|
||||
&QueryInstruction::PutValue(norm, arg) =>
|
||||
self.registers[arg] = self[norm],
|
||||
&QueryInstruction::PutVariable(norm, arg) => {
|
||||
self.heap.push(HeapCellValue::Ref(Ref::HeapCell(self.h)));
|
||||
|
||||
self[norm] = Addr::HeapCell(self.h);
|
||||
self.registers[arg] = Addr::HeapCell(self.h);
|
||||
|
||||
self.h += 1;
|
||||
},
|
||||
&QueryInstruction::SetVariable(reg) => {
|
||||
self.heap.push(HeapCellValue::Ref(Ref::HeapCell(self.h)));
|
||||
self[reg] = Addr::HeapCell(self.h);
|
||||
|
||||
self.h += 1;
|
||||
},
|
||||
&QueryInstruction::SetValue(reg) => {
|
||||
let heap_val = self[reg];
|
||||
self.heap.push(HeapCellValue::from(heap_val));
|
||||
|
||||
self.h += 1;
|
||||
},
|
||||
}
|
||||
}
|
||||
|
||||
fn execute_fact_instr(&mut self, instr: &FactInstruction) {
|
||||
match instr {
|
||||
&FactInstruction::GetStructure(_, ref name, arity, reg) => {
|
||||
let addr = self.deref(self[reg]);
|
||||
|
||||
match self.store(addr) {
|
||||
Addr::Str(a) => {
|
||||
let result = &self.heap[a];
|
||||
|
||||
if let &HeapCellValue::NamedStr(narity, ref str) = result {
|
||||
if narity == arity && *name == *str {
|
||||
self.s = a + 1;
|
||||
self.mode = MachineMode::Read;
|
||||
} else {
|
||||
self.fail = true;
|
||||
}
|
||||
}
|
||||
},
|
||||
Addr::HeapCell(_) | Addr::StackCell(_, _) => {
|
||||
self.heap.push(HeapCellValue::Str(self.h + 1));
|
||||
self.heap.push(HeapCellValue::NamedStr(arity, name.clone()));
|
||||
|
||||
let h = self.h;
|
||||
|
||||
self.bind(addr.as_ref().unwrap(), Addr::HeapCell(h));
|
||||
|
||||
self.h += 2;
|
||||
self.mode = MachineMode::Write;
|
||||
}
|
||||
};
|
||||
},
|
||||
&FactInstruction::GetVariable(norm, arg) =>
|
||||
self[norm] = self.registers[arg],
|
||||
&FactInstruction::GetValue(norm, arg) => {
|
||||
let norm_addr = self[norm];
|
||||
let reg_addr = self.registers[arg];
|
||||
|
||||
self.unify(norm_addr, reg_addr);
|
||||
},
|
||||
&FactInstruction::UnifyVariable(reg) => {
|
||||
match self.mode {
|
||||
MachineMode::Read =>
|
||||
self[reg] = self.heap[self.s].as_addr(self.s),
|
||||
MachineMode::Write => {
|
||||
self.heap.push(HeapCellValue::Ref(Ref::HeapCell(self.h)));
|
||||
self[reg] = Addr::HeapCell(self.h);
|
||||
self.h += 1;
|
||||
}
|
||||
};
|
||||
|
||||
self.s += 1;
|
||||
},
|
||||
&FactInstruction::UnifyValue(reg) => {
|
||||
let s = self.s;
|
||||
|
||||
match self.mode {
|
||||
MachineMode::Read => {
|
||||
let reg_addr = self[reg];
|
||||
self.unify(reg_addr, Addr::HeapCell(s));
|
||||
},
|
||||
MachineMode::Write => {
|
||||
let heap_val = self.store(self[reg]);
|
||||
self.heap.push(HeapCellValue::from(heap_val));
|
||||
self.h += 1;
|
||||
}
|
||||
};
|
||||
|
||||
self.s += 1;
|
||||
}
|
||||
};
|
||||
}
|
||||
|
||||
fn execute_ctrl_instr(&mut self, code_dir: &CodeDir, instr: &ControlInstruction)
|
||||
{
|
||||
match instr {
|
||||
&ControlInstruction::Allocate(num_cells) => {
|
||||
let num_frames = self.num_frames();
|
||||
|
||||
self.and_stack.push(num_frames + 1, self.e, self.cp, num_cells);
|
||||
|
||||
self.e = self.and_stack.len() - 1;
|
||||
self.p += 1;
|
||||
},
|
||||
&ControlInstruction::Call(ref name, arity) => {
|
||||
let compiled_tl_index = code_dir.get(&(name.clone(), arity))
|
||||
.map(|index| *index);
|
||||
|
||||
match compiled_tl_index {
|
||||
Some(compiled_tl_index) => {
|
||||
self.cp = self.p + 1;
|
||||
self.num_of_args = arity;
|
||||
self.p = CodePtr::DirEntry(compiled_tl_index);
|
||||
},
|
||||
None => self.fail = true
|
||||
};
|
||||
},
|
||||
&ControlInstruction::Deallocate => {
|
||||
let e = self.e;
|
||||
|
||||
let num_frame_e = self.and_stack.top().unwrap().global_index;
|
||||
let num_frame_b = self.or_stack
|
||||
.top()
|
||||
.map(|fr| fr.global_index)
|
||||
.unwrap_or(0);
|
||||
|
||||
self.p = self.and_stack[e].cp;
|
||||
self.e = self.and_stack[e].e;
|
||||
|
||||
if num_frame_e > num_frame_b {
|
||||
let top_e = self.and_stack.top().unwrap().e;
|
||||
self.and_stack.drop_frames(top_e - self.e + 1);
|
||||
}
|
||||
},
|
||||
&ControlInstruction::Proceed =>
|
||||
self.p = self.cp,
|
||||
};
|
||||
}
|
||||
|
||||
fn execute_choice_instr(&mut self, instr: &ChoiceInstruction)
|
||||
{
|
||||
match instr {
|
||||
&ChoiceInstruction::TryMeElse(offset) => {
|
||||
let n = self.num_of_args;
|
||||
let num_frames = self.num_frames();
|
||||
|
||||
self.or_stack.push(num_frames + 1,
|
||||
self.e,
|
||||
self.cp,
|
||||
self.b,
|
||||
self.p + offset,
|
||||
self.tr,
|
||||
self.h,
|
||||
self.num_of_args);
|
||||
|
||||
self.b = self.or_stack.len() - 1;
|
||||
let b = self.b;
|
||||
|
||||
for i in 1 .. n + 1 {
|
||||
self.or_stack[b][i] = self.registers[i];
|
||||
}
|
||||
|
||||
self.hb = self.h;
|
||||
self.p += 1;
|
||||
},
|
||||
&ChoiceInstruction::RetryMeElse(offset) => {
|
||||
let b = self.b;
|
||||
let n = self.or_stack[b].num_args();
|
||||
|
||||
for i in 1 .. n + 1 {
|
||||
self.registers[i] = self.or_stack[b][i];
|
||||
}
|
||||
|
||||
self.e = self.or_stack[b].e;
|
||||
self.cp = self.or_stack[b].cp;
|
||||
|
||||
self.or_stack[b].bp = self.p + offset;
|
||||
|
||||
let old_tr = self.or_stack[b].tr;
|
||||
let curr_tr = self.tr;
|
||||
|
||||
self.unwind_trail(old_tr, curr_tr);
|
||||
self.tr = self.or_stack[b].tr;
|
||||
|
||||
self.trail.truncate(self.tr);
|
||||
self.heap.truncate(self.or_stack[b].h);
|
||||
|
||||
self.h = self.or_stack[b].h;
|
||||
self.hb = self.h;
|
||||
|
||||
self.p += 1;
|
||||
},
|
||||
&ChoiceInstruction::TrustMe => {
|
||||
let b = self.b;
|
||||
let n = self.or_stack[b].num_args();
|
||||
|
||||
for i in 1 .. n + 1 {
|
||||
self.registers[i] = self.or_stack[b][i];
|
||||
}
|
||||
|
||||
self.e = self.or_stack[b].e;
|
||||
self.cp = self.or_stack[b].cp;
|
||||
|
||||
let old_tr = self.or_stack[b].tr;
|
||||
let curr_tr = self.tr;
|
||||
|
||||
self.unwind_trail(old_tr, curr_tr);
|
||||
|
||||
self.tr = self.or_stack[b].tr;
|
||||
self.trail.truncate(self.tr);
|
||||
|
||||
self.h = self.or_stack[b].h;
|
||||
self.heap.truncate(self.h);
|
||||
|
||||
self.b = self.or_stack[b].b;
|
||||
|
||||
self.or_stack.pop();
|
||||
|
||||
self.hb = self.h;
|
||||
self.p += 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn reset(&mut self) {
|
||||
self.h = 0;
|
||||
self.hb = 0;
|
||||
self.e = 0;
|
||||
self.b = 0;
|
||||
self.s = 0;
|
||||
self.tr = 0;
|
||||
self.p = CodePtr::TopLevel;
|
||||
self.cp = CodePtr::TopLevel;
|
||||
self.num_of_args = 0;
|
||||
|
||||
self.fail = false;
|
||||
self.trail.clear();
|
||||
self.heap.clear();
|
||||
self.mode = MachineMode::Write;
|
||||
self.and_stack.clear();
|
||||
self.or_stack.clear();
|
||||
self.registers = vec![Addr::HeapCell(0); 32];
|
||||
}
|
||||
}
|
||||
@@ -1,9 +0,0 @@
|
||||
pub mod and_stack;
|
||||
pub mod ast;
|
||||
pub mod codegen;
|
||||
pub mod heapview;
|
||||
pub mod io;
|
||||
pub mod iterators;
|
||||
pub mod l3_parser;
|
||||
pub mod machine;
|
||||
pub mod or_stack;
|
||||
@@ -1,112 +0,0 @@
|
||||
use l3::ast::*;
|
||||
|
||||
use std::ops::{Index, IndexMut};
|
||||
use std::vec::Vec;
|
||||
|
||||
pub struct Frame {
|
||||
pub global_index: usize,
|
||||
pub e: usize,
|
||||
pub cp: CodePtr,
|
||||
pub b: usize,
|
||||
pub bp: CodePtr,
|
||||
pub tr: usize,
|
||||
pub h: usize,
|
||||
args: Vec<Addr>
|
||||
}
|
||||
|
||||
impl Frame {
|
||||
fn new(global_index: usize,
|
||||
e: usize,
|
||||
cp: CodePtr,
|
||||
b: usize,
|
||||
bp: CodePtr,
|
||||
tr: usize,
|
||||
h: usize,
|
||||
n: usize)
|
||||
-> Self
|
||||
{
|
||||
Frame {
|
||||
global_index: global_index,
|
||||
e: e,
|
||||
cp: cp,
|
||||
b: b,
|
||||
bp: bp,
|
||||
tr: tr,
|
||||
h: h,
|
||||
args: vec![Addr::HeapCell(0); n]
|
||||
}
|
||||
}
|
||||
|
||||
pub fn num_args(&self) -> usize {
|
||||
self.args.len()
|
||||
}
|
||||
}
|
||||
|
||||
pub struct OrStack(Vec<Frame>);
|
||||
|
||||
impl OrStack {
|
||||
pub fn new() -> Self {
|
||||
OrStack(Vec::new())
|
||||
}
|
||||
|
||||
pub fn push(&mut self,
|
||||
global_index: usize,
|
||||
e: usize,
|
||||
cp: CodePtr,
|
||||
b: usize,
|
||||
bp: CodePtr,
|
||||
tr: usize,
|
||||
h: usize,
|
||||
n: usize)
|
||||
{
|
||||
self.0.push(Frame::new(global_index, e, cp, b, bp, tr, h, n));
|
||||
}
|
||||
|
||||
pub fn len(&self) -> usize {
|
||||
self.0.len()
|
||||
}
|
||||
|
||||
pub fn clear(&mut self) {
|
||||
self.0.clear()
|
||||
}
|
||||
|
||||
pub fn top(&self) -> Option<&Frame> {
|
||||
self.0.last()
|
||||
}
|
||||
|
||||
pub fn pop(&mut self) {
|
||||
self.0.pop();
|
||||
}
|
||||
|
||||
pub fn is_empty(&self) -> bool {
|
||||
self.0.is_empty()
|
||||
}
|
||||
}
|
||||
|
||||
impl Index<usize> for OrStack {
|
||||
type Output = Frame;
|
||||
|
||||
fn index(&self, index: usize) -> &Self::Output {
|
||||
self.0.index(index)
|
||||
}
|
||||
}
|
||||
|
||||
impl IndexMut<usize> for OrStack {
|
||||
fn index_mut(&mut self, index: usize) -> &mut Self::Output {
|
||||
self.0.index_mut(index)
|
||||
}
|
||||
}
|
||||
|
||||
impl Index<usize> for Frame {
|
||||
type Output = Addr;
|
||||
|
||||
fn index(&self, index: usize) -> &Self::Output {
|
||||
self.args.index(index - 1)
|
||||
}
|
||||
}
|
||||
|
||||
impl IndexMut<usize> for Frame {
|
||||
fn index_mut(&mut self, index: usize) -> &mut Self::Output {
|
||||
self.args.index_mut(index - 1)
|
||||
}
|
||||
}
|
||||
13
src/main.rs
13
src/main.rs
@@ -1,5 +1,9 @@
|
||||
extern crate crossterm;
|
||||
extern crate divrem;
|
||||
#[macro_use]
|
||||
extern crate downcast;
|
||||
extern crate git_version;
|
||||
extern crate hostname;
|
||||
extern crate indexmap;
|
||||
#[macro_use]
|
||||
extern crate lazy_static;
|
||||
@@ -9,24 +13,21 @@ extern crate nix;
|
||||
extern crate prolog_parser;
|
||||
#[macro_use]
|
||||
extern crate ref_thread_local;
|
||||
extern crate termion;
|
||||
|
||||
use nix::sys::signal;
|
||||
|
||||
mod prolog;
|
||||
|
||||
use crate::prolog::machine::*;
|
||||
use crate::prolog::machine::streams::*;
|
||||
use crate::prolog::read::*;
|
||||
|
||||
use std::sync::atomic::Ordering;
|
||||
|
||||
#[cfg(test)]
|
||||
mod tests;
|
||||
|
||||
extern fn handle_sigint(signal: libc::c_int) {
|
||||
let signal = signal::Signal::from_c_int(signal).unwrap();
|
||||
if signal == signal::Signal::SIGINT {
|
||||
INTERRUPT.store(true, Ordering::Relaxed);
|
||||
INTERRUPT.store(true, Ordering::Relaxed);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -34,6 +35,6 @@ fn main() {
|
||||
let handler = signal::SigHandler::Handler(handle_sigint);
|
||||
unsafe { signal::signal(signal::Signal::SIGINT, handler) }.unwrap();
|
||||
|
||||
let mut wam = Machine::new(readline::input_stream());
|
||||
let mut wam = Machine::new(readline::input_stream(), Stream::stdout());
|
||||
wam.run_top_level();
|
||||
}
|
||||
|
||||
@@ -6,6 +6,7 @@ use crate::prolog::forms::*;
|
||||
use crate::prolog::instructions::*;
|
||||
use crate::prolog::iterators::*;
|
||||
|
||||
use crate::prolog::machine::heap::*;
|
||||
use crate::prolog::machine::machine_errors::*;
|
||||
use crate::prolog::machine::machine_indices::*;
|
||||
|
||||
@@ -15,12 +16,14 @@ use crate::prolog::rug::{Assign, Integer, Rational};
|
||||
|
||||
use std::cell::Cell;
|
||||
use std::cmp::{max, min, Ordering};
|
||||
use std::convert::TryFrom;
|
||||
use std::f64;
|
||||
use std::num::FpCategory;
|
||||
use std::ops::{Add, Div, Mul, Neg, Sub};
|
||||
use std::rc::Rc;
|
||||
use std::vec::Vec;
|
||||
|
||||
#[derive(Debug)]
|
||||
pub struct ArithInstructionIterator<'a> {
|
||||
state_stack: Vec<TermIterState<'a>>,
|
||||
}
|
||||
@@ -66,6 +69,7 @@ impl<'a> ArithInstructionIterator<'a> {
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub enum ArithTermRef<'a> {
|
||||
Constant(&'a Constant),
|
||||
Op(ClauseName, usize), // name, arity.
|
||||
@@ -107,6 +111,7 @@ impl<'a> Iterator for ArithInstructionIterator<'a> {
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub struct ArithmeticEvaluator<'a> {
|
||||
bindings: &'a AllocVarDict,
|
||||
interm: Vec<ArithmeticTerm>,
|
||||
@@ -159,6 +164,7 @@ impl<'a> ArithmeticEvaluator<'a> {
|
||||
"round" => Ok(ArithmeticInstruction::Round(a1, t)),
|
||||
"ceiling" => Ok(ArithmeticInstruction::Ceiling(a1, t)),
|
||||
"floor" => Ok(ArithmeticInstruction::Floor(a1, t)),
|
||||
"sign" => Ok(ArithmeticInstruction::Sign(a1, t)),
|
||||
"\\" => Ok(ArithmeticInstruction::BitwiseComplement(a1, t)),
|
||||
_ => Err(ArithmeticError::NonEvaluableFunctor(
|
||||
Constant::Atom(name, None),
|
||||
@@ -192,6 +198,7 @@ impl<'a> ArithmeticEvaluator<'a> {
|
||||
"xor" => Ok(ArithmeticInstruction::Xor(a1, a2, t)),
|
||||
"mod" => Ok(ArithmeticInstruction::Mod(a1, a2, t)),
|
||||
"rem" => Ok(ArithmeticInstruction::Rem(a1, a2, t)),
|
||||
"gcd" => Ok(ArithmeticInstruction::Gcd(a1, a2, t)),
|
||||
"atan2" => Ok(ArithmeticInstruction::ATan2(a1, a2, t)),
|
||||
_ => Err(ArithmeticError::NonEvaluableFunctor(
|
||||
Constant::Atom(name, None),
|
||||
@@ -260,6 +267,9 @@ impl<'a> ArithmeticEvaluator<'a> {
|
||||
|
||||
fn push_constant(&mut self, c: &Constant) -> Result<(), ArithmeticError> {
|
||||
match c {
|
||||
&Constant::Fixnum(n) => self
|
||||
.interm
|
||||
.push(ArithmeticTerm::Number(Number::Fixnum(n))),
|
||||
&Constant::Integer(ref n) => self
|
||||
.interm
|
||||
.push(ArithmeticTerm::Number(Number::Integer(n.clone()))),
|
||||
@@ -314,18 +324,25 @@ impl<'a> ArithmeticEvaluator<'a> {
|
||||
}
|
||||
|
||||
// integer division rounding function -- 9.1.3.1.
|
||||
pub fn rnd_i<'a>(n: &'a Number) -> RefOrOwned<'a, Integer> {
|
||||
pub fn rnd_i<'a>(n: &'a Number) -> RefOrOwned<'a, Number> {
|
||||
match n {
|
||||
&Number::Integer(ref n) => RefOrOwned::Borrowed(n),
|
||||
&Number::Integer(_) => {
|
||||
RefOrOwned::Borrowed(n)
|
||||
}
|
||||
&Number::Float(OrderedFloat(f)) => {
|
||||
RefOrOwned::Owned(Integer::from_f64(f.floor()).unwrap_or_else(|| Integer::from(0)))
|
||||
RefOrOwned::Owned(Number::from(
|
||||
Integer::from_f64(f.floor()).unwrap_or_else(|| Integer::from(0))
|
||||
))
|
||||
}
|
||||
&Number::Fixnum(n) => {
|
||||
RefOrOwned::Owned(Number::from(n))
|
||||
}
|
||||
&Number::Rational(ref r) => {
|
||||
let r_ref = r.fract_floor_ref();
|
||||
let (mut fract, mut floor) = (Rational::new(), Integer::new());
|
||||
|
||||
(&mut fract, &mut floor).assign(r_ref);
|
||||
RefOrOwned::Owned(floor)
|
||||
|
||||
RefOrOwned::Owned(Number::from(floor))
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -333,6 +350,7 @@ pub fn rnd_i<'a>(n: &'a Number) -> RefOrOwned<'a, Integer> {
|
||||
// floating point rounding function -- 9.1.4.1.
|
||||
pub fn rnd_f(n: &Number) -> f64 {
|
||||
match n {
|
||||
&Number::Fixnum(n) => n as f64,
|
||||
&Number::Integer(ref n) => n.to_f64(),
|
||||
&Number::Float(OrderedFloat(f)) => f,
|
||||
&Number::Rational(ref r) => r.to_f64(),
|
||||
@@ -368,22 +386,32 @@ where
|
||||
}
|
||||
}
|
||||
|
||||
#[inline]
|
||||
fn float_fn_to_f(n: isize) -> Result<f64, EvalError> {
|
||||
classify_float(n as f64, rnd_f)
|
||||
}
|
||||
|
||||
#[inline]
|
||||
fn float_i_to_f(n: &Integer) -> Result<f64, EvalError> {
|
||||
classify_float(n.to_f64(), rnd_f)
|
||||
}
|
||||
|
||||
#[inline]
|
||||
fn float_r_to_f(r: &Rational) -> Result<f64, EvalError> {
|
||||
classify_float(r.to_f64(), rnd_f)
|
||||
}
|
||||
|
||||
#[inline]
|
||||
fn add_f(f1: f64, f2: f64) -> Result<OrderedFloat<f64>, EvalError> {
|
||||
Ok(OrderedFloat(classify_float(f1 + f2, rnd_f)?))
|
||||
}
|
||||
|
||||
#[inline]
|
||||
fn mul_f(f1: f64, f2: f64) -> Result<OrderedFloat<f64>, EvalError> {
|
||||
Ok(OrderedFloat(classify_float(f1 * f2, rnd_f)?))
|
||||
}
|
||||
|
||||
#[inline]
|
||||
fn div_f(f1: f64, f2: f64) -> Result<OrderedFloat<f64>, EvalError> {
|
||||
if FpCategory::Zero == f2.classify() {
|
||||
Err(EvalError::ZeroDivisor)
|
||||
@@ -397,23 +425,46 @@ impl Add<Number> for Number {
|
||||
|
||||
fn add(self, rhs: Number) -> Self::Output {
|
||||
match (self, rhs) {
|
||||
(Number::Integer(n1), Number::Integer(n2)) => Ok(Number::Integer(n1 + n2)), // add_i
|
||||
(Number::Fixnum(n1), Number::Fixnum(n2)) => {
|
||||
Ok(if let Some(result) = n1.checked_add(n2) {
|
||||
Number::Fixnum(result)
|
||||
} else {
|
||||
Number::from(Integer::from(n1) + Integer::from(n2))
|
||||
})
|
||||
}
|
||||
(Number::Fixnum(n1), Number::Integer(n2)) |
|
||||
(Number::Integer(n2), Number::Fixnum(n1)) => {
|
||||
Ok(Number::from(Integer::from(n1) + &*n2))
|
||||
}
|
||||
(Number::Fixnum(n1), Number::Rational(n2)) |
|
||||
(Number::Rational(n2), Number::Fixnum(n1)) => {
|
||||
Ok(Number::from(Rational::from(n1) + &*n2))
|
||||
}
|
||||
(Number::Fixnum(n1), Number::Float(OrderedFloat(n2))) |
|
||||
(Number::Float(OrderedFloat(n2)), Number::Fixnum(n1)) => {
|
||||
Ok(Number::Float(add_f(float_fn_to_f(n1)?, n2)?))
|
||||
}
|
||||
(Number::Integer(n1), Number::Integer(n2)) => {
|
||||
Ok(Number::from(Integer::from(&*n1) + &*n2)) // add_i
|
||||
}
|
||||
(Number::Integer(n1), Number::Float(OrderedFloat(n2)))
|
||||
| (Number::Float(OrderedFloat(n2)), Number::Integer(n1)) => {
|
||||
| (Number::Float(OrderedFloat(n2)), Number::Integer(n1)) => {
|
||||
Ok(Number::Float(add_f(float_i_to_f(&n1)?, n2)?))
|
||||
}
|
||||
(Number::Integer(n1), Number::Rational(n2))
|
||||
| (Number::Rational(n2), Number::Integer(n1)) => {
|
||||
Ok(Number::Rational(Rational::from(n1) + n2))
|
||||
| (Number::Rational(n2), Number::Integer(n1)) => {
|
||||
Ok(Number::from(Rational::from(&*n1) + &*n2))
|
||||
}
|
||||
(Number::Rational(n1), Number::Float(OrderedFloat(n2)))
|
||||
| (Number::Float(OrderedFloat(n2)), Number::Rational(n1)) => {
|
||||
| (Number::Float(OrderedFloat(n2)), Number::Rational(n1)) => {
|
||||
Ok(Number::Float(add_f(float_r_to_f(&n1)?, n2)?))
|
||||
}
|
||||
(Number::Float(OrderedFloat(f1)), Number::Float(OrderedFloat(f2))) => {
|
||||
Ok(Number::Float(add_f(f1, f2)?))
|
||||
}
|
||||
(Number::Rational(r1), Number::Rational(r2)) => Ok(Number::Rational(r1 + r2)),
|
||||
(Number::Rational(r1), Number::Rational(r2)) => {
|
||||
Ok(Number::from(Rational::from(&*r1) + &*r2))
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -423,9 +474,15 @@ impl Neg for Number {
|
||||
|
||||
fn neg(self) -> Self::Output {
|
||||
match self {
|
||||
Number::Integer(n) => Number::Integer(-n),
|
||||
Number::Fixnum(n) =>
|
||||
if let Some(n) = n.checked_neg() {
|
||||
Number::Fixnum(n)
|
||||
} else {
|
||||
Number::from(-Integer::from(n))
|
||||
}
|
||||
Number::Integer(n) => Number::Integer(Rc::new(-Integer::from(&*n))),
|
||||
Number::Float(OrderedFloat(f)) => Number::Float(OrderedFloat(-f)),
|
||||
Number::Rational(r) => Number::Rational(-r),
|
||||
Number::Rational(r) => Number::Rational(Rc::new(-Rational::from(&*r))),
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -443,14 +500,35 @@ impl Mul<Number> for Number {
|
||||
|
||||
fn mul(self, rhs: Number) -> Self::Output {
|
||||
match (self, rhs) {
|
||||
(Number::Integer(n1), Number::Integer(n2)) => Ok(Number::Integer(n1 * n2)), // mul_i
|
||||
(Number::Fixnum(n1), Number::Fixnum(n2)) => {
|
||||
Ok(if let Some(result) = n1.checked_mul(n2) {
|
||||
Number::Fixnum(result)
|
||||
} else {
|
||||
Number::from(Integer::from(n1) * Integer::from(n2))
|
||||
})
|
||||
}
|
||||
(Number::Fixnum(n1), Number::Integer(n2)) |
|
||||
(Number::Integer(n2), Number::Fixnum(n1)) => {
|
||||
Ok(Number::from(Integer::from(n1) * &*n2))
|
||||
}
|
||||
(Number::Fixnum(n1), Number::Rational(n2)) |
|
||||
(Number::Rational(n2), Number::Fixnum(n1)) => {
|
||||
Ok(Number::from(Rational::from(n1) * &*n2))
|
||||
}
|
||||
(Number::Fixnum(n1), Number::Float(OrderedFloat(n2))) |
|
||||
(Number::Float(OrderedFloat(n2)), Number::Fixnum(n1)) => {
|
||||
Ok(Number::Float(mul_f(float_fn_to_f(n1)?, n2)?))
|
||||
}
|
||||
(Number::Integer(n1), Number::Integer(n2)) => {
|
||||
Ok(Number::Integer(Rc::new(Integer::from(&*n1) * &*n2))) // mul_i
|
||||
}
|
||||
(Number::Integer(n1), Number::Float(OrderedFloat(n2)))
|
||||
| (Number::Float(OrderedFloat(n2)), Number::Integer(n1)) => {
|
||||
Ok(Number::Float(mul_f(float_i_to_f(&n1)?, n2)?))
|
||||
}
|
||||
(Number::Integer(n1), Number::Rational(n2))
|
||||
| (Number::Rational(n2), Number::Integer(n1)) => {
|
||||
Ok(Number::Rational(Rational::from(n1) * n2))
|
||||
Ok(Number::Rational(Rc::new(Rational::from(&*n1) * &*n2)))
|
||||
}
|
||||
(Number::Rational(n1), Number::Float(OrderedFloat(n2)))
|
||||
| (Number::Float(OrderedFloat(n2)), Number::Rational(n1)) => {
|
||||
@@ -459,7 +537,9 @@ impl Mul<Number> for Number {
|
||||
(Number::Float(OrderedFloat(f1)), Number::Float(OrderedFloat(f2))) => {
|
||||
Ok(Number::Float(mul_f(f1, f2)?))
|
||||
}
|
||||
(Number::Rational(r1), Number::Rational(r2)) => Ok(Number::Rational(r1 * r2)),
|
||||
(Number::Rational(r1), Number::Rational(r2)) => {
|
||||
Ok(Number::Rational(Rc::new(Rational::from(&*r1) * &*r2)))
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -469,24 +549,72 @@ impl Div<Number> for Number {
|
||||
|
||||
fn div(self, rhs: Number) -> Self::Output {
|
||||
match (self, rhs) {
|
||||
(Number::Integer(n1), Number::Integer(n2)) => Ok(Number::Float(div_f(
|
||||
float_i_to_f(&n1)?,
|
||||
float_i_to_f(&n2)?,
|
||||
)?)),
|
||||
(Number::Fixnum(n1), Number::Fixnum(n2)) => {
|
||||
Ok(Number::Float(div_f(
|
||||
float_fn_to_f(n1)?,
|
||||
float_fn_to_f(n2)?,
|
||||
)?))
|
||||
}
|
||||
(Number::Fixnum(n1), Number::Integer(n2)) => {
|
||||
Ok(Number::Float(div_f(
|
||||
float_fn_to_f(n1)?,
|
||||
float_i_to_f(&n2)?,
|
||||
)?))
|
||||
}
|
||||
(Number::Integer(n1), Number::Fixnum(n2)) => {
|
||||
Ok(Number::Float(div_f(
|
||||
float_i_to_f(&n1)?,
|
||||
float_fn_to_f(n2)?,
|
||||
)?))
|
||||
}
|
||||
(Number::Fixnum(n1), Number::Rational(n2)) => {
|
||||
Ok(Number::Float(div_f(
|
||||
float_fn_to_f(n1)?,
|
||||
float_r_to_f(&n2)?,
|
||||
)?))
|
||||
}
|
||||
(Number::Rational(n1), Number::Fixnum(n2)) => {
|
||||
Ok(Number::Float(div_f(
|
||||
float_r_to_f(&n1)?,
|
||||
float_fn_to_f(n2)?,
|
||||
)?))
|
||||
}
|
||||
(Number::Fixnum(n1), Number::Float(OrderedFloat(n2))) => {
|
||||
Ok(Number::Float(div_f(
|
||||
float_fn_to_f(n1)?,
|
||||
n2,
|
||||
)?))
|
||||
}
|
||||
(Number::Float(OrderedFloat(n1)), Number::Fixnum(n2)) => {
|
||||
Ok(Number::Float(div_f(
|
||||
n1,
|
||||
float_fn_to_f(n2)?,
|
||||
)?))
|
||||
}
|
||||
(Number::Integer(n1), Number::Integer(n2)) => {
|
||||
Ok(Number::Float(div_f(
|
||||
float_i_to_f(&n1)?,
|
||||
float_i_to_f(&n2)?,
|
||||
)?))
|
||||
}
|
||||
(Number::Integer(n1), Number::Float(OrderedFloat(n2))) => {
|
||||
Ok(Number::Float(div_f(float_i_to_f(&n1)?, n2)?))
|
||||
}
|
||||
(Number::Float(OrderedFloat(n2)), Number::Integer(n1)) => {
|
||||
Ok(Number::Float(div_f(n2, float_i_to_f(&n1)?)?))
|
||||
}
|
||||
(Number::Integer(n1), Number::Rational(n2)) => Ok(Number::Float(div_f(
|
||||
float_i_to_f(&n1)?,
|
||||
float_r_to_f(&n2)?,
|
||||
)?)),
|
||||
(Number::Rational(n2), Number::Integer(n1)) => Ok(Number::Float(div_f(
|
||||
float_r_to_f(&n2)?,
|
||||
float_i_to_f(&n1)?,
|
||||
)?)),
|
||||
(Number::Integer(n1), Number::Rational(n2)) => {
|
||||
Ok(Number::Float(div_f(
|
||||
float_i_to_f(&n1)?,
|
||||
float_r_to_f(&n2)?,
|
||||
)?))
|
||||
}
|
||||
(Number::Rational(n2), Number::Integer(n1)) => {
|
||||
Ok(Number::Float(div_f(
|
||||
float_r_to_f(&n2)?,
|
||||
float_i_to_f(&n1)?,
|
||||
)?))
|
||||
}
|
||||
(Number::Rational(n1), Number::Float(OrderedFloat(n2))) => {
|
||||
Ok(Number::Float(div_f(float_r_to_f(&n1)?, n2)?))
|
||||
}
|
||||
@@ -504,41 +632,172 @@ impl Div<Number> for Number {
|
||||
}
|
||||
}
|
||||
|
||||
impl PartialEq for Number {
|
||||
fn eq(&self, rhs: &Self) -> bool {
|
||||
match (self, rhs) {
|
||||
(&Number::Fixnum(n1), &Number::Fixnum(n2)) => n1.eq(&n2),
|
||||
(&Number::Fixnum(n1), &Number::Integer(ref n2)) => n1.eq(&**n2),
|
||||
(&Number::Integer(ref n1), &Number::Fixnum(n2)) => (&**n1).eq(&n2),
|
||||
(&Number::Fixnum(n1), &Number::Rational(ref n2)) => n1.eq(&**n2),
|
||||
(&Number::Rational(ref n1), &Number::Fixnum(n2)) => (&**n1).eq(&n2),
|
||||
(&Number::Fixnum(n1), &Number::Float(n2)) => OrderedFloat(n1 as f64).eq(&n2),
|
||||
(&Number::Float(n1), &Number::Fixnum(n2)) => n1.eq(&OrderedFloat(n2 as f64)),
|
||||
(&Number::Integer(ref n1), &Number::Integer(ref n2)) => n1.eq(n2),
|
||||
(&Number::Integer(ref n1), Number::Float(n2)) => OrderedFloat(n1.to_f64()).eq(&n2),
|
||||
(&Number::Float(n1), &Number::Integer(ref n2)) => n1.eq(&OrderedFloat(n2.to_f64())),
|
||||
(&Number::Integer(ref n1), &Number::Rational(ref n2)) => {
|
||||
#[cfg(feature = "num")]
|
||||
{
|
||||
&Rational::from(&**n1) == &**n2
|
||||
}
|
||||
#[cfg(not(feature = "num"))]
|
||||
{
|
||||
&**n1 == &**n2
|
||||
}
|
||||
}
|
||||
(&Number::Rational(ref n1), &Number::Integer(ref n2)) => {
|
||||
#[cfg(feature = "num")]
|
||||
{
|
||||
&**n1 == &Rational::from(&**n2)
|
||||
}
|
||||
#[cfg(not(feature = "num"))]
|
||||
{
|
||||
&**n1 == &**n2
|
||||
}
|
||||
}
|
||||
(&Number::Rational(ref n1), &Number::Float(n2)) => OrderedFloat(n1.to_f64()).eq(&n2),
|
||||
(&Number::Float(n1), &Number::Rational(ref n2)) => n1.eq(&OrderedFloat(n2.to_f64())),
|
||||
(&Number::Float(f1), &Number::Float(f2)) => f1.eq(&f2),
|
||||
(&Number::Rational(ref r1), &Number::Rational(ref r2)) => r1.eq(&r2),
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl Eq for Number {}
|
||||
|
||||
impl PartialOrd for Number {
|
||||
fn partial_cmp(&self, rhs: &Number) -> Option<Ordering> {
|
||||
match (self, rhs) {
|
||||
(&Number::Integer(ref n1), &Number::Integer(ref n2)) => Some(n1.cmp(n2)),
|
||||
(&Number::Integer(_), Number::Float(_)) => Some(Ordering::Greater),
|
||||
(&Number::Float(_), &Number::Integer(_)) => Some(Ordering::Less),
|
||||
(&Number::Integer(_), &Number::Rational(_)) => Some(Ordering::Greater),
|
||||
(&Number::Rational(_), &Number::Integer(_)) => Some(Ordering::Less),
|
||||
(&Number::Rational(_), Number::Float(_)) => Some(Ordering::Greater),
|
||||
(&Number::Float(_), &Number::Rational(_)) => Some(Ordering::Less),
|
||||
(&Number::Float(f1), &Number::Float(f2)) => Some(f1.cmp(&f2)),
|
||||
(&Number::Rational(ref r1), &Number::Rational(ref r2)) => Some(r1.cmp(&r2)),
|
||||
}
|
||||
Some(self.cmp(rhs))
|
||||
}
|
||||
}
|
||||
|
||||
impl Ord for Number {
|
||||
fn cmp(&self, rhs: &Number) -> Ordering {
|
||||
match (self, rhs) {
|
||||
(&Number::Fixnum(n1), &Number::Fixnum(n2)) => n1.cmp(&n2),
|
||||
(&Number::Fixnum(n1), Number::Integer(n2)) => Integer::from(n1).cmp(&*n2),
|
||||
(Number::Integer(n1), &Number::Fixnum(n2)) => (&**n1).cmp(&Integer::from(n2)),
|
||||
(&Number::Fixnum(n1), Number::Rational(n2)) => Rational::from(n1).cmp(&*n2),
|
||||
(Number::Rational(n1), &Number::Fixnum(n2)) => (&**n1).cmp(&Rational::from(n2)),
|
||||
(&Number::Fixnum(n1), &Number::Float(n2)) => OrderedFloat(n1 as f64).cmp(&n2),
|
||||
(&Number::Float(n1), &Number::Fixnum(n2)) => n1.cmp(&OrderedFloat(n2 as f64)),
|
||||
(&Number::Integer(ref n1), &Number::Integer(ref n2)) => n1.cmp(n2),
|
||||
(&Number::Integer(_), Number::Float(_)) => Ordering::Greater,
|
||||
(&Number::Float(_), &Number::Integer(_)) => Ordering::Less,
|
||||
(&Number::Integer(_), &Number::Rational(_)) => Ordering::Greater,
|
||||
(&Number::Rational(_), &Number::Integer(_)) => Ordering::Less,
|
||||
(&Number::Rational(_), Number::Float(_)) => Ordering::Greater,
|
||||
(&Number::Float(_), &Number::Rational(_)) => Ordering::Less,
|
||||
(&Number::Integer(ref n1), Number::Float(n2)) => OrderedFloat(n1.to_f64()).cmp(&n2),
|
||||
(&Number::Float(n1), &Number::Integer(ref n2)) => n1.cmp(&OrderedFloat(n2.to_f64())),
|
||||
(&Number::Integer(ref n1), &Number::Rational(ref n2)) => {
|
||||
#[cfg(feature = "num")]
|
||||
{
|
||||
Rational::from(&**n1).cmp(n2)
|
||||
}
|
||||
#[cfg(not(feature = "num"))]
|
||||
{
|
||||
(&**n1).partial_cmp(&**n2).unwrap_or(Ordering::Less)
|
||||
}
|
||||
}
|
||||
(&Number::Rational(ref n1), &Number::Integer(ref n2)) => {
|
||||
#[cfg(feature = "num")]
|
||||
{
|
||||
(&**n1).cmp(&Rational::from(&**n2))
|
||||
}
|
||||
#[cfg(not(feature = "num"))]
|
||||
{
|
||||
(&**n1).partial_cmp(&**n2).unwrap_or(Ordering::Less)
|
||||
}
|
||||
}
|
||||
(&Number::Rational(ref n1), &Number::Float(n2)) => OrderedFloat(n1.to_f64()).cmp(&n2),
|
||||
(&Number::Float(n1), &Number::Rational(ref n2)) => n1.cmp(&OrderedFloat(n2.to_f64())),
|
||||
(&Number::Float(f1), &Number::Float(f2)) => f1.cmp(&f2),
|
||||
(&Number::Rational(ref r1), &Number::Rational(ref r2)) => r1.cmp(&r2),
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> TryFrom<(Addr, &'a Heap)> for Number {
|
||||
type Error = ();
|
||||
|
||||
fn try_from((addr, heap): (Addr, &'a Heap)) -> Result<Number, Self::Error> {
|
||||
match addr {
|
||||
Addr::Fixnum(n) => {
|
||||
Ok(Number::from(n))
|
||||
}
|
||||
Addr::Float(n) => {
|
||||
Ok(Number::Float(n))
|
||||
}
|
||||
Addr::Usize(n) => {
|
||||
if let Ok(n) = isize::try_from(n) {
|
||||
Ok(Number::from(n))
|
||||
} else {
|
||||
Ok(Number::from(Integer::from(n)))
|
||||
}
|
||||
}
|
||||
Addr::Con(h) => {
|
||||
Number::try_from(&heap[h])
|
||||
}
|
||||
_ => {
|
||||
Err(())
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> TryFrom<&'a HeapCellValue> for Number {
|
||||
type Error = ();
|
||||
|
||||
fn try_from(value: &'a HeapCellValue) -> Result<Number, Self::Error> {
|
||||
match value {
|
||||
HeapCellValue::Addr(addr) => {
|
||||
match addr {
|
||||
&Addr::Fixnum(n) => {
|
||||
Ok(Number::from(n))
|
||||
}
|
||||
&Addr::Float(n) => {
|
||||
Ok(Number::Float(n))
|
||||
}
|
||||
&Addr::Usize(n) => {
|
||||
if let Ok(n) = isize::try_from(n) {
|
||||
Ok(Number::from(n))
|
||||
} else {
|
||||
Ok(Number::from(Integer::from(n)))
|
||||
}
|
||||
}
|
||||
_ => {
|
||||
Err(())
|
||||
}
|
||||
}
|
||||
}
|
||||
HeapCellValue::Integer(n) => {
|
||||
Ok(Number::Integer(n.clone()))
|
||||
}
|
||||
HeapCellValue::Rational(n) => {
|
||||
Ok(Number::Rational(n.clone()))
|
||||
}
|
||||
_ => {
|
||||
Err(())
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> From<&'a Integer> for Number {
|
||||
#[inline]
|
||||
fn from(src: &'a Integer) -> Self {
|
||||
Number::Integer(Rc::new(Integer::from(src)))
|
||||
}
|
||||
}
|
||||
|
||||
// Computes n ^ power. Ignores the sign of power.
|
||||
pub fn binary_pow(mut n: Integer, power: Integer) -> Integer {
|
||||
let mut power = power.abs();
|
||||
pub fn binary_pow(mut n: Integer, power: &Integer) -> Integer {
|
||||
let mut power = Integer::from(power.abs_ref());
|
||||
|
||||
if power == 0 {
|
||||
return Integer::from(1);
|
||||
|
||||
@@ -2,12 +2,13 @@ use prolog_parser::ast::*;
|
||||
|
||||
use crate::prolog::forms::Number;
|
||||
use crate::prolog::machine::machine_indices::*;
|
||||
use crate::prolog::rug::rand::RandState;
|
||||
|
||||
use ref_thread_local::RefThreadLocal;
|
||||
|
||||
use std::collections::BTreeMap;
|
||||
|
||||
#[derive(Clone, Copy, Eq, PartialEq)]
|
||||
#[derive(Debug, Clone, Copy, Eq, PartialEq)]
|
||||
pub enum CompareNumberQT {
|
||||
GreaterThan,
|
||||
LessThan,
|
||||
@@ -30,7 +31,7 @@ impl CompareNumberQT {
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Clone, Copy, PartialEq, Eq)]
|
||||
#[derive(Debug, Clone, Copy, PartialEq, Eq)]
|
||||
pub enum CompareTermQT {
|
||||
LessThan,
|
||||
LessThanOrEqual,
|
||||
@@ -49,7 +50,7 @@ impl CompareTermQT {
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Clone, PartialEq, Eq)]
|
||||
#[derive(Debug, Clone, PartialEq, Eq)]
|
||||
pub enum ArithmeticTerm {
|
||||
Reg(RegType),
|
||||
Interm(usize),
|
||||
@@ -66,7 +67,7 @@ impl ArithmeticTerm {
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Clone, Eq, PartialEq)]
|
||||
#[derive(Debug, Clone, Eq, PartialEq)]
|
||||
pub enum InlinedClauseType {
|
||||
CompareNumber(CompareNumberQT, ArithmeticTerm, ArithmeticTerm),
|
||||
IsAtom(RegType),
|
||||
@@ -74,13 +75,15 @@ pub enum InlinedClauseType {
|
||||
IsCompound(RegType),
|
||||
IsInteger(RegType),
|
||||
IsRational(RegType),
|
||||
IsString(RegType),
|
||||
IsFloat(RegType),
|
||||
IsNonVar(RegType),
|
||||
IsPartialString(RegType),
|
||||
IsVar(RegType),
|
||||
}
|
||||
|
||||
ref_thread_local! {
|
||||
pub static managed RANDOM_STATE: RandState<'static> = RandState::new();
|
||||
}
|
||||
|
||||
ref_thread_local! {
|
||||
pub static managed CLAUSE_TYPE_FORMS: BTreeMap<(&'static str, usize), ClauseType> = {
|
||||
let mut m = BTreeMap::new();
|
||||
@@ -101,10 +104,8 @@ ref_thread_local! {
|
||||
m.insert(("compound", 1), ClauseType::Inlined(InlinedClauseType::IsCompound(r1)));
|
||||
m.insert(("integer", 1), ClauseType::Inlined(InlinedClauseType::IsInteger(r1)));
|
||||
m.insert(("rational", 1), ClauseType::Inlined(InlinedClauseType::IsRational(r1)));
|
||||
m.insert(("string", 1), ClauseType::Inlined(InlinedClauseType::IsString(r1)));
|
||||
m.insert(("float", 1), ClauseType::Inlined(InlinedClauseType::IsFloat(r1)));
|
||||
m.insert(("nonvar", 1), ClauseType::Inlined(InlinedClauseType::IsNonVar(r1)));
|
||||
m.insert(("is_partial_string", 1), ClauseType::Inlined(InlinedClauseType::IsPartialString(r1)));
|
||||
m.insert(("var", 1), ClauseType::Inlined(InlinedClauseType::IsVar(r1)));
|
||||
m.insert(("acyclic_term", 1), ClauseType::BuiltIn(BuiltInClauseType::AcyclicTerm));
|
||||
m.insert(("arg", 3), ClauseType::BuiltIn(BuiltInClauseType::Arg));
|
||||
@@ -114,7 +115,6 @@ ref_thread_local! {
|
||||
m.insert(("@>=", 2), ClauseType::BuiltIn(BuiltInClauseType::CompareTerm(CompareTermQT::GreaterThanOrEqual)));
|
||||
m.insert(("@=<", 2), ClauseType::BuiltIn(BuiltInClauseType::CompareTerm(CompareTermQT::LessThanOrEqual)));
|
||||
m.insert(("copy_term", 2), ClauseType::BuiltIn(BuiltInClauseType::CopyTerm));
|
||||
m.insert(("cyclic_term", 1), ClauseType::BuiltIn(BuiltInClauseType::CyclicTerm));
|
||||
m.insert(("==", 2), ClauseType::BuiltIn(BuiltInClauseType::Eq));
|
||||
m.insert(("functor", 3), ClauseType::BuiltIn(BuiltInClauseType::Functor));
|
||||
m.insert(("ground", 1), ClauseType::BuiltIn(BuiltInClauseType::Ground));
|
||||
@@ -122,7 +122,6 @@ ref_thread_local! {
|
||||
m.insert(("keysort", 2), ClauseType::BuiltIn(BuiltInClauseType::KeySort));
|
||||
m.insert(("nl", 0), ClauseType::BuiltIn(BuiltInClauseType::Nl));
|
||||
m.insert(("\\==", 2), ClauseType::BuiltIn(BuiltInClauseType::NotEq));
|
||||
m.insert(("partial_string", 2), ClauseType::BuiltIn(BuiltInClauseType::PartialString));
|
||||
m.insert(("read", 1), ClauseType::BuiltIn(BuiltInClauseType::Read));
|
||||
m.insert(("sort", 2), ClauseType::BuiltIn(BuiltInClauseType::Sort));
|
||||
|
||||
@@ -139,41 +138,56 @@ impl InlinedClauseType {
|
||||
&InlinedClauseType::IsCompound(..) => "compound",
|
||||
&InlinedClauseType::IsInteger(..) => "integer",
|
||||
&InlinedClauseType::IsRational(..) => "rational",
|
||||
&InlinedClauseType::IsString(..) => "string",
|
||||
&InlinedClauseType::IsFloat(..) => "float",
|
||||
&InlinedClauseType::IsNonVar(..) => "nonvar",
|
||||
&InlinedClauseType::IsPartialString(..) => "is_partial_string",
|
||||
&InlinedClauseType::IsVar(..) => "var",
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Copy, Clone, Eq, PartialEq)]
|
||||
#[derive(Debug, Copy, Clone, Eq, PartialEq)]
|
||||
pub enum SystemClauseType {
|
||||
AbolishClause,
|
||||
AbolishModuleClause,
|
||||
AssertDynamicPredicateToBack,
|
||||
AssertDynamicPredicateToFront,
|
||||
AtEndOfExpansion,
|
||||
AtomChars,
|
||||
AtomCodes,
|
||||
AtomLength,
|
||||
ModuleAssertDynamicPredicateToFront,
|
||||
ModuleAssertDynamicPredicateToBack,
|
||||
BindFromRegister,
|
||||
CallContinuation,
|
||||
CharCode,
|
||||
CharType,
|
||||
CharsToNumber,
|
||||
ClearAttributeGoals,
|
||||
CloneAttributeGoals,
|
||||
CodesToNumber,
|
||||
CopyTermWithoutAttrVars,
|
||||
CheckCutPoint,
|
||||
Close,
|
||||
CopyToLiftedHeap,
|
||||
CreatePartialString,
|
||||
CurrentHostname,
|
||||
CurrentInput,
|
||||
CurrentOutput,
|
||||
DeleteAttribute,
|
||||
DeleteHeadAttribute,
|
||||
DynamicModuleResolution,
|
||||
DynamicModuleResolution(usize),
|
||||
EnqueueAttributeGoal,
|
||||
EnqueueAttributedVar,
|
||||
ExpandGoal,
|
||||
ExpandTerm,
|
||||
FetchGlobalVar,
|
||||
FetchGlobalVarWithOffset,
|
||||
FileToChars,
|
||||
FirstStream,
|
||||
FlushOutput,
|
||||
GetByte,
|
||||
GetChar,
|
||||
GetCode,
|
||||
GetSingleChar,
|
||||
ResetAttrVarState,
|
||||
TruncateIfNoLiftedHeapGrowthDiff,
|
||||
TruncateIfNoLiftedHeapGrowth,
|
||||
GetAttributedVariableList,
|
||||
@@ -181,9 +195,11 @@ pub enum SystemClauseType {
|
||||
GetAttrVarQueueBeyond,
|
||||
GetBValue,
|
||||
GetClause,
|
||||
GetContinuationChunk,
|
||||
GetModuleClause,
|
||||
GetNextDBRef,
|
||||
GetNextOpDBRef,
|
||||
IsPartialString,
|
||||
LookupDBRef,
|
||||
LookupOpDBRef,
|
||||
Halt,
|
||||
@@ -195,25 +211,45 @@ pub enum SystemClauseType {
|
||||
InstallSCCCleaner,
|
||||
InstallInferenceCounter,
|
||||
LiftedHeapLength,
|
||||
ModuleAssertDynamicPredicateToFront,
|
||||
ModuleAssertDynamicPredicateToBack,
|
||||
ModuleExists,
|
||||
ModuleOf,
|
||||
ModuleRetractClause,
|
||||
NextEP,
|
||||
NoSuchPredicate,
|
||||
NumberToChars,
|
||||
NumberToCodes,
|
||||
OpDeclaration,
|
||||
Open,
|
||||
NextStream,
|
||||
PartialStringTail,
|
||||
PeekByte,
|
||||
PeekChar,
|
||||
PeekCode,
|
||||
PointsToContinuationResetMarker,
|
||||
PutByte,
|
||||
PutBytes,
|
||||
PutChar,
|
||||
PutCode,
|
||||
REPL(REPLCodePtr),
|
||||
ReadQueryTerm,
|
||||
ReadTerm,
|
||||
RedoAttrVarBindings,
|
||||
RedoAttrVarBinding,
|
||||
RemoveCallPolicyCheck,
|
||||
RemoveInferenceCounter,
|
||||
ResetContinuationMarker,
|
||||
ResetGlobalVarAtKey,
|
||||
ResetGlobalVarAtOffset,
|
||||
RetractClause,
|
||||
RestoreCutPolicy,
|
||||
SetCutPoint(RegType),
|
||||
SetInput,
|
||||
SetOutput,
|
||||
StoreGlobalVar,
|
||||
StoreGlobalVarWithOffset,
|
||||
StreamProperty,
|
||||
SetStreamPosition,
|
||||
InferenceLevel,
|
||||
CleanUpBlock,
|
||||
EraseBall,
|
||||
@@ -223,21 +259,44 @@ pub enum SystemClauseType {
|
||||
GetCutPoint,
|
||||
GetDoubleQuotes,
|
||||
InstallNewBlock,
|
||||
Maybe,
|
||||
CpuNow,
|
||||
QuotedToken,
|
||||
ReadTermFromChars,
|
||||
ResetBlock,
|
||||
ReturnFromAttributeGoals,
|
||||
ReturnFromVerifyAttr,
|
||||
SetBall,
|
||||
SetCutPointByDefault(RegType),
|
||||
SetDoubleQuotes,
|
||||
SetSeed,
|
||||
SkipMaxList,
|
||||
Sleep,
|
||||
SocketClientOpen,
|
||||
SocketServerOpen,
|
||||
SocketServerAccept,
|
||||
SocketServerClose,
|
||||
Succeed,
|
||||
TermAttributedVariables,
|
||||
TermVariables,
|
||||
TruncateLiftedHeapTo,
|
||||
UnifyWithOccursCheck,
|
||||
UnwindEnvironments,
|
||||
UnwindStack,
|
||||
Variant,
|
||||
WAMInstructions,
|
||||
WriteTerm,
|
||||
WriteTermToChars,
|
||||
ScryerPrologVersion,
|
||||
CryptoRandomByte,
|
||||
CryptoDataHash,
|
||||
CryptoDataHKDF,
|
||||
CryptoPasswordHash,
|
||||
CryptoDataEncrypt,
|
||||
CryptoDataDecrypt,
|
||||
Ed25519Sign,
|
||||
Ed25519Verify,
|
||||
Ed25519NewKeyPair,
|
||||
Ed25519KeyPairPublicKey
|
||||
}
|
||||
|
||||
impl SystemClauseType {
|
||||
@@ -247,37 +306,40 @@ impl SystemClauseType {
|
||||
&SystemClauseType::AbolishModuleClause => clause_name!("$abolish_module_clause"),
|
||||
&SystemClauseType::AssertDynamicPredicateToBack => clause_name!("$assertz"),
|
||||
&SystemClauseType::AssertDynamicPredicateToFront => clause_name!("$asserta"),
|
||||
&SystemClauseType::AtEndOfExpansion => clause_name!("$at_end_of_expansion"),
|
||||
&SystemClauseType::AtomChars => clause_name!("$atom_chars"),
|
||||
&SystemClauseType::AtomCodes => clause_name!("$atom_codes"),
|
||||
&SystemClauseType::AtomLength => clause_name!("$atom_length"),
|
||||
&SystemClauseType::ModuleAssertDynamicPredicateToFront => {
|
||||
clause_name!("$module_asserta")
|
||||
}
|
||||
&SystemClauseType::ModuleAssertDynamicPredicateToBack => {
|
||||
clause_name!("$module_assertz")
|
||||
}
|
||||
&SystemClauseType::BindFromRegister => clause_name!("$bind_from_register"),
|
||||
&SystemClauseType::CallContinuation => clause_name!("$call_continuation"),
|
||||
&SystemClauseType::CharCode => clause_name!("$char_code"),
|
||||
&SystemClauseType::CharType => clause_name!("$char_type"),
|
||||
&SystemClauseType::CharsToNumber => clause_name!("$chars_to_number"),
|
||||
&SystemClauseType::CodesToNumber => clause_name!("$codes_to_number"),
|
||||
&SystemClauseType::CheckCutPoint => clause_name!("$check_cp"),
|
||||
&SystemClauseType::ClearAttributeGoals => clause_name!("$clear_attribute_goals"),
|
||||
&SystemClauseType::CloneAttributeGoals => clause_name!("$clone_attribute_goals"),
|
||||
&SystemClauseType::CodesToNumber => clause_name!("$codes_to_number"),
|
||||
&SystemClauseType::CopyTermWithoutAttrVars => clause_name!("$copy_term_without_attr_vars"),
|
||||
&SystemClauseType::CreatePartialString => clause_name!("$create_partial_string"),
|
||||
&SystemClauseType::CurrentInput => clause_name!("$current_input"),
|
||||
&SystemClauseType::CurrentHostname => clause_name!("$current_hostname"),
|
||||
&SystemClauseType::CurrentOutput => clause_name!("$current_output"),
|
||||
&SystemClauseType::REPL(REPLCodePtr::CompileBatch) => clause_name!("$compile_batch"),
|
||||
&SystemClauseType::REPL(REPLCodePtr::SubmitQueryAndPrintResults) => {
|
||||
clause_name!("$submit_query_and_print_results")
|
||||
&SystemClauseType::REPL(REPLCodePtr::UseModule) => clause_name!("$use_module"),
|
||||
&SystemClauseType::REPL(REPLCodePtr::UseQualifiedModule) => {
|
||||
clause_name!("$use_qualified_module")
|
||||
}
|
||||
&SystemClauseType::REPL(REPLCodePtr::UseModule) => clause_name!("$use_module"),
|
||||
&SystemClauseType::REPL(REPLCodePtr::UseQualifiedModule) => {
|
||||
clause_name!("$use_qualified_module")
|
||||
}
|
||||
&SystemClauseType::REPL(REPLCodePtr::UseModuleFromFile) => {
|
||||
clause_name!("$use_module_from_file")
|
||||
}
|
||||
&SystemClauseType::REPL(REPLCodePtr::UseQualifiedModuleFromFile) => {
|
||||
clause_name!("$use_qualified_module_from_file")
|
||||
}
|
||||
&SystemClauseType::REPL(REPLCodePtr::UseModuleFromFile) => {
|
||||
clause_name!("$use_module_from_file")
|
||||
}
|
||||
&SystemClauseType::REPL(REPLCodePtr::UseQualifiedModuleFromFile) => {
|
||||
clause_name!("$use_qualified_module_from_file")
|
||||
}
|
||||
&SystemClauseType::Close => clause_name!("$close"),
|
||||
&SystemClauseType::CopyToLiftedHeap => clause_name!("$copy_to_lh"),
|
||||
&SystemClauseType::DeleteAttribute => clause_name!("$del_attr_non_head"),
|
||||
&SystemClauseType::DeleteHeadAttribute => clause_name!("$del_attr_head"),
|
||||
&SystemClauseType::DynamicModuleResolution => clause_name!("$module_call"),
|
||||
&SystemClauseType::DynamicModuleResolution(_) => clause_name!("$module_call"),
|
||||
&SystemClauseType::EnqueueAttributeGoal => clause_name!("$enqueue_attribute_goal"),
|
||||
&SystemClauseType::EnqueueAttributedVar => clause_name!("$enqueue_attr_var"),
|
||||
&SystemClauseType::ExpandTerm => clause_name!("$expand_term"),
|
||||
@@ -286,7 +348,14 @@ impl SystemClauseType {
|
||||
&SystemClauseType::FetchGlobalVarWithOffset => {
|
||||
clause_name!("$fetch_global_var_with_offset")
|
||||
}
|
||||
&SystemClauseType::FileToChars => clause_name!("$file_to_chars"),
|
||||
&SystemClauseType::FirstStream => clause_name!("$first_stream"),
|
||||
&SystemClauseType::FlushOutput => clause_name!("$flush_output"),
|
||||
&SystemClauseType::GetByte => clause_name!("$get_byte"),
|
||||
&SystemClauseType::GetChar => clause_name!("$get_char"),
|
||||
&SystemClauseType::GetCode => clause_name!("$get_code"),
|
||||
&SystemClauseType::GetSingleChar => clause_name!("$get_single_char"),
|
||||
&SystemClauseType::ResetAttrVarState => clause_name!("$reset_attr_var_state"),
|
||||
&SystemClauseType::TruncateIfNoLiftedHeapGrowth => {
|
||||
clause_name!("$truncate_if_no_lh_growth")
|
||||
}
|
||||
@@ -298,6 +367,7 @@ impl SystemClauseType {
|
||||
clause_name!("$get_attr_var_queue_delim")
|
||||
}
|
||||
&SystemClauseType::GetAttrVarQueueBeyond => clause_name!("$get_attr_var_queue_beyond"),
|
||||
&SystemClauseType::GetContinuationChunk => clause_name!("$get_cont_chunk"),
|
||||
&SystemClauseType::GetLiftedHeapFromOffset => clause_name!("$get_lh_from_offset"),
|
||||
&SystemClauseType::GetLiftedHeapFromOffsetDiff => {
|
||||
clause_name!("$get_lh_from_offset_diff")
|
||||
@@ -313,22 +383,61 @@ impl SystemClauseType {
|
||||
&SystemClauseType::GetSCCCleaner => clause_name!("$get_scc_cleaner"),
|
||||
&SystemClauseType::Halt => clause_name!("$halt"),
|
||||
&SystemClauseType::HeadIsDynamic => clause_name!("$head_is_dynamic"),
|
||||
&SystemClauseType::OpDeclaration => clause_name!("$op$"),
|
||||
&SystemClauseType::Open => clause_name!("$open"),
|
||||
&SystemClauseType::OpDeclaration => clause_name!("$op"),
|
||||
&SystemClauseType::InstallSCCCleaner => clause_name!("$install_scc_cleaner"),
|
||||
&SystemClauseType::InstallInferenceCounter => {
|
||||
clause_name!("$install_inference_counter")
|
||||
}
|
||||
&SystemClauseType::IsPartialString => clause_name!("$is_partial_string"),
|
||||
&SystemClauseType::PartialStringTail => clause_name!("$partial_string_tail"),
|
||||
&SystemClauseType::PeekByte => clause_name!("$peek_byte"),
|
||||
&SystemClauseType::PeekChar => clause_name!("$peek_char"),
|
||||
&SystemClauseType::PeekCode => clause_name!("$peek_code"),
|
||||
&SystemClauseType::LiftedHeapLength => clause_name!("$lh_length"),
|
||||
&SystemClauseType::Maybe => clause_name!("maybe"),
|
||||
&SystemClauseType::CpuNow => clause_name!("$cpu_now"),
|
||||
&SystemClauseType::ModuleAssertDynamicPredicateToFront => {
|
||||
clause_name!("$module_asserta")
|
||||
}
|
||||
&SystemClauseType::ModuleAssertDynamicPredicateToBack => {
|
||||
clause_name!("$module_assertz")
|
||||
}
|
||||
&SystemClauseType::ModuleHeadIsDynamic => clause_name!("$module_head_is_dynamic"),
|
||||
&SystemClauseType::ModuleExists => clause_name!("$module_exists"),
|
||||
&SystemClauseType::ModuleOf => clause_name!("$module_of"),
|
||||
&SystemClauseType::NextStream => clause_name!("$next_stream"),
|
||||
&SystemClauseType::NoSuchPredicate => clause_name!("$no_such_predicate"),
|
||||
&SystemClauseType::NumberToChars => clause_name!("$number_to_chars"),
|
||||
&SystemClauseType::NumberToCodes => clause_name!("$number_to_codes"),
|
||||
&SystemClauseType::RedoAttrVarBindings => clause_name!("$redo_attr_var_bindings"),
|
||||
&SystemClauseType::PointsToContinuationResetMarker => {
|
||||
clause_name!("$points_to_cont_reset_marker")
|
||||
}
|
||||
&SystemClauseType::PutByte => {
|
||||
clause_name!("$put_byte")
|
||||
}
|
||||
&SystemClauseType::PutBytes => {
|
||||
clause_name!("$put_bytes")
|
||||
}
|
||||
&SystemClauseType::PutChar => {
|
||||
clause_name!("$put_char")
|
||||
}
|
||||
&SystemClauseType::PutCode => {
|
||||
clause_name!("$put_code")
|
||||
}
|
||||
&SystemClauseType::QuotedToken => {
|
||||
clause_name!("$quoted_token")
|
||||
}
|
||||
&SystemClauseType::RedoAttrVarBinding => clause_name!("$redo_attr_var_binding"),
|
||||
&SystemClauseType::RemoveCallPolicyCheck => clause_name!("$remove_call_policy_check"),
|
||||
&SystemClauseType::RemoveInferenceCounter => clause_name!("$remove_inference_counter"),
|
||||
&SystemClauseType::RestoreCutPolicy => clause_name!("$restore_cut_policy"),
|
||||
&SystemClauseType::SetCutPoint(_) => clause_name!("$set_cp"),
|
||||
&SystemClauseType::SetInput => clause_name!("$set_input"),
|
||||
&SystemClauseType::SetOutput => clause_name!("$set_output"),
|
||||
&SystemClauseType::SetSeed => clause_name!("$set_seed"),
|
||||
&SystemClauseType::StreamProperty => clause_name!("$stream_property"),
|
||||
&SystemClauseType::SetStreamPosition => clause_name!("$set_stream_position"),
|
||||
&SystemClauseType::StoreGlobalVar => clause_name!("$store_global_var"),
|
||||
&SystemClauseType::StoreGlobalVarWithOffset => {
|
||||
clause_name!("$store_global_var_with_offset")
|
||||
@@ -342,62 +451,121 @@ impl SystemClauseType {
|
||||
&SystemClauseType::GetCurrentBlock => clause_name!("$get_current_block"),
|
||||
&SystemClauseType::InstallNewBlock => clause_name!("$install_new_block"),
|
||||
&SystemClauseType::ModuleRetractClause => clause_name!("$module_retract_clause"),
|
||||
&SystemClauseType::NextEP => clause_name!("$nextEP"),
|
||||
&SystemClauseType::ReadQueryTerm => clause_name!("$read_query_term"),
|
||||
&SystemClauseType::ReadTerm => clause_name!("$read_term"),
|
||||
&SystemClauseType::ReadTermFromChars => clause_name!("$read_term_from_chars"),
|
||||
&SystemClauseType::ResetGlobalVarAtKey => clause_name!("$reset_global_var_at_key"),
|
||||
&SystemClauseType::ResetGlobalVarAtOffset => clause_name!("$reset_global_var_at_offset"),
|
||||
&SystemClauseType::RetractClause => clause_name!("$retract_clause"),
|
||||
&SystemClauseType::ResetBlock => clause_name!("$reset_block"),
|
||||
&SystemClauseType::ReturnFromAttributeGoals => {
|
||||
clause_name!("$return_from_attribute_goals")
|
||||
}
|
||||
&SystemClauseType::ResetContinuationMarker => clause_name!("$reset_cont_marker"),
|
||||
&SystemClauseType::ReturnFromVerifyAttr => clause_name!("$return_from_verify_attr"),
|
||||
&SystemClauseType::SetBall => clause_name!("$set_ball"),
|
||||
&SystemClauseType::SetCutPointByDefault(_) => clause_name!("$set_cp_by_default"),
|
||||
&SystemClauseType::SetDoubleQuotes => clause_name!("$set_double_quotes"),
|
||||
&SystemClauseType::SkipMaxList => clause_name!("$skip_max_list"),
|
||||
&SystemClauseType::Sleep => clause_name!("$sleep"),
|
||||
&SystemClauseType::SocketClientOpen => clause_name!("$socket_client_open"),
|
||||
&SystemClauseType::SocketServerOpen => clause_name!("$socket_server_open"),
|
||||
&SystemClauseType::SocketServerAccept => clause_name!("$socket_server_accept"),
|
||||
&SystemClauseType::SocketServerClose => clause_name!("$socket_server_close"),
|
||||
&SystemClauseType::Succeed => clause_name!("$succeed"),
|
||||
&SystemClauseType::TermAttributedVariables => clause_name!("$term_attributed_variables"),
|
||||
&SystemClauseType::TermVariables => clause_name!("$term_variables"),
|
||||
&SystemClauseType::TruncateLiftedHeapTo => clause_name!("$truncate_lh_to"),
|
||||
&SystemClauseType::UnifyWithOccursCheck => clause_name!("$unify_with_occurs_check"),
|
||||
&SystemClauseType::UnwindEnvironments => clause_name!("$unwind_environments"),
|
||||
&SystemClauseType::UnwindStack => clause_name!("$unwind_stack"),
|
||||
&SystemClauseType::Variant => clause_name!("$variant"),
|
||||
&SystemClauseType::WAMInstructions => clause_name!("$wam_instructions"),
|
||||
&SystemClauseType::WriteTerm => clause_name!("$write_term"),
|
||||
&SystemClauseType::WriteTermToChars => clause_name!("$write_term_to_chars"),
|
||||
&SystemClauseType::ScryerPrologVersion => clause_name!("$scryer_prolog_version"),
|
||||
&SystemClauseType::CryptoRandomByte => clause_name!("$crypto_random_byte"),
|
||||
&SystemClauseType::CryptoDataHash => clause_name!("$crypto_data_hash"),
|
||||
&SystemClauseType::CryptoDataHKDF => clause_name!("$crypto_data_hkdf"),
|
||||
&SystemClauseType::CryptoPasswordHash => clause_name!("$crypto_password_hash"),
|
||||
&SystemClauseType::CryptoDataEncrypt => clause_name!("$crypto_data_encrypt"),
|
||||
&SystemClauseType::CryptoDataDecrypt => clause_name!("$crypto_data_decrypt"),
|
||||
&SystemClauseType::Ed25519Sign => clause_name!("$ed25519_sign"),
|
||||
&SystemClauseType::Ed25519Verify => clause_name!("$ed25519_verify"),
|
||||
&SystemClauseType::Ed25519NewKeyPair => clause_name!("$ed25519_new_keypair"),
|
||||
&SystemClauseType::Ed25519KeyPairPublicKey => clause_name!("$ed25519_keypair_public_key")
|
||||
}
|
||||
}
|
||||
|
||||
pub fn from(name: &str, arity: usize) -> Option<SystemClauseType> {
|
||||
match (name, arity) {
|
||||
("$abolish_clause", 2) => Some(SystemClauseType::AbolishClause),
|
||||
("$at_end_of_expansion", 0) => Some(SystemClauseType::AtEndOfExpansion),
|
||||
("$atom_chars", 2) => Some(SystemClauseType::AtomChars),
|
||||
("$atom_codes", 2) => Some(SystemClauseType::AtomCodes),
|
||||
("$atom_length", 2) => Some(SystemClauseType::AtomLength),
|
||||
("$abolish_module_clause", 3) => Some(SystemClauseType::AbolishModuleClause),
|
||||
("$bind_from_register", 2) => Some(SystemClauseType::BindFromRegister),
|
||||
("$module_asserta", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToFront),
|
||||
("$module_assertz", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToBack),
|
||||
("$asserta", 4) => Some(SystemClauseType::AssertDynamicPredicateToFront),
|
||||
("$assertz", 4) => Some(SystemClauseType::AssertDynamicPredicateToBack),
|
||||
("$call_continuation", 1) => Some(SystemClauseType::CallContinuation),
|
||||
("$char_code", 2) => Some(SystemClauseType::CharCode),
|
||||
("$char_type", 2) => Some(SystemClauseType::CharType),
|
||||
("$chars_to_number", 2) => Some(SystemClauseType::CharsToNumber),
|
||||
("$clear_attribute_goals", 0) => Some(SystemClauseType::ClearAttributeGoals),
|
||||
("$clone_attribute_goals", 1) => Some(SystemClauseType::CloneAttributeGoals),
|
||||
("$codes_to_number", 2) => Some(SystemClauseType::CodesToNumber),
|
||||
("$copy_term_without_attr_vars", 2) => Some(SystemClauseType::CopyTermWithoutAttrVars),
|
||||
("$create_partial_string", 3) => Some(SystemClauseType::CreatePartialString),
|
||||
("$check_cp", 1) => Some(SystemClauseType::CheckCutPoint),
|
||||
("$compile_batch", 0) => Some(SystemClauseType::REPL(REPLCodePtr::CompileBatch)),
|
||||
("$copy_to_lh", 2) => Some(SystemClauseType::CopyToLiftedHeap),
|
||||
("$close", 2) => Some(SystemClauseType::Close),
|
||||
("$current_hostname", 1) => Some(SystemClauseType::CurrentHostname),
|
||||
("$current_input", 1) => Some(SystemClauseType::CurrentInput),
|
||||
("$current_output", 1) => Some(SystemClauseType::CurrentOutput),
|
||||
("$first_stream", 1) => Some(SystemClauseType::FirstStream),
|
||||
("$next_stream", 2) => Some(SystemClauseType::NextStream),
|
||||
("$flush_output", 1) => Some(SystemClauseType::FlushOutput),
|
||||
("$del_attr_non_head", 1) => Some(SystemClauseType::DeleteAttribute),
|
||||
("$del_attr_head", 1) => Some(SystemClauseType::DeleteHeadAttribute),
|
||||
("$get_next_db_ref", 2) => Some(SystemClauseType::GetNextDBRef),
|
||||
("$get_next_op_db_ref", 2) => Some(SystemClauseType::GetNextOpDBRef),
|
||||
("$lookup_db_ref", 3) => Some(SystemClauseType::LookupDBRef),
|
||||
("$lookup_op_db_ref", 4) => Some(SystemClauseType::LookupOpDBRef),
|
||||
("$module_call", 2) => Some(SystemClauseType::DynamicModuleResolution),
|
||||
("$module_call", _) => Some(SystemClauseType::DynamicModuleResolution(arity - 2)),
|
||||
("$enqueue_attribute_goal", 1) => Some(SystemClauseType::EnqueueAttributeGoal),
|
||||
("$enqueue_attr_var", 1) => Some(SystemClauseType::EnqueueAttributedVar),
|
||||
("$partial_string_tail", 2) => Some(SystemClauseType::PartialStringTail),
|
||||
("$peek_byte", 2) => Some(SystemClauseType::PeekByte),
|
||||
("$peek_char", 2) => Some(SystemClauseType::PeekChar),
|
||||
("$peek_code", 2) => Some(SystemClauseType::PeekCode),
|
||||
("$is_partial_string", 1) => Some(SystemClauseType::IsPartialString),
|
||||
("$expand_term", 2) => Some(SystemClauseType::ExpandTerm),
|
||||
("$expand_goal", 2) => Some(SystemClauseType::ExpandGoal),
|
||||
("$fetch_global_var", 2) => Some(SystemClauseType::FetchGlobalVar),
|
||||
("$fetch_global_var_with_offset", 3) => Some(SystemClauseType::FetchGlobalVarWithOffset),
|
||||
("$get_char", 1) => Some(SystemClauseType::GetChar),
|
||||
("$file_to_chars", 3) => Some(SystemClauseType::FileToChars),
|
||||
("$get_byte", 2) => Some(SystemClauseType::GetByte),
|
||||
("$get_char", 2) => Some(SystemClauseType::GetChar),
|
||||
("$get_code", 2) => Some(SystemClauseType::GetCode),
|
||||
("$get_single_char", 1) => Some(SystemClauseType::GetSingleChar),
|
||||
("$points_to_cont_reset_marker", 1) => {
|
||||
Some(SystemClauseType::PointsToContinuationResetMarker)
|
||||
}
|
||||
("$put_byte", 2) => {
|
||||
Some(SystemClauseType::PutByte)
|
||||
}
|
||||
("$put_bytes", 2) => {
|
||||
Some(SystemClauseType::PutBytes)
|
||||
}
|
||||
("$put_char", 2) => {
|
||||
Some(SystemClauseType::PutChar)
|
||||
}
|
||||
("$put_code", 2) => {
|
||||
Some(SystemClauseType::PutCode)
|
||||
}
|
||||
("$reset_attr_var_state", 0) => Some(SystemClauseType::ResetAttrVarState),
|
||||
("$truncate_if_no_lh_growth", 1) => {
|
||||
Some(SystemClauseType::TruncateIfNoLiftedHeapGrowth)
|
||||
}
|
||||
@@ -417,6 +585,9 @@ impl SystemClauseType {
|
||||
("$install_scc_cleaner", 2) => Some(SystemClauseType::InstallSCCCleaner),
|
||||
("$install_inference_counter", 3) => Some(SystemClauseType::InstallInferenceCounter),
|
||||
("$lh_length", 1) => Some(SystemClauseType::LiftedHeapLength),
|
||||
("$maybe", 0) => Some(SystemClauseType::Maybe),
|
||||
("$cpu_now", 1) => Some(SystemClauseType::CpuNow),
|
||||
("$module_exists", 1) => Some(SystemClauseType::ModuleExists),
|
||||
("$module_of", 2) => Some(SystemClauseType::ModuleOf),
|
||||
("$module_retract_clause", 5) => Some(SystemClauseType::ModuleRetractClause),
|
||||
("$module_head_is_dynamic", 2) => Some(SystemClauseType::ModuleHeadIsDynamic),
|
||||
@@ -424,11 +595,16 @@ impl SystemClauseType {
|
||||
("$number_to_chars", 2) => Some(SystemClauseType::NumberToChars),
|
||||
("$number_to_codes", 2) => Some(SystemClauseType::NumberToCodes),
|
||||
("$op", 3) => Some(SystemClauseType::OpDeclaration),
|
||||
("$redo_attr_var_bindings", 0) => Some(SystemClauseType::RedoAttrVarBindings),
|
||||
("$open", 7) => Some(SystemClauseType::Open),
|
||||
("$redo_attr_var_binding", 2) => Some(SystemClauseType::RedoAttrVarBinding),
|
||||
("$remove_call_policy_check", 1) => Some(SystemClauseType::RemoveCallPolicyCheck),
|
||||
("$remove_inference_counter", 2) => Some(SystemClauseType::RemoveInferenceCounter),
|
||||
("$restore_cut_policy", 0) => Some(SystemClauseType::RestoreCutPolicy),
|
||||
("$set_cp", 1) => Some(SystemClauseType::SetCutPoint(temp_v!(1))),
|
||||
("$set_input", 1) => Some(SystemClauseType::SetInput),
|
||||
("$set_output", 1) => Some(SystemClauseType::SetOutput),
|
||||
("$stream_property", 3) => Some(SystemClauseType::StreamProperty),
|
||||
("$set_stream_position", 2) => Some(SystemClauseType::SetStreamPosition),
|
||||
("$inference_level", 2) => Some(SystemClauseType::InferenceLevel),
|
||||
("$clean_up_block", 1) => Some(SystemClauseType::CleanUpBlock),
|
||||
("$erase_ball", 0) => Some(SystemClauseType::EraseBall),
|
||||
@@ -436,52 +612,72 @@ impl SystemClauseType {
|
||||
("$get_attr_var_queue_beyond", 2) => Some(SystemClauseType::GetAttrVarQueueBeyond),
|
||||
("$get_attr_var_queue_delim", 1) => Some(SystemClauseType::GetAttrVarQueueDelimiter),
|
||||
("$get_ball", 1) => Some(SystemClauseType::GetBall),
|
||||
("$get_cont_chunk", 3) => Some(SystemClauseType::GetContinuationChunk),
|
||||
("$get_current_block", 1) => Some(SystemClauseType::GetCurrentBlock),
|
||||
("$get_cp", 1) => Some(SystemClauseType::GetCutPoint),
|
||||
("$install_new_block", 1) => Some(SystemClauseType::InstallNewBlock),
|
||||
("$read_query_term", 2) => Some(SystemClauseType::ReadQueryTerm),
|
||||
("$read_term", 2) => Some(SystemClauseType::ReadTerm),
|
||||
("$quoted_token", 1) => Some(SystemClauseType::QuotedToken),
|
||||
("$nextEP", 3) => Some(SystemClauseType::NextEP),
|
||||
("$read_query_term", 5) => Some(SystemClauseType::ReadQueryTerm),
|
||||
("$read_term", 5) => Some(SystemClauseType::ReadTerm),
|
||||
("$read_term_from_chars", 2) => Some(SystemClauseType::ReadTermFromChars),
|
||||
("$reset_block", 1) => Some(SystemClauseType::ResetBlock),
|
||||
("$reset_cont_marker", 0) => Some(SystemClauseType::ResetContinuationMarker),
|
||||
("$reset_global_var_at_key", 1) => Some(SystemClauseType::ResetGlobalVarAtKey),
|
||||
("$reset_global_var_at_offset", 3) => Some(SystemClauseType::ResetGlobalVarAtOffset),
|
||||
("$retract_clause", 4) => Some(SystemClauseType::RetractClause),
|
||||
("$return_from_attribute_goals", 0) => Some(SystemClauseType::ReturnFromAttributeGoals),
|
||||
("$return_from_verify_attr", 0) => Some(SystemClauseType::ReturnFromVerifyAttr),
|
||||
("$set_ball", 1) => Some(SystemClauseType::SetBall),
|
||||
("$set_cp_by_default", 1) => Some(SystemClauseType::SetCutPointByDefault(temp_v!(1))),
|
||||
("$set_double_quotes", 1) => Some(SystemClauseType::SetDoubleQuotes),
|
||||
("$set_seed", 1) => Some(SystemClauseType::SetSeed),
|
||||
("$skip_max_list", 4) => Some(SystemClauseType::SkipMaxList),
|
||||
("$sleep", 1) => Some(SystemClauseType::Sleep),
|
||||
("$socket_client_open", 7) => Some(SystemClauseType::SocketClientOpen),
|
||||
("$socket_server_open", 3) => Some(SystemClauseType::SocketServerOpen),
|
||||
("$socket_server_accept", 7) => Some(SystemClauseType::SocketServerAccept),
|
||||
("$socket_server_close", 1) => Some(SystemClauseType::SocketServerClose),
|
||||
("$store_global_var", 2) => Some(SystemClauseType::StoreGlobalVar),
|
||||
("$store_global_var_with_offset", 2) => Some(SystemClauseType::StoreGlobalVarWithOffset),
|
||||
("$submit_query_and_print_results", 2) => Some(SystemClauseType::REPL(
|
||||
REPLCodePtr::SubmitQueryAndPrintResults,
|
||||
)),
|
||||
("$term_attributed_variables", 2) => Some(SystemClauseType::TermAttributedVariables),
|
||||
("$term_variables", 2) => Some(SystemClauseType::TermVariables),
|
||||
("$truncate_lh_to", 1) => Some(SystemClauseType::TruncateLiftedHeapTo),
|
||||
("$unwind_environments", 0) => Some(SystemClauseType::UnwindEnvironments),
|
||||
("$unwind_stack", 0) => Some(SystemClauseType::UnwindStack),
|
||||
("$unify_with_occurs_check", 2) => Some(SystemClauseType::UnifyWithOccursCheck),
|
||||
("$use_module", 1) => Some(SystemClauseType::REPL(REPLCodePtr::UseModule)),
|
||||
("$use_module_from_file", 1) =>
|
||||
Some(SystemClauseType::REPL(REPLCodePtr::UseModuleFromFile)),
|
||||
("$use_qualified_module", 2) =>
|
||||
Some(SystemClauseType::REPL(REPLCodePtr::UseQualifiedModule)),
|
||||
("$use_qualified_module_from_file", 2) =>
|
||||
Some(SystemClauseType::REPL(REPLCodePtr::UseQualifiedModuleFromFile)),
|
||||
("$use_module", 1) => Some(SystemClauseType::REPL(REPLCodePtr::UseModule)),
|
||||
("$use_module_from_file", 1) =>
|
||||
Some(SystemClauseType::REPL(REPLCodePtr::UseModuleFromFile)),
|
||||
("$use_qualified_module", 2) =>
|
||||
Some(SystemClauseType::REPL(REPLCodePtr::UseQualifiedModule)),
|
||||
("$use_qualified_module_from_file", 2) =>
|
||||
Some(SystemClauseType::REPL(REPLCodePtr::UseQualifiedModuleFromFile)),
|
||||
("$variant", 2) => Some(SystemClauseType::Variant),
|
||||
("$write_term", 5) => Some(SystemClauseType::WriteTerm),
|
||||
("$wam_instructions", 3) => Some(SystemClauseType::WAMInstructions),
|
||||
("$write_term", 7) => Some(SystemClauseType::WriteTerm),
|
||||
("$write_term_to_chars", 7) => Some(SystemClauseType::WriteTermToChars),
|
||||
("$scryer_prolog_version", 1) => Some(SystemClauseType::ScryerPrologVersion),
|
||||
("$crypto_random_byte", 1) => Some(SystemClauseType::CryptoRandomByte),
|
||||
("$crypto_data_hash", 3) => Some(SystemClauseType::CryptoDataHash),
|
||||
("$crypto_data_hkdf", 6) => Some(SystemClauseType::CryptoDataHKDF),
|
||||
("$crypto_password_hash", 4) => Some(SystemClauseType::CryptoPasswordHash),
|
||||
("$crypto_data_encrypt", 5) => Some(SystemClauseType::CryptoDataEncrypt),
|
||||
("$crypto_data_decrypt", 5) => Some(SystemClauseType::CryptoDataDecrypt),
|
||||
("$ed25519_sign", 3) => Some(SystemClauseType::Ed25519Sign),
|
||||
("$ed25519_verify", 3) => Some(SystemClauseType::Ed25519Verify),
|
||||
("$ed25519_new_keypair", 1) => Some(SystemClauseType::Ed25519NewKeyPair),
|
||||
("$ed25519_keypair_public_key", 2) => Some(SystemClauseType::Ed25519KeyPairPublicKey),
|
||||
_ => None,
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Clone, Eq, PartialEq)]
|
||||
#[derive(Debug, Clone, Eq, PartialEq)]
|
||||
pub enum BuiltInClauseType {
|
||||
AcyclicTerm,
|
||||
Arg,
|
||||
Compare,
|
||||
CompareTerm(CompareTermQT),
|
||||
CyclicTerm,
|
||||
CopyTerm,
|
||||
Eq,
|
||||
Functor,
|
||||
@@ -490,12 +686,11 @@ pub enum BuiltInClauseType {
|
||||
KeySort,
|
||||
Nl,
|
||||
NotEq,
|
||||
PartialString,
|
||||
Read,
|
||||
Sort,
|
||||
}
|
||||
|
||||
#[derive(Clone, PartialEq, Eq)]
|
||||
#[derive(Debug, Clone, PartialEq, Eq)]
|
||||
pub enum ClauseType {
|
||||
BuiltIn(BuiltInClauseType),
|
||||
CallN,
|
||||
@@ -513,7 +708,6 @@ impl BuiltInClauseType {
|
||||
&BuiltInClauseType::Arg => clause_name!("arg"),
|
||||
&BuiltInClauseType::Compare => clause_name!("compare"),
|
||||
&BuiltInClauseType::CompareTerm(qt) => clause_name!(qt.name()),
|
||||
&BuiltInClauseType::CyclicTerm => clause_name!("cyclic_term"),
|
||||
&BuiltInClauseType::CopyTerm => clause_name!("copy_term"),
|
||||
&BuiltInClauseType::Eq => clause_name!("=="),
|
||||
&BuiltInClauseType::Functor => clause_name!("functor"),
|
||||
@@ -522,7 +716,6 @@ impl BuiltInClauseType {
|
||||
&BuiltInClauseType::KeySort => clause_name!("keysort"),
|
||||
&BuiltInClauseType::Nl => clause_name!("nl"),
|
||||
&BuiltInClauseType::NotEq => clause_name!("\\=="),
|
||||
&BuiltInClauseType::PartialString => clause_name!("partial_string"),
|
||||
&BuiltInClauseType::Read => clause_name!("read"),
|
||||
&BuiltInClauseType::Sort => clause_name!("sort"),
|
||||
}
|
||||
@@ -534,7 +727,6 @@ impl BuiltInClauseType {
|
||||
&BuiltInClauseType::Arg => 3,
|
||||
&BuiltInClauseType::Compare => 2,
|
||||
&BuiltInClauseType::CompareTerm(_) => 2,
|
||||
&BuiltInClauseType::CyclicTerm => 1,
|
||||
&BuiltInClauseType::CopyTerm => 2,
|
||||
&BuiltInClauseType::Eq => 2,
|
||||
&BuiltInClauseType::Functor => 3,
|
||||
@@ -543,7 +735,6 @@ impl BuiltInClauseType {
|
||||
&BuiltInClauseType::KeySort => 2,
|
||||
&BuiltInClauseType::NotEq => 2,
|
||||
&BuiltInClauseType::Nl => 0,
|
||||
&BuiltInClauseType::PartialString => 1,
|
||||
&BuiltInClauseType::Read => 1,
|
||||
&BuiltInClauseType::Sort => 2,
|
||||
}
|
||||
@@ -565,8 +756,8 @@ impl ClauseType {
|
||||
|
||||
pub fn name(&self) -> ClauseName {
|
||||
match self {
|
||||
&ClauseType::CallN => clause_name!("call"),
|
||||
&ClauseType::BuiltIn(ref built_in) => built_in.name(),
|
||||
&ClauseType::CallN => clause_name!("call"),
|
||||
&ClauseType::Hook(ref hook) => hook.name(),
|
||||
&ClauseType::Inlined(ref inlined) => clause_name!(inlined.name()),
|
||||
&ClauseType::Op(ref name, ..) => name.clone(),
|
||||
|
||||
@@ -11,19 +11,20 @@ use crate::prolog::iterators::*;
|
||||
use crate::prolog::machine::machine_indices::*;
|
||||
use crate::prolog::targets::*;
|
||||
|
||||
use indexmap::IndexMap;
|
||||
use indexmap::{IndexMap, IndexSet};
|
||||
|
||||
use std::cell::Cell;
|
||||
use std::rc::Rc;
|
||||
use std::vec::Vec;
|
||||
|
||||
#[derive(Debug)]
|
||||
pub struct CodeGenerator<TermMarker> {
|
||||
flags: MachineFlags,
|
||||
marker: TermMarker,
|
||||
pub var_count: IndexMap<Rc<Var>, usize>,
|
||||
non_counted_bt: bool,
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub struct ConjunctInfo<'a> {
|
||||
pub perm_vs: VariableFixtures<'a>,
|
||||
pub num_of_chunks: usize,
|
||||
@@ -51,68 +52,56 @@ impl<'a> ConjunctInfo<'a> {
|
||||
self.has_deep_cut as usize
|
||||
}
|
||||
|
||||
fn mark_unsafe_vars<Alloc: Allocator<'a>>(
|
||||
fn mark_unsafe_vars(
|
||||
&self,
|
||||
mut unsafe_var_marker: UnsafeVarMarker,
|
||||
marker: &Alloc,
|
||||
code: &mut Code
|
||||
code: &mut Code,
|
||||
) {
|
||||
// target the last goal of the rule for handling unsafe variables.
|
||||
// we use this weird logic to find the last goal.
|
||||
let right_index = if let Some(Line::Control(_)) = code.last() {
|
||||
if code.len() >= 2 {
|
||||
code.len() - 2
|
||||
} else {
|
||||
return;
|
||||
}
|
||||
} else {
|
||||
if code.len() >= 1 {
|
||||
code.len() - 1
|
||||
} else {
|
||||
return;
|
||||
}
|
||||
};
|
||||
if code.is_empty() {
|
||||
return;
|
||||
}
|
||||
|
||||
let mut index = right_index;
|
||||
let mut code_index = 0;
|
||||
|
||||
if let Line::Query(_) = &code[right_index] {
|
||||
while let Line::Query(_) = &code[index] {
|
||||
if index == 0 {
|
||||
break;
|
||||
} else {
|
||||
index -= 1;
|
||||
for phase in 0 .. {
|
||||
while let Line::Query(ref query_instr) = &code[code_index] {
|
||||
if !unsafe_var_marker.mark_safe_vars(query_instr) {
|
||||
unsafe_var_marker.mark_phase(query_instr, phase);
|
||||
}
|
||||
|
||||
code_index += 1;
|
||||
}
|
||||
|
||||
if let Line::Query(_) = &code[index] {
|
||||
if code_index + 1 < code.len() {
|
||||
code_index += 1;
|
||||
} else {
|
||||
index += 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
code_index = 0;
|
||||
|
||||
for phase in 0 .. {
|
||||
while let Line::Query(ref mut query_instr) = &mut code[code_index] {
|
||||
unsafe_var_marker.mark_unsafe_vars(query_instr, phase);
|
||||
code_index += 1;
|
||||
}
|
||||
|
||||
unsafe_var_marker.record_unsafe_vars(&self.perm_vs, marker);
|
||||
|
||||
for line in code.iter() {
|
||||
if let Line::Query(ref query_instr) = line {
|
||||
unsafe_var_marker.mark_safe_vars(query_instr);
|
||||
}
|
||||
}
|
||||
|
||||
for index in index..right_index + 1 {
|
||||
if let &mut Line::Query(ref mut query_instr) = &mut code[index] {
|
||||
unsafe_var_marker.mark_unsafe_vars(query_instr);
|
||||
}
|
||||
if code_index + 1 < code.len() {
|
||||
code_index += 1;
|
||||
} else {
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
pub fn new(non_counted_bt: bool, flags: MachineFlags) -> Self {
|
||||
pub fn new(non_counted_bt: bool) -> Self {
|
||||
CodeGenerator {
|
||||
marker: Allocator::new(),
|
||||
var_count: IndexMap::new(),
|
||||
non_counted_bt,
|
||||
flags,
|
||||
}
|
||||
}
|
||||
|
||||
@@ -133,31 +122,45 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
*self.var_count.get(var).unwrap()
|
||||
}
|
||||
|
||||
fn mark_var_in_non_callable(
|
||||
&mut self,
|
||||
name: Rc<Var>,
|
||||
term_loc: GenContext,
|
||||
vr: &'a Cell<VarReg>,
|
||||
code: &mut Code,
|
||||
) -> RegType {
|
||||
let mut target = Vec::new();
|
||||
self.marker.mark_var(name, Level::Shallow, vr, term_loc, &mut target);
|
||||
|
||||
if !target.is_empty() {
|
||||
code.extend(target.into_iter().map(Line::Query));
|
||||
}
|
||||
|
||||
vr.get().norm()
|
||||
}
|
||||
|
||||
fn mark_non_callable(
|
||||
&mut self,
|
||||
name: Rc<Var>,
|
||||
arity: usize,
|
||||
arg: usize,
|
||||
term_loc: GenContext,
|
||||
vr: &'a Cell<VarReg>,
|
||||
code: &mut Code,
|
||||
) -> RegType {
|
||||
match self.marker.bindings().get(&name) {
|
||||
Some(&VarData::Temp(_, t, _)) if t != 0 => RegType::Temp(t),
|
||||
Some(&VarData::Perm(p)) if p != 0 => RegType::Perm(p),
|
||||
_ => {
|
||||
let mut target = Vec::new();
|
||||
|
||||
self.marker.reset_arg(arity);
|
||||
self.marker
|
||||
.mark_var(name, Level::Shallow, vr, term_loc, &mut target);
|
||||
|
||||
if !target.is_empty() {
|
||||
for query_instr in target {
|
||||
code.push(Line::Query(query_instr));
|
||||
}
|
||||
Some(&VarData::Temp(_, t, _)) if t != 0 => {
|
||||
RegType::Temp(t)
|
||||
}
|
||||
Some(&VarData::Perm(p)) if p != 0 => {
|
||||
if let GenContext::Last(_) = term_loc {
|
||||
self.mark_var_in_non_callable(name.clone(), term_loc, vr, code);
|
||||
temp_v!(arg)
|
||||
} else {
|
||||
RegType::Perm(p)
|
||||
}
|
||||
|
||||
vr.get().norm()
|
||||
}
|
||||
_ => {
|
||||
self.mark_var_in_non_callable(name, term_loc, vr, code)
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -176,40 +179,49 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
target.push(Target::to_void(1));
|
||||
}
|
||||
|
||||
fn subterm_to_instr<Target>(
|
||||
fn deep_var_instr<Target: CompilationTarget<'a>>(
|
||||
&mut self,
|
||||
cell: &'a Cell<VarReg>,
|
||||
var: &'a Rc<Var>,
|
||||
term_loc: GenContext,
|
||||
is_exposed: bool,
|
||||
target: &mut Vec<Target>,
|
||||
) {
|
||||
if is_exposed || self.get_var_count(var.as_ref()) > 1 {
|
||||
self.marker.mark_var(var.clone(), Level::Deep, cell, term_loc, target);
|
||||
} else {
|
||||
Self::add_or_increment_void_instr(target);
|
||||
}
|
||||
}
|
||||
|
||||
fn subterm_to_instr<Target: CompilationTarget<'a>>(
|
||||
&mut self,
|
||||
subterm: &'a Term,
|
||||
term_loc: GenContext,
|
||||
is_exposed: bool,
|
||||
target: &mut Vec<Target>,
|
||||
) where
|
||||
Target: CompilationTarget<'a>,
|
||||
{
|
||||
) {
|
||||
match subterm {
|
||||
&Term::AnonVar if is_exposed => {
|
||||
self.marker.mark_anon_var(Level::Deep, term_loc, target)
|
||||
self.marker.mark_anon_var(Level::Deep, term_loc, target);
|
||||
}
|
||||
&Term::AnonVar => {
|
||||
Self::add_or_increment_void_instr(target);
|
||||
}
|
||||
&Term::AnonVar => Self::add_or_increment_void_instr(target),
|
||||
&Term::Cons(ref cell, _, _) | &Term::Clause(ref cell, _, _, _) => {
|
||||
self.marker
|
||||
.mark_non_var(Level::Deep, term_loc, cell, target);
|
||||
self.marker.mark_non_var(Level::Deep, term_loc, cell, target);
|
||||
target.push(Target::clause_arg_to_instr(cell.get()));
|
||||
}
|
||||
&Term::Constant(_, ref constant) => {
|
||||
target.push(Target::constant_subterm(constant.clone()))
|
||||
target.push(Target::constant_subterm(constant.clone()));
|
||||
}
|
||||
&Term::Var(ref cell, ref var) => {
|
||||
if is_exposed || self.get_var_count(var) > 1 {
|
||||
self.marker
|
||||
.mark_var(var.clone(), Level::Deep, cell, term_loc, target);
|
||||
} else {
|
||||
Self::add_or_increment_void_instr(target);
|
||||
}
|
||||
self.deep_var_instr(cell, var, term_loc, is_exposed, target);
|
||||
}
|
||||
};
|
||||
}
|
||||
|
||||
fn compile_target<Target, Iter>(
|
||||
fn compile_target<Target, Iter>(
|
||||
&mut self,
|
||||
iter: Iter,
|
||||
term_loc: GenContext,
|
||||
@@ -223,6 +235,13 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
|
||||
for term in iter {
|
||||
match term {
|
||||
TermRef::AnonVar(lvl @ Level::Shallow) => {
|
||||
if let GenContext::Head = term_loc {
|
||||
self.marker.advance_arg();
|
||||
} else {
|
||||
self.marker.mark_anon_var(lvl, term_loc, &mut target);
|
||||
}
|
||||
}
|
||||
TermRef::Clause(lvl, cell, ct, terms) => {
|
||||
self.marker.mark_non_var(lvl, term_loc, cell, &mut target);
|
||||
target.push(Target::to_structure(ct, terms.len(), cell.get()));
|
||||
@@ -238,15 +257,22 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
self.subterm_to_instr(head, term_loc, is_exposed, &mut target);
|
||||
self.subterm_to_instr(tail, term_loc, is_exposed, &mut target);
|
||||
}
|
||||
TermRef::Constant(lvl @ Level::Shallow, cell, Constant::String(ref string)) => {
|
||||
self.marker.mark_non_var(lvl, term_loc, cell, &mut target);
|
||||
target.push(Target::to_pstr(lvl, string.to_string(), cell.get(), false));
|
||||
}
|
||||
TermRef::Constant(lvl @ Level::Shallow, cell, constant) => {
|
||||
self.marker.mark_non_var(lvl, term_loc, cell, &mut target);
|
||||
target.push(Target::to_constant(lvl, constant.clone(), cell.get()));
|
||||
}
|
||||
TermRef::AnonVar(lvl @ Level::Shallow) => {
|
||||
if let GenContext::Head = term_loc {
|
||||
self.marker.advance_arg();
|
||||
TermRef::PartialString(lvl, cell, string, tail) => {
|
||||
self.marker.mark_non_var(lvl, term_loc, cell, &mut target);
|
||||
|
||||
if let Some(tail) = tail {
|
||||
target.push(Target::to_pstr(lvl, string, cell.get(), true));
|
||||
self.subterm_to_instr(tail, term_loc, is_exposed, &mut target);
|
||||
} else {
|
||||
self.marker.mark_anon_var(lvl, term_loc, &mut target);
|
||||
target.push(Target::to_pstr(lvl, string, cell.get(), false));
|
||||
}
|
||||
}
|
||||
TermRef::Var(lvl @ Level::Shallow, cell, ref var) if var.as_str() == "!" => {
|
||||
@@ -265,14 +291,13 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
}
|
||||
}
|
||||
|
||||
self.marker
|
||||
.mark_var(var.clone(), lvl, cell, term_loc, &mut target);
|
||||
self.marker.mark_var(var.clone(), lvl, cell, term_loc, &mut target);
|
||||
}
|
||||
TermRef::Var(lvl @ Level::Shallow, cell, var) => {
|
||||
self.marker
|
||||
.mark_var(var.clone(), lvl, cell, term_loc, &mut target)
|
||||
self.marker.mark_var(var.clone(), lvl, cell, term_loc, &mut target);
|
||||
}
|
||||
_ => {
|
||||
}
|
||||
_ => {}
|
||||
};
|
||||
}
|
||||
|
||||
@@ -281,11 +306,11 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
|
||||
fn collect_var_data(&mut self, mut iter: ChunkedIterator<'a>) -> ConjunctInfo<'a> {
|
||||
let mut vs = VariableFixtures::new();
|
||||
|
||||
|
||||
while let Some((chunk_num, lt_arity, chunked_terms)) = iter.next() {
|
||||
for (i, chunked_term) in chunked_terms.iter().enumerate() {
|
||||
let term_loc = match chunked_term {
|
||||
&ChunkedTerm::HeadClause(..) =>
|
||||
&ChunkedTerm::HeadClause(..) =>
|
||||
GenContext::Head,
|
||||
&ChunkedTerm::BodyTerm(_) => {
|
||||
if i < chunked_terms.len() - 1 {
|
||||
@@ -332,7 +357,9 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
&mut ControlInstruction::CallClause(_, _, _, ref mut last_call, _) => {
|
||||
*last_call = true
|
||||
}
|
||||
&mut ControlInstruction::JmpBy(_, _, _, ref mut last_call) => *last_call = true,
|
||||
&mut ControlInstruction::JmpBy(_, _, _, ref mut last_call) => {
|
||||
*last_call = true
|
||||
}
|
||||
&mut ControlInstruction::Proceed => {}
|
||||
_ => dealloc_index += 1,
|
||||
},
|
||||
@@ -352,33 +379,42 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
) -> Result<(), ParserError> {
|
||||
match ct {
|
||||
&InlinedClauseType::CompareNumber(cmp, ..) => {
|
||||
if let &Term::Var(ref vr, ref name) = terms[0].as_ref() {
|
||||
self.mark_non_callable(name.clone(), 2, term_loc, vr, code);
|
||||
}
|
||||
|
||||
if let &Term::Var(ref vr, ref name) = terms[1].as_ref() {
|
||||
self.mark_non_callable(name.clone(), 2, term_loc, vr, code);
|
||||
}
|
||||
self.marker.reset_arg(2);
|
||||
|
||||
let (mut lcode, at_1) = self.call_arith_eval(terms[0].as_ref(), 1)?;
|
||||
let (mut rcode, at_2) = self.call_arith_eval(terms[1].as_ref(), 2)?;
|
||||
|
||||
let at_1 =
|
||||
if let &Term::Var(ref vr, ref name) = terms[0].as_ref() {
|
||||
ArithmeticTerm::Reg(
|
||||
self.mark_non_callable(name.clone(), 1, term_loc, vr, code)
|
||||
)
|
||||
} else {
|
||||
at_1.unwrap_or(interm!(1))
|
||||
};
|
||||
|
||||
let at_2 =
|
||||
if let &Term::Var(ref vr, ref name) = terms[1].as_ref() {
|
||||
ArithmeticTerm::Reg(
|
||||
self.mark_non_callable(name.clone(), 2, term_loc, vr, code)
|
||||
)
|
||||
} else {
|
||||
at_2.unwrap_or(interm!(2))
|
||||
};
|
||||
|
||||
code.append(&mut lcode);
|
||||
code.append(&mut rcode);
|
||||
|
||||
code.push(compare_number_instr!(
|
||||
cmp,
|
||||
at_1.unwrap_or(interm!(1)),
|
||||
at_2.unwrap_or(interm!(2))
|
||||
));
|
||||
code.push(compare_number_instr!(cmp, at_1, at_2));
|
||||
}
|
||||
&InlinedClauseType::IsAtom(..) => match terms[0].as_ref() {
|
||||
&Term::Constant(_, Constant::Char(_))
|
||||
| &Term::Constant(_, Constant::EmptyList)
|
||||
| &Term::Constant(_, Constant::Atom(..)) => {
|
||||
&Term::Constant(_, Constant::Char(_)) |
|
||||
&Term::Constant(_, Constant::EmptyList) |
|
||||
&Term::Constant(_, Constant::Atom(..)) => {
|
||||
code.push(succeed!());
|
||||
}
|
||||
&Term::Var(ref vr, ref name) => {
|
||||
self.marker.reset_arg(1);
|
||||
let r = self.mark_non_callable(name.clone(), 1, term_loc, vr, code);
|
||||
code.push(is_atom!(r));
|
||||
}
|
||||
@@ -394,6 +430,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
code.push(succeed!());
|
||||
}
|
||||
&Term::Var(ref vr, ref name) => {
|
||||
self.marker.reset_arg(1);
|
||||
let r = self.mark_non_callable(name.clone(), 1, term_loc, vr, code);
|
||||
code.push(is_atomic!(r));
|
||||
}
|
||||
@@ -403,6 +440,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
code.push(succeed!());
|
||||
}
|
||||
&Term::Var(ref vr, ref name) => {
|
||||
self.marker.reset_arg(1);
|
||||
let r = self.mark_non_callable(name.clone(), 1, term_loc, vr, code);
|
||||
code.push(is_compound!(r));
|
||||
}
|
||||
@@ -415,6 +453,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
code.push(succeed!());
|
||||
}
|
||||
&Term::Var(ref vr, ref name) => {
|
||||
self.marker.reset_arg(1);
|
||||
let r = self.mark_non_callable(name.clone(), 1, term_loc, vr, code);
|
||||
code.push(is_rational!(r));
|
||||
}
|
||||
@@ -427,6 +466,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
code.push(succeed!());
|
||||
}
|
||||
&Term::Var(ref vr, ref name) => {
|
||||
self.marker.reset_arg(1);
|
||||
let r = self.mark_non_callable(name.clone(), 1, term_loc, vr, code);
|
||||
code.push(is_float!(r));
|
||||
}
|
||||
@@ -434,23 +474,12 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
code.push(fail!());
|
||||
}
|
||||
},
|
||||
&InlinedClauseType::IsString(..) => match terms[0].as_ref() {
|
||||
&Term::Constant(_, Constant::String(_)) => {
|
||||
code.push(succeed!());
|
||||
}
|
||||
&Term::Var(ref vr, ref name) => {
|
||||
let r = self.mark_non_callable(name.clone(), 1, term_loc, vr, code);
|
||||
code.push(is_string!(r));
|
||||
}
|
||||
_ => {
|
||||
code.push(fail!());
|
||||
}
|
||||
},
|
||||
&InlinedClauseType::IsNonVar(..) => match terms[0].as_ref() {
|
||||
&Term::AnonVar => {
|
||||
code.push(fail!());
|
||||
}
|
||||
&Term::Var(ref vr, ref name) => {
|
||||
self.marker.reset_arg(1);
|
||||
let r = self.mark_non_callable(name.clone(), 1, term_loc, vr, code);
|
||||
code.push(is_nonvar!(r));
|
||||
}
|
||||
@@ -459,11 +488,12 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
}
|
||||
},
|
||||
&InlinedClauseType::IsInteger(..) => match terms[0].as_ref() {
|
||||
&Term::Constant(_, Constant::CharCode(_))
|
||||
| &Term::Constant(_, Constant::Integer(_)) => {
|
||||
&Term::Constant(_, Constant::Integer(_)) |
|
||||
&Term::Constant(_, Constant::Fixnum(_)) => {
|
||||
code.push(succeed!());
|
||||
}
|
||||
&Term::Var(ref vr, ref name) => {
|
||||
self.marker.reset_arg(1);
|
||||
let r = self.mark_non_callable(name.clone(), 1, term_loc, vr, code);
|
||||
code.push(is_integer!(r));
|
||||
}
|
||||
@@ -479,17 +509,11 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
code.push(succeed!());
|
||||
}
|
||||
&Term::Var(ref vr, ref name) => {
|
||||
self.marker.reset_arg(1);
|
||||
let r = self.mark_non_callable(name.clone(), 1, term_loc, vr, code);
|
||||
code.push(is_var!(r));
|
||||
}
|
||||
},
|
||||
&InlinedClauseType::IsPartialString(..) => match terms[0].as_ref() {
|
||||
&Term::Var(ref vr, ref name) => {
|
||||
let r = self.mark_non_callable(name.clone(), 1, term_loc, vr, code);
|
||||
code.push(is_partial_string!(r));
|
||||
}
|
||||
_ => code.push(fail!()),
|
||||
},
|
||||
}
|
||||
|
||||
Ok(())
|
||||
@@ -500,7 +524,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
term: &'a Term,
|
||||
target_int: usize,
|
||||
) -> Result<ArithCont, ArithmeticError> {
|
||||
let mut evaluator = ArithmeticEvaluator::new(self.marker.bindings(), target_int);
|
||||
let mut evaluator = ArithmeticEvaluator::new(&self.marker.bindings(), target_int);
|
||||
evaluator.eval(term)
|
||||
}
|
||||
|
||||
@@ -514,36 +538,27 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
let (mut acode, at) = self.call_arith_eval(terms[1].as_ref(), 1)?;
|
||||
code.append(&mut acode);
|
||||
|
||||
Ok(match terms[0].as_ref() {
|
||||
self.marker.reset_arg(2);
|
||||
|
||||
match terms[0].as_ref() {
|
||||
&Term::Var(ref vr, ref name) => {
|
||||
let mut target = vec![];
|
||||
|
||||
self.marker.reset_arg(2);
|
||||
self.marker
|
||||
.mark_var(name.clone(), Level::Shallow, vr, term_loc, &mut target);
|
||||
self.marker.mark_var(name.clone(), Level::Shallow, vr, term_loc, &mut target);
|
||||
|
||||
if !target.is_empty() {
|
||||
code.extend(target.into_iter().map(Line::Query));
|
||||
}
|
||||
|
||||
if use_default_call_policy {
|
||||
code.push(is_call_by_default!(temp_v!(1), at.unwrap_or(interm!(1))))
|
||||
} else {
|
||||
code.push(is_call!(temp_v!(1), at.unwrap_or(interm!(1))))
|
||||
}
|
||||
}
|
||||
&Term::Constant(_, ref c @ Constant::Integer(_)) => {
|
||||
&Term::Constant(_, ref c @ Constant::Integer(_)) |
|
||||
&Term::Constant(_, ref c @ Constant::Fixnum(_)) => {
|
||||
code.push(Line::Query(put_constant!(
|
||||
Level::Shallow,
|
||||
c.clone(),
|
||||
temp_v!(1)
|
||||
)));
|
||||
|
||||
if use_default_call_policy {
|
||||
code.push(is_call_by_default!(temp_v!(1), at.unwrap_or(interm!(1))))
|
||||
} else {
|
||||
code.push(is_call!(temp_v!(1), at.unwrap_or(interm!(1))))
|
||||
}
|
||||
self.marker.advance_arg();
|
||||
}
|
||||
&Term::Constant(_, ref c @ Constant::Float(_)) => {
|
||||
code.push(Line::Query(put_constant!(
|
||||
@@ -552,11 +567,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
temp_v!(1)
|
||||
)));
|
||||
|
||||
if use_default_call_policy {
|
||||
code.push(is_call_by_default!(temp_v!(1), at.unwrap_or(interm!(1))))
|
||||
} else {
|
||||
code.push(is_call!(temp_v!(1), at.unwrap_or(interm!(1))))
|
||||
}
|
||||
self.marker.advance_arg();
|
||||
}
|
||||
&Term::Constant(_, ref c @ Constant::Rational(_)) => {
|
||||
code.push(Line::Query(put_constant!(
|
||||
@@ -565,13 +576,27 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
temp_v!(1)
|
||||
)));
|
||||
|
||||
if use_default_call_policy {
|
||||
code.push(is_call_by_default!(temp_v!(1), at.unwrap_or(interm!(1))))
|
||||
} else {
|
||||
code.push(is_call!(temp_v!(1), at.unwrap_or(interm!(1))))
|
||||
}
|
||||
self.marker.advance_arg();
|
||||
}
|
||||
_ => code.push(fail!()),
|
||||
_ => {
|
||||
code.push(fail!());
|
||||
return Ok(());
|
||||
}
|
||||
}
|
||||
|
||||
let at =
|
||||
if let &Term::Var(ref vr, ref name) = terms[1].as_ref() {
|
||||
ArithmeticTerm::Reg(
|
||||
self.mark_non_callable(name.clone(), 2, term_loc, vr, code)
|
||||
)
|
||||
} else {
|
||||
at.unwrap_or(interm!(1))
|
||||
};
|
||||
|
||||
Ok(if use_default_call_policy {
|
||||
code.push(is_call_by_default!(temp_v!(1), at));
|
||||
} else {
|
||||
code.push(is_call!(temp_v!(1), at));
|
||||
})
|
||||
}
|
||||
|
||||
@@ -694,6 +719,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
head: (_, ref args, ref p1),
|
||||
ref clauses,
|
||||
} = rule;
|
||||
|
||||
let mut code = Vec::new();
|
||||
|
||||
self.marker.reset_at_head(args);
|
||||
@@ -715,39 +741,31 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
let iter = ChunkedIterator::from_rule_body(p1, clauses);
|
||||
self.compile_seq(iter, &conjunct_info, &mut code, false)?;
|
||||
|
||||
conjunct_info.mark_unsafe_vars(unsafe_var_marker, &self.marker, &mut code);
|
||||
conjunct_info.mark_unsafe_vars(unsafe_var_marker, &mut code);
|
||||
|
||||
Self::compile_cleanup(&mut code, &conjunct_info, clauses.last().unwrap_or(p1));
|
||||
Ok(code)
|
||||
}
|
||||
|
||||
fn mark_unsafe_fact_vars(&self, fact: &mut CompiledFact) -> UnsafeVarMarker {
|
||||
let mut unsafe_vars = IndexMap::new();
|
||||
|
||||
for var_status in self.marker.bindings().values() {
|
||||
unsafe_vars.insert(var_status.as_reg_type(), false);
|
||||
}
|
||||
let mut safe_vars = IndexSet::new();
|
||||
|
||||
for fact_instr in fact.iter_mut() {
|
||||
match fact_instr {
|
||||
&mut FactInstruction::UnifyValue(reg) => {
|
||||
if let Some(found) = unsafe_vars.get_mut(®) {
|
||||
if !*found {
|
||||
*found = true;
|
||||
*fact_instr = FactInstruction::UnifyLocalValue(reg);
|
||||
}
|
||||
&mut FactInstruction::UnifyValue(r) => {
|
||||
if !safe_vars.contains(&r) {
|
||||
*fact_instr = FactInstruction::UnifyLocalValue(r);
|
||||
safe_vars.insert(r);
|
||||
}
|
||||
}
|
||||
&mut FactInstruction::UnifyVariable(reg) => {
|
||||
if let Some(found) = unsafe_vars.get_mut(®) {
|
||||
*found = true;
|
||||
}
|
||||
&mut FactInstruction::UnifyVariable(r) => {
|
||||
safe_vars.insert(r);
|
||||
}
|
||||
_ => {}
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
UnsafeVarMarker { unsafe_vars }
|
||||
UnsafeVarMarker::from_safe_vars(safe_vars)
|
||||
}
|
||||
|
||||
pub fn compile_fact<'b: 'a>(&mut self, term: &'b Term) -> Code {
|
||||
@@ -812,7 +830,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
let iter = ChunkedIterator::from_term_sequence(query);
|
||||
self.compile_seq(iter, &conjunct_info, &mut code, true)?;
|
||||
|
||||
conjunct_info.mark_unsafe_vars(UnsafeVarMarker::new(), &self.marker, &mut code);
|
||||
conjunct_info.mark_unsafe_vars(UnsafeVarMarker::new(), &mut code);
|
||||
|
||||
if let Some(query_term) = query.last() {
|
||||
Self::compile_cleanup(&mut code, &conjunct_info, query_term);
|
||||
@@ -867,7 +885,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
|
||||
clauses: &'b [PredicateClause],
|
||||
) -> Result<Code, ParserError> {
|
||||
let mut code_body = Vec::new();
|
||||
let mut code_offsets = CodeOffsets::new(self.flags);
|
||||
let mut code_offsets = CodeOffsets::new();
|
||||
|
||||
let num_clauses = clauses.len();
|
||||
|
||||
|
||||
@@ -12,6 +12,7 @@ use std::cell::Cell;
|
||||
use std::collections::BTreeSet;
|
||||
use std::rc::Rc;
|
||||
|
||||
#[derive(Debug)]
|
||||
pub struct DebrayAllocator {
|
||||
bindings: IndexMap<Rc<Var>, VarData>,
|
||||
arg_c: usize,
|
||||
@@ -292,7 +293,9 @@ impl<'a> Allocator<'a> for DebrayAllocator {
|
||||
|
||||
(pr, true)
|
||||
}
|
||||
r => (r, false),
|
||||
r => {
|
||||
(r, false)
|
||||
}
|
||||
};
|
||||
|
||||
self.mark_reserved_var(var, lvl, cell, term_loc, target, r, is_new_var);
|
||||
|
||||
1202
src/prolog/examples/bimetatrans_ruleml/bimetatrans_ruleml.pl
Normal file
1202
src/prolog/examples/bimetatrans_ruleml/bimetatrans_ruleml.pl
Normal file
File diff suppressed because it is too large
Load Diff
4174
src/prolog/examples/bimetatrans_ruleml/bimetatrans_ruleml_tests.pl
Normal file
4174
src/prolog/examples/bimetatrans_ruleml/bimetatrans_ruleml_tests.pl
Normal file
File diff suppressed because it is too large
Load Diff
@@ -22,7 +22,6 @@ verify_attributes(Var, Other, Goals) :-
|
||||
( Els = [] -> % exactly one element
|
||||
Goals = [Other=El] % implied binding
|
||||
; Goals = [],
|
||||
put_atts(Other, -dom(_)),
|
||||
put_atts(Other, dom(Dc))% rescue intersection
|
||||
)
|
||||
; Goals = [],
|
||||
|
||||
31
src/prolog/examples/echo_server.pl
Normal file
31
src/prolog/examples/echo_server.pl
Normal file
@@ -0,0 +1,31 @@
|
||||
:- module(echo_server, [echo_server/0,
|
||||
echo_server/1]).
|
||||
|
||||
:- use_module(library(format)).
|
||||
:- use_module(library(sockets)).
|
||||
|
||||
|
||||
echo_server :-
|
||||
echo_server('127.0.0.1').
|
||||
|
||||
|
||||
echo_server(Addr) :-
|
||||
socket_server_open(Addr:Port, ServerSocket),
|
||||
format("echo_server: connection opened at ~w:~d~n", [Addr, Port]),
|
||||
socket_server_accept(ServerSocket, Client, Stream, [eof_action(eof_code)]),
|
||||
format("echo_server: connection accepted from ~a~n", [Client]),
|
||||
!,
|
||||
echo_loop(Stream),
|
||||
socket_server_close(ServerSocket).
|
||||
|
||||
|
||||
echo_loop(Stream) :-
|
||||
read_term(Stream, Term, []),
|
||||
( Term == end_of_file ->
|
||||
true
|
||||
;
|
||||
format("received: ~w~n", [Term]),
|
||||
!,
|
||||
echo_loop(Stream)
|
||||
).
|
||||
|
||||
64
src/prolog/examples/least_time.pl
Normal file
64
src/prolog/examples/least_time.pl
Normal file
@@ -0,0 +1,64 @@
|
||||
/* least_time.pl
|
||||
*
|
||||
* By Mark Thom, 2020
|
||||
*
|
||||
* find_min_time/2 solves a problem sometimes posed in the first round
|
||||
* of Google interviews: given a time of day in 24 H format, what is the
|
||||
* lexicographically least permutation of the time that is itself a
|
||||
* valid time in 24 H format?
|
||||
*
|
||||
* Full generality is achieved using the reif library.
|
||||
*/
|
||||
|
||||
:- module(least_time, [find_min_time/2,
|
||||
write_time_nl/1]).
|
||||
|
||||
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(format)).
|
||||
:- use_module(library(reif)).
|
||||
|
||||
|
||||
permutation([], []).
|
||||
permutation([X|Xs], Ys) :-
|
||||
permutation(Xs, Yss),
|
||||
select(X, Ys, Yss).
|
||||
|
||||
|
||||
valid_time([H1,H2,M1,M2], T) :-
|
||||
memberd_t(H1, [0,1,2], TH1),
|
||||
memberd_t(H2, [0,1,2,3,4,5,6,7,8,9], TH2),
|
||||
memberd_t(M1, [0,1,2,3,4,5], TM1),
|
||||
memberd_t(M2, [0,1,2,3,4,5,6,7,8,9], TM2),
|
||||
( maplist(=(true), [TH1, TH2, TM1, TM2]) ->
|
||||
( H1 =:= 2 ->
|
||||
( H2 =< 3 ->
|
||||
T = true
|
||||
; T = false
|
||||
)
|
||||
; T = true
|
||||
)
|
||||
; T = false
|
||||
).
|
||||
|
||||
|
||||
permuted_times(Time, PermutedTimes) :-
|
||||
setof(P, permutation(Time, P), PermutedTimes0),
|
||||
tfilter(valid_time, PermutedTimes0, PermutedTimes).
|
||||
|
||||
|
||||
find_min_time(Time, Min) :-
|
||||
valid_time(Time, true),
|
||||
permuted_times(Time, PermutedTimes),
|
||||
find_min_time_(PermutedTimes, Time, Min).
|
||||
|
||||
find_min_time_([], Min, Min).
|
||||
find_min_time_([Time|Times], MinSoFar, Min) :-
|
||||
( Time @< MinSoFar ->
|
||||
find_min_time_(Times, Time, Min)
|
||||
; find_min_time_(Times, MinSoFar, Min)
|
||||
).
|
||||
|
||||
|
||||
write_time_nl(Time) :-
|
||||
format("\"~w~w:~w~w\"~n", Time).
|
||||
@@ -31,6 +31,7 @@
|
||||
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(dif)).
|
||||
:- use_module(library(format)).
|
||||
:- use_module(library(lists)).
|
||||
|
||||
pl_resolution(Clauses0, Chain) :-
|
||||
|
||||
15
src/prolog/examples/utf8.pl
Normal file
15
src/prolog/examples/utf8.pl
Normal file
@@ -0,0 +1,15 @@
|
||||
:- use_module(library(charsio)).
|
||||
:- use_module(library(lists)).
|
||||
|
||||
:- initialization(unit_test).
|
||||
|
||||
unit_test :-
|
||||
chars_utf8bytes("a£\x2124\", Bs),
|
||||
Bs = [97, 194, 163, 226, 132, 164].
|
||||
|
||||
write_f :-
|
||||
open('x.txt', write, Stream, [type(binary)]),
|
||||
F = put_byte(Stream),
|
||||
chars_utf8bytes("£\x2124\\x2764\\x1F496\\n", Bs),
|
||||
maplist(F, Bs),
|
||||
close(Stream).
|
||||
@@ -1,6 +1,5 @@
|
||||
use prolog_parser::ast::*;
|
||||
|
||||
use crate::prolog::allocator::*;
|
||||
use crate::prolog::forms::*;
|
||||
use crate::prolog::instructions::*;
|
||||
use crate::prolog::iterators::*;
|
||||
@@ -14,6 +13,7 @@ use std::rc::Rc;
|
||||
use std::vec::Vec;
|
||||
|
||||
// labeled with chunk numbers.
|
||||
#[derive(Debug)]
|
||||
pub enum VarStatus {
|
||||
Perm(usize),
|
||||
Temp(usize, TempVarData), // Perm(chunk_num) | Temp(chunk_num, _)
|
||||
@@ -23,6 +23,7 @@ pub type OccurrenceSet = BTreeSet<(GenContext, usize)>;
|
||||
|
||||
// Perm: 0 initially, a stack register once processed.
|
||||
// Temp: labeled with chunk_num and temp offset (unassigned if 0).
|
||||
#[derive(Debug)]
|
||||
pub enum VarData {
|
||||
Perm(usize),
|
||||
Temp(usize, usize, TempVarData),
|
||||
@@ -37,6 +38,7 @@ impl VarData {
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub struct TempVarData {
|
||||
pub last_term_arity: usize,
|
||||
pub use_set: OccurrenceSet,
|
||||
@@ -80,6 +82,7 @@ impl TempVarData {
|
||||
|
||||
type VariableFixture<'a> = (VarStatus, Vec<&'a Cell<VarReg>>);
|
||||
|
||||
#[derive(Debug)]
|
||||
pub struct VariableFixtures<'a>{
|
||||
perm_vars: IndexMap<Rc<Var>, VariableFixture<'a>>,
|
||||
last_chunk_temp_vars: IndexSet<Rc<Var>>
|
||||
@@ -91,7 +94,7 @@ impl<'a> VariableFixtures<'a> {
|
||||
perm_vars: IndexMap::new(),
|
||||
last_chunk_temp_vars: IndexSet::new()
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
|
||||
pub fn insert(&mut self, var: Rc<Var>, vs: VariableFixture<'a>) {
|
||||
@@ -249,68 +252,69 @@ impl<'a> VariableFixtures<'a> {
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub struct UnsafeVarMarker {
|
||||
pub unsafe_vars: IndexMap<RegType, bool>,
|
||||
pub unsafe_vars: IndexMap<RegType, usize>,
|
||||
pub safe_vars: IndexSet<RegType>,
|
||||
}
|
||||
|
||||
impl UnsafeVarMarker {
|
||||
pub fn new() -> Self {
|
||||
UnsafeVarMarker {
|
||||
unsafe_vars: IndexMap::new(),
|
||||
safe_vars: IndexSet::new()
|
||||
}
|
||||
}
|
||||
|
||||
pub fn record_unsafe_vars<'a, Alloc: Allocator<'a>>(
|
||||
&mut self,
|
||||
fixtures: &VariableFixtures,
|
||||
marker: &Alloc
|
||||
) {
|
||||
for &(_, ref cb) in fixtures.values() {
|
||||
if let Some(index) = cb.first() {
|
||||
if !self.unsafe_vars.contains_key(&index.get().norm()) {
|
||||
self.unsafe_vars.insert(index.get().norm(), false);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
for var in fixtures.last_chunk_temp_vars.iter().cloned() {
|
||||
let r = marker.get(var);
|
||||
self.unsafe_vars.insert(r, false);
|
||||
pub fn from_safe_vars(safe_vars: IndexSet<RegType>) -> Self {
|
||||
UnsafeVarMarker {
|
||||
unsafe_vars: IndexMap::new(),
|
||||
safe_vars
|
||||
}
|
||||
}
|
||||
|
||||
pub fn mark_safe_vars(&mut self, query_instr: &QueryInstruction) {
|
||||
pub fn mark_safe_vars(&mut self, query_instr: &QueryInstruction) -> bool {
|
||||
match query_instr {
|
||||
QueryInstruction::PutVariable(RegType::Temp(r), _) => {
|
||||
if let Some(found) = self.unsafe_vars.get_mut(&RegType::Temp(*r)) {
|
||||
*found = true;
|
||||
}
|
||||
&QueryInstruction::PutVariable(r @ RegType::Temp(_), _)
|
||||
| &QueryInstruction::SetVariable(r) => {
|
||||
self.safe_vars.insert(r);
|
||||
true
|
||||
}
|
||||
QueryInstruction::SetVariable(reg) => {
|
||||
if let Some(found) = self.unsafe_vars.get_mut(reg) {
|
||||
*found = true;
|
||||
}
|
||||
_ => {
|
||||
false
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub fn mark_phase(&mut self, query_instr: &QueryInstruction, phase: usize) {
|
||||
match query_instr {
|
||||
&QueryInstruction::PutValue(r @ RegType::Perm(_), _)
|
||||
| &QueryInstruction::SetValue(r) => {
|
||||
let p = self.unsafe_vars.entry(r).or_insert(0);
|
||||
*p = phase;
|
||||
}
|
||||
_ => {}
|
||||
}
|
||||
}
|
||||
|
||||
pub fn mark_unsafe_vars(&mut self, query_instr: &mut QueryInstruction) {
|
||||
pub fn mark_unsafe_vars(&mut self, query_instr: &mut QueryInstruction, phase: usize) {
|
||||
match query_instr {
|
||||
&mut QueryInstruction::PutValue(RegType::Perm(i), arg) => {
|
||||
if let Some(found) = self.unsafe_vars.get_mut(&RegType::Perm(i)) {
|
||||
if !*found {
|
||||
*found = true;
|
||||
if let Some(p) = self.unsafe_vars.swap_remove(&RegType::Perm(i)) {
|
||||
if p == phase {
|
||||
*query_instr = QueryInstruction::PutUnsafeValue(i, arg);
|
||||
self.safe_vars.insert(RegType::Perm(i));
|
||||
} else {
|
||||
self.unsafe_vars.insert(RegType::Perm(i), p);
|
||||
}
|
||||
}
|
||||
}
|
||||
&mut QueryInstruction::SetValue(reg) => {
|
||||
if let Some(found) = self.unsafe_vars.get_mut(®) {
|
||||
if !*found {
|
||||
*found = true;
|
||||
*query_instr = QueryInstruction::SetLocalValue(reg);
|
||||
}
|
||||
&mut QueryInstruction::SetValue(r) => {
|
||||
if !self.safe_vars.contains(&r) {
|
||||
*query_instr = QueryInstruction::SetLocalValue(r);
|
||||
|
||||
self.safe_vars.insert(r);
|
||||
self.unsafe_vars.remove(&r);
|
||||
}
|
||||
}
|
||||
_ => {}
|
||||
|
||||
@@ -12,6 +12,7 @@ use indexmap::IndexMap;
|
||||
|
||||
use std::cell::Cell;
|
||||
use std::collections::VecDeque;
|
||||
use std::path::PathBuf;
|
||||
use std::rc::Rc;
|
||||
|
||||
pub type PredicateKey = (ClauseName, usize); // name, arity.
|
||||
@@ -20,7 +21,7 @@ pub type PredicateKey = (ClauseName, usize); // name, arity.
|
||||
// of vars (we get their adjoining cells this way).
|
||||
pub type JumpStub = Vec<Term>;
|
||||
|
||||
#[derive(Clone)]
|
||||
#[derive(Debug, Clone)]
|
||||
pub enum TopLevel {
|
||||
Declaration(Declaration),
|
||||
Fact(Term, usize, usize), // Term, line_num, col_num
|
||||
@@ -30,26 +31,6 @@ pub enum TopLevel {
|
||||
}
|
||||
|
||||
impl TopLevel {
|
||||
pub fn name(&self) -> Option<ClauseName> {
|
||||
match self {
|
||||
&TopLevel::Declaration(_) => None,
|
||||
&TopLevel::Fact(ref term, ..) => term.name(),
|
||||
&TopLevel::Predicate(ref clauses) => clauses.0.first().and_then(|ref term| term.name()),
|
||||
&TopLevel::Query(_) => None,
|
||||
&TopLevel::Rule(Rule { ref head, .. }, ..) => Some(head.0.clone()),
|
||||
}
|
||||
}
|
||||
|
||||
pub fn arity(&self) -> usize {
|
||||
match self {
|
||||
&TopLevel::Declaration(_) => 0,
|
||||
&TopLevel::Fact(ref term, ..) => term.arity(),
|
||||
&TopLevel::Predicate(ref clauses) => clauses.0.first().map(|t| t.arity()).unwrap_or(0),
|
||||
&TopLevel::Query(_) => 0,
|
||||
&TopLevel::Rule(Rule { ref head, .. }, ..) => head.1.len(),
|
||||
}
|
||||
}
|
||||
|
||||
pub fn is_end_of_file_atom(&self) -> bool {
|
||||
match self {
|
||||
&TopLevel::Fact(Term::Constant(_, Constant::Atom(ref name, _)), ..) => {
|
||||
@@ -60,7 +41,7 @@ impl TopLevel {
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Clone, Copy)]
|
||||
#[derive(Debug, Clone, Copy)]
|
||||
pub enum Level {
|
||||
Deep,
|
||||
Root,
|
||||
@@ -76,7 +57,7 @@ impl Level {
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Clone)]
|
||||
#[derive(Debug, Clone)]
|
||||
pub enum QueryTerm {
|
||||
// register, clause type, subterms, use default call policy.
|
||||
Clause(Cell<RegType>, ClauseType, Vec<Box<Term>>, bool),
|
||||
@@ -104,13 +85,13 @@ impl QueryTerm {
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Clone)]
|
||||
#[derive(Debug, Clone)]
|
||||
pub struct Rule {
|
||||
pub head: (ClauseName, Vec<Box<Term>>, QueryTerm),
|
||||
pub clauses: Vec<QueryTerm>,
|
||||
}
|
||||
|
||||
#[derive(Clone)]
|
||||
#[derive(Debug, Clone)]
|
||||
pub struct Predicate(pub Vec<PredicateClause>);
|
||||
|
||||
impl Predicate {
|
||||
@@ -132,9 +113,219 @@ impl Predicate {
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug, Clone)]
|
||||
pub enum ListingSource {
|
||||
File(ClauseName, PathBuf), // filename, path
|
||||
User,
|
||||
}
|
||||
|
||||
impl ListingSource {
|
||||
pub fn from_file_and_path(filename: ClauseName, path_buf: PathBuf) -> Self {
|
||||
ListingSource::File(filename, path_buf)
|
||||
}
|
||||
|
||||
pub fn name(&self) -> ClauseName {
|
||||
match self {
|
||||
ListingSource::File(ref filename, _) => filename.clone(),
|
||||
ListingSource::User => clause_name!("[user]")
|
||||
}
|
||||
}
|
||||
|
||||
pub fn path(&self) -> PathBuf {
|
||||
match self {
|
||||
ListingSource::File(_, ref path) => path.clone(),
|
||||
ListingSource::User => std::env::current_dir().unwrap(),
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn resolved_term_and_module(term: &Term) -> Option<(ClauseName, ClauseName)>
|
||||
{
|
||||
match term {
|
||||
Term::Clause(_, ref name, ref terms, _) => {
|
||||
if name.as_str() == ":" && terms.len() == 2 {
|
||||
let module_name = match terms[0].as_ref() {
|
||||
&Term::Constant(_, Constant::Atom(ref module_name, _)) => {
|
||||
module_name.clone()
|
||||
}
|
||||
_ => {
|
||||
return Some((name.owning_module(), name.clone()));
|
||||
}
|
||||
};
|
||||
|
||||
match terms[1].as_ref() {
|
||||
Term::Clause(_, ref name, ..)
|
||||
| Term::Constant(_, Constant::Atom(ref name, ..)) => {
|
||||
return Some((module_name, name.clone()));
|
||||
}
|
||||
_ => {
|
||||
}
|
||||
}
|
||||
|
||||
Some((name.owning_module(), name.clone()))
|
||||
} else {
|
||||
Some((name.owning_module(), name.clone()))
|
||||
}
|
||||
}
|
||||
Term::Constant(_, Constant::Atom(ref name, _)) => {
|
||||
Some((name.owning_module(), name.clone()))
|
||||
}
|
||||
_ => {
|
||||
None
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn resolved_term_arity(term: &Term) -> usize
|
||||
{
|
||||
match term {
|
||||
Term::Clause(_, ref name, ref terms, _) => {
|
||||
if name.as_str() == ":" && terms.len() == 2 {
|
||||
match terms[0].as_ref() {
|
||||
&Term::Constant(_, Constant::Atom(..)) => {
|
||||
}
|
||||
_ => {
|
||||
return 2;
|
||||
}
|
||||
}
|
||||
|
||||
match terms[1].as_ref() {
|
||||
Term::Clause(_, _, ref terms, _) => {
|
||||
terms.len()
|
||||
}
|
||||
Term::Constant(_, Constant::Atom(..)) => {
|
||||
0
|
||||
}
|
||||
_ => {
|
||||
2
|
||||
}
|
||||
}
|
||||
} else {
|
||||
terms.len()
|
||||
}
|
||||
}
|
||||
_ => {
|
||||
0
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub trait ClauseConsistency {
|
||||
fn is_consistent(&self, clauses: &Vec<PredicateClause>) -> bool {
|
||||
match clauses.first() {
|
||||
Some(ref cl) => {
|
||||
self.name_and_module() == cl.name_and_module() && self.arity() == cl.arity()
|
||||
}
|
||||
None => {
|
||||
true
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn name_and_module(&self) -> Option<(ClauseName, ClauseName)>;
|
||||
fn arity(&self) -> usize;
|
||||
}
|
||||
|
||||
/* Of course '$current_module$' isn't the name of the current
|
||||
* module. It'll do if no module is explicitly specified through
|
||||
* (:)/2.
|
||||
*/
|
||||
impl ClauseConsistency for Term {
|
||||
fn name_and_module(&self) -> Option<(ClauseName, ClauseName)>
|
||||
{
|
||||
match self {
|
||||
Term::Clause(_, ref name, ref terms, _) =>
|
||||
match name.as_str() {
|
||||
":-" => {
|
||||
match terms.len() {
|
||||
1 => None, // a declaration.
|
||||
2 => resolved_term_and_module(&terms[0]),
|
||||
_ => Some((name.owning_module(), clause_name!(":-"))),
|
||||
}
|
||||
}
|
||||
_ => {
|
||||
resolved_term_and_module(self)
|
||||
}
|
||||
},
|
||||
Term::Constant(_, Constant::Atom(ref name, _)) => {
|
||||
Some((name.owning_module(), name.clone()))
|
||||
}
|
||||
_ => {
|
||||
None
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn arity(&self) -> usize {
|
||||
match self {
|
||||
Term::Clause(_, ref name, ref terms, _) =>
|
||||
match name.as_str() {
|
||||
":-" => {
|
||||
match terms.len() {
|
||||
1 => 0,
|
||||
2 => resolved_term_arity(&terms[0]),
|
||||
_ => terms.len(),
|
||||
}
|
||||
}
|
||||
_ => {
|
||||
resolved_term_arity(self)
|
||||
}
|
||||
},
|
||||
_ => {
|
||||
0
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl ClauseConsistency for Rule {
|
||||
fn name_and_module(&self) -> Option<(ClauseName, ClauseName)> {
|
||||
Some((self.head.0.owning_module(), self.head.0.clone()))
|
||||
}
|
||||
|
||||
fn arity(&self) -> usize {
|
||||
self.head.1.len()
|
||||
}
|
||||
}
|
||||
|
||||
impl ClauseConsistency for PredicateClause {
|
||||
fn name_and_module(&self) -> Option<(ClauseName, ClauseName)> {
|
||||
match self {
|
||||
&PredicateClause::Fact(ref term, ..) => {
|
||||
term.name_and_module()
|
||||
.map(|(_, name)| (name.owning_module(), name))
|
||||
}
|
||||
&PredicateClause::Rule(ref rule, ..) => {
|
||||
rule.name_and_module()
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn arity(&self) -> usize {
|
||||
match self {
|
||||
&PredicateClause::Fact(ref term, ..) => {
|
||||
term.arity()
|
||||
}
|
||||
&PredicateClause::Rule(ref rule, ..) => {
|
||||
rule.arity()
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl ClauseConsistency for Predicate {
|
||||
fn name_and_module(&self) -> Option<(ClauseName, ClauseName)> {
|
||||
self.0.first().and_then(|clause| clause.name_and_module())
|
||||
}
|
||||
|
||||
fn arity(&self) -> usize {
|
||||
self.0.first().map(|clause| clause.arity()).unwrap_or(0)
|
||||
}
|
||||
}
|
||||
|
||||
pub type CompiledResult = (Predicate, VecDeque<TopLevel>);
|
||||
|
||||
#[derive(Clone)]
|
||||
#[derive(Debug, Clone)]
|
||||
pub enum PredicateClause {
|
||||
Fact(Term, usize, usize), // Term, line number, column number.
|
||||
Rule(Rule, usize, usize), // Term, line number, column number.
|
||||
@@ -150,8 +341,24 @@ impl PredicateClause {
|
||||
|
||||
pub fn arity(&self) -> usize {
|
||||
match self {
|
||||
&PredicateClause::Fact(ref term, ..) => term.arity(),
|
||||
&PredicateClause::Rule(ref rule, ..) => rule.head.1.len(),
|
||||
&PredicateClause::Fact(ref term, ..) => {
|
||||
term.arity()
|
||||
}
|
||||
&PredicateClause::Rule(ref rule, ..) => {
|
||||
if rule.head.0.as_str() == ":" && rule.head.1.len() == 2 {
|
||||
match (rule.head.1)[0].as_ref() {
|
||||
&Term::Constant(_, Constant::Atom(..)) => {
|
||||
}
|
||||
_ => {
|
||||
return 2;
|
||||
}
|
||||
}
|
||||
|
||||
(rule.head.1)[1].arity()
|
||||
} else {
|
||||
rule.head.1.len()
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -163,23 +370,46 @@ impl PredicateClause {
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Clone)]
|
||||
#[derive(Debug, Clone)]
|
||||
pub enum ModuleSource {
|
||||
Library(ClauseName),
|
||||
File(ClauseName),
|
||||
}
|
||||
|
||||
#[derive(Clone)]
|
||||
impl ModuleSource {
|
||||
pub fn as_functor_stub(&self) -> MachineStub {
|
||||
match self {
|
||||
ModuleSource::Library(ref name) => {
|
||||
functor!("library", [clause_name(name.clone())])
|
||||
}
|
||||
ModuleSource::File(ref name) => {
|
||||
functor!(clause_name(name.clone()))
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub type ScopedPredicateKey = (ClauseName, PredicateKey); // module name, predicate indicator.
|
||||
|
||||
#[derive(Debug, Clone)]
|
||||
pub enum MultiFileIndicator {
|
||||
LocalScoped(ClauseName, usize), // name, arity
|
||||
ModuleScoped(ScopedPredicateKey),
|
||||
}
|
||||
|
||||
#[derive(Debug, Clone)]
|
||||
pub enum Declaration {
|
||||
Dynamic(ClauseName, usize), // name, arity
|
||||
EndOfFile,
|
||||
Hook(CompileTimeHook, PredicateClause, VecDeque<TopLevel>),
|
||||
ModuleInitialization(Vec<QueryTerm>, VecDeque<TopLevel>), // goal
|
||||
Module(ModuleDecl),
|
||||
MultiFile(MultiFileIndicator),
|
||||
NonCountedBacktracking(ClauseName, usize), // name, arity
|
||||
Op(OpDecl),
|
||||
SetPrologFlag(DoubleQuotes),
|
||||
UseModule(ModuleSource),
|
||||
UseQualifiedModule(ModuleSource, Vec<PredicateKey>),
|
||||
UseQualifiedModule(ModuleSource, Vec<ModuleExport>),
|
||||
}
|
||||
|
||||
impl Declaration {
|
||||
@@ -202,7 +432,7 @@ impl Declaration {
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Clone, PartialEq, Eq, PartialOrd, Ord)]
|
||||
#[derive(Debug, Clone, PartialEq, Eq, PartialOrd, Ord)]
|
||||
pub struct OpDecl(pub usize, pub Specifier, pub ClauseName);
|
||||
|
||||
impl OpDecl {
|
||||
@@ -216,15 +446,20 @@ impl OpDecl {
|
||||
self.insert_into_op_dir(clause_name!(""), op_dir, 0);
|
||||
}
|
||||
|
||||
fn insert_into_op_dir(&self, module: ClauseName, op_dir: &mut OpDir, prec: usize) {
|
||||
let (spec, name) = (self.1, self.2.clone());
|
||||
|
||||
let fixity = match spec {
|
||||
#[inline]
|
||||
pub fn fixity(&self) -> Fixity {
|
||||
match self.1 {
|
||||
XFY | XFX | YFX => Fixity::In,
|
||||
XF | YF => Fixity::Post,
|
||||
FX | FY => Fixity::Pre,
|
||||
_ => return,
|
||||
};
|
||||
_ => unreachable!()
|
||||
}
|
||||
}
|
||||
|
||||
pub fn insert_into_op_dir(&self, module: ClauseName, op_dir: &mut OpDir, prec: usize) {
|
||||
let (spec, name) = (self.1, self.2.clone());
|
||||
|
||||
let fixity = self.fixity();
|
||||
|
||||
match op_dir.get(&(name.clone(), fixity)) {
|
||||
Some(cell) => {
|
||||
@@ -281,11 +516,11 @@ pub fn fetch_op_spec(
|
||||
op_dir: &OpDir,
|
||||
) -> Option<SharedOpDesc> {
|
||||
if let Some(ref op_desc) = &spec {
|
||||
if op_desc.arity() != arity {
|
||||
if op_desc.arity() != arity {
|
||||
/* it's possible to extend operator functors with
|
||||
* additional terms. When that happens,
|
||||
* void the op_spec by returning None. */
|
||||
return None;
|
||||
return None;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -322,29 +557,63 @@ pub fn fetch_op_spec(
|
||||
|
||||
pub type ModuleDir = IndexMap<ClauseName, Module>;
|
||||
|
||||
#[derive(Clone)]
|
||||
pub struct ModuleDecl {
|
||||
pub name: ClauseName,
|
||||
pub exports: Vec<PredicateKey>,
|
||||
#[derive(Debug, Clone, PartialEq)]
|
||||
pub enum ModuleExport {
|
||||
OpDecl(OpDecl),
|
||||
PredicateKey(PredicateKey),
|
||||
}
|
||||
|
||||
#[derive(Debug, Clone)]
|
||||
pub struct ModuleDecl {
|
||||
pub name: ClauseName,
|
||||
pub exports: Vec<ModuleExport>,
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub struct Module {
|
||||
pub atom_tbl: TabledData<Atom>,
|
||||
pub module_decl: ModuleDecl,
|
||||
pub code_dir: CodeDir,
|
||||
pub op_dir: OpDir,
|
||||
pub term_dir: TermDir, // this contains multifile predicates.
|
||||
pub term_expansions: (Predicate, VecDeque<TopLevel>),
|
||||
pub goal_expansions: (Predicate, VecDeque<TopLevel>),
|
||||
pub user_term_expansions: (Predicate, VecDeque<TopLevel>), // term expansions inherited from the user scope.
|
||||
pub user_goal_expansions: (Predicate, VecDeque<TopLevel>), // same for goal_expansions.
|
||||
pub local_term_expansions: (Predicate, VecDeque<TopLevel>), // expansions local to the module.
|
||||
pub local_goal_expansions: (Predicate, VecDeque<TopLevel>),
|
||||
pub inserted_expansions: bool, // has the module been successfully inserted into toplevel??
|
||||
pub is_impromptu_module: bool,
|
||||
pub listing_src: ListingSource,
|
||||
}
|
||||
|
||||
#[derive(Clone, PartialEq, Eq)]
|
||||
#[derive(Debug, Clone)]
|
||||
pub enum Number {
|
||||
Float(OrderedFloat<f64>),
|
||||
Integer(Integer),
|
||||
Rational(Rational),
|
||||
Integer(Rc<Integer>),
|
||||
Rational(Rc<Rational>),
|
||||
Fixnum(isize),
|
||||
}
|
||||
|
||||
impl From<Integer> for Number {
|
||||
#[inline]
|
||||
fn from(n: Integer) -> Self {
|
||||
Number::Integer(Rc::new(n))
|
||||
}
|
||||
}
|
||||
|
||||
impl From<Rational> for Number {
|
||||
#[inline]
|
||||
fn from(n: Rational) -> Self {
|
||||
Number::Rational(Rc::new(n))
|
||||
}
|
||||
}
|
||||
|
||||
impl From<isize> for Number {
|
||||
#[inline]
|
||||
fn from(n: isize) -> Self {
|
||||
Number::Fixnum(n)
|
||||
}
|
||||
}
|
||||
|
||||
impl Default for Number {
|
||||
@@ -353,48 +622,74 @@ impl Default for Number {
|
||||
}
|
||||
}
|
||||
|
||||
impl Number {
|
||||
pub fn to_constant(self) -> Constant {
|
||||
impl Into<Constant> for Number {
|
||||
#[inline]
|
||||
fn into(self) -> Constant {
|
||||
match self {
|
||||
Number::Fixnum(n) => Constant::Fixnum(n),
|
||||
Number::Integer(n) => Constant::Integer(n),
|
||||
Number::Float(f) => Constant::Float(f),
|
||||
Number::Rational(r) => Constant::Rational(r),
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl Into<HeapCellValue> for Number {
|
||||
#[inline]
|
||||
fn into(self) -> HeapCellValue {
|
||||
match self {
|
||||
Number::Fixnum(n) => HeapCellValue::Addr(Addr::Fixnum(n)),
|
||||
Number::Integer(n) => HeapCellValue::Integer(n),
|
||||
Number::Float(f) => HeapCellValue::Addr(Addr::Float(f)),
|
||||
Number::Rational(r) => HeapCellValue::Rational(r),
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
impl Number {
|
||||
#[inline]
|
||||
pub fn is_positive(&self) -> bool {
|
||||
match self {
|
||||
&Number::Integer(ref n) => n > &0,
|
||||
&Number::Fixnum(n) => n > 0,
|
||||
&Number::Integer(ref n) => &**n > &0,
|
||||
&Number::Float(OrderedFloat(f)) => f.is_sign_positive(),
|
||||
&Number::Rational(ref r) => r > &0,
|
||||
&Number::Rational(ref r) => &**r > &0,
|
||||
}
|
||||
}
|
||||
|
||||
#[inline]
|
||||
pub fn is_negative(&self) -> bool {
|
||||
match self {
|
||||
&Number::Integer(ref n) => n < &0,
|
||||
&Number::Fixnum(n) => n < 0,
|
||||
&Number::Integer(ref n) => &**n < &0,
|
||||
&Number::Float(OrderedFloat(f)) => f.is_sign_negative(),
|
||||
&Number::Rational(ref r) => r < &0,
|
||||
&Number::Rational(ref r) => &**r < &0,
|
||||
}
|
||||
}
|
||||
|
||||
#[inline]
|
||||
pub fn is_zero(&self) -> bool {
|
||||
match self {
|
||||
&Number::Integer(ref n) => n == &0,
|
||||
&Number::Fixnum(n) => n == 0,
|
||||
&Number::Integer(ref n) => &**n == &0,
|
||||
&Number::Float(f) => f == OrderedFloat(0f64),
|
||||
&Number::Rational(ref r) => r == &0,
|
||||
&Number::Rational(ref r) => &**r == &0,
|
||||
}
|
||||
}
|
||||
|
||||
#[inline]
|
||||
pub fn abs(self) -> Self {
|
||||
match self {
|
||||
Number::Integer(n) => Number::Integer(n.abs()),
|
||||
Number::Fixnum(n) =>
|
||||
if let Some(n) = n.checked_abs() {
|
||||
Number::from(n)
|
||||
} else {
|
||||
Number::from(Integer::from(n).abs())
|
||||
}
|
||||
Number::Integer(n) => Number::from(Integer::from(n.abs_ref())),
|
||||
Number::Float(f) => Number::Float(OrderedFloat(f.abs())),
|
||||
Number::Rational(r) => Number::Rational(r.abs()),
|
||||
Number::Rational(r) => Number::from(Rational::from(r.abs_ref())),
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1,5 +1,3 @@
|
||||
use prolog_parser::ast::*;
|
||||
|
||||
use crate::prolog::machine::machine_indices::*;
|
||||
use crate::prolog::machine::machine_state::*;
|
||||
|
||||
@@ -9,6 +7,7 @@ use std::cmp::Ordering;
|
||||
use std::ops::Deref;
|
||||
use std::vec::Vec;
|
||||
|
||||
#[derive(Debug)]
|
||||
pub struct HCPreOrderIterator<'a> {
|
||||
pub machine_st: &'a MachineState,
|
||||
pub state_stack: Vec<Addr>,
|
||||
@@ -22,6 +21,7 @@ impl<'a> HCPreOrderIterator<'a> {
|
||||
}
|
||||
}
|
||||
|
||||
#[inline]
|
||||
pub fn machine_st(&self) -> &MachineState {
|
||||
&self.machine_st
|
||||
}
|
||||
@@ -29,13 +29,28 @@ impl<'a> HCPreOrderIterator<'a> {
|
||||
fn follow_heap(&mut self, h: usize) -> Addr {
|
||||
match &self.machine_st.heap[h] {
|
||||
&HeapCellValue::NamedStr(arity, _, _) => {
|
||||
for idx in (1..arity + 1).rev() {
|
||||
for idx in (1 .. arity + 1).rev() {
|
||||
self.state_stack.push(Addr::HeapCell(h + idx));
|
||||
}
|
||||
|
||||
Addr::HeapCell(h)
|
||||
Addr::Str(h)
|
||||
}
|
||||
&HeapCellValue::Addr(a) => {
|
||||
self.follow(a)
|
||||
}
|
||||
HeapCellValue::PartialString(..) => {
|
||||
self.follow(Addr::PStrLocation(h, 0))
|
||||
}
|
||||
HeapCellValue::Atom(..) | HeapCellValue::DBRef(_)
|
||||
| HeapCellValue::Integer(_) | HeapCellValue::Rational(_) => {
|
||||
Addr::Con(h)
|
||||
}
|
||||
HeapCellValue::Stream(_) => {
|
||||
Addr::Stream(h)
|
||||
}
|
||||
&HeapCellValue::TcpListener(_) => {
|
||||
Addr::TcpListener(h)
|
||||
}
|
||||
&HeapCellValue::Addr(ref a) => self.follow(a.clone()),
|
||||
}
|
||||
}
|
||||
|
||||
@@ -46,79 +61,92 @@ impl<'a> HCPreOrderIterator<'a> {
|
||||
let da = self.machine_st.store(self.machine_st.deref(addr));
|
||||
|
||||
match da {
|
||||
Addr::Con(Constant::String(ref s)) => {
|
||||
match self.machine_st.machine_flags().double_quotes {
|
||||
DoubleQuotes::Chars => {
|
||||
if let Some(c) = s.head() {
|
||||
let tail = s.tail();
|
||||
|
||||
self.state_stack.push(Addr::Con(Constant::String(tail)));
|
||||
self.state_stack.push(Addr::Con(Constant::Char(c)));
|
||||
}
|
||||
}
|
||||
DoubleQuotes::Codes => {
|
||||
if let Some(c) = s.head() {
|
||||
let tail = s.tail();
|
||||
|
||||
self.state_stack.push(Addr::Con(Constant::String(tail)));
|
||||
self.state_stack
|
||||
.push(Addr::Con(Constant::CharCode(c as u8)));
|
||||
}
|
||||
}
|
||||
_ => {}
|
||||
}
|
||||
|
||||
Addr::Con(Constant::String(s.clone()))
|
||||
}
|
||||
Addr::Con(_) | Addr::DBRef(_) => da,
|
||||
Addr::Lis(a) => {
|
||||
self.state_stack.push(Addr::HeapCell(a + 1));
|
||||
self.state_stack.push(Addr::HeapCell(a));
|
||||
|
||||
da
|
||||
}
|
||||
Addr::AttrVar(_) | Addr::HeapCell(_) | Addr::StackCell(_, _) => da,
|
||||
Addr::Str(s) => self.follow_heap(s), // record terms of structure.
|
||||
Addr::PStrLocation(h, n) => {
|
||||
if let &HeapCellValue::PartialString(ref pstr, has_tail) = &self.machine_st.heap[h] {
|
||||
if let Some(c) = pstr.range_from(n ..).next() {
|
||||
if !pstr.at_end(n + c.len_utf8()) {
|
||||
self.state_stack.push(Addr::PStrLocation(h, n + c.len_utf8()));
|
||||
} else if has_tail {
|
||||
self.state_stack.push(Addr::HeapCell(h + 1));
|
||||
} else {
|
||||
self.state_stack.push(Addr::EmptyList);
|
||||
}
|
||||
|
||||
self.state_stack.push(Addr::Char(c));
|
||||
} else if has_tail {
|
||||
return self.follow(Addr::HeapCell(h + 1));
|
||||
}
|
||||
} else {
|
||||
unreachable!()
|
||||
}
|
||||
|
||||
Addr::PStrLocation(h, n)
|
||||
}
|
||||
Addr::Str(s) => {
|
||||
self.follow_heap(s) // record terms of structure.
|
||||
}
|
||||
Addr::Con(h) => {
|
||||
if let &HeapCellValue::PartialString(ref pstr, has_tail) = &self.machine_st.heap[h] {
|
||||
if !self.machine_st.flags.double_quotes.is_atom() {
|
||||
return if let Some(c) = pstr.range_from(0 ..).next() {
|
||||
self.state_stack.push(Addr::PStrLocation(h, c.len_utf8()));
|
||||
self.state_stack.push(Addr::Char(c));
|
||||
|
||||
Addr::PStrLocation(h, 0)
|
||||
} else if has_tail {
|
||||
self.follow(Addr::HeapCell(h + 1))
|
||||
} else {
|
||||
Addr::EmptyList
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
Addr::Con(h)
|
||||
}
|
||||
da => {
|
||||
da
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> Iterator for HCPreOrderIterator<'a> {
|
||||
type Item = HeapCellValue;
|
||||
type Item = Addr;
|
||||
|
||||
fn next(&mut self) -> Option<Self::Item> {
|
||||
self.state_stack.pop().map(|a| match self.follow(a) {
|
||||
Addr::HeapCell(h) => self.machine_st.heap[h].clone(),
|
||||
Addr::StackCell(fr, sc) => {
|
||||
HeapCellValue::Addr(self.machine_st.and_stack[fr][sc].clone())
|
||||
}
|
||||
da => HeapCellValue::Addr(da),
|
||||
})
|
||||
self.state_stack.pop().map(|a| self.follow(a))
|
||||
}
|
||||
}
|
||||
|
||||
pub trait MutStackHCIterator
|
||||
where
|
||||
Self: Iterator<Item = HeapCellValue>,
|
||||
pub trait MutStackHCIterator<'b> where Self: Iterator
|
||||
{
|
||||
fn stack(&mut self) -> &mut Vec<Addr>;
|
||||
type MutStack;
|
||||
|
||||
fn stack(&'b mut self) -> Self::MutStack;
|
||||
}
|
||||
|
||||
pub struct HCPostOrderIterator<HCIter> {
|
||||
base_iter: HCIter,
|
||||
parent_stack: Vec<(usize, HeapCellValue)>, // number of children, parent node.
|
||||
#[derive(Debug)]
|
||||
pub struct HCPostOrderIterator<'a> {
|
||||
base_iter: HCPreOrderIterator<'a>,
|
||||
parent_stack: Vec<(usize, Addr)>, // number of children, parent node.
|
||||
}
|
||||
|
||||
impl<HCIter> Deref for HCPostOrderIterator<HCIter> {
|
||||
type Target = HCIter;
|
||||
impl<'a> Deref for HCPostOrderIterator<'a> {
|
||||
type Target = HCPreOrderIterator<'a>;
|
||||
|
||||
fn deref(&self) -> &Self::Target {
|
||||
&self.base_iter
|
||||
}
|
||||
}
|
||||
|
||||
impl<HCIter: Iterator<Item = HeapCellValue>> HCPostOrderIterator<HCIter> {
|
||||
pub fn new(base_iter: HCIter) -> Self {
|
||||
impl<'a> HCPostOrderIterator<'a> {
|
||||
pub fn new(base_iter: HCPreOrderIterator<'a>) -> Self {
|
||||
HCPostOrderIterator {
|
||||
base_iter,
|
||||
parent_stack: vec![],
|
||||
@@ -126,8 +154,8 @@ impl<HCIter: Iterator<Item = HeapCellValue>> HCPostOrderIterator<HCIter> {
|
||||
}
|
||||
}
|
||||
|
||||
impl<HCIter: Iterator<Item = HeapCellValue>> Iterator for HCPostOrderIterator<HCIter> {
|
||||
type Item = HeapCellValue;
|
||||
impl<'a> Iterator for HCPostOrderIterator<'a> {
|
||||
type Item = Addr;
|
||||
|
||||
fn next(&mut self) -> Option<Self::Item> {
|
||||
loop {
|
||||
@@ -140,15 +168,30 @@ impl<HCIter: Iterator<Item = HeapCellValue>> Iterator for HCPostOrderIterator<HC
|
||||
}
|
||||
|
||||
if let Some(item) = self.base_iter.next() {
|
||||
match item {
|
||||
HeapCellValue::NamedStr(arity, name, fix) => self
|
||||
.parent_stack
|
||||
.push((arity, HeapCellValue::NamedStr(arity, name, fix))),
|
||||
HeapCellValue::Addr(Addr::Lis(a)) => self
|
||||
.parent_stack
|
||||
.push((2, HeapCellValue::Addr(Addr::Lis(a)))),
|
||||
child_node => {
|
||||
return Some(child_node);
|
||||
match self.base_iter.machine_st.heap.index_addr(&item).as_ref() {
|
||||
&HeapCellValue::NamedStr(arity, ..) => {
|
||||
self.parent_stack.push((arity, item));
|
||||
}
|
||||
&HeapCellValue::Addr(Addr::Lis(a)) => {
|
||||
self.parent_stack.push((2, Addr::Lis(a)));
|
||||
}
|
||||
&HeapCellValue::Addr(Addr::PStrLocation(h, n)) => {
|
||||
match &self.machine_st.heap[h] {
|
||||
&HeapCellValue::PartialString(ref pstr, _) => {
|
||||
let c = pstr.range_from(n ..).next().unwrap();
|
||||
let next_n = n + c.len_utf8();
|
||||
|
||||
if !pstr.at_end(next_n) {
|
||||
self.parent_stack.push((2, Addr::PStrLocation(h, next_n)));
|
||||
}
|
||||
}
|
||||
_ => {
|
||||
unreachable!()
|
||||
}
|
||||
}
|
||||
}
|
||||
_ => {
|
||||
return Some(item);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
@@ -158,21 +201,16 @@ impl<HCIter: Iterator<Item = HeapCellValue>> Iterator for HCPostOrderIterator<HC
|
||||
}
|
||||
}
|
||||
|
||||
pub type HCProperPostOrderIterator<'a> = HCPostOrderIterator<HCPreOrderIterator<'a>>;
|
||||
|
||||
impl MachineState {
|
||||
pub fn pre_order_iter<'a>(&'a self, a: Addr) -> HCPreOrderIterator<'a> {
|
||||
HCPreOrderIterator::new(self, a)
|
||||
}
|
||||
|
||||
pub fn post_order_iter<'a>(&'a self, a: Addr) -> HCProperPostOrderIterator<'a> {
|
||||
pub fn post_order_iter<'a>(&'a self, a: Addr) -> HCPostOrderIterator<'a> {
|
||||
HCPostOrderIterator::new(HCPreOrderIterator::new(self, a))
|
||||
}
|
||||
|
||||
pub fn acyclic_pre_order_iter<'a>(
|
||||
&'a self,
|
||||
a: Addr,
|
||||
) -> HCAcyclicIterator<HCPreOrderIterator<'a>> {
|
||||
pub fn acyclic_pre_order_iter<'a>(&'a self, a: Addr,) -> HCAcyclicIterator<'a> {
|
||||
HCAcyclicIterator::new(HCPreOrderIterator::new(self, a))
|
||||
}
|
||||
|
||||
@@ -180,7 +218,7 @@ impl MachineState {
|
||||
&'a self,
|
||||
a1: Addr,
|
||||
a2: Addr,
|
||||
) -> HCZippedAcyclicIterator<HCPreOrderIterator<'a>> {
|
||||
) -> HCZippedAcyclicIterator<'a> {
|
||||
HCZippedAcyclicIterator::new(
|
||||
HCPreOrderIterator::new(self, a1),
|
||||
HCPreOrderIterator::new(self, a2),
|
||||
@@ -188,19 +226,22 @@ impl MachineState {
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> MutStackHCIterator for HCPreOrderIterator<'a> {
|
||||
fn stack(&mut self) -> &mut Vec<Addr> {
|
||||
impl<'b, 'a: 'b> MutStackHCIterator<'b> for HCPreOrderIterator<'a> {
|
||||
type MutStack = &'b mut Vec<Addr>;
|
||||
|
||||
fn stack(&'b mut self) -> Self::MutStack {
|
||||
&mut self.state_stack
|
||||
}
|
||||
}
|
||||
|
||||
pub struct HCAcyclicIterator<HCIter> {
|
||||
iter: HCIter,
|
||||
#[derive(Debug)]
|
||||
pub struct HCAcyclicIterator<'a> {
|
||||
iter: HCPreOrderIterator<'a>,
|
||||
seen: IndexSet<Addr>,
|
||||
}
|
||||
|
||||
impl<HCIter: MutStackHCIterator> HCAcyclicIterator<HCIter> {
|
||||
pub fn new(iter: HCIter) -> Self {
|
||||
impl<'a> HCAcyclicIterator<'a> {
|
||||
pub fn new(iter: HCPreOrderIterator<'a>) -> Self {
|
||||
HCAcyclicIterator {
|
||||
iter,
|
||||
seen: IndexSet::new(),
|
||||
@@ -208,19 +249,25 @@ impl<HCIter: MutStackHCIterator> HCAcyclicIterator<HCIter> {
|
||||
}
|
||||
}
|
||||
|
||||
impl<HCIter> Deref for HCAcyclicIterator<HCIter> {
|
||||
type Target = HCIter;
|
||||
impl<'a> Deref for HCAcyclicIterator<'a> {
|
||||
type Target = HCPreOrderIterator<'a>;
|
||||
|
||||
fn deref(&self) -> &Self::Target {
|
||||
&self.iter
|
||||
}
|
||||
}
|
||||
|
||||
impl<HCIter> Iterator for HCAcyclicIterator<HCIter>
|
||||
where
|
||||
HCIter: Iterator<Item = HeapCellValue> + MutStackHCIterator,
|
||||
impl<'b, 'a: 'b> MutStackHCIterator<'b> for HCAcyclicIterator<'a> {
|
||||
type MutStack = &'b mut Vec<Addr>;
|
||||
|
||||
fn stack(&'b mut self) -> Self::MutStack {
|
||||
self.iter.stack()
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> Iterator for HCAcyclicIterator<'a>
|
||||
{
|
||||
type Item = HeapCellValue;
|
||||
type Item = Addr;
|
||||
|
||||
fn next(&mut self) -> Option<Self::Item> {
|
||||
while let Some(addr) = self.iter.stack().pop() {
|
||||
@@ -236,15 +283,24 @@ where
|
||||
}
|
||||
}
|
||||
|
||||
pub struct HCZippedAcyclicIterator<HCIter> {
|
||||
i1: HCIter,
|
||||
i2: HCIter,
|
||||
#[derive(Debug)]
|
||||
pub struct HCZippedAcyclicIterator<'a> {
|
||||
i1: HCPreOrderIterator<'a>,
|
||||
i2: HCPreOrderIterator<'a>,
|
||||
seen: IndexSet<(Addr, Addr)>,
|
||||
pub first_to_expire: Ordering,
|
||||
}
|
||||
|
||||
impl<HCIter: MutStackHCIterator> HCZippedAcyclicIterator<HCIter> {
|
||||
pub fn new(i1: HCIter, i2: HCIter) -> Self {
|
||||
impl<'b, 'a: 'b> MutStackHCIterator<'b> for HCZippedAcyclicIterator<'a> {
|
||||
type MutStack = (&'b mut Vec<Addr>, &'b mut Vec<Addr>);
|
||||
|
||||
fn stack(&'b mut self) -> Self::MutStack {
|
||||
(self.i1.stack(), self.i2.stack())
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> HCZippedAcyclicIterator<'a> {
|
||||
pub fn new(i1: HCPreOrderIterator<'a>, i2: HCPreOrderIterator<'a>) -> Self {
|
||||
HCZippedAcyclicIterator {
|
||||
i1,
|
||||
i2,
|
||||
@@ -254,17 +310,16 @@ impl<HCIter: MutStackHCIterator> HCZippedAcyclicIterator<HCIter> {
|
||||
}
|
||||
}
|
||||
|
||||
impl<HCIter> Iterator for HCZippedAcyclicIterator<HCIter>
|
||||
where
|
||||
HCIter: Iterator<Item = HeapCellValue> + MutStackHCIterator,
|
||||
impl<'a> Iterator for HCZippedAcyclicIterator<'a>
|
||||
{
|
||||
type Item = (HeapCellValue, HeapCellValue);
|
||||
type Item = (Addr, Addr);
|
||||
|
||||
fn next(&mut self) -> Option<Self::Item> {
|
||||
while let (Some(a1), Some(a2)) = (self.i1.stack().pop(), self.i2.stack().pop()) {
|
||||
if !self.seen.contains(&(a1.clone(), a2.clone())) {
|
||||
self.i1.stack().push(a1.clone());
|
||||
self.i2.stack().push(a2.clone());
|
||||
|
||||
self.seen.insert((a1, a2));
|
||||
|
||||
break;
|
||||
@@ -281,7 +336,9 @@ where
|
||||
self.first_to_expire = Ordering::Less;
|
||||
None
|
||||
}
|
||||
_ => None,
|
||||
_ => {
|
||||
None
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,30 +1,35 @@
|
||||
use prolog_parser::ast::*;
|
||||
use prolog_parser::tabled_rc::*;
|
||||
|
||||
use crate::prolog::instructions::*;
|
||||
use crate::prolog::rug::Integer;
|
||||
|
||||
use indexmap::IndexMap;
|
||||
|
||||
use std::collections::VecDeque;
|
||||
use std::convert::TryFrom;
|
||||
use std::hash::Hash;
|
||||
use std::rc::Rc;
|
||||
|
||||
#[derive(Clone, Copy)]
|
||||
#[derive(Debug, Clone, Copy)]
|
||||
enum IntIndex {
|
||||
External(usize),
|
||||
Fail,
|
||||
Internal(usize),
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub struct CodeOffsets {
|
||||
flags: MachineFlags,
|
||||
atom_tbl: TabledData<Atom>,
|
||||
pub constants: IndexMap<Constant, ThirdLevelIndex>,
|
||||
pub lists: ThirdLevelIndex,
|
||||
pub structures: IndexMap<(ClauseName, usize), ThirdLevelIndex>,
|
||||
}
|
||||
|
||||
impl CodeOffsets {
|
||||
pub fn new(flags: MachineFlags) -> Self {
|
||||
pub fn new() -> Self {
|
||||
CodeOffsets {
|
||||
flags,
|
||||
atom_tbl: TabledData::new(Rc::new("_index".to_string())),
|
||||
constants: IndexMap::new(),
|
||||
lists: Vec::new(),
|
||||
structures: IndexMap::new(),
|
||||
@@ -50,6 +55,98 @@ impl CodeOffsets {
|
||||
}
|
||||
}
|
||||
|
||||
fn intercept_overlapping_constant(&mut self, constant: &Constant, index: usize) {
|
||||
match constant {
|
||||
&Constant::Atom(ref name, ref op) if name.is_char() => {
|
||||
let c = name.as_str().chars().next().unwrap();
|
||||
let code = self.constants
|
||||
.entry(Constant::Char(c))
|
||||
.or_insert(vec![]);
|
||||
|
||||
code.push(Self::add_index(code.is_empty(), index));
|
||||
|
||||
if op.is_some() {
|
||||
let code = self.constants
|
||||
.entry(Constant::Atom(name.clone(), None))
|
||||
.or_insert(vec![]);
|
||||
|
||||
code.push(Self::add_index(false, index));
|
||||
}
|
||||
}
|
||||
&Constant::Atom(ref name, Some(_)) => {
|
||||
let code = self.constants
|
||||
.entry(Constant::Atom(name.clone(), None))
|
||||
.or_insert(vec![]);
|
||||
|
||||
code.push(Self::add_index(code.is_empty(), index));
|
||||
}
|
||||
&Constant::Char(c) => {
|
||||
let atom = clause_name!(c.to_string(), self.atom_tbl.clone());
|
||||
|
||||
let code = self.constants
|
||||
.entry(Constant::Atom(atom, None))
|
||||
.or_insert(vec![]);
|
||||
|
||||
code.push(Self::add_index(code.is_empty(), index));
|
||||
}
|
||||
&Constant::Fixnum(n) => {
|
||||
let code = self.constants
|
||||
.entry(Constant::Integer(Rc::new(Integer::from(n))))
|
||||
.or_insert(vec![]);
|
||||
|
||||
code.push(Self::add_index(code.is_empty(), index));
|
||||
|
||||
if n >= 0 {
|
||||
if let Ok(n) = usize::try_from(n) {
|
||||
let code = self.constants
|
||||
.entry(Constant::Usize(n))
|
||||
.or_insert(vec![]);
|
||||
|
||||
code.push(Self::add_index(code.is_empty(), index));
|
||||
}
|
||||
}
|
||||
}
|
||||
&Constant::Integer(ref n) => {
|
||||
if let Some(n) = n.to_isize() {
|
||||
let code = self.constants
|
||||
.entry(Constant::Fixnum(n))
|
||||
.or_insert(vec![]);
|
||||
|
||||
code.push(Self::add_index(code.is_empty(), index));
|
||||
}
|
||||
|
||||
if let Some(n) = n.to_usize() {
|
||||
let code = self.constants
|
||||
.entry(Constant::Usize(n))
|
||||
.or_insert(vec![]);
|
||||
|
||||
code.push(Self::add_index(code.is_empty(), index));
|
||||
}
|
||||
}
|
||||
&Constant::String(_) => {
|
||||
let is_initial_index = self.lists.is_empty();
|
||||
self.lists.push(Self::add_index(is_initial_index, index));
|
||||
}
|
||||
&Constant::Usize(n) => {
|
||||
let code = self.constants
|
||||
.entry(Constant::Integer(Rc::new(Integer::from(n))))
|
||||
.or_insert(vec![]);
|
||||
|
||||
code.push(Self::add_index(code.is_empty(), index));
|
||||
|
||||
if let Ok(n) = isize::try_from(n) {
|
||||
let code = self.constants
|
||||
.entry(Constant::Fixnum(n))
|
||||
.or_insert(vec![]);
|
||||
|
||||
code.push(Self::add_index(code.is_empty(), index));
|
||||
}
|
||||
}
|
||||
_ => {
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub fn index_term(&mut self, first_arg: &Term, index: usize) {
|
||||
match first_arg {
|
||||
&Term::Clause(_, ref name, ref terms, _) => {
|
||||
@@ -65,21 +162,12 @@ impl CodeOffsets {
|
||||
let is_initial_index = self.lists.is_empty();
|
||||
self.lists.push(Self::add_index(is_initial_index, index));
|
||||
}
|
||||
&Term::Constant(_, Constant::String(ref s))
|
||||
if !self.flags.double_quotes.is_atom() && !s.is_empty() =>
|
||||
{
|
||||
// strings are lists in this case.
|
||||
let is_initial_index = self.lists.is_empty();
|
||||
self.lists.push(Self::add_index(is_initial_index, index));
|
||||
}
|
||||
&Term::Constant(_, Constant::String(ref s))
|
||||
if !self.flags.double_quotes.is_atom() && s.is_expandable() =>
|
||||
{
|
||||
let is_initial_index = self.lists.is_empty();
|
||||
self.lists.push(Self::add_index(is_initial_index, index));
|
||||
}
|
||||
&Term::Constant(_, ref constant) => {
|
||||
let code = self.constants.entry(constant.clone()).or_insert(Vec::new());
|
||||
self.intercept_overlapping_constant(constant, index);
|
||||
|
||||
let code = self.constants
|
||||
.entry(constant.clone())
|
||||
.or_insert(vec![]);
|
||||
|
||||
let is_initial_index = code.is_empty();
|
||||
code.push(Self::add_index(is_initial_index, index));
|
||||
@@ -232,12 +320,11 @@ impl CodeOffsets {
|
||||
fn switch_on_lst_offset_from(
|
||||
lst_loc: IntIndex,
|
||||
prelude_len: usize,
|
||||
lst_offset: usize,
|
||||
) -> usize {
|
||||
match lst_loc {
|
||||
IntIndex::External(o) => o + prelude_len + 1,
|
||||
IntIndex::Fail => 0,
|
||||
IntIndex::Internal(_) => prelude_len - lst_offset + 1,
|
||||
IntIndex::Internal(_) => 1, // this internal is always 0.
|
||||
}
|
||||
}
|
||||
|
||||
@@ -250,8 +337,6 @@ impl CodeOffsets {
|
||||
let mut prelude = VecDeque::new();
|
||||
|
||||
let lst_loc = Self::switch_on_list(self.lists, &mut prelude);
|
||||
let lst_offset = prelude.len();
|
||||
|
||||
let str_loc = Self::switch_on_structure(self.structures, &mut prelude);
|
||||
let con_loc = Self::switch_on_constant(self.constants, &mut prelude);
|
||||
|
||||
@@ -259,18 +344,19 @@ impl CodeOffsets {
|
||||
|
||||
for (index, line) in prelude.iter_mut().enumerate() {
|
||||
match line {
|
||||
&mut Line::IndexedChoice(IndexedChoiceInstruction::Try(ref mut i))
|
||||
| &mut Line::IndexedChoice(IndexedChoiceInstruction::Retry(ref mut i))
|
||||
| &mut Line::IndexedChoice(IndexedChoiceInstruction::Trust(ref mut i)) => {
|
||||
*i += prelude_length - index
|
||||
&mut Line::IndexedChoice(IndexedChoiceInstruction::Try(ref mut i)) |
|
||||
&mut Line::IndexedChoice(IndexedChoiceInstruction::Retry(ref mut i)) |
|
||||
&mut Line::IndexedChoice(IndexedChoiceInstruction::Trust(ref mut i)) => {
|
||||
*i += prelude_length - index;
|
||||
}
|
||||
_ => {
|
||||
}
|
||||
_ => {}
|
||||
}
|
||||
}
|
||||
|
||||
let str_loc = Self::switch_on_str_offset_from(str_loc, prelude.len(), con_loc);
|
||||
let con_loc = Self::switch_on_con_offset_from(con_loc, prelude.len());
|
||||
let lst_loc = Self::switch_on_lst_offset_from(lst_loc, prelude.len(), lst_offset);
|
||||
let lst_loc = Self::switch_on_lst_offset_from(lst_loc, prelude.len());
|
||||
|
||||
let switch_instr =
|
||||
IndexingInstruction::SwitchOnTerm(prelude.len() + 1, con_loc, lst_loc, str_loc);
|
||||
|
||||
@@ -2,28 +2,29 @@ use prolog_parser::ast::*;
|
||||
|
||||
use crate::prolog::clause_types::*;
|
||||
use crate::prolog::forms::*;
|
||||
use crate::prolog::machine::heap::*;
|
||||
use crate::prolog::machine::machine_errors::MachineStub;
|
||||
use crate::prolog::machine::machine_indices::*;
|
||||
|
||||
use crate::prolog::rug::Integer;
|
||||
|
||||
use indexmap::IndexMap;
|
||||
|
||||
use std::collections::VecDeque;
|
||||
use std::rc::Rc;
|
||||
|
||||
fn reg_type_into_functor(r: RegType) -> MachineStub {
|
||||
match r {
|
||||
RegType::Temp(r) => functor!("x", 1, [heap_integer!(Integer::from(r))]),
|
||||
RegType::Perm(r) => functor!("y", 1, [heap_integer!(Integer::from(r))]),
|
||||
RegType::Temp(r) => functor!("x", [integer(r)]),
|
||||
RegType::Perm(r) => functor!("y", [integer(r)]),
|
||||
}
|
||||
}
|
||||
|
||||
impl Level {
|
||||
fn into_functor(self) -> MachineStub {
|
||||
match self {
|
||||
Level::Root => functor!("level", 1, [heap_atom!("root")]),
|
||||
Level::Shallow => functor!("level", 1, [heap_atom!("shallow")]),
|
||||
Level::Deep => functor!("level", 1, [heap_atom!("deep")]),
|
||||
Level::Root => functor!("level", [atom("root")]),
|
||||
Level::Shallow => functor!("level", [atom("shallow")]),
|
||||
Level::Deep => functor!("level", [atom("deep")]),
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -31,15 +32,20 @@ impl Level {
|
||||
impl ArithmeticTerm {
|
||||
fn into_functor(&self) -> MachineStub {
|
||||
match self {
|
||||
&ArithmeticTerm::Reg(r) => reg_type_into_functor(r),
|
||||
&ArithmeticTerm::Interm(i) => {
|
||||
functor!("intermediate", 1, [heap_integer!(Integer::from(i))])
|
||||
&ArithmeticTerm::Reg(r) => {
|
||||
reg_type_into_functor(r)
|
||||
}
|
||||
&ArithmeticTerm::Interm(i) => {
|
||||
functor!("intermediate", [integer(i)])
|
||||
}
|
||||
&ArithmeticTerm::Number(ref n) => {
|
||||
vec![n.clone().into()]
|
||||
}
|
||||
&ArithmeticTerm::Number(ref n) => vec![heap_con!(n.clone().to_constant())],
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub enum ChoiceInstruction {
|
||||
DefaultRetryMeElse(usize),
|
||||
DefaultTrustMe,
|
||||
@@ -52,22 +58,25 @@ impl ChoiceInstruction {
|
||||
pub fn to_functor(&self) -> MachineStub {
|
||||
match self {
|
||||
&ChoiceInstruction::TryMeElse(offset) => {
|
||||
functor!("try_me_else", 1, [heap_integer!(Integer::from(offset))])
|
||||
functor!("try_me_else", [integer(offset)])
|
||||
}
|
||||
&ChoiceInstruction::RetryMeElse(offset) => {
|
||||
functor!("retry_me_else", 1, [heap_integer!(Integer::from(offset))])
|
||||
functor!("retry_me_else", [integer(offset)])
|
||||
}
|
||||
&ChoiceInstruction::TrustMe => {
|
||||
functor!("trust_me")
|
||||
}
|
||||
&ChoiceInstruction::DefaultRetryMeElse(offset) => {
|
||||
functor!("default_retry_me_else", [integer(offset)])
|
||||
}
|
||||
&ChoiceInstruction::DefaultTrustMe => {
|
||||
functor!("default_trust_me")
|
||||
}
|
||||
&ChoiceInstruction::TrustMe => vec![heap_atom!("trust_me")],
|
||||
&ChoiceInstruction::DefaultRetryMeElse(offset) => functor!(
|
||||
"default_retry_me_else",
|
||||
1,
|
||||
[heap_integer!(Integer::from(offset))]
|
||||
),
|
||||
&ChoiceInstruction::DefaultTrustMe => vec![heap_atom!("default_trust_me")],
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub enum CutInstruction {
|
||||
Cut(RegType),
|
||||
GetLevel(RegType),
|
||||
@@ -79,25 +88,25 @@ impl CutInstruction {
|
||||
pub fn to_functor(&self, h: usize) -> MachineStub {
|
||||
match self {
|
||||
&CutInstruction::Cut(r) => {
|
||||
let mut stub = functor!("cut", 1, [heap_str!(h + 2)]);
|
||||
stub.append(&mut reg_type_into_functor(r));
|
||||
stub
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
functor!("cut", [aux(h, 0)], [rt_stub])
|
||||
}
|
||||
&CutInstruction::GetLevel(r) => {
|
||||
let mut stub = functor!("get_level", 1, [heap_str!(h + 2)]);
|
||||
stub.append(&mut reg_type_into_functor(r));
|
||||
stub
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
functor!("get_level", [aux(h, 0)], [rt_stub])
|
||||
}
|
||||
&CutInstruction::GetLevelAndUnify(r) => {
|
||||
let mut stub = functor!("get_level_and_unify", 1, [heap_str!(h + 2)]);
|
||||
stub.append(&mut reg_type_into_functor(r));
|
||||
stub
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
functor!("get_level_and_unify", [aux(h, 0)], [rt_stub])
|
||||
}
|
||||
&CutInstruction::NeckCut => {
|
||||
functor!("neck_cut")
|
||||
}
|
||||
&CutInstruction::NeckCut => vec![heap_atom!("neck_cut")],
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub enum IndexedChoiceInstruction {
|
||||
Retry(usize),
|
||||
Trust(usize),
|
||||
@@ -122,18 +131,19 @@ impl IndexedChoiceInstruction {
|
||||
pub fn to_functor(&self) -> MachineStub {
|
||||
match self {
|
||||
&IndexedChoiceInstruction::Try(offset) => {
|
||||
functor!("try", 1, [heap_integer!(Integer::from(offset))])
|
||||
functor!("try", [integer(offset)])
|
||||
}
|
||||
&IndexedChoiceInstruction::Trust(offset) => {
|
||||
functor!("trust", 1, [heap_integer!(Integer::from(offset))])
|
||||
functor!("trust", [integer(offset)])
|
||||
}
|
||||
&IndexedChoiceInstruction::Retry(offset) => {
|
||||
functor!("retry", 1, [heap_integer!(Integer::from(offset))])
|
||||
functor!("retry", [integer(offset)])
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub enum Line {
|
||||
Arithmetic(ArithmeticInstruction),
|
||||
Choice(ChoiceInstruction),
|
||||
@@ -169,7 +179,7 @@ impl Line {
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Clone)]
|
||||
#[derive(Debug, Clone)]
|
||||
pub enum ArithmeticInstruction {
|
||||
Add(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
Sub(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
@@ -189,6 +199,8 @@ pub enum ArithmeticInstruction {
|
||||
Or(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
Mod(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
Rem(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
Gcd(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
Sign(ArithmeticTerm, usize),
|
||||
Cos(ArithmeticTerm, usize),
|
||||
Sin(ArithmeticTerm, usize),
|
||||
Tan(ArithmeticTerm, usize),
|
||||
@@ -218,14 +230,11 @@ fn arith_instr_unary_functor(
|
||||
) -> MachineStub {
|
||||
let at_stub = at.into_functor();
|
||||
|
||||
let mut stub = functor!(
|
||||
functor!(
|
||||
name,
|
||||
2,
|
||||
[heap_cell!(h + 4), heap_integer!(Integer::from(t))]
|
||||
);
|
||||
|
||||
stub.extend(at_stub.into_iter());
|
||||
stub
|
||||
[aux(h, 0), integer(t)],
|
||||
[at_stub]
|
||||
)
|
||||
}
|
||||
|
||||
fn arith_instr_bin_functor(
|
||||
@@ -238,20 +247,11 @@ fn arith_instr_bin_functor(
|
||||
let at_1_stub = at_1.into_functor();
|
||||
let at_2_stub = at_2.into_functor();
|
||||
|
||||
let mut stub = functor!(
|
||||
functor!(
|
||||
name,
|
||||
3,
|
||||
[
|
||||
heap_cell!(h + 4),
|
||||
heap_cell!(h + 4 + at_1_stub.len()),
|
||||
heap_integer!(Integer::from(t))
|
||||
]
|
||||
);
|
||||
|
||||
stub.extend(at_1_stub.into_iter());
|
||||
stub.extend(at_2_stub.into_iter());
|
||||
|
||||
stub
|
||||
[aux(h, 0), aux(h, 1), integer(t)],
|
||||
[at_1_stub, at_2_stub]
|
||||
)
|
||||
}
|
||||
|
||||
impl ArithmeticInstruction {
|
||||
@@ -314,16 +314,42 @@ impl ArithmeticInstruction {
|
||||
&ArithmeticInstruction::ATan2(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "rem", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::Cos(ref at, t) => arith_instr_unary_functor(h, "cos", at, t),
|
||||
&ArithmeticInstruction::Sin(ref at, t) => arith_instr_unary_functor(h, "sin", at, t),
|
||||
&ArithmeticInstruction::Tan(ref at, t) => arith_instr_unary_functor(h, "tan", at, t),
|
||||
&ArithmeticInstruction::Log(ref at, t) => arith_instr_unary_functor(h, "log", at, t),
|
||||
&ArithmeticInstruction::Exp(ref at, t) => arith_instr_unary_functor(h, "exp", at, t),
|
||||
&ArithmeticInstruction::ACos(ref at, t) => arith_instr_unary_functor(h, "acos", at, t),
|
||||
&ArithmeticInstruction::ASin(ref at, t) => arith_instr_unary_functor(h, "asin", at, t),
|
||||
&ArithmeticInstruction::ATan(ref at, t) => arith_instr_unary_functor(h, "atan", at, t),
|
||||
&ArithmeticInstruction::Sqrt(ref at, t) => arith_instr_unary_functor(h, "sqrt", at, t),
|
||||
&ArithmeticInstruction::Abs(ref at, t) => arith_instr_unary_functor(h, "abs", at, t),
|
||||
&ArithmeticInstruction::Gcd(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "gcd", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::Sign(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "sign", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Cos(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "cos", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Sin(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "sin", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Tan(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "tan", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Log(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "log", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Exp(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "exp", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::ACos(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "acos", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::ASin(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "asin", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::ATan(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "atan", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Sqrt(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "sqrt", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Abs(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "abs", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Float(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "float", at, t)
|
||||
}
|
||||
@@ -339,8 +365,12 @@ impl ArithmeticInstruction {
|
||||
&ArithmeticInstruction::Floor(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "floor", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Neg(ref at, t) => arith_instr_unary_functor(h, "-", at, t),
|
||||
&ArithmeticInstruction::Plus(ref at, t) => arith_instr_unary_functor(h, "+", at, t),
|
||||
&ArithmeticInstruction::Neg(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "-", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Plus(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "+", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::BitwiseComplement(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "\\", at, t)
|
||||
}
|
||||
@@ -348,6 +378,7 @@ impl ArithmeticInstruction {
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub enum ControlInstruction {
|
||||
Allocate(usize), // num_frames.
|
||||
// name, arity, perm_vars after threshold, last call, use default call policy.
|
||||
@@ -358,44 +389,42 @@ pub enum ControlInstruction {
|
||||
}
|
||||
|
||||
impl ControlInstruction {
|
||||
pub fn is_jump_instr(&self) -> bool {
|
||||
pub fn perm_vars(&self) -> Option<usize> {
|
||||
match self {
|
||||
&ControlInstruction::CallClause(..) => true,
|
||||
&ControlInstruction::JmpBy(..) => true,
|
||||
_ => false,
|
||||
ControlInstruction::CallClause(_, _, num_cells, ..) =>
|
||||
Some(*num_cells),
|
||||
ControlInstruction::JmpBy(_, _, num_cells, ..) =>
|
||||
Some(*num_cells),
|
||||
_ =>
|
||||
None
|
||||
}
|
||||
}
|
||||
|
||||
pub fn to_functor(&self) -> MachineStub {
|
||||
match self {
|
||||
&ControlInstruction::Allocate(num_frames) => {
|
||||
functor!("allocate", 1, [heap_integer!(Integer::from(num_frames))])
|
||||
functor!("allocate", [integer(num_frames)])
|
||||
}
|
||||
&ControlInstruction::CallClause(ref ct, arity, _, false, _) => {
|
||||
functor!("call", [clause_name(ct.name()), integer(arity)])
|
||||
}
|
||||
&ControlInstruction::CallClause(ref ct, arity, _, true, _) => {
|
||||
functor!("execute", [clause_name(ct.name()), integer(arity)])
|
||||
}
|
||||
&ControlInstruction::Deallocate => {
|
||||
functor!("deallocate")
|
||||
}
|
||||
&ControlInstruction::CallClause(ref ct, arity, _, false, _) => functor!(
|
||||
"call",
|
||||
2,
|
||||
[
|
||||
heap_con!(Constant::Atom(ct.name(), None)),
|
||||
heap_integer!(Integer::from(arity))
|
||||
]
|
||||
),
|
||||
&ControlInstruction::CallClause(ref ct, arity, _, true, _) => functor!(
|
||||
"execute",
|
||||
2,
|
||||
[
|
||||
heap_con!(Constant::Atom(ct.name(), None)),
|
||||
heap_integer!(Integer::from(arity))
|
||||
]
|
||||
),
|
||||
&ControlInstruction::Deallocate => vec![heap_atom!("deallocate")],
|
||||
&ControlInstruction::JmpBy(_, offset, ..) => {
|
||||
functor!("jmp_by", 1, [heap_integer!(Integer::from(offset))])
|
||||
functor!("jmp_by", [integer(offset)])
|
||||
}
|
||||
&ControlInstruction::Proceed => {
|
||||
functor!("proceed")
|
||||
}
|
||||
&ControlInstruction::Proceed => vec![heap_atom!("proceed")],
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub enum IndexingInstruction {
|
||||
SwitchOnTerm(usize, usize, usize, usize),
|
||||
SwitchOnConstant(usize, IndexMap<Constant, usize>),
|
||||
@@ -411,34 +440,36 @@ impl From<IndexingInstruction> for Line {
|
||||
impl IndexingInstruction {
|
||||
pub fn to_functor(&self) -> MachineStub {
|
||||
match self {
|
||||
&IndexingInstruction::SwitchOnTerm(vars, constants, lists, structures) => functor!(
|
||||
"switch_on_term",
|
||||
4,
|
||||
[
|
||||
heap_integer!(Integer::from(vars)),
|
||||
heap_integer!(Integer::from(constants)),
|
||||
heap_integer!(Integer::from(lists)),
|
||||
heap_integer!(Integer::from(structures))
|
||||
]
|
||||
),
|
||||
&IndexingInstruction::SwitchOnConstant(constants, _) => functor!(
|
||||
"switch_on_constant",
|
||||
1,
|
||||
[heap_integer!(Integer::from(constants))]
|
||||
),
|
||||
&IndexingInstruction::SwitchOnStructure(structures, _) => functor!(
|
||||
"switch_on_structure",
|
||||
1,
|
||||
[heap_integer!(Integer::from(structures))]
|
||||
),
|
||||
&IndexingInstruction::SwitchOnTerm(vars, constants, lists, structures) => {
|
||||
functor!(
|
||||
"switch_on_term",
|
||||
[integer(vars),
|
||||
integer(constants),
|
||||
integer(lists),
|
||||
integer(structures)]
|
||||
)
|
||||
}
|
||||
&IndexingInstruction::SwitchOnConstant(constants, _) => {
|
||||
functor!(
|
||||
"switch_on_constant",
|
||||
[integer(constants)]
|
||||
)
|
||||
}
|
||||
&IndexingInstruction::SwitchOnStructure(structures, _) => {
|
||||
functor!(
|
||||
"switch_on_structure",
|
||||
[integer(structures)]
|
||||
)
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Clone)]
|
||||
#[derive(Debug, Clone)]
|
||||
pub enum FactInstruction {
|
||||
GetConstant(Level, Constant, RegType),
|
||||
GetList(Level, RegType),
|
||||
GetPartialString(Level, String, RegType, bool),
|
||||
GetStructure(ClauseType, usize, RegType),
|
||||
GetValue(RegType, usize),
|
||||
GetVariable(RegType, usize),
|
||||
@@ -452,96 +483,106 @@ pub enum FactInstruction {
|
||||
impl FactInstruction {
|
||||
pub fn to_functor(&self, h: usize) -> MachineStub {
|
||||
match self {
|
||||
&FactInstruction::GetConstant(lvl, ref constant, r) => {
|
||||
let mut stub = functor!(
|
||||
&FactInstruction::GetConstant(lvl, ref c, r) => {
|
||||
let lvl_stub = lvl.into_functor();
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"get_constant",
|
||||
3,
|
||||
[
|
||||
heap_str!(h + 4),
|
||||
heap_con!(constant.clone()),
|
||||
heap_str!(h + 6)
|
||||
]
|
||||
);
|
||||
|
||||
stub.append(&mut lvl.into_functor());
|
||||
stub.append(&mut reg_type_into_functor(r));
|
||||
|
||||
stub
|
||||
[aux(h, 0), constant(h, c), aux(h, 1)],
|
||||
[lvl_stub, rt_stub]
|
||||
)
|
||||
}
|
||||
&FactInstruction::GetList(lvl, r) => {
|
||||
let mut stub = functor!("get_list", 2, [heap_str!(h + 3), heap_str!(h + 5)]);
|
||||
stub.append(&mut lvl.into_functor());
|
||||
stub.append(&mut reg_type_into_functor(r));
|
||||
let lvl_stub = lvl.into_functor();
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
stub
|
||||
functor!(
|
||||
"get_list",
|
||||
[aux(h, 0), aux(h, 1)],
|
||||
[lvl_stub, rt_stub]
|
||||
)
|
||||
}
|
||||
&FactInstruction::GetPartialString(lvl, ref s, r, has_tail) => {
|
||||
let lvl_stub = lvl.into_functor();
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"get_partial_string",
|
||||
[aux(h, 0), string(h, s), aux(h, 1), boolean(has_tail)],
|
||||
[lvl_stub, rt_stub]
|
||||
)
|
||||
}
|
||||
&FactInstruction::GetStructure(ref ct, arity, r) => {
|
||||
let mut stub = functor!(
|
||||
"get_structure",
|
||||
3,
|
||||
[
|
||||
heap_con!(Constant::Atom(ct.name(), None)),
|
||||
heap_integer!(Integer::from(arity)),
|
||||
heap_str!(h + 4)
|
||||
]
|
||||
);
|
||||
stub.append(&mut reg_type_into_functor(r));
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
stub
|
||||
functor!(
|
||||
"get_structure",
|
||||
[clause_name(ct.name()), integer(arity), aux(h, 0)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&FactInstruction::GetValue(r, arg) => {
|
||||
let mut stub = functor!(
|
||||
"get_value",
|
||||
2,
|
||||
[heap_str!(h + 3), heap_integer!(Integer::from(arg))]
|
||||
);
|
||||
stub.append(&mut reg_type_into_functor(r));
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
stub
|
||||
functor!(
|
||||
"get_value",
|
||||
[aux(h, 0), integer(arg)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&FactInstruction::GetVariable(r, arg) => {
|
||||
let mut stub = functor!(
|
||||
"get_variable",
|
||||
2,
|
||||
[heap_str!(h + 3), heap_integer!(Integer::from(arg))]
|
||||
);
|
||||
stub.append(&mut reg_type_into_functor(r));
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
stub
|
||||
functor!(
|
||||
"get_variable",
|
||||
[aux(h, 0), integer(arg)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&FactInstruction::UnifyConstant(ref constant) => {
|
||||
functor!("unify_constant", 1, [heap_con!(constant.clone())])
|
||||
&FactInstruction::UnifyConstant(ref c) => {
|
||||
functor!("unify_constant", [constant(h, c)], [])
|
||||
}
|
||||
&FactInstruction::UnifyLocalValue(r) => {
|
||||
let mut stub = functor!("unify_local_value", 1, [heap_str!(h + 2)]);
|
||||
stub.append(&mut reg_type_into_functor(r));
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
stub
|
||||
functor!(
|
||||
"unify_local_value",
|
||||
[aux(h, 0)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&FactInstruction::UnifyVariable(r) => {
|
||||
let mut stub = functor!("unify_variable", 1, [heap_str!(h + 2)]);
|
||||
stub.append(&mut reg_type_into_functor(r));
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
stub
|
||||
functor!(
|
||||
"unify_variable",
|
||||
[aux(h, 0)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&FactInstruction::UnifyValue(r) => {
|
||||
let mut stub = functor!("unify_value", 1, [heap_str!(h + 2)]);
|
||||
stub.append(&mut reg_type_into_functor(r));
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
stub
|
||||
functor!(
|
||||
"unify_value",
|
||||
[aux(h, 0)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&FactInstruction::UnifyVoid(vars) => {
|
||||
functor!("unify_void", 1, [heap_integer!(Integer::from(vars))])
|
||||
functor!("unify_void", [integer(vars)])
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Clone)]
|
||||
#[derive(Debug, Clone)]
|
||||
pub enum QueryInstruction {
|
||||
GetVariable(RegType, usize),
|
||||
PutConstant(Level, Constant, RegType),
|
||||
PutList(Level, RegType),
|
||||
PutPartialString(Level, String, RegType, bool),
|
||||
PutStructure(ClauseType, usize, RegType),
|
||||
PutUnsafeValue(usize, usize),
|
||||
PutValue(RegType, usize),
|
||||
@@ -558,103 +599,106 @@ impl QueryInstruction {
|
||||
match self {
|
||||
&QueryInstruction::PutUnsafeValue(norm, arg) => functor!(
|
||||
"put_unsafe_value",
|
||||
2,
|
||||
[
|
||||
heap_integer!(Integer::from(norm)),
|
||||
heap_integer!(Integer::from(arg))
|
||||
]
|
||||
[integer(norm), integer(arg)]
|
||||
),
|
||||
&QueryInstruction::PutConstant(lvl, ref constant, r) => {
|
||||
let mut stub = functor!(
|
||||
&QueryInstruction::PutConstant(lvl, ref c, r) => {
|
||||
let lvl_stub = lvl.into_functor();
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"put_constant",
|
||||
3,
|
||||
[
|
||||
heap_str!(h + 4),
|
||||
heap_con!(constant.clone()),
|
||||
heap_str!(h + 6)
|
||||
]
|
||||
);
|
||||
|
||||
stub.append(&mut lvl.into_functor());
|
||||
stub.append(&mut reg_type_into_functor(r));
|
||||
|
||||
stub
|
||||
[aux(h, 0), constant(h, c), aux(h, 1)],
|
||||
[lvl_stub, rt_stub]
|
||||
)
|
||||
}
|
||||
&QueryInstruction::PutList(lvl, r) => {
|
||||
let mut stub = functor!("put_list", 2, [heap_str!(h + 3), heap_str!(h + 5)]);
|
||||
let lvl_stub = lvl.into_functor();
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
stub.append(&mut lvl.into_functor());
|
||||
stub.append(&mut reg_type_into_functor(r));
|
||||
functor!(
|
||||
"put_list",
|
||||
[aux(h, 0), aux(h, 1)],
|
||||
[lvl_stub, rt_stub]
|
||||
)
|
||||
}
|
||||
&QueryInstruction::PutPartialString(lvl, ref s, r, has_tail) => {
|
||||
let lvl_stub = lvl.into_functor();
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
stub
|
||||
functor!(
|
||||
"put_partial_string",
|
||||
[aux(h, 0), string(h, s), aux(h, 1), boolean(has_tail)],
|
||||
[lvl_stub, rt_stub]
|
||||
)
|
||||
}
|
||||
&QueryInstruction::PutStructure(ref ct, arity, r) => {
|
||||
let mut stub = functor!(
|
||||
"put_structure",
|
||||
3,
|
||||
[
|
||||
heap_con!(Constant::Atom(ct.name(), None)),
|
||||
heap_integer!(Integer::from(arity)),
|
||||
heap_str!(h + 4)
|
||||
]
|
||||
);
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
stub.append(&mut reg_type_into_functor(r));
|
||||
stub
|
||||
functor!(
|
||||
"put_structure",
|
||||
[clause_name(ct.name()), integer(arity), aux(h, 0)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&QueryInstruction::PutValue(r, arg) => {
|
||||
let mut stub = functor!(
|
||||
"put_value",
|
||||
2,
|
||||
[heap_str!(h + 3), heap_integer!(Integer::from(arg))]
|
||||
);
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
stub.append(&mut reg_type_into_functor(r));
|
||||
stub
|
||||
functor!(
|
||||
"put_value",
|
||||
[aux(h, 0), integer(arg)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&QueryInstruction::GetVariable(r, arg) => {
|
||||
let mut stub = functor!(
|
||||
"get_variable",
|
||||
2,
|
||||
[heap_str!(h + 3), heap_integer!(Integer::from(arg))]
|
||||
);
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
stub.append(&mut reg_type_into_functor(r));
|
||||
stub
|
||||
functor!(
|
||||
"get_variable",
|
||||
[aux(h, 0), integer(arg)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&QueryInstruction::PutVariable(r, arg) => {
|
||||
let mut stub = functor!(
|
||||
"put_variable",
|
||||
2,
|
||||
[heap_str!(h + 3), heap_integer!(Integer::from(arg))]
|
||||
);
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
stub.append(&mut reg_type_into_functor(r));
|
||||
stub
|
||||
functor!(
|
||||
"put_variable",
|
||||
[aux(h, 0), integer(arg)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&QueryInstruction::SetConstant(ref constant) => {
|
||||
functor!("set_constant", 1, [heap_con!(constant.clone())])
|
||||
&QueryInstruction::SetConstant(ref c) => {
|
||||
functor!("set_constant", [constant(h, c)], [])
|
||||
}
|
||||
&QueryInstruction::SetLocalValue(r) => {
|
||||
let mut stub = functor!("set_local_value", 1, [heap_str!(h + 2)]);
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
stub.append(&mut reg_type_into_functor(r));
|
||||
stub
|
||||
functor!(
|
||||
"set_local_value",
|
||||
[aux(h, 0)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&QueryInstruction::SetVariable(r) => {
|
||||
let mut stub = functor!("set_variable", 1, [heap_str!(h + 2)]);
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
stub.append(&mut reg_type_into_functor(r));
|
||||
stub
|
||||
functor!(
|
||||
"set_variable",
|
||||
[aux(h, 0)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&QueryInstruction::SetValue(r) => {
|
||||
let mut stub = functor!("set_value", 1, [heap_str!(h + 2)]);
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
stub.append(&mut reg_type_into_functor(r));
|
||||
stub
|
||||
functor!(
|
||||
"set_value",
|
||||
[aux(h, 0)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&QueryInstruction::SetVoid(vars) => {
|
||||
functor!("set_void", 1, [heap_integer!(Integer::from(vars))])
|
||||
functor!("set_void", [integer(vars)])
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -6,16 +6,18 @@ use crate::prolog::machine::machine_indices::*;
|
||||
|
||||
use std::cell::Cell;
|
||||
use std::collections::VecDeque;
|
||||
use std::fmt;
|
||||
use std::iter::*;
|
||||
use std::rc::Rc;
|
||||
use std::vec::Vec;
|
||||
|
||||
#[derive(Clone)]
|
||||
#[derive(Debug, Clone)]
|
||||
pub enum TermRef<'a> {
|
||||
AnonVar(Level),
|
||||
Cons(Level, &'a Cell<RegType>, &'a Term, &'a Term),
|
||||
Constant(Level, &'a Cell<RegType>, &'a Constant),
|
||||
Clause(Level, &'a Cell<RegType>, ClauseType, &'a Vec<Box<Term>>),
|
||||
PartialString(Level, &'a Cell<RegType>, String, Option<&'a Term>),
|
||||
Var(Level, &'a Cell<VarReg>, Rc<Var>),
|
||||
}
|
||||
|
||||
@@ -27,10 +29,12 @@ impl<'a> TermRef<'a> {
|
||||
| TermRef::Constant(lvl, ..)
|
||||
| TermRef::Var(lvl, ..)
|
||||
| TermRef::Clause(lvl, ..) => lvl,
|
||||
| TermRef::PartialString(lvl, ..) => lvl,
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub enum TermIterState<'a> {
|
||||
AnonVar(Level),
|
||||
Constant(Level, &'a Cell<RegType>, &'a Constant),
|
||||
@@ -43,13 +47,67 @@ pub enum TermIterState<'a> {
|
||||
),
|
||||
InitialCons(Level, &'a Cell<RegType>, &'a Term, &'a Term),
|
||||
FinalCons(Level, &'a Cell<RegType>, &'a Term, &'a Term),
|
||||
PartialString(Level, &'a Cell<RegType>, String, Option<&'a Term>),
|
||||
Var(Level, &'a Cell<VarReg>, Rc<Var>),
|
||||
}
|
||||
|
||||
fn is_partial_string<'a>(
|
||||
head: &'a Term,
|
||||
mut tail: &'a Term,
|
||||
) -> Option<(String, Option<&'a Term>)>
|
||||
{
|
||||
let mut string =
|
||||
match head {
|
||||
&Term::Constant(_, Constant::Atom(ref atom, _)) if atom.is_char() => {
|
||||
atom.as_str().chars().next().unwrap().to_string()
|
||||
}
|
||||
&Term::Constant(_, Constant::Char(c)) => {
|
||||
c.to_string()
|
||||
}
|
||||
_ => {
|
||||
return None;
|
||||
}
|
||||
};
|
||||
|
||||
while let Term::Cons(_, ref head, ref succ) = tail {
|
||||
match head.as_ref() {
|
||||
&Term::Constant(_, Constant::Atom(ref atom, _)) if atom.is_char() => {
|
||||
string.push(atom.as_str().chars().next().unwrap());
|
||||
}
|
||||
&Term::Constant(_, Constant::Char(c)) => {
|
||||
string.push(c);
|
||||
}
|
||||
_ => {
|
||||
return None;
|
||||
}
|
||||
};
|
||||
|
||||
tail = succ.as_ref();
|
||||
}
|
||||
|
||||
match tail {
|
||||
Term::AnonVar | Term::Var(..) => {
|
||||
return Some((string, Some(tail)));
|
||||
}
|
||||
Term::Constant(_, Constant::EmptyList) => {
|
||||
return Some((string, None));
|
||||
}
|
||||
Term::Constant(_, Constant::String(tail)) => {
|
||||
string += &tail;
|
||||
return Some((string, None));
|
||||
}
|
||||
_ => {
|
||||
return None;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> TermIterState<'a> {
|
||||
pub fn subterm_to_state(lvl: Level, term: &'a Term) -> TermIterState<'a> {
|
||||
match term {
|
||||
&Term::AnonVar => TermIterState::AnonVar(lvl),
|
||||
&Term::AnonVar => {
|
||||
TermIterState::AnonVar(lvl)
|
||||
}
|
||||
&Term::Clause(ref cell, ref name, ref subterms, ref spec) => {
|
||||
let ct = if let Some(spec) = spec {
|
||||
ClauseType::Op(name.clone(), spec.clone(), CodeIndex::default())
|
||||
@@ -62,12 +120,17 @@ impl<'a> TermIterState<'a> {
|
||||
&Term::Cons(ref cell, ref head, ref tail) => {
|
||||
TermIterState::InitialCons(lvl, cell, head.as_ref(), tail.as_ref())
|
||||
}
|
||||
&Term::Constant(ref cell, ref constant) => TermIterState::Constant(lvl, cell, constant),
|
||||
&Term::Var(ref cell, ref var) => TermIterState::Var(lvl, cell, var.clone()),
|
||||
&Term::Constant(ref cell, ref constant) => {
|
||||
TermIterState::Constant(lvl, cell, constant)
|
||||
}
|
||||
&Term::Var(ref cell, ref var) => {
|
||||
TermIterState::Var(lvl, cell, var.clone())
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub struct QueryIterator<'a> {
|
||||
state_stack: Vec<TermIterState<'a>>,
|
||||
}
|
||||
@@ -169,7 +232,9 @@ impl<'a> Iterator for QueryIterator<'a> {
|
||||
fn next(&mut self) -> Option<Self::Item> {
|
||||
while let Some(iter_state) = self.state_stack.pop() {
|
||||
match iter_state {
|
||||
TermIterState::AnonVar(lvl) => return Some(TermRef::AnonVar(lvl)),
|
||||
TermIterState::AnonVar(lvl) => {
|
||||
return Some(TermRef::AnonVar(lvl));
|
||||
}
|
||||
TermIterState::Clause(lvl, child_num, cell, ct, child_terms) => {
|
||||
if child_num == child_terms.len() {
|
||||
match ct {
|
||||
@@ -182,7 +247,9 @@ impl<'a> Iterator for QueryIterator<'a> {
|
||||
lvl => Some(TermRef::Clause(lvl, cell, ct, child_terms)),
|
||||
}
|
||||
}
|
||||
_ => return None,
|
||||
_ => {
|
||||
return None;
|
||||
}
|
||||
};
|
||||
} else {
|
||||
self.state_stack.push(TermIterState::Clause(
|
||||
@@ -192,23 +259,41 @@ impl<'a> Iterator for QueryIterator<'a> {
|
||||
ct,
|
||||
child_terms,
|
||||
));
|
||||
|
||||
self.push_subterm(lvl.child_level(), child_terms[child_num].as_ref());
|
||||
}
|
||||
}
|
||||
TermIterState::InitialCons(lvl, cell, head, tail) => {
|
||||
self.state_stack
|
||||
.push(TermIterState::FinalCons(lvl, cell, head, tail));
|
||||
if let Some((string, tail)) = is_partial_string(head, tail) {
|
||||
self.state_stack.push(TermIterState::PartialString(
|
||||
lvl,
|
||||
cell,
|
||||
string,
|
||||
tail,
|
||||
));
|
||||
|
||||
self.push_subterm(lvl.child_level(), tail);
|
||||
self.push_subterm(lvl.child_level(), head);
|
||||
if let Some(tail) = tail {
|
||||
self.push_subterm(lvl.child_level(), tail);
|
||||
}
|
||||
} else {
|
||||
self.state_stack.push(TermIterState::FinalCons(lvl, cell, head, tail));
|
||||
|
||||
self.push_subterm(lvl.child_level(), tail);
|
||||
self.push_subterm(lvl.child_level(), head);
|
||||
}
|
||||
}
|
||||
TermIterState::PartialString(lvl, cell, string, tail) => {
|
||||
return Some(TermRef::PartialString(lvl, cell, string, tail));
|
||||
}
|
||||
TermIterState::FinalCons(lvl, cell, head, tail) => {
|
||||
return Some(TermRef::Cons(lvl, cell, head, tail))
|
||||
return Some(TermRef::Cons(lvl, cell, head, tail));
|
||||
}
|
||||
TermIterState::Constant(lvl, cell, constant) => {
|
||||
return Some(TermRef::Constant(lvl, cell, constant))
|
||||
return Some(TermRef::Constant(lvl, cell, constant));
|
||||
}
|
||||
TermIterState::Var(lvl, cell, var) => {
|
||||
return Some(TermRef::Var(lvl, cell, var));
|
||||
}
|
||||
TermIterState::Var(lvl, cell, var) => return Some(TermRef::Var(lvl, cell, var)),
|
||||
};
|
||||
}
|
||||
|
||||
@@ -216,6 +301,7 @@ impl<'a> Iterator for QueryIterator<'a> {
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub struct FactIterator<'a> {
|
||||
state_queue: VecDeque<TermIterState<'a>>,
|
||||
iterable_root: bool,
|
||||
@@ -223,8 +309,7 @@ pub struct FactIterator<'a> {
|
||||
|
||||
impl<'a> FactIterator<'a> {
|
||||
fn push_subterm(&mut self, lvl: Level, term: &'a Term) {
|
||||
self.state_queue
|
||||
.push_back(TermIterState::subterm_to_state(lvl, term));
|
||||
self.state_queue.push_back(TermIterState::subterm_to_state(lvl, term));
|
||||
}
|
||||
|
||||
pub fn from_rule_head_clause(terms: &'a Vec<Box<Term>>) -> Self {
|
||||
@@ -241,7 +326,9 @@ impl<'a> FactIterator<'a> {
|
||||
|
||||
fn new(term: &'a Term, iterable_root: bool) -> Self {
|
||||
let states = match term {
|
||||
&Term::AnonVar => vec![TermIterState::AnonVar(Level::Root)],
|
||||
&Term::AnonVar => {
|
||||
vec![TermIterState::AnonVar(Level::Root)]
|
||||
}
|
||||
&Term::Clause(ref cell, ref name, ref terms, ref fixity) => {
|
||||
let ct = ClauseType::from(name.clone(), terms.len(), fixity.clone());
|
||||
vec![TermIterState::Clause(Level::Root, 0, cell, ct, terms)]
|
||||
@@ -273,7 +360,9 @@ impl<'a> Iterator for FactIterator<'a> {
|
||||
fn next(&mut self) -> Option<Self::Item> {
|
||||
while let Some(state) = self.state_queue.pop_front() {
|
||||
match state {
|
||||
TermIterState::AnonVar(lvl) => return Some(TermRef::AnonVar(lvl)),
|
||||
TermIterState::AnonVar(lvl) => {
|
||||
return Some(TermRef::AnonVar(lvl));
|
||||
}
|
||||
TermIterState::Clause(lvl, _, cell, ct, child_terms) => {
|
||||
for child_term in child_terms {
|
||||
self.push_subterm(lvl.child_level(), child_term);
|
||||
@@ -285,16 +374,27 @@ impl<'a> Iterator for FactIterator<'a> {
|
||||
};
|
||||
}
|
||||
TermIterState::InitialCons(lvl, cell, head, tail) => {
|
||||
self.push_subterm(Level::Deep, head);
|
||||
self.push_subterm(Level::Deep, tail);
|
||||
if let Some((string, tail)) = is_partial_string(head, tail) {
|
||||
if let Some(tail) = tail {
|
||||
self.push_subterm(Level::Deep, tail);
|
||||
}
|
||||
|
||||
return Some(TermRef::Cons(lvl, cell, head, tail));
|
||||
return Some(TermRef::PartialString(lvl, cell, string, tail));
|
||||
} else {
|
||||
self.push_subterm(Level::Deep, head);
|
||||
self.push_subterm(Level::Deep, tail);
|
||||
|
||||
return Some(TermRef::Cons(lvl, cell, head, tail));
|
||||
}
|
||||
}
|
||||
TermIterState::Constant(lvl, cell, constant) => {
|
||||
return Some(TermRef::Constant(lvl, cell, constant))
|
||||
}
|
||||
TermIterState::Var(lvl, cell, var) => return Some(TermRef::Var(lvl, cell, var)),
|
||||
_ => {}
|
||||
TermIterState::Var(lvl, cell, var) => {
|
||||
return Some(TermRef::Var(lvl, cell, var));
|
||||
}
|
||||
_ => {
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -310,6 +410,7 @@ pub fn breadth_first_iter(term: &Term, iterable_root: bool) -> FactIterator {
|
||||
FactIterator::new(term, iterable_root)
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub enum ChunkedTerm<'a> {
|
||||
HeadClause(ClauseName, &'a Vec<Box<Term>>),
|
||||
BodyTerm(&'a QueryTerm),
|
||||
@@ -347,6 +448,18 @@ pub struct ChunkedIterator<'a> {
|
||||
cut_var_in_head: bool,
|
||||
}
|
||||
|
||||
impl<'a> fmt::Debug for ChunkedIterator<'a> {
|
||||
fn fmt(&self, fmt: &mut fmt::Formatter<'_>) -> fmt::Result {
|
||||
fmt.debug_struct("ChunkedIterator")
|
||||
.field("chunk_num", &self.chunk_num)
|
||||
// Hacky solution.
|
||||
.field("iter", &"Box<dyn Iterator<Item = ChunkedTerm<'a>> + 'a>")
|
||||
.field("deep_cut_encountered", &self.deep_cut_encountered)
|
||||
.field("cut_var_in_head", &self.cut_var_in_head)
|
||||
.finish()
|
||||
}
|
||||
}
|
||||
|
||||
type ChunkedIteratorItem<'a> = (usize, usize, Vec<ChunkedTerm<'a>>);
|
||||
type RuleBodyIteratorItem<'a> = (usize, usize, Vec<&'a QueryTerm>);
|
||||
|
||||
|
||||
123
src/prolog/lib/arithmetic.pl
Normal file
123
src/prolog/lib/arithmetic.pl
Normal file
@@ -0,0 +1,123 @@
|
||||
:- module(arithmetic, [expmod/4, lsb/2, msb/2, number_to_rational/2,
|
||||
number_to_rational/3,
|
||||
rational_numerator_denominator/3]).
|
||||
|
||||
:- use_module(library(charsio), [write_term_to_chars/3]).
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(lists), [append/3, member/2]).
|
||||
|
||||
expmod(Base, Expo, Mod, R) :-
|
||||
( member(N, [Base, Expo, Mod]), var(N) -> instantiation_error(expmod/4)
|
||||
; member(N, [Base, Expo, Mod]), \+ integer(N) ->
|
||||
type_error(integer, N, expmod/4)
|
||||
; Expo < 0 -> domain_error(not_less_than_zero, Expo, expmod/4)
|
||||
; expmod_(Base, Expo, Mod, 1, R)
|
||||
).
|
||||
|
||||
expmod_(_, _, 1, _, 0) :- !.
|
||||
expmod_(_, 0, _, R, R) :- !.
|
||||
expmod_(Base0, Expo0, Mod, C0, R) :-
|
||||
Expo0 /\ 1 =:= 1,
|
||||
C is (C0 * Base0) mod Mod,
|
||||
!,
|
||||
Expo is Expo0 >> 1,
|
||||
Base is (Base0 * Base0) mod Mod,
|
||||
expmod_(Base, Expo, Mod, C, R).
|
||||
expmod_(Base0, Expo0, Mod, C, R) :-
|
||||
Expo is Expo0 >> 1,
|
||||
Base is (Base0 * Base0) mod Mod,
|
||||
expmod_(Base, Expo, Mod, C, R).
|
||||
|
||||
lsb(X, N) :-
|
||||
builtins:must_be_number(X, lsb/2),
|
||||
( \+ integer(X) -> type_error(integer, X, lsb/2)
|
||||
; X < 1 -> domain_error(not_less_than_one, X, lsb/2)
|
||||
; builtins:can_be_number(N, lsb/2),
|
||||
X1 is X /\ (-X),
|
||||
msb_(X1, -1, N)
|
||||
).
|
||||
|
||||
msb(X, N) :-
|
||||
builtins:must_be_number(X, msb/2),
|
||||
( \+ integer(X) -> type_error(integer, X, msb/2)
|
||||
; X < 1 -> domain_error(not_less_than_one, X, msb/2)
|
||||
; builtins:can_be_number(N, msb/2),
|
||||
X1 is X >> 1,
|
||||
msb_(X1, 0, N)
|
||||
).
|
||||
|
||||
msb_(0, N, N) :- !.
|
||||
msb_(X, M, N) :-
|
||||
X1 is X >> 1,
|
||||
M1 is M + 1,
|
||||
msb_(X1, M1, N).
|
||||
|
||||
number_to_rational(Real, Fraction) :-
|
||||
( var(Real) -> instantiation_error(number_to_rational/2)
|
||||
; integer(Real) -> Fraction is Real rdiv 1
|
||||
; (rational(Real) ; float(Real)) ->
|
||||
number_to_rational(1.0e-6, Real, Fraction)
|
||||
; type_error(number, Real, number_to_rational/2)
|
||||
).
|
||||
|
||||
% If 0 <= Eps0 <= 1e-16 then the search is for "infinite" precision.
|
||||
number_to_rational(Eps0, Real0, Fraction) :-
|
||||
( var(Eps0) -> instantiation_error(number_to_rational/3)
|
||||
; \+ number(Eps0) -> type_error(number, Eps0, number_to_rational/3)
|
||||
; Eps0 < 0 -> domain_error(not_less_than_zero, Eps0, number_to_rational/3)
|
||||
; Eps_ is Eps0 rdiv 1,
|
||||
rational_numerator_denominator(Eps_, EpsN, EpsD),
|
||||
Eps = EpsN/EpsD
|
||||
),
|
||||
( var(Real0) -> instantiation_error(number_to_rational/3)
|
||||
; \+ number(Real0) -> type_error(number, Eps0, number_to_rational/3)
|
||||
; Real_ is Real0 rdiv 1,
|
||||
rational_numerator_denominator(Real_, RealN, RealD),
|
||||
Real = RealN/RealD
|
||||
),
|
||||
E0/E1 = Eps,
|
||||
P0/Q0 = Real,
|
||||
( P0 < 0 -> I1 is -1 + P0 // Q0
|
||||
; I1 is P0 // Q0
|
||||
),
|
||||
P1 is P0 mod Q0,
|
||||
Q1 = Q0,
|
||||
( P1 =:= 0 -> Fraction is I1 + 0 rdiv 1
|
||||
; Qn1n is max(P1 * E1 - Q1 * E0, 0),
|
||||
Qn1d is Q1 * E1,
|
||||
Qn1 = Qn1n/Qn1d,
|
||||
Qp1n is P1 * E1 + Q1 * E0,
|
||||
Qp1d = Qn1d,
|
||||
Qp1 = Qp1n/Qp1d,
|
||||
stern_brocot_(Qn1, Qp1, 0/1, 1/0, P2/Q2),
|
||||
Fraction is I1 + P2 rdiv Q2
|
||||
),
|
||||
!.
|
||||
|
||||
number(X) :-
|
||||
( integer(X)
|
||||
; float(X)
|
||||
; rational(X)
|
||||
).
|
||||
|
||||
stern_brocot_(Qnn/Qnd, Qpn/Qpd, A/B, C/D, Fraction) :-
|
||||
Fn1 is A + C,
|
||||
Fd1 is B + D,
|
||||
simplify_fraction(Fn1/Fd1, Fn/Fd),
|
||||
S1 is sign(Fn * Qnd - Fd * Qnn),
|
||||
S2 is sign(Fn * Qpd - Fd * Qpn),
|
||||
( S1 < 0 -> stern_brocot_(Qnn/Qnd, Qpn/Qpd, Fn/Fd, C/D, Fraction)
|
||||
; S2 > 0 -> stern_brocot_(Qnn/Qnd, Qpn/Qpd, A/B, Fn/Fd, Fraction)
|
||||
; Fraction = Fn/Fd
|
||||
).
|
||||
|
||||
simplify_fraction(A0/B0, A/B) :-
|
||||
G is gcd(A0, B0),
|
||||
A is A0 // G,
|
||||
B is B0 // G.
|
||||
|
||||
rational_numerator_denominator(R, N, D) :-
|
||||
write_term_to_chars(R, [], Cs),
|
||||
append(Ns, [' ', r, d, i, v, ' '|Ds], Cs),
|
||||
number_chars(N, Ns),
|
||||
number_chars(D, Ds).
|
||||
@@ -63,12 +63,12 @@ Assocs are Key-Value associations implemented as a balanced binary tree
|
||||
@author R.A.O'Keefe, L.Damas, V.S.Costa and Jan Wielemaker
|
||||
*/
|
||||
|
||||
/*
|
||||
/*
|
||||
:- meta_predicate
|
||||
map_assoc(1, ?),
|
||||
map_assoc(2, ?, ?).
|
||||
*/
|
||||
|
||||
|
||||
%! empty_assoc(?Assoc) is semidet.
|
||||
%
|
||||
% Is true if Assoc is the empty association list.
|
||||
|
||||
@@ -1,14 +1,14 @@
|
||||
:- module(atts, [attribute/1, call_residue_vars/2, '$absent_attr'/2,
|
||||
'$copy_attr_list'/2, '$get_attr'/2, '$put_attr'/2,
|
||||
'$absent_from_list'/2, '$get_from_list'/3,
|
||||
'$add_to_list'/3, '$del_attr'/3, '$del_attr_step'/3,
|
||||
'$del_attr_buried'/4, '$default_attr_list'/4]).
|
||||
:- module(atts, [op(1199, fx, attribute), call_residue_vars/2,
|
||||
term_attributed_variables/2,
|
||||
'$absent_attr'/2, '$copy_attr_list'/2, '$get_attr'/2,
|
||||
'$put_attr'/2, '$absent_from_list'/2,
|
||||
'$get_from_list'/3, '$add_to_list'/3, '$del_attr'/3,
|
||||
'$del_attr_step'/3, '$del_attr_buried'/4,
|
||||
'$default_attr_list'/4]).
|
||||
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(terms)).
|
||||
|
||||
:- op(1199, fx, attribute).
|
||||
|
||||
/* represent the list of attributes belonging to a variable,
|
||||
of a particular module, as a list of terms of the form
|
||||
Module:put_atts(V, ListOfAtts). */
|
||||
@@ -20,7 +20,7 @@
|
||||
|
||||
'$default_attr_list'([PG | PGs], Module, AttrVar) -->
|
||||
( { '$module_of'(Module, PG) } -> [Module:put_atts(AttrVar, PG)]
|
||||
; true
|
||||
; { true }
|
||||
),
|
||||
'$default_attr_list'(PGs, Module, AttrVar).
|
||||
'$default_attr_list'([], _, _) --> [].
|
||||
@@ -29,26 +29,26 @@
|
||||
'$get_attr_list'(V, Ls),
|
||||
'$absent_from_list'(Ls, Attr).
|
||||
|
||||
'$absent_from_list'(X, _) :-
|
||||
var(X), !.
|
||||
'$absent_from_list'([L|Ls], Attr) :-
|
||||
( L \= Attr -> '$absent_from_list'(Ls, Attr) ).
|
||||
'$absent_from_list'(X, Attr) :-
|
||||
( var(X) -> true
|
||||
; X = [L|Ls], L \= Attr -> '$absent_from_list'(Ls, Attr)
|
||||
).
|
||||
|
||||
'$get_attr'(V, Attr) :-
|
||||
'$get_attr_list'(V, Ls), nonvar(Ls), '$get_from_list'(Ls, V, Attr).
|
||||
|
||||
'$get_from_list'([L|Ls], V, Attr) :-
|
||||
nonvar(L),
|
||||
( L \= Attr -> nonvar(Ls), '$get_from_list'(Ls, V, Attr)
|
||||
; L = Attr -> '$enqueue_attr_var'(V)
|
||||
; '$get_from_list'(Ls, V, Attr)
|
||||
( L \= Attr -> nonvar(Ls), '$get_from_list'(Ls, V, Attr)
|
||||
; L = Attr, '$enqueue_attr_var'(V)
|
||||
).
|
||||
|
||||
'$put_attr'(V, Attr) :-
|
||||
'$get_attr_list'(V, Ls), '$add_to_list'(Ls, V, Attr).
|
||||
|
||||
'$add_to_list'(Ls, V, Attr) :-
|
||||
( var(Ls) -> Ls = [Attr | _], '$enqueue_attr_var'(V)
|
||||
( var(Ls) ->
|
||||
Ls = [Attr | _], '$enqueue_attr_var'(V)
|
||||
; Ls = [_ | Ls0], '$add_to_list'(Ls0, V, Attr)
|
||||
).
|
||||
|
||||
@@ -57,26 +57,28 @@
|
||||
'$del_attr'(Ls0, V, Attr) :-
|
||||
Ls0 = [Att | Ls1],
|
||||
nonvar(Att),
|
||||
( Att \= Attr -> '$del_attr_buried'(Ls0, Ls1, V, Attr)
|
||||
; '$enqueue_attr_var'(V), '$del_attr_head'(V), '$del_attr'(Ls1, V, Attr)
|
||||
( Att \= Attr ->
|
||||
'$del_attr_buried'(Ls0, Ls1, V, Attr)
|
||||
; '$enqueue_attr_var'(V),
|
||||
'$del_attr_head'(V),
|
||||
'$del_attr'(Ls1, V, Attr)
|
||||
).
|
||||
|
||||
'$del_attr_step'(Ls1, V, Attr) :-
|
||||
( nonvar(Ls1) -> Ls1 = [_ | Ls2], '$del_attr_buried'(Ls1, Ls2, V, Attr)
|
||||
; true ).
|
||||
( nonvar(Ls1) -> Ls1 = [_ | Ls2], '$del_attr_buried'(Ls1, Ls2, V, Attr)
|
||||
; true ).
|
||||
|
||||
%% assumptions: Ls0 is a list, Ls1 is its tail;
|
||||
%% the head of Ls0 can be ignored.
|
||||
'$del_attr_buried'(Ls0, Ls1, V, Attr) :-
|
||||
Ls0 = [_, Att | _],
|
||||
nonvar(Att),
|
||||
!,
|
||||
( Att \= Attr -> '$del_attr_step'(Ls1, V, Attr)
|
||||
; '$enqueue_attr_var'(V),
|
||||
'$del_attr_non_head'(Ls0), %% set tail of Ls0 = tail of Ls1. can be undone by backtracking.
|
||||
'$del_attr_step'(Ls1, V, Attr)
|
||||
( var(Ls1) -> true
|
||||
; Ls1 = [Att | Ls2] ->
|
||||
( Att \= Attr -> '$del_attr_buried'(Ls1, Ls2, V, Attr)
|
||||
; '$enqueue_attr_var'(V),
|
||||
'$del_attr_non_head'(Ls0), %% set tail of Ls0 = tail of Ls1. can be undone by backtracking.
|
||||
'$del_attr_step'(Ls1, V, Attr)
|
||||
)
|
||||
).
|
||||
'$del_attr_buried'(_, _, _, _).
|
||||
|
||||
'$copy_attr_list'(L, []) :- var(L), !.
|
||||
'$copy_attr_list'([Att|Atts], [Att|CopiedAtts]) :-
|
||||
@@ -125,11 +127,19 @@ put_attr(Name, Arity) -->
|
||||
{ functor(Attr, Name, Arity),
|
||||
numbervars(Attr, 0, Arity),
|
||||
V = '$VAR'(Arity) },
|
||||
[(put_atts(V, +Attr) :- !, functor(Attr, Head, Arity), functor(AttrForm, Head, Arity),
|
||||
'$get_attr_list'(V, Ls), '$del_attr'(Ls, V, AttrForm), '$put_attr'(V, Attr)),
|
||||
(put_atts(V, Attr) :- !, functor(Attr, Head, Arity), functor(AttrForm, Head, Arity),
|
||||
'$get_attr_list'(V, Ls), '$del_attr'(Ls, V, AttrForm), '$put_attr'(V, Attr)),
|
||||
(put_atts(V, -Attr) :- !, functor(Attr, _, _), '$get_attr_list'(V, Ls), '$del_attr'(Ls, V, Attr))].
|
||||
[(put_atts(V, +Attr) :- !, functor(Attr, Head, Arity),
|
||||
functor(AttrForm, Head, Arity),
|
||||
'$get_attr_list'(V, Ls),
|
||||
'$del_attr'(Ls, V, AttrForm),
|
||||
'$put_attr'(V, Attr)),
|
||||
(put_atts(V, Attr) :- !, functor(Attr, Head, Arity),
|
||||
functor(AttrForm, Head, Arity),
|
||||
'$get_attr_list'(V, Ls),
|
||||
'$del_attr'(Ls, V, AttrForm),
|
||||
'$put_attr'(V, Attr)),
|
||||
(put_atts(V, -Attr) :- !, functor(Attr, _, _),
|
||||
'$get_attr_list'(V, Ls),
|
||||
'$del_attr'(Ls, V, Attr))].
|
||||
|
||||
get_attr(Name, Arity) -->
|
||||
{ functor(Attr, Name, Arity),
|
||||
@@ -150,3 +160,6 @@ call_residue_vars(Goal, Vars) :-
|
||||
'$get_attr_var_queue_delim'(B),
|
||||
call(Goal),
|
||||
'$get_attr_var_queue_beyond'(B, Vars).
|
||||
|
||||
term_attributed_variables(Term, Vars) :-
|
||||
'$term_attributed_variables'(Term, Vars).
|
||||
|
||||
@@ -9,7 +9,11 @@ between(Lower, Upper, X) :-
|
||||
must_be(integer, Lower),
|
||||
must_be(integer, Upper),
|
||||
can_be(integer, X),
|
||||
between_(Lower, Upper, X).
|
||||
( nonvar(X) ->
|
||||
Lower =< X,
|
||||
X =< Upper
|
||||
; between_(Lower, Upper, X)
|
||||
).
|
||||
|
||||
between_(Lower, Upper, Lower) :-
|
||||
Lower =< Upper.
|
||||
|
||||
@@ -1,35 +1,19 @@
|
||||
:- op(400, yfx, /).
|
||||
|
||||
/* this is an implementation specific declarative operator used to implement call_with_inference_limit/3
|
||||
and setup_call_cleanup/3. switches to the default trust_me and retry_me_else. Indexing choice
|
||||
instructions are unchanged. */
|
||||
:- op(700, fx, non_counted_backtracking).
|
||||
|
||||
:- module(builtins, [(=)/2, (\=)/2, (\+)/1, (^)/2, (\)/1, (+)/1,
|
||||
(+)/2, (**)/2, (*)/2, (-)/1, (-)/2, (/)/2, (/\)/2, (\/)/2,
|
||||
(is)/2, (xor)/2, (div)/2, (//)/2, (rdiv)/2, (<<)/2, (>>)/2,
|
||||
(mod)/2, (rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2, (>=)/2,
|
||||
(=<)/2, (',')/2, (->)/2, (;)/2, (=..)/2, (==)/2, (\==)/2,
|
||||
(@=<)/2, (@>=)/2, (@<)/2, (@>)/2, (:)/2, abolish/1, asserta/1,
|
||||
assertz/1, atom_chars/2, atom_codes/2, atom_concat/3,
|
||||
atom_length/2, bagof/3, catch/3, char_code/2, clause/2,
|
||||
current_op/3, current_predicate/1, current_prolog_flag/2,
|
||||
expand_goal/2, expand_term/2, fail/0, false/0, findall/3,
|
||||
findall/4, get_char/1, halt/0, number_chars/2, number_codes/2,
|
||||
once/1, op/3, read_term/2, repeat/0, retract/1,
|
||||
set_prolog_flag/2, setof/3, sub_atom/5, subsumes_term/2,
|
||||
term_variables/2, throw/1, true/0, unify_with_occurs_check/2,
|
||||
write/1, write_canonical/1, write_term/2, writeq/1]).
|
||||
|
||||
% module resolution operator.
|
||||
:- op(600, xfy, :).
|
||||
|
||||
user:term_expansion((:- op(Pred, Spec, [Op | OtherOps])), OpResults) :-
|
||||
expand_op_list([Op | OtherOps], Pred, Spec, OpResults).
|
||||
'$expand_op_list'([Op | OtherOps], Pred, Spec, OpResults).
|
||||
|
||||
expand_op_list([], _, _, []).
|
||||
expand_op_list([Op | OtherOps], Pred, Spec, [(:- op(Pred, Spec, Op)) | OtherResults]) :-
|
||||
expand_op_list(OtherOps, Pred, Spec, OtherResults).
|
||||
'$expand_op_list'([], _, _, []).
|
||||
'$expand_op_list'([Op | OtherOps], Pred, Spec, [(:- op(Pred, Spec, Op)) | OtherResults]) :-
|
||||
'$expand_op_list'(OtherOps, Pred, Spec, OtherResults).
|
||||
|
||||
/* this is an implementation specific declarative operator used to implement call_with_inference_limit/3
|
||||
and setup_call_cleanup/3. switches to the default trust_me and retry_me_else. Indexing choice
|
||||
instructions are unchanged. */
|
||||
:- op(700, fx, non_counted_backtracking).
|
||||
|
||||
% arithmetic operators.
|
||||
:- op(700, xfx, is).
|
||||
@@ -37,8 +21,7 @@ expand_op_list([Op | OtherOps], Pred, Spec, [(:- op(Pred, Spec, Op)) | OtherResu
|
||||
:- op(400, yfx, *).
|
||||
:- op(200, xfy, [**, ^]).
|
||||
:- op(500, yfx, [/\, \/, xor]).
|
||||
:- op(400, yfx, [div, //, rdiv]).
|
||||
:- op(400, yfx, [<<, >>, mod, rem]).
|
||||
:- op(400, yfx, [div, //, rdiv, <<, >>, mod, rem]).
|
||||
:- op(200, fy, [+, -, \]).
|
||||
|
||||
% arithmetic comparison operators.
|
||||
@@ -47,9 +30,6 @@ expand_op_list([Op | OtherOps], Pred, Spec, [(:- op(Pred, Spec, Op)) | OtherResu
|
||||
% term comparison.
|
||||
:- op(700, xfx, [==, \==, @=<, @>=, @<, @>]).
|
||||
|
||||
% the maximum arity flag. needs to be replaced with current_prolog_flag(max_arity, MAX_ARITY).
|
||||
max_arity(255).
|
||||
|
||||
% conditional operators.
|
||||
:- op(1050, xfy, ->).
|
||||
:- op(1100, xfy, ;).
|
||||
@@ -58,6 +38,39 @@ max_arity(255).
|
||||
:- op(700, xfx, [=, =.., \=]).
|
||||
:- op(900, fy, \+).
|
||||
|
||||
:- module(builtins, [(=)/2, (\=)/2, (\+)/1, (',')/2, (->)/2, (;)/2,
|
||||
(=..)/2, (:)/2, (:)/3, (:)/4, (:)/5, (:)/6,
|
||||
(:)/7, (:)/8, (:)/9, (:)/10, (:)/11, (:)/12,
|
||||
abolish/1, asserta/1, assertz/1,
|
||||
at_end_of_stream/0, at_end_of_stream/1,
|
||||
atom_chars/2, atom_codes/2, atom_concat/3,
|
||||
atom_length/2, bagof/3, catch/3, char_code/2,
|
||||
clause/2, close/1, close/2, current_input/1,
|
||||
current_output/1, current_op/3,
|
||||
current_predicate/1, current_prolog_flag/2,
|
||||
expand_goal/2, expand_term/2, fail/0, false/0,
|
||||
findall/3, findall/4, flush_output/0,
|
||||
flush_output/1, get_byte/1, get_byte/2,
|
||||
get_char/1, get_char/2, get_code/1, get_code/2,
|
||||
halt/0, max_arity/1, number_chars/2,
|
||||
number_codes/2, once/1, op/3, open/3, open/4,
|
||||
peek_byte/1, peek_byte/2, peek_char/1,
|
||||
peek_char/2, peek_code/1, peek_code/2,
|
||||
put_byte/1, put_byte/2, put_code/1, put_code/2,
|
||||
put_char/1, put_char/2, read_term/2, read_term/3,
|
||||
repeat/0, retract/1, set_prolog_flag/2,
|
||||
set_input/1, set_stream_position/2, set_output/1,
|
||||
setof/3, stream_property/2, sub_atom/5,
|
||||
subsumes_term/2, term_variables/2, throw/1,
|
||||
true/0, unify_with_occurs_check/2, write/1,
|
||||
write_canonical/1, write_term/2, write_term/3,
|
||||
writeq/1]).
|
||||
|
||||
|
||||
% the maximum arity flag. needs to be replaced with
|
||||
% current_prolog_flag(max_arity, MAX_ARITY).
|
||||
max_arity(1023).
|
||||
|
||||
% unify.
|
||||
X = X.
|
||||
|
||||
@@ -72,6 +85,57 @@ Module : Predicate :-
|
||||
; throw(error(type_error(atom, Module), (:)/2))
|
||||
).
|
||||
|
||||
:(Module, Predicate, A1) :-
|
||||
( atom(Module) -> '$module_call'(A1, Module, Predicate)
|
||||
; throw(error(type_error(atom, Module), (:)/2))
|
||||
).
|
||||
|
||||
:(Module, Predicate, A1, A2) :-
|
||||
( atom(Module) -> '$module_call'(A1, A2, Module, Predicate)
|
||||
; throw(error(type_error(atom, Module), (:)/2))
|
||||
).
|
||||
|
||||
:(Module, Predicate, A1, A2, A3) :-
|
||||
( atom(Module) -> '$module_call'(A1, A2, A3, Module, Predicate)
|
||||
; throw(error(type_error(atom, Module), (:)/2))
|
||||
).
|
||||
|
||||
:(Module, Predicate, A1, A2, A3, A4) :-
|
||||
( atom(Module) -> '$module_call'(A1, A2, A3, A4, Module, Predicate)
|
||||
; throw(error(type_error(atom, Module), (:)/2))
|
||||
).
|
||||
|
||||
:(Module, Predicate, A1, A2, A3, A4, A5) :-
|
||||
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, Module, Predicate)
|
||||
; throw(error(type_error(atom, Module), (:)/2))
|
||||
).
|
||||
|
||||
:(Module, Predicate, A1, A2, A3, A4, A5, A6) :-
|
||||
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, Module, Predicate)
|
||||
; throw(error(type_error(atom, Module), (:)/2))
|
||||
).
|
||||
|
||||
:(Module, Predicate, A1, A2, A3, A4, A5, A6, A7) :-
|
||||
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, Module, Predicate)
|
||||
; throw(error(type_error(atom, Module), (:)/2))
|
||||
).
|
||||
|
||||
:(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8) :-
|
||||
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, Module, Predicate)
|
||||
; throw(error(type_error(atom, Module), (:)/2))
|
||||
).
|
||||
|
||||
:(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8, A9) :-
|
||||
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, A9, Module, Predicate)
|
||||
; throw(error(type_error(atom, Module), (:)/2))
|
||||
).
|
||||
|
||||
:(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10) :-
|
||||
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, Module, Predicate)
|
||||
; throw(error(type_error(atom, Module), (:)/2))
|
||||
).
|
||||
|
||||
|
||||
% flags.
|
||||
|
||||
current_prolog_flag(Flag, false) :- Flag == bounded, !.
|
||||
@@ -125,13 +189,13 @@ set_prolog_flag(Flag, _) :-
|
||||
|
||||
fail :- '$fail'.
|
||||
|
||||
\+ G :- G, !, false.
|
||||
\+ G :- call(G), !, false.
|
||||
\+ _.
|
||||
|
||||
X \= X :- !, false.
|
||||
_ \= _.
|
||||
|
||||
once(G) :- G, !.
|
||||
once(G) :- call(G), !.
|
||||
|
||||
repeat.
|
||||
repeat :- repeat.
|
||||
@@ -148,56 +212,94 @@ comma_errors(G1, G2, B) :- '$call_with_default_policy'(','(G1, G2, B)).
|
||||
'$set_cp'(B),
|
||||
'$call_with_default_policy'(comma_errors(G1, G2, B)).
|
||||
','(!, Atom, B) :- Atom == !, '$set_cp'(B).
|
||||
','(!, G, B) :- '$set_cp'(B), G.
|
||||
','(!, G, B) :- '$set_cp'(B), call(G).
|
||||
','(G, CF, B) :- compound(CF),
|
||||
'$call_with_default_policy'(CF = ','(G1, G2)), !, G,
|
||||
'$call_with_default_policy'(CF = ','(G1, G2)),
|
||||
!,
|
||||
call(G),
|
||||
'$call_with_default_policy'(comma_errors(G1, G2, B)).
|
||||
','(G, Atom, B) :- Atom == !, !, G, '$set_cp'(B).
|
||||
','(G1, G2, _) :- G1, G2.
|
||||
','(G, Atom, B) :- Atom == !, !, call(G), '$set_cp'(B).
|
||||
','(G1, G2, _) :- call(G1), call(G2).
|
||||
|
||||
;(G1, G2) :- '$get_b_value'(B), ;(G1, G2, B).
|
||||
|
||||
:- non_counted_backtracking semicolon_compound_selector/3.
|
||||
semicolon_compound_selector(->(G2, G3), G4, B) :-
|
||||
( call(G2) ->
|
||||
call(G3)
|
||||
; '$set_cp'(B),
|
||||
call(G4)
|
||||
).
|
||||
semicolon_compound_selector(','(G2, G3), G4, B) :-
|
||||
( ','(G2, G3, B)
|
||||
; '$set_cp'(B),
|
||||
call(G4)
|
||||
).
|
||||
semicolon_compound_selector(';'(G2, G3), G4, B) :-
|
||||
( ';'(G2, G3, B)
|
||||
; '$set_cp'(B),
|
||||
call(G4)
|
||||
).
|
||||
|
||||
:- non_counted_backtracking (;)/3.
|
||||
;(G1, G4, B) :- compound(G1),
|
||||
'$call_with_default_policy'(G1 = ->(G2, G3)),
|
||||
!,
|
||||
(G2 -> G3 ; '$set_cp'(B), G4).
|
||||
;(G1, G2, B) :- G1 == !, '$set_cp'(B), G2.
|
||||
;(G1, G2, B) :- G2 == !, G1, '$set_cp'(B).
|
||||
;(G, _, _) :- G.
|
||||
;(_, G, _) :- G.
|
||||
;(G1, G4, B) :-
|
||||
( ( G1 = (_ -> _)
|
||||
; G1 = (_ , _)
|
||||
; G1 = (_ ; _)
|
||||
) ->
|
||||
!,
|
||||
semicolon_compound_selector(G1, G4, B)
|
||||
).
|
||||
;(G1, G2, B) :-
|
||||
G1 == !, !, '$set_cp'(B), call(G2).
|
||||
;(G1, G2, B) :-
|
||||
G2 == !, !, call(G1), '$set_cp'(B).
|
||||
;(G, _, _) :-
|
||||
call(G).
|
||||
;(_, G, _) :-
|
||||
call(G).
|
||||
|
||||
G1 -> G2 :- '$get_b_value'(B), '$call_with_default_policy'(->(G1, G2, B)).
|
||||
|
||||
:- non_counted_backtracking (->)/3.
|
||||
->(G1, G2, B) :- G2 == !, G1, '$set_cp'(B).
|
||||
->(G1, G2, B) :- G1, '$set_cp'(B), G2.
|
||||
->(G1, G2, B) :- G2 == !, call(G1), '$set_cp'(B).
|
||||
->(G1, G2, B) :- call(G1), '$set_cp'(B), call(G2).
|
||||
|
||||
% univ.
|
||||
|
||||
:- non_counted_backtracking univ_errors/3.
|
||||
univ_errors(Term, List, N) :-
|
||||
'$skip_max_list'(N, -1, List, R),
|
||||
( var(R) -> ( var(Term), throw(error(instantiation_error, (=..)/2)) % 8.5.3.3 a)
|
||||
; true )
|
||||
; R \== [] -> throw(error(type_error(list, List), (=..)/2)) % 8.5.3.3 b)
|
||||
; List = [H|T] -> ( var(H), var(Term), % R == [] => List is a proper list.
|
||||
throw(error(instantiation_error, (=..)/2)) % 8.5.3.3 c)
|
||||
; T \== [], nonvar(H), \+ atom(H),
|
||||
throw(error(type_error(atom, H), (=..)/2)) % 8.5.3.3 d)
|
||||
; compound(H), T == [],
|
||||
throw(error(type_error(atomic, H), (=..)/2)) % 8.5.3.3 e)
|
||||
; var(Term), max_arity(M), N - 1 > M,
|
||||
throw(error(representation_error(max_arity), (=..)/2)) % 8.5.3.3 g)
|
||||
; true )
|
||||
; var(Term) -> throw(error(domain_error(non_empty_list, List), (=..)/2)) % 8.5.3.3 f)
|
||||
; true ).
|
||||
( var(R) ->
|
||||
( var(Term), throw(error(instantiation_error, (=..)/2)) % 8.5.3.3 a)
|
||||
; true
|
||||
)
|
||||
; R \== [] ->
|
||||
throw(error(type_error(list, List), (=..)/2)) % 8.5.3.3 b)
|
||||
; List = [H|T] ->
|
||||
( var(H), var(Term), % R == [] => List is a proper list.
|
||||
throw(error(instantiation_error, (=..)/2)) % 8.5.3.3 c)
|
||||
; T \== [], nonvar(H), \+ atom(H),
|
||||
throw(error(type_error(atom, H), (=..)/2)) % 8.5.3.3 d)
|
||||
; compound(H), T == [],
|
||||
throw(error(type_error(atomic, H), (=..)/2)) % 8.5.3.3 e)
|
||||
; var(Term), max_arity(M), N - 1 > M,
|
||||
throw(error(representation_error(max_arity), (=..)/2)) % 8.5.3.3 g)
|
||||
; true
|
||||
)
|
||||
; var(Term) ->
|
||||
throw(error(domain_error(non_empty_list, List), (=..)/2)) % 8.5.3.3 f)
|
||||
; true
|
||||
).
|
||||
|
||||
Term =.. List :- '$call_with_default_policy'(univ_errors(Term, List, N)),
|
||||
'$call_with_default_policy'(univ_worker(Term, List, N)).
|
||||
|
||||
|
||||
:- non_counted_backtracking univ_worker/3.
|
||||
univ_worker(Term, List, _) :- atomic(Term), !, '$call_with_default_policy'(List = [Term]).
|
||||
|
||||
univ_worker(Term, List, _) :-
|
||||
atomic(Term), !, '$call_with_default_policy'(List = [Term]).
|
||||
univ_worker(Term, [Name|Args], N) :-
|
||||
var(Term), !,
|
||||
'$call_with_default_policy'(Arity is N-1),
|
||||
@@ -208,7 +310,9 @@ univ_worker(Term, List, _) :-
|
||||
'$call_with_default_policy'(get_args(Args, Term, 1, Arity)),
|
||||
'$call_with_default_policy'(List = [Name|Args]).
|
||||
|
||||
|
||||
:- non_counted_backtracking get_args/4.
|
||||
|
||||
get_args(Args, _, _, 0) :-
|
||||
!, '$call_with_default_policy'(Args = []).
|
||||
get_args([Arg], Func, N, N) :-
|
||||
@@ -218,34 +322,39 @@ get_args([Arg|Args], Func, I0, N) :-
|
||||
'$call_with_default_policy'(I1 is I0 + 1),
|
||||
'$call_with_default_policy'(get_args(Args, Func, I1, N)).
|
||||
|
||||
% write, write_canonical, writeq, write_term.
|
||||
is_write_option(Functor) :-
|
||||
Functor =.. [Name, Arg],
|
||||
( Arg == true -> true
|
||||
; Arg == false -> true
|
||||
; Name == variable_names -> must_be_var_names_list(Arg)
|
||||
; var(Arg) -> throw(error(instantiation_error, write_term/2))
|
||||
; throw(error(domain_error(write_option, Functor), write_term/2))
|
||||
), % 8.14.2.3 e)
|
||||
( Name == ignore_ops -> true
|
||||
; Name == quoted -> true
|
||||
; Name == numbervars -> true
|
||||
; Name == variable_names -> true
|
||||
; throw(error(domain_error(write_option, Functor), write_term/2))
|
||||
). % 8.14.2.3 e)
|
||||
parse_write_options(Options, OptionValues, Stub) :-
|
||||
DefaultOptions = [ignore_ops-false, max_depth-0, numbervars-false,
|
||||
quoted-false, variable_names-[]],
|
||||
parse_options_list(Options, parse_write_options_, DefaultOptions, OptionValues, Stub).
|
||||
|
||||
inst_member_or([X|Xs], Y, Z) :-
|
||||
( var(X) -> throw(error(instantiation_error, write_term/2))
|
||||
; is_write_option(X) -> ( Y = X, ! ; inst_member_or(Xs, Y, Z) )
|
||||
; throw(error(domain_error(write_option, X), write_term/2))
|
||||
parse_write_options_(ignore_ops(IgnoreOps), ignore_ops-IgnoreOps) :-
|
||||
( nonvar(IgnoreOps), lists:member(IgnoreOps, [true, false])
|
||||
;
|
||||
throw(error(domain_error(write_option, ignore_ops(IgnoreOps)), _))
|
||||
).
|
||||
parse_write_options_(quoted(Quoted), quoted-Quoted) :-
|
||||
( nonvar(Quoted), lists:member(Quoted, [true, false])
|
||||
;
|
||||
throw(error(domain_error(write_option, quoted(Quoted)), _))
|
||||
).
|
||||
parse_write_options_(numbervars(NumberVars), numbervars-NumberVars) :-
|
||||
( nonvar(NumberVars), lists:member(NumberVars, [true, false])
|
||||
;
|
||||
throw(error(domain_error(write_option, numbervars(NumberVars)), _))
|
||||
).
|
||||
parse_write_options_(variable_names(VNNames), variable_names-VNNames) :-
|
||||
must_be_var_names_list(VNNames).
|
||||
parse_write_options_(max_depth(MaxDepth), max_depth-MaxDepth) :-
|
||||
( integer(MaxDepth), MaxDepth >= 0
|
||||
;
|
||||
throw(error(domain_error(write_option, max_depth(MaxDepth)), _))
|
||||
).
|
||||
inst_member_or([], Y, Y).
|
||||
|
||||
must_be_var_names_list(VarNames) :-
|
||||
'$skip_max_list'(_, -1, VarNames, Tail),
|
||||
( Tail == [] -> must_be_var_names_list_(VarNames, VarNames)
|
||||
; var(Tail) -> throw(error(instantiation_error, write_term/2))
|
||||
; throw(error(domain_error(write_options, variable_names(VarNames)), write_term/2))
|
||||
; throw(error(domain_error(write_option, variable_names(VarNames)), write_term/2))
|
||||
).
|
||||
|
||||
must_be_var_names_list_([], List).
|
||||
@@ -254,44 +363,90 @@ must_be_var_names_list_([VarName | VarNames], List) :-
|
||||
( VarName = (Atom = _) ->
|
||||
( atom(Atom) -> must_be_var_names_list_(VarNames, List)
|
||||
; var(Atom) -> throw(error(instantiation_error, write_term/2))
|
||||
; throw(error(domain_error(write_options, variable_names(List)), write_term/2))
|
||||
; throw(error(domain_error(write_option, variable_names(List)), write_term/2))
|
||||
)
|
||||
; throw(error(domain_error(write_options, variable_names(List)), write_term/2))
|
||||
; throw(error(domain_error(write_option, variable_names(List)), write_term/2))
|
||||
)
|
||||
; throw(error(instantiation_error, write_term/2)) % throw(error(domain_error(write_options, variable_names(List)), write_term/2))
|
||||
; throw(error(instantiation_error, write_term/2))
|
||||
).
|
||||
|
||||
write_term(_, Options) :-
|
||||
var(Options), throw(error(instantiation_error, write_term/2)).
|
||||
|
||||
write_term(Term, Options) :-
|
||||
'$skip_max_list'(_, -1, Options, Options0),
|
||||
( var(Options0) -> throw(error(instantiation_error, write_term/2))
|
||||
; Options0 == [] -> true
|
||||
; throw(error(type_error(list, Options), write_term/2))
|
||||
), % 8.14.2.3 c)
|
||||
inst_member_or(Options, ignore_ops(IgnoreOps), ignore_ops(false)),
|
||||
inst_member_or(Options, numbervars(NumberVars), numbervars(false)),
|
||||
inst_member_or(Options, quoted(Quoted), quoted(false)),
|
||||
inst_member_or(Options, variable_names(VarNames), variable_names([])),
|
||||
'$write_term'(Term, IgnoreOps, NumberVars, Quoted, VarNames).
|
||||
current_output(Stream),
|
||||
write_term(Stream, Term, Options).
|
||||
|
||||
write(Term) :- write_term(Term, [numbervars(true)]).
|
||||
write_term(Stream, Term, Options) :-
|
||||
parse_write_options(Options, [IgnoreOps, MaxDepth, NumberVars, Quoted, VNNames], write_term/3),
|
||||
'$write_term'(Stream, Term, IgnoreOps, NumberVars, Quoted, VNNames, MaxDepth).
|
||||
|
||||
write_canonical(Term) :- write_term(Term, [ignore_ops(true), quoted(true)]).
|
||||
|
||||
writeq(Term) :- write_term(Term, [quoted(true), numbervars(true)]).
|
||||
write(Term) :-
|
||||
current_output(Stream),
|
||||
'$write_term'(Stream, Term, false, true, false, [], 0).
|
||||
|
||||
%% TODO: complete the predicate! Most read options are missing.
|
||||
read_term(Term, Options) :-
|
||||
'$skip_max_list'(_, -1, Options, Options0),
|
||||
( Options0 == [] -> true
|
||||
; var(Options0) -> throw(error(instantiation_error, read_term/2)) % 8.14.1.3 b)
|
||||
; throw(error(type_error(list, Options), read_term/2)) % 8.14.1.3 d)
|
||||
),
|
||||
( Options = [variable_names(VarList)] -> '$read_term'(Term, VarList)
|
||||
; Options = [] -> read(Term)
|
||||
; false
|
||||
write_canonical(Term) :-
|
||||
current_output(Stream),
|
||||
'$write_term'(Stream, Term, true, false, true, [], 0).
|
||||
|
||||
writeq(Term) :-
|
||||
current_output(Stream),
|
||||
'$write_term'(Stream, Term, false, true, true, [], 0).
|
||||
|
||||
|
||||
|
||||
select_rightmost_options([Option-Value | OptionPairs], OptionValues) :-
|
||||
( pairs:same_key(Option, OptionPairs, OtherValues, _),
|
||||
OtherValues == [] ->
|
||||
OptionValues = [Value | OptionValues0],
|
||||
select_rightmost_options(OptionPairs, OptionValues0)
|
||||
;
|
||||
select_rightmost_options(OptionPairs, OptionValues)
|
||||
).
|
||||
select_rightmost_options([], []).
|
||||
|
||||
|
||||
parse_options_list(Options, Selector, DefaultPairs, OptionValues, Stub) :-
|
||||
'$skip_max_list'(_, -1, Options, Tail),
|
||||
( Tail == [] ->
|
||||
true
|
||||
; var(Tail) ->
|
||||
throw(error(instantiation_error, Stub)) % 8.11.5.3c)
|
||||
; Tail \== [] ->
|
||||
throw(error(type_error(list, Options), Stub)) % 8.11.5.3e)
|
||||
),
|
||||
( lists:maplist(nonvar, Options),
|
||||
catch(lists:maplist(Selector, Options, OptionPairs0),
|
||||
error(E, _),
|
||||
throw(error(E, Stub))) ->
|
||||
lists:append(DefaultPairs, OptionPairs0, OptionPairs1),
|
||||
keysort(OptionPairs1, OptionPairs),
|
||||
select_rightmost_options(OptionPairs, OptionValues)
|
||||
;
|
||||
throw(error(instantiation_error, Stub)) % 8.11.5.3c)
|
||||
).
|
||||
|
||||
|
||||
parse_read_term_options(Options, OptionValues, Stub) :-
|
||||
DefaultOptions = [singletons-_, variables-_, variable_names-_],
|
||||
parse_options_list(Options, parse_read_term_options_, DefaultOptions, OptionValues, Stub).
|
||||
|
||||
|
||||
parse_read_term_options_(singletons(Vars), singletons-Vars).
|
||||
parse_read_term_options_(variables(Vars), variables-Vars).
|
||||
parse_read_term_options_(variable_names(Vars), variable_names-Vars).
|
||||
parse_read_term_options_(E,_) :-
|
||||
throw(error(domain_error(read_option, E), _)).
|
||||
|
||||
|
||||
|
||||
read_term(Stream, Term, Options) :-
|
||||
parse_read_term_options(Options, [Singletons, VariableNames, Variables], read_term/3),
|
||||
'$read_term'(Stream, Term, Singletons, Variables, VariableNames).
|
||||
|
||||
read_term(Term, Options) :-
|
||||
current_input(Stream),
|
||||
read_term(Stream, Term, Options).
|
||||
|
||||
|
||||
% expand_goal.
|
||||
|
||||
@@ -318,7 +473,8 @@ catch(G,C,R) :- '$get_current_block'(Bb), '$call_with_default_policy'(catch(G,C,
|
||||
|
||||
:- non_counted_backtracking catch/4.
|
||||
catch(G,C,R,Bb) :-
|
||||
'$install_new_block'(NBb), call(G),
|
||||
'$install_new_block'(NBb),
|
||||
call(G),
|
||||
'$call_with_default_policy'(end_block(Bb, NBb)).
|
||||
catch(G,C,R,Bb) :-
|
||||
'$reset_block'(Bb),
|
||||
@@ -382,7 +538,7 @@ set_difference([], _, []) :- !.
|
||||
set_difference(Xs, [], Xs).
|
||||
|
||||
group_by_variant([V2-S2 | Pairs], V1-S1, [S2 | Solutions], Pairs0) :-
|
||||
non_iso:variant(V1, V2), !, V1 = V2, group_by_variant(Pairs, V2-S2, Solutions, Pairs0).
|
||||
iso_ext:variant(V1, V2), !, V1 = V2, group_by_variant(Pairs, V2-S2, Solutions, Pairs0).
|
||||
group_by_variant(Pairs, _, [], Pairs).
|
||||
|
||||
group_by_variants([V-S|Pairs], [V-Solution|Solutions]) :-
|
||||
@@ -390,7 +546,10 @@ group_by_variants([V-S|Pairs], [V-Solution|Solutions]) :-
|
||||
group_by_variants(Pairs0, Solutions).
|
||||
group_by_variants([], []).
|
||||
|
||||
iterate_variants([V-Solution|GroupSolutions], V, Solution).
|
||||
iterate_variants([V-Solution|GroupSolutions], V, Solution) :-
|
||||
( GroupSolutions == [] -> !
|
||||
; true
|
||||
).
|
||||
iterate_variants([_|GroupSolutions], Ws, Solution) :-
|
||||
iterate_variants(GroupSolutions, Ws, Solution).
|
||||
|
||||
@@ -406,7 +565,9 @@ findall_with_existential(Template, Goal, PairedSolutions, Witnesses0, Witnesses)
|
||||
( nonvar(Goal), Goal = _ ^ _ ->
|
||||
rightmost_power(Goal, Goal1, ExistentialVars0),
|
||||
term_variables(ExistentialVars0, ExistentialVars),
|
||||
set_difference(Witnesses0, ExistentialVars, Witnesses),
|
||||
sort(Witnesses0, Witnesses1),
|
||||
sort(ExistentialVars, ExistentialVars1),
|
||||
set_difference(Witnesses1, ExistentialVars1, Witnesses),
|
||||
findall(Witnesses-Template, Goal1, PairedSolutions)
|
||||
; Witnesses = Witnesses0,
|
||||
findall(Witnesses-Template, Goal, PairedSolutions)
|
||||
@@ -425,7 +586,10 @@ bagof(Template, Goal, Solution) :-
|
||||
iterate_variants(GroupedSolutions, Witnesses, Solution).
|
||||
|
||||
iterate_variants_and_sort([V-Solution0|GroupSolutions], V, Solution) :-
|
||||
sort(Solution0, Solution).
|
||||
sort(Solution0, Solution),
|
||||
( GroupSolutions == [] -> !
|
||||
; true
|
||||
).
|
||||
iterate_variants_and_sort([_|GroupSolutions], Ws, Solution) :-
|
||||
iterate_variants_and_sort(GroupSolutions, Ws, Solution).
|
||||
|
||||
@@ -465,18 +629,19 @@ setof(Template, Goal, Solution) :-
|
||||
|
||||
clause(H, B) :-
|
||||
( var(H) -> throw(error(instantiation_error, clause/2))
|
||||
; functor(H, Name, Arity) -> ( Name == '.' -> throw(error(type_error(callable, H), clause/2))
|
||||
; Name == (:), Arity =:= 2 ->
|
||||
arg(1, H, Module),
|
||||
arg(2, H, F),
|
||||
'$module_clause'(F, B, Module)
|
||||
%% '$no_such_predicate' fails if H is not callable.
|
||||
; '$no_such_predicate'(H) -> '$fail'
|
||||
; '$head_is_dynamic'(H) -> '$clause_body_is_valid'(B),
|
||||
'$get_clause'(H, B)
|
||||
; throw(error(permission_error(access, private_procedure, Name/Arity),
|
||||
clause/2))
|
||||
)
|
||||
; functor(H, Name, Arity) ->
|
||||
( Name == '.' -> throw(error(type_error(callable, H), clause/2))
|
||||
; Name == (:), Arity =:= 2 ->
|
||||
arg(1, H, Module),
|
||||
arg(2, H, F),
|
||||
'$module_clause'(F, B, Module)
|
||||
%% '$no_such_predicate' fails if H is not callable.
|
||||
; '$no_such_predicate'(H) -> '$fail'
|
||||
; '$head_is_dynamic'(H) -> '$clause_body_is_valid'(B),
|
||||
'$get_clause'(H, B)
|
||||
; throw(error(permission_error(access, private_procedure, Name/Arity),
|
||||
clause/2))
|
||||
)
|
||||
; throw(error(type_error(callable, H), clause/2))
|
||||
).
|
||||
|
||||
@@ -548,9 +713,11 @@ assertz_clause(Head, Body) :-
|
||||
arg(1, Head, Module),
|
||||
arg(2, Head, F),
|
||||
module_assertz_clause(F, Body, Module)
|
||||
; '$no_such_predicate'(Head) -> call_assertz(Head, Body, Name, Arity)
|
||||
; '$head_is_dynamic'(Head) -> call_assertz(Head, Body, Name, Arity)
|
||||
; throw(error(permission_error(modify, static_procedure, Name/Arity), assertz/1))
|
||||
; '$no_such_predicate'(Head) ->
|
||||
call_assertz(Head, Body, Name, Arity)
|
||||
; '$head_is_dynamic'(Head) ->
|
||||
call_assertz(Head, Body, Name, Arity)
|
||||
; throw(error(permission_error(modify, static_procedure, Name/Arity), assertz/1))
|
||||
)
|
||||
; throw(error(type_error(callable, Head), assertz/1))
|
||||
).
|
||||
@@ -561,12 +728,13 @@ assertz(Clause) :-
|
||||
).
|
||||
|
||||
first_match_index([Clause0 | Clauses], Clause1, N0, N) :-
|
||||
( Clause0 \= Clause1 -> N1 is N0 + 1,
|
||||
first_match_index(Clauses, Clause1, N1, N)
|
||||
( Clause0 \= Clause1 ->
|
||||
N1 is N0 + 1,
|
||||
first_match_index(Clauses, Clause1, N1, N)
|
||||
; N0 = N, Clause0 = Clause1
|
||||
).
|
||||
|
||||
retract_clauses([Clause|Clauses0], Head, Body, Name, Arity) :-
|
||||
retract_clauses([Clause | Clauses0], Head, Body, Name, Arity) :-
|
||||
functor(VarHead, Name, Arity),
|
||||
findall((VarHead :- VarBody), clause(VarHead, VarBody), Clauses1),
|
||||
first_match_index(Clauses1, (Head :- Body), 0, N),
|
||||
@@ -574,7 +742,7 @@ retract_clauses([Clause|Clauses0], Head, Body, Name, Arity) :-
|
||||
; true
|
||||
),
|
||||
'$retract_clause'(Name, Arity, N, Clauses1).
|
||||
retract_clauses([_|Clauses0], Head, Body, Name, Arity) :-
|
||||
retract_clauses([_ | Clauses0], Head, Body, Name, Arity) :-
|
||||
retract_clauses(Clauses0, Head, Body, Name, Arity).
|
||||
|
||||
call_retract(Head, Body, Name, Arity) :-
|
||||
@@ -764,10 +932,10 @@ atom_chars(Atom, List) :-
|
||||
),
|
||||
( var(Atom) ->
|
||||
( var(Tail) -> throw(error(instantiation_error, atom_chars/2))
|
||||
; ground(List), Tail == [] -> '$atom_chars'(Atom, List)
|
||||
; ground(List) -> '$atom_chars'(Atom, List)
|
||||
; throw(error(instantiation_error, atom_chars/2))
|
||||
)
|
||||
; atom(Atom) -> can_be_chars_or_vars(List, atom_chars/2), '$atom_chars'(Atom, List)
|
||||
; atom(Atom) -> '$atom_chars'(Atom, List)
|
||||
; throw(error(type_error(atom, Atom), atom_chars/2))
|
||||
).
|
||||
|
||||
@@ -781,7 +949,7 @@ atom_codes(Atom, List) :-
|
||||
; ground(List), Tail == [] -> '$atom_codes'(Atom, List)
|
||||
; throw(error(instantiation_error, atom_codes/2))
|
||||
)
|
||||
; atom(Atom) -> can_be_codes_or_vars(List, atom_codes/2), '$atom_codes'(Atom, List)
|
||||
; atom(Atom) -> '$atom_codes'(Atom, List)
|
||||
; throw(error(type_error(atom, Atom), atom_codes/2))
|
||||
).
|
||||
|
||||
@@ -838,11 +1006,11 @@ char_code(Char, Code) :-
|
||||
).
|
||||
|
||||
get_char(C) :-
|
||||
( var(C) -> '$get_char'(C)
|
||||
; C == end_of_file -> '$get_char'(C)
|
||||
; atom_length(C, 1) -> '$get_char'(C)
|
||||
; throw(error(type_error(in_character, C), get_char/1))
|
||||
).
|
||||
current_input(S),
|
||||
'$get_char'(S, C).
|
||||
|
||||
get_char(S, C) :-
|
||||
'$get_char'(S, C).
|
||||
|
||||
can_be_number(N, PI) :-
|
||||
( var(N) -> true
|
||||
@@ -859,37 +1027,6 @@ must_be_number(N, PI) :-
|
||||
; throw(error(instantiation_error, PI))
|
||||
).
|
||||
|
||||
can_be_chars_or_vars(Cs, _) :- var(Cs), !.
|
||||
can_be_chars_or_vars(Cs, PI) :- chars_or_vars(Cs, PI).
|
||||
|
||||
chars_or_vars([], _).
|
||||
chars_or_vars([C|Cs], PI) :-
|
||||
( nonvar(C) ->
|
||||
( catch(atom_length(C, 1), _, false) ->
|
||||
( nonvar(Cs) -> chars_or_vars(Cs, PI)
|
||||
; false
|
||||
)
|
||||
; throw(error(type_error(character, C), PI))
|
||||
)
|
||||
; chars_or_vars(Cs, PI)
|
||||
).
|
||||
|
||||
can_be_codes_or_vars(Cs, _) :- var(Cs), !.
|
||||
can_be_codes_or_vars(Cs, PI) :- codes_or_vars(Cs, PI).
|
||||
|
||||
codes_or_vars([], _).
|
||||
codes_or_vars([C|Cs], PI) :-
|
||||
( nonvar(C) ->
|
||||
( catch(char_code(_, C), _, false) ->
|
||||
( nonvar(Cs) -> codes_or_vars(Cs, PI)
|
||||
; false
|
||||
)
|
||||
; integer(C) -> throw(error(representation_error(character_code), PI))
|
||||
; throw(error(type_error(integer, C), PI))
|
||||
)
|
||||
; codes_or_vars(Cs, PI)
|
||||
).
|
||||
|
||||
number_chars(N, Chs) :-
|
||||
( ground(Chs)
|
||||
-> can_be_number(N, number_chars/2),
|
||||
@@ -929,3 +1066,226 @@ subsumes_term(General, Specific) :-
|
||||
).
|
||||
|
||||
unify_with_occurs_check(X, Y) :- '$unify_with_occurs_check'(X, Y).
|
||||
|
||||
current_input(S) :- '$current_input'(S).
|
||||
|
||||
current_output(S) :- '$current_output'(S).
|
||||
|
||||
set_input(S) :-
|
||||
( var(S) ->
|
||||
throw(error(instantiation_error, set_input/1))
|
||||
; '$set_input'(S)
|
||||
).
|
||||
|
||||
set_output(S) :-
|
||||
( var(S) ->
|
||||
throw(error(instantiation_error, set_output/1))
|
||||
; '$set_output'(S)
|
||||
).
|
||||
|
||||
|
||||
parse_stream_options(Options, OptionValues, Stub) :-
|
||||
DefaultOptions = [alias-[], eof_action-eof_code, reposition-false, type-text],
|
||||
parse_options_list(Options, parse_stream_options_, DefaultOptions, OptionValues, Stub).
|
||||
|
||||
|
||||
parse_stream_options_(type(Type), type-Type) :-
|
||||
( nonvar(Type), lists:member(Type, [text, binary]), !, true
|
||||
;
|
||||
throw(error(domain_error(stream_option, type(Type)), _))
|
||||
).
|
||||
parse_stream_options_(reposition(Bool), reposition-Bool) :-
|
||||
( nonvar(Bool), lists:member(Bool, [true, false]), !, true
|
||||
;
|
||||
throw(error(domain_error(stream_option, reposition(Bool)), _))
|
||||
).
|
||||
parse_stream_options_(alias(A), alias-A) :-
|
||||
( atom(A), A \== [], !, true
|
||||
;
|
||||
throw(error(domain_error(stream_option, alias(A)), _))
|
||||
).
|
||||
parse_stream_options_(eof_action(Action), eof_action-Action) :-
|
||||
( nonvar(Action), lists:member(Action, [eof_code, error, reset]), !, true
|
||||
;
|
||||
throw(error(domain_error(stream_option, eof_action(Action)), _))
|
||||
).
|
||||
parse_stream_options_(E, _) :-
|
||||
throw(error(domain_error(stream_option, E), _)). % 8.11.5.3i)
|
||||
|
||||
|
||||
open(SourceSink, Mode, Stream) :-
|
||||
open(SourceSink, Mode, Stream, []).
|
||||
|
||||
open(SourceSink, Mode, Stream, StreamOptions) :-
|
||||
( var(SourceSink) ->
|
||||
throw(error(instantiation_error, open/4)) % 8.11.5.3a)
|
||||
; var(Mode) ->
|
||||
throw(error(instantiation_error, open/4)) % 8.11.5.3b)
|
||||
; \+ atom(Mode) ->
|
||||
throw(error(type_error(atom, Mode), open/4)) % 8.11.5.3d)
|
||||
; nonvar(Stream) ->
|
||||
throw(error(type_error(variable, Stream), open/4)) % 8.11.5.3f)
|
||||
;
|
||||
parse_stream_options(StreamOptions, [Alias, EOFAction, Reposition, Type], open/4),
|
||||
'$open'(SourceSink, Mode, Stream, Alias, EOFAction, Reposition, Type)
|
||||
).
|
||||
|
||||
|
||||
parse_close_options(Options, OptionValues, Stub) :-
|
||||
DefaultOptions = [force-false],
|
||||
parse_options_list(Options, parse_close_options_, DefaultOptions, OptionValues, Stub).
|
||||
|
||||
parse_close_options_(force(Force), force-Force) :-
|
||||
( nonvar(Force), lists:member(Force, [true, false]), !
|
||||
;
|
||||
throw(error(domain_error(close_option, force(Force)), _))
|
||||
).
|
||||
parse_close_options_(E, _) :-
|
||||
throw(error(domain_error(close_option, E), _)).
|
||||
|
||||
|
||||
close(Stream, CloseOptions) :-
|
||||
parse_close_options(CloseOptions, [Force], close/2),
|
||||
'$close'(Stream, CloseOptions).
|
||||
|
||||
close(Stream) :-
|
||||
'$close'(Stream, []).
|
||||
|
||||
|
||||
flush_output(S) :-
|
||||
'$flush_output'(S).
|
||||
|
||||
flush_output :-
|
||||
current_output(S),
|
||||
'$flush_output'(S).
|
||||
|
||||
|
||||
get_byte(S, B) :-
|
||||
'$get_byte'(S, B).
|
||||
|
||||
get_byte(B) :-
|
||||
current_input(S),
|
||||
'$get_byte'(S, B).
|
||||
|
||||
|
||||
put_char(C) :-
|
||||
current_output(S),
|
||||
'$put_char'(S, C).
|
||||
|
||||
put_char(S, C) :-
|
||||
'$put_char'(S, C).
|
||||
|
||||
|
||||
put_byte(C) :-
|
||||
current_output(S),
|
||||
'$put_byte'(S, C).
|
||||
|
||||
put_byte(S, C) :-
|
||||
'$put_byte'(S, C).
|
||||
|
||||
|
||||
put_code(C) :-
|
||||
current_output(S),
|
||||
'$put_code'(S, C).
|
||||
|
||||
put_code(S, C) :-
|
||||
'$put_code'(S, C).
|
||||
|
||||
|
||||
get_code(C) :-
|
||||
current_input(S),
|
||||
'$get_code'(S, C).
|
||||
|
||||
get_code(S, C) :-
|
||||
'$get_code'(S, C).
|
||||
|
||||
|
||||
peek_byte(S, B) :-
|
||||
'$peek_byte'(S, B).
|
||||
|
||||
peek_byte(B) :-
|
||||
current_input(S),
|
||||
'$peek_byte'(S, B).
|
||||
|
||||
|
||||
peek_code(C) :-
|
||||
current_input(S),
|
||||
'$peek_code'(S, C).
|
||||
|
||||
peek_code(S, C) :-
|
||||
'$peek_code'(S, C).
|
||||
|
||||
|
||||
peek_char(C) :-
|
||||
current_input(S),
|
||||
'$peek_char'(S, C).
|
||||
|
||||
peek_char(S, C) :-
|
||||
'$peek_char'(S, C).
|
||||
|
||||
|
||||
check_stream_property(file_name(F), file_name, F) :-
|
||||
( var(F) -> true ; atom(F) ).
|
||||
check_stream_property(mode(M), mode, M) :-
|
||||
( var(M) -> true ; lists:member(M, [read, write, append]) ).
|
||||
check_stream_property(D, direction, D) :-
|
||||
( var(D) -> true ; lists:member(D, [input, output, input_output]), ! ).
|
||||
check_stream_property(alias(A), alias, A) :-
|
||||
( var(A) -> true ; atom(A) ).
|
||||
check_stream_property(position(P), position, P) :-
|
||||
( var(P) -> true ; integer(P), P >= 0 ).
|
||||
check_stream_property(end_of_stream(E), end_of_stream, E) :-
|
||||
( var(E) -> true ; lists:member(E, [not, at, past]) ).
|
||||
check_stream_property(eof_action(A), eof_action, A) :-
|
||||
( var(A) -> true ; lists:member(A, [error, eof_code, reset]) ).
|
||||
check_stream_property(reposition(B), reposition, B) :-
|
||||
( var(B) -> true ; lists:member(B, [true, false]) ).
|
||||
check_stream_property(type(T), type, T) :-
|
||||
( var(T) -> true ; lists:member(T, [text, binary]) ).
|
||||
|
||||
|
||||
stream_iter_(S, S).
|
||||
stream_iter_(S, S1) :-
|
||||
'$next_stream'(S, S0),
|
||||
stream_iter_(S0, S1).
|
||||
|
||||
stream_iter(S) :-
|
||||
( nonvar(S) ->
|
||||
true
|
||||
; '$first_stream'(S0),
|
||||
stream_iter_(S0, S)
|
||||
).
|
||||
|
||||
|
||||
stream_property(S, P) :-
|
||||
( nonvar(P), \+ check_stream_property(P, _, _) ->
|
||||
throw(error(domain_error(stream_property, P), stream_property/2))
|
||||
; stream_iter(S),
|
||||
check_stream_property(P, PropertyName, PropertyValue),
|
||||
'$stream_property'(S, PropertyName, PropertyValue)
|
||||
).
|
||||
|
||||
|
||||
at_end_of_stream(S_or_a) :-
|
||||
( atom(S_or_a) ->
|
||||
stream_property(S, alias(S_or_a))
|
||||
; S = S_or_a
|
||||
),
|
||||
stream_property(S, end_of_stream(E)),
|
||||
( E = at -> true ; E = past ).
|
||||
|
||||
at_end_of_stream :-
|
||||
current_input(S),
|
||||
stream_property(S, end_of_stream(E)),
|
||||
!,
|
||||
( E = at ; E = past ).
|
||||
|
||||
|
||||
set_stream_position(S_or_a, Position) :-
|
||||
( var(Position) ->
|
||||
throw(error(instantiation_error, set_stream_position/2))
|
||||
; integer(Position), Position >= 0 ->
|
||||
true
|
||||
; throw(error(domain_error(stream_position, Position)))
|
||||
),
|
||||
'$set_stream_position'(S_or_a, Position).
|
||||
|
||||
164
src/prolog/lib/charsio.pl
Normal file
164
src/prolog/lib/charsio.pl
Normal file
@@ -0,0 +1,164 @@
|
||||
:- module(charsio, [char_type/2,
|
||||
chars_utf8bytes/2,
|
||||
get_single_char/1,
|
||||
read_term_from_chars/2,
|
||||
write_term_to_chars/3]).
|
||||
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(iso_ext)).
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(lists)).
|
||||
|
||||
fabricate_var_name(VarType, VarName, N) :-
|
||||
char_code('A', AC),
|
||||
LN is N mod 26 + AC,
|
||||
char_code(LC, LN),
|
||||
NN is N // 26,
|
||||
( NN =:= 0 ->
|
||||
( VarType == fabricated ->
|
||||
atom_chars(VarName, ['_', LC])
|
||||
; VarType == numbervars ->
|
||||
atom_chars(VarName, [LC])
|
||||
)
|
||||
; number_chars(NN, NNChars),
|
||||
( VarType == fabricated ->
|
||||
atom_chars(VarName, ['_', LC | NNChars])
|
||||
; VarType == numbervars ->
|
||||
atom_chars(VarName, [LC | NNChars])
|
||||
)
|
||||
).
|
||||
|
||||
var_list_contains_name([VarName = _ | VarList], VarName0) :-
|
||||
( VarName == VarName0 -> true
|
||||
; var_list_contains_name(VarList, VarName0)
|
||||
).
|
||||
|
||||
var_list_contains_variable([_ = Var | VarList], Var0) :-
|
||||
( Var == Var0 -> true
|
||||
; var_list_contains_variable(VarList, Var0)
|
||||
).
|
||||
|
||||
make_new_var_name(VarType, V, VarName, N, N1, VarList) :-
|
||||
fabricate_var_name(VarType, VarName0, N),
|
||||
( var_list_contains_name(VarList, VarName0) ->
|
||||
N0 is N + 1,
|
||||
make_new_var_name(VarType, V, VarName, N0, N1, VarList)
|
||||
; VarName = VarName0,
|
||||
N1 is N + 1
|
||||
).
|
||||
|
||||
extend_var_list(Vars, VarList, NewVarList, VarType) :-
|
||||
extend_var_list_(Vars, 0, VarList, NewVarList0, VarType),
|
||||
append(VarList, NewVarList0, NewVarList).
|
||||
|
||||
extend_var_list_([], _, VarList, [], _).
|
||||
extend_var_list_([V|Vs], N, VarList, NewVarList, VarType) :-
|
||||
( var_list_contains_variable(VarList, V) ->
|
||||
extend_var_list_(Vs, N, VarList, NewVarList, VarType)
|
||||
; make_new_var_name(VarType, V, VarName, N, N1, VarList),
|
||||
NewVarList = [VarName = V | NewVarList0],
|
||||
extend_var_list_(Vs, N1, VarList, NewVarList0, VarType)
|
||||
).
|
||||
|
||||
|
||||
char_type(Char, Type) :-
|
||||
( var(Char) -> instantiation_error(char_type/2)
|
||||
; atom_length(Char, 1) ->
|
||||
( ground(Type) ->
|
||||
( ctype(Type) ->
|
||||
'$char_type'(Char, Type)
|
||||
; domain_error(char_type, Type, char_type/2)
|
||||
)
|
||||
; ctype(Type),
|
||||
'$char_type'(Char, Type)
|
||||
)
|
||||
; type_error(in_character, Char, char_type/2)
|
||||
).
|
||||
|
||||
|
||||
ctype(alnum).
|
||||
ctype(alpha).
|
||||
ctype(alphabetic).
|
||||
ctype(ascii).
|
||||
ctype(ascii_graphic).
|
||||
ctype(ascii_punctuation).
|
||||
ctype(binary_digit).
|
||||
ctype(control).
|
||||
ctype(decimal_digit).
|
||||
ctype(exponent).
|
||||
ctype(graphic).
|
||||
ctype(hexadecimal_digit).
|
||||
ctype(layout).
|
||||
ctype(lower).
|
||||
ctype(meta).
|
||||
ctype(numeric).
|
||||
ctype(octal_digit).
|
||||
ctype(prolog).
|
||||
ctype(sign).
|
||||
ctype(solo).
|
||||
ctype(symbolic_control).
|
||||
ctype(symbolic_hexadecimal).
|
||||
ctype(upper).
|
||||
ctype(whitespace).
|
||||
|
||||
|
||||
get_single_char(C) :-
|
||||
( var(C) -> '$get_single_char'(C)
|
||||
; atom_length(C, 1) -> '$get_single_char'(C)
|
||||
; type_error(in_character, C, get_single_char/1)
|
||||
).
|
||||
|
||||
|
||||
read_term_from_chars(Chars, Term) :-
|
||||
( var(Chars) ->
|
||||
instantiation_error(read_term_from_chars/2)
|
||||
; nonvar(Term) ->
|
||||
throw(error(uninstantiation_error(Term), read_term_from_chars/2))
|
||||
; '$skip_max_list'(_, -1, Chars, Chars0),
|
||||
Chars0 == [],
|
||||
partial_string(Chars) ->
|
||||
true
|
||||
;
|
||||
type_error(complete_string, Chars, read_term_from_chars/2)
|
||||
),
|
||||
'$read_term_from_chars'(Chars, Term).
|
||||
|
||||
|
||||
write_term_to_chars(_, Options, _) :-
|
||||
var(Options), instantiation_error(write_term_to_chars/3).
|
||||
write_term_to_chars(Term, Options, Chars) :-
|
||||
builtins:parse_write_options(Options,
|
||||
[IgnoreOps, MaxDepth, NumberVars, Quoted, VNNames],
|
||||
write_term_to_chars/3),
|
||||
( nonvar(Chars) ->
|
||||
throw(error(uninstantiation_error(Chars), write_term_to_chars/3))
|
||||
;
|
||||
true
|
||||
),
|
||||
term_variables(Term, Vars),
|
||||
extend_var_list(Vars, VNNames, NewVarNames, numbervars),
|
||||
'$write_term_to_chars'(Chars, Term, IgnoreOps, NumberVars, Quoted, NewVarNames, MaxDepth).
|
||||
|
||||
% Encodes Ch character to list of Bytes.
|
||||
% TODO: if Ch is variable, decode Bytes to Char.
|
||||
char_utf8bytes(Ch, Bytes) :-
|
||||
char_code(Ch, Code),
|
||||
phrase(code_to_utf8(Code), Bytes).
|
||||
|
||||
code_to_utf8(Code) --> {Code @< 0x80}, [Code], !.
|
||||
code_to_utf8(Code) --> {Code @< 0x800}, encode(Code, 0xC0, 2), !.
|
||||
code_to_utf8(Code) --> {Code @< 0x10000}, encode(Code, 0xE0, 3), !.
|
||||
code_to_utf8(Code) --> {Code @< 0x110000}, encode(Code, 0xF0, 4), !.
|
||||
|
||||
encode(_, _, 0) --> !.
|
||||
encode(Code, Prefix, Nb) -->
|
||||
{ Nb1 is Nb - 1, Byte is Prefix \/ ((Code >> (6 * Nb1)) /\ 0x3F) },
|
||||
[Byte], encode(Code, 0x80, Nb1).
|
||||
|
||||
% Encodes a list of characters Cs to a list of UTF-8 bytes Bs.
|
||||
% TODO: if Cs is variable, decode bytes to chars instead.
|
||||
chars_utf8bytes(Cs, Bs) :-
|
||||
must_be(list, Cs),
|
||||
maplist(must_be(atom), Cs),
|
||||
maplist(char_utf8bytes, Cs, Bss),
|
||||
append(Bss, Bs).
|
||||
@@ -16,11 +16,9 @@
|
||||
Public operators.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
:- op(300, fy, ~).
|
||||
:- op(500, yfx, #).
|
||||
|
||||
:- module(clpb, [
|
||||
sat/1,
|
||||
:- module(clpb, [op(300, fy, ~),
|
||||
op(500, yfx, #),
|
||||
sat/1,
|
||||
taut/2,
|
||||
labeling/1,
|
||||
sat_count/2,
|
||||
@@ -32,9 +30,11 @@
|
||||
:- use_module(library(between)).
|
||||
:- use_module(library(atts)).
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(non_iso)).
|
||||
:- use_module(library(iso_ext)).
|
||||
:- use_module(library(random)).
|
||||
:- use_module(library(pairs)).
|
||||
:- use_module(library(dcgs)).
|
||||
%:- use_module(library(types)).
|
||||
:- use_module(library(error), [domain_error/3, type_error/3]).
|
||||
|
||||
:- attribute
|
||||
clpb/1,
|
||||
@@ -77,8 +77,8 @@ must_be(list(What), Where, Term) :- !,
|
||||
must_be(ground, _, Term) :- !,
|
||||
functor(Term, _, _).
|
||||
|
||||
must_be(Type, Goal-Arg, Term) :-
|
||||
must_be(Term, Type, Goal, Arg).
|
||||
must_be(Type, _, Term) :-
|
||||
error:must_be(Type, Term).
|
||||
|
||||
clpz_list(Nil, _) :- Nil == [].
|
||||
clpz_list(Ls, Where) :-
|
||||
@@ -87,7 +87,6 @@ clpz_list(Ls, Where) :-
|
||||
; Ls = [_|Rest],
|
||||
clpz_list(Rest, Where)
|
||||
).
|
||||
|
||||
|
||||
|
||||
instantiation_error(Term) :- instantiation_error(Term, unknown(Term)-1).
|
||||
@@ -99,72 +98,14 @@ instantiation_error(_, Goal-Arg) :-
|
||||
domain_error(Expectation, Term) :-
|
||||
domain_error(Expectation, Term, unknown(Term)-1).
|
||||
|
||||
domain_error(Expectation, Term, Goal-Arg) :-
|
||||
throw(error(domain_error(Expectation, Term), domain_error(Goal, Arg, Expectation, Term))).
|
||||
|
||||
|
||||
type_error(Expectation, Term) :-
|
||||
type_error(Expectation, Term, unknown(Term)-1).
|
||||
|
||||
type_error(Expectation, Term, Goal-Arg) :-
|
||||
throw(error(type_error(Expectation, Term), type_error(Goal, Arg, Expectation, Term))).
|
||||
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
foldl/4
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
foldl(Goal_3, Ls, A0, A) :-
|
||||
foldl_(Ls, Goal_3, A0, A).
|
||||
|
||||
foldl_([], _, A, A).
|
||||
foldl_([L|Ls], G_3, A0, A) :-
|
||||
call(G_3, L, A0, A1),
|
||||
foldl_(Ls, G_3, A1, A).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
foldl/5
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
foldl(Goal_4, Xs, Ys, A0, A) :-
|
||||
foldl_(Xs, Ys, Goal_4, A0, A).
|
||||
|
||||
foldl_([], [], _, A, A).
|
||||
foldl_([X|Xs], [Y|Ys], G_4, A0, A) :-
|
||||
call(G_4, X, Y, A0, A1),
|
||||
foldl_(Xs, Ys, G_4, A1, A).
|
||||
|
||||
|
||||
partition(Pred, Ls0, As, Bs) :-
|
||||
include(Pred, Ls0, As),
|
||||
exclude(Pred, Ls0, Bs).
|
||||
|
||||
sum_list(Ls, S) :- sumlist(Ls, S).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Pairs.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
pairs_keys_values([], [], []).
|
||||
pairs_keys_values([A-B|ABs], [A|As], [B|Bs]) :-
|
||||
pairs_keys_values(ABs, As, Bs).
|
||||
|
||||
pairs_keys(Ps, Ks) :- pairs_keys_values(Ps, Ks, _).
|
||||
|
||||
pairs_values(Ps, Vs) :- pairs_keys_values(Ps, _, Vs).
|
||||
|
||||
map_list_to_pairs(Pred, Ls, Ps) :-
|
||||
map_list_to_pairs2(Ls, Pred, Ps).
|
||||
|
||||
map_list_to_pairs2([], _, []).
|
||||
map_list_to_pairs2([H|T0], Pred, [K-H|T]) :-
|
||||
call(Pred, H, K),
|
||||
map_list_to_pairs2(T0, Pred, T).
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
goal_expansion(get_attr(Var, Module, Value), (var(Var),get_atts(Var, Access))) :-
|
||||
Access =.. [Module,Value].
|
||||
|
||||
@@ -728,10 +669,6 @@ existential(V, BDD, Node) :-
|
||||
Counter network for card(Is,Fs).
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
same_length([], []).
|
||||
same_length([_|As], [_|Bs]) :-
|
||||
same_length(As, Bs).
|
||||
|
||||
counter_network(Cs, Fs, Node) :-
|
||||
same_length([_|Fs], Indicators),
|
||||
fill_indicators(Indicators, 0, Cs),
|
||||
@@ -1242,8 +1179,7 @@ bdd_count(Node, VNum, Count) :-
|
||||
bdd_count(High, VNum, HCount),
|
||||
bdd_pow(Low, V, VNum, LPow),
|
||||
bdd_pow(High, V, VNum, HPow),
|
||||
Count0 is LPow*LCount + HPow*HCount,
|
||||
Count = Count0
|
||||
Count is LPow*LCount + HPow*HCount
|
||||
)
|
||||
).
|
||||
|
||||
|
||||
7622
src/prolog/lib/clpz.pl
Normal file
7622
src/prolog/lib/clpz.pl
Normal file
File diff suppressed because it is too large
Load Diff
30
src/prolog/lib/cont.pl
Normal file
30
src/prolog/lib/cont.pl
Normal file
@@ -0,0 +1,30 @@
|
||||
:- module(cont, [reset/3, shift/1]).
|
||||
|
||||
reset(Goal, Ball, Cont) :-
|
||||
call(Goal),
|
||||
'$reset_cont_marker',
|
||||
'$bind_from_register'(Cont, 3),
|
||||
'$bind_from_register'(Ball, 4).
|
||||
|
||||
shift(Ball) :-
|
||||
'$nextEP'(first, E, P),
|
||||
get_chunks(E, P, L),
|
||||
( L == [] ->
|
||||
Cont = cont(true)
|
||||
; Cont = cont(call_continuation(L))
|
||||
),
|
||||
'$write_cont_and_term'(_, _, Cont, Ball),
|
||||
'$unwind_environments'.
|
||||
|
||||
get_chunks(E, P, L) :-
|
||||
( '$points_to_cont_reset_marker'(P) ->
|
||||
L = []
|
||||
; '$get_cont_chunk'(E,P,TB),
|
||||
L = [TB|Rest],
|
||||
'$nextEP'(E, NextE, NextP),
|
||||
get_chunks(NextE, NextP, Rest)
|
||||
).
|
||||
|
||||
call_continuation(L) :- '$call_continuation'(L).
|
||||
|
||||
'$write_cont_and_term'(_, _, _, _).
|
||||
875
src/prolog/lib/crypto.pl
Normal file
875
src/prolog/lib/crypto.pl
Normal file
@@ -0,0 +1,875 @@
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Written May 2020 by Markus Triska (triska@metalevel.at)
|
||||
Part of Scryer Prolog.
|
||||
|
||||
Predicates for cryptographic applications.
|
||||
|
||||
This library assumes that the Prolog flag double_quotes is set to chars.
|
||||
In Scryer Prolog, lists of characters are very efficiently represented,
|
||||
and strings have the advantage that the atom table remains unmodified.
|
||||
|
||||
Especially for cryptographic applications, it as an advantage that
|
||||
using strings leaves little trace of what was processed in the system.
|
||||
|
||||
For predicates that accept an encoding/1 option to specify the encoding
|
||||
of the input data, if encoding(octet) is used, then the input can also
|
||||
be specified as a list of bytes, i.e., integers between 0 and 255.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
:- module(crypto,
|
||||
[hex_bytes/2, % ?Hex, ?Bytes
|
||||
crypto_n_random_bytes/2, % +N, -Bytes
|
||||
crypto_data_hash/3, % +Data, -Hash, +Options
|
||||
crypto_data_hkdf/4, % +Data, +Length, -Bytes, +Options
|
||||
crypto_password_hash/2, % +Password, ?Hash
|
||||
crypto_password_hash/3, % +Password, -Hash, +Options
|
||||
crypto_data_encrypt/6, % +PlainText, +Algorithm, +Key, +IV, -CipherText, +Options
|
||||
crypto_data_decrypt/6, % +CipherText, +Algorithm, +Key, +IV, -PlainText, +Options
|
||||
ed25519_new_keypair/1, % -KeyPair
|
||||
ed25519_keypair_public_key/2, % +KeyPair, +PublicKey
|
||||
ed25519_sign/4, % +KeyPair, +Data, -Signature, +Options
|
||||
ed25519_verify/4, % +PublicKey, +Data, +Signature, +Options
|
||||
crypto_name_curve/2, % +Name, -Curve
|
||||
crypto_curve_order/2, % +Curve, -Order
|
||||
crypto_curve_generator/2, % +Curve, -Generator
|
||||
crypto_curve_scalar_mult/4 % +Curve, +Scalar, +Point, -Result
|
||||
]).
|
||||
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(between)).
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(clpz)).
|
||||
:- use_module(library(arithmetic)).
|
||||
:- use_module(library(format)).
|
||||
:- use_module(library(charsio)).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
hex_bytes(?Hex, ?Bytes) is det.
|
||||
|
||||
Relation between a hexadecimal sequence and a list of bytes. Hex
|
||||
is a string of hexadecimal numbers. Bytes is a list of *integers*
|
||||
between 0 and 255 that represent the sequence as a list of bytes.
|
||||
At least one of the arguments must be instantiated.
|
||||
|
||||
Example:
|
||||
|
||||
?- hex_bytes("501ACE", Bs).
|
||||
Bs = [80,26,206]
|
||||
; false.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
hex_bytes(Hs, Bytes) :-
|
||||
( ground(Hs) ->
|
||||
must_be(list, Hs),
|
||||
maplist(must_be(atom), Hs),
|
||||
( phrase(hex_bytes(Hs), Bytes) ->
|
||||
true
|
||||
; domain_error(hex_encoding, Hs, hex_bytes/2)
|
||||
)
|
||||
; must_be_bytes(Bytes, hex_bytes/2),
|
||||
phrase(bytes_hex(Bytes), Hs)
|
||||
).
|
||||
|
||||
hex_bytes([]) --> [].
|
||||
hex_bytes([H1,H2|Hs]) --> [Byte],
|
||||
{ char_hexval(H1, High),
|
||||
char_hexval(H2, Low),
|
||||
Byte is High*16 + Low },
|
||||
hex_bytes(Hs).
|
||||
|
||||
bytes_hex([]) --> [].
|
||||
bytes_hex([B|Bs]) --> [C0,C1],
|
||||
{ High is B>>4,
|
||||
Low is B /\ 0xf,
|
||||
char_hexval(C0, High),
|
||||
char_hexval(C1, Low)
|
||||
},
|
||||
bytes_hex(Bs).
|
||||
|
||||
char_hexval(C, H) :- nth0(H, "0123456789abcdef", C), !.
|
||||
char_hexval(C, H) :- nth0(H, "0123456789ABCDEF", C), !.
|
||||
|
||||
|
||||
must_be_bytes(Bytes, Context) :-
|
||||
must_be(list, Bytes),
|
||||
maplist(must_be(integer), Bytes),
|
||||
( member(B, Bytes), \+ between(0, 255, B) ->
|
||||
type_error(byte, B, Context)
|
||||
; true
|
||||
).
|
||||
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Cryptographically secure random numbers
|
||||
=======================================
|
||||
|
||||
crypto_n_random_bytes(+N, -Bytes) is det
|
||||
|
||||
Bytes is unified with a list of N cryptographically secure
|
||||
pseudo-random bytes. Each byte is an integer between 0 and 255. If
|
||||
the internal pseudo-random number generator (PRNG) has not been
|
||||
seeded with enough entropy to ensure an unpredictable byte
|
||||
sequence, an exception is thrown.
|
||||
|
||||
One way to relate such a list of bytes to an _integer_ is to use
|
||||
CLP(ℤ) constraints as follows:
|
||||
|
||||
:- use_module(library(clpz)).
|
||||
:- use_module(library(lists)).
|
||||
|
||||
bytes_integer(Bs, N) :-
|
||||
foldl(pow, Bs, 0-0, N-_).
|
||||
|
||||
pow(B, N0-I0, N-I) :-
|
||||
B in 0..255,
|
||||
N #= N0 + B*256^I0,
|
||||
I #= I0 + 1.
|
||||
|
||||
With this definition, we can generate a random 256-bit integer
|
||||
_from_ a list of 32 random _bytes_:
|
||||
|
||||
?- crypto_n_random_bytes(32, Bs),
|
||||
bytes_integer(Bs, I).
|
||||
Bs = [146,166,162,210,242,7,25,132,64,94|...],
|
||||
I = 337420085690608915485...(56 digits omitted)
|
||||
|
||||
The above relation also works in the other direction, letting you
|
||||
translate an integer _to_ a list of bytes. In addition, you can
|
||||
use hex_bytes/2 to convert bytes to _tokens_ that can be easily
|
||||
exchanged in your applications.
|
||||
|
||||
?- crypto_n_random_bytes(12, Bs),
|
||||
hex_bytes(Hex, Bs).
|
||||
Bs = [34,25,50,72,58,63,50,172,32,46|...], Hex = "221932483a3f32ac202 ..."
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
crypto_n_random_bytes(N, Bs) :-
|
||||
must_be(integer, N),
|
||||
length(Bs, N),
|
||||
maplist(crypto_random_byte, Bs).
|
||||
|
||||
crypto_random_byte(B) :- '$crypto_random_byte'(B).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Hashing
|
||||
=======
|
||||
|
||||
crypto_data_hash(+Data, -Hash, +Options)
|
||||
|
||||
Where Data is a list of characters, and Hash is the computed hash
|
||||
as a list of hexadecimal characters.
|
||||
|
||||
Options is a list of:
|
||||
|
||||
- algorithm(+A)
|
||||
where A is one of ripemd160, sha256, sha384, sha512, sha512_256,
|
||||
sha3_224, sha3_256, sha3_384, sha3_512, blake2s256, blake2b512,
|
||||
or a variable. If A is a variable, then it is unified with the
|
||||
default algorithm, which is an algorithm that is considered
|
||||
cryptographically secure at the time of this writing.
|
||||
- encoding(+Encoding)
|
||||
The default encoding is utf8. The alternative is octet,
|
||||
to treat the input as a list of raw bytes.
|
||||
|
||||
Example:
|
||||
|
||||
?- crypto_data_hash("abc", Hs, [algorithm(sha256)]).
|
||||
Hs = "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad"
|
||||
; false.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
SHA256 is the current default for several hash-related predicates.
|
||||
It is deemed sufficiently secure for the foreseeable future. Yet,
|
||||
application programmers must be aware that the default may change in
|
||||
future versions. The hash predicates all yield the algorithm they
|
||||
used if a Prolog variable is used for the pertaining option.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
crypto_data_hash(Data0, Hash, Options0) :-
|
||||
must_be(list, Options0),
|
||||
options_data_bytes(Options0, Data0, Data),
|
||||
functor_hash_options(algorithm, A, Options0, _),
|
||||
( hash_algorithm(A) -> true
|
||||
; domain_error(hash_algorithm, A, crypto_data_hash/3)
|
||||
),
|
||||
'$crypto_data_hash'(Data, HashBytes, A),
|
||||
hex_bytes(Hash, HashBytes).
|
||||
|
||||
options_data_bytes(Options, Data, Bytes) :-
|
||||
option(encoding(Encoding), Options, utf8),
|
||||
must_be(atom, Encoding),
|
||||
encoding_bytes(Encoding, Data, Bytes).
|
||||
|
||||
default_hash(sha256).
|
||||
|
||||
functor_hash_options(F, Hash, Options0, [Option|Options]) :-
|
||||
Option =.. [F,Hash],
|
||||
( select(Option, Options0, Options) ->
|
||||
( var(Hash) ->
|
||||
default_hash(Hash)
|
||||
; must_be(atom, Hash)
|
||||
)
|
||||
; Options = Options0,
|
||||
default_hash(Hash)
|
||||
).
|
||||
|
||||
hash_algorithm(ripemd160).
|
||||
hash_algorithm(sha256).
|
||||
hash_algorithm(sha512).
|
||||
hash_algorithm(sha384).
|
||||
hash_algorithm(sha512_256).
|
||||
hash_algorithm(sha3_224).
|
||||
hash_algorithm(sha3_256).
|
||||
hash_algorithm(sha3_384).
|
||||
hash_algorithm(sha3_512).
|
||||
hash_algorithm(blake2s256).
|
||||
hash_algorithm(blake2b512).
|
||||
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
crypto_data_hkdf(+Data, +Length, -Bytes, +Options) is det.
|
||||
|
||||
Concentrate possibly dispersed entropy of Data and then expand it
|
||||
to the desired length. Data is a list of characters.
|
||||
|
||||
Bytes is unified with a list of bytes of length Length, and is
|
||||
suitable as input keying material and initialization vectors to
|
||||
symmetric encryption algorithms.
|
||||
|
||||
Admissible options are:
|
||||
|
||||
- algorithm(+Algorithm)
|
||||
One of sha256, sha384 or sha512. If you specify a variable,
|
||||
then it is unified with the algorithm that was used, which is a
|
||||
cryptographically secure algorithm by default.
|
||||
- info(+Info)
|
||||
Optional context and application specific information,
|
||||
specified as a list of characters. The default is [].
|
||||
- salt(+List)
|
||||
Optionally, a list of bytes that are used as salt. The
|
||||
default is all zeroes.
|
||||
- encoding(+Encoding)
|
||||
The default encoding is utf8. The alternative is octet,
|
||||
to treat the input as a list of raw bytes.
|
||||
|
||||
The `info/1` option can be used to generate multiple keys from a
|
||||
single master key, using for example values such as "key" and
|
||||
"iv", or the name of a file that is to be encrypted.
|
||||
|
||||
See crypto_n_random_bytes/2 to obtain a suitable salt.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
crypto_data_hkdf(Data0, L, Bytes, Options0) :-
|
||||
functor_hash_options(algorithm, Algorithm, Options0, Options),
|
||||
( hkdf_algorithm(Algorithm) -> true
|
||||
; domain_error(hkdf_algorithm, Algorithm, crypto_data_hkdf/4)
|
||||
),
|
||||
must_be(integer, L),
|
||||
L >= 0,
|
||||
options_data_bytes(Options, Data0, Data),
|
||||
option(salt(SaltBytes), Options, []),
|
||||
must_be_bytes(SaltBytes, crypto_data_hkdf/4),
|
||||
option(info(Info0), Options, []),
|
||||
chars_bytes_(Info0, Info, crypto_data_hkdf/4),
|
||||
'$crypto_data_hkdf'(Data, SaltBytes, Info, Algorithm, L, Bytes).
|
||||
|
||||
hkdf_algorithm(sha256).
|
||||
hkdf_algorithm(sha384).
|
||||
hkdf_algorithm(sha512).
|
||||
|
||||
option(What, Options, Default) :-
|
||||
( member(V, Options), var(V) ->
|
||||
instantiation_error(option/3)
|
||||
; true
|
||||
),
|
||||
( member(What, Options) -> true
|
||||
; What =.. [_,Default]
|
||||
).
|
||||
|
||||
chars_bytes_(Cs, Bytes, Context) :-
|
||||
must_be(list, Cs),
|
||||
( maplist(integer, Cs) -> Bytes = Cs
|
||||
; chars_utf8bytes(Cs, Bytes)
|
||||
),
|
||||
must_be_bytes(Bytes, Context).
|
||||
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
The so-called modular crypt format (MCF) is a standard for encoding
|
||||
password hash strings. However, there's no official specification
|
||||
document describing it. Nor is there a central registry of
|
||||
identifiers or rules. This page describes what is known about it:
|
||||
|
||||
https://pythonhosted.org/passlib/modular_crypt_format.html
|
||||
|
||||
As of 2016, the MCF is deprecated in favor of the PHC String Format:
|
||||
|
||||
https://github.com/P-H-C/phc-string-format/blob/master/phc-sf-spec.md
|
||||
|
||||
This is what we are using below. For the time being, it is best to
|
||||
treat these hashes as opaque terms in applications. Please let me
|
||||
know if you need to rely on any specifics of this format.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
crypto_password_hash(+Password, ?Hash) is semidet.
|
||||
|
||||
If Hash is instantiated, the predicate succeeds _iff_ the hash
|
||||
matches the given password. Otherwise, the call is equivalent to
|
||||
crypto_password_hash(Password, Hash, []) and computes a
|
||||
password-based hash using the default options.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
crypto_password_hash(Password0, Hash) :-
|
||||
( nonvar(Hash) ->
|
||||
chars_bytes_(Password0, Password, crypto_password_hash/2),
|
||||
must_be(list, Hash),
|
||||
dollar_segments(Hash, [[],"pbkdf2-sha512",[t,=|CsIterations],SaltB64,HashB64]),
|
||||
number_chars(Iterations, CsIterations),
|
||||
bytes_base64(SaltBytes, SaltB64),
|
||||
bytes_base64(HashBytes, HashB64),
|
||||
'$crypto_password_hash'(Password, SaltBytes, Iterations, HashBytes)
|
||||
; crypto_password_hash(Password0, Hash, [])
|
||||
).
|
||||
|
||||
|
||||
dollar_segments(Ls, Segments) :-
|
||||
( append(Front, [$|Ds], Ls) ->
|
||||
Segments = [Front|Rest],
|
||||
dollar_segments(Ds, Rest)
|
||||
; Segments = [Ls]
|
||||
).
|
||||
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
crypto_password_hash(+Password, -Hash, +Options) is det.
|
||||
|
||||
Derive Hash based on Password. This predicate is similar to
|
||||
crypto_data_hash/3 in that it derives a hash from given data.
|
||||
However, it is tailored for the specific use case of _passwords_.
|
||||
One essential distinction is that for this use case, the derivation
|
||||
of a hash should be _as slow as possible_ to counteract brute-force
|
||||
attacks over possible passwords.
|
||||
|
||||
Another important distinction is that equal passwords must yield,
|
||||
with very high probability, _different_ hashes. For this reason,
|
||||
cryptographically strong random numbers are automatically added to
|
||||
the password before a hash is derived.
|
||||
|
||||
Hash is unified with a string that contains the computed hash and
|
||||
all parameters that were used, except for the password. Instead of
|
||||
storing passwords, store these hashes. Later, you can verify the
|
||||
validity of a password with crypto_password_hash/2, comparing the
|
||||
then entered password to the stored hash. If you need to export this
|
||||
atom, you should treat it as opaque ASCII data with up to 255 bytes
|
||||
of length. The maximal length may increase in the future.
|
||||
|
||||
Admissible options are:
|
||||
|
||||
- algorithm(+Algorithm)
|
||||
The algorithm to use. Currently, the only available algorithm
|
||||
is 'pbkdf2-sha512', which is therefore also the default.
|
||||
- cost(+C)
|
||||
C is an integer, denoting the binary logarithm of the number
|
||||
of _iterations_ used for the derivation of the hash. This
|
||||
means that the number of iterations is set to 2^C. Currently,
|
||||
the default is 17, and thus more than one hundred _thousand_
|
||||
iterations. You should set this option as high as your server
|
||||
and users can tolerate. The default is subject to change and
|
||||
will likely increase in the future or adapt to new algorithms.
|
||||
- salt(+Salt)
|
||||
Use the given list of bytes as salt. By default,
|
||||
cryptographically secure random numbers are generated for this
|
||||
purpose. The default is intended to be secure, and constitutes
|
||||
the typical use case of this predicate.
|
||||
|
||||
Currently, PBKDF2 with SHA-512 is used as the hash derivation
|
||||
function, using 128 bits of salt. All default parameters, including
|
||||
the algorithm, are subject to change, and other algorithms will also
|
||||
become available in the future. Since computed hashes store all
|
||||
parameters that were used during their derivation, such changes will
|
||||
not affect the operation of existing deployments. Note though that
|
||||
new hashes will then be computed with the new default parameters.
|
||||
|
||||
See crypto_data_hkdf/4 for generating keys from Hash.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
crypto_password_hash(Password0, Hash, Options) :-
|
||||
chars_bytes_(Password0, Password, crypto_password_hash/3),
|
||||
must_be(list, Options),
|
||||
option(cost(C), Options, 17),
|
||||
Iterations is 2^C,
|
||||
Algorithm = 'pbkdf2-sha512', % current default and only option
|
||||
option(algorithm(Algorithm), Options, Algorithm),
|
||||
( member(salt(SaltBytes), Options) ->
|
||||
must_be_bytes(SaltBytes, crypto_password_hash/2)
|
||||
; crypto_n_random_bytes(16, SaltBytes)
|
||||
),
|
||||
'$crypto_password_hash'(Password, SaltBytes, Iterations, HashBytes),
|
||||
bytes_base64(HashBytes, HashB64),
|
||||
bytes_base64(SaltBytes, SaltB64),
|
||||
phrase(format_("$pbkdf2-sha512$t=~d$~s$~s", [Iterations,SaltB64,HashB64]), Hash).
|
||||
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Bidirectional Bytes <-> Base64 conversion
|
||||
=========================================
|
||||
|
||||
This implements Base64 conversion *without padding*.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
n_base64(0 , 'A'). n_base64(1 , 'B'). n_base64(2 , 'C'). n_base64(3 , 'D').
|
||||
n_base64(4 , 'E'). n_base64(5 , 'F'). n_base64(6 , 'G'). n_base64(7 , 'H').
|
||||
n_base64(8 , 'I'). n_base64(9 , 'J'). n_base64(10, 'K'). n_base64(11, 'L').
|
||||
n_base64(12, 'M'). n_base64(13, 'N'). n_base64(14, 'O'). n_base64(15, 'P').
|
||||
n_base64(16, 'Q'). n_base64(17, 'R'). n_base64(18, 'S'). n_base64(19, 'T').
|
||||
n_base64(20, 'U'). n_base64(21, 'V'). n_base64(22, 'W'). n_base64(23, 'X').
|
||||
n_base64(24, 'Y'). n_base64(25, 'Z'). n_base64(26, 'a'). n_base64(27, 'b').
|
||||
n_base64(28, 'c'). n_base64(29, 'd'). n_base64(30, 'e'). n_base64(31, 'f').
|
||||
n_base64(32, 'g'). n_base64(33, 'h'). n_base64(34, 'i'). n_base64(35, 'j').
|
||||
n_base64(36, 'k'). n_base64(37, 'l'). n_base64(38, 'm'). n_base64(39, 'n').
|
||||
n_base64(40, 'o'). n_base64(41, 'p'). n_base64(42, 'q'). n_base64(43, 'r').
|
||||
n_base64(44, 's'). n_base64(45, 't'). n_base64(46, 'u'). n_base64(47, 'v').
|
||||
n_base64(48, 'w'). n_base64(49, 'x'). n_base64(50, 'y'). n_base64(51, 'z').
|
||||
n_base64(52, '0'). n_base64(53, '1'). n_base64(54, '2'). n_base64(55, '3').
|
||||
n_base64(56, '4'). n_base64(57, '5'). n_base64(58, '6'). n_base64(59, '7').
|
||||
n_base64(60, '8'). n_base64(61, '9'). n_base64(62, '+'). n_base64(63, '/').
|
||||
|
||||
bytes_base64(Ls, Bs) :-
|
||||
( list(Bs), maplist(atom, Bs) ->
|
||||
maplist(n_base64, Is, Bs),
|
||||
phrase(bytes_base64_(Ls), Is),
|
||||
Ls ins 0..255
|
||||
; phrase(bytes_base64_(Ls), Is),
|
||||
Is ins 0..63,
|
||||
maplist(n_base64, Is, Bs)
|
||||
).
|
||||
|
||||
list(Ls) :-
|
||||
nonvar(Ls),
|
||||
( Ls = [] -> true
|
||||
; Ls = [_|Rest],
|
||||
list(Rest)
|
||||
).
|
||||
|
||||
bytes_base64_([]) --> [].
|
||||
bytes_base64_([A]) --> [W,X],
|
||||
{ A #= W*4 + X//16,
|
||||
X #= 16*_ }.
|
||||
bytes_base64_([A,B]) --> [W,X,Y],
|
||||
{ A #= W*4 + X//16,
|
||||
B #= (X mod 16)*16 + Y//4,
|
||||
Y #= 4*_ }.
|
||||
bytes_base64_([A,B,C|Ls]) --> [W,X,Y,Z],
|
||||
{ A #= W*4 + X//16,
|
||||
B #= (X mod 16)*16 + Y//4,
|
||||
C #= (Y mod 4)*64 + Z },
|
||||
bytes_base64_(Ls).
|
||||
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
crypto_data_encrypt(+PlainText,
|
||||
+Algorithm,
|
||||
+Key,
|
||||
+IV,
|
||||
-CipherText,
|
||||
+Options).
|
||||
|
||||
Encrypt the given PlainText, using the symmetric algorithm
|
||||
Algorithm, key Key, and initialization vector (or nonce) IV, to
|
||||
give CipherText.
|
||||
|
||||
PlainText must be a list of characters, Key and IV must be lists of
|
||||
bytes, and CipherText is created as a list of characters.
|
||||
|
||||
Keys and IVs can be chosen at random (using for example
|
||||
crypto_n_random_bytes/2) or derived from input keying material (IKM)
|
||||
using for example crypto_data_hkdf/4. This input is often a shared
|
||||
secret, such as a negotiated point on an elliptic curve, or the hash
|
||||
that was computed from a password via crypto_password_hash/3 with a
|
||||
freshly generated and specified _salt_.
|
||||
|
||||
Reusing the same combination of Key and IV typically leaks at least
|
||||
_some_ information about the plaintext. For example, identical
|
||||
plaintexts will then correspond to identical ciphertexts. For some
|
||||
algorithms, reusing an IV with the same Key has disastrous results
|
||||
and can cause the loss of all properties that are otherwise
|
||||
guaranteed. Especially in such cases, an IV is also called a
|
||||
_nonce_ (number used once).
|
||||
|
||||
It is safe to store and transfer the used initialization vector (or
|
||||
nonce) in plain text, but the key _must be kept secret_.
|
||||
|
||||
Currently, the only supported algorithm is 'chacha20-poly1305', a
|
||||
powerful and efficient _authenticated_ encryption scheme, providing
|
||||
secrecy and at the same time reliable protection against undetected
|
||||
_modifications_ of the encrypted data. This is a very good choice
|
||||
for virtually all use cases. It is a stream cipher and can encrypt
|
||||
data of any length up to 256 GB. Further, the encrypted data has
|
||||
exactly the same length as the original, and no padding is used.
|
||||
|
||||
Options:
|
||||
|
||||
- encoding(+Encoding)
|
||||
Encoding to use for PlainText. Default is utf8. The alternative
|
||||
is octet to treat PlainText as raw bytes.
|
||||
|
||||
- tag(-List)
|
||||
For authenticated encryption schemes, List is unified with a
|
||||
list of _bytes_ holding the tag. This tag must be provided for
|
||||
decryption.
|
||||
|
||||
Here is an example encryption and decryption, using the ChaCha20
|
||||
stream cipher with the Poly1305 authenticator. This cipher uses a
|
||||
256-bit key and a 96-bit nonce, i.e., 32 and 12 _bytes_,
|
||||
respectively:
|
||||
|
||||
?- Algorithm = 'chacha20-poly1305',
|
||||
crypto_n_random_bytes(32, Key),
|
||||
crypto_n_random_bytes(12, IV),
|
||||
crypto_data_encrypt("this text is to be encrypted", Algorithm,
|
||||
Key, IV, CipherText, [tag(Tag)]),
|
||||
crypto_data_decrypt(CipherText, Algorithm,
|
||||
Key, IV, RecoveredText, [tag(Tag)]).
|
||||
|
||||
Yielding:
|
||||
|
||||
Algorithm = 'chacha20-poly1305',
|
||||
Key = [113,247,153,134,177,220,13,193,50,150|...],
|
||||
IV = [135,20,149,153,63,35,68,114,247,171|...],
|
||||
CipherText = "\x94\0Ej\x94\®Â\x95\óÑÆXÃn¾ð©b\x1c\ ...",
|
||||
RecoveredText = "this text is to be ...",
|
||||
Tag = [152,117,152,17,162,75,150,206,144,40|...]
|
||||
|
||||
In this example, we use crypto_n_random_bytes/2 to generate a key
|
||||
and nonce from cryptographically secure random numbers. For
|
||||
repeated applications, you must ensure that a nonce is only used
|
||||
_once_ together with the same key. Note that for _authenticated_
|
||||
encryption schemes, the _tag_ that was computed during encryption
|
||||
is necessary for decryption. It is safe to store and transfer the
|
||||
tag in plain text.
|
||||
|
||||
See also crypto_data_decrypt/6, and hex_bytes/2 for conversion
|
||||
between bytes and hex encoding.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
crypto_data_encrypt(PlainText0, Algorithm, Key, IV, CipherText, Options) :-
|
||||
options_data_bytes(Options, PlainText0, PlainText),
|
||||
option(tag(Tag), Options, _),
|
||||
( nonvar(Tag) ->
|
||||
must_be_bytes(Tag, crypto_data_encrypt/6)
|
||||
; true
|
||||
),
|
||||
must_be_bytes(Key, crypto_data_encrypt/6),
|
||||
must_be_bytes(IV, crypto_data_encrypt/6),
|
||||
must_be(atom, Algorithm),
|
||||
( Algorithm = 'chacha20-poly1305' -> true
|
||||
; domain_error('chacha20-poly1305', Algorithm, crypto_data_encrypt/6)
|
||||
),
|
||||
'$crypto_data_encrypt'(PlainText, Key, IV, Tag, CipherText).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
crypto_data_decrypt(+CipherText,
|
||||
+Algorithm,
|
||||
+Key,
|
||||
+IV,
|
||||
-PlainText,
|
||||
+Options).
|
||||
|
||||
Decrypt the given CipherText, using the symmetric algorithm
|
||||
Algorithm, key Key, and initialization vector IV, to give
|
||||
PlainText. CipherText must be a list of characters, and Key and IV
|
||||
must be lists of bytes. PlainText is created as a list of
|
||||
characters.
|
||||
|
||||
Currently, the only supported algorithm is 'chacha20-poly1305',
|
||||
a very secure, fast and versatile authenticated encryption method.
|
||||
|
||||
Options is a list of:
|
||||
|
||||
- encoding(+Encoding)
|
||||
Encoding to use for PlainText. The default is utf8. The
|
||||
alternative is octet, which is used if the data are raw bytes.
|
||||
|
||||
- tag(+Tag)
|
||||
For authenticated encryption schemes, the tag must be specified as
|
||||
a list of bytes exactly as they were generated upon encryption.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
crypto_data_decrypt(CipherText0, Algorithm, Key, IV, PlainText, Options) :-
|
||||
option(tag(Tag), Options, []),
|
||||
must_be_bytes(Tag, crypto_data_decrypt/6),
|
||||
must_be_bytes(Key, crypto_data_decrypt/6),
|
||||
must_be_bytes(IV, crypto_data_decrypt/6),
|
||||
must_be(atom, Algorithm),
|
||||
option(encoding(Encoding), Options, utf8),
|
||||
must_be(atom, Encoding),
|
||||
member(Encoding, [utf8,octet]),
|
||||
must_be(list, CipherText0),
|
||||
encoding_bytes(octet, CipherText0, CipherText1),
|
||||
append(CipherText1, Tag, CipherText),
|
||||
( Algorithm = 'chacha20-poly1305' -> true
|
||||
; domain_error('chacha20-poly1305', Algorithm, crypto_data_decrypt/6)
|
||||
),
|
||||
'$crypto_data_decrypt'(CipherText, Key, IV, Encoding, PlainText).
|
||||
|
||||
encoding_bytes(octet, Bs0, Bs) :-
|
||||
must_be(list, Bs0),
|
||||
( maplist(integer, Bs0) ->
|
||||
Bs0 = Bs
|
||||
; maplist(char_code, Bs0, Bs)
|
||||
),
|
||||
must_be_bytes(Bs, crypto_encoding).
|
||||
encoding_bytes(utf8, Cs, Bs) :-
|
||||
must_be(list, Cs),
|
||||
( maplist(atom, Cs) ->
|
||||
chars_bytes_(Cs, Bs, crypto_encoding)
|
||||
; domain_error(encryption_encoding, Cs, crypto)
|
||||
).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Digital signatures with Ed25519
|
||||
===============================
|
||||
|
||||
- ed25519_new_keypair(-Pair)
|
||||
Yields a new Ed25519 key pair Pair, a list of characters. The
|
||||
pair contains the private key and must be kept absolutely secret.
|
||||
Pair can be used for signing. Its public key can be obtained
|
||||
with ed25519_keypair_public_key/2.
|
||||
|
||||
- ed25519_keypair_public_key(+Pair, -PublicKey)
|
||||
PublicKey is the public key of the given key pair. The public key
|
||||
can be used for signature verification, and can be shared freely.
|
||||
The public key is represented as a list of characters.
|
||||
|
||||
- ed25519_sign(+Key, +Data, -Signature, +Options)
|
||||
Key and Data must be lists of characters. Key is a key pair in
|
||||
PKCS#8 v2 format as generated by ed25519_new_keypair/1. Sign Data
|
||||
with Key, yielding Signature as a list of hexadecimal characters.
|
||||
|
||||
- ed25519_verify(+Key, +Data, +Signature, +Options)
|
||||
Key and Data must be lists of characters. Key is a public key.
|
||||
Succeeds if Data was signed with the private key corresponding to
|
||||
Key, where Signature is a list of hexadecimal characters as
|
||||
generated by ed25519_sign/4. Fails otherwise.
|
||||
|
||||
Currently, the only option for signing and verifying is:
|
||||
|
||||
- encoding(+Encoding)
|
||||
The default encoding of Data is utf8. The alternative is octet,
|
||||
which treats Data as a list of raw bytes.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
ed25519_new_keypair(Pair) :-
|
||||
'$ed25519_new_keypair'(Pair).
|
||||
|
||||
ed25519_keypair_public_key(Pair0, PublicKey) :-
|
||||
encoding_bytes(octet, Pair0, Pair),
|
||||
'$ed25519_keypair_public_key'(Pair, PublicKey).
|
||||
|
||||
ed25519_sign(Key0, Data0, Signature, Options) :-
|
||||
options_data_bytes(Options, Data0, Data),
|
||||
encoding_bytes(octet, Key0, Key),
|
||||
'$ed25519_sign'(Key, Data, Signature0),
|
||||
hex_bytes(Signature, Signature0).
|
||||
|
||||
ed25519_verify(Key0, Data0, Signature0, Options) :-
|
||||
options_data_bytes(Options, Data0, Data),
|
||||
encoding_bytes(octet, Key0, Key),
|
||||
hex_bytes(Signature0, Signature),
|
||||
'$ed25519_verify'(Key, Data, Signature).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Modular multiplicative inverse.
|
||||
|
||||
Compute Y = X^(-1) mod p, using the extended Euclidean algorithm.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
multiplicative_inverse_modulo_p(X, P, Y) :-
|
||||
eea(X, P, _, _, Y),
|
||||
R #= X*Y mod P,
|
||||
zcompare(C, 1, R),
|
||||
must_be_one(C, X, P, Y).
|
||||
|
||||
must_be_one(=, _, _, _).
|
||||
must_be_one(>, X, P, Y) :- throw(multiplicative_inverse_modulo_p(X,P,Y)).
|
||||
must_be_one(<, X, P, Y) :- throw(multiplicative_inverse_modulo_p(X,P,Y)).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Extended Euclidean algorithm.
|
||||
|
||||
Computes the GCD and the Bézout coefficients S and T.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
eea(I, J, G, S, T) :-
|
||||
State0 = state(1,0,0,1),
|
||||
eea_loop(I, J, State0, G, S, T).
|
||||
|
||||
eea_loop(I, J, State0, G, S, T) :-
|
||||
zcompare(C, 0, J),
|
||||
eea_(C, I, J, State0, G, S, T).
|
||||
|
||||
eea_(=, I, _, state(_,_,U,V), I, U, V).
|
||||
eea_(<, I0, J0, state(S0,T0,U0,V0), I, U, V) :-
|
||||
Q #= I0 // J0,
|
||||
R #= I0 mod J0,
|
||||
S1 #= U0 - (Q*S0),
|
||||
T1 #= V0 - (Q*T0),
|
||||
eea_loop(J0, R, state(S1,T1,S0,T0), I, U, V).
|
||||
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Operations on Elliptic Curves
|
||||
=============================
|
||||
|
||||
Sample use: Establishing a shared secret S, using ECDH key exchange.
|
||||
|
||||
?- crypto_name_curve(Name, C),
|
||||
crypto_curve_generator(C, Generator),
|
||||
PrivateKey = 10,
|
||||
crypto_curve_scalar_mult(C, PrivateKey, Generator, PublicKey),
|
||||
Random = 12,
|
||||
crypto_curve_scalar_mult(C, Random, Generator, R),
|
||||
crypto_curve_scalar_mult(C, Random, PublicKey, S),
|
||||
crypto_curve_scalar_mult(C, PrivateKey, R, S).
|
||||
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
An elliptic curve over a prime field F_p is represented as:
|
||||
|
||||
curve(P,A,B,point(X,Y),Order,Cofactor).
|
||||
|
||||
First, we define suitable accessors.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
curve_p(curve(P,_,_,_,_,_), P).
|
||||
curve_a(curve(_,A,_,_,_,_), A).
|
||||
curve_b(curve(_,_,B,_,_,_), B).
|
||||
|
||||
crypto_curve_order(curve(_,_,_,_,Order,_), Order).
|
||||
crypto_curve_generator(curve(_,_,_,G,_,_), G).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Scalar point multiplication.
|
||||
|
||||
R = k*Q.
|
||||
|
||||
The Montgomery ladder method is used to mitigate side-channel
|
||||
attacks such as timing attacks, since the number of multiplications
|
||||
and additions is independent of the private key K. This method does
|
||||
not even reveal the key's Hamming weight (number of 1s).
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
crypto_curve_scalar_mult(Curve, K, Q, R) :-
|
||||
msb(K, Upper),
|
||||
scalar_multiplication(Curve, K, Upper, ml(null,Q)-R),
|
||||
must_be_on_curve(Curve, R).
|
||||
|
||||
scalar_multiplication(Curve, K, I, R0-R) :-
|
||||
zcompare(C, -1, I),
|
||||
scalar_mult_(C, Curve, K, I, R0-R).
|
||||
|
||||
scalar_mult_(=, _, _, _, ml(R,_)-R).
|
||||
scalar_mult_(<, Curve, K, I0, ML0-R) :-
|
||||
BitSet #= K /\ (1 << I0),
|
||||
zcompare(C, 0, BitSet),
|
||||
montgomery_step(C, Curve, ML0, ML1),
|
||||
I1 #= I0 - 1,
|
||||
scalar_multiplication(Curve, K, I1, ML1-R).
|
||||
|
||||
montgomery_step(=, Curve, ml(R0,S0), ml(R,S)) :-
|
||||
curve_points_addition(Curve, R0, S0, S),
|
||||
curve_point_double(Curve, R0, R).
|
||||
montgomery_step(<, Curve, ml(R0,S0), ml(R,S)) :-
|
||||
curve_points_addition(Curve, R0, S0, R),
|
||||
curve_point_double(Curve, S0, S).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Doubling a point: R = A + A.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
curve_point_double(_, null, null).
|
||||
curve_point_double(Curve, point(AX,AY), R) :-
|
||||
curve_p(Curve, P),
|
||||
curve_a(Curve, A),
|
||||
Numerator #= (3*AX^2 + A) mod P,
|
||||
Denom0 #= 2*AY mod P,
|
||||
multiplicative_inverse_modulo_p(Denom0, P, Denom),
|
||||
S #= (Numerator*Denom) mod P,
|
||||
R = point(RX,RY),
|
||||
RX #= (S^2 - 2*AX) mod P,
|
||||
RY #= (S*(AX - RX) - AY) mod P,
|
||||
must_be_on_curve(Curve, R).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Adding two points.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
curve_points_addition(Curve, P, Q, R) :-
|
||||
curve_points_addition_(P, Curve, Q, R).
|
||||
|
||||
curve_points_addition_(null, _, P, P).
|
||||
curve_points_addition_(P, _, null, P).
|
||||
curve_points_addition_(point(AX,AY), Curve, point(BX,BY), R) :-
|
||||
curve_p(Curve, P),
|
||||
Numerator #= (AY - BY) mod P,
|
||||
Denom0 #= (AX - BX) mod P,
|
||||
multiplicative_inverse_modulo_p(Denom0, P, Denom),
|
||||
S #= (Numerator * Denom) mod P,
|
||||
R = point(RX,RY),
|
||||
RX #= (S^2 - AX - BX) mod P,
|
||||
RY #= (S*(AX - RX) - AY) mod P,
|
||||
must_be_on_curve(Curve, R).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Validation.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
curve_contains_point(Curve, point(QX,QY)) :-
|
||||
curve_a(Curve, A),
|
||||
curve_b(Curve, B),
|
||||
curve_p(Curve, P),
|
||||
QY^2 mod P #= (QX^3 + A*QX + B) mod P.
|
||||
|
||||
must_be_on_curve(Curve, P) :-
|
||||
\+ curve_contains_point(Curve, P),
|
||||
throw(not_on_curve(P)).
|
||||
must_be_on_curve(Curve, P) :- curve_contains_point(Curve, P).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Predefined curves
|
||||
=================
|
||||
|
||||
List available curves:
|
||||
|
||||
$ openssl ecparam -list_curves
|
||||
|
||||
Show curve parameters for secp256k1:
|
||||
|
||||
$ openssl ecparam -param_enc explicit -conv_form uncompressed \
|
||||
-text -no_seed -name secp256k1
|
||||
|
||||
You must remove the leading "04:" from the generator.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
crypto_name_curve(secp112r1,
|
||||
curve(0x00db7c2abf62e35e668076bead208b,
|
||||
0x00db7c2abf62e35e668076bead2088,
|
||||
0x659ef8ba043916eede8911702b22,
|
||||
point(0x09487239995a5ee76b55f9c2f098,
|
||||
0xa89ce5af8724c0a23e0e0ff77500),
|
||||
0x00db7c2abf62e35e7628dfac6561c5,
|
||||
1)).
|
||||
crypto_name_curve(secp256k1,
|
||||
curve(0x00fffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc2f,
|
||||
0x0,
|
||||
0x7,
|
||||
point(0x79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798,
|
||||
0x483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8),
|
||||
0x00fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141,
|
||||
1)).
|
||||
@@ -1,14 +1,11 @@
|
||||
:- op(1200, xfx, -->).
|
||||
% :- op(1105, xfy, ('|')).
|
||||
|
||||
:- module(dcgs, [phrase/2, phrase/3]).
|
||||
:- module(dcgs, [op(1200, xfx, -->),
|
||||
op(1105, xfy, '|'),
|
||||
phrase/2,
|
||||
phrase/3]).
|
||||
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(lists), [append/3]).
|
||||
|
||||
user:term_expansion(Term0, (Head :- Body)) :-
|
||||
dcg_rule(Term0, Term),
|
||||
Term = (Head :- Body).
|
||||
|
||||
phrase(GRBody, S0) :-
|
||||
phrase(GRBody, S0, []).
|
||||
|
||||
@@ -31,10 +28,10 @@ phrase_((A -> B ; C), S0, S) :-
|
||||
).
|
||||
phrase_((A ; B), S0, S) :-
|
||||
( phrase(A, S0, S) ; phrase(B, S0, S) ).
|
||||
%% phrase_((A | B), S0, S) :-
|
||||
%% ( phrase(A, S0, S) ; phrase(B, S0, S) ).
|
||||
phrase_((A | B), S0, S) :-
|
||||
( phrase(A, S0, S) ; phrase(B, S0, S) ).
|
||||
phrase_({G}, S0, S) :-
|
||||
( G, S0 = S ).
|
||||
( call(G), S0 = S ).
|
||||
phrase_(call(G), S0, S) :-
|
||||
call(G, S0, S).
|
||||
phrase_((A -> B), S0, S) :-
|
||||
@@ -44,6 +41,17 @@ phrase_(phrase(NonTerminal), S0, S) :-
|
||||
phrase_([T|Ts], S0, S) :-
|
||||
append([T|Ts], S, S0).
|
||||
|
||||
% The same version of the below two dcg_rule clauses, but with module scoping.
|
||||
dcg_rule(( M:NonTerminal, Terminals --> GRBody ), ( M:Head :- Body )) :-
|
||||
dcg_non_terminal(NonTerminal, S0, S, Head),
|
||||
dcg_body(GRBody, S0, S1, Goal1),
|
||||
dcg_terminals(Terminals, S, S1, Goal2),
|
||||
Body = ( Goal1, Goal2 ).
|
||||
dcg_rule(( M:NonTerminal --> GRBody ), ( M:Head :- Body )) :-
|
||||
NonTerminal \= ( _, _ ),
|
||||
dcg_non_terminal(NonTerminal, S0, S, Head),
|
||||
dcg_body(GRBody, S0, S, Body).
|
||||
|
||||
% This program uses append/3 as defined in the Prolog prologue.
|
||||
% Expands a DCG rule into a Prolog rule, when no error condition applies.
|
||||
dcg_rule(( NonTerminal, Terminals --> GRBody ), ( Head :- Body )) :-
|
||||
@@ -84,7 +92,7 @@ dcg_constr([]). % 7.14.1
|
||||
dcg_constr([_|_]). % 7.14.2 - terminal sequence
|
||||
dcg_constr(( _, _ )). % 7.14.3 - concatenation
|
||||
dcg_constr(( _ ; _ )). % 7.14.4 - alternative
|
||||
%% dcg_constr(( _'|'_ )). % 7.14.6 - alternative
|
||||
dcg_constr(( _'|'_ )). % 7.14.6 - alternative
|
||||
dcg_constr({_}). % 7.14.7
|
||||
dcg_constr(call(_)). % 7.14.8
|
||||
dcg_constr(phrase(_)). % 7.14.9
|
||||
@@ -96,6 +104,7 @@ dcg_constr((_->_)). % 7.14.12 - if-then (existence implementation dep.)
|
||||
% the construct to be expanded.
|
||||
dcg_cbody([], S0, S, S0 = S).
|
||||
dcg_cbody([T|Ts], S0, S, Goal) :-
|
||||
must_be(list, [T|Ts]),
|
||||
dcg_terminals([T|Ts], S0, S, Goal).
|
||||
dcg_cbody(( GRFirst, GRSecond ), S0, S, ( First, Second )) :-
|
||||
dcg_body(GRFirst, S0, S1, First),
|
||||
@@ -108,9 +117,9 @@ dcg_cbody(( GRCond ; GRElse ), S0, S, ( Cond ; Else )) :-
|
||||
subsumes_term(( _GRIf -> _GRThen ), GRCond),
|
||||
dcg_cbody(GRCond, S0, S, Cond),
|
||||
dcg_body(GRElse, S0, S, Else).
|
||||
%% dcg_cbody(( GREither '|' GROr ), S0, S, ( Either ; Or )) :-
|
||||
%% dcg_body(GREither, S0, S, Either),
|
||||
%% dcg_body(GROr, S0, S, Or).
|
||||
dcg_cbody(( GREither '|' GROr ), S0, S, ( Either ; Or )) :-
|
||||
dcg_body(GREither, S0, S, Either),
|
||||
dcg_body(GROr, S0, S, Or).
|
||||
dcg_cbody({Goal}, S0, S, ( Goal, S0 = S )).
|
||||
dcg_cbody(call(Cont), S0, S, call(Cont, S0, S)).
|
||||
dcg_cbody(phrase(Body), S0, S, phrase(Body, S0, S)).
|
||||
@@ -119,3 +128,8 @@ dcg_cbody(\+ GRBody, S0, S, ( \+ phrase(GRBody,S0,_), S0 = S )).
|
||||
dcg_cbody(( GRIf -> GRThen ), S0, S, ( If -> Then )) :-
|
||||
dcg_body(GRIf, S0, S1, If),
|
||||
dcg_body(GRThen, S1, S, Then).
|
||||
|
||||
user:term_expansion(Term0, Term) :-
|
||||
nonvar(Term0),
|
||||
dcg_rule(Term0, (Head :- Body)),
|
||||
Term = (Head :- Body).
|
||||
|
||||
@@ -51,4 +51,5 @@ gather_dif_goals([(X \== Y) | Goals]) -->
|
||||
|
||||
attribute_goals(X) -->
|
||||
{ get_atts(X, +dif(Goals)) },
|
||||
gather_dif_goals(Goals).
|
||||
gather_dif_goals(Goals),
|
||||
{ put_atts(X, -dif(_)) }.
|
||||
|
||||
@@ -1,5 +1,9 @@
|
||||
:- module(error, [must_be/2,
|
||||
can_be/2]).
|
||||
can_be/2,
|
||||
instantiation_error/1,
|
||||
domain_error/3,
|
||||
type_error/3
|
||||
]).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Written September 2018 by Markus Triska (triska@metalevel.at)
|
||||
@@ -32,19 +36,23 @@ must_be(Type, Term) :-
|
||||
|
||||
must_be_(Type, _) :-
|
||||
var(Type),
|
||||
instantiation_error(Type).
|
||||
instantiation_error(must_be/2).
|
||||
must_be_(var, Term) :-
|
||||
( var(Term) -> true
|
||||
; throw(error(uninstantiation_error, must_be/2))
|
||||
).
|
||||
must_be_(integer, Term) :- check_(integer, integer, Term).
|
||||
must_be_(atom, Term) :- check_(atom, atom, Term).
|
||||
must_be_(list, Term) :- check_(ilist, list, Term).
|
||||
must_be_(type, Term) :- check_(type, type, Term).
|
||||
|
||||
check_(Pred, Type, Term) :-
|
||||
( var(Term) -> instantiation_error(Term)
|
||||
( var(Term) -> instantiation_error(must_be/2)
|
||||
; call(Pred, Term) -> true
|
||||
; type_error(Type, Term)
|
||||
; type_error(Type, Term, must_be/2)
|
||||
).
|
||||
|
||||
ilist(V) :- var(V), instantiation_error(V).
|
||||
ilist(V) :- var(V), instantiation_error(must_be/2).
|
||||
ilist([]).
|
||||
ilist([_|Ls]) :- ilist(Ls).
|
||||
|
||||
@@ -52,6 +60,7 @@ type(type).
|
||||
type(integer).
|
||||
type(atom).
|
||||
type(list).
|
||||
type(var).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
can_be(Type, Term)
|
||||
@@ -71,7 +80,7 @@ can_be(Type, Term) :-
|
||||
must_be(type, Type),
|
||||
( var(Term) -> true
|
||||
; can_(Type, Term) -> true
|
||||
; type_error(Type, Term)
|
||||
; type_error(Type, Term, can_be/2)
|
||||
).
|
||||
|
||||
can_(integer, Term) :- integer(Term).
|
||||
@@ -87,11 +96,11 @@ list_or_partial_list([_|Ls]) :-
|
||||
Shorthands for throwing ISO errors.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
instantiation_error(_Term) :-
|
||||
throw(error(instantiation_error, _)).
|
||||
instantiation_error(Context) :-
|
||||
throw(error(instantiation_error, Context)).
|
||||
|
||||
domain_error(Type, Term) :-
|
||||
throw(error(domain_error(Type, Term), _)).
|
||||
domain_error(Type, Term, Context) :-
|
||||
throw(error(domain_error(Type, Term), Context)).
|
||||
|
||||
type_error(Type, Term) :-
|
||||
throw(error(type_error(Type, Term), _)).
|
||||
type_error(Type, Term, Context) :-
|
||||
throw(error(type_error(Type, Term), Context)).
|
||||
|
||||
580
src/prolog/lib/format.pl
Normal file
580
src/prolog/lib/format.pl
Normal file
@@ -0,0 +1,580 @@
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Written March 2020 by Markus Triska (triska@metalevel.at)
|
||||
Part of Scryer Prolog.
|
||||
|
||||
This library provides the nonterminal format_//2 to describe
|
||||
formatted strings. format/2 is provided for impure output.
|
||||
|
||||
Usage:
|
||||
======
|
||||
|
||||
phrase(format_(FormatString, Arguments), Ls)
|
||||
|
||||
format_//2 describes a list of characters Ls that are formatted
|
||||
according to FormatString. FormatString is a string (i.e.,
|
||||
a list of characters) that specifies the layout of Ls.
|
||||
The characters in FormatString are used literally, except
|
||||
for the following tokens with special meaning:
|
||||
|
||||
~w use the next available argument from Arguments here
|
||||
~q use the next argument here, formatted as by writeq/1
|
||||
~a use the next argument here, which must be an atom
|
||||
~s use the next argument here, which must be a string
|
||||
~d use the next argument here, which must be an integer
|
||||
~f use the next argument here, a floating point number
|
||||
~Nf where N is an integer: format the float argument
|
||||
using N digits after the decimal point
|
||||
~Nd like ~d, placing the last N digits after a decimal point;
|
||||
if N is 0 or omitted, no decimal point is used.
|
||||
~ND like ~Nd, separating digits to the left of the decimal point
|
||||
in groups of three, using the character "," (comma)
|
||||
~Nr where N is an integer between 2 and 36: format the
|
||||
next argument, which must be an integer, in radix N.
|
||||
The characters "a" to "z" are used for radices 10 to 36.
|
||||
~NR like ~Nr, except that "A" to "Z" are used for radices > 9
|
||||
~| place a tab stop at this position
|
||||
~N| where N is an integer: place a tab stop at text column N
|
||||
~N+ where N is an integer: place a tab stop N characters
|
||||
after the previous tab stop (or start of line)
|
||||
~t distribute spaces evenly between the two closest tab stops
|
||||
~`Ct like ~t, use character C instead of spaces to fill the space
|
||||
~n newline
|
||||
~Nn N newlines
|
||||
~i ignore the next argument
|
||||
~~ the literal ~
|
||||
|
||||
Instead of ~N, you can write ~* to use the next argument from Arguments
|
||||
as the numeric argument.
|
||||
|
||||
The predicate format/2 is like format_//2, except that it outputs
|
||||
the text on the terminal instead of describing it declaratively.
|
||||
|
||||
format/3, used as format(Stream, FormatString, Arguments), outputs
|
||||
the described string to the given Stream. If Stream is a binary
|
||||
stream, then the code of each emitted character must be in 0..255.
|
||||
|
||||
If at all possible, format_//2 should be used, to stress pure parts
|
||||
that enable easy testing etc. If necessary, you can emit the list Ls
|
||||
with maplist(write, Ls).
|
||||
|
||||
The entire library only works if the Prolog flag double_quotes
|
||||
is set to chars, the default value in Scryer Prolog. This should
|
||||
also stay that way, to encourage a sensible environment.
|
||||
|
||||
Example:
|
||||
|
||||
?- phrase(format_("~s~n~`.t~w!~12|", ["hello",there]), Cs).
|
||||
%@ Cs = "hello\n......there!"
|
||||
%@ ; false.
|
||||
|
||||
I place this code in the public domain. Use it in any way you want.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
:- module(format, [format_//2,
|
||||
format/2,
|
||||
format/3,
|
||||
portray_clause/1,
|
||||
listing/1
|
||||
]).
|
||||
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(charsio)).
|
||||
:- use_module(library(between)).
|
||||
|
||||
format_(Fs, Args) -->
|
||||
{ must_be(list, Fs),
|
||||
must_be(list, Args),
|
||||
phrase(cells(Fs,Args,0,[]), Cells) },
|
||||
format_cells(Cells).
|
||||
|
||||
format_cells([]) --> [].
|
||||
format_cells([Cell|Cells]) -->
|
||||
format_cell(Cell),
|
||||
format_cells(Cells).
|
||||
|
||||
format_cell(newline) --> "\n".
|
||||
format_cell(cell(From,To,Es)) -->
|
||||
% distribute the space between the glue elements
|
||||
{ phrase(elements_gluevars(Es, 0, Length), Vs),
|
||||
( Vs = [] -> true
|
||||
; Space is To - From - Length,
|
||||
( Space =< 0 -> maplist(=(0), Vs)
|
||||
; length(Vs, NumGlue),
|
||||
Distr is Space // NumGlue,
|
||||
Delta is Space - Distr*NumGlue,
|
||||
( Delta =:= 0 ->
|
||||
maplist(=(Distr), Vs)
|
||||
; BigGlue is Distr + Delta,
|
||||
reverse(Vs, [BigGlue|Rest]),
|
||||
maplist(=(Distr), Rest)
|
||||
)
|
||||
)
|
||||
) },
|
||||
format_elements(Es).
|
||||
|
||||
format_elements([]) --> [].
|
||||
format_elements([E|Es]) -->
|
||||
format_element(E),
|
||||
format_elements(Es).
|
||||
|
||||
format_element(chars(Cs)) --> list(Cs).
|
||||
format_element(glue(Fill,Num)) -->
|
||||
{ length(Ls, Num),
|
||||
maplist(=(Fill), Ls) },
|
||||
list(Ls).
|
||||
|
||||
list([]) --> [].
|
||||
list([L|Ls]) --> [L], list(Ls).
|
||||
|
||||
elements_gluevars([], N, N) --> [].
|
||||
elements_gluevars([E|Es], N0, N) -->
|
||||
element_gluevar(E, N0, N1),
|
||||
elements_gluevars(Es, N1, N).
|
||||
|
||||
element_gluevar(chars(Cs), N0, N) -->
|
||||
{ length(Cs, L),
|
||||
N is N0 + L }.
|
||||
element_gluevar(glue(_,V), N, N) --> [V].
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Our key datastructure is a list of cells and newlines.
|
||||
A cell has the shape from_to(From,To,Elements), where
|
||||
From and To denote the positions of surrounding tab stops.
|
||||
|
||||
Elements is a list of elements that occur in a cell,
|
||||
namely terms of the form chars(Cs) and glue(Char, Var).
|
||||
"glue" elements (TeX terminology) are evenly stretched
|
||||
to fill the remaining whitespace in the cell. For each
|
||||
glue element, the character Char is used for filling,
|
||||
and Var is a free variable that is used when the
|
||||
available space is distributed.
|
||||
|
||||
newline is used if ~n occurs in a format string.
|
||||
It is is used because a newline character does not
|
||||
consume whitespace in the sense of format strings.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
cells([], Args, Tab, Es) -->
|
||||
( { Args == [] } -> cell(Tab, Tab, Es)
|
||||
; { domain_error(no_remaining_arguments, Args, format_//2) }
|
||||
).
|
||||
cells([~,~|Fs], Args, Tab, Es) --> !,
|
||||
cells(Fs, Args, Tab, [chars("~")|Es]).
|
||||
cells([~,w|Fs], [Arg|Args], Tab, Es) --> !,
|
||||
{ write_term_to_chars(Arg, [], Chars) },
|
||||
cells(Fs, Args, Tab, [chars(Chars)|Es]).
|
||||
cells([~,q|Fs], [Arg|Args], Tab, Es) --> !,
|
||||
{ write_term_to_chars(Arg, [quoted(true)], Chars) },
|
||||
cells(Fs, Args, Tab, [chars(Chars)|Es]).
|
||||
cells([~,a|Fs], [Arg|Args], Tab, Es) --> !,
|
||||
{ atom_chars(Arg, Chars) },
|
||||
cells(Fs, Args, Tab, [chars(Chars)|Es]).
|
||||
cells([~|Fs0], Args0, Tab, Es) -->
|
||||
{ numeric_argument(Fs0, Num, [d|Fs], Args0, [Arg|Args]) },
|
||||
!,
|
||||
{ number_chars(Arg, Cs0) },
|
||||
( { Num =:= 0 } -> { Cs = Cs0 }
|
||||
; { length(Cs0, L),
|
||||
( L =< Num ->
|
||||
Delta is Num - L,
|
||||
length(Zs, Delta),
|
||||
maplist(=('0'), Zs),
|
||||
phrase(("0.",list(Zs),list(Cs0)), Cs)
|
||||
; BeforeComma is L - Num,
|
||||
length(Bs, BeforeComma),
|
||||
append(Bs, Ds, Cs0),
|
||||
phrase((list(Bs),".",list(Ds)), Cs)
|
||||
) }
|
||||
),
|
||||
cells(Fs, Args, Tab, [chars(Cs)|Es]).
|
||||
cells([~|Fs0], Args0, Tab, Es) -->
|
||||
{ numeric_argument(Fs0, Num, ['D'|Fs], Args0, [Arg|Args]) },
|
||||
!,
|
||||
{ number_chars(Num, NCs),
|
||||
phrase(("~",list(NCs),"d"), FStr),
|
||||
phrase(format_(FStr, [Arg]), Cs0),
|
||||
phrase(upto_what(Bs0, .), Cs0, Ds),
|
||||
reverse(Bs0, Bs1),
|
||||
phrase(groups_of_three(Bs1), Bs2),
|
||||
reverse(Bs2, Bs),
|
||||
append(Bs, Ds, Cs) },
|
||||
cells(Fs, Args, Tab, [chars(Cs)|Es]).
|
||||
cells([~,i|Fs], [_|Args], Tab, Es) --> !,
|
||||
cells(Fs, Args, Tab, Es).
|
||||
cells([~,n|Fs], Args, Tab, Es) --> !,
|
||||
cell(Tab, Tab, Es),
|
||||
n_newlines(1),
|
||||
cells(Fs, Args, 0, []).
|
||||
cells([~|Fs0], Args0, Tab, Es) -->
|
||||
{ numeric_argument(Fs0, Num, [n|Fs], Args0, Args) },
|
||||
!,
|
||||
cell(Tab, Tab, Es),
|
||||
n_newlines(Num),
|
||||
cells(Fs, Args, 0, []).
|
||||
cells([~,s|Fs], [Arg|Args], Tab, Es) --> !,
|
||||
cells(Fs, Args, Tab, [chars(Arg)|Es]).
|
||||
cells([~,f|Fs], [Arg|Args], Tab, Es) --> !,
|
||||
{ number_chars(Arg, Chars) },
|
||||
cells(Fs, Args, Tab, [chars(Chars)|Es]).
|
||||
cells([~|Fs0], Args0, Tab, Es) -->
|
||||
{ numeric_argument(Fs0, Num, [f|Fs], Args0, [Arg|Args]) },
|
||||
!,
|
||||
{ number_chars(Arg, Cs0),
|
||||
phrase(upto_what(Bs, .), Cs0, Cs),
|
||||
( Num =:= 0 -> Chars = Bs
|
||||
; ( Cs = ['.'|Rest] ->
|
||||
length(Rest, L),
|
||||
( Num < L ->
|
||||
length(Ds, Num),
|
||||
append(Ds, _, Rest)
|
||||
; Num =:= L ->
|
||||
Ds = Rest
|
||||
; Num > L,
|
||||
Delta is Num - L,
|
||||
% we should look into the float with
|
||||
% greater accuracy here, and use the
|
||||
% actual digits instead of 0.
|
||||
length(Zs, Delta),
|
||||
maplist(=('0'), Zs),
|
||||
append(Rest, Zs, Ds)
|
||||
)
|
||||
; length(Ds, Num),
|
||||
maplist(=('0'), Ds)
|
||||
),
|
||||
append(Bs, ['.'|Ds], Chars)
|
||||
) },
|
||||
cells(Fs, Args, Tab, [chars(Chars)|Es]).
|
||||
cells([~|Fs0], Args0, Tab, Es) -->
|
||||
{ numeric_argument(Fs0, Num, [r|Fs], Args0, [Arg|Args]) },
|
||||
!,
|
||||
{ integer_to_radix(Arg, Num, lowercase, Cs) },
|
||||
cells(Fs, Args, Tab, [chars(Cs)|Es]).
|
||||
cells([~|Fs0], Args0, Tab, Es) -->
|
||||
{ numeric_argument(Fs0, Num, ['R'|Fs], Args0, [Arg|Args]) },
|
||||
!,
|
||||
{ integer_to_radix(Arg, Num, uppercase, Cs) },
|
||||
cells(Fs, Args, Tab, [chars(Cs)|Es]).
|
||||
cells([~,'`',Char,t|Fs], Args, Tab, Es) --> !,
|
||||
cells(Fs, Args, Tab, [glue(Char,_)|Es]).
|
||||
cells([~,t|Fs], Args, Tab, Es) --> !,
|
||||
cells(Fs, Args, Tab, [glue(' ',_)|Es]).
|
||||
cells([~|Fs0], Args0, Tab, Es) -->
|
||||
{ numeric_argument(Fs0, Num, ['|'|Fs], Args0, Args) },
|
||||
!,
|
||||
cell(Tab, Num, Es),
|
||||
cells(Fs, Args, Num, []).
|
||||
cells([~|Fs0], Args0, Tab0, Es) -->
|
||||
{ numeric_argument(Fs0, Num, [+|Fs], Args0, Args) },
|
||||
!,
|
||||
{ Tab is Tab0 + Num },
|
||||
cell(Tab0, Tab, Es),
|
||||
cells(Fs, Args, Tab, []).
|
||||
cells([~,C|_], _, _, _) -->
|
||||
{ atom_chars(A, [~,C]),
|
||||
domain_error(format_string, A, format_//2) }.
|
||||
cells(Fs0, Args, Tab, Es) -->
|
||||
{ phrase(upto_what(Fs1, ~), Fs0, Fs),
|
||||
Fs1 = [_|_] },
|
||||
cells(Fs, Args, Tab, [chars(Fs1)|Es]).
|
||||
|
||||
n_newlines(0) --> !.
|
||||
n_newlines(N0) --> { N0 > 0, N is N0 - 1 }, [newline], n_newlines(N).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
?- phrase(upto_what(Cs, ~), "abc~test", Rest).
|
||||
Cs = [a,b,c], Rest = [~,t,e,s,t].
|
||||
?- phrase(upto_what(Cs, ~), "abc", Rest).
|
||||
Cs = [a,b,c], Rest = [].
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
upto_what([], W), [W] --> [W], !.
|
||||
upto_what([C|Cs], W) --> [C], !, upto_what(Cs, W).
|
||||
upto_what([], _) --> [].
|
||||
|
||||
groups_of_three([A,B,C,D|Rs]) --> !, [A,B,C], ",", groups_of_three([D|Rs]).
|
||||
groups_of_three(Ls) --> list(Ls).
|
||||
|
||||
cell(From, To, Es0) -->
|
||||
( { Es0 == [] } -> []
|
||||
; { reverse(Es0, Es) },
|
||||
[cell(From,To,Es)]
|
||||
).
|
||||
|
||||
%?- numeric_argument("2f", Num, ['f'|Fs], Args0, Args).
|
||||
|
||||
%?- numeric_argument("100b", Num, Rs, Args0, Args).
|
||||
|
||||
numeric_argument(Ds, Num, Rest, Args0, Args) :-
|
||||
( Ds = [*|Rest] ->
|
||||
Args0 = [Num|Args]
|
||||
; numeric_argument_(Ds, [], Ns, Rest),
|
||||
foldl(pow10, Ns, 0-0, Num-_),
|
||||
Args0 = Args
|
||||
).
|
||||
|
||||
numeric_argument_([D|Ds], Ns0, Ns, Rest) :-
|
||||
( member(D, "0123456789") ->
|
||||
number_chars(N, [D]),
|
||||
numeric_argument_(Ds, [N|Ns0], Ns, Rest)
|
||||
; Ns = Ns0,
|
||||
Rest = [D|Ds]
|
||||
).
|
||||
|
||||
|
||||
pow10(D, N0-Pow0, N-Pow) :-
|
||||
N is N0 + D*10^Pow0,
|
||||
Pow is Pow0 + 1.
|
||||
|
||||
integer_to_radix(I, R, Which, Cs) :-
|
||||
must_be(integer, I),
|
||||
must_be(integer, R),
|
||||
( \+ between(2, 36, R) ->
|
||||
domain_error(radix, R, format_//2)
|
||||
; true
|
||||
),
|
||||
digits(Which, Ds),
|
||||
( I < 0 ->
|
||||
Pos is abs(I),
|
||||
phrase(integer_to_radix_(Pos, R, Ds), Cs0, "-")
|
||||
; I =:= 0 -> Cs0 = "0"
|
||||
; phrase(integer_to_radix_(I, R, Ds), Cs0)
|
||||
),
|
||||
reverse(Cs0, Cs).
|
||||
|
||||
integer_to_radix_(0, _, _) --> !.
|
||||
integer_to_radix_(I0, R, Ds) -->
|
||||
{ M is I0 mod R,
|
||||
nth0(M, Ds, D),
|
||||
I is I0 // R
|
||||
},
|
||||
[D],
|
||||
integer_to_radix_(I, R, Ds).
|
||||
|
||||
digits(lowercase, "0123456789abcdefghijklmnopqrstuvwxyz").
|
||||
digits(uppercase, "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ").
|
||||
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Impure I/O, implemented as a small wrapper over format_//2.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
format(Fs, Args) :-
|
||||
phrase(format_(Fs, Args), Cs),
|
||||
maplist(write, Cs).
|
||||
|
||||
format(Stream, Fs, Args) :-
|
||||
phrase(format_(Fs, Args), Cs),
|
||||
( stream_property(Stream, type(binary)) ->
|
||||
% maplist(char_code, Cs, Bytes) is currently a lot slower
|
||||
% than first converting Cs to an atom, and then to codes.
|
||||
% In the future, we can ideally avoid creating an atom here,
|
||||
% since an atom leaves traces in the system.
|
||||
atom_chars(A, Cs),
|
||||
atom_codes(A, Bytes),
|
||||
( member(NonByte, Bytes), NonByte > 255 ->
|
||||
char_code(Char, NonByte),
|
||||
throw(error(representation_error(Char), format/3))
|
||||
; true
|
||||
),
|
||||
% For binary streams, we use a specialised internal predicate
|
||||
% that uses only a single "write" operation for efficiency.
|
||||
'$put_bytes'(Stream, Bytes)
|
||||
; maplist(put_char(Stream), Cs)
|
||||
).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
?- phrase(cells("hello", [], 0, []), Cs).
|
||||
|
||||
?- phrase(cells("hello~10|", [], 0, []), Cs).
|
||||
?- phrase(cells("~ta~t~10|", [], 0, []), Cs).
|
||||
|
||||
?- phrase(format_("~`at~50|", []), Ls).
|
||||
|
||||
?- phrase(cells("~`at~50|", [], 0, []), Cs),
|
||||
phrase(format_cells(Cs), Ls).
|
||||
?- phrase(cells("~ta~t~tb~tc~21|", [], 0, []), Cs).
|
||||
Cs = [cell(0,21,[glue(' ',_38),chars([a]),glue(' ',_62),glue(' ',_67),chars([b]),glue(' ',_91),chars([c])])].
|
||||
?- phrase(cells("~ta~t~4|", [], 0, []), Cs).
|
||||
Cs = [cell(0,4,[glue(' ',_38),chars([a]),glue(' ',_62)])].
|
||||
|
||||
?- phrase(format_cell(cell(0,1,[glue(a,_94)])), Ls).
|
||||
|
||||
?- phrase(format_cell(cell(0,50,[chars("hello")])), Ls).
|
||||
|
||||
?- phrase(format_("~`at~50|~n", []), Ls).
|
||||
?- phrase(format_("hello~n~tthere~6|", []), Ls).
|
||||
|
||||
?- format("~ta~t~4|", []).
|
||||
a true
|
||||
; false.
|
||||
|
||||
?- format("~ta~tb~tc~10|", []).
|
||||
a b c true
|
||||
; false.
|
||||
|
||||
?- format("~tabc~3|", []).
|
||||
|
||||
?- format("~ta~t~4|", []).
|
||||
|
||||
?- format("~ta~t~tb~tc~20|", []).
|
||||
a b c true
|
||||
; false.
|
||||
|
||||
?- format("~2f~n", [3]).
|
||||
3.00
|
||||
true
|
||||
|
||||
?- format("~20f", [0.1]).
|
||||
0.10000000000000000000 true % this should use higher accuracy!
|
||||
; false.
|
||||
|
||||
?- X is atan(2), format("~7f~n", [X]).
|
||||
1.1071487
|
||||
X = 1.1071487177940906
|
||||
|
||||
?- format("~`at~50|~n", []).
|
||||
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
|
||||
true
|
||||
|
||||
?- format("~t~N", []).
|
||||
|
||||
?- format("~q", [.]).
|
||||
'.' true
|
||||
|
||||
?- format("~12r", [300]).
|
||||
210 true
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
We also provide rudimentary versions of portray_clause/1 and listing/1.
|
||||
|
||||
In the eventual library organization, portray_clause/1 and
|
||||
related predicates may be placed in their own dedicated library.
|
||||
|
||||
portray_clause/1 is useful for printing solutions in such a way
|
||||
that they can be read back with read/1.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
portray_clause(Term) :-
|
||||
phrase(portray_clause_(Term), Ls),
|
||||
maplist(write, Ls).
|
||||
|
||||
portray_clause_(Term) -->
|
||||
{ term_variables(Term, Vs),
|
||||
foldl(var_name, Vs, VNs, 0, _) },
|
||||
portray_(Term, VNs), ".\n".
|
||||
|
||||
var_name(V, Name=V, Num0, Num) :-
|
||||
charsio:fabricate_var_name(numbervars, Name, Num0),
|
||||
Num is Num0 + 1.
|
||||
|
||||
literal(Lit, VNs) -->
|
||||
{ write_term_to_chars(Lit, [quoted(true),variable_names(VNs)], Ls) },
|
||||
list(Ls).
|
||||
|
||||
portray_(Var, VNs) --> { var(Var) }, !, literal(Var, VNs).
|
||||
portray_((Head :- Body), VNs) --> !,
|
||||
literal(Head, VNs), " :-\n",
|
||||
body_(Body, 0, 3, VNs).
|
||||
portray_((Head --> Body), VNs) --> !,
|
||||
literal(Head, VNs), " -->\n",
|
||||
body_(Body, 0, 3, VNs).
|
||||
portray_(Any, VNs) --> literal(Any, VNs).
|
||||
|
||||
|
||||
body_(Var, C, I, VNs) --> { var(Var) }, !,
|
||||
indent_to(C, I),
|
||||
literal(Var, VNs).
|
||||
body_((A,B), C, I, VNs) --> !,
|
||||
body_(A, C, I, VNs), ",\n",
|
||||
body_(B, 0, I, VNs).
|
||||
body_((A ; Else), C, I, VNs) --> % ( If -> Then ; Else )
|
||||
{ nonvar(A), A = (If -> Then) },
|
||||
!,
|
||||
indent_to(C, I),
|
||||
"( ",
|
||||
{ C1 is I + 3 },
|
||||
body_(If, C1, C1, VNs), " ->\n",
|
||||
body_(Then, 0, C1, VNs), "\n",
|
||||
else_branch(Else, C1, I, VNs).
|
||||
body_((A;B), C, I, VNs) --> !,
|
||||
indent_to(C, I),
|
||||
"( ",
|
||||
{ C1 is I + 3 },
|
||||
body_(A, C1, C1, VNs), "\n",
|
||||
else_branch(B, C1, I, VNs).
|
||||
body_(Goal, C, I, VNs) -->
|
||||
indent_to(C, I), literal(Goal, VNs).
|
||||
|
||||
|
||||
else_branch(Else, C, I, VNs) -->
|
||||
indent_to(0, I),
|
||||
"; ",
|
||||
body_(Else, C, C, VNs), "\n",
|
||||
indent_to(0, I),
|
||||
")".
|
||||
|
||||
indent_to(CurrentColumn, Indent) -->
|
||||
{ Delta is Indent - CurrentColumn },
|
||||
format_("~t~*|", [Delta]).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
?- portray_clause(a).
|
||||
a.
|
||||
|
||||
?- portray_clause((a :- b)).
|
||||
a :-
|
||||
b.
|
||||
|
||||
?- portray_clause((a :- b, c, d)).
|
||||
a :-
|
||||
b,
|
||||
c,
|
||||
d.
|
||||
true
|
||||
|
||||
|
||||
?- portray_clause([a,b,c,d]).
|
||||
"abcd".
|
||||
|
||||
?- portray_clause(X).
|
||||
?- portray_clause((f(X) :- X)).
|
||||
|
||||
?- portray_clause((h :- ( a -> b; c))).
|
||||
|
||||
?- portray_clause((h :- ( (a -> x ; y) -> b; c))).
|
||||
|
||||
?- portray_clause((h(X) :- ( (a(X) ; y(A,B)) -> b; c))).
|
||||
|
||||
?- portray_clause((h :- (a,d;b,c) ; (b,e;d))).
|
||||
|
||||
?- portray_clause((a :- b ; c ; d)).
|
||||
|
||||
?- portray_clause((h :- L = '.')).
|
||||
|
||||
?- portray_clause(-->(a, (b, {t}, d))).
|
||||
|
||||
?- portray_clause((A :- B)).
|
||||
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
listing(PI) :-
|
||||
nonvar(PI),
|
||||
( PI = Name/Arity0 ->
|
||||
Arity = Arity0
|
||||
; PI = Name//Arity0 ->
|
||||
Arity is Arity0 + 2
|
||||
; type_error(predicate_indicator, PI, listing/1)
|
||||
),
|
||||
functor(Head, Name, Arity),
|
||||
\+ \+ clause(Head, _), % only true if there is at least one clause
|
||||
( clause(Head, Body),
|
||||
( Body == true ->
|
||||
portray_clause(Head)
|
||||
; portray_clause((Head :- Body))
|
||||
),
|
||||
false
|
||||
; true
|
||||
).
|
||||
@@ -21,15 +21,8 @@ freeze(X, Goal) :-
|
||||
put_atts(Fresh, frozen(Goal)),
|
||||
Fresh = X.
|
||||
|
||||
gather_freeze_goals(Attrs, _) -->
|
||||
{ var(Attrs) },
|
||||
!.
|
||||
gather_freeze_goals([frozen(X) | _], Var) -->
|
||||
[freeze(Var, X)],
|
||||
!.
|
||||
gather_freeze_goals([_ | Attrs], Var) -->
|
||||
gather_freeze_goals(Attrs, Var).
|
||||
attribute_goals(Var) -->
|
||||
{ get_atts(Var, frozen(Goals)),
|
||||
put_atts(Var, -frozen(_)) },
|
||||
[freeze(Var, Goals)].
|
||||
|
||||
attribute_goals(X) -->
|
||||
{ '$get_attr_list'(X, Attrs) },
|
||||
gather_freeze_goals(Attrs, X).
|
||||
|
||||
32
src/prolog/lib/gensym.pl
Normal file
32
src/prolog/lib/gensym.pl
Normal file
@@ -0,0 +1,32 @@
|
||||
:- module(gensym, [gensym/2,
|
||||
reset_gensym/1]).
|
||||
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(iso_ext)).
|
||||
:- use_module(library(si)).
|
||||
|
||||
gensym_key(Base, BaseKey) :-
|
||||
atom_concat('gensym_', Base, BaseKey).
|
||||
|
||||
append_id(Base, UniqueID, Unique) :-
|
||||
atom_chars(Base, BaseChars),
|
||||
number_chars(UniqueID, IDChars),
|
||||
append(BaseChars, IDChars, AtomChars),
|
||||
atom_chars(Unique, AtomChars).
|
||||
|
||||
gensym(Base, Unique) :-
|
||||
must_be(var, Unique),
|
||||
atom_si(Base),
|
||||
gensym_key(Base, BaseKey),
|
||||
( bb_get(BaseKey, UniqueID0) ->
|
||||
UniqueID is UniqueID0 + 1,
|
||||
bb_put(BaseKey, UniqueID),
|
||||
append_id(Base, UniqueID, Unique)
|
||||
; bb_put(BaseKey, 1),
|
||||
append_id(Base, 1, Unique)
|
||||
).
|
||||
|
||||
reset_gensym(Base) :-
|
||||
atom_si(Base),
|
||||
bb_put(Base, 0).
|
||||
@@ -1,11 +1,13 @@
|
||||
%% for builtins that are not part of the ISO standard.
|
||||
%% must be loaded at the REPL with
|
||||
|
||||
%% ?- use_module(library(non_iso)).
|
||||
%% ?- use_module(library(iso_ext)).
|
||||
|
||||
:- module(non_iso, [bb_b_put/2, bb_get/2, bb_put/2, call_cleanup/2,
|
||||
call_with_inference_limit/3, forall/2,
|
||||
setup_call_cleanup/3, variant/2]).
|
||||
:- module(iso_ext, [bb_b_put/2, bb_get/2, bb_put/2, call_cleanup/2,
|
||||
call_with_inference_limit/3, forall/2,
|
||||
partial_string/1, partial_string/3,
|
||||
partial_string_tail/2, setup_call_cleanup/3,
|
||||
variant/2]).
|
||||
|
||||
forall(Generate, Test) :-
|
||||
\+ (Generate, \+ Test).
|
||||
@@ -20,9 +22,9 @@ bb_put(Key, _) :- throw(error(type_error(atom, Key), bb_put/2)).
|
||||
bb_b_put(Key, NewValue) :-
|
||||
( '$bb_get_with_offset'(Key, OldValue, OldOffset) ->
|
||||
call_cleanup((store_global_var_with_offset(Key, NewValue) ; false),
|
||||
reset_global_var_at_offset(Key, OldValue, OldOffset))
|
||||
; call_cleanup((store_global_var(Key, NewValue, _) ; false),
|
||||
reset_global_var_at_key(Key))
|
||||
reset_global_var_at_offset(Key, OldValue, OldOffset))
|
||||
; call_cleanup((store_global_var_with_offset(Key, NewValue) ; false),
|
||||
reset_global_var_at_key(Key))
|
||||
).
|
||||
|
||||
store_global_var_with_offset(Key, Value) :- '$store_global_var_with_offset'(Key, Value).
|
||||
@@ -46,10 +48,35 @@ call_cleanup(G, C) :- setup_call_cleanup(true, G, C).
|
||||
|
||||
% setup_call_cleanup.
|
||||
|
||||
setup_call_cleanup(S, G, C) :- '$get_b_value'(B),
|
||||
S, '$set_cp_by_default'(B), '$get_current_block'(Bb),
|
||||
( '$call_with_default_policy'(var(C)) -> throw(error(instantiation_error, setup_call_cleanup/3))
|
||||
; '$call_with_default_policy'(scc_helper(C, G, Bb)) ).
|
||||
setup_call_cleanup(S, G, C) :-
|
||||
'$get_b_value'(B),
|
||||
call(S),
|
||||
'$set_cp_by_default'(B),
|
||||
'$get_current_block'(Bb),
|
||||
( '$call_with_default_policy'(var(C)) ->
|
||||
throw(error(instantiation_error, setup_call_cleanup/3))
|
||||
; '$call_with_default_policy'(scc_helper(C, G, Bb))
|
||||
).
|
||||
|
||||
:- non_counted_backtracking scc_helper/3.
|
||||
scc_helper(C, G, Bb) :-
|
||||
'$get_cp'(Cp), '$install_scc_cleaner'(C, NBb), call(G),
|
||||
( '$check_cp'(Cp) ->
|
||||
'$reset_block'(Bb),
|
||||
'$call_with_default_policy'(run_cleaners_without_handling(Cp))
|
||||
; '$call_with_default_policy'(true)
|
||||
; '$reset_block'(NBb),
|
||||
'$fail').
|
||||
scc_helper(_, _, Bb) :-
|
||||
'$reset_block'(Bb),
|
||||
'$get_ball'(Ball),
|
||||
'$call_with_default_policy'(run_cleaners_with_handling),
|
||||
'$erase_ball',
|
||||
'$call_with_default_policy'(throw(Ball)).
|
||||
scc_helper(_, _, _) :-
|
||||
'$get_cp'(Cp),
|
||||
'$call_with_default_policy'(run_cleaners_without_handling(Cp)),
|
||||
'$fail'.
|
||||
|
||||
:- non_counted_backtracking run_cleaners_with_handling/0.
|
||||
run_cleaners_with_handling :-
|
||||
@@ -62,27 +89,14 @@ run_cleaners_with_handling :-
|
||||
|
||||
:- non_counted_backtracking run_cleaners_without_handling/1.
|
||||
run_cleaners_without_handling(Cp) :-
|
||||
'$get_scc_cleaner'(C), '$get_level'(B), C, '$set_cp_by_default'(B),
|
||||
'$get_scc_cleaner'(C),
|
||||
'$get_level'(B),
|
||||
call(C),
|
||||
'$set_cp_by_default'(B),
|
||||
'$call_with_default_policy'(run_cleaners_without_handling(Cp)).
|
||||
run_cleaners_without_handling(Cp) :-
|
||||
'$set_cp_by_default'(Cp), '$restore_cut_policy'.
|
||||
|
||||
:- non_counted_backtracking scc_helper/3.
|
||||
scc_helper(C, G, Bb) :-
|
||||
'$get_cp'(Cp), '$install_scc_cleaner'(C, NBb), call(G),
|
||||
( '$check_cp'(Cp) -> '$reset_block'(Bb),
|
||||
'$call_with_default_policy'(run_cleaners_without_handling(Cp))
|
||||
; '$call_with_default_policy'(true)
|
||||
; '$reset_block'(NBb), '$fail').
|
||||
scc_helper(_, _, Bb) :-
|
||||
'$reset_block'(Bb), '$get_ball'(Ball),
|
||||
'$call_with_default_policy'(run_cleaners_with_handling),
|
||||
'$erase_ball',
|
||||
'$call_with_default_policy'(throw(Ball)).
|
||||
scc_helper(_, _, _) :-
|
||||
'$get_cp'(Cp),
|
||||
'$call_with_default_policy'(run_cleaners_without_handling(Cp)),
|
||||
'$fail'.
|
||||
'$set_cp_by_default'(Cp),
|
||||
'$restore_cut_policy'.
|
||||
|
||||
% call_with_inference_limit
|
||||
|
||||
@@ -119,9 +133,31 @@ call_with_inference_limit(G, L, R, Bb, B) :-
|
||||
call_with_inference_limit(_, _, R, Bb, B) :-
|
||||
'$reset_block'(Bb),
|
||||
'$remove_inference_counter'(B, _),
|
||||
( '$get_ball'(Ball), '$get_level'(Cp), '$set_cp_by_default'(Cp)
|
||||
; '$remove_call_policy_check'(B), '$fail' ),
|
||||
( '$get_ball'(Ball),
|
||||
'$get_level'(Cp),
|
||||
'$set_cp_by_default'(Cp)
|
||||
; '$remove_call_policy_check'(B),
|
||||
'$fail'
|
||||
),
|
||||
'$erase_ball',
|
||||
'$call_with_default_policy'(handle_ile(B, Ball, R)).
|
||||
|
||||
variant(X, Y) :- '$variant'(X, Y).
|
||||
|
||||
partial_string(String, L, L0) :-
|
||||
( String == [] ->
|
||||
L = L0
|
||||
; catch(atom_chars(Atom, String),
|
||||
error(E, _),
|
||||
throw(error(E, partial_string/3))),
|
||||
'$create_partial_string'(Atom, L, L0)
|
||||
).
|
||||
|
||||
partial_string(String) :-
|
||||
'$is_partial_string'(String).
|
||||
|
||||
partial_string_tail(String, Tail) :-
|
||||
( partial_string(String) ->
|
||||
'$partial_string_tail'(String, Tail)
|
||||
; throw(error(type_error(partial_string, String), partial_string_tail/2))
|
||||
).
|
||||
@@ -1,7 +1,12 @@
|
||||
:- module(lists, [member/2, select/3, append/3, memberchk/2,
|
||||
reverse/2, length/2, maplist/2, maplist/3,
|
||||
maplist/4, maplist/5, maplist/6, maplist/7,
|
||||
maplist/8, maplist/9]).
|
||||
:- module(lists, [member/2, select/3, append/2, append/3, foldl/4, foldl/5,
|
||||
memberchk/2, reverse/2, length/2, maplist/2,
|
||||
maplist/3, maplist/4, maplist/5, maplist/6,
|
||||
maplist/7, maplist/8, maplist/9, same_length/2, nth0/3,
|
||||
sum_list/2, transpose/2, list_to_set/2]).
|
||||
|
||||
|
||||
:- use_module(library(error)).
|
||||
|
||||
|
||||
length(Xs, N) :-
|
||||
var(N), !,
|
||||
@@ -16,9 +21,9 @@ length(Xs, N) :-
|
||||
; var(Xs0) -> R is N-M, length_rundown(Xs0, R)).
|
||||
length(_, N) :-
|
||||
integer(N), !,
|
||||
throw(error(domain_error(not_less_than_zero, N), length/2)).
|
||||
domain_error(not_less_than_zero, N, length/2).
|
||||
length(_, N) :-
|
||||
throw(error(type_error(integer, N), length/2)).
|
||||
type_error(integer, N, length/2).
|
||||
|
||||
length_addendum([], N, N).
|
||||
length_addendum([_|Xs], N, M) :-
|
||||
@@ -30,26 +35,38 @@ length_rundown([_|Xs], N) :-
|
||||
N1 is N-1,
|
||||
length_rundown(Xs, N1).
|
||||
|
||||
|
||||
member(X, [X|_]).
|
||||
member(X, [_|Xs]) :- member(X, Xs).
|
||||
|
||||
|
||||
select(X, [X|Xs], Xs).
|
||||
select(X, [Y|Xs], [Y|Ys]) :- select(X, Xs, Ys).
|
||||
|
||||
|
||||
append([], []).
|
||||
append([L0|Ls0], Ls) :-
|
||||
append(L0, Rest, Ls),
|
||||
append(Ls0, Rest).
|
||||
|
||||
|
||||
append([], R, R).
|
||||
append([X|L], R, [X|S]) :- append(L, R, S).
|
||||
|
||||
|
||||
memberchk(X, Xs) :- member(X, Xs), !.
|
||||
|
||||
|
||||
reverse(Xs, Ys) :-
|
||||
( nonvar(Xs) -> reverse(Xs, Ys, [], Xs)
|
||||
; reverse(Ys, Xs, [], Ys)
|
||||
).
|
||||
|
||||
reverse([], [], YsRev, YsRev).
|
||||
reverse([X1|Xs], [Y1|Ys], YsPreludeRev, Xss) :-
|
||||
reverse([_|Xs], [Y1|Ys], YsPreludeRev, Xss) :-
|
||||
reverse(Xs, Ys, [Y1|YsPreludeRev], Xss).
|
||||
|
||||
|
||||
maplist(_, []).
|
||||
maplist(Cont1, [E1|E1s]) :-
|
||||
call(Cont1, E1),
|
||||
@@ -87,5 +104,99 @@ maplist(Cont, [E1|E1s], [E2|E2s], [E3|E3s], [E4|E4s], [E5|E5s], [E6|E6s], [E7|E7
|
||||
|
||||
maplist(_, [], [], [], [], [], [], [], []).
|
||||
maplist(Cont, [E1|E1s], [E2|E2s], [E3|E3s], [E4|E4s], [E5|E5s], [E6|E6s], [E7|E7s], [E8|E8s]) :-
|
||||
call(Cont, E1, E2, E3, E4, E5, E6, E7),
|
||||
call(Cont, E1, E2, E3, E4, E5, E6, E7, E8),
|
||||
maplist(Cont, E1s, E2s, E3s, E4s, E5s, E6s, E7s, E8s).
|
||||
|
||||
|
||||
sum_list(Ls, S) :-
|
||||
foldl(sum_, Ls, 0, S).
|
||||
|
||||
sum_(L, S0, S) :- S is S0 + L.
|
||||
|
||||
|
||||
|
||||
same_length([], []).
|
||||
same_length([_|As], [_|Bs]) :-
|
||||
same_length(As, Bs).
|
||||
|
||||
|
||||
foldl(Goal_3, Ls, A0, A) :-
|
||||
foldl_(Ls, Goal_3, A0, A).
|
||||
|
||||
foldl_([], _, A, A).
|
||||
foldl_([L|Ls], G_3, A0, A) :-
|
||||
call(G_3, L, A0, A1),
|
||||
foldl_(Ls, G_3, A1, A).
|
||||
|
||||
|
||||
foldl(Goal_4, Xs, Ys, A0, A) :-
|
||||
foldl_(Xs, Ys, Goal_4, A0, A).
|
||||
|
||||
foldl_([], [], _, A, A).
|
||||
foldl_([X|Xs], [Y|Ys], G_4, A0, A) :-
|
||||
call(G_4, X, Y, A0, A1),
|
||||
foldl_(Xs, Ys, G_4, A1, A).
|
||||
|
||||
transpose(Ls, Ts) :-
|
||||
lists_transpose(Ls, Ts).
|
||||
|
||||
lists_transpose([], []).
|
||||
lists_transpose([L|Ls], Ts) :-
|
||||
maplist(same_length(L), Ls),
|
||||
foldl(transpose_, L, Ts, [L|Ls], _).
|
||||
|
||||
transpose_(_, Fs, Lists0, Lists) :-
|
||||
maplist(list_first_rest, Lists0, Fs, Lists).
|
||||
|
||||
list_first_rest([L|Ls], L, Ls).
|
||||
|
||||
|
||||
list_to_set(Ls0, Ls) :-
|
||||
maplist(with_var, Ls0, LVs0),
|
||||
keysort(LVs0, LVs),
|
||||
same_elements(LVs),
|
||||
pick_firsts(LVs0, Ls).
|
||||
|
||||
pick_firsts([], []).
|
||||
pick_firsts([E-V|EVs], Fs0) :-
|
||||
( V == visited ->
|
||||
Fs0 = Fs
|
||||
; V = visited,
|
||||
Fs0 = [E|Fs]
|
||||
),
|
||||
pick_firsts(EVs, Fs).
|
||||
|
||||
with_var(E, E-_).
|
||||
|
||||
same_elements([]).
|
||||
same_elements([EV|EVs]) :-
|
||||
foldl(unify_same, EVs, EV, _).
|
||||
|
||||
unify_same(E-V, Prev-Var, E-V) :-
|
||||
( Prev == E ->
|
||||
Var = V
|
||||
; true
|
||||
).
|
||||
|
||||
|
||||
nth0(N, Es, E) :-
|
||||
can_be(integer, N),
|
||||
can_be(list, Es),
|
||||
( integer(N) ->
|
||||
nth0_index(N, Es, E)
|
||||
; nth0_search(N, Es, E)
|
||||
).
|
||||
|
||||
nth0_index(0, [E|_], E) :- !.
|
||||
nth0_index(N, [_|Es], E) :-
|
||||
N > 0,
|
||||
N1 is N - 1,
|
||||
nth0_index(N1, Es, E).
|
||||
|
||||
nth0_search(N, Es, E) :-
|
||||
nth0_search(0, N, Es, E).
|
||||
|
||||
nth0_search(N, N, [E|_], E).
|
||||
nth0_search(N0, N, [_|Es], E) :-
|
||||
N1 is N0 + 1,
|
||||
nth0_search(N1, N, Es, E).
|
||||
|
||||
33
src/prolog/lib/pairs.pl
Normal file
33
src/prolog/lib/pairs.pl
Normal file
@@ -0,0 +1,33 @@
|
||||
:- module(pairs, [pairs_keys_values/3,
|
||||
pairs_keys/2,
|
||||
pairs_values/2,
|
||||
group_pairs_by_key/2,
|
||||
map_list_to_pairs/3]).
|
||||
|
||||
|
||||
pairs_keys_values([], [], []).
|
||||
pairs_keys_values([A-B|ABs], [A|As], [B|Bs]) :-
|
||||
pairs_keys_values(ABs, As, Bs).
|
||||
|
||||
pairs_keys(Ps, Ks) :- pairs_keys_values(Ps, Ks, _).
|
||||
|
||||
pairs_values(Ps, Vs) :- pairs_keys_values(Ps, _, Vs).
|
||||
|
||||
map_list_to_pairs(Pred, Ls, Ps) :-
|
||||
map_list_to_pairs2(Ls, Pred, Ps).
|
||||
|
||||
map_list_to_pairs2([], _, []).
|
||||
map_list_to_pairs2([H|T0], Pred, [K-H|T]) :-
|
||||
call(Pred, H, K),
|
||||
map_list_to_pairs2(T0, Pred, T).
|
||||
|
||||
|
||||
group_pairs_by_key([], []).
|
||||
group_pairs_by_key([K-V|KVs0], [K-[V|Vs]|KVs]) :-
|
||||
same_key(K, KVs0, Vs, KVs1),
|
||||
group_pairs_by_key(KVs1, KVs).
|
||||
|
||||
same_key(K0, [K1-V|KVs0], [V|Vs], KVs) :-
|
||||
K0 == K1, !,
|
||||
same_key(K0, KVs0, Vs, KVs).
|
||||
same_key(_, KVs, [], KVs).
|
||||
24
src/prolog/lib/pio.pl
Normal file
24
src/prolog/lib/pio.pl
Normal file
@@ -0,0 +1,24 @@
|
||||
:- module(pio, [phrase_from_file/2,
|
||||
phrase_from_file/3]).
|
||||
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(lists), [member/2]).
|
||||
|
||||
phrase_from_file(NT, File) :-
|
||||
phrase_from_file(NT, File, []).
|
||||
|
||||
phrase_from_file(NT, File, Options) :-
|
||||
( var(File) -> instantiation_error(phrase_from_file/3)
|
||||
; (\+ atom(File) ; File = []) ->
|
||||
domain_error(source_sink, File, phrase_from_file/3)
|
||||
; must_be(list, Options),
|
||||
( member(Var, Options), var(Var) -> instantiation_error(phrase_from_file/3)
|
||||
; member(type(Type), Options) ->
|
||||
must_be(atom, Type),
|
||||
member(Type, [text,binary])
|
||||
; Type = text
|
||||
),
|
||||
'$file_to_chars'(File, Chars, Type),
|
||||
phrase(NT, Chars)
|
||||
).
|
||||
59
src/prolog/lib/random.pl
Normal file
59
src/prolog/lib/random.pl
Normal file
@@ -0,0 +1,59 @@
|
||||
:- module(random, [maybe/0, random/1, random_integer/3, set_random/1]).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
To retain desirable declarative properties, predicates that internally
|
||||
use random numbers should be equipped with an argument that specifies
|
||||
the random seed. This makes everything completely reproducible.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
:- use_module(library(error)).
|
||||
|
||||
% succeeds with probability 0.5.
|
||||
maybe :- '$maybe'.
|
||||
|
||||
% The higher the precision, the slower it gets.
|
||||
random_number_precision(64).
|
||||
|
||||
random(R) :-
|
||||
var(R),
|
||||
random_number_precision(N),
|
||||
rnd(N, R).
|
||||
|
||||
random_integer(Lower, Upper, R) :-
|
||||
var(R),
|
||||
( (var(Lower) ; var(Upper)) ->
|
||||
instantiation_error(random_integer/3)
|
||||
; \+ integer(Lower) ->
|
||||
domain_error(integer, Lower, random_integer/3)
|
||||
; \+ integer(Upper) ->
|
||||
domain_error(integer, Upper, random_integer/3)
|
||||
; Upper > Lower,
|
||||
random(R0),
|
||||
R is floor((Upper - Lower) * R0 + Lower)
|
||||
).
|
||||
|
||||
rnd(N, R) :-
|
||||
rnd_(N, 0, R).
|
||||
|
||||
rnd_(0, R, R) :- !.
|
||||
rnd_(N, R0, R) :-
|
||||
maybe,
|
||||
!,
|
||||
N1 is N - 1,
|
||||
rnd_(N1, R0, R).
|
||||
rnd_(N, R0, R) :-
|
||||
N1 is N - 1,
|
||||
R1 is R0 + 1.0 / 2.0 ^ N,
|
||||
rnd_(N1, R1, R).
|
||||
|
||||
set_random(Seed) :-
|
||||
( nonvar(Seed) ->
|
||||
( Seed = seed(S) ->
|
||||
( var(S) -> instantiation_error(set_random/1)
|
||||
; integer(S) -> '$set_seed'(S)
|
||||
; type_error(integer, S, set_random/1)
|
||||
)
|
||||
)
|
||||
; instantiation_error(set_random/1)
|
||||
).
|
||||
|
||||
58
src/prolog/lib/sockets.pl
Normal file
58
src/prolog/lib/sockets.pl
Normal file
@@ -0,0 +1,58 @@
|
||||
|
||||
:- module(sockets, [socket_client_open/3,
|
||||
socket_server_open/2,
|
||||
socket_server_accept/4,
|
||||
socket_server_close/1,
|
||||
current_hostname/1]).
|
||||
|
||||
:- use_module(library(error)).
|
||||
|
||||
|
||||
socket_client_open(Addr, Stream, Options) :-
|
||||
( var(Addr) ->
|
||||
throw(error(instantiation_error, socket_client_open/3))
|
||||
;
|
||||
true
|
||||
),
|
||||
must_be(var, Stream),
|
||||
must_be(list, Options),
|
||||
( Addr = Address:Port,
|
||||
atom(Address),
|
||||
( atom(Port) ; integer(Port) ) ->
|
||||
true
|
||||
;
|
||||
throw(error(type_error(socket_address, Addr), socket_client_open/3))
|
||||
),
|
||||
builtins:parse_stream_options(Options,
|
||||
[Alias, EOFAction, Reposition, Type],
|
||||
socket_client_open/3),
|
||||
'$socket_client_open'(Address, Port, Stream, Alias, EOFAction, Reposition, Type).
|
||||
|
||||
|
||||
socket_server_open(Addr, ServerSocket) :-
|
||||
must_be(var, ServerSocket),
|
||||
( ( integer(Addr) ; var(Addr) ) ->
|
||||
'$socket_server_open'([], Addr, ServerSocket)
|
||||
;
|
||||
Addr = Address:Port,
|
||||
must_be(atom, Address),
|
||||
can_be(integer, Port),
|
||||
'$socket_server_open'(Address, Port, ServerSocket)
|
||||
).
|
||||
|
||||
|
||||
socket_server_accept(ServerSocket, Client, Stream, Options) :-
|
||||
must_be(var, Client),
|
||||
must_be(var, Stream),
|
||||
builtins:parse_stream_options(Options,
|
||||
[Alias, EOFAction, Reposition, Type],
|
||||
socket_server_accept/4),
|
||||
'$socket_server_accept'(ServerSocket, Client, Stream, Alias, EOFAction, Reposition, Type).
|
||||
|
||||
|
||||
socket_server_close(ServerSocket) :-
|
||||
'$socket_server_close'(ServerSocket).
|
||||
|
||||
|
||||
current_hostname(HostName) :-
|
||||
'$current_hostname'(HostName).
|
||||
220
src/prolog/lib/tabling.pl
Normal file
220
src/prolog/lib/tabling.pl
Normal file
@@ -0,0 +1,220 @@
|
||||
|
||||
:- module(tabling,
|
||||
[ start_tabling/2, % +Wrapper, :Worker.
|
||||
|
||||
abolish_all_tables/0,
|
||||
|
||||
% (table)/1, % +PI ...
|
||||
op(1150, fx, table)
|
||||
]).
|
||||
|
||||
:- use_module('tabling/double_linked_list').
|
||||
:- use_module('tabling/table_data_structure').
|
||||
:- use_module('tabling/batched_worklist').
|
||||
:- use_module('tabling/wrapper').
|
||||
:- use_module('tabling/global_worklist').
|
||||
:- use_module('tabling/table_link_manager').
|
||||
|
||||
:- use_module(library(cont)).
|
||||
:- use_module(library(lists)).
|
||||
%:- use_module(library(debug)).
|
||||
:- use_module(library(iso_ext)).
|
||||
|
||||
%% :- meta_predicate
|
||||
%% start_tabling(+, 0).
|
||||
|
||||
%% user:exception(+Exception, +Var, -Action)
|
||||
%
|
||||
% Realises lazy initialization of table variables.
|
||||
|
||||
%% user:exception(undefined_global_variable, Var, retry) :-
|
||||
%% ( table_gvar(Var)
|
||||
%% -> true
|
||||
%% ; format('Creating global var ~q~n', [Var]),
|
||||
%% nb_setval(Var, [])
|
||||
%% ).
|
||||
/*
|
||||
table_gvar(trie_table_link) :-
|
||||
table_datastructure_initialize.
|
||||
table_gvar(newly_created_table_identifiers) :-
|
||||
table_datastructure_initialize.
|
||||
table_gvar(table_global_worklist) :-
|
||||
bb_put(table_global_worklist, []).
|
||||
table_gvar(table_leader) :-
|
||||
bb_put(table_leader, []).
|
||||
*/
|
||||
|
||||
%% abolish_all_tables
|
||||
%
|
||||
% Remove all tables. Should not be called when tabling is in
|
||||
% progress.
|
||||
%
|
||||
% @bug Check whether tabling is in progress
|
||||
|
||||
|
||||
abolish_all_tables :-
|
||||
bb_put(trie_table_link, []),
|
||||
bb_put(newly_created_table_identifiers, []),
|
||||
bb_put(table_global_worklist,[]),
|
||||
bb_put(table_leader, []).
|
||||
|
||||
|
||||
% Find table and status for the given call variant.
|
||||
%
|
||||
table_and_status_for_variant(V,T,S) :-
|
||||
% Order of the two calls really important: first create, then get status
|
||||
table_for_variant(V,T),
|
||||
tbd_table_status(T,S).
|
||||
|
||||
start_tabling(Wrapper,Worker) :-
|
||||
put_new_trie_table_link,
|
||||
put_new_global_worklist,
|
||||
put_new_table_identifiers,
|
||||
table_and_status_for_variant(Wrapper,T,S),
|
||||
( S == complete ->
|
||||
get_answer(T,Wrapper)
|
||||
;
|
||||
( exists_scheduling_component ->
|
||||
run_leader(Wrapper,Worker,T),
|
||||
% Now answer the original query!
|
||||
get_answer(T,Wrapper)
|
||||
;
|
||||
run_follower(S,Wrapper,Worker,T)
|
||||
)
|
||||
).
|
||||
|
||||
run_follower(fresh,Wrapper,Worker,T) :-
|
||||
activate(Wrapper,Worker,T),
|
||||
shift(call_info(Wrapper,T)).
|
||||
|
||||
run_follower(active,Wrapper,_Worker,T) :-
|
||||
shift(call_info(Wrapper,T)).
|
||||
|
||||
run_leader(Wrapper,Worker,T) :-
|
||||
create_scheduling_component,
|
||||
activate(Wrapper,Worker,T),
|
||||
completion,
|
||||
unset_scheduling_component.
|
||||
|
||||
exists_scheduling_component :-
|
||||
bb_get(table_leader, Leader),
|
||||
Leader == [].
|
||||
|
||||
create_scheduling_component :-
|
||||
bb_b_put(table_leader, leaderCreated).
|
||||
|
||||
unset_scheduling_component :-
|
||||
bb_put(table_leader, []).
|
||||
|
||||
set_all_complete :-
|
||||
get_newly_created_table_identifiers(Ts, _),
|
||||
set_all_complete_(Ts).
|
||||
|
||||
set_all_complete_([]).
|
||||
set_all_complete_([T|Ts]) :-
|
||||
set_complete_status(T),
|
||||
set_all_complete_(Ts).
|
||||
|
||||
cleanup_all_complete :-
|
||||
get_newly_created_table_identifiers(Ts,_),
|
||||
cleanup_all_complete_(Ts).
|
||||
|
||||
cleanup_all_complete_([]).
|
||||
cleanup_all_complete_([T|Ts]) :-
|
||||
cleanup_after_complete(T),
|
||||
cleanup_all_complete_(Ts).
|
||||
|
||||
activate(Wrapper,Worker,T) :-
|
||||
set_active_status(T),
|
||||
(
|
||||
delim(Wrapper,Worker,T),
|
||||
fail
|
||||
;
|
||||
true
|
||||
).
|
||||
|
||||
delim(Wrapper,Worker,Table) :-
|
||||
% debug(tabling, 'ACT: ~p on ~p', [Wrapper, Table]),
|
||||
reset(Worker,SourceCall,Continuation),
|
||||
( Continuation = none ->
|
||||
( add_answer(Table,Wrapper)
|
||||
-> true %debug(tabling, 'ADD: ~p', [Wrapper])
|
||||
; %debug(tabling, 'DUP: ~p', [Wrapper]),
|
||||
fail
|
||||
)
|
||||
;
|
||||
Continuation = cont(Cont),
|
||||
SourceCall = call_info(_,SourceTable),
|
||||
TargetCall = call_info(Wrapper,Table),
|
||||
Dependency = dependency(SourceCall,Cont,TargetCall),
|
||||
%debug(tabling, 'DEP: ~p: ~p', [SourceTable,Dependency]),
|
||||
store_dependency(SourceTable,Dependency)
|
||||
).
|
||||
|
||||
completion :-
|
||||
( worklist_empty ->
|
||||
set_all_complete,
|
||||
cleanup_all_complete,
|
||||
% The place of the call to reset is really important: it must happen after the completion. If you do it before, you will wrongly remove yourself from the list of newly created table identifiers. On starting hProlog there are no newly created table identifiers, and nb_getval gives [] which is the perfect value.
|
||||
reset_newly_created_table_identifiers
|
||||
;
|
||||
pop_worklist(Table),
|
||||
completion_step(Table),
|
||||
completion
|
||||
).
|
||||
|
||||
completion_step(SourceTableID) :-
|
||||
bb_get(SourceTableID, Table),
|
||||
get_nb_identifiers(Table, NBWorklistID, _),
|
||||
(
|
||||
table_get_work(NBWorklistID,Answer,dependency(Source,Continuation,Target)),
|
||||
Source = call_info(Answer,_),
|
||||
Target = call_info(Wrapper,TargetTable),
|
||||
delim(Wrapper,Continuation,TargetTable),
|
||||
fail
|
||||
;
|
||||
true
|
||||
).
|
||||
|
||||
table_get_work(NBWorklistID,Answer,Dependency) :-
|
||||
% get_worklist(Table, Worklist),
|
||||
% NOT IN PAPER (could be part of the definition of pop_worklist):
|
||||
bb_get(NBWorklistID, table_nb_worklist(Worklist)),
|
||||
unset_global_worklist_presence_flag(Worklist),
|
||||
set_flag_executing_all_work(Worklist),
|
||||
bb_put(NBWorklistID, table_nb_worklist(Worklist)),
|
||||
table_get_work_(NBWorklistID,Answer,Dependency).
|
||||
|
||||
table_get_work_(NBWorklistID,Answer,Dependency) :-
|
||||
worklist_do_all_work(NBWorklistID,Answer,Dependency0), % This will eventually fail
|
||||
copy_term(Dependency0,Dependency).
|
||||
|
||||
table_get_work_(NBWorklistID,_Answer,_Dependency) :-
|
||||
bb_get(NBWorklistID, table_nb_worklist(Worklist)),
|
||||
unset_flag_executing_all_work(Worklist),
|
||||
bb_put(NBWorklistID, table_nb_worklist(Worklist)),
|
||||
fail.
|
||||
|
||||
worklist_do_all_work(NBWorklistID,Answer,Dependency) :-
|
||||
( bb_get(NBWorklistID, table_nb_worklist(Worklist)),
|
||||
wkl_worklist_work_done(Worklist) ->
|
||||
fail
|
||||
;
|
||||
worklist_do_step(NBWorklistID,Answer,Dependency)
|
||||
;
|
||||
worklist_do_all_work(NBWorklistID,Answer,Dependency)
|
||||
).
|
||||
|
||||
worklist_do_step(NBWorklistID,Answer,Dependency) :-
|
||||
bb_get(NBWorklistID, table_nb_worklist(Worklist)),
|
||||
wkl_p_get_rightmost_inner_answer_cluster_pointer(Worklist,ACP),
|
||||
wkl_p_swap_answer_continuation(Worklist,ACP,SCP),
|
||||
dll_get_data(ACP,wkl_answer_cluster(AListFlag)),
|
||||
dll_get_data(SCP,wkl_suspension_cluster(SListFlag)),
|
||||
get_atts(AListFlag, batched_worklist, wkl_answer_cluster(AList)),
|
||||
get_atts(SListFlag, batched_worklist, wkl_suspension_cluster(SList)),
|
||||
bb_put(NBWorklistID, table_nb_worklist(Worklist)),
|
||||
member(Answer,AList),
|
||||
member(Dependency,SList).
|
||||
|
||||
:- initialization(bb_put(table_leader, [])).
|
||||
389
src/prolog/lib/tabling/batched_worklist.pl
Normal file
389
src/prolog/lib/tabling/batched_worklist.pl
Normal file
@@ -0,0 +1,389 @@
|
||||
/* Part of SWI-Prolog
|
||||
|
||||
Author: Benoit Desouter <Benoit.Desouter@UGent.be>
|
||||
Jan Wielemaker (SWI-Prolog port)
|
||||
Copyright (c) 2016, Benoit Desouter
|
||||
All rights reserved.
|
||||
|
||||
Ported to Scryer Prolog by Mark Thom (2019/2020).
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions
|
||||
are met:
|
||||
|
||||
1. Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
|
||||
2. Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions and the following disclaimer in
|
||||
the documentation and/or other materials provided with the
|
||||
distribution.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
|
||||
FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
|
||||
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
|
||||
BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
|
||||
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||||
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
|
||||
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGE.
|
||||
*/
|
||||
|
||||
:- module(batched_worklist,
|
||||
[ wkl_add_answer/2, % +WorkList, +Answer
|
||||
wkl_add_suspension/2, % +Worklist, +Suspension
|
||||
wkl_new_worklist/2, % +TableID, -WorkList
|
||||
unset_flag_executing_all_work/1, % +WorkList
|
||||
unset_global_worklist_presence_flag/1, % +WorkList
|
||||
set_flag_executing_all_work/1, % +WorkList
|
||||
wkl_p_get_rightmost_inner_answer_cluster_pointer/2, % +WorkList, -Cluster
|
||||
wkl_p_swap_answer_continuation/3, % +WorkList, +Cluster1, +Cluster2
|
||||
wkl_worklist_work_done/1 % +WorkList
|
||||
]).
|
||||
|
||||
:- use_module(global_worklist).
|
||||
:- use_module(double_linked_list).
|
||||
|
||||
:- use_module(library(atts)).
|
||||
:- use_module(library(lists)).
|
||||
|
||||
:- attribute executing_all_work/1, worklist_presence/1, wkl_answer_cluster/1, wkl_suspension_cluster/1, wkl_answer_cluster_pointer_flag/1.
|
||||
|
||||
/** <module> Tabling Worklist management
|
||||
|
||||
A batched worklist: a worklist that clusters suspensions and answers as
|
||||
much as possible. The idea is to minimize the number of swaps. This
|
||||
should be more efficient than the worklist implementation without
|
||||
clustering.
|
||||
|
||||
Argument positions for nb_setarg:
|
||||
|
||||
1. double linked list
|
||||
2. pointer to the list entry of the rightmost inner answer cluster
|
||||
3. flag indicating the execution of wkl_unfolded_do_all_work
|
||||
4. flag indicating whether the table identifier associated with this
|
||||
worklist is already in the global worklist. This is because more
|
||||
than one answer can be added due to the execution of other
|
||||
worklists. 5: table identifier for the table this worklist belongs
|
||||
to
|
||||
|
||||
Contents of a batched worklist:
|
||||
|
||||
- wkl_answer_cluster([Answer|RestAnswers]).
|
||||
- wkl_suspension([Suspension|RestSuspension]).
|
||||
|
||||
The difficulty is that you should not add new entries to a cluster once
|
||||
you started its execution. Probably the simplest way to do so is by
|
||||
swapping the answer cluster AC and suspension cluster SC before you take
|
||||
the cartesian product of all answers in AC with all suspensions in SC.
|
||||
|
||||
Illustration why you may need a complex procedure for finding the future
|
||||
rightmost inner answer cluster.
|
||||
|
||||
Assume all clusters have 2 entries.
|
||||
|
||||
1. AA1 CC1
|
||||
2. AA2 CC1 AA1 CC2 (swapped AA1 and CC1)
|
||||
3. AA2 CC1 CC2 AA1 (swapped AA1 and CC2)
|
||||
4. AA3 CC1 AA2 CC2 AA1 CC3 (swapped AA2 and CC1)
|
||||
|
||||
Now AA1 is the RIAC, but AA2 is the future RIAC.
|
||||
|
||||
Can you find the future RIAC smarter than by walking back? If you don't,
|
||||
then it doesn't make sense to use a future RIAC at all. You could use a
|
||||
stack, which should not grow too large because you use batches. But
|
||||
walking back also should not take too long, since you use batches.
|
||||
|
||||
So let's not use a future RIAC in the first place, and just walk back
|
||||
when we need a new RIAC. This is easy to implement, hence we can test
|
||||
more quickly.
|
||||
|
||||
Abbreviations:
|
||||
|
||||
- RIAC = rightmost inner answer cluster
|
||||
- FUTRIAC = future rightmost inner answer cluster
|
||||
*/
|
||||
|
||||
%% wkl_new_worklist(+TableID, -WorkList) is det.
|
||||
%
|
||||
% Create a new worklist for TableID and add it to the global
|
||||
% worklist list (global variable `table_global_worklist`.
|
||||
|
||||
wkl_new_worklist(TableIdentifier, wkl_worklist(List,AnswerClusterPointerFlag,ExecutingAllWork,WorklistPresence,TableIdentifier)) :-
|
||||
dll_new_double_linked_list(List),
|
||||
put_atts(AnswerClusterPointerFlag, wkl_answer_cluster_pointer_flag(List)),
|
||||
% We set the RIAC to the dummy element at the start of the double linked list, which is List.
|
||||
% Don't set all the rest for now.
|
||||
put_atts(ExecutingAllWork, executing_all_work(false)),
|
||||
put_atts(WorklistPresence, worklist_presence(true)),
|
||||
add_to_global_worklist(TableIdentifier).
|
||||
|
||||
%% wkl_worklist_work_done(+WorkList) is semidet.
|
||||
%
|
||||
% The work is done if the RIAC pointer points to the unused cell
|
||||
% at the beginning. The work is also done if the RIAC pointer
|
||||
% points to the sole answer cluster in a list dll_start -
|
||||
% wkl_answer_cluster, because in that case there are no
|
||||
% suspensions to swap with. This is a special case, which we only
|
||||
% discovered by testing. You can detect it by checking whether the
|
||||
% NEXT-pointer of the RIAC is the dummy pointer.
|
||||
|
||||
wkl_worklist_work_done(Worklist) :-
|
||||
wkl_p_get_rightmost_inner_answer_cluster_pointer(Worklist,RiacPointer),
|
||||
( wkl_is_dummy_pointer(Worklist,RiacPointer) ->
|
||||
true
|
||||
;
|
||||
dll_get_pointer_to_next(RiacPointer,NextPointer),
|
||||
wkl_is_dummy_pointer(Worklist,NextPointer)
|
||||
).
|
||||
|
||||
set_flag_executing_all_work(wkl_worklist(_,_,ExecutingAllWork,_,_)) :-
|
||||
put_atts(ExecutingAllWork, executing_all_work(true)).
|
||||
|
||||
unset_flag_executing_all_work(wkl_worklist(_,_,ExecutingAllWork,_,_)) :-
|
||||
put_atts(ExecutingAllWork, executing_all_work(false)).
|
||||
|
||||
% Swap answer cluster and the adjacent continuation cluster.
|
||||
% Mode: + + -
|
||||
wkl_p_swap_answer_continuation(Worklist,InnerAnswerClusterPointer,SuspensionClusterPointer) :-
|
||||
% You can have a worklist containing only an answer cluster, but no continuations.
|
||||
% In that case SuspensionClusterPointer will be dll_start. We must take our precautions elsewhere.
|
||||
% Do not forget that the list of answers and the list of suspensions is wrapped in a predicate!
|
||||
dll_get_pointer_to_next(InnerAnswerClusterPointer,SuspensionClusterPointer),
|
||||
% For reasons of speed we don't use dll_swap: we only swap adjacent elements and we can be sure that they are in the order A,B.
|
||||
% Therefore we can use dll_p_swap_adjacent_elements_
|
||||
dll_p_swap_adjacent_elements_(InnerAnswerClusterPointer,SuspensionClusterPointer),
|
||||
% Update the necessary pointers
|
||||
wkl_p_update_righmost_inner_answer_cluster_pointer(Worklist,InnerAnswerClusterPointer).
|
||||
|
||||
% Update the pointer if the answer cluster it points to is no longer the rightmost inner answer cluster.
|
||||
wkl_p_update_righmost_inner_answer_cluster_pointer(Worklist,InnerAnswerClusterPointer) :-
|
||||
( wkl_p_answer_cluster_currently_moved_completely(Worklist,InnerAnswerClusterPointer) ->
|
||||
wkl_p_find_new_rightmost_inner_answer_cluster_pointer(Worklist,InnerAnswerClusterPointer,NewRiacPointer),
|
||||
wkl_p_set_rightmost_inner_answer_cluster_pointer(Worklist,NewRiacPointer)
|
||||
;
|
||||
true
|
||||
).
|
||||
|
||||
% Rationale for this implementation: see the top of the file.
|
||||
% Unify NewRiacPointer to the first pointer satisfying the following conditions:
|
||||
% - left of StartPointer (when viewing the list as DUMMY-ELEM POINTER POINTER POINTER START-POINTER)
|
||||
% - either an anwer pointer or the dummy element
|
||||
% When StartPointer is the dummy element, NewRiacPointer is also the dummy element. We never look "in front of" the dummy element.
|
||||
wkl_p_find_new_rightmost_inner_answer_cluster_pointer(Worklist,StartPointer,NewRiacPointer) :-
|
||||
( wkl_is_dummy_pointer(Worklist,StartPointer) ->
|
||||
NewRiacPointer = StartPointer
|
||||
;
|
||||
dll_get_pointer_to_previous(StartPointer,FirstCandidatePointer),
|
||||
wkl_p_find_new_riac_helper(Worklist,FirstCandidatePointer,NewRiacPointer)
|
||||
).
|
||||
|
||||
wkl_p_find_new_riac_helper(Worklist,CandidatePointer,NewRiacPointer) :-
|
||||
( is_answer_cluster_or_dummy_pointer(Worklist,CandidatePointer) ->
|
||||
NewRiacPointer = CandidatePointer
|
||||
;
|
||||
dll_get_pointer_to_previous(CandidatePointer,NewCandidate),
|
||||
wkl_p_find_new_riac_helper(Worklist,NewCandidate,NewRiacPointer)
|
||||
).
|
||||
|
||||
is_answer_cluster_or_dummy_pointer(Worklist,Pointer) :-
|
||||
( wkl_is_dummy_pointer(Worklist,Pointer) ->
|
||||
true
|
||||
;
|
||||
wkl_p_dereference_pointer(Worklist,Pointer,A),
|
||||
wkl_p_is_answer_cluster(A)
|
||||
).
|
||||
|
||||
% Failure-driven loop
|
||||
wkl_clusters_cartesian_product(AnswerCluster,SuspensionCluster) :-
|
||||
( member(Answer,AnswerCluster),
|
||||
member(Suspension,SuspensionCluster),
|
||||
% The meat
|
||||
run_worklist_helper(Suspension,Answer),
|
||||
% Trigger loop
|
||||
fail
|
||||
;
|
||||
% Loop base case
|
||||
true
|
||||
).
|
||||
|
||||
run_worklist_helper(_Suspension, _Answer) :- % FIXME: just silense
|
||||
throw('not implemented').
|
||||
|
||||
wkl_both_flags_unset(wkl_worklist(_Dll,_Riac,ExecutingAllWork,WorklistPresence,_TableIdentifier)) :-
|
||||
put_atts(ExecutingAllWork, executing_all_work(false)),
|
||||
put_atts(WorklistPresence, worklist_presence(false)).
|
||||
|
||||
set_global_worklist_presence_flag(wkl_worklist(_,_,_,WorklistPresence,_)) :-
|
||||
put_atts(WorklistPresence, worklist_presence(true)).
|
||||
|
||||
unset_global_worklist_presence_flag(wkl_worklist(_,_,_,WorklistPresence,_)) :-
|
||||
put_atts(WorklistPresence, worklist_presence(false)).
|
||||
|
||||
potentially_add_to_global_worklist(Worklist) :-
|
||||
( wkl_both_flags_unset(Worklist) ->
|
||||
% Set the flag for presence in the metaworklist
|
||||
set_global_worklist_presence_flag(Worklist),
|
||||
% Should add to the metaworklist
|
||||
arg(5,Worklist,TableIdentifier),
|
||||
add_to_global_worklist(TableIdentifier)
|
||||
;
|
||||
% Nothing to do.
|
||||
true
|
||||
).
|
||||
|
||||
wkl_add_answer(Worklist,Answer) :-
|
||||
% Add to global worklist if not executing during wkl_unfolded_do_all_work and not there yet as well.
|
||||
potentially_add_to_global_worklist(Worklist),
|
||||
( wkl_p_leftmost_cluster_is_answer_cluster(Worklist) ->
|
||||
wkl_add_to_existing_answer_cluster(Worklist,Answer)
|
||||
% If you add to an existing cluster, then obviously you should not change the RIAC.
|
||||
;
|
||||
wkl_add_to_new_answer_cluster(Worklist,Answer,AnswerClusterPointer),
|
||||
% If the RIAC is the dummy pointer, we need to change that.
|
||||
wkl_p_update_rightmost_inner_answer_cluster_pointer(Worklist,AnswerClusterPointer)
|
||||
).
|
||||
|
||||
wkl_p_update_rightmost_inner_answer_cluster_pointer(Worklist,NewAnswerClusterPointer) :-
|
||||
wkl_p_get_rightmost_inner_answer_cluster_pointer(Worklist,CurrentRiac),
|
||||
( wkl_is_dummy_pointer(Worklist,CurrentRiac) -> %% <- debugging this.
|
||||
wkl_p_set_rightmost_inner_answer_cluster_pointer(Worklist,NewAnswerClusterPointer)
|
||||
;
|
||||
% Nothing to do.
|
||||
true
|
||||
).
|
||||
|
||||
wkl_add_suspension(Worklist,Suspension) :-
|
||||
% Add to global worklist if not executing during wkl_unfolded_do_all_work and not there yet as well.
|
||||
potentially_add_to_global_worklist(Worklist),
|
||||
( wkl_p_rightmost_cluster_is_suspension_cluster(Worklist) ->
|
||||
wkl_add_to_existing_suspension_cluster(Worklist,Suspension)
|
||||
;
|
||||
wkl_add_to_new_suspension_cluster(Worklist,Suspension,SuspensionClusterPointer),
|
||||
% If added to a new suspension cluster, we may need to change the righmost inner answer pointer
|
||||
wkl_p_potential_rias_update_add_contin(Worklist,SuspensionClusterPointer)
|
||||
).
|
||||
|
||||
% This predicate should not fail.
|
||||
wkl_p_potential_rias_update_add_contin(Worklist,SuspensionClusterPointer) :-
|
||||
% Look back one entry of the freshly inserted SuspensionClusterPointer
|
||||
dll_get_pointer_to_previous(SuspensionClusterPointer,PotentialNewRiacPointer),
|
||||
( wkl_p_is_answer_cluster_pointer(Worklist,PotentialNewRiacPointer) ->
|
||||
% We must indeed update the rightmost inner answer cluster pointer.
|
||||
wkl_p_set_rightmost_inner_answer_cluster_pointer(Worklist,PotentialNewRiacPointer)
|
||||
;
|
||||
% Nothing to do, but we should not fail.
|
||||
true
|
||||
).
|
||||
|
||||
wkl_add_to_existing_answer_cluster(Worklist, Answer) :-
|
||||
arg(1,Worklist,Dll),
|
||||
dll_get_pointer_to_next(Dll,AnswerClusterPointer),
|
||||
wkl_p_dereference_pointer(Worklist,AnswerClusterPointer,AnswerCluster),
|
||||
AnswerCluster = wkl_answer_cluster(AnswersFlag),
|
||||
get_atts(AnswersFlag, wkl_answer_cluster(AnswersAlreadyInCluster)),
|
||||
put_atts(AnswersFlag, wkl_answer_cluster([Answer|AnswersAlreadyInCluster])).
|
||||
|
||||
wkl_add_to_new_answer_cluster(
|
||||
wkl_worklist(Dll,_Ria,_FlagExecutingWork,_AlreadyInMetaworklist,_TableIdentifier),
|
||||
Answer,AnswerClusterPointer
|
||||
) :-
|
||||
dll_append_left(Dll,wkl_answer_cluster(AnswerFlag),AnswerClusterPointer),
|
||||
put_atts(AnswerFlag, wkl_answer_cluster([Answer])).
|
||||
|
||||
wkl_add_to_existing_suspension_cluster(Worklist, Suspension) :-
|
||||
arg(1,Worklist,Dll),
|
||||
dll_get_pointer_to_previous(Dll,SuspensionClusterPointer),
|
||||
wkl_p_dereference_pointer(Worklist,SuspensionClusterPointer,SuspensionCluster),
|
||||
SuspensionCluster = wkl_suspension_cluster(SuspensionsFlag),
|
||||
get_atts(SuspensionsFlag, wkl_suspension_cluster(SuspensionsAlreadyInCluster)),
|
||||
put_atts(SuspensionsFlag, wkl_suspension_cluster([Suspension|SuspensionsAlreadyInCluster])).
|
||||
%% nb_linkarg(1,SuspensionCluster,[Suspension|SuspensionsAlreadyInCluster]).
|
||||
|
||||
wkl_add_to_new_suspension_cluster(
|
||||
wkl_worklist(Dll,_Ria,_FlagExecutingWork,_AlreadyInMetaworklist,_TableIdentifier),
|
||||
Suspension,
|
||||
SuspensionClusterPointer
|
||||
) :-
|
||||
put_atts(SuspensionFlag, wkl_suspension_cluster([Suspension])),
|
||||
dll_append_right(Dll,wkl_suspension_cluster(SuspensionFlag),SuspensionClusterPointer).
|
||||
|
||||
wkl_p_is_answer_cluster(CandidateAnswerCluster) :-
|
||||
nonvar(CandidateAnswerCluster),
|
||||
CandidateAnswerCluster = wkl_answer_cluster(_).
|
||||
|
||||
wkl_p_is_suspension_cluster(CandidateSuspensionCluster) :-
|
||||
nonvar(CandidateSuspensionCluster),
|
||||
CandidateSuspensionCluster = wkl_suspension_cluster(_).
|
||||
|
||||
wkl_p_leftmost_cluster_is_answer_cluster(Worklist) :-
|
||||
arg(1,Worklist,Dll),
|
||||
dll_get_pointer_to_next(Dll,CandidateAnswerClusterPointer),
|
||||
wkl_p_is_answer_cluster_pointer(Worklist,CandidateAnswerClusterPointer).
|
||||
|
||||
wkl_p_rightmost_cluster_is_suspension_cluster(Worklist) :-
|
||||
arg(1,Worklist,Dll),
|
||||
dll_get_pointer_to_previous(Dll,CandidateSuspensionClusterPointer),
|
||||
wkl_p_is_suspension_cluster_pointer(Worklist,CandidateSuspensionClusterPointer).
|
||||
|
||||
|
||||
wkl_p_get_rightmost_inner_answer_cluster_pointer(wkl_worklist(_Dll,InnerAnswerClusterPointerFlag,_FlagExecutingWork,_AlreadyInMetaworklist,_TableIdentifier), InnerAnswerClusterPointer) :-
|
||||
get_atts(InnerAnswerClusterPointerFlag, wkl_answer_cluster_pointer_flag(InnerAnswerClusterPointer)).
|
||||
|
||||
% Succeed if there are currently no more continuation clusters on the right of the given position:
|
||||
% Why 'currently' in the name? Another continuation can be added.
|
||||
wkl_p_answer_cluster_currently_moved_completely(Worklist,AnswerClusterPointer) :-
|
||||
( wkl_p_at_right(Worklist,AnswerClusterPointer) ->
|
||||
true
|
||||
;
|
||||
wkl_p_answer_cluster_on_right(Worklist,AnswerClusterPointer)
|
||||
).
|
||||
|
||||
% Succeeds if the given pointer points to the last element in the list. That is, if its next pointer is the dummy element in the double linked list.
|
||||
wkl_p_at_right(Worklist,Pointer) :-
|
||||
dll_get_pointer_to_next(Pointer,NextPointer),
|
||||
wkl_is_dummy_pointer(Worklist,NextPointer).
|
||||
|
||||
wkl_p_answer_cluster_on_right(Worklist,Pointer) :-
|
||||
dll_get_pointer_to_next(Pointer,NextPointer),
|
||||
wkl_p_is_answer_cluster_pointer(Worklist,NextPointer).
|
||||
|
||||
wkl_is_dummy_pointer(Worklist,Pointer) :-
|
||||
wkl_p_get_double_linked_list(Worklist,Dll),
|
||||
dll_is_dummy_pointer(Dll,Pointer).
|
||||
|
||||
wkl_p_is_answer_cluster_pointer(Worklist,PointerCandidateAnswerCluster) :-
|
||||
( wkl_is_dummy_pointer(Worklist,PointerCandidateAnswerCluster) ->
|
||||
% Certainly not an answer cluster, should not dereference this
|
||||
fail
|
||||
;
|
||||
wkl_p_dereference_pointer(Worklist,PointerCandidateAnswerCluster,CandidateAnswerCluster),
|
||||
wkl_p_is_answer_cluster(CandidateAnswerCluster)
|
||||
).
|
||||
|
||||
wkl_p_is_suspension_cluster_pointer(Worklist,PointerCandidateSuspensionCluster) :-
|
||||
( wkl_is_dummy_pointer(Worklist,PointerCandidateSuspensionCluster) ->
|
||||
% Certainly not an answer cluster, should not dereference this
|
||||
fail
|
||||
;
|
||||
wkl_p_dereference_pointer(Worklist,PointerCandidateSuspensionCluster,CandidateSuspensionCluster),
|
||||
wkl_p_is_suspension_cluster(CandidateSuspensionCluster)
|
||||
).
|
||||
|
||||
wkl_p_get_double_linked_list(Worklist,Dll) :-
|
||||
arg(1,Worklist,Dll).
|
||||
|
||||
% One should not attempt to dereference the dummy pointer in the double linked list.
|
||||
wkl_p_dereference_pointer(_Worklist,Pointer,Data) :-
|
||||
dll_get_data(Pointer,Data).
|
||||
|
||||
% SETTING POINTERS
|
||||
%%%%%%%%%%%%%%%%%%
|
||||
|
||||
wkl_p_set_rightmost_inner_answer_cluster_pointer(Worklist,AnswerClusterPointer) :-
|
||||
arg(2, Worklist, AnswerClusterPointerFlag),
|
||||
put_atts(AnswerClusterPointerFlag, wkl_answer_cluster_pointer_flag(AnswerClusterPointer)).
|
||||
210
src/prolog/lib/tabling/double_linked_list.pl
Normal file
210
src/prolog/lib/tabling/double_linked_list.pl
Normal file
@@ -0,0 +1,210 @@
|
||||
/* Part of SWI-Prolog
|
||||
|
||||
Author: Benoit Desouter <Benoit.Desouter@UGent.be>
|
||||
Jan Wielemaker (SWI-Prolog port)
|
||||
Copyright (c) 2016, Benoit Desouter
|
||||
All rights reserved.
|
||||
|
||||
Ported to Scryer Prolog by Mark Thom (2019/2020).
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions
|
||||
are met:
|
||||
|
||||
1. Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
|
||||
2. Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions and the following disclaimer in
|
||||
the documentation and/or other materials provided with the
|
||||
distribution.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
|
||||
FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
|
||||
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
|
||||
BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
|
||||
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||||
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
|
||||
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGE.
|
||||
*/
|
||||
|
||||
:- module(double_linked_list,
|
||||
[ dll_new_double_linked_list/1, % -List
|
||||
dll_append_right/2, % !List, +Element
|
||||
dll_append_left/2, % !List, +Element
|
||||
dll_append_right/3, % !List, +Element, -Pointer
|
||||
dll_append_left/3, % !List, +Element, -Pointer
|
||||
dll_get_data/2, % +List, -Head
|
||||
dll_get_pointer_to_next/2, % +List, -Pointer
|
||||
dll_get_pointer_to_previous/2, % +List, -Pointer
|
||||
dll_is_dummy_pointer/2, % +List, +Pointer
|
||||
dll_p_swap_adjacent_elements_/2, % +Pointer1, +Pointer2
|
||||
dll_get_contents/2,
|
||||
dll_get_reverse_contents/2
|
||||
]).
|
||||
|
||||
:- use_module(library(atts)).
|
||||
|
||||
:- attribute dll_element/1, dll_next/1, dll_prev/1.
|
||||
|
||||
% A circular double linked list
|
||||
% =============================
|
||||
|
||||
% Always have a unused-cell at the beginning.
|
||||
|
||||
% I do not always inline unifications because the head is then more readable for users who don't need to know the details.
|
||||
|
||||
% Due to lack of modules in hProlog, the following predicate names should not be used elsewhere:
|
||||
% - the heads of all following rules (starting with dll_, I reserve "the namespace"!)
|
||||
|
||||
% dll_cell(Element,Next,Previous)
|
||||
|
||||
% The following is perhaps odd:
|
||||
%
|
||||
% Next link = more to the front (the left)
|
||||
% Previous link = more to the back (the right)
|
||||
%
|
||||
% List structure
|
||||
% --------------
|
||||
% front-of-the-list | ... | back-of-the-list
|
||||
|
||||
dll_new_double_linked_list(List) :-
|
||||
% Nonused cell dll_start at the beginning, points to itself (this is easy when adding elements).
|
||||
List = dll_cell(Start),
|
||||
put_atts(Start, [dll_next(List), dll_prev(List), dll_element(dll_start)]).
|
||||
|
||||
dll_append_right(List, Element) :-
|
||||
dll_append_right(List, Element, _).
|
||||
|
||||
dll_append_left(List, Element) :-
|
||||
dll_append_left(List, Element, _).
|
||||
|
||||
% Append at the back of the list
|
||||
% Mode: + + -
|
||||
dll_append_right(List, Element, Pointer) :-
|
||||
% Get pointer to cell currently at the back. Done by taking the previous element from the unused element representing the list.
|
||||
dll_get_pointer_to_previous(List, OldBack),
|
||||
% Make the new cell point to OldBack as predecessor
|
||||
% Make the new cell point to the unused cell as successor.
|
||||
Pointer = dll_cell(NewCell),
|
||||
put_atts(NewCell, [dll_element(Element), dll_next(List), dll_prev(OldBack)]),
|
||||
% Make OldBack point to the new cell as successor
|
||||
dll_p_set_next_pointer(OldBack, Pointer),
|
||||
% Make the unused cell point to the new cell as predecessor
|
||||
dll_p_set_previous_pointer(List, Pointer).
|
||||
|
||||
% Add to the front of the list
|
||||
% Mode: + + -
|
||||
dll_append_left(List, Element, Pointer) :-
|
||||
% Get pointer to cell currently at the front. Done by taking the next element from the unused element representing the list.
|
||||
dll_get_pointer_to_next(List, OldFront),
|
||||
% Make the new cell point to OldFront as successor
|
||||
% Make the new cell point to the unused cell as predecessor
|
||||
Pointer = dll_cell(NewCell),
|
||||
put_atts(NewCell, [dll_element(Element), dll_prev(List), dll_next(OldFront)]),
|
||||
% Make OldFront point to the new cell as predecessor
|
||||
dll_p_set_previous_pointer(OldFront, Pointer),
|
||||
% Make the unused cell point to the new cell as successor
|
||||
dll_p_set_next_pointer(List, Pointer).
|
||||
|
||||
% get_next_cell?
|
||||
dll_get_pointer_to_next(dll_cell(Cell), PointerNext) :-
|
||||
get_atts(Cell, dll_next(PointerNext)).
|
||||
|
||||
% get_previous_cell?
|
||||
dll_get_pointer_to_previous(dll_cell(Cell), PointerPrevious) :-
|
||||
get_atts(Cell, dll_prev(PointerPrevious)).
|
||||
|
||||
% Will happily give you the "data" from the unused cell at the beginning. (We use this odd behaviour below, f.e. in dll_p_foreach_element_/2.)
|
||||
dll_get_data(dll_cell(Cell), Element) :-
|
||||
get_atts(Cell, dll_element(Element)).
|
||||
|
||||
dll_is_dummy_pointer(List, Pointer) :-
|
||||
dll_get_contents(List, ListContents),
|
||||
dll_get_contents(Pointer, PointerContents),
|
||||
\+ PointerContents \= ListContents.
|
||||
|
||||
% Special case of swapping - used in dll_swap/2.
|
||||
% This is also the case used for swapping a freshly created list with itself.
|
||||
%
|
||||
% Sketch: APrevious <-> PointerA <-> PointerB <-> BNext etc.
|
||||
dll_p_swap_adjacent_elements(PointerA, PointerB) :-
|
||||
% Order B A?
|
||||
( dll_get_pointer_to_next(PointerB, PointerA) ->
|
||||
dll_p_swap_adjacent_elements_(PointerB, PointerA)
|
||||
;
|
||||
% Order A B!
|
||||
dll_p_swap_adjacent_elements_(PointerA, PointerB)
|
||||
).
|
||||
|
||||
% Assumes the order A B.
|
||||
dll_p_swap_adjacent_elements_(PointerA, PointerB) :-
|
||||
% Get A's previous and B's next
|
||||
dll_get_pointer_to_previous(PointerA, PointerAPrevious),
|
||||
dll_get_pointer_to_next(PointerB, PointerBNext),
|
||||
% Set A's previous to B
|
||||
dll_p_set_previous_pointer(PointerA, PointerB),
|
||||
% Set B's next to A
|
||||
dll_p_set_next_pointer(PointerB, PointerA),
|
||||
% Set A's next to BNext
|
||||
dll_p_set_next_pointer(PointerA, PointerBNext),
|
||||
% Set B's previous to APrevious
|
||||
dll_p_set_previous_pointer(PointerB, PointerAPrevious),
|
||||
% Set APrevious' next to B !!
|
||||
dll_p_set_next_pointer(PointerAPrevious, PointerB),
|
||||
% Set BNext's previous to A !!
|
||||
dll_p_set_previous_pointer(PointerBNext, PointerA).
|
||||
|
||||
% Private
|
||||
% Careful: make sure this is called on the actual cell, and not some copy.
|
||||
% Mode: + +
|
||||
dll_p_set_previous_pointer(dll_cell(Cell), PointerToNewPrevious) :-
|
||||
put_atts(Cell, dll_prev(PointerToNewPrevious)).
|
||||
|
||||
% Private
|
||||
% Careful: make sure this is called on the actual cell, and not some copy.
|
||||
% Mode: + +
|
||||
dll_p_set_next_pointer(dll_cell(Cell), PointerToNewNext) :-
|
||||
put_atts(Cell, dll_next(PointerToNewNext)).
|
||||
|
||||
dll_extract_element(ElementFlag, Element) :-
|
||||
( ElementFlag = wkl_suspension_cluster(SuspensionClusterFlag) ->
|
||||
get_atts(SuspensionClusterFlag, batched_worklist, wkl_suspension_cluster(SuspensionCluster)),
|
||||
Element = wkl_suspension_cluster(SuspensionCluster)
|
||||
; ElementFlag = wkl_answer_cluster(AnswerClusterFlag) ->
|
||||
get_atts(AnswerClusterFlag, batched_worklist, wkl_answer_cluster(AnswerCluster)),
|
||||
Element = wkl_answer_cluster(AnswerCluster)
|
||||
).
|
||||
|
||||
dll_get_contents(List, Contents) :-
|
||||
dll_get_pointer_to_next(List, Next),
|
||||
dll_get_contents_(Next, Contents).
|
||||
|
||||
dll_get_contents_(List, Contents) :-
|
||||
dll_get_data(List, ElementFlag),
|
||||
( ElementFlag == dll_start ->
|
||||
Contents = []
|
||||
; dll_extract_element(ElementFlag, Element),
|
||||
Contents = [Element | Rest],
|
||||
dll_get_pointer_to_next(List, Next),
|
||||
dll_get_contents_(Next, Rest)
|
||||
).
|
||||
|
||||
dll_get_reverse_contents(List, Contents) :-
|
||||
dll_get_pointer_to_previous(List, Prev),
|
||||
dll_get_reverse_contents_(Prev, Contents).
|
||||
|
||||
dll_get_reverse_contents_(List, Contents) :-
|
||||
dll_get_data(List, ElementFlag),
|
||||
( ElementFlag == dll_start ->
|
||||
Contents = []
|
||||
; dll_extract_element(ElementFlag, Element),
|
||||
Contents = [Element | Rest],
|
||||
dll_get_pointer_to_previous(List, Prev),
|
||||
dll_get_reverse_contents_(Prev, Rest)
|
||||
).
|
||||
40
src/prolog/lib/tabling/global_worklist.pl
Normal file
40
src/prolog/lib/tabling/global_worklist.pl
Normal file
@@ -0,0 +1,40 @@
|
||||
/* Ported to Scryer Prolog by Mark Thom (2019/2020).
|
||||
*/
|
||||
|
||||
:- module(global_worklist,
|
||||
[ put_new_global_worklist/0,
|
||||
add_to_global_worklist/1,
|
||||
worklist_empty/0,
|
||||
pop_worklist/1
|
||||
]).
|
||||
|
||||
:- use_module(library(atts)).
|
||||
:- use_module(library(iso_ext)).
|
||||
|
||||
:- attribute table_global_worklist/1.
|
||||
|
||||
put_new_global_worklist :-
|
||||
( bb_get(table_global_worklist_initialized, _) ->
|
||||
true
|
||||
; put_atts(Worklist, table_global_worklist([])),
|
||||
bb_put(table_global_worklist, Worklist),
|
||||
bb_b_put(table_global_worklist_initialized, [])
|
||||
).
|
||||
|
||||
add_to_global_worklist(TableIdentifier) :-
|
||||
bb_get(table_global_worklist, TableGlobalWorklistFlag),
|
||||
get_atts(TableGlobalWorklistFlag, table_global_worklist(L1)),
|
||||
put_atts(TableGlobalWorklistFlag, table_global_worklist([TableIdentifier|L1])),
|
||||
bb_put(table_global_worklist, TableGlobalWorklistFlag).
|
||||
|
||||
worklist_empty :-
|
||||
bb_get(table_global_worklist,TableGlobalWorklistFlag),
|
||||
get_atts(TableGlobalWorklistFlag, table_global_worklist(L)),
|
||||
L == [].
|
||||
|
||||
pop_worklist(TableIdentifier) :-
|
||||
bb_get(table_global_worklist,TableGlobalWorklistFlag),
|
||||
get_atts(TableGlobalWorklistFlag, table_global_worklist(L1)),
|
||||
L1 = [TableIdentifier|L2],
|
||||
put_atts(TableGlobalWorklistFlag, table_global_worklist(L2)),
|
||||
bb_put(table_global_worklist, TableGlobalWorklistFlag).
|
||||
253
src/prolog/lib/tabling/table_data_structure.pl
Normal file
253
src/prolog/lib/tabling/table_data_structure.pl
Normal file
@@ -0,0 +1,253 @@
|
||||
:- module(table_datastructure,
|
||||
[ get_answer/2, % +TableID, -Answer
|
||||
add_answer/2, % +TableID, +Answer
|
||||
get_call_variant/2, % +TableID, -CallVariant
|
||||
set_complete_status/1, % +TableID
|
||||
set_active_status/1, % +TableID
|
||||
tbd_table_status/2, % +TableID, -Status
|
||||
table_for_variant/2, % +Variant, -TableID
|
||||
store_dependency/2, % +TableID, +Suspension
|
||||
cleanup_after_complete/1, % +TableID
|
||||
get_newly_created_table_identifiers/2, % NewlyCreatedTableIDs, NumIDs
|
||||
reset_newly_created_table_identifiers/0,
|
||||
answers_for_variant/2, % +Variant, -Answers
|
||||
put_new_table_identifiers/0,
|
||||
get_nb_identifiers/3 % +Table, -NbWorklistID, -NbAnswerTreeID
|
||||
]).
|
||||
|
||||
:- use_module(table_link_manager).
|
||||
:- use_module(trie).
|
||||
|
||||
/* Part of SWI-Prolog
|
||||
|
||||
Author: Benoit Desouter <Benoit.Desouter@UGent.be>
|
||||
Jan Wielemaker (SWI-Prolog port)
|
||||
Copyright (c) 2016, Benoit Desouter
|
||||
All rights reserved.
|
||||
|
||||
Ported to Scryer Prolog by Mark Thom (2019/2020).
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions
|
||||
are met:
|
||||
|
||||
1. Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
|
||||
2. Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions and the following disclaimer in
|
||||
the documentation and/or other materials provided with the
|
||||
distribution.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
|
||||
FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
|
||||
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
|
||||
BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
|
||||
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||||
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
|
||||
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGE.
|
||||
*/
|
||||
|
||||
:- use_module(batched_worklist).
|
||||
|
||||
:- use_module(library(atts)).
|
||||
:- use_module(library(gensym)).
|
||||
:- use_module(library(iso_ext)).
|
||||
|
||||
:- attribute table_status/1, newly_created_table_identifiers/1.
|
||||
|
||||
% This file defines the table datastructure.
|
||||
%
|
||||
% The table datastructure contains the following sub-structures:
|
||||
% - the answer trie
|
||||
% - the worklist
|
||||
%
|
||||
% Structure for tables:
|
||||
% table(CallVariant,Status,AnswerTrie,Worklist) or complete_table(CallVariant,AnswerTrie).
|
||||
% where AnswerTrie contains a trie of unique answers
|
||||
%
|
||||
% Remember that a table may also be nonexistent!
|
||||
% nb_getval(nonexistent,X) then gives [].
|
||||
|
||||
put_new_table_identifiers :-
|
||||
( bb_get(newly_created_table_identifiers_initialized, _) ->
|
||||
true
|
||||
; put_atts(NewlyCreatedFlag, newly_created_table_identifiers([]-0)),
|
||||
bb_b_put(newly_created_table_identifiers, NewlyCreatedFlag),
|
||||
bb_b_put(newly_created_table_identifiers_initialized, [])
|
||||
).
|
||||
|
||||
% Returns a list of newly created table identifiers since the last call to reset_newly_created_table_identifiers/0, as well as the length of the list.
|
||||
get_newly_created_table_identifiers(NewlyCreatedTableIdentifiers,NumIdentifiers) :-
|
||||
bb_get(newly_created_table_identifiers, NewlyCreatedFlag),
|
||||
get_atts(NewlyCreatedFlag, newly_created_table_identifiers(NewlyCreatedTableIdentifiers-NumIdentifiers)).
|
||||
|
||||
reset_newly_created_table_identifiers :-
|
||||
bb_get(newly_created_table_identifiers, NewlyCreatedFlag),
|
||||
put_atts(NewlyCreatedFlag, newly_created_table_identifiers([]-0)).
|
||||
|
||||
add_to_newly_created_table_identifiers(TableIdentifier) :-
|
||||
bb_get(newly_created_table_identifiers, NewlyCreatedFlag),
|
||||
get_atts(NewlyCreatedFlag, newly_created_table_identifiers(L1-Num1)),
|
||||
Num2 is Num1 + 1,
|
||||
put_atts(NewlyCreatedFlag, newly_created_table_identifiers([TableIdentifier|L1]-Num2)).
|
||||
|
||||
% PRIVATE
|
||||
% Mode: + -
|
||||
%
|
||||
% Created in the fresh status.
|
||||
p_create_table(CallVariant,TableIdentifier) :-
|
||||
% We use a copy_term here so that we can be sure not to corrupt our table if CallVariant is "changed" afterwards.
|
||||
copy_term(CallVariant,CallVariant2),
|
||||
% Generate a table identifier, create the table and do bookkeeping.
|
||||
gensym(table,TableIdentifier),
|
||||
% Create a trie and a worklist.
|
||||
trie_new(EmptyTrie),
|
||||
wkl_new_worklist(TableIdentifier,NewWorklist),
|
||||
put_atts(StatusFlag, table_status(fresh)),
|
||||
%% this is important! we don't want to copy the incomplete table every time we refer to it,
|
||||
%% which would occur if we used bb_put here.
|
||||
%% note that the complete_table variant is written to the blackboard using bb_get.
|
||||
atom_concat(TableIdentifier, nb_worklist, NbWorklistID),
|
||||
atom_concat(TableIdentifier, nb_answer_trie, NbAnswerTrieID),
|
||||
bb_put(TableIdentifier, table(CallVariant2,StatusFlag,NbWorklistID,NbAnswerTrieID)),
|
||||
bb_put(NbWorklistID, table_nb_worklist(NewWorklist)),
|
||||
bb_put(NbAnswerTrieID, table_nb_answer_trie(EmptyTrie)),
|
||||
p_link_variant_identifier(CallVariant2,TableIdentifier),
|
||||
add_to_newly_created_table_identifiers(TableIdentifier).
|
||||
|
||||
% Get the Status for table TableIdentifier
|
||||
% Throws exception if this table does not exist.
|
||||
tbd_table_status(TableIdentifier,Status) :-
|
||||
p_get_table_for_identifier(TableIdentifier,Table),
|
||||
tbd_table_status_(Table,Status).
|
||||
|
||||
% Is also used in other predicates than tbd_table_status.
|
||||
tbd_table_status_(table(_CallVariant,StatusFlag,_NbWorklistID, _NbAnswerTrieID),Status) :-
|
||||
get_atts(StatusFlag, table_status(Status)).
|
||||
tbd_table_status_(complete_table(_,_,_),complete).
|
||||
|
||||
% PRIVATE
|
||||
% Table must already exist.
|
||||
p_get_table_for_identifier(TableIdentifier,Table) :-
|
||||
bb_get(TableIdentifier,Table).
|
||||
|
||||
% Get the table identifier (!!) for call variant V, creating a new one if necessary.
|
||||
%
|
||||
% More costly than directly passing the table identifier for already existing tables.
|
||||
%
|
||||
% Since this creates a new table, this predicate is NOT meant for users who should get access to existing tables - f.e. benchmark shortest_path.P
|
||||
%
|
||||
table_for_variant(V,TableIdentifier) :-
|
||||
( p_existing_table(V,TableIdentifier) ->
|
||||
true
|
||||
;
|
||||
p_create_table(V,TableIdentifier)
|
||||
).
|
||||
|
||||
% Get call variant for this table
|
||||
get_call_variant(TableIdentifier,CallVariant) :-
|
||||
p_get_table_for_identifier(TableIdentifier,Table),
|
||||
get_call_variant_(Table,CallVariant).
|
||||
|
||||
get_call_variant_(table(CallVariant,_Status,_NbWorklistID,_NbAnswerTrieID),CallVariant).
|
||||
get_call_variant_(complete_table(CallVariant,_NbWorklistID,_NbAnswerTrieID),CallVariant).
|
||||
|
||||
add_answer(TableIdentifier,A) :-
|
||||
p_get_table_for_identifier(TableIdentifier,Table),
|
||||
% arg(1,Table,CallVariant),
|
||||
arg(3,Table,NbWorklistID),
|
||||
arg(4,Table,NbAnswerTrieID),
|
||||
bb_get(NbWorklistID,table_nb_worklist(Worklist)),
|
||||
bb_get(NbAnswerTrieID,table_nb_answer_trie(AnswerTrie)),
|
||||
copy_term(A,A2),
|
||||
% This predicate succeeds if the answer was new, otherwise it fails.
|
||||
trie_insert(AnswerTrie,A2,A2), % Use answer both as key and as value. Having it as value uses memory, but greatly simplifies getting all the answers.
|
||||
% We got here, so trie_insert added a new answer.
|
||||
% We must also insert this answer in the worklist
|
||||
wkl_add_answer(Worklist,A2),
|
||||
bb_put(NbWorklistID, table_nb_worklist(Worklist)),
|
||||
bb_put(NbAnswerTrieID, table_nb_answer_trie(AnswerTrie)).
|
||||
|
||||
get_answer(TableIdentifier,A) :-
|
||||
p_get_table_for_identifier(TableIdentifier,Table),
|
||||
get_answer_trie_(Table,AnswerTrie),
|
||||
% The trick is that we have stored the answers as values of the trie and that there is a method to get all the values.
|
||||
trie_get_all_values(AnswerTrie,A).
|
||||
|
||||
% get_answer_trie_(TableOrCompleteTable,AnswerTrie).
|
||||
% First argument is not a TableIdentifier.
|
||||
get_answer_trie_(table(_CallVariant,_Status,_NbWorklistID, NbAnswerTrieID),AnswerTrie) :-
|
||||
bb_get(NbAnswerTrieID, table_nb_answer_trie(AnswerTrie)).
|
||||
get_answer_trie_(complete_table(_CallVariant,_NbWorklistID, NbAnswerTrieID),AnswerTrie) :-
|
||||
bb_get(NbAnswerTrieID, table_nb_answer_trie(AnswerTrie)).
|
||||
|
||||
get_nb_identifiers(table(_CallVariant, _Status, NbWorklistID, NbAnswerTrieID), NbWorklistID, NbAnswerTrieID).
|
||||
get_nb_identifiers(complete_table(_CallVariant, NbWorklistID, NbAnswerTrieID), NbWorklistID, NbAnswerTrieID).
|
||||
|
||||
% Get a list of answers for the given call variant.
|
||||
% Used in compare_expected_for_variant/3 in testlib.pl
|
||||
% IMPORTANT: table must be filled already, this is not done in this predicate! Therefore can be called during execution.
|
||||
% V = variant
|
||||
% LA = list of answers.
|
||||
%
|
||||
% More costly operation than directly giving the table identifier.
|
||||
answers_for_variant(V,LA) :-
|
||||
table_for_variant(V,TableIdentifier),
|
||||
p_get_table_for_identifier(TableIdentifier,Table),
|
||||
get_answer_trie_(Table,AnswerTrie),
|
||||
findall(Value,trie_get_all_values(AnswerTrie,Value),LA).
|
||||
|
||||
% Set status of table TableIdentifier to active
|
||||
set_active_status(TableIdentifier) :-
|
||||
tbd_status_transition(TableIdentifier,active,fresh,'set_active_status').
|
||||
|
||||
cleanup_after_complete(TableIdentifier) :-
|
||||
p_get_table_for_identifier(TableIdentifier,Table),
|
||||
cleanup_after_complete_(Table,TableIdentifier).
|
||||
|
||||
% Clause for a (noncomplete) table.
|
||||
cleanup_after_complete_(
|
||||
table(CallVariant,_ActualOldStatus, NbWorklistID, NbAnswerTrieID),
|
||||
TableIdentifier
|
||||
) :-
|
||||
bb_put(TableIdentifier,complete_table(CallVariant, NbWorklistID, NbAnswerTrieID)).
|
||||
% If necessary for debugging add second clause for complete_table.
|
||||
|
||||
% Set status of table TableIdentifier to complete.
|
||||
set_complete_status(TableIdentifier) :-
|
||||
% The transition must be active to complete, otherwise we have an invalid status transition.
|
||||
% Preexisting tables should have been cleaned-up, thus not have the form table/5 anymore, thus complete -> complete is not possible there.
|
||||
p_get_table_for_identifier(TableIdentifier,Table),
|
||||
set_complete_status_(Table,TableIdentifier).
|
||||
|
||||
% set_complete_status_(Table,TableIdentifier).
|
||||
set_complete_status_(table(_CallVariant,_OldStatus,_NbWorklistID, _NbAnswerTrieID),TableIdentifier) :-
|
||||
tbd_status_transition(TableIdentifier,complete,active,'set_complete_status').
|
||||
|
||||
tbd_status_transition_no_check(TableIdentifier,NewStatus) :-
|
||||
p_get_table_for_identifier(TableIdentifier,Table),
|
||||
tbd_status_transition_no_check_(TableIdentifier,Table,NewStatus).
|
||||
|
||||
tbd_status_transition_no_check_(TableIdentifier,Table,NewStatus) :-
|
||||
Table = table(_,StatusFlag,_,_),
|
||||
put_atts(StatusFlag, table_status(NewStatus)),
|
||||
bb_put(TableIdentifier, Table).
|
||||
|
||||
% Set Table's status to NewStatus if current status is RequiredOldStatus, otherwise throw an exception mentioning CallerAsString: attempt to set NewStatus for table TableIdentifier, but current status was ActualOldStatus instead of RequiredOldStatus
|
||||
tbd_status_transition(TableIdentifier,NewStatus,_RequiredOldStatus,_CallerAsString) :-
|
||||
p_get_table_for_identifier(TableIdentifier,Table),
|
||||
tbd_status_transition_no_check_(TableIdentifier,Table,NewStatus).
|
||||
|
||||
store_dependency(TableIdentifier,Suspension) :-
|
||||
p_get_table_for_identifier(TableIdentifier, Table),
|
||||
get_nb_identifiers(Table, NbWorklistID, _NbAnswerTrieID),
|
||||
copy_term(Suspension, SuspensionCopy),
|
||||
bb_get(NbWorklistID, table_nb_worklist(Worklist)),
|
||||
wkl_add_suspension(Worklist, SuspensionCopy),
|
||||
bb_put(NbWorklistID, table_nb_worklist(Worklist)).
|
||||
123
src/prolog/lib/tabling/table_link_manager.pl
Normal file
123
src/prolog/lib/tabling/table_link_manager.pl
Normal file
@@ -0,0 +1,123 @@
|
||||
/* Part of SWI-Prolog
|
||||
|
||||
Author: Benoit Desouter <Benoit.Desouter@UGent.be>
|
||||
Jan Wielemaker (SWI-Prolog port)
|
||||
Copyright (c) 2016, Benoit Desouter
|
||||
All rights reserved.
|
||||
|
||||
Ported to Scryer Prolog by Mark Thom (2019/2020).
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions
|
||||
are met:
|
||||
|
||||
1. Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
|
||||
2. Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions and the following disclaimer in
|
||||
the documentation and/or other materials provided with the
|
||||
distribution.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
|
||||
FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
|
||||
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
|
||||
BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
|
||||
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||||
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
|
||||
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGE.
|
||||
*/
|
||||
|
||||
:- module(table_link_manager,
|
||||
[ get_existing_tables/1, % -Tables
|
||||
p_existing_table/2, % +Variant, -TableID
|
||||
p_link_variant_identifier/2, % +Variant, -TableID
|
||||
num_tables/1, % -Count
|
||||
get_trie_table_link/1, % -Trie
|
||||
put_new_trie_table_link/0
|
||||
]).
|
||||
|
||||
:- use_module(library(atts)).
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(iso_ext)).
|
||||
:- use_module(library(terms)).
|
||||
|
||||
:- use_module(trie).
|
||||
|
||||
:- attribute trie_table_link/1.
|
||||
|
||||
% This file defines a call pattern trie.
|
||||
%
|
||||
% This data structure keeps the relation between a variant and the
|
||||
% corresponding table identifier using a trie. The trick is to make a
|
||||
% canonical representation of a given variant using the numbervars/3
|
||||
% predicate. The trie uses this canonical representation as key, and
|
||||
% the table identifier as value.
|
||||
|
||||
% Uses the (private) global variable trie_table_link
|
||||
|
||||
% This predicate should be called exactly once.
|
||||
% It throws an exception if it is called more than once.
|
||||
|
||||
%% table_link_manager_initialize
|
||||
%
|
||||
% Initializes the global variables `trie_table_link`. Normally
|
||||
% called from table_datastructure_initialize/0.
|
||||
|
||||
put_new_trie_table_link :-
|
||||
( bb_get(trie_table_link_initialized, _) ->
|
||||
true
|
||||
; trie_new(Trie),
|
||||
put_atts(TrieFlag, trie_table_link(Trie)),
|
||||
bb_put(trie_table_link, TrieFlag),
|
||||
bb_put(trie_table_link_initialized, [])
|
||||
).
|
||||
|
||||
get_trie_table_link(Trie) :-
|
||||
bb_get(trie_table_link, TrieFlag),
|
||||
get_atts(TrieFlag, trie_table_link(Trie)).
|
||||
|
||||
% PRIVATE
|
||||
% mode: + -
|
||||
% Variant is not modified
|
||||
variant_canonical_representation(Variant, CanonicalRepresentation) :-
|
||||
copy_term(Variant, CanonicalRepresentation),
|
||||
numbervars(CanonicalRepresentation, 0 ,_).
|
||||
|
||||
% Succeeds if there is a table TableIdentifier in existance for the
|
||||
% given call variant Variant.
|
||||
p_existing_table(Variant, TableIdentifier) :-
|
||||
get_trie_table_link(Trie),
|
||||
variant_canonical_representation(Variant, CanonicalRepresentation),
|
||||
trie_lookup(Trie, CanonicalRepresentation, TableIdentifier).
|
||||
|
||||
% Important remark: we cannot use an out-of-the-box association list,
|
||||
% because we need a lookup based on variant checking, which is not
|
||||
% available for such lists. Converting the association list to a
|
||||
% regular list => why would you use an association list in the first
|
||||
% place...
|
||||
p_link_variant_identifier(Variant, TableIdentifier) :-
|
||||
get_trie_table_link(Trie),
|
||||
variant_canonical_representation(Variant, CanonicalRepresentation),
|
||||
trie_insert_succeed(Trie, CanonicalRepresentation, TableIdentifier),
|
||||
put_atts(TrieFlag, trie_table_link(Trie)),
|
||||
bb_put(trie_table_link, TrieFlag).
|
||||
|
||||
% Returns a list of existing table identifiers.
|
||||
% Rather costly.
|
||||
get_existing_tables(Ts) :-
|
||||
get_trie_table_link(Trie),
|
||||
findall(T, trie_get_all_values(Trie, T), Ts).
|
||||
|
||||
% A very unefficient way of implementing this predicate. But it is
|
||||
% only used for unit testing, so it doesn't really matter. Also, it
|
||||
% doesn't require any additional bookkeeping during the actual
|
||||
% execution.
|
||||
num_tables(N) :-
|
||||
get_existing_tables(Ts),
|
||||
length(Ts, N).
|
||||
225
src/prolog/lib/tabling/trie.pl
Normal file
225
src/prolog/lib/tabling/trie.pl
Normal file
@@ -0,0 +1,225 @@
|
||||
/* Part of SWI-Prolog
|
||||
|
||||
Author: Benoit Desouter <Benoit.Desouter@UGent.be>
|
||||
Jan Wielemaker (SWI-Prolog port)
|
||||
Copyright (c) 2016, Benoit Desouter
|
||||
All rights reserved.
|
||||
|
||||
Ported to Scryer Prolog by Mark Thom (2019/2020).
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions
|
||||
are met:
|
||||
|
||||
1. Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
|
||||
2. Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions and the following disclaimer in
|
||||
the documentation and/or other materials provided with the
|
||||
distribution.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
|
||||
FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
|
||||
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
|
||||
BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
|
||||
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||||
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
|
||||
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGE.
|
||||
*/
|
||||
|
||||
:- module(trie,
|
||||
[ trie_new/1, % -Trie
|
||||
trie_insert/3, % !Trie, +Key, +Value
|
||||
trie_insert_succeed/3,
|
||||
trie_lookup/3, % +Trie, +Key, -Value
|
||||
trie_get_all_values/2 % +Trie, -Value
|
||||
]).
|
||||
|
||||
:- use_module(library(assoc)).
|
||||
:- use_module(library(atts)).
|
||||
:- use_module(library(lists)).
|
||||
|
||||
:- attribute maybe_just/1, children/1.
|
||||
|
||||
% Implementation of a prefix tree, a.k.a. trie %
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
|
||||
% Desired complexity for lookup and insert: linear in the length of the key.
|
||||
|
||||
% ATTENTION: do not use the term functor_data/2; this is used internally here.
|
||||
|
||||
% Inspiration from http://en.wikipedia.org/wiki/Trie
|
||||
|
||||
% Structure of tries:
|
||||
% trie_inner_node(MaybeValue,Children).
|
||||
% where Children is an association list of nonvars to tries.
|
||||
% and where MaybeValue is maybe_none/0 or maybe_just(Value).
|
||||
|
||||
% PRIVATE
|
||||
% For a term of the form p(a,q(b)), "returns" functor_data(p,2) and [a,q(b)].
|
||||
% p_trie_arity_univ(+Term,-FunctorData,-ArgumentsList).
|
||||
p_trie_arity_univ(Term,functor_data(Name,Arity),Arguments) :-
|
||||
( var(Term) ->
|
||||
Name = var,
|
||||
Arity = 0,
|
||||
Arguments = []
|
||||
; Term =.. [Name|Arguments],
|
||||
functor(Term,_,Arity)
|
||||
).
|
||||
|
||||
% Returns a new empty trie.
|
||||
trie_new(Trie) :-
|
||||
empty_assoc(Assoc),
|
||||
put_atts(A, children(Assoc)),
|
||||
Trie = trie_inner_node(_,A).
|
||||
|
||||
% Succeeds if given trie does not contain any key-value pair.
|
||||
% trie_is_empty(+Trie)
|
||||
trie_is_empty(trie_inner_node(X,A)) :-
|
||||
get_atts(X, -maybe_just(_)),
|
||||
get_atts(A, children(Assoc)),
|
||||
empty_assoc(Assoc).
|
||||
|
||||
% For internal use.
|
||||
% For now, Children is an association list that can be manipulated using the assoc_ predicates.
|
||||
trie_get_children(trie_inner_node(_,ChildNode),Children) :-
|
||||
get_atts(ChildNode, children(Children)).
|
||||
|
||||
% For internal use.
|
||||
trie_get_maybe_value(trie_inner_node(MaybeNode,_),MaybeValue) :-
|
||||
get_atts(MaybeNode, maybe_just(MaybeValue)).
|
||||
|
||||
% Destructive update of the association list Children.
|
||||
% For internal use.
|
||||
trie_set_children(trie_inner_node(_,ChildNode),Children) :-
|
||||
put_atts(ChildNode, children(Children)).
|
||||
|
||||
trie_set_maybe_value(trie_inner_node(MaybeNode, _),MaybeValue) :-
|
||||
put_atts(MaybeNode, MaybeValue).
|
||||
|
||||
trie_insert_succeed(Trie,Key,Value) :-
|
||||
( trie_insert(Trie,Key,Value) ->
|
||||
true
|
||||
;
|
||||
true
|
||||
).
|
||||
|
||||
% Succeeds if the term was not present, fails if the term was present.
|
||||
% The term will be present now, whatever the outcome.
|
||||
% We don't use an extra argument to indicate earlier presence, as this increases the trail size.
|
||||
trie_insert(Trie,Key,Value) :-
|
||||
p_trie_arity_univ(Key,FunctorData,KeyList),
|
||||
trie_insert_1(KeyList,FunctorData,Trie,Value).
|
||||
|
||||
trie_insert_1([],FunctorData,Trie,Value) :-
|
||||
trie_get_children(Trie,Assoc),
|
||||
% You need Assoc twice: once to traverse through it, once keeping it as a whole for insertion using put_assoc/4.
|
||||
trie_insert_a(Assoc,Assoc,FunctorData,Trie,Value).
|
||||
|
||||
% Inline the failure and success continuation to avoid a growing trail stack.
|
||||
trie_insert_1([First|Rest],FunctorData,Trie,Value) :-
|
||||
trie_get_children(Trie,Assoc),
|
||||
% You need Assoc twice: once to traverse through it, once keeping it as a whole for insertion using put_assoc/4.
|
||||
trie_insert_1_1(Assoc,Assoc,FunctorData,Trie,First,Rest,Value).
|
||||
|
||||
% Else part, base case: empty assoc list.
|
||||
trie_insert_a(t,Assoc,FunctorData,Trie,Value) :-
|
||||
trie_new(Subtrie),
|
||||
trie_set_maybe_value(Subtrie,maybe_just(Value)),
|
||||
put_assoc(FunctorData,Assoc,Subtrie,NewAssoc),
|
||||
trie_set_children(Trie,NewAssoc).
|
||||
|
||||
% Then part, nonempty assoc tree.
|
||||
trie_insert_a(t(K,V,_,L,R),Assoc,FunctorData,Trie,Value) :-
|
||||
compare(Rel,FunctorData,K),
|
||||
trie_insert_b(Rel,V,L,R,Assoc,FunctorData,Trie,Value).
|
||||
|
||||
% Recursively look in the left part of the assoc tree.
|
||||
trie_insert_b(<,_V,L,_R,Assoc,FunctorData,Trie,Value) :-
|
||||
trie_insert_a(L,Assoc,FunctorData,Trie,Value).
|
||||
|
||||
% Recursively look in the right part of the assoc tree.
|
||||
trie_insert_b(>,_V,_L,R,Assoc,FunctorData,Trie,Value) :-
|
||||
trie_insert_a(R,Assoc,FunctorData,Trie,Value).
|
||||
|
||||
trie_insert_b(=,V,_L,_R,_Assoc,_FunctorData,_Trie,Value) :-
|
||||
trie_get_maybe_value(V,MaybeValue), % V is the Subtrie
|
||||
( MaybeValue == maybe_none ->
|
||||
trie_set_maybe_value(V,maybe_just(Value))
|
||||
% Use true to indicate that the answer was new.
|
||||
;
|
||||
MaybeValue = maybe_just(JustValue),
|
||||
( JustValue == Value ->
|
||||
% Fail to indicate earlier presence
|
||||
fail
|
||||
;
|
||||
throw('trie: attempt to update the value for a key')
|
||||
)
|
||||
).
|
||||
|
||||
% Else part, base case: empty assoc list
|
||||
trie_insert_1_1(t,Assoc,FunctorData,Trie,First,Rest,Value) :-
|
||||
% Assoc = t, % t is the empty assoc tree
|
||||
trie_new(Subtrie),
|
||||
put_assoc(FunctorData,Assoc,Subtrie,NewAssoc),
|
||||
trie_set_children(Trie,NewAssoc),
|
||||
trie_insert_2(First,Rest,Subtrie,Value).
|
||||
|
||||
% Then part, lookup in assoc list.
|
||||
trie_insert_1_1(t(K,V,_,L,R),Assoc,FunctorData,Trie,First,Rest,Value) :-
|
||||
compare(Rel,FunctorData,K),
|
||||
trie_insert_1_1_1(Rel,V,L,R,Assoc,FunctorData,Trie,First,Rest,Value).
|
||||
|
||||
trie_insert_1_1_1(=,V,_L,_R,_Assoc,_FunctorData,_Trie,First,Rest,Value) :-
|
||||
trie_insert_2(First,Rest,V,Value). % V is the Subtrie
|
||||
|
||||
trie_insert_1_1_1(<,_V,L,_R,Assoc,FunctorData,Trie,First,Rest,Value) :-
|
||||
% Look in the left part of the assoc tree.
|
||||
trie_insert_1_1(L,Assoc,FunctorData,Trie,First,Rest,Value).
|
||||
|
||||
trie_insert_1_1_1(>,_V,_L,R,Assoc,FunctorData,Trie,First,Rest,Value) :-
|
||||
% Look in the right part of the assoc tree.
|
||||
trie_insert_1_1(R,Assoc,FunctorData,Trie,First,Rest,Value).
|
||||
|
||||
trie_insert_2(RegularTerm,Rest,Trie,Value) :-
|
||||
p_trie_arity_univ(RegularTerm,FunctorData,KList),
|
||||
append(KList,Rest,KList2),
|
||||
trie_insert_1(KList2,FunctorData,Trie,Value).
|
||||
|
||||
trie_lookup(Trie,Key,Value) :-
|
||||
p_trie_arity_univ(Key,FunctorData,KeyList),
|
||||
trie_lookup_1(FunctorData,KeyList,Trie,Value).
|
||||
|
||||
trie_lookup_1(FunctorData,Rest,Trie,Value) :-
|
||||
% Select right subtree, fail if it isn't there, and do recursive call.
|
||||
trie_get_children(Trie,Assoc),
|
||||
get_assoc(FunctorData,Assoc,Subtrie), % Fails if not present
|
||||
trie_lookup_2(Rest,Subtrie,Value).
|
||||
|
||||
trie_lookup_2([],Trie,Value) :-
|
||||
% If the value at this trie is maybe_just(X), then X is our Value.
|
||||
% Otherwise, there is no value for this key, so we fail...
|
||||
trie_get_maybe_value(Trie,Value).
|
||||
% Regular term at the head, like p or p(a). Not functor_data/2.
|
||||
trie_lookup_2([RegularTerm|Rest],Trie,Value) :-
|
||||
% split RegularTerm
|
||||
p_trie_arity_univ(RegularTerm,FunctorData,KList),
|
||||
% Make a recursive call on KList ++ Rest.
|
||||
% Since we cannot implement p_trie_arity_univ so that "its result", KList, has a free variable at the end, without resorting to techniques that require linear time, we need a call to append/3. However, since KList will in general be rather short, I don't expect this to be a large problem in practice.
|
||||
append(KList,Rest,KList2),
|
||||
trie_lookup_1(FunctorData,KList2,Trie,Value).
|
||||
|
||||
|
||||
% Returns all values in the trie by backtracking - we don't provide any information about the associated key.
|
||||
trie_get_all_values(Trie,Value) :-
|
||||
trie_get_maybe_value(Trie,Value).
|
||||
trie_get_all_values(Trie,Value) :-
|
||||
trie_get_children(Trie,Children),
|
||||
gen_assoc(_Key, Children, ChildTrie),
|
||||
trie_get_all_values(ChildTrie,Value).
|
||||
118
src/prolog/lib/tabling/wrapper.pl
Normal file
118
src/prolog/lib/tabling/wrapper.pl
Normal file
@@ -0,0 +1,118 @@
|
||||
/* Part of SWI-Prolog
|
||||
|
||||
Author: Jan Wielemaker
|
||||
Copyright (c) 2016, VU University Amsterdam
|
||||
All rights reserved.
|
||||
|
||||
Ported to Scryer Prolog by Mark Thom (2019/2020).
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions
|
||||
are met:
|
||||
|
||||
1. Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
|
||||
2. Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions and the following disclaimer in
|
||||
the documentation and/or other materials provided with the
|
||||
distribution.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
|
||||
FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
|
||||
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
|
||||
BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
|
||||
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||||
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
|
||||
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGE.
|
||||
*/
|
||||
|
||||
:- module(table_wrapper,
|
||||
[ %(table)/1, % +Predicates
|
||||
op(1150, fx, table)
|
||||
]).
|
||||
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(error)).
|
||||
|
||||
%%:- multifile
|
||||
%% system:term_expansion/2,
|
||||
%% tabled/2.
|
||||
%%:- dynamic
|
||||
%% system:term_expansion/2.
|
||||
|
||||
%% table(+PredicateIndicators)
|
||||
%
|
||||
% Prepare the given PredicateIndicators for tabling. Can only
|
||||
% be used as a directive.
|
||||
|
||||
%% table(PIList) :-
|
||||
%% throw(error(context_error(nodirective, table(PIList)), _)).
|
||||
|
||||
instantiation_error(Var) :-
|
||||
throw(error(instantiation_error(Var), _)).
|
||||
|
||||
wrappers(Var) -->
|
||||
{ var(Var), !,
|
||||
instantiation_error(Var)
|
||||
}.
|
||||
wrappers((A,B)) --> !,
|
||||
wrappers(A),
|
||||
wrappers(B).
|
||||
wrappers(Name//Arity) -->
|
||||
{ atom(Name), integer(Arity), Arity >= 0, !,
|
||||
Arity1 is Arity+2
|
||||
},
|
||||
wrappers(Name/Arity1).
|
||||
wrappers(Name/Arity) -->
|
||||
{ atom(Name), integer(Arity), Arity >= 0, !,
|
||||
functor(Head, Name, Arity),
|
||||
atom_concat(Name, ' tabled', WrapName),
|
||||
Head =.. [Name|Args],
|
||||
WrappedHead =.. [WrapName|Args],
|
||||
'$module_of'(Module, Name) %prolog_load_context(module, Module)
|
||||
},
|
||||
[ ( Head :-
|
||||
start_tabling(Module:Head, WrappedHead)
|
||||
),
|
||||
(:- multifile(table_wrapper:tabled/2)),
|
||||
table_wrapper:tabled(Head, Module)
|
||||
].
|
||||
|
||||
rename(M:Term0, M:Term, _) :-
|
||||
atom(M), !,
|
||||
rename(Term0, Term, M).
|
||||
rename((Head :- Body), (NewHead :- Body), Module) :- !,
|
||||
rename(Head, NewHead, Module).
|
||||
rename((Head --> Body), (NewHead --> Body), Module) :- !,
|
||||
functor(Head, Name, Arity),
|
||||
PlainArity is Arity+1,
|
||||
functor(PlainHead, Name, PlainArity),
|
||||
table_wrapper:tabled(PlainHead, Module),
|
||||
rename_term(Head, NewHead).
|
||||
rename(Head, NewHead, Module) :-
|
||||
table_wrapper:tabled(Head, Module), !,
|
||||
rename_term(Head, NewHead).
|
||||
|
||||
rename_term(Compound0, Compound) :-
|
||||
compound(Compound0), !,
|
||||
Compound0 =.. [Name|Args],
|
||||
atom_concat(Name, ' tabled', WrapName),
|
||||
Compound =.. [WrapName|Args].
|
||||
rename_term(Name, WrapName) :-
|
||||
atom_concat(Name, ' tabled', WrapName).
|
||||
|
||||
|
||||
user:term_expansion(Term0, Clauses) :-
|
||||
nonvar(Term0),
|
||||
Term0 = (:- table Preds),
|
||||
phrase(wrappers(Preds), Clauses).
|
||||
user:term_expansion(Clause, NewClause) :-
|
||||
nonvar(Clause),
|
||||
'$module_of'(Module, Clause),
|
||||
rename(Clause, NewClause, Module).
|
||||
72
src/prolog/lib/time.pl
Normal file
72
src/prolog/lib/time.pl
Normal file
@@ -0,0 +1,72 @@
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Written April 2020 by Markus Triska (triska@metalevel.at)
|
||||
Part of Scryer Prolog.
|
||||
|
||||
This library provides predicates for reasoning about time.
|
||||
Reasoning about time stamps would be a useful addition, for example
|
||||
by obtaining the current time, comparing and formatting it.
|
||||
|
||||
'$cpu_now' can be replaced by statistics/2 once that is implemented.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
:- module(time, [max_sleep_time/1, sleep/1, time/1]).
|
||||
|
||||
:- use_module(library(format)).
|
||||
:- use_module(library(iso_ext)).
|
||||
:- use_module(library(error)).
|
||||
|
||||
max_sleep_time(0xfffffffffffffbff).
|
||||
|
||||
sleep(T) :-
|
||||
builtins:must_be_number(T, sleep),
|
||||
( T < 0 ->
|
||||
domain_error(not_less_than_zero, T, sleep/1)
|
||||
; max_sleep_time(N), T > N ->
|
||||
throw(error(representation_error(max_sleep_time), sleep/1))
|
||||
; '$sleep'(T)
|
||||
).
|
||||
|
||||
time(Goal) :-
|
||||
'$cpu_now'(T0),
|
||||
setup_call_cleanup(true,
|
||||
( Goal,
|
||||
report_time(T0)
|
||||
),
|
||||
report_time(T0)).
|
||||
|
||||
report_time(T0) :-
|
||||
'$cpu_now'(T),
|
||||
Time is T - T0,
|
||||
( bb_get('$first_answer', true) ->
|
||||
format(" % CPU time: ~3f seconds~n", [Time])
|
||||
; format("% CPU time: ~3f seconds~n ", [Time])
|
||||
).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
?- time((true;false)).
|
||||
% CPU time: 0.000 seconds
|
||||
true
|
||||
; % CPU time: 0.001 seconds
|
||||
false.
|
||||
|
||||
:- time(use_module(library(clpz))).
|
||||
% CPU time: 2.762 seconds
|
||||
true
|
||||
; false.
|
||||
|
||||
:- time(use_module(library(lists))).
|
||||
% CPU time: 0.000 seconds
|
||||
true
|
||||
; % CPU time: 0.001 seconds
|
||||
false.
|
||||
|
||||
?- time(member(X, [a,b,c])).
|
||||
% CPU time: 0.000 seconds
|
||||
X = a
|
||||
; % CPU time: 0.002 seconds
|
||||
X = b
|
||||
; % CPU time: 0.004 seconds
|
||||
X = c
|
||||
; % CPU time: 0.007 seconds
|
||||
false.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
@@ -1,102 +0,0 @@
|
||||
use crate::prolog::machine::machine_indices::*;
|
||||
|
||||
use std::mem;
|
||||
use std::ops::{Index, IndexMut};
|
||||
use std::vec::Vec;
|
||||
|
||||
#[derive(Clone)]
|
||||
pub struct Frame {
|
||||
pub global_index: usize,
|
||||
pub e: usize,
|
||||
pub cp: LocalCodePtr,
|
||||
pub interrupt_cp: LocalCodePtr,
|
||||
perms: Vec<Addr>,
|
||||
}
|
||||
|
||||
impl Frame {
|
||||
fn new(global_index: usize, fr: usize, e: usize, cp: LocalCodePtr, n: usize) -> Self {
|
||||
Frame {
|
||||
global_index,
|
||||
e: e,
|
||||
cp: cp,
|
||||
interrupt_cp: LocalCodePtr::default(),
|
||||
perms: (1..n + 1).map(|i| Addr::StackCell(fr, i)).collect(),
|
||||
}
|
||||
}
|
||||
|
||||
#[inline]
|
||||
pub fn len(&self) -> usize {
|
||||
self.perms.len()
|
||||
}
|
||||
}
|
||||
|
||||
pub struct AndStack(Vec<Frame>);
|
||||
|
||||
impl AndStack {
|
||||
pub fn new() -> Self {
|
||||
AndStack(Vec::new())
|
||||
}
|
||||
|
||||
#[inline]
|
||||
pub(crate) fn take(&mut self) -> Self {
|
||||
AndStack(mem::replace(&mut self.0, vec![]))
|
||||
}
|
||||
|
||||
pub fn push(&mut self, global_index: usize, e: usize, cp: LocalCodePtr, n: usize) {
|
||||
let len = self.0.len();
|
||||
self.0.push(Frame::new(global_index, len, e, cp, n));
|
||||
}
|
||||
|
||||
pub fn len(&self) -> usize {
|
||||
self.0.len()
|
||||
}
|
||||
|
||||
pub fn clear(&mut self) {
|
||||
self.0.clear()
|
||||
}
|
||||
|
||||
pub fn resize(&mut self, fr: usize, n: usize) {
|
||||
let len = self[fr].perms.len();
|
||||
|
||||
if len < n {
|
||||
self[fr].perms.reserve(n - len);
|
||||
|
||||
for i in len..n {
|
||||
self[fr].perms.push(Addr::StackCell(fr, i));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[inline]
|
||||
pub fn truncate(&mut self, len: usize) {
|
||||
self.0.truncate(len);
|
||||
}
|
||||
}
|
||||
|
||||
impl Index<usize> for AndStack {
|
||||
type Output = Frame;
|
||||
|
||||
fn index(&self, index: usize) -> &Self::Output {
|
||||
self.0.index(index)
|
||||
}
|
||||
}
|
||||
|
||||
impl IndexMut<usize> for AndStack {
|
||||
fn index_mut(&mut self, index: usize) -> &mut Self::Output {
|
||||
self.0.index_mut(index)
|
||||
}
|
||||
}
|
||||
|
||||
impl Index<usize> for Frame {
|
||||
type Output = Addr;
|
||||
|
||||
fn index(&self, index: usize) -> &Self::Output {
|
||||
self.perms.index(index - 1)
|
||||
}
|
||||
}
|
||||
|
||||
impl IndexMut<usize> for Frame {
|
||||
fn index_mut(&mut self, index: usize) -> &mut Self::Output {
|
||||
self.perms.index_mut(index - 1)
|
||||
}
|
||||
}
|
||||
1188
src/prolog/machine/arithmetic_ops.rs
Normal file
1188
src/prolog/machine/arithmetic_ops.rs
Normal file
File diff suppressed because it is too large
Load Diff
@@ -1,6 +1,7 @@
|
||||
:- module('$atts', []).
|
||||
|
||||
driver(Vars, Values) :-
|
||||
iterate(Vars, Values, ListOfListsOfGoalLists),
|
||||
'$redo_attr_var_bindings', % the bindings list is emptied here.
|
||||
!,
|
||||
call_goals(ListOfListsOfGoalLists),
|
||||
'$return_from_verify_attr'.
|
||||
@@ -8,6 +9,7 @@ driver(Vars, Values) :-
|
||||
iterate([Var|VarBindings], [Value|ValueBindings], [ListOfGoalLists | ListsCubed]) :-
|
||||
'$get_attr_list'(Var, Ls),
|
||||
call_verify_attributes(Ls, Var, Value, ListOfGoalLists),
|
||||
'$redo_attr_var_binding'(Var, Value),
|
||||
iterate(VarBindings, ValueBindings, ListsCubed).
|
||||
iterate([], [], []).
|
||||
|
||||
@@ -16,6 +18,14 @@ gather_modules([Attr|Attrs], [Module|Modules]) :-
|
||||
'$module_of'(Module, Attr), % write the owning module of Attr to Module.
|
||||
gather_modules(Attrs, Modules).
|
||||
|
||||
call_verify_attributes(Attrs, _, _, []) :-
|
||||
var(Attrs), !.
|
||||
call_verify_attributes([], _, _, []).
|
||||
call_verify_attributes([Attr|Attrs], Var, Value, ListOfGoalLists) :-
|
||||
gather_modules([Attr|Attrs], Modules0),
|
||||
sort(Modules0, Modules),
|
||||
verify_attrs(Modules, Var, Value, ListOfGoalLists).
|
||||
|
||||
verify_attrs([Module|Modules], Var, Value, [Goals|ListOfGoalLists]) :-
|
||||
catch(Module:verify_attributes(Var, Value, Goals),
|
||||
error(evaluation_error((Module:verify_attributes)/3), verify_attributes/3),
|
||||
@@ -23,13 +33,6 @@ verify_attrs([Module|Modules], Var, Value, [Goals|ListOfGoalLists]) :-
|
||||
verify_attrs(Modules, Var, Value, ListOfGoalLists).
|
||||
verify_attrs([], _, _, []).
|
||||
|
||||
call_verify_attributes(Attrs, _, _, []) :-
|
||||
var(Attrs), !.
|
||||
call_verify_attributes([Attr|Attrs], Var, Value, ListOfGoalLists) :-
|
||||
gather_modules([Attr|Attrs], Modules0),
|
||||
sort(Modules0, Modules),
|
||||
verify_attrs(Modules, Var, Value, ListOfGoalLists).
|
||||
|
||||
call_goals([ListOfGoalLists | ListsCubed]) :-
|
||||
call_goals_0(ListOfGoalLists),
|
||||
call_goals(ListsCubed).
|
||||
|
||||
@@ -1,7 +1,9 @@
|
||||
use crate::prolog::heap_iter::*;
|
||||
use crate::prolog::machine::*;
|
||||
|
||||
use indexmap::IndexSet;
|
||||
use crate::indexmap::IndexSet;
|
||||
|
||||
use std::cmp::Ordering;
|
||||
use std::vec::IntoIter;
|
||||
|
||||
pub static VERIFY_ATTRS: &str = include_str!("attributed_variables.pl");
|
||||
@@ -9,21 +11,25 @@ pub static PROJECT_ATTRS: &str = include_str!("project_attributes.pl");
|
||||
|
||||
pub(super) type Bindings = Vec<(usize, Addr)>;
|
||||
|
||||
#[derive(Debug)]
|
||||
pub(super) struct AttrVarInitializer {
|
||||
pub(super) attribute_goals: Vec<Addr>,
|
||||
pub(super) attr_var_queue: Vec<usize>,
|
||||
pub(super) bindings: Bindings,
|
||||
pub(super) cp: LocalCodePtr,
|
||||
pub(super) instigating_p: LocalCodePtr,
|
||||
pub(super) verify_attrs_loc: usize,
|
||||
pub(super) project_attrs_loc: usize,
|
||||
}
|
||||
|
||||
impl AttrVarInitializer {
|
||||
pub(super) fn new(verify_attrs_loc: usize, project_attrs_loc: usize) -> Self {
|
||||
pub(super)
|
||||
fn new(verify_attrs_loc: usize, project_attrs_loc: usize) -> Self {
|
||||
AttrVarInitializer {
|
||||
attribute_goals: vec![],
|
||||
attr_var_queue: vec![],
|
||||
bindings: vec![],
|
||||
instigating_p: LocalCodePtr::default(),
|
||||
cp: LocalCodePtr::default(),
|
||||
verify_attrs_loc,
|
||||
project_attrs_loc,
|
||||
@@ -31,22 +37,33 @@ impl AttrVarInitializer {
|
||||
}
|
||||
|
||||
#[inline]
|
||||
pub(super) fn reset(&mut self) {
|
||||
pub(super)
|
||||
fn reset(&mut self) {
|
||||
self.attribute_goals.clear();
|
||||
self.attr_var_queue.clear();
|
||||
self.bindings.clear();
|
||||
self.attribute_goals.clear();
|
||||
}
|
||||
|
||||
#[inline]
|
||||
pub(super)
|
||||
fn backtrack(&mut self, queue_b: usize, bindings_b: usize) {
|
||||
self.attr_var_queue.truncate(queue_b);
|
||||
self.bindings.truncate(bindings_b);
|
||||
}
|
||||
}
|
||||
|
||||
impl MachineState {
|
||||
pub(super) fn push_attr_var_binding(&mut self, h: usize, addr: Addr) {
|
||||
pub(super)
|
||||
fn push_attr_var_binding(&mut self, h: usize, addr: Addr) {
|
||||
if self.attr_var_init.bindings.is_empty() {
|
||||
self.attr_var_init.instigating_p = self.p.local();
|
||||
|
||||
if self.last_call {
|
||||
self.attr_var_init.cp = self.cp;
|
||||
} else {
|
||||
self.attr_var_init.cp = self.p.local();
|
||||
self.attr_var_init.cp = self.p.local() + 1;
|
||||
}
|
||||
|
||||
|
||||
self.p = CodePtr::VerifyAttrInterrupt(self.attr_var_init.verify_attrs_loc);
|
||||
}
|
||||
|
||||
@@ -58,16 +75,17 @@ impl MachineState {
|
||||
.attr_var_init
|
||||
.bindings
|
||||
.iter()
|
||||
.map(|(ref h, _)| Addr::AttrVar(*h));
|
||||
.map(|(ref h, _)| HeapCellValue::Addr(Addr::AttrVar(*h)));
|
||||
|
||||
let var_list_addr = Addr::HeapCell(self.heap.to_list(iter));
|
||||
|
||||
let iter = self
|
||||
.attr_var_init
|
||||
.bindings
|
||||
.iter()
|
||||
.map(|(_, ref addr)| addr.clone());
|
||||
let value_list_addr = Addr::HeapCell(self.heap.to_list(iter));
|
||||
.drain(0 ..)
|
||||
.map(|(_, addr)| HeapCellValue::Addr(addr));
|
||||
|
||||
let value_list_addr = Addr::HeapCell(self.heap.to_list(iter));
|
||||
(var_list_addr, value_list_addr)
|
||||
}
|
||||
|
||||
@@ -82,7 +100,8 @@ impl MachineState {
|
||||
self[temp_v!(2)] = value_list_addr;
|
||||
}
|
||||
|
||||
pub(super) fn gather_attr_vars_created_since(&self, b: usize) -> IntoIter<Addr> {
|
||||
pub(super)
|
||||
fn gather_attr_vars_created_since(&self, b: usize) -> IntoIter<Addr> {
|
||||
let mut attr_vars: Vec<_> = self.attr_var_init.attr_var_queue[b..]
|
||||
.iter()
|
||||
.filter_map(|h| match self.store(self.deref(Addr::HeapCell(*h))) {
|
||||
@@ -91,60 +110,29 @@ impl MachineState {
|
||||
})
|
||||
.collect();
|
||||
|
||||
attr_vars.sort_unstable_by(|a1, a2| self.compare_term_test(a1, a2));
|
||||
attr_vars.sort_unstable_by(|a1, a2| {
|
||||
self.compare_term_test(a1, a2).unwrap_or(Ordering::Less)
|
||||
});
|
||||
|
||||
self.term_dedup(&mut attr_vars);
|
||||
attr_vars.into_iter()
|
||||
}
|
||||
|
||||
fn populate_project_attr_lists(&mut self) -> (Addr, Addr) {
|
||||
let mut query_vars = IndexSet::new();
|
||||
let attr_vars = self.gather_attr_vars_created_since(0);
|
||||
|
||||
for (_, addr) in self.heap_locs.iter() {
|
||||
let iter = self.acyclic_pre_order_iter(addr.clone());
|
||||
|
||||
for value in iter {
|
||||
match value {
|
||||
HeapCellValue::Addr(Addr::HeapCell(h)) => {
|
||||
query_vars.insert(Addr::HeapCell(h));
|
||||
}
|
||||
HeapCellValue::Addr(Addr::StackCell(fr, sc)) => {
|
||||
query_vars.insert(Addr::StackCell(fr, sc));
|
||||
}
|
||||
HeapCellValue::Addr(Addr::AttrVar(h)) => {
|
||||
query_vars.insert(Addr::AttrVar(h));
|
||||
}
|
||||
_ => {}
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
let query_var_list = Addr::HeapCell(self.heap.to_list(query_vars.into_iter()));
|
||||
let attr_var_list = Addr::HeapCell(self.heap.to_list(attr_vars));
|
||||
|
||||
(query_var_list, attr_var_list)
|
||||
}
|
||||
|
||||
pub(super) fn verify_attr_interrupt(&mut self, p: usize) {
|
||||
let rs = MAX_ARITY;
|
||||
|
||||
// store temp vars in perm vars slots along with self.b0 and
|
||||
// self.num_of_args. why self.b0? if we return to a NeckCut
|
||||
// after finishing the interrupt, it won't work correctly if
|
||||
// self.b == self.b0. we must change it back when we return,
|
||||
// as if nothing happened.
|
||||
self.allocate(rs + 2);
|
||||
pub(super)
|
||||
fn verify_attr_interrupt(&mut self, p: usize) {
|
||||
self.allocate(self.num_of_args + 2);
|
||||
|
||||
let e = self.e;
|
||||
self.and_stack[e].interrupt_cp = self.attr_var_init.cp;
|
||||
self.stack.index_and_frame_mut(e).prelude.interrupt_cp = self.attr_var_init.cp;
|
||||
|
||||
for i in 1..rs + 1 {
|
||||
self.and_stack[e][i] = self[RegType::Temp(i)].clone();
|
||||
for i in 1 .. self.num_of_args + 1 {
|
||||
self.stack.index_and_frame_mut(e)[i] = self[RegType::Temp(i)].clone();
|
||||
}
|
||||
|
||||
self.and_stack[e][rs + 1] = Addr::Con(Constant::Usize(self.b0));
|
||||
self.and_stack[e][rs + 2] = Addr::Con(Constant::Usize(self.num_of_args));
|
||||
self.stack.index_and_frame_mut(e)[self.num_of_args + 1] =
|
||||
Addr::CutPoint(self.b0);
|
||||
self.stack.index_and_frame_mut(e)[self.num_of_args + 2] =
|
||||
Addr::Usize(self.num_of_args);
|
||||
|
||||
self.verify_attributes();
|
||||
|
||||
@@ -153,56 +141,36 @@ impl MachineState {
|
||||
self.p = CodePtr::Local(LocalCodePtr::DirEntry(p));
|
||||
}
|
||||
|
||||
fn print_attribute_goals_string(&mut self, op_dir: &OpDir) -> String {
|
||||
let mut attr_goals = mem::replace(&mut self.attr_var_init.attribute_goals, vec![]);
|
||||
pub(super)
|
||||
fn attr_vars_of_term(&self, addr: Addr) -> Vec<Addr> {
|
||||
let mut seen_set = IndexSet::new();
|
||||
let mut seen_vars = vec![];
|
||||
|
||||
if attr_goals.is_empty() {
|
||||
return String::from("");
|
||||
let mut iter = self.acyclic_pre_order_iter(addr);
|
||||
|
||||
while let Some(addr) = iter.next() {
|
||||
if let HeapCellValue::Addr(Addr::AttrVar(h)) = self.heap.index_addr(&addr).as_ref() {
|
||||
if seen_set.contains(h) {
|
||||
continue;
|
||||
}
|
||||
|
||||
seen_vars.push(addr);
|
||||
seen_set.insert(*h);
|
||||
|
||||
let mut l = h + 1;
|
||||
let mut list_elements = vec![];
|
||||
|
||||
while let Addr::Lis(elem) = self.store(self.deref(Addr::HeapCell(l))) {
|
||||
list_elements.push(self.heap[elem].as_addr(elem));
|
||||
l = elem + 1;
|
||||
}
|
||||
|
||||
for element in list_elements.into_iter().rev() {
|
||||
iter.stack().push(element);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
attr_goals.sort_unstable_by(|a1, a2| self.compare_term_test(a1, a2));
|
||||
self.term_dedup(&mut attr_goals);
|
||||
|
||||
let mut output = PrinterOutputter::new();
|
||||
|
||||
for goal_addr in attr_goals {
|
||||
let mut printer = HCPrinter::from_heap_locs(&self, op_dir, output);
|
||||
printer.see_all_locs();
|
||||
|
||||
printer.numbervars = false;
|
||||
printer.quoted = true;
|
||||
|
||||
output = printer.print(goal_addr);
|
||||
output.append(", ");
|
||||
}
|
||||
|
||||
// cut trailing ", "
|
||||
let output_len = output.len();
|
||||
output.truncate(output_len - 2);
|
||||
|
||||
output.result()
|
||||
}
|
||||
}
|
||||
|
||||
impl Machine {
|
||||
pub fn attribute_goals(&mut self) -> String {
|
||||
let p = self.machine_st.attr_var_init.project_attrs_loc;
|
||||
let (query_vars, attr_vars) = self.machine_st.populate_project_attr_lists();
|
||||
|
||||
self.machine_st.allocate(0);
|
||||
|
||||
self.machine_st[temp_v!(1)] = query_vars;
|
||||
self.machine_st[temp_v!(2)] = attr_vars;
|
||||
|
||||
self.machine_st.p = CodePtr::Local(LocalCodePtr::DirEntry(p));
|
||||
self.machine_st.query_stepper(
|
||||
&mut self.indices,
|
||||
&mut self.policies,
|
||||
&mut self.code_repo,
|
||||
&mut readline::input_stream(),
|
||||
);
|
||||
|
||||
self.machine_st
|
||||
.print_attribute_goals_string(&self.indices.op_dir)
|
||||
seen_vars
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1,5 +1,3 @@
|
||||
use prolog_parser::ast::MachineFlags;
|
||||
|
||||
use crate::prolog::clause_types::*;
|
||||
use crate::prolog::codegen::*;
|
||||
use crate::prolog::debray_allocator::*;
|
||||
@@ -9,8 +7,12 @@ use crate::prolog::machine::compile::*;
|
||||
use crate::prolog::machine::machine_errors::*;
|
||||
use crate::prolog::machine::machine_indices::*;
|
||||
|
||||
use std::collections::VecDeque;
|
||||
use indexmap::IndexSet;
|
||||
|
||||
use std::collections::VecDeque;
|
||||
use std::mem;
|
||||
|
||||
#[derive(Debug)]
|
||||
pub struct CodeRepo {
|
||||
pub(super) cached_query: Code,
|
||||
pub(super) goal_expanders: Code,
|
||||
@@ -51,19 +53,32 @@ impl CodeRepo {
|
||||
self.term_dir
|
||||
.get_mut(&key)
|
||||
.map(|entry| {
|
||||
(
|
||||
Predicate((entry.0).0.drain(len..).collect()),
|
||||
entry.1.drain(queue_len..).collect(),
|
||||
)
|
||||
let terms =
|
||||
if len < (entry.0).0.len() {
|
||||
(entry.0).0.drain(len ..).collect()
|
||||
} else {
|
||||
vec![]
|
||||
};
|
||||
|
||||
let queue =
|
||||
if queue_len < entry.1.len() {
|
||||
entry.1.drain(queue_len ..).collect()
|
||||
} else {
|
||||
VecDeque::new()
|
||||
};
|
||||
|
||||
(Predicate(terms), queue)
|
||||
})
|
||||
.unwrap_or((Predicate::new(), VecDeque::from(vec![])))
|
||||
.unwrap_or((Predicate::new(), VecDeque::new()))
|
||||
}
|
||||
|
||||
pub fn add_in_situ_result(
|
||||
pub(crate)
|
||||
fn add_in_situ_result(
|
||||
&mut self,
|
||||
result: &CompiledResult,
|
||||
in_situ_code_dir: &mut InSituCodeDir,
|
||||
flags: MachineFlags,
|
||||
in_situ_module_dir: &mut ModuleStubDir,
|
||||
non_counted_bt_preds: &IndexSet<PredicateKey>,
|
||||
) -> Result<(), SessionError> {
|
||||
let (ref decl, ref queue) = result;
|
||||
let (name, arity) = decl
|
||||
@@ -75,25 +90,42 @@ impl CodeRepo {
|
||||
})
|
||||
.ok_or(SessionError::NamelessEntry)?;
|
||||
|
||||
let non_counted_bt = non_counted_bt_preds.contains(&(name.clone(), arity));
|
||||
let module_name = name.owning_module();
|
||||
|
||||
let p = self.in_situ_code.len();
|
||||
in_situ_code_dir.insert((name, arity), p);
|
||||
|
||||
let mut cg = CodeGenerator::<DebrayAllocator>::new(true, flags);
|
||||
// clone the decl to avoid the need to wipe its register cells later.
|
||||
let mut decl_code = cg.compile_predicate(&decl.0.clone())?;
|
||||
match in_situ_module_dir.get_mut(&module_name) {
|
||||
Some(ref mut module_stub) if name.has_table(&module_stub.atom_tbl) => {
|
||||
module_stub.in_situ_code_dir.insert((name, arity), p);
|
||||
}
|
||||
_ => {
|
||||
in_situ_code_dir.insert((name, arity), p);
|
||||
}
|
||||
}
|
||||
|
||||
compile_appendix(&mut decl_code, queue, true, flags)?;
|
||||
let mut cg = CodeGenerator::<DebrayAllocator>::new(non_counted_bt);
|
||||
let mut decl_code = cg.compile_predicate(&decl.0)?;
|
||||
|
||||
self.in_situ_code.extend(decl_code.into_iter());
|
||||
Ok(())
|
||||
compile_appendix(&mut decl_code, queue, non_counted_bt)?;
|
||||
|
||||
Ok(self.in_situ_code.extend(decl_code.into_iter()))
|
||||
}
|
||||
|
||||
#[inline]
|
||||
pub(super) fn size_of_cached_query(&self) -> usize {
|
||||
pub(super)
|
||||
fn size_of_cached_query(&self) -> usize {
|
||||
self.cached_query.len()
|
||||
}
|
||||
|
||||
pub(super) fn lookup_instr<'a>(
|
||||
#[inline]
|
||||
pub(super)
|
||||
fn take_in_situ_code(&mut self) -> Code {
|
||||
mem::replace(&mut self.in_situ_code, Code::new())
|
||||
}
|
||||
|
||||
pub(super)
|
||||
fn lookup_instr<'a>(
|
||||
&'a self,
|
||||
last_call: bool,
|
||||
p: &CodePtr,
|
||||
@@ -134,7 +166,7 @@ impl CodeRepo {
|
||||
);
|
||||
Some(RefOrOwned::Owned(call_clause))
|
||||
}
|
||||
&CodePtr::CallN(arity, _) => {
|
||||
&CodePtr::CallN(arity, _, last_call) => {
|
||||
let call_clause = call_clause!(ClauseType::CallN, arity, 0, last_call);
|
||||
Some(RefOrOwned::Owned(call_clause))
|
||||
}
|
||||
|
||||
81
src/prolog/machine/code_walker.rs
Normal file
81
src/prolog/machine/code_walker.rs
Normal file
@@ -0,0 +1,81 @@
|
||||
use crate::prolog::instructions::*;
|
||||
|
||||
use std::collections::VecDeque;
|
||||
|
||||
fn scan_for_trust_me(code: &Code, jmp_offsets: &mut VecDeque<usize>, after_idx: &mut usize) {
|
||||
for (idx, instr) in code[*after_idx..].iter().enumerate() {
|
||||
match instr {
|
||||
&Line::Choice(ChoiceInstruction::TrustMe)
|
||||
| &Line::IndexedChoice(IndexedChoiceInstruction::Trust(..)) => {
|
||||
*after_idx += idx;
|
||||
return;
|
||||
}
|
||||
&Line::Control(ControlInstruction::JmpBy(_, offset, ..)) => {
|
||||
jmp_offsets.push_back(*after_idx + idx + offset)
|
||||
}
|
||||
_ => {}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn capture_next_range(code: &Code, queue: &mut VecDeque<usize>, last_idx: &mut usize) {
|
||||
loop {
|
||||
match &code[*last_idx] {
|
||||
&Line::Choice(ChoiceInstruction::TryMeElse(..))
|
||||
| &Line::IndexedChoice(IndexedChoiceInstruction::Try(..)) => {
|
||||
*last_idx += 1;
|
||||
scan_for_trust_me(code, queue, last_idx);
|
||||
}
|
||||
&Line::Control(ControlInstruction::JmpBy(_, offset, _, false)) => {
|
||||
queue.push_back(*last_idx + offset);
|
||||
*last_idx += 1;
|
||||
}
|
||||
&Line::Control(ControlInstruction::JmpBy(_, offset, _, true)) => {
|
||||
queue.push_back(*last_idx + offset);
|
||||
break;
|
||||
}
|
||||
&Line::Control(ControlInstruction::Proceed)
|
||||
| &Line::Control(ControlInstruction::CallClause(_, _, _, true, _)) =>
|
||||
break,
|
||||
_ =>
|
||||
*last_idx += 1,
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
/* This function walks the code of a single predicate, supposed to
|
||||
* begin in code at the offset p. Each instruction is passed to the
|
||||
* walker function.
|
||||
*/
|
||||
pub fn walk_code(code: &Code, p: usize, mut walker: impl FnMut(&Line))
|
||||
{
|
||||
let mut queue = VecDeque::from(vec![p]);
|
||||
|
||||
while let Some(first_idx) = queue.pop_front() {
|
||||
let mut last_idx = first_idx;
|
||||
|
||||
capture_next_range(code, &mut queue, &mut last_idx);
|
||||
|
||||
for instr in &code[first_idx .. last_idx + 1] {
|
||||
walker(instr);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* A function for code walking that might result in modification to
|
||||
* the code. Otherwise identical to walk_code.
|
||||
*/
|
||||
pub fn walk_code_mut(code: &mut Code, p: usize, mut walker: impl FnMut(&mut Line))
|
||||
{
|
||||
let mut queue = VecDeque::from(vec![p]);
|
||||
|
||||
while let Some(first_idx) = queue.pop_front() {
|
||||
let mut last_idx = first_idx;
|
||||
|
||||
capture_next_range(code, &mut queue, &mut last_idx);
|
||||
|
||||
for instr in &mut code[first_idx .. last_idx + 1] {
|
||||
walker(instr);
|
||||
}
|
||||
}
|
||||
}
|
||||
File diff suppressed because it is too large
Load Diff
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user