Compare commits
385 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
888d844ec5 | ||
|
|
3a7eb9fc0c | ||
|
|
46276aacd9 | ||
|
|
3a7a29868f | ||
|
|
0060c8988a | ||
|
|
458f482c2a | ||
|
|
dadf1b6ff9 | ||
|
|
db56bb92f0 | ||
|
|
e82e36f51e | ||
|
|
f9aad34d28 | ||
|
|
b2d720b853 | ||
|
|
c10c05e924 | ||
|
|
8909246725 | ||
|
|
48c0b0ab3c | ||
|
|
cbbed310c5 | ||
|
|
9e9c3b6342 | ||
|
|
fefd262c2e | ||
|
|
1108c99688 | ||
|
|
93da831ef0 | ||
|
|
72bf45912e | ||
|
|
5d94276c4f | ||
|
|
b43f27030e | ||
|
|
2845f55157 | ||
|
|
e254d84710 | ||
|
|
0ef7b5488d | ||
|
|
56b04f8df8 | ||
|
|
2d036c6b25 | ||
|
|
ad3be5c848 | ||
|
|
a0544cc345 | ||
|
|
3245261162 | ||
|
|
21b7348c6a | ||
|
|
54d4dc6e1e | ||
|
|
e00d864199 | ||
|
|
ad6fc89a24 | ||
|
|
fc4823ce8e | ||
|
|
0bd9831eec | ||
|
|
dec2ef70c7 | ||
|
|
d19d8ea770 | ||
|
|
34f7752c0f | ||
|
|
da4d061067 | ||
|
|
85155439be | ||
|
|
dd32e69061 | ||
|
|
1c0c660c32 | ||
|
|
2eac902c33 | ||
|
|
9f5322d309 | ||
|
|
f5c2f6f9e9 | ||
|
|
e0e3b180e7 | ||
|
|
041dc039d4 | ||
|
|
ac755b0ada | ||
|
|
c14259060c | ||
|
|
a423eb5323 | ||
|
|
fd732550d8 | ||
|
|
fac7ba70c8 | ||
|
|
e9f8b35918 | ||
|
|
23034dd4f5 | ||
|
|
70ad44adfd | ||
|
|
95ca8a2630 | ||
|
|
a7fd3c50e5 | ||
|
|
5639f40994 | ||
|
|
33a8262334 | ||
|
|
9b4f7ad696 | ||
|
|
eecd809d9a | ||
|
|
240d3cb8f1 | ||
|
|
5720b7b94c | ||
|
|
3855d7ea02 | ||
|
|
9f3351469d | ||
|
|
2c4a0cf65b | ||
|
|
a8f360c8fd | ||
|
|
b3cff6555f | ||
|
|
69706ecab0 | ||
|
|
05d3b97eae | ||
|
|
a38fb41e37 | ||
|
|
204ae377e3 | ||
|
|
3e5a652874 | ||
|
|
862ae26631 | ||
|
|
9e0208ec71 | ||
|
|
510530973c | ||
|
|
4e69301562 | ||
|
|
df06d4b9a2 | ||
|
|
b60561c3bb | ||
|
|
fffa503968 | ||
|
|
8754157810 | ||
|
|
0763686892 | ||
|
|
50776748a7 | ||
|
|
c07274a6fa | ||
|
|
4084005ee7 | ||
|
|
40fce574cf | ||
|
|
fd761735d4 | ||
|
|
9cb98bdcdc | ||
|
|
b5b1f7ff8a | ||
|
|
a86019d53b | ||
|
|
8cd7d08573 | ||
|
|
6d6f6ed8fc | ||
|
|
c9aed1381f | ||
|
|
49ba5f30c5 | ||
|
|
3c6149fd27 | ||
|
|
23f804eda3 | ||
|
|
4e321db189 | ||
|
|
716fde5784 | ||
|
|
c70b873397 | ||
|
|
4c0da691b8 | ||
|
|
d1d36f9af0 | ||
|
|
56efb4ffba | ||
|
|
540bc71873 | ||
|
|
c1df7ead1a | ||
|
|
d170c807e3 | ||
|
|
50c0abc786 | ||
|
|
c5057127ee | ||
|
|
ea7b1a9592 | ||
|
|
26d483f2d7 | ||
|
|
67fce58708 | ||
|
|
ea5771c442 | ||
|
|
fa8a1faeb3 | ||
|
|
d60a000af6 | ||
|
|
3d68e2b74f | ||
|
|
42f6d48abf | ||
|
|
5587957602 | ||
|
|
1d313ebf25 | ||
|
|
cf92349c1d | ||
|
|
b0ae44bc25 | ||
|
|
0c94124fdf | ||
|
|
22298ddb41 | ||
|
|
6f927b9941 | ||
|
|
dc5626f34d | ||
|
|
2717ec2759 | ||
|
|
d75449ea63 | ||
|
|
034f5b16bd | ||
|
|
ff420f1e67 | ||
|
|
5be771842f | ||
|
|
a131c93a14 | ||
|
|
3da3546ef8 | ||
|
|
47f5223c37 | ||
|
|
b8c50eb0fe | ||
|
|
fe05082ddc | ||
|
|
414acda9e0 | ||
|
|
47e3a5e75a | ||
|
|
573df892bc | ||
|
|
bfced59949 | ||
|
|
9a63b1751b | ||
|
|
53ae8b9bd1 | ||
|
|
bf3cc5a367 | ||
|
|
ac00bc6b70 | ||
|
|
ab62603c5a | ||
|
|
dd247cd541 | ||
|
|
0d7a9f32d6 | ||
|
|
0d85ef4404 | ||
|
|
8e9273a96a | ||
|
|
2dfdaaa4ba | ||
|
|
407094cdcb | ||
|
|
0111db6744 | ||
|
|
a49230c0e1 | ||
|
|
d04abc2021 | ||
|
|
b5368207d6 | ||
|
|
b8400e0c92 | ||
|
|
ef6b6cd279 | ||
|
|
e5903d8d6e | ||
|
|
e2a3db1b82 | ||
|
|
9e220e8416 | ||
|
|
605c233753 | ||
|
|
aafe18c2b5 | ||
|
|
262e8af813 | ||
|
|
75aa4ce8a0 | ||
|
|
a494cdaf92 | ||
|
|
848425418b | ||
|
|
989bed88fe | ||
|
|
99f66200f7 | ||
|
|
b642bd2cfd | ||
|
|
c062b7c9da | ||
|
|
7df7901532 | ||
|
|
9dabce819a | ||
|
|
a019109857 | ||
|
|
46cdf14ecc | ||
|
|
fd5ff20b68 | ||
|
|
81f9666e82 | ||
|
|
aa8659d5c7 | ||
|
|
9df2df0f9f | ||
|
|
98d38d763b | ||
|
|
319a4622b3 | ||
|
|
59b4c6dacb | ||
|
|
ec6d725587 | ||
|
|
6f19649186 | ||
|
|
6a583b9b5b | ||
|
|
6617b79cd8 | ||
|
|
46b695d093 | ||
|
|
de8a017e80 | ||
|
|
b71ec91f57 | ||
|
|
1b7c226779 | ||
|
|
ca5a5b4392 | ||
|
|
6ae7ae0210 | ||
|
|
b911d2fda4 | ||
|
|
847a92f580 | ||
|
|
a346493de1 | ||
|
|
efd5d6efab | ||
|
|
b6df5a4b7f | ||
|
|
34ae56e319 | ||
|
|
5870824d01 | ||
|
|
1dbadbfc35 | ||
|
|
d3f1cd7411 | ||
|
|
a821daadd3 | ||
|
|
a39f4b4487 | ||
|
|
f7b401b9b6 | ||
|
|
c342d18f92 | ||
|
|
e0e52a3090 | ||
|
|
6f92480315 | ||
|
|
490d008edf | ||
|
|
ccee17c573 | ||
|
|
dd4832e40b | ||
|
|
ff5b870a9f | ||
|
|
a371580201 | ||
|
|
b499c575bc | ||
|
|
f5a6268cef | ||
|
|
2df4083602 | ||
|
|
2495fb796d | ||
|
|
f7b49740c1 | ||
|
|
7e765fe726 | ||
|
|
1d339f74d1 | ||
|
|
a3bb288f01 | ||
|
|
0e1226573a | ||
|
|
8151b65d12 | ||
|
|
eefd36b50d | ||
|
|
6f4d769187 | ||
|
|
20b76a703a | ||
|
|
dcc09b7bb5 | ||
|
|
4ea0dee90a | ||
|
|
e61116d35a | ||
|
|
f7256c75d5 | ||
|
|
2696fd1291 | ||
|
|
b139620fba | ||
|
|
97115a9c1c | ||
|
|
36134c61b2 | ||
|
|
77cf0fd87b | ||
|
|
ab77a1cbc0 | ||
|
|
8490892493 | ||
|
|
5f35dffa34 | ||
|
|
89a4b5a6ff | ||
|
|
931de7e39c | ||
|
|
ff41d6aef9 | ||
|
|
8e1ba58551 | ||
|
|
2b1692a860 | ||
|
|
7a2981e21c | ||
|
|
f8717359d7 | ||
|
|
fe395e3a8c | ||
|
|
eb9fe851af | ||
|
|
d61851ad02 | ||
|
|
de7a408903 | ||
|
|
4b0f60fe71 | ||
|
|
a167bcff5e | ||
|
|
fb812e6335 | ||
|
|
3fd557c74a | ||
|
|
9b1272da51 | ||
|
|
ae2402f4a7 | ||
|
|
c98e869564 | ||
|
|
e1a019ec56 | ||
|
|
2d7fcbf23d | ||
|
|
b604177ca1 | ||
|
|
f27597cab5 | ||
|
|
40619c8184 | ||
|
|
b0a5df2838 | ||
|
|
ae9232a2cb | ||
|
|
ad28d0025a | ||
|
|
d6772c5ca5 | ||
|
|
a2400767ed | ||
|
|
1873b655a8 | ||
|
|
e27c2b59c8 | ||
|
|
4b50608642 | ||
|
|
e3a7f9eb7a | ||
|
|
c130b3a92e | ||
|
|
20fb6d6669 | ||
|
|
caf20cd43d | ||
|
|
608d661355 | ||
|
|
31c868818b | ||
|
|
443c4b6cd0 | ||
|
|
ee425bb7f0 | ||
|
|
9d1c026231 | ||
|
|
6d7612ead6 | ||
|
|
b3e31094ff | ||
|
|
c9750fab2c | ||
|
|
5a1348e4d1 | ||
|
|
b64d45a74e | ||
|
|
ba5a4c3945 | ||
|
|
9ba37a932b | ||
|
|
8ce377d033 | ||
|
|
a7f3dafd81 | ||
|
|
fb38b4b906 | ||
|
|
f0a1a90b0e | ||
|
|
fb331d39a6 | ||
|
|
7a3e6e19b1 | ||
|
|
5a063c541d | ||
|
|
eef25ec638 | ||
|
|
7141fb18c1 | ||
|
|
2c92be5e3d | ||
|
|
cae0733149 | ||
|
|
5d6ca7a88e | ||
|
|
23b8a4d364 | ||
|
|
c0df8cb578 | ||
|
|
4693c23a49 | ||
|
|
86364ff278 | ||
|
|
60f1f1cb3d | ||
|
|
ab3c520006 | ||
|
|
3798dcb98d | ||
|
|
9daf290432 | ||
|
|
3438f88c1e | ||
|
|
2c8858ff2d | ||
|
|
45ed9405b0 | ||
|
|
075ca78dd2 | ||
|
|
1d964ef921 | ||
|
|
0c6d9b1d3b | ||
|
|
1713f1222b | ||
|
|
450591d5a9 | ||
|
|
5c4863dfb1 | ||
|
|
c6a82cbc07 | ||
|
|
cc8f074d33 | ||
|
|
196d74c3a0 | ||
|
|
f28e87b240 | ||
|
|
2d77ef4245 | ||
|
|
3f578e24b5 | ||
|
|
fb5ee5e190 | ||
|
|
63e8378310 | ||
|
|
c24ebaf506 | ||
|
|
d3a1f11dfe | ||
|
|
f96e694ff8 | ||
|
|
d5d635e50f | ||
|
|
1ad4ce9822 | ||
|
|
3f971174e4 | ||
|
|
16e257ea32 | ||
|
|
37f1f8ac14 | ||
|
|
474fa9b3ec | ||
|
|
6d7b14ceb5 | ||
|
|
af14832b6c | ||
|
|
9ef185978f | ||
|
|
38bb44664c | ||
|
|
124d924ff5 | ||
|
|
e8091d8add | ||
|
|
500bd53b6a | ||
|
|
6996ca832d | ||
|
|
2e15ab44ab | ||
|
|
2ae5472872 | ||
|
|
98a32790cd | ||
|
|
6dcefcfb71 | ||
|
|
988366e37f | ||
|
|
98a37905b8 | ||
|
|
bd832d0fbb | ||
|
|
1f7e18f2a9 | ||
|
|
105e9c8e88 | ||
|
|
99e1a5f117 | ||
|
|
b35b49f7b3 | ||
|
|
5d064b18e6 | ||
|
|
11ea92288d | ||
|
|
1ea6ae9fd9 | ||
|
|
57d739673a | ||
|
|
4d8f76e922 | ||
|
|
fb41d4ab0f | ||
|
|
023ee688d3 | ||
|
|
5f8f0d8573 | ||
|
|
f56e0a6586 | ||
|
|
2c96420bc4 | ||
|
|
8d95eb57fa | ||
|
|
a9a5e79e85 | ||
|
|
2b720b8d0b | ||
|
|
93a0ab7f0a | ||
|
|
18dd55d1f4 | ||
|
|
c9074d8d96 | ||
|
|
f6c995157e | ||
|
|
a059a9fbdc | ||
|
|
2ac6596ba9 | ||
|
|
2d1f57e839 | ||
|
|
7799ed36f0 | ||
|
|
db5ed345bc | ||
|
|
082c6a9e64 | ||
|
|
b74a4d5225 | ||
|
|
16a572c250 | ||
|
|
6a8a2d6f56 | ||
|
|
237c855f10 | ||
|
|
15d18484e3 | ||
|
|
378e9b5539 | ||
|
|
7a135bd87c | ||
|
|
9e907e36e2 | ||
|
|
9ac71f304d | ||
|
|
ab9b604d02 | ||
|
|
155645307a | ||
|
|
4ca7ac4851 | ||
|
|
02eb24cd57 | ||
|
|
787fbe1bb6 | ||
|
|
7678858bab | ||
|
|
bf7a28f07c |
6
.dockerignore
Executable file
6
.dockerignore
Executable file
@@ -0,0 +1,6 @@
|
||||
target
|
||||
Dockerfile
|
||||
README.md
|
||||
.git
|
||||
.gitignore
|
||||
.gitmodules
|
||||
41
.travis.yml
41
.travis.yml
@@ -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
1029
Cargo.lock
generated
File diff suppressed because it is too large
Load Diff
27
Cargo.toml
27
Cargo.toml
@@ -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
30
Dockerfile
Executable file
@@ -0,0 +1,30 @@
|
||||
# Based on https://hub.docker.com/_/rust?tab=description and https://blog.sedrik.se/posts/my-docker-setup-for-rust/
|
||||
|
||||
# The first container is for build purposes only.
|
||||
FROM rust as builder
|
||||
|
||||
WORKDIR /usr/src/scryer-prolog
|
||||
|
||||
# Using a dummy build.rs and src/main.rs with your Cargo.toml lets Docker cache your Rust dependencies and not rebuild
|
||||
# them every time.
|
||||
COPY Cargo.toml .
|
||||
COPY Cargo.lock .
|
||||
RUN mkdir -p src
|
||||
RUN echo "fn main() {}" > src/main.rs
|
||||
RUN echo "fn main() {}" > build.rs
|
||||
RUN cargo build --release
|
||||
|
||||
# We need to touch our real main.rs and build.rs files or else
|
||||
# docker will use the cached ones.
|
||||
COPY . .
|
||||
RUN touch src/main.rs
|
||||
RUN touch build.rs
|
||||
|
||||
RUN cargo build --release
|
||||
|
||||
RUN ls ./target/release
|
||||
|
||||
# Finally, copy the scryer-prolog executable to a slimmer container.
|
||||
FROM debian:buster-slim
|
||||
COPY --from=builder /usr/src/scryer-prolog/target/release/scryer-prolog /usr/local/bin/scryer-prolog
|
||||
CMD ["scryer-prolog"]
|
||||
206
README.md
206
README.md
@@ -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 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 input and consults the entered Prolog text.
|
||||
|
||||
After a program is consulted, you can ask *queries* about the
|
||||
predicates it defines. For example, with the program shown above:
|
||||
|
||||
```
|
||||
?- hello(What).
|
||||
What = declarative_world
|
||||
; What = pure_world.
|
||||
```
|
||||
|
||||
Press `SPACE` to show further answers, if any exist. Press `RETURN` or
|
||||
`.` to abort the search and return to the toplevel prompt.
|
||||
Press `h` to show a help message.
|
||||
|
||||
To quit Scryer Prolog, use the standard predicate `halt/0`:
|
||||
|
||||
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 `(=)/2` is used.
|
||||
Definite clause grammars as provided by `library(dcgs)` are ideally
|
||||
suited for reasoning about strings.
|
||||
|
||||
### Tabling (SLG resolution)
|
||||
|
||||
One of the foremost attractions of Prolog is that logical consequences
|
||||
of pure programs can be derived by various execution strategies
|
||||
that differ regarding essential properties such as termination,
|
||||
completeness and efficiency.
|
||||
|
||||
The default execution strategy of Prolog is depth-first search with
|
||||
chronological backtracking. This strategy is very efficient. Its main
|
||||
drawback is that it is *incomplete*: It may fail to find any solution
|
||||
even if one exists.
|
||||
|
||||
Scryer Prolog supports an alternative execution strategy which is
|
||||
called *tabling* and also known as tabled execution and
|
||||
SLG resolution. To enable tabled execution for a predicate, use
|
||||
[`library(tabling)`](src/prolog/lib/tabling.pl) and add a `(table)/1`
|
||||
directive for the desired predicate indicator. For example, if we
|
||||
write:
|
||||
|
||||
```
|
||||
:- use_module(library(tabling)).
|
||||
:- table a/0.
|
||||
|
||||
a :- a.
|
||||
```
|
||||
|
||||
Then the query `?- a.` *terminates* (and fails), whereas it
|
||||
does not terminate with the default execution strategy.
|
||||
|
||||
Scryer Prolog implements tabling via *delimited continuations* as
|
||||
described in [*Tabling as a Library with Delimited
|
||||
Control*](https://biblio.ugent.be/publication/6880648/file/6885145.pdf)
|
||||
by Desouter et. al.
|
||||
|
||||
### Constraint Logic Programming (CLP)
|
||||
|
||||
Scryer Prolog provides excellent support for Constraint Logic
|
||||
Programming (CLP), which is the amalgamation of
|
||||
Logic Programming (LP) and Constraints.
|
||||
|
||||
In addition to built-in support for [`dif/2`](src/prolog/lib/dif.pl),
|
||||
[`freeze/2`](src/prolog/lib/freeze.pl),
|
||||
[CLP(B)](src/prolog/lib/clpb.pl) and [CLP(ℤ)](src/prolog/lib/clpz.pl),
|
||||
Scryer provides a convenient way to implement new user-defined
|
||||
constraints: *Attributed variables* are available via
|
||||
[`library(atts)`](src/prolog/lib/atts.pl) as in SICStus Prolog,
|
||||
which is one of the most sophisticated and fastest constraint systems
|
||||
in existence. In [`library(iso_ext)`](src/prolog/lib/iso_ext.pl),
|
||||
Scryer provides predicates for backtrackable (`bb_b_put/2`) and
|
||||
non-backtrackable (`bb_put/2`) global variables, which are needed to
|
||||
implement certain types of constraint solvers.
|
||||
|
||||
These features make Scryer Prolog an ideal platform for teaching,
|
||||
learning and developing portable CLP applications.
|
||||
|
||||
### Modules
|
||||
|
||||
Scryer has a simple predicate-based module system. It provides a
|
||||
@@ -300,15 +383,41 @@ The modules that ship with Scryer 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 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 trees which ensure
|
||||
*O*(log(*N*)) access.
|
||||
* [`ordsets`](src/prolog/lib/ordsets.pl)
|
||||
represents ordered sets as lists.
|
||||
* [`clpb`](src/prolog/lib/clpb.pl)
|
||||
CLP(B): Constraint Logic Programming over Boolean variables,
|
||||
a BDD-based SAT solver provided via the predicates
|
||||
`sat/1`, `taut/2`, `labeling/1` etc.
|
||||
* [`arithmetic`](src/prolog/lib/arithmetic.pl)
|
||||
Arithmetic predicates such as `lsb/2`, `msb/2` and
|
||||
`number_to_rational/2`.
|
||||
* [`time`](src/prolog/lib/time.pl)
|
||||
`time/1` reports the CPU time of a goal. It is useful
|
||||
for measuring the performance of your code.
|
||||
* [`cont`](src/prolog/lib/cont.pl)
|
||||
Provides *delimited continuations* via `reset/3` and `shift/1`.
|
||||
* [`random`](src/prolog/lib/random.pl)
|
||||
Probabilistic predicates and random number generators.
|
||||
* [`sockets`](src/prolog/lib/sockets.pl)
|
||||
Predicates for opening and accepting TCP connections as streams.
|
||||
* [`crypto`](src/prolog/lib/crypto.pl)
|
||||
Cryptographically secure random numbers and hashes, HMAC-based
|
||||
key derivation (HKDF), password-based key derivation (PBKDF2),
|
||||
public key signatures and signature verification with Ed25519,
|
||||
authenticated encryption, and reasoning about elliptic curves.
|
||||
|
||||
To read contents of external files, use `phrase_from_file/2` from
|
||||
[`library(pio)`](src/prolog/lib/pio.pl) to apply a DCG to
|
||||
file contents. The predicates in
|
||||
[`library(charsio)`](src/prolog/lib/charsio.pl) are also useful for
|
||||
parsing.
|
||||
|
||||
To use predicates provided by the `lists` library, write:
|
||||
|
||||
@@ -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)).
|
||||
|
||||
|
||||
11
src/main.rs
11
src/main.rs
@@ -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();
|
||||
}
|
||||
|
||||
@@ -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());
|
||||
|
||||
@@ -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,
|
||||
|
||||
@@ -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));
|
||||
})
|
||||
}
|
||||
|
||||
|
||||
@@ -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);
|
||||
|
||||
@@ -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),
|
||||
"\">",
|
||||
4174
src/prolog/examples/bimetatrans_ruleml/bimetatrans_ruleml_tests.pl
Normal file
4174
src/prolog/examples/bimetatrans_ruleml/bimetatrans_ruleml_tests.pl
Normal file
File diff suppressed because it is too large
Load Diff
@@ -22,7 +22,6 @@ verify_attributes(Var, Other, Goals) :-
|
||||
( Els = [] -> % exactly one element
|
||||
Goals = [Other=El] % implied binding
|
||||
; Goals = [],
|
||||
put_atts(Other, -dom(_)),
|
||||
put_atts(Other, dom(Dc))% rescue intersection
|
||||
)
|
||||
; Goals = [],
|
||||
|
||||
31
src/prolog/examples/echo_server.pl
Normal file
31
src/prolog/examples/echo_server.pl
Normal file
@@ -0,0 +1,31 @@
|
||||
:- module(echo_server, [echo_server/0,
|
||||
echo_server/1]).
|
||||
|
||||
:- use_module(library(format)).
|
||||
:- use_module(library(sockets)).
|
||||
|
||||
|
||||
echo_server :-
|
||||
echo_server('127.0.0.1').
|
||||
|
||||
|
||||
echo_server(Addr) :-
|
||||
socket_server_open(Addr:Port, ServerSocket),
|
||||
format("echo_server: connection opened at ~w:~d~n", [Addr, Port]),
|
||||
socket_server_accept(ServerSocket, Client, Stream, [eof_action(eof_code)]),
|
||||
format("echo_server: connection accepted from ~a~n", [Client]),
|
||||
!,
|
||||
echo_loop(Stream),
|
||||
socket_server_close(ServerSocket).
|
||||
|
||||
|
||||
echo_loop(Stream) :-
|
||||
read_term(Stream, Term, []),
|
||||
( Term == end_of_file ->
|
||||
true
|
||||
;
|
||||
format("received: ~w~n", [Term]),
|
||||
!,
|
||||
echo_loop(Stream)
|
||||
).
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -31,6 +31,7 @@
|
||||
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(dif)).
|
||||
:- use_module(library(format)).
|
||||
:- use_module(library(lists)).
|
||||
|
||||
pl_resolution(Clauses0, Chain) :-
|
||||
|
||||
15
src/prolog/examples/utf8.pl
Normal file
15
src/prolog/examples/utf8.pl
Normal file
@@ -0,0 +1,15 @@
|
||||
:- use_module(library(charsio)).
|
||||
:- use_module(library(lists)).
|
||||
|
||||
:- initialization(unit_test).
|
||||
|
||||
unit_test :-
|
||||
chars_utf8bytes("a£\x2124\", Bs),
|
||||
Bs = [97, 194, 163, 226, 132, 164].
|
||||
|
||||
write_f :-
|
||||
open('x.txt', write, Stream, [type(binary)]),
|
||||
F = put_byte(Stream),
|
||||
chars_utf8bytes("£\x2124\\x2764\\x1F496\\n", Bs),
|
||||
maplist(F, Bs),
|
||||
close(Stream).
|
||||
@@ -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>,
|
||||
|
||||
@@ -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 {
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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('{'),
|
||||
|
||||
@@ -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())
|
||||
|
||||
@@ -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),
|
||||
|
||||
@@ -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>);
|
||||
|
||||
|
||||
123
src/prolog/lib/arithmetic.pl
Normal file
123
src/prolog/lib/arithmetic.pl
Normal file
@@ -0,0 +1,123 @@
|
||||
:- module(arithmetic, [expmod/4, lsb/2, msb/2, number_to_rational/2,
|
||||
number_to_rational/3,
|
||||
rational_numerator_denominator/3]).
|
||||
|
||||
:- use_module(library(charsio), [write_term_to_chars/3]).
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(lists), [append/3, member/2]).
|
||||
|
||||
expmod(Base, Expo, Mod, R) :-
|
||||
( member(N, [Base, Expo, Mod]), var(N) -> instantiation_error(expmod/4)
|
||||
; member(N, [Base, Expo, Mod]), \+ integer(N) ->
|
||||
type_error(integer, N, expmod/4)
|
||||
; Expo < 0 -> domain_error(not_less_than_zero, Expo, expmod/4)
|
||||
; expmod_(Base, Expo, Mod, 1, R)
|
||||
).
|
||||
|
||||
expmod_(_, _, 1, _, 0) :- !.
|
||||
expmod_(_, 0, _, R, R) :- !.
|
||||
expmod_(Base0, Expo0, Mod, C0, R) :-
|
||||
Expo0 /\ 1 =:= 1,
|
||||
C is (C0 * Base0) mod Mod,
|
||||
!,
|
||||
Expo is Expo0 >> 1,
|
||||
Base is (Base0 * Base0) mod Mod,
|
||||
expmod_(Base, Expo, Mod, C, R).
|
||||
expmod_(Base0, Expo0, Mod, C, R) :-
|
||||
Expo is Expo0 >> 1,
|
||||
Base is (Base0 * Base0) mod Mod,
|
||||
expmod_(Base, Expo, Mod, C, R).
|
||||
|
||||
lsb(X, N) :-
|
||||
builtins:must_be_number(X, lsb/2),
|
||||
( \+ integer(X) -> type_error(integer, X, lsb/2)
|
||||
; X < 1 -> domain_error(not_less_than_one, X, lsb/2)
|
||||
; builtins:can_be_number(N, lsb/2),
|
||||
X1 is X /\ (-X),
|
||||
msb_(X1, -1, N)
|
||||
).
|
||||
|
||||
msb(X, N) :-
|
||||
builtins:must_be_number(X, msb/2),
|
||||
( \+ integer(X) -> type_error(integer, X, msb/2)
|
||||
; X < 1 -> domain_error(not_less_than_one, X, msb/2)
|
||||
; builtins:can_be_number(N, msb/2),
|
||||
X1 is X >> 1,
|
||||
msb_(X1, 0, N)
|
||||
).
|
||||
|
||||
msb_(0, N, N) :- !.
|
||||
msb_(X, M, N) :-
|
||||
X1 is X >> 1,
|
||||
M1 is M + 1,
|
||||
msb_(X1, M1, N).
|
||||
|
||||
number_to_rational(Real, Fraction) :-
|
||||
( var(Real) -> instantiation_error(number_to_rational/2)
|
||||
; integer(Real) -> Fraction is Real rdiv 1
|
||||
; (rational(Real) ; float(Real)) ->
|
||||
number_to_rational(1.0e-6, Real, Fraction)
|
||||
; type_error(number, Real, number_to_rational/2)
|
||||
).
|
||||
|
||||
% If 0 <= Eps0 <= 1e-16 then the search is for "infinite" precision.
|
||||
number_to_rational(Eps0, Real0, Fraction) :-
|
||||
( var(Eps0) -> instantiation_error(number_to_rational/3)
|
||||
; \+ number(Eps0) -> type_error(number, Eps0, number_to_rational/3)
|
||||
; Eps0 < 0 -> domain_error(not_less_than_zero, Eps0, number_to_rational/3)
|
||||
; Eps_ is Eps0 rdiv 1,
|
||||
rational_numerator_denominator(Eps_, EpsN, EpsD),
|
||||
Eps = EpsN/EpsD
|
||||
),
|
||||
( var(Real0) -> instantiation_error(number_to_rational/3)
|
||||
; \+ number(Real0) -> type_error(number, Eps0, number_to_rational/3)
|
||||
; Real_ is Real0 rdiv 1,
|
||||
rational_numerator_denominator(Real_, RealN, RealD),
|
||||
Real = RealN/RealD
|
||||
),
|
||||
E0/E1 = Eps,
|
||||
P0/Q0 = Real,
|
||||
( P0 < 0 -> I1 is -1 + P0 // Q0
|
||||
; I1 is P0 // Q0
|
||||
),
|
||||
P1 is P0 mod Q0,
|
||||
Q1 = Q0,
|
||||
( P1 =:= 0 -> Fraction is I1 + 0 rdiv 1
|
||||
; Qn1n is max(P1 * E1 - Q1 * E0, 0),
|
||||
Qn1d is Q1 * E1,
|
||||
Qn1 = Qn1n/Qn1d,
|
||||
Qp1n is P1 * E1 + Q1 * E0,
|
||||
Qp1d = Qn1d,
|
||||
Qp1 = Qp1n/Qp1d,
|
||||
stern_brocot_(Qn1, Qp1, 0/1, 1/0, P2/Q2),
|
||||
Fraction is I1 + P2 rdiv Q2
|
||||
),
|
||||
!.
|
||||
|
||||
number(X) :-
|
||||
( integer(X)
|
||||
; float(X)
|
||||
; rational(X)
|
||||
).
|
||||
|
||||
stern_brocot_(Qnn/Qnd, Qpn/Qpd, A/B, C/D, Fraction) :-
|
||||
Fn1 is A + C,
|
||||
Fd1 is B + D,
|
||||
simplify_fraction(Fn1/Fd1, Fn/Fd),
|
||||
S1 is sign(Fn * Qnd - Fd * Qnn),
|
||||
S2 is sign(Fn * Qpd - Fd * Qpn),
|
||||
( S1 < 0 -> stern_brocot_(Qnn/Qnd, Qpn/Qpd, Fn/Fd, C/D, Fraction)
|
||||
; S2 > 0 -> stern_brocot_(Qnn/Qnd, Qpn/Qpd, A/B, Fn/Fd, Fraction)
|
||||
; Fraction = Fn/Fd
|
||||
).
|
||||
|
||||
simplify_fraction(A0/B0, A/B) :-
|
||||
G is gcd(A0, B0),
|
||||
A is A0 // G,
|
||||
B is B0 // G.
|
||||
|
||||
rational_numerator_denominator(R, N, D) :-
|
||||
write_term_to_chars(R, [], Cs),
|
||||
append(Ns, [' ', r, d, i, v, ' '|Ds], Cs),
|
||||
number_chars(N, Ns),
|
||||
number_chars(D, Ds).
|
||||
@@ -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).
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -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).
|
||||
|
||||
@@ -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).
|
||||
|
||||
@@ -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).
|
||||
|
||||
@@ -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),_)),
|
||||
|
||||
@@ -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
875
src/prolog/lib/crypto.pl
Normal file
@@ -0,0 +1,875 @@
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Written May 2020 by Markus Triska (triska@metalevel.at)
|
||||
Part of Scryer Prolog.
|
||||
|
||||
Predicates for cryptographic applications.
|
||||
|
||||
This library assumes that the Prolog flag double_quotes is set to chars.
|
||||
In Scryer Prolog, lists of characters are very efficiently represented,
|
||||
and strings have the advantage that the atom table remains unmodified.
|
||||
|
||||
Especially for cryptographic applications, it as an advantage that
|
||||
using strings leaves little trace of what was processed in the system.
|
||||
|
||||
For predicates that accept an encoding/1 option to specify the encoding
|
||||
of the input data, if encoding(octet) is used, then the input can also
|
||||
be specified as a list of bytes, i.e., integers between 0 and 255.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
:- module(crypto,
|
||||
[hex_bytes/2, % ?Hex, ?Bytes
|
||||
crypto_n_random_bytes/2, % +N, -Bytes
|
||||
crypto_data_hash/3, % +Data, -Hash, +Options
|
||||
crypto_data_hkdf/4, % +Data, +Length, -Bytes, +Options
|
||||
crypto_password_hash/2, % +Password, ?Hash
|
||||
crypto_password_hash/3, % +Password, -Hash, +Options
|
||||
crypto_data_encrypt/6, % +PlainText, +Algorithm, +Key, +IV, -CipherText, +Options
|
||||
crypto_data_decrypt/6, % +CipherText, +Algorithm, +Key, +IV, -PlainText, +Options
|
||||
ed25519_new_keypair/1, % -KeyPair
|
||||
ed25519_keypair_public_key/2, % +KeyPair, +PublicKey
|
||||
ed25519_sign/4, % +KeyPair, +Data, -Signature, +Options
|
||||
ed25519_verify/4, % +PublicKey, +Data, +Signature, +Options
|
||||
crypto_name_curve/2, % +Name, -Curve
|
||||
crypto_curve_order/2, % +Curve, -Order
|
||||
crypto_curve_generator/2, % +Curve, -Generator
|
||||
crypto_curve_scalar_mult/4 % +Curve, +Scalar, +Point, -Result
|
||||
]).
|
||||
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(between)).
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(clpz)).
|
||||
:- use_module(library(arithmetic)).
|
||||
:- use_module(library(format)).
|
||||
:- use_module(library(charsio)).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
hex_bytes(?Hex, ?Bytes) is det.
|
||||
|
||||
Relation between a hexadecimal sequence and a list of bytes. Hex
|
||||
is a string of hexadecimal numbers. Bytes is a list of *integers*
|
||||
between 0 and 255 that represent the sequence as a list of bytes.
|
||||
At least one of the arguments must be instantiated.
|
||||
|
||||
Example:
|
||||
|
||||
?- hex_bytes("501ACE", Bs).
|
||||
Bs = [80,26,206]
|
||||
; false.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
hex_bytes(Hs, Bytes) :-
|
||||
( ground(Hs) ->
|
||||
must_be(list, Hs),
|
||||
maplist(must_be(atom), Hs),
|
||||
( phrase(hex_bytes(Hs), Bytes) ->
|
||||
true
|
||||
; domain_error(hex_encoding, Hs, hex_bytes/2)
|
||||
)
|
||||
; must_be_bytes(Bytes, hex_bytes/2),
|
||||
phrase(bytes_hex(Bytes), Hs)
|
||||
).
|
||||
|
||||
hex_bytes([]) --> [].
|
||||
hex_bytes([H1,H2|Hs]) --> [Byte],
|
||||
{ char_hexval(H1, High),
|
||||
char_hexval(H2, Low),
|
||||
Byte is High*16 + Low },
|
||||
hex_bytes(Hs).
|
||||
|
||||
bytes_hex([]) --> [].
|
||||
bytes_hex([B|Bs]) --> [C0,C1],
|
||||
{ High is B>>4,
|
||||
Low is B /\ 0xf,
|
||||
char_hexval(C0, High),
|
||||
char_hexval(C1, Low)
|
||||
},
|
||||
bytes_hex(Bs).
|
||||
|
||||
char_hexval(C, H) :- nth0(H, "0123456789abcdef", C), !.
|
||||
char_hexval(C, H) :- nth0(H, "0123456789ABCDEF", C), !.
|
||||
|
||||
|
||||
must_be_bytes(Bytes, Context) :-
|
||||
must_be(list, Bytes),
|
||||
maplist(must_be(integer), Bytes),
|
||||
( member(B, Bytes), \+ between(0, 255, B) ->
|
||||
type_error(byte, B, Context)
|
||||
; true
|
||||
).
|
||||
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Cryptographically secure random numbers
|
||||
=======================================
|
||||
|
||||
crypto_n_random_bytes(+N, -Bytes) is det
|
||||
|
||||
Bytes is unified with a list of N cryptographically secure
|
||||
pseudo-random bytes. Each byte is an integer between 0 and 255. If
|
||||
the internal pseudo-random number generator (PRNG) has not been
|
||||
seeded with enough entropy to ensure an unpredictable byte
|
||||
sequence, an exception is thrown.
|
||||
|
||||
One way to relate such a list of bytes to an _integer_ is to use
|
||||
CLP(ℤ) constraints as follows:
|
||||
|
||||
:- use_module(library(clpz)).
|
||||
:- use_module(library(lists)).
|
||||
|
||||
bytes_integer(Bs, N) :-
|
||||
foldl(pow, Bs, 0-0, N-_).
|
||||
|
||||
pow(B, N0-I0, N-I) :-
|
||||
B in 0..255,
|
||||
N #= N0 + B*256^I0,
|
||||
I #= I0 + 1.
|
||||
|
||||
With this definition, we can generate a random 256-bit integer
|
||||
_from_ a list of 32 random _bytes_:
|
||||
|
||||
?- crypto_n_random_bytes(32, Bs),
|
||||
bytes_integer(Bs, I).
|
||||
Bs = [146,166,162,210,242,7,25,132,64,94|...],
|
||||
I = 337420085690608915485...(56 digits omitted)
|
||||
|
||||
The above relation also works in the other direction, letting you
|
||||
translate an integer _to_ a list of bytes. In addition, you can
|
||||
use hex_bytes/2 to convert bytes to _tokens_ that can be easily
|
||||
exchanged in your applications.
|
||||
|
||||
?- crypto_n_random_bytes(12, Bs),
|
||||
hex_bytes(Hex, Bs).
|
||||
Bs = [34,25,50,72,58,63,50,172,32,46|...], Hex = "221932483a3f32ac202 ..."
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
crypto_n_random_bytes(N, Bs) :-
|
||||
must_be(integer, N),
|
||||
length(Bs, N),
|
||||
maplist(crypto_random_byte, Bs).
|
||||
|
||||
crypto_random_byte(B) :- '$crypto_random_byte'(B).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Hashing
|
||||
=======
|
||||
|
||||
crypto_data_hash(+Data, -Hash, +Options)
|
||||
|
||||
Where Data is a list of characters, and Hash is the computed hash
|
||||
as a list of hexadecimal characters.
|
||||
|
||||
Options is a list of:
|
||||
|
||||
- algorithm(+A)
|
||||
where A is one of ripemd160, sha256, sha384, sha512, sha512_256,
|
||||
sha3_224, sha3_256, sha3_384, sha3_512, blake2s256, blake2b512,
|
||||
or a variable. If A is a variable, then it is unified with the
|
||||
default algorithm, which is an algorithm that is considered
|
||||
cryptographically secure at the time of this writing.
|
||||
- encoding(+Encoding)
|
||||
The default encoding is utf8. The alternative is octet,
|
||||
to treat the input as a list of raw bytes.
|
||||
|
||||
Example:
|
||||
|
||||
?- crypto_data_hash("abc", Hs, [algorithm(sha256)]).
|
||||
Hs = "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad"
|
||||
; false.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
SHA256 is the current default for several hash-related predicates.
|
||||
It is deemed sufficiently secure for the foreseeable future. Yet,
|
||||
application programmers must be aware that the default may change in
|
||||
future versions. The hash predicates all yield the algorithm they
|
||||
used if a Prolog variable is used for the pertaining option.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
crypto_data_hash(Data0, Hash, Options0) :-
|
||||
must_be(list, Options0),
|
||||
options_data_bytes(Options0, Data0, Data),
|
||||
functor_hash_options(algorithm, A, Options0, _),
|
||||
( hash_algorithm(A) -> true
|
||||
; domain_error(hash_algorithm, A, crypto_data_hash/3)
|
||||
),
|
||||
'$crypto_data_hash'(Data, HashBytes, A),
|
||||
hex_bytes(Hash, HashBytes).
|
||||
|
||||
options_data_bytes(Options, Data, Bytes) :-
|
||||
option(encoding(Encoding), Options, utf8),
|
||||
must_be(atom, Encoding),
|
||||
encoding_bytes(Encoding, Data, Bytes).
|
||||
|
||||
default_hash(sha256).
|
||||
|
||||
functor_hash_options(F, Hash, Options0, [Option|Options]) :-
|
||||
Option =.. [F,Hash],
|
||||
( select(Option, Options0, Options) ->
|
||||
( var(Hash) ->
|
||||
default_hash(Hash)
|
||||
; must_be(atom, Hash)
|
||||
)
|
||||
; Options = Options0,
|
||||
default_hash(Hash)
|
||||
).
|
||||
|
||||
hash_algorithm(ripemd160).
|
||||
hash_algorithm(sha256).
|
||||
hash_algorithm(sha512).
|
||||
hash_algorithm(sha384).
|
||||
hash_algorithm(sha512_256).
|
||||
hash_algorithm(sha3_224).
|
||||
hash_algorithm(sha3_256).
|
||||
hash_algorithm(sha3_384).
|
||||
hash_algorithm(sha3_512).
|
||||
hash_algorithm(blake2s256).
|
||||
hash_algorithm(blake2b512).
|
||||
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
crypto_data_hkdf(+Data, +Length, -Bytes, +Options) is det.
|
||||
|
||||
Concentrate possibly dispersed entropy of Data and then expand it
|
||||
to the desired length. Data is a list of characters.
|
||||
|
||||
Bytes is unified with a list of bytes of length Length, and is
|
||||
suitable as input keying material and initialization vectors to
|
||||
symmetric encryption algorithms.
|
||||
|
||||
Admissible options are:
|
||||
|
||||
- algorithm(+Algorithm)
|
||||
One of sha256, sha384 or sha512. If you specify a variable,
|
||||
then it is unified with the algorithm that was used, which is a
|
||||
cryptographically secure algorithm by default.
|
||||
- info(+Info)
|
||||
Optional context and application specific information,
|
||||
specified as a list of characters. The default is [].
|
||||
- salt(+List)
|
||||
Optionally, a list of bytes that are used as salt. The
|
||||
default is all zeroes.
|
||||
- encoding(+Encoding)
|
||||
The default encoding is utf8. The alternative is octet,
|
||||
to treat the input as a list of raw bytes.
|
||||
|
||||
The `info/1` option can be used to generate multiple keys from a
|
||||
single master key, using for example values such as "key" and
|
||||
"iv", or the name of a file that is to be encrypted.
|
||||
|
||||
See crypto_n_random_bytes/2 to obtain a suitable salt.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
crypto_data_hkdf(Data0, L, Bytes, Options0) :-
|
||||
functor_hash_options(algorithm, Algorithm, Options0, Options),
|
||||
( hkdf_algorithm(Algorithm) -> true
|
||||
; domain_error(hkdf_algorithm, Algorithm, crypto_data_hkdf/4)
|
||||
),
|
||||
must_be(integer, L),
|
||||
L >= 0,
|
||||
options_data_bytes(Options, Data0, Data),
|
||||
option(salt(SaltBytes), Options, []),
|
||||
must_be_bytes(SaltBytes, crypto_data_hkdf/4),
|
||||
option(info(Info0), Options, []),
|
||||
chars_bytes_(Info0, Info, crypto_data_hkdf/4),
|
||||
'$crypto_data_hkdf'(Data, SaltBytes, Info, Algorithm, L, Bytes).
|
||||
|
||||
hkdf_algorithm(sha256).
|
||||
hkdf_algorithm(sha384).
|
||||
hkdf_algorithm(sha512).
|
||||
|
||||
option(What, Options, Default) :-
|
||||
( member(V, Options), var(V) ->
|
||||
instantiation_error(option/3)
|
||||
; true
|
||||
),
|
||||
( member(What, Options) -> true
|
||||
; What =.. [_,Default]
|
||||
).
|
||||
|
||||
chars_bytes_(Cs, Bytes, Context) :-
|
||||
must_be(list, Cs),
|
||||
( maplist(integer, Cs) -> Bytes = Cs
|
||||
; chars_utf8bytes(Cs, Bytes)
|
||||
),
|
||||
must_be_bytes(Bytes, Context).
|
||||
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
The so-called modular crypt format (MCF) is a standard for encoding
|
||||
password hash strings. However, there's no official specification
|
||||
document describing it. Nor is there a central registry of
|
||||
identifiers or rules. This page describes what is known about it:
|
||||
|
||||
https://pythonhosted.org/passlib/modular_crypt_format.html
|
||||
|
||||
As of 2016, the MCF is deprecated in favor of the PHC String Format:
|
||||
|
||||
https://github.com/P-H-C/phc-string-format/blob/master/phc-sf-spec.md
|
||||
|
||||
This is what we are using below. For the time being, it is best to
|
||||
treat these hashes as opaque terms in applications. Please let me
|
||||
know if you need to rely on any specifics of this format.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
crypto_password_hash(+Password, ?Hash) is semidet.
|
||||
|
||||
If Hash is instantiated, the predicate succeeds _iff_ the hash
|
||||
matches the given password. Otherwise, the call is equivalent to
|
||||
crypto_password_hash(Password, Hash, []) and computes a
|
||||
password-based hash using the default options.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
crypto_password_hash(Password0, Hash) :-
|
||||
( nonvar(Hash) ->
|
||||
chars_bytes_(Password0, Password, crypto_password_hash/2),
|
||||
must_be(list, Hash),
|
||||
dollar_segments(Hash, [[],"pbkdf2-sha512",[t,=|CsIterations],SaltB64,HashB64]),
|
||||
number_chars(Iterations, CsIterations),
|
||||
bytes_base64(SaltBytes, SaltB64),
|
||||
bytes_base64(HashBytes, HashB64),
|
||||
'$crypto_password_hash'(Password, SaltBytes, Iterations, HashBytes)
|
||||
; crypto_password_hash(Password0, Hash, [])
|
||||
).
|
||||
|
||||
|
||||
dollar_segments(Ls, Segments) :-
|
||||
( append(Front, [$|Ds], Ls) ->
|
||||
Segments = [Front|Rest],
|
||||
dollar_segments(Ds, Rest)
|
||||
; Segments = [Ls]
|
||||
).
|
||||
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
crypto_password_hash(+Password, -Hash, +Options) is det.
|
||||
|
||||
Derive Hash based on Password. This predicate is similar to
|
||||
crypto_data_hash/3 in that it derives a hash from given data.
|
||||
However, it is tailored for the specific use case of _passwords_.
|
||||
One essential distinction is that for this use case, the derivation
|
||||
of a hash should be _as slow as possible_ to counteract brute-force
|
||||
attacks over possible passwords.
|
||||
|
||||
Another important distinction is that equal passwords must yield,
|
||||
with very high probability, _different_ hashes. For this reason,
|
||||
cryptographically strong random numbers are automatically added to
|
||||
the password before a hash is derived.
|
||||
|
||||
Hash is unified with a string that contains the computed hash and
|
||||
all parameters that were used, except for the password. Instead of
|
||||
storing passwords, store these hashes. Later, you can verify the
|
||||
validity of a password with crypto_password_hash/2, comparing the
|
||||
then entered password to the stored hash. If you need to export this
|
||||
atom, you should treat it as opaque ASCII data with up to 255 bytes
|
||||
of length. The maximal length may increase in the future.
|
||||
|
||||
Admissible options are:
|
||||
|
||||
- algorithm(+Algorithm)
|
||||
The algorithm to use. Currently, the only available algorithm
|
||||
is 'pbkdf2-sha512', which is therefore also the default.
|
||||
- cost(+C)
|
||||
C is an integer, denoting the binary logarithm of the number
|
||||
of _iterations_ used for the derivation of the hash. This
|
||||
means that the number of iterations is set to 2^C. Currently,
|
||||
the default is 17, and thus more than one hundred _thousand_
|
||||
iterations. You should set this option as high as your server
|
||||
and users can tolerate. The default is subject to change and
|
||||
will likely increase in the future or adapt to new algorithms.
|
||||
- salt(+Salt)
|
||||
Use the given list of bytes as salt. By default,
|
||||
cryptographically secure random numbers are generated for this
|
||||
purpose. The default is intended to be secure, and constitutes
|
||||
the typical use case of this predicate.
|
||||
|
||||
Currently, PBKDF2 with SHA-512 is used as the hash derivation
|
||||
function, using 128 bits of salt. All default parameters, including
|
||||
the algorithm, are subject to change, and other algorithms will also
|
||||
become available in the future. Since computed hashes store all
|
||||
parameters that were used during their derivation, such changes will
|
||||
not affect the operation of existing deployments. Note though that
|
||||
new hashes will then be computed with the new default parameters.
|
||||
|
||||
See crypto_data_hkdf/4 for generating keys from Hash.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
crypto_password_hash(Password0, Hash, Options) :-
|
||||
chars_bytes_(Password0, Password, crypto_password_hash/3),
|
||||
must_be(list, Options),
|
||||
option(cost(C), Options, 17),
|
||||
Iterations is 2^C,
|
||||
Algorithm = 'pbkdf2-sha512', % current default and only option
|
||||
option(algorithm(Algorithm), Options, Algorithm),
|
||||
( member(salt(SaltBytes), Options) ->
|
||||
must_be_bytes(SaltBytes, crypto_password_hash/2)
|
||||
; crypto_n_random_bytes(16, SaltBytes)
|
||||
),
|
||||
'$crypto_password_hash'(Password, SaltBytes, Iterations, HashBytes),
|
||||
bytes_base64(HashBytes, HashB64),
|
||||
bytes_base64(SaltBytes, SaltB64),
|
||||
phrase(format_("$pbkdf2-sha512$t=~d$~s$~s", [Iterations,SaltB64,HashB64]), Hash).
|
||||
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Bidirectional Bytes <-> Base64 conversion
|
||||
=========================================
|
||||
|
||||
This implements Base64 conversion *without padding*.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
n_base64(0 , 'A'). n_base64(1 , 'B'). n_base64(2 , 'C'). n_base64(3 , 'D').
|
||||
n_base64(4 , 'E'). n_base64(5 , 'F'). n_base64(6 , 'G'). n_base64(7 , 'H').
|
||||
n_base64(8 , 'I'). n_base64(9 , 'J'). n_base64(10, 'K'). n_base64(11, 'L').
|
||||
n_base64(12, 'M'). n_base64(13, 'N'). n_base64(14, 'O'). n_base64(15, 'P').
|
||||
n_base64(16, 'Q'). n_base64(17, 'R'). n_base64(18, 'S'). n_base64(19, 'T').
|
||||
n_base64(20, 'U'). n_base64(21, 'V'). n_base64(22, 'W'). n_base64(23, 'X').
|
||||
n_base64(24, 'Y'). n_base64(25, 'Z'). n_base64(26, 'a'). n_base64(27, 'b').
|
||||
n_base64(28, 'c'). n_base64(29, 'd'). n_base64(30, 'e'). n_base64(31, 'f').
|
||||
n_base64(32, 'g'). n_base64(33, 'h'). n_base64(34, 'i'). n_base64(35, 'j').
|
||||
n_base64(36, 'k'). n_base64(37, 'l'). n_base64(38, 'm'). n_base64(39, 'n').
|
||||
n_base64(40, 'o'). n_base64(41, 'p'). n_base64(42, 'q'). n_base64(43, 'r').
|
||||
n_base64(44, 's'). n_base64(45, 't'). n_base64(46, 'u'). n_base64(47, 'v').
|
||||
n_base64(48, 'w'). n_base64(49, 'x'). n_base64(50, 'y'). n_base64(51, 'z').
|
||||
n_base64(52, '0'). n_base64(53, '1'). n_base64(54, '2'). n_base64(55, '3').
|
||||
n_base64(56, '4'). n_base64(57, '5'). n_base64(58, '6'). n_base64(59, '7').
|
||||
n_base64(60, '8'). n_base64(61, '9'). n_base64(62, '+'). n_base64(63, '/').
|
||||
|
||||
bytes_base64(Ls, Bs) :-
|
||||
( list(Bs), maplist(atom, Bs) ->
|
||||
maplist(n_base64, Is, Bs),
|
||||
phrase(bytes_base64_(Ls), Is),
|
||||
Ls ins 0..255
|
||||
; phrase(bytes_base64_(Ls), Is),
|
||||
Is ins 0..63,
|
||||
maplist(n_base64, Is, Bs)
|
||||
).
|
||||
|
||||
list(Ls) :-
|
||||
nonvar(Ls),
|
||||
( Ls = [] -> true
|
||||
; Ls = [_|Rest],
|
||||
list(Rest)
|
||||
).
|
||||
|
||||
bytes_base64_([]) --> [].
|
||||
bytes_base64_([A]) --> [W,X],
|
||||
{ A #= W*4 + X//16,
|
||||
X #= 16*_ }.
|
||||
bytes_base64_([A,B]) --> [W,X,Y],
|
||||
{ A #= W*4 + X//16,
|
||||
B #= (X mod 16)*16 + Y//4,
|
||||
Y #= 4*_ }.
|
||||
bytes_base64_([A,B,C|Ls]) --> [W,X,Y,Z],
|
||||
{ A #= W*4 + X//16,
|
||||
B #= (X mod 16)*16 + Y//4,
|
||||
C #= (Y mod 4)*64 + Z },
|
||||
bytes_base64_(Ls).
|
||||
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
crypto_data_encrypt(+PlainText,
|
||||
+Algorithm,
|
||||
+Key,
|
||||
+IV,
|
||||
-CipherText,
|
||||
+Options).
|
||||
|
||||
Encrypt the given PlainText, using the symmetric algorithm
|
||||
Algorithm, key Key, and initialization vector (or nonce) IV, to
|
||||
give CipherText.
|
||||
|
||||
PlainText must be a list of characters, Key and IV must be lists of
|
||||
bytes, and CipherText is created as a list of characters.
|
||||
|
||||
Keys and IVs can be chosen at random (using for example
|
||||
crypto_n_random_bytes/2) or derived from input keying material (IKM)
|
||||
using for example crypto_data_hkdf/4. This input is often a shared
|
||||
secret, such as a negotiated point on an elliptic curve, or the hash
|
||||
that was computed from a password via crypto_password_hash/3 with a
|
||||
freshly generated and specified _salt_.
|
||||
|
||||
Reusing the same combination of Key and IV typically leaks at least
|
||||
_some_ information about the plaintext. For example, identical
|
||||
plaintexts will then correspond to identical ciphertexts. For some
|
||||
algorithms, reusing an IV with the same Key has disastrous results
|
||||
and can cause the loss of all properties that are otherwise
|
||||
guaranteed. Especially in such cases, an IV is also called a
|
||||
_nonce_ (number used once).
|
||||
|
||||
It is safe to store and transfer the used initialization vector (or
|
||||
nonce) in plain text, but the key _must be kept secret_.
|
||||
|
||||
Currently, the only supported algorithm is 'chacha20-poly1305', a
|
||||
powerful and efficient _authenticated_ encryption scheme, providing
|
||||
secrecy and at the same time reliable protection against undetected
|
||||
_modifications_ of the encrypted data. This is a very good choice
|
||||
for virtually all use cases. It is a stream cipher and can encrypt
|
||||
data of any length up to 256 GB. Further, the encrypted data has
|
||||
exactly the same length as the original, and no padding is used.
|
||||
|
||||
Options:
|
||||
|
||||
- encoding(+Encoding)
|
||||
Encoding to use for PlainText. Default is utf8. The alternative
|
||||
is octet to treat PlainText as raw bytes.
|
||||
|
||||
- tag(-List)
|
||||
For authenticated encryption schemes, List is unified with a
|
||||
list of _bytes_ holding the tag. This tag must be provided for
|
||||
decryption.
|
||||
|
||||
Here is an example encryption and decryption, using the ChaCha20
|
||||
stream cipher with the Poly1305 authenticator. This cipher uses a
|
||||
256-bit key and a 96-bit nonce, i.e., 32 and 12 _bytes_,
|
||||
respectively:
|
||||
|
||||
?- Algorithm = 'chacha20-poly1305',
|
||||
crypto_n_random_bytes(32, Key),
|
||||
crypto_n_random_bytes(12, IV),
|
||||
crypto_data_encrypt("this text is to be encrypted", Algorithm,
|
||||
Key, IV, CipherText, [tag(Tag)]),
|
||||
crypto_data_decrypt(CipherText, Algorithm,
|
||||
Key, IV, RecoveredText, [tag(Tag)]).
|
||||
|
||||
Yielding:
|
||||
|
||||
Algorithm = 'chacha20-poly1305',
|
||||
Key = [113,247,153,134,177,220,13,193,50,150|...],
|
||||
IV = [135,20,149,153,63,35,68,114,247,171|...],
|
||||
CipherText = "\x94\0Ej\x94\®Â\x95\óÑÆXÃn¾ð©b\x1c\ ...",
|
||||
RecoveredText = "this text is to be ...",
|
||||
Tag = [152,117,152,17,162,75,150,206,144,40|...]
|
||||
|
||||
In this example, we use crypto_n_random_bytes/2 to generate a key
|
||||
and nonce from cryptographically secure random numbers. For
|
||||
repeated applications, you must ensure that a nonce is only used
|
||||
_once_ together with the same key. Note that for _authenticated_
|
||||
encryption schemes, the _tag_ that was computed during encryption
|
||||
is necessary for decryption. It is safe to store and transfer the
|
||||
tag in plain text.
|
||||
|
||||
See also crypto_data_decrypt/6, and hex_bytes/2 for conversion
|
||||
between bytes and hex encoding.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
crypto_data_encrypt(PlainText0, Algorithm, Key, IV, CipherText, Options) :-
|
||||
options_data_bytes(Options, PlainText0, PlainText),
|
||||
option(tag(Tag), Options, _),
|
||||
( nonvar(Tag) ->
|
||||
must_be_bytes(Tag, crypto_data_encrypt/6)
|
||||
; true
|
||||
),
|
||||
must_be_bytes(Key, crypto_data_encrypt/6),
|
||||
must_be_bytes(IV, crypto_data_encrypt/6),
|
||||
must_be(atom, Algorithm),
|
||||
( Algorithm = 'chacha20-poly1305' -> true
|
||||
; domain_error('chacha20-poly1305', Algorithm, crypto_data_encrypt/6)
|
||||
),
|
||||
'$crypto_data_encrypt'(PlainText, Key, IV, Tag, CipherText).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
crypto_data_decrypt(+CipherText,
|
||||
+Algorithm,
|
||||
+Key,
|
||||
+IV,
|
||||
-PlainText,
|
||||
+Options).
|
||||
|
||||
Decrypt the given CipherText, using the symmetric algorithm
|
||||
Algorithm, key Key, and initialization vector IV, to give
|
||||
PlainText. CipherText must be a list of characters, and Key and IV
|
||||
must be lists of bytes. PlainText is created as a list of
|
||||
characters.
|
||||
|
||||
Currently, the only supported algorithm is 'chacha20-poly1305',
|
||||
a very secure, fast and versatile authenticated encryption method.
|
||||
|
||||
Options is a list of:
|
||||
|
||||
- encoding(+Encoding)
|
||||
Encoding to use for PlainText. The default is utf8. The
|
||||
alternative is octet, which is used if the data are raw bytes.
|
||||
|
||||
- tag(+Tag)
|
||||
For authenticated encryption schemes, the tag must be specified as
|
||||
a list of bytes exactly as they were generated upon encryption.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
crypto_data_decrypt(CipherText0, Algorithm, Key, IV, PlainText, Options) :-
|
||||
option(tag(Tag), Options, []),
|
||||
must_be_bytes(Tag, crypto_data_decrypt/6),
|
||||
must_be_bytes(Key, crypto_data_decrypt/6),
|
||||
must_be_bytes(IV, crypto_data_decrypt/6),
|
||||
must_be(atom, Algorithm),
|
||||
option(encoding(Encoding), Options, utf8),
|
||||
must_be(atom, Encoding),
|
||||
member(Encoding, [utf8,octet]),
|
||||
must_be(list, CipherText0),
|
||||
encoding_bytes(octet, CipherText0, CipherText1),
|
||||
append(CipherText1, Tag, CipherText),
|
||||
( Algorithm = 'chacha20-poly1305' -> true
|
||||
; domain_error('chacha20-poly1305', Algorithm, crypto_data_decrypt/6)
|
||||
),
|
||||
'$crypto_data_decrypt'(CipherText, Key, IV, Encoding, PlainText).
|
||||
|
||||
encoding_bytes(octet, Bs0, Bs) :-
|
||||
must_be(list, Bs0),
|
||||
( maplist(integer, Bs0) ->
|
||||
Bs0 = Bs
|
||||
; maplist(char_code, Bs0, Bs)
|
||||
),
|
||||
must_be_bytes(Bs, crypto_encoding).
|
||||
encoding_bytes(utf8, Cs, Bs) :-
|
||||
must_be(list, Cs),
|
||||
( maplist(atom, Cs) ->
|
||||
chars_bytes_(Cs, Bs, crypto_encoding)
|
||||
; domain_error(encryption_encoding, Cs, crypto)
|
||||
).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Digital signatures with Ed25519
|
||||
===============================
|
||||
|
||||
- ed25519_new_keypair(-Pair)
|
||||
Yields a new Ed25519 key pair Pair, a list of characters. The
|
||||
pair contains the private key and must be kept absolutely secret.
|
||||
Pair can be used for signing. Its public key can be obtained
|
||||
with ed25519_keypair_public_key/2.
|
||||
|
||||
- ed25519_keypair_public_key(+Pair, -PublicKey)
|
||||
PublicKey is the public key of the given key pair. The public key
|
||||
can be used for signature verification, and can be shared freely.
|
||||
The public key is represented as a list of characters.
|
||||
|
||||
- ed25519_sign(+Key, +Data, -Signature, +Options)
|
||||
Key and Data must be lists of characters. Key is a key pair in
|
||||
PKCS#8 v2 format as generated by ed25519_new_keypair/1. Sign Data
|
||||
with Key, yielding Signature as a list of hexadecimal characters.
|
||||
|
||||
- ed25519_verify(+Key, +Data, +Signature, +Options)
|
||||
Key and Data must be lists of characters. Key is a public key.
|
||||
Succeeds if Data was signed with the private key corresponding to
|
||||
Key, where Signature is a list of hexadecimal characters as
|
||||
generated by ed25519_sign/4. Fails otherwise.
|
||||
|
||||
Currently, the only option for signing and verifying is:
|
||||
|
||||
- encoding(+Encoding)
|
||||
The default encoding of Data is utf8. The alternative is octet,
|
||||
which treats Data as a list of raw bytes.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
ed25519_new_keypair(Pair) :-
|
||||
'$ed25519_new_keypair'(Pair).
|
||||
|
||||
ed25519_keypair_public_key(Pair0, PublicKey) :-
|
||||
encoding_bytes(octet, Pair0, Pair),
|
||||
'$ed25519_keypair_public_key'(Pair, PublicKey).
|
||||
|
||||
ed25519_sign(Key0, Data0, Signature, Options) :-
|
||||
options_data_bytes(Options, Data0, Data),
|
||||
encoding_bytes(octet, Key0, Key),
|
||||
'$ed25519_sign'(Key, Data, Signature0),
|
||||
hex_bytes(Signature, Signature0).
|
||||
|
||||
ed25519_verify(Key0, Data0, Signature0, Options) :-
|
||||
options_data_bytes(Options, Data0, Data),
|
||||
encoding_bytes(octet, Key0, Key),
|
||||
hex_bytes(Signature0, Signature),
|
||||
'$ed25519_verify'(Key, Data, Signature).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Modular multiplicative inverse.
|
||||
|
||||
Compute Y = X^(-1) mod p, using the extended Euclidean algorithm.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
multiplicative_inverse_modulo_p(X, P, Y) :-
|
||||
eea(X, P, _, _, Y),
|
||||
R #= X*Y mod P,
|
||||
zcompare(C, 1, R),
|
||||
must_be_one(C, X, P, Y).
|
||||
|
||||
must_be_one(=, _, _, _).
|
||||
must_be_one(>, X, P, Y) :- throw(multiplicative_inverse_modulo_p(X,P,Y)).
|
||||
must_be_one(<, X, P, Y) :- throw(multiplicative_inverse_modulo_p(X,P,Y)).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Extended Euclidean algorithm.
|
||||
|
||||
Computes the GCD and the Bézout coefficients S and T.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
eea(I, J, G, S, T) :-
|
||||
State0 = state(1,0,0,1),
|
||||
eea_loop(I, J, State0, G, S, T).
|
||||
|
||||
eea_loop(I, J, State0, G, S, T) :-
|
||||
zcompare(C, 0, J),
|
||||
eea_(C, I, J, State0, G, S, T).
|
||||
|
||||
eea_(=, I, _, state(_,_,U,V), I, U, V).
|
||||
eea_(<, I0, J0, state(S0,T0,U0,V0), I, U, V) :-
|
||||
Q #= I0 // J0,
|
||||
R #= I0 mod J0,
|
||||
S1 #= U0 - (Q*S0),
|
||||
T1 #= V0 - (Q*T0),
|
||||
eea_loop(J0, R, state(S1,T1,S0,T0), I, U, V).
|
||||
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Operations on Elliptic Curves
|
||||
=============================
|
||||
|
||||
Sample use: Establishing a shared secret S, using ECDH key exchange.
|
||||
|
||||
?- crypto_name_curve(Name, C),
|
||||
crypto_curve_generator(C, Generator),
|
||||
PrivateKey = 10,
|
||||
crypto_curve_scalar_mult(C, PrivateKey, Generator, PublicKey),
|
||||
Random = 12,
|
||||
crypto_curve_scalar_mult(C, Random, Generator, R),
|
||||
crypto_curve_scalar_mult(C, Random, PublicKey, S),
|
||||
crypto_curve_scalar_mult(C, PrivateKey, R, S).
|
||||
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
An elliptic curve over a prime field F_p is represented as:
|
||||
|
||||
curve(P,A,B,point(X,Y),Order,Cofactor).
|
||||
|
||||
First, we define suitable accessors.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
curve_p(curve(P,_,_,_,_,_), P).
|
||||
curve_a(curve(_,A,_,_,_,_), A).
|
||||
curve_b(curve(_,_,B,_,_,_), B).
|
||||
|
||||
crypto_curve_order(curve(_,_,_,_,Order,_), Order).
|
||||
crypto_curve_generator(curve(_,_,_,G,_,_), G).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Scalar point multiplication.
|
||||
|
||||
R = k*Q.
|
||||
|
||||
The Montgomery ladder method is used to mitigate side-channel
|
||||
attacks such as timing attacks, since the number of multiplications
|
||||
and additions is independent of the private key K. This method does
|
||||
not even reveal the key's Hamming weight (number of 1s).
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
crypto_curve_scalar_mult(Curve, K, Q, R) :-
|
||||
msb(K, Upper),
|
||||
scalar_multiplication(Curve, K, Upper, ml(null,Q)-R),
|
||||
must_be_on_curve(Curve, R).
|
||||
|
||||
scalar_multiplication(Curve, K, I, R0-R) :-
|
||||
zcompare(C, -1, I),
|
||||
scalar_mult_(C, Curve, K, I, R0-R).
|
||||
|
||||
scalar_mult_(=, _, _, _, ml(R,_)-R).
|
||||
scalar_mult_(<, Curve, K, I0, ML0-R) :-
|
||||
BitSet #= K /\ (1 << I0),
|
||||
zcompare(C, 0, BitSet),
|
||||
montgomery_step(C, Curve, ML0, ML1),
|
||||
I1 #= I0 - 1,
|
||||
scalar_multiplication(Curve, K, I1, ML1-R).
|
||||
|
||||
montgomery_step(=, Curve, ml(R0,S0), ml(R,S)) :-
|
||||
curve_points_addition(Curve, R0, S0, S),
|
||||
curve_point_double(Curve, R0, R).
|
||||
montgomery_step(<, Curve, ml(R0,S0), ml(R,S)) :-
|
||||
curve_points_addition(Curve, R0, S0, R),
|
||||
curve_point_double(Curve, S0, S).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Doubling a point: R = A + A.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
curve_point_double(_, null, null).
|
||||
curve_point_double(Curve, point(AX,AY), R) :-
|
||||
curve_p(Curve, P),
|
||||
curve_a(Curve, A),
|
||||
Numerator #= (3*AX^2 + A) mod P,
|
||||
Denom0 #= 2*AY mod P,
|
||||
multiplicative_inverse_modulo_p(Denom0, P, Denom),
|
||||
S #= (Numerator*Denom) mod P,
|
||||
R = point(RX,RY),
|
||||
RX #= (S^2 - 2*AX) mod P,
|
||||
RY #= (S*(AX - RX) - AY) mod P,
|
||||
must_be_on_curve(Curve, R).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Adding two points.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
curve_points_addition(Curve, P, Q, R) :-
|
||||
curve_points_addition_(P, Curve, Q, R).
|
||||
|
||||
curve_points_addition_(null, _, P, P).
|
||||
curve_points_addition_(P, _, null, P).
|
||||
curve_points_addition_(point(AX,AY), Curve, point(BX,BY), R) :-
|
||||
curve_p(Curve, P),
|
||||
Numerator #= (AY - BY) mod P,
|
||||
Denom0 #= (AX - BX) mod P,
|
||||
multiplicative_inverse_modulo_p(Denom0, P, Denom),
|
||||
S #= (Numerator * Denom) mod P,
|
||||
R = point(RX,RY),
|
||||
RX #= (S^2 - AX - BX) mod P,
|
||||
RY #= (S*(AX - RX) - AY) mod P,
|
||||
must_be_on_curve(Curve, R).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Validation.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
curve_contains_point(Curve, point(QX,QY)) :-
|
||||
curve_a(Curve, A),
|
||||
curve_b(Curve, B),
|
||||
curve_p(Curve, P),
|
||||
QY^2 mod P #= (QX^3 + A*QX + B) mod P.
|
||||
|
||||
must_be_on_curve(Curve, P) :-
|
||||
\+ curve_contains_point(Curve, P),
|
||||
throw(not_on_curve(P)).
|
||||
must_be_on_curve(Curve, P) :- curve_contains_point(Curve, P).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Predefined curves
|
||||
=================
|
||||
|
||||
List available curves:
|
||||
|
||||
$ openssl ecparam -list_curves
|
||||
|
||||
Show curve parameters for secp256k1:
|
||||
|
||||
$ openssl ecparam -param_enc explicit -conv_form uncompressed \
|
||||
-text -no_seed -name secp256k1
|
||||
|
||||
You must remove the leading "04:" from the generator.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
crypto_name_curve(secp112r1,
|
||||
curve(0x00db7c2abf62e35e668076bead208b,
|
||||
0x00db7c2abf62e35e668076bead2088,
|
||||
0x659ef8ba043916eede8911702b22,
|
||||
point(0x09487239995a5ee76b55f9c2f098,
|
||||
0xa89ce5af8724c0a23e0e0ff77500),
|
||||
0x00db7c2abf62e35e7628dfac6561c5,
|
||||
1)).
|
||||
crypto_name_curve(secp256k1,
|
||||
curve(0x00fffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc2f,
|
||||
0x0,
|
||||
0x7,
|
||||
point(0x79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798,
|
||||
0x483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8),
|
||||
0x00fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141,
|
||||
1)).
|
||||
@@ -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).
|
||||
|
||||
@@ -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)).
|
||||
|
||||
@@ -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
|
||||
).
|
||||
|
||||
@@ -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)
|
||||
).
|
||||
|
||||
|
||||
@@ -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).
|
||||
|
||||
@@ -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
24
src/prolog/lib/pio.pl
Normal file
@@ -0,0 +1,24 @@
|
||||
:- module(pio, [phrase_from_file/2,
|
||||
phrase_from_file/3]).
|
||||
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(lists), [member/2]).
|
||||
|
||||
phrase_from_file(NT, File) :-
|
||||
phrase_from_file(NT, File, []).
|
||||
|
||||
phrase_from_file(NT, File, Options) :-
|
||||
( var(File) -> instantiation_error(phrase_from_file/3)
|
||||
; (\+ atom(File) ; File = []) ->
|
||||
domain_error(source_sink, File, phrase_from_file/3)
|
||||
; must_be(list, Options),
|
||||
( member(Var, Options), var(Var) -> instantiation_error(phrase_from_file/3)
|
||||
; member(type(Type), Options) ->
|
||||
must_be(atom, Type),
|
||||
member(Type, [text,binary])
|
||||
; Type = text
|
||||
),
|
||||
'$file_to_chars'(File, Chars, Type),
|
||||
phrase(NT, Chars)
|
||||
).
|
||||
59
src/prolog/lib/random.pl
Normal file
59
src/prolog/lib/random.pl
Normal file
@@ -0,0 +1,59 @@
|
||||
:- module(random, [maybe/0, random/1, random_integer/3, set_random/1]).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
To retain desirable declarative properties, predicates that internally
|
||||
use random numbers should be equipped with an argument that specifies
|
||||
the random seed. This makes everything completely reproducible.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
:- use_module(library(error)).
|
||||
|
||||
% succeeds with probability 0.5.
|
||||
maybe :- '$maybe'.
|
||||
|
||||
% The higher the precision, the slower it gets.
|
||||
random_number_precision(64).
|
||||
|
||||
random(R) :-
|
||||
var(R),
|
||||
random_number_precision(N),
|
||||
rnd(N, R).
|
||||
|
||||
random_integer(Lower, Upper, R) :-
|
||||
var(R),
|
||||
( (var(Lower) ; var(Upper)) ->
|
||||
instantiation_error(random_integer/3)
|
||||
; \+ integer(Lower) ->
|
||||
domain_error(integer, Lower, random_integer/3)
|
||||
; \+ integer(Upper) ->
|
||||
domain_error(integer, Upper, random_integer/3)
|
||||
; Upper > Lower,
|
||||
random(R0),
|
||||
R is floor((Upper - Lower) * R0 + Lower)
|
||||
).
|
||||
|
||||
rnd(N, R) :-
|
||||
rnd_(N, 0, R).
|
||||
|
||||
rnd_(0, R, R) :- !.
|
||||
rnd_(N, R0, R) :-
|
||||
maybe,
|
||||
!,
|
||||
N1 is N - 1,
|
||||
rnd_(N1, R0, R).
|
||||
rnd_(N, R0, R) :-
|
||||
N1 is N - 1,
|
||||
R1 is R0 + 1.0 / 2.0 ^ N,
|
||||
rnd_(N1, R1, R).
|
||||
|
||||
set_random(Seed) :-
|
||||
( nonvar(Seed) ->
|
||||
( Seed = seed(S) ->
|
||||
( var(S) -> instantiation_error(set_random/1)
|
||||
; integer(S) -> '$set_seed'(S)
|
||||
; type_error(integer, S, set_random/1)
|
||||
)
|
||||
)
|
||||
; instantiation_error(set_random/1)
|
||||
).
|
||||
|
||||
58
src/prolog/lib/sockets.pl
Normal file
58
src/prolog/lib/sockets.pl
Normal file
@@ -0,0 +1,58 @@
|
||||
|
||||
:- module(sockets, [socket_client_open/3,
|
||||
socket_server_open/2,
|
||||
socket_server_accept/4,
|
||||
socket_server_close/1,
|
||||
current_hostname/1]).
|
||||
|
||||
:- use_module(library(error)).
|
||||
|
||||
|
||||
socket_client_open(Addr, Stream, Options) :-
|
||||
( var(Addr) ->
|
||||
throw(error(instantiation_error, socket_client_open/3))
|
||||
;
|
||||
true
|
||||
),
|
||||
must_be(var, Stream),
|
||||
must_be(list, Options),
|
||||
( Addr = Address:Port,
|
||||
atom(Address),
|
||||
( atom(Port) ; integer(Port) ) ->
|
||||
true
|
||||
;
|
||||
throw(error(type_error(socket_address, Addr), socket_client_open/3))
|
||||
),
|
||||
builtins:parse_stream_options(Options,
|
||||
[Alias, EOFAction, Reposition, Type],
|
||||
socket_client_open/3),
|
||||
'$socket_client_open'(Address, Port, Stream, Alias, EOFAction, Reposition, Type).
|
||||
|
||||
|
||||
socket_server_open(Addr, ServerSocket) :-
|
||||
must_be(var, ServerSocket),
|
||||
( ( integer(Addr) ; var(Addr) ) ->
|
||||
'$socket_server_open'([], Addr, ServerSocket)
|
||||
;
|
||||
Addr = Address:Port,
|
||||
must_be(atom, Address),
|
||||
can_be(integer, Port),
|
||||
'$socket_server_open'(Address, Port, ServerSocket)
|
||||
).
|
||||
|
||||
|
||||
socket_server_accept(ServerSocket, Client, Stream, Options) :-
|
||||
must_be(var, Client),
|
||||
must_be(var, Stream),
|
||||
builtins:parse_stream_options(Options,
|
||||
[Alias, EOFAction, Reposition, Type],
|
||||
socket_server_accept/4),
|
||||
'$socket_server_accept'(ServerSocket, Client, Stream, Alias, EOFAction, Reposition, Type).
|
||||
|
||||
|
||||
socket_server_close(ServerSocket) :-
|
||||
'$socket_server_close'(ServerSocket).
|
||||
|
||||
|
||||
current_hostname(HostName) :-
|
||||
'$current_hostname'(HostName).
|
||||
@@ -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),
|
||||
|
||||
@@ -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
72
src/prolog/lib/time.pl
Normal file
@@ -0,0 +1,72 @@
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Written April 2020 by Markus Triska (triska@metalevel.at)
|
||||
Part of Scryer Prolog.
|
||||
|
||||
This library provides predicates for reasoning about time.
|
||||
Reasoning about time stamps would be a useful addition, for example
|
||||
by obtaining the current time, comparing and formatting it.
|
||||
|
||||
'$cpu_now' can be replaced by statistics/2 once that is implemented.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
:- module(time, [max_sleep_time/1, sleep/1, time/1]).
|
||||
|
||||
:- use_module(library(format)).
|
||||
:- use_module(library(iso_ext)).
|
||||
:- use_module(library(error)).
|
||||
|
||||
max_sleep_time(0xfffffffffffffbff).
|
||||
|
||||
sleep(T) :-
|
||||
builtins:must_be_number(T, sleep),
|
||||
( T < 0 ->
|
||||
domain_error(not_less_than_zero, T, sleep/1)
|
||||
; max_sleep_time(N), T > N ->
|
||||
throw(error(representation_error(max_sleep_time), sleep/1))
|
||||
; '$sleep'(T)
|
||||
).
|
||||
|
||||
time(Goal) :-
|
||||
'$cpu_now'(T0),
|
||||
setup_call_cleanup(true,
|
||||
( Goal,
|
||||
report_time(T0)
|
||||
),
|
||||
report_time(T0)).
|
||||
|
||||
report_time(T0) :-
|
||||
'$cpu_now'(T),
|
||||
Time is T - T0,
|
||||
( bb_get('$first_answer', true) ->
|
||||
format(" % CPU time: ~3f seconds~n", [Time])
|
||||
; format("% CPU time: ~3f seconds~n ", [Time])
|
||||
).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
?- time((true;false)).
|
||||
% CPU time: 0.000 seconds
|
||||
true
|
||||
; % CPU time: 0.001 seconds
|
||||
false.
|
||||
|
||||
:- time(use_module(library(clpz))).
|
||||
% CPU time: 2.762 seconds
|
||||
true
|
||||
; false.
|
||||
|
||||
:- time(use_module(library(lists))).
|
||||
% CPU time: 0.000 seconds
|
||||
true
|
||||
; % CPU time: 0.001 seconds
|
||||
false.
|
||||
|
||||
?- time(member(X, [a,b,c])).
|
||||
% CPU time: 0.000 seconds
|
||||
X = a
|
||||
; % CPU time: 0.002 seconds
|
||||
X = b
|
||||
; % CPU time: 0.004 seconds
|
||||
X = c
|
||||
; % CPU time: 0.007 seconds
|
||||
false.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
@@ -1,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)) => {
|
||||
|
||||
@@ -1,3 +1,5 @@
|
||||
:- module('$atts', []).
|
||||
|
||||
driver(Vars, Values) :-
|
||||
iterate(Vars, Values, ListOfListsOfGoalLists),
|
||||
!,
|
||||
|
||||
@@ -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
|
||||
}
|
||||
}
|
||||
|
||||
@@ -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,
|
||||
|
||||
@@ -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
|
||||
));
|
||||
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -307,6 +307,12 @@ impl Machine {
|
||||
}
|
||||
}
|
||||
}
|
||||
Addr::Usize(n) => {
|
||||
n
|
||||
}
|
||||
Addr::Fixnum(n) => {
|
||||
usize::try_from(n).unwrap()
|
||||
}
|
||||
_ => {
|
||||
unreachable!()
|
||||
}
|
||||
|
||||
@@ -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 => {
|
||||
|
||||
@@ -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),
|
||||
|
||||
@@ -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 {
|
||||
|
||||
@@ -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)>,
|
||||
|
||||
@@ -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,
|
||||
|
||||
@@ -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!(),
|
||||
}
|
||||
};
|
||||
|
||||
|
||||
@@ -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,
|
||||
);
|
||||
);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -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),
|
||||
|
||||
@@ -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,
|
||||
|
||||
@@ -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
@@ -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(),
|
||||
|
||||
@@ -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();
|
||||
|
||||
@@ -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!()
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -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 {
|
||||
|
||||
@@ -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
|
||||
).
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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).
|
||||
|
||||
@@ -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).
|
||||
|
||||
Reference in New Issue
Block a user