618 Commits

Author SHA1 Message Date
Mark Thom
888d844ec5 address arity discrepancies in builtins.n and call/N (#525) 2020-05-22 23:57:32 -06:00
Mark Thom
3a7eb9fc0c Merge pull request #560 from notoria/cargo
Added some informations in Cargo.toml
2020-05-22 23:43:06 -03:00
Mark Thom
46276aacd9 Merge pull request #557 from mthom/docker
Merge Master with Docker branch
2020-05-22 23:42:55 -03:00
notoria
3a7a29868f Added some informations in Cargo.toml 2020-05-23 02:03:24 +02:00
Mark Thom
0060c8988a use -1 as eof_code for binary streams (#555) 2020-05-22 15:58:07 -06:00
Mark Thom
458f482c2a Merge pull request #556 from panasenco/docker
Valid Dockerfile and README
2020-05-22 18:54:10 -03:00
panasenco
dadf1b6ff9 Phrasing 2020-05-22 14:01:10 -07:00
panasenco
db56bb92f0 Fixed link in Dockerfile documentation. Updated README with working Docker link. Made general improvements to the Docker section of the README now that I'm not in a sleep-deprived zombie state. 2020-05-22 13:57:48 -07:00
panasenco
e82e36f51e Revert "Revert "Created and Tested Dockerfile""
This reverts commit e00d864199.
2020-05-22 13:57:48 -07:00
Mark Thom
f9aad34d28 Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-05-22 14:50:51 -06:00
Mark Thom
b2d720b853 correct get_byte/1 not emitted -1 upon discovery of end_of_stream position (#555) 2020-05-22 14:50:40 -06:00
Mark Thom
c10c05e924 Merge pull request #552 from mthom/master
Scryer Dockerfile
2020-05-22 16:04:03 -03:00
Mark Thom
8909246725 Merge pull request #554 from triska/format3
ADDED: format/3, writing formatted output to a stream
2020-05-22 14:32:44 -03:00
Markus Triska
48c0b0ab3c ENHANCED: Faster format/3 for binary streams.
This speeds up web servers considerably when sending binary files.
2020-05-22 17:30:29 +02:00
Markus Triska
cbbed310c5 ADDED: format/3, writing formatted output to a stream
Both binary and text streams are supported.
2020-05-22 17:23:51 +02:00
Mark Thom
9e9c3b6342 modify int_pow so that a power of -1 is valid (#548) 2020-05-21 22:33:22 -06:00
Mark Thom
fefd262c2e Merge pull request #545 from triska/ed25519
ADDED: Public key signatures and signature verification with Ed25519
2020-05-21 11:30:47 -03:00
Markus Triska
1108c99688 document that lists of integers can be specified if encoding(octet) is used
This seems to be a good compromise: The API now strongly encourages
lists of characters, which are ideally suited to represent text, and
also allows lists of bytes if the encoding(octet) option is used.
2020-05-21 13:41:57 +02:00
Markus Triska
93da831ef0 correct mode indication for ed25519_verify/4
Noted by @notoria in #545. Many thanks!
2020-05-21 01:27:06 +02:00
Markus Triska
72bf45912e "PrivateKey" --> "KeyPair" 2020-05-21 00:14:15 +02:00
Markus Triska
5d94276c4f remove several mentions of list of bytes in predicate descriptions
This is to focus more on the intended core representation of text: In
Prolog, text is ideally represented as a list of characters, and this
is what we want to encourage, especially given Scryer's compact
representation for strings.

For the time being, library(crypto) still also supports lists of bytes in
several predicates. This will likely be removed at some point in the
future. Please use lists of characters to make your code future-proof.
2020-05-21 00:07:42 +02:00
Markus Triska
b43f27030e require PKCS#8 v2 format for better security
Notably, this format requires that the public key also be present.
This format is what ed25519_new_keypair/1 generates, and it is
strongly encouraged for higher security.
2020-05-20 23:55:21 +02:00
Markus Triska
2845f55157 ADDED: ed25519_keypair_public_key/2, relating a key pair to its public key 2020-05-20 23:43:28 +02:00
Markus Triska
e254d84710 clarify format of public key 2020-05-20 23:17:42 +02:00
Markus Triska
0ef7b5488d ADDED: ed25519_new_keypair/1 to dynamically create a new Ed25519 key pair 2020-05-20 23:11:56 +02:00
Markus Triska
56b04f8df8 use LessSafeKey to simplify the implementation of authenticated encryption
The nonce is explicitly specified, and the application programmer
must (and always had to) ensure that it is unique for a given key.
2020-05-20 22:32:39 +02:00
Markus Triska
2d036c6b25 "codes" --> "bytes"
Support for lists of bytes may be dropped from library(crypto). Use
lists of characters to make your code future-proof. Lists of
characters will always be supported due to their compactness,
and because Prolog applications should move towards characters.
2020-05-20 22:32:39 +02:00
Markus Triska
ad3be5c848 ADDED: Public key signatures and signature verification with Ed25519 2020-05-20 22:32:39 +02:00
Mark Thom
a0544cc345 revert printing of characters 2020-05-19 17:34:55 -06:00
Mark Thom
3245261162 Merge pull request #537 from triska/master
import member/2 from library(lists)
2020-05-19 15:16:38 -03:00
Markus Triska
21b7348c6a import member/2 from library(lists) 2020-05-19 20:13:06 +02:00
Mark Thom
54d4dc6e1e Merge pull request #536 from mthom/revert-517-docker
Revert "Created and Tested Dockerfile"
2020-05-19 15:00:29 -03:00
Mark Thom
e00d864199 Revert "Created and Tested Dockerfile" 2020-05-19 11:59:06 -06:00
Mark Thom
ad6fc89a24 Merge pull request #533 from triska/master
ADDED: Support for SHA-3 algorithms in crypto_data_hash/3
2020-05-19 14:23:12 -03:00
Mark Thom
fc4823ce8e Merge pull request #534 from triska/phrase_from_file_3
ADDED: phrase_from_file/3 in library(pio)
2020-05-19 14:22:59 -03:00
Markus Triska
0bd9831eec ADDED: phrase_from_file/3 in library(pio)
This allows us to specify type(binary), and read from binary files
with DCGs.
2020-05-19 18:52:18 +02:00
Markus Triska
dec2ef70c7 better error handling in crypto_data_hkdf/4
Noted by @notoria in #533. Many thanks!
2020-05-19 18:22:25 +02:00
Markus Triska
d19d8ea770 crypto_data_hkdf/4: do not crash for length > usize::max_value()
For now, we fail silently in such cases.

Noted by @notoria in #533. Many thanks!
2020-05-19 17:31:36 +02:00
Markus Triska
34f7752c0f use more fixnums in cryptographic routines 2020-05-19 17:03:02 +02:00
Markus Triska
da4d061067 correct option processing in crypto_data_decrypt/6 2020-05-19 17:02:33 +02:00
Markus Triska
85155439be use Fixnums for bytes in hashing.
Suggested by @notoria in #533. Many thanks!
2020-05-19 16:43:44 +02:00
Markus Triska
dd32e69061 use matching to select the hashing algorithm
Suggested by @notoria in #533. Many thanks!
2020-05-19 16:37:50 +02:00
Mark Thom
1c0c660c32 Merge pull request #517 from panasenco/docker
Created and Tested Dockerfile
2020-05-19 11:30:08 -03:00
Mark Thom
2eac902c33 correct fixnum overflow on negation (#528) 2020-05-19 10:45:54 -06:00
Markus Triska
9f5322d309 ADDED: Support for BLAKE2 algorithms in crypto_data_hash/3. 2020-05-19 12:44:10 +02:00
Markus Triska
f5c2f6f9e9 ADDED: Support for SHA-3 algorithms in crypto_data_hash/3 2020-05-19 12:10:46 +02:00
Mark Thom
e0e3b180e7 accomodate \0\ in partial strings, print null as \0\ (#267, #526), update prolog parser, version bump 2020-05-18 23:45:34 -06:00
Mark Thom
041dc039d4 add Addr::Lis as case in PartialStringTail (#530) 2020-05-18 12:27:26 -06:00
Mark Thom
ac755b0ada Merge pull request #527 from triska/master
Add type checks to increase robustness of library(crypto)
2020-05-18 11:18:58 -03:00
Mark Thom
c14259060c fix partial_string_tail panic (#530) 2020-05-18 11:14:27 -06:00
Markus Triska
a423eb5323 stronger validation of input lists for cryptographic routines
Example:

    ?- crypto_data_hkdf(Var, 32, Bs, []).
    caught: error(instantiation_error,must_be/2)

Reported by @notoria in #527. Many thanks!
2020-05-18 13:28:52 +02:00
Markus Triska
fd732550d8 crypto_data_hkdf/4: Fail if the length is too long.
Due to the way the counter is constructed in the HKDF specification,
the requested output length can be at most 255 times the size of the
digest algorithm's output.

Reported by @notoria in #527. Many thanks!
2020-05-18 13:21:38 +02:00
Markus Triska
fac7ba70c8 crypto_password_hash/3: fail if the number of iterations is too high
Discussed in #527.
2020-05-18 13:11:39 +02:00
Markus Triska
e9f8b35918 centralize reasoning about encoding 2020-05-18 11:29:35 +02:00
Markus Triska
23034dd4f5 raise instantiation errors for variable encoding
Reported by notoria in #527.

Note that from a declarative perspective, it would indeed be valid to
give answers for both available encodings.
2020-05-18 11:21:38 +02:00
Markus Triska
70ad44adfd type check for length argument in crypto_data_hkdf/4
Reported by @notoria in #527.
2020-05-18 11:12:59 +02:00
Markus Triska
95ca8a2630 throw instantiation error if the list of options contains a variable (#523)
Many thanks to @notoria for the test case!
2020-05-18 09:58:09 +02:00
panasenco
a7fd3c50e5 Updated README with Docker install instructions 2020-05-17 20:50:34 -07:00
panasenco
5639f40994 Managed to create a 77MB scryer-prolog Docker image 2020-05-17 20:50:34 -07:00
panasenco
33a8262334 New Dockerfile based on Fredrik Park's blog post - compilation fails with linker error 2020-05-17 20:50:34 -07:00
panasenco
9b4f7ad696 Created initial working Docker deployment 2020-05-17 20:50:33 -07:00
Mark Thom
eecd809d9a fix atom_codes (#521) 2020-05-17 16:34:52 -06:00
Mark Thom
240d3cb8f1 add Cargo.lock 2020-05-17 15:20:02 -06:00
Mark Thom
5720b7b94c eliminate Addr::CharCode (#519), fix atom_code panic (#521), fix failure involving lists of character codes (#520), bump version number 2020-05-17 15:19:27 -06:00
Markus Triska
3855d7ea02 type test for salt in crypto_password_hash/3 2020-05-17 22:01:22 +02:00
Mark Thom
9f3351469d solve overflow of left arithmetic shift (#518) 2020-05-17 12:20:22 -06:00
Mark Thom
2c4a0cf65b update Cargo.lock 2020-05-16 23:13:57 -06:00
Mark Thom
a8f360c8fd scryer version bump 2020-05-16 23:12:43 -06:00
Mark Thom
b3cff6555f propagate syntax errors from read_term when they're not UnexpectedEOF (#507) 2020-05-16 23:10:38 -06:00
Mark Thom
69706ecab0 fix sign error in shl on fixnum with n >= 63 (#499) 2020-05-16 23:00:37 -06:00
Mark Thom
05d3b97eae correct for second argument when (is)/2 is a tail call 2020-05-16 20:22:17 -06:00
Mark Thom
a38fb41e37 Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-05-16 14:51:19 -06:00
Mark Thom
204ae377e3 restore old clpz.pl 2020-05-16 14:51:04 -06:00
notoria
3e5a652874 Enhanced Travis-CI (#512) 2020-05-16 11:51:53 -06:00
Markus Triska
862ae26631 Authenticated encryption in library(crypto), new encoding/1 option for hashes (#515)
* shorten n_newlines//1

* remove unneeded variable

* ADDED: authenticated encryption and decryption with ChaCha20-Poly1305

* ADDED: encoding/1 option for crypto_data_hash/3 and crypto_data_hkdf/4
2020-05-16 11:51:41 -06:00
Mark Thom
9e0208ec71 Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-05-15 22:51:24 -06:00
Mark Thom
510530973c correct mishandled Addr::CharCode case in eq_test (#505) 2020-05-15 22:51:18 -06:00
Markus Triska
4e69301562 ADDED: Password-based key derivation (PBKDF2) (#509)
The new predicates crypto_password_hash/[2,3] let you store
passwords safely, and easily verify passwords later.
2020-05-15 10:49:23 -06:00
Matthieu Wipliez
df06d4b9a2 Work in progress: add char_utf8bytes (#493)
* Add char_utf8bytes to library

* Improved implementation

* Improve code + add chars predicate

* Update example

* Renamed string_utf8bytes to char_utf8bytes
2020-05-15 10:05:04 -06:00
Mark Thom
b60561c3bb fix existence_error in atom_chars/2, atom_codes/2 (#504, #506) 2020-05-14 22:33:28 -06:00
Mark Thom
fffa503968 Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-05-14 22:25:50 -06:00
Mark Thom
8754157810 implement (div)/2 properly (#435) 2020-05-14 22:25:39 -06:00
Mark Thom
0763686892 Merge pull request #502 from triska/hkdf
ADDED: HMAC-based key derivation (HKDF) via crypto_data_hkdf/4
2020-05-14 15:13:32 -03:00
Markus Triska
50776748a7 ADDED: HMAC-based key derivation (HKDF) via crypto_data_hkdf/4
This is useful to generate keys and initialization vectors
from suitable input keying material, so that future predicates
for symmetric encryption can be used with appropriate parameters.
2020-05-14 20:07:59 +02:00
Mark Thom
c07274a6fa Merge pull request #501 from triska/elliptic_curves
ADDED: Reasoning about elliptic curves in library(crypto).
2020-05-13 20:58:39 -03:00
Markus Triska
4084005ee7 ADDED: Reasoning about elliptic curves in library(crypto).
This is useful to establish shared secrets, using ECDH key exchange.

Note that CLP(ℤ) goal expansion is currently disabled due to #445,
and this slows down the computations considerably for the time being.
2020-05-13 22:44:27 +02:00
Mark Thom
40fce574cf Merge pull request #500 from triska/master
ADDED: ripemd160 digest algorithm
2020-05-13 17:39:24 -03:00
Markus Triska
fd761735d4 ADDED: ripemd160 digest algorithm
This is used for example for Bitcoin address generation.
2020-05-13 22:36:40 +02:00
Mark Thom
9cb98bdcdc Merge pull request #496 from triska/master
ADDED: crypto_data_hash/3, computing cryptographically secure digests
2020-05-13 17:32:46 -03:00
Mark Thom
b5b1f7ff8a Merge pull request #498 from notoria/between
Enhanced between/3
2020-05-13 17:32:31 -03:00
notoria
a86019d53b Enhanced between/3 2020-05-13 21:21:46 +02:00
Markus Triska
8cd7d08573 ADDED: crypto_data_hash/3, computing cryptographically secure digests 2020-05-13 19:23:09 +02:00
Mark Thom
6d6f6ed8fc resolve warning messages (#495) 2020-05-12 20:36:21 -06:00
Mark Thom
c9aed1381f Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-05-12 20:28:42 -06:00
Mark Thom
49ba5f30c5 throw existence_error on failed put_byte write (#492) 2020-05-12 20:28:39 -06:00
Mark Thom
3c6149fd27 do not unwrap stream write, TcpStream::shutdown results (#492) 2020-05-12 18:51:42 -06:00
Mark Thom
23f804eda3 return true on unmatching partial strings in eq_test to indicate failure (#491) 2020-05-12 18:22:41 -06:00
Mark Thom
4e321db189 Merge pull request #494 from triska/master
ADDED: crypto_n_random_bytes/2, creating cryptographically secure random bytes
2020-05-12 19:44:07 -03:00
Markus Triska
716fde5784 ADDED: crypto_n_random_bytes/2, creating cryptographically secure random bytes
The ring crate is used since it will be needed also for future
predicates in library(crypto).
2020-05-13 00:36:27 +02:00
Mark Thom
c70b873397 reset current input in ReadQueryTerm 2020-05-11 15:29:28 -06:00
Mark Thom
4c0da691b8 record names of variables at root in write_term_to_heap (#487) 2020-05-10 21:48:38 -06:00
Mark Thom
d1d36f9af0 fix at_end_of_stream/1 (#479) 2020-05-10 16:06:15 -06:00
Mark Thom
56efb4ffba change VarNames to VNNames (#476) 2020-05-10 15:54:53 -06:00
Mark Thom
540bc71873 use heap_pstr_iter in AtomChars (#482) 2020-05-10 15:46:51 -06:00
Mark Thom
c1df7ead1a set past end of stream, set Byte to -1, Char and Code to end_of_file, at end of stream (#479) 2020-05-10 14:50:17 -06:00
Mark Thom
d170c807e3 deref addr's in list of atom_codes (#484) 2020-05-10 14:33:56 -06:00
Mark Thom
50c0abc786 correct failed partial string matching (#483) 2020-05-10 14:00:49 -06:00
Mark Thom
c5057127ee eliminate duplicates in term_variables/2, term_attributed_variables/2 (#481) 2020-05-10 13:43:39 -06:00
Mark Thom
ea7b1a9592 fix position property in stream_property/2 (#477) 2020-05-10 13:35:48 -06:00
Mark Thom
26d483f2d7 place cut after infinitely expanding VarList in write_term_to_chars/3 (#476) 2020-05-10 13:30:30 -06:00
Mark Thom
67fce58708 change wrong at_end_of_stream value 'end' to 'at' (#479) 2020-05-10 13:24:45 -06:00
Mark Thom
ea5771c442 detect source_sink domain error in open/4 (#480) 2020-05-10 13:19:14 -06:00
Mark Thom
fa8a1faeb3 Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-05-09 20:08:09 -06:00
Mark Thom
d60a000af6 increase prolog_parser version 2020-05-09 20:07:57 -06:00
Mark Thom
3d68e2b74f Merge pull request #475 from notoria/debug
Debug & warnings
2020-05-09 18:35:16 -03:00
Mark Thom
42f6d48abf Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-05-09 15:05:09 -06:00
Mark Thom
5587957602 halt on Ctrl-D in toplevel (#473) 2020-05-09 15:04:36 -06:00
notoria
1d313ebf25 Removed the warnings 2020-05-09 22:30:39 +02:00
notoria
cf92349c1d Implemented Debug for the new data structures 2020-05-09 22:28:32 +02:00
Mark Thom
b0ae44bc25 Merge branch 'sockets-develop' 2020-05-09 14:26:29 -06:00
Mark Thom
0c94124fdf Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-05-09 14:26:22 -06:00
Mark Thom
22298ddb41 update README.md 2020-05-09 14:26:08 -06:00
Mark Thom
6f927b9941 add set_stream_position/2 2020-05-09 14:20:32 -06:00
Mark Thom
dc5626f34d Merge pull request #474 from triska/radix
ADDED: ~Nr and ~NR are now available for radix conversions
2020-05-09 15:09:14 -03:00
Mark Thom
2717ec2759 Merge pull request #471 from triska/master
ADDED: Initial version of library(crypto).
2020-05-09 14:33:58 -03:00
Markus Triska
d75449ea63 ADDED: ~Nr and ~NR are now available for radix conversions 2020-05-09 19:19:25 +02:00
Mark Thom
034f5b16bd add at_end_of_stream/{0,1} 2020-05-09 01:38:23 -06:00
Mark Thom
ff420f1e67 carry past_end_of_stream in WrappedStreamInstance 2020-05-09 01:34:56 -06:00
Mark Thom
5be771842f add stream_property/2 2020-05-09 00:56:17 -06:00
Markus Triska
a131c93a14 ADDED: Initial version of library(crypto). 2020-05-08 22:33:49 +02:00
Mark Thom
3da3546ef8 Merge pull request #468 from notoria/cont
Enhanced shift/1
2020-05-07 14:26:34 -03:00
notoria
47f5223c37 Enhanced shift/1 2020-05-07 19:10:21 +02:00
Mark Thom
b8c50eb0fe add peek_char/{1,2}, peek_byte/{1,2}, peek_code/{1,2} 2020-05-06 01:05:03 -06:00
Mark Thom
fe05082ddc add sockets library, use new type_error function from sockets system calls 2020-05-05 22:57:06 -06:00
Mark Thom
414acda9e0 add put_code/{1,2}, get_code/{1,2}, improve get_* predicates 2020-05-05 22:42:35 -06:00
Mark Thom
47e3a5e75a add put_byte/{1,2}, put_char/{1,2} 2020-05-05 17:42:18 -06:00
Mark Thom
573df892bc cleanup on reading predicates, add get_char/{1,2} 2020-05-05 16:54:40 -06:00
Mark Thom
bfced59949 clean up stream error handling, add get_byte/{1,2} 2020-05-05 16:09:17 -06:00
Mark Thom
9a63b1751b change EOFCode eof_action from end_of_stream to end_of_file, add echo_server.pl example 2020-05-05 14:15:16 -06:00
Mark Thom
53ae8b9bd1 add flush_output/{0,1}, past_end_of_stream 2020-05-05 14:10:49 -06:00
Mark Thom
bf3cc5a367 Merge pull request #460 from notoria/get_single_char
Fixed ctrl-c issue with get_single_char/1
2020-05-05 14:10:24 -03:00
notoria
ac00bc6b70 Fixed ctrl-c issue with get_single_char/1 2020-05-05 18:47:00 +02:00
Mark Thom
ab62603c5a add close/{1,2}, better EOF action handling in read_term 2020-05-05 00:38:21 -06:00
Mark Thom
dd247cd541 adapt write_term family, add handling for EOF actions. 2020-05-04 21:17:06 -06:00
Mark Thom
0d7a9f32d6 add open/3, write_term/3 2020-05-04 14:50:26 -06:00
Mark Thom
0d85ef4404 Merge pull request #453 from triska/master
disable goal expansion until #445 is resolved
2020-05-04 14:32:26 -03:00
Mark Thom
8e9273a96a test 2020-05-04 11:18:13 -06:00
Markus Triska
2dfdaaa4ba disable goal expansion until #445 is resolved 2020-05-04 18:55:52 +02:00
Mark Thom
407094cdcb merge 2020-05-03 23:36:26 -06:00
Mark Thom
0111db6744 improve answer substitutions at top-level 2020-05-03 23:35:21 -06:00
Mark Thom
a49230c0e1 Merge branch 'master' into sockets-develop 2020-05-03 23:09:13 -06:00
Mark Thom
d04abc2021 improve answer substitutions at top-level 2020-05-03 23:08:53 -06:00
Mark Thom
b5368207d6 merge with master 2020-05-03 18:49:15 -06:00
Mark Thom
b8400e0c92 make term{_attributed_}variables/2 order {attributed} variables by left-to-right occurrence 2020-05-03 18:43:23 -06:00
Mark Thom
ef6b6cd279 Merge pull request #450 from triska/master
do not project queue/2 attributes to residual goals
2020-05-03 20:34:47 -03:00
Mark Thom
e5903d8d6e use select/3 in gather_equations for detecting whether variables are distinct. 2020-05-03 20:31:12 -06:00
Mark Thom
e2a3db1b82 use copy_term/3 as source of attribute goals 2020-05-03 19:34:18 -06:00
Mark Thom
9e220e8416 restore previous focus upon character match failure in compare_pstr_to_string (#441) 2020-05-03 17:03:59 -06:00
Markus Triska
605c233753 do not project queue/2 attributes to residual goals 2020-05-04 00:54:43 +02:00
Mark Thom
aafe18c2b5 Merge pull request #449 from notoria/read
Completed read/1, ctrl-d is end_of_file
2020-05-03 15:27:46 -03:00
Mark Thom
262e8af813 version bump for prolog_parser 2020-05-03 13:46:34 -06:00
notoria
75aa4ce8a0 Completed read/1, ctrl-d is end_of_file 2020-05-03 19:54:17 +02:00
Mark Thom
a494cdaf92 use complete strings in FileToChars (#430) 2020-05-03 02:54:49 -06:00
Mark Thom
848425418b Project goals of query variables (#362) 2020-05-02 22:27:32 -06:00
Mark Thom
989bed88fe wrap support code in modules 2020-05-02 21:26:36 -06:00
Mark Thom
99f66200f7 Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-05-02 18:47:53 -06:00
Mark Thom
b642bd2cfd add term_attributed_variables/2 (#422) 2020-05-02 18:46:29 -06:00
Mark Thom
c062b7c9da Merge pull request #443 from notoria/arithmetic
Implemented expmod/4
2020-05-02 12:00:44 -03:00
notoria
7df7901532 Implemented expmod/4 2020-05-02 14:56:07 +02:00
Mark Thom
9dabce819a remove now unnecessary dependencies, correct ordering of ! in (;)/3 2020-05-01 23:38:44 -03:00
Mark Thom
a019109857 Merge pull request #440 from notoria/arithmetic
Enhanced number_to_rational/2 and number_to_rational/3
2020-05-01 21:48:55 -03:00
Mark Thom
46cdf14ecc Merge pull request #439 from notoria/cli2
Enhanced command line?
2020-05-01 21:45:03 -03:00
Mark Thom
fd5ff20b68 Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-05-01 21:40:45 -06:00
Mark Thom
81f9666e82 cut after compound check in (;)/2 only after semicolon_compound_selector succeeds 2020-05-01 21:40:36 -06:00
Mark Thom
aa8659d5c7 insert cuts where needed into (;)/3 (#434) 2020-05-01 18:52:01 -06:00
notoria
9df2df0f9f Enhanced number_to_rational/2 and number_to_rational/3 2020-05-02 02:36:23 +02:00
notoria
98d38d763b Added $scryer_prolog_version/1 2020-05-02 02:19:22 +02:00
notoria
319a4622b3 Enhanced command line 2020-05-02 01:02:06 +02:00
Mark Thom
59b4c6dacb Merge pull request #437 from triska/master
use ℤ
2020-05-01 19:08:45 -03:00
Markus Triska
ec6d725587 use ℤ
This is now possible thanks to the great contribution by @matt2xu.

Many thanks!
2020-05-02 00:06:16 +02:00
Mark Thom
6f19649186 Merge pull request #436 from mthom/revert-419-cli
Revert "Enhanced command line"
2020-05-01 18:43:37 -03:00
Mark Thom
6a583b9b5b Revert "Enhanced command line" 2020-05-01 15:43:20 -06:00
Mark Thom
6617b79cd8 Merge pull request #419 from notoria/cli
Enhanced command line
2020-05-01 18:32:02 -03:00
Mark Thom
46b695d093 accept any and all characters in comment chars 2020-05-01 16:39:27 -06:00
notoria
de8a017e80 Enhanced command line #2 2020-05-01 18:52:41 +02:00
Mark Thom
b71ec91f57 Merge pull request #432 from triska/master
correct overeager CLP(ℤ) goal expansion
2020-05-01 13:41:43 -03:00
Mark Thom
1b7c226779 correct failing character match in compare_pstr_to_string (#397) 2020-05-01 10:29:10 -06:00
Markus Triska
ca5a5b4392 correct overeager CLP(ℤ) goal expansion
For instance, consider:

    t(X) :- X #= 1.

We *cannot* expand this to:

    ?- listing(t/1).
    t(A) :-
       (  integer(A) ->
          A=:=A
       ;  (  var(A) ->
             true
          ;  true,
             clpz:clpz_equal(A,A)
          )
       ).

Also, a new binding *must not* be dragged outside of disjunctions,
since the code may look for example like this:

        i(X) :-
            (   X #= 3
            ;   X #= 4
            ).

This commit fixes such issues, and still rewrites CLP(ℤ) expressions
as far as possible already at compilation time.

For example:

    n(X) :- X #= 1+3.

This is now compiled to (note that 1+3 is evaluated to 4):

    ?- listing(n/1).
    n(A) :-
       (  integer(A) ->
          A=:=4
       ;  (  var(A) ->
             A=4
          ;  B=4,
             clpz:clpz_equal(A,B)
          )
       ).

Ideally, it should be compiled to:

    n(4).
2020-05-01 18:29:00 +02:00
notoria
6ae7ae0210 Enhanced version 2020-05-01 16:46:31 +02:00
notoria
b911d2fda4 Enhanced command line 2020-05-01 16:19:06 +02:00
Mark Thom
847a92f580 map single character atoms down to characters in constant_index 2020-05-01 01:34:09 -06:00
Mark Thom
a346493de1 Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-04-30 18:20:51 -06:00
Mark Thom
efd5d6efab use slightly better names in indexing functions 2020-04-30 18:20:42 -06:00
Mark Thom
b6df5a4b7f only add expanded goals to dynamic clause code (#416) 2020-04-30 17:53:26 -06:00
Mark Thom
34ae56e319 correct queue_len += queue_len; to queue_len += queue.len(); (#416) 2020-04-30 15:31:01 -06:00
Mark Thom
5870824d01 Merge pull request #425 from triska/master
enable goal expansion for CLP(ℤ) goals
2020-04-30 18:20:27 -03:00
Markus Triska
1dbadbfc35 enable goal expansion for CLP(ℤ) goals
Example:

    integer_successor(I0, I) :- I #= I0 + 1.

Yielding:

    ?- listing(integer_successor/2).
    integer_successor(A,B) :-
       (  integer(B) ->
          (  integer(A) ->
             B=:=A+1
          ;  C is B,
             clpz:clpz_equal(C,A+1)
          )
       ;  (  integer(A) ->
             (  var(B) ->
                B is A+1
             ;  C is A+1,
                clpz:clpz_equal(B,C)
             )
          ;  clpz:clpz_equal(B,A+1)
          )
       ).

Thus, fast low-level arithmetic is used whenever possible.
2020-04-30 23:09:15 +02:00
Mark Thom
d3f1cd7411 index atoms with operators against the same atom with no operator (#387) 2020-04-30 15:09:05 -06:00
Mark Thom
a821daadd3 Merge pull request #420 from triska/master
correct verify_attributes/3 for variables that have no CLP(ℤ) attribute attached (#373)
2020-04-30 13:32:21 -03:00
Markus Triska
a39f4b4487 correct verify_attributes/3 for variables that have no CLP(ℤ) attribute attached (#373)
Example:

    ?- freeze(B, queen_value_truth(C,N,B)), Q #= N #<==> B.
       clpz:(Q#=N#<==>B), clpz:(B in 0..1), freeze:freeze(B,queen_value_truth(C,N,B))
    ;  false.
2020-04-30 18:10:09 +02:00
Mark Thom
f7b401b9b6 fix user:goal_expansion 2020-04-30 09:28:11 -06:00
Mark Thom
c342d18f92 Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-04-30 00:01:12 -06:00
Mark Thom
e0e52a3090 fix 'drain lower bound was too large', store user-level expansions to modules (#416) 2020-04-30 00:01:00 -06:00
Mark Thom
6f92480315 Merge pull request #418 from notoria/mediants
Documentation for arithmetic.pl
2020-04-29 18:53:00 -03:00
notoria
490d008edf Merge pull request #4 from triska/mediants
include library(arithmetic) in the overview
2020-04-29 23:48:07 +02:00
notoria
ccee17c573 Merge branch 'mediants' into mediants 2020-04-29 23:47:05 +02:00
Mark Thom
dd4832e40b add ordsets.pl to README 2020-04-29 18:42:17 -03:00
Mark Thom
ff5b870a9f Merge pull request #417 from notoria/mediants
Implemented predicate mediants/2 with Stern-Brocot tree
2020-04-29 18:33:35 -03:00
notoria
a371580201 Add rational_numerator_denominator/3, number_to_rational/2 and renamed stern_brocot/3 to number_to_rational/3 2020-04-29 23:30:14 +02:00
Markus Triska
b499c575bc include library(arithmetic) in the overview
Many thanks to @notoria for these very useful predicates!
2020-04-29 22:06:49 +02:00
notoria
f5a6268cef Add rational_numerator_denominator/3, number_to_rational/2 and renamed stern_brocot/3 to number_to_rational/3 2020-04-29 21:52:01 +02:00
Mark Thom
2df4083602 use select to filter variable lists when printing equations of two variables 2020-04-29 11:05:10 -03:00
Mark Thom
2495fb796d select variable names in write_eq based on whether RHS is a variable (#326) 2020-04-29 10:56:17 -03:00
notoria
f7b49740c1 Removed predicate mediants/2 and added stern_brocot/3 2020-04-29 14:18:20 +02:00
Mark Thom
7e765fe726 correct answer substitution order, equating variables to themselves (#326) 2020-04-29 01:45:42 -06:00
notoria
1d339f74d1 Implemented predicate mediants/2 with Stern-Brocot tree 2020-04-29 02:44:13 +02:00
Mark Thom
a3bb288f01 check that lower bound on term expansion drain is below the len of the term expansion vector, queue (#416) 2020-04-28 19:22:20 -06:00
Mark Thom
0e1226573a print rational numbers using the rdiv operator when defined (#413) 2020-04-28 18:03:04 -06:00
Mark Thom
8151b65d12 Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-04-28 17:20:25 -06:00
Mark Thom
eefd36b50d do length check in PartialString::range_from (#412) 2020-04-28 17:20:14 -06:00
Mark Thom
6f4d769187 Merge pull request #414 from triska/master
Small corrections, additions and improvements
2020-04-28 16:54:39 -03:00
Markus Triska
20b76a703a mention portray_clause/1 and listing/1 2020-04-28 18:27:46 +02:00
Markus Triska
dcc09b7bb5 mention backtrackable and non-backtrackable global variables 2020-04-28 18:22:18 +02:00
Markus Triska
4ea0dee90a use new nth0/3 from library(lists) 2020-04-28 17:59:49 +02:00
Markus Triska
e61116d35a use singleton variable, correct a mistake in maplist/8 2020-04-28 17:59:49 +02:00
Markus Triska
f7256c75d5 ADDED: nth0/3, relating indices to list elements 2020-04-28 17:59:49 +02:00
Markus Triska
2696fd1291 small typographic corrections 2020-04-28 17:59:49 +02:00
Markus Triska
b139620fba use new predicates from library(error) to throw type and domain errors 2020-04-28 17:59:49 +02:00
Mark Thom
97115a9c1c Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-04-28 01:41:11 -06:00
Mark Thom
36134c61b2 erase unnecessary stub from block of FileToChars 2020-04-28 01:40:59 -06:00
Mark Thom
77cf0fd87b don't append lists of attributes when binding attributed variables (#353) 2020-04-28 01:40:11 -06:00
Mark Thom
ab77a1cbc0 modify domain.pl example (#347) 2020-04-28 01:39:34 -06:00
Mark Thom
8490892493 Merge pull request #409 from triska/clp
add more information about Constraint Logic Programming (CLP)
2020-04-27 15:05:15 -03:00
Markus Triska
5f35dffa34 if_ --> if_/3 2020-04-27 19:53:25 +02:00
Markus Triska
89a4b5a6ff add more information about Constraint Logic Programming (CLP) 2020-04-27 19:48:46 +02:00
Mark Thom
931de7e39c Merge pull request #408 from triska/master
Introduce and use new predicates for throwing ISO errors
2020-04-27 14:35:17 -03:00
Markus Triska
ff41d6aef9 include the new library(random) in the overview
Many thanks to @notoria for this contribution!
2020-04-27 18:44:59 +02:00
Markus Triska
8e1ba58551 use new predicates from library(error) 2020-04-27 18:44:59 +02:00
Markus Triska
2b1692a860 ADDED: library(error): instantiation_error/1, domain_error/3, type_error/3
These predicates simplify throwing ISO errors.
2020-04-27 18:44:59 +02:00
Markus Triska
7a2981e21c include usage advice about probabilistic predicates 2020-04-27 18:44:59 +02:00
Mark Thom
f8717359d7 Merge pull request #406 from notoria/random
Created the library random and updated library clpb
2020-04-27 09:14:01 -03:00
Mark Thom
fe395e3a8c publish bimetatrans_ruleml_tests, move both files to own directory 2020-04-26 20:32:16 -06:00
Mark Thom
eb9fe851af Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-04-26 20:15:27 -06:00
notoria
d61851ad02 Added predicate random_integer and updated clpb 2020-04-27 01:52:19 +02:00
notoria
de7a408903 Created the library random and moved some predicates from iso_ext 2020-04-26 23:37:22 +02:00
Mark Thom
4b0f60fe71 Merge pull request #405 from triska/master
Two small documentation additions
2020-04-26 17:20:58 -03:00
Markus Triska
a167bcff5e add library(cont) to the list 2020-04-26 21:57:37 +02:00
Markus Triska
fb812e6335 add more information about tabling 2020-04-26 21:57:37 +02:00
Mark Thom
3fd557c74a Merge pull request #402 from notoria/pio
Small patch for library pio
2020-04-26 12:17:09 -03:00
notoria
9b1272da51 Small patch for library pio 2020-04-26 14:54:20 +02:00
Mark Thom
ae2402f4a7 Merge pull request #399 from notoria/debug
Implemented the Debug trait for all data structures
2020-04-25 23:35:27 -03:00
notoria
c98e869564 Implemented the Debug trait for all data structures 2020-04-26 02:20:24 +02:00
Mark Thom
e1a019ec56 Merge pull request #398 from triska/master
Several smaller improvements
2020-04-25 17:20:24 -03:00
Mark Thom
2d7fcbf23d use proper module name in bimetatrans_ruleml 2020-04-25 12:55:36 -06:00
Markus Triska
b604177ca1 include library(pio) and library(charsio) in the description 2020-04-25 20:12:54 +02:00
Markus Triska
f27597cab5 update toplevel interaction 2020-04-25 20:12:54 +02:00
Markus Triska
40619c8184 ENHANCED: Throw domain errors in char_type/2 for wrong types
This is especially important because a few of our names diverge from
ctype(3), and we better inform programmers when the type they are
using is not available at all.
2020-04-25 20:12:54 +02:00
Markus Triska
b0a5df2838 use an anonymous variable 2020-04-25 19:59:46 +02:00
Mark Thom
ae9232a2cb Merge pull request #396 from notoria/phrase_from_file
Implemented phrase_from_file/2 and /2
2020-04-25 14:17:24 -03:00
notoria
ad28d0025a No trimming of the buffer 2020-04-25 18:20:20 +02:00
notoria
d6772c5ca5 Implemented phrase_from_file/2 and /2 2020-04-25 18:04:13 +02:00
Mark Thom
a2400767ed Merge pull request #391 from notoria/msb_lsb2
Implemented lsb/2 and msb/2
2020-04-25 12:58:03 -03:00
notoria
1873b655a8 Implemented lsb/2 and msb/2 2020-04-24 23:52:32 +02:00
Mark Thom
e27c2b59c8 Merge pull request #380 from notoria/char_type
Implementation of the predicate char_type for a subset
2020-04-23 21:57:03 -03:00
notoria
4b50608642 Implementation of the predicate char_type for a subset 2020-04-23 16:09:06 +02:00
notoria
e3a7f9eb7a Draft of an implementation of char_type 2020-04-22 12:57:18 +02:00
Mark Thom
c130b3a92e Merge pull request #381 from triska/master
ADDED: library(format) now provides a rudimentary version of listing/1
2020-04-21 21:16:40 -03:00
Markus Triska
20fb6d6669 ADDED: library(format) now provides a rudimentary version of listing/1
Example:

    :- dynamic(a/1).

    a(X) :- X = true, b(X).

Yielding:

    ?- listing(a/1).
    %@ a(A) :-
    %@    A=true,
    %@    b(A).
    %@    true.

listing/1 only works for predicates and DCGs that are declared dynamic/1.
2020-04-22 01:53:20 +02:00
Mark Thom
caf20cd43d Merge pull request #377 from triska/master
portray_clause/1 now correctly tracks variable names (#376)
2020-04-20 19:16:12 -03:00
Markus Triska
608d661355 portray_clause/1 now correctly tracks variable names (#376)
Example:

    ?- portray_clause((A :- B)).
    %@ A :-
    %@    B.
    %@    true
    %@ ;  ...

Also, change the indentation from 8 to 3 at the express request of @UWN.
2020-04-20 22:53:15 +02:00
Mark Thom
31c868818b Merge pull request #375 from notoria/sleep
Changed the error being thrown by sleep/1
2020-04-20 11:52:25 -03:00
Mark Thom
443c4b6cd0 speed unification of pairs of partial strings 2020-04-20 11:37:32 -06:00
Mark Thom
ee425bb7f0 change CPU_now to CpuNow 2020-04-20 10:37:00 -06:00
Mark Thom
9d1c026231 check for num in comparisons, bump num-rug-adapter to 0.1.3 2020-04-20 10:35:30 -06:00
notoria
6d7612ead6 Corrected the error being thrown by sleep/1 2020-04-20 16:36:57 +02:00
notoria
b3e31094ff Changed the error being thrown by sleep/1 2020-04-20 11:27:28 +02:00
Mark Thom
c9750fab2c Merge pull request #371 from notoria/sleep
Added the sleep predicate
2020-04-19 21:41:33 -03:00
Mark Thom
5a1348e4d1 do casts between different arithmetic types for comparison and equality (#372) 2020-04-19 21:34:59 -06:00
Mark Thom
b64d45a74e speed comparisons of partial strings 2020-04-19 20:58:53 -06:00
Mark Thom
ba5a4c3945 use default machine policies in term expansions 2020-04-19 19:54:23 -06:00
Mark Thom
9ba37a932b Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-04-19 16:43:32 -06:00
Mark Thom
8ce377d033 update toplevel comments, add mutable stack to zipped acyclic iterators 2020-04-19 16:01:35 -06:00
notoria
a7f3dafd81 Undo a workaround 2020-04-19 23:26:16 +02:00
notoria
fb38b4b906 Corrected bound 2020-04-19 23:04:51 +02:00
notoria
f0a1a90b0e Merge pull request #3 from triska/sleep
update comment
2020-04-19 22:44:48 +02:00
notoria
fb331d39a6 Thrown an error if T < 0 or T > 0xfffffffffffffbff in sleep(T) 2020-04-19 22:43:13 +02:00
Markus Triska
7a3e6e19b1 update comment 2020-04-19 22:36:27 +02:00
notoria
5a063c541d Added the sleep predicate 2020-04-19 21:35:49 +02:00
Mark Thom
eef25ec638 Merge pull request #370 from triska/master
ENHANCED: time(Goal) now also reports the time if Goal fails
2020-04-19 16:33:51 -03:00
Markus Triska
7141fb18c1 ENHANCED: time(Goal) now also reports the time if Goal fails 2020-04-19 21:13:15 +02:00
Mark Thom
2c92be5e3d Merge pull request #367 from triska/master
ADDED: library(time), providing time/1 for benchmarking
2020-04-19 14:29:09 -03:00
Mark Thom
cae0733149 Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-04-19 12:58:54 -06:00
Mark Thom
5d6ca7a88e throw '' whenever an interrupt is made (#365, #366) 2020-04-19 12:58:44 -06:00
Markus Triska
23b8a4d364 add entry for time/1 2020-04-19 19:24:22 +02:00
Markus Triska
c0df8cb578 update answer to use the latest toplevel improvements 2020-04-19 19:18:47 +02:00
Markus Triska
4693c23a49 ADDED: library(time), providing time/1 for benchmarking
sleep/1 and predicates for reasoning about time stamps should also
be added to this library.
2020-04-19 19:18:47 +02:00
Mark Thom
86364ff278 Merge pull request #364 from triska/master
Documentation addition, and correction of error term
2020-04-18 22:54:17 -03:00
Markus Triska
60f1f1cb3d Restore the type_error, which was implemented correctly by @notoria.
This corrects f28e87b240:
in_character is a valid type by 7.12.2 Error classification!
2020-04-19 02:15:59 +02:00
Markus Triska
ab3c520006 document ~| format modifier to place a tab stop at this position
This works best when used in tandem with ~N+, since it is currently
equivalent to ~0| and does not take the actual text position into account.
However, when using relative positions, this works as intended.
2020-04-19 01:59:16 +02:00
Mark Thom
3798dcb98d Merge pull request #363 from triska/master
Delay toplevel output until after the goal succeeds
2020-04-18 20:37:32 -03:00
Mark Thom
9daf290432 remove SCCCutPolicy panic, revise (;)/2 so that comma'ed cuts are handled properly (#361) 2020-04-18 20:10:53 -06:00
Mark Thom
3438f88c1e drop $ naming convention inside '' when unnecessary 2020-04-18 20:06:52 -06:00
Mark Thom
2c8858ff2d use correct signs in fixnum remainders 2020-04-18 17:37:54 -06:00
Markus Triska
45ed9405b0 use the most recent improvements 2020-04-19 01:34:13 +02:00
Markus Triska
075ca78dd2 ENHANCED: Delay toplevel output until after the goal succeeds.
This is to accommodate goals that are used for their side-effects,
when we are interested in their output.

Examples:

    ?- portray_clause((a :- a)).
    a :-
            a.
       true
    ;  false.

    ?- format("hello~w~n", [!]).
    hello!
       true
    ;  false.
2020-04-19 01:34:03 +02:00
Mark Thom
1d964ef921 add domain and type errors for compare/3 (#296) 2020-04-18 14:37:14 -06:00
Mark Thom
0c6d9b1d3b Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-04-18 14:17:13 -06:00
Markus Triska
1713f1222b reintroduce "n" as a synonym for ";" and " " 2020-04-18 14:16:46 -06:00
Markus Triska
450591d5a9 ENHANCED: the toplevel interaction now supports RETURN as a synonym for "."
This is made possible due to the recent improvements by @notoria.
2020-04-18 14:16:46 -06:00
Markus Triska
5c4863dfb1 small simplifications 2020-04-18 14:16:46 -06:00
notoria
c6a82cbc07 Removed a check in get_single_char 2020-04-18 14:16:46 -06:00
notoria
cc8f074d33 Added Space for continuation 2020-04-18 14:16:46 -06:00
notoria
196d74c3a0 Fixed the predicate name when error is thrown 2020-04-18 14:16:46 -06:00
Markus Triska
f28e87b240 instead of a type error, use a domain error
The preceding use of atom_length/2 already ensures that C has the
correct type (i.e., atom). However, its domain may still be wrong,
if its length is greater than 1.
2020-04-18 14:16:46 -06:00
Markus Triska
2d77ef4245 use get_single_char/1 2020-04-18 14:16:46 -06:00
notoria
3f578e24b5 Removed $raw_input_read_char 2020-04-18 14:16:46 -06:00
notoria
fb5ee5e190 get_single_char reads Tab as \t 2020-04-18 14:16:46 -06:00
notoria
63e8378310 get_single_char reads Enter as \n 2020-04-18 14:16:46 -06:00
notoria
c24ebaf506 Moved get_single_char from builtins.pl to charsio.pl 2020-04-18 14:16:46 -06:00
notoria
d3a1f11dfe Added predicate for reading a single character 2020-04-18 14:16:46 -06:00
Mark Thom
f96e694ff8 bracket graphic token chars in toplevel.pl (#357) 2020-04-18 14:16:40 -06:00
Mark Thom
d5d635e50f slight tweaks to bimetatrans 2020-04-18 14:16:40 -06:00
Mark Thom
1ad4ce9822 index Constant::Usize (#355) 2020-04-18 14:16:40 -06:00
Mark Thom
3f971174e4 quote single dots only 2020-04-18 14:16:40 -06:00
Markus Triska
16e257ea32 ADDED: list_to_set/2, using the first occurrence of each element
Example:

    ?- list_to_set([B,a,b,a,B,A,b,A], Ls).
       Ls = [B,a,b,A]
    ;  false.
2020-04-18 14:16:40 -06:00
Mark Thom
37f1f8ac14 allow characters as atoms in Machine::use_module and Machine::use_qualified_module 2020-04-18 14:16:40 -06:00
Mark Thom
474fa9b3ec remove underscores in printed variables produced by write_term_to_chars (#340) 2020-04-18 14:16:40 -06:00
Mark Thom
6d7b14ceb5 don't count the terminator in PStrIter len 2020-04-18 14:16:40 -06:00
Mark Thom
af14832b6c quote dot when quoted(true) (#349) 2020-04-18 14:16:40 -06:00
Mark Thom
9ef185978f privilege new op declarations over old ones (#346) 2020-04-18 14:16:40 -06:00
Mark Thom
38bb44664c interrupt running queries and return to toplevel (#323) 2020-04-18 14:16:40 -06:00
Mark Thom
124d924ff5 write [a,b,c] correctly with write_canonical (#349) 2020-04-18 14:16:40 -06:00
Markus Triska
e8091d8add update the toplevel description, incorporating the latest changes 2020-04-18 14:16:40 -06:00
Mark Thom
500bd53b6a Merge pull request #360 from notoria/master
Add get_single_char predicate.
2020-04-18 14:10:26 -03:00
notoria
6996ca832d Merge pull request #2 from triska/get_single_char
New feature: RET can now be used as a synonym for "." in the interaction
2020-04-18 18:51:37 +02:00
notoria
2e15ab44ab Removed a check in get_single_char 2020-04-18 18:28:26 +02:00
Markus Triska
2ae5472872 reintroduce "n" as a synonym for ";" and " " 2020-04-18 18:09:55 +02:00
Markus Triska
98a32790cd ENHANCED: the toplevel interaction now supports RETURN as a synonym for "."
This is made possible due to the recent improvements by @notoria.
2020-04-18 17:56:37 +02:00
Markus Triska
6dcefcfb71 small simplifications 2020-04-18 17:52:43 +02:00
notoria
988366e37f Added Space for continuation 2020-04-18 16:57:45 +02:00
notoria
98a37905b8 Fixed the predicate name when error is thrown 2020-04-18 15:21:19 +02:00
notoria
bd832d0fbb Merge pull request #1 from triska/get_single_char
use get_single_char/1
2020-04-18 14:50:32 +02:00
Markus Triska
1f7e18f2a9 instead of a type error, use a domain error
The preceding use of atom_length/2 already ensures that C has the
correct type (i.e., atom). However, its domain may still be wrong,
if its length is greater than 1.
2020-04-18 14:39:30 +02:00
Markus Triska
105e9c8e88 use get_single_char/1 2020-04-18 14:33:11 +02:00
notoria
99e1a5f117 Removed $raw_input_read_char 2020-04-18 13:54:18 +02:00
notoria
b35b49f7b3 get_single_char reads Tab as \t 2020-04-18 13:33:42 +02:00
notoria
5d064b18e6 get_single_char reads Enter as \n 2020-04-18 13:30:52 +02:00
notoria
11ea92288d Moved get_single_char from builtins.pl to charsio.pl 2020-04-18 12:52:49 +02:00
notoria
1ea6ae9fd9 Added predicate for reading a single character 2020-04-18 11:49:28 +02:00
Mark Thom
57d739673a index Constant::Usize (#355) 2020-04-15 14:11:45 -06:00
Mark Thom
4d8f76e922 quote single dots only 2020-04-15 13:45:35 -06:00
Mark Thom
fb41d4ab0f Merge pull request #354 from triska/master
ADDED: list_to_set/2, using the first occurrence of each element
2020-04-15 13:19:54 -03:00
Mark Thom
023ee688d3 allow characters as atoms in Machine::use_module and Machine::use_qualified_module 2020-04-15 10:32:23 -06:00
Mark Thom
5f8f0d8573 remove underscores in printed variables produced by write_term_to_chars (#340) 2020-04-15 10:27:20 -06:00
Mark Thom
f56e0a6586 don't count the terminator in PStrIter len 2020-04-15 10:07:44 -06:00
Markus Triska
2c96420bc4 ADDED: list_to_set/2, using the first occurrence of each element
Example:

    ?- list_to_set([B,a,b,a,B,A,b,A], Ls).
       Ls = [B,a,b,A]
    ;  false.
2020-04-15 18:04:01 +02:00
Mark Thom
8d95eb57fa quote dot when quoted(true) (#349) 2020-04-15 00:54:32 -06:00
Mark Thom
a9a5e79e85 privilege new op declarations over old ones (#346) 2020-04-15 00:37:00 -06:00
Mark Thom
2b720b8d0b interrupt running queries and return to toplevel (#323) 2020-04-15 00:08:35 -06:00
Mark Thom
93a0ab7f0a write [a,b,c] correctly with write_canonical (#349) 2020-04-14 23:25:15 -06:00
Mark Thom
18dd55d1f4 Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-04-14 23:15:01 -06:00
Mark Thom
c9074d8d96 properly iterate through UTF-8 strings (#350) 2020-04-14 23:14:47 -06:00
Mark Thom
f6c995157e clean up print_list_like 2020-04-14 14:26:30 -06:00
Mark Thom
a059a9fbdc print lists as strings when possible (#295) 2020-04-14 13:28:51 -06:00
Mark Thom
2ac6596ba9 Merge pull request #348 from triska/master
update the toplevel description, incorporating the latest changes
2020-04-14 14:29:40 -03:00
Markus Triska
2d1f57e839 update the toplevel description, incorporating the latest changes 2020-04-14 19:24:13 +02:00
Mark Thom
7799ed36f0 provide better variable names in write_term_to_chars/3 (#340) 2020-04-14 10:39:10 -06:00
Mark Thom
db5ed345bc improve writeX performance (#290) 2020-04-14 10:25:05 -06:00
Mark Thom
082c6a9e64 copy operator exports to impromptu modules (#307) 2020-04-14 01:03:49 -06:00
Mark Thom
b74a4d5225 Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-04-14 00:40:57 -06:00
Mark Thom
16a572c250 change from xsi to iso in bimetatrans, correct atomic/1 failure (#343) 2020-04-14 00:40:51 -06:00
Mark Thom
6a8a2d6f56 Merge pull request #345 from triska/master
ADDED: group_pairs_by_key/2
2020-04-13 19:24:52 -03:00
Markus Triska
237c855f10 ADDED: group_pairs_by_key/2
Pairs must be keysorted and may also contain variables as keys.

Examples:

    ?-  group_pairs_by_key([1-a,1-b,2-c], Ps).
       Ps = [1-[a,b],2-[c]].

    ?-  group_pairs_by_key([X-a,X-b,2-c], Ps).
       Ps = [X-[a,b],2-[c]].
2020-04-14 00:10:33 +02:00
Mark Thom
15d18484e3 version bump 2020-04-13 11:17:50 -06:00
Mark Thom
378e9b5539 Merge pull request #327 from srenatus/sr/pass-argv-as-partial-strings
use partial strings for passing argv to toplevel.pl
2020-04-13 11:17:08 -03:00
Mark Thom
7a135bd87c Merge pull request #342 from srenatus/sr/fix-cargo-install
main: fix version reporting without git
2020-04-13 11:16:55 -03:00
Stephan Renatus
9e907e36e2 main: fix version reporting without git
Fixes #339.

At least I hope so. I didn't come up with an idea how to test this with
little effort.

Signed-off-by: Stephan Renatus <srenatus@chef.io>
2020-04-13 15:50:33 +02:00
Mark Thom
9ac71f304d Merge pull request #341 from triska/master
the workaround is no longer necessary, since #336 is now corrected
2020-04-13 09:13:17 -03:00
Markus Triska
ab9b604d02 the workaround is no longer necessary, since #336 is now corrected 2020-04-13 11:32:06 +02:00
Stephan Renatus
155645307a use partial strings for passing argv to toplevel.pl
In run_top_level: rename variables, make them partial strings

The rename is mostly cosmetic: all of argv is passed, and if argv
contains flags, goals, etc, it's more than filenames.

Using partial strings instead of atom came from discussions about how to
pass goals in the CLI, and can thus be considered preliminary work for
that.

In toplevel.pl: convert partial string to atom before passing it to
`use_module`.

Signed-off-by: Stephan Renatus <srenatus@chef.io>
2020-04-13 10:10:10 +02:00
Mark Thom
4ca7ac4851 use prolog_parser 0.8.50 (#336) 2020-04-13 00:32:41 -06:00
Mark Thom
02eb24cd57 correct partial string copying by resetting threshold to redirected partial string stubs to 0 2020-04-12 23:33:07 -06:00
Mark Thom
787fbe1bb6 use partial_string/1 in place of the removed string/1 in bimetatrans_ruleml.pl 2020-04-12 22:27:53 -06:00
Mark Thom
7678858bab update Cargo.lock 2020-04-12 22:01:59 -06:00
Mark Thom
bf7a28f07c bump version to 0.8.119 2020-04-12 21:59:22 -06:00
Mark Thom
9e54b1406c Merge pull request #338 from triska/master
also include a newline in portray_clause/1
2020-04-12 20:35:48 -03:00
Markus Triska
f52c9772a7 also include a newline in portray_clause/1 2020-04-13 01:24:15 +02:00
Mark Thom
ea5203d8c3 Merge pull request #337 from triska/master
ADDED: provide a rudimentary version of portray_clause/1
2020-04-12 20:10:21 -03:00
Mark Thom
0fad2f9953 make write_term_to_chars work with variable terms (#335) 2020-04-12 18:10:45 -06:00
Mark Thom
d3a9392421 provide read_term_from_chars/2 (#334) 2020-04-12 17:26:11 -06:00
Markus Triska
208927544d ADDED: provide a rudimentary version of portray_clause/1
At the moment, library(format) seems to be a fitting place.
In the eventual library organization, portray_clause/1 and
related predicates may be moved to their own dedicated library.
2020-04-13 01:04:52 +02:00
Mark Thom
7621155a89 change wording of QueryCannotBePostedAsFact to QueryCannotBeDefinedAsFact, remove old commented code in read.rs 2020-04-12 16:01:53 -06:00
Mark Thom
4ddc4ebf46 Merge pull request #333 from triska/master
incorporate the latest improvements in the description of partial strings
2020-04-12 16:00:01 -03:00
Markus Triska
786f0b5ca2 incorporate the latest improvements in the description of partial strings
As of 6e4b76a3b4, the use of
partial_string/3 can be replaced by (=)/2 in this example.
2020-04-12 20:46:22 +02:00
Mark Thom
b4ff429bfa Merge pull request #332 from triska/master
ENHANCED: ~w now supports compound terms, and ~q is now also available
2020-04-12 15:00:20 -03:00
Mark Thom
f2cf0ec459 move write_term_to_chars/3 to src/prolog/lib/charsio.pl 2020-04-12 14:42:39 -06:00
Mark Thom
0380d70a46 add write_term_to_chars/3 to iso_ext.pl (#288) 2020-04-12 14:29:28 -06:00
Mark Thom
28099b9812 correct misleading error for modules (#300) 2020-04-12 12:51:59 -06:00
Mark Thom
2ce4f602c0 be more judicious with at_cdr in print_string (#295) 2020-04-12 12:18:15 -06:00
Mark Thom
5e81fb4754 throw exception when attempting to post query as goal (#329) 2020-04-12 12:07:41 -06:00
Markus Triska
c9f1a95343 ENHANCED: ~w now supports compound terms, and ~q is now also available 2020-04-12 19:56:01 +02:00
Mark Thom
97d8d07947 recognize empty lists as partial strings (#328) 2020-04-11 23:08:15 -06:00
Mark Thom
4f0adad78e remove string/1, use a more general test for the partial_string/1 type test (#328) 2020-04-11 22:47:52 -06:00
Mark Thom
0499005db5 throw error when trying to use partial lists as DCG terminal-sequence (#286) 2020-04-11 22:40:29 -06:00
Mark Thom
aedffb3cfe remove unnecessary use of partial_string in bimetatrans example 2020-04-11 22:02:17 -06:00
Mark Thom
fff96e69db Merge pull request #310 from triska/bimeta_example
Bimeta example
2020-04-11 22:03:10 -03:00
Mark Thom
abc99c9dd8 Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-04-11 21:59:25 -06:00
Mark Thom
6e4b76a3b4 compile special instructions for partial strings when recognized 2020-04-11 21:53:28 -06:00
Mark Thom
92d8642133 do not accept [X|Xs] patterns as DCG non-terminals (#286) 2020-04-11 21:52:45 -06:00
Mark Thom
184124586b Merge pull request #320 from triska/master
add library(freeze) to make zcompare/3 work
2020-04-09 12:26:31 -03:00
Markus Triska
4d32b6976a add library(freeze) to make zcompare/3 work 2020-04-08 22:09:59 +02:00
Mark Thom
45a99e576d Merge pull request #318 from triska/master
extend description of strings and partial strings
2020-04-08 16:59:13 -03:00
Markus Triska
fac6d54986 extend description of strings and partial strings
Also, explain in more detail what this feature means to Prolog
application programmers, and the strategic direction of Scryer.
2020-04-08 21:07:00 +02:00
Mark Thom
036c35729c Merge pull request #316 from triska/master
clpz_monotonic/0 --> monotonic/0
2020-04-08 13:18:42 -03:00
Markus Triska
e442fddc66 tuples_in/2 now works 2020-04-08 17:49:06 +02:00
Mark Thom
a3c3afba48 fix list index offset bug (#314) 2020-04-06 16:15:36 -06:00
Markus Triska
794ceac440 clpz_monotonic/0 --> monotonic/0 2020-04-06 23:05:57 +02:00
Mark Thom
6299d41cda mark clp(X) item as completed, restore clp(Z) library description 2020-04-05 21:26:27 -03:00
Mark Thom
2e5ce0249e Merge pull request #312 from triska/master
ADDED: CLP(ℤ), Constraint Logic Programming over Integers
2020-04-05 21:14:11 -03:00
Mark Thom
560298655b consolidate Cargo.lock 2020-04-05 20:34:49 -06:00
Mark Thom
4086df27b2 merge with master 2020-04-05 20:33:45 -06:00
Mark Thom
d76ae413c4 use fixnums in place of bignums where possible 2020-04-05 20:32:16 -06:00
Markus Triska
8b1df2e9ca ADDED: CLP(ℤ), Constraint Logic Programming over Integers
library(clpz) implements declarative integer arithmetic.

The most important predicates for reasoning about integers are:

    (#=)/2    equality
    (#\=)/2   disequality
    (#<)/2    less than
    (#>)/2    greater than
    (#=<)/2   less than or equal to
    (#>=)/2   greater than or equal to

In addition, the library provides several global constraints, such as
all_distinct/1 and global_cardinality/2, and reification predicates
that reflect the truth values of constraints into integer variables.

Enumeration predicates such label/1 and labeling/2 can be used to
search for solutions over finite domains.

Almost all Prolog programs also reason about integers. Therefore, I
recommend to add this library to your .scryerrc configuration file so
that declarative integer arithmetic is available in all your programs.

More information about CLP(ℤ):

    https://www.metalevel.at/prolog/clpz

Enjoy!
2020-04-06 01:59:41 +02:00
Mark Thom
c8855f97e8 allocate empty partial strings 2020-04-05 02:55:30 -06:00
Mark Thom
bbf1aa1668 use copy_term/3 to print residual goals (#254) 2020-04-05 02:55:04 -06:00
Mark Thom
141f3bcec3 harmonize partial strings with complete strings (#276), make Addr a copyable type 2020-04-03 10:22:46 -06:00
Mark Thom
8f11fd7c62 Merge pull request #306 from srenatus/sr/version-argument
main: add -v/--version flag
2020-04-03 00:35:51 -03:00
Mark Thom
9f960c25a5 add bimetatrans_ruleml.pl to examples 2020-03-30 20:00:08 -06:00
Markus Triska
11a616917a introduce and use nonterminal list//1
Example:

    ?- phrase(list(Ls), Ls0).
       Ls = [], Ls0 = []
    ;  Ls = [_A], Ls0 = [_A]
    ;  Ls = [_A,_B], Ls0 = [_A,_B]
    ;  Ls = [_A,_B,_C], Ls0 = [_A,_B,_C]
    ;  ...
2020-03-31 01:28:16 +02:00
Markus Triska
a89f03f27d embed literal lists directly in DCGs
Example use of direct embedding:

    ?- phrase("abc", Ls0, Ls).
       Ls0 = [a,b,c|Ls].
2020-03-31 01:24:15 +02:00
Markus Triska
3faf36440c naming: partial_list_ws//1 --> list_ws//1
A DCG describes a list, so "list" is an appropriate name.
2020-03-31 01:23:00 +02:00
Stephan Renatus
45d4f46024 main: skip args[0]
This is a bit pedantic, it's unlikely that the executable would be
called `-v` or `--version`. However, it seems slightly more correct to
disregard argv[0] when checking flags.
Signed-off-by: Stephan Renatus <srenatus@chef.io>
2020-03-28 09:07:44 +01:00
Stephan Renatus
896f2aeb74 main: add -v/--version flag
Added a new dependency to take care of pulling in the version from git
at build time.

Args handling is minimalistic, but there wasn't any before, so I figured
this might do for now. (Eventually, some proper `--help` and usage
output might come in handy?)

Signed-off-by: Stephan Renatus <srenatus@chef.io>
2020-03-27 19:59:50 +01:00
Mark Thom
7de39611f3 Merge pull request #305 from srenatus/sr/typo
examples/least_time.pl: fix typo
2020-03-27 14:35:17 -03:00
Stephan Renatus
7e6be23287 examples/least_time.pl: fix typo
Signed-off-by: Stephan Renatus <srenatus@chef.io>
2020-03-27 18:29:17 +01:00
Mark Thom
cac76d4739 Merge branch 'master' into develop 2020-03-26 22:01:25 -06:00
Mark Thom
194e5dc94e initial commit for merge 2020-03-26 22:01:23 -06:00
Mark Thom
f7629362d7 Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-03-19 20:42:37 -06:00
Mark Thom
ea0c396114 add least_time example 2020-03-19 20:42:11 -06:00
Mark Thom
057e2d8056 provide contextual information in the return value of try_in_situ_result 2020-03-19 20:41:58 -06:00
Mark Thom
487fe21e25 #278 2020-03-19 17:49:17 -06:00
Mark Thom
54dce9b60e Merge pull request #294 from triska/format
ENHANCED: format_//2 now supports ~a, ~d, ~Nd, ~D, ~ND, ~Nn, ~i and ~*
2020-03-19 20:00:40 -03:00
Markus Triska
f09a3142a6 ENHANCED: format_//2 now supports ~a, ~d, ~Nd, ~D, ~ND, ~Nn, ~i and ~* 2020-03-19 21:51:53 +01:00
Mark Thom
121c8d8a48 Merge pull request #293 from triska/documentation
update toplevel interaction
2020-03-17 13:55:05 -03:00
Markus Triska
b9561ec8db update toplevel interaction 2020-03-17 17:42:57 +01:00
Mark Thom
b1d8eff019 remove Addr::PStrTail (#276) 2020-03-17 02:03:29 -06:00
Mark Thom
f9c4a40d60 add set_input/1, set_output/1 2020-03-15 23:29:21 -06:00
Mark Thom
8e318f76a7 correct contextual quoting of chars 2020-03-15 21:15:42 -06:00
Mark Thom
7d21ea93a6 Merge pull request #289 from triska/documentation
include a short overview of notable libraries
2020-03-15 12:09:44 -03:00
Mark Thom
8630ba4a2d Merge pull request #291 from triska/toplevel
Two small toplevel features
2020-03-15 12:09:25 -03:00
Markus Triska
17a448e045 support 'h' to print help message during toplevel interaction 2020-03-15 13:42:51 +01:00
Markus Triska
7ff11dce35 support 'p' to reprint answer with max depth, allowing w -> p -> w ... 2020-03-15 13:26:49 +01:00
Markus Triska
e2a4854bcf include a short overview of notable libraries 2020-03-15 11:43:32 +01:00
Mark Thom
bef96e231d use max_depth at toplevel, allowing full printing of terms with the 'w' keypress (#287), put disjunctions on new lines (#278) 2020-03-15 00:35:59 -06:00
Mark Thom
325df8a6e3 add provisional max_depth option to write_term, speed printing of non-cyclic terms 2020-03-15 00:09:20 -06:00
Mark Thom
3620f72b6c output strings more efficiently 2020-03-14 18:17:11 -06:00
Mark Thom
42a90b2d40 don't emit overwriting warnings for term_expansion/2 or goal_expansion/2 2020-03-14 14:18:01 -06:00
Mark Thom
97aab6950c correct DCG descriptions of lists (#286) 2020-03-14 14:14:26 -06:00
Mark Thom
31258247b3 Give new answer variables readable names (#279) 2020-03-14 03:04:11 -06:00
Mark Thom
beed4e8aa8 print strings as strings only in the term expander 2020-03-13 21:05:25 -06:00
Mark Thom
c60a0bc062 print strings as strings (#285) 2020-03-13 18:24:13 -06:00
Mark Thom
733c2d4152 eliminate inner_numbervar_count 2020-03-13 17:12:35 -06:00
Mark Thom
79b5857f72 Merge pull request #284 from triska/master
ADDED: library(format), describing strings with format_//2
2020-03-13 17:06:27 -03:00
Mark Thom
7260eba26a allow module export of nonterminals (#281) 2020-03-13 15:40:03 -06:00
Mark Thom
7e7a1b2caf properly handle '\n' when quoted and not (#283, #280) 2020-03-13 15:32:56 -06:00
Mark Thom
99181e3302 fix -names (#275) 2020-03-13 13:49:12 -06:00
Mark Thom
d57d2b96d6 Revert "fix $VAR-names (#275) and properly print single control chars (#280)"
This reverts commit d3eb31e4c3.
2020-03-13 13:47:58 -06:00
Markus Triska
24bed8c548 ADDED: library(format), describing strings with format_//2
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,
        which must be atomic (a current limitation)
  ~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
  ~s    use the next argument here, which must be a string
  ~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 tabstops
  ~`Ct  like ~t, use character C instead of spaces to fill the space
  ~n    newline
  ~~    the literal ~

The predicate format/2 is like format_//2, except that it outputs
the text on the terminal instead of describing it declaratively.

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 = [h,e,l,l,o,'\n','.','.','.','.','.','.',t,h,e,r,e,!] ;
%@ false.
2020-03-13 20:46:53 +01:00
Mark Thom
6c9e704aa8 sort variables in findall_with_existential before computing set difference (#282), trawl back changes of (#279) 2020-03-13 13:18:47 -06:00
Mark Thom
d3eb31e4c3 fix $VAR-names (#275) and properly print single control chars (#280) 2020-03-13 02:48:40 -06:00
Mark Thom
698b01f85a give new answer variables readable names (#279) 2020-03-13 02:40:06 -06:00
Mark Thom
4c88e97330 add current_output, printing of stream terms 2020-03-11 00:38:01 -06:00
Mark Thom
25babff827 add streams.rs, consume them in place of the old PrologStream 2020-03-09 11:56:16 -06:00
Mark Thom
23e833c69e update README.md 2020-03-08 18:02:06 -06:00
Mark Thom
22bb3fe876 replace termion with crossterm 2020-03-08 18:01:54 -06:00
Mark Thom
eee10d3ee7 fix broken conformity tests, quote left paren 2020-03-08 16:49:47 -06:00
Mark Thom
c7591045af represent the current_dir as an absolute path, not a relative one. (#262) 2020-03-07 16:00:10 -07:00
Mark Thom
6ddfef6383 count single character atoms as characters when generating first argument indices 2020-03-06 21:19:53 -07:00
Mark Thom
9852e30b39 compare characters directly in term comparison tests 2020-03-05 12:50:11 -07:00
Mark Thom
2d3ce32314 switch to representation error for partial strings (#267) 2020-03-01 23:21:35 -07:00
Mark Thom
d8e0bea110 correct handling of strings and partial strings as lists, print bar operator with surrounding spaces (#274) 2020-03-01 00:00:40 -07:00
Mark Thom
b2cf6a6ea8 update README 2020-02-29 15:23:48 -07:00
Mark Thom
2ebcd673c8 add s pointers for strings and partial strings, put_unsafe_value calls store earlier to avoid unnecessary heap writes (#273) 2020-02-28 23:42:40 -07:00
Mark Thom
aa5f186a96 allow set_prolog_flag in declarations 2020-02-28 21:42:22 -07:00
Mark Thom
934f73f696 remove cyclic_term/1 2020-02-27 16:19:48 -07:00
Mark Thom
993c6f0e7b actually do lco, and mark unsafe variables before the goals where they last occur, not just in the last goal 2020-02-27 16:17:20 -07:00
Mark Thom
1d79e22468 mention rustup.rs in README (#261) 2020-02-23 13:22:56 -07:00
Mark Thom
8ba92d8b99 update prolog_parser version, allow ('|') operator in DCGs (#274) 2020-02-23 13:16:14 -07:00
Mark Thom
af23258152 remove setof/3, bagof/3 non-determinism (#270) 2020-02-22 15:13:01 -07:00
Mark Thom
b2e50b42a3 rename non_iso.pl to iso_ext.pl (#265) 2020-02-22 00:58:37 -07:00
Mark Thom
003b4d0218 add comparisons between partial strings and string constants (#263) 2020-02-22 00:51:27 -07:00
Mark Thom
545472f9c4 correct misreported error in toplevel loop (#272) 2020-02-21 21:09:59 -07:00
Mark Thom
8f781c27f9 remove same_length/2 from clpb.pl 2020-02-21 17:21:15 -07:00
Mark Thom
589dc34b99 make partial strings accept characters (#268) 2020-02-21 13:08:03 -07:00
Mark Thom
564622e38b partial_string/3 should accept empty lists (#264) 2020-02-21 12:55:33 -07:00
Mark Thom
d3744d6f66 identify ground partial strings under (==) (#269) 2020-02-21 12:51:23 -07:00
Mark Thom
2613ef0633 adopt compatibility predicates from clpb and clpz into lists and pairs libraries 2020-02-21 12:48:15 -07:00
Mark Thom
be3cdcd71a fix #255 (I think?) 2020-02-21 01:02:52 -07:00
Mark Thom
d48ac09e25 correct PStrLocation offset bug in copier.rs 2020-02-20 10:59:42 -07:00
Mark Thom
e5a0ba7bf3 revert to older between.pl 2020-02-20 10:07:45 -07:00
Mark Thom
eb1980d286 Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-02-19 21:44:18 -07:00
Mark Thom
424af312e5 update Cargo.lock and toml version 2020-02-19 21:42:39 -07:00
Mark Thom
a2a4c78c9a update README 2020-02-19 21:38:19 -07:00
Mark Thom
0457b38e41 add redone partial strings (#24, #95) 2020-02-19 21:34:09 -07:00
Mark Thom
617f803355 update between/3 to allow inf as upper bound 2020-02-19 15:55:56 -07:00
Mark Thom
d3da2683cb stop applying (=..)/2 to variables in tabling/trie.pl 2020-02-19 14:43:06 -07:00
Mark Thom
d97c670fcd Merge pull request #258 from aarroyoc/master
add n as an option to get the next solution
2020-02-19 12:10:48 -04:00
Mark Thom
8902bcb5ab use raw_block.rs for the heap backend 2020-02-16 16:30:36 -07:00
Mark Thom
5f51e264f2 change raw_vec to raw_block to avoid clashes with liballoc package 2020-02-13 20:05:46 -07:00
Mark Thom
1c4e2c0ed6 allow the frontier of the RawVec to be offset by a trait function 2020-02-12 23:52:30 -07:00
Mark Thom
5a6333129b move bump allocation logic to its own module 2020-02-12 23:34:05 -07:00
Mark Thom
969bd8f82c remove partial strings, but represent strings as lists when warranted by double_quotes 2020-02-12 22:12:42 -07:00
Adrián Arroyo Calle
a732bc9dc4 add n as an option to get the next solution 2020-02-10 17:51:26 +01:00
Mark Thom
1b5cf493d6 correct improper use of multifile directive in tabling/wrapper.pl 2020-02-06 10:12:57 -07:00
Mark Thom
0be8abd38c print extended characters recently added to alpha char set 2020-02-04 23:39:49 -07:00
Mark Thom
b71e8082d2 prolog_parser version bump 2020-02-04 23:35:03 -07:00
Mark Thom
034af296ff recommit Cargo.lock 2020-02-04 17:49:20 -07:00
Mark Thom
554b08a7d2 version bump, README.md tweak 2020-02-04 17:47:57 -07:00
Mark Thom
00b38549f5 enable cross-query memoization in the tabling library 2020-02-02 22:52:17 -07:00
Mark Thom
62b41ddb93 remove tabling/SLG resolution from nice-to-have list 2020-02-02 22:34:54 -07:00
Mark Thom
d83c5cf5f1 add tabling library, update README, make Cargo.toml non-local 2020-02-02 22:24:48 -07:00
Mark Thom
740bd528c4 add multifile and module scoped predicates 2020-02-02 22:13:14 -07:00
Mark Thom
668c9489c9 update README 2020-01-26 20:19:44 -07:00
Mark Thom
dcf2eadcf2 add preliminary multifile declaration support 2020-01-26 20:17:52 -07:00
Mark Thom
9c1064c1a3 use atom_concat in gensym.pl 2020-01-22 22:08:42 -07:00
Mark Thom
40bf5bc75f don't hold on to popped or frames 2020-01-20 20:59:30 -07:00
Mark Thom
6be2d8ccf2 correct bug in bb_b_put, correct stack truncation bug resulting in erroneous failures (affecting issue #255 and the in-progress tabling library) 2020-01-19 20:56:11 -07:00
Mark Thom
9958ad6f34 add prefixes to gensym keys 2020-01-13 21:01:09 -07:00
Mark Thom
728be8c259 add simple gensym library 2020-01-13 20:30:58 -07:00
Mark Thom
9a80d398e8 add listing sources to modules 2020-01-13 20:17:22 -07:00
Mark Thom
242c47bb92 Merge branch 'master' of https://github.com/mthom/rusty-wam 2020-01-03 00:47:56 -07:00
Mark Thom
85e37a9977 implement less defaulty interface in cont.pl 2019-12-23 12:19:18 -07:00
Mark Thom
dded56af78 remove l* languages 2019-12-23 11:49:20 -07:00
Mark Thom
3bf1cbbe6c push of preliminary delimited continuations library cont.pl (#136) 2019-12-20 22:27:49 -07:00
Mark Thom
4ef8ab6e76 merge with master 2019-12-19 20:04:30 -04:00
Mark Thom
837ae4cb17 preliminary cont work 2019-12-19 20:02:10 -04:00
Mark Thom
a4e352ba0d use Addr::StackCell(0,0) to indicate non-live local variables 2019-12-12 20:34:50 -07:00
Mark Thom
02d8b1441d expand goals inside (\+)/1 2019-12-11 21:42:15 -07:00
Mark Thom
196784bd09 change goal and term expansions, change call/N to use goal expansions 2019-12-10 21:36:02 -07:00
Mark Thom
b0fa45cd33 correct odd accidental change to clpb.pl 2019-12-08 11:44:01 -07:00
Mark Thom
923c9d4ad8 remove zeroing out from Stack::truncate 2019-12-08 11:43:22 -07:00
Mark Thom
2be7070e1a revert arithmetic code 2019-12-08 00:17:55 -07:00
Mark Thom
f16c2a6e99 update tests 2019-12-07 19:21:09 -07:00
Mark Thom
d6e75110a5 reconcile latest changes against stack changes 2019-12-07 18:59:03 -07:00
Mark Thom
3d2c4f0801 add backtracking of attributed variable data 2019-12-06 20:52:40 -04:00
Mark Thom
5ccd334555 resolve panic caused by lingering attribute goals (#253) 2019-12-06 15:22:28 -04:00
Mark Thom
90e1c990e5 print equations between variables (#228, #252) 2019-12-06 10:30:16 -04:00
Mark Thom
018b076835 binding attributed variables more eagerly after each implementation of verify_attributes/3 has been called (#248) 2019-12-05 00:33:46 -07:00
Mark Thom
9ae029b04d pop AND stack frames after unwinding the trail (#250) 2019-12-03 23:11:57 -07:00
Mark Thom
43b39538ff correct attributed variables bugs 2019-12-03 22:59:51 -07:00
Mark Thom
738ea59e23 fix copy_term/3 infinite looping on cyclic terms 2019-12-03 22:01:38 -07:00
Mark Thom
33c60d3434 Merge branch 'master' of https://github.com/mthom/rusty-wam 2019-12-02 19:38:15 -07:00
Mark Thom
607673ddcb Merge branch 'master' of https://github.com/mthom/scryer-prolog 2019-12-02 17:06:28 -04:00
Mark Thom
fc8e55c582 correct copying of cyclic lists in copier.rs 2019-12-02 17:06:12 -04:00
Mark Thom
943e5eeb35 correct misprinting of attributed variables done by printer 2019-12-01 21:46:04 -07:00
Mark Thom
52488b875a add predicates to lists.pl 2019-12-01 19:30:40 -07:00
Mark Thom
c362cc6d34 fix list copying 2019-12-01 15:28:47 -07:00
Mark Thom
406d3520f1 delete freeze attribute in freeze::attribute_goals//1 2019-12-01 14:43:27 -07:00
Mark Thom
9b71866b54 properly copy attributed variables (#247)" 2019-12-01 14:42:59 -07:00
Mark Thom
e48f87fcf0 clear ball before setting it (#246) 2019-12-01 03:04:01 -07:00
Mark Thom
77e83a390c add sumlist/2 to lists.pl 2019-11-30 14:26:15 -07:00
Mark Thom
27b659c401 add sumlist/2 to lists.pl 2019-11-30 14:22:59 -07:00
Mark Thom
a4cacaeab2 compress the definition of freeze:attribute_goals//1 2019-11-30 14:12:33 -07:00
Mark Thom
0eb20a5d8e pop AND frames when safe to do so, suspend resizing of AND frames until a proper GC is implemented (#244) 2019-11-30 14:08:02 -07:00
Mark Thom
3e49db1a29 backtrack attributed variable bindings after failure (#242) 2019-11-29 13:47:22 -04:00
Mark Thom
2d719ab6b7 create a list of module-prefixed goals in copy_term/3 2019-11-29 10:59:20 -04:00
Mark Thom
34745f6242 clone attribute goals from copy_term/3, fetch attribute goals should be a move 2019-11-29 00:59:31 -07:00
Mark Thom
9c9c484ee4 add copy_term/3 (#232) 2019-11-29 00:44:23 -07:00
Mark Thom
335202b9d9 reset attributed variable state between toplevel queries (#242) 2019-11-28 19:08:08 -07:00
Mark Thom
f998d6a99f merge latest commit 2019-11-28 21:22:59 -04:00
Mark Thom
5723edd765 unsafe stack transition 2019-11-28 21:22:03 -04:00
Mark Thom
7eb0de7f52 preserve heap contents in between goal expansions (#240, #241) 2019-11-28 00:45:13 -07:00
Mark Thom
9ae901bd0d terms containing attributed variables are not ground (#239) 2019-11-27 14:13:18 -04:00
Mark Thom
1dec482e22 use in situ code directory from metacall if conventional lookup fails (#238) 2019-11-27 00:52:30 -07:00
Mark Thom
0a665b79f2 add (:)/{3..12} to enable metacalls on module-prefixed predicates 2019-11-26 20:51:59 -07:00
Mark Thom
c3c53017f9 add ambiguity check for period printing, remove extraneous space between last goal and period (#237) 2019-11-26 19:38:43 -07:00
Mark Thom
834c57466f add operator exports to module declarations, treat them separately from predicate exports (#230)" 2019-11-25 23:09:49 -07:00
Mark Thom
4e887e3a87 generate module-level expansion code along with rest of module code 2019-11-24 15:47:34 -07:00
Mark Thom
7bf6a230f3 record module-level term_expansion and goal_expansion as inner predicates (#228) 2019-11-24 12:50:53 -07:00
Mark Thom
24ffdc2724 correct bug, dead code in toplevel.pl 2019-11-22 20:38:03 -07:00
Mark Thom
6899f051ac Merge branch 'master' of https://github.com/mthom/rusty-wam 2019-11-21 18:05:09 -07:00
Mark Thom
d9d77b3022 Merge branch 'master' of https://github.com/mthom/scryer-prolog 2019-11-21 16:26:13 -04:00
Mark Thom
b31b23e41c add conditional bracketing to equations printed by toplevel 2019-11-21 16:26:00 -04:00
Mark Thom
16418a47a8 Merge branch 'master' of https://github.com/mthom/rusty-wam 2019-11-20 23:50:54 -07:00
Mark Thom
1139b3b4c1 small test updates 2019-11-20 23:50:51 -07:00
Mark Thom
3277ecd13d Merge pull request #226 from malbarbo/num
Add feature num to use num crate in place of rug.
2019-11-20 23:51:55 -04:00
Marco A L Barbosa
37ff4a821c Add feature num to use num crate in place of rug. 2019-11-20 17:51:08 -03:00
Mark Thom
f82c6f3fed avoid overwriting IndexPtr's for clauses already declared dynamic (#227) 2019-11-20 10:50:33 -04:00
Mark Thom
d3842bb070 Merge pull request #234 from XVilka/patch-2
Fix README formatting
2019-11-19 20:14:00 -04:00
Mark Thom
2ab745016a Merge branch 'master' of https://github.com/mthom/rusty-wam 2019-11-19 20:09:44 -07:00
Mark Thom
5aaba8534f bump prolog_parser to version 0.8.35 2019-11-19 20:09:28 -07:00
Mark Thom
2b625b1094 commit Cargo.lock 2019-11-19 20:08:52 -07:00
Mark Thom
17f9695ab2 remove tests.rs module from main.rs 2019-11-19 10:13:59 -04:00
Anton Kochkov
c0a49b6a66 Fix README formatting 2019-11-19 18:48:46 +08:00
Mark Thom
66bebff01e add setup_call_cleanup tests, expand builtins tests 2019-11-18 23:17:56 -07:00
Mark Thom
6f9477f0bb rollback changes in snapshot handling 2019-11-17 21:07:16 -04:00
Mark Thom
de88fdc4dc correct failure to observe last call position in queries' 2019-11-17 20:18:11 -04:00
Mark Thom
17b2510480 update version number 2019-11-16 19:18:41 -07:00
Mark Thom
bcfd7cbf8d begin migrating tests to pure prolog, correct bug in toplevel 2019-11-16 19:15:07 -07:00
Mark Thom
cee3dbc453 quote values and goals in equations, eliminate dead code, correct retract/1 2019-11-16 17:15:25 -07:00
Mark Thom
c219d9ad5f Merge branch 'master' of https://github.com/mthom/scryer-prolog 2019-11-16 19:53:29 -04:00
Mark Thom
15927d7054 transition to unsafe and/or stack 2019-11-16 19:51:53 -04:00
Mark Thom
ed985c3cfe move more of the toplevel from rust into prolog 2019-11-16 00:26:15 -07:00
Mark Thom
4ad62e4606 add warnings when initialization goals fail (#168) 2019-10-30 00:25:17 -06:00
Mark Thom
d34811aa36 handle asserts in modules a little better (#223, #224) 2019-10-30 00:14:36 -06:00
Mark Thom
b90d69a45b install asserted predicates into modules from initialization directives (#222) 2019-10-29 00:06:51 -06:00
Mark Thom
81f220a4d2 replace \n\r and \r\n by \n (#221) 2019-10-27 20:50:21 -06:00
Mark Thom
e594ade84d finish #214, add needed ambiguity checks if 0 is the final character 2019-10-27 19:23:35 -06:00
Mark Thom
0dcd9e5805 correct sign/1 (#216) 2019-10-27 14:18:32 -06:00
Mark Thom
67a00e4deb update to prolog_parser v0.8.34 with increased MAX_ARITY (#218) 2019-10-27 13:10:32 -06:00
Mark Thom
e656e7fbae add sign/1 (#216) and gcd/2 (#217) as evaluable functors, update the README 2019-10-27 13:05:05 -06:00
Mark Thom
0fdf0d8d06 correct #215 by fixing bug in ambiguity_check 2019-10-27 12:32:18 -06:00
Mark Thom
7cdbd2f16c add consult/1 and shorthand for consult/1 (#214) 2019-10-27 11:33:49 -06:00
Mark Thom
ccfcc654a5 remove module from toplevel in unqualified use_module 2019-10-26 12:39:42 -06:00
Mark Thom
2eea0528b1 remove all mention of [clear] from the README 2019-10-26 01:35:26 -06:00
Mark Thom
a358431d30 reload files properly (re: #213) 2019-10-26 01:34:41 -06:00
Mark Thom
e9c1556c32 remove scratch comments from clpb.pl 2019-10-22 21:19:01 -06:00
Mark Thom
1b1879a6fa fix attributed variables bug causing weighted_maximum/3 example to omit a variable binding 2019-10-20 14:50:46 -06:00
131 changed files with 37277 additions and 23512 deletions

6
.dockerignore Executable file
View File

@@ -0,0 +1,6 @@
target
Dockerfile
README.md
.git
.gitignore
.gitmodules

1
.gitignore vendored
View File

@@ -1,4 +1,3 @@
target/
Cargo.lock

View File

@@ -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

File diff suppressed because it is too large Load Diff

View File

@@ -1,28 +1,43 @@
[package]
name = "scryer-prolog"
version = "0.8.114"
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
View 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
View File

@@ -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&nbsp;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&nbsp;input and consults the entered Prolog&nbsp;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
&nbsp;`.` to abort the search and return to the toplevel&nbsp;prompt.
Press&nbsp;`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&nbsp;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&nbsp;encoding. A naive representation of strings as lists of
characters would use one memory&nbsp;cell per character, one
memory&nbsp;cell per list constructor, and one memory&nbsp;cell for
each tail that occurs in the list. Since one memory&nbsp;cell takes
8&nbsp;bytes on 64-bit machines, the packed representation used by
Scryer&nbsp;Prolog yields an up&nbsp;to **24-fold&nbsp;reduction** of
memory usage, and corresponding reduction of memory&nbsp;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&nbsp;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&nbsp;list with tail&nbsp;`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&nbsp;=&nbsp;[a,b,c|Ls]</tt> yields
the exact same internal representation, and has the advantage that
only the standard predicate&nbsp;`(=)/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&nbsp;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&nbsp;execution and
SLG&nbsp;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&nbsp;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&nbsp;et.&nbsp;al.
### Constraint Logic Programming (CLP)
Scryer Prolog provides excellent support for Constraint Logic
Programming&nbsp;(CLP), which is the amalgamation of
Logic&nbsp;Programming&nbsp;(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&nbsp;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&nbsp;solvers.
These features make Scryer Prolog an ideal platform for teaching,
learning and developing portable CLP&nbsp;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&nbsp;Prolog are also called
*library*&nbsp;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&nbsp;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&nbsp;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&nbsp;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&nbsp;resolution).
* [`format`](src/prolog/lib/format.pl)
The nonterminal `format_//2` is used to describe formatted output,
arranging arguments according to a given format&nbsp;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&nbsp;trees which ensure
*O*(log(*N*))&nbsp;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&nbsp;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&nbsp;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&nbsp;DCG to
file&nbsp;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.

View File

@@ -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();
}

View File

@@ -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)
};
}
}

View File

@@ -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
}

View File

@@ -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 }
}
}

View File

@@ -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), <>),
};

File diff suppressed because it is too large Load Diff

View File

@@ -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;
}
}

View File

@@ -1,7 +0,0 @@
mod l0_parser;
pub mod ast;
pub mod iterators;
pub mod parser;
pub mod codegen;
pub mod machine;

View File

@@ -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
}

View File

@@ -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()
}
}
}

View File

@@ -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
}

View File

@@ -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)
}
}

View File

@@ -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)), <>)
};

File diff suppressed because it is too large Load Diff

View File

@@ -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];
}
}

View File

@@ -1,5 +0,0 @@
pub mod ast;
pub mod iterators;
pub mod l1_parser;
pub mod codegen;
pub mod machine;

View File

@@ -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()
}
}
}

View File

@@ -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
}
}

View File

@@ -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
}
}

View File

@@ -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)
}
}

View File

@@ -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(),
};

File diff suppressed because it is too large Load Diff

View File

@@ -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];
}
}

View File

@@ -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;

View File

@@ -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)
}
}

View File

@@ -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)
}
}

View File

@@ -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
}
}
}

View File

@@ -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
}
}

View File

@@ -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
}
}

View File

@@ -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"),
_ => {}
};
}

View File

@@ -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)
}
}

View File

@@ -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(),
};

File diff suppressed because it is too large Load Diff

View File

@@ -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];
}
}

View File

@@ -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;

View File

@@ -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)
}
}

View File

@@ -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();
}

View File

@@ -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);

View File

@@ -8,7 +8,7 @@ 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,
@@ -31,7 +31,7 @@ impl CompareNumberQT {
}
}
#[derive(Clone, Copy, PartialEq, Eq)]
#[derive(Debug, Clone, Copy, PartialEq, Eq)]
pub enum CompareTermQT {
LessThan,
LessThanOrEqual,
@@ -50,7 +50,7 @@ impl CompareTermQT {
}
}
#[derive(Clone, PartialEq, Eq)]
#[derive(Debug, Clone, PartialEq, Eq)]
pub enum ArithmeticTerm {
Reg(RegType),
Interm(usize),
@@ -67,7 +67,7 @@ impl ArithmeticTerm {
}
}
#[derive(Clone, Eq, PartialEq)]
#[derive(Debug, Clone, Eq, PartialEq)]
pub enum InlinedClauseType {
CompareNumber(CompareNumberQT, ArithmeticTerm, ArithmeticTerm),
IsAtom(RegType),
@@ -75,10 +75,8 @@ pub enum InlinedClauseType {
IsCompound(RegType),
IsInteger(RegType),
IsRational(RegType),
IsString(RegType),
IsFloat(RegType),
IsNonVar(RegType),
IsPartialString(RegType),
IsVar(RegType),
}
@@ -106,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));
@@ -119,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));
@@ -127,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));
@@ -144,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,
@@ -186,9 +195,11 @@ pub enum SystemClauseType {
GetAttrVarQueueBeyond,
GetBValue,
GetClause,
GetContinuationChunk,
GetModuleClause,
GetNextDBRef,
GetNextOpDBRef,
IsPartialString,
LookupDBRef,
LookupOpDBRef,
Halt,
@@ -200,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,
@@ -229,22 +260,43 @@ pub enum SystemClauseType {
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 {
@@ -254,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"),
@@ -293,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")
}
@@ -305,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")
@@ -320,24 +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")
@@ -351,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)
}
@@ -427,6 +586,8 @@ impl SystemClauseType {
("$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),
@@ -434,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),
@@ -446,53 +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,
@@ -501,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,
@@ -524,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"),
@@ -533,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"),
}
@@ -545,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,
@@ -554,7 +735,6 @@ impl BuiltInClauseType {
&BuiltInClauseType::KeySort => 2,
&BuiltInClauseType::NotEq => 2,
&BuiltInClauseType::Nl => 0,
&BuiltInClauseType::PartialString => 1,
&BuiltInClauseType::Read => 1,
&BuiltInClauseType::Sort => 2,
}
@@ -576,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(),

View File

@@ -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(&reg) {
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(&reg) {
*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();

View File

@@ -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);

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -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 = [],

View 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)
).

View 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).

View File

@@ -31,6 +31,7 @@
:- use_module(library(dcgs)).
:- use_module(library(dif)).
:- use_module(library(format)).
:- use_module(library(lists)).
pl_resolution(Clauses0, Chain) :-

View 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).

View File

@@ -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(&reg) {
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);
}
}
_ => {}

View File

@@ -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())),
}
}
}

View File

@@ -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

View File

@@ -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);

View File

@@ -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)])
}
}
}

View File

@@ -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>);

View 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).

View File

@@ -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.

View File

@@ -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). */
@@ -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).

View File

@@ -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.

View File

@@ -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
View 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).

View File

@@ -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(error), []).
:- use_module(library(error), [domain_error/3, type_error/3]).
:- attribute
clpb/1,
@@ -98,75 +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) :-
foldl(sum_, Ls, 0, S).
sum_(L, S0, S) :- S is S0 + L.
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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].
@@ -730,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),
@@ -1244,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

File diff suppressed because it is too large Load Diff

30
src/prolog/lib/cont.pl Normal file
View 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
View 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)).

View File

@@ -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).

View File

@@ -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(_)) }.

View File

@@ -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,10 +36,10 @@ 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, _))
; throw(error(uninstantiation_error, must_be/2))
).
must_be_(integer, Term) :- check_(integer, integer, Term).
must_be_(atom, Term) :- check_(atom, atom, Term).
@@ -43,12 +47,12 @@ 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).
@@ -76,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).
@@ -92,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
View 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
).

View File

@@ -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
View 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).

View File

@@ -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, maybe/0,
set_random/1, 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,23 +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).
% succeeds with probability 0.5.
maybe :- '$maybe'.
set_random(Seed) :-
( nonvar(Seed) ->
( Seed = seed(S) ->
( var(S) -> throw(error(instantiation_error, set_random/1))
; integer(S) -> '$set_seed'(S)
; throw(error(type_error(integer(S), set_random/1)))
)
)
; throw(error(instantiation_error, set_random/1))
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))
).

View File

@@ -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
View 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
View 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
View 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
View 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
View 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, [])).

View 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)).

View 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)
).

View 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).

View 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)).

View 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).

View 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).

View 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
View 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.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

View File

@@ -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)
}
}

File diff suppressed because it is too large Load Diff

View File

@@ -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,13 +18,6 @@ gather_modules([Attr|Attrs], [Module|Modules]) :-
'$module_of'(Module, Attr), % write the owning module of Attr to Module.
gather_modules(Attrs, Modules).
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),
Goals = []),
verify_attrs(Modules, Var, Value, ListOfGoalLists).
verify_attrs([], _, _, []).
call_verify_attributes(Attrs, _, _, []) :-
var(Attrs), !.
call_verify_attributes([], _, _, []).
@@ -31,6 +26,13 @@ call_verify_attributes([Attr|Attrs], Var, Value, ListOfGoalLists) :-
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),
Goals = []),
verify_attrs(Modules, Var, Value, ListOfGoalLists).
verify_attrs([], _, _, []).
call_goals([ListOfGoalLists | ListsCubed]) :-
call_goals_0(ListOfGoalLists),
call_goals(ListsCubed).

View File

@@ -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,6 +11,7 @@ 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>,
@@ -20,7 +23,8 @@ pub(super) struct AttrVarInitializer {
}
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![],
@@ -33,24 +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() + 1;
}
self.p = CodePtr::VerifyAttrInterrupt(self.attr_var_init.verify_attrs_loc);
}
@@ -62,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)
}
@@ -86,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))) {
@@ -95,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();
@@ -157,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
}
}

View File

@@ -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))
}

View 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