385 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
74 changed files with 12536 additions and 2145 deletions

6
.dockerignore Executable file
View File

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

View File

@@ -1,14 +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
- cargo test --verbose --all --no-default-features --features num
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"

1029
Cargo.lock generated

File diff suppressed because it is too large Load Diff

View File

@@ -1,12 +1,15 @@
[package]
name = "scryer-prolog"
version = "0.8.118"
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"
@@ -16,17 +19,25 @@ 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.1" }
num-rug-adapter = { optional = true, version = "0.1.3" }
ordered-float = "0.5.0"
prolog_parser = { version = "0.8.49", default-features = false }
prolog_parser = { version = "0.8.59", default-features = false }
ref_thread_local = "0.0.0"
rug = { version = "1.4.0", optional = true }
rustyline = "6.0.0"
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"]

206
README.md
View File

@@ -40,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`,
@@ -55,7 +55,10 @@ Extend Scryer Prolog to include the following, among other features:
- [x] A _redone_ representation of strings as difference lists of
characters, using a packed internal representation.
- [x] clp(B) and clp() as builtin libraries.
- [ ] Streams and predicates for stream control (_in progress_).
- [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.
@@ -90,6 +93,8 @@ strings.
## 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. Scryer tends to use features from newer Rust
@@ -123,62 +128,85 @@ $> cargo run [--release]
The optional `--release` flag will perform various optimizations,
producing a faster executable.
### 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]).
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.
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:
```
?- hello(What).
What = declarative_world
; What = pure_world.
```
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`:
To quit scryer-prolog, type
```
?- halt.
```
@@ -190,8 +218,8 @@ arithmetic operators with the usual precedences,
```
?- write_canonical(-5 + 3 - (2 * 4) // 8), nl.
-(+(-5,3),//(*(2,4),8))
true.
-(+(-5,3),//(*(2,4),8))
true.
```
New operators can be defined using the `op` declaration.
@@ -244,6 +272,61 @@ 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
@@ -300,15 +383,41 @@ The modules that ship with Scryer&nbsp;Prolog are also called
* [`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 predicate `format/2` is provided for impure output.
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:
@@ -345,7 +454,6 @@ REPL:
```
?- [user].
(type Enter + Ctrl-D to terminate the stream when finished)
:- module(test, [local_member/2]).
:- use_module(library(lists)).

View File

@@ -1,7 +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;
@@ -12,7 +14,6 @@ extern crate prolog_parser;
#[macro_use]
extern crate ref_thread_local;
use git_version::git_version;
use nix::sys::signal;
mod prolog;
@@ -21,13 +22,12 @@ use crate::prolog::machine::*;
use crate::prolog::machine::streams::*;
use crate::prolog::read::*;
use std::env;
use std::sync::atomic::Ordering;
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);
}
}
@@ -35,11 +35,6 @@ fn main() {
let handler = signal::SigHandler::Handler(handle_sigint);
unsafe { signal::signal(signal::Signal::SIGINT, handler) }.unwrap();
if env::args().skip(1).any(|a| a == "-v" || a == "--version") {
println!("{:}", git_version!());
return;
}
let mut wam = Machine::new(readline::input_stream(), Stream::stdout());
wam.run_top_level();
}

View File

@@ -23,6 +23,7 @@ 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>>,
}
@@ -68,6 +69,7 @@ impl<'a> ArithInstructionIterator<'a> {
}
}
#[derive(Debug)]
pub enum ArithTermRef<'a> {
Constant(&'a Constant),
Op(ClauseName, usize), // name, arity.
@@ -109,6 +111,7 @@ impl<'a> Iterator for ArithInstructionIterator<'a> {
}
}
#[derive(Debug)]
pub struct ArithmeticEvaluator<'a> {
bindings: &'a AllocVarDict,
interm: Vec<ArithmeticTerm>,
@@ -471,7 +474,12 @@ impl Neg for Number {
fn neg(self) -> Self::Output {
match self {
Number::Fixnum(n) => Number::Fixnum(-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(Rc::new(-Rational::from(&*r))),
@@ -632,15 +640,33 @@ impl PartialEq for Number {
(&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(_), &Number::Float(OrderedFloat(_))) => false,
(&Number::Float(OrderedFloat(_)), &Number::Fixnum(_)) => false,
(&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(_), Number::Float(_)) => false,
(&Number::Float(_), &Number::Integer(_)) => false,
(&Number::Integer(_), &Number::Rational(_)) => false,
(&Number::Rational(_), &Number::Integer(_)) => false,
(&Number::Rational(_), Number::Float(_)) => false,
(&Number::Float(_), &Number::Rational(_)) => false,
(&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),
}
@@ -663,15 +689,33 @@ impl Ord for Number {
(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(_), &Number::Float(OrderedFloat(_))) => Ordering::Greater,
(&Number::Float(OrderedFloat(_)), &Number::Fixnum(_)) => Ordering::Less,
(&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),
}
@@ -683,9 +727,6 @@ impl<'a> TryFrom<(Addr, &'a Heap)> for Number {
fn try_from((addr, heap): (Addr, &'a Heap)) -> Result<Number, Self::Error> {
match addr {
Addr::CharCode(c) => {
Ok(Number::from(c as isize))
}
Addr::Fixnum(n) => {
Ok(Number::from(n))
}
@@ -716,9 +757,6 @@ impl<'a> TryFrom<&'a HeapCellValue> for Number {
match value {
HeapCellValue::Addr(addr) => {
match addr {
&Addr::CharCode(c) => {
Ok(Number::from(c as isize))
}
&Addr::Fixnum(n) => {
Ok(Number::from(n))
}
@@ -750,6 +788,13 @@ impl<'a> TryFrom<&'a HeapCellValue> for Number {
}
}
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 = Integer::from(power.abs_ref());

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),
@@ -145,7 +145,7 @@ impl InlinedClauseType {
}
}
#[derive(Copy, Clone, Eq, PartialEq)]
#[derive(Debug, Copy, Clone, Eq, PartialEq)]
pub enum SystemClauseType {
AbolishClause,
AbolishModuleClause,
@@ -158,14 +158,17 @@ pub enum SystemClauseType {
BindFromRegister,
CallContinuation,
CharCode,
CharType,
CharsToNumber,
ClearAttributeGoals,
CloneAttributeGoals,
CodesToNumber,
CopyTermWithoutAttrVars,
CheckCutPoint,
Close,
CopyToLiftedHeap,
CreatePartialString,
CurrentHostname,
CurrentInput,
CurrentOutput,
DeleteAttribute,
@@ -177,7 +180,13 @@ pub enum SystemClauseType {
ExpandTerm,
FetchGlobalVar,
FetchGlobalVarWithOffset,
FileToChars,
FirstStream,
FlushOutput,
GetByte,
GetChar,
GetCode,
GetSingleChar,
ResetAttrVarState,
TruncateIfNoLiftedHeapGrowthDiff,
TruncateIfNoLiftedHeapGrowth,
@@ -212,8 +221,17 @@ pub enum SystemClauseType {
NumberToChars,
NumberToCodes,
OpDeclaration,
Open,
NextStream,
PartialStringTail,
PeekByte,
PeekChar,
PeekCode,
PointsToContinuationResetMarker,
PutByte,
PutBytes,
PutChar,
PutCode,
REPL(REPLCodePtr),
ReadQueryTerm,
ReadTerm,
@@ -230,6 +248,8 @@ pub enum SystemClauseType {
SetOutput,
StoreGlobalVar,
StoreGlobalVarWithOffset,
StreamProperty,
SetStreamPosition,
InferenceLevel,
CleanUpBlock,
EraseBall,
@@ -240,8 +260,8 @@ pub enum SystemClauseType {
GetDoubleQuotes,
InstallNewBlock,
Maybe,
CpuNow,
QuotedToken,
RawInputReadChar,
ReadTermFromChars,
ResetBlock,
ReturnFromVerifyAttr,
@@ -250,7 +270,13 @@ pub enum SystemClauseType {
SetDoubleQuotes,
SetSeed,
SkipMaxList,
Sleep,
SocketClientOpen,
SocketServerOpen,
SocketServerAccept,
SocketServerClose,
Succeed,
TermAttributedVariables,
TermVariables,
TruncateLiftedHeapTo,
UnifyWithOccursCheck,
@@ -260,6 +286,17 @@ pub enum SystemClauseType {
WAMInstructions,
WriteTerm,
WriteTermToChars,
ScryerPrologVersion,
CryptoRandomByte,
CryptoDataHash,
CryptoDataHKDF,
CryptoPasswordHash,
CryptoDataEncrypt,
CryptoDataDecrypt,
Ed25519Sign,
Ed25519Verify,
Ed25519NewKeyPair,
Ed25519KeyPairPublicKey
}
impl SystemClauseType {
@@ -276,6 +313,7 @@ impl SystemClauseType {
&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::CheckCutPoint => clause_name!("$check_cp"),
&SystemClauseType::ClearAttributeGoals => clause_name!("$clear_attribute_goals"),
@@ -284,18 +322,20 @@ impl SystemClauseType {
&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::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::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::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"),
@@ -308,7 +348,13 @@ 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")
@@ -337,15 +383,20 @@ 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")
}
@@ -355,16 +406,28 @@ impl SystemClauseType {
&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::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::RawInputReadChar => clause_name!("$raw_input_read_char"),
&SystemClauseType::RedoAttrVarBinding => clause_name!("$redo_attr_var_binding"),
&SystemClauseType::RemoveCallPolicyCheck => clause_name!("$remove_call_policy_check"),
&SystemClauseType::RemoveInferenceCounter => clause_name!("$remove_inference_counter"),
@@ -373,6 +436,8 @@ impl SystemClauseType {
&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")
@@ -400,7 +465,13 @@ impl SystemClauseType {
&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"),
@@ -410,6 +481,17 @@ impl SystemClauseType {
&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")
}
}
@@ -428,6 +510,7 @@ impl SystemClauseType {
("$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),
@@ -437,8 +520,13 @@ impl SystemClauseType {
("$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),
@@ -449,15 +537,34 @@ impl SystemClauseType {
("$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)
@@ -479,6 +586,7 @@ 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),
@@ -487,6 +595,7 @@ impl SystemClauseType {
("$number_to_chars", 2) => Some(SystemClauseType::NumberToChars),
("$number_to_codes", 2) => Some(SystemClauseType::NumberToCodes),
("$op", 3) => Some(SystemClauseType::OpDeclaration),
("$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),
@@ -494,6 +603,8 @@ impl SystemClauseType {
("$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),
@@ -506,10 +617,9 @@ impl SystemClauseType {
("$get_cp", 1) => Some(SystemClauseType::GetCutPoint),
("$install_new_block", 1) => Some(SystemClauseType::InstallNewBlock),
("$quoted_token", 1) => Some(SystemClauseType::QuotedToken),
("$raw_input_read_char", 1) => Some(SystemClauseType::RawInputReadChar),
("$nextEP", 3) => Some(SystemClauseType::NextEP),
("$read_query_term", 2) => Some(SystemClauseType::ReadQueryTerm),
("$read_term", 2) => Some(SystemClauseType::ReadTerm),
("$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),
@@ -522,30 +632,47 @@ impl SystemClauseType {
("$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),
("$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),
("$wam_instructions", 3) => Some(SystemClauseType::WAMInstructions),
("$write_term", 6) => Some(SystemClauseType::WriteTerm),
("$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,
@@ -563,7 +690,7 @@ pub enum BuiltInClauseType {
Sort,
}
#[derive(Clone, PartialEq, Eq)]
#[derive(Debug, Clone, PartialEq, Eq)]
pub enum ClauseType {
BuiltIn(BuiltInClauseType),
CallN,

View File

@@ -17,12 +17,14 @@ use std::cell::Cell;
use std::rc::Rc;
use std::vec::Vec;
#[derive(Debug)]
pub struct CodeGenerator<TermMarker> {
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,
@@ -120,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)
}
}
}
@@ -341,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,
},
@@ -361,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));
}
@@ -403,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));
}
@@ -412,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));
}
@@ -424,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));
}
@@ -436,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));
}
@@ -448,6 +479,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker> {
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));
}
@@ -461,6 +493,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_integer!(r));
}
@@ -476,6 +509,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_var!(r));
}
@@ -490,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)
}
@@ -504,23 +538,17 @@ 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::Fixnum(_)) => {
@@ -530,11 +558,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::Float(_)) => {
code.push(Line::Query(put_constant!(
@@ -543,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!(
@@ -556,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));
})
}

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

View File

@@ -1,6 +1,8 @@
:- module(ruleml_xml_parser, [parse_ruleml/3]).
:- module(bimetatrans_ruleml, [parse_ruleml/3]).
:- use_module(library(dcgs)).
:- use_module(library(iso_ext)).
:- use_module(library(lists)).
:- set_prolog_flag(double_quotes, chars).
@@ -498,7 +500,7 @@ ruleml_plex(Plex) -->
list_ws("</Plex>")
; list_ws("<Plex/>")
)
; { \+ string(Plex),
; { ( \+ partial_string(Plex) ; Plex == [] ),
acyclic_term(Plex) },
( { functor(Plex, ('.'), 2) } ->
{ split_plex(Plex, PlexItems, RepoVar) },
@@ -582,13 +584,11 @@ ruleml_atom(Item) -->
list_ws("<Atom>"),
list_ws("<Rel>"),
prolog_symbol(Name),
{ Name \== (','), Name \== (';') },
list_ws("</Rel>"),
ruleml_items(Args),
list_ws("</Atom>"),
{ Item =.. [Name | Args] }
; { Item =.. [Name | Args] },
{ Name \== (','), Name \== (';') },
"<Atom>",
"<Rel>",
prolog_symbol(Name),
@@ -789,7 +789,7 @@ constant_chars(symbol, Constant, Chars) :-
/*
* ruleml_data//1 delegates to ruleml_data_contents//2 to determine
* the contents of <Data> nodes, with adjoining xsi:type elements.
* the contents of <Data> nodes, with adjoining iso:type elements.
*
* constant_chars/3 performs type-driven conversion between
* Prolog/'$V' and RuleML/XML in both directions;
@@ -799,13 +799,13 @@ constant_chars(symbol, Constant, Chars) :-
ruleml_data(Name) -->
( { var(Name) } ->
list_ws("<Data xsi:type=\""),
list_ws("<Data iso:type=\""),
prolog_symbol(Type),
list_ws("\">"),
ruleml_data_contents(Type, Cs),
{ constant_chars(Type, Name, Cs) },
list_ws("</Data>")
; "<Data xsi:type=\"",
; "<Data iso:type=\"",
{ constant_chars(Type, Name, Cs) },
prolog_symbol(Type),
"\">",

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

@@ -30,7 +30,7 @@ valid_time([H1,H2,M1,M2], T) :-
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]) ->
( maplist(=(true), [TH1, TH2, TM1, TM2]) ->
( H1 =:= 2 ->
( H2 =< 3 ->
T = true

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

@@ -13,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, _)
@@ -22,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),
@@ -36,6 +38,7 @@ impl VarData {
}
}
#[derive(Debug)]
pub struct TempVarData {
pub last_term_arity: usize,
pub use_set: OccurrenceSet,
@@ -79,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>>
@@ -248,6 +252,7 @@ impl<'a> VariableFixtures<'a> {
}
}
#[derive(Debug)]
pub struct UnsafeVarMarker {
pub unsafe_vars: IndexMap<RegType, usize>,
pub safe_vars: IndexSet<RegType>,

View File

@@ -12,7 +12,6 @@ use indexmap::IndexMap;
use std::cell::Cell;
use std::collections::VecDeque;
use std::convert::TryFrom;
use std::path::PathBuf;
use std::rc::Rc;
@@ -22,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
@@ -42,7 +41,7 @@ impl TopLevel {
}
}
#[derive(Clone, Copy)]
#[derive(Debug, Clone, Copy)]
pub enum Level {
Deep,
Root,
@@ -58,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),
@@ -86,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 {
@@ -114,7 +113,7 @@ impl Predicate {
}
}
#[derive(Clone)]
#[derive(Debug, Clone)]
pub enum ListingSource {
File(ClauseName, PathBuf), // filename, path
User,
@@ -326,7 +325,7 @@ impl ClauseConsistency for Predicate {
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.
@@ -371,7 +370,7 @@ impl PredicateClause {
}
}
#[derive(Clone)]
#[derive(Debug, Clone)]
pub enum ModuleSource {
Library(ClauseName),
File(ClauseName),
@@ -392,13 +391,13 @@ impl ModuleSource {
pub type ScopedPredicateKey = (ClauseName, PredicateKey); // module name, predicate indicator.
#[derive(Clone)]
#[derive(Debug, Clone)]
pub enum MultiFileIndicator {
LocalScoped(ClauseName, usize), // name, arity
ModuleScoped(ScopedPredicateKey),
}
#[derive(Clone)]
#[derive(Debug, Clone)]
pub enum Declaration {
Dynamic(ClauseName, usize), // name, arity
EndOfFile,
@@ -433,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 {
@@ -558,18 +557,19 @@ pub fn fetch_op_spec(
pub type ModuleDir = IndexMap<ClauseName, Module>;
#[derive(Clone, PartialEq)]
#[derive(Debug, Clone, PartialEq)]
pub enum ModuleExport {
OpDecl(OpDecl),
PredicateKey(PredicateKey),
}
#[derive(Clone)]
#[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,
@@ -587,7 +587,7 @@ pub struct Module {
pub listing_src: ListingSource,
}
#[derive(Clone)]
#[derive(Debug, Clone)]
pub enum Number {
Float(OrderedFloat<f64>),
Integer(Rc<Integer>),
@@ -648,21 +648,6 @@ impl Into<HeapCellValue> for Number {
impl Number {
#[inline]
pub fn to_u32(&self) -> Option<u32> {
match self {
&Number::Fixnum(n) => u32::try_from(n).ok(),
&Number::Integer(ref n) => n.to_u32(),
&Number::Float(_) => None,
&Number::Rational(ref r) =>
if r.denom() == &1 {
r.numer().to_u32()
} else {
None
}
}
}
#[inline]
pub fn is_positive(&self) -> bool {
match self {

View File

@@ -7,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>,
@@ -47,6 +48,9 @@ impl<'a> HCPreOrderIterator<'a> {
HeapCellValue::Stream(_) => {
Addr::Stream(h)
}
&HeapCellValue::TcpListener(_) => {
Addr::TcpListener(h)
}
}
}
@@ -120,12 +124,14 @@ impl<'a> Iterator for HCPreOrderIterator<'a> {
}
}
pub trait MutStackHCIterator
where Self: Iterator<Item = Addr>
pub trait MutStackHCIterator<'b> where Self: Iterator
{
fn stack(&mut self) -> &mut Vec<Addr>;
type MutStack;
fn stack(&'b mut self) -> Self::MutStack;
}
#[derive(Debug)]
pub struct HCPostOrderIterator<'a> {
base_iter: HCPreOrderIterator<'a>,
parent_stack: Vec<(usize, Addr)>, // number of children, parent node.
@@ -220,12 +226,15 @@ 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
}
}
#[derive(Debug)]
pub struct HCAcyclicIterator<'a> {
iter: HCPreOrderIterator<'a>,
seen: IndexSet<Addr>,
@@ -248,6 +257,14 @@ impl<'a> Deref for HCAcyclicIterator<'a> {
}
}
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 = Addr;
@@ -266,6 +283,7 @@ impl<'a> Iterator for HCAcyclicIterator<'a>
}
}
#[derive(Debug)]
pub struct HCZippedAcyclicIterator<'a> {
i1: HCPreOrderIterator<'a>,
i2: HCPreOrderIterator<'a>,
@@ -273,6 +291,14 @@ pub struct HCZippedAcyclicIterator<'a> {
pub first_to_expire: Ordering,
}
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 {
@@ -293,6 +319,7 @@ impl<'a> Iterator for HCZippedAcyclicIterator<'a>
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;

View File

@@ -6,19 +6,21 @@ use crate::prolog::heap_iter::*;
use crate::prolog::machine::heap::*;
use crate::prolog::machine::machine_indices::*;
use crate::prolog::machine::machine_state::*;
use crate::prolog::machine::streams::*;
use crate::prolog::ordered_float::OrderedFloat;
use crate::prolog::rug::Integer;
use crate::prolog::rug::{Integer, Rational};
use indexmap::{IndexMap, IndexSet};
use std::cell::Cell;
use std::convert::TryFrom;
use std::iter::{FromIterator, once};
use std::net::{IpAddr, TcpListener};
use std::ops::{Range, RangeFrom};
use std::rc::Rc;
/* contains the location, name, precision and Specifier of the parent op. */
#[derive(Clone)]
#[derive(Debug, Clone)]
pub enum DirectedOp {
Left(ClauseName, SharedOpDesc),
Right(ClauseName, SharedOpDesc),
@@ -162,7 +164,7 @@ fn char_to_string(is_quoted: bool, c: char) -> String {
}
}
#[derive(Clone)]
#[derive(Debug, Clone)]
enum TokenOrRedirect {
Atom(ClauseName),
BarAsOp,
@@ -170,9 +172,12 @@ enum TokenOrRedirect {
NumberedVar(String),
CompositeRedirect(usize, DirectedOp),
FunctorRedirect(usize),
IpAddr(IpAddr),
Number(Number, Option<DirectedOp>),
Open,
Close,
Comma,
RawPtr(*const u8),
Space,
LeftCurly,
RightCurly,
@@ -197,6 +202,7 @@ pub trait HCValueOutputter {
fn range_from(&self, range: RangeFrom<usize>) -> &str;
}
#[derive(Debug)]
pub struct PrinterOutputter {
contents: String,
}
@@ -335,6 +341,7 @@ impl MachineState {
type ReverseHeapVarDict = IndexMap<Addr, Rc<Var>>;
#[derive(Debug)]
pub struct HCPrinter<'a, Outputter> {
outputter: Outputter,
machine_st: &'a MachineState,
@@ -442,6 +449,8 @@ fn non_quoted_token<Iter: Iterator<Item = char>>(mut iter: Iter) -> bool {
if let Some(c) = iter.next() {
if small_letter_char!(c) {
iter.all(|c| alpha_numeric_char!(c))
} else if c == '.' {
iter.next().is_some()
} else if graphic_token_char!(c) {
non_quoted_graphic_token(iter, c)
} else if semicolon_char!(c) {
@@ -449,9 +458,9 @@ fn non_quoted_token<Iter: Iterator<Item = char>>(mut iter: Iter) -> bool {
} else if cut_char!(c) {
iter.next().is_none()
} else if c == '[' {
(iter.next() == Some(']') && iter.next().is_none())
iter.next() == Some(']') && iter.next().is_none()
} else if c == '{' {
(iter.next() == Some('}') && iter.next().is_none())
iter.next() == Some('}') && iter.next().is_none()
} else if solo_char!(c) {
!(c == '(' || c == ')' || c == '}' || c == ']' || c == ',' || c == '%' || c == '|')
} else {
@@ -638,8 +647,8 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
}
self.state_stack.pop();
self.state_stack.push(TokenOrRedirect::Open);
self.state_stack.push(TokenOrRedirect::Open);
self.state_stack.push(TokenOrRedirect::Atom(name));
true
@@ -959,6 +968,18 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
});
}
#[inline]
fn print_ip_addr(&mut self, ip: IpAddr) {
self.push_char('\'');
self.append_str(&format!("{}", ip));
self.push_char('\'');
}
#[inline]
fn print_raw_ptr(&mut self, ptr: *const u8) {
self.append_str(&format!("0x{:x}", ptr as usize));
}
fn print_number(&mut self, n: Number, op: &Option<DirectedOp>) {
let add_brackets = if let Some(op) = op {
op.is_negative_sign() && n.is_positive()
@@ -985,6 +1006,10 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
});
}
}
Number::Rational(r) => {
self.print_rational(&r, add_brackets);
return;
}
n => {
let output_str = format!("{}", n);
@@ -999,6 +1024,71 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
}
}
fn print_rational(&mut self, r: &Rational, add_brackets: bool) {
match self.op_dir.get(&(clause_name!("rdiv"), Fixity::In)) {
Some(OpDirValue(ref spec, _)) => {
if add_brackets {
self.state_stack.push(TokenOrRedirect::Close);
}
let rdiv_ct = clause_name!("rdiv");
let left_directed_op =
if spec.prec() > 0 {
Some(DirectedOp::Left(rdiv_ct.clone(), spec.clone()))
} else {
None
};
let right_directed_op =
if spec.prec() > 0 {
Some(DirectedOp::Right(rdiv_ct.clone(), spec.clone()))
} else {
None
};
if spec.prec() > 0 {
self.state_stack.push(TokenOrRedirect::Number(
Number::from(r.denom()),
left_directed_op,
));
self.state_stack.push(TokenOrRedirect::Op(
rdiv_ct,
spec.clone(),
));
self.state_stack.push(TokenOrRedirect::Number(
Number::from(r.numer()),
right_directed_op,
));
} else {
self.state_stack.push(TokenOrRedirect::Close);
self.state_stack.push(TokenOrRedirect::Number(
Number::from(r.denom()),
None,
));
self.state_stack.push(TokenOrRedirect::Comma);
self.state_stack.push(TokenOrRedirect::Number(
Number::from(r.numer()),
None,
));
self.state_stack.push(TokenOrRedirect::Open);
self.state_stack.push(TokenOrRedirect::Atom(rdiv_ct));
}
return;
}
_ => {
unreachable!()
}
}
}
fn print_char(&mut self, is_quoted: bool, c: char)
{
if non_quoted_token(once(c)) {
@@ -1024,56 +1114,67 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
}
}
fn print_string(
fn print_proper_string(&mut self, buf: String, max_depth: usize) {
self.push_char('"');
let buf =
if max_depth == 0 {
String::from_iter(buf.chars().map(|c| {
char_to_string(self.quoted, c)
}))
} else {
let mut char_count = 0;
let mut buf =
String::from_iter(buf.chars().take(max_depth).map(|c| {
char_count += 1;
char_to_string(self.quoted, c)
}));
if char_count == max_depth {
buf += " ...";
}
buf
};
self.append_str(&buf);
self.push_char('"');
}
fn print_list_like(
&mut self,
iter: &mut HCPreOrderIterator,
addr: Addr,
mut max_depth: usize,
h: usize,
n: usize,
) {
iter.stack().pop();
iter.stack().pop();
if self.check_max_depth(&mut max_depth) {
iter.stack().pop();
iter.stack().pop();
self.state_stack.push(TokenOrRedirect::Atom(clause_name!("...")));
return;
}
let mut heap_pstr_iter =
self.machine_st.heap_pstr_iter(Addr::PStrLocation(h, n));
self.machine_st.heap_pstr_iter(addr);
let buf = heap_pstr_iter.to_string();
if buf.is_empty() {
self.push_list(iter, max_depth);
return;
}
iter.stack().pop();
iter.stack().pop();
let end_addr = heap_pstr_iter.focus();
let at_cdr = self.at_cdr(",");
if !at_cdr && Addr::EmptyList == end_addr {
if !self.machine_st.flags.double_quotes.is_codes() {
self.push_char('"');
let buf =
if max_depth == 0 {
String::from_iter(buf.chars().map(|c| {
char_to_string(self.quoted, c)
}))
} else {
let mut char_count = 0;
let mut buf =
String::from_iter(buf.chars().take(max_depth).map(|c| {
char_count += 1;
char_to_string(self.quoted, c)
}));
if char_count == max_depth {
buf += " ...";
}
buf
};
self.append_str(&buf);
self.push_char('"');
if self.machine_st.flags.double_quotes.is_chars() && !self.ignore_ops {
self.print_proper_string(buf, max_depth);
return;
}
}
@@ -1105,7 +1206,7 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
let mut char_count = 0;
for c in buf_iter {
self.push_char('.');
self.append_str("'.'");
self.push_char('(');
char_printer(self, c);
@@ -1245,6 +1346,66 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
}
}
fn print_tcp_listener(
&mut self,
iter: &mut HCPreOrderIterator,
tcp_listener: &TcpListener,
max_depth: usize,
) {
let (ip, port) =
if let Some(addr) = tcp_listener.local_addr().ok() {
(addr.ip(), Number::from(addr.port() as isize))
} else {
let disconnected_atom = clause_name!("$disconnected_tcp_listener");
self.state_stack.push(TokenOrRedirect::Atom(disconnected_atom));
return;
};
if self.format_struct(iter, max_depth, 1, clause_name!("$tcp_listener")) {
let atom = self.state_stack.pop().unwrap();
self.state_stack.pop();
self.state_stack.pop();
self.state_stack.push(TokenOrRedirect::Number(port, None));
self.state_stack.push(TokenOrRedirect::Comma);
self.state_stack.push(TokenOrRedirect::IpAddr(ip));
self.state_stack.push(TokenOrRedirect::Open);
self.state_stack.push(atom);
}
}
fn print_stream(
&mut self,
iter: &mut HCPreOrderIterator,
stream: &Stream,
max_depth: usize,
) {
if let Some(alias) = &stream.options.alias {
self.print_atom(alias);
} else {
if self.format_struct(iter, max_depth, 1, clause_name!("$stream")) {
let atom =
if stream.is_stdout() || stream.is_stdin() {
TokenOrRedirect::Atom(clause_name!("user"))
} else {
TokenOrRedirect::RawPtr(stream.as_ptr())
};
let stream_root = self.state_stack.pop().unwrap();
self.state_stack.pop();
self.state_stack.pop();
self.state_stack.push(atom);
self.state_stack.push(TokenOrRedirect::Open);
self.state_stack.push(stream_root);
}
}
}
fn handle_heap_term(
&mut self,
iter: &mut HCPreOrderIterator,
@@ -1308,9 +1469,6 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
});
}
}
&HeapCellValue::Addr(Addr::CharCode(c)) => {
self.append_str(&format!("{}", c as u32));
}
&HeapCellValue::Addr(Addr::Char(c)) => {
self.print_char(self.quoted, c);
}
@@ -1332,13 +1490,13 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
self.append_str(&format!("{}", u));
}
&HeapCellValue::Addr(Addr::PStrLocation(h, n)) => {
self.print_string(iter, max_depth, h, n);
self.print_list_like(iter, Addr::PStrLocation(h, n), max_depth);
}
&HeapCellValue::Addr(Addr::Lis(_)) => {
&HeapCellValue::Addr(Addr::Lis(l)) => {
if self.ignore_ops {
self.format_struct(iter, max_depth, 2, clause_name!("."));
} else {
self.push_list(iter, max_depth);
self.print_list_like(iter, Addr::Lis(l), max_depth);
}
}
&HeapCellValue::Addr(addr) => {
@@ -1355,15 +1513,10 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
self.print_number(Number::Rational(n.clone()), &op);
}
&HeapCellValue::Stream(ref stream) => {
if let Some(alias) = &stream.options.alias {
self.print_atom(alias);
} else {
if stream.is_stdout() || stream.is_stdin() {
self.print_atom(&clause_name!("user"));
} else {
self.format_struct(iter, max_depth, 1, clause_name!("$stream"));
}
}
self.print_stream(iter, stream, max_depth);
}
&HeapCellValue::TcpListener(ref tcp_listener) => {
self.print_tcp_listener(iter, tcp_listener, max_depth);
}
_ => {
unreachable!()
@@ -1401,6 +1554,8 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
self.handle_heap_term(&mut iter, None, true, max_depth)
}
TokenOrRedirect::Close => self.push_char(')'),
TokenOrRedirect::IpAddr(ip) => self.print_ip_addr(ip),
TokenOrRedirect::RawPtr(ptr) => self.print_raw_ptr(ptr),
TokenOrRedirect::Open => self.push_char('('),
TokenOrRedirect::OpenList(delimit) => {
if !self.at_cdr(",") {
@@ -1416,6 +1571,7 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
}
}
TokenOrRedirect::HeadTailSeparator => self.append_str("|"),
TokenOrRedirect::Number(n, op) => self.print_number(n, &op),
TokenOrRedirect::Comma => self.append_str(","),
TokenOrRedirect::Space => self.push_char(' '),
TokenOrRedirect::LeftCurly => self.push_char('{'),

View File

@@ -1,4 +1,5 @@
use prolog_parser::ast::*;
use prolog_parser::tabled_rc::*;
use crate::prolog::instructions::*;
use crate::prolog::rug::Integer;
@@ -6,17 +7,20 @@ 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 {
atom_tbl: TabledData<Atom>,
pub constants: IndexMap<Constant, ThirdLevelIndex>,
pub lists: ThirdLevelIndex,
pub structures: IndexMap<(ClauseName, usize), ThirdLevelIndex>,
@@ -25,6 +29,7 @@ pub struct CodeOffsets {
impl CodeOffsets {
pub fn new() -> Self {
CodeOffsets {
atom_tbl: TabledData::new(Rc::new("_index".to_string())),
constants: IndexMap::new(),
lists: Vec::new(),
structures: IndexMap::new(),
@@ -50,15 +55,39 @@ impl CodeOffsets {
}
}
fn intercept_constant(&mut self, constant: &Constant, index: usize) {
fn intercept_overlapping_constant(&mut self, constant: &Constant, index: usize) {
match constant {
&Constant::Atom(ref name, _) if name.is_char() => {
&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
@@ -66,6 +95,16 @@ impl CodeOffsets {
.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() {
@@ -75,11 +114,34 @@ impl CodeOffsets {
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));
}
}
_ => {
}
}
@@ -101,7 +163,7 @@ impl CodeOffsets {
self.lists.push(Self::add_index(is_initial_index, index));
}
&Term::Constant(_, ref constant) => {
self.intercept_constant(constant, index);
self.intercept_overlapping_constant(constant, index);
let code = self.constants
.entry(constant.clone())

View File

@@ -45,6 +45,7 @@ impl ArithmeticTerm {
}
}
#[derive(Debug)]
pub enum ChoiceInstruction {
DefaultRetryMeElse(usize),
DefaultTrustMe,
@@ -75,6 +76,7 @@ impl ChoiceInstruction {
}
}
#[derive(Debug)]
pub enum CutInstruction {
Cut(RegType),
GetLevel(RegType),
@@ -104,6 +106,7 @@ impl CutInstruction {
}
}
#[derive(Debug)]
pub enum IndexedChoiceInstruction {
Retry(usize),
Trust(usize),
@@ -140,6 +143,7 @@ impl IndexedChoiceInstruction {
}
}
#[derive(Debug)]
pub enum Line {
Arithmetic(ArithmeticInstruction),
Choice(ChoiceInstruction),
@@ -175,7 +179,7 @@ impl Line {
}
}
#[derive(Clone)]
#[derive(Debug, Clone)]
pub enum ArithmeticInstruction {
Add(ArithmeticTerm, ArithmeticTerm, usize),
Sub(ArithmeticTerm, ArithmeticTerm, usize),
@@ -374,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.
@@ -419,6 +424,7 @@ impl ControlInstruction {
}
}
#[derive(Debug)]
pub enum IndexingInstruction {
SwitchOnTerm(usize, usize, usize, usize),
SwitchOnConstant(usize, IndexMap<Constant, usize>),
@@ -459,7 +465,7 @@ impl IndexingInstruction {
}
}
#[derive(Clone)]
#[derive(Debug, Clone)]
pub enum FactInstruction {
GetConstant(Level, Constant, RegType),
GetList(Level, RegType),
@@ -571,7 +577,7 @@ impl FactInstruction {
}
}
#[derive(Clone)]
#[derive(Debug, Clone)]
pub enum QueryInstruction {
GetVariable(RegType, usize),
PutConstant(Level, Constant, RegType),

View File

@@ -6,11 +6,12 @@ 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),
@@ -33,6 +34,7 @@ impl<'a> TermRef<'a> {
}
}
#[derive(Debug)]
pub enum TermIterState<'a> {
AnonVar(Level),
Constant(Level, &'a Cell<RegType>, &'a Constant),
@@ -90,6 +92,10 @@ fn is_partial_string<'a>(
Term::Constant(_, Constant::EmptyList) => {
return Some((string, None));
}
Term::Constant(_, Constant::String(tail)) => {
string += &tail;
return Some((string, None));
}
_ => {
return None;
}
@@ -124,6 +130,7 @@ impl<'a> TermIterState<'a> {
}
}
#[derive(Debug)]
pub struct QueryIterator<'a> {
state_stack: Vec<TermIterState<'a>>,
}
@@ -294,6 +301,7 @@ impl<'a> Iterator for QueryIterator<'a> {
}
}
#[derive(Debug)]
pub struct FactIterator<'a> {
state_queue: VecDeque<TermIterState<'a>>,
iterable_root: bool,
@@ -402,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),
@@ -439,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

@@ -1,9 +1,10 @@
:- module(atts, [op(1199, fx, attribute), 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]).
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)).
@@ -56,7 +57,8 @@
'$del_attr'(Ls0, V, Attr) :-
Ls0 = [Att | Ls1],
nonvar(Att),
( Att \= Attr -> '$del_attr_buried'(Ls0, 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)
@@ -158,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

@@ -41,25 +41,35 @@ user:term_expansion((:- op(Pred, Spec, [Op | OtherOps])), OpResults) :-
:- 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, atom_chars/2,
atom_codes/2, atom_concat/3, atom_length/2,
bagof/3, catch/3, char_code/2, clause/2,
current_input/1, current_output/1, current_op/3,
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, get_char/1, halt/0,
max_arity/1, number_chars/2, number_codes/2,
once/1, op/3, read_term/2, repeat/0, retract/1,
set_prolog_flag/2, set_input/1, set_output/1,
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]).
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(255).
max_arity(1023).
% unify.
X = X.
@@ -213,18 +223,41 @@ comma_errors(G1, G2, B) :- '$call_with_default_policy'(','(G1, G2, B)).
;(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)),
!,
( call(G2) -> call(G3)
; '$set_cp'(B),
call(G4)
).
;(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, 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)).
@@ -289,36 +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)
; Name == max_depth -> integer(Arg), Arg >= 0
; 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
; Name == max_depth -> 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).
@@ -327,45 +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([])),
inst_member_or(Options, max_depth(MaxDepth), max_depth(0)),
'$write_term'(Term, IgnoreOps, NumberVars, Quoted, VarNames, MaxDepth).
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.
@@ -548,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))
).
@@ -850,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))
).
@@ -867,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))
).
@@ -924,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
@@ -945,45 +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) :-
( string(Cs) ->
current_prolog_flag(double_quotes, chars)
; 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) :-
( string(Cs) ->
current_prolog_flag(double_quotes, codes)
; 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),
@@ -1039,3 +1082,210 @@ set_output(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).

View File

@@ -1,11 +1,117 @@
:- module(charsio, [read_term_from_chars/2,
:- 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) ->
throw(error(instantiation_error, read_term_from_chars/2))
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),
@@ -13,27 +119,46 @@ read_term_from_chars(Chars, Term) :-
partial_string(Chars) ->
true
;
throw(error(type_error(complete_string, Chars), read_term_from_chars/2))
type_error(complete_string, Chars, read_term_from_chars/2)
),
'$read_term_from_chars'(Chars, Term).
write_term_to_chars(_, Options, _) :-
var(Options), throw(error(instantiation_error, write_term_to_chars/3)).
var(Options), instantiation_error(write_term_to_chars/3).
write_term_to_chars(Term, Options, Chars) :-
'$skip_max_list'(_, -1, Options, Options0),
( var(Options0) ->
throw(error(instantiation_error, write_term_to_chars/3))
; nonvar(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))
; Options0 == [] ->
true
;
throw(error(type_error(list, Options), write_term_to_chars/3))
true
),
builtins:inst_member_or(Options, ignore_ops(IgnoreOps), ignore_ops(false)),
builtins:inst_member_or(Options, numbervars(NumberVars), numbervars(false)),
builtins:inst_member_or(Options, quoted(Quoted), quoted(false)),
builtins:inst_member_or(Options, variable_names(VarNames), variable_names([])),
builtins:inst_member_or(Options, max_depth(MaxDepth), max_depth(0)),
'$write_term_to_chars'(Term, IgnoreOps, NumberVars, Quoted, VarNames, MaxDepth, Chars).
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

@@ -31,9 +31,10 @@
:- use_module(library(atts)).
:- use_module(library(lists)).
:- 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,
@@ -97,16 +98,10 @@ 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))).
partition(Pred, Ls0, As, Bs) :-
include(Pred, Ls0, As),
exclude(Pred, Ls0, Bs).

View File

@@ -1,11 +1,11 @@
/* CLP(Z): Constraint Logic Programming over Integers.
/* CLP(): Constraint Logic Programming over Integers.
Author: Markus Triska
E-mail: triska@metalevel.at
WWW: https://www.metalevel.at
Copyright (C): 2016-2020 Markus Triska
This library provides CLP(Z):
This library provides CLP():
Constraint Logic Programming over Integers
==========================================
@@ -115,7 +115,7 @@
:- use_module(library(iso_ext)).
:- use_module(library(dcgs)).
:- use_module(library(terms)).
:- use_module(library(error), []).
:- use_module(library(error), [domain_error/3, type_error/3]).
:- use_module(library(si)).
:- use_module(library(freeze)).
@@ -185,16 +185,9 @@ 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))).
partition(Pred, Ls0, As, Bs) :-
include(Pred, Ls0, As),
@@ -281,15 +274,15 @@ exclude_([L|Ls0], Goal, Ls) :-
## Introduction {#clpz-intro}
This library provides CLP(Z): Constraint Logic Programming over
This library provides CLP(): Constraint Logic Programming over
Integers.
CLP(Z) is an instance of the general CLP(.) scheme, extending logic
programming with reasoning over specialised domains. CLP(Z) lets us
CLP() is an instance of the general CLP(.) scheme, extending logic
programming with reasoning over specialised domains. CLP() lets us
reason about **integers** in a way that honors the relational nature
of Prolog.
There are two major use cases of CLP(Z) constraints:
There are two major use cases of CLP() constraints:
1. [**declarative integer arithmetic**](<#clpz-integer-arith>)
2. solving **combinatorial problems** such as planning, scheduling
@@ -307,7 +300,7 @@ The predicates of this library can be classified as:
In most cases, [_arithmetic constraints_](<#clpz-arith-constraints>)
are the only predicates you will ever need from this library. When
reasoning over integers, simply replace low-level arithmetic
predicates like `(is)/2` and `(>)/2` by the corresponding CLP(Z)
predicates like `(is)/2` and `(>)/2` by the corresponding CLP()
constraints like #=/2 and #>/2 to honor and preserve declarative
properties of your programs. For satisfactory performance, arithmetic
constraints are implicitly rewritten at compilation time so that
@@ -315,7 +308,7 @@ low-level fallback predicates are automatically used whenever
possible.
Almost all Prolog programs also reason about integers. Therefore, it
is highly advisable that you make CLP(Z) constraints available in all
is highly advisable that you make CLP() constraints available in all
your programs. One way to do this is to put the following directive in
your =|~/.swiplrc|= initialisation file:
@@ -323,7 +316,7 @@ your =|~/.swiplrc|= initialisation file:
:- use_module(library(clpz)).
==
All example programs that appear in the CLP(Z) documentation assume
All example programs that appear in the CLP() documentation assume
that you have done this.
Important concepts and principles of this library are illustrated by
@@ -331,7 +324,7 @@ means of usage examples that are available in a public git repository:
[**github.com/triska/clpz**](https://github.com/triska/clpz)
If you are used to the complicated operational considerations that
low-level arithmetic primitives necessitate, then moving to CLP(Z)
low-level arithmetic primitives necessitate, then moving to CLP()
constraints may, due to their power and convenience, at first feel to
you excessive and almost like cheating. It _isn't_. Constraints are an
integral part of all popular Prolog systems, and they are designed
@@ -339,7 +332,7 @@ to help you eliminate and avoid the use of low-level and less general
primitives by providing declarative alternatives that are meant to be
used instead.
When teaching Prolog, CLP(Z) constraints should be introduced
When teaching Prolog, CLP() constraints should be introduced
_before_ explaining low-level arithmetic predicates and their
procedural idiosyncrasies. This is because constraints are easy to
explain, understand and use due to their purely relational nature. In
@@ -347,13 +340,13 @@ contrast, the modedness and directionality of low-level arithmetic
primitives are impure limitations that are better deferred to more
advanced lectures.
More information about CLP(Z) constraints and their implementation is
More information about CLP() constraints and their implementation is
contained in: [**metalevel.at/drt.pdf**](https://www.metalevel.at/drt.pdf)
The best way to discuss applying, improving and extending CLP(Z)
The best way to discuss applying, improving and extending CLP()
constraints is to use the dedicated `clpz` tag on
[stackoverflow.com](http://stackoverflow.com). Several of the world's
foremost CLP(Z) experts regularly participate in these discussions
foremost CLP() experts regularly participate in these discussions
and will help you for free on this platform.
## Arithmetic constraints {#clpz-arith-constraints}
@@ -408,7 +401,7 @@ etc. are meant to be used _instead_ of the primitives `(is)/2`,
`(=:=)/2`, `(>)/2` etc. over integers. Almost all Prolog programs also
reason about integers. Therefore, it is recommended that you put the
following directive in your =|~/.swiplrc|= initialisation file to make
CLP(Z) constraints available in all your programs:
CLP() constraints available in all your programs:
==
:- use_module(library(clpz)).
@@ -416,7 +409,7 @@ CLP(Z) constraints available in all your programs:
Throughout the following, it is assumed that you have done this.
The most basic use of CLP(Z) constraints is _evaluation_ of
The most basic use of CLP() constraints is _evaluation_ of
arithmetic expressions involving integers. For example:
==
@@ -435,7 +428,7 @@ partially instantiated. For example:
Y = 1.
==
This relational nature makes CLP(Z) constraints easy to explain and
This relational nature makes CLP() constraints easy to explain and
use, and well suited for beginners and experienced Prolog programmers
alike. In contrast, when using low-level integer arithmetic, we get:
@@ -451,7 +444,7 @@ Due to the necessary operational considerations, the use of these
low-level arithmetic predicates is considerably harder to understand
and should therefore be deferred to more advanced lectures.
For supported expressions, CLP(Z) constraints are drop-in
For supported expressions, CLP() constraints are drop-in
replacements of these low-level arithmetic predicates, often yielding
more general programs. See [`n_factorial/2`](<#clpz-factorial>) for an
example.
@@ -475,13 +468,13 @@ positive_integer(N) :-
).
==
This illustrates why the performance of CLP(Z) constraints is almost
This illustrates why the performance of CLP() constraints is almost
always completely satisfactory when they are used in modes that can be
handled by low-level arithmetic. To disable the automatic rewriting,
set the Prolog flag `clpz_goal_expansion` to `false`.
If you are used to the complicated operational considerations that
low-level arithmetic primitives necessitate, then moving to CLP(Z)
low-level arithmetic primitives necessitate, then moving to CLP()
constraints may, due to their power and convenience, at first feel to
you excessive and almost like cheating. It _isn't_. Constraints are an
integral part of all popular Prolog systems, and they are designed
@@ -507,9 +500,9 @@ n_factorial(N, F) :-
F #= N * F1.
==
This program uses CLP(Z) constraints _instead_ of low-level
This program uses CLP() constraints _instead_ of low-level
arithmetic throughout, and everything that _would have worked_ with
low-level arithmetic _also_ works with CLP(Z) constraints, retaining
low-level arithmetic _also_ works with CLP() constraints, retaining
roughly the same performance. For example:
==
@@ -519,7 +512,7 @@ false.
==
Now the point: Due to the increased flexibility and generality of
CLP(Z) constraints, we are free to _reorder_ the goals as follows:
CLP() constraints, we are free to _reorder_ the goals as follows:
==
n_factorial(0, 1).
@@ -548,18 +541,18 @@ the (implied) constraint `F #\= 0` before the recursive call.
Otherwise, the query `n_factorial(N, 0)` is the only non-terminating
case of this kind.
The value of CLP(Z) constraints does _not_ lie in completely freeing
The value of CLP() constraints does _not_ lie in completely freeing
us from _all_ procedural phenomena. For example, the two programs do
not even have the same _termination properties_ in all cases.
Instead, the primary benefit of CLP(Z) constraints is that they allow
Instead, the primary benefit of CLP() constraints is that they allow
you to try different execution orders and apply [**declarative
debugging**](https://www.metalevel.at/prolog/debugging.html)
techniques _at all_! Reordering goals (and clauses) can significantly
impact the performance of Prolog programs, and you are free to try
different variants if you use declarative approaches. Moreover, since
all CLP(Z) constraints _always terminate_, placing them earlier can
all CLP() constraints _always terminate_, placing them earlier can
at most _improve_, never worsen, the termination properties of your
programs. An additional benefit of CLP(Z) constraints is that they
programs. An additional benefit of CLP() constraints is that they
eliminate the complexity of introducing `(is)/2` and `(=:=)/2` to
beginners, since _both_ predicates are subsumed by #=/2 when reasoning
over integers.
@@ -567,7 +560,7 @@ over integers.
## Combinatorial constraints {#clpz-combinatorial}
In addition to subsuming and replacing low-level arithmetic
predicates, CLP(Z) constraints are often used to solve combinatorial
predicates, CLP() constraints are often used to solve combinatorial
problems such as planning, scheduling and allocation tasks. Among the
most frequently used *combinatorial constraints* are all_distinct/1,
global_cardinality/2 and cumulative/2. This library also provides
@@ -576,12 +569,12 @@ useful in more specialized applications.
## Domains {#clpz-domains}
Each CLP(Z) variable has an associated set of admissible integers,
Each CLP() variable has an associated set of admissible integers,
which we call the variable's *domain*. Initially, the domain of each
CLP(Z) variable is the set of _all_ integers. CLP(Z) constraints
CLP() variable is the set of _all_ integers. CLP() constraints
like #=/2, #>/2 and #\=/2 can at most reduce, and never extend, the
domains of their arguments. The constraints in/2 and ins/2 let us
explicitly state domains of CLP(Z) variables. The process of
explicitly state domains of CLP() variables. The process of
determining and adjusting domains of variables is called constraint
*propagation*, and it is performed automatically by this library. When
the domain of a variable contains only one element, then the variable
@@ -593,7 +586,7 @@ and by enumeration predicates like labeling/2.
## Example: Sudoku {#clpz-sudoku}
As another example, consider _Sudoku_: It is a popular puzzle
over integers that can be easily solved with CLP(Z) constraints.
over integers that can be easily solved with CLP() constraints.
==
sudoku(Rows) :-
@@ -697,7 +690,7 @@ own labeling strategies.
## Core relations and search {#clpz-search}
Using CLP(Z) constraints to solve combinatorial tasks typically
Using CLP() constraints to solve combinatorial tasks typically
consists of two phases:
1. First, all relevant constraints are stated.
@@ -713,7 +706,7 @@ search, and more easily try different search strategies.
As an example of a constraint satisfaction problem, consider the
cryptoarithmetic puzzle SEND + MORE = MONEY, where different letters
denote distinct integers between 0 and 9. It can be modeled in CLP(Z)
denote distinct integers between 0 and 9. It can be modeled in CLP()
as follows:
==
@@ -776,13 +769,13 @@ so-called _eight queens puzzle_. The task is to place 8 queens on an
8x8 chessboard such that none of the queens is under attack. This
means that no two queens share the same row, column or diagonal.
To express this puzzle via CLP(Z) constraints, we must first pick a
suitable representation. Since CLP(Z) constraints reason over
To express this puzzle via CLP() constraints, we must first pick a
suitable representation. Since CLP() constraints reason over
_integers_, we must find a way to map the positions of queens to
integers. Several such mappings are conceivable, and it is not
immediately obvious which we should use. On top of that, different
constraints can be used to express the desired relations. For such
reasons, _modeling_ combinatorial problems via CLP(Z) constraints
reasons, _modeling_ combinatorial problems via CLP() constraints
often necessitates some creativity and has been described as more of
an art than a science.
@@ -847,7 +840,7 @@ separated the core relation from the actual search.
## Optimisation {#clpz-optimisation}
We can use labeling/2 to minimize or maximize the value of a CLP(Z)
We can use labeling/2 to minimize or maximize the value of a CLP()
expression, and generate solutions in increasing or decreasing order
of the value. See the labeling options `min(Expr)` and `max(Expr)`,
respectively.
@@ -864,9 +857,9 @@ solutions that are _also_ optimal, so that we can choose among optimal
solutions by other criteria. For the sake of
[**purity**](https://www.metalevel.at/prolog/purity.html) and
completeness, we recommend to avoid `once/1` and other constructs that
lead to impurities in CLP(Z) programs.
lead to impurities in CLP() programs.
Related to optimisation with CLP(Z) constraints are `library(simplex)`
Related to optimisation with CLP() constraints are `library(simplex)`
and CLP(Q) which reason about _linear_ constraints over rational
numbers.
@@ -890,9 +883,9 @@ The constraints of this table are reifiable as well.
When reasoning over Boolean variables, also consider using CLP(B)
constraints as provided by `library(clpb)`.
## Enabling monotonic CLP(Z) {#clpz-monotonicity}
## Enabling monotonic CLP() {#clpz-monotonicity}
In the default execution mode, CLP(Z) constraints still exhibit some
In the default execution mode, CLP() constraints still exhibit some
non-relational properties. For example, _adding_ constraints can yield
new solutions:
@@ -907,7 +900,7 @@ X = 1+1.
This behaviour is highly problematic from a logical point of view, and
it may render declarative debugging techniques inapplicable.
Assert `clpz:monotonic` to make CLP(Z) **monotonic**: This means
Assert `clpz:monotonic` to make CLP() **monotonic**: This means
that _adding_ new constraints _cannot_ yield new solutions. When this
flag is `true`, we must wrap variables that occur in arithmetic
expressions with the functor `(?)/1` or `(#)/1`. For example:
@@ -2516,7 +2509,7 @@ remove_lower([C*X|CXs], Min) :-
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Parsing a CLP(Z) expression has two important side-effects: First,
Parsing a CLP() expression has two important side-effects: First,
it constrains the variables occurring in the expression to
integers. Second, it constrains some of them even more: For
example, in X/Y and X mod Y, Y is constrained to be #\= 0.
@@ -2954,7 +2947,7 @@ expr_conds(A0 mod B0, A mod B) -->
expr_conds(A0^B0, A^B) -->
expr_conds(A0, A), expr_conds(B0, B),
[(B >= 0 ; A =:= -1)].
% Bitwise operations, added to make CLP(Z) usable in more cases
% Bitwise operations, added to make CLP() usable in more cases
expr_conds(\ A0, \ A) --> expr_conds(A0, A).
expr_conds(A0<<B0, A<<B) --> expr_conds(A0, A), expr_conds(B0, B).
expr_conds(A0>>B0, A>>B) --> expr_conds(A0, A), expr_conds(B0, B).
@@ -3045,13 +3038,13 @@ expansion_simpler((A0,B0), (A,B)) :- !,
expansion_simpler(Var is Expr0, Goal) :-
ground(Expr0), !,
phrase(expr_conds(Expr0, Expr), Gs),
( maplist(call, Gs) -> Var is Expr, Goal = true
( maplist(call, Gs) -> Value is Expr, Goal = (Var = Value)
; Goal = false
).
expansion_simpler(Var =:= Expr0, Goal) :-
ground(Expr0), !,
phrase(expr_conds(Expr0, Expr), Gs),
( maplist(call, Gs) -> Goal = (Var =:= Expr)
( maplist(call, Gs) -> Value is Expr, Goal = (Var =:= Value)
; Goal = false
).
expansion_simpler(between(L,U,V), Goal) :- maplist(integer, [L,U,V]), !,
@@ -3071,10 +3064,12 @@ is_false(var(X)) :- nonvar(X).
:- dynamic(goal_expansion/1).
goal_expansion(Goal0, _Layout1, _Module, Goal, []) :-
\+ goal_expansion(false),
clpz_expandable(Goal0),
clpz_expansion(Goal0, Goal).
% goal expansion is disabled for now, until #445 is resolved
%
% user:goal_expansion(Goal0, Goal) :-
% \+ goal_expansion(false),
% clpz_expandable(Goal0),
% clpz_expansion(Goal0, Goal).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -6924,12 +6919,6 @@ contribution_at(T, Task, Offset-Bs, Contribution) :-
?(Contribution) #= B*C
).
nth0(0, [E|_], E) :- !.
nth0(N, [_|Ls], E) :-
N > 0,
N1 is N - 1,
nth0(N1, Ls, E).
nth1(I, Es, E) :-
I0 is I-1,
nth0(I0, Es, E).
@@ -7272,7 +7261,7 @@ chain(Relation, X, Prev, X) :- call(Relation, ?(Prev), ?(X)).
%% fd_var(+Var)
%
% True iff Var is a CLP(Z) variable.
% True iff Var is a CLP() variable.
fd_var(X) :- get_attr(X, clpz, _).
@@ -7384,7 +7373,8 @@ goals_entail(Goals, E) :-
verify_attributes(Var, Other, Gs) :-
% portray_clause(Var = Other),
( get_attr(Var, clpz, clpz_attr(_,_,_,Dom,Ps,Q)) ->
( get_atts(Var, clpz(CLPZ)) ->
CLPZ = clpz_attr(_,_,_,Dom,Ps,Q),
( nonvar(Other) ->
( integer(Other) -> true
; type_error(integer, Other)
@@ -7392,14 +7382,17 @@ verify_attributes(Var, Other, Gs) :-
domain_contains(Dom, Other),
phrase(trigger_props(Ps), [Q], [_]),
Gs = [phrase(do_queue, [Q], _)]
; fd_get(Other, OD, OPs),
domains_intersection(OD, Dom, Dom1),
append_propagators(Ps, OPs, Ps1),
new_queue(Q0),
variables_same_queue([Var,Other]),
phrase((fd_put(Other,Dom1,Ps1),
trigger_props(Ps1)), [Q0], _),
Gs = [phrase(do_queue, [Q0], _)]
; ( get_atts(Other, clpz(clpz_attr(_,_,_,OD,OPs,_))) ->
domains_intersection(OD, Dom, Dom1),
append_propagators(Ps, OPs, Ps1),
new_queue(Q0),
variables_same_queue([Var,Other]),
phrase((fd_put(Other,Dom1,Ps1),
trigger_props(Ps1)), [Q0], _),
Gs = [phrase(do_queue, [Q0], _)]
; put_atts(Other, clpz(CLPZ)),
Gs = []
)
)
; Gs = []
).
@@ -7433,6 +7426,10 @@ intervals_to_drep([A0-B0|Rest], Drep0, Drep) :-
),
intervals_to_drep(Rest, Drep0 \/ D1, Drep).
attribute_goals(X) -->
{ get_atts(X, queue(_,_)) },
!,
{ put_atts(X, -queue(_,_)) }.
attribute_goals(X) -->
% { get_attr(X, clpz, Attr), format("A: ~w\n", [Attr]) },
{ get_attr(X, clpz, clpz_attr(_,_,_,Dom,fd_props(Gs,Bs,Os),_)),

View File

@@ -10,7 +10,7 @@ shift(Ball) :-
'$nextEP'(first, E, P),
get_chunks(E, P, L),
( L == [] ->
Cont = none
Cont = cont(true)
; Cont = cont(call_continuation(L))
),
'$write_cont_and_term'(_, _, Cont, Ball),

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

@@ -6,11 +6,6 @@
:- use_module(library(error)).
:- use_module(library(lists), [append/3]).
user:term_expansion(Term0, Term) :-
nonvar(Term0),
dcg_rule(Term0, (Head :- Body)),
Term = (Head :- Body).
phrase(GRBody, S0) :-
phrase(GRBody, S0, []).
@@ -133,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

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

View File

@@ -28,6 +28,11 @@
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)
@@ -44,6 +49,10 @@
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).
@@ -55,7 +64,7 @@
Example:
?- phrase(format_("~s~n~`.t~w!~12|", ["hello",there]), Cs).
%@ Cs = [h,e,l,l,o,'\n','.','.','.','.','.','.',t,h,e,r,e,!]
%@ Cs = "hello\n......there!"
%@ ; false.
I place this code in the public domain. Use it in any way you want.
@@ -63,13 +72,16 @@
:- module(format, [format_//2,
format/2,
portray_clause/1
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),
@@ -146,7 +158,7 @@ element_gluevar(glue(_,V), N, N) --> [V].
cells([], Args, Tab, Es) -->
( { Args == [] } -> cell(Tab, Tab, Es)
; { domain_error(no_remaining_arguments, Args) }
; { domain_error(no_remaining_arguments, Args, format_//2) }
).
cells([~,~|Fs], Args, Tab, Es) --> !,
cells(Fs, Args, Tab, [chars("~")|Es]).
@@ -234,6 +246,16 @@ cells([~|Fs0], Args0, Tab, Es) -->
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) --> !,
@@ -251,18 +273,14 @@ cells([~|Fs0], Args0, Tab0, Es) -->
cells(Fs, Args, Tab, []).
cells([~,C|_], _, _, _) -->
{ atom_chars(A, [~,C]),
domain_error(format_string, A) }.
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]).
domain_error(Type, Term) :-
throw(error(domain_error(Type, Term), _)).
n_newlines(0) --> !.
n_newlines(1) --> !, [newline].
n_newlines(N0) --> { N0 > 1, N is N0 - 1 }, [newline], n_newlines(N).
n_newlines(N0) --> { N0 > 0, N is N0 - 1 }, [newline], n_newlines(N).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
?- phrase(upto_what(Cs, ~), "abc~test", Rest).
@@ -309,6 +327,35 @@ 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.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
@@ -317,6 +364,26 @@ 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).
@@ -340,11 +407,11 @@ Cs = [cell(0,4,[glue(' ',_38),chars([a]),glue(' ',_62)])].
?- phrase(format_("hello~n~tthere~6|", []), Ls).
?- format("~ta~t~4|", []).
a true
a true
; false.
?- format("~ta~tb~tc~10|", []).
a b ctrue
a b c true
; false.
?- format("~tabc~3|", []).
@@ -352,37 +419,39 @@ Cs = [cell(0,4,[glue(' ',_38),chars([a]),glue(' ',_62)])].
?- format("~ta~t~4|", []).
?- format("~ta~t~tb~tc~20|", []).
a b ctrue
a b c true
; false.
?- format("~2f~n", [3]).
3.00
true
3.00
true
?- format("~20f", [0.1]).
0.10000000000000000000true % this should use higher accuracy!
0.10000000000000000000 true % this should use higher accuracy!
; false.
?- X is atan(2), format("~7f~n", [X]).
1.1071487
X = 1.1071487177940906
1.1071487
X = 1.1071487177940906
?- format("~`at~50|~n", []).
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
true
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
true
?- format("~t~N", []).
?- format("~q", [.]).
'.'true
'.' true
?- format("~12r", [300]).
210 true
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
We also provide a rudimentary version of portray_clause/1.
We also provide rudimentary versions of portray_clause/1 and listing/1.
In the eventual library organization, portray_clause/1
and related predicates (such as listing/1) may be placed
in their own dedicated library.
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.
@@ -393,49 +462,57 @@ portray_clause(Term) :-
maplist(write, Ls).
portray_clause_(Term) -->
portray_(Term), ".\n".
{ term_variables(Term, Vs),
foldl(var_name, Vs, VNs, 0, _) },
portray_(Term, VNs), ".\n".
literal(Lit) --> format_("~q", [Lit]).
var_name(V, Name=V, Num0, Num) :-
charsio:fabricate_var_name(numbervars, Name, Num0),
Num is Num0 + 1.
portray_(Var) --> { var(Var) }, !, literal(Var).
portray_((Head :- Body)) --> !,
literal(Head), " :-\n",
body_(Body, 0, 8).
portray_((Head --> Body)) --> !,
literal(Head), " -->\n",
body_(Body, 0, 8).
portray_(Any) --> literal(Any).
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) --> { var(Var) }, !,
body_(Var, C, I, VNs) --> { var(Var) }, !,
indent_to(C, I),
literal(Var).
body_((A,B), C, I) --> !,
body_(A, C, I), ",\n",
body_(B, 0, I).
body_((A ; Else), C, I) --> % ( If -> Then ; Else )
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), " ->\n",
body_(Then, 0, C1), "\n",
else_branch(Else, C1, I).
body_((A;B), C, I) --> !,
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), "\n",
else_branch(B, C1, I).
body_(Goal, C, I) -->
indent_to(C, I), literal(Goal).
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) -->
else_branch(Else, C, I, VNs) -->
indent_to(0, I),
";", " ", % (see #336)
body_(Else, C, C), "\n",
"; ",
body_(Else, C, C, VNs), "\n",
indent_to(0, I),
")".
@@ -444,38 +521,60 @@ indent_to(CurrentColumn, Indent) -->
format_("~t~*|", [Delta]).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
?- portray_clause(a), nl.
a.
?- portray_clause(a).
a.
?- nl, portray_clause((a :- b)), nl.
?- portray_clause((a :- b)).
a :-
b.
b.
?- nl, portray_clause((a :- b, c, d)), nl.
?- portray_clause((a :- b, c, d)).
a :-
b,
c,
d.
b,
c,
d.
true
?- nl, portray_clause([a,b,c,d]), nl.
?- portray_clause([a,b,c,d]).
"abcd".
?- nl, portray_clause(X).
?- nl, portray_clause((f(X) :- X)).
?- portray_clause(X).
?- portray_clause((f(X) :- X)).
?- nl, portray_clause((h :- ( a -> b; c))).
?- portray_clause((h :- ( a -> b; c))).
?- nl, portray_clause((h :- ( (a -> x ; y) -> b; c))).
?- portray_clause((h :- ( (a -> x ; y) -> b; c))).
?- nl, portray_clause((h(X) :- ( (a(X) ; y(A,B)) -> b; c))).
?- portray_clause((h(X) :- ( (a(X) ; y(A,B)) -> b; c))).
?- nl, portray_clause((h :- (a,d;b,c) ; (b,e;d))).
?- portray_clause((h :- (a,d;b,c) ; (b,e;d))).
?- nl, portray_clause((a :- b ; c ; d)).
?- portray_clause((a :- b ; c ; d)).
?- nl, portray_clause((h :- L = '.')).
?- portray_clause((h :- L = '.')).
?- nl, portray_clause(-->(a, (b, {t}, d))).
?- 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

@@ -4,10 +4,10 @@
%% ?- use_module(library(iso_ext)).
:- module(iso_ext, [bb_b_put/2, bb_get/2, bb_put/2, call_cleanup/2,
call_with_inference_limit/3, forall/2, maybe/0,
partial_string/1, partial_string/3,
partial_string_tail/2, set_random/1,
setup_call_cleanup/3, variant/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).
@@ -22,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))
reset_global_var_at_offset(Key, OldValue, OldOffset))
; call_cleanup((store_global_var_with_offset(Key, NewValue) ; false),
reset_global_var_at_key(Key))
reset_global_var_at_key(Key))
).
store_global_var_with_offset(Key, Value) :- '$store_global_var_with_offset'(Key, Value).
@@ -68,7 +68,8 @@ scc_helper(C, G, Bb) :-
; '$reset_block'(NBb),
'$fail').
scc_helper(_, _, Bb) :-
'$reset_block'(Bb), '$get_ball'(Ball),
'$reset_block'(Bb),
'$get_ball'(Ball),
'$call_with_default_policy'(run_cleaners_with_handling),
'$erase_ball',
'$call_with_default_policy'(throw(Ball)).
@@ -143,27 +144,12 @@ call_with_inference_limit(_, _, R, Bb, B) :-
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))),
error(E, _),
throw(error(E, partial_string/3))),
'$create_partial_string'(Atom, L, L0)
).

View File

@@ -1,8 +1,8 @@
:- 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,
sum_list/2, transpose/2]).
maplist/7, maplist/8, maplist/9, same_length/2, nth0/3,
sum_list/2, transpose/2, list_to_set/2]).
:- use_module(library(error)).
@@ -21,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) :-
@@ -63,7 +63,7 @@ reverse(Xs, Ys) :-
).
reverse([], [], YsRev, YsRev).
reverse([X1|Xs], [Y1|Ys], YsPreludeRev, Xss) :-
reverse([_|Xs], [Y1|Ys], YsPreludeRev, Xss) :-
reverse(Xs, Ys, [Y1|YsPreludeRev], Xss).
@@ -104,7 +104,7 @@ 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).
@@ -149,3 +149,54 @@ 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).

View File

@@ -1,6 +1,7 @@
:- module(pairs, [pairs_keys_values/3,
pairs_keys/2,
pairs_values/2,
group_pairs_by_key/2,
map_list_to_pairs/3]).
@@ -19,3 +20,14 @@ 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).

View File

@@ -136,18 +136,14 @@ activate(Wrapper,Worker,T) :-
delim(Wrapper,Worker,Table) :-
% debug(tabling, 'ACT: ~p on ~p', [Wrapper, Table]),
reset(Worker,SourceCall,Continuation),
( Continuation == none, var(SourceCall) ->
( Continuation = none ->
( add_answer(Table,Wrapper)
-> true %debug(tabling, 'ADD: ~p', [Wrapper])
; %debug(tabling, 'DUP: ~p', [Wrapper]),
fail
)
;
( Continuation = cont(Cont) ->
true
; Continuation = none ->
Cont = true
),
Continuation = cont(Cont),
SourceCall = call_info(_,SourceTable),
TargetCall = call_info(Wrapper,Table),
Dependency = dependency(SourceCall,Cont,TargetCall),

View File

@@ -291,7 +291,7 @@ wkl_add_to_existing_answer_cluster(Worklist, Answer) :-
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])).

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,3 +1,5 @@
use crate::divrem::*;
use crate::prolog_parser::ast::*;
use crate::prolog::arithmetic::*;
@@ -221,9 +223,6 @@ impl MachineState {
}
}
}
&HeapCellValue::Addr(Addr::CharCode(n)) => {
interms.push(Number::Integer(Rc::new(Integer::from(n))));
}
&HeapCellValue::Addr(Addr::Fixnum(n)) => {
interms.push(Number::Fixnum(n));
}
@@ -266,20 +265,10 @@ impl MachineState {
pub(crate)
fn int_floor_div(&self, n1: Number, n2: Number) -> Result<Number, MachineStub> {
match n1 / n2 {
Ok(result) => {
Ok(rnd_i(&result).to_owned())
}
Err(e) => {
let stub = MachineError::functor_stub(clause_name!("(div)"), 2);
Err(self.error_form(
MachineError::evaluation_error(
e
),
stub
))
}
}
let stub = MachineError::functor_stub(clause_name!("(div)"), 2);
let modulus = self.modulus(n1.clone(), n2.clone())?;
self.idiv(try_numeric_result!(self, n1 - modulus, stub)?, n2)
}
pub(crate)
@@ -409,7 +398,7 @@ impl MachineState {
match (n1, n2) {
(Number::Fixnum(n1), Number::Fixnum(n2)) => {
if n1 != 1 && n2 < 0 {
if n1 != 1 && n2 < -1 {
let n = Number::from(n1);
let stub = MachineError::functor_stub(clause_name!("^"), 2);
@@ -435,7 +424,7 @@ impl MachineState {
}
}
(Number::Fixnum(n1), Number::Integer(n2)) => {
if n1 != 1 && &*n2 < &0 {
if n1 != 1 && &*n2 < &-1 {
let n = Number::from(n1);
let stub = MachineError::functor_stub(clause_name!("^"), 2);
@@ -453,7 +442,7 @@ impl MachineState {
}
}
(Number::Integer(n1), Number::Fixnum(n2)) => {
if &*n1 != &1 && n2 < 0 {
if &*n1 != &1 && n2 < -1 {
let n = Number::Integer(n1);
let stub = MachineError::functor_stub(clause_name!("^"), 2);
@@ -471,7 +460,7 @@ impl MachineState {
}
}
(Number::Integer(n1), Number::Integer(n2)) => {
if &*n1 != &1 && &*n2 < &0 {
if &*n1 != &1 && &*n2 < &-1 {
let n = Number::Integer(n1);
let stub = MachineError::functor_stub(clause_name!("^"), 2);
@@ -730,18 +719,12 @@ impl MachineState {
match (n1, n2) {
(Number::Fixnum(n1), Number::Fixnum(n2)) => {
if let Ok(n2) = u32::try_from(n2) {
if let Some(result) = n1.checked_shr(n2) {
return Ok(Number::from(result));
}
}
let n1 = Integer::from(n1);
let n2 = Integer::from(n2);
match n2.to_u32() {
Some(n2) => Ok(Number::from(n1 >> n2)),
_ => Ok(Number::from(n1 >> u32::max_value())),
if let Ok(n2) = u32::try_from(n2) {
return Ok(Number::from(n1 >> n2));
} else {
return Ok(Number::from(n1 >> u32::max_value()));
}
}
(Number::Fixnum(n1), Number::Integer(n2)) => {
@@ -788,18 +771,12 @@ impl MachineState {
match (n1, n2) {
(Number::Fixnum(n1), Number::Fixnum(n2)) => {
if let Ok(n2) = u32::try_from(n2) {
if let Some(result) = n1.checked_shl(n2) {
return Ok(Number::from(result));
}
}
let n1 = Integer::from(n1);
let n2 = Integer::from(n2);
match n2.to_u32() {
Some(n2) => Ok(Number::from(n1 << n2)),
_ => Ok(Number::from(n1 << u32::max_value())),
if let Ok(n2) = u32::try_from(n2) {
return Ok(Number::from(n1 << n2));
} else {
return Ok(Number::from(n1 << u32::max_value()));
}
}
(Number::Fixnum(n1), Number::Integer(n2)) => {
@@ -990,7 +967,7 @@ impl MachineState {
stub,
))
} else {
Ok(Number::from(n1 % n2))
Ok(Number::from(n1.rem_floor(n2)))
}
}
(Number::Fixnum(n1), Number::Integer(n2)) => {

View File

@@ -1,3 +1,5 @@
:- module('$atts', []).
driver(Vars, Values) :-
iterate(Vars, Values, ListOfListsOfGoalLists),
!,

View File

@@ -1,5 +1,8 @@
use crate::prolog::heap_iter::*;
use crate::prolog::machine::*;
use crate::indexmap::IndexSet;
use std::cmp::Ordering;
use std::vec::IntoIter;
@@ -8,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>,
@@ -136,4 +140,37 @@ impl MachineState {
self.b0 = self.b;
self.p = CodePtr::Local(LocalCodePtr::DirEntry(p));
}
pub(super)
fn attr_vars_of_term(&self, addr: Addr) -> Vec<Addr> {
let mut seen_set = IndexSet::new();
let mut seen_vars = vec![];
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);
}
}
}
seen_vars
}
}

View File

@@ -12,6 +12,7 @@ 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,
@@ -52,15 +53,27 @@ 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(crate) fn add_in_situ_result(
pub(crate)
fn add_in_situ_result(
&mut self,
result: &CompiledResult,
in_situ_code_dir: &mut InSituCodeDir,
@@ -100,16 +113,19 @@ impl CodeRepo {
}
#[inline]
pub(super) fn size_of_cached_query(&self) -> usize {
pub(super)
fn size_of_cached_query(&self) -> usize {
self.cached_query.len()
}
#[inline]
pub(super) fn take_in_situ_code(&mut self) -> Code {
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>(
pub(super)
fn lookup_instr<'a>(
&'a self,
last_call: bool,
p: &CodePtr,

View File

@@ -77,9 +77,11 @@ fn load_module(
listing_src.clone(),
);
let mut stream = parsing_stream(stream)?;
let results = compiler.gather_items(
wam,
&mut parsing_stream(stream),
&mut stream,
&mut indices,
);
@@ -117,7 +119,7 @@ fn load_module_from_file(
let mut path_buf = fix_filename(wam.indices.atom_tbl.clone(), path_buf)?;
let filename = clause_name!(path_buf.to_string_lossy().to_string(), wam.indices.atom_tbl);
let file_handle = Stream::from(File::open(&path_buf).or_else(|_| {
let file_handle = Stream::from_file_as_input(filename.clone(), File::open(&path_buf).or_else(|_| {
Err(SessionError::InvalidFileName(filename.clone()))
})?);
@@ -188,6 +190,8 @@ fn set_first_index(code: &mut Code) {
if *offset == 0 =>
{
*offset = code_len - idx;
debug_assert!(*offset > 0);
break;
}
_ => {}
@@ -344,12 +348,10 @@ fn compile_into_module(
);
match compile_into_module_impl(wam, &mut compiler, module, src, indices) {
Ok(()) => EvalSession::EntrySuccess,
Ok(()) => {
EvalSession::EntrySuccess
}
Err(e) => {
if let Some(module) = compiler.module.take() {
wam.indices.insert_module(module);
}
compiler.drop_expansions(&mut wam.code_repo);
EvalSession::from(e)
}
@@ -366,14 +368,16 @@ fn compile_into_module_impl(
setup_module_expansions(wam, &module);
let module_name = module.module_decl.name.clone();
compiler.module = Some(module);
// compiler.module = Some(module); This trips the goal expansion up. Should be possible to 'merge' modules.
// A much better strategy!
wam.indices.insert_module(module);
wam.code_repo.compile_hook(CompileTimeHook::TermExpansion)?;
wam.code_repo.compile_hook(CompileTimeHook::GoalExpansion)?;
let mut results = compiler.gather_items(
wam,
&mut parsing_stream(src),
&mut parsing_stream(src)?,
&mut indices,
)?;
@@ -395,10 +399,11 @@ fn compile_into_module_impl(
clause_code_generator.generate_clause_code(&results.dynamic_clause_map, wam)?;
let top_level_term_dir = results.top_level_term_dirs.consolidate();
let module = wam.indices.take_module(module_name).unwrap();
add_module(
wam,
compiler.module.take().unwrap(),
module,
indices,
top_level_term_dir,
);
@@ -409,6 +414,7 @@ fn compile_into_module_impl(
Ok(compiler.drop_expansions(&mut wam.code_repo))
}
#[derive(Debug)]
pub struct GatherResult {
dynamic_clause_map: DynamicClauseMap,
pub(crate) worker_results: Vec<PredicateCompileQueue>,
@@ -423,6 +429,7 @@ pub struct GatherResult {
in_situ_module_dir: ModuleStubDir,
}
#[derive(Debug)]
pub struct ClauseCodeGenerator {
len_offset: usize,
code: Code,
@@ -529,6 +536,7 @@ fn insert_or_refresh_term_dir_quantum(
}
}
#[derive(Debug)]
pub struct ListingCompiler {
module: Option<Module>,
user_term_dir: TermDir,
@@ -608,7 +616,7 @@ fn load_library(
)
}
None => {
let err = ExistenceError::SourceSink(ModuleSource::Library(
let err = ExistenceError::ModuleSource(ModuleSource::Library(
name.clone()
));
@@ -631,7 +639,7 @@ impl ListingCompiler {
.term_dir_entry_len((clause_name!("term_expansion"), 2)),
orig_goal_expansion_lens: code_repo
.term_dir_entry_len((clause_name!("goal_expansion"), 2)),
initialization_goals: (vec![], VecDeque::from(vec![])),
initialization_goals: (vec![], VecDeque::from(vec![])),
suppress_warnings,
listing_src
}
@@ -699,7 +707,7 @@ impl ListingCompiler {
Ok(wam_indices.insert_module(submodule))
} else {
let err = ExistenceError::SourceSink(ModuleSource::File(
let err = ExistenceError::ModuleSource(ModuleSource::File(
module_name,
));
@@ -737,7 +745,7 @@ impl ListingCompiler {
Ok(wam_indices.insert_module(submodule))
} else {
let err = ExistenceError::SourceSink(ModuleSource::File(
let err = ExistenceError::ModuleSource(ModuleSource::File(
module_name
));
@@ -754,14 +762,14 @@ impl ListingCompiler {
}
fn generate_init_goal_code(
&mut self,
&mut self,
) -> Result<Code, SessionError> {
let query_terms = mem::replace(&mut self.initialization_goals.0, vec![]);
let queue = mem::replace(&mut self.initialization_goals.1, VecDeque::new());
let query_terms = mem::replace(&mut self.initialization_goals.0, vec![]);
let queue = mem::replace(&mut self.initialization_goals.1, VecDeque::new());
compile_query(query_terms, queue)
.map(|(code, _)| code)
.map_err(SessionError::from)
compile_query(query_terms, queue)
.map(|(code, _)| code)
.map_err(SessionError::from)
}
fn set_code_index(
@@ -900,7 +908,7 @@ impl ListingCompiler {
.or_insert((Predicate::new(), VecDeque::from(vec![])));
len += 1;
queue_len += queue_len;
queue_len += queue.len();
(preds.0).0.push(clause);
preds.1.extend(queue.into_iter());
@@ -977,12 +985,12 @@ impl ListingCompiler {
Err(SessionError::from(ParserError::InvalidModuleDecl))
}
}
Declaration::ModuleInitialization(query_terms, queue) => {
self.initialization_goals.0.extend(query_terms.into_iter());
self.initialization_goals.1.extend(queue.into_iter());
Declaration::ModuleInitialization(query_terms, queue) => {
self.initialization_goals.0.extend(query_terms.into_iter());
self.initialization_goals.1.extend(queue.into_iter());
Ok(())
}
Ok(())
}
Declaration::MultiFile(..) => {
Ok(())
}
@@ -1071,7 +1079,7 @@ impl ListingCompiler {
insert_or_refresh_term_dir_quantum(term_dir, key, term_dirs);
}
None => {
let err = ExistenceError::SourceSink(ModuleSource::File(
let err = ExistenceError::ModuleSource(ModuleSource::File(
module_name,
));
@@ -1100,9 +1108,9 @@ impl ListingCompiler {
.entry((name.clone(), arity))
.or_insert(vec![]);
indices.code_dir
.entry((name.clone(), arity))
.or_insert(CodeIndex::dynamic_undefined(self.get_module_name()));
indices.code_dir
.entry((name.clone(), arity))
.or_insert(CodeIndex::dynamic_undefined(self.get_module_name()));
}
&Declaration::Hook(hook, _, ref queue) if self.module.is_none() => worker
.term_stream
@@ -1134,7 +1142,8 @@ impl ListingCompiler {
result
}
pub(crate) fn gather_items(
pub(crate)
fn gather_items(
&mut self,
wam: &mut Machine,
src: &mut ParsingStream<Stream>,
@@ -1279,6 +1288,17 @@ fn compile_work_impl(
.filter(|(name, _)| name.owning_module().as_str() != "builtins")
.map(ModuleExport::PredicateKey)
.collect();
module.module_decl.exports.extend(
indices.op_dir.iter()
.map(|((name, _), OpDirValue (shared_op_desc, _))|
ModuleExport::OpDecl(OpDecl(
shared_op_desc.prec(),
shared_op_desc.assoc(),
name.clone(),
))
)
);
}
let mut clause_code_generator =
@@ -1319,7 +1339,7 @@ fn compile_work_impl(
let init_goal_code = compiler.generate_init_goal_code()?;
if init_goal_code.len() > 0 {
if !wam.run_init_code(init_goal_code) {
if !wam.run_init_code(init_goal_code) {
println!("Warning: initialization goal for {} failed",
compiler.listing_src.name());
}
@@ -1341,7 +1361,8 @@ fn compile_work(
src: Stream,
mut indices: IndexStore,
) -> EvalSession {
let src = &mut parsing_stream(src);
let mut stream = try_eval_session!(parsing_stream(src));
let src = &mut stream;
let results = try_eval_session!(compiler.gather_items(wam, src, &mut indices));
try_eval_session!(compile_work_impl(compiler, wam, indices, results));
@@ -1360,9 +1381,9 @@ pub fn compile_special_form(
let mut indices = default_index_store!(wam.indices.atom_tbl.clone());
setup_indices(wam, clause_name!("builtins"), &mut indices)?;
let src = &mut parsing_stream(src);
let mut src = parsing_stream(src)?;
let mut compiler = ListingCompiler::new(&wam.code_repo, true, listing_src);
let mut results = compiler.gather_items(wam, src, &mut indices)?;
let mut results = compiler.gather_items(wam, &mut src, &mut indices)?;
compiler.adapt_in_situ_code(
results.worker_results,
@@ -1417,7 +1438,7 @@ pub(super) fn setup_indices(
wam.indices.insert_module(module);
result
} else {
let err = ExistenceError::SourceSink(ModuleSource::Library(
let err = ExistenceError::ModuleSource(ModuleSource::Library(
module
));

View File

@@ -1,13 +1,12 @@
use crate::prolog::machine::machine_indices::*;
use crate::prolog::machine::stack::*;
use crate::prolog::machine::streams::*;
use std::mem;
use std::ops::IndexMut;
type Trail = Vec<(Ref, HeapCellValue)>;
#[derive(Clone, Copy)]
#[derive(Debug, Clone, Copy)]
pub enum AttrVarPolicy {
DeepCopy,
StripAttributes
@@ -28,6 +27,7 @@ fn copy_term<T: CopierTarget>(target: T, addr: Addr, attr_var_policy: AttrVarPol
copy_term_state.copy_term_impl(addr);
}
#[derive(Debug)]
struct CopyTermState<T: CopierTarget> {
trail: Trail,
scan: usize,
@@ -104,7 +104,7 @@ impl<T: CopierTarget> CopyTermState<T> {
fn copy_partial_string(&mut self, addr: usize, n: usize) {
if let &HeapCellValue::Addr(Addr::PStrLocation(h, _)) = &self.target[addr] {
if h >= self.old_h {
*self.value_at_scan() = HeapCellValue::Addr(Addr::PStrLocation(h, n));
*self.value_at_scan() = HeapCellValue::Addr(Addr::PStrLocation(h, 0));
self.scan += 1;
return;
@@ -214,24 +214,6 @@ impl<T: CopierTarget> CopyTermState<T> {
}
}
fn copy_stream(&mut self, addr: usize) {
let threshold = self.target.threshold();
let trail_item = mem::replace(
&mut self.target[addr],
HeapCellValue::Addr(Addr::Stream(threshold)),
);
self.trail.push((
Ref::HeapCell(addr),
trail_item,
));
self.target.push(HeapCellValue::Stream(Stream::null_stream()));
self.scan += 1;
}
fn copy_structure(&mut self, addr: usize) {
match self.target[addr].context_free_clone() {
HeapCellValue::NamedStr(arity, name, fixity) => {
@@ -284,11 +266,12 @@ impl<T: CopierTarget> CopyTermState<T> {
*self.value_at_scan() = HeapCellValue::Addr(addr);
}
}
Addr::Lis(h) if h >= self.old_h => {
self.scan += 1;
}
Addr::Lis(h) => {
self.copy_list(h);
if h >= self.old_h {
self.scan += 1;
} else {
self.copy_list(h);
}
}
addr @ Addr::AttrVar(_) |
addr @ Addr::HeapCell(_) |
@@ -302,7 +285,7 @@ impl<T: CopierTarget> CopyTermState<T> {
self.copy_partial_string(addr, n);
}
Addr::Stream(h) => {
self.copy_stream(h);
*self.value_at_scan() = self.target[h].context_free_clone();
}
_ => {
self.scan += 1;

View File

@@ -307,6 +307,12 @@ impl Machine {
}
}
}
Addr::Usize(n) => {
n
}
Addr::Fixnum(n) => {
usize::try_from(n).unwrap()
}
_ => {
unreachable!()
}

View File

@@ -11,6 +11,7 @@ use std::mem;
use std::ops::{Index, IndexMut};
use std::ptr;
#[derive(Debug)]
pub(crate) struct StandardHeapTraits {}
impl RawBlockTraits for StandardHeapTraits {
@@ -25,6 +26,7 @@ impl RawBlockTraits for StandardHeapTraits {
}
}
#[derive(Debug)]
pub(crate) struct HeapTemplate<T: RawBlockTraits> {
buf: RawBlock<T>,
_marker: PhantomData<HeapCellValue>,
@@ -39,6 +41,7 @@ impl<T: RawBlockTraits> Drop for HeapTemplate<T> {
}
}
#[derive(Debug)]
pub(crate)
struct HeapIntoIter<T: RawBlockTraits> {
offset: usize,
@@ -72,6 +75,7 @@ impl<T: RawBlockTraits> Iterator for HeapIntoIter<T> {
}
}
#[derive(Debug)]
pub(crate)
struct HeapIter<'a, T: RawBlockTraits> {
offset: usize,
@@ -110,6 +114,7 @@ fn print_heap_terms<'a, I: Iterator<Item = &'a HeapCellValue>>(heap: I, h: usize
}
}
#[derive(Debug)]
pub(crate)
struct HeapIterMut<'a, T: RawBlockTraits> {
offset: usize,
@@ -166,21 +171,28 @@ impl<T: RawBlockTraits> HeapTemplate<T> {
&HeapCellValue::NamedStr(arity, ref name, ref op) => {
HeapCellValue::NamedStr(arity, name.clone(), op.clone())
}
&HeapCellValue::Rational(ref r) => {
HeapCellValue::Rational(r.clone())
}
&HeapCellValue::PartialString(..) => {
HeapCellValue::Addr(Addr::PStrLocation(h, 0))
}
&HeapCellValue::Rational(ref r) => {
HeapCellValue::Rational(r.clone())
}
&HeapCellValue::Stream(_) => {
HeapCellValue::Addr(Addr::Stream(h))
}
&HeapCellValue::TcpListener(_) => {
HeapCellValue::Addr(Addr::TcpListener(h))
}
}
}
#[inline]
pub(crate)
fn put_complete_string(&mut self, s: &str) -> Addr {
if s.is_empty() {
return Addr::EmptyList;
}
let addr = self.allocate_pstr(s);
self.pop();
@@ -208,9 +220,6 @@ impl<T: RawBlockTraits> HeapTemplate<T> {
Constant::Char(c) => {
Addr::Char(c)
}
Constant::CharCode(c) => {
Addr::CharCode(c)
}
Constant::EmptyList => {
Addr::EmptyList
}
@@ -280,18 +289,15 @@ impl<T: RawBlockTraits> HeapTemplate<T> {
HeapCellValue::Addr(addr) => {
addr
}
val @ HeapCellValue::Atom(..)
| val @ HeapCellValue::Integer(_)
| val @ HeapCellValue::DBRef(_)
| val @ HeapCellValue::Rational(_) => {
val @ HeapCellValue::Atom(..) |
val @ HeapCellValue::Integer(_) |
val @ HeapCellValue::DBRef(_) |
val @ HeapCellValue::Rational(_) => {
Addr::Con(self.push(val))
}
val @ HeapCellValue::NamedStr(..) => {
Addr::Str(self.push(val))
}
val @ HeapCellValue::Stream(..) => {
Addr::Stream(self.push(val))
}
HeapCellValue::PartialString(pstr, has_tail) => {
let h = self.push(HeapCellValue::PartialString(pstr, has_tail));
@@ -301,6 +307,12 @@ impl<T: RawBlockTraits> HeapTemplate<T> {
Addr::Con(h)
}
val @ HeapCellValue::Stream(..) => {
Addr::Stream(self.push(val))
}
val @ HeapCellValue::TcpListener(..) => {
Addr::TcpListener(self.push(val))
}
}
}
@@ -308,20 +320,7 @@ impl<T: RawBlockTraits> HeapTemplate<T> {
pub(crate)
fn allocate_pstr(&mut self, src: &str) -> Addr {
self.write_pstr(src)
.unwrap_or_else(|| {
let h = self.h();
self.push(HeapCellValue::PartialString(
PartialString::empty(),
true,
));
self.push(HeapCellValue::Addr(
Addr::HeapCell(h + 1)
));
Addr::PStrLocation(h, 0)
})
.unwrap_or_else(|| Addr::EmptyList)
}
#[inline]
@@ -512,7 +511,7 @@ impl<T: RawBlockTraits> HeapTemplate<T> {
pub
fn index_addr<'a>(&'a self, addr: &Addr) -> RefOrOwned<'a, HeapCellValue> {
match addr {
&Addr::Con(h) | &Addr::Str(h) | &Addr::Stream(h) => {
&Addr::Con(h) | &Addr::Str(h) | &Addr::Stream(h) | &Addr::TcpListener(h) => {
RefOrOwned::Borrowed(&self[h])
}
addr => {

View File

@@ -10,19 +10,20 @@ use std::rc::Rc;
pub(crate) type MachineStub = Vec<HeapCellValue>;
#[derive(Clone, Copy)]
#[derive(Debug, Clone, Copy)]
enum ErrorProvenance {
Constructed, // if constructed, offset the addresses.
Received, // otherwise, preserve the addresses.
}
pub(super) struct MachineError {
#[derive(Debug)]
pub(crate) struct MachineError {
stub: MachineStub,
location: Option<(usize, usize)>, // line_num, col_num
from: ErrorProvenance,
}
pub(super)
pub(crate)
trait TypeError {
fn type_error(self, h: usize, valid_type: ValidType) -> MachineError;
}
@@ -73,7 +74,7 @@ impl TypeError for Number {
}
}
pub(super)
pub(crate)
trait PermissionError {
fn permission_error(self, h: usize, index_str: &'static str, perm: Permission) -> MachineError;
}
@@ -154,6 +155,18 @@ impl MachineError {
)
}
#[inline]
pub(super)
fn interrupt_error() -> Self {
let stub = functor!("$interrupt_thrown");
MachineError {
stub,
location: None,
from: ErrorProvenance::Received,
}
}
pub(super)
fn evaluation_error(eval_error: EvalError) -> Self {
let stub = functor!("evaluation_error", [atom(eval_error.as_str())]);
@@ -237,7 +250,7 @@ impl MachineError {
from: ErrorProvenance::Constructed,
}
}
ExistenceError::SourceSink(source) => {
ExistenceError::ModuleSource(source) => {
let source_stub = source.as_functor_stub();
let stub = functor!(
@@ -252,6 +265,18 @@ impl MachineError {
from: ErrorProvenance::Constructed,
}
}
ExistenceError::SourceSink(culprit) => {
let stub = functor!(
"existence_error",
[atom("source_sink"), addr(culprit)]
);
MachineError {
stub,
location: None,
from: ErrorProvenance::Received,
}
}
ExistenceError::Stream(culprit) => {
let stub = functor!(
"existence_error",
@@ -435,47 +460,53 @@ impl MachineError {
}
}
#[derive(Clone, Copy)]
#[derive(Debug, Clone, Copy)]
pub enum Permission {
Access,
Create,
InputStream,
Modify,
Open,
OutputStream,
Reposition,
}
impl Permission {
#[inline]
pub fn as_str(self) -> &'static str {
match self {
Permission::Access => "access",
Permission::Create => "create",
Permission::InputStream => "input",
Permission::Modify => "modify",
Permission::Open => "open",
Permission::OutputStream => "output",
Permission::Reposition => "reposition",
}
}
}
// from 7.12.2 b) of 13211-1:1995
#[derive(Clone, Copy)]
#[derive(Debug, Clone, Copy)]
pub enum ValidType {
Atom,
Atomic,
// Boolean,
// Byte,
Byte,
Callable,
Character,
Compound,
Evaluable,
Float,
// InByte,
// InCharacter,
InByte,
InCharacter,
Integer,
List,
// Number,
Pair,
// PredicateIndicator,
// Variable
TcpListener,
}
impl ValidType {
@@ -484,27 +515,31 @@ impl ValidType {
ValidType::Atom => "atom",
ValidType::Atomic => "atomic",
// ValidType::Boolean => "boolean",
// ValidType::Byte => "byte",
ValidType::Byte => "byte",
ValidType::Callable => "callable",
ValidType::Character => "character",
ValidType::Compound => "compound",
ValidType::Evaluable => "evaluable",
ValidType::Float => "float",
// ValidType::InByte => "in_byte",
// ValidType::InCharacter => "in_character",
ValidType::InByte => "in_byte",
ValidType::InCharacter => "in_character",
ValidType::Integer => "integer",
ValidType::List => "list",
// ValidType::Number => "number",
ValidType::Pair => "pair",
// ValidType::PredicateIndicator => "predicate_indicator",
// ValidType::Variable => "variable"
ValidType::TcpListener => "tcp_listener",
}
}
}
#[derive(Clone, Copy)]
#[derive(Debug, Clone, Copy)]
pub enum DomainErrorType {
IOMode,
NotLessThanZero,
Order,
SourceSink,
Stream,
StreamOrAlias,
}
@@ -512,7 +547,10 @@ pub enum DomainErrorType {
impl DomainErrorType {
pub fn as_str(self) -> &'static str {
match self {
DomainErrorType::IOMode => "io_mode",
DomainErrorType::NotLessThanZero => "not_less_than_zero",
DomainErrorType::Order => "order",
DomainErrorType::SourceSink => "source_sink",
DomainErrorType::Stream => "stream",
DomainErrorType::StreamOrAlias => "stream_or_alias",
}
@@ -520,11 +558,11 @@ impl DomainErrorType {
}
// from 7.12.2 f) of 13211-1:1995
#[derive(Clone, Copy)]
#[derive(Debug, Clone, Copy)]
pub enum RepFlag {
Character,
// Character,
CharacterCode,
// InCharacterCode,
InCharacterCode,
MaxArity,
// MaxInteger,
// MinInteger
@@ -533,9 +571,9 @@ pub enum RepFlag {
impl RepFlag {
pub fn as_str(self) -> &'static str {
match self {
RepFlag::Character => "character",
// RepFlag::Character => "character",
RepFlag::CharacterCode => "character_code",
// RepFlag::InCharacterCode => "in_character_code",
RepFlag::InCharacterCode => "in_character_code",
RepFlag::MaxArity => "max_arity",
// RepFlag::MaxInteger => "max_integer",
// RepFlag::MinInteger => "min_integer"
@@ -544,7 +582,7 @@ impl RepFlag {
}
// from 7.12.2 g) of 13211-1:1995
#[derive(Clone, Copy)]
#[derive(Debug, Clone, Copy)]
pub enum EvalError {
FloatOverflow,
Undefined,
@@ -564,7 +602,7 @@ impl EvalError {
}
// used by '$skip_max_list'.
#[derive(Clone, Copy)]
#[derive(Debug, Clone, Copy)]
pub(super) enum CycleSearchResult {
EmptyList,
NotList,
@@ -666,6 +704,41 @@ impl MachineState {
self.check_for_list_pairs(sorted)
}
#[inline]
pub(crate)
fn type_error<T: TypeError>(
&self,
valid_type: ValidType,
culprit: T,
caller: ClauseName,
arity: usize,
) -> MachineStub {
let stub = MachineError::functor_stub(caller, arity);
let err = MachineError::type_error(
self.heap.h(),
valid_type,
culprit,
);
return self.error_form(err, stub);
}
#[inline]
pub(crate)
fn representation_error(
&self,
rep_flag: RepFlag,
caller: ClauseName,
arity: usize,
) -> MachineStub {
let stub = MachineError::functor_stub(caller, arity);
let err = MachineError::representation_error(
rep_flag,
);
return self.error_form(err, stub);
}
pub(super)
fn error_form(&self, err: MachineError, src: MachineStub) -> MachineStub {
let location = err.location;
@@ -708,13 +781,16 @@ impl MachineState {
}
}
#[derive(Debug)]
pub enum ExistenceError {
Module(ClauseName),
ModuleSource(ModuleSource),
Procedure(ClauseName, usize),
SourceSink(ModuleSource),
SourceSink(Addr),
Stream(Addr),
}
#[derive(Debug)]
pub enum SessionError {
CannotOverwriteBuiltIn(ClauseName),
CannotOverwriteImport(ClauseName),
@@ -727,6 +803,7 @@ pub enum SessionError {
ParserError(ParserError),
}
#[derive(Debug)]
pub enum EvalSession {
EntrySuccess,
Error(SessionError),

View File

@@ -19,18 +19,20 @@ use indexmap::IndexMap;
use std::cell::RefCell;
use std::cmp::Ordering;
use std::collections::{BTreeMap, VecDeque};
use std::collections::{BTreeMap, BTreeSet, VecDeque};
use std::convert::TryFrom;
use std::fmt;
use std::mem;
use std::net::TcpListener;
use std::ops::{Add, AddAssign, Sub, SubAssign};
use std::rc::Rc;
#[derive(Clone, PartialEq, Eq, PartialOrd, Ord, Hash)]
#[derive(Debug, Clone, PartialEq, Eq, PartialOrd, Ord, Hash)]
pub struct OrderedOpDirKey(pub ClauseName, pub Fixity);
pub type OssifiedOpDir = BTreeMap<OrderedOpDirKey, (usize, Specifier)>;
#[derive(Clone, PartialEq, Eq, Hash)]
#[derive(Debug, Clone, PartialEq, Eq, Hash)]
pub enum DBRef {
NamedPred(ClauseName, usize, Option<SharedOpDesc>),
Op(
@@ -43,7 +45,7 @@ pub enum DBRef {
}
// 7.2
#[derive(Clone, Copy, PartialEq, Eq, PartialOrd, Ord)]
#[derive(Debug, Clone, Copy, PartialEq, Eq, PartialOrd, Ord)]
pub enum TermOrderCategory {
Variable,
FloatingPoint,
@@ -52,11 +54,10 @@ pub enum TermOrderCategory {
Compound,
}
#[derive(Clone, Copy, PartialEq, Eq, Hash)]
#[derive(Debug, Clone, Copy, PartialEq, Eq, Hash)]
pub enum Addr {
AttrVar(usize),
Char(char),
CharCode(u32),
Con(usize),
CutPoint(usize),
EmptyList,
@@ -68,10 +69,11 @@ pub enum Addr {
StackCell(usize, usize),
Str(usize),
Stream(usize),
TcpListener(usize),
Usize(usize),
}
#[derive(Clone, Copy, Hash, Eq, PartialEq, PartialOrd)]
#[derive(Debug, Clone, Copy, Hash, Eq, PartialEq, PartialOrd)]
pub enum Ref {
AttrVar(usize),
HeapCell(usize),
@@ -157,7 +159,7 @@ impl Addr {
#[inline]
pub fn is_heap_bound(&self) -> bool {
match self {
Addr::Char(_) | Addr::CharCode(_) | Addr::EmptyList |
Addr::Char(_) | Addr::EmptyList |
Addr::CutPoint(_) | Addr::Usize(_) | Addr::Fixnum(_) |
Addr::Float(_) => {
false
@@ -223,13 +225,13 @@ impl Addr {
Addr::Char(_) | Addr::EmptyList => {
Some(TermOrderCategory::Atom)
}
Addr::CharCode(_) | Addr::Fixnum(_) | Addr::Usize(_) => {
Addr::Fixnum(_) | Addr::Usize(_) => {
Some(TermOrderCategory::Integer)
}
Addr::Lis(_) | Addr::PStrLocation(..) | Addr::Str(_) => {
Some(TermOrderCategory::Compound)
}
Addr::CutPoint(_) | Addr::Stream(_) => {
Addr::CutPoint(_) | Addr::Stream(_) | Addr::TcpListener(_) => {
None
}
}
@@ -237,18 +239,18 @@ impl Addr {
}
}
pub fn as_constant(&self, machine_st: &MachineState) -> Option<Constant> {
pub fn as_constant_index(&self, machine_st: &MachineState) -> Option<Constant> {
match self {
&Addr::Char(c) => {
Some(Constant::Char(c))
}
&Addr::CharCode(c) => {
Some(Constant::CharCode(c))
}
&Addr::Con(h) => {
match &machine_st.heap[h] {
&HeapCellValue::Atom(ref name, ref op) => {
Some(Constant::Atom(name.clone(), op.clone()))
&HeapCellValue::Atom(ref name, _) if name.is_char() => {
Some(Constant::Char(name.as_str().chars().next().unwrap()))
}
&HeapCellValue::Atom(ref name, _) => {
Some(Constant::Atom(name.clone(), None))
}
&HeapCellValue::Integer(ref n) => {
Some(Constant::Integer(n.clone()))
@@ -283,6 +285,9 @@ impl Addr {
None
}
}
&Addr::Usize(n) => {
Some(Constant::Usize(n))
}
_ => {
None
}
@@ -358,7 +363,7 @@ impl SubAssign<usize> for Addr {
}
}
#[derive(Clone, Copy)]
#[derive(Debug, Clone, Copy)]
pub enum TrailRef {
Ref(Ref),
AttrVarHeapLink(usize),
@@ -371,6 +376,7 @@ impl From<Ref> for TrailRef {
}
}
#[derive(Debug)]
pub enum HeapCellValue {
Addr(Addr),
Atom(ClauseName, Option<SharedOpDesc>),
@@ -380,6 +386,7 @@ pub enum HeapCellValue {
Rational(Rc<Rational>),
PartialString(PartialString, bool), // the partial string, a bool indicating whether it came from a Constant.
Stream(Stream),
TcpListener(TcpListener),
}
impl HeapCellValue {
@@ -402,6 +409,9 @@ impl HeapCellValue {
HeapCellValue::Stream(_) => {
Addr::Stream(focus)
}
HeapCellValue::TcpListener(_) => {
Addr::TcpListener(focus)
}
}
}
@@ -429,8 +439,11 @@ impl HeapCellValue {
&HeapCellValue::PartialString(ref pstr, has_tail) => {
HeapCellValue::PartialString(pstr.clone(), has_tail)
}
&HeapCellValue::Stream(_) => {
HeapCellValue::Stream(Stream::null_stream())
&HeapCellValue::Stream(ref stream) => {
HeapCellValue::Stream(stream.clone())
}
&HeapCellValue::TcpListener(_) => {
HeapCellValue::Atom(clause_name!("$tcp_listener"), None)
}
}
}
@@ -443,7 +456,7 @@ impl From<Addr> for HeapCellValue {
}
}
#[derive(Clone, Copy, Eq, PartialEq, Ord, PartialOrd)]
#[derive(Debug, Clone, Copy, Eq, PartialEq, Ord, PartialOrd)]
pub enum IndexPtr {
DynamicUndefined, // a predicate, declared as dynamic, whose location in code is as yet undefined.
Undefined,
@@ -453,7 +466,7 @@ pub enum IndexPtr {
UserTermExpansion
}
#[derive(Clone, Ord, PartialOrd, Eq, PartialEq)]
#[derive(Debug, Clone, Ord, PartialOrd, Eq, PartialEq)]
pub struct CodeIndex(pub Rc<RefCell<(IndexPtr, ClauseName)>>);
impl CodeIndex {
@@ -508,7 +521,7 @@ impl From<(usize, ClauseName)> for CodeIndex {
}
}
#[derive(Clone, Copy, PartialEq)]
#[derive(Debug, Clone, Copy, PartialEq)]
pub enum DynamicAssertPlace {
Back,
Front,
@@ -532,7 +545,7 @@ impl DynamicAssertPlace {
}
}
#[derive(Clone, Copy, PartialEq)]
#[derive(Debug, Clone, Copy, PartialEq)]
pub enum DynamicTransactionType {
Abolish,
Assert(DynamicAssertPlace),
@@ -542,7 +555,7 @@ pub enum DynamicTransactionType {
Retract, // dynamic index of the clause to remove.
}
#[derive(Clone, Copy, PartialOrd, Ord, PartialEq, Eq)]
#[derive(Debug, Clone, Copy, PartialOrd, Ord, PartialEq, Eq)]
pub enum REPLCodePtr {
CompileBatch,
UseModule,
@@ -551,7 +564,7 @@ pub enum REPLCodePtr {
UseQualifiedModuleFromFile
}
#[derive(Clone, PartialEq)]
#[derive(Debug, Clone, PartialEq)]
pub enum CodePtr {
BuiltInClause(BuiltInClauseType, LocalCodePtr), // local is the successor call.
CallN(usize, LocalCodePtr, bool), // arity, local, last call.
@@ -770,7 +783,7 @@ impl AddAssign<usize> for CodePtr {
pub type HeapVarDict = IndexMap<Rc<Var>, Addr>;
pub type AllocVarDict = IndexMap<Rc<Var>, VarData>;
#[derive(Clone)]
#[derive(Debug, Clone)]
pub struct DynamicPredicateInfo {
pub(super) clauses_subsection_p: usize, // a LocalCodePtr::DirEntry value.
}
@@ -790,6 +803,7 @@ pub type DynamicCodeDir = IndexMap<(ClauseName, ClauseName, usize), DynamicPredi
pub type GlobalVarDir = IndexMap<ClauseName, (Ball, Option<usize>)>;
#[derive(Debug)]
pub(crate) struct ModuleStub {
pub(crate) atom_tbl: TabledData<Atom>,
pub(crate) in_situ_code_dir: InSituCodeDir,
@@ -806,7 +820,9 @@ impl ModuleStub {
pub(crate) type ModuleStubDir = IndexMap<ClauseName, ModuleStub>;
pub(crate) type StreamAliasDir = IndexMap<ClauseName, Stream>;
pub(crate) type StreamDir = BTreeSet<Stream>;
#[derive(Debug)]
pub struct IndexStore {
pub(super) atom_tbl: TabledData<Atom>,
pub(super) code_dir: CodeDir,
@@ -817,6 +833,7 @@ pub struct IndexStore {
pub(super) module_dir: ModuleDir,
pub(super) modules: ModuleDir,
pub(super) op_dir: OpDir,
pub(super) streams: StreamDir,
pub(super) stream_aliases: StreamAliasDir,
}
@@ -905,6 +922,7 @@ impl IndexStore {
op_dir: default_op_dir(),
modules: ModuleDir::new(),
stream_aliases: StreamAliasDir::new(),
streams: StreamDir::new(),
}
}
@@ -957,6 +975,7 @@ impl IndexStore {
pub type CodeDir = BTreeMap<PredicateKey, CodeIndex>;
pub type TermDir = IndexMap<PredicateKey, (Predicate, VecDeque<TopLevel>)>;
#[derive(Debug)]
pub struct TermDirQuantumEntry {
pub old_terms: (Predicate, VecDeque<TopLevel>),
pub new_terms: (Predicate, VecDeque<TopLevel>),
@@ -985,6 +1004,7 @@ impl TermDirQuantumEntry {
}
}
#[derive(Debug)]
pub struct TermDirQuantum(IndexMap<PredicateKey, TermDirQuantumEntry>);
impl TermDirQuantum {
@@ -1028,7 +1048,7 @@ impl TermDirQuantum {
}
}
#[derive(Clone, Copy, PartialEq, Eq, Ord, PartialOrd)]
#[derive(Debug, Clone, Copy, PartialEq, Eq, Ord, PartialOrd)]
pub enum CompileTimeHook {
GoalExpansion,
TermExpansion,
@@ -1082,6 +1102,16 @@ pub enum RefOrOwned<'a, T: 'a> {
Owned(T),
}
impl<'a, T: 'a + fmt::Debug> fmt::Debug for RefOrOwned<'a, T> {
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
match self {
&RefOrOwned::Borrowed(ref borrowed) =>
write!(f, "Borrowed({:?})", borrowed),
&RefOrOwned::Owned(ref owned) => write!(f, "Owned({:?})", owned),
}
}
}
impl<'a, T> RefOrOwned<'a, T> {
pub fn as_ref(&'a self) -> &'a T {
match self {

View File

@@ -12,7 +12,6 @@ use crate::prolog::machine::machine_indices::*;
use crate::prolog::machine::modules::*;
use crate::prolog::machine::stack::*;
use crate::prolog::machine::streams::*;
use crate::prolog::read::readline;
use crate::prolog::rug::Integer;
use downcast::Any;
@@ -21,10 +20,12 @@ use indexmap::{IndexMap, IndexSet};
use std::cmp::Ordering;
use std::convert::TryFrom;
use std::fmt;
use std::io::Write;
use std::mem;
use std::ops::{Index, IndexMut};
#[derive(Debug)]
pub(crate) struct HeapPStrIter<'a> {
focus: Addr,
machine_st: &'a MachineState,
@@ -43,7 +44,7 @@ impl<'a> HeapPStrIter<'a> {
#[inline]
pub(crate)
fn focus(&'a self) -> Addr {
fn focus(&self) -> Addr {
self.machine_st.store(self.machine_st.deref(self.focus))
}
@@ -74,7 +75,7 @@ impl<'a> HeapPStrIter<'a> {
}
}
#[derive(Clone, Copy)]
#[derive(Debug, Clone, Copy)]
pub(crate) enum PStrIteratee {
Char(char),
PStrSegment(usize, usize),
@@ -147,6 +148,116 @@ impl<'a> Iterator for HeapPStrIter<'a> {
}
}
#[inline]
pub(super)
fn compare_pstr_prefixes<'a>(
i1: &mut HeapPStrIter<'a>,
i2: &mut HeapPStrIter<'a>,
) -> Option<Ordering> {
let mut r1 = i1.next();
let mut r2 = i2.next();
loop {
if let Some(r1i) = r1 {
if let Some(r2i) = r2 {
match (r1i, r2i) {
(PStrIteratee::Char(c1), PStrIteratee::Char(c2)) => {
if c1 != c2 {
return c1.partial_cmp(&c2);
}
}
(PStrIteratee::Char(c1), PStrIteratee::PStrSegment(h, n)) => {
if let &HeapCellValue::PartialString(ref pstr, _) = &i2.machine_st.heap[h] {
if let Some(c2) = pstr.as_str_from(n).chars().next() {
if c1 != c2 {
return c1.partial_cmp(&c2);
} else {
r1 = i1.next();
r2 = Some(PStrIteratee::PStrSegment(h, n + c2.len_utf8()));
continue;
}
} else {
r2 = i2.next();
continue;
}
} else {
unreachable!()
}
}
(PStrIteratee::PStrSegment(h, n), PStrIteratee::Char(c2)) => {
if let &HeapCellValue::PartialString(ref pstr, _) = &i1.machine_st.heap[h] {
if let Some(c1) = pstr.as_str_from(n).chars().next() {
if c1 != c2 {
return c2.partial_cmp(&c1);
} else {
r1 = i1.next();
r2 = Some(PStrIteratee::PStrSegment(h, n + c1.len_utf8()));
continue;
}
} else {
r1 = i1.next();
continue;
}
} else {
unreachable!()
}
}
(PStrIteratee::PStrSegment(h1, n1), PStrIteratee::PStrSegment(h2, n2)) => {
match (&i1.machine_st.heap[h1], &i2.machine_st.heap[h2]) {
(
&HeapCellValue::PartialString(ref pstr1, _),
&HeapCellValue::PartialString(ref pstr2, _),
) => {
let str1 = pstr1.as_str_from(n1);
let str2 = pstr2.as_str_from(n2);
if str1.starts_with(str2) {
r1 = Some(PStrIteratee::PStrSegment(h1, n1 + str2.len()));
r2 = i2.next();
continue;
} else if str2.starts_with(str1) {
r1 = i1.next();
r2 = Some(PStrIteratee::PStrSegment(h2, n2 + str1.len()));
continue;
} else {
return str1.partial_cmp(str2);
}
}
_ => {
unreachable!()
}
}
}
}
r1 = i1.next();
r2 = i2.next();
continue;
}
}
return match (i1.focus(), i2.focus()) {
(Addr::EmptyList, Addr::EmptyList) => {
Some(Ordering::Equal)
}
(Addr::EmptyList, _) => {
Some(Ordering::Less)
}
(_, Addr::EmptyList) => {
Some(Ordering::Greater)
}
_ => {
None
}
};
}
}
#[inline]
pub(super)
fn compare_pstr_to_string<'a>(
@@ -165,7 +276,7 @@ fn compare_pstr_to_string<'a>(
s_offset += c1.len_utf8();
}
} else {
return None;
return Some(s_offset);
}
}
PStrIteratee::PStrSegment(h, n) => {
@@ -191,11 +302,16 @@ fn compare_pstr_to_string<'a>(
}
}
}
if s[s_offset ..].is_empty() {
return Some(s_offset);
}
}
Some(s_offset)
}
#[derive(Debug)]
pub struct Ball {
pub(super) boundary: usize,
pub(super) stub: Heap,
@@ -247,6 +363,7 @@ impl Ball {
}
}
#[derive(Debug)]
pub(super) struct CopyTerm<'a> {
state: &'a mut MachineState,
}
@@ -294,6 +411,7 @@ impl<'a> CopierTarget for CopyTerm<'a> {
}
}
#[derive(Debug)]
pub(super) struct CopyBallTerm<'a> {
stack: &'a mut Stack,
heap: &'a mut Heap,
@@ -419,13 +537,13 @@ impl IndexMut<RegType> for MachineState {
pub type Registers = Vec<Addr>;
#[derive(Clone, Copy)]
#[derive(Debug, Clone, Copy)]
pub(super) enum MachineMode {
Read,
Write,
}
#[derive(Clone)]
#[derive(Debug, Clone)]
pub(super) enum HeapPtr {
HeapCell(usize),
PStrChar(usize, usize),
@@ -466,6 +584,7 @@ impl Default for HeapPtr {
}
}
#[derive(Debug)]
pub struct MachineState {
pub(super) s: HeapPtr,
pub(super) p: CodePtr,
@@ -497,56 +616,131 @@ impl MachineState {
pub(crate)
fn read_term(
&mut self,
current_input_stream: &mut Stream,
mut stream: Stream,
indices: &mut IndexStore,
) -> CallResult {
match self.read(
&mut parsing_stream(current_input_stream.clone()),
indices.atom_tbl.clone(),
&indices.op_dir,
) {
Ok(term_write_result) => {
let a1 = self[temp_v!(1)];
self.unify(Addr::HeapCell(term_write_result.heap_loc), a1);
self.check_stream_properties(
&mut stream,
StreamType::Text,
Some(self[temp_v!(2)]),
clause_name!("read_term"),
3,
)?;
if self.fail {
return Ok(());
}
let mut list_of_var_eqs = vec![];
for (var, binding) in term_write_result.var_dict.into_iter().rev() {
let var_atom = clause_name!(var.to_string(), indices.atom_tbl);
let h = self.heap.h();
let spec = fetch_atom_op_spec(clause_name!("="), None, &indices.op_dir);
self.heap.push(HeapCellValue::NamedStr(2, clause_name!("="), spec));
self.heap.push(HeapCellValue::Atom(var_atom, None));
self.heap.push(HeapCellValue::Addr(binding));
list_of_var_eqs.push(Addr::Str(h));
}
let a2 = self[temp_v!(2)];
let list_offset =
Addr::HeapCell(self.heap.to_list(list_of_var_eqs.into_iter()));
Ok(self.unify(list_offset, a2))
if stream.past_end_of_stream() {
if EOFAction::Reset != stream.options.eof_action {
return return_from_clause!(self.last_call, self);
} else if self.fail {
return Ok(());
}
Err(err) => {
if let ParserError::UnexpectedEOF = err {
std::process::exit(0);
}
let mut orig_stream = stream.clone();
let mut stream = self.open_parsing_stream(stream, "read_term", 3)?;
loop {
match self.read(
&mut stream,
indices.atom_tbl.clone(),
&indices.op_dir,
) {
Ok(term_write_result) => {
let term = self[temp_v!(2)];
self.unify(Addr::HeapCell(term_write_result.heap_loc), term);
if self.fail {
return Ok(());
}
let mut list_of_var_eqs = vec![];
for (var, binding) in term_write_result.var_dict.into_iter() {
let var_atom = clause_name!(var.to_string(), indices.atom_tbl);
let h = self.heap.h();
let spec = fetch_atom_op_spec(clause_name!("="), None, &indices.op_dir);
self.heap.push(HeapCellValue::NamedStr(2, clause_name!("="), spec));
self.heap.push(HeapCellValue::Atom(var_atom, None));
self.heap.push(HeapCellValue::Addr(binding));
list_of_var_eqs.push(Addr::Str(h));
}
let mut var_set: IndexMap<Ref, bool> = IndexMap::new();
for addr in self.acyclic_pre_order_iter(term) {
if let Some(var) = addr.as_var() {
if !var_set.contains_key(&var) {
var_set.insert(var, true);
} else {
var_set.insert(var, false);
}
}
}
let mut var_list = vec![];
let mut singleton_var_list = vec![];
for addr in self.acyclic_pre_order_iter(term) {
if let Some(var) = addr.as_var() {
if var_set.get(&var) == Some(&true) {
singleton_var_list.push(var.as_addr());
}
var_list.push(var.as_addr());
}
}
let singleton_addr = self[temp_v!(3)];
let singletons_offset =
Addr::HeapCell(self.heap.to_list(singleton_var_list.into_iter()));
self.unify(singletons_offset, singleton_addr);
if self.fail {
return Ok(());
}
let vars_addr = self[temp_v!(4)];
let vars_offset =
Addr::HeapCell(self.heap.to_list(var_list.into_iter()));
self.unify(vars_offset, vars_addr);
if self.fail {
return Ok(());
}
let var_names_addr = self[temp_v!(5)];
let var_names_offset =
Addr::HeapCell(self.heap.to_list(list_of_var_eqs.into_iter()));
return Ok(self.unify(var_names_offset, var_names_addr));
}
Err(err) => {
if let ParserError::UnexpectedEOF = err {
self.eof_action(
self[temp_v!(2)],
&mut orig_stream,
clause_name!("read_term"),
3
)?;
// reset the input stream after an input failure.
*current_input_stream = readline::input_stream();
if orig_stream.options.eof_action == EOFAction::Reset {
if self.fail == false {
continue;
}
}
let h = self.heap.h();
let syntax_error = MachineError::syntax_error(h, err);
let stub = MachineError::functor_stub(clause_name!("read_term"), 2);
return Ok(());
}
Err(self.error_form(syntax_error, stub))
let stub = MachineError::functor_stub(clause_name!("read_term"), 3);
let err = MachineError::syntax_error(self.heap.h(), err);
return Err(self.error_form(err, stub));
}
}
}
}
@@ -557,10 +751,10 @@ impl MachineState {
op_dir: &'a OpDir,
) -> Result<Option<HCPrinter<'a, PrinterOutputter>>, MachineStub>
{
let ignore_ops = self.store(self.deref(self[temp_v!(2)]));
let numbervars = self.store(self.deref(self[temp_v!(3)]));
let quoted = self.store(self.deref(self[temp_v!(4)]));
let max_depth = self.store(self.deref(self[temp_v!(6)]));
let ignore_ops = self.store(self.deref(self[temp_v!(3)]));
let numbervars = self.store(self.deref(self[temp_v!(4)]));
let quoted = self.store(self.deref(self[temp_v!(5)]));
let max_depth = self.store(self.deref(self[temp_v!(7)]));
let mut printer = HCPrinter::new(&self, op_dir, PrinterOutputter::new());
@@ -610,7 +804,7 @@ impl MachineState {
let stub = MachineError::functor_stub(clause_name!("write_term"), 2);
match self.try_from_list(temp_v!(5), stub) {
match self.try_from_list(temp_v!(6), stub) {
Ok(addrs) => {
let mut var_names: IndexMap<Addr, String> = IndexMap::new();
@@ -643,9 +837,11 @@ impl MachineState {
var_names.insert(var, atom);
}
_ => unreachable!(),
_ => {
}
},
_ => unreachable!(),
_ => {
}
}
}
@@ -824,7 +1020,7 @@ fn try_in_situ(
pub(crate) type CallResult = Result<(), Vec<HeapCellValue>>;
pub(crate) trait CallPolicy: Any {
pub(crate) trait CallPolicy: Any + fmt::Debug {
fn retry_me_else(&mut self, machine_st: &mut MachineState, offset: usize) -> CallResult {
let b = machine_st.b;
let n = machine_st.stack.index_or_frame(b).prelude.univ_prelude.num_cells;
@@ -1076,10 +1272,38 @@ pub(crate) trait CallPolicy: Any {
return_from_clause!(machine_st.last_call, machine_st)
}
&BuiltInClauseType::Compare => {
let a1 = machine_st[temp_v!(1)];
let a1 = machine_st.store(machine_st.deref(machine_st[temp_v!(1)]));
let a2 = machine_st[temp_v!(2)];
let a3 = machine_st[temp_v!(3)];
match a1 {
Addr::Con(h) if machine_st.heap.atom_at(h) => {
if let HeapCellValue::Atom(ref atom, _) = &machine_st.heap[h] {
match atom.as_str() {
">" | "<" | "=" => {
}
_ => {
let stub =
MachineError::functor_stub(clause_name!("compare"), 3);
let err = MachineError::domain_error(DomainErrorType::Order, a1);
return Err(machine_st.error_form(err, stub));
}
}
} else {
unreachable!()
}
}
addr if !addr.is_ref() => {
let h = machine_st.heap.h();
let stub = MachineError::functor_stub(clause_name!("compare"), 3);
let err = MachineError::type_error(h, ValidType::Atom, a1);
return Err(machine_st.error_form(err, stub));
}
_ => {
}
}
let atom = match machine_st.compare_term_test(&a2, &a3) {
Some(Ordering::Greater) => {
let spec = fetch_atom_op_spec(clause_name!(">"), None, &indices.op_dir);
@@ -1113,8 +1337,14 @@ pub(crate) trait CallPolicy: Any {
return_from_clause!(machine_st.last_call, machine_st)
}
&BuiltInClauseType::Read => {
let mut stream = machine_st.open_parsing_stream(
current_input_stream.clone(),
"read",
1,
)?;
match machine_st.read(
&mut parsing_stream(current_input_stream.clone()),
&mut stream,
indices.atom_tbl.clone(),
&indices.op_dir,
) {
@@ -1122,6 +1352,15 @@ pub(crate) trait CallPolicy: Any {
let addr = machine_st[temp_v!(1)];
machine_st.unify(addr, Addr::HeapCell(offset.heap_loc));
}
Err(ParserError::UnexpectedEOF) => {
let addr = machine_st[temp_v!(1)];
let eof = clause_name!("end_of_file".to_string(),
indices.atom_tbl);
let atom = machine_st.heap.to_unifiable(
HeapCellValue::Atom(eof, None)
);
machine_st.unify(addr, atom);
}
Err(e) => {
let h = machine_st.heap.h();
let stub = MachineError::functor_stub(clause_name!("read"), 1);
@@ -1379,10 +1618,12 @@ impl CallPolicy for CWILCallPolicy {
downcast!(dyn CallPolicy);
#[derive(Debug)]
pub(crate) struct DefaultCallPolicy {}
impl CallPolicy for DefaultCallPolicy {}
#[derive(Debug)]
pub(crate) struct CWILCallPolicy {
pub(crate) prev_policy: Box<dyn CallPolicy>,
count: Integer,
@@ -1463,7 +1704,7 @@ impl CWILCallPolicy {
}
}
pub(crate) trait CutPolicy: Any {
pub(crate) trait CutPolicy: Any + fmt::Debug {
// returns true iff we fail or cut redirected the MachineState's p itself
fn cut(&mut self, machine_st: &mut MachineState, r: RegType) -> bool;
}
@@ -1489,6 +1730,7 @@ fn cut_body(machine_st: &mut MachineState, addr: &Addr) -> bool {
false
}
#[derive(Debug)]
pub(crate) struct DefaultCutPolicy {}
pub(super) fn deref_cut(machine_st: &mut MachineState, r: RegType) {
@@ -1503,6 +1745,7 @@ impl CutPolicy for DefaultCutPolicy {
}
}
#[derive(Debug)]
pub(crate) struct SCCCutPolicy {
// locations of cleaners, cut points, the previous block
cont_pts: Vec<(Addr, usize, usize)>,

View File

@@ -281,19 +281,18 @@ impl MachineState {
(Addr::PStrLocation(h1, n1), Addr::PStrLocation(h2, n2)) => {
if let &HeapCellValue::PartialString(ref pstr1, has_tail_1) = &self.heap[h1] {
if let &HeapCellValue::PartialString(ref pstr2, has_tail_2) = &self.heap[h2] {
let pstr1_iter = pstr1.range_from(n1 ..);
let pstr2_iter = pstr2.range_from(n2 ..);
let pstr1_s = pstr1.as_str_from(n1);
let pstr2_s = pstr2.as_str_from(n2);
let mut m_len = 0;
for (c1, c2) in pstr1_iter.zip(pstr2_iter) {
if c1 != c2 {
let m_len =
if pstr1_s.starts_with(pstr2_s) {
pstr2_s.len()
} else if pstr2_s.starts_with(pstr1_s) {
pstr1_s.len()
} else {
self.fail = true;
return;
}
m_len += c1.len_utf8();
}
};
if pstr1.at_end(n1 + m_len) {
if has_tail_1 {
@@ -499,19 +498,18 @@ impl MachineState {
(Addr::PStrLocation(h1, n1), Addr::PStrLocation(h2, n2)) => {
if let &HeapCellValue::PartialString(ref pstr1, has_tail_1) = &self.heap[h1] {
if let &HeapCellValue::PartialString(ref pstr2, has_tail_2) = &self.heap[h2] {
let pstr1_iter = pstr1.range_from(n1 ..);
let pstr2_iter = pstr2.range_from(n2 ..);
let pstr1_s = pstr1.as_str_from(n1);
let pstr2_s = pstr2.as_str_from(n2);
let mut m_len = 0;
for (c1, c2) in pstr1_iter.zip(pstr2_iter) {
if c1 != c2 {
let m_len =
if pstr1_s.starts_with(pstr2_s) {
pstr2_s.len()
} else if pstr2_s.starts_with(pstr1_s) {
pstr1_s.len()
} else {
self.fail = true;
return;
}
m_len += c1.len_utf8();
}
};
if pstr1.at_end(n1 + m_len) {
if has_tail_1 {
@@ -798,7 +796,7 @@ impl MachineState {
if let Some(var) = addr.as_var() {
self.bind(var, Addr::EmptyList);
} else {
self.fail = true;
self.fail = addr != Addr::EmptyList;
}
}
}
@@ -806,9 +804,7 @@ impl MachineState {
}
Some(prefix_len) => {
match heap_pstr_iter.focus() {
addr @ Addr::AttrVar(_) |
addr @ Addr::StackCell(..) |
addr @ Addr::HeapCell(_) => {
addr if addr.is_ref() => {
let h = self.heap.h();
let pstr_addr =
@@ -1402,9 +1398,11 @@ impl MachineState {
let addr = self.store(self.deref(addr));
let offset = match addr {
Addr::HeapCell(_) | Addr::StackCell(..) |
Addr::AttrVar(..) | Addr::Stream(_) => {
v
Addr::Stream(_) | Addr::TcpListener(_) => {
0
}
Addr::HeapCell(_) | Addr::StackCell(..) | Addr::AttrVar(..) => {
v
}
Addr::PStrLocation(..) => {
if !self.flags.double_quotes.is_atom() {
@@ -1413,7 +1411,7 @@ impl MachineState {
c
}
}
Addr::Char(_) | Addr::CharCode(_) | Addr::Con(_) | Addr::CutPoint(_) |
Addr::Char(_) | Addr::Con(_) | Addr::CutPoint(_) |
Addr::EmptyList | Addr::Fixnum(_) | Addr::Float(_) | Addr::Usize(_) => {
c
}
@@ -1435,7 +1433,7 @@ impl MachineState {
let addr = self.store(self.deref(addr));
let offset =
match addr.as_constant(&self) {
match addr.as_constant_index(&self) {
Some(c) => {
match hm.get(&c) {
Some(offset) => *offset,
@@ -1494,9 +1492,13 @@ impl MachineState {
&QueryInstruction::PutPartialString(_, ref string, reg, has_tail) => {
let pstr_addr =
if has_tail {
let pstr_addr = self.heap.allocate_pstr(&string);
self.heap.pop(); // the tail will be added by the next instruction.
pstr_addr
if !string.is_empty() {
let pstr_addr = self.heap.allocate_pstr(&string);
self.heap.pop(); // the tail will be added by the next instruction.
pstr_addr
} else {
Addr::EmptyList
}
} else {
self.heap.put_complete_string(&string)
};
@@ -1595,7 +1597,8 @@ impl MachineState {
);
}
pub(super) fn handle_internal_call_n(&mut self, arity: usize) {
pub(super)
fn handle_internal_call_n(&mut self, arity: usize) {
let arity = arity + 1;
let pred = self.registers[1];
@@ -1611,7 +1614,8 @@ impl MachineState {
self.fail = true;
}
pub(super) fn setup_call_n(&mut self, arity: usize) -> Option<PredicateKey> {
pub(super)
fn setup_call_n(&mut self, arity: usize) -> Option<PredicateKey> {
let addr = self.store(self.deref(self.registers[arity]));
let (name, narity) = match addr {
@@ -1621,7 +1625,7 @@ impl MachineState {
if let HeapCellValue::NamedStr(narity, name, _) = result {
let stub = MachineError::functor_stub(clause_name!("call"), arity + 1);
if narity + arity > 63 {
if narity + arity > MAX_ARITY {
let representation_error = self.error_form(
MachineError::representation_error(RepFlag::MaxArity),
stub,
@@ -1886,8 +1890,28 @@ impl MachineState {
if !self.flags.double_quotes.is_atom() => {
continue;
}
(Addr::PStrLocation(..), Addr::PStrLocation(..)) => {
continue;
(pstr1 @ Addr::PStrLocation(..), pstr2 @ Addr::PStrLocation(..)) => {
let mut i1 = self.heap_pstr_iter(pstr1);
let mut i2 = self.heap_pstr_iter(pstr2);
let ordering = compare_pstr_prefixes(&mut i1, &mut i2);
if let Some(ordering) = ordering {
if ordering != Ordering::Equal {
return true;
}
}
let (lstack, rstack) = iter.stack();
lstack.pop();
lstack.pop();
rstack.pop();
rstack.pop();
lstack.push(i1.focus());
rstack.push(i2.focus());
}
(Addr::Lis(_), Addr::Lis(_)) => {
continue;
@@ -1938,15 +1962,6 @@ impl MachineState {
}
}
}
(Addr::CharCode(n1), v2) | (v2, Addr::CharCode(n1)) => {
if let Ok(n2) = Number::try_from((v2, &self.heap)) {
if let Some(n2) = n2.to_u32() {
if n1 != n2 {
return true;
}
}
}
}
(a1, a2) => {
if let Ok(n1) = Number::try_from((a1, &self.heap)) {
if let Ok(n2) = Number::try_from((a2, &self.heap)) {
@@ -1969,7 +1984,8 @@ impl MachineState {
iter.first_to_expire != Ordering::Equal
}
pub(super) fn compare_term_test(&self, a1: &Addr, a2: &Addr) -> Option<Ordering> {
pub(super)
fn compare_term_test(&self, a1: &Addr, a2: &Addr) -> Option<Ordering> {
let mut iter = self.zipped_acyclic_pre_order_iter(*a1, *a2);
while let Some((v1, v2)) = iter.next() {
@@ -2115,42 +2131,6 @@ impl MachineState {
unreachable!()
}
}
(
Addr::Con(h),
Addr::CharCode(c),
) => {
let c = std::char::from_u32(c).unwrap();
if let HeapCellValue::Atom(ref n1, _) = &self.heap[h] {
if n1.is_char() {
if n1.as_str().chars().next() != Some(c) {
return Some(n1.as_str().chars().next().cmp(&Some(c)));
}
} else {
return Some(Ordering::Greater);
}
} else {
unreachable!()
}
}
(
Addr::CharCode(c),
Addr::Con(h),
) => {
let c = std::char::from_u32(c).unwrap();
if let HeapCellValue::Atom(ref n1, _) = &self.heap[h] {
if n1.is_char() {
if n1.as_str().chars().next() != Some(c) {
return Some(Some(c).cmp(&n1.as_str().chars().next()));
}
} else {
return Some(Ordering::Less);
}
} else {
unreachable!()
}
}
(
Addr::EmptyList,
Addr::Con(h),
@@ -2183,34 +2163,6 @@ impl MachineState {
return Some(c1.cmp(&c2));
}
}
(
Addr::CharCode(c1),
Addr::CharCode(c2),
) => {
if c1 != c2 {
return Some(c1.cmp(&c2));
}
}
(
Addr::Char(c1),
Addr::CharCode(c2),
) => {
let c2 = std::char::from_u32(c2).unwrap();
if c1 != c2 {
return Some(c1.cmp(&c2));
}
}
(
Addr::CharCode(c1),
Addr::Char(c2),
) => {
let c1 = std::char::from_u32(c1).unwrap();
if c1 != c2 {
return Some(c1.cmp(&c2));
}
}
(
Addr::Char(c),
Addr::EmptyList,
@@ -2231,30 +2183,6 @@ impl MachineState {
Some('['.cmp(&c))
};
}
(
Addr::CharCode(c),
Addr::EmptyList,
) => {
let c = std::char::from_u32(c).unwrap();
return if c == '[' {
Some(Ordering::Less)
} else {
Some(c.cmp(&'['))
};
}
(
Addr::EmptyList,
Addr::CharCode(c),
) => {
let c = std::char::from_u32(c).unwrap();
return if c == '[' {
Some(Ordering::Greater)
} else {
Some('['.cmp(&c))
};
}
(
Addr::EmptyList,
Addr::EmptyList,
@@ -2273,9 +2201,30 @@ impl MachineState {
) => {
}
(
Addr::PStrLocation(..),
Addr::PStrLocation(..),
pstr1 @ Addr::PStrLocation(..),
pstr2 @ Addr::PStrLocation(..),
) => {
let mut i1 = self.heap_pstr_iter(pstr1);
let mut i2 = self.heap_pstr_iter(pstr2);
let ordering = compare_pstr_prefixes(&mut i1, &mut i2);
if let Some(ordering) = ordering {
if ordering != Ordering::Equal {
return Some(ordering);
}
} else {
let (lstack, rstack) = iter.stack();
lstack.pop();
lstack.pop();
rstack.pop();
rstack.pop();
lstack.push(i1.focus());
rstack.push(i2.focus());
}
}
(
Addr::Str(h1),
@@ -2400,7 +2349,12 @@ impl MachineState {
let d = self.store(self.deref(self[r1]));
match d {
Addr::Con(_) => self.p += 1,
Addr::Char(_) |
Addr::Con(_) |
Addr::EmptyList |
Addr::Fixnum(_) |
Addr::Float(_) |
Addr::Usize(_) => self.p += 1,
_ => self.fail = true,
};
}
@@ -2423,9 +2377,6 @@ impl MachineState {
}
_ => {
match d {
Addr::CharCode(_) => {
self.p += 1;
}
Addr::Char(_) if self.flags.double_quotes.is_codes() => {
self.p += 1;
}
@@ -2553,7 +2504,7 @@ impl MachineState {
Addr::Stream(_) => {
self.fail = true;
}
Addr::Char(_) | Addr::CharCode(_) | Addr::Con(_) | Addr::Fixnum(_) |
Addr::Char(_) | Addr::Con(_) | Addr::Fixnum(_) |
Addr::Float(_) | Addr::EmptyList | Addr::Usize(_) => {
self.try_functor_unify_components(a1, 0);
}
@@ -2589,9 +2540,6 @@ impl MachineState {
},
_ =>
match arity {
Addr::CharCode(c) => {
Some(c as isize)
}
arity => {
return Err(
self.error_form(
@@ -2633,7 +2581,7 @@ impl MachineState {
}
match name {
Addr::Char(_) | Addr::CharCode(_) | Addr::Con(_) | Addr::Fixnum(_) | Addr::Float(_) |
Addr::Char(_) | Addr::Con(_) | Addr::Fixnum(_) | Addr::Float(_) |
Addr::EmptyList | Addr::PStrLocation(..) | Addr::Usize(_) if arity == 0 => {
self.unify(a1, name);
}
@@ -2700,6 +2648,51 @@ impl MachineState {
*list = result;
}
pub(super)
fn integers_to_bytevec(
&self,
r: RegType,
caller: MachineStub,
) -> Vec<u8> {
let mut bytes: Vec<u8> = Vec::new();
match self.try_from_list(r, caller) {
Err(_) => { unreachable!() }
Ok(addrs) => {
for addr in addrs {
let addr = self.store(self.deref(addr));
match Number::try_from((addr, &self.heap)) {
Ok(Number::Fixnum(n)) => {
match u8::try_from(n) {
Ok(b) => {
bytes.push(b);
}
Err(_) => { }
}
continue;
}
Ok(Number::Integer(n)) => {
if let Some(b) = n.to_u8() {
bytes.push(b);
}
continue;
}
_ => {
}
}
}
}
}
bytes
}
pub(super)
fn try_from_list(
&self,
@@ -2862,7 +2855,8 @@ impl MachineState {
}
}
pub(super) fn copy_term(&mut self, attr_var_policy: AttrVarPolicy) {
pub(super)
fn copy_term(&mut self, attr_var_policy: AttrVarPolicy) {
let old_h = self.heap.h();
let a1 = self[temp_v!(1)];
@@ -2874,7 +2868,8 @@ impl MachineState {
}
// returns true on failure.
pub(super) fn structural_eq_test(&self) -> bool {
pub(super)
fn structural_eq_test(&self) -> bool {
let a1 = self[temp_v!(1)];
let a2 = self[temp_v!(2)];
@@ -3083,6 +3078,14 @@ impl MachineState {
self.p += 1;
}
fn throw_interrupt_exception(&mut self) {
let err = MachineError::interrupt_error();
let src = functor!("repl");
let err = self.error_form(err, src);
self.throw_exception(err);
}
fn handle_call_clause(
&mut self,
indices: &mut IndexStore,
@@ -3099,8 +3102,7 @@ impl MachineState {
let interrupted = INTERRUPT.load(std::sync::atomic::Ordering::Relaxed);
if INTERRUPT.compare_and_swap(interrupted, false, std::sync::atomic::Ordering::Relaxed) {
self.reset();
self.fail = true;
self.throw_interrupt_exception();
return;
}
@@ -3160,7 +3162,8 @@ impl MachineState {
self.last_call = false;
}
pub(super) fn execute_ctrl_instr(
pub(super)
fn execute_ctrl_instr(
&mut self,
indices: &mut IndexStore,
code_repo: &CodeRepo,

View File

@@ -53,6 +53,7 @@ use std::path::PathBuf;
use std::rc::Rc;
use std::sync::atomic::AtomicBool;
#[derive(Debug)]
pub struct MachinePolicies {
call_policy: Box<dyn CallPolicy>,
cut_policy: Box<dyn CutPolicy>,
@@ -72,6 +73,14 @@ impl MachinePolicies {
}
}
impl Default for MachinePolicies {
#[inline]
fn default() -> Self {
MachinePolicies::new()
}
}
#[derive(Debug)]
pub struct Machine {
pub(super) machine_st: MachineState,
pub(super) inner_heap: Heap,
@@ -288,7 +297,7 @@ impl Machine {
Ok(self.indices.insert_module(module))
} else {
let err = ExistenceError::SourceSink(ModuleSource::File(
let err = ExistenceError::ModuleSource(ModuleSource::File(
clause_name!("$toplevel"),
));
@@ -306,7 +315,10 @@ impl Machine {
if path.is_file() {
let file_src = match File::open(&path) {
Ok(file_handle) => Stream::from(file_handle),
Ok(file_handle) => Stream::from_file_as_input(
clause_name!(".scryerrc"),
file_handle,
),
Err(_) => return,
};
@@ -340,24 +352,21 @@ impl Machine {
}
pub fn run_top_level(&mut self) {
use std::env;
use std::env;
let mut filename_atoms = vec![];
let mut arg_pstrs = vec![];
// the first of these is the path to the scryer-prolog executable, so skip
// it.
for filename in env::args().skip(1) {
let atom = clause_name!(filename, self.indices.atom_tbl);
filename_atoms.push(HeapCellValue::Atom(atom, None));
}
for arg in env::args() {
arg_pstrs.push(self.machine_st.heap.put_complete_string(&arg));
}
let list_addr =
Addr::HeapCell(self.machine_st.heap.to_list(filename_atoms.into_iter()));
let list_addr = Addr::HeapCell(self.machine_st.heap.to_list(arg_pstrs.into_iter()));
self.machine_st[temp_v!(1)] = list_addr;
self.machine_st[temp_v!(1)] = list_addr;
self.machine_st.p = CodePtr::Local(LocalCodePtr::DirEntry(self.toplevel_idx));
self.run_query();
loop {
self.machine_st.p = CodePtr::Local(LocalCodePtr::DirEntry(self.toplevel_idx));
self.run_query();
}
}
pub fn new(current_input_stream: Stream, current_output_stream: Stream) -> Self
@@ -403,6 +412,15 @@ impl Machine {
)
);
compile_user_module(&mut wam,
Stream::from(PAIRS),
true,
ListingSource::from_file_and_path(
clause_name!("pairs"),
lib_path.clone(),
)
);
compile_user_module(&mut wam,
Stream::from(LISTS),
true,
@@ -430,15 +448,49 @@ impl Machine {
)
);
compile_user_module(&mut wam,
Stream::from(CHARSIO),
true,
ListingSource::from_file_and_path(
clause_name!("si"),
lib_path.clone(),
)
);
if wam.compile_top_level().is_err() {
panic!("Loading '$toplevel' module failed");
}
wam.compile_scryerrc();
wam.configure_streams();
wam
}
pub fn configure_streams(&mut self) {
self.current_input_stream.options.alias = Some(clause_name!("user_input"));
self.indices.stream_aliases.insert(
clause_name!("user_input"),
self.current_input_stream.clone(),
);
self.indices.streams.insert(
self.current_input_stream.clone()
);
self.current_output_stream.options.alias = Some(clause_name!("user_output"));
self.indices.stream_aliases.insert(
clause_name!("user_output"),
self.current_output_stream.clone(),
);
self.indices.streams.insert(
self.current_output_stream.clone()
);
}
#[inline]
pub fn machine_flags(&self) -> MachineFlags {
self.machine_st.flags
@@ -625,8 +677,12 @@ impl Machine {
let addr = self.machine_st.store(self.machine_st.deref(module_spec));
match self.machine_st.heap.index_addr(&addr).as_ref() {
HeapCellValue::Atom(name, _) => name.clone(),
_ => unreachable!(),
HeapCellValue::Atom(name, _) =>
name.clone(),
HeapCellValue::Addr(Addr::Char(c)) =>
clause_name!(c.to_string(), self.indices.atom_tbl),
_ =>
unreachable!(),
}
};
@@ -672,8 +728,12 @@ impl Machine {
let addr = self.machine_st.store(self.machine_st.deref(module_spec));
match self.machine_st.heap.index_addr(&addr).as_ref() {
HeapCellValue::Atom(name, _) => name.clone(),
_ => unreachable!(),
HeapCellValue::Atom(name, _) =>
name.clone(),
HeapCellValue::Addr(Addr::Char(c)) =>
clause_name!(c.to_string(), self.indices.atom_tbl),
_ =>
unreachable!(),
}
};

View File

@@ -48,6 +48,7 @@ impl Module {
(te.0)
.0
.extend((self.user_term_expansions.0).0.iter().cloned());
te.1.extend(self.user_term_expansions.1.iter().cloned());
}
@@ -60,6 +61,7 @@ impl Module {
(ge.0)
.0
.extend((self.user_goal_expansions.0).0.iter().cloned());
ge.1.extend(self.user_goal_expansions.1.iter().cloned());
}
@@ -166,7 +168,7 @@ pub trait SubModuleUser {
}
}
}
}
}
_ => {}
};
},
@@ -202,7 +204,7 @@ pub trait SubModuleUser {
_: &Module,
_: &Vec<ModuleExport>,
) -> Result<(), SessionError>;
fn use_module(
&mut self,
_: &mut CodeRepo,
@@ -232,7 +234,7 @@ where
if !user.import_decl(name.clone(), arity, submodule) {
let submodule_name = submodule.module_decl.name.clone();
return Err(SessionError::ModuleDoesNotContainExport(
submodule_name,
(name, arity)
@@ -250,12 +252,12 @@ where
let op_dir = user.op_dir();
let prec = op_decl.0;
op_decl.insert_into_op_dir(
submodule.module_decl.name.clone(),
op_dir,
prec,
);
);
}
}
}
@@ -282,12 +284,12 @@ pub fn use_module<User: SubModuleUser>(
ModuleExport::OpDecl(op_decl) => {
let op_dir = user.op_dir();
let prec = op_decl.0;
op_decl.insert_into_op_dir(
submodule.module_decl.name.clone(),
op_dir,
prec,
);
);
}
}
}

View File

@@ -7,6 +7,7 @@ use std::ops::RangeFrom;
use std::slice;
use std::str;
#[derive(Debug)]
pub struct PartialString {
buf: *const u8,
len: usize,
@@ -36,8 +37,8 @@ fn scan_for_terminator<Iter: Iterator<Item = char>>(iter: Iter) -> usize {
let mut terminator_idx = 0;
for c in iter {
if c == '\u{0}' {
break;
if c == '\u{0}' && terminator_idx != 0 {
return terminator_idx;
}
terminator_idx += c.len_utf8();
@@ -46,15 +47,18 @@ fn scan_for_terminator<Iter: Iterator<Item = char>>(iter: Iter) -> usize {
terminator_idx
}
#[derive(Debug)]
pub struct PStrIter {
buf: *const u8,
len: usize,
}
impl PStrIter {
#[inline]
fn from(buf: *const u8, idx: usize) -> Self {
fn from(buf: *const u8, len: usize, idx: usize) -> Self {
PStrIter {
buf: (buf as usize + idx) as *const _
buf: (buf as usize + idx) as *const _,
len: len - idx,
}
}
}
@@ -64,27 +68,13 @@ impl Iterator for PStrIter {
fn next(&mut self) -> Option<Self::Item> {
unsafe {
let mut byte_count = 0;
for n in 0 .. mem::size_of::<char>() {
let b = ptr::read((self.buf as usize + n) as *const u8);
if b == 0u8 {
break;
} else {
byte_count += 1;
}
}
if byte_count == 0 {
return None;
}
let slice = slice::from_raw_parts(self.buf, byte_count);
let slice = slice::from_raw_parts(self.buf, self.len);
let s = str::from_utf8(slice).unwrap();
if let Some(c) = s.chars().next() {
self.buf = self.buf.offset(c.len_utf8() as isize);
self.len -= c.len_utf8();
Some(c)
} else {
None
@@ -108,37 +98,9 @@ impl PartialString {
}
}
#[inline]
pub(super)
fn empty() -> Self {
let mut pstr = PartialString {
buf: ptr::null(),
len: 0,
_marker: PhantomData,
};
unsafe {
let layout = alloc::Layout::from_size_align_unchecked(
'\u{0}'.len_utf8(),
mem::align_of::<u8>(),
);
pstr.buf = alloc::alloc(layout) as *const _;
pstr.len = '\u{0}'.len_utf8();
pstr.write_terminator_at(0);
}
pstr
}
unsafe fn append_chars(mut self, src: &str) -> Option<(Self, &str)> {
let terminator_idx = scan_for_terminator(src.chars());
if terminator_idx == 0 {
return None;
}
let layout = alloc::Layout::from_size_align_unchecked(
terminator_idx + '\u{0}'.len_utf8(),
mem::align_of::<u8>(),
@@ -155,8 +117,8 @@ impl PartialString {
self.write_terminator_at(terminator_idx);
Some(if terminator_idx != src.len() {
(self, &src[terminator_idx + '\u{0}'.len_utf8() ..])
Some(if terminator_idx != src.as_bytes().len() {
(self, &src[terminator_idx ..])
} else {
(self, "")
})
@@ -212,14 +174,16 @@ impl PartialString {
#[inline]
pub fn range_from(&self, index: RangeFrom<usize>) -> PStrIter {
PStrIter::from(self.buf, index.start)
if self.len >= '\u{0}'.len_utf8() {
PStrIter::from(self.buf, self.len - '\u{0}'.len_utf8(), index.start)
} else {
PStrIter::from(self.buf, 0, 0)
}
}
#[inline]
pub fn at_end(&self, end_n: usize) -> bool {
unsafe {
ptr::read((self.buf as usize + end_n) as *const u8) == 0u8
}
end_n + 1 == self.len
}
#[inline]

View File

@@ -1,3 +1,5 @@
:- module('$project_atts', [copy_term/3]).
'$attribute_goals_driver'(QueryVars, AttrVars) :-
gather_modules(AttrVars, Modules0, _),
sort(Modules0, Modules),
@@ -99,7 +101,7 @@ call_attribute_goals_with_module_prefix([Module | Modules], GoalCaller, AttrVars
call_attribute_goals_with_module_prefix(Modules, GoalCaller, AttrVars, Gs).
copy_term(Source, Dest, Goals) :-
term_variables(Source, Vars),
'$term_attributed_variables'(Source, Vars),
gather_modules(Vars, Modules0, _),
sort(Modules0, Modules),
call_attribute_goals_with_module_prefix(Modules, call_query_var_goals, Vars, Goals0),

View File

@@ -14,6 +14,7 @@ pub(crate) trait RawBlockTraits {
}
}
#[derive(Debug)]
pub(crate) struct RawBlock<T: RawBlockTraits> {
pub(crate) size: usize,
pub(crate) base: *const u8,

View File

@@ -7,6 +7,7 @@ use std::mem;
use std::ops::{Index, IndexMut};
use std::ptr;
#[derive(Debug)]
struct StackTraits {}
impl RawBlockTraits for StackTraits {
@@ -35,6 +36,7 @@ const fn prelude_size<Prelude>() -> usize {
(size & !(align - 1)) + align
}
#[derive(Debug)]
pub struct Stack {
buf: RawBlock<StackTraits>,
_marker: PhantomData<Addr>,
@@ -47,11 +49,12 @@ impl Drop for Stack {
}
}
#[derive(Clone, Copy)]
#[derive(Debug, Clone, Copy)]
pub struct FramePrelude {
pub num_cells: usize,
}
#[derive(Debug)]
pub struct AndFramePrelude {
pub univ_prelude: FramePrelude,
pub e: usize,
@@ -59,6 +62,7 @@ pub struct AndFramePrelude {
pub interrupt_cp: LocalCodePtr,
}
#[derive(Debug)]
pub struct AndFrame {
pub prelude: AndFramePrelude,
}
@@ -99,6 +103,7 @@ impl IndexMut<usize> for AndFrame {
}
}
#[derive(Debug)]
pub struct OrFramePrelude {
pub univ_prelude: FramePrelude,
pub e: usize,
@@ -113,6 +118,7 @@ pub struct OrFramePrelude {
pub attr_var_init_bindings_b: usize,
}
#[derive(Debug)]
pub struct OrFrame {
pub prelude: OrFramePrelude,
}
@@ -165,16 +171,19 @@ impl Stack {
unsafe {
let new_top = self.buf.new_block(frame_size);
let e = self.buf.top as usize - self.buf.base as usize;
for idx in 0 .. num_cells {
let offset = prelude_size::<AndFramePrelude>() + idx * mem::size_of::<Addr>();
ptr::write((self.buf.top as usize + offset) as *mut Addr, Addr::StackCell(0,0));
ptr::write(
(self.buf.top as usize + offset) as *mut Addr,
Addr::StackCell(e, idx + 1),
);
}
let and_frame = &mut *(self.buf.top as *mut AndFrame);
and_frame.prelude.univ_prelude.num_cells = num_cells;
let e = self.buf.top as usize - self.buf.base as usize;
self.buf.top = new_top;
e
@@ -186,16 +195,19 @@ impl Stack {
unsafe {
let new_top = self.buf.new_block(frame_size);
let b = self.buf.top as usize - self.buf.base as usize;
for idx in 0 .. num_cells {
let offset = prelude_size::<OrFramePrelude>() + idx * mem::size_of::<Addr>();
ptr::write((self.buf.top as usize + offset) as *mut Addr, Addr::StackCell(0,0));
ptr::write(
(self.buf.top as usize + offset) as *mut Addr,
Addr::StackCell(b, idx),
);
}
let or_frame = &mut *(self.buf.top as *mut OrFrame);
or_frame.prelude.univ_prelude.num_cells = num_cells;
let b = self.buf.top as usize - self.buf.base as usize;
self.buf.top = new_top;
b

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -47,6 +47,7 @@ fn extract_from_list(
}
}
#[derive(Debug)]
pub struct TermStream<'a> {
stack: Vec<Term>,
pub(crate) wam: &'a mut Machine,
@@ -57,6 +58,7 @@ pub struct TermStream<'a> {
top_level_terms: Vec<(Term, usize, usize)>, // term, line_num, col_num.
}
#[derive(Debug)]
pub struct ExpansionAdditionResult {
term_expansion_additions: (Predicate, VecDeque<TopLevel>),
goal_expansion_additions: (Predicate, VecDeque<TopLevel>),
@@ -179,6 +181,7 @@ impl<'a> TermStream<'a> {
te_len,
te_queue_len,
);
let goal_expansion_additions = self.wam.code_repo.truncate_terms(
(clause_name!("goal_expansion"), 2),
ge_len,
@@ -218,7 +221,7 @@ impl<'a> TermStream<'a> {
term_string: &str,
op_dir: &OpDir,
) -> Result<Term, ParserError> {
let mut stream = parsing_stream(term_string.trim().as_bytes());
let mut stream = parsing_stream(term_string.trim().as_bytes())?;
let mut parser = Parser::new(&mut stream, self.parser.get_atom_tbl(), self.flags);
parser.read_term(composite_op!(
@@ -368,7 +371,7 @@ impl MachineState {
self.query_stepper(
&mut wam.indices,
&mut wam.policies,
&mut MachinePolicies::default(),
&mut wam.code_repo,
&mut readline::input_stream(),
&mut Stream::stdout(),

View File

@@ -14,6 +14,7 @@ use std::borrow::BorrowMut;
use std::cell::Cell;
use std::collections::VecDeque;
use std::convert::TryFrom;
use std::fmt;
use std::mem;
use std::ops::DerefMut;
use std::rc::Rc;
@@ -23,6 +24,15 @@ enum IndexSource<'a, T> {
Local(&'a mut T)
}
impl<'a, T: fmt::Debug> fmt::Debug for IndexSource<'a, T> {
fn fmt(&self, fmt: &mut fmt::Formatter) -> fmt::Result {
match self {
IndexSource::TermStream => write!(fmt, "TermStream"),
IndexSource::Local(ref local) => write!(fmt, "Local({:?})", local),
}
}
}
fn op_dir<'a, 'b: 'a>(from: &'b IndexSource<'a, IndexStore>) -> RefOrOwned<'a, OpDir> {
match from {
IndexSource::TermStream => RefOrOwned::Owned(OpDir::new()),
@@ -30,6 +40,7 @@ fn op_dir<'a, 'b: 'a>(from: &'b IndexSource<'a, IndexStore>) -> RefOrOwned<'a, O
}
}
#[derive(Debug)]
struct CompositeIndices<'a, 'b, 'c> {
term_stream: &'b mut TermStream<'a>,
index_src: IndexSource<'c, IndexStore>,
@@ -642,7 +653,7 @@ fn setup_declaration<'a, 'b, 'c>(
}
("initialization", 1) => {
let mut rel_worker = RelationWorker::new(flags, line_num, col_num);
let query_terms = rel_worker.setup_query(indices, terms, false)?;
let (query_terms, _) = rel_worker.setup_query(indices, terms, false, false)?;
let queue = rel_worker.parse_queue(indices)?;
Ok(Declaration::ModuleInitialization(query_terms, queue))
@@ -690,6 +701,7 @@ fn setup_declaration<'a, 'b, 'c>(
}
}
#[derive(Debug)]
struct RelationWorker {
flags: MachineFlags,
dynamic_clauses: Vec<(Term, Term)>, // Head, Body.
@@ -860,6 +872,7 @@ impl RelationWorker {
let term = Term::Clause(Cell::default(), clause_name!(";"), terms, None);
let (stub, clauses) = self.fabricate_disjunct(term);
debug_assert!(clauses.len() > 0);
self.queue.push_back(clauses);
Ok(QueryTerm::Jump(stub))
}
@@ -911,11 +924,14 @@ impl RelationWorker {
indices: &mut CompositeIndices<'a, 'b, 'c>,
terms: Vec<Box<Term>>,
blocks_cuts: bool,
) -> Result<Vec<QueryTerm>, ParserError> {
assume_dyn: bool,
) -> Result<(Vec<QueryTerm>, Term), ParserError> {
let mut query_terms = vec![];
let mut work_queue = VecDeque::from(terms);
let mut machine_st = MachineState::new();
let mut dynamic_clause_terms = vec![];
while let Some(term) = work_queue.pop_front() {
let term = *term;
let op_dir = op_dir(&indices.index_src);
@@ -934,7 +950,7 @@ impl RelationWorker {
let mut term = *term;
if let Term::Clause(cell, name, terms, op_spec) = term {
if name.as_str() == "," {
if name.as_str() == "," && terms.len() == 2 {
let term = Term::Clause(cell, name, terms, op_spec);
let mut subterms = unfold_by_str(term, ",");
@@ -952,11 +968,22 @@ impl RelationWorker {
mark_cut_variable(&mut term);
}
if assume_dyn {
dynamic_clause_terms.push(term.clone());
}
query_terms.push(self.pre_query_term(indices, term)?);
}
}
Ok(query_terms)
let dynamic_clause_body =
if let Some(term) = dynamic_clause_terms.pop() {
fold_by_str(dynamic_clause_terms.into_iter(), term, clause_name!(","))
} else {
Term::Constant(Cell::default(), Constant::Atom(clause_name!("true"), None))
};
Ok((query_terms, dynamic_clause_body))
}
fn setup_hook<'a, 'b, 'c>(
@@ -990,17 +1017,17 @@ impl RelationWorker {
blocks_cuts: bool,
assume_dyn: bool,
) -> Result<Rule, ParserError> {
let head = *terms.first().cloned().unwrap();
let post_head_terms: Vec<_> = terms.drain(1..).collect();
let dynamic_term_head = *terms.first().cloned().unwrap();
let post_head_terms: Vec<_> = terms.drain(1 ..).collect();
let tail = *post_head_terms.first().cloned().unwrap();
let (mut query_terms, dynamic_term_body) =
self.setup_query(indices, post_head_terms, blocks_cuts, assume_dyn)?;
if assume_dyn {
self.dynamic_clauses.push((head, tail));
self.dynamic_clauses.push((dynamic_term_head, dynamic_term_body));
}
let mut query_terms = self.setup_query(indices, post_head_terms, blocks_cuts)?;
let clauses = query_terms.drain(1..).collect();
let clauses = query_terms.drain(1 ..).collect();
let qt = query_terms.pop().unwrap();
match *terms.pop().unwrap() {
@@ -1022,11 +1049,14 @@ impl RelationWorker {
terms: Vec<Box<Term>>,
blocks_cuts: bool,
) -> Result<TopLevel, ParserError> {
Ok(TopLevel::Query(self.setup_query(
let (result, _) = self.setup_query(
indices,
terms,
blocks_cuts,
)?))
false,
)?;
Ok(TopLevel::Query(result))
}
fn compact_module_scoped_head<'a, 'b, 'c>(
@@ -1141,6 +1171,7 @@ pub type DynamicClause = Vec<(Term, Term)>;
pub type DynamicClauseMap = IndexMap<(ClauseName, usize), DynamicClause>;
#[derive(Debug)]
pub struct TopLevelBatchWorker<'a> {
pub(crate) term_stream: TermStream<'a>,
rel_worker: RelationWorker,
@@ -1243,7 +1274,7 @@ impl<'a> TopLevelBatchWorker<'a> {
match self.dynamic_clause_map.get_mut(&(name.clone(), arity)) {
Some(ref mut entry) => {
entry.clear(); // don't treat dynamic predicates as if they're discontiguous.
entry.extend(self.rel_worker.dynamic_clauses.drain(0..));
entry.extend(self.rel_worker.dynamic_clauses.drain(0 ..));
}
_ => {
self.rel_worker.dynamic_clauses.clear();

View File

@@ -150,9 +150,6 @@ macro_rules! from_constant {
&Constant::Char(c) => {
HeapCellValue::Addr(Addr::Char(c))
}
&Constant::CharCode(c) => {
HeapCellValue::Addr(Addr::CharCode(c))
}
&Constant::Fixnum(n) => {
HeapCellValue::Addr(Addr::Fixnum(n))
}
@@ -358,6 +355,7 @@ macro_rules! index_store {
op_dir: $op_dir,
modules: $modules,
stream_aliases: StreamAliasDir::new(),
streams: StreamDir::new(),
}
};
}
@@ -405,3 +403,26 @@ macro_rules! ar_reg {
ArithmeticTerm::Reg($r)
};
}
macro_rules! atom_from {
($self:expr, $indices:expr, $e:expr) => {
match $e {
Addr::Con(h) if $self.heap.atom_at(h) => {
match &$self.heap[h] {
HeapCellValue::Atom(ref atom, _) => {
atom.clone()
}
_ => {
unreachable!()
}
}
}
Addr::Char(c) => {
clause_name!(c.to_string(), $indices.atom_tbl.clone())
}
_ => {
unreachable!()
}
}
}
}

View File

@@ -18,7 +18,7 @@ pub mod readline {
use crate::prolog::machine::streams::Stream;
use crate::prolog::rustyline::error::ReadlineError;
use crate::prolog::rustyline::{Cmd, Editor, KeyPress};
use std::io::{Cursor, Read};
use std::io::{Cursor, Error, ErrorKind, Read};
static mut PROMPT: bool = false;
@@ -35,16 +35,23 @@ pub mod readline {
}
}
#[derive(Debug)]
pub struct ReadlineStream {
rl: Editor<()>,
pending_input: Cursor<String>,
}
impl ReadlineStream {
pub fn input_stream(pending_input: String) -> Stream {
#[inline]
pub fn new(pending_input: String) -> Self {
let mut rl = Editor::<()>::new();
rl.bind_sequence(KeyPress::Tab, Cmd::Insert(1, "\t".to_string()));
Stream::from(ReadlineStream { rl, pending_input: Cursor::new(pending_input) })
ReadlineStream { rl, pending_input: Cursor::new(pending_input) }
}
#[inline]
pub fn input_stream(pending_input: String) -> Stream {
Stream::from(Self::new(pending_input))
}
fn call_readline(&mut self, buf: &mut [u8]) -> std::io::Result<usize> {
@@ -67,7 +74,61 @@ pub mod readline {
Ok(0)
}
Err(e) => {
Err(std::io::Error::new(std::io::ErrorKind::InvalidInput, e))
Err(Error::new(ErrorKind::InvalidInput, e))
}
}
}
pub fn peek_byte(&mut self) -> std::io::Result<u8> {
set_prompt(false);
loop {
match self.pending_input.get_ref().bytes().next() {
Some(b) => {
return Ok(b);
}
None => {
match self.call_readline(&mut []) {
Err(e) => {
return Err(e);
}
Ok(0) => {
return Err(Error::new(
ErrorKind::UnexpectedEof,
"end of file",
));
}
_ => {
}
}
}
}
}
}
pub fn peek_char(&mut self) -> std::io::Result<char> {
set_prompt(false);
loop {
match self.pending_input.get_ref().chars().next() {
Some(c) => {
return Ok(c);
}
None => {
match self.call_readline(&mut []) {
Err(e) => {
return Err(e);
}
Ok(0) => {
return Err(Error::new(
ErrorKind::UnexpectedEof,
"end of file",
));
}
_ => {
}
}
}
}
}
}
@@ -114,12 +175,14 @@ fn write_term_to_heap(term: &Term, machine_st: &mut MachineState) -> TermWriteRe
term_writer.write_term_to_heap(term)
}
#[derive(Debug)]
struct TermWriter<'a> {
machine_st: &'a mut MachineState,
queue: SubtermDeque,
var_dict: HeapVarDict,
}
#[derive(Debug)]
pub struct TermWriteResult {
pub(crate) heap_loc: usize,
pub(crate) var_dict: HeapVarDict,
@@ -205,11 +268,15 @@ impl<'a> TermWriter<'a> {
continue;
}
}
&TermRef::AnonVar(Level::Root) | &TermRef::Constant(Level::Root, ..) |
&TermRef::Var(Level::Root, ..) => {
&TermRef::AnonVar(Level::Root) | &TermRef::Constant(Level::Root, ..) => {
let addr = self.term_as_addr(&term, h);
self.machine_st.heap.push(HeapCellValue::Addr(addr));
}
&TermRef::Var(Level::Root, _, ref var) => {
let addr = self.term_as_addr(&term, h);
self.var_dict.insert(var.clone(), Addr::HeapCell(h));
self.machine_st.heap.push(HeapCellValue::Addr(addr));
}
&TermRef::AnonVar(_) => {
if let Some((arity, site_h)) = self.queue.pop_front() {
if arity > 1 {

View File

@@ -1,60 +1,157 @@
:- module('$toplevel', ['$repl'/1, consult/1, use_module/1, use_module/2,
argv/1]).
:- use_module(library(charsio)).
:- use_module(library(lists)).
:- use_module(library(si)).
:- module('$toplevel', ['$repl'/1, consult/1, use_module/1, use_module/2]).
:- dynamic(argv/1).
'$repl'(ListOfModules) :-
maplist('$use_list_of_modules', ListOfModules),
false.
'$repl'(_) :- '$repl'.
'$repl'([_|Args0]) :-
\+ argv(_),
( append(Args1, ["--"|Args2], Args0) ->
asserta(argv(Args2)),
Args = Args1
; asserta(argv([])),
Args = Args0
),
delegate_task(Args, []),
repl.
'$repl'(_) :-
( \+ argv(_) -> asserta(argv([]))
; true
),
repl.
'$use_list_of_modules'(Module) :-
catch(use_module(Module), E, '$print_exception'(E)).
delegate_task([], []).
delegate_task([], Goals0) :-
reverse(Goals0, Goals),
run_goals(Goals),
repl.
delegate_task([Arg0|Args], Goals0) :-
( member(Arg0, ["-h", "--help"]) -> print_help
; member(Arg0, ["-v", "--version"]) -> print_version
; member(Arg0, ["-g", "--goal"]) -> gather_goal(g, Args, Goals0)
; atom_chars(Mod, Arg0),
catch(use_module(Mod), E, print_exception(E))
),
delegate_task(Args, Goals0).
'$repl' :-
catch('$read_and_match', E, '$print_exception'(E)),
print_help :-
write('Usage: scryer-prolog [OPTIONS] [FILES] [-- ARGUMENTS]'),
nl, nl,
write('Options:'), nl,
write(' -h, --help '),
write('Display this message'), nl,
write(' -v, --version '),
write('Print version information and exit'), nl,
write(' -g, --goal GOAL '),
write('Run the query GOAL'), nl,
% write(' '),
halt.
print_version :-
'$scryer_prolog_version'(Version),
write(Version), nl,
halt.
gather_goal(Type, Args0, Goals) :-
length(Args0, N),
( N < 1 -> print_help, halt
; true
),
[Gs1|Args] = Args0,
Gs =.. [Type, Gs1],
delegate_task(Args, [Gs|Goals]).
arg_type(g).
arg_type(t).
arg_type(g(_)).
arg_type(t(_)).
ends_with_dot(Ls0) :-
reverse(Ls0, Ls),
layout_and_dot(Ls).
layout_and_dot(['.'|_]).
layout_and_dot([C|Cs]) :-
char_type(C, layout),
layout_and_dot(Cs).
run_goals([]).
run_goals([g(Gs0)|Goals]) :-
( ends_with_dot(Gs0) -> Gs1 = Gs0
; append(Gs0, ".", Gs1)
),
read_term_from_chars(Gs1, Goal),
( catch(
Goal,
Exception,
(write(Gs0), write(' causes: '), write(Exception), nl) % halt?
)
; write('Warning: initialization failed for '),
write(Gs0), nl
),
run_goals(Goals).
run_goals([Goal|_]) :-
write('caught: '),
write(error(domain_error(arg_type, Goal), run_goals/1)), nl,
halt.
repl :-
catch(read_and_match, E, print_exception(E)),
false. %% this is for GC, until we get actual GC.
'$repl' :-
'$repl'.
repl :-
repl.
'$read_and_match' :-
'$read_query_term'(Term, VarList),
'$instruction_match'(Term, VarList).
read_and_match :-
'$read_query_term'(_, Term, _, _, VarList),
instruction_match(Term, VarList).
% make '$compile_batch', a system routine, callable.
'$$compile_batch' :- '$compile_batch'.
% make compile_batch, a system routine, callable.
compile_batch :- '$compile_batch'.
'$instruction_match'(Term, VarList) :-
instruction_match(Term, VarList) :-
( var(Term) ->
throw(error(instantiation_error, repl/0))
;
Term = [Item] -> !,
( atom(Item) ->
( Item == user ->
catch('$$compile_batch', E, '$print_exception_with_check'(E))
; consult(Item)
)
;
catch(throw(error(type_error(atom, Item), repl/0)),
E,
'$print_exception_with_check'(E))
)
Term = [Item] -> !,
( atom(Item) ->
( Item == user ->
catch(compile_batch, E, print_exception_with_check(E))
; consult(Item)
)
;
catch(throw(error(type_error(atom, Item), repl/0)),
E,
print_exception_with_check(E))
)
;
'$submit_query_and_print_results'(Term, VarList)
Term = end_of_file -> halt
;
submit_query_and_print_results(Term, VarList)
).
'$submit_query_and_print_results'(Term0, VarList) :-
:- use_module(library(iso_ext)).
% auxiliary predicates, so that using them in setup_call_cleanup/3 works
get_b_value(B) :- '$get_b_value'(B).
clear_attribute_goals :- '$clear_attribute_goals'.
submit_query_and_print_results(Term0, VarList) :-
( expand_goals(Term0, Term) -> true
; Term0 = Term
),
( '$get_b_value'(B), write(' '), call(Term), '$write_eqs_and_read_input'(B, VarList),
!
% clear attribute goal lists, which may be populated by
% copy_term/3 prior to failure.
; '$clear_attribute_goals', write('false.'), nl
).
setup_call_cleanup(bb_put('$first_answer', true),
( get_b_value(B), call(Term), write_eqs_and_read_input(B, VarList),
!
; % clear attribute goal lists, which may be populated by
% copy_term/3 prior to failure.
clear_attribute_goals, write('false.'), nl
),
bb_put('$first_answer', false)).
'$needs_bracketing'(Value, Op) :-
needs_bracketing(Value, Op) :-
catch((functor(Value, F, _),
current_op(EqPrec, EqSpec, Op),
current_op(FPrec, _, F)),
@@ -62,194 +159,199 @@
false),
( EqPrec < FPrec -> true
; '$quoted_token'(F) -> true
; atom_length(F, 1), graphic_token_char(F) -> true
; EqPrec == FPrec,
memberchk(EqSpec, [fx,xfx,yfx])
).
'$fabricate_var_name'(VarName, N) :-
char_code('A', AC),
LN is N mod 26 + AC,
char_code(LC, LN),
NN is N // 26,
( NN =:= 0 ->
atom_chars(VarName, ['_', LC])
; number_chars(NN, NNChars),
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'(V, VarName, N, N1, VarList) :-
'$fabricate_var_name'(VarName0, N),
( '$var_list_contains_name'(VarList, VarName0) ->
N0 is N + 1,
'$make_new_var_name'(V, VarName, N0, N1, VarList)
; VarName = VarName0,
N1 is N + 1
).
'$extend_var_list'(Value, VarList, NewVarList) :-
term_variables(Value, Vars),
'$extend_var_list_'(Vars, 0, VarList, NewVarList).
'$extend_var_list_'([], N, VarList, VarList).
'$extend_var_list_'([V|Vs], N, VarList, NewVarList) :-
( '$var_list_contains_variable'(VarList, V) ->
'$extend_var_list_'(Vs, N, VarList, NewVarList)
; '$make_new_var_name'(V, VarName, N, N1, VarList),
NewVarList = [VarName = V | NewVarList0],
'$extend_var_list_'(Vs, N1, VarList, NewVarList0)
).
'$write_goal'(G, VarList, MaxDepth) :-
write_goal(G, VarList, MaxDepth) :-
( G = (Var = Value) ->
( var(Value) ->
select((Var = _), VarList, NewVarList)
; VarList = NewVarList
),
write(Var),
write(' = '),
( '$needs_bracketing'(Value, (=)) ->
write('('),
write_term(Value, [quoted(true), variable_names(VarList), max_depth(MaxDepth)]),
write(')')
; write_term(Value, [quoted(true), variable_names(VarList), max_depth(MaxDepth)])
( needs_bracketing(Value, (=)) ->
write('('),
write_term(Value, [quoted(true), variable_names(NewVarList), max_depth(MaxDepth)]),
write(')')
; write_term(Value, [quoted(true), variable_names(NewVarList), max_depth(MaxDepth)])
)
; G == [] ->
write('true')
; write_term(G, [quoted(true), variable_names(VarList), max_depth(MaxDepth)])
).
'$write_last_goal'(G, VarList, MaxDepth) :-
write_last_goal(G, VarList, MaxDepth) :-
( G = (Var = Value) ->
( var(Value) ->
select((Var = _), VarList, NewVarList)
; VarList = NewVarList
),
write(Var),
write(' = '),
( '$needs_bracketing'(Value, (=)) ->
write('('),
write_term(Value, [quoted(true), variable_names(VarList), max_depth(MaxDepth)]),
write(')')
; write_term(Value, [quoted(true), variable_names(VarList), max_depth(MaxDepth)]),
( '$trailing_period_is_ambiguous'(Value) ->
write(' ')
; true
)
( needs_bracketing(Value, (=)) ->
write('('),
write_term(Value, [quoted(true), variable_names(NewVarList), max_depth(MaxDepth)]),
write(')')
; write_term(Value, [quoted(true), variable_names(NewVarList), max_depth(MaxDepth)]),
( trailing_period_is_ambiguous(Value) ->
write(' ')
; true
)
)
; G == [] ->
write('true')
; write_term(G, [quoted(true), variable_names(VarList), max_depth(MaxDepth)])
).
'$write_eq'((G1, G2), VarList, MaxDepth) :-
write_eq((G1, G2), VarList, MaxDepth) :-
!,
'$write_goal'(G1, VarList, MaxDepth),
write_goal(G1, VarList, MaxDepth),
write(', '),
'$write_eq'(G2, VarList, MaxDepth).
'$write_eq'(G, VarList, MaxDepth) :-
'$write_last_goal'(G, VarList, MaxDepth).
write_eq(G2, VarList, MaxDepth).
write_eq(G, VarList, MaxDepth) :-
write_last_goal(G, VarList, MaxDepth).
'$graphic_token_char'(C) :-
graphic_token_char(C) :-
memberchk(C, ['#', '$', '&', '*', '+', '-', '.', ('/'), ':',
'<', '=', '>', '?', '@', '^', '~', ('\\')]).
'$list_last_item'([C], C) :- !.
'$list_last_item'([_|Cs], D) :-
'$list_last_item'(Cs, D).
list_last_item([C], C) :- !.
list_last_item([_|Cs], D) :-
list_last_item(Cs, D).
'$trailing_period_is_ambiguous'(Value) :-
trailing_period_is_ambiguous(Value) :-
atom(Value),
atom_chars(Value, ValueChars),
'$list_last_item'(ValueChars, Char),
'$graphic_token_char'(Char).
list_last_item(ValueChars, Char),
ValueChars \== ['.'],
graphic_token_char(Char).
'$write_eqs_and_read_input'(B, VarList) :-
'$extend_var_list'(VarList, VarList, NewVarList),
sort(NewVarList, SortedVarList),
write_eqs_and_read_input(B, VarList) :-
term_variables(VarList, Vars0),
'$term_attributed_variables'(VarList, AttrVars),
copy_term(AttrVars, AttrVars, AttrGoals),
term_variables(AttrGoals, AttrGoalVars),
append([Vars0, AttrVars, AttrGoalVars], Vars),
charsio:extend_var_list(Vars, VarList, NewVarList, fabricated),
'$get_b_value'(B0),
'$gather_goals'(SortedVarList, SortedVarList, Goals),
gather_query_vars(VarList, OrigVars),
gather_equations(NewVarList, OrigVars, Goals, AttrGoals),
( bb_get('$first_answer', true) ->
write(' '),
bb_put('$first_answer', false)
; true
),
( B0 == B ->
( Goals == [] ->
write('true.'), nl
write('true.'), nl
; thread_goals(Goals, ThreadedGoals, (',')),
'$write_eq'(ThreadedGoals, NewVarList, 20),
write('.'),
nl
write_eq(ThreadedGoals, NewVarList, 20),
write('.'),
nl
)
; thread_goals(Goals, ThreadedGoals, (',')),
'$write_eq'(ThreadedGoals, NewVarList, 20),
'$read_input'(ThreadedGoals, NewVarList)
write_eq(ThreadedGoals, NewVarList, 20),
read_input(ThreadedGoals, NewVarList)
).
'$read_input'(ThreadedGoals, NewVarList) :-
'$raw_input_read_char'(C),
( C == w ->
read_input(ThreadedGoals, NewVarList) :-
get_single_char(C),
( C = w ->
nl,
write(' '),
'$write_eq'(ThreadedGoals, NewVarList, 0),
'$read_input'(ThreadedGoals, NewVarList)
; C == p ->
write_eq(ThreadedGoals, NewVarList, 0),
read_input(ThreadedGoals, NewVarList)
; C = p ->
nl,
write(' '),
'$write_eq'(ThreadedGoals, NewVarList, 20),
'$read_input'(ThreadedGoals, NewVarList)
; C == (';') ->
write_eq(ThreadedGoals, NewVarList, 20),
read_input(ThreadedGoals, NewVarList)
; member(C, [';', ' ', n]) ->
nl, write('; '), false
; C == h ->
'$help_message',
'$read_input'(ThreadedGoals, NewVarList)
; C == '.',
; C = h ->
help_message,
read_input(ThreadedGoals, NewVarList)
; member(C, ['\n', .]) ->
nl, write('; ...'), nl
; read_input(ThreadedGoals, NewVarList)
).
'$help_message' :-
help_message :-
nl, nl,
write('SPACE, "n" or ";": next solution, if any\n'),
write('".": stop enumeration\n'),
write('RETURN or ".": stop enumeration\n'),
write('"h": display this help message\n'),
write('"w": write terms without depth limit\n'),
write('"p": print terms with depth limit\n\n').
'$gather_query_vars'([_ = Var | Vars], QueryVars) :-
gather_query_vars([_ = Var | Vars], QueryVars) :-
( var(Var) ->
QueryVars = [Var | QueryVars1],
'$gather_query_vars'(Vars, QueryVars1)
; '$gather_query_vars'(Vars, QueryVars)
QueryVars = [Var | QueryVars0],
gather_query_vars(Vars, QueryVars0)
; gather_query_vars(Vars, QueryVars)
).
'$gather_query_vars'([], []).
gather_query_vars([], []).
'$is_a_different_variable'([_ = Binding | Pairs], Value) :-
is_a_different_variable([_ = Binding | Pairs], Value) :-
( Value == Binding, !
; '$is_a_different_variable'(Pairs, Value)
; is_a_different_variable(Pairs, Value)
).
'$gather_goals'([], VarList, Goals) :-
'$gather_query_vars'(VarList, QueryVars),
copy_term(QueryVars, QueryVars, Goals).
'$gather_goals'([Var = Value | Pairs], VarList, Goals) :-
eq_member(X, [Y|_]) :- X == Y, !.
eq_member(X, [_|Ys]) :- eq_member(X, Ys).
gather_equations([], _, Goals, Goals).
gather_equations([Var = Value | Pairs], OrigVarList, Goals, Goals1) :-
( var(Value) ->
( eq_member(Value, OrigVarList),
( Pairs == [], NewPairs = []
; ( select((OtherVar = OtherValue), Pairs, NewPairs),
Value == OtherValue, Var \== OtherVar
)
) ->
Goals = [Var = Value | Goals0],
gather_equations(NewPairs, OrigVarList, Goals0, Goals1)
; gather_equations(Pairs, OrigVarList, Goals, Goals1)
)
; Goals = [Var = Value | Goals0],
gather_equations(Pairs, OrigVarList, Goals0, Goals1)
).
/*
gather_equations([], MasterList, Goals, Goals).
gather_equations([Var = Value | Pairs], MasterList, Goals, Goals1) :-
( ( nonvar(Value)
; '$is_a_different_variable'(Pairs, Value)
; select((Var = _), MasterList, MasterPairs),
is_a_different_variable(MasterPairs, Value)
) ->
Goals = [Var = Value | Goals0],
'$gather_goals'(Pairs, VarList, Goals0)
; '$gather_goals'(Pairs, VarList, Goals)
gather_equations(Pairs, MasterList, Goals0, Goals1)
; gather_equations(Pairs, MasterList, Goals, Goals1)
).
*/
'$print_exception'(E) :-
print_exception(E) :-
( E == error('$interrupt_thrown', repl) -> nl % print the
% exception on a
% newline to evade
% "^C".
; true
),
write_term('caught: ', [quoted(false), max_depth(20)]),
writeq(E),
nl.
'$print_exception_with_check'(E) :-
print_exception_with_check(E) :-
( E = error(_, _:_) -> true % if the error source contains a line
% number, a GNU-style error message
% is expected to be printed instead.
; '$print_exception'(E)
% number, a GNU-style error message
% is expected to be printed instead.
; print_exception(E)
).
'$module_export'(Source, PI) :-
module_export(Source, PI) :-
( nonvar(PI) ->
( PI = Name / Arity ->
( var(Name) -> throw(error(instantiation_error, Source))
@@ -296,12 +398,12 @@ use_module(Module, QualifiedExports) :-
( nonvar(Module) ->
( list_si(QualifiedExports) ->
maplist('$module_export'(use_module/2), QualifiedExports) ->
( Module = library(Filename) ->
'$use_qualified_module'(Filename, QualifiedExports)
; atom(Module) ->
'$use_qualified_module_from_file'(Module, QualifiedExports)
; throw(error(invalid_module_specifier, use_module/2))
)
( Module = library(Filename) ->
'$use_qualified_module'(Filename, QualifiedExports)
; atom(Module) ->
'$use_qualified_module_from_file'(Module, QualifiedExports)
; throw(error(invalid_module_specifier, use_module/2))
)
; throw(error(type_error(list, QualifiedExports), use_module/2))
)
; throw(error(instantiation_error, use_module/2))
@@ -315,7 +417,7 @@ user:term_expansion(Term0, (:- initialization(ExpandedGoals))) :-
expand_goals(Goals, ExpandedGoals),
Goals \== ExpandedGoals.
'$module_expand_goal'(UnexpandedGoals, ExpandedGoals) :-
module_expand_goal(UnexpandedGoals, ExpandedGoals) :-
( '$module_of'(Module, UnexpandedGoals),
'$module_exists'(Module),
Module:goal_expansion(UnexpandedGoals, ExpandedGoals),
@@ -327,7 +429,7 @@ user:term_expansion(Term0, (:- initialization(ExpandedGoals))) :-
expand_goals(UnexpandedGoals, ExpandedGoals) :-
nonvar(UnexpandedGoals),
var(ExpandedGoals),
( '$module_expand_goal'(UnexpandedGoals, Goals) ->
( module_expand_goal(UnexpandedGoals, Goals) ->
true
; Goals = UnexpandedGoals
),
@@ -374,3 +476,4 @@ thread_goals(Goals0, Goals1, Functor) :-
)
; Goals1 = Goals0
).

View File

@@ -181,6 +181,9 @@ impl fmt::Display for HeapCellValue {
&HeapCellValue::Stream(ref stream) => {
write!(f, "$stream({})", stream.as_ptr() as usize)
}
&HeapCellValue::TcpListener(ref tcp_listener) => {
write!(f, "$tcp_listener({})", tcp_listener.local_addr().unwrap())
}
}
}
}
@@ -200,7 +203,6 @@ impl fmt::Display for Addr {
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
match self {
&Addr::Char(c) => write!(f, "Addr::Char({})", c),
&Addr::CharCode(c) => write!(f, "Addr::CharCode({})", c),
&Addr::EmptyList => write!(f, "Addr::EmptyList"),
&Addr::Fixnum(n) => write!(f, "Addr::Fixnum({})", n),
&Addr::Float(fl) => write!(f, "Addr::Float({})", fl),
@@ -213,6 +215,7 @@ impl fmt::Display for Addr {
&Addr::Str(s) => write!(f, "Addr::Str({})", s),
&Addr::PStrLocation(h, n) => write!(f, "Addr::PStrLocation({}, {})", h, n),
&Addr::Stream(stream) => write!(f, "Addr::Stream({})", stream),
&Addr::TcpListener(tcp_listener) => write!(f, "Addr::TcpListener({})", tcp_listener),
&Addr::Usize(cp) => write!(f, "Addr::Usize({})", cp),
}
}
@@ -332,11 +335,14 @@ impl fmt::Display for ExistenceError {
&ExistenceError::Module(ref module_name) => {
write!(f, "the module {} does not exist", module_name)
}
&ExistenceError::ModuleSource(ref module_source) => {
write!(f, "the source/sink {} does not exist", module_source)
}
&ExistenceError::Procedure(ref name, arity) => {
write!(f, "the procedure {}/{} does not exist", name, arity)
}
&ExistenceError::SourceSink(ref module_source) => {
write!(f, "the source/sink {} does not exist", module_source)
&ExistenceError::SourceSink(ref addr) => {
write!(f, "the source/sink {} does not exist", addr)
}
&ExistenceError::Stream(ref addr) => {
write!(f, "the stream at {} does not exist", addr)

View File

@@ -33,6 +33,6 @@ test_queries_on_predicates :-
assertz((p(X, Y) :- q(Z), p(X, X))),
once(p(X,b)),
retract((p(X, Y) :- q(Z), p(X, X))),
retract(q(z)).
retract(q(z)).
:- initialization(test_queries_on_predicates).

View File

@@ -24,5 +24,5 @@ test_queries_on_setup_call_cleanup :-
findall(Pat, catch(setup_call_cleanup(true,throw(goal),throw(cl)), Pat, true), [goal]),
findall(Pat, catch(( setup_call_cleanup(true,(G=1;G=2),throw(cl)), throw(cont)), Pat, true), [cont]),
findall([X,Y], (setup_call_cleanup(true, (X=1;X=2), writeq(a)), setup_call_cleanup(true,(Y=1;Y=2),writeq(b)), !), [[1,1]]).
:- initialization(test_queries_on_setup_call_cleanup).