Merge pull request #1635 from mthom/rebis-dev

Merge rebis-dev into master

.gitattributes

@@ -0,0 +1,4 @@
+*.png binary
+*.pl text eol=lf
+*.rs text eol=lf diff=rust
+*.md text eol=lf diff=markdown

.github/workflows/docker-publish.yml

@@ -0,0 +1,52 @@
+name: Docker Publish
+
+on:
+  push:
+    tags: [ 'v*.*.*' ]
+
+env:
+  IMAGE_NAME: mjt128/scryer-prolog
+
+jobs:
+  build:
+
+    runs-on: ubuntu-latest
+
+    steps:
+      - name: Checkout repository
+        uses: actions/checkout@v3
+
+      # Workaround: https://github.com/docker/build-push-action/issues/461
+      - name: Setup Docker buildx
+        uses: docker/setup-buildx-action@79abd3f86f79a9d68a23c75a09a9a85889262adf
+
+      # Login against Docker registry
+      # https://github.com/docker/login-action
+      - name: Log into registry
+        uses: docker/login-action@28218f9b04b4f3f62068d7b6ce6ca5b26e35336c
+        with:
+          username: ${{ secrets.DOCKERHUB_USERNAME }}
+          password: ${{ secrets.DOCKERHUB_TOKEN }}
+
+      # Extract Docker image tag from git tag. E.g. if git tag is "v0.19.1" then use 
+      # Docker image tag "0.19.1". Tag "latest" is automatically synced with newest
+      # version.
+      # https://github.com/docker/metadata-action
+      - name: Extract Docker metadata
+        id: meta
+        uses: docker/metadata-action@98669ae865ea3cffbcbaa878cf57c20bbf1c6c38
+        with:
+          images: docker.io/${{ env.IMAGE_NAME }}
+          tags: |
+            type=semver,pattern={{version}}
+
+      # Build and push Docker image with Buildx
+      # https://github.com/docker/build-push-action
+      - name: Build and push Docker image
+        id: build-and-push
+        uses: docker/build-push-action@ad44023a93711e3deb337508980b4b5e9bcdc5dc
+        with:
+          context: .
+          push: true
+          tags: ${{ steps.meta.outputs.tags }}
+          labels: ${{ steps.meta.outputs.labels }}

.github/workflows/test.yml

@@ -0,0 +1,71 @@
+name: Test
+on: [push, pull_request]
+
+jobs:
+  build:
+    runs-on: ${{ matrix.os }}
+    strategy:
+      matrix:
+        os: [ubuntu-20.04, macos-10.15]
+        rust-version: [stable, beta]
+    steps:
+      - name: Checkout sources
+        uses: actions/checkout@v2
+      - name: Install Rust
+        uses: actions-rs/toolchain@v1
+        with:
+          profile: minimal
+          toolchain: ${{ matrix.rust-version }}
+          override: true
+      - name: Build lib
+        uses: actions-rs/cargo@v1
+        with:
+          command: rustc
+          args: --verbose --lib -- -D warnings
+      - name: Build bin
+        uses: actions-rs/cargo@v1
+        with:
+          command: rustc
+          args: --verbose --bin scryer-prolog -- -D warnings
+      - name: Test
+        uses: actions-rs/cargo@v1
+        with:
+          command: test
+          args: --verbose --all
+      - name: Num tests
+        uses: actions-rs/cargo@v1
+        continue-on-error: true
+        with:
+          command: test
+          args: --verbose --all --no-default-features --features num
+  msrv:
+    runs-on: ${{ matrix.os }}
+    strategy:
+      matrix:
+        os: [ubuntu-20.04, macos-10.15]
+    steps:
+      - name: Checkout sources
+        uses: actions/checkout@v2
+      - name: Install cargo-msrv
+        uses: baptiste0928/cargo-install@v1.1.0
+        with:
+          crate: cargo-msrv
+      - name: Verify MSRV
+        run: cargo msrv --verify
+  windows:
+    runs-on: windows-latest
+    defaults:
+      run:
+        shell: msys2 {0}
+    steps:
+      - name: Setup MSYS2
+        uses: msys2/setup-msys2@v2
+        with:
+          update: true
+          install: >-
+            base-devel
+            mingw-w64-x86_64-rust
+      - name: Checkout sources
+        uses: actions/checkout@v3
+      - name: Test on Windows
+        run: cargo test --verbose --all

.gitignore

@@ -1,3 +1,5 @@
+src/static_atoms.rs
 target/
 
 
+

.travis.yml

@@ -1,31 +0,0 @@
-language: rust
-cache: cargo
-os: linux
-dist: xenial
-
-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"

Cargo.toml

@@ -1,50 +1,76 @@
 [package]
 name = "scryer-prolog"
-version = "0.8.127"
+version = "0.9.1"
 authors = ["Mark Thom <markjordanthom@gmail.com>"]
-edition = "2018"
+edition = "2021"
 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-system"]
 categories = ["command-line-utilities"]
-build = "build.rs"
+build = "build/main.rs"
+rust-version = "1.61"
+
+[features]
+default = ["rug"]
 
 [build-dependencies]
 indexmap = "1.0.2"
-
-[features]
-default = ["rug", "prolog_parser/rug"]
-num = ["num-rug-adapter", "prolog_parser/num"]
+proc-macro2 = "1.0.36"
+quote = "1.0.15"
+strum = "0.23"
+strum_macros = "0.23"
+syn = { version = "1.0.88", features = ['full', 'visit', 'extra-traits'] }
+to-syn-value = "0.1.0"
+to-syn-value_derive = "0.1.0"
+walkdir = "2"
 
 [dependencies]
 cpu-time = "1.0.0"
-crossterm = "0.16.0"
-dirs = "2.0.2"
+crossterm = "0.20.0"
+dirs-next = "2.0.0"
 divrem = "0.1.0"
-downcast = "0.10.0"
+fxhash = "0.2.1"
 git-version = "0.3.4"
 hostname = "0.3.1"
 indexmap = "1.0.2"
 lazy_static = "1.4.0"
+lexical = "5.2.2"
 libc = "0.2.62"
-nix = "0.15.0"
-num-rug-adapter = { optional = true, version = "0.1.3" }
-ordered-float = "0.5.0"
-prolog_parser = { version = "0.8.65", default-features = false }
+modular-bitfield = "0.11.2"
+ctrlc = "3.2.2"
+ordered-float = "2.6.0"
+phf = { version = "0.9",  features = ["macros"] }
 ref_thread_local = "0.0.0"
-rug = { version = "1.4.0", optional = true }
-rustyline = "6.0.0"
-unicode_reader = "1.0.0"
+rug = { version = "1.15.0", optional = true }
+rustyline = "9.0.0"
 ring = "0.16.13"
 ripemd160 = "0.8.0"
 sha3 = "0.8.2"
 blake2 = "0.8.1"
-openssl = { version = "0.10.29", features = ["vendored"] }
+crrl ="0.2.0"
 native-tls = "0.2.4"
 chrono = "0.4.11"
 select = "0.4.3"
 roxmltree = "0.11.0"
 base64 = "0.12.3"
+smallvec = "1.8.0"
 sodiumoxide = "0.2.6"
+static_assertions = "1.1.0"
+ryu = "1.0.9"
+hyper = { version = "0.14", features = ["full"] }
+hyper-tls = "0.5.0"
+tokio = { version = "1", features = ["full"] }
+futures = "0.3"
+
+[dev-dependencies]
+assert_cmd = "1.0.3"
+predicates-core = "1.0.2"
+serial_test = "0.5.1"
+
+[patch.crates-io]
+modular-bitfield = { git = "https://github.com/mthom/modular-bitfield" }
+
+[profile.release]
+debug = true

Dockerfile

@@ -1,30 +1,26 @@
-# 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"]
+# See https://github.com/LukeMathWalker/cargo-chef
+ARG RUST_VERSION=1.60-buster
+FROM rust:${RUST_VERSION} as planner
+WORKDIR /scryer-prolog
+RUN cargo install cargo-chef 
+COPY . .
+RUN cargo chef prepare --recipe-path recipe.json
+
+FROM rust:${RUST_VERSION} as cacher
+WORKDIR /scryer-prolog
+RUN cargo install cargo-chef
+COPY --from=planner /scryer-prolog/recipe.json recipe.json
+RUN cargo chef cook --release --recipe-path recipe.json
+
+FROM rust:${RUST_VERSION} as builder
+WORKDIR /scryer-prolog
+COPY . .
+# Copy over the cached dependencies
+COPY --from=cacher /scryer-prolog/target target
+COPY --from=cacher $CARGO_HOME $CARGO_HOME
+RUN cargo build --release --bin scryer-prolog
+
+FROM debian:stable-slim
+COPY --from=builder /scryer-prolog/target/release/scryer-prolog /usr/local/bin
+ENV RUST_BACKTRACE=1
+ENTRYPOINT ["/usr/local/bin/scryer-prolog"]

README.md

@@ -1,3 +1,4 @@
+
 # Scryer Prolog
 
 Scryer Prolog aims to become to ISO Prolog what GHC is to Haskell: an open
@@ -59,10 +60,16 @@ Extend Scryer Prolog to include the following, among other features:
 - [x] clp(B) and clp(ℤ) as builtin libraries.
 - [x] Streams and predicates for stream control.
   - [x] A simple sockets library representing TCP connections as streams.  
-- [ ] Incremental compilation and loading process, newly written,
-      primarily in Prolog. (_in progress_)
-- [ ] A compacting garbage collector satisfying the five
-      properties of "Precise Garbage Collection in Prolog."
+- [x] Incremental compilation and loading process, newly written,
+      primarily in Prolog.
+- [ ] Improvements to the WAM compiler and heap representation:
+  - [ ] Replacing choice points pivoting on inlined semi-deterministic predicates
+        (`atom`, `var`, etc) with if/else ladders. (_in progress_)
+  - [ ] Inlining all built-ins and system call instructions.
+  - [ ] Greatly reducing the number of instructions used to compile disjunctives.
+  - [ ] Storing short atoms to heap cells without writing them to the atom table.
+- [ ] A compacting garbage collector satisfying the five properties of
+      "Precise Garbage Collection in Prolog." (_in progress_)
 - [ ] Mode declarations.
 
 ## Phase 3
@@ -95,7 +102,7 @@ strings.
 
 ## Installing Scryer Prolog
 
-### Native Install (Unix Only)
+### Native Install
 
 First, install the latest stable version of
 [Rust](https://www.rust-lang.org/en-US/install.html) using your
@@ -106,20 +113,8 @@ Rust updated to the latest stable release; any existing Rust
 distribution should be uninstalled from your system before rustup is
 used.
 
-Scryer Prolog can be installed with cargo, like so:
-
-```
-$> cargo install scryer-prolog
-```
-
-cargo will download and install the libraries Scryer Prolog uses
-automatically from crates.io. You can find the `scryer-prolog`
-executable in `~/.cargo/bin`.
-
-Publishing Rust crates to crates.io and pushing to git are entirely
-distinct, independent processes, so to be sure you have the latest
-commit, it is recommended to clone directly from this git repository,
-which can be done as follows:
+Currently the only way to install the latest version of Scryer is to
+clone directly from this git repository, which can be done as follows:
 
 ```
 $> git clone https://github.com/mthom/scryer-prolog
@@ -130,7 +125,20 @@ $> cargo run [--release]
 The optional `--release` flag will perform various optimizations,
 producing a faster executable.
 
-### Docker Install (All Platforms)
+On Windows, Scryer Prolog is easier to build inside a [MSYS2](https://www.msys2.org/)
+environment as some crates may require native C compilation. However, 
+the resulting binary does not need MSYS2 to run. When executing Scryer in a shell, it is recommended to use a more advanced shell than mintty (the default MSYS2 shell). The [Windows Terminal](https://github.com/microsoft/terminal) works correctly.
+
+To build a Windows Installer, you'll need first Scryer Prolog compiled in release mode, then, with WiX Toolset installed, execute:
+```
+candle.exe scryer-prolog.wxs
+light.exe scryer-prolog.wixobj
+```
+It will generate a very basic MSI file which installs the main executable and a shortcut in the Start Menu. It can be installed with a double-click. To uninstall, go to the Control Panel and uninstall as usual.
+
+Scryer Prolog must be built with **Rust 1.57 and up**.
+
+### Docker Install
 
 First, install [Docker](https://docs.docker.com/get-docker/) on Linux,
 Windows, or Mac.
@@ -203,9 +211,16 @@ predicates it defines. For example, with the program shown above:
 ;  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.
+Press `SPACE` to show further answers, if any exist. Press `RETURN`
+or `.` to abort the search and return to the
+toplevel prompt. Press `f` to see up to the next multiple of
+5 answers, and `a` to see all answers. Press `h` to show a help
+message.
+
+Use `TAB` to complete atoms and predicate names in queries. For
+instance, after consulting the program above, typing `decl` followed
+by `TAB` yields `declarative_world`. Press `TAB` repeatedly
+to cycle through alternative completions.
 
 To quit Scryer Prolog, use the standard predicate `halt/0`:
 
@@ -226,11 +241,62 @@ arithmetic operators with the usual precedences,
 
 New operators can be defined using the `op` declaration.
 
+### First instantiated argument indexing
+
+Scryer Prolog indexes on the leftmost argument that is not a variable
+in all clauses of a predicate's definition. We call this strategy
+first *instantiated* argument indexing.
+
+A key motivation for first instantiated argument indexing is to enable
+indexing for meta-predicates such as `maplist/N` and `foldl/N`, whose
+first argument is a partial goal that is a variable in the definition
+of these predicates and therefore cannot be used for indexing.
+
+For example, a natural definition of `maplist/2` reads:
+
+```
+maplist(_, []).
+maplist(Goal_1, [L|Ls]) :-
+        call(Goal_1, L),
+        maplist(Goal_1, Ls).
+```
+
+In this case, first instantiated argument indexing automatically uses
+the *second* argument for indexing, and thus prevents choicepoints for
+calls with lists of fixed lengths (and deterministic goals).
+Conveniently, no auxiliary predicates with reordered arguments are
+needed to benefit from indexing in such cases.
+
+Conventional first argument indexing naturally arises as a
+special case of this strategy, if the first argument is instantiated
+in any clause of a predicate's definition.
+
 ### Strings and partial strings
 
+A very compact internal representation of *strings* is one of the key
+innovations of Scryer Prolog. This means that terms which appear as
+lists of characters to Prolog programs are stored in packed
+UTF-8 encoding by the engine.
+
+Without this innovation, storing a list of characters in memory
+would use one memory cell per character, one memory cell per
+list constructor, and one memory cell for each tail that occurs
+in the list. Since one memory cell takes 8 bytes on 64-bit
+machines, the packed representation used by Scryer Prolog yields
+an up to **24-fold reduction** of memory usage, and
+corresponding reduction of memory accesses when creating and
+processing strings.
+
+Scryer Prolog's compact internal string representation makes it
+ideally suited for the use case Prolog was originally developed for:
+efficient and convenient text processing, especially with definite
+clause grammars (DCGs) as provided by
+[`library(dcgs)`](src/lib/dcgs.pl) and
+[`library(pio)`](src/lib/pio.pl) to transparently apply DCGs to files.
+
 In Scryer Prolog, the default value of the Prolog flag `double_quotes`
 is `chars`, which is also the recommended setting. This means that
-double-quoted strings are interpreted as lists of *characters*, in the
+lists of characters can be written as double-quoted strings, in the
 tradition of Marseille Prolog.
 
 For example, the following query succeeds:
@@ -240,15 +306,9 @@ For example, the following query succeeds:
    true.
 ```
 
-Internally, strings are represented very compactly in packed
-UTF-8 encoding. A naive representation of strings as lists of
-characters would use one memory cell per character, one
-memory cell per list constructor, and one memory cell for
-each tail that occurs in the list. Since one memory cell takes
-8 bytes on 64-bit machines, the packed representation used by
-Scryer Prolog yields an up to **24-fold reduction** of
-memory usage, and corresponding reduction of memory accesses when
-creating and processing strings.
+This shows that the string `"abc"`, which is represented as a sequence
+of 3 bytes internally, appears to Prolog programs as a list of
+characters.
 
 Scryer Prolog uses the same efficient encoding for *partial* strings,
 which appear to Prolog code as partial lists of characters. The
@@ -271,13 +331,58 @@ the above example, posting <tt>Ls0&nbsp;=&nbsp;[a,b,c|Ls]</tt> yields
 the exact same internal representation, and has the advantage that
 only the standard predicate&nbsp;`(=)/2` is used.
 
-Definite clause grammars as provided by
-[`library(dcgs)`](src/lib/lists.pl), and the predicates from
-[`library(lists)`](src/lib/lists.pl), are ideally suited for reasoning
-about strings.
+The efficient internal representation of strings and partial strings
+was first proposed and explained by Ulrich Neumerkel in
+issues&nbsp;[#24](https://github.com/mthom/scryer-prolog/issues/24)
+and&nbsp;[#95](https://github.com/mthom/scryer-prolog/issues/95), and
+Scryer&nbsp;Prolog is the first Prolog&nbsp;system that implements it.
 
-Partial strings were first proposed by Ulrich Neumerkel in issue
-[#95](https://github.com/mthom/scryer-prolog/issues/95).
+### Occurs check and cyclic terms
+
+The *occurs&nbsp;check* is an element of algorithms that perform
+syntactic unification, causing the unification to fail if a variable
+is unified with a term that contains that variable as a proper
+subterm. For efficiency, the *occurs&nbsp;check* is omitted by default
+in Scryer&nbsp;Prolog and many other Prolog systems.
+
+In Scryer Prolog, performing unifications which succeed only if the
+*occurs&nbsp;check* is omitted yield *cyclic&nbsp;terms*, also called
+*rational&nbsp;trees*. For example:
+
+```
+?- X = f(X), Y = g(X,Y).
+   X = f(X), Y = g(f(X),Y).
+```
+
+The creation of cyclic terms often indicates a programming mistake in
+the formulation of Prolog predicates, and to obtain logically sound
+results it is desirable to either perform all unifications with
+*occurs&nbsp;check* enabled, or let Prolog throw an error if enabling
+the *occurs&nbsp;check* is necessary to prevent a unification.
+
+Scryer Prolog supports this via the Prolog flag `occurs_check`. It can
+be set to one of the following values to obtain the desired behaviour:
+
+- `false`
+  Do not perform the *occurs&nbsp;check*. This is the default.
+- `true`
+  Perform all unifications with the *occurs&nbsp;check* enabled.
+- `error`
+  Yield an error if a unification is performed that the
+  *occurs&nbsp;check* would have prevented.
+
+Especially when starting with Prolog, we recommend to add the
+following directive to the `~/.scryerrc` configuration file so that
+programming mistakes in predicates that lead to the creation of cyclic
+terms are indicated by errors:
+
+```
+:- set_prolog_flag(occurs_check, error).
+```
+
+Scryer Prolog implements specialized reasoning to make unifications
+fast in many frequently occurring situations also if the
+*occurs&nbsp;check* is enabled.
 
 ### Tabling (SLG resolution)
 
@@ -387,6 +492,10 @@ The modules that ship with Scryer&nbsp;Prolog are also called
   file, reading lazily only as much as is needed. Due to the compact
   internal string representation, also extremely large files can be
   efficiently processed with Scryer&nbsp;Prolog in this way.
+  `phrase_to_file/2` and `phrase_to_stream/2` write lists of
+  characters described by DCGs to files and streams, respectively.
+* [`lambda`](src/lib/lambda.pl)
+  Lambda expressions to simplify higher order programming.
 * [`charsio`](src/lib/charsio.pl) Various predicates that are useful
   for parsing and reasoning about characters, notably `char_type/2` to
   classify characters according to their type, and conversion
@@ -430,6 +539,7 @@ The modules that ship with Scryer&nbsp;Prolog are also called
   Probabilistic predicates and random number generators.
 * [`http/http_open`](src/lib/http/http_open.pl) Open a stream to
   read answers from web&nbsp;servers. HTTPS is also supported.
+* [`http/http_server`](src/lib/http/http_server.pl) Runs a HTTP/1.1 and HTTP/2.0 web server. Uses [Hyper](https://hyper.rs) as a backend. Supports some query and form handling.
 * [`sgml`](src/lib/sgml.pl)
   `load_html/3` and `load_xml/3` represent HTML and XML&nbsp;documents
   as Prolog&nbsp;terms for convenient and efficient reasoning. Use
@@ -438,19 +548,28 @@ The modules that ship with Scryer&nbsp;Prolog are also called
 * [`csv`](src/lib/csv.pl)
   `parse_csv//1` and `parse_csv//2` can be used with [`phrase_from_file/2`](src/lib/pio.pl)
   or [`phrase/2`](src/lib/dcgs.pl) to parse csv
+* [`serialization/abnf`](src/lib/serialization/abnf.pl)
+  DCGs describing the
+  [ABNF grammar core (RFC 5234)](https://tools.ietf.org/html/rfc5234#appendix-B.1),
+  which is used to describe many [IETF](https://www.ietf.org/standards/rfcs/)
+  syntaxes, such as [HTTP v1.1](https://www.rfc-editor.org/rfc/rfc7230.html#page-82),
+  [SMTP](https://www.rfc-editor.org/rfc/rfc5321.html),
+  [iCalendar](https://www.rfc-editor.org/rfc/rfc5545.html), and more.
+* [`serialization/json`](src/lib/serialization/json.pl)
+  `json_chars//1` can be used with [`phrase_from_file/2`](src/lib/pio.pl)
+  or [`phrase/2`](src/lib/dcgs.pl) to parse and generate
+  [JSON](https://www.json.org/json-en.html).
 * [`xpath`](src/lib/xpath.pl)
   The predicate `xpath/3` is used for convenient reasoning about HTML
   and XML&nbsp;documents, inspired by the XPath language. This library
   is often used together with [`library(sgml)`](src/lib/sgml.pl).
 * [`sockets`](src/lib/sockets.pl)
   Predicates for opening and accepting TCP connections as streams.
-  TLS negotiation is performed via the option `tls(true)` in
-  `socket_client_open/3`, yielding secure encrypted connections.
 * [`os`](src/lib/os.pl)
   Predicates for reasoning about environment&nbsp;variables.
 * [`iso_ext`](src/lib/iso_ext.pl)
   Conforming extensions to and candidates for inclusion in the Prolog
-  ISO&nbsp;standard, such as `setup_call_cleanup/3` and
+  ISO&nbsp;standard, such as `setup_call_cleanup/3`, `call_nth/2` and
   `call_with_inference_limit/3`.
 * [`crypto`](src/lib/crypto.pl)
   Cryptographically secure random numbers and hashes, HMAC-based key
@@ -458,6 +577,13 @@ The modules that ship with Scryer&nbsp;Prolog are also called
   public key signatures and signature verification with&nbsp;Ed25519,
   ECDH key&nbsp;exchange over Curve25519 (X25519), authenticated symmetric
   encryption with ChaCha20-Poly1305, and reasoning about elliptic curves.
+* [`uuid`](src/lib/uuid.pl) UUIDv4 generation and hex representation
+* [`tls`](src/lib/tls.pl)
+  Predicates for negotiating TLS connections explicitly.
+* [`ugraphs`](src/lib/ugraphs.pl) Graph manipulation library
+* [`simplex`](src/lib/simplex.pl) Providing `assignment/2`,
+  `transportation/4` and other predicates for solving linear
+  programming problems.
 
 To use predicates provided by the `lists` library, write:
 
@@ -516,3 +642,41 @@ For example, a sensible starting point for `~/.scryerrc` is:
 :- use_module(library(dcgs)).
 :- use_module(library(reif)).
 ```
+
+### Development environment
+
+To write and edit Prolog programs, we recommend
+[GNU&nbsp;Emacs](https://www.gnu.org/software/emacs/) with the
+[Prolog&nbsp;mode](https://bruda.ca/emacs/prolog_mode_for_emacs)
+maintained by Stefan Bruda.
+
+Use [ediprolog](https://www.metalevel.at/ediprolog/) to consult
+Prolog&nbsp;code and evaluate Prolog queries in arbitrary
+Emacs&nbsp;buffers.
+
+Emacs definitions that show Prolog terms as trees are available
+in&nbsp;[tools](tools).
+
+To *debug* Prolog code, we recommend the predicates from
+[**`library(debug)`**](src/lib/debug.pl), most notably:
+
+- `(*)/1` to *"generalize&nbsp;away"* a Prolog goal. Use it to debug
+  unexpected failures by generalizing your definitions until they
+  succeed. Simply place&nbsp;`*` in front of a goal to generalize it away.
+- `($)/1` to emit a *trace* of the execution, showing when a goal
+  is invoked, and when it has succeeded. Place&nbsp;`$` in front of a goal
+  to emit this information for that goal.
+
+This way of debugging Prolog code has several major benefits, such as:
+It stays close to the actual Prolog code under consideration, it does
+not need additional tools and formalisms for its application, and
+further, it encourages declarative reasoning that can in principle
+also be performed automatically.
+
+## Support and discussions
+
+If Scryer Prolog crashes or yields unexpected errors, consider filing
+an&nbsp;[issue](https://github.com/mthom/scryer-prolog/issues).
+
+To get in touch with the Scryer Prolog community, participate in
+[discussions](https://github.com/mthom/scryer-prolog/discussions)!

build.rs

@@ -1,55 +0,0 @@
-extern crate indexmap;
-
-use std::env;
-use std::fs;
-use std::fs::File;
-use std::io::Write;
-use std::path::Path;
-
-fn find_prolog_files(libraries: &mut File, prefix: &str, current_dir: &Path) {
-    let entries = match current_dir.read_dir() {
-        Ok(entries) => entries,
-        Err(_) => return,
-    };
-    for entry in entries.filter_map(Result::ok).map(|e| e.path()) {
-        if entry.is_dir() {
-            if let Some(file_name) = entry.file_name() {
-                let new_prefix =
-                    prefix.to_owned() + file_name.to_str().unwrap() + "/";
-                find_prolog_files(libraries, &new_prefix, &entry);
-            }
-        } else if entry.is_file() {
-            let ext = std::ffi::OsStr::new("pl");
-            if entry.extension() == Some(ext) {
-                let contain =
-                    String::from_utf8(fs::read(&entry).unwrap()).unwrap();
-                let name = entry.file_stem().unwrap().to_str().unwrap();
-                let line = format!(
-                    "        m.insert(\"{}\",\n{:?});\n",
-                    prefix.to_owned() + name,
-                    contain
-                );
-
-                libraries.write_all(line.as_bytes()).unwrap();
-            }
-        }
-    }
-}
-
-fn main() {
-    let out_dir = env::var("OUT_DIR").unwrap();
-    let dest_path = Path::new(&out_dir).join("libraries.rs");
-
-    let mut libraries = File::create(&dest_path).unwrap();
-    let lib_path = Path::new("src/lib");
-
-    libraries
-        .write_all(
-            b"ref_thread_local! {
-    pub static managed LIBRARIES: IndexMap<&'static str, &'static str> = {
-        let mut m = IndexMap::new();\n",
-        )
-        .unwrap();
-    find_prolog_files(&mut libraries, "", &lib_path);
-    libraries.write_all(b"\n        m\n    };\n}\n").unwrap();
-}

build/main.rs

@@ -0,0 +1,114 @@
+mod instructions_template;
+mod static_string_indexing;
+
+use instructions_template::generate_instructions_rs;
+use static_string_indexing::index_static_strings;
+
+use std::env;
+use std::fs;
+use std::fs::File;
+use std::io::Write;
+use std::path::Path;
+use std::process::{Command, Stdio};
+
+fn find_prolog_files(libraries: &mut File, prefix: &str, current_dir: &Path) {
+    let entries = match current_dir.read_dir() {
+        Ok(entries) => entries,
+        Err(_) => return,
+    };
+
+    for entry in entries.filter_map(Result::ok).map(|e| e.path()) {
+        if entry.is_dir() {
+            if let Some(file_name) = entry.file_name() {
+                let new_prefix = prefix.to_owned() + file_name.to_str().unwrap() + "/";
+                find_prolog_files(libraries, &new_prefix, &entry);
+            }
+        } else if entry.is_file() {
+            let ext = std::ffi::OsStr::new("pl");
+            if entry.extension() == Some(ext) {
+                let contain = String::from_utf8(fs::read(&entry).unwrap()).unwrap();
+                let name = entry.file_stem().unwrap().to_str().unwrap();
+
+                let line = format!(
+                    "        m.insert(\"{}\",\n{:?});\n",
+                    prefix.to_owned() + name,
+                    contain
+                );
+
+                libraries.write_all(line.as_bytes()).unwrap();
+            }
+        }
+    }
+}
+
+fn main() {
+    let has_rustfmt = Command::new("rustfmt")
+        .arg("--version")
+        .stdin(Stdio::inherit())
+        .status()
+        .is_ok();
+
+    if !has_rustfmt {
+        println!("Failed to run rustfmt, will skip formatting generated files.")
+    }
+
+    let out_dir = env::var("OUT_DIR").unwrap();
+    let dest_path = Path::new(&out_dir).join("libraries.rs");
+
+    let mut libraries = File::create(&dest_path).unwrap();
+    let lib_path = Path::new("src/lib");
+
+    libraries
+        .write_all(
+            b"ref_thread_local::ref_thread_local! {
+    pub(crate) static managed LIBRARIES: IndexMap<&'static str, &'static str> = {
+        let mut m = IndexMap::new();\n",
+        )
+        .unwrap();
+
+    find_prolog_files(&mut libraries, "", &lib_path);
+    libraries.write_all(b"\n        m\n    };\n}\n").unwrap();
+
+    let instructions_path = Path::new(&out_dir).join("instructions.rs");
+    let mut instructions_file = File::create(&instructions_path).unwrap();
+
+    let quoted_output = generate_instructions_rs();
+
+    instructions_file
+        .write_all(quoted_output.to_string().as_bytes())
+        .unwrap();
+
+    if has_rustfmt {
+        format_generated_file(instructions_path.as_path());
+    }
+
+    let static_atoms_path = Path::new(&out_dir).join("static_atoms.rs");
+    let mut static_atoms_file = File::create(&static_atoms_path).unwrap();
+
+    let quoted_output = index_static_strings(&instructions_path);
+
+    static_atoms_file
+        .write_all(quoted_output.to_string().as_bytes())
+        .unwrap();
+
+    if has_rustfmt {
+        format_generated_file(static_atoms_path.as_path());
+    }
+
+    println!("cargo:rerun-if-changed=src/");
+}
+
+fn format_generated_file(path: &Path) {
+    Command::new("rustfmt")
+        .arg(path.as_os_str())
+        .spawn()
+        .unwrap_or_else(|err| {
+            panic!(
+                "{}: rustfmt was detected as available, but failed to format generated file '{}'",
+                err,
+                path.display()
+            );
+        })
+        .wait()
+        .unwrap();
+}

build/static_string_indexing.rs

@@ -0,0 +1,177 @@
+use proc_macro2::TokenStream;
+use syn::*;
+use syn::parse::*;
+use syn::visit::*;
+
+use indexmap::IndexSet;
+
+struct StaticStrVisitor {
+    static_strs: IndexSet<String>,
+}
+
+impl StaticStrVisitor {
+    fn new() -> Self {
+        Self { static_strs: IndexSet::new() }
+    }
+}
+
+struct MacroFnArgs {
+    args: Vec<Expr>,
+}
+
+struct ReadHeapCellExprAndArms {
+    expr: Expr,
+    arms: Vec<Arm>,
+}
+
+impl Parse for ReadHeapCellExprAndArms {
+    fn parse(input: ParseStream) -> Result<Self> {
+        let mut arms = vec![];
+        let expr = input.parse()?;
+
+        input.parse::<Token![,]>()?;
+        arms.push(input.parse()?);
+
+        while !input.is_empty() {
+            if let Ok(_) = input.parse::<Token![,]>() {}
+            arms.push(input.parse()?);
+        }
+
+        Ok(ReadHeapCellExprAndArms { expr, arms })
+    }
+}
+
+impl Parse for MacroFnArgs {
+    fn parse(input: ParseStream) -> Result<Self> {
+        let mut args = vec![];
+
+        if !input.is_empty() {
+            args.push(input.parse()?);
+        }
+
+        while !input.is_empty() {
+            if let Ok(_) = input.parse::<Token![,]>() {}
+            args.push(input.parse()?);
+        }
+
+        Ok(MacroFnArgs { args })
+    }
+}
+
+impl<'ast> Visit<'ast> for StaticStrVisitor {
+    fn visit_macro(&mut self, m: &'ast Macro) {
+        let Macro { path, .. } = m;
+
+        if path.is_ident("atom") {
+            if let Some(Lit::Str(string)) = m.parse_body::<Lit>().ok() {
+                self.static_strs.insert(string.value());
+            }
+        } else if path.is_ident("read_heap_cell") || path.is_ident("match_untyped_arena_ptr") {
+            if let Some(m) = m.parse_body::<ReadHeapCellExprAndArms>().ok() {
+                self.visit_expr(&m.expr);
+
+                for e in m.arms {
+                    self.visit_arm(&e);
+                }
+            }
+        } else {
+            if let Some(m) = m.parse_body::<MacroFnArgs>().ok() {
+                for e in m.args {
+                    self.visit_expr(&e);
+                }
+            }
+        }
+    }
+}
+
+pub fn index_static_strings(instruction_rs_path: &std::path::Path) -> TokenStream {
+    use quote::*;
+
+    use std::ffi::OsStr;
+    use std::fs::File;
+    use std::io::Read;
+
+    use walkdir::WalkDir;
+
+    fn filter_rust_files(e: &walkdir::DirEntry) -> bool {
+        if e.path().is_dir() {
+            return true;
+        }
+
+        e.path().extension().and_then(OsStr::to_str) == Some("rs")
+    }
+
+    let mut visitor = StaticStrVisitor::new();
+
+    fn process_filepath(path: &std::path::Path) -> std::result::Result<syn::File, ()> {
+        let mut src = String::new();
+
+        let mut file = match File::open(path) {
+            Ok(file) => file,
+            Err(_) => return Err(()),
+        };
+
+        match file.read_to_string(&mut src) {
+            Ok(_) => {}
+            Err(e) => {
+                panic!("error reading file: {:?}", e);
+            }
+        }
+
+        let syntax = match syn::parse_file(&src) {
+            Ok(s) => s,
+            Err(e) => {
+                panic!("parse error: {} in file {:?}", e, path);
+            }
+        };
+        Ok(syntax)
+    }
+
+    for entry in WalkDir::new("src/")
+        .into_iter()
+        .filter_entry(filter_rust_files)
+    {
+        let entry = entry.unwrap();
+
+        if entry.path().is_dir() {
+            continue;
+        }
+
+        let syntax = match process_filepath(entry.path()) {
+            Ok(syntax) => syntax,
+            Err(_) => continue,
+        };
+
+        visitor.visit_file(&syntax);
+    }
+
+    match process_filepath(instruction_rs_path) {
+        Ok(syntax) => visitor.visit_file(&syntax),
+        Err(_) => {}
+    }
+
+    let indices = (0..visitor.static_strs.len()).map(|i| i << 3);
+    let indices_iter = indices.clone();
+
+    let static_strs_len = visitor.static_strs.len();
+    let static_strs: &Vec<_> = &visitor.static_strs.into_iter().collect();
+
+    quote! {
+        use phf;
+
+        static STRINGS: [&'static str; #static_strs_len] = [
+            #(
+                #static_strs,
+            )*
+        ];
+
+        #[macro_export]
+        macro_rules! atom {
+            #((#static_strs) => { Atom { index: #indices_iter } };)*
+        }
+
+        pub static STATIC_ATOMS_MAP: phf::Map<&'static str, Atom> = phf::phf_map! {
+            #(#static_strs => { Atom { index: #indices } },)*
+        };
+    }
+}

scryer-prolog.wxs

@@ -0,0 +1,31 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Wix xmlns="http://schemas.microsoft.com/wix/2006/wi">
+  <Product Name="Scryer Prolog" Manufacturer="Scryer Prolog contributors" Id="*" UpgradeCode="cfb2dee4-5dd5-4d7d-b426-cd7340810559" Language="1033" Codepage="1252" Version="0.9.0">
+    <Package Description="An open source industrial strength production environment for ISO Prolog that is also a testbed for bleeding edge research in logic and constraint programming, which is itself written in a high-level language." Platform="x64" Keywords="prolog" Id="*" Compressed="yes" InstallScope="perMachine" InstallerVersion="300" Languages="1033" SummaryCodepage="1252" Manufacturer="Scryer Prolog contributors"/>
+    <Property Id="APPHELPLINK" Value="https://github.com/mthom/scryer-prolog"/>
+    <Media Id="1" Cabinet="scryer.cab" EmbedCab="yes" />
+    
+    <Directory Id="TARGETDIR" Name="SourceDir">
+      <Directory Id="ProgramFilesFolder" Name="PFiles">
+        <Directory Id="INSTALLDIR" Name="Scryer Prolog">
+          <Component Id="MainExecutable" Guid="1b41ceda-ba18-47f9-911b-ee41b4f20921">
+            <File Id="ScryerPrologEXE" Name="scryer-prolog.exe" DiskId="1" Source="target/release/scryer-prolog.exe" KeyPath="yes" Checksum="yes"/>
+          </Component>
+        </Directory>
+      </Directory>
+      <Directory Id="ProgramMenuFolder">
+	<Component Id="ApplicationShortcut" Guid="8c9b14a3-e7b1-4d30-a892-61d7371dcae2">
+          <Shortcut Id="ApplicationStarMenuShortcut" Name="Scryer Prolog" Description="Launch Scryer Prolog" Target="[#ScryerPrologEXE]" WorkingDirectory="INSTALLDIR"/>
+	  <RemoveFolder Id="ApplicationShortcut" On="uninstall"/>
+	  <RegistryValue Root="HKCU" Key="Software\Microsoft\ScryerProlog" Name="installed" Type="integer" Value="1" KeyPath="yes"/>
+	</Component>
+      </Directory>
+    </Directory>
+
+    <Feature Id="Complete" Level="1" Display="expand" ConfigurableDirectory="INSTALLDIR">
+      <ComponentRef Id="MainExecutable"/>
+      <ComponentRef Id="ApplicationShortcut"/>
+    </Feature>
+  </Product>
+</Wix>
+  

src/allocator.rs

@@ -1,41 +1,57 @@
-use crate::prolog_parser::ast::*;
+use crate::parser::ast::*;
+use crate::temp_v;
 
 use crate::fixtures::*;
 use crate::forms::*;
+use crate::instructions::*;
 use crate::machine::machine_indices::*;
 use crate::targets::*;
 
 use std::cell::Cell;
 use std::rc::Rc;
 
-pub trait Allocator<'a> {
+pub(crate) trait Allocator {
     fn new() -> Self;
 
-    fn mark_anon_var<Target>(&mut self, _: Level, _: GenContext, _: &mut Vec<Target>)
-    where
-        Target: CompilationTarget<'a>;
-    fn mark_non_var<Target>(&mut self, _: Level, _: GenContext, _: &'a Cell<RegType>, _: &mut Vec<Target>)
-    where
-        Target: CompilationTarget<'a>;
-    fn mark_reserved_var<Target>(
+    fn mark_anon_var<'a, Target: CompilationTarget<'a>>(
         &mut self,
-        _: Rc<Var>,
-        _: Level,
-        _: &'a Cell<VarReg>,
-        _: GenContext,
-        _: &mut Vec<Target>,
-        _: RegType,
-        _: bool,
-    ) where
-        Target: CompilationTarget<'a>;
-    fn mark_var<Target>(&mut self, _: Rc<Var>, _: Level, _: &'a Cell<VarReg>, _: GenContext, _: &mut Vec<Target>)
-    where
-        Target: CompilationTarget<'a>;
+        lvl: Level,
+        context: GenContext,
+        code: &mut Code,
+    );
+
+    fn mark_non_var<'a, Target: CompilationTarget<'a>>(
+        &mut self,
+        lvl: Level,
+        context: GenContext,
+        cell: &'a Cell<RegType>,
+        code: &mut Code,
+    );
+
+    fn mark_reserved_var<'a, Target: CompilationTarget<'a>>(
+        &mut self,
+        var_name: Rc<String>,
+        lvl: Level,
+        cell: &'a Cell<VarReg>,
+        term_loc: GenContext,
+        code: &mut Code,
+        r: RegType,
+        is_new_var: bool,
+    );
+
+    fn mark_var<'a, Target: CompilationTarget<'a>>(
+        &mut self,
+        var_name: Rc<String>,
+        lvl: Level,
+        cell: &'a Cell<VarReg>,
+        context: GenContext,
+        code: &mut Code,
+    );
 
     fn reset(&mut self);
     fn reset_contents(&mut self) {}
-    fn reset_arg(&mut self, _: usize);
-    fn reset_at_head(&mut self, _: &Vec<Box<Term>>);
+    fn reset_arg(&mut self, arg_num: usize);
+    fn reset_at_head(&mut self, args: &Vec<Term>);
 
     fn advance_arg(&mut self);
 
@@ -43,11 +59,12 @@ pub trait Allocator<'a> {
     fn bindings_mut(&mut self) -> &mut AllocVarDict;
 
     fn take_bindings(self) -> AllocVarDict;
+    fn max_reg_allocated(&self) -> usize;
 
-    fn drain_var_data(
+    fn drain_var_data<'a>(
         &mut self,
         vs: VariableFixtures<'a>,
-        num_of_chunks: usize
+        num_of_chunks: usize,
     ) -> VariableFixtures<'a> {
         let mut perm_vs = VariableFixtures::new();
 
@@ -71,17 +88,17 @@ pub trait Allocator<'a> {
         perm_vs
     }
 
-    fn get(&self, var: Rc<Var>) -> RegType {
+    fn get(&self, var: Rc<String>) -> RegType {
         self.bindings()
             .get(&var)
             .map_or(temp_v!(0), |v| v.as_reg_type())
     }
 
-    fn is_unbound(&self, var: Rc<Var>) -> bool {
+    fn is_unbound(&self, var: Rc<String>) -> bool {
         self.get(var).reg_num() == 0
     }
 
-    fn record_register(&mut self, var: Rc<Var>, r: RegType) {
+    fn record_register(&mut self, var: Rc<String>, r: RegType) {
         match self.bindings_mut().get_mut(&var).unwrap() {
             &mut VarData::Temp(_, ref mut s, _) => *s = r.reg_num(),
             &mut VarData::Perm(ref mut s) => *s = r.reg_num(),

src/atom_table.rs

@@ -0,0 +1,366 @@
+use crate::parser::ast::MAX_ARITY;
+use crate::raw_block::*;
+use crate::types::*;
+
+use std::borrow::Borrow;
+use std::cmp::Ordering;
+use std::hash::{Hash, Hasher};
+use std::mem;
+use std::ptr;
+use std::slice;
+use std::str;
+
+use indexmap::IndexSet;
+
+use modular_bitfield::prelude::*;
+
+#[derive(Copy, Clone, Debug, PartialEq, Eq)]
+pub struct Atom {
+    pub index: usize,
+}
+
+const_assert!(mem::size_of::<Atom>() == 8);
+
+include!(concat!(env!("OUT_DIR"), "/static_atoms.rs"));
+
+impl<'a> From<&'a Atom> for Atom {
+    #[inline]
+    fn from(atom: &'a Atom) -> Self {
+        *atom
+    }
+}
+
+impl From<bool> for Atom {
+    #[inline]
+    fn from(value: bool) -> Self {
+        if value { atom!("true") } else { atom!("false") }
+    }
+}
+
+#[cfg(test)]
+use std::cell::RefCell;
+
+const ATOM_TABLE_INIT_SIZE: usize = 1 << 16;
+const ATOM_TABLE_ALIGN: usize = 8;
+
+#[cfg(test)]
+thread_local! {
+    static ATOM_TABLE_BUF_BASE: RefCell<*const u8> = RefCell::new(ptr::null_mut());
+}
+
+#[cfg(not(test))]
+static mut ATOM_TABLE_BUF_BASE: *const u8 = ptr::null_mut();
+
+#[cfg(test)]
+fn set_atom_tbl_buf_base(ptr: *const u8) {
+    ATOM_TABLE_BUF_BASE.with(|atom_table_buf_base| {
+        *atom_table_buf_base.borrow_mut() = ptr;
+    });
+}
+
+#[cfg(test)]
+pub(crate) fn get_atom_tbl_buf_base() -> *const u8 {
+    ATOM_TABLE_BUF_BASE.with(|atom_table_buf_base| *atom_table_buf_base.borrow())
+}
+
+#[cfg(not(test))]
+fn set_atom_tbl_buf_base(ptr: *const u8) {
+    unsafe {
+        ATOM_TABLE_BUF_BASE = ptr;
+    }
+}
+
+#[cfg(not(test))]
+pub(crate) fn get_atom_tbl_buf_base() -> *const u8 {
+    unsafe { ATOM_TABLE_BUF_BASE }
+}
+
+impl RawBlockTraits for AtomTable {
+    #[inline]
+    fn init_size() -> usize {
+        ATOM_TABLE_INIT_SIZE
+    }
+
+    #[inline]
+    fn align() -> usize {
+        ATOM_TABLE_ALIGN
+    }
+}
+
+#[bitfield]
+#[derive(Copy, Clone, Debug)]
+struct AtomHeader {
+    #[allow(unused)] m: bool,
+    len: B50,
+    #[allow(unused)] padding: B13,
+}
+
+impl AtomHeader {
+    fn build_with(len: u64) -> Self {
+        AtomHeader::new().with_len(len).with_m(false)
+    }
+}
+
+impl Borrow<str> for Atom {
+    #[inline]
+    fn borrow(&self) -> &str {
+        self.as_str()
+    }
+}
+
+impl Hash for Atom {
+    #[inline]
+    fn hash<H: Hasher>(&self, hasher: &mut H) {
+        self.as_str().hash(hasher)
+        // hasher.write_usize(self.index)
+    }
+}
+
+#[macro_export]
+macro_rules! is_char {
+    ($s:expr) => {
+        !$s.is_empty() && $s.chars().nth(1).is_none()
+    };
+}
+
+impl Atom {
+    #[inline]
+    pub fn buf(self) -> *const u8 {
+        let ptr = self.as_ptr();
+
+        if ptr.is_null() {
+            return ptr::null();
+        }
+
+        (ptr as usize + mem::size_of::<AtomHeader>()) as *const u8
+    }
+
+    #[inline(always)]
+    pub fn is_static(self) -> bool {
+        self.index < STRINGS.len() << 3
+    }
+
+    #[inline(always)]
+    pub fn as_ptr(self) -> *const u8 {
+        if self.is_static() {
+            ptr::null()
+        } else {
+            (get_atom_tbl_buf_base() as usize + self.index - (STRINGS.len() << 3)) as *const u8
+        }
+    }
+
+    #[inline(always)]
+    pub fn from(index: usize) -> Self {
+        Self { index }
+    }
+
+    #[inline(always)]
+    pub fn len(self) -> usize {
+        if self.is_static() {
+            STRINGS[self.index >> 3].len()
+        } else {
+            unsafe { ptr::read(self.as_ptr() as *const AtomHeader).len() as _ }
+        }
+    }
+
+    #[inline(always)]
+    pub fn flat_index(self) -> u64 {
+        (self.index >> 3) as u64
+    }
+
+    pub fn as_char(self) -> Option<char> {
+        let s = self.as_str();
+        let mut it = s.chars();
+
+        let c1 = it.next();
+        let c2 = it.next();
+
+        if c2.is_none() { c1 } else { None }
+    }
+
+    #[inline]
+    pub fn chars(&self) -> str::Chars {
+        self.as_str().chars()
+    }
+
+    #[inline]
+    pub fn as_str(&self) -> &str {
+        unsafe {
+            let ptr = self.as_ptr();
+
+            if ptr.is_null() {
+                return STRINGS[self.index >> 3];
+            }
+
+            let header = ptr::read::<AtomHeader>(ptr as *const _);
+            let len = header.len() as usize;
+            let buf = (ptr as usize + mem::size_of::<AtomHeader>()) as *mut u8;
+
+            str::from_utf8_unchecked(slice::from_raw_parts(buf, len))
+        }
+    }
+
+    pub fn defrock_brackets(&self, atom_tbl: &mut AtomTable) -> Self {
+        let s = self.as_str();
+
+        let s = if s.starts_with('(') && s.ends_with(')') {
+            &s['('.len_utf8()..s.len() - ')'.len_utf8()]
+        } else {
+            return *self;
+        };
+
+        atom_tbl.build_with(s)
+    }
+}
+
+unsafe fn write_to_ptr(string: &str, ptr: *mut u8) {
+    ptr::write(ptr as *mut _, AtomHeader::build_with(string.len() as u64));
+    let str_ptr = (ptr as usize + mem::size_of::<AtomHeader>()) as *mut u8;
+    ptr::copy_nonoverlapping(string.as_ptr(), str_ptr as *mut u8, string.len());
+}
+
+impl PartialOrd for Atom {
+    #[inline]
+    fn partial_cmp(&self, other: &Atom) -> Option<Ordering> {
+        Some(self.cmp(other))
+    }
+}
+
+impl Ord for Atom {
+    #[inline]
+    fn cmp(&self, other: &Atom) -> Ordering {
+        self.as_str().cmp(other.as_str())
+    }
+}
+
+#[derive(Debug)]
+pub struct AtomTable {
+    block: RawBlock<AtomTable>,
+    pub table: IndexSet<Atom>,
+}
+
+impl Drop for AtomTable {
+    fn drop(&mut self) {
+        self.block.deallocate();
+    }
+}
+
+impl AtomTable {
+    #[inline]
+    pub fn new() -> Self {
+        let table = Self {
+            block: RawBlock::new(),
+            table: IndexSet::new(),
+        };
+
+        set_atom_tbl_buf_base(table.block.base);
+        table
+    }
+
+    #[inline]
+    pub fn buf(&self) -> *const u8 {
+        self.block.base as *const u8
+    }
+
+    #[inline]
+    pub fn top(&self) -> *const u8 {
+        self.block.top
+    }
+
+    #[inline(always)]
+    fn lookup_str(&self, string: &str) -> Option<Atom> {
+        STATIC_ATOMS_MAP.get(string).or_else(|| self.table.get(string)).cloned()
+    }
+
+    pub fn build_with(&mut self, string: &str) -> Atom {
+        if let Some(atom) = self.lookup_str(string) {
+            return atom;
+        }
+
+        unsafe {
+            let size = mem::size_of::<AtomHeader>() + string.len();
+            let align_offset = 8 * mem::align_of::<AtomHeader>();
+            let size = (size & !(align_offset - 1)) + align_offset;
+
+            let len_ptr = {
+                let mut ptr;
+
+                loop {
+                    ptr = self.block.alloc(size);
+
+                    if ptr.is_null() {
+                        self.block.grow();
+                        set_atom_tbl_buf_base(self.block.base);
+                    } else {
+                        break;
+                    }
+                }
+
+                ptr
+            };
+
+            let ptr_base = self.block.base as usize;
+
+            write_to_ptr(string, len_ptr);
+
+            let atom = Atom {
+                index: (STRINGS.len() << 3) + len_ptr as usize - ptr_base,
+            };
+
+            self.table.insert(atom);
+
+            atom
+        }
+    }
+}
+
+#[bitfield]
+#[repr(u64)]
+#[derive(Copy, Clone, Debug)]
+pub struct AtomCell {
+    name: B46,
+    arity: B10,
+    #[allow(unused)] f: bool,
+    #[allow(unused)] m: bool,
+    #[allow(unused)] tag: B6,
+}
+
+impl AtomCell {
+    #[inline]
+    pub fn build_with(name: u64, arity: u16, tag: HeapCellValueTag) -> Self {
+        if arity > 0 {
+            debug_assert!(arity as usize <= MAX_ARITY);
+
+            AtomCell::new()
+                .with_name(name)
+                .with_arity(arity)
+                .with_f(false)
+                .with_tag(tag as u8)
+        } else {
+            AtomCell::new()
+                .with_name(name)
+                .with_f(false)
+                .with_tag(tag as u8)
+        }
+    }
+
+    #[inline]
+    pub fn get_index(self) -> usize {
+        self.name() as usize
+    }
+
+    #[inline]
+    pub fn get_name(self) -> Atom {
+        Atom::from(self.get_index() << 3)
+    }
+
+    #[inline]
+    pub fn get_arity(self) -> usize {
+        self.arity() as usize
+    }
+
+    #[inline]
+    pub fn get_name_and_arity(self) -> (Atom, usize) {
+        (Atom::from(self.get_index() << 3), self.get_arity())
+    }
+}

src/bin/scryer-prolog.rs

@@ -0,0 +1,11 @@
+fn main() {
+    use std::sync::atomic::Ordering;
+    use scryer_prolog::*;
+
+    ctrlc::set_handler(move || {
+        scryer_prolog::machine::INTERRUPT.store(true, Ordering::Relaxed);
+    }).unwrap();
+
+    let mut wam = machine::Machine::new();
+    wam.run_top_level();
+}

src/clause_types.rs

@@ -1,851 +0,0 @@
-use crate::prolog_parser::ast::*;
-
-use crate::forms::Number;
-use crate::machine::machine_indices::*;
-use crate::rug::rand::RandState;
-
-use crate::ref_thread_local::RefThreadLocal;
-
-use std::collections::BTreeMap;
-
-#[derive(Debug, Clone, Copy, Eq, PartialEq)]
-pub enum CompareNumberQT {
-    GreaterThan,
-    LessThan,
-    GreaterThanOrEqual,
-    LessThanOrEqual,
-    NotEqual,
-    Equal,
-}
-
-impl CompareNumberQT {
-    fn name(self) -> &'static str {
-        match self {
-            CompareNumberQT::GreaterThan => ">",
-            CompareNumberQT::LessThan => "<",
-            CompareNumberQT::GreaterThanOrEqual => ">=",
-            CompareNumberQT::LessThanOrEqual => "=<",
-            CompareNumberQT::NotEqual => "=\\=",
-            CompareNumberQT::Equal => "=:=",
-        }
-    }
-}
-
-#[derive(Debug, Clone, Copy, PartialEq, Eq)]
-pub enum CompareTermQT {
-    LessThan,
-    LessThanOrEqual,
-    GreaterThanOrEqual,
-    GreaterThan,
-}
-
-impl CompareTermQT {
-    fn name<'a>(self) -> &'a str {
-        match self {
-            CompareTermQT::GreaterThan => "@>",
-            CompareTermQT::LessThan => "@<",
-            CompareTermQT::GreaterThanOrEqual => "@>=",
-            CompareTermQT::LessThanOrEqual => "@=<",
-        }
-    }
-}
-
-#[derive(Debug, Clone, PartialEq, Eq)]
-pub enum ArithmeticTerm {
-    Reg(RegType),
-    Interm(usize),
-    Number(Number),
-}
-
-impl ArithmeticTerm {
-    pub fn interm_or(&self, interm: usize) -> usize {
-        if let &ArithmeticTerm::Interm(interm) = self {
-            interm
-        } else {
-            interm
-        }
-    }
-}
-
-#[derive(Debug, Clone, Eq, PartialEq)]
-pub enum InlinedClauseType {
-    CompareNumber(CompareNumberQT, ArithmeticTerm, ArithmeticTerm),
-    IsAtom(RegType),
-    IsAtomic(RegType),
-    IsCompound(RegType),
-    IsInteger(RegType),
-    IsRational(RegType),
-    IsFloat(RegType),
-    IsNonVar(RegType),
-    IsVar(RegType),
-}
-
-ref_thread_local! {
-    pub static managed RANDOM_STATE: RandState<'static> = RandState::new();
-}
-
-ref_thread_local! {
-    pub static managed CLAUSE_TYPE_FORMS: BTreeMap<(&'static str, usize), ClauseType> = {
-        let mut m = BTreeMap::new();
-
-        let r1 = temp_v!(1);
-        let r2 = temp_v!(2);
-
-        m.insert((">", 2),
-                 ClauseType::Inlined(InlinedClauseType::CompareNumber(CompareNumberQT::GreaterThan, ar_reg!(r1), ar_reg!(r2))));
-        m.insert(("<", 2),
-                 ClauseType::Inlined(InlinedClauseType::CompareNumber(CompareNumberQT::LessThan, ar_reg!(r1), ar_reg!(r2))));
-        m.insert((">=", 2), ClauseType::Inlined(InlinedClauseType::CompareNumber(CompareNumberQT::GreaterThanOrEqual, ar_reg!(r1), ar_reg!(r2))));
-        m.insert(("=<", 2), ClauseType::Inlined(InlinedClauseType::CompareNumber(CompareNumberQT::LessThanOrEqual, ar_reg!(r1), ar_reg!(r2))));
-        m.insert(("=:=", 2), ClauseType::Inlined(InlinedClauseType::CompareNumber(CompareNumberQT::Equal, ar_reg!(r1), ar_reg!(r2))));
-        m.insert(("=\\=", 2), ClauseType::Inlined(InlinedClauseType::CompareNumber(CompareNumberQT::NotEqual, ar_reg!(r1), ar_reg!(r2))));
-        m.insert(("atom", 1), ClauseType::Inlined(InlinedClauseType::IsAtom(r1)));
-        m.insert(("atomic", 1), ClauseType::Inlined(InlinedClauseType::IsAtomic(r1)));
-        m.insert(("compound", 1), ClauseType::Inlined(InlinedClauseType::IsCompound(r1)));
-        m.insert(("integer", 1), ClauseType::Inlined(InlinedClauseType::IsInteger(r1)));
-        m.insert(("rational", 1), ClauseType::Inlined(InlinedClauseType::IsRational(r1)));
-        m.insert(("float", 1), ClauseType::Inlined(InlinedClauseType::IsFloat(r1)));
-        m.insert(("nonvar", 1), ClauseType::Inlined(InlinedClauseType::IsNonVar(r1)));
-        m.insert(("var", 1), ClauseType::Inlined(InlinedClauseType::IsVar(r1)));
-        m.insert(("acyclic_term", 1), ClauseType::BuiltIn(BuiltInClauseType::AcyclicTerm));
-        m.insert(("arg", 3), ClauseType::BuiltIn(BuiltInClauseType::Arg));
-        m.insert(("compare", 3), ClauseType::BuiltIn(BuiltInClauseType::Compare));
-        m.insert(("@>", 2), ClauseType::BuiltIn(BuiltInClauseType::CompareTerm(CompareTermQT::GreaterThan)));
-        m.insert(("@<", 2), ClauseType::BuiltIn(BuiltInClauseType::CompareTerm(CompareTermQT::LessThan)));
-        m.insert(("@>=", 2), ClauseType::BuiltIn(BuiltInClauseType::CompareTerm(CompareTermQT::GreaterThanOrEqual)));
-        m.insert(("@=<", 2), ClauseType::BuiltIn(BuiltInClauseType::CompareTerm(CompareTermQT::LessThanOrEqual)));
-        m.insert(("copy_term", 2), ClauseType::BuiltIn(BuiltInClauseType::CopyTerm));
-        m.insert(("==", 2), ClauseType::BuiltIn(BuiltInClauseType::Eq));
-        m.insert(("functor", 3), ClauseType::BuiltIn(BuiltInClauseType::Functor));
-        m.insert(("ground", 1), ClauseType::BuiltIn(BuiltInClauseType::Ground));
-        m.insert(("is", 2), ClauseType::BuiltIn(BuiltInClauseType::Is(r1, ar_reg!(r2))));
-        m.insert(("keysort", 2), ClauseType::BuiltIn(BuiltInClauseType::KeySort));
-        m.insert(("nl", 0), ClauseType::BuiltIn(BuiltInClauseType::Nl));
-        m.insert(("\\==", 2), ClauseType::BuiltIn(BuiltInClauseType::NotEq));
-        m.insert(("read", 1), ClauseType::BuiltIn(BuiltInClauseType::Read));
-        m.insert(("sort", 2), ClauseType::BuiltIn(BuiltInClauseType::Sort));
-
-        m
-    };
-}
-
-impl InlinedClauseType {
-    pub fn name(&self) -> &'static str {
-        match self {
-            &InlinedClauseType::CompareNumber(qt, ..) => qt.name(),
-            &InlinedClauseType::IsAtom(..) => "atom",
-            &InlinedClauseType::IsAtomic(..) => "atomic",
-            &InlinedClauseType::IsCompound(..) => "compound",
-            &InlinedClauseType::IsInteger(..) => "integer",
-            &InlinedClauseType::IsRational(..) => "rational",
-            &InlinedClauseType::IsFloat(..) => "float",
-            &InlinedClauseType::IsNonVar(..) => "nonvar",
-            &InlinedClauseType::IsVar(..) => "var",
-        }
-    }
-}
-
-#[derive(Debug, Copy, Clone, Eq, PartialEq)]
-pub enum SystemClauseType {
-    AbolishClause,
-    AbolishModuleClause,
-    AssertDynamicPredicateToBack,
-    AssertDynamicPredicateToFront,
-    AtEndOfExpansion,
-    AtomChars,
-    AtomCodes,
-    AtomLength,
-    BindFromRegister,
-    CallContinuation,
-    CharCode,
-    CharType,
-    CharsToNumber,
-    ClearAttributeGoals,
-    CloneAttributeGoals,
-    CodesToNumber,
-    CopyTermWithoutAttrVars,
-    CheckCutPoint,
-    Close,
-    CopyToLiftedHeap,
-    CreatePartialString,
-    CurrentHostname,
-    CurrentInput,
-    CurrentOutput,
-    DirectoryFiles,
-    FileSize,
-    FileExists,
-    DirectoryExists,
-    DirectorySeparator,
-    MakeDirectory,
-    DeleteFile,
-    WorkingDirectory,
-    PathCanonical,
-    FileTime,
-    DeleteAttribute,
-    DeleteHeadAttribute,
-    DynamicModuleResolution(usize),
-    EnqueueAttributeGoal,
-    EnqueueAttributedVar,
-    ExpandGoal,
-    ExpandTerm,
-    FetchGlobalVar,
-    FetchGlobalVarWithOffset,
-    FirstStream,
-    FlushOutput,
-    GetByte,
-    GetChar,
-    GetNChars,
-    GetCode,
-    GetSingleChar,
-    ResetAttrVarState,
-    TruncateIfNoLiftedHeapGrowthDiff,
-    TruncateIfNoLiftedHeapGrowth,
-    GetAttributedVariableList,
-    GetAttrVarQueueDelimiter,
-    GetAttrVarQueueBeyond,
-    GetBValue,
-    GetClause,
-    GetContinuationChunk,
-    GetModuleClause,
-    GetNextDBRef,
-    GetNextOpDBRef,
-    IsPartialString,
-    LookupDBRef,
-    LookupOpDBRef,
-    Halt,
-    ModuleHeadIsDynamic,
-    GetLiftedHeapFromOffset,
-    GetLiftedHeapFromOffsetDiff,
-    GetSCCCleaner,
-    HeadIsDynamic,
-    InstallSCCCleaner,
-    InstallInferenceCounter,
-    LiftedHeapLength,
-    ModuleAssertDynamicPredicateToFront,
-    ModuleAssertDynamicPredicateToBack,
-    ModuleExists,
-    ModuleOf,
-    ModuleRetractClause,
-    NextEP,
-    NoSuchPredicate,
-    NumberToChars,
-    NumberToCodes,
-    OpDeclaration,
-    Open,
-    NextStream,
-    PartialStringTail,
-    PeekByte,
-    PeekChar,
-    PeekCode,
-    PointsToContinuationResetMarker,
-    PutByte,
-    PutChar,
-    PutChars,
-    PutCode,
-    REPL(REPLCodePtr),
-    ReadQueryTerm,
-    ReadTerm,
-    RedoAttrVarBinding,
-    RemoveCallPolicyCheck,
-    RemoveInferenceCounter,
-    ResetContinuationMarker,
-    ResetGlobalVarAtKey,
-    ResetGlobalVarAtOffset,
-    RetractClause,
-    RestoreCutPolicy,
-    SetCutPoint(RegType),
-    SetInput,
-    SetOutput,
-    StoreGlobalVar,
-    StoreGlobalVarWithOffset,
-    StreamProperty,
-    SetStreamPosition,
-    InferenceLevel,
-    CleanUpBlock,
-    EraseBall,
-    Fail,
-    GetBall,
-    GetCurrentBlock,
-    GetCutPoint,
-    GetDoubleQuotes,
-    InstallNewBlock,
-    Maybe,
-    CpuNow,
-    CurrentTime,
-    QuotedToken,
-    ReadTermFromChars,
-    ResetBlock,
-    ReturnFromVerifyAttr,
-    SetBall,
-    SetCutPointByDefault(RegType),
-    SetDoubleQuotes,
-    SetSeed,
-    SkipMaxList,
-    Sleep,
-    SocketClientOpen,
-    SocketServerOpen,
-    SocketServerAccept,
-    SocketServerClose,
-    Succeed,
-    TermAttributedVariables,
-    TermVariables,
-    TruncateLiftedHeapTo,
-    UnifyWithOccursCheck,
-    UnwindEnvironments,
-    UnwindStack,
-    Variant,
-    WAMInstructions,
-    WriteTerm,
-    WriteTermToChars,
-    ScryerPrologVersion,
-    CryptoRandomByte,
-    CryptoDataHash,
-    CryptoDataHKDF,
-    CryptoPasswordHash,
-    CryptoDataEncrypt,
-    CryptoDataDecrypt,
-    CryptoCurveScalarMult,
-    Ed25519Sign,
-    Ed25519Verify,
-    Ed25519NewKeyPair,
-    Ed25519KeyPairPublicKey,
-    Curve25519ScalarMult,
-    LoadHTML,
-    LoadXML,
-    GetEnv,
-    SetEnv,
-    UnsetEnv,
-    CharsBase64,
-}
-
-impl SystemClauseType {
-    pub fn name(&self) -> ClauseName {
-        match self {
-            &SystemClauseType::AbolishClause => clause_name!("$abolish_clause"),
-            &SystemClauseType::AbolishModuleClause => clause_name!("$abolish_module_clause"),
-            &SystemClauseType::AssertDynamicPredicateToBack => clause_name!("$assertz"),
-            &SystemClauseType::AssertDynamicPredicateToFront => clause_name!("$asserta"),
-            &SystemClauseType::AtEndOfExpansion => clause_name!("$at_end_of_expansion"),
-            &SystemClauseType::AtomChars => clause_name!("$atom_chars"),
-            &SystemClauseType::AtomCodes => clause_name!("$atom_codes"),
-            &SystemClauseType::AtomLength => clause_name!("$atom_length"),
-            &SystemClauseType::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"),
-            &SystemClauseType::CloneAttributeGoals => clause_name!("$clone_attribute_goals"),
-            &SystemClauseType::CodesToNumber => clause_name!("$codes_to_number"),
-            &SystemClauseType::CopyTermWithoutAttrVars => clause_name!("$copy_term_without_attr_vars"),
-            &SystemClauseType::CreatePartialString => clause_name!("$create_partial_string"),
-            &SystemClauseType::CurrentInput => clause_name!("$current_input"),
-            &SystemClauseType::CurrentHostname => clause_name!("$current_hostname"),
-            &SystemClauseType::CurrentOutput => clause_name!("$current_output"),
-            &SystemClauseType::DirectoryFiles => clause_name!("$directory_files"),
-            &SystemClauseType::FileSize => clause_name!("$file_size"),
-            &SystemClauseType::FileExists => clause_name!("$file_exists"),
-            &SystemClauseType::DirectoryExists => clause_name!("$directory_exists"),
-            &SystemClauseType::DirectorySeparator => clause_name!("$directory_separator"),
-            &SystemClauseType::MakeDirectory => clause_name!("$make_directory"),
-            &SystemClauseType::DeleteFile => clause_name!("$delete_file"),
-            &SystemClauseType::WorkingDirectory => clause_name!("$working_directory"),
-            &SystemClauseType::PathCanonical => clause_name!("$path_canonical"),
-            &SystemClauseType::FileTime => clause_name!("$file_time"),
-            &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::Close => clause_name!("$close"),
-            &SystemClauseType::CopyToLiftedHeap => clause_name!("$copy_to_lh"),
-            &SystemClauseType::DeleteAttribute => clause_name!("$del_attr_non_head"),
-            &SystemClauseType::DeleteHeadAttribute => clause_name!("$del_attr_head"),
-            &SystemClauseType::DynamicModuleResolution(_) => clause_name!("$module_call"),
-            &SystemClauseType::EnqueueAttributeGoal => clause_name!("$enqueue_attribute_goal"),
-            &SystemClauseType::EnqueueAttributedVar => clause_name!("$enqueue_attr_var"),
-            &SystemClauseType::ExpandTerm => clause_name!("$expand_term"),
-            &SystemClauseType::ExpandGoal => clause_name!("$expand_goal"),
-            &SystemClauseType::FetchGlobalVar => clause_name!("$fetch_global_var"),
-            &SystemClauseType::FetchGlobalVarWithOffset => {
-                clause_name!("$fetch_global_var_with_offset")
-            }
-            &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::GetNChars => clause_name!("$get_n_chars"),
-            &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")
-            }
-            &SystemClauseType::TruncateIfNoLiftedHeapGrowthDiff => {
-                clause_name!("$truncate_if_no_lh_growth_diff")
-            }
-            &SystemClauseType::GetAttributedVariableList => clause_name!("$get_attr_list"),
-            &SystemClauseType::GetAttrVarQueueDelimiter => {
-                clause_name!("$get_attr_var_queue_delim")
-            }
-            &SystemClauseType::GetAttrVarQueueBeyond => clause_name!("$get_attr_var_queue_beyond"),
-            &SystemClauseType::GetContinuationChunk => clause_name!("$get_cont_chunk"),
-            &SystemClauseType::GetLiftedHeapFromOffset => clause_name!("$get_lh_from_offset"),
-            &SystemClauseType::GetLiftedHeapFromOffsetDiff => {
-                clause_name!("$get_lh_from_offset_diff")
-            }
-            &SystemClauseType::GetBValue => clause_name!("$get_b_value"),
-            &SystemClauseType::GetClause => clause_name!("$get_clause"),
-            &SystemClauseType::GetNextDBRef => clause_name!("$get_next_db_ref"),
-            &SystemClauseType::GetNextOpDBRef => clause_name!("$get_next_op_db_ref"),
-            &SystemClauseType::LookupDBRef => clause_name!("$lookup_db_ref"),
-            &SystemClauseType::LookupOpDBRef => clause_name!("$lookup_op_db_ref"),
-            &SystemClauseType::GetDoubleQuotes => clause_name!("$get_double_quotes"),
-            &SystemClauseType::GetModuleClause => clause_name!("$get_module_clause"),
-            &SystemClauseType::GetSCCCleaner => clause_name!("$get_scc_cleaner"),
-            &SystemClauseType::Halt => clause_name!("$halt"),
-            &SystemClauseType::HeadIsDynamic => clause_name!("$head_is_dynamic"),
-            &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::CurrentTime => clause_name!("$current_time"),
-            &SystemClauseType::ModuleAssertDynamicPredicateToFront => {
-                clause_name!("$module_asserta")
-            }
-            &SystemClauseType::ModuleAssertDynamicPredicateToBack => {
-                clause_name!("$module_assertz")
-            }
-            &SystemClauseType::ModuleHeadIsDynamic => clause_name!("$module_head_is_dynamic"),
-            &SystemClauseType::ModuleExists => clause_name!("$module_exists"),
-            &SystemClauseType::ModuleOf => clause_name!("$module_of"),
-            &SystemClauseType::NextStream => clause_name!("$next_stream"),
-            &SystemClauseType::NoSuchPredicate => clause_name!("$no_such_predicate"),
-            &SystemClauseType::NumberToChars => clause_name!("$number_to_chars"),
-            &SystemClauseType::NumberToCodes => clause_name!("$number_to_codes"),
-            &SystemClauseType::PointsToContinuationResetMarker => {
-                clause_name!("$points_to_cont_reset_marker")
-            }
-            &SystemClauseType::PutByte => {
-                clause_name!("$put_byte")
-            }
-            &SystemClauseType::PutChar => {
-                clause_name!("$put_char")
-            }
-            &SystemClauseType::PutChars => {
-                clause_name!("$put_chars")
-            }
-            &SystemClauseType::PutCode => {
-                clause_name!("$put_code")
-            }
-            &SystemClauseType::QuotedToken => {
-                clause_name!("$quoted_token")
-            }
-            &SystemClauseType::RedoAttrVarBinding => clause_name!("$redo_attr_var_binding"),
-            &SystemClauseType::RemoveCallPolicyCheck => clause_name!("$remove_call_policy_check"),
-            &SystemClauseType::RemoveInferenceCounter => clause_name!("$remove_inference_counter"),
-            &SystemClauseType::RestoreCutPolicy => clause_name!("$restore_cut_policy"),
-            &SystemClauseType::SetCutPoint(_) => clause_name!("$set_cp"),
-            &SystemClauseType::SetInput => clause_name!("$set_input"),
-            &SystemClauseType::SetOutput => clause_name!("$set_output"),
-            &SystemClauseType::SetSeed => clause_name!("$set_seed"),
-            &SystemClauseType::StreamProperty => clause_name!("$stream_property"),
-            &SystemClauseType::SetStreamPosition => clause_name!("$set_stream_position"),
-            &SystemClauseType::StoreGlobalVar => clause_name!("$store_global_var"),
-            &SystemClauseType::StoreGlobalVarWithOffset => {
-                clause_name!("$store_global_var_with_offset")
-            }
-            &SystemClauseType::InferenceLevel => clause_name!("$inference_level"),
-            &SystemClauseType::CleanUpBlock => clause_name!("$clean_up_block"),
-            &SystemClauseType::EraseBall => clause_name!("$erase_ball"),
-            &SystemClauseType::Fail => clause_name!("$fail"),
-            &SystemClauseType::GetBall => clause_name!("$get_ball"),
-            &SystemClauseType::GetCutPoint => clause_name!("$get_cp"),
-            &SystemClauseType::GetCurrentBlock => clause_name!("$get_current_block"),
-            &SystemClauseType::InstallNewBlock => clause_name!("$install_new_block"),
-            &SystemClauseType::ModuleRetractClause => clause_name!("$module_retract_clause"),
-            &SystemClauseType::NextEP => clause_name!("$nextEP"),
-            &SystemClauseType::ReadQueryTerm => clause_name!("$read_query_term"),
-            &SystemClauseType::ReadTerm => clause_name!("$read_term"),
-            &SystemClauseType::ReadTermFromChars => clause_name!("$read_term_from_chars"),
-            &SystemClauseType::ResetGlobalVarAtKey => clause_name!("$reset_global_var_at_key"),
-            &SystemClauseType::ResetGlobalVarAtOffset => clause_name!("$reset_global_var_at_offset"),
-            &SystemClauseType::RetractClause => clause_name!("$retract_clause"),
-            &SystemClauseType::ResetBlock => clause_name!("$reset_block"),
-            &SystemClauseType::ResetContinuationMarker => clause_name!("$reset_cont_marker"),
-            &SystemClauseType::ReturnFromVerifyAttr => clause_name!("$return_from_verify_attr"),
-            &SystemClauseType::SetBall => clause_name!("$set_ball"),
-            &SystemClauseType::SetCutPointByDefault(_) => clause_name!("$set_cp_by_default"),
-            &SystemClauseType::SetDoubleQuotes => clause_name!("$set_double_quotes"),
-            &SystemClauseType::SkipMaxList => clause_name!("$skip_max_list"),
-            &SystemClauseType::Sleep => clause_name!("$sleep"),
-            &SystemClauseType::SocketClientOpen => clause_name!("$socket_client_open"),
-            &SystemClauseType::SocketServerOpen => clause_name!("$socket_server_open"),
-            &SystemClauseType::SocketServerAccept => clause_name!("$socket_server_accept"),
-            &SystemClauseType::SocketServerClose => clause_name!("$socket_server_close"),
-            &SystemClauseType::Succeed => clause_name!("$succeed"),
-            &SystemClauseType::TermAttributedVariables => clause_name!("$term_attributed_variables"),
-            &SystemClauseType::TermVariables => clause_name!("$term_variables"),
-            &SystemClauseType::TruncateLiftedHeapTo => clause_name!("$truncate_lh_to"),
-            &SystemClauseType::UnifyWithOccursCheck => clause_name!("$unify_with_occurs_check"),
-            &SystemClauseType::UnwindEnvironments => clause_name!("$unwind_environments"),
-            &SystemClauseType::UnwindStack => clause_name!("$unwind_stack"),
-            &SystemClauseType::Variant => clause_name!("$variant"),
-            &SystemClauseType::WAMInstructions => clause_name!("$wam_instructions"),
-            &SystemClauseType::WriteTerm => clause_name!("$write_term"),
-            &SystemClauseType::WriteTermToChars => clause_name!("$write_term_to_chars"),
-            &SystemClauseType::ScryerPrologVersion => clause_name!("$scryer_prolog_version"),
-            &SystemClauseType::CryptoRandomByte => clause_name!("$crypto_random_byte"),
-            &SystemClauseType::CryptoDataHash => clause_name!("$crypto_data_hash"),
-            &SystemClauseType::CryptoDataHKDF => clause_name!("$crypto_data_hkdf"),
-            &SystemClauseType::CryptoPasswordHash => clause_name!("$crypto_password_hash"),
-            &SystemClauseType::CryptoDataEncrypt => clause_name!("$crypto_data_encrypt"),
-            &SystemClauseType::CryptoDataDecrypt => clause_name!("$crypto_data_decrypt"),
-            &SystemClauseType::CryptoCurveScalarMult => clause_name!("$crypto_curve_scalar_mult"),
-            &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"),
-            &SystemClauseType::Curve25519ScalarMult => clause_name!("$curve25519_scalar_mult"),
-            &SystemClauseType::LoadHTML => clause_name!("$load_html"),
-            &SystemClauseType::LoadXML => clause_name!("$load_xml"),
-            &SystemClauseType::GetEnv => clause_name!("$getenv"),
-            &SystemClauseType::SetEnv => clause_name!("$setenv"),
-            &SystemClauseType::UnsetEnv => clause_name!("$unsetenv"),
-            &SystemClauseType::CharsBase64 => clause_name!("$chars_base64"),
-        }
-    }
-
-    pub fn from(name: &str, arity: usize) -> Option<SystemClauseType> {
-        match (name, arity) {
-            ("$abolish_clause", 2) => Some(SystemClauseType::AbolishClause),
-            ("$at_end_of_expansion", 0) => Some(SystemClauseType::AtEndOfExpansion),
-            ("$atom_chars", 2) => Some(SystemClauseType::AtomChars),
-            ("$atom_codes", 2) => Some(SystemClauseType::AtomCodes),
-            ("$atom_length", 2) => Some(SystemClauseType::AtomLength),
-            ("$abolish_module_clause", 3) => Some(SystemClauseType::AbolishModuleClause),
-            ("$bind_from_register", 2) => Some(SystemClauseType::BindFromRegister),
-            ("$module_asserta", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToFront),
-            ("$module_assertz", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToBack),
-            ("$asserta", 4) => Some(SystemClauseType::AssertDynamicPredicateToFront),
-            ("$assertz", 4) => Some(SystemClauseType::AssertDynamicPredicateToBack),
-            ("$call_continuation", 1) => Some(SystemClauseType::CallContinuation),
-            ("$char_code", 2) => Some(SystemClauseType::CharCode),
-            ("$char_type", 2) => Some(SystemClauseType::CharType),
-            ("$chars_to_number", 2) => Some(SystemClauseType::CharsToNumber),
-            ("$clear_attribute_goals", 0) => Some(SystemClauseType::ClearAttributeGoals),
-            ("$clone_attribute_goals", 1) => Some(SystemClauseType::CloneAttributeGoals),
-            ("$codes_to_number", 2) => Some(SystemClauseType::CodesToNumber),
-            ("$copy_term_without_attr_vars", 2) => Some(SystemClauseType::CopyTermWithoutAttrVars),
-            ("$create_partial_string", 3) => Some(SystemClauseType::CreatePartialString),
-            ("$check_cp", 1) => Some(SystemClauseType::CheckCutPoint),
-            ("$compile_batch", 0) => Some(SystemClauseType::REPL(REPLCodePtr::CompileBatch)),
-            ("$copy_to_lh", 2) => Some(SystemClauseType::CopyToLiftedHeap),
-            ("$close", 2) => Some(SystemClauseType::Close),
-            ("$current_hostname", 1) => Some(SystemClauseType::CurrentHostname),
-            ("$current_input", 1) => Some(SystemClauseType::CurrentInput),
-            ("$current_output", 1) => Some(SystemClauseType::CurrentOutput),
-            ("$first_stream", 1) => Some(SystemClauseType::FirstStream),
-            ("$next_stream", 2) => Some(SystemClauseType::NextStream),
-            ("$flush_output", 1) => Some(SystemClauseType::FlushOutput),
-            ("$del_attr_non_head", 1) => Some(SystemClauseType::DeleteAttribute),
-            ("$del_attr_head", 1) => Some(SystemClauseType::DeleteHeadAttribute),
-            ("$get_next_db_ref", 2) => Some(SystemClauseType::GetNextDBRef),
-            ("$get_next_op_db_ref", 2) => Some(SystemClauseType::GetNextOpDBRef),
-            ("$lookup_db_ref", 3) => Some(SystemClauseType::LookupDBRef),
-            ("$lookup_op_db_ref", 4) => Some(SystemClauseType::LookupOpDBRef),
-            ("$module_call", _) => Some(SystemClauseType::DynamicModuleResolution(arity - 2)),
-            ("$enqueue_attribute_goal", 1) => Some(SystemClauseType::EnqueueAttributeGoal),
-            ("$enqueue_attr_var", 1) => Some(SystemClauseType::EnqueueAttributedVar),
-            ("$partial_string_tail", 2) => Some(SystemClauseType::PartialStringTail),
-            ("$peek_byte", 2) => Some(SystemClauseType::PeekByte),
-            ("$peek_char", 2) => Some(SystemClauseType::PeekChar),
-            ("$peek_code", 2) => Some(SystemClauseType::PeekCode),
-            ("$is_partial_string", 1) => Some(SystemClauseType::IsPartialString),
-            ("$expand_term", 2) => Some(SystemClauseType::ExpandTerm),
-            ("$expand_goal", 2) => Some(SystemClauseType::ExpandGoal),
-            ("$fetch_global_var", 2) => Some(SystemClauseType::FetchGlobalVar),
-            ("$fetch_global_var_with_offset", 3) => Some(SystemClauseType::FetchGlobalVarWithOffset),
-            ("$get_byte", 2) => Some(SystemClauseType::GetByte),
-            ("$get_char", 2) => Some(SystemClauseType::GetChar),
-            ("$get_n_chars", 3) => Some(SystemClauseType::GetNChars),
-            ("$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_char", 2) => {
-                Some(SystemClauseType::PutChar)
-            }
-            ("$put_chars", 2) => {
-                Some(SystemClauseType::PutChars)
-            }
-            ("$put_code", 2) => {
-                Some(SystemClauseType::PutCode)
-            }
-            ("$reset_attr_var_state", 0) => Some(SystemClauseType::ResetAttrVarState),
-            ("$truncate_if_no_lh_growth", 1) => {
-                Some(SystemClauseType::TruncateIfNoLiftedHeapGrowth)
-            }
-            ("$truncate_if_no_lh_growth_diff", 2) => {
-                Some(SystemClauseType::TruncateIfNoLiftedHeapGrowthDiff)
-            }
-            ("$get_attr_list", 2) => Some(SystemClauseType::GetAttributedVariableList),
-            ("$get_b_value", 1) => Some(SystemClauseType::GetBValue),
-            ("$get_clause", 2) => Some(SystemClauseType::GetClause),
-            ("$get_module_clause", 3) => Some(SystemClauseType::GetModuleClause),
-            ("$get_lh_from_offset", 2) => Some(SystemClauseType::GetLiftedHeapFromOffset),
-            ("$get_lh_from_offset_diff", 3) => Some(SystemClauseType::GetLiftedHeapFromOffsetDiff),
-            ("$get_double_quotes", 1) => Some(SystemClauseType::GetDoubleQuotes),
-            ("$get_scc_cleaner", 1) => Some(SystemClauseType::GetSCCCleaner),
-            ("$halt", 1) => Some(SystemClauseType::Halt),
-            ("$head_is_dynamic", 1) => Some(SystemClauseType::HeadIsDynamic),
-            ("$install_scc_cleaner", 2) => Some(SystemClauseType::InstallSCCCleaner),
-            ("$install_inference_counter", 3) => Some(SystemClauseType::InstallInferenceCounter),
-            ("$lh_length", 1) => Some(SystemClauseType::LiftedHeapLength),
-            ("$maybe", 0) => Some(SystemClauseType::Maybe),
-            ("$cpu_now", 1) => Some(SystemClauseType::CpuNow),
-            ("$current_time", 1) => Some(SystemClauseType::CurrentTime),
-            ("$module_exists", 1) => Some(SystemClauseType::ModuleExists),
-            ("$module_of", 2) => Some(SystemClauseType::ModuleOf),
-            ("$module_retract_clause", 5) => Some(SystemClauseType::ModuleRetractClause),
-            ("$module_head_is_dynamic", 2) => Some(SystemClauseType::ModuleHeadIsDynamic),
-            ("$no_such_predicate", 1) => Some(SystemClauseType::NoSuchPredicate),
-            ("$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),
-            ("$restore_cut_policy", 0) => Some(SystemClauseType::RestoreCutPolicy),
-            ("$set_cp", 1) => Some(SystemClauseType::SetCutPoint(temp_v!(1))),
-            ("$set_input", 1) => Some(SystemClauseType::SetInput),
-            ("$set_output", 1) => Some(SystemClauseType::SetOutput),
-            ("$stream_property", 3) => Some(SystemClauseType::StreamProperty),
-            ("$set_stream_position", 2) => Some(SystemClauseType::SetStreamPosition),
-            ("$inference_level", 2) => Some(SystemClauseType::InferenceLevel),
-            ("$clean_up_block", 1) => Some(SystemClauseType::CleanUpBlock),
-            ("$erase_ball", 0) => Some(SystemClauseType::EraseBall),
-            ("$fail", 0) => Some(SystemClauseType::Fail),
-            ("$get_attr_var_queue_beyond", 2) => Some(SystemClauseType::GetAttrVarQueueBeyond),
-            ("$get_attr_var_queue_delim", 1) => Some(SystemClauseType::GetAttrVarQueueDelimiter),
-            ("$get_ball", 1) => Some(SystemClauseType::GetBall),
-            ("$get_cont_chunk", 3) => Some(SystemClauseType::GetContinuationChunk),
-            ("$get_current_block", 1) => Some(SystemClauseType::GetCurrentBlock),
-            ("$get_cp", 1) => Some(SystemClauseType::GetCutPoint),
-            ("$install_new_block", 1) => Some(SystemClauseType::InstallNewBlock),
-            ("$quoted_token", 1) => Some(SystemClauseType::QuotedToken),
-            ("$nextEP", 3) => Some(SystemClauseType::NextEP),
-            ("$read_query_term", 5) => Some(SystemClauseType::ReadQueryTerm),
-            ("$read_term", 5) => Some(SystemClauseType::ReadTerm),
-            ("$read_term_from_chars", 2) => Some(SystemClauseType::ReadTermFromChars),
-            ("$reset_block", 1) => Some(SystemClauseType::ResetBlock),
-            ("$reset_cont_marker", 0) => Some(SystemClauseType::ResetContinuationMarker),
-            ("$reset_global_var_at_key", 1) => Some(SystemClauseType::ResetGlobalVarAtKey),
-            ("$reset_global_var_at_offset", 3) => Some(SystemClauseType::ResetGlobalVarAtOffset),
-            ("$retract_clause", 4) => Some(SystemClauseType::RetractClause),
-            ("$return_from_verify_attr", 0) => Some(SystemClauseType::ReturnFromVerifyAttr),
-            ("$set_ball", 1) => Some(SystemClauseType::SetBall),
-            ("$set_cp_by_default", 1) => Some(SystemClauseType::SetCutPointByDefault(temp_v!(1))),
-            ("$set_double_quotes", 1) => Some(SystemClauseType::SetDoubleQuotes),
-            ("$set_seed", 1) => Some(SystemClauseType::SetSeed),
-            ("$skip_max_list", 4) => Some(SystemClauseType::SkipMaxList),
-            ("$sleep", 1) => Some(SystemClauseType::Sleep),
-            ("$socket_client_open", 8) => 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),
-            ("$directory_files", 2) => Some(SystemClauseType::DirectoryFiles),
-            ("$file_size", 2) => Some(SystemClauseType::FileSize),
-            ("$file_exists", 1) => Some(SystemClauseType::FileExists),
-            ("$directory_exists", 1) => Some(SystemClauseType::DirectoryExists),
-            ("$directory_separator", 1) => Some(SystemClauseType::DirectorySeparator),
-            ("$make_directory", 1) => Some(SystemClauseType::MakeDirectory),
-            ("$delete_file", 1) => Some(SystemClauseType::DeleteFile),
-            ("$working_directory", 2) => Some(SystemClauseType::WorkingDirectory),
-            ("$path_canonical", 2) => Some(SystemClauseType::PathCanonical),
-            ("$file_time", 3) => Some(SystemClauseType::FileTime),
-            ("$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", 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", 4) => Some(SystemClauseType::CryptoDataHash),
-            ("$crypto_data_hkdf", 7) => Some(SystemClauseType::CryptoDataHKDF),
-            ("$crypto_password_hash", 4) => Some(SystemClauseType::CryptoPasswordHash),
-            ("$crypto_data_encrypt", 6) => Some(SystemClauseType::CryptoDataEncrypt),
-            ("$crypto_data_decrypt", 6) => Some(SystemClauseType::CryptoDataDecrypt),
-            ("$crypto_curve_scalar_mult", 5) => Some(SystemClauseType::CryptoCurveScalarMult),
-            ("$ed25519_sign", 5) => Some(SystemClauseType::Ed25519Sign),
-            ("$ed25519_verify", 5) => Some(SystemClauseType::Ed25519Verify),
-            ("$ed25519_new_keypair", 1) => Some(SystemClauseType::Ed25519NewKeyPair),
-            ("$ed25519_keypair_public_key", 3) => Some(SystemClauseType::Ed25519KeyPairPublicKey),
-            ("$curve25519_scalar_mult", 3) => Some(SystemClauseType::Curve25519ScalarMult),
-            ("$load_html", 3) => Some(SystemClauseType::LoadHTML),
-            ("$load_xml", 3) => Some(SystemClauseType::LoadXML),
-            ("$getenv", 2) => Some(SystemClauseType::GetEnv),
-            ("$setenv", 2) => Some(SystemClauseType::SetEnv),
-            ("$unsetenv", 1) => Some(SystemClauseType::UnsetEnv),
-            ("$chars_base64", 4) => Some(SystemClauseType::CharsBase64),
-            _ => None,
-        }
-    }
-}
-
-#[derive(Debug, Clone, Eq, PartialEq)]
-pub enum BuiltInClauseType {
-    AcyclicTerm,
-    Arg,
-    Compare,
-    CompareTerm(CompareTermQT),
-    CopyTerm,
-    Eq,
-    Functor,
-    Ground,
-    Is(RegType, ArithmeticTerm),
-    KeySort,
-    Nl,
-    NotEq,
-    Read,
-    Sort,
-}
-
-#[derive(Debug, Clone, PartialEq, Eq)]
-pub enum ClauseType {
-    BuiltIn(BuiltInClauseType),
-    CallN,
-    Hook(CompileTimeHook),
-    Inlined(InlinedClauseType),
-    Named(ClauseName, usize, CodeIndex), // name, arity, index.
-    Op(ClauseName, SharedOpDesc, CodeIndex),
-    System(SystemClauseType),
-}
-
-impl BuiltInClauseType {
-    pub fn name(&self) -> ClauseName {
-        match self {
-            &BuiltInClauseType::AcyclicTerm => clause_name!("acyclic_term"),
-            &BuiltInClauseType::Arg => clause_name!("arg"),
-            &BuiltInClauseType::Compare => clause_name!("compare"),
-            &BuiltInClauseType::CompareTerm(qt) => clause_name!(qt.name()),
-            &BuiltInClauseType::CopyTerm => clause_name!("copy_term"),
-            &BuiltInClauseType::Eq => clause_name!("=="),
-            &BuiltInClauseType::Functor => clause_name!("functor"),
-            &BuiltInClauseType::Ground => clause_name!("ground"),
-            &BuiltInClauseType::Is(..) => clause_name!("is"),
-            &BuiltInClauseType::KeySort => clause_name!("keysort"),
-            &BuiltInClauseType::Nl => clause_name!("nl"),
-            &BuiltInClauseType::NotEq => clause_name!("\\=="),
-            &BuiltInClauseType::Read => clause_name!("read"),
-            &BuiltInClauseType::Sort => clause_name!("sort"),
-        }
-    }
-
-    pub fn arity(&self) -> usize {
-        match self {
-            &BuiltInClauseType::AcyclicTerm => 1,
-            &BuiltInClauseType::Arg => 3,
-            &BuiltInClauseType::Compare => 2,
-            &BuiltInClauseType::CompareTerm(_) => 2,
-            &BuiltInClauseType::CopyTerm => 2,
-            &BuiltInClauseType::Eq => 2,
-            &BuiltInClauseType::Functor => 3,
-            &BuiltInClauseType::Ground => 1,
-            &BuiltInClauseType::Is(..) => 2,
-            &BuiltInClauseType::KeySort => 2,
-            &BuiltInClauseType::NotEq => 2,
-            &BuiltInClauseType::Nl => 0,
-            &BuiltInClauseType::Read => 1,
-            &BuiltInClauseType::Sort => 2,
-        }
-    }
-}
-
-impl ClauseType {
-    pub fn spec(&self) -> Option<SharedOpDesc> {
-        match self {
-            &ClauseType::Op(_, ref spec, _) => Some(spec.clone()),
-            &ClauseType::Inlined(InlinedClauseType::CompareNumber(..))
-          | &ClauseType::BuiltIn(BuiltInClauseType::Is(..))
-          | &ClauseType::BuiltIn(BuiltInClauseType::CompareTerm(_))
-          | &ClauseType::BuiltIn(BuiltInClauseType::NotEq)
-          | &ClauseType::BuiltIn(BuiltInClauseType::Eq) => Some(SharedOpDesc::new(700, XFX)),
-            _ => None,
-        }
-    }
-
-    pub fn name(&self) -> ClauseName {
-        match self {
-            &ClauseType::BuiltIn(ref built_in) => built_in.name(),
-            &ClauseType::CallN => clause_name!("call"),
-            &ClauseType::Hook(ref hook) => hook.name(),
-            &ClauseType::Inlined(ref inlined) => clause_name!(inlined.name()),
-            &ClauseType::Op(ref name, ..) => name.clone(),
-            &ClauseType::Named(ref name, ..) => name.clone(),
-            &ClauseType::System(ref system) => system.name(),
-        }
-    }
-
-    pub fn from(name: ClauseName, arity: usize, spec: Option<SharedOpDesc>) -> Self {
-        CLAUSE_TYPE_FORMS
-            .borrow()
-            .get(&(name.as_str(), arity))
-            .cloned()
-            .unwrap_or_else(|| {
-                SystemClauseType::from(name.as_str(), arity)
-                    .map(ClauseType::System)
-                    .unwrap_or_else(|| {
-                        if let Some(spec) = spec {
-                            ClauseType::Op(name, spec, CodeIndex::default())
-                        } else if name.as_str() == "call" {
-                            ClauseType::CallN
-                        } else {
-                            ClauseType::Named(name, arity, CodeIndex::default())
-                        }
-                    })
-            })
-    }
-}
-
-impl From<InlinedClauseType> for ClauseType {
-    fn from(inlined_ct: InlinedClauseType) -> Self {
-        ClauseType::Inlined(inlined_ct)
-    }
-}

src/debray_allocator.rs

@@ -1,36 +1,40 @@
-use crate::indexmap::IndexMap;
-
-use crate::prolog_parser::ast::*;
+use indexmap::IndexMap;
 
 use crate::allocator::*;
 use crate::fixtures::*;
-use crate::forms::*;
+use crate::forms::Level;
+use crate::instructions::*;
 use crate::machine::machine_indices::*;
-use crate::targets::*;
+use crate::parser::ast::*;
+use crate::targets::CompilationTarget;
+
+use crate::temp_v;
+
+use fxhash::FxBuildHasher;
 
 use std::cell::Cell;
 use std::collections::BTreeSet;
 use std::rc::Rc;
 
 #[derive(Debug)]
-pub struct DebrayAllocator {
-    bindings: IndexMap<Rc<Var>, VarData>,
+pub(crate) struct DebrayAllocator {
+    bindings: IndexMap<Rc<String>, VarData, FxBuildHasher>,
     arg_c: usize,
     temp_lb: usize,
     arity: usize, // 0 if not at head.
-    contents: IndexMap<usize, Rc<Var>>,
+    contents: IndexMap<usize, Rc<String>, FxBuildHasher>,
     in_use: BTreeSet<usize>,
 }
 
 impl DebrayAllocator {
-    fn is_curr_arg_distinct_from(&self, var: &Var) -> bool {
+    fn is_curr_arg_distinct_from(&self, var: &String) -> bool {
         match self.contents.get(&self.arg_c) {
             Some(t_var) if **t_var != *var => true,
             _ => false,
         }
     }
 
-    fn occurs_shallowly_in_head(&self, var: &Var, r: usize) -> bool {
+    fn occurs_shallowly_in_head(&self, var: &String, r: usize) -> bool {
         match self.bindings.get(var).unwrap() {
             &VarData::Temp(_, _, ref tvd) => tvd.use_set.contains(&(GenContext::Head, r)),
             _ => false,
@@ -43,7 +47,7 @@ impl DebrayAllocator {
         in_use_range || self.in_use.contains(&r)
     }
 
-    fn alloc_with_cr(&self, var: &Var) -> usize {
+    fn alloc_with_cr(&self, var: &String) -> usize {
         match self.bindings.get(var) {
             Some(&VarData::Temp(_, _, ref tvd)) => {
                 for &(_, reg) in tvd.use_set.iter() {
@@ -69,7 +73,7 @@ impl DebrayAllocator {
         }
     }
 
-    fn alloc_with_ca(&self, var: &Var) -> usize {
+    fn alloc_with_ca(&self, var: &String) -> usize {
         match self.bindings.get(var) {
             Some(&VarData::Temp(_, _, ref tvd)) => {
                 for &(_, reg) in tvd.use_set.iter() {
@@ -97,7 +101,7 @@ impl DebrayAllocator {
         }
     }
 
-    fn alloc_in_last_goal_hint(&self, chunk_num: usize) -> Option<(Rc<Var>, usize)> {
+    fn alloc_in_last_goal_hint(&self, chunk_num: usize) -> Option<(Rc<String>, usize)> {
         // we want to allocate a register to the k^{th} parameter, par_k.
         // par_k may not be a temporary variable.
         let k = self.arg_c;
@@ -122,10 +126,11 @@ impl DebrayAllocator {
         }
     }
 
-    fn evacuate_arg<'a, Target>(&mut self, chunk_num: usize, target: &mut Vec<Target>)
-    where
-        Target: CompilationTarget<'a>,
-    {
+    fn evacuate_arg<'a, Target: CompilationTarget<'a>>(
+        &mut self,
+        chunk_num: usize,
+        code: &mut Code,
+    ) {
         match self.alloc_in_last_goal_hint(chunk_num) {
             Some((var, r)) => {
                 let k = self.arg_c;
@@ -133,7 +138,7 @@ impl DebrayAllocator {
                 if r != k {
                     let r = RegType::Temp(r);
 
-                    target.push(Target::move_to_register(r, k));
+                    code.push(Target::move_to_register(r, k));
 
                     self.contents.swap_remove(&k);
                     self.contents.insert(r.reg_num(), var.clone());
@@ -146,20 +151,17 @@ impl DebrayAllocator {
         };
     }
 
-    fn alloc_reg_to_var<'a, Target>(
+    fn alloc_reg_to_var<'a, Target: CompilationTarget<'a>>(
         &mut self,
-        var: &Var,
+        var: &String,
         lvl: Level,
         term_loc: GenContext,
-        target: &mut Vec<Target>,
-    ) -> usize
-    where
-        Target: CompilationTarget<'a>,
-    {
+        target: &mut Vec<Instruction>,
+    ) -> usize {
         match term_loc {
             GenContext::Head => {
                 if let Level::Shallow = lvl {
-                    self.evacuate_arg(0, target);
+                    self.evacuate_arg::<Target>(0, target);
                     self.alloc_with_cr(var)
                 } else {
                     self.alloc_with_ca(var)
@@ -168,7 +170,7 @@ impl DebrayAllocator {
             GenContext::Mid(_) => self.alloc_with_ca(var),
             GenContext::Last(chunk_num) => {
                 if let Level::Shallow = lvl {
-                    self.evacuate_arg(chunk_num, target);
+                    self.evacuate_arg::<Target>(chunk_num, target);
                     self.alloc_with_cr(var)
                 } else {
                     self.alloc_with_ca(var)
@@ -192,7 +194,7 @@ impl DebrayAllocator {
         final_index
     }
 
-    fn in_place(&self, var: &Var, term_loc: GenContext, r: RegType, k: usize) -> bool {
+    fn in_place(&self, var: &String, term_loc: GenContext, r: RegType, k: usize) -> bool {
         match term_loc {
             GenContext::Head if !r.is_perm() => r.reg_num() == k,
             _ => match self.bindings().get(var).unwrap() {
@@ -203,49 +205,49 @@ impl DebrayAllocator {
     }
 }
 
-impl<'a> Allocator<'a> for DebrayAllocator {
+impl Allocator for DebrayAllocator {
     fn new() -> DebrayAllocator {
         DebrayAllocator {
             arity: 0,
             arg_c: 1,
             temp_lb: 1,
-            bindings: IndexMap::new(),
-            contents: IndexMap::new(),
+            bindings: IndexMap::with_hasher(FxBuildHasher::default()),
+            contents: IndexMap::with_hasher(FxBuildHasher::default()),
             in_use: BTreeSet::new(),
         }
     }
 
-    fn mark_anon_var<Target>(&mut self, lvl: Level, term_loc: GenContext, target: &mut Vec<Target>)
-    where
-        Target: CompilationTarget<'a>,
-    {
+    fn mark_anon_var<'a, Target: CompilationTarget<'a>>(
+        &mut self,
+        lvl: Level,
+        term_loc: GenContext,
+        code: &mut Code,
+    ) {
         let r = RegType::Temp(self.alloc_reg_to_non_var());
 
         match lvl {
-            Level::Deep => target.push(Target::subterm_to_variable(r)),
+            Level::Deep => code.push(Target::subterm_to_variable(r)),
             Level::Root | Level::Shallow => {
                 let k = self.arg_c;
 
                 if let GenContext::Last(chunk_num) = term_loc {
-                    self.evacuate_arg(chunk_num, target);
+                    self.evacuate_arg::<Target>(chunk_num, code);
                 }
 
                 self.arg_c += 1;
 
-                target.push(Target::argument_to_variable(r, k));
+                code.push(Target::argument_to_variable(r, k));
             }
         };
     }
 
-    fn mark_non_var<Target>(
+    fn mark_non_var<'a, Target: CompilationTarget<'a>>(
         &mut self,
         lvl: Level,
         term_loc: GenContext,
-        cell: &Cell<RegType>,
-        target: &mut Vec<Target>,
-    ) where
-        Target: CompilationTarget<'a>,
-    {
+        cell: &'a Cell<RegType>,
+        code: &mut Code,
+    ) {
         let r = cell.get();
 
         let r = match lvl {
@@ -253,7 +255,7 @@ impl<'a> Allocator<'a> for DebrayAllocator {
                 let k = self.arg_c;
 
                 if let GenContext::Last(chunk_num) = term_loc {
-                    self.evacuate_arg(chunk_num, target);
+                    self.evacuate_arg::<Target>(chunk_num, code);
                 }
 
                 self.arg_c += 1;
@@ -269,20 +271,18 @@ impl<'a> Allocator<'a> for DebrayAllocator {
         cell.set(r);
     }
 
-    fn mark_var<Target>(
+    fn mark_var<'a, Target: CompilationTarget<'a>>(
         &mut self,
-        var: Rc<Var>,
+        var: Rc<String>,
         lvl: Level,
         cell: &'a Cell<VarReg>,
         term_loc: GenContext,
-        target: &mut Vec<Target>,
-    ) where
-        Target: CompilationTarget<'a>,
-    {
+        code: &mut Code,
+    ) {
         let (r, is_new_var) = match self.get(var.clone()) {
             RegType::Temp(0) => {
                 // here, r is temporary *and* unassigned.
-                let o = self.alloc_reg_to_var(&var, lvl, term_loc, target);
+                let o = self.alloc_reg_to_var::<Target>(&var, lvl, term_loc, code);
                 cell.set(VarReg::Norm(RegType::Temp(o)));
 
                 (RegType::Temp(o), true)
@@ -293,32 +293,28 @@ 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);
+        self.mark_reserved_var::<Target>(var, lvl, cell, term_loc, code, r, is_new_var);
     }
 
-    fn mark_reserved_var<Target>(
+    fn mark_reserved_var<'a, Target: CompilationTarget<'a>>(
         &mut self,
-        var: Rc<Var>,
+        var: Rc<String>,
         lvl: Level,
         cell: &'a Cell<VarReg>,
         term_loc: GenContext,
-        target: &mut Vec<Target>,
+        code: &mut Code,
         r: RegType,
         is_new_var: bool,
-    ) where
-        Target: CompilationTarget<'a>,
-    {
+    ) {
         match lvl {
             Level::Root | Level::Shallow => {
                 let k = self.arg_c;
 
                 if self.is_curr_arg_distinct_from(&var) {
-                    self.evacuate_arg(term_loc.chunk_num(), target);
+                    self.evacuate_arg::<Target>(term_loc.chunk_num(), code);
                 }
 
                 self.arg_c += 1;
@@ -327,24 +323,24 @@ impl<'a> Allocator<'a> for DebrayAllocator {
 
                 if !self.in_place(&var, term_loc, r, k) {
                     if is_new_var {
-                        target.push(Target::argument_to_variable(r, k));
+                        code.push(Target::argument_to_variable(r, k));
                     } else {
-                        target.push(Target::argument_to_value(r, k));
+                        code.push(Target::argument_to_value(r, k));
                     }
                 }
             }
             Level::Deep if is_new_var => {
                 if let GenContext::Head = term_loc {
                     if self.occurs_shallowly_in_head(&var, r.reg_num()) {
-                        target.push(Target::subterm_to_value(r));
+                        code.push(Target::subterm_to_value(r));
                     } else {
-                        target.push(Target::subterm_to_variable(r));
+                        code.push(Target::subterm_to_variable(r));
                     }
                 } else {
-                    target.push(Target::subterm_to_variable(r));
+                    code.push(Target::subterm_to_variable(r));
                 }
             }
-            Level::Deep => target.push(Target::subterm_to_value(r)),
+            Level::Deep => code.push(Target::subterm_to_value(r)),
         };
 
         if !r.is_perm() {
@@ -383,12 +379,12 @@ impl<'a> Allocator<'a> for DebrayAllocator {
         self.bindings
     }
 
-    fn reset_at_head(&mut self, args: &Vec<Box<Term>>) {
+    fn reset_at_head(&mut self, args: &Vec<Term>) {
         self.reset_arg(args.len());
         self.arity = args.len();
 
         for (idx, arg) in args.iter().enumerate() {
-            if let &Term::Var(_, ref var) = arg.as_ref() {
+            if let &Term::Var(_, ref var) = arg {
                 let r = self.get(var.clone());
 
                 if !r.is_perm() && r.reg_num() == 0 {
@@ -405,4 +401,9 @@ impl<'a> Allocator<'a> for DebrayAllocator {
         self.arg_c = 1;
         self.temp_lb = arity + 1;
     }
+
+    #[inline(always)]
+    fn max_reg_allocated(&self) -> usize {
+        std::cmp::max(self.temp_lb, self.arg_c)
+    }
 }

src/examples/bimetatrans/bimetatrans_tests.pl

@@ -1,6 +1,6 @@
-:- module(bimetatran_tests, [test_bimetatrans/0]).
+:- module(bimetatrans_tests, [test_bimetatrans/0]).
 
-:- use_module('bimetatrans').
+:- use_module(bimetatrans).
 
 :- use_module(library(dcgs)).
 :- use_module(library(iso_ext)).
@@ -21,28 +21,6 @@
  * order of ascending N.
  */
 
-term_expansion(Term0, Term) :-
-    nonvar(Term0),
-    Term0 = test(N, Assert, Query, XML),
-    integer(N),
-    list_si(Assert),
-    list_si(Query),
-    partial_string(XML),
-    number_chars(N, NChars),
-    atom_chars(NAtom, NChars),
-    atom_concat(prolog2ruleml_, NAtom, Prolog2RuleML),
-    atom_concat(ruleml2prolog_, NAtom, RuleML2Prolog),
-    atom_concat(test_, NAtom, TestN),
-    strip_indentation(XML, XML1),
-    Term = [(Prolog2RuleML :- parse_ruleml(Assert, Query, XML0),
-                              XML0 = XML1),
-            (RuleML2Prolog :- parse_ruleml(Assert0, Query0, XML),
-                              Assert0 = Assert,
-                              Query0 = Query),
-            (TestN :- write(test(N)), nl, Prolog2RuleML, RuleML2Prolog, !),
-            (TestN :- throw(error(test_failure, TestN)))].
-
-
 until_non_space_or_end([C|Cs], Cs1) :-
     (  C == (' ') ->
        until_non_space_or_end(Cs, Cs1)
@@ -66,6 +44,28 @@ strip_indentation_([C|Cs], Cs0) :-
 strip_indentation_([], []).
 
 
+user:term_expansion(Term0, Term) :-
+    nonvar(Term0),
+    Term0 = test(N, Assert, Query, XML),
+    integer(N),
+    list_si(Assert),
+    list_si(Query),
+    partial_string(XML),
+    number_chars(N, NChars),
+    atom_chars(NAtom, NChars),
+    atom_concat(prolog2ruleml_, NAtom, Prolog2RuleML),
+    atom_concat(ruleml2prolog_, NAtom, RuleML2Prolog),
+    atom_concat(test_, NAtom, TestN),
+    strip_indentation(XML, XML1),
+    Term = [(Prolog2RuleML :- parse_ruleml(Assert, Query, XML0),
+                              XML0 = XML1),
+            (RuleML2Prolog :- parse_ruleml(Assert0, Query0, XML),
+                              Assert0 = Assert,
+                              Query0 = Query),
+            (TestN :- write(test(N)), nl, Prolog2RuleML, RuleML2Prolog, !),
+            (TestN :- throw(error(test_failure, TestN)))].
+
+
 test(1,
      [people('Alex',male),people('Alex',female),people('Siri',female)],
      [],

src/examples/least_time.pl

@@ -11,7 +11,7 @@
  */
 
 :- module(least_time, [find_min_time/2,
-		               write_time_nl/1]).
+                       write_time_nl/1]).
 
 
 :- use_module(library(dcgs)).
@@ -20,12 +20,6 @@
 :- use_module(library(reif)).
 
 
-permutation([], []).
-permutation([X|Xs], Ys) :-
-    permutation(Xs, Yss),
-    select(X, Ys, Yss).
-
-
 valid_time([H1,H2,M1,M2], T) :-
     memberd_t(H1, [0,1,2], TH1),
     memberd_t(H2, [0,1,2,3,4,5,6,7,8,9], TH2),
@@ -33,10 +27,10 @@ valid_time([H1,H2,M1,M2], T) :-
     memberd_t(M2, [0,1,2,3,4,5,6,7,8,9], TM2),
     (  maplist(=(true), [TH1, TH2, TM1, TM2]) ->
        (  H1 =:= 2 ->
-	      (  H2 =< 3 ->
-	         T = true
-	      ;  T = false
-	      )
+          (  H2 =< 3 ->
+             T = true
+          ;  T = false
+          )
        ;  T = true
        )
     ;  T = false

src/fixtures.rs

@@ -1,10 +1,10 @@
-use crate::prolog_parser::ast::*;
+use crate::parser::ast::*;
 
 use crate::forms::*;
 use crate::instructions::*;
 use crate::iterators::*;
 
-use crate::indexmap::{IndexMap, IndexSet};
+use indexmap::{IndexMap, IndexSet};
 
 use std::cell::Cell;
 use std::collections::BTreeSet;
@@ -14,23 +14,23 @@ use std::vec::Vec;
 
 // labeled with chunk numbers.
 #[derive(Debug)]
-pub enum VarStatus {
+pub(crate) enum VarStatus {
     Perm(usize),
     Temp(usize, TempVarData), // Perm(chunk_num) | Temp(chunk_num, _)
 }
 
-pub type OccurrenceSet = BTreeSet<(GenContext, usize)>;
+pub(crate) 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 {
+pub(crate) enum VarData {
     Perm(usize),
     Temp(usize, usize, TempVarData),
 }
 
 impl VarData {
-    pub fn as_reg_type(&self) -> RegType {
+    pub(crate) fn as_reg_type(&self) -> RegType {
         match self {
             &VarData::Temp(_, r, _) => RegType::Temp(r),
             &VarData::Perm(r) => RegType::Perm(r),
@@ -39,15 +39,15 @@ impl VarData {
 }
 
 #[derive(Debug)]
-pub struct TempVarData {
-    pub last_term_arity: usize,
-    pub use_set: OccurrenceSet,
-    pub no_use_set: BTreeSet<usize>,
-    pub conflict_set: BTreeSet<usize>,
+pub(crate) struct TempVarData {
+    pub(crate) last_term_arity: usize,
+    pub(crate) use_set: OccurrenceSet,
+    pub(crate) no_use_set: BTreeSet<usize>,
+    pub(crate) conflict_set: BTreeSet<usize>,
 }
 
 impl TempVarData {
-    pub fn new(last_term_arity: usize) -> Self {
+    pub(crate) fn new(last_term_arity: usize) -> Self {
         TempVarData {
             last_term_arity: last_term_arity,
             use_set: BTreeSet::new(),
@@ -56,7 +56,7 @@ impl TempVarData {
         }
     }
 
-    pub fn uses_reg(&self, reg: usize) -> bool {
+    pub(crate) fn uses_reg(&self, reg: usize) -> bool {
         for &(_, nreg) in self.use_set.iter() {
             if reg == nreg {
                 return true;
@@ -66,7 +66,7 @@ impl TempVarData {
         return false;
     }
 
-    pub fn populate_conflict_set(&mut self) {
+    pub(crate) fn populate_conflict_set(&mut self) {
         if self.last_term_arity > 0 {
             let arity = self.last_term_arity;
             let mut conflict_set: BTreeSet<usize> = (1..arity).collect();
@@ -83,30 +83,29 @@ 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>>
+pub(crate) struct VariableFixtures<'a> {
+    perm_vars: IndexMap<Rc<String>, VariableFixture<'a>>,
+    last_chunk_temp_vars: IndexSet<Rc<String>>,
 }
 
 impl<'a> VariableFixtures<'a> {
-    pub fn new() -> Self {
+    pub(crate) fn new() -> Self {
         VariableFixtures {
             perm_vars: IndexMap::new(),
-            last_chunk_temp_vars: IndexSet::new()
+            last_chunk_temp_vars: IndexSet::new(),
         }
-
     }
 
-    pub fn insert(&mut self, var: Rc<Var>, vs: VariableFixture<'a>) {
+    pub(crate) fn insert(&mut self, var: Rc<String>, vs: VariableFixture<'a>) {
         self.perm_vars.insert(var, vs);
     }
 
-    pub fn insert_last_chunk_temp_var(&mut self, var: Rc<Var>) {
+    pub(crate) fn insert_last_chunk_temp_var(&mut self, var: Rc<String>) {
         self.last_chunk_temp_vars.insert(var);
     }
 
     // computes no_use and conflict sets for all temp vars.
-    pub fn populate_restricting_sets(&mut self) {
+    pub(crate) fn populate_restricting_sets(&mut self) {
         // three stages:
         // 1. move the use sets of each variable to a local IndexMap, use_set
         // (iterate mutably, swap mutable refs).
@@ -116,7 +115,7 @@ impl<'a> VariableFixtures<'a> {
         // Compute the conflict set of u.
 
         // 1.
-        let mut use_sets: IndexMap<Rc<Var>, OccurrenceSet> = IndexMap::new();
+        let mut use_sets: IndexMap<Rc<String>, OccurrenceSet> = IndexMap::new();
 
         for (var, &mut (ref mut var_status, _)) in self.iter_mut() {
             if let &mut VarStatus::Temp(_, ref mut var_data) = var_status {
@@ -154,11 +153,11 @@ impl<'a> VariableFixtures<'a> {
         }
     }
 
-    fn get_mut(&mut self, u: Rc<Var>) -> Option<&mut VariableFixture<'a>> {
+    fn get_mut(&mut self, u: Rc<String>) -> Option<&mut VariableFixture<'a>> {
         self.perm_vars.get_mut(&u)
     }
 
-    fn iter_mut(&mut self) -> indexmap::map::IterMut<Rc<Var>, VariableFixture<'a>> {
+    fn iter_mut(&mut self) -> indexmap::map::IterMut<Rc<String>, VariableFixture<'a>> {
         self.perm_vars.iter_mut()
     }
 
@@ -171,7 +170,7 @@ impl<'a> VariableFixtures<'a> {
         };
     }
 
-    pub fn vars_above_threshold(&self, index: usize) -> usize {
+    pub(crate) fn vars_above_threshold(&self, index: usize) -> usize {
         let mut var_count = 0;
 
         for &(ref var_status, _) in self.values() {
@@ -185,7 +184,7 @@ impl<'a> VariableFixtures<'a> {
         var_count
     }
 
-    pub fn mark_vars_in_chunk<I>(&mut self, iter: I, lt_arity: usize, term_loc: GenContext)
+    pub(crate) fn mark_vars_in_chunk<I>(&mut self, iter: I, lt_arity: usize, term_loc: GenContext)
     where
         I: Iterator<Item = TermRef<'a>>,
     {
@@ -219,19 +218,19 @@ impl<'a> VariableFixtures<'a> {
         }
     }
 
-    pub fn into_iter(self) -> indexmap::map::IntoIter<Rc<Var>, VariableFixture<'a>> {
+    pub(crate) fn into_iter(self) -> indexmap::map::IntoIter<Rc<String>, VariableFixture<'a>> {
         self.perm_vars.into_iter()
     }
 
-    fn values(&self) -> indexmap::map::Values<Rc<Var>, VariableFixture<'a>> {
+    fn values(&self) -> indexmap::map::Values<Rc<String>, VariableFixture<'a>> {
         self.perm_vars.values()
     }
 
-    pub fn size(&self) -> usize {
+    pub(crate) fn size(&self) -> usize {
         self.perm_vars.len()
     }
 
-    pub fn set_perm_vals(&self, has_deep_cuts: bool) {
+    pub(crate) fn set_perm_vals(&self, has_deep_cuts: bool) {
         let mut values_vec: Vec<_> = self
             .values()
             .filter_map(|ref v| match &v.0 {
@@ -253,43 +252,41 @@ impl<'a> VariableFixtures<'a> {
 }
 
 #[derive(Debug)]
-pub struct UnsafeVarMarker {
-    pub unsafe_vars: IndexMap<RegType, usize>,
-    pub safe_vars: IndexSet<RegType>,
+pub(crate) struct UnsafeVarMarker {
+    pub(crate) unsafe_vars: IndexMap<RegType, usize>,
+    pub(crate) safe_vars: IndexSet<RegType>,
 }
 
 impl UnsafeVarMarker {
-    pub fn new() -> Self {
+    pub(crate) fn new() -> Self {
         UnsafeVarMarker {
             unsafe_vars: IndexMap::new(),
-            safe_vars: IndexSet::new()
+            safe_vars: IndexSet::new(),
         }
     }
 
-    pub fn from_safe_vars(safe_vars: IndexSet<RegType>) -> Self {
+    pub(crate) fn from_safe_vars(safe_vars: IndexSet<RegType>) -> Self {
         UnsafeVarMarker {
             unsafe_vars: IndexMap::new(),
-            safe_vars
+            safe_vars,
         }
     }
 
-    pub fn mark_safe_vars(&mut self, query_instr: &QueryInstruction) -> bool {
+    pub(crate) fn mark_safe_vars(&mut self, query_instr: &Instruction) -> bool {
         match query_instr {
-            &QueryInstruction::PutVariable(r @ RegType::Temp(_), _)
-          | &QueryInstruction::SetVariable(r) =>  {
+            &Instruction::PutVariable(r @ RegType::Temp(_), _) |
+            &Instruction::SetVariable(r) => {
                 self.safe_vars.insert(r);
                 true
             }
-            _ => {
-                false
-            }
+            _ => false,
         }
     }
 
-    pub fn mark_phase(&mut self, query_instr: &QueryInstruction, phase: usize) {
+    pub(crate) fn mark_phase(&mut self, query_instr: &Instruction, phase: usize) {
         match query_instr {
-            &QueryInstruction::PutValue(r @ RegType::Perm(_), _)
-          | &QueryInstruction::SetValue(r) => {
+            &Instruction::PutValue(r @ RegType::Perm(_), _) |
+            &Instruction::SetValue(r) => {
                 let p = self.unsafe_vars.entry(r).or_insert(0);
                 *p = phase;
             }
@@ -297,21 +294,21 @@ impl UnsafeVarMarker {
         }
     }
 
-    pub fn mark_unsafe_vars(&mut self, query_instr: &mut QueryInstruction, phase: usize) {
+    pub(crate) fn mark_unsafe_vars(&mut self, query_instr: &mut Instruction, phase: usize) {
         match query_instr {
-            &mut QueryInstruction::PutValue(RegType::Perm(i), arg) => {
+            &mut Instruction::PutValue(RegType::Perm(i), arg) => {
                 if let Some(p) = self.unsafe_vars.swap_remove(&RegType::Perm(i)) {
                     if p == phase {
-                        *query_instr = QueryInstruction::PutUnsafeValue(i, arg);
+                        *query_instr = Instruction::PutUnsafeValue(i, arg);
                         self.safe_vars.insert(RegType::Perm(i));
                     } else {
                         self.unsafe_vars.insert(RegType::Perm(i), p);
                     }
                 }
             }
-            &mut QueryInstruction::SetValue(r) => {
+            &mut Instruction::SetValue(r) => {
                 if !self.safe_vars.contains(&r) {
-                    *query_instr = QueryInstruction::SetLocalValue(r);
+                    *query_instr = Instruction::SetLocalValue(r);
 
                     self.safe_vars.insert(r);
                     self.unsafe_vars.remove(&r);

src/http.rs

@@ -0,0 +1,25 @@
+use std::sync::Arc;
+use std::convert::Infallible;
+
+use hyper::{Response, Request, Body};
+use tokio::sync::Mutex;
+use tokio::sync::mpsc::{channel, Receiver, Sender};
+
+pub struct HttpListener {
+    pub incoming: Receiver<HttpRequest>
+}
+
+#[derive(Debug)]
+pub struct HttpRequest {
+    pub request: Request<Body>,
+    pub response: HttpResponse,
+}
+
+pub type HttpResponse = Sender<Response<Body>>;
+
+pub async fn serve_req(req: Request<Body>, tx: Arc<Mutex<Sender<HttpRequest>>>) -> Result<Response<Body>, Infallible> {
+    let (response_tx, mut rx) = channel(1);
+    let http_request = HttpRequest { request: req, response: response_tx };
+    tx.lock().await.send(http_request).await.unwrap();
+    Ok(rx.recv().await.unwrap())
+}

src/instructions.rs

@@ -1,713 +0,0 @@
-use crate::prolog_parser::ast::*;
-
-use crate::clause_types::*;
-use crate::forms::*;
-use crate::machine::heap::*;
-use crate::machine::machine_errors::MachineStub;
-use crate::machine::machine_indices::*;
-use crate::rug::Integer;
-
-use crate::indexmap::IndexMap;
-
-use std::collections::VecDeque;
-use std::rc::Rc;
-
-fn reg_type_into_functor(r: RegType) -> MachineStub {
-    match r {
-        RegType::Temp(r) => functor!("x", [integer(r)]),
-        RegType::Perm(r) => functor!("y", [integer(r)]),
-    }
-}
-
-impl Level {
-    fn into_functor(self) -> MachineStub {
-        match self {
-            Level::Root => functor!("level", [atom("root")]),
-            Level::Shallow => functor!("level", [atom("shallow")]),
-            Level::Deep => functor!("level", [atom("deep")]),
-        }
-    }
-}
-
-impl ArithmeticTerm {
-    fn into_functor(&self) -> MachineStub {
-        match self {
-            &ArithmeticTerm::Reg(r) => {
-                reg_type_into_functor(r)
-            }
-            &ArithmeticTerm::Interm(i) => {
-                functor!("intermediate", [integer(i)])
-            }
-            &ArithmeticTerm::Number(ref n) => {
-                vec![n.clone().into()]
-            }
-        }
-    }
-}
-
-#[derive(Debug)]
-pub enum ChoiceInstruction {
-    DefaultRetryMeElse(usize),
-    DefaultTrustMe,
-    RetryMeElse(usize),
-    TrustMe,
-    TryMeElse(usize),
-}
-
-impl ChoiceInstruction {
-    pub fn to_functor(&self) -> MachineStub {
-        match self {
-            &ChoiceInstruction::TryMeElse(offset) => {
-                functor!("try_me_else", [integer(offset)])
-            }
-            &ChoiceInstruction::RetryMeElse(offset) => {
-                functor!("retry_me_else", [integer(offset)])
-            }
-            &ChoiceInstruction::TrustMe => {
-                functor!("trust_me")
-            }
-            &ChoiceInstruction::DefaultRetryMeElse(offset) => {
-                functor!("default_retry_me_else", [integer(offset)])
-            }
-            &ChoiceInstruction::DefaultTrustMe => {
-                functor!("default_trust_me")
-            }
-        }
-    }
-}
-
-#[derive(Debug)]
-pub enum CutInstruction {
-    Cut(RegType),
-    GetLevel(RegType),
-    GetLevelAndUnify(RegType),
-    NeckCut,
-}
-
-impl CutInstruction {
-    pub fn to_functor(&self, h: usize) -> MachineStub {
-        match self {
-            &CutInstruction::Cut(r) => {
-                let rt_stub = reg_type_into_functor(r);
-                functor!("cut", [aux(h, 0)], [rt_stub])
-            }
-            &CutInstruction::GetLevel(r) => {
-                let rt_stub = reg_type_into_functor(r);
-                functor!("get_level", [aux(h, 0)], [rt_stub])
-            }
-            &CutInstruction::GetLevelAndUnify(r) => {
-                let rt_stub = reg_type_into_functor(r);
-                functor!("get_level_and_unify", [aux(h, 0)], [rt_stub])
-            }
-            &CutInstruction::NeckCut => {
-                functor!("neck_cut")
-            }
-        }
-    }
-}
-
-#[derive(Debug)]
-pub enum IndexedChoiceInstruction {
-    Retry(usize),
-    Trust(usize),
-    Try(usize),
-}
-
-impl From<IndexedChoiceInstruction> for Line {
-    fn from(i: IndexedChoiceInstruction) -> Self {
-        Line::IndexedChoice(i)
-    }
-}
-
-impl IndexedChoiceInstruction {
-    pub fn offset(&self) -> usize {
-        match self {
-            &IndexedChoiceInstruction::Retry(offset) => offset,
-            &IndexedChoiceInstruction::Trust(offset) => offset,
-            &IndexedChoiceInstruction::Try(offset) => offset,
-        }
-    }
-
-    pub fn to_functor(&self) -> MachineStub {
-        match self {
-            &IndexedChoiceInstruction::Try(offset) => {
-                functor!("try", [integer(offset)])
-            }
-            &IndexedChoiceInstruction::Trust(offset) => {
-                functor!("trust", [integer(offset)])
-            }
-            &IndexedChoiceInstruction::Retry(offset) => {
-                functor!("retry", [integer(offset)])
-            }
-        }
-    }
-}
-
-#[derive(Debug)]
-pub enum Line {
-    Arithmetic(ArithmeticInstruction),
-    Choice(ChoiceInstruction),
-    Control(ControlInstruction),
-    Cut(CutInstruction),
-    Fact(FactInstruction),
-    Indexing(IndexingInstruction),
-    IndexedChoice(IndexedChoiceInstruction),
-    Query(QueryInstruction),
-}
-
-impl Line {
-    pub fn is_head_instr(&self) -> bool {
-        match self {
-            &Line::Cut(_) => true,
-            &Line::Fact(_) => true,
-            &Line::Query(_) => true,
-            _ => false,
-        }
-    }
-
-    pub fn to_functor(&self, h: usize) -> MachineStub {
-        match self {
-            &Line::Arithmetic(ref arith_instr) => arith_instr.to_functor(h),
-            &Line::Choice(ref choice_instr) => choice_instr.to_functor(),
-            &Line::Control(ref control_instr) => control_instr.to_functor(),
-            &Line::Cut(ref cut_instr) => cut_instr.to_functor(h),
-            &Line::Fact(ref fact_instr) => fact_instr.to_functor(h),
-            &Line::Indexing(ref indexing_instr) => indexing_instr.to_functor(),
-            &Line::IndexedChoice(ref indexed_choice_instr) => indexed_choice_instr.to_functor(),
-            &Line::Query(ref query_instr) => query_instr.to_functor(h),
-        }
-    }
-}
-
-#[derive(Debug, Clone)]
-pub enum ArithmeticInstruction {
-    Add(ArithmeticTerm, ArithmeticTerm, usize),
-    Sub(ArithmeticTerm, ArithmeticTerm, usize),
-    Mul(ArithmeticTerm, ArithmeticTerm, usize),
-    Pow(ArithmeticTerm, ArithmeticTerm, usize),
-    IntPow(ArithmeticTerm, ArithmeticTerm, usize),
-    IDiv(ArithmeticTerm, ArithmeticTerm, usize),
-    Max(ArithmeticTerm, ArithmeticTerm, usize),
-    Min(ArithmeticTerm, ArithmeticTerm, usize),
-    IntFloorDiv(ArithmeticTerm, ArithmeticTerm, usize),
-    RDiv(ArithmeticTerm, ArithmeticTerm, usize),
-    Div(ArithmeticTerm, ArithmeticTerm, usize),
-    Shl(ArithmeticTerm, ArithmeticTerm, usize),
-    Shr(ArithmeticTerm, ArithmeticTerm, usize),
-    Xor(ArithmeticTerm, ArithmeticTerm, usize),
-    And(ArithmeticTerm, ArithmeticTerm, usize),
-    Or(ArithmeticTerm, ArithmeticTerm, usize),
-    Mod(ArithmeticTerm, ArithmeticTerm, usize),
-    Rem(ArithmeticTerm, ArithmeticTerm, usize),
-    Gcd(ArithmeticTerm, ArithmeticTerm, usize),
-    Sign(ArithmeticTerm, usize),
-    Cos(ArithmeticTerm, usize),
-    Sin(ArithmeticTerm, usize),
-    Tan(ArithmeticTerm, usize),
-    Log(ArithmeticTerm, usize),
-    Exp(ArithmeticTerm, usize),
-    ACos(ArithmeticTerm, usize),
-    ASin(ArithmeticTerm, usize),
-    ATan(ArithmeticTerm, usize),
-    ATan2(ArithmeticTerm, ArithmeticTerm, usize),
-    Sqrt(ArithmeticTerm, usize),
-    Abs(ArithmeticTerm, usize),
-    Float(ArithmeticTerm, usize),
-    Truncate(ArithmeticTerm, usize),
-    Round(ArithmeticTerm, usize),
-    Ceiling(ArithmeticTerm, usize),
-    Floor(ArithmeticTerm, usize),
-    Neg(ArithmeticTerm, usize),
-    Plus(ArithmeticTerm, usize),
-    BitwiseComplement(ArithmeticTerm, usize),
-}
-
-fn arith_instr_unary_functor(
-    h: usize,
-    name: &'static str,
-    at: &ArithmeticTerm,
-    t: usize,
-) -> MachineStub {
-    let at_stub = at.into_functor();
-
-    functor!(
-        name,
-        [aux(h, 0), integer(t)],
-        [at_stub]
-    )
-}
-
-fn arith_instr_bin_functor(
-    h: usize,
-    name: &'static str,
-    at_1: &ArithmeticTerm,
-    at_2: &ArithmeticTerm,
-    t: usize,
-) -> MachineStub {
-    let at_1_stub = at_1.into_functor();
-    let at_2_stub = at_2.into_functor();
-
-    functor!(
-        name,
-        [aux(h, 0), aux(h, 1), integer(t)],
-        [at_1_stub, at_2_stub]
-    )
-}
-
-impl ArithmeticInstruction {
-    pub fn to_functor(&self, h: usize) -> MachineStub {
-        match self {
-            &ArithmeticInstruction::Add(ref at_1, ref at_2, t) => {
-                arith_instr_bin_functor(h, "add", at_1, at_2, t)
-            }
-            &ArithmeticInstruction::Sub(ref at_1, ref at_2, t) => {
-                arith_instr_bin_functor(h, "sub", at_1, at_2, t)
-            }
-            &ArithmeticInstruction::Mul(ref at_1, ref at_2, t) => {
-                arith_instr_bin_functor(h, "mul", at_1, at_2, t)
-            }
-            &ArithmeticInstruction::IntPow(ref at_1, ref at_2, t) => {
-                arith_instr_bin_functor(h, "int_pow", at_1, at_2, t)
-            }
-            &ArithmeticInstruction::Pow(ref at_1, ref at_2, t) => {
-                arith_instr_bin_functor(h, "pow", at_1, at_2, t)
-            }
-            &ArithmeticInstruction::IDiv(ref at_1, ref at_2, t) => {
-                arith_instr_bin_functor(h, "idiv", at_1, at_2, t)
-            }
-            &ArithmeticInstruction::Max(ref at_1, ref at_2, t) => {
-                arith_instr_bin_functor(h, "max", at_1, at_2, t)
-            }
-            &ArithmeticInstruction::Min(ref at_1, ref at_2, t) => {
-                arith_instr_bin_functor(h, "min", at_1, at_2, t)
-            }
-            &ArithmeticInstruction::IntFloorDiv(ref at_1, ref at_2, t) => {
-                arith_instr_bin_functor(h, "int_floor_div", at_1, at_2, t)
-            }
-            &ArithmeticInstruction::RDiv(ref at_1, ref at_2, t) => {
-                arith_instr_bin_functor(h, "rdiv", at_1, at_2, t)
-            }
-            &ArithmeticInstruction::Div(ref at_1, ref at_2, t) => {
-                arith_instr_bin_functor(h, "div", at_1, at_2, t)
-            }
-            &ArithmeticInstruction::Shl(ref at_1, ref at_2, t) => {
-                arith_instr_bin_functor(h, "shl", at_1, at_2, t)
-            }
-            &ArithmeticInstruction::Shr(ref at_1, ref at_2, t) => {
-                arith_instr_bin_functor(h, "shr", at_1, at_2, t)
-            }
-            &ArithmeticInstruction::Xor(ref at_1, ref at_2, t) => {
-                arith_instr_bin_functor(h, "xor", at_1, at_2, t)
-            }
-            &ArithmeticInstruction::And(ref at_1, ref at_2, t) => {
-                arith_instr_bin_functor(h, "and", at_1, at_2, t)
-            }
-            &ArithmeticInstruction::Or(ref at_1, ref at_2, t) => {
-                arith_instr_bin_functor(h, "or", at_1, at_2, t)
-            }
-            &ArithmeticInstruction::Mod(ref at_1, ref at_2, t) => {
-                arith_instr_bin_functor(h, "mod", at_1, at_2, t)
-            }
-            &ArithmeticInstruction::Rem(ref at_1, ref at_2, t) => {
-                arith_instr_bin_functor(h, "rem", at_1, at_2, t)
-            }
-            &ArithmeticInstruction::ATan2(ref at_1, ref at_2, t) => {
-                arith_instr_bin_functor(h, "rem", at_1, at_2, t)
-            }
-            &ArithmeticInstruction::Gcd(ref at_1, ref at_2, t) => {
-                arith_instr_bin_functor(h, "gcd", at_1, at_2, t)
-            }
-            &ArithmeticInstruction::Sign(ref at, t) => {
-                arith_instr_unary_functor(h, "sign", at, t)
-            }
-            &ArithmeticInstruction::Cos(ref at, t)  => {
-                arith_instr_unary_functor(h, "cos", at, t)
-            }
-            &ArithmeticInstruction::Sin(ref at, t)  => {
-                arith_instr_unary_functor(h, "sin", at, t)
-            }
-            &ArithmeticInstruction::Tan(ref at, t)  => {
-                arith_instr_unary_functor(h, "tan", at, t)
-            }
-            &ArithmeticInstruction::Log(ref at, t)  => {
-                arith_instr_unary_functor(h, "log", at, t)
-            }
-            &ArithmeticInstruction::Exp(ref at, t)  => {
-                arith_instr_unary_functor(h, "exp", at, t)
-            }
-            &ArithmeticInstruction::ACos(ref at, t) => {
-                arith_instr_unary_functor(h, "acos", at, t)
-            }
-            &ArithmeticInstruction::ASin(ref at, t) => {
-                arith_instr_unary_functor(h, "asin", at, t)
-            }
-            &ArithmeticInstruction::ATan(ref at, t) => {
-                arith_instr_unary_functor(h, "atan", at, t)
-            }
-            &ArithmeticInstruction::Sqrt(ref at, t) => {
-                arith_instr_unary_functor(h, "sqrt", at, t)
-            }
-            &ArithmeticInstruction::Abs(ref at, t) => {
-                arith_instr_unary_functor(h, "abs", at, t)
-            }
-            &ArithmeticInstruction::Float(ref at, t) => {
-                arith_instr_unary_functor(h, "float", at, t)
-            }
-            &ArithmeticInstruction::Truncate(ref at, t) => {
-                arith_instr_unary_functor(h, "truncate", at, t)
-            }
-            &ArithmeticInstruction::Round(ref at, t) => {
-                arith_instr_unary_functor(h, "round", at, t)
-            }
-            &ArithmeticInstruction::Ceiling(ref at, t) => {
-                arith_instr_unary_functor(h, "ceiling", at, t)
-            }
-            &ArithmeticInstruction::Floor(ref at, t) => {
-                arith_instr_unary_functor(h, "floor", at, t)
-            }
-            &ArithmeticInstruction::Neg(ref at, t) => {
-                arith_instr_unary_functor(h, "-", at, t)
-            }
-            &ArithmeticInstruction::Plus(ref at, t) => {
-                arith_instr_unary_functor(h, "+", at, t)
-            }
-            &ArithmeticInstruction::BitwiseComplement(ref at, t) => {
-                arith_instr_unary_functor(h, "\\", at, t)
-            }
-        }
-    }
-}
-
-#[derive(Debug)]
-pub enum ControlInstruction {
-    Allocate(usize), // num_frames.
-    // name, arity, perm_vars after threshold, last call, use default call policy.
-    CallClause(ClauseType, usize, usize, bool, bool),
-    Deallocate,
-    JmpBy(usize, usize, usize, bool), // arity, global_offset, perm_vars after threshold, last call.
-    Proceed,
-}
-
-impl ControlInstruction {
-    pub fn perm_vars(&self) -> Option<usize> {
-        match self {
-            ControlInstruction::CallClause(_, _, num_cells, ..) =>
-                Some(*num_cells),
-            ControlInstruction::JmpBy(_, _, num_cells, ..) =>
-                Some(*num_cells),
-            _ =>
-                None
-        }
-    }
-
-    pub fn to_functor(&self) -> MachineStub {
-        match self {
-            &ControlInstruction::Allocate(num_frames) => {
-                functor!("allocate", [integer(num_frames)])
-            }
-            &ControlInstruction::CallClause(ref ct, arity, _, false, _) => {
-                functor!("call", [clause_name(ct.name()), integer(arity)])
-            }
-            &ControlInstruction::CallClause(ref ct, arity, _, true, _) => {
-                functor!("execute", [clause_name(ct.name()), integer(arity)])
-            }
-            &ControlInstruction::Deallocate => {
-                functor!("deallocate")
-            }
-            &ControlInstruction::JmpBy(_, offset, ..) => {
-                functor!("jmp_by", [integer(offset)])
-            }
-            &ControlInstruction::Proceed => {
-                functor!("proceed")
-            }
-        }
-    }
-}
-
-#[derive(Debug)]
-pub enum IndexingInstruction {
-    SwitchOnTerm(usize, usize, usize, usize),
-    SwitchOnConstant(usize, IndexMap<Constant, usize>),
-    SwitchOnStructure(usize, IndexMap<(ClauseName, usize), usize>),
-}
-
-impl From<IndexingInstruction> for Line {
-    fn from(i: IndexingInstruction) -> Self {
-        Line::Indexing(i)
-    }
-}
-
-impl IndexingInstruction {
-    pub fn to_functor(&self) -> MachineStub {
-        match self {
-            &IndexingInstruction::SwitchOnTerm(vars, constants, lists, structures) => {
-                functor!(
-                    "switch_on_term",
-                    [integer(vars),
-                     integer(constants),
-                     integer(lists),
-                     integer(structures)]
-                )
-            }
-            &IndexingInstruction::SwitchOnConstant(constants, _) => {
-                functor!(
-                    "switch_on_constant",
-                    [integer(constants)]
-                )
-            }
-            &IndexingInstruction::SwitchOnStructure(structures, _) => {
-                functor!(
-                    "switch_on_structure",
-                    [integer(structures)]
-                )
-            }
-        }
-    }
-}
-
-#[derive(Debug, Clone)]
-pub enum FactInstruction {
-    GetConstant(Level, Constant, RegType),
-    GetList(Level, RegType),
-    GetPartialString(Level, String, RegType, bool),
-    GetStructure(ClauseType, usize, RegType),
-    GetValue(RegType, usize),
-    GetVariable(RegType, usize),
-    UnifyConstant(Constant),
-    UnifyLocalValue(RegType),
-    UnifyVariable(RegType),
-    UnifyValue(RegType),
-    UnifyVoid(usize),
-}
-
-impl FactInstruction {
-    pub fn to_functor(&self, h: usize) -> MachineStub {
-        match self {
-            &FactInstruction::GetConstant(lvl, ref c, r) => {
-                let lvl_stub = lvl.into_functor();
-                let rt_stub  = reg_type_into_functor(r);
-
-                functor!(
-                    "get_constant",
-                    [aux(h, 0), constant(h, c), aux(h, 1)],
-                    [lvl_stub, rt_stub]
-                )
-            }
-            &FactInstruction::GetList(lvl, r) => {
-                let lvl_stub = lvl.into_functor();
-                let rt_stub  = reg_type_into_functor(r);
-
-                functor!(
-                    "get_list",
-                    [aux(h, 0), aux(h, 1)],
-                    [lvl_stub, rt_stub]
-                )
-            }
-            &FactInstruction::GetPartialString(lvl, ref s, r, has_tail) => {
-                let lvl_stub = lvl.into_functor();
-                let rt_stub  = reg_type_into_functor(r);
-
-                functor!(
-                    "get_partial_string",
-                    [aux(h, 0), string(h, s), aux(h, 1), boolean(has_tail)],
-                    [lvl_stub, rt_stub]
-                )
-            }
-            &FactInstruction::GetStructure(ref ct, arity, r) => {
-                let rt_stub = reg_type_into_functor(r);
-
-                functor!(
-                    "get_structure",
-                    [clause_name(ct.name()), integer(arity), aux(h, 0)],
-                    [rt_stub]
-                )
-            }
-            &FactInstruction::GetValue(r, arg) => {
-                let rt_stub = reg_type_into_functor(r);
-
-                functor!(
-                    "get_value",
-                    [aux(h, 0), integer(arg)],
-                    [rt_stub]
-                )
-            }
-            &FactInstruction::GetVariable(r, arg) => {
-                let rt_stub = reg_type_into_functor(r);
-
-                functor!(
-                    "get_variable",
-                    [aux(h, 0), integer(arg)],
-                    [rt_stub]
-                )
-            }
-            &FactInstruction::UnifyConstant(ref c) => {
-                functor!("unify_constant", [constant(h, c)], [])
-            }
-            &FactInstruction::UnifyLocalValue(r) => {
-                let rt_stub = reg_type_into_functor(r);
-
-                functor!(
-                    "unify_local_value",
-                    [aux(h, 0)],
-                    [rt_stub]
-                )
-            }
-            &FactInstruction::UnifyVariable(r) => {
-                let rt_stub = reg_type_into_functor(r);
-
-                functor!(
-                    "unify_variable",
-                    [aux(h, 0)],
-                    [rt_stub]
-                )
-            }
-            &FactInstruction::UnifyValue(r) => {
-                let rt_stub = reg_type_into_functor(r);
-
-                functor!(
-                    "unify_value",
-                    [aux(h, 0)],
-                    [rt_stub]
-                )
-            }
-            &FactInstruction::UnifyVoid(vars) => {
-                functor!("unify_void", [integer(vars)])
-            }
-        }
-    }
-}
-
-#[derive(Debug, Clone)]
-pub enum QueryInstruction {
-    GetVariable(RegType, usize),
-    PutConstant(Level, Constant, RegType),
-    PutList(Level, RegType),
-    PutPartialString(Level, String, RegType, bool),
-    PutStructure(ClauseType, usize, RegType),
-    PutUnsafeValue(usize, usize),
-    PutValue(RegType, usize),
-    PutVariable(RegType, usize),
-    SetConstant(Constant),
-    SetLocalValue(RegType),
-    SetVariable(RegType),
-    SetValue(RegType),
-    SetVoid(usize),
-}
-
-impl QueryInstruction {
-    pub fn to_functor(&self, h: usize) -> MachineStub {
-        match self {
-            &QueryInstruction::PutUnsafeValue(norm, arg) => functor!(
-                "put_unsafe_value",
-                [integer(norm), integer(arg)]
-            ),
-            &QueryInstruction::PutConstant(lvl, ref c, r) => {
-                let lvl_stub = lvl.into_functor();
-                let rt_stub  = reg_type_into_functor(r);
-
-                functor!(
-                    "put_constant",
-                    [aux(h, 0), constant(h, c), aux(h, 1)],
-                    [lvl_stub, rt_stub]
-                )
-            }
-            &QueryInstruction::PutList(lvl, r) => {
-                let lvl_stub = lvl.into_functor();
-                let rt_stub  = reg_type_into_functor(r);
-
-                functor!(
-                    "put_list",
-                    [aux(h, 0), aux(h, 1)],
-                    [lvl_stub, rt_stub]
-                )
-            }
-            &QueryInstruction::PutPartialString(lvl, ref s, r, has_tail) => {
-                let lvl_stub = lvl.into_functor();
-                let rt_stub  = reg_type_into_functor(r);
-
-                functor!(
-                    "put_partial_string",
-                    [aux(h, 0), string(h, s), aux(h, 1), boolean(has_tail)],
-                    [lvl_stub, rt_stub]
-                )
-            }
-            &QueryInstruction::PutStructure(ref ct, arity, r) => {
-                let rt_stub = reg_type_into_functor(r);
-
-                functor!(
-                    "put_structure",
-                    [clause_name(ct.name()), integer(arity), aux(h, 0)],
-                    [rt_stub]
-                )
-            }
-            &QueryInstruction::PutValue(r, arg) => {
-                let rt_stub = reg_type_into_functor(r);
-
-                functor!(
-                    "put_value",
-                    [aux(h, 0), integer(arg)],
-                    [rt_stub]
-                )
-            }
-            &QueryInstruction::GetVariable(r, arg) => {
-                let rt_stub = reg_type_into_functor(r);
-
-                functor!(
-                    "get_variable",
-                    [aux(h, 0), integer(arg)],
-                    [rt_stub]
-                )
-            }
-            &QueryInstruction::PutVariable(r, arg) => {
-                let rt_stub = reg_type_into_functor(r);
-
-                functor!(
-                    "put_variable",
-                    [aux(h, 0), integer(arg)],
-                    [rt_stub]
-                )
-            }
-            &QueryInstruction::SetConstant(ref c) => {
-                functor!("set_constant", [constant(h, c)], [])
-            }
-            &QueryInstruction::SetLocalValue(r) => {
-                let rt_stub = reg_type_into_functor(r);
-
-                functor!(
-                    "set_local_value",
-                    [aux(h, 0)],
-                    [rt_stub]
-                )
-            }
-            &QueryInstruction::SetVariable(r) => {
-                let rt_stub = reg_type_into_functor(r);
-
-                functor!(
-                    "set_variable",
-                    [aux(h, 0)],
-                    [rt_stub]
-                )
-            }
-            &QueryInstruction::SetValue(r) => {
-                let rt_stub = reg_type_into_functor(r);
-
-                functor!(
-                    "set_value",
-                    [aux(h, 0)],
-                    [rt_stub]
-                )
-            }
-            &QueryInstruction::SetVoid(vars) => {
-                functor!("set_void", [integer(vars)])
-            }
-        }
-    }
-}
-
-pub type CompiledFact = Vec<FactInstruction>;
-
-pub type ThirdLevelIndex = Vec<IndexedChoiceInstruction>;
-
-pub type Code = Vec<Line>;
-
-pub type CodeDeque = VecDeque<Line>;

src/iterators.rs

@@ -1,8 +1,7 @@
-use crate::prolog_parser::ast::*;
-
-use crate::clause_types::*;
+use crate::atom_table::*;
 use crate::forms::*;
-use crate::machine::machine_indices::*;
+use crate::instructions::*;
+use crate::parser::ast::*;
 
 use std::cell::Cell;
 use std::collections::VecDeque;
@@ -12,126 +11,67 @@ use std::rc::Rc;
 use std::vec::Vec;
 
 #[derive(Debug, Clone)]
-pub enum TermRef<'a> {
+pub(crate) enum TermRef<'a> {
     AnonVar(Level),
     Cons(Level, &'a Cell<RegType>, &'a Term, &'a Term),
-    Constant(Level, &'a Cell<RegType>, &'a Constant),
-    Clause(Level, &'a Cell<RegType>, ClauseType, &'a Vec<Box<Term>>),
-    PartialString(Level, &'a Cell<RegType>, String, Option<&'a Term>),
-    Var(Level, &'a Cell<VarReg>, Rc<Var>),
+    Literal(Level, &'a Cell<RegType>, &'a Literal),
+    Clause(Level, &'a Cell<RegType>, Atom, &'a Vec<Term>),
+    PartialString(Level, &'a Cell<RegType>, &'a String, &'a Box<Term>),
+    CompleteString(Level, &'a Cell<RegType>, Atom),
+    Var(Level, &'a Cell<VarReg>, Rc<String>),
 }
 
 impl<'a> TermRef<'a> {
-    pub fn level(self) -> Level {
+    pub(crate) fn level(self) -> Level {
         match self {
             TermRef::AnonVar(lvl)
-          | TermRef::Cons(lvl, ..)
-          | TermRef::Constant(lvl, ..)
-          | TermRef::Var(lvl, ..)
-          | TermRef::Clause(lvl, ..) => lvl,
-          | TermRef::PartialString(lvl, ..) => lvl,
+            | TermRef::Cons(lvl, ..)
+            | TermRef::Literal(lvl, ..)
+            | TermRef::Var(lvl, ..)
+            | TermRef::Clause(lvl, ..)
+            | TermRef::CompleteString(lvl, ..)
+            | TermRef::PartialString(lvl, ..) => lvl,
         }
     }
 }
 
 #[derive(Debug)]
-pub enum TermIterState<'a> {
+pub(crate) enum TermIterState<'a> {
     AnonVar(Level),
-    Constant(Level, &'a Cell<RegType>, &'a Constant),
-    Clause(
-        Level,
-        usize,
-        &'a Cell<RegType>,
-        ClauseType,
-        &'a Vec<Box<Term>>,
-    ),
+    Literal(Level, &'a Cell<RegType>, &'a Literal),
+    Clause(Level, usize, &'a Cell<RegType>, Atom, &'a Vec<Term>),
     InitialCons(Level, &'a Cell<RegType>, &'a Term, &'a Term),
     FinalCons(Level, &'a Cell<RegType>, &'a Term, &'a Term),
-    PartialString(Level, &'a Cell<RegType>, String, Option<&'a Term>),
-    Var(Level, &'a Cell<VarReg>, Rc<Var>),
-}
-
-fn is_partial_string<'a>(
-    head: &'a Term,
-    mut tail: &'a Term,
-) -> Option<(String, Option<&'a Term>)>
-{
-    let mut string =
-        match head {
-            &Term::Constant(_, Constant::Atom(ref atom, _)) if atom.is_char() => {
-                atom.as_str().chars().next().unwrap().to_string()
-            }
-            &Term::Constant(_, Constant::Char(c)) => {
-                c.to_string()
-            }
-            _ => {
-                return None;
-            }
-        };
-
-    while let Term::Cons(_, ref head, ref succ) = tail {
-        match head.as_ref() {
-            &Term::Constant(_, Constant::Atom(ref atom, _)) if atom.is_char() => {
-                string.push(atom.as_str().chars().next().unwrap());
-            }
-            &Term::Constant(_, Constant::Char(c)) => {
-                string.push(c);
-            }
-            _ => {
-                return None;
-            }
-        };
-
-        tail = succ.as_ref();
-    }
-
-    match tail {
-        Term::AnonVar | Term::Var(..) => {
-            return Some((string, Some(tail)));
-        }
-        Term::Constant(_, Constant::EmptyList) => {
-            return Some((string, None));
-        }
-        Term::Constant(_, Constant::String(tail)) => {
-            string += &tail;
-            return Some((string, None));
-        }
-        _ => {
-            return None;
-        }
-    }
+    InitialPartialString(Level, &'a Cell<RegType>, &'a String, &'a Box<Term>),
+    FinalPartialString(Level, &'a Cell<RegType>, &'a String, &'a Box<Term>),
+    CompleteString(Level, &'a Cell<RegType>, Atom),
+    Var(Level, &'a Cell<VarReg>, Rc<String>),
 }
 
 impl<'a> TermIterState<'a> {
-    pub fn subterm_to_state(lvl: Level, term: &'a Term) -> TermIterState<'a> {
+    pub(crate) fn subterm_to_state(lvl: Level, term: &'a Term) -> TermIterState<'a> {
         match term {
-            &Term::AnonVar => {
-                TermIterState::AnonVar(lvl)
+            Term::AnonVar => TermIterState::AnonVar(lvl),
+            Term::Clause(cell, name, subterms) => {
+                TermIterState::Clause(lvl, 0, cell, *name, subterms)
             }
-            &Term::Clause(ref cell, ref name, ref subterms, ref spec) => {
-                let ct = if let Some(spec) = spec {
-                    ClauseType::Op(name.clone(), spec.clone(), CodeIndex::default())
-                } else {
-                    ClauseType::Named(name.clone(), subterms.len(), CodeIndex::default())
-                };
-
-                TermIterState::Clause(lvl, 0, cell, ct, subterms)
-            }
-            &Term::Cons(ref cell, ref head, ref tail) => {
+            Term::Cons(cell, head, tail) => {
                 TermIterState::InitialCons(lvl, cell, head.as_ref(), tail.as_ref())
             }
-            &Term::Constant(ref cell, ref constant) => {
-                TermIterState::Constant(lvl, cell, constant)
+            Term::Literal(cell, constant) => TermIterState::Literal(lvl, cell, constant),
+            Term::PartialString(cell, string_buf, tail) => {
+                TermIterState::InitialPartialString(lvl, cell, string_buf, tail)
             }
-            &Term::Var(ref cell, ref var) => {
-                TermIterState::Var(lvl, cell, var.clone())
+            Term::CompleteString(cell, atom) => {
+                TermIterState::CompleteString(lvl, cell, *atom)
             }
+            Term::Var(cell, var) => TermIterState::Var(lvl, cell, var.clone()),
         }
     }
 }
 
 #[derive(Debug)]
-pub struct QueryIterator<'a> {
+pub(crate) struct QueryIterator<'a> {
     state_stack: Vec<TermIterState<'a>>,
 }
 
@@ -141,11 +81,11 @@ impl<'a> QueryIterator<'a> {
             .push(TermIterState::subterm_to_state(lvl, term));
     }
 
-    fn from_rule_head_clause(terms: &'a Vec<Box<Term>>) -> Self {
+    fn from_rule_head_clause(terms: &'a Vec<Term>) -> Self {
         let state_stack = terms
             .iter()
             .rev()
-            .map(|bt| TermIterState::subterm_to_state(Level::Shallow, bt.as_ref()))
+            .map(|bt| TermIterState::subterm_to_state(Level::Shallow, bt))
             .collect();
 
         QueryIterator { state_stack }
@@ -153,30 +93,20 @@ impl<'a> QueryIterator<'a> {
 
     fn from_term(term: &'a Term) -> Self {
         let state = match term {
-            &Term::AnonVar => {
+            Term::AnonVar | Term::Cons(..) | Term::Literal(..) |
+            Term::PartialString(..) | Term::CompleteString(..) => {
                 return QueryIterator {
                     state_stack: vec![],
                 }
             }
-            &Term::Clause(ref r, ref name, ref terms, ref fixity) => TermIterState::Clause(
+            Term::Clause(r, name, terms) => TermIterState::Clause(
                 Level::Root,
                 0,
                 r,
-                ClauseType::from(name.clone(), terms.len(), fixity.clone()),
+                *name,
                 terms,
             ),
-            &Term::Cons(..) => {
-                return QueryIterator {
-                    state_stack: vec![],
-                }
-            }
-            &Term::Constant(_, _) => {
-                return QueryIterator {
-                    state_stack: vec![],
-                }
-            }
-            &Term::Var(ref cell, ref var) =>
-                TermIterState::Var(Level::Root, cell, (*var).clone()),
+            Term::Var(cell, var) => TermIterState::Var(Level::Root, cell, var.clone()),
         };
 
         QueryIterator {
@@ -186,20 +116,20 @@ impl<'a> QueryIterator<'a> {
 
     fn new(term: &'a QueryTerm) -> Self {
         match term {
-            &QueryTerm::Clause(ref cell, ClauseType::CallN, ref terms, _) => {
-                let state = TermIterState::Clause(Level::Root, 1, cell, ClauseType::CallN, terms);
+            &QueryTerm::Clause(ref cell, ClauseType::CallN(_), ref terms, _) => {
+                let state = TermIterState::Clause(Level::Root, 1, cell, atom!("$call"), terms);
                 QueryIterator {
                     state_stack: vec![state],
                 }
             }
             &QueryTerm::Clause(ref cell, ref ct, ref terms, _) => {
-                let state = TermIterState::Clause(Level::Root, 0, cell, ct.clone(), terms);
+                let state = TermIterState::Clause(Level::Root, 0, cell, ct.name(), terms);
                 QueryIterator {
                     state_stack: vec![state],
                 }
             }
             &QueryTerm::UnblockedCut(ref cell) => {
-                let state = TermIterState::Var(Level::Root, cell, rc_atom!("!"));
+                let state = TermIterState::Var(Level::Root, cell, Rc::new("!".to_string()));
                 QueryIterator {
                     state_stack: vec![state],
                 }
@@ -235,20 +165,17 @@ impl<'a> Iterator for QueryIterator<'a> {
                 TermIterState::AnonVar(lvl) => {
                     return Some(TermRef::AnonVar(lvl));
                 }
-                TermIterState::Clause(lvl, child_num, cell, ct, child_terms) => {
+                TermIterState::Clause(lvl, child_num, cell, name, child_terms) => {
                     if child_num == child_terms.len() {
-                        match ct {
-                            ClauseType::CallN => {
-                                self.push_subterm(Level::Shallow, child_terms[0].as_ref())
-                            }
-                            ClauseType::Named(..) | ClauseType::Op(..) => {
-                                return match lvl {
-                                    Level::Root => None,
-                                    lvl => Some(TermRef::Clause(lvl, cell, ct, child_terms)),
-                                }
+                        match name {
+                            atom!("$call") if lvl == Level::Root => {
+                                self.push_subterm(Level::Shallow, &child_terms[0]);
                             }
                             _ => {
-                                return None;
+                                return match lvl {
+                                    Level::Root => None,
+                                    lvl => Some(TermRef::Clause(lvl, cell, name, child_terms)),
+                                }
                             }
                         };
                     } else {
@@ -256,40 +183,34 @@ impl<'a> Iterator for QueryIterator<'a> {
                             lvl,
                             child_num + 1,
                             cell,
-                            ct,
+                            name,
                             child_terms,
                         ));
 
-                        self.push_subterm(lvl.child_level(), child_terms[child_num].as_ref());
+                        self.push_subterm(lvl.child_level(), &child_terms[child_num]);
                     }
                 }
                 TermIterState::InitialCons(lvl, cell, head, tail) => {
-                    if let Some((string, tail)) = is_partial_string(head, tail) {
-                        self.state_stack.push(TermIterState::PartialString(
-                            lvl,
-                            cell,
-                            string,
-                            tail,
-                        ));
+                    self.state_stack.push(TermIterState::FinalCons(lvl, cell, head, tail));
 
-                        if let Some(tail) = tail {
-                            self.push_subterm(lvl.child_level(), tail);
-                        }
-                    } else {
-                        self.state_stack.push(TermIterState::FinalCons(lvl, cell, head, tail));
-
-                        self.push_subterm(lvl.child_level(), tail);
-                        self.push_subterm(lvl.child_level(), head);
-                    }
+                    self.push_subterm(lvl.child_level(), tail);
+                    self.push_subterm(lvl.child_level(), head);
                 }
-                TermIterState::PartialString(lvl, cell, string, tail) => {
-                    return Some(TermRef::PartialString(lvl, cell, string, tail));
+                TermIterState::InitialPartialString(lvl, cell, string, tail) => {
+                    self.state_stack.push(TermIterState::FinalPartialString(lvl, cell, string, tail));
+                    self.push_subterm(lvl.child_level(), tail);
+                }
+                TermIterState::FinalPartialString(lvl, cell, atom, tail) => {
+                    return Some(TermRef::PartialString(lvl, cell, atom, tail));
+                }
+                TermIterState::CompleteString(lvl, cell, atom) => {
+                    return Some(TermRef::CompleteString(lvl, cell, atom));
                 }
                 TermIterState::FinalCons(lvl, cell, head, tail) => {
                     return Some(TermRef::Cons(lvl, cell, head, tail));
                 }
-                TermIterState::Constant(lvl, cell, constant) => {
-                    return Some(TermRef::Constant(lvl, cell, constant));
+                TermIterState::Literal(lvl, cell, constant) => {
+                    return Some(TermRef::Literal(lvl, cell, constant));
                 }
                 TermIterState::Var(lvl, cell, var) => {
                     return Some(TermRef::Var(lvl, cell, var));
@@ -302,20 +223,21 @@ impl<'a> Iterator for QueryIterator<'a> {
 }
 
 #[derive(Debug)]
-pub struct FactIterator<'a> {
+pub(crate) struct FactIterator<'a> {
     state_queue: VecDeque<TermIterState<'a>>,
     iterable_root: bool,
 }
 
 impl<'a> FactIterator<'a> {
     fn push_subterm(&mut self, lvl: Level, term: &'a Term) {
-        self.state_queue.push_back(TermIterState::subterm_to_state(lvl, term));
+        self.state_queue
+            .push_back(TermIterState::subterm_to_state(lvl, term));
     }
 
-    pub fn from_rule_head_clause(terms: &'a Vec<Box<Term>>) -> Self {
+    pub(crate) fn from_rule_head_clause(terms: &'a Vec<Term>) -> Self {
         let state_queue = terms
             .iter()
-            .map(|bt| TermIterState::subterm_to_state(Level::Shallow, bt.as_ref()))
+            .map(|bt| TermIterState::subterm_to_state(Level::Shallow, bt))
             .collect();
 
         FactIterator {
@@ -326,23 +248,37 @@ impl<'a> FactIterator<'a> {
 
     fn new(term: &'a Term, iterable_root: bool) -> Self {
         let states = match term {
-            &Term::AnonVar => {
+            Term::AnonVar => {
                 vec![TermIterState::AnonVar(Level::Root)]
             }
-            &Term::Clause(ref cell, ref name, ref terms, ref fixity) => {
-                let ct = ClauseType::from(name.clone(), terms.len(), fixity.clone());
-                vec![TermIterState::Clause(Level::Root, 0, cell, ct, terms)]
+            Term::Clause(cell, name, terms) => {
+                vec![TermIterState::Clause(Level::Root, 0, cell, *name, terms)]
             }
-            &Term::Cons(ref cell, ref head, ref tail) => vec![TermIterState::InitialCons(
+            Term::Cons(cell, head, tail) => vec![TermIterState::InitialCons(
                 Level::Root,
                 cell,
                 head.as_ref(),
                 tail.as_ref(),
             )],
-            &Term::Constant(ref cell, ref constant) => {
-                vec![TermIterState::Constant(Level::Root, cell, constant)]
+            Term::PartialString(cell, string_buf, tail) => {
+                vec![TermIterState::InitialPartialString(
+                    Level::Root,
+                    cell,
+                    string_buf,
+                    tail,
+                )]
             }
-            &Term::Var(ref cell, ref var) => {
+            Term::CompleteString(cell, atom) => {
+                vec![TermIterState::CompleteString(
+                    Level::Root,
+                    cell,
+                    *atom,
+                )]
+            }
+            Term::Literal(cell, constant) => {
+                vec![TermIterState::Literal(Level::Root, cell, constant)]
+            }
+            Term::Var(cell, var) => {
                 vec![TermIterState::Var(Level::Root, cell, var.clone())]
             }
         };
@@ -363,38 +299,36 @@ impl<'a> Iterator for FactIterator<'a> {
                 TermIterState::AnonVar(lvl) => {
                     return Some(TermRef::AnonVar(lvl));
                 }
-                TermIterState::Clause(lvl, _, cell, ct, child_terms) => {
+                TermIterState::Clause(lvl, _, cell, name, child_terms) => {
                     for child_term in child_terms {
                         self.push_subterm(lvl.child_level(), child_term);
                     }
 
                     match lvl {
                         Level::Root if !self.iterable_root => continue,
-                        _ => return Some(TermRef::Clause(lvl, cell, ct, child_terms)),
+                        _ => return Some(TermRef::Clause(lvl, cell, name, child_terms)),
                     };
                 }
                 TermIterState::InitialCons(lvl, cell, head, tail) => {
-                    if let Some((string, tail)) = is_partial_string(head, tail) {
-                        if let Some(tail) = tail {
-                            self.push_subterm(Level::Deep, tail);
-                        }
+                    self.push_subterm(Level::Deep, head);
+                    self.push_subterm(Level::Deep, tail);
 
-                        return Some(TermRef::PartialString(lvl, cell, string, tail));
-                    } else {
-                        self.push_subterm(Level::Deep, head);
-                        self.push_subterm(Level::Deep, tail);
-
-                        return Some(TermRef::Cons(lvl, cell, head, tail));
-                    }
+                    return Some(TermRef::Cons(lvl, cell, head, tail));
                 }
-                TermIterState::Constant(lvl, cell, constant) => {
-                    return Some(TermRef::Constant(lvl, cell, constant))
+                TermIterState::InitialPartialString(lvl, cell, string_buf, tail) => {
+                    self.push_subterm(Level::Deep, tail);
+                    return Some(TermRef::PartialString(lvl, cell, string_buf, tail));
+                }
+                TermIterState::CompleteString(lvl, cell, atom) => {
+                    return Some(TermRef::CompleteString(lvl, cell, atom));
+                }
+                TermIterState::Literal(lvl, cell, constant) => {
+                    return Some(TermRef::Literal(lvl, cell, constant))
                 }
                 TermIterState::Var(lvl, cell, var) => {
                     return Some(TermRef::Var(lvl, cell, var));
                 }
-                _ => {
-                }
+                _ => {}
             }
         }
 
@@ -402,28 +336,28 @@ impl<'a> Iterator for FactIterator<'a> {
     }
 }
 
-pub fn post_order_iter(term: &Term) -> QueryIterator {
+pub(crate) fn post_order_iter<'a>(term: &'a Term) -> QueryIterator<'a> {
     QueryIterator::from_term(term)
 }
 
-pub fn breadth_first_iter(term: &Term, iterable_root: bool) -> FactIterator {
+pub(crate) fn breadth_first_iter<'a>(term: &'a Term, iterable_root: bool) -> FactIterator<'a> {
     FactIterator::new(term, iterable_root)
 }
 
 #[derive(Debug)]
-pub enum ChunkedTerm<'a> {
-    HeadClause(ClauseName, &'a Vec<Box<Term>>),
+pub(crate) enum ChunkedTerm<'a> {
+    HeadClause(Atom, &'a Vec<Term>),
     BodyTerm(&'a QueryTerm),
 }
 
-pub fn query_term_post_order_iter<'a>(query_term: &'a QueryTerm) -> QueryIterator<'a> {
+pub(crate) fn query_term_post_order_iter<'a>(query_term: &'a QueryTerm) -> QueryIterator<'a> {
     QueryIterator::new(query_term)
 }
 
 impl<'a> ChunkedTerm<'a> {
-    pub fn post_order_iter(&self) -> QueryIterator<'a> {
+    pub(crate) fn post_order_iter(&self) -> QueryIterator<'a> {
         match self {
-            &ChunkedTerm::BodyTerm(ref qt) => QueryIterator::new(qt),
+            &ChunkedTerm::BodyTerm(qt) => QueryIterator::new(qt),
             &ChunkedTerm::HeadClause(_, terms) => QueryIterator::from_rule_head_clause(terms),
         }
     }
@@ -441,8 +375,8 @@ fn contains_cut_var<'a, Iter: Iterator<Item = &'a Term>>(terms: Iter) -> bool {
     false
 }
 
-pub struct ChunkedIterator<'a> {
-    pub chunk_num: usize,
+pub(crate) struct ChunkedIterator<'a> {
+    pub(crate) chunk_num: usize,
     iter: Box<dyn Iterator<Item = ChunkedTerm<'a>> + 'a>,
     deep_cut_encountered: bool,
     cut_var_in_head: bool,
@@ -464,7 +398,7 @@ type ChunkedIteratorItem<'a> = (usize, usize, Vec<ChunkedTerm<'a>>);
 type RuleBodyIteratorItem<'a> = (usize, usize, Vec<&'a QueryTerm>);
 
 impl<'a> ChunkedIterator<'a> {
-    pub fn rule_body_iter(self) -> Box<dyn Iterator<Item = RuleBodyIteratorItem<'a>> + 'a> {
+    pub(crate) fn rule_body_iter(self) -> Box<dyn Iterator<Item = RuleBodyIteratorItem<'a>> + 'a> {
         Box::new(self.filter_map(|(cn, lt_arity, terms)| {
             let filtered_terms: Vec<_> = terms
                 .into_iter()
@@ -482,16 +416,7 @@ impl<'a> ChunkedIterator<'a> {
         }))
     }
 
-    pub fn from_term_sequence(terms: &'a [QueryTerm]) -> Self {
-        ChunkedIterator {
-            chunk_num: 0,
-            iter: Box::new(terms.iter().map(|t| ChunkedTerm::BodyTerm(t))),
-            deep_cut_encountered: false,
-            cut_var_in_head: false,
-        }
-    }
-
-    pub fn from_rule_body(p1: &'a QueryTerm, clauses: &'a Vec<QueryTerm>) -> Self {
+    pub(crate) fn from_rule_body(p1: &'a QueryTerm, clauses: &'a Vec<QueryTerm>) -> Self {
         let inner_iter = Box::new(once(ChunkedTerm::BodyTerm(p1)));
         let iter = inner_iter.chain(clauses.iter().map(|t| ChunkedTerm::BodyTerm(t)));
 
@@ -503,7 +428,7 @@ impl<'a> ChunkedIterator<'a> {
         }
     }
 
-    pub fn from_rule(rule: &'a Rule) -> Self {
+    pub(crate) fn from_rule(rule: &'a Rule) -> Self {
         let &Rule {
             head: (ref name, ref args, ref p1),
             ref clauses,
@@ -521,7 +446,7 @@ impl<'a> ChunkedIterator<'a> {
         }
     }
 
-    pub fn encountered_deep_cut(&self) -> bool {
+    pub(crate) fn encountered_deep_cut(&self) -> bool {
         self.deep_cut_encountered
     }
 
@@ -533,7 +458,7 @@ impl<'a> ChunkedIterator<'a> {
         while let Some(term) = item {
             match term {
                 ChunkedTerm::HeadClause(_, terms) => {
-                    if contains_cut_var(terms.iter().map(|t| t.as_ref())) {
+                    if contains_cut_var(terms.iter()) {
                         self.cut_var_in_head = true;
                     }
 
@@ -563,13 +488,16 @@ impl<'a> ChunkedIterator<'a> {
                     arity = 1;
                     break;
                 }
-                ChunkedTerm::BodyTerm(&QueryTerm::UnblockedCut(..)) => result.push(term),
+                ChunkedTerm::BodyTerm(&QueryTerm::UnblockedCut(..)) => {
+                    self.deep_cut_encountered = true;
+                    result.push(term);
+                }
                 ChunkedTerm::BodyTerm(&QueryTerm::Clause(_, ClauseType::Inlined(_), ..)) => {
                     result.push(term)
                 }
                 ChunkedTerm::BodyTerm(&QueryTerm::Clause(
                     _,
-                    ClauseType::CallN,
+                    ClauseType::CallN(_),
                     ref subterms,
                     _,
                 )) => {

src/lib.rs

@@ -0,0 +1,36 @@
+#![recursion_limit = "4112"]
+
+#[macro_use]
+extern crate static_assertions;
+
+#[macro_use]
+pub mod macros;
+#[macro_use]
+pub mod atom_table;
+#[macro_use]
+pub mod arena;
+#[macro_use]
+pub mod parser;
+mod allocator;
+mod arithmetic;
+pub mod codegen;
+mod debray_allocator;
+mod fixtures;
+mod forms;
+mod heap_iter;
+pub mod heap_print;
+mod http;
+mod indexing;
+#[macro_use]
+pub mod instructions {
+    include!(concat!(env!("OUT_DIR"), "/instructions.rs"));
+}
+mod iterators;
+pub mod machine;
+mod raw_block;
+pub mod read;
+mod repl_helper;
+mod targets;
+pub mod types;
+
+use instructions::instr;

src/lib/arithmetic.pl

@@ -1,5 +1,5 @@
 :- module(arithmetic, [expmod/4, lsb/2, msb/2, number_to_rational/2,
-                       number_to_rational/3,
+                       number_to_rational/3, popcount/2,
                        rational_numerator_denominator/3]).
 
 :- use_module(library(charsio), [write_term_to_chars/3]).
@@ -94,12 +94,6 @@ number_to_rational(Eps0, Real0, Fraction) :-
     ),
     !.
 
-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,
@@ -121,3 +115,7 @@ rational_numerator_denominator(R, N, D) :-
     append(Ns, [' ', r, d, i, v, ' '|Ds], Cs),
     number_chars(N, Ns),
     number_chars(D, Ds).
+
+popcount(X, N) :-
+    must_be(integer, X),
+    '$popcount'(X, N).

src/lib/assoc.pl

@@ -63,11 +63,8 @@ Assocs are Key-Value associations implemented as  a balanced binary tree
 @author         R.A.O'Keefe, L.Damas, V.S.Costa and Jan Wielemaker
 */
 
-/*
-:- meta_predicate
-    map_assoc(1, ?),
-    map_assoc(2, ?, ?).
-*/
+:- meta_predicate map_assoc(1, ?).
+:- meta_predicate map_assoc(2, ?, ?).
 
 %!  empty_assoc(?Assoc) is semidet.
 %

src/lib/atts.pl

@@ -1,10 +1,6 @@
-:- module(atts, [op(1199, fx, attribute), call_residue_vars/2,
-                 term_attributed_variables/2,
-		         '$absent_attr'/2, '$copy_attr_list'/2, '$get_attr'/2,
-		         '$put_attr'/2, '$absent_from_list'/2,
-		         '$get_from_list'/3, '$add_to_list'/3, '$del_attr'/3,
-		         '$del_attr_step'/3, '$del_attr_buried'/4,
-		         '$default_attr_list'/4]).
+:- module(atts, [op(1199, fx, attribute),
+                 call_residue_vars/2,
+                 term_attributed_variables/2]).
 
 :- use_module(library(dcgs)).
 :- use_module(library(terms)).
@@ -19,9 +15,7 @@
     ).
 
 '$default_attr_list'([PG | PGs], Module, AttrVar) -->
-    (  { '$module_of'(Module, PG) } -> [Module:put_atts(AttrVar, PG)]
-    ;  { true }
-    ),
+    [Module:put_atts(AttrVar, PG)],
     '$default_attr_list'(PGs, Module, AttrVar).
 '$default_attr_list'([], _, _) --> [].
 
@@ -30,30 +24,42 @@
     '$absent_from_list'(Ls, Attr).
 
 '$absent_from_list'(X, Attr) :-
-    (  var(X) -> true
-    ;  X = [L|Ls], L \= Attr -> '$absent_from_list'(Ls, Attr)
+    (  var(X) ->
+       true
+    ;  X = [L|Ls],
+       L \= Attr ->
+       '$absent_from_list'(Ls, Attr)
     ).
 
 '$get_attr'(V, Attr) :-
-    '$get_attr_list'(V, Ls), nonvar(Ls), '$get_from_list'(Ls, V, Attr).
+    '$get_attr_list'(V, Ls),
+    nonvar(Ls),
+    '$get_from_list'(Ls, V, Attr).
 
 '$get_from_list'([L|Ls], V, Attr) :-
     nonvar(L),
-    (  L \= Attr -> nonvar(Ls), '$get_from_list'(Ls, V, Attr)
-    ;  L = Attr, '$enqueue_attr_var'(V)
+    (  L \= Attr ->
+       nonvar(Ls),
+       '$get_from_list'(Ls, V, Attr)
+    ;  L = Attr,
+       '$enqueue_attr_var'(V)
     ).
 
 '$put_attr'(V, Attr) :-
-    '$get_attr_list'(V, Ls), '$add_to_list'(Ls, V, Attr).
+    '$get_attr_list'(V, Ls),
+    '$add_to_list'(Ls, V, Attr).
 
 '$add_to_list'(Ls, V, Attr) :-
-    ( var(Ls) ->
-      Ls = [Attr | _], '$enqueue_attr_var'(V)
-    ; Ls = [_ | Ls0], '$add_to_list'(Ls0, V, Attr)
+    (  var(Ls) ->
+       Ls = [Attr | _],
+       '$enqueue_attr_var'(V)
+    ;  Ls = [_ | Ls0],
+       '$add_to_list'(Ls0, V, Attr)
     ).
 
 '$del_attr'(Ls0, _, _) :-
-    var(Ls0), !.
+    var(Ls0),
+    !.
 '$del_attr'(Ls0, V, Attr) :-
     Ls0 = [Att | Ls1],
     nonvar(Att),
@@ -65,89 +71,112 @@
     ).
 
 '$del_attr_step'(Ls1, V, Attr) :-
-    (  nonvar(Ls1) -> Ls1 = [_ | Ls2], '$del_attr_buried'(Ls1, Ls2, V, Attr)
-    ;  true ).
+    (  nonvar(Ls1) ->
+       Ls1 = [_ | Ls2],
+       '$del_attr_buried'(Ls1, Ls2, V, Attr)
+    ;  true
+    ).
 
 %% assumptions: Ls0 is a list, Ls1 is its tail;
 %%              the head of Ls0 can be ignored.
 '$del_attr_buried'(Ls0, Ls1, V, Attr) :-
     (  var(Ls1) -> true
     ;  Ls1 = [Att | Ls2] ->
-       (  Att \= Attr -> '$del_attr_buried'(Ls1, Ls2, V, Attr)
+       (  Att \= Attr ->
+          '$del_attr_buried'(Ls1, Ls2, V, Attr)
        ;  '$enqueue_attr_var'(V),
-	  '$del_attr_non_head'(Ls0), %% set tail of Ls0 = tail of Ls1. can be undone by backtracking.
-	  '$del_attr_step'(Ls1, V, Attr)
+	      '$del_attr_non_head'(Ls0), %% set tail of Ls0 = tail of Ls1. can be undone by backtracking.
+	      '$del_attr_step'(Ls1, V, Attr)
        )
     ).
 
-'$copy_attr_list'(L, []) :- var(L), !.
-'$copy_attr_list'([Att|Atts], [Att|CopiedAtts]) :-
-    '$copy_attr_list'(Atts, CopiedAtts).
+'$copy_attr_list'(L, _Module, []) :- var(L), !.
+'$copy_attr_list'([Module0:Att|Atts], Module, CopiedAtts) :-
+    (  Module0 == Module ->
+       CopiedAtts = [Att|CopiedAtts0],
+       '$copy_attr_list'(Atts, Module, CopiedAtts0)
+    ;  '$copy_attr_list'(Atts, Module, CopiedAtts)
+    ).
 
 user:term_expansion(Term0, Terms) :-
     nonvar(Term0),
     Term0 = (:- attribute Atts),
     nonvar(Atts),
-    phrase(expand_terms(Atts), Terms).
+    prolog_load_context(module, Module),
+    phrase(expand_terms(Atts, Module), Terms).
 
-expand_terms(Atts) -->
+expand_terms(Atts, Module) -->
     put_attrs_var_check,
-    put_attrs(Atts),
-    get_attrs_var_check,
-    get_attrs(Atts).
+    put_attrs(Atts, Module),
+    get_attrs_var_check(Module),
+    get_attrs(Atts, Module).
 
 put_attrs_var_check -->
-    { numbervars([Var, Attr], 0, _) },
-    [(put_atts(Var, Attr) :- nonvar(Var), throw(error(type_error(variable, Var), put_atts/2))),
-     (put_atts(Var, Attr) :- var(Attr), throw(error(instantiation_error, put_atts/2)))].
+    [(put_atts(Var, Attr) :- nonvar(Var),
+                             throw(error(uninstantiation_error(Var), put_atts/2))),
+     (put_atts(Var, Attr) :- var(Attr),
+                             throw(error(instantiation_error, put_atts/2)))].
 
-get_attrs_var_check -->
-    { numbervars([Var, Ls, Attr], 0, _) },
-    [(get_atts(Var, Attr) :- nonvar(Var), throw(error(type_error(variable, Var), get_atts/2))),
-     (get_atts(Var, Attr) :- var(Attr), !, '$get_attr_list'(Var, Ls), nonvar(Ls),
-			     '$copy_attr_list'(Ls, Attr))].
+get_attrs_var_check(Module) -->
+    [(get_atts(Var, Attr) :- nonvar(Var),
+                             throw(error(uninstantiation_error(Var), get_atts/2))),
+     (get_atts(Var, Attr) :- var(Attr),
+                             !,
+                             '$get_attr_list'(Var, Ls),
+                             nonvar(Ls),
+			                 atts:'$copy_attr_list'(Ls, Module, Attr))].
 
-put_attrs(Name/Arity) -->
-    put_attr(Name, Arity),
-    { numbervars([Var, Attr], 0, _) },
-    [(put_atts(Var, Attr) :- lists:maplist(put_atts(Var), Attr), !)].
-put_attrs((Name/Arity, Atts)) -->
+put_attrs(Name/Arity, Module) -->
+    put_attr(Name, Arity, Module),
+    [(put_atts(Var, Attr) :- lists:maplist(Module:put_atts(Var), Attr), !)].
+put_attrs((Name/Arity, Atts), Module) -->
     { nonvar(Atts) },
-    put_attr(Name, Arity),
-    put_attrs(Atts).
+    put_attr(Name, Arity, Module),
+    put_attrs(Atts, Module).
 
-get_attrs(Name/Arity) -->
-    get_attr(Name, Arity).
-get_attrs((Name/Arity, Atts)) -->
+get_attrs(Name/Arity, Module) -->
+    get_attr(Name, Arity, Module).
+get_attrs((Name/Arity, Atts), Module) -->
     { nonvar(Atts) },
-    get_attr(Name, Arity),
-    get_attrs(Atts).
+    get_attr(Name, Arity, Module),
+    get_attrs(Atts, Module).
 
-put_attr(Name, Arity) -->
-    { functor(Attr, Name, Arity),
-      numbervars(Attr, 0, Arity),
-      V = '$VAR'(Arity) },
-    [(put_atts(V, +Attr) :- !, functor(Attr, Head, Arity),
-			    functor(AttrForm, Head, Arity),
-			    '$get_attr_list'(V, Ls),
-			    '$del_attr'(Ls, V, AttrForm),
-			    '$put_attr'(V, Attr)),
-     (put_atts(V,  Attr) :- !, functor(Attr, Head, Arity),
-			    functor(AttrForm, Head, Arity),
-			    '$get_attr_list'(V, Ls),
-			    '$del_attr'(Ls, V, AttrForm),
-			    '$put_attr'(V, Attr)),
-     (put_atts(V, -Attr) :- !, functor(Attr, _, _),
-			    '$get_attr_list'(V, Ls),
-			    '$del_attr'(Ls, V, Attr))].
+put_attr(Name, Arity, Module) -->
+    { functor(Attr, Name, Arity) },
+    [(put_atts(V, +Attr) :-
+          !,
+          functor(Attr, Head, Arity),
+	      functor(AttrForm, Head, Arity),
+	      '$get_attr_list'(V, Ls),
+	      atts:'$del_attr'(Ls, V, Module:AttrForm),
+	      atts:'$put_attr'(V, Module:Attr)),
+     (put_atts(V,  Attr) :-
+          !,
+          functor(Attr, Head, Arity),
+	      functor(AttrForm, Head, Arity),
+	      '$get_attr_list'(V, Ls),
+	      atts:'$del_attr'(Ls, V, Module:AttrForm),
+	      atts:'$put_attr'(V, Module:Attr)),
+     (put_atts(V, -Attr) :-
+          !,
+          functor(Attr, _, _),
+	      '$get_attr_list'(V, Ls),
+	      atts:'$del_attr'(Ls, V, Module:Attr))].
 
-get_attr(Name, Arity) -->
-    { functor(Attr, Name, Arity),
-      numbervars(Attr, 0, Arity),
-      V = '$VAR'(Arity) },
-    [(get_atts(V, +Attr) :- !, functor(Attr, _, _), '$get_attr'(V, Attr)),
-     (get_atts(V,  Attr) :- !, functor(Attr, _, _), '$get_attr'(V, Attr)),
-     (get_atts(V, -Attr) :- !, functor(Attr, _, _), '$absent_attr'(V, Attr))].
+get_attr(Name, Arity, Module) -->
+    { functor(Attr, Name, Arity) },
+    [(get_atts(V, +Attr) :-
+          !,
+          functor(Attr, _, _),
+          atts:'$get_attr'(V, Module:Attr)),
+     (get_atts(V,  Attr) :-
+          !,
+          functor(Attr, _, _),
+          atts:'$get_attr'(V, Module:Attr)),
+     (get_atts(V, -Attr) :-
+          !,
+          functor(Attr, _, _),
+          atts:'$absent_attr'(V, Module:Attr))].
 
 user:goal_expansion(Term, M:put_atts(Var, Attr)) :-
     nonvar(Term),
@@ -156,6 +185,8 @@ user:goal_expansion(Term, M:get_atts(Var, Attr)) :-
     nonvar(Term),
     Term = get_atts(Var, M, Attr).
 
+:- meta_predicate call_residue_vars(0, ?).
+
 call_residue_vars(Goal, Vars) :-
     '$get_attr_var_queue_delim'(B),
     call(Goal),

src/lib/between.pl

@@ -12,15 +12,18 @@ between(Lower, Upper, X) :-
     (   nonvar(X) ->
         Lower =< X,
         X =< Upper
-    ;   between_(Lower, Upper, X)
+    ;   Lower =< Upper,
+        between_(Lower, Upper, X)
     ).
 
-between_(Lower, Upper, Lower) :-
-    Lower =< Upper.
-between_(Lower1, Upper, X) :-
-    Lower1 < Upper,
-    Lower2 is Lower1 + 1,
-    between_(Lower2, Upper, X).
+between_(Lower, Upper, Lower1) :-
+   Lower < Upper,
+   !,
+   (  Lower1 = Lower
+   ;  Lower0 is Lower + 1,
+      between_(Lower0, Upper, Lower1)
+   ).
+between_(Lower, Lower, Lower).
 
 enumerate_nats(I, I).
 enumerate_nats(I0, N) :-

src/lib/charsio.pl

@@ -1,8 +1,9 @@
 :- module(charsio, [char_type/2,
                     chars_utf8bytes/2,
                     get_single_char/1,
+                    get_n_chars/3,
                     read_line_to_chars/3,
-                    read_term_from_chars/2,
+                    read_from_chars/2,
                     write_term_to_chars/3,
                     chars_base64/3]).
 
@@ -10,6 +11,7 @@
 :- use_module(library(iso_ext)).
 :- use_module(library(error)).
 :- use_module(library(lists)).
+:- use_module(library(iso_ext), [partial_string/1,partial_string/3]).
 
 fabricate_var_name(VarType, VarName, N) :-
     char_code('A', AC),
@@ -53,7 +55,7 @@ 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_([], _, _, [], _).
 extend_var_list_([V|Vs], N, VarList, NewVarList, VarType) :-
     (  var_list_contains_variable(VarList, V) ->
        extend_var_list_(Vs, N, VarList, NewVarList, VarType)
@@ -64,8 +66,7 @@ extend_var_list_([V|Vs], N, VarList, NewVarList, VarType) :-
 
 
 char_type(Char, Type) :-
-    (   var(Char) -> instantiation_error(char_type/2)
-    ;   atom_length(Char, 1) ->
+        must_be(character, Char),
         (   ground(Type) ->
             (   ctype(Type) ->
                 '$char_type'(Char, Type)
@@ -73,14 +74,13 @@ char_type(Char, Type) :-
             )
         ;   ctype(Type),
             '$char_type'(Char, Type)
-        )
-    ;   type_error(in_character, Char, char_type/2)
-    ).
+        ).
 
 
 ctype(alnum).
 ctype(alpha).
 ctype(alphabetic).
+ctype(alphanumeric).
 ctype(ascii).
 ctype(ascii_graphic).
 ctype(ascii_punctuation).
@@ -89,12 +89,14 @@ ctype(control).
 ctype(decimal_digit).
 ctype(exponent).
 ctype(graphic).
+ctype(graphic_token).
 ctype(hexadecimal_digit).
 ctype(layout).
 ctype(lower).
 ctype(meta).
 ctype(numeric).
 ctype(octal_digit).
+ctype(octet).
 ctype(prolog).
 ctype(sign).
 ctype(solo).
@@ -111,18 +113,8 @@ get_single_char(C) :-
     ).
 
 
-read_term_from_chars(Chars, Term) :-
-    (  var(Chars) ->
-       instantiation_error(read_term_from_chars/2)
-    ;  nonvar(Term) ->
-       throw(error(uninstantiation_error(Term), read_term_from_chars/2))
-    ;  '$skip_max_list'(_, -1, Chars, Chars0),
-       Chars0 == [],
-       partial_string(Chars) ->
-       true
-    ;
-       type_error(complete_string, Chars, read_term_from_chars/2)
-    ),
+read_from_chars(Chars, Term) :-
+    must_be(chars, Chars),
     '$read_term_from_chars'(Chars, Term).
 
 
@@ -196,6 +188,29 @@ read_line_to_chars(Stream, Cs0, Cs) :-
             )
         ).
 
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   Read N characters from Stream.
+
+   If N is a variable, read until EOF, unifying N with the number of
+   characters read.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+get_n_chars(Stream, N, Cs) :-
+        can_be(integer, N),
+        (   var(N) ->
+            read_to_eof(Stream, Cs),
+            length(Cs, N)
+        ;   N >= 0,
+            '$get_n_chars'(Stream, N, Cs)
+        ).
+
+read_to_eof(Stream, Cs) :-
+        '$get_n_chars'(Stream, 512, Cs0),
+        (   Cs0 == [] -> Cs = []
+        ;   partial_string(Cs0, Cs, Rest),
+            read_to_eof(Stream, Rest)
+        ).
+
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Relation between a list of characters Cs and its Base64 encoding Bs,
    also a list of characters.
@@ -212,8 +227,7 @@ read_line_to_chars(Stream, Cs0, Cs) :-
    Example:
 
       ?- chars_base64("hello", Bs, []).
-         Bs = "aGVsbG8="
-      ;  false.
+         Bs = "aGVsbG8=".
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 chars_base64(Cs, Bs, Options) :-
@@ -233,10 +247,11 @@ chars_base64(Cs, Bs, Options) :-
         ;   domain_error(charset, Charset, chars_base64/3)
         ),
         (   var(Cs) ->
-            must_be(list, Bs),
-            maplist(must_be(character), Bs),
-            '$chars_base64'(Cs, Bs, Padding, Charset)
-        ;   must_be(list, Cs),
-            maplist(must_be(character), Cs),
+            must_be(chars, Bs),
             '$chars_base64'(Cs, Bs, Padding, Charset)
+        ;   must_be(chars, Cs),
+            (   '$first_non_octet'(Cs, N) ->
+                domain_error(octet_character, N, chars_base64/3)
+            ;   '$chars_base64'(Cs, Bs, Padding, Charset)
+            )
         ).

src/lib/clpb.pl

@@ -17,8 +17,8 @@
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 :- module(clpb, [op(300, fy, ~),
-		 op(500, yfx, #),
-		 sat/1,
+		         op(500, yfx, #),
+		         sat/1,
                  taut/2,
                  labeling/1,
                  sat_count/2,
@@ -49,17 +49,6 @@
    Compatibility predicates.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
-group_pairs_by_key([], []).
-group_pairs_by_key([M-N|T0], [M-[N|TN]|T]) :-
-    same_key(M, T0, TN, T1),
-    group_pairs_by_key(T1, T).
-
-same_key(M0, [M-N|T0], [N|TN], T) :-
-    M0 == M,
-    !,
-    same_key(M, T0, TN, T).
-same_key(_, L, [], L).
-
 must_be(What, Term) :- must_be(What, unknown(Term)-1, Term).
 
 must_be(acyclic, Where, Term) :- !,
@@ -842,9 +831,8 @@ verify_attributes(Var, Other, Gs) :-
             (   integer(Other) ->
                 (   between(0, 1, Other) ->
                     root_get_formula_bdd(Root, Sat, BDD0),
-                    bdd_restriction(BDD0, I, Other, BDD),
                     root_put_formula_bdd(Root, Sat, BDD),
-                    Gs = [satisfiable_bdd(BDD)]
+                    Gs = [bdd_restriction(BDD0,I,Other,BDD),satisfiable_bdd(BDD)]
                 ;   no_truth_value(Other)
                 )
             ;   atom(Other) ->
@@ -1134,6 +1122,8 @@ indomain(1).
 % CountAnd = 1.
 % ==
 
+
+
 sat_count(Sat0, N) :-
         catch((parse_sat(Sat0, Sat),
                sat_bdd(Sat, BDD),
@@ -1288,13 +1278,18 @@ weighted_maximum(Ws, Vars, Max) :-
         maplist(var_with_index, Vars, IVs),
         pairs_keys_values(Pairs0, IVs, Ws),
         keysort(Pairs0, Pairs1),
-        pairs_keys_values(Pairs1, IVs1, WeightsIndexOrder),
+        % sum linear combinations of repeated variables
+        group_pairs_by_key(Pairs1, Groups),
+        maplist(group_sumweights_pair, Groups, Pairs2),
+        pairs_keys_values(Pairs2, IVs1, WeightsIndexOrder),
         pairs_values(IVs1, VarsIndexOrder),
         % Pairs is a list of Var-Weight terms, in index order of Vars
         pairs_keys_values(Pairs, VarsIndexOrder, WeightsIndexOrder),
         bdd_maximum(BDD, Pairs, Max),
         max_labeling(BDD, Pairs).
 
+group_sumweights_pair((I-V)-Ws, (I-V)-W) :- sum_list(Ws, W).
+
 max_labeling(1, Pairs) :- max_upto(Pairs, _, _).
 max_labeling(node(_,Var,Low,High,Aux), Pairs0) :-
         max_upto(Pairs0, Var, Pairs),
@@ -1529,8 +1524,8 @@ pairs_([], _) --> [].
 pairs_([B|Bs], A) --> [A-B], pairs_(Bs, A).
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-   Set the Prolog flag clpb_residuals to bdd to obtain the BDD nodes
-   as residuals. Note that they cannot be used as regular goals.
+   Assert clpb:clpb_residuals(bdd) to obtain the BDD nodes as
+   residuals. Note that they cannot be used as regular goals.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 nodes([]) --> [].
@@ -1558,9 +1553,10 @@ sats([]) --> [].
 sats([A|As]) --> [clpb:sat(A)], sats(As).
 
 booleans([]) --> [].
-booleans([B|Bs]) --> boolean(B), { del_clpb(B) }, booleans(Bs).
+booleans([B|Bs]) --> boolean(B), booleans(Bs).
 
 boolean(Var) -->
+        { del_clpb(Var) },
         (   { get_attr(Var, clpb_omit_boolean, true) } -> []
         ;   [clpb:sat(Var =:= Var)]
         ).

src/lib/clpz.pl

@@ -3,7 +3,7 @@
     Author:        Markus Triska
     E-mail:        triska@metalevel.at
     WWW:           https://www.metalevel.at
-    Copyright (C): 2016-2020 Markus Triska
+    Copyright (C): 2016-2022 Markus Triska
 
     This library provides CLP(ℤ):
 
@@ -99,7 +99,11 @@
                  fd_inf/2,
                  fd_sup/2,
                  fd_size/2,
-                 fd_dom/2
+                 fd_dom/2,
+
+                 % for use in predicates from library(reif)
+                 (#=)/3,
+                 (#<)/3
 
                  % called from goal_expansion
                  % clpz_equal/2,
@@ -118,6 +122,9 @@
 :- use_module(library(error), [domain_error/3, type_error/3]).
 :- use_module(library(si)).
 :- use_module(library(freeze)).
+:- use_module(library(arithmetic)).
+:- use_module(library(debug)).
+:- use_module(library(format)).
 
 % :- use_module(library(types)).
 
@@ -189,6 +196,8 @@ type_error(Expectation, Term) :-
         type_error(Expectation, Term, unknown(Term)-1).
 
 
+:- meta_predicate(partition(1, ?, ?, ?)).
+
 partition(Pred, Ls0, As, Bs) :-
         include(Pred, Ls0, As),
         exclude(Pred, Ls0, Bs).
@@ -209,6 +218,8 @@ partition_([X|Xs], Pred, Ls0, Es0, Gs0) :-
    include/3 and exclude/3
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
+:- meta_predicate(include(1, ?, ?)).
+
 include(Goal, Ls0, Ls) :-
         include_(Ls0, Goal, Ls).
 
@@ -221,6 +232,7 @@ include_([L|Ls0], Goal, Ls) :-
         include_(Ls0, Goal, Rest).
 
 
+:- meta_predicate(exclude(1, ?, ?)).
 
 exclude(Goal, Ls0, Ls) :-
         exclude_(Ls0, Goal, Ls).
@@ -310,7 +322,7 @@ possible.
 Almost all Prolog programs also reason about integers. Therefore, it
 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:
+your =|~/.scryerrc|= initialisation file:
 
 ==
 :- use_module(library(clpz)).
@@ -385,6 +397,7 @@ In total, the arithmetic constraints are:
     | Expr `mod` Expr    | Modulo induced by floored division   |
     | Expr `rem` Expr    | Modulo induced by truncated division |
     | abs(Expr)          | Absolute value                       |
+    | sign(Expr)         | Sign (-1, 0, 1) of Expr              |
     | Expr // Expr       | Truncated integer division           |
     | Expr div Expr      | Floored integer division             |
 
@@ -400,7 +413,7 @@ The [_arithmetic constraints_](<#clpz-arith-constraints>) #=/2, #>/2
 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
+following directive in your =|~/.scryerrc|= initialisation file to make
 CLP(ℤ) constraints available in all your programs:
 
 ==
@@ -1898,12 +1911,6 @@ label([], _, Selection, Order, Choice, Optim0, Consistency, Vars) :-
                          retractall(extremum(_)))
         ).
 
-retractall(What) :-
-        (   \+ \+ retract(What) ->
-            retractall(What)
-        ;   true
-        ).
-
 % Introduce new variables for each min/max expression to avoid
 % reparsing expressions during optimisation.
 
@@ -2236,8 +2243,8 @@ all_distinct(Ls) :-
         fd_must_be_list(Ls, all_distinct(Ls)-1),
         maplist(fd_variable, Ls),
         make_propagator(pdistinct(Ls), Prop),
-        distinct_attach(Ls, Prop, []),
-        trigger_once(Prop).
+        new_queue(Q0),
+        phrase((distinct_attach(Ls, Prop, []),trigger_prop(Prop),do_queue), [Q0], _).
 
 %% nvalue(?N, +Vars).
 %
@@ -2565,16 +2572,17 @@ parse_clpz(E, R,
              m(A//B)           => [g(B #\= 0), p(ptzdiv(A, B, R))],
              m(A div B)        => [g(?(R) #= (A - (A mod B)) // B)],
              m(A^B)            => [p(pexp(A, B, R))],
+             m(sign(A))        => [g(R in -1..1), p(psign(A, R))],
              % bitwise operations
              m(\A)             => [p(pfunction(\, A, R))],
              m(msb(A))         => [p(pfunction(msb, A, R))],
              m(lsb(A))         => [p(pfunction(lsb, A, R))],
-             m(popcount(A))    => [p(pfunction(popcount, A, R))],
+             m(popcount(A))    => [p(ppopcount(A, R))],
              m(A<<B)           => [p(pfunction(<<, A, B, R))],
              m(A>>B)           => [p(pfunction(>>, A, B, R))],
              m(A/\B)           => [p(pfunction(/\, A, B, R))],
              m(A\/B)           => [p(pfunction(\/, A, B, R))],
-             m(xor(A,B))       => [p(pfunction(xor, A, B, R))],
+             m(xor(A, B))      => [p(pxor(A, B, R))],
              g(true)           => [g(domain_error(clpz_expression, E))]
             ]).
 
@@ -2956,7 +2964,15 @@ expr_conds(A0\/B0, A\/B) --> expr_conds(A0, A), expr_conds(B0, B).
 expr_conds(xor(A0,B0), xor(A,B)) --> expr_conds(A0, A), expr_conds(B0, B).
 expr_conds(lsb(A0), lsb(A)) --> expr_conds(A0, A).
 expr_conds(msb(A0), msb(A)) --> expr_conds(A0, A).
-expr_conds(popcount(A0), popcount(A)) --> expr_conds(A0, A).
+expr_conds(popcount(A0), Count) -->
+        expr_conds(A0, A),
+        [I is A, arithmetic:popcount(I, Count)].
+
+no_popcount_t(Gs, T) :-
+        (   member(arithmetic:popcount(_, _), Gs) ->
+            T = false
+        ;   T = true
+        ).
 
 clpz_expandable(_ in _).
 clpz_expandable(_ #= _).
@@ -2965,29 +2981,48 @@ clpz_expandable(_ #=< _).
 clpz_expandable(_ #> _).
 clpz_expandable(_ #< _).
 clpz_expandable(_ #\= _).
+clpz_expandable(_ #<==> _).
 
 clpz_expansion(Var in Dom, In) :-
         (   ground(Dom), Dom = L..U, integer(L), integer(U) ->
             expansion_simpler(
                 (   integer(Var) ->
-                    between(L, U, Var)
+                    between:between(L, U, Var)
                 ;   clpz:clpz_in(Var, Dom)
                 ), In)
         ;   In = clpz:clpz_in(Var, Dom)
         ).
+clpz_expansion(A #<==> B, Reif) :-
+        nonvar(A),
+        A =.. [F0,X0,Y0],
+        clpz_builtin(F0, F),
+        phrase(expr_conds(X0, X), Cs0, Cs),
+        phrase(expr_conds(Y0, Y), Cs),
+        list_goal(Cs0, Cond),
+        Expr =.. [F,X,Y],
+        expansion_simpler(( Cond, ( var(B) ; integer(B), clpz:between(0, 1, B) ) ->
+                            (   Expr ->
+                                B = 1
+                            ;   B = 0
+                            )
+                          ; clpz:reify(A, RA),
+                            clpz:reify(B, RA)
+                          ), Reif).
 clpz_expansion(X0 #= Y0, Equal) :-
         phrase(expr_conds(X0, X), CsX),
         phrase(expr_conds(Y0, Y), CsY),
         list_goal(CsX, CondX),
         list_goal(CsY, CondY),
+        no_popcount_t(CsY, YT),
+        no_popcount_t(CsX, XT),
         expansion_simpler(
                 (   CondX ->
-                    (   var(Y) -> Y is X
+                    (   YT, var(Y) -> Y is X
                     ;   CondY -> X =:= Y
                     ;   T is X, clpz:clpz_equal(T, Y0)
                     )
                 ;   CondY ->
-                    (   var(X) -> X is Y
+                    (   XT, var(X) -> X is Y
                     ;   T is Y, clpz:clpz_equal(X0, T)
                     )
                 ;   clpz:clpz_equal(X0, Y0)
@@ -3023,6 +3058,13 @@ clpz_expansion(X0 #\= Y0, Neq) :-
               ), Neq).
 
 
+clpz_builtin(#=, =:=).
+clpz_builtin(#\=, =\=).
+clpz_builtin(#>, >).
+clpz_builtin(#<, <).
+clpz_builtin(#>=, >=).
+clpz_builtin(#=<, =<).
+
 expansion_simpler((True->Then0;_), Then) :-
         is_true(True), !,
         expansion_simpler(Then0, Then).
@@ -3047,7 +3089,9 @@ expansion_simpler(Var =:= Expr0, Goal) :-
         (   maplist(call, Gs) -> Value is Expr, Goal = (Var =:= Value)
         ;   Goal = false
         ).
-expansion_simpler(between(L,U,V), Goal) :- maplist(integer, [L,U,V]), !,
+expansion_simpler(between:between(L,U,V), Goal) :-
+        maplist(integer, [L,U,V]),
+        !,
         (   between(L,U,V) -> Goal = true
         ;   Goal = false
         ).
@@ -3064,12 +3108,10 @@ is_false(var(X)) :- nonvar(X).
 
 :- dynamic(goal_expansion/1).
 
-% 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).
+user:goal_expansion(Goal0, Goal) :-
+        \+ goal_expansion(false),
+        clpz_expandable(Goal0),
+        clpz_expansion(Goal0, Goal).
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
@@ -3501,7 +3543,7 @@ parse_reified(E, R, D,
                m(A>>B)       => [function(D,>>,A,B,R)],
                m(A/\B)       => [function(D,/\,A,B,R)],
                m(A\/B)       => [function(D,\/,A,B,R)],
-               m(xor(A, B))  => [function(D,xor,A,B,R)],
+               m(xor(A, B))  => [skeleton(A,B,D,R,pxor)],
                g(true)       => [g(domain_error(clpz_expression, E))]]
              ).
 
@@ -4010,12 +4052,13 @@ trigger_props(fd_props(Gs,Bs,Os)) -->
 trigger_props_([]) --> [].
 trigger_props_([P|Ps]) --> trigger_prop(P), trigger_props_(Ps).
 
-trigger_prop(_P) :- true. % TODO: What to do?
+trigger_prop(P) :- trigger_once(P).
 
 trigger_prop(Propagator) -->
         { propagator_state(Propagator, State) },
         (   { State == dead } -> []
         ;   { get_attr(State, clpz_aux, queued) } -> []
+        ;   { bb_get('$clpz_current_propagator', C), C == State } -> []
         ;   % passive
             %{ format("triggering: ~w\n", [Propagator]) },
             { put_attr(State, clpz_aux, queued) },
@@ -4108,12 +4151,13 @@ no_reactivation(pgcc_single(_,_)).
 %no_reactivation(scalar_product(_,_,_,_)).
 
 activate_propagator(propagator(P,State)) -->
+        % { portray_clause(running(P)) },
         (   State == dead -> []
         ;   { del_attr(State, clpz_aux) },
             (   { no_reactivation(P) } ->
-                %b_setval('$clpz_current_propagator', State), TODO
-                run_propagator(P, State)
-                %b_setval('$clpz_current_propagator', [])
+                { bb_b_put('$clpz_current_propagator', State) },
+                run_propagator(P, State),
+                { bb_b_put('$clpz_current_propagator', []) }
             ;   run_propagator(P, State)
             )
         ).
@@ -4159,7 +4203,8 @@ queue_get_arg_(Queue, Which, Element) :-
         ).
 
 queue_enabled --> state(queue(_,_,_,Aux)), { \+ get_atts(Aux, +enabled(false)) }.
-
+disable_queue --> state(queue(_,_,_,Aux)), { put_atts(Aux, +enabled(false)) }.
+enable_queue --> state(queue(_,_,_,Aux)), { put_atts(Aux, +enabled(true)) }.
 
 portray_propagator(propagator(P,_), F) :- functor(P, F, _).
 
@@ -4285,13 +4330,13 @@ tuples_in(Tuples, Relation) :-
         must_be(list(list), Tuples),
         maplist(maplist(fd_variable), Tuples),
         must_be(list(list(integer)), Relation),
-        maplist(relation_tuple(Relation), Tuples),
-        do_queue.
+        maplist(relation_tuple(Relation), Tuples).
 
 relation_tuple(Relation, Tuple) :-
         relation_unifiable(Relation, Tuple, Us, _, _),
         (   ground(Tuple) -> memberchk(Tuple, Relation)
-        ;   phrase(tuple_domain(Tuple, Us), _),
+        ;   new_queue(Q),
+            phrase((tuple_domain(Tuple, Us),do_queue), [Q], _),
             (   Tuple = [_,_|_] -> tuple_freeze(Tuple, Us)
             ;   true
             )
@@ -4354,14 +4399,14 @@ run_propagator(pdifferent(Left,Right,X,_), MState) -->
         run_propagator(pexclude(Left,Right,X), MState).
 
 run_propagator(pexclude(Left,Right,X), _) -->
-        { (   ground(X) ->
-              disable_queue,
-              exclude_fire(Left, Right, X),
-              enable_queue
-          ;   true
-          ) }.
+        (   ground(X) ->
+            disable_queue,
+            exclude_fire(Left, Right, X),
+            enable_queue
+        ;   true
+        ).
 
-run_propagator(pdistinct(Ls), _MState) --> { distinct(Ls) }.
+run_propagator(pdistinct(Ls), _MState) --> distinct(Ls).
 
 run_propagator(pnvalue(N, Vars), _MState) --> { propagate_nvalue(N, Vars) }.
 
@@ -4395,8 +4440,8 @@ run_propagator(pgcc(Vs, _, Pairs), _) --> { gcc_global(Vs, Pairs) }.
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 run_propagator(pcircuit(Vs), _MState) -->
-        { distinct(Vs),
-          propagate_circuit(Vs) }.
+        distinct(Vs),
+        { propagate_circuit(Vs) }.
 
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -4925,97 +4970,232 @@ run_propagator(ptzdiv(X,Y,Z), MState) -->
 %% % Z = X mod Y
 
 run_propagator(pmod(X,Y,Z), MState) -->
-        (   nonvar(X) ->
-            (   nonvar(Y) -> kill(MState), Y =\= 0, Z is X mod Y
+        (   Y == 0 -> { false }
+        ;   Y == Z -> { false }
+        % ;   nonvar(Y), Z == X -> true
+        ;   X == Y -> kill(MState), queue_goal(Z = 0)
+        ;   true
+        ),
+        (   nonvar(X), nonvar(Y) ->
+            kill(MState),
+            Z is X mod Y
+        ;   nonvar(Y), nonvar(Z) ->
+            (   Y > 0 -> Z >= 0, Z < Y
+            ;   Y < 0 -> Z =< 0, Z > Y
+            ),
+            (   { fd_get(X, _, n(XL), _, _) } ->
+                (   (XL - Z) mod Y =\= 0 ->
+                    XMin is Z + Y * ((XL - Z) div Y + 1)
+                ;   XMin is XL
+                ),
+                { fd_get(X, XD0, XPs),
+                  domain_remove_smaller_than(XD0, XMin, XD2) },
+                  fd_put(X, XD2, XPs)
+                % queue_goal(X #>= XMin)
+            ;   true
+            ),
+            (   { fd_get(X, _, _, n(XU), _) } ->
+                XMax is Z + Y * ((XU - Z) div Y),
+                { fd_get(X, XD1, XPs),
+                  domain_remove_greater_than(XD1, XMax, XD3) },
+                  fd_put(X, XD3, XPs)
+                % queue_goal(X #=< XMax)
             ;   true
             )
-        ;   nonvar(Y) ->
-            Y =\= 0,
-            (   abs(Y) =:= 1 -> kill(MState), Z = 0
-            ;   var(Z) ->
-                YP is abs(Y) - 1,
-                (   Y > 0, { fd_get(X, _, n(XL), n(XU), _) } ->
-                    (   XL >= 0, XU < Y ->
-                        kill(MState), Z = X, ZL = XL, ZU = XU
-                    ;   ZL = 0, ZU = YP
-                    )
-                ;   Y > 0 -> ZL = 0, ZU = YP
-                ;   YN is -YP, ZL = YN, ZU = 0
-                ),
-                (   { fd_get(Z, ZD, ZPs) } ->
-                    { domains_intersection(ZD, from_to(n(ZL), n(ZU)), ZD1),
-                      domain_infimum(ZD1, n(ZMin)),
-                      domain_supremum(ZD1, n(ZMax)) },
-                    fd_put(Z, ZD1, ZPs)
-                ;   ZMin = Z, ZMax = Z
-                ),
-                (   { fd_get(X, XD, XPs), domain_infimum(XD, n(XMin)) } ->
-                    Z1 is XMin mod Y,
-                    (   { between(ZMin, ZMax, Z1) } -> true
-                    ;   Y > 0 ->
-                        Next is ((XMin - ZMin + Y - 1) div Y)*Y + ZMin,
-                        { domain_remove_smaller_than(XD, Next, XD1) },
-                        fd_put(X, XD1, XPs)
-                    ;   neq_num(X, XMin)
-                    )
-                ;   true
-                ),
-                (   { fd_get(X, XD2, XPs2), domain_supremum(XD2, n(XMax)) } ->
-                    Z2 is XMax mod Y,
-                    (   { between(ZMin, ZMax, Z2) } -> true
-                    ;   Y > 0 ->
-                        Prev is ((XMax - ZMin) div Y)*Y + ZMax,
-                        { domain_remove_greater_than(XD2, Prev, XD3) },
-                        fd_put(X, XD3, XPs2)
-                    ;   neq_num(X, XMax)
-                    )
-                ;   true
+            % kill(MState),
+            % queue_goal(X #= Z + Y * _) % Add a variable to be efficient.
+        ;   nonvar(Z), nonvar(X) ->
+            (   Z > 0 ->
+                (   X < 0 -> true
+                ;   X >= Z
                 )
-            ;   { fd_get(X, XD, XPs) },
-                % if possible, propagate at the boundaries
-                (   { domain_infimum(XD, n(Min)) } ->
-                    (   Min mod Y =:= Z -> true
-                    ;   Y > 0 ->
-                        Next is ((Min - Z + Y - 1) div Y)*Y + Z,
-                        { domain_remove_smaller_than(XD, Next, XD1) },
-                        fd_put(X, XD1, XPs)
-                    ;   neq_num(X, Min)
-                    )
-                ;   true
-                ),
-                (   { fd_get(X, XD2, XPs2) } ->
-                    (   { domain_supremum(XD2, n(Max)) } ->
-                        (   Max mod Y =:= Z -> true
-                        ;   Y > 0 ->
-                            Prev is ((Max - Z) div Y)*Y + Z,
-                            { domain_remove_greater_than(XD2, Prev, XD3) },
-                            fd_put(X, XD3, XPs2)
-                        ;   neq_num(X, Max)
-                        )
-                    ;   true
-                    )
+            ;   Z < 0 ->
+                (   X > 0 -> true
+                ;   X =< Z
+                )
+            ;   Z =:= 0 % Multiple solutions so do nothing special.
+            ),
+            (   { fd_get(Y, _, _, n(YU), _),
+                  YU < X, X =< 0 } -> kill(MState), Z =:= X
+            ;   { fd_get(Y, _, n(YL), _, _),
+                  YL > X, X >= 0 } -> kill(MState), Z =:= X
+            ;   (   Z > 0 ->
+                    { fd_get(Y, YD, YPs),
+                      YMin is Z + 1,
+                      domain_remove_smaller_than(YD, YMin, YD1) },
+                      fd_put(Y, YD1, YPs)
+                    % queue_goal(Y #> Z)
+                ;   Z < 0 ->
+                    { fd_get(Y, YD, YPs),
+                      YMax is Z - 1,
+                      domain_remove_greater_than(YD, YMax, YD1) },
+                      fd_put(Y, YD1, YPs)
+                    % queue_goal(Y #< Z)
                 ;   true
                 )
             )
-        ;   X == Y -> kill(MState), Z = 0
-        ;   { fd_get(X, XD, XPs),
-              fd_get(Y, YD, _),
-              fd_get(Z, ZD, ZPs) },
-            (   { domain_infimum(XD, n(XMin)), XMin >= 0,
-                  domain_infimum(YD, n(YMin)), YMin > 0 } ->
-                { domain_remove_smaller_than(ZD, 0, ZD1) }
-            ;   ZD1 = ZD
-            ),
-            (   { domain_supremum(YD, n(YMax)), YMax > 0 } ->
-                { Max is YMax - 1, Min is -Max,
-                  domain_remove_smaller_than(ZD1, Min, ZD2),
-                  domain_remove_greater_than(ZD2, Max, ZD3) }
-            ;   ZD3 = ZD1
-            ),
-            fd_put(Z, ZD3, ZPs)
-            % TODO: propagate more
+        ;   run_propagator(pmodz(X,Y,Z), MState),
+            run_propagator(pmody(X,Y,Z), MState),
+            true
         ).
 
+run_propagator(pmodz(X,Y,Z), MState) -->
+        (   nonvar(Z) -> true % Nothing to do.
+        ;   nonvar(X) ->
+            (   X =:= 0 -> kill(MState), queue_goal(Z = X)
+            ;   (   X > 0 ->
+                    (   { fd_get(Y, _, n(YL), _, _), YL > X } ->
+                        kill(MState),
+                        queue_goal(Z = X)
+                    ;   { fd_get(Z, ZD0, ZPs),
+                          domain_remove_greater_than(ZD0, X, ZD2) },
+                          fd_put(Z, ZD2, ZPs)
+                        % queue_goal(Z #=< X)
+                    )
+                ;   X < 0 ->
+                    (   { fd_get(Y, _, _, n(YU), _), YU < X } ->
+                        kill(MState),
+                        queue_goal(Z = X)
+                    ;   { fd_get(Z, ZD0, ZPs),
+                          domain_remove_smaller_than(ZD0, X, ZD2) },
+                          fd_put(Z, ZD2, ZPs)
+                        % queue_goal(Z #>= X)
+                    )
+                ),
+                (   { fd_get(Y, _, n(YL), n(YU), _), YL > 0 } ->
+                    ZMax is YU - 1,
+                    { fd_get(Z, ZD1, ZPs),
+                      domain_remove_smaller_than(ZD1, 0, ZD3),
+                      domain_remove_greater_than(ZD3, ZMax, ZD5) },
+                      fd_put(Z, ZD5, ZPs)
+                    % queue_goal(Z in 0..ZMax)
+                ;   { fd_get(Y, _, n(YL), n(YU), _), YU < 0 } ->
+                    ZMin is YL + 1,
+                    { fd_get(Z, ZD1, ZPs),
+                      domain_remove_greater_than(ZD1, 0, ZD3),
+                      domain_remove_smaller_than(ZD3, ZMin, ZD5) },
+                      fd_put(Z, ZD5, ZPs)
+                    % queue_goal(Z in ZMin..0)
+                ;   true
+                )
+            )
+        ;   nonvar(Y) ->
+            (   abs(Y) =:= 1 -> kill(MState), queue_goal(Z = 0)
+            ;   Y < 0 ->
+                (   { fd_get(X, _, n(XL), n(XU), _), XU =< 0, Y < XL } ->
+                    kill(MState),
+                    queue_goal(Z = X)
+                ;   ZMin is Y + 1,
+                    { fd_get(Z, ZD1, ZPs),
+                      domain_remove_greater_than(ZD1, 0, ZD3),
+                      domain_remove_smaller_than(ZD3, ZMin, ZD5) },
+                      fd_put(Z, ZD5, ZPs)
+                    % queue_goal(Z in ZMin..0)
+                )
+            ;   Y > 0 ->
+                (   { fd_get(X, _, n(XL), n(XU), _), XL >= 0, Y > XU } ->
+                    kill(MState),
+                    queue_goal(Z = X)
+                ;   ZMax is Y - 1,
+                    { fd_get(Z, ZD1, ZPs),
+                      domain_remove_smaller_than(ZD1, 0, ZD3),
+                      domain_remove_greater_than(ZD3, ZMax, ZD5) },
+                      fd_put(Z, ZD5, ZPs)
+                    % queue_goal(Z in 0..ZMax)
+                )
+            )
+        ;   (   { fd_get(X, _, n(XL), n(XU), _), XL >= 0,
+                  fd_get(Y, _, n(YL), _, _), XU < YL } ->
+                kill(MState),
+                queue_goal(Z = X)
+            ;   { fd_get(X, _, n(XL), n(XU), _), XU =< 0,
+                  fd_get(Y, _, _, n(YU), _), XL > YU } ->
+                kill(MState),
+                queue_goal(Z = X)
+            ;   (   { fd_get(X, _, n(XL), n(XU), _), XL >= 0 } ->
+                    { fd_get(Z, ZD0, ZPs),
+                      domain_remove_greater_than(ZD0, XU, ZD2) },
+                      fd_put(Z, ZD2, ZPs)
+                    % queue_goal(Z #=< XU)
+                ;   { fd_get(X, _, n(XL), n(XU), _), XU =< 0 } ->
+                    { fd_get(Z, ZD0, ZPs),
+                      domain_remove_smaller_than(ZD0, XL, ZD2) },
+                      fd_put(Z, ZD2, ZPs)
+                    % queue_goal(Z #>= XL)
+                ;   true
+                ),
+                (   { fd_get(Y, _, n(YL), n(YU), _), YL > 0 } ->
+                    ZMax is YU - 1,
+                    { fd_get(Z, ZD1, ZPs),
+                      domain_remove_smaller_than(ZD1, 0, ZD3),
+                      domain_remove_greater_than(ZD3, ZMax, ZD5) },
+                      fd_put(Z, ZD5, ZPs)
+                    % queue_goal(Z in 0..ZMax)
+                ;   { fd_get(Y, _, n(YL), n(YU), _), YU < 0 } ->
+                    ZMin is YL + 1,
+                    { fd_get(Z, ZD1, ZPs),
+                      domain_remove_greater_than(ZD1, 0, ZD3),
+                      domain_remove_smaller_than(ZD3, ZMin, ZD5) },
+                      fd_put(Z, ZD5, ZPs)
+                    % queue_goal(Z in ZMin..0)
+                ;   { fd_get(Y, _, n(YL), n(YU), _) } ->
+                    ZMin is YL + 1,
+                    ZMax is YU - 1,
+                    { fd_get(Z, ZD1, ZPs),
+                      domain_remove_greater_than(ZD1, ZMax, ZD3),
+                      domain_remove_smaller_than(ZD3, ZMin, ZD5) },
+                      fd_put(Z, ZD5, ZPs)
+                    % queue_goal(Z in ZMin..ZMax)
+                ;   { fd_get(Y, _, _, n(YU), _), YU > 0 } ->
+                    { fd_get(Z, ZD1, ZPs),
+                      ZMax is YU - 1,
+                      domain_remove_greater_than(ZD1, ZMax, ZD3) },
+                      fd_put(Z, ZD3, ZPs)
+                    % queue_goal(Z #< YU)
+                ;   { fd_get(Y, _, n(YL), _, _), YL < 0 } ->
+                    { fd_get(Z, ZD1, ZPs),
+                      ZMin is YL + 1,
+                      domain_remove_smaller_than(ZD1, ZMin, ZD3) },
+                      fd_put(Z, ZD3, ZPs)
+                    % queue_goal(Z #> YL)
+                ;   true
+                )
+            )
+        ).
+
+run_propagator(pmody(X,Y,Z), MState) -->
+        (   nonvar(Y) -> true % Nothing to do.
+        % ;   nonvar(X) -> true
+        ;   nonvar(Z) ->
+            (   Z > 0 -> % queue_goal(Y #> Z)
+                { fd_get(Y, YD, YPs),
+                  YMin is Z + 1,
+                  domain_remove_smaller_than(YD, YMin, YD1) },
+                  fd_put(Y, YD1, YPs)
+            ;   Z < 0 -> % queue_goal(Y #< Z)
+                { fd_get(Y, YD, YPs),
+                  YMax is Z - 1,
+                  domain_remove_greater_than(YD, YMax, YD1) },
+                  fd_put(Y, YD1, YPs)
+            ;   Z =:= 0 -> kill(MState), queue_goal(X / Y #= _)
+            )
+        ;   (   { fd_get(Z, _, n(ZL), _, _), ZL > 0 } ->
+                { fd_get(Y, YD, YPs),
+                  YMin is ZL + 1,
+                  domain_remove_smaller_than(YD, YMin, YD1) },
+                  fd_put(Y, YD1, YPs)
+                % queue_goal(Y #> ZL)
+            ;   { fd_get(Z, _, _, n(ZU), _), ZU < 0 } ->
+                { fd_get(Y, YD, YPs),
+                  YMax is ZU - 1,
+                  domain_remove_greater_than(YD, YMax, YD1) },
+                  fd_put(Y, YD1, YPs)
+                % queue_goal(Y #< ZU)
+            ;   true
+            )
+        ).
+
+
 %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %% % Z = X rem Y
 
@@ -5314,6 +5494,66 @@ run_propagator(pexp(X,Y,Z), MState) -->
         ;   true
         ).
 
+%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% % Y = sign(X)
+
+run_propagator(psign(X,Y), MState) -->
+        (   nonvar(X) -> kill(MState), queue_goal(Y is sign(X))
+        ;   Y == -1 -> kill(MState), queue_goal(X #< 0)
+        ;   Y == 0 -> kill(MState), queue_goal(X = 0)
+        ;   Y == 1 -> kill(MState), queue_goal(X #> 0)
+        ;   { fd_get(X, _, XL, XU, _) },
+            (   { XL = n(L), L > 0 } -> kill(MState), queue_goal(Y = 1)
+            ;   { XU = n(U), U < 0 } -> kill(MState), queue_goal(Y = -1)
+            ;   true
+            )
+        ).
+
+%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% % Y = popcount(X)
+
+run_propagator(ppopcount(X,Y), MState) -->
+        (   nonvar(X) ->
+            kill(MState),
+            queue_goal(popcount(X, Y))
+        ;   true
+        ).
+
+
+%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% % Z = X xor Y
+
+run_propagator(pxor(X,Y,Z), MState) -->
+        (   nonvar(X), nonvar(Y) ->
+            kill(MState),
+            Z is xor(X, Y)
+        ;   nonvar(Y), nonvar(Z) ->
+            kill(MState),
+            X is xor(Y, Z)
+        ;   nonvar(Z), nonvar(X) ->
+            kill(MState),
+            Y is xor(Z, X)
+        ;   X == Y ->
+            kill(MState),
+            queue_goal(Z = 0)
+        ;   Y == Z ->
+            kill(MState),
+            queue_goal(X = 0)
+        ;   Z == X ->
+            kill(MState),
+            queue_goal(Y = 0)
+        ;   X == 0 ->
+            kill(MState),
+            queue_goal(Y = Z)
+        ;   Y == 0 ->
+            kill(MState),
+            queue_goal(Z = X)
+        ;   Z == 0 ->
+            kill(MState),
+            queue_goal(X = Y)
+        ;   true
+        ).
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 run_propagator(pzcompare(Order, A, B), MState) -->
         (   A == B -> kill(MState), Order = (=)
@@ -5698,12 +5938,12 @@ max_factor(L1, U1, L2, U2, Max) :-
    CSPs", AAAI-94, Seattle, WA, USA, pp 362--367, 1994
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
-distinct_attach([], _, _).
-distinct_attach([X|Xs], Prop, Right) :-
+distinct_attach([], _, _) --> [].
+distinct_attach([X|Xs], Prop, Right) -->
         (   var(X) ->
-            init_propagator(X, Prop),
-            make_propagator(pexclude(Xs,Right,X), P1),
-            init_propagator(X, P1),
+            { init_propagator(X, Prop),
+              make_propagator(pexclude(Xs,Right,X), P1),
+              init_propagator(X, P1) },
             trigger_prop(P1)
         ;   exclude_fire(Xs, Right, X)
         ),
@@ -5748,10 +5988,12 @@ difference_arcs([V|Vs], FL0) -->
 
 writeln(T) :- write(T), nl.
 
+:- meta_predicate must_succeed(0).
+
 must_succeed(G) :-
-    (G -> true
-     ;write(failed-G), halt
-    ).
+        (   G -> true
+        ;   throw(failed-G)
+        ).
 
 enumerate([], _) --> [].
 enumerate([N|Ns], V) -->
@@ -5870,57 +6112,26 @@ put_free(F) :- put_attr(F, free, true).
 
 free_node(F) :- get_attr(F, free, true).
 
-del_vars_attr(Vars, Attr) :- maplist(del_attr(Attr), Vars).
+:- meta_predicate with_local_attributes(?, 0, ?).
 
-%del_attr_(Attr, Var) :- del_attr(Var, Attr).
-
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-  This needs to be spelt out.
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
-
-% del_attr_(edges, Var)    :- del_attr(Var, edges).
-% del_attr_(parent, Var)   :- del_attr(Var, parent).
-% del_attr_(g0_edges, Var) :- del_attr(Var, g0_edges).
-% del_attr_(index, Var)    :- del_attr(Var, index).
-% del_attr_(visited, Var)  :- del_attr(Var, visited).
-
-del_all_attrs(Var) :-
-        (   var(Var) ->
-            Atts = [clpz,
-                    clpz_aux,
-                    clpz_relation,
-                    edges,
-                    flow,
-                    parent,
-                    free,
-                    g0_edges,
-                    used,
-                    lowlink,
-                    value,
-                    visited,
-                    index,
-                    in_stack,
-                    clpz_gcc_vs,
-                    clpz_gcc_num,
-                    clpz_gcc_occurred],
-            maplist(remove_attr(Var), Atts)
-        ;   true
-        ).
-
-remove_attr(Var, Attr) :-
-        functor(Term, Attr, 1),
-        put_atts(Var, -Term).
+:- dynamic(nat_copy/1).
 
 with_local_attributes(Vars, Goal, Result) :-
         catch((Goal,
-               maplist(del_all_attrs, Vars),
-               % reset all attributes, only the result matters
-               throw(local_attributes(Result,Vars))),
-              local_attributes(Result,Vars),
+               % Create a copy where all attributes are removed. Only
+               % the result and its relation to Vars matters. We throw
+               % an exception to undo all modifications to attributes
+               % we made during propagation, and unify the variables
+               % in the thrown copy with Vars in order to get the
+               % intended variables in Result.
+               asserta(nat_copy(Vars-Result)),
+               retract(nat_copy(Copy)),
+               throw(local_attributes(Copy))),
+              local_attributes(Vars-Result),
               true).
 
-distinct(Vars) :-
-        with_local_attributes(Vars,
+distinct(Vars) -->
+        { with_local_attributes(Vars,
            (   difference_arcs(Vars, FreeLeft, FreeRight0),
                length(FreeLeft, LFL),
                length(FreeRight0, LFR),
@@ -5931,11 +6142,16 @@ distinct(Vars) :-
                maplist(g_g0, FreeLeft),
                scc(FreeLeft, g0_successors),
                maplist(dfs_used, FreeRight),
-               phrase(distinct_goals(FreeLeft), Gs)), Gs),
+               phrase(distinct_goals(FreeLeft), Gs)), Gs) },
         disable_queue,
-        maplist(call, Gs),
+        neq_nums(Gs),
         enable_queue.
 
+neq_nums([]) --> [].
+neq_nums([neq_num(V,N)|VNs]) -->
+        % { portray_clause(neq_num(V, N)) },
+        neq_num(V, N), neq_nums(VNs).
+
 distinct_goals([]) --> [].
 distinct_goals([V|Vs]) -->
         { get_attr(V, edges, Es) },
@@ -6142,6 +6358,10 @@ exclude_fire(Left, Right, E) :-
         all_neq(Left, E),
         all_neq(Right, E).
 
+exclude_fire(Left, Right, E) -->
+        all_neq(Left, E),
+        all_neq(Right, E).
+
 list_contains([X|Xs], Y) :-
         (   X == Y -> true
         ;   list_contains(Xs, Y)
@@ -6471,7 +6691,7 @@ gcc_edge_goal(arc_to(_,_,V,F), Val) -->
               get_attr(Val, lowlink, L2),
               L1 =\= L2,
               get_attr(Val, value, Value) } ->
-            [neq_num(V, Value)]
+            [clpz:neq_num(V, Value)]
         ;   []
         ).
 
@@ -6703,6 +6923,11 @@ vs_key_min_others([V|Vs], Key, Min0, Min, Others) :-
             )
         ).
 
+all_neq([], _) --> [].
+all_neq([X|Xs], C) -->
+        neq_num(X, C),
+        all_neq(Xs, C).
+
 all_neq([], _).
 all_neq([X|Xs], C) :-
         neq_num(X, C),
@@ -6734,8 +6959,8 @@ circuit(Vs) :-
         (   L =:= 1 -> true
         ;   neq_index(Vs, 1),
             make_propagator(pcircuit(Vs), Prop),
-            distinct_attach(Vs, Prop, []),
-            trigger_once(Prop)
+            new_queue(Q0),
+            phrase((distinct_attach(Vs, Prop, []),trigger_prop(Prop),do_queue), [Q0], _)
         ).
 
 neq_index([], _).
@@ -6847,10 +7072,6 @@ cumulative(Tasks, Options) :-
             resource_limit(Start, End, Tasks, Bss, L)
         ).
 
-min_(E, M0, M) :- M is min(E,M0).
-
-max_(E, M0, M) :- M is max(E,M0).
-
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Trivial lower and upper bounds, assuming no gaps and not necessarily
    retaining the rectangular shape of each task.
@@ -6919,10 +7140,6 @@ contribution_at(T, Task, Offset-Bs, Contribution) :-
             ?(Contribution) #= B*C
         ).
 
-nth1(I, Es, E) :-
-        I0 is I-1,
-        nth0(I0, Es, E).
-
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 %% disjoint2(+Rectangles)
@@ -7442,20 +7659,6 @@ attribute_goals(X) -->
         attributes_goals(Ps),
         { del_attr(X, clpz) }.
 
-clpz_aux:attribute_goals(_) --> [].
-
-clpz_gcc_vs:attribute_goals(_) --> [].
-
-clpz_gcc_num:attribute_goals(_) --> [].
-
-clpz_gcc_occurred:attribute_goals(_) --> [].
-
-clpz_relation:attribute_goals(_) --> [].
-
-attribute_goal(Var, Goal) :-
-        phrase(attribute_goals(Var), Goals),
-        list_goal(Goals, Goal).
-
 attributes_goals([]) --> [].
 attributes_goals([propagator(P, State)|As]) -->
         (   { ground(State) } -> []
@@ -7495,11 +7698,14 @@ attribute_goal_(ptzdiv(X,Y,Z))         --> [?(X) // ?(Y) #= ?(Z)].
 attribute_goal_(pdiv(X,Y,Z))           --> [?(X) div ?(Y) #= ?(Z)].
 attribute_goal_(prdiv(X,Y,Z))          --> [?(X) / ?(Y) #= ?(Z)].
 attribute_goal_(pexp(X,Y,Z))           --> [?(X) ^ ?(Y) #= ?(Z)].
+attribute_goal_(psign(X,Y))            --> [?(Y) #= sign(?(X))].
 attribute_goal_(pabs(X,Y))             --> [?(Y) #= abs(?(X))].
 attribute_goal_(pmod(X,M,K))           --> [?(X) mod ?(M) #= ?(K)].
 attribute_goal_(prem(X,Y,Z))           --> [?(X) rem ?(Y) #= ?(Z)].
 attribute_goal_(pmax(X,Y,Z))           --> [?(Z) #= max(?(X),?(Y))].
 attribute_goal_(pmin(X,Y,Z))           --> [?(Z) #= min(?(X),?(Y))].
+attribute_goal_(pxor(X,Y,Z))           --> [?(Z) #= xor(?(X), ?(Y))].
+attribute_goal_(ppopcount(X,Y))        --> [?(Y) #= popcount(?(X))].
 attribute_goal_(scalar_product_neq(Cs,Vs,C)) -->
         [Left #\= Right],
         { scalar_product_left_right([-1|Cs], [C|Vs], Left, Right) }.
@@ -7518,7 +7724,9 @@ attribute_goal_(pelement(N,Is,V)) --> [element(N, Is, V)].
 attribute_goal_(pgcc(Vs, Pairs, _))   --> [global_cardinality(Vs, Pairs)].
 attribute_goal_(pgcc_single(_,_))     --> [].
 attribute_goal_(pgcc_check_single(_)) --> [].
-attribute_goal_(pgcc_check(_))        --> [].
+attribute_goal_(pgcc_check(Pairs))    -->
+        { pairs_values(Pairs, Nums),
+          maplist(gcc_done, Nums) }.
 attribute_goal_(pcircuit(Vs))       --> [circuit(Vs)].
 attribute_goal_(pserialized(_,_,_,_,O)) --> original_goal(O).
 attribute_goal_(rel_tuple(R, Tuple)) -->
@@ -7608,15 +7816,29 @@ plusterm_(CV, T0, T0+T) :- coeff_var_term(CV, T).
 
 coeff_var_term(C-V, T) :- ( C =:= 1 -> T = ?(V) ; T = C * ?(V) ).
 
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   Reified predicates for use with predicates from library(reif).
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+#=(X, Y, T) :-
+        X #= Y #<==> B,
+        zo_t(B, T).
+
+#<(X, Y, T) :-
+        X #< Y #<==> B,
+        zo_t(B, T).
+
+zo_t(0, false).
+zo_t(1, true).
+
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Generated predicates
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
-generated_clauses(Cs) :-
-        make_parse_clpz(Cs1),
-        make_parse_reified(Cs2),
-        make_matches(Cs3),
-        append([Cs1,Cs2,Cs3], Cs).
+term_expansion(make_parse_clpz, Clauses)    :- make_parse_clpz(Clauses).
+term_expansion(make_parse_reified, Clauses) :- make_parse_reified(Clauses).
+term_expansion(make_matches, Clauses)       :- make_matches(Clauses).
 
-:- initialization((generated_clauses(Cs),
-                   maplist(assertz, Cs))).
+make_parse_clpz.
+make_parse_reified.
+make_matches.

src/lib/cont.pl

@@ -1,5 +1,7 @@
 :- module(cont, [reset/3, shift/1]).
 
+:- meta_predicate reset(0, ?, ?).
+
 reset(Goal, Ball, Cont) :-
     call(Goal),
     '$reset_cont_marker',
@@ -11,7 +13,7 @@ shift(Ball) :-
     get_chunks(E, P, L),
     (  L == [] ->
        Cont = cont(true)
-    ;  Cont = cont(call_continuation(L))
+    ;  Cont = cont(cont:call_continuation(L))
     ),
     '$write_cont_and_term'(_, _, Cont, Ball),
     '$unwind_environments'.

src/lib/crypto.pl

@@ -1,5 +1,5 @@
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-   Written May 2020 by Markus Triska (triska@metalevel.at)
+   Written 2020, 2021, 2022 by Markus Triska (triska@metalevel.at)
    Part of Scryer Prolog.
 
    Predicates for cryptographic applications.
@@ -8,7 +8,7 @@
    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
+   Especially for cryptographic applications, it is 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
@@ -46,6 +46,7 @@
 :- use_module(library(format)).
 :- use_module(library(charsio)).
 :- use_module(library(si)).
+:- use_module(library(iso_ext), [partial_string/3]).
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    hex_bytes(?Hex, ?Bytes) is det.
@@ -58,15 +59,13 @@
    Example:
 
    ?- hex_bytes("501ACE", Bs).
-      Bs = [80,26,206]
-   ;  false.
+      Bs = [80,26,206].
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
 hex_bytes(Hs, Bytes) :-
         (   ground(Hs) ->
-            must_be(list, Hs),
-            maplist(must_be(atom), Hs),
+            must_be(chars, Hs),
             (   phrase(hex_bytes(Hs), Bytes) ->
                 true
             ;   domain_error(hex_encoding, Hs, hex_bytes/2)
@@ -104,16 +103,13 @@ must_be_bytes(Bytes, Context) :-
         ).
 
 
-must_be_byte_chars(Chars, Context) :-
-        must_be(list, Chars),
-        (   member(Char, Chars),
-            char_code(Char, Code),
-            \+ between(0, 255, Code) ->
-            domain_error(byte_char, Char, Context)
+must_be_octet_chars(Chars, Context) :-
+        must_be(chars, Chars),
+        (   '$first_non_octet'(Chars, F) ->
+            domain_error(octet_character, F, Context)
         ;   true
         ).
 
-
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Cryptographically secure random numbers
    =======================================
@@ -146,7 +142,7 @@ must_be_byte_chars(Chars, Context) :-
    ?- 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)
+      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
@@ -155,7 +151,7 @@ must_be_byte_chars(Chars, Context) :-
 
    ?- crypto_n_random_bytes(12, Bs),
       hex_bytes(Hex, Bs).
-      Bs = [34,25,50,72,58,63,50,172,32,46|...], Hex = "221932483a3f32ac202 ..."
+      Bs = [34,25,50,72,58,63,50,172,32,46|...], Hex = "221932483a3f32ac202 ...".
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 
@@ -190,8 +186,7 @@ crypto_random_byte(B) :- '$crypto_random_byte'(B).
    Example:
 
    ?- crypto_data_hash("abc", Hs, [algorithm(sha256)]).
-      Hs = "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad"
-   ;  false.
+      Hs = "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad".
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -282,7 +277,7 @@ crypto_data_hkdf(Data0, L, Bytes, Options0) :-
         ;   domain_error(hkdf_algorithm, Algorithm, crypto_data_hkdf/4)
         ),
         must_be(integer, L),
-        L >= 0,
+        L #>= 0,
         options_data_chars(Options, Data0, Data, Encoding),
         option(salt(SaltBytes), Options, []),
         must_be_bytes(SaltBytes, crypto_data_hkdf/4),
@@ -415,7 +410,7 @@ 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,
+        Iterations #= 2^C,
         Algorithm = 'pbkdf2-sha512', % current default and only option
         option(algorithm(Algorithm), Options, Algorithm),
         (   member(salt(SaltBytes), Options) ->
@@ -492,6 +487,12 @@ bytes_base64(Bytes, Base64) :-
       list of _bytes_ holding the tag. This tag must be provided for
       decryption.
 
+      - aad(+Data)
+      Data is additional authenticated data (AAD), a list of
+      characters. It is authenticated in that it influences the tag,
+      but it is not encrypted. The encoding/1 option also specifies
+      the encoding of Data.
+
    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_,
@@ -533,13 +534,20 @@ crypto_data_encrypt(PlainText0, Algorithm, Key, IV, CipherText, Options) :-
             must_be_bytes(Tag, crypto_data_encrypt/6)
         ;   true
         ),
+        option(aad(AAD0), Options, []),
+        encoding_chars(Encoding, AAD0, AAD),
         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, Encoding, Key, IV, Tag, CipherText).
+        algorithm_key_iv(Algorithm, Key, IV),
+        '$crypto_data_encrypt'(PlainText, AAD, Encoding, Key, IV, Tag, CipherText).
+
+algorithm_key_iv('chacha20-poly1305', Key, IV) :-
+        length(Key, 32),
+        length(IV, 12).
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   crypto_data_decrypt(+CipherText,
@@ -567,6 +575,10 @@ crypto_data_encrypt(PlainText0, Algorithm, Key, IV, CipherText, Options) :-
     - tag(+Tag)
     For authenticated encryption schemes, the tag must be specified as
     a list of bytes exactly as they were generated upon encryption.
+
+    - aad(+Data)
+    Any additional authenticated data (AAD) must be specified. The
+    encoding/1 option also specifies the encoding of Data.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 crypto_data_decrypt(CipherText0, Algorithm, Key, IV, PlainText, Options) :-
@@ -576,16 +588,20 @@ crypto_data_decrypt(CipherText0, Algorithm, Key, IV, PlainText, Options) :-
         must_be_bytes(IV, crypto_data_decrypt/6),
         must_be(atom, Algorithm),
         option(encoding(Encoding), Options, utf8),
+        option(aad(AAD0), Options, []),
+        encoding_chars(Encoding, AAD0, AAD),
         must_be(atom, Encoding),
         member(Encoding, [utf8,octet]),
-        must_be(list, CipherText0),
         encoding_chars(octet, CipherText0, CipherText1),
         maplist(char_code, TagChars, Tag),
-        append(CipherText1, TagChars, CipherText),
+        % we append the tag very efficiently, retaining a compact
+        % internal string representation of the ciphertext
+        partial_string(CipherText1, CipherText, TagChars),
         (   Algorithm = 'chacha20-poly1305' -> true
         ;   domain_error('chacha20-poly1305', Algorithm, crypto_data_decrypt/6)
         ),
-        '$crypto_data_decrypt'(CipherText, octet, Key, IV, Encoding, PlainText).
+        algorithm_key_iv(Algorithm, Key, IV),
+        '$crypto_data_decrypt'(CipherText, AAD, Key, IV, Encoding, PlainText).
 
 
 encoding_chars(octet, Bs, Cs) :-
@@ -594,10 +610,9 @@ encoding_chars(octet, Bs, Cs) :-
             maplist(char_code, Cs, Bs)
         ;   Bs = Cs
         ),
-        must_be_byte_chars(Cs, crypto_encoding).
+        must_be_octet_chars(Cs, crypto_encoding).
 encoding_chars(utf8, Cs, Cs) :-
-        must_be(list, Cs),
-        maplist(must_be(character), Cs).
+        must_be(chars, Cs).
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Digital signatures with Ed25519
@@ -636,20 +651,20 @@ ed25519_new_keypair(Pair) :-
         '$ed25519_new_keypair'(Pair).
 
 ed25519_keypair_public_key(Pair, PublicKey) :-
-        must_be_byte_chars(Pair, ed25519_keypair_public_key),
-        '$ed25519_keypair_public_key'(Pair, octet, PublicKey).
+        must_be_octet_chars(Pair, ed25519_keypair_public_key),
+        '$ed25519_keypair_public_key'(Pair, PublicKey).
 
 ed25519_sign(Key, Data0, Signature, Options) :-
-        must_be_byte_chars(Key, ed25519_sign),
+        must_be_octet_chars(Key, ed25519_sign),
         options_data_chars(Options, Data0, Data, Encoding),
-        '$ed25519_sign'(Key, octet, Data, Encoding, Signature0),
+        '$ed25519_sign'(Key, Data, Encoding, Signature0),
         hex_bytes(Signature, Signature0).
 
 ed25519_verify(Key, Data0, Signature0, Options) :-
-        must_be_byte_chars(Key, ed25519_verify),
+        must_be_octet_chars(Key, ed25519_verify),
         options_data_chars(Options, Data0, Data, Encoding),
         hex_bytes(Signature0, Signature),
-        '$ed25519_verify'(Key, octet, Data, Encoding, Signature).
+        '$ed25519_verify'(Key, Data, Encoding, Signature).
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    X25519: ECDH key exchange over Curve25519
@@ -688,8 +703,6 @@ curve25519_generator(Gs) :-
 
 curve25519_scalar_mult(Scalar, Point, Result) :-
         (   integer_si(Scalar) ->
-            Scalar #>= 0,
-            Scalar #< 2^256,
             length(ScalarBytes, 32),
             bytes_integer(ScalarBytes, Scalar)
         ;   ScalarBytes = Scalar,
@@ -700,12 +713,17 @@ curve25519_scalar_mult(Scalar, Point, Result) :-
         '$curve25519_scalar_mult'(ScalarBytes, PointBytes, Result).
 
 bytes_integer(Bs, N) :-
-        foldl(pow, Bs, 0-0, N-_).
+        foldl(pow, Bs, t(0,0,N), t(N,_,_)).
 
-pow(B, N0-I0, N-I) :-
+pow(B, t(N0,P0,I0), t(N,P,I)) :-
+        (   integer(I0) ->
+            B #= I0 mod 256,
+            I #= I0 >> 8
+        ;   true
+        ),
         B in 0..255,
-        N #= N0 + B*256^I0,
-        I #= I0 + 1.
+        N #= N0 + B*256^P0,
+        P #= P0 + 1.
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Operations on Elliptic Curves
@@ -748,11 +766,15 @@ crypto_curve_scalar_mult(Curve, Scalar, point(X,Y), point(RX, RY)) :-
         curve_name(Curve, Name),
         curve_field_length(Curve, L0),
         L #= 2*L0, % for hex encoding
-        phrase(format_("04~|~`0t~16r~*+~`0t~16r~*+", [X,L,Y,L]), Hex),
-        hex_bytes(Hex, Bytes),
-        '$crypto_curve_scalar_mult'(Name, Scalar, Bytes, SX, SY),
-        number_chars(RX, SX),
-        number_chars(RY, SY).
+        phrase(format_("04~|~`0t~16r~*+~`0t~16r~*+", [X,L,Y,L]), PointHex),
+        hex_bytes(PointHex, PointBytes),
+        once(bytes_integer(ScalarBytes, Scalar)),
+        '$crypto_curve_scalar_mult'(Name, ScalarBytes, PointBytes, [_|Us]),
+        maplist(char_code, Us, Bs),
+        length(XBs, 32),
+        append(XBs, YBs, Bs),
+        maplist(reverse, [XBs,YBs], RBs),
+        maplist(bytes_integer, RBs, [RX,RY]).
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 ?- crypto_name_curve(secp256k1, Curve),
@@ -804,16 +826,6 @@ fitting_exponent(N, E0, E) :-
             fitting_exponent(N, E1, E)
         ).
 
-crypto_name_curve(secp112r1,
-                  curve(secp112r1,
-                        0x00db7c2abf62e35e668076bead208b,
-                        0x00db7c2abf62e35e668076bead2088,
-                        0x659ef8ba043916eede8911702b22,
-                        point(0x09487239995a5ee76b55f9c2f098,
-                              0xa89ce5af8724c0a23e0e0ff77500),
-                        0x00db7c2abf62e35e7628dfac6561c5,
-                        14,
-                        1)).
 crypto_name_curve(secp256k1,
                   curve(secp256k1,
                         0x00fffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc2f,

src/lib/dcgs.pl

@@ -1,45 +1,41 @@
 :- module(dcgs,
           [op(1105, xfy, '|'),
-		   phrase/2,
-		   phrase/3]).
+           phrase/2,
+           phrase/3,
+           seq//1,
+           seqq//1,
+           ... //0
+          ]).
 
 :- use_module(library(error)).
-:- use_module(library(lists), [append/3]).
+:- use_module(library(iso_ext)).
+:- use_module(library(lists), [append/3, member/2]).
+:- use_module(library(loader), [strip_module/3]).
+
+:- meta_predicate phrase(2, ?).
+
+:- meta_predicate phrase(2, ?, ?).
 
 phrase(GRBody, S0) :-
     phrase(GRBody, S0, []).
 
 phrase(GRBody, S0, S) :-
-    (  var(GRBody) -> throw(error(instantiation_error, phrase/3))
-    ;  dcg_constr(GRBody) -> phrase_(GRBody, S0, S)
-    ;  functor(GRBody, _, _) -> call(GRBody, S0, S)
-    ;  throw(error(type_error(callable, GRBody), phrase/3))
+    strip_module(GRBody, M, GRBody1),
+    (  var(GRBody) ->
+       instantiation_error(phrase/3)
+    ;  nonvar(GRBody1),
+       dcg_constr(GRBody1),
+       dcg_body(GRBody1, S0, S, GRBody2) ->
+       call(M:GRBody2)
+    ;  call(M:GRBody1, S0, S)
     ).
 
-phrase_([], S, S).
-phrase_(!, S, S).
-phrase_((A, B), S0, S) :-
-    phrase(A, S0, S1), phrase(B, S1, S).
-phrase_((A -> B ; C), S0, S) :-
-    !,
-    (  phrase(A, S0, S1) ->
-       phrase(B, S1, S)
-    ;  phrase(C, S0, S)
+
+module_call_qualified(M, Call, Call1) :-
+    (  nonvar(M) -> Call1 = M:Call
+    ;  Call = Call1
     ).
-phrase_((A ; B), S0, S) :-
-    (  phrase(A, S0, S) ; phrase(B, S0, S)  ).
-phrase_((A | B), S0, S) :-
-    (  phrase(A, S0, S) ; phrase(B, S0, S)  ).
-phrase_({G}, S0, S) :-
-    (  call(G), S0 = S  ).
-phrase_(call(G), S0, S) :-
-    call(G, S0, S).
-phrase_((A -> B), S0, S) :-
-    phrase((A -> B ; fail), S0, S).
-phrase_(phrase(NonTerminal), S0, S) :-
-    phrase(NonTerminal, S0, S).
-phrase_([T|Ts], S0, S) :-
-    append([T|Ts], S, S0).
+
 
 % The same version of the below two dcg_rule clauses, but with module scoping.
 dcg_rule(( M:NonTerminal, Terminals --> GRBody ), ( M:Head :- Body )) :-
@@ -79,12 +75,14 @@ dcg_body(GRBody, S0, S, Body) :-
     nonvar(GRBody),
     dcg_constr(GRBody),
     dcg_cbody(GRBody, S0, S, Body).
-dcg_body(NonTerminal, S0, S, Goal) :-
+dcg_body(NonTerminal, S0, S, Goal1) :-
     nonvar(NonTerminal),
     \+ dcg_constr(NonTerminal),
     NonTerminal \= ( _ -> _ ),
     NonTerminal \= ( \+ _ ),
-    dcg_non_terminal(NonTerminal, S0, S, Goal).
+    loader:strip_module(NonTerminal, M, NonTerminal0),
+    dcg_non_terminal(NonTerminal0, S0, S, Goal0),
+    module_call_qualified(M, Goal0, Goal1).
 
 % The following constructs in a grammar rule body
 % are defined in the corresponding subclauses.
@@ -131,5 +129,40 @@ dcg_cbody(( GRIf -> GRThen ), S0, S, ( If -> Then )) :-
 
 user:term_expansion(Term0, Term) :-
     nonvar(Term0),
-    dcg_rule(Term0, (Head :- Body)),
-    Term = (Head :- Body).
+    dcg_rule(Term0, Term).
+
+% Describes a sequence
+seq(Xs, Cs0,Cs) :-
+   var(Xs),
+   Cs0 == [],
+   !,
+   Xs = [],
+   Cs0 = Cs.
+seq([]) --> [].
+seq([E|Es]) --> [E], seq(Es).
+
+% Describes a sequence of sequences
+seqq([]) --> [].
+seqq([Es|Ess]) --> seq(Es), seqq(Ess).
+
+% Describes an arbitrary number of elements
+...(Cs0,Cs) :-
+   Cs0 == [],
+   !,
+   Cs0 = Cs.
+... --> [] | [_], ... .
+
+error_goal(error(E, must_be/2), error(E, must_be/2)).
+error_goal(error(E, (=..)/2), error(E, (=..)/2)).
+error_goal(E, _) :- throw(E).
+
+user:goal_expansion(phrase(GRBody, S, S0), GRBody2) :-
+    loader:strip_module(GRBody, M, GRBody0),
+    nonvar(GRBody0),
+    catch(dcgs:dcg_body(GRBody0, S, S0, GRBody1),
+          E,
+          dcgs:error_goal(E, GRBody1)
+         ),
+    module_call_qualified(M, GRBody1, GRBody2).
+
+user:goal_expansion(phrase(GRBody, S), phrase(GRBody, S, [])).

src/lib/debug.pl

@@ -11,6 +11,10 @@
 
 :- use_module(library(format), [portray_clause/1]).
 
+:- meta_predicate *(0).
+:- meta_predicate $(0).
+:- meta_predicate $-(0).
+
 $-(G_0) :-
    catch(G_0, Ex, ( portray_clause(exception:Ex:G_0), throw(Ex) ) ).
 

src/lib/diag.pl

@@ -2,13 +2,23 @@
 
 :- use_module(library(error)).
 
+
 wam_instructions(Clause, Listing) :-
     (  nonvar(Clause) ->
-       Clause = Name / Arity,
-       must_be(atom, Name),
-       must_be(integer, Arity),
-       (  Arity >= 0 -> '$wam_instructions'(Name, Arity, Listing)
-       ;  throw(error(domain_error(not_less_than_zero, Arity), wam_instructions/2))
+       (  Clause = Name / Arity ->
+          fetch_instructions(user, Name, Arity, Listing)
+       ;  Clause = Module : (Name / Arity) ->
+          fetch_instructions(Module, Name, Arity, Listing)
        )
     ;  throw(error(instantiation_error, wam_instructions/2))
     ).
+
+
+fetch_instructions(Module, Name, Arity, Listing) :-
+    must_be(atom, Module),
+    must_be(atom, Name),
+    must_be(integer, Arity),
+    (  Arity >= 0 ->
+       '$wam_instructions'(Module, Name, Arity, Listing)
+    ;  throw(error(domain_error(not_less_than_zero, Arity), wam_instructions/2))
+    ).

src/lib/dif.pl

@@ -8,8 +8,8 @@
 
 put_dif_att(Var, X, Y) :-
     (   get_atts(Var, +dif(Z)) ->
-	sort([X \== Y | Z], NewZ),
-	put_atts(Var, +dif(NewZ))
+	    sort([X \== Y | Z], NewZ),
+	    put_atts(Var, +dif(NewZ))
     ;   put_atts(Var, +dif([X \== Y]))
     ).
 
@@ -21,8 +21,8 @@ dif_set_variables([Var|Vars], X, Y) :-
 append_goals([], _).
 append_goals([Var|Vars], Goals) :-
     (   get_atts(Var, +dif(VarGoals)) ->
-	append(Goals, VarGoals, NewGoals0),
-	sort(NewGoals0, NewGoals)
+	    append(Goals, VarGoals, NewGoals0),
+	    sort(NewGoals0, NewGoals)
     ;   NewGoals = Goals
     ),
     put_atts(Var, +dif(NewGoals)),
@@ -30,23 +30,27 @@ append_goals([Var|Vars], Goals) :-
 
 verify_attributes(Var, Value, Goals) :-
     (   get_atts(Var, +dif(Goals)) ->
-	term_variables(Value, ValueVars),
-	append_goals(ValueVars, Goals)
+	    term_variables(Value, ValueVars),
+	    append_goals(ValueVars, Goals)
     ;   Goals = []
     ).
 
 % Probably the world's worst dif/2 implementation. I'm open to
 % suggestions for improvement.
 
-dif(X, Y) :- X \== Y,
-             (   term_variables(X, XVars), term_variables(Y, YVars),
-	         dif_set_variables(XVars, X, Y),
-		 dif_set_variables(YVars, X, Y)
-	     ).
+dif(X, Y) :-
+    X \== Y,
+    (   X \= Y -> true
+    ;   (   term_variables(X, XVars),
+            term_variables(Y, YVars),
+            dif_set_variables(XVars, X, Y),
+            dif_set_variables(YVars, X, Y)
+        )
+    ).
 
 gather_dif_goals([]) --> [].
 gather_dif_goals([(X \== Y) | Goals]) -->
-    [dif(X, Y)],
+    [dif:dif(X, Y)],
     gather_dif_goals(Goals).
 
 attribute_goals(X) -->

src/lib/error.pl

@@ -1,3 +1,8 @@
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   Written 2018-2022 by Markus Triska (triska@metalevel.at)
+   I place this code in the public domain. Use it in any way you want.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
 :- module(error, [must_be/2,
                   can_be/2,
                   instantiation_error/1,
@@ -5,10 +10,8 @@
                   type_error/3
                   ]).
 
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-   Written September 2018 by Markus Triska (triska@metalevel.at)
-   I place this code in the public domain. Use it in any way you want.
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+:- meta_predicate check_(1, ?, ?).
 
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -25,10 +28,16 @@
 
    Currently, the following types are supported:
 
-       - integer
        - atom
-       - list
        - boolean
+       - character
+       - chars
+       - in_character
+       - integer
+       - list
+       - octet_character
+       - octet_chars
+       - term
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 must_be(Type, Term) :-
@@ -40,14 +49,56 @@ must_be_(Type, _) :-
         instantiation_error(must_be/2).
 must_be_(var, Term) :-
         (   var(Term) -> true
-        ;   throw(error(uninstantiation_error, must_be/2))
+        ;   throw(error(uninstantiation_error(Term), must_be/2))
         ).
 must_be_(integer, Term) :- check_(integer, integer, Term).
+must_be_(not_less_than_zero, N) :-
+        must_be(integer, N),
+        (   N >= 0 -> true
+        ;   domain_error(not_less_than_zero, N, must_be/2)
+        ).
 must_be_(atom, Term)    :- check_(atom, atom, Term).
-must_be_(character, T)  :- check_(character, character, T).
-must_be_(list, Term)    :- check_(ilist, list, Term).
-must_be_(type, Term)    :- check_(type, type, Term).
-must_be_(boolean, Term) :- check_(boolean, boolean, Term).
+must_be_(character, T)  :- check_(error:character, character, T).
+must_be_(in_character, T) :- check_(error:in_character, in_character, T).
+must_be_(chars, Ls) :-
+        can_be(chars, Ls), % prioritize type errors over instantiation errors
+        must_be(list, Ls),
+        (   '$is_partial_string'(Ls) ->
+            % The expected case (success) uses a very fast test.
+            % We cannot use partial_string/1 from library(iso_ext),
+            % because that library itself imports library(error).
+            true
+        ;   all_characters(Ls)
+        ).
+must_be_(octet_character, C) :-
+        must_be(character, C),
+        (   octet_character(C) -> true
+        ;   domain_error(octet_character, C, must_be/2)
+        ).
+must_be_(octet_chars, Cs) :-
+        must_be(chars, Cs),
+        (   '$first_non_octet'(Cs, C) ->
+            domain_error(octet_character, C, must_be/2)
+        ;   true
+        ).
+must_be_(list, Term)    :- check_(error:ilist, list, Term).
+must_be_(type, Term)    :- check_(error:type, type, Term).
+must_be_(boolean, Term) :- check_(error:boolean, boolean, Term).
+must_be_(term, Term)    :-
+        (   \+ ground(Term) ->
+            instantiation_error(must_be/2)
+        ;   \+ acyclic_term(Term) ->
+            type_error(term, Term, must_be/2)
+        ;   true
+        ).
+
+% We cannot use maplist(must_be(character), Cs), because library(lists)
+% uses library(error), so importing it would create a cyclic dependency.
+
+all_characters([]).
+all_characters([C|Cs]) :-
+        must_be(character, C),
+        all_characters(Cs).
 
 check_(Pred, Type, Term) :-
         (   var(Term) -> instantiation_error(must_be/2)
@@ -61,17 +112,35 @@ character(C) :-
         atom(C),
         atom_length(C, 1).
 
-ilist(V) :- var(V), instantiation_error(must_be/2).
-ilist([]).
-ilist([_|Ls]) :- ilist(Ls).
+octet_character(C) :-
+        char_code(C, Code),
+        0 =< Code, Code =< 0xff.
+
+in_character(C) :-
+        (   character(C)
+        ;   C == end_of_file
+        ).
+
+ilist(Ls) :-
+        '$skip_max_list'(_, _, Ls, Rs),
+        (   var(Rs) ->
+            instantiation_error(must_be/2)
+        ;   Rs == []
+        ).
 
 type(type).
 type(integer).
 type(atom).
 type(character).
+type(in_character).
+type(octet_character).
+type(octet_chars).
+type(chars).
 type(list).
 type(var).
 type(boolean).
+type(term).
+type(not_less_than_zero).
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    can_be(Type, Term)
@@ -95,15 +164,51 @@ can_be(Type, Term) :-
         ).
 
 can_(integer, Term) :- integer(Term).
+can_(not_less_than_zero, N) :-
+        (   integer(N) ->
+            (   N >= 0 -> true
+            ;   domain_error(not_less_than_zero, N, can_be/2)
+            )
+        ;   type_error(integer, N, can_be/2)
+        ).
 can_(atom, Term)    :- atom(Term).
 can_(character, T)  :- character(T).
+can_(in_character, T) :- in_character(T).
+can_(chars, Ls)     :-
+        (   '$is_partial_string'(Ls) -> true
+        ;   can_be(list, Ls),
+            can_be_chars(Ls)
+        ).
+can_(octet_character, C) :-
+        (   octet_character(C) -> true
+        ;   domain_error(octet_character, C, can_be/2)
+        ).
+can_(octet_chars, Cs) :-
+        can_be(chars, Cs),
+        (   '$skip_max_list'(_, _, Cs, []), % temporarily turn Cs into a list
+            '$first_non_octet'(Cs, C) ->
+            domain_error(octet_character, C, can_be/2)
+        ;   true
+        ).
 can_(list, Term)    :- list_or_partial_list(Term).
 can_(boolean, Term) :- boolean(Term).
+can_(term, Term)    :-
+        (   acyclic_term(Term) ->
+            true
+        ;   type_error(term, Term, can_be/2)
+        ).
 
-list_or_partial_list(Var) :- var(Var).
-list_or_partial_list([]).
-list_or_partial_list([_|Ls]) :-
-        list_or_partial_list(Ls).
+can_be_chars(Var) :- var(Var), !.
+can_be_chars([]).
+can_be_chars([X|Xs]) :-
+        can_be(character, X),
+        can_be_chars(Xs).
+
+list_or_partial_list(Ls) :-
+        '$skip_max_list'(_, _, Ls, Rs),
+        (   var(Rs) -> true
+        ;   Rs == []
+        ).
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Shorthands for throwing ISO errors.

src/lib/files.pl

@@ -1,5 +1,5 @@
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-   Written June 2020 by Markus Triska (triska@metalevel.at)
+   Written 2020, 2022 by Markus Triska (triska@metalevel.at)
    Part of Scryer Prolog.
 
    Predicates for reasoning about files and directories.
@@ -51,7 +51,10 @@
                   file_exists/1,
                   directory_exists/1,
                   delete_file/1,
+				  rename_file/2,
+				  delete_directory/1,
                   make_directory/1,
+                  make_directory_path/1,
                   working_directory/2,
                   path_canonical/2,
                   path_segments/2,
@@ -62,37 +65,58 @@
 :- use_module(library(error)).
 :- use_module(library(lists)).
 :- use_module(library(charsio)).
-
-list_of_chars(Cs) :-
-        must_be(list, Cs),
-        maplist(must_be(character), Cs).
+:- use_module(library(dcgs)).
 
 directory_files(Directory, Files) :-
-        list_of_chars(Directory),
+        must_be(chars, Directory),
         can_be(list, Files),
         '$directory_files'(Directory, Files).
 
 file_size(File, Size) :-
-        list_of_chars(File),
+        file_must_exist(File, file_size/2),
         can_be(integer, Size),
         '$file_size'(File, Size).
 
 file_exists(File) :-
-        list_of_chars(File),
+        must_be(chars, File),
         '$file_exists'(File).
 
 directory_exists(Directory) :-
-        list_of_chars(Directory),
+        must_be(chars, Directory),
         '$directory_exists'(Directory).
 
 make_directory(Directory) :-
-        list_of_chars(Directory),
+        must_be(chars, Directory),
         '$make_directory'(Directory).
 
+make_directory_path(Directory) :-
+        must_be(chars, Directory),
+        '$make_directory_path'(Directory).
+
 delete_file(File) :-
-        list_of_chars(File),
+        file_must_exist(File, delete_file/1),
         '$delete_file'(File).
 
+rename_file(File, Renamed) :-
+        file_must_exist(File, rename_file/2),
+        must_be(chars, Renamed),
+        '$rename_file'(File, Renamed).
+
+delete_directory(Directory) :-
+        directory_must_exist(Directory, delete_directory/1),
+        must_be(chars, Directory),
+        '$delete_directory'(Directory).
+
+file_must_exist(File, Context) :-
+        (   file_exists(File) -> true
+        ;   throw(error(existence_error(file, File), Context))
+        ).
+
+directory_must_exist(Directory, Context) :-
+        (   directory_exists(Directory) -> true
+        ;   throw(error(existence_error(directory, Directory), Context))
+        ).
+
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Dir0 is the current working directory, and the working directory
    is changed to Dir.
@@ -120,8 +144,7 @@ working_directory(Dir0, Dir) :-
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 path_canonical(Ps, Cs) :-
-        must_be(list, Ps),
-        maplist(must_be(character), Ps),
+        must_be(chars, Ps),
         can_be(list, Cs),
         '$path_canonical'(Ps, Cs).
 
@@ -142,8 +165,9 @@ file_creation_time(File, T) :-
         file_time_(File, creation, T).
 
 file_time_(File, Which, T) :-
+        file_must_exist(File, file_time_/3),
         '$file_time'(File, Which, T0),
-        read_term_from_chars(T0, T).
+        read_from_chars(T0, T).
 
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -158,39 +182,36 @@ file_time_(File, Which, T) :-
    Examples:
 
       ?- path_segments("/hello/there", Segments).
-         Segments = [[],"hello","there"]
-      ;  false.
+         Segments = [[],"hello","there"].
 
       ?- path_segments(Path, ["hello","there"]).
-         Path = "hello/there"
-      ;  false.
+         Path = "hello/there".
 
 
    To obtain the platform-specific directory separator, you can use:
 
       ?- path_segments(Separator, ["",""]).
-         Separator = "/"
-      ;  false.
+         Separator = "/".
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 path_segments(Path, Segments) :-
         '$directory_separator'(Sep),
         (   var(Path) ->
             must_be(list, Segments),
-            maplist(list_of_chars, Segments),
-            append_with_separator(Segments, Sep, Path)
-        ;   list_of_chars(Path),
+            maplist(must_be(chars), Segments),
+            phrase(append_with_separator(Segments, Sep), Path)
+        ;   must_be(chars, Path),
             path_to_segments(Path, Sep, Segments)
         ).
 
-append_with_separator([], _, []).
-append_with_separator([Segment|Segments], Sep, Path) :-
-        append_with_separator_(Segments, Segment, Sep, Path).
+append_with_separator([], _) --> [].
+append_with_separator([Segment|Segments], Sep) -->
+        append_with_separator_(Segments, Segment, Sep).
 
-append_with_separator_([], Segment, _, Segment).
-append_with_separator_([Segment|Segments], Prev, Sep, Path) :-
-        append(Prev, [Sep|Rest], Path),
-        append_with_separator_(Segments, Segment, Sep, Rest).
+append_with_separator_([], Segment, _) --> seq(Segment).
+append_with_separator_([Segment|Segments], Prev, Sep) -->
+        seq(Prev), [Sep],
+        append_with_separator_(Segments, Segment, Sep).
 
 path_to_segments(Path, Sep, Segments) :-
         (   append(Front, [Sep|Ps], Path) ->

src/lib/format.pl

@@ -1,5 +1,5 @@
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-   Written March 2020 by Markus Triska (triska@metalevel.at)
+   Written 2020, 2021, 2022 by Markus Triska (triska@metalevel.at)
    Part of Scryer Prolog.
 
    This library provides the nonterminal format_//2 to describe
@@ -28,9 +28,13 @@
            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)
+     ~NU   like ~ND, using "_" (underscore) to separate groups of digits
+     ~NL   format an integer so that at most N digits appear on a line.
+           If N is 0 or omitted, it defaults to 72.
      ~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.
+           If N is omitted, it defaults to 8 (octal).
      ~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
@@ -55,7 +59,12 @@
 
    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).
+   with maplist(put_char, Ls) or, much faster, with format("~s", [Ls]).
+   Ideally, however, you use phrase_to_file/[2,3] or phrase_to_stream/2
+   from library(pio) to write the described list directly to a file
+   or stream, respectively: phrase_to_stream(format_(..., [...]), S).
+   The advantage of this is that an ideal implementation writes
+   the characters as they become known, without manifesting the list.
 
    The entire library only works if the Prolog flag double_quotes
    is set to chars, the default value in Scryer Prolog. This should
@@ -64,8 +73,7 @@
    Example:
 
    ?- phrase(format_("~s~n~`.t~w!~12|", ["hello",there]), Cs).
-   %@    Cs = "hello\n......there!"
-   %@ ;  false.
+   %@    Cs = "hello\n......there!".
 
    I place this code in the public domain. Use it in any way you want.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
@@ -73,6 +81,7 @@
 :- module(format, [format_//2,
                    format/2,
                    format/3,
+                   portray_clause_//1,
                    portray_clause/1,
                    portray_clause/2,
                    listing/1
@@ -83,11 +92,13 @@
 :- use_module(library(error)).
 :- use_module(library(charsio)).
 :- use_module(library(between)).
+:- use_module(library(pio)).
 
 format_(Fs, Args) -->
         { must_be(list, Fs),
           must_be(list, Args),
-          phrase(cells(Fs,Args,0,[]), Cells) },
+          unique_variable_names(Args, VNs),
+          phrase(cells(Fs,Args,0,[],VNs), Cells) },
         format_cells(Cells).
 
 format_cells([]) --> [].
@@ -120,14 +131,11 @@ format_elements([E|Es]) -->
         format_element(E),
         format_elements(Es).
 
-format_element(chars(Cs)) --> list(Cs).
+format_element(chars(Cs)) --> seq(Cs).
 format_element(glue(Fill,Num)) -->
         { length(Ls, Num),
           maplist(=(Fill), Ls) },
-        list(Ls).
-
-list([]) --> [].
-list([L|Ls]) --> [L], list(Ls).
+        seq(Ls).
 
 elements_gluevars([], N, N) --> [].
 elements_gluevars([E|Es], N0, N) -->
@@ -141,7 +149,7 @@ element_gluevar(glue(_,V), N, N) --> [V].
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Our key datastructure is a list of cells and newlines.
-   A cell has the shape from_to(From,To,Elements), where
+   A cell has the shape cell(From,To,Elements), where
    From and To denote the positions of surrounding tab stops.
 
    Elements is a list of elements that occur in a cell,
@@ -153,26 +161,26 @@ element_gluevar(glue(_,V), N, N) --> [V].
    available space is distributed.
 
    newline is used if ~n occurs in a format string.
-   It is is used because a newline character does not
+   It is used because a newline character does not
    consume whitespace in the sense of format strings.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
-cells([], Args, Tab, Es) -->
+cells([], Args, Tab, Es, _) --> !,
         (   { Args == [] } -> cell(Tab, Tab, Es)
         ;   { domain_error(empty_list, Args, format_//2) }
         ).
-cells([~,~|Fs], Args, Tab, Es) --> !,
-        cells(Fs, Args, Tab, [chars("~")|Es]).
-cells([~,w|Fs], [Arg|Args], Tab, Es) --> !,
-        { write_term_to_chars(Arg, [], Chars) },
-        cells(Fs, Args, Tab, [chars(Chars)|Es]).
-cells([~,q|Fs], [Arg|Args], Tab, Es) --> !,
-        { write_term_to_chars(Arg, [quoted(true)], Chars) },
-        cells(Fs, Args, Tab, [chars(Chars)|Es]).
-cells([~,a|Fs], [Arg|Args], Tab, Es) --> !,
+cells([~,~|Fs], Args, Tab, Es, VNs) --> !,
+        cells(Fs, Args, Tab, [chars("~")|Es], VNs).
+cells([~,w|Fs], [Arg|Args], Tab, Es, VNs) --> !,
+        { write_term_to_chars(Arg, [numbervars(true),variable_names(VNs)], Chars) },
+        cells(Fs, Args, Tab, [chars(Chars)|Es], VNs).
+cells([~,q|Fs], [Arg|Args], Tab, Es, VNs) --> !,
+        { write_term_to_chars(Arg, [quoted(true),numbervars(true),variable_names(VNs)], Chars) },
+        cells(Fs, Args, Tab, [chars(Chars)|Es], VNs).
+cells([~,a|Fs], [Arg|Args], Tab, Es, VNs) --> !,
         { atom_chars(Arg, Chars) },
-        cells(Fs, Args, Tab, [chars(Chars)|Es]).
-cells([~|Fs0], Args0, Tab, Es) -->
+        cells(Fs, Args, Tab, [chars(Chars)|Es], VNs).
+cells([~|Fs0], Args0, Tab, Es, VNs) -->
         { numeric_argument(Fs0, Num, [d|Fs], Args0, [Arg0|Args]) },
         !,
         { Arg is Arg0, % evaluate compound expression
@@ -184,44 +192,52 @@ cells([~|Fs0], Args0, Tab, Es) -->
                   Delta is Num - L,
                   length(Zs, Delta),
                   maplist(=('0'), Zs),
-                  phrase(("0.",list(Zs),list(Cs0)), Cs)
+                  phrase(("0.",seq(Zs),seq(Cs0)), Cs)
               ;   BeforeComma is L - Num,
                   length(Bs, BeforeComma),
                   append(Bs, Ds, Cs0),
-                  phrase((list(Bs),".",list(Ds)), Cs)
+                  phrase((seq(Bs),".",seq(Ds)), Cs)
               ) }
         ),
-        cells(Fs, Args, Tab, [chars(Cs)|Es]).
-cells([~|Fs0], Args0, Tab, Es) -->
+        cells(Fs, Args, Tab, [chars(Cs)|Es], VNs).
+cells([~|Fs0], Args0, Tab, Es, VNs) -->
         { numeric_argument(Fs0, Num, ['D'|Fs], Args0, [Arg|Args]) },
         !,
-        { number_chars(Num, NCs),
-          phrase(("~",list(NCs),"d"), FStr),
-          phrase(format_(FStr, [Arg]), Cs0),
-          phrase(upto_what(Bs0, .), Cs0, Ds),
-          reverse(Bs0, Bs1),
-          phrase(groups_of_three(Bs1), Bs2),
-          reverse(Bs2, Bs),
-          append(Bs, Ds, Cs) },
-        cells(Fs, Args, Tab, [chars(Cs)|Es]).
-cells([~,i|Fs], [_|Args], Tab, Es) --> !,
-        cells(Fs, Args, Tab, Es).
-cells([~,n|Fs], Args, Tab, Es) --> !,
+        { separate_digits_fractional(Arg, ',', Num, Cs) },
+        cells(Fs, Args, Tab, [chars(Cs)|Es], VNs).
+cells([~|Fs0], Args0, Tab, Es, VNs) -->
+        { numeric_argument(Fs0, Num, ['U'|Fs], Args0, [Arg|Args]) },
+        !,
+        { separate_digits_fractional(Arg, '_', Num, Cs) },
+        cells(Fs, Args, Tab, [chars(Cs)|Es], VNs).
+cells([~|Fs0], Args0, Tab, Es, VNs) -->
+        { numeric_argument(Fs0, Num0, ['L'|Fs], Args0, [Arg|Args]) },
+        !,
+        { (   Num0 =:= 0 ->
+              Num = 72
+          ;   Num = Num0
+          ),
+          phrase(format_("~d", [Arg]), Cs0),
+          phrase(split_lines_width(Cs0, Num), Cs) },
+        cells(Fs, Args, Tab, [chars(Cs)|Es], VNs).
+cells([~,i|Fs], [_|Args], Tab, Es, VNs) --> !,
+        cells(Fs, Args, Tab, Es, VNs).
+cells([~,n|Fs], Args, Tab, Es, VNs) --> !,
         cell(Tab, Tab, Es),
         n_newlines(1),
-        cells(Fs, Args, 0, []).
-cells([~|Fs0], Args0, Tab, Es) -->
+        cells(Fs, Args, 0, [], VNs).
+cells([~|Fs0], Args0, Tab, Es, VNs) -->
         { numeric_argument(Fs0, Num, [n|Fs], Args0, Args) },
         !,
         cell(Tab, Tab, Es),
         n_newlines(Num),
-        cells(Fs, Args, 0, []).
-cells([~,s|Fs], [Arg|Args], Tab, Es) --> !,
-        cells(Fs, Args, Tab, [chars(Arg)|Es]).
-cells([~,f|Fs], [Arg|Args], Tab, Es) --> !,
+        cells(Fs, Args, 0, [], VNs).
+cells([~,s|Fs], [Arg|Args], Tab, Es, VNs) --> !,
+        cells(Fs, Args, Tab, [chars(Arg)|Es], VNs).
+cells([~,f|Fs], [Arg|Args], Tab, Es, VNs) --> !,
         { format_number_chars(Arg, Chars) },
-        cells(Fs, Args, Tab, [chars(Chars)|Es]).
-cells([~|Fs0], Args0, Tab, Es) -->
+        cells(Fs, Args, Tab, [chars(Chars)|Es], VNs).
+cells([~|Fs0], Args0, Tab, Es, VNs) -->
         { numeric_argument(Fs0, Num, [f|Fs], Args0, [Arg|Args]) },
         !,
         { format_number_chars(Arg, Cs0),
@@ -248,39 +264,50 @@ cells([~|Fs0], Args0, Tab, Es) -->
               ),
               append(Bs, ['.'|Ds], Chars)
           ) },
-        cells(Fs, Args, Tab, [chars(Chars)|Es]).
-cells([~|Fs0], Args0, Tab, Es) -->
+        cells(Fs, Args, Tab, [chars(Chars)|Es], VNs).
+cells([~,r|Fs], Args, Tab, Es, VNs) --> !,
+        cells([~,'8',r|Fs], Args, Tab, Es, VNs).
+cells([~|Fs0], Args0, Tab, Es, VNs) -->
         { 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) -->
+        cells(Fs, Args, Tab, [chars(Cs)|Es], VNs).
+cells([~,'R'|Fs], Args, Tab, Es, VNs) --> !,
+        cells([~,'8','R'|Fs], Args, Tab, Es, VNs).
+cells([~|Fs0], Args0, Tab, Es, VNs) -->
         { numeric_argument(Fs0, Num, ['R'|Fs], Args0, [Arg|Args]) },
         !,
         { integer_to_radix(Arg, Num, uppercase, Cs) },
-        cells(Fs, Args, Tab, [chars(Cs)|Es]).
-cells([~,'`',Char,t|Fs], Args, Tab, Es) --> !,
-        cells(Fs, Args, Tab, [glue(Char,_)|Es]).
-cells([~,t|Fs], Args, Tab, Es) --> !,
-        cells(Fs, Args, Tab, [glue(' ',_)|Es]).
-cells([~|Fs0], Args0, Tab, Es) -->
+        cells(Fs, Args, Tab, [chars(Cs)|Es], VNs).
+cells([~,'`',Char,t|Fs], Args, Tab, Es, VNs) --> !,
+        cells(Fs, Args, Tab, [glue(Char,_)|Es], VNs).
+cells([~,t|Fs], Args, Tab, Es, VNs) --> !,
+        cells(Fs, Args, Tab, [glue(' ',_)|Es], VNs).
+cells([~,'|'|Fs], Args, Tab0, Es, VNs) --> !,
+        { phrase(elements_gluevars(Es, 0, Width), _),
+          Tab is Tab0 + Width },
+        cell(Tab0, Tab, Es),
+        cells(Fs, Args, Tab, [], VNs).
+cells([~|Fs0], Args0, Tab, Es, VNs) -->
         { numeric_argument(Fs0, Num, ['|'|Fs], Args0, Args) },
         !,
         cell(Tab, Num, Es),
-        cells(Fs, Args, Num, []).
-cells([~|Fs0], Args0, Tab0, Es) -->
+        cells(Fs, Args, Num, [], VNs).
+cells([~|Fs0], Args0, Tab0, Es, VNs) -->
         { numeric_argument(Fs0, Num, [+|Fs], Args0, Args) },
         !,
         { Tab is Tab0 + Num },
         cell(Tab0, Tab, Es),
-        cells(Fs, Args, Tab, []).
-cells([~,C|_], _, _, _) -->
-        { atom_chars(A, [~,C]),
-          domain_error(format_string, A, format_//2) }.
-cells(Fs0, Args, Tab, Es) -->
+        cells(Fs, Args, Tab, [], VNs).
+cells([~|Cs], Args, _, _, _) -->
+        (   { Args == [] } ->
+            { domain_error(non_empty_list, [], format_//2) }
+        ;   { domain_error(format_string, [~|Cs], format_//2) }
+        ).
+cells(Fs0, Args, Tab, Es, VNs) -->
         { phrase(upto_what(Fs1, ~), Fs0, Fs),
           Fs1 = [_|_] },
-        cells(Fs, Args, Tab, [chars(Fs1)|Es]).
+        cells(Fs, Args, Tab, [chars(Fs1)|Es], VNs).
 
 format_number_chars(N0, Chars) :-
         N is N0, % evaluate compound expression
@@ -296,12 +323,30 @@ Cs = [a,b,c], Rest = [~,t,e,s,t].
 Cs = [a,b,c], Rest = [].
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
+separate_digits_fractional(Arg, Sep, Num, Cs) :-
+        number_chars(Num, NCs),
+        phrase(("~",seq(NCs),"d"), FStr),
+        phrase(format_(FStr, [Arg]), Cs0),
+        phrase(upto_what(Bs0, .), Cs0, Ds),
+        reverse(Bs0, Bs1),
+        phrase(groups_of_three(Bs1,Sep), Bs2),
+        reverse(Bs2, Bs),
+        append(Bs, Ds, Cs).
+
 upto_what([], W), [W] --> [W], !.
 upto_what([C|Cs], W) --> [C], !, upto_what(Cs, W).
 upto_what([], _) --> [].
 
-groups_of_three([A,B,C,D|Rs]) --> !, [A,B,C], ",", groups_of_three([D|Rs]).
-groups_of_three(Ls) --> list(Ls).
+groups_of_three([A,B,C,D|Rs], Sep) --> !, [A,B,C,Sep], groups_of_three([D|Rs], Sep).
+groups_of_three(Ls, _) --> seq(Ls).
+
+split_lines_width(Cs, Num) -->
+        (   { length(Prefix, Num),
+              append(Prefix, [R|Rs], Cs) } ->
+            seq(Prefix), "_\n",
+            split_lines_width([R|Rs], Num)
+        ;   seq(Cs)
+        ).
 
 cell(From, To, Es0) -->
         (   { Es0 == [] } -> []
@@ -309,37 +354,39 @@ cell(From, To, Es0) -->
             [cell(From,To,Es)]
         ).
 
-%?- numeric_argument("2f", Num, ['f'|Fs], Args0, Args).
+%?- format:numeric_argument("2f", Num, [f|Fs], Args0, Args).
 
-%?- numeric_argument("100b", Num, Rs, Args0, Args).
+%?- format:numeric_argument("100b", Num, Rs, Args0, Args).
 
 numeric_argument(Ds, Num, Rest, Args0, Args) :-
         (   Ds = [*|Rest] ->
             Args0 = [Num|Args]
-        ;   numeric_argument_(Ds, [], Ns, Rest),
-            foldl(pow10, Ns, 0-0, Num-_),
+        ;   phrase(numeric_argument_(Ds, Rest), Ns),
+            foldl(plus_times10, Ns, 0, Num),
             Args0 = Args
         ).
 
-numeric_argument_([D|Ds], Ns0, Ns, Rest) :-
-        (   member(D, "0123456789") ->
-            number_chars(N, [D]),
-            numeric_argument_(Ds, [N|Ns0], Ns, Rest)
-        ;   Ns = Ns0,
-            Rest = [D|Ds]
+numeric_argument_([D|Ds], Rest) -->
+        (   { member(D, "0123456789") } ->
+            { number_chars(N, [D]) },
+            [N],
+            numeric_argument_(Ds, Rest)
+        ;   { Rest = [D|Ds] }
         ).
 
 
-pow10(D, N0-Pow0, N-Pow) :-
-        N is N0 + D*10^Pow0,
-        Pow is Pow0 + 1.
+plus_times10(D, N0, N) :- N is D + N0*10.
+
+radix_error(lowercase, R) --> format_("~~~dr", [R]).
+radix_error(uppercase, R) --> format_("~~~dR", [R]).
 
 integer_to_radix(I0, R, Which, Cs) :-
         I is I0, % evaluate compound expression
         must_be(integer, I),
         must_be(integer, R),
         (   \+ between(2, 36, R) ->
-            domain_error(radix, R, format_//2)
+            phrase(radix_error(Which,R), Es),
+            domain_error(format_string, Es, format_//2)
         ;   true
         ),
         digits(Which, Ds),
@@ -355,8 +402,7 @@ integer_to_radix_(0, _, _) --> !.
 integer_to_radix_(I0, R, Ds) -->
         { M is I0 mod R,
           nth0(M, Ds, D),
-          I is I0 // R
-          },
+          I is I0 // R },
         [D],
         integer_to_radix_(I, R, Ds).
 
@@ -373,62 +419,54 @@ format(Fs, Args) :-
         format(Stream, Fs, Args).
 
 format(Stream, Fs, Args) :-
-        phrase(format_(Fs, Args), Cs),
-        % we use a specialised internal predicate that uses only a
-        % single "write" operation for efficiency. It is equivalent to
-        % maplist(put_char(Stream), Cs). It also works for binary streams.
-        '$put_chars'(Stream, Cs),
+        phrase_to_stream(format_(Fs, Args), Stream),
         flush_output(Stream).
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-?- phrase(cells("hello", [], 0, []), Cs).
+?- phrase(format:cells("hello", [], 0, [], []), Cs).
 
-?- phrase(cells("hello~10|", [], 0, []), Cs).
-?- phrase(cells("~ta~t~10|", [], 0, []), Cs).
+?- phrase(format:cells("hello~10|", [], 0, [], []), Cs).
+?- phrase(format:cells("~ta~t~10|", [], 0, [], []), Cs).
 
 ?- phrase(format_("~`at~50|", []), Ls).
 
-?- phrase(cells("~`at~50|", [], 0, []), Cs),
-   phrase(format_cells(Cs), Ls).
-?- phrase(cells("~ta~t~tb~tc~21|", [], 0, []), Cs).
-Cs = [cell(0,21,[glue(' ',_38),chars([a]),glue(' ',_62),glue(' ',_67),chars([b]),glue(' ',_91),chars([c])])].
-?- phrase(cells("~ta~t~4|", [], 0, []), Cs).
-Cs = [cell(0,4,[glue(' ',_38),chars([a]),glue(' ',_62)])].
+?- phrase(format:cells("~`at~50|", [], 0, [], []), Cs),
+   phrase(format:format_cells(Cs), Ls).
+?- phrase(format:cells("~ta~t~tb~tc~21|", [], 0, [], []), Cs).
+Cs = [cell(0,21,[glue(' ',_A),chars("a"),glue(' ',_B),glue(' ',_C),chars("b"),glue(' ',_D),chars("c ...")])]
+?- phrase(format:cells("~ta~t~4|", [], 0, [], []), Cs).
+Cs = [cell(0,4,[glue(' ',_A),chars("a"),glue(' ',_B)])]
 
-?- phrase(format_cell(cell(0,1,[glue(a,_94)])), Ls).
+?- phrase(format:format_cell(cell(0,1,[glue(a,_94)])), Ls).
 
-?- phrase(format_cell(cell(0,50,[chars("hello")])), Ls).
+?- phrase(format:format_cell(cell(0,50,[chars("hello")])), Ls).
 
 ?- phrase(format_("~`at~50|~n", []), Ls).
 ?- phrase(format_("hello~n~tthere~6|", []), Ls).
 
 ?- format("~ta~t~4|", []).
- a     true
-;  false.
+ a     true.
 
 ?- format("~ta~tb~tc~10|", []).
-  a  b   c   true
-;  false.
+  a  b   c   true.
 
 ?- format("~tabc~3|", []).
 
 ?- format("~ta~t~4|", []).
 
 ?- format("~ta~t~tb~tc~20|", []).
-    a        b     c   true
-;  false.
+    a        b     c   true.
 
 ?- format("~2f~n", [3]).
 3.00
-   true
+   true.
 
 ?- format("~20f", [0.1]).
-0.10000000000000000000   true % this should use higher accuracy!
-;  false.
+0.10000000000000000000   true.
 
 ?- X is atan(2), format("~7f~n", [X]).
 1.1071487
-   X = 1.1071487177940906
+   X = 1.1071487177940906.
 
 ?- format("~`at~50|~n", []).
 aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
@@ -437,10 +475,10 @@ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
 ?- format("~t~N", []).
 
 ?- format("~q", [.]).
-'.'   true
+'.'   true.
 
 ?- format("~12r", [300]).
-210   true
+210   true.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -458,21 +496,24 @@ portray_clause(Term) :-
         portray_clause(Out, Term).
 
 portray_clause(Stream, Term) :-
-        phrase(portray_clause_(Term), Ls),
-        format(Stream, "~s", [Ls]).
+        phrase_to_stream(portray_clause_(Term), Stream),
+        flush_output(Stream).
 
 portray_clause_(Term) -->
-        { term_variables(Term, Vs),
-          foldl(var_name, Vs, VNs, 0, _) },
+        { unique_variable_names(Term, VNs) },
         portray_(Term, VNs), ".\n".
 
+unique_variable_names(Term, VNs) :-
+        term_variables(Term, Vs),
+        foldl(var_name, Vs, VNs, 0, _).
+
 var_name(V, Name=V, Num0, Num) :-
         charsio:fabricate_var_name(numbervars, Name, Num0),
         Num is Num0 + 1.
 
 literal(Lit, VNs) -->
         { write_term_to_chars(Lit, [quoted(true),variable_names(VNs)], Ls) },
-        list(Ls).
+        seq(Ls).
 
 portray_(Var, VNs) --> { var(Var) }, !, literal(Var, VNs).
 portray_((Head :- Body), VNs) --> !,
@@ -490,35 +531,50 @@ body_(Var, C, I, VNs) --> { var(Var) }, !,
 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) },
+body_(Body, C, I, VNs) -->
+        { body_if_then_else(Body, If, Then, Else) },
         !,
         indent_to(C, I),
         "(  ",
         { C1 is I + 3 },
         body_(If, C1, C1, VNs), " ->\n",
         body_(Then, 0, C1, VNs), "\n",
-        else_branch(Else, C1, I, VNs).
+        else_branch(Else, I, VNs).
 body_((A;B), C, I, VNs) --> !,
         indent_to(C, I),
         "(  ",
         { C1 is I + 3 },
         body_(A, C1, C1, VNs), "\n",
-        else_branch(B, C1, I, VNs).
+        else_branch(B, I, VNs).
 body_(Goal, C, I, VNs) -->
         indent_to(C, I), literal(Goal, VNs).
 
 
-else_branch(Else, C, I, VNs) -->
+% True iff Body has the shape ( If -> Then ; Else ).
+body_if_then_else(Body, If, Then, Else) :-
+        nonvar(Body),
+        Body = (A ; Else),
+        nonvar(A),
+        A = (If -> Then).
+
+else_branch(Else, I, VNs) -->
         indent_to(0, I),
         ";  ",
-        body_(Else, C, C, VNs), "\n",
-        indent_to(0, I),
-        ")".
+        { C is I + 3 },
+        (   { body_if_then_else(Else, If, Then, NextElse) } ->
+            body_(If, C, C, VNs), " ->\n",
+            body_(Then, 0, C, VNs), "\n",
+            else_branch(NextElse, I, VNs)
+        ;   { nonvar(Else), Else = ( A ; B ) } ->
+            body_(A, C, C, VNs), "\n",
+            else_branch(B, I, VNs)
+        ;   body_(Else, C, C, VNs), "\n",
+            indent_to(0, I),
+            ")"
+        ).
 
 indent_to(CurrentColumn, Indent) -->
-        { Delta is Indent - CurrentColumn },
-        format_("~t~*|", [Delta]).
+        format_("~t~*|", [Indent-CurrentColumn]).
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 ?- portray_clause(a).
@@ -533,7 +589,7 @@ a :-
    b,
    c,
    d.
-   true
+   true.
 
 
 ?- portray_clause([a,b,c,d]).

src/lib/freeze.pl

@@ -3,6 +3,8 @@
 :- use_module(library(atts)).
 :- use_module(library(dcgs)).
 
+:- meta_predicate freeze(-, 0).
+
 :- attribute frozen/1.
 
 verify_attributes(Var, Other, Goals) :-

src/lib/http/http_open.pl

@@ -1,5 +1,5 @@
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-   Written June 2020 by Markus Triska (triska@metalevel.at)
+   Written 2022 by Adrián Arroyo Calle (adrian.arroyocalle@gmail.com)
    Part of Scryer Prolog.
 
    http_open(+Address, -Stream, +Options)
@@ -7,78 +7,62 @@
 
    Yields Stream to read the body of an HTTP reply from Address.
    Address is a list of characters, and includes the method. Both HTTP
-   and HTTPS are supported. Redirects are followed.
+   and HTTPS are supported.
 
-   Currently, Options must be the empty list. Options may be
-   added in the future to give more control over the connection.
+   Options supported:
 
-   We use HTTP/1.0 until we can read chunked transfer-encoding.
+     * method(+Method): Sets the HTTP method of the call. Method can be get (default), head, delete, post, put or patch.
+     * data(+Data): Data to be sent in the request. Useful for POST, PUT and PATCH operations.
+     * size(-Size): Unifies with the value of the Content-Length header
+     * request_headers(+RequestHeaders): Headers to be used in the request
+     * headers(-ListHeaders): Unifies with a list with all headers returned in the response
+     * status_code(-Code): Unifies with the status code of the request (200, 201, 404, ...)
 
    Example:
 
        ?- http_open("https://github.com/mthom/scryer-prolog", S, []).
-       %@    S = '$stream'(0x7f86f94a6cd0)
-       %@ ;  false.
+       %@    S = '$stream'(0x7fcfc9e00f00).
 
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 :- module(http_open, [http_open/3]).
 
-:- use_module(library(sockets)).
-:- use_module(library(error)).
-:- use_module(library(format)).
-:- use_module(library(charsio)).
-:- use_module(library(dcgs)).
-:- use_module(library(lists), [member/2]).
+:- use_module(library(lists)).
 
-http_open(Address, Stream, Options) :-
-        must_be(list, Options),
-        must_be(list, Address),
-        once(phrase((list(SchemeCs), "://", list(Rest)), Address)),
-        atom_chars(Scheme, SchemeCs),
-        chars_host_url(Rest, Host, URL),
-        connect(Scheme, Host, Stream0),
-        format(Stream0, "\
-GET ~s HTTP/1.0\r\n\
-Host: ~w\r\n\
-User-Agent: Scryer Prolog\r\n\
-Connection: close\r\n\r\n\
-", [URL,Host]),
-        read_line_to_chars(Stream0, StatusLine, []),
-        once(phrase(("HTTP/1.",(['0']|['1'])," ",[D1]), StatusLine, _)),
-        read_header_lines(Stream0, HeaderLines),
-        handle_response(D1, HeaderLines, Stream0, Stream).
+http_open(Address, Response, Options) :-
+    parse_http_options(Options, OptionValues),
+    ( member(method(Method), OptionValues) -> true; Method = get),
+    ( member(data(Data), OptionValues) -> true; Data = []),
+    ( member(request_headers(RequestHeaders), OptionValues) -> true; RequestHeaders = ['user-agent'("Scryer Prolog")]),
+    ( member(status_code(Code), OptionValues) -> true; true),
+    ( member(headers(Headers), OptionValues) -> true; true),
+    ( member(size(Size), OptionValues) -> member('content-length'(Size), Headers); true),
+    '$http_open'(Address, Response, Method, Code, Data, Headers, RequestHeaders).
 
-list([]) --> [].
-list([L|Ls]) --> [L], list(Ls).
+parse_http_options(Options, OptionValues) :-
+    maplist(parse_http_options_, Options, OptionValues).
 
-handle_response('2', _, Stream, Stream).              % ok
-handle_response('3', HeaderLines, Stream0, Stream) :- % redirect
-        close(Stream0),
-        once((member(Line, HeaderLines),
-              phrase(("Location: ",list(Location),"\r\n"), Line))),
-        http_open(Location, Stream, []).
+parse_http_options_(method(Method), method(Method)) :-
+    (  var(Method) ->
+       throw(error(instantiation_error, http_open/3))
+    ;
+       member(Method, [get, post, put, delete, patch, head]) -> true
+    ;
+       throw(error(domain_error(http_option, method(Method)), _))
+    ).
 
-% Status-Line = HTTP-Version SP Status-Code SP Reason-Phrase CRLF
+parse_http_options_(data(Data), data(Data)) :-
+    (  var(Data) ->
+       throw(error(instantiation_error, http_open/3))
+    ;  true
+    ).
 
-read_header_lines(Stream, Hs) :-
-        read_line_to_chars(Stream, Cs, []),
-        (   Cs == "" -> Hs = []
-        ;   Cs == "\r\n" -> Hs = []
-        ;   Hs = [Cs|Rest],
-            read_header_lines(Stream, Rest)
-        ).
-
-chars_host_url(Cs, Host, [/|Us]) :-
-        (   phrase((list(Hs),"/",list(Us)), Cs) ->
-            true
-        ;   Hs = Cs,
-            Us = []
-        ),
-        atom_chars(Host, Hs).
-
-connect(https, Host, Stream) :-
-        socket_client_open(Host:443, Stream, [tls(true)]).
-connect(http, Host, Stream) :-
-        socket_client_open(Host:80, Stream, []).
+parse_http_options_(request_headers(Headers), request_headers(Headers)) :-
+    (  var(Headers) ->
+       throw(error(instantiation_error, http_open/3))
+    ;  true
+    ).
 
+parse_http_options_(size(Size), size(Size)).
+parse_http_options_(status_code(Code), status_code(Code)).
+parse_http_options_(headers(Headers), headers(Headers)).

src/lib/http/http_server.pl

@@ -0,0 +1,315 @@
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   Written in December 2020 by Adrián Arroyo (adrian.arroyocalle@gmail.com)
+   Updated in March 2022 by Adrián Arroyo to use the Hyper backend
+   Part of Scryer Prolog
+
+   This library provides an starting point to build HTTP server based applications.
+   It is based on Hyper, which allows for HTTP/1.0, HTTP/1.1 and HTTP/2. However,
+   some advanced features that Hyper provides are still not accesible.
+
+   Usage
+   ==========
+   The main predicate of the library is http_listen/2, which needs a port number
+    (usually 80) and a list of handlers. A handler is a compound term with the functor
+   as one HTTP method (in lowercase) and followed by a Route Match and a predicate
+   which will handle the call.
+
+   text_handler(Request, Response) :-
+    http_status_code(Response, 200),
+    http_body(Response, text("Welcome to Scryer Prolog!")).
+
+   parameter_handler(User, Request, Response) :-
+    http_body(Response, text(User)).
+
+   http_listen(7890, [
+        get(echo, text_handler),           % GET /echo
+        post(user/User, parameter_handler(User)) % POST /user/<User>
+   ]).
+
+   Every handler predicate will have at least 2-arity, with Request and Response.
+   Although you can work directly with http_request and http_response terms, it is
+   recommeded to use the helper predicates, which are easier to understand and cleaner:
+   - http_headers(Response/Request, Headers)
+   - http_status_code(Responde, StatusCode)
+   - http_body(Response/Request, text(Body))
+   - http_body(Response/Request, binary(Body))
+   - http_body(Request, form(Form))
+   - http_body(Response, file(Filename))
+   - http_redirect(Response, Url)
+   - http_query(Request, QueryName, QueryValue)
+
+   Some things that are still missing:
+   - Read forms in multipart format
+   - HTTP Basic Auth
+   - Session handling via cookies
+   - HTML Templating
+
+   I place this code in the public domain. Use it in any way you want.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+:- module(http_server, [
+	      http_listen/2,
+	      http_headers/2,
+	      http_status_code/2,
+	      http_body/2,
+	      http_redirect/2,
+	      http_query/3
+]).
+
+:- meta_predicate http_listen(?, :).
+
+:- use_module(library(charsio)).
+:- use_module(library(crypto)).
+:- use_module(library(error)).
+:- use_module(library(format)).
+:- use_module(library(iso_ext)).
+:- use_module(library(lists)).
+:- use_module(library(pio)).
+:- use_module(library(time)).
+
+http_listen(Port, Module:Handlers0) :-
+    must_be(integer, Port),
+    must_be(list, Handlers0),
+    maplist(module_qualification(Module), Handlers0, Handlers),
+    http_listen_(Port, Handlers).
+
+module_qualification(M, H0, H) :-
+    H0 =.. [Method, Path, Goal],
+    H =.. [Method, Path, M:Goal].
+
+http_listen_(Port, Handlers) :-
+    phrase(format_("0.0.0.0:~d", [Port]), Addr),
+    '$http_listen'(Addr, HttpListener),!,
+    format("Listening at ~s\n", [Addr]),
+    http_loop(HttpListener, Handlers).
+
+http_loop(HttpListener, Handlers) :-
+    '$http_accept'(HttpListener, RequestMethod, RequestPath, RequestHeaders, RequestQuery, RequestStream, ResponseHandle),
+    current_time(Time),
+    phrase(format_time("%Y-%m-%d (%H:%M:%S)", Time), TimeString),
+    format("~s ~w ~s\n", [TimeString, RequestMethod, RequestPath]),
+    maplist(map_header_kv, RequestHeaders, RequestHeadersKV),
+    phrase(parse_queries(RequestQueries), RequestQuery),
+    (
+	match_handler(Handlers, RequestMethod, RequestPath, Handler) ->
+	(
+	    HttpRequest = http_request(RequestHeadersKV, stream(RequestStream), RequestQueries),
+	    HttpResponse = http_response(_, _, _),
+	    (call(Handler, HttpRequest, HttpResponse) ->
+		 send_response(ResponseHandle, HttpResponse)
+	    ;    (
+		'$http_answer'(ResponseHandle, 500, [], ResponseStream),
+		call_cleanup(format(ResponseStream, "Internal Server Error", []), close(ResponseStream)))
+	    )
+	)
+    ; (
+	'$http_answer'(ResponseHandle, 404, [], ResponseStream),
+	call_cleanup(format(ResponseStream, "Not Found"), close(ResponseStream)))
+    ),
+    http_loop(HttpListener, Handlers).
+
+send_response(ResponseHandle, http_response(StatusCode0, text(ResponseText), ResponseHeaders0)) :-
+    default(StatusCode0, 200, StatusCode),
+    maplist(map_header_kv_2, ResponseHeaders, ResponseHeaders0),
+    '$http_answer'(ResponseHandle, StatusCode, ResponseHeaders, ResponseStream),
+    call_cleanup(
+	format(ResponseStream, "~s", [ResponseText]),
+	close(ResponseStream)
+    ).
+
+send_response(ResponseHandle, http_response(StatusCode0, bytes(ResponseBytes), ResponseHeaders0)) :-
+    default(StatusCode0, 200, StatusCode),
+    maplist(map_header_kv_2, ResponseHeaders, ResponseHeaders0),
+    '$http_answer'(ResponseHandle, StatusCode, ResponseHeaders, ResponseStream),
+    call_cleanup(
+	format(ResponseStream, "~s", [ResponseBytes]),
+	close(ResponseStream)
+    ).
+
+send_response(ResponseHandle, http_response(StatusCode0, file(Filename), ResponseHeaders0)) :-
+    default(StatusCode0, 200, StatusCode),
+    maplist(map_header_kv_2, ResponseHeaders, ResponseHeaders0),
+    '$http_answer'(ResponseHandle, StatusCode, ResponseHeaders, ResponseStream),
+    call_cleanup(
+	setup_call_cleanup(
+	    open(Filename, read, FileStream, [type(binary)]),
+	    (
+		get_n_chars(FileStream, _, FileCs),
+		format(ResponseStream, "~s", [FileCs])
+	    ),
+	    close(FileStream)
+	),
+        close(ResponseStream)
+    ).
+    
+
+default(Var, Default, Out) :-
+    (var(Var) -> Out = Default
+    ;   Var = Out  
+    ).
+
+map_header_kv(T, K-V) :-
+    T =.. [K0, V],
+    atom_chars(K0, K).
+
+map_header_kv_2(T, K-V) :-
+    atom_chars(K0, K),
+    T =.. [K0, V].
+
+match_handler(Handlers, Method, "/", Handler) :-
+    member(H, Handlers),
+    H =.. [Method, /, Handler].
+match_handler(Handlers, Method, Path, Handler) :-
+    member(H, Handlers),
+    copy_term(H, H1),
+    H1 =.. [Method, Pattern, Handler],
+    \+ var(Pattern),
+    phrase(path(Pattern), Path).
+match_handler(Handlers, Method, Path, Handler) :-
+    member(H, Handlers),
+    copy_term(H, H1),
+    H1 =.. [Method, Var, Handler],
+    var(Var),
+    Var = Path.
+
+path(Pattern) -->
+    {
+        Pattern =.. Parts,
+        length(Parts, 3),
+        nth0(1, Parts, Pattern0),
+        nth0(2, Parts, PartAtom),
+        (var(PartAtom) -> Part = PartAtom; atom_chars(PartAtom, Part))
+    },
+    path(Pattern0),
+    "/",
+    string_without("/", Part).
+
+path(Pattern) -->
+    {
+        Pattern =.. Parts,
+        Parts = [PartAtom],
+        (var(PartAtom) -> Part = PartAtom; atom_chars(PartAtom, Part))
+    },
+    "/",
+    string_without("/", Part).
+
+path([]) --> [].
+
+string_without(Not, [Char|String]) -->
+    [Char],
+    {
+        \+ member(Char, Not)
+    },
+    string_without(Not, String).
+
+string_without(_, []) -->
+    [].
+
+http_headers(http_request(Headers, _, _), Headers).
+http_headers(http_response(_, _, Headers), Headers).
+
+http_body(http_request(_, stream(StreamBody), _), bytes(BytesBody)) :- get_n_chars(StreamBody, _, BytesBody).
+http_body(http_request(_, stream(StreamBody), _), text(TextBody)) :- get_n_chars(StreamBody, _, TextBody).
+http_body(http_request(Headers, stream(StreamBody), _), form(FormBody)) :- 
+    member("content-type"-"application/x-www-form-urlencoded", Headers),
+    get_n_chars(StreamBody, _, TextBody),
+    phrase(parse_queries(FormBody), TextBody).
+http_body(http_request(_, Body, _), Body).
+http_body(http_response(_, Body, _), Body).
+
+http_status_code(http_response(StatusCode, _, _), StatusCode).
+http_redirect(http_response(307, text("Moved Temporarily"), ["Location"-Uri]), Uri).
+http_query(http_request(_, _, Queries), Key, Value) :- member(Key-Value, Queries).
+
+parse_queries([Key-Value|Queries]) -->
+    string_without("=", Key0),
+    {
+        phrase(url_decode(Key), Key0)
+    },
+    "=",
+    string_without("&", Value0),
+    {
+        phrase(url_decode(Value), Value0)
+    },
+    "&",
+    parse_queries(Queries).
+
+parse_queries([Key-Value]) -->
+    string_without("=", Key0),
+    {
+        phrase(url_decode(Key), Key0)
+    },
+    "=",
+    string_without(" ", Value0),
+    {
+        phrase(url_decode(Value), Value0)  
+    }.
+
+parse_queries([]) -->
+    [].
+
+% Decodes a UTF-8 URL Encoded string: RFC-1738
+url_decode([Char|Chars]) -->
+    [Char],
+    {
+        Char \= '%'
+    },
+    url_decode(Chars).
+url_decode([Char|Chars]) -->
+    "%",
+    [A],
+    [B],
+    {
+        hex_bytes([A,B], Bytes),
+        Bytes = [FirstByte|_],
+        FirstByte < 128,
+        chars_utf8bytes(Chars0, Bytes),
+        Chars0 = [Char]
+    },
+    url_decode(Chars).
+url_decode([Char|Chars]) -->
+    "%",
+    [A, B],
+    "%",
+    [C, D],
+    {
+        hex_bytes([A,B,C,D], Bytes),
+        Bytes = [FirstByte|_],
+        FirstByte < 224,
+        chars_utf8bytes(Chars0, Bytes),
+        Chars0 = [Char]
+    },
+    url_decode(Chars).
+url_decode([Char|Chars]) -->
+    "%",
+    [A, B],
+    "%",
+    [C, D],
+    "%",
+    [E, F],
+    {
+        hex_bytes([A,B,C,D,E,F], Bytes),
+        Bytes = [FirstByte|_],
+        FirstByte < 240,
+        chars_utf8bytes(Chars0, Bytes),
+        Chars0 = [Char]
+    },
+    url_decode(Chars).
+url_decode([Char|Chars]) -->
+    "%",
+    [A, B],
+    "%",
+    [C, D],
+    "%",
+    [E, F],
+    "%",
+    [H, I],
+    {
+        hex_bytes([A,B,C,D,E,F,H,I], Bytes),
+        chars_utf8bytes(Chars0, Bytes),
+        Chars0 = [Char]
+    },
+    url_decode(Chars).
+
+url_decode([]) --> [].

src/lib/iso_ext.pl

@@ -1,99 +1,119 @@
-%% for builtins that are not part of the ISO standard.
-%% must be loaded at the REPL with
+:- module(iso_ext, [bb_b_put/2,
+                    bb_get/2,
+                    bb_put/2,
+                    call_cleanup/2,
+                    call_with_inference_limit/3,
+                    forall/2,
+                    partial_string/1,
+                    partial_string/3,
+                    partial_string_tail/2,
+                    setup_call_cleanup/3,
+                    call_nth/2,
+                    copy_term_nat/2,
+		    asserta/2,
+		    assertz/2]).
 
-%% ?- use_module(library(iso_ext)).
+:- use_module(library(error), [can_be/2,
+                               domain_error/3,
+                               instantiation_error/1,
+                               type_error/3]).
 
-:- module(iso_ext, [bb_b_put/2, bb_get/2, bb_put/2, call_cleanup/2,
-                    call_with_inference_limit/3, forall/2,
-                    partial_string/1, partial_string/3,
-                    partial_string_tail/2, setup_call_cleanup/3,
-                    variant/2]).
+:- use_module(library(lists), [maplist/3]).
+
+:- meta_predicate(forall(0, 0)).
 
 forall(Generate, Test) :-
     \+ (Generate, \+ Test).
 
 %% (non-)backtrackable global variables.
 
-bb_put(Key, Value) :- atom(Key), !, '$store_global_var'(Key, Value).
-bb_put(Key, _) :- throw(error(type_error(atom, Key), bb_put/2)).
+bb_put(Key, Value) :-
+    (  atom(Key) ->
+       '$store_global_var'(Key, Value)
+    ;  type_error(atom, Key, bb_put/2)
+    ).
 
 %% backtrackable global variables.
 
-bb_b_put(Key, NewValue) :-
-    (  '$bb_get_with_offset'(Key, OldValue, OldOffset) ->
-       call_cleanup((store_global_var_with_offset(Key, NewValue) ; false),
-                    reset_global_var_at_offset(Key, OldValue, OldOffset))
-    ;  call_cleanup((store_global_var_with_offset(Key, NewValue) ; false),
-                    reset_global_var_at_key(Key))
+bb_b_put(Key, Value) :-
+    (  atom(Key) ->
+       '$store_backtrackable_global_var'(Key, Value)
+    ;  type_error(atom, Key, bb_b_put/2)
     ).
 
-store_global_var_with_offset(Key, Value) :- '$store_global_var_with_offset'(Key, Value).
-
-store_global_var(Key, Value) :- '$store_global_var'(Key, Value).
-
-reset_global_var_at_key(Key) :- '$reset_global_var_at_key'(Key).
-
-reset_global_var_at_offset(Key, Value, Offset) :- '$reset_global_var_at_offset'(Key, Value, Offset).
-
-'$bb_get_with_offset'(Key, OldValue, Offset) :-
-    atom(Key), !, '$fetch_global_var_with_offset'(Key, OldValue, Offset).
-'$bb_get_with_offset'(Key, _, _) :-
-    throw(error(type_error(atom, Key), bb_b_put/2)).
-
-bb_get(Key, Value) :- atom(Key), !, '$fetch_global_var'(Key, Value).
-bb_get(Key, _) :- throw(error(type_error(atom, Key), bb_get/2)).
-
-call_cleanup(G, C) :- setup_call_cleanup(true, G, C).
+bb_get(Key, Value) :-
+    (  atom(Key) ->
+       '$fetch_global_var'(Key, Value)
+    ;  type_error(atom, Key, bb_get/2)
+    ).
 
 
 % setup_call_cleanup.
 
+:- meta_predicate(call_cleanup(0, 0)).
+
+call_cleanup(G, C) :- setup_call_cleanup(true, G, C).
+
+:- meta_predicate(setup_call_cleanup(0, 0, 0)).
+
+:- non_counted_backtracking setup_call_cleanup/3.
+
 setup_call_cleanup(S, G, C) :-
     '$get_b_value'(B),
-    call(S),
+    '$call_with_inference_counting'(call(S)),
     '$set_cp_by_default'(B),
     '$get_current_block'(Bb),
-    (  '$call_with_default_policy'(var(C)) ->
-       throw(error(instantiation_error, setup_call_cleanup/3))
-    ;  '$call_with_default_policy'(scc_helper(C, G, Bb))
+    (  C = _:CC,
+       var(CC) ->
+       instantiation_error(setup_call_cleanup/3)
+    ;  scc_helper(C, G, Bb)
     ).
 
+:- meta_predicate(scc_helper(?,0,?)).
+
 :- non_counted_backtracking scc_helper/3.
+
 scc_helper(C, G, Bb) :-
-    '$get_cp'(Cp), '$install_scc_cleaner'(C, NBb), call(G),
-    ( '$check_cp'(Cp) ->
-      '$reset_block'(Bb),
-      '$call_with_default_policy'(run_cleaners_without_handling(Cp))
-    ; '$call_with_default_policy'(true)
-    ; '$reset_block'(NBb),
-      '$fail').
+    '$get_cp'(Cp),
+    '$install_scc_cleaner'(C, NBb),
+    '$call_with_inference_counting'(call(G)),
+    (  '$check_cp'(Cp) ->
+       '$reset_block'(Bb),
+       run_cleaners_without_handling(Cp)
+    ;  true
+    ;  '$reset_block'(NBb),
+       '$fail'
+    ).
 scc_helper(_, _, Bb) :-
     '$reset_block'(Bb),
-    '$get_ball'(Ball),
-    '$call_with_default_policy'(run_cleaners_with_handling),
-    '$erase_ball',
-    '$call_with_default_policy'(throw(Ball)).
+    '$push_ball_stack',
+    run_cleaners_with_handling,
+    '$pop_from_ball_stack',
+    '$unwind_stack'.
 scc_helper(_, _, _) :-
     '$get_cp'(Cp),
-    '$call_with_default_policy'(run_cleaners_without_handling(Cp)),
+    run_cleaners_without_handling(Cp),
     '$fail'.
 
 :- non_counted_backtracking run_cleaners_with_handling/0.
+
 run_cleaners_with_handling :-
-    '$get_scc_cleaner'(C), '$get_level'(B),
-    '$call_with_default_policy'(catch(C, _, true)),
+    '$get_scc_cleaner'(C),
+    '$get_level'(B),
+    catch(C, _, true),
     '$set_cp_by_default'(B),
-    '$call_with_default_policy'(run_cleaners_with_handling).
+    run_cleaners_with_handling.
 run_cleaners_with_handling :-
     '$restore_cut_policy'.
 
 :- non_counted_backtracking run_cleaners_without_handling/1.
+
 run_cleaners_without_handling(Cp) :-
     '$get_scc_cleaner'(C),
     '$get_level'(B),
     call(C),
     '$set_cp_by_default'(B),
-    '$call_with_default_policy'(run_cleaners_without_handling(Cp)).
+    run_cleaners_without_handling(Cp).
 run_cleaners_without_handling(Cp) :-
     '$set_cp_by_default'(Cp),
     '$restore_cut_policy'.
@@ -101,55 +121,77 @@ run_cleaners_without_handling(Cp) :-
 % call_with_inference_limit
 
 :- non_counted_backtracking end_block/4.
-end_block(_, Bb, NBb, L) :-
+
+end_block(_, Bb, NBb, _L) :-
     '$clean_up_block'(NBb),
     '$reset_block'(Bb).
-end_block(B, Bb, NBb, L) :-
+end_block(B, _Bb, NBb, L) :-
     '$install_inference_counter'(B, L, _),
     '$reset_block'(NBb),
     '$fail'.
 
 :- non_counted_backtracking handle_ile/3.
-handle_ile(B, inference_limit_exceeded(B), inference_limit_exceeded) :- !.
-handle_ile(B, E, _) :-
+
+handle_ile(B, inference_limit_exceeded(B), inference_limit_exceeded) :-
+    !,
+    '$pop_ball_stack'.
+handle_ile(B, _, _) :-
     '$remove_call_policy_check'(B),
-    '$call_with_default_policy'(throw(E)).
+    '$pop_from_ball_stack',
+    '$unwind_stack'.
+
+:- meta_predicate(call_with_inference_limit(0, ?, ?)).
+
+:- non_counted_backtracking call_with_inference_limit/3.
 
 call_with_inference_limit(G, L, R) :-
+    (  integer(L) ->
+       (  L < 0 ->
+          domain_error(not_less_than_zero, L, call_with_inference_limit/3)
+       ;  true
+       )
+    ;  var(L) ->
+       instantiation_error(call_with_inference_limit/3)
+    ;  type_error(integer, L, call_with_inference_limit/3)
+    ),
     '$get_current_block'(Bb),
     '$get_b_value'(B),
-    '$call_with_default_policy'(call_with_inference_limit(G, L, R, Bb, B)),
+    call_with_inference_limit(G, L, R, Bb, B),
     '$remove_call_policy_check'(B).
 
+install_inference_counter(B, L, Count0) :-
+    '$install_inference_counter'(B, L, Count0).
+
+:- meta_predicate(call_with_inference_limit(0,?,?,?,?)).
+
 :- non_counted_backtracking call_with_inference_limit/5.
+
 call_with_inference_limit(G, L, R, Bb, B) :-
     '$install_new_block'(NBb),
     '$install_inference_counter'(B, L, Count0),
-    call(G),
+    '$call_with_inference_counting'(call(G)),
     '$inference_level'(R, B),
     '$remove_inference_counter'(B, Count1),
-    '$call_with_default_policy'(is(Diff, L - (Count1 - Count0))),
-    '$call_with_default_policy'(end_block(B, Bb, NBb, Diff)).
+    Diff is L - (Count1 - Count0),
+    end_block(B, Bb, NBb, Diff).
 call_with_inference_limit(_, _, R, Bb, B) :-
     '$reset_block'(Bb),
     '$remove_inference_counter'(B, _),
     (  '$get_ball'(Ball),
+       '$push_ball_stack',
        '$get_level'(Cp),
        '$set_cp_by_default'(Cp)
     ;  '$remove_call_policy_check'(B),
        '$fail'
     ),
-    '$erase_ball',
-    '$call_with_default_policy'(handle_ile(B, Ball, R)).
-
-variant(X, Y) :- '$variant'(X, Y).
+    handle_ile(B, Ball, R).
 
 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)
     ).
 
@@ -161,3 +203,63 @@ partial_string_tail(String, Tail) :-
        '$partial_string_tail'(String, Tail)
     ;  throw(error(type_error(partial_string, String), partial_string_tail/2))
     ).
+
+:- dynamic(i_call_nth_nesting/2).
+:- dynamic(i_call_nth_counter/1).
+
+:- meta_predicate(call_nth(0, ?)).
+
+call_nth(Goal, N) :-
+    can_be(integer, N),
+    (   integer(N) ->
+        (   N < 0 ->
+            domain_error(not_less_than_zero, N, call_nth/2)
+        ;   N > 0
+        )
+    ;   true
+    ),
+    setup_call_cleanup(call_nth_nesting(C, ID),
+                       (   Goal,
+                           bb_get(ID, N0),
+                           N1 is N0 + 1,
+                           bb_put(ID, N1),
+                           (   integer(N) ->
+                               N = N1,
+                               !
+                           ;   N = N1
+                           )
+                       ),
+                       (   bb_get(i_call_nth_counter, C) ->
+                           C1 is C - 1,
+                           bb_put(i_call_nth_counter, C1)
+                       ;   true
+                       )).
+
+call_nth_nesting(C, ID) :-
+    (   bb_get(i_call_nth_counter, C0) ->
+        C is C0 + 1
+    ;   C = 0
+    ),
+    number_chars(C, Cs),
+    atom_chars(Atom, Cs),
+    atom_concat(i_call_nth_nesting_, Atom, ID),
+    bb_put(ID, 0),
+    bb_put(i_call_nth_counter, C).
+
+
+copy_term_nat(Source, Dest) :-
+    '$copy_term_without_attr_vars'(Source, Dest).
+
+
+asserta(Module, (Head :- Body)) :-
+    !,
+    '$asserta'(Module, Head, Body).
+asserta(Module, Fact) :-
+    '$asserta'(Module, Fact, true).
+
+assertz(Module, (Head :- Body)) :-
+    !,
+    '$assertz'(Module, Head, Body).
+assertz(Module, Fact) :-
+    '$assertz'(Module, Fact, true).
+

src/lib/lambda.pl

@@ -0,0 +1,230 @@
+/*
+    Author:        Ulrich Neumerkel
+    E-mail:        ulrich@complang.tuwien.ac.at
+    Copyright (C): 2009 Ulrich Neumerkel. All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY Ulrich Neumerkel ``AS IS'' AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL Ulrich Neumerkel OR
+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+The views and conclusions contained in the software and documentation
+are those of the authors and should not be interpreted as representing
+official policies, either expressed or implied, of Ulrich Neumerkel.
+
+
+
+*/
+
+:- module(lambda, [
+		   (^)/3, (^)/4, (^)/5, (^)/6, (^)/7, (^)/8, (^)/9, (^)/10,
+		   (\)/1, (\)/2, (\)/3, (\)/4, (\)/5, (\)/6, (\)/7, (\)/8,
+		   (+\)/2, (+\)/3, (+\)/4, (+\)/5, (+\)/6, (+\)/7, (+\)/8,
+			(+\)/9, op(201,xfx,+\)]).
+
+:- use_module(library(iso_ext)).
+
+/** <module> Lambda expressions
+
+This library provides lambda expressions to simplify higher order
+programming based on call/N.
+
+Lambda expressions are represented by ordinary Prolog terms.
+There are two kinds of lambda expressions:
+
+    Free+\X1^X2^ ..^XN^Goal
+
+         \X1^X2^ ..^XN^Goal
+
+The second is a shorthand for t+\X1^X2^..^XN^Goal.
+
+Xi are the parameters.
+
+Goal is a goal or continuation. Syntax note: Operators within Goal
+require parentheses due to the low precedence of the ^ operator.
+
+Free contains variables that are valid outside the scope of the lambda
+expression. They are thus free variables within.
+
+All other variables of Goal are considered local variables. They must
+not appear outside the lambda expression. This restriction is
+currently not checked. Violations may lead to unexpected bindings.
+
+In the following example the parentheses around X>3 are necessary.
+
+==
+?- use_module(library(lambda)).
+?- use_module(library(lists)).
+
+?- maplist(\X^(X>3),[4,5,9]).
+   true.
+==
+
+In the following X is a variable that is shared by both instances of
+the lambda expression. The second query illustrates the cooperation of
+continuations and lambdas. The lambda expression is in this case a
+continuation expecting a further argument.
+
+==
+?- use_module(library(dif)).
+   true.
+
+?- Xs = [A,B], maplist(X+\Y^dif(X,Y), Xs).
+   Xs = [A,B], dif:dif(X,A), dif:dif(X,B).
+
+?- Xs = [A,B], maplist(X+\dif(X), Xs).
+   Xs = [A,B], dif:dif(X,A), dif:dif(X,B).
+==
+
+The following queries are all equivalent. To see this, use
+the fact f(x,y).
+==
+?- call(f,A1,A2).
+?- call(\X^f(X),A1,A2).
+?- call(\X^Y^f(X,Y), A1,A2).
+?- call(\X^(X+\Y^f(X,Y)), A1,A2).
+?- call(call(f, A1),A2).
+?- call(f(A1),A2).
+?- f(A1,A2).
+   A1 = x, A2 = y.
+==
+
+Further discussions
+http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/ISO-Hiord
+
+@tbd Static expansion similar to apply_macros.
+@author Ulrich Neumerkel
+*/
+
+:- meta_predicate ^(?,0,?).
+:- meta_predicate ^(?,1,?,?).
+:- meta_predicate ^(?,2,?,?,?).
+:- meta_predicate ^(?,3,?,?,?,?).
+:- meta_predicate ^(?,4,?,?,?,?,?).
+:- meta_predicate ^(?,5,?,?,?,?,?,?).
+:- meta_predicate ^(?,6,?,?,?,?,?,?,?).
+:- meta_predicate ^(?,7,?,?,?,?,?,?,?,?).
+:- meta_predicate \(0).
+:- meta_predicate \(1,?).
+:- meta_predicate \(2,?,?).
+:- meta_predicate \(3,?,?,?).
+:- meta_predicate \(4,?,?,?,?).
+:- meta_predicate \(5,?,?,?,?,?).
+:- meta_predicate \(6,?,?,?,?,?,?).
+:- meta_predicate \(7,?,?,?,?,?,?,?).
+:- meta_predicate +\(?,0).
+:- meta_predicate +\(?,1,?).
+:- meta_predicate +\(?,2,?,?).
+:- meta_predicate +\(?,3,?,?,?).
+:- meta_predicate +\(?,4,?,?,?,?).
+:- meta_predicate +\(?,5,?,?,?,?,?).
+:- meta_predicate +\(?,6,?,?,?,?,?,?).
+:- meta_predicate +\(?,7,?,?,?,?,?,?,?).
+
+:- meta_predicate no_hat_call(0).
+
+^(V1,C_0,V1) :-
+   no_hat_call(C_0).
+^(V1,C_1,V1,V2) :-
+   call(C_1,V2).
+^(V1,C_2,V1,V2,V3) :-
+   call(C_2,V2,V3).
+^(V1,C_3,V1,V2,V3,V4) :-
+   call(C_3,V2,V3,V4).
+^(V1,C_4,V1,V2,V3,V4,V5) :-
+   call(C_4,V2,V3,V4,V5).
+^(V1,C_5,V1,V2,V3,V4,V5,V6) :-
+   call(C_5,V2,V3,V4,V5,V6).
+^(V1,C_6,V1,V2,V3,V4,V5,V6,V7) :-
+   call(C_6,V2,V3,V4,V5,V6,V7).
+^(V1,C_7,V1,V2,V3,V4,V5,V6,V7,V8) :-
+   call(C_7,V2,V3,V4,V5,V6,V7,V8).
+
+\(FC_0) :-
+   copy_term_nat(FC_0,C_0),
+   no_hat_call(C_0).
+\(FC_1,V1) :-
+   copy_term_nat(FC_1,C_1),
+   call(C_1,V1).
+\(FC_2,V1,V2) :-
+   copy_term_nat(FC_2,C_2),
+   call(C_2,V1,V2).
+\(FC_3,V1,V2,V3) :-
+   copy_term_nat(FC_3,C_3),
+   call(C_3,V1,V2,V3).
+\(FC_4,V1,V2,V3,V4) :-
+   copy_term_nat(FC_4,C_4),
+   call(C_4,V1,V2,V3,V4).
+\(FC_5,V1,V2,V3,V4,V5) :-
+   copy_term_nat(FC_5,C_5),
+   call(C_5,V1,V2,V3,V4,V5).
+\(FC_6,V1,V2,V3,V4,V5,V6) :-
+   copy_term_nat(FC_6,C_6),
+   call(C_6,V1,V2,V3,V4,V5,V6).
+\(FC_7,V1,V2,V3,V4,V5,V6,V7) :-
+   copy_term_nat(FC_7,C_7),
+   call(C_7,V1,V2,V3,V4,V5,V6,V7).
+
+
++\(GV,FC_0) :-
+   copy_term_nat(GV+FC_0,GV+C_0),
+   no_hat_call(C_0).
++\(GV,FC_1,V1) :-
+   copy_term_nat(GV+FC_1,GV+C_1),
+   call(C_1,V1).
++\(GV,FC_2,V1,V2) :-
+   copy_term_nat(GV+FC_2,GV+C_2),
+   call(C_2,V1,V2).
++\(GV,FC_3,V1,V2,V3) :-
+   copy_term_nat(GV+FC_3,GV+C_3),
+   call(C_3,V1,V2,V3).
++\(GV,FC_4,V1,V2,V3,V4) :-
+   copy_term_nat(GV+FC_4,GV+C_4),
+   call(C_4,V1,V2,V3,V4).
++\(GV,FC_5,V1,V2,V3,V4,V5) :-
+   copy_term_nat(GV+FC_5,GV+C_5),
+   call(C_5,V1,V2,V3,V4,V5).
++\(GV,FC_6,V1,V2,V3,V4,V5,V6) :-
+   copy_term_nat(GV+FC_6,GV+C_6),
+   call(C_6,V1,V2,V3,V4,V5,V6).
++\(GV,FC_7,V1,V2,V3,V4,V5,V6,V7) :-
+   copy_term_nat(GV+FC_7,GV+C_7),
+   call(C_7,V1,V2,V3,V4,V5,V6,V7).
+
+
+%% no_hat_call(:Goal_0)
+%
+% Like call, but issues an error for a goal (^)/2.  Such goals are
+% likely the result of an insufficient number of arguments.
+
+no_hat_call(MGoal_0) :-
+   strip_module(MGoal_0, _, Goal_0),
+   (  nonvar(Goal_0),
+      Goal_0 = (_^_)
+   -> throw(
+			error(
+				existence_error(lambda_parameter,MGoal_0),
+				_))
+	;	call(MGoal_0)
+   ).
+
+% I would like to replace this by:
+% V1^Goal :- throw(error(existence_error(lambda_parameter,V1^Goal),_)).

src/lib/lists.pl

@@ -1,40 +1,100 @@
 :- module(lists, [member/2, select/3, append/2, append/3, foldl/4, foldl/5,
-		  memberchk/2, reverse/2, length/2, maplist/2,
-		  maplist/3, maplist/4, maplist/5, maplist/6,
-		  maplist/7, maplist/8, maplist/9, same_length/2, nth0/3,
-		  sum_list/2, transpose/2, list_to_set/2]).
+		          memberchk/2, reverse/2, length/2, maplist/2,
+		          maplist/3, maplist/4, maplist/5, maplist/6,
+		          maplist/7, maplist/8, maplist/9, same_length/2, nth0/3, nth0/4, nth1/3, nth1/4,
+		          sum_list/2, transpose/2, list_to_set/2, list_max/2,
+                  list_min/2, permutation/2]).
+
+/*  Author:        Mark Thom, Jan Wielemaker, and Richard O'Keefe
+    Copyright (c)  2018-2021, Mark Thom
+    Copyright (c)  2002-2020, University of Amsterdam
+                              VU University Amsterdam
+                              SWI-Prolog Solutions b.v.
+    All rights reserved.
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
 
 
 :- use_module(library(error)).
 
 
-length(Xs, N) :-
-    var(N), !,
-    '$skip_max_list'(M, -1, Xs, Xs0),
-    (  Xs0 == [] -> N = M
-    ;  var(Xs0)  -> length_addendum(Xs0, N, M)).
-length(Xs, N) :-
-    integer(N),
-    N >= 0, !,
-    '$skip_max_list'(M, N, Xs, Xs0),
-    (  Xs0 == [] -> N = M
-    ;  var(Xs0)  -> R is N-M, length_rundown(Xs0, R)).
+:- meta_predicate maplist(1, ?).
+:- meta_predicate maplist(2, ?, ?).
+:- meta_predicate maplist(3, ?, ?, ?).
+:- meta_predicate maplist(4, ?, ?, ?, ?).
+:- meta_predicate maplist(5, ?, ?, ?, ?, ?).
+:- meta_predicate maplist(6, ?, ?, ?, ?, ?, ?).
+:- meta_predicate maplist(7, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate maplist(8, ?, ?, ?, ?, ?, ?, ?, ?).
+
+:- meta_predicate foldl(3, ?, ?, ?).
+:- meta_predicate foldl(4, ?, ?, ?, ?).
+
+:- use_module(library(error)).
+
+:- meta_predicate(resource_error(+,:)).
+
+resource_error(Resource, Context) :-
+   throw(error(resource_error(Resource), Context)).
+
+length(Xs0, N) :-
+   '$skip_max_list'(M, N, Xs0,Xs),
+   !,
+   (  Xs == [] -> N = M
+   ;  nonvar(Xs) -> var(N), Xs = [_|_], resource_error(finite_memory,length/2)
+   ;  nonvar(N) -> R is N-M, length_rundown(Xs, R)
+   ;  N == Xs -> failingvarskip(Xs), resource_error(finite_memory,length/2)
+   ;  length_addendum(Xs, N, M)
+   ).
 length(_, N) :-
-    integer(N), !,
-    domain_error(not_less_than_zero, N, length/2).
+   integer(N), !,
+   domain_error(not_less_than_zero, N, length/2).
 length(_, N) :-
-    type_error(integer, N, length/2).
+   type_error(integer, N, length/2).
+
+length_rundown(Xs, 0) :- !, Xs = [].
+length_rundown(Vs, N) :-
+    \+ \+ '$project_atts':copy_term(Vs,Vs,[]), % unconstrained
+    !,
+    '$det_length_rundown'(Vs, N).
+length_rundown([_|Xs], N) :- % force unification
+    N1 is N-1,
+    length(Xs, N1). % maybe some new info on Xs
+
+failingvarskip(Xs) :-
+    \+ \+ '$project_atts':copy_term(Xs,Xs,[]), % unconstrained
+    !.
+failingvarskip([_|Xs0]) :- % force unification
+    '$skip_max_list'(_, _, Xs0,Xs),
+    (  nonvar(Xs) -> Xs = [_|_]
+	 ;  failingvarskip(Xs)
+    ).
 
 length_addendum([], N, N).
 length_addendum([_|Xs], N, M) :-
     M1 is M + 1,
     length_addendum(Xs, N, M1).
 
-length_rundown(Xs, 0) :- !, Xs = [].
-length_rundown([_|Xs], N) :-
-    N1 is N-1,
-    length_rundown(Xs, N1).
-
 
 member(X, [X|_]).
 member(X, [_|Xs]) :- member(X, Xs).
@@ -66,7 +126,6 @@ reverse([], [], YsRev, YsRev).
 reverse([_|Xs], [Y1|Ys], YsPreludeRev, Xss) :-
     reverse(Xs, Ys, [Y1|YsPreludeRev], Xss).
 
-
 maplist(_, []).
 maplist(Cont1, [E1|E1s]) :-
     call(Cont1, E1),
@@ -87,21 +146,25 @@ maplist(Cont, [E1|E1s], [E2|E2s], [E3|E3s], [E4|E4s]) :-
     call(Cont, E1, E2, E3, E4),
     maplist(Cont, E1s, E2s, E3s, E4s).
 
+
 maplist(_, [], [], [], [], []).
 maplist(Cont, [E1|E1s], [E2|E2s], [E3|E3s], [E4|E4s], [E5|E5s]) :-
     call(Cont, E1, E2, E3, E4, E5),
     maplist(Cont, E1s, E2s, E3s, E4s, E5s).
 
+
 maplist(_, [], [], [], [], [], []).
 maplist(Cont, [E1|E1s], [E2|E2s], [E3|E3s], [E4|E4s], [E5|E5s], [E6|E6s]) :-
     call(Cont, E1, E2, E3, E4, E5, E6),
     maplist(Cont, E1s, E2s, E3s, E4s, E5s, E6s).
 
+
 maplist(_, [], [], [], [], [], [], []).
 maplist(Cont, [E1|E1s], [E2|E2s], [E3|E3s], [E4|E4s], [E5|E5s], [E6|E6s], [E7|E7s]) :-
     call(Cont, E1, E2, E3, E4, E5, E6, E7),
     maplist(Cont, E1s, E2s, E3s, E4s, E5s, E6s, E7s).
 
+
 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, E8),
@@ -109,7 +172,7 @@ maplist(Cont, [E1|E1s], [E2|E2s], [E3|E3s], [E4|E4s], [E5|E5s], [E6|E6s], [E7|E7
 
 
 sum_list(Ls, S) :-
-        foldl(sum_, Ls, 0, S).
+        foldl(lists:sum_, Ls, 0, S).
 
 sum_(L, S0, S) :- S is S0 + L.
 
@@ -132,6 +195,7 @@ foldl_([L|Ls], G_3, A0, A) :-
 foldl(Goal_4, Xs, Ys, A0, A) :-
         foldl_(Xs, Ys, Goal_4, A0, A).
 
+
 foldl_([], [], _, A, A).
 foldl_([X|Xs], [Y|Ys], G_4, A0, A) :-
         call(G_4, X, Y, A0, A1),
@@ -142,17 +206,17 @@ transpose(Ls, Ts) :-
 
 lists_transpose([], []).
 lists_transpose([L|Ls], Ts) :-
-        maplist(same_length(L), Ls),
-        foldl(transpose_, L, Ts, [L|Ls], _).
+        maplist(lists:same_length(L), Ls),
+        foldl(lists:transpose_, L, Ts, [L|Ls], _).
 
 transpose_(_, Fs, Lists0, Lists) :-
-        maplist(list_first_rest, Lists0, Fs, Lists).
+        maplist(lists:list_first_rest, Lists0, Fs, Lists).
 
 list_first_rest([L|Ls], L, Ls).
 
 
 list_to_set(Ls0, Ls) :-
-        maplist(with_var, Ls0, LVs0),
+        maplist(lists:with_var, Ls0, LVs0),
         keysort(LVs0, LVs),
         same_elements(LVs),
         pick_firsts(LVs0, Ls).
@@ -170,7 +234,7 @@ with_var(E, E-_).
 
 same_elements([]).
 same_elements([EV|EVs]) :-
-        foldl(unify_same, EVs, EV, _).
+        foldl(lists:unify_same, EVs, EV, _).
 
 unify_same(E-V, Prev-Var, E-V) :-
         (   Prev == E ->
@@ -179,24 +243,136 @@ unify_same(E-V, Prev-Var, E-V) :-
         ).
 
 
-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(N, Es0, E) :-
+   nonvar(N),
+   '$skip_max_list'(Skip, N, Es0,Es1),
+   !,
+   (  Skip == N
+   -> Es1 = [E|_]
+   ;  ( var(Es1) ; Es1 = [_|_] ) % a partial or infinite list
+   -> R is N-Skip,
+      skipn(R,Es1,Es2),
+      Es2 = [E|_]
+   ).
+nth0(N, Es0, E) :-
+   can_be(not_less_than_zero, N),
+   Es0 = [E0|Es1],
+   nth0_el(0,N, E0,E, Es1).
 
-nth0_index(0, [E|_], E) :- !.
-nth0_index(N, [_|Es], E) :-
-        N > 0,
-        N1 is N - 1,
-        nth0_index(N1, Es, E).
+skipn(N0, Es0,Es) :-
+   N0>0,
+   !, % should not be necessary #1028
+   N1 is N0-1,
+   Es0 = [_|Es1],
+   skipn(N1, Es1,Es).
+skipn(0, Es,Es).
 
-nth0_search(N, Es, E) :-
-        nth0_search(0, N, Es, E).
+nth0_el(N0,N, E0,E, Es0) :-
+   Es0 == [],
+   !, % indexing
+   N0 = N,
+   E0 = E.
+nth0_el(N,N, E,E, _).
+nth0_el(N0,N, _,E, [E0|Es0]) :-
+   N1 is N0+1,
+   nth0_el(N1,N, E0,E, Es0).
 
-nth0_search(N, N, [E|_], E).
-nth0_search(N0, N, [_|Es], E) :-
-        N1 is N0 + 1,
-        nth0_search(N1, N, Es, E).
+nth1(N, Es0, E) :-
+   N \== 0,
+   nth0(N, [_|Es0], E),
+   N \== 0.
+
+skipn(N0, Es0,Es, Xs0,Xs) :-
+   N0>0,
+   !, % should not be necessary #1028
+   N1 is N0-1,
+   Es0 = [E|Es1],
+   Xs0 = [E|Xs1],
+   skipn(N1, Es1,Es, Xs1,Xs).
+skipn(0, Es,Es, Xs,Xs).
+
+nth0(N, Es0, E, Es) :-
+   integer(N),
+   N >= 0,
+   !,
+   skipn(N, Es0,Es1, Es,Es2),
+   Es1 = [E|Es2].
+nth0(N, Es0, E, Es) :-
+   can_be(not_less_than_zero, N),
+   Es0 = [E0|Es1],
+   nth0_elx(0,N, E0,E, Es1, Es).
+
+nth0_elx(N0,N, E0,E, Es0, Es) :-
+   Es0 == [],
+   !,
+   N0 = N,
+   E0 = E,
+   Es0 = Es.
+nth0_elx(N,N, E,E, Es, Es).
+nth0_elx(N0,N, E0,E, [E1|Es0], [E0|Es]) :-
+   N1 is N0+1,
+   nth0_elx(N1,N, E1,E, Es0, Es).
+
+% p.p.8.5
+
+nth1(N, Es0, E, Es) :-
+   N \== 0,
+   nth0(N, [_|Es0], E, [_|Es]),
+   N \== 0.
+
+
+list_max([N|Ns], Max) :-
+    foldl(lists:list_max_, Ns, N, Max).
+
+list_max_(N, Max0, Max) :-
+    Max is max(N, Max0).
+
+list_min([N|Ns], Min) :-
+    foldl(lists:list_min_, Ns, N, Min).
+
+list_min_(N, Min0, Min) :-
+    Min is min(N, Min0).
+
+%!  permutation(?Xs, ?Ys) is nondet.
+%
+%   True when Xs is a permutation of Ys. This can solve for Ys given
+%   Xs or Xs given Ys, or  even   enumerate  Xs and Ys together. The
+%   predicate  permutation/2  is  primarily   intended  to  generate
+%   permutations. Note that a list of  length N has N! permutations,
+%   and  unbounded  permutation  generation   becomes  prohibitively
+%   expensive, even for rather short lists (10! = 3,628,800).
+%
+%   The example below illustrates that Xs   and Ys being proper lists
+%   is not a sufficient condition to use the above replacement.
+%
+%     ==
+%     ?- permutation([1,2], [X,Y]).
+%     X = 1, Y = 2 ;
+%     X = 2, Y = 1 ;
+%     false.
+%     ==
+%
+%   @error  type_error(list, Arg) if either argument is not a proper
+%           or partial list.
+
+permutation(Xs, Ys) :-
+    '$skip_max_list'(Xlen, _, Xs, XTail),
+    '$skip_max_list'(Ylen, _, Ys, YTail),
+    (   XTail == [], YTail == []            % both proper lists
+    ->  Xlen == Ylen
+    ;   var(XTail), YTail == []             % partial, proper
+    ->  length(Xs, Ylen)
+    ;   XTail == [], var(YTail)             % proper, partial
+    ->  length(Ys, Xlen)
+    ;   var(XTail), var(YTail)              % partial, partial
+    ->  length(Xs, Len),
+        length(Ys, Len)
+    ;   must_be(list, Xs),                  % either is not a list
+        must_be(list, Ys)
+    ),
+    perm(Xs, Ys).
+
+perm([], []).
+perm(List, [First|Perm]) :-
+    select(First, List, Rest),
+    perm(Rest, Perm).

src/lib/ops_and_meta_predicates.pl

@@ -0,0 +1,129 @@
+:- op(400, yfx, /).
+
+% module resolution operator.
+:- op(600, xfy, :).
+
+:- op(1199, fx, meta_predicate).
+
+/* this is an implementation specific declarative operator used to implement call_with_inference_limit/3
+   and setup_call_cleanup/3. switches to the default trust_me and retry_me_else. Indexing choice
+   instructions are unchanged. */
+:- op(700, fx, non_counted_backtracking).
+
+% arithmetic operators.
+:- op(700, xfx, is).
+:- op(500, yfx, +).
+:- op(500, yfx, -).
+:- op(400, yfx, *).
+:- op(200, xfx, **).
+:- op(200, xfy, ^).
+:- op(500, yfx, /\).
+:- op(500, yfx, \/).
+:- op(500, yfx, xor).
+:- op(400, yfx, div).
+:- op(400, yfx, //).
+:- op(400, yfx, rdiv).
+:- op(400, yfx, <<).
+:- op(400, yfx, >>).
+:- op(400, yfx, mod).
+:- op(400, yfx, rem).
+:- op(200, fy, +).
+:- op(200, fy, -).
+:- op(200, fy, \).
+
+% arithmetic comparison operators.
+:- op(700, xfx, >).
+:- op(700, xfx, <).
+:- op(700, xfx, =\=).
+:- op(700, xfx, =:=).
+:- op(700, xfx, >=).
+:- op(700, xfx, =<).
+
+% term comparison.
+:- op(700, xfx, ==).
+:- op(700, xfx, \==).
+:- op(700, xfx, @=<).
+:- op(700, xfx, @>=).
+:- op(700, xfx, @<).
+:- op(700, xfx, @>).
+
+% conditional operators.
+:- op(1050, xfy, ->).
+:- op(1100, xfy, ;).
+
+% control.
+:- op(700, xfx, =).
+:- op(700, xfx, =..).
+:- op(700, xfx, \=).
+:- op(900, fy, \+).
+
+:- op(1200, xfx, -->).
+
+% meta_predicate declarations for call/{1, 66}.
+:- meta_predicate call(0).
+:- meta_predicate call(1, ?).
+:- meta_predicate call(2, ?, ?).
+:- meta_predicate call(3, ?, ?, ?).
+:- meta_predicate call(4, ?, ?, ?, ?).
+:- meta_predicate call(5, ?, ?, ?, ?, ?).
+:- meta_predicate call(6, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(7, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(8, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(9, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(10, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(11, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(12, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(13, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(14, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(15, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(16, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(17, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(18, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(19, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(20, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(21, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(22, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(23, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(24, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(25, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(26, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(27, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(28, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(29, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(30, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(31, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(32, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(33, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(34, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(35, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(36, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(37, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(38, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(39, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(40, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(41, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(42, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(43, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(44, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(45, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(46, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(47, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(48, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(49, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(50, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(51, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(52, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(53, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(54, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(55, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(56, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(57, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(58, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(59, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(60, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(60, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(61, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(62, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(63, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(64, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
+:- meta_predicate call(65, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).

src/lib/ordsets.pl

@@ -89,7 +89,7 @@ because the order it relies on may have been changed.
 %   setof/3.
 
 is_ordset(Term) :-
-    '$skip_max_list'(_, -1, Term, Tail), Tail == [], %% is_list(Term),
+    '$skip_max_list'(_, _, Term, Tail), Tail == [], %% is_list(Term),
     is_ordset2(Term).
 
 is_ordset2([]).

src/lib/os.pl

@@ -1,4 +1,4 @@
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Predicates for reasoning about the operating system (OS) environment.
    Written July 2020 by Markus Triska (triska@metalevel.at).
 
@@ -7,19 +7,22 @@
    Example:
 
        ?- getenv("LANG", Ls).
-          Ls = "en_US.UTF-8"
-       ;  false.
+          Ls = "en_US.UTF-8".
 
    Public domain code.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 :- module(os, [getenv/2,
                setenv/2,
-               unsetenv/1]).
+               unsetenv/1,
+               shell/1,
+               shell/2,
+               pid/1]).
 
 :- use_module(library(error)).
 :- use_module(library(charsio)).
 :- use_module(library(lists)).
+:- use_module(library(si)).
 
 getenv(Key, Value) :-
         must_be_env_var(Key),
@@ -34,6 +37,16 @@ unsetenv(Key) :-
         must_be_env_var(Key),
         '$unsetenv'(Key).
 
+shell(Command) :- shell(Command, 0).
+shell(Command, Status) :-
+    must_be_chars(Command),
+    can_be(integer, Status),
+    '$shell'(Command, Status).
+
+pid(PID) :-
+        can_be(integer, PID),
+        '$pid'(PID).
+
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    For now, we only support a restricted subset of variable names.
 

src/lib/pairs.pl

@@ -5,6 +5,8 @@
 		  map_list_to_pairs/3]).
 
 
+:- meta_predicate map_list_to_pairs(2, ?, ?).
+
 pairs_keys_values([], [], []).
 pairs_keys_values([A-B|ABs], [A|As], [B|Bs]) :-
         pairs_keys_values(ABs, As, Bs).

src/lib/pio.pl

@@ -1,19 +1,46 @@
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   Pure I/O
+   ========
+
+   Our goal is to encourage the use of definite clause grammars (DCGs)
+   for describing strings. The predicates phrase_from_file/[2,3],
+   phrase_to_file/[2,3] and phrase_to_stream/2 let us apply DCGs
+   transparently to files and streams, and therefore decouple side-effects
+   from declarative descriptions.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
 :- module(pio, [phrase_from_file/2,
-                phrase_from_file/3]).
+                phrase_from_file/3,
+                phrase_to_file/2,
+                phrase_to_file/3,
+                phrase_to_stream/2
+               ]).
 
 :- use_module(library(dcgs)).
 :- use_module(library(error)).
 :- use_module(library(freeze)).
 :- use_module(library(iso_ext), [setup_call_cleanup/3, partial_string/3]).
-:- use_module(library(lists), [member/2]).
+:- use_module(library(lists), [member/2, maplist/2]).
+:- use_module(library(charsio), [get_n_chars/3]).
+
+:- meta_predicate(phrase_from_file(2, ?)).
+:- meta_predicate(phrase_from_file(2, ?, ?)).
+:- meta_predicate(phrase_to_file(2, ?)).
+:- meta_predicate(phrase_to_file(2, ?, ?)).
+:- meta_predicate(phrase_to_stream(2, ?)).
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   phrase_from_file(GRBody, File)
+
+   True if grammar rule body GRBody covers the contents of File,
+   represented as a list of characters.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 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) ->
@@ -36,7 +63,53 @@ reader_step(Stream, Pos, Xs0) :-
         set_stream_position(Stream, Pos),
         (   at_end_of_stream(Stream)
         ->  Xs0 = []
-        ;   '$get_n_chars'(Stream, 4096, Cs),
+        ;   get_n_chars(Stream, 4096, Cs),
             partial_string(Cs, Xs0, Xs),
             stream_to_lazy_list(Stream, Xs)
         ).
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   phrase_to_stream(+GRBody, +Stream)
+
+   Emit the list of characters described by the grammar rule body
+   GRBody to Stream.
+
+   An ideal implementation of phrase_to_stream/2 writes each character
+   as soon as it becomes known and no choice-points remain, and thus
+   avoids the manifestation of the entire string in memory. See #691
+   for more information.
+
+   The current preliminary implementation is provided so that Prolog
+   programmers can already get used to describing output with DCGs,
+   and then writing it to a file when necessary. This simple
+   implementation suffices as long as the entire contents can be
+   represented in memory, and thus covers a large number of use cases.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+phrase_to_stream(GRBody, Stream) :-
+        phrase(GRBody, Cs),
+        must_be(chars, Cs),
+        (   stream_property(Stream, type(binary)) ->
+            (   '$first_non_octet'(Cs, N) ->
+                domain_error(octet_character, N, phrase_to_stream/2)
+            ;   true
+            )
+        ;   true
+        ),
+        % we use a specialised internal predicate that uses only a
+        % single "write" operation for efficiency. It is equivalent to
+        % maplist(put_char(Stream), Cs). It also works for binary streams.
+        '$put_chars'(Stream, Cs).
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   phrase_to_file(+GRBody, +File), writing the string described
+   by GRBody to File.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+phrase_to_file(GRBody, File) :-
+        phrase_to_file(GRBody, File, []).
+
+phrase_to_file(GRBody, File, Options) :-
+        setup_call_cleanup(open(File, write, Stream, Options),
+                           phrase_to_stream(GRBody, Stream),
+                           close(Stream)).

src/lib/random.pl

@@ -22,11 +22,11 @@ random(R) :-
 random_integer(Lower, Upper, R) :-
     var(R),
     (   (var(Lower) ; var(Upper)) ->
-            instantiation_error(random_integer/3)
+        instantiation_error(random_integer/3)
     ;   \+ integer(Lower) ->
-            domain_error(integer, Lower, random_integer/3)
+        type_error(integer, Lower, random_integer/3)
     ;   \+ integer(Upper) ->
-            domain_error(integer, Upper, random_integer/3)
+        type_error(integer, Upper, random_integer/3)
     ;   Upper > Lower,
         random(R0),
         R is floor((Upper - Lower) * R0 + Lower)

src/lib/reif.pl

@@ -1,9 +1,11 @@
 :- module(reif, [if_/3, (=)/3, (',')/3, (;)/3, cond_t/3, dif/3,
-		 memberd_t/3, tfilter/3, tmember/2, tmember_t/3,
-		 tpartition/4]).
+		         memberd_t/3, tfilter/3, tmember/2, tmember_t/3,
+		         tpartition/4]).
 
 :- use_module(library(dif)).
 
+:- meta_predicate(if_(1, 0, 0)).
+
 if_(If_1, Then_0, Else_0) :-
     call(If_1, T),
     (  T == true  -> call(Then_0)
@@ -26,13 +28,14 @@ dif(X, Y, T) :-
 non(true, false).
 non(false, true).
 
-tfilter(C_2, Es, Fs) :-
-   i_tfilter(Es, C_2, Fs).
+:- meta_predicate(tfilter(2, ?, ?)).
 
-i_tfilter([], _, []).
-i_tfilter([E|Es], C_2, Fs0) :-
+tfilter(_, [], []).
+tfilter(C_2, [E|Es], Fs0) :-
    if_(call(C_2, E), Fs0 = [E|Fs], Fs0 = Fs),
-   i_tfilter(Es, C_2, Fs).
+   tfilter(C_2, Es, Fs).
+
+:- meta_predicate(tpartition(2, ?, ?, ?)).
 
 tpartition(P_2, Xs, Ts, Fs) :-
    i_tpartition(Xs, P_2, Ts, Fs).
@@ -44,12 +47,18 @@ i_tpartition([X|Xs], P_2, Ts0, Fs0) :-
       , ( Fs0 = [X|Fs], Ts0 = Ts ) ),
    i_tpartition(Xs, P_2, Ts, Fs).
 
+:- meta_predicate(','(1, 1, ?)).
+
 ','(A_1, B_1, T) :-
     if_(A_1, call(B_1, T), T = false).
 
+:- meta_predicate(';'(1, 1, ?)).
+
 ';'(A_1, B_1, T) :-
     if_(A_1, T = true, call(B_1, T)).
 
+:- meta_predicate(cond_t(1, 0, ?)).
+
 cond_t(If_1, Then_0, T) :-
    if_(If_1, ( Then_0, T = true ), T = false ).
 
@@ -60,8 +69,13 @@ i_memberd_t([], _, false).
 i_memberd_t([X|Xs], E, T) :-
    if_( X = E, T = true, i_memberd_t(Xs, E, T) ).
 
+:- meta_predicate(tmember(2, ?)).
+
 tmember(P_2, [X|Xs]) :-
    if_( call(P_2, X), true, tmember(P_2, Xs) ).
 
+:- meta_predicate(tmember_t(2, ?, ?)).
+
+tmember_t(_P_2, [], false).
 tmember_t(P_2, [X|Xs], T) :-
    if_( call(P_2, X), T = true, tmember_t(P_2, Xs, T) ).

src/lib/serialization/abnf.pl

@@ -0,0 +1,166 @@
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   Written Apr 2021 by Aram Panasenco (panasenco@ucla.edu)
+   Part of Scryer Prolog.
+
+   [Core Rules](https://tools.ietf.org/html/rfc5234#appendix-B.1) of the
+   Augmented Backus-Naur Form specification (ABNF - RFC 5234). ABNF commonly
+   serves as the definition language for IETF communication protocols, so
+   having these DCGs can be extremely useful for reasoning about most IETF
+   syntaxes. The DCGs are presented in the order they appear in the RFC.
+   While some DCGs below use `char_type/2`, the most common ones are defined
+   manually in order to take advantage of Prolog's first-argument indexing.
+
+   BSD 3-Clause License
+
+   Copyright (c) 2021, Aram Panasenco
+   All rights reserved.
+
+   Redistribution and use in source and binary forms, with or without
+   modification, are permitted provided that the following conditions are met:
+
+   * Redistributions of source code must retain the above copyright notice, this
+     list of conditions and the following disclaimer.
+
+   * Redistributions in binary form must reproduce the above copyright notice,
+     this list of conditions and the following disclaimer in the documentation
+     and/or other materials provided with the distribution.
+
+   * Neither the name of the copyright holder nor the names of its
+     contributors may be used to endorse or promote products derived from
+     this software without specific prior written permission.
+
+   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+   AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+   IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+   DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+   FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+   DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+   SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+   CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+   OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+:- module(abnf, [abnf_alpha//1,
+                 abnf_bit//1,
+                 abnf_char//1,
+                 abnf_cr//0,
+                 abnf_crlf//0,
+                 abnf_ctl//1,
+                 abnf_digit//1,
+                 abnf_dquote//0,
+                 abnf_hexdig//1,
+                 abnf_htab//0,
+                 abnf_lf//0,
+                 abnf_lwsp//0,
+                 abnf_octet//1,
+                 abnf_sp//0,
+                 abnf_vchar//1,
+                 abnf_wsp//0 ]).
+
+:- use_module(library(charsio)).
+:- use_module(library(dcgs)).
+:- use_module(library(dif)).
+:- use_module(library(lists)).
+
+abnf_alpha('a') --> "a".
+abnf_alpha('b') --> "b".
+abnf_alpha('c') --> "c".
+abnf_alpha('d') --> "d".
+abnf_alpha('e') --> "e".
+abnf_alpha('f') --> "f".
+abnf_alpha('g') --> "g".
+abnf_alpha('h') --> "h".
+abnf_alpha('i') --> "i".
+abnf_alpha('j') --> "j".
+abnf_alpha('k') --> "k".
+abnf_alpha('l') --> "l".
+abnf_alpha('m') --> "m".
+abnf_alpha('n') --> "n".
+abnf_alpha('o') --> "o".
+abnf_alpha('p') --> "p".
+abnf_alpha('q') --> "q".
+abnf_alpha('r') --> "r".
+abnf_alpha('s') --> "s".
+abnf_alpha('t') --> "t".
+abnf_alpha('u') --> "u".
+abnf_alpha('v') --> "v".
+abnf_alpha('w') --> "w".
+abnf_alpha('x') --> "x".
+abnf_alpha('y') --> "y".
+abnf_alpha('z') --> "z".
+abnf_alpha('A') --> "A".
+abnf_alpha('B') --> "B".
+abnf_alpha('C') --> "C".
+abnf_alpha('D') --> "D".
+abnf_alpha('E') --> "E".
+abnf_alpha('F') --> "F".
+abnf_alpha('G') --> "G".
+abnf_alpha('H') --> "H".
+abnf_alpha('I') --> "I".
+abnf_alpha('J') --> "J".
+abnf_alpha('K') --> "K".
+abnf_alpha('L') --> "L".
+abnf_alpha('M') --> "M".
+abnf_alpha('N') --> "N".
+abnf_alpha('O') --> "O".
+abnf_alpha('P') --> "P".
+abnf_alpha('Q') --> "Q".
+abnf_alpha('R') --> "R".
+abnf_alpha('S') --> "S".
+abnf_alpha('T') --> "T".
+abnf_alpha('U') --> "U".
+abnf_alpha('V') --> "V".
+abnf_alpha('W') --> "W".
+abnf_alpha('X') --> "X".
+abnf_alpha('Y') --> "Y".
+abnf_alpha('Z') --> "Z".
+
+abnf_bit('0') --> "0".
+abnf_bit('1') --> "1".
+
+abnf_char(Char) --> [Char], { dif(Char, '\x0000\'), char_type(Char, ascii) }. %'
+
+abnf_cr --> "\r".
+
+abnf_crlf --> "\r\n".
+
+abnf_ctl(Char) --> [Char], { char_type(Char, ascii), char_type(Char, control) }.
+
+abnf_digit('0') --> "0".
+abnf_digit('1') --> "1".
+abnf_digit('2') --> "2".
+abnf_digit('3') --> "3".
+abnf_digit('4') --> "4".
+abnf_digit('5') --> "5".
+abnf_digit('6') --> "6".
+abnf_digit('7') --> "7".
+abnf_digit('8') --> "8".
+abnf_digit('9') --> "9".
+
+abnf_dquote --> "\"".
+
+abnf_hexdig(Char) --> abnf_digit(Char).
+abnf_hexdig('A') --> "A".
+abnf_hexdig('B') --> "B".
+abnf_hexdig('C') --> "C".
+abnf_hexdig('D') --> "D".
+abnf_hexdig('E') --> "E".
+abnf_hexdig('F') --> "F".
+
+abnf_htab --> "\t".
+
+abnf_lf --> "\n".
+
+abnf_lwsp --> "".
+abnf_lwsp --> abnf_wsp, abnf_lwsp.
+abnf_lwsp --> abnf_crlf, abnf_wsp, abnf_lwsp.
+
+abnf_octet(Char) --> [Char], char_type(Char, octet).
+
+abnf_sp --> " ".
+
+abnf_vchar(Char) --> [Char], char_type(Char, ascii_graphic).
+
+abnf_wsp --> abnf_sp.
+abnf_wsp --> abnf_htab.

src/lib/serialization/json.pl

@@ -0,0 +1,273 @@
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   Written Apr 2021 by Aram Panasenco (panasenco@ucla.edu)
+   Part of Scryer Prolog.
+
+   `json_chars//1` can be used with [`phrase_from_file/2`](src/lib/pio.pl)
+   or [`phrase/2`](src/lib/dcgs.pl) to parse and generate [JSON](https://www.json.org/json-en.html).
+
+   BSD 3-Clause License
+
+   Copyright (c) 2021, Aram Panasenco
+   All rights reserved.
+
+   Redistribution and use in source and binary forms, with or without
+   modification, are permitted provided that the following conditions are met:
+
+   * Redistributions of source code must retain the above copyright notice, this
+     list of conditions and the following disclaimer.
+
+   * Redistributions in binary form must reproduce the above copyright notice,
+     this list of conditions and the following disclaimer in the documentation
+     and/or other materials provided with the distribution.
+
+   * Neither the name of the copyright holder nor the names of its
+     contributors may be used to endorse or promote products derived from
+     this software without specific prior written permission.
+
+   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+   AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+   IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+   DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+   FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+   DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+   SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+   CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+   OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+:- module(json, [
+                 json_chars//1
+                ]).
+
+:- use_module(library(dcgs)).
+:- use_module(library(dif)).
+:- use_module(library(lists)).
+
+/*  The DCGs are written to match the McKeeman form presented on the right side of https://www.json.org/json-en.html
+    as closely as possible. Note that the names in the McKeeman form conflict with the pictures on the site. */
+json_chars(Internal) --> json_element(Internal).
+
+/*  Because it's impossible to distinguish between an empty array [] and an empty string "", we distinguish between
+    different types of values based on their principal functor. The principal functors match the types defined in
+    the JSON Schema spec here: https://json-schema.org/draft/2020-12/json-schema-validation.html#rfc.section.6.1.1
+    EXCEPT we don't yet support the integer type. There are plans for more JSON Schema support in the near future. */
+json_value(pairs(Pairs))    --> json_object(Pairs).
+json_value(list(List))      --> json_array(List).
+json_value(string(Chars))   --> json_string(Chars).
+json_value(number(Number))  --> json_number(Number).
+json_value(boolean(Bool))   --> json_boolean(Bool).
+json_value(null)            --> "null".
+
+/*  We pull json_boolean out into its own predicate in order to take advantage of first argument indexing and not leave
+    choice points. For more details, watch this video on decomposing arguments: https://youtu.be/FZLofckPu4A?t=1648 */
+json_boolean(true) --> "true".
+json_boolean(false) --> "false".
+
+json_object([])           --> "{", json_ws, "}".
+json_object([Pair|Pairs]) -->
+        "{",
+        json_members(Pairs, Pair),
+        "}".
+
+/*  `json_members//2` below is implemented with a lagged argument to take advantage of first argument indexing.
+    This is a pure performance-driven decision that doesn't affect the logic. The predicate could equivalently be
+    implementes as `json_members//1` below:
+    ```
+    json_members([Key-Value, Pair2 | Pairs]) --> json_member(Key, Value), ",", json_members([Pair2 | Pairs]).
+    ```
+    That's a logically equivalent and equally clean representation to the lagged argument. However, it leaves
+    choice points, while using the lagged argument doesn't. For more info, watch: https://youtu.be/FZLofckPu4A?t=1737
+    */
+json_members([], Key-Value)               --> json_member(Key, Value).
+json_members([NextPair|Pairs], Key-Value) -->
+        json_member(Key, Value),
+        ",",
+        json_members(Pairs, NextPair).
+
+json_member(string(Key), Value) --> json_ws, json_string(Key), json_ws, ":", json_element(Value).
+
+json_array([])             --> "[", json_ws, "]".
+json_array([Value|Values]) --> "[", json_elements(Values, Value), "]".
+
+/* Also using a lagged argument with `json_elements//2` to take advantage of first-argument indexing */
+json_elements([], Value)                 --> json_element(Value).
+json_elements([NextValue|Values], Value) -->
+        json_element(Value),
+        ",",
+        json_elements(Values, NextValue).
+
+json_element(Value) --> json_ws, json_value(Value), json_ws.
+
+json_string(Chars) --> "\"", json_characters(Chars), "\"".
+
+json_characters("")           --> "".
+json_characters([Char|Chars]) --> json_character(Char), json_characters(Chars).
+
+/*  Note on variable instantiation checks (`var/1` and `nonvar/1`) used below and in Prolog in general.
+    Instantiation checks should never be used to change the logic of your program. Instead, they are one of
+    many tools to adjust the 'control' or 'search strategy' used by Prolog to execute the logic of your program.
+    For a general overview of the idea, read Bob Kowalski's "Algorithm = Logic + Control":
+    https://www.doc.ic.ac.uk/~rak/papers/algorithm%20=%20logic%20+%20control.pdf
+    For an introduction to search strategies in Prolog, read: https://www.metalevel.at/prolog/sorting#searching
+    It's tempting to use instantiation checks to be more strict while generating and more relaxed while parsing.
+    In fact, the early version of this library aimed to return exactly one result when generating. However, doing that
+    is **wrong** and leads to difficult-to-catch bugs. Instead, adjust the search strategy to return the most ideal
+    and strictest answer FIRST and then return less ideal answers on backtracking.
+    As an example, consider a string containing just the forward slash. The JSON standard recommends the forward slash
+    be escaped with a backslash, but allows it to not be escaped. Attempting to force stricter behavior with
+    instantiation checks can lead to this confusing mess:
+    ```
+    phrase(json:json_characters("/"), External).
+       External = "\\/".
+    ?- phrase(json:json_characters(Internal), "/").
+       Internal = "/"
+    ;  false.
+    ?- phrase(json:json_characters("/"), "/").
+    false.
+    ```
+    To avoid such bugs, never use instantiation checks to reduce the number of right answers, but rather to adjust
+    the *path* used to traverse those answers. */
+
+escape_char('"', '"').
+escape_char('\\', '\\').
+escape_char('/', '/').
+escape_char('\b', 'b').
+escape_char('\f', 'f').
+escape_char('\n', 'n').
+escape_char('\r', 'r').
+escape_char('\t', 't').
+
+json_character(EscapeChar) -->
+        { escape_char(EscapeChar, PrintChar) },
+        "\\",
+        [PrintChar].
+json_character(PrintChar)  -->
+    [PrintChar],
+    { dif(PrintChar, '\\'),
+      dif(PrintChar, '"'),
+      char_code(PrintChar, PrintCharCode),
+      PrintCharCode >= 32 }.
+json_character(EscapeChar) -->
+        "\\u",
+        json_hex(H1),
+        json_hex(H2),
+        json_hex(H3),
+        json_hex(H4),
+        { (   nonvar(H1) ->
+              EscapeCharCode is H1 * 16^3 + H2 * 16^2 + H3 * 16 + H4,
+              char_code(EscapeChar, EscapeCharCode)
+          ;   char_code(EscapeChar, EscapeCharCode),
+              H1 is (EscapeCharCode // 16^3) mod 16,
+              H2 is (EscapeCharCode // 16^2) mod 16,
+              H3 is (EscapeCharCode // 16^1) mod 16,
+              H4 is (EscapeCharCode // 16^0) mod 16
+          ) }.
+
+json_hex(Digit) --> json_digit(Digit).
+json_hex(10)    --> "a".
+json_hex(11)    --> "b".
+json_hex(12)    --> "c".
+json_hex(13)    --> "d".
+json_hex(14)    --> "e".
+json_hex(15)    --> "f".
+json_hex(10)    --> "A".
+json_hex(11)    --> "B".
+json_hex(12)    --> "C".
+json_hex(13)    --> "D".
+json_hex(14)    --> "E".
+json_hex(15)    --> "F".
+
+/*  I can't think of any alternatives to using `number_chars/2` when generating, though this leads
+    to under-reporting of correct solutions. At least matching solutions unify when both are instantiated...
+    ```
+    ?- phrase(json:json_number(N), "123E2").
+       N = 12300
+    ;  false.
+    ?- phrase(json:json_number(12300), Cs).
+       Cs = "12300".
+    ?- phrase(json:json_number(12300), "123E2").
+       true
+    ;  false.
+    ```
+*/
+parsing, [C] --> [C], { nonvar(C) }.
+
+json_number(Number) -->
+        (   parsing ->
+            json_sign_noplus(Sign),
+            json_integer(Integer),
+            json_fraction(Fraction),
+            json_exponent(Exponent),
+            { (   Exponent >= 0 ->
+                  Base = 10
+              ;   Base = 10.0
+              ),
+              Number is Sign * (Integer + Fraction) * Base ^ Exponent }
+        ;   { number_chars(Number, NumberChars) },
+            NumberChars
+        ).
+
+json_integer(Digit)      --> json_digit(Digit).
+json_integer(TotalValue) -->
+        json_onenine(FirstDigit),
+        json_digits(RemainingValue, Power),
+        { TotalValue is FirstDigit * 10 ^ (Power + 1) + RemainingValue }.
+
+json_digits(Digit, 0)     --> json_digit(Digit).
+json_digits(Value, Power) -->
+        json_digit(FirstDigit),
+        json_digits(RemainingValue, NextPower),
+        { Power is NextPower + 1,
+          Value is FirstDigit * 10^Power + RemainingValue }.
+
+json_digit(0)     --> "0".
+json_digit(Digit) --> json_onenine(Digit).
+
+json_onenine(1) --> "1".
+json_onenine(2) --> "2".
+json_onenine(3) --> "3".
+json_onenine(4) --> "4".
+json_onenine(5) --> "5".
+json_onenine(6) --> "6".
+json_onenine(7) --> "7".
+json_onenine(8) --> "8".
+json_onenine(9) --> "9".
+
+json_fraction(0)        --> "".
+json_fraction(Fraction) -->
+        ".",
+        json_digits(Value, Power),
+        { Fraction is Value / 10.0 ^ (Power + 1) }.
+
+json_exponent(0)        --> "".
+json_exponent(Exponent) -->
+        json_exponent_signifier,
+        json_sign(Sign),
+        json_digits(Value, _),
+        { Exponent is Sign * Value }.
+
+json_exponent_signifier --> "E".
+json_exponent_signifier --> "e".
+
+json_sign_noplus(1)  --> "".
+json_sign_noplus(-1) --> "-".
+
+json_sign(Sign) --> json_sign_noplus(Sign).
+json_sign(1)    --> "+".
+
+/* Make `json_ws/0` greedy when parsing, lazy when generating */
+json_ws_empty --> "".
+json_ws_nonempty --> " ".
+json_ws_nonempty --> "\n".
+json_ws_nonempty --> "\r".
+json_ws_nonempty --> "\t".
+json_ws_greedy --> json_ws_nonempty, json_ws_greedy.
+json_ws_greedy --> json_ws_empty.
+json_ws_lazy --> json_ws_empty.
+json_ws_lazy --> json_ws_nonempty, json_ws_lazy.
+json_ws -->
+        (   parsing ->
+            json_ws_greedy
+        ;   json_ws_lazy
+        ).

src/lib/sgml.pl

@@ -1,28 +1,30 @@
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Predicates for parsing HTML and XML documents.
-   Written June 2020 by Markus Triska (triska@metalevel.at)
+   Written 2020-2022 by Markus Triska (triska@metalevel.at)
    Part of Scryer Prolog.
 
    Currently, two predicates are provided:
 
-   -  load_html(+Source, -Es, +Options)
-   -  load_xml(+Source, -Es, +Options)
+     -  load_html(+Source, -Es, +Options)
+     -  load_xml(+Source, -Es, +Options)
 
    These predicates parse HTML and XML documents, respectively.
 
-   Source must be a stream, specified as stream(S), or a file,
-   specified as file(Name), where Name is a list of characters, or a
-   list of characters with the document contents.
+   Source must be one of:
+
+     - a list of characters with the document contents
+     - stream(S), specifying a stream S from which to read the content
+     - file(Name), where Name is a list of characters specifying a file name.
 
    Es is unified with the abstract syntax tree of the parsed document,
    represented as a list of elements where each is of the form:
 
-   * a list of characters, representing text
-   * element(Name, Attrs, Children)
-     - Name is the name of the tag
-     - Attrs is a list of Key=Value pairs:
-       Key is an atom, and Value is a list of characters
-     - Children is a list of elements as specified here.
+     * a list of characters, representing text
+     * element(Name, Attrs, Children)
+       - Name, an atom, is the name of the tag
+       - Attrs is a list of Key=Value pairs:
+         Key is an atom, and Value is a list of characters
+       - Children is a list of elements as specified here.
 
    Currently, Options are ignored. In the future, more options may be
    provided to control parsing.
@@ -58,35 +60,37 @@
 :- use_module(library(error)).
 :- use_module(library(dcgs)).
 :- use_module(library(pio)).
+:- use_module(library(charsio)).
 
 load_html(Source, Es, Options) :-
+        must_be_source(Source, load_html/3),
+        must_be(list, Options),
         load_structure_(Source, Es, Options, html).
 load_xml(Source, Es, Options) :-
+        must_be_source(Source, load_xml/3),
+        must_be(list, Options),
         load_structure_(Source, Es, Options, xml).
 
-list([]) --> [].
-list([L|Ls]) --> [L], list(Ls).
+must_be_source(Source, Context) :-
+        (   var(Source) -> instantiation_error(Context)
+        ;   is_sgml_source(Source) -> true
+        ;   domain_error(sgml_source, Source, Context)
+        ).
+
+is_sgml_source(file(Fs)) :- must_be(chars, Fs).
+is_sgml_source(stream(_)).
+is_sgml_source([]).
+is_sgml_source([C|Cs]) :- must_be(chars, [C|Cs]).
 
 load_structure_([], [], _, _).
 load_structure_([C|Cs], [E], Options, What) :-
         load_(What, [C|Cs], E, Options).
 load_structure_(file(Fs), [E], Options, What) :-
-        must_be(list, Options),
-        must_be(list, Fs),
-        atom_chars(File, Fs),
-        once(phrase_from_file(list(Cs), File)),
+        once(phrase_from_file(seq(Cs), Fs)),
         load_(What, Cs, E, Options).
 load_structure_(stream(Stream), [E], Options, What) :-
-        must_be(list, Options),
-        read_to_end(Stream, Cs),
+        get_n_chars(Stream, _, Cs),
         load_(What, Cs, E, Options).
 
 load_(html, Cs, E, Options) :- '$load_html'(Cs, E, Options).
 load_(xml, Cs, E, Options) :- '$load_xml'(Cs, E, Options).
-
-read_to_end(Stream, Cs) :-
-        '$get_n_chars'(Stream, 4096, Cs0),
-        (   Cs0 = [] -> Cs = []
-        ;   partial_string(Cs0, Cs, Rest),
-            read_to_end(Stream, Rest)
-        ).

src/lib/si.pl

@@ -27,7 +27,8 @@
 :- module(si, [atom_si/1,
                integer_si/1,
                atomic_si/1,
-               list_si/1]).
+               list_si/1,
+               chars_si/1]).
 
 :- use_module(library(lists)).
 
@@ -42,6 +43,16 @@ integer_si(I) :-
 atomic_si(AC) :-
    functor(AC,_,0).
 
-list_si(L) :-
-   \+ \+ length(L, _),
-   sort(L, _).
+% list_si(L) :-
+%    \+ \+ length(L, _),
+%    sort(L, _).
+
+list_si(L0) :-
+   '$skip_max_list'(_,_, L0,L),
+   (  nonvar(L) -> L = []
+   ;  throw(error(instantiation_error, list_si/1))
+   ).
+
+chars_si(Cs) :-
+   list_si(Cs),
+   '$is_partial_string'(Cs).

src/lib/sockets.pl

@@ -6,16 +6,6 @@
                     current_hostname/1]).
 
 :- use_module(library(error)).
-:- use_module(library(lists)).
-
-parse_socket_options_(tls(TLS), tls-TLS) :-
-    must_be(boolean, TLS), !.
-parse_socket_options_(Option, OptionPair) :-
-    builtins:parse_stream_options_(Option, OptionPair).
-
-parse_socket_options(Options, OptionValues, Stub) :-
-    DefaultOptions = [alias-[], eof_action-eof_code, reposition-false, tls-false, type-text],
-    builtins:parse_options_list(Options, parse_socket_options_, DefaultOptions, OptionValues, Stub).
 
 socket_client_open(Addr, Stream, Options) :-
     (  var(Addr) ->
@@ -32,10 +22,10 @@ socket_client_open(Addr, Stream, Options) :-
     ;
        throw(error(type_error(socket_address, Addr), socket_client_open/3))
     ),
-    parse_socket_options(Options,
-                         [Alias, EOFAction, Reposition, TLS, Type],
-                         socket_client_open/3),
-    '$socket_client_open'(Address, Port, Stream, Alias, EOFAction, Reposition, Type, TLS).
+    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) :-

src/lib/tabling.pl

@@ -11,9 +11,9 @@
 :- use_module(library(tabling/double_linked_list)).
 :- use_module(library(tabling/table_data_structure)).
 :- use_module(library(tabling/batched_worklist)).
-:- use_module(library(tabling/wrapper)).
 :- use_module(library(tabling/global_worklist)).
 :- use_module(library(tabling/table_link_manager)).
+:- use_module(library(tabling/wrapper)).
 
 :- use_module(library(cont)).
 :- use_module(library(lists)).
@@ -66,6 +66,9 @@ table_and_status_for_variant(V,T,S) :-
   table_for_variant(V,T),
   tbd_table_status(T,S).
 
+
+:- meta_predicate start_tabling(?, :).
+
 start_tabling(Wrapper,Worker) :-
   put_new_trie_table_link,
   put_new_global_worklist,

src/lib/tabling/batched_worklist.pl

@@ -53,6 +53,8 @@
 
 :- attribute executing_all_work/1, worklist_presence/1, wkl_answer_cluster/1, wkl_suspension_cluster/1, wkl_answer_cluster_pointer_flag/1.
 
+verify_attributes(_, _, []).
+
 /** <module> Tabling Worklist management
 
 A batched worklist: a worklist that  clusters suspensions and answers as
@@ -161,6 +163,8 @@ wkl_p_swap_answer_continuation(Worklist,InnerAnswerClusterPointer,SuspensionClus
   wkl_p_update_righmost_inner_answer_cluster_pointer(Worklist,InnerAnswerClusterPointer).
 
 % Update the pointer if the answer cluster it points to is no longer the rightmost inner answer cluster.
+% Strangely, this predicate was intentionally named "wkl_p_update_righmost_inner_answer_cluster_pointer"
+% in the original library.
 wkl_p_update_righmost_inner_answer_cluster_pointer(Worklist,InnerAnswerClusterPointer) :-
   ( wkl_p_answer_cluster_currently_moved_completely(Worklist,InnerAnswerClusterPointer) ->
     wkl_p_find_new_rightmost_inner_answer_cluster_pointer(Worklist,InnerAnswerClusterPointer,NewRiacPointer),

src/lib/tabling/global_worklist.pl

@@ -13,6 +13,8 @@
 
 :- attribute table_global_worklist/1.
 
+verify_attributes(_, _, []).
+
 put_new_global_worklist :-
   (  bb_get(table_global_worklist_initialized, _) ->
      true

src/lib/tabling/table_data_structure.pl

@@ -61,6 +61,8 @@
 
 :- attribute table_status/1, newly_created_table_identifiers/1.
 
+verify_attributes(_, _, []).
+
 % This file defines the table datastructure.
 %
 % The table datastructure contains the following sub-structures:

src/lib/tabling/table_link_manager.pl

@@ -51,6 +51,8 @@
 
 :- attribute trie_table_link/1.
 
+verify_attributes(_, _, []).
+
 % This file defines a call pattern trie.
 %
 % This data structure keeps the relation between a variant and the

src/lib/tabling/trie.pl

@@ -41,12 +41,16 @@
 	    trie_get_all_values/2		% +Trie, -Value
 	  ]).
 
+:- use_module(library(format)).
+
 :- use_module(library(assoc)).
 :- use_module(library(atts)).
 :- use_module(library(lists)).
 
 :- attribute maybe_just/1, children/1.
 
+verify_attributes(_, _, []).
+
 % Implementation of a prefix tree, a.k.a. trie %
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 

src/lib/tabling/wrapper.pl

@@ -40,6 +40,8 @@
 :- use_module(library(dcgs)).
 :- use_module(library(error)).
 
+:- multifile(tabled/2).
+
 %%:- multifile
 %%	system:term_expansion/2,
 %%	tabled/2.
@@ -54,8 +56,8 @@
 %% table(PIList) :-
 %% 	throw(error(context_error(nodirective, table(PIList)), _)).
 
-instantiation_error(Var) :-
-        throw(error(instantiation_error(Var), _)).
+%% instantiation_error(Var) :-
+%%         throw(error(instantiation_error(Var), _)).
 
 wrappers(Var) -->
 	{ var(Var), !,
@@ -75,7 +77,7 @@ wrappers(Name/Arity) -->
 	  atom_concat(Name, ' tabled', WrapName),
 	  Head =.. [Name|Args],
 	  WrappedHead =.. [WrapName|Args],
-	  '$module_of'(Module, Name) %prolog_load_context(module, Module)
+	  prolog_load_context(module, Module)
 	},
 	[ (   Head :-
 		 start_tabling(Module:Head, WrappedHead)
@@ -93,10 +95,15 @@ rename((Head --> Body), (NewHead --> Body), Module) :- !,
 	functor(Head, Name, Arity),
 	PlainArity is Arity+1,
 	functor(PlainHead, Name, PlainArity),
-	table_wrapper:tabled(PlainHead, Module),
+	catch(table_wrapper:tabled(PlainHead, Module),
+          error(existence_error(procedure, tabled/2), _),
+          false),
 	rename_term(Head, NewHead).
 rename(Head, NewHead, Module) :-
-	table_wrapper:tabled(Head, Module), !,
+	catch(table_wrapper:tabled(Head, Module),
+          error(existence_error(procedure, tabled/2), _),
+          false),
+    !,
 	rename_term(Head, NewHead).
 
 rename_term(Compound0, Compound) :-
@@ -109,10 +116,10 @@ rename_term(Name, WrapName) :-
 
 
 user:term_expansion(Term0, Clauses) :-
-        nonvar(Term0),
+    nonvar(Term0),
 	Term0 = (:- table Preds),
 	phrase(wrappers(Preds), Clauses).
 user:term_expansion(Clause, NewClause) :-
-        nonvar(Clause),
-	'$module_of'(Module, Clause),
+    nonvar(Clause),
+    prolog_load_context(module, Module),
 	rename(Clause, NewClause, Module).

src/lib/terms.pl

@@ -4,8 +4,8 @@
 
 numbervars(Term, N0, N) :-
    catch(internal_numbervars(Term, N0, N),
-	 error(E,Ctx),
-	 ( ( var(Ctx) -> Ctx = numbervars/3 ; true ), throw(error(E,Ctx) ) ) ).
+	     error(E,Ctx),
+	     ( ( var(Ctx) -> Ctx = numbervars/3 ; true ), throw(error(E,Ctx) ) ) ).
 
 internal_numbervars(Term, N0, N) :-
    must_be(integer, N0),

src/lib/time.pl

@@ -1,5 +1,5 @@
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-   Written 2020 by Markus Triska (triska@metalevel.at)
+   Written 2020, 2021 by Markus Triska (triska@metalevel.at)
    Part of Scryer Prolog.
 
    This library provides predicates for reasoning about time.
@@ -34,8 +34,7 @@
    Example:
 
      ?- current_time(T), phrase(format_time("%d.%m.%Y (%H:%M:%S)", T), Cs).
-        T = [...], Cs = "11.06.2020 (00:24:32)"
-     ;  false.
+        T = [...], Cs = "11.06.2020 (00:24:32)".
 
    sleep(S) sleeps for S seconds (a floating point number).
 
@@ -50,25 +49,22 @@
 :- use_module(library(error)).
 :- use_module(library(dcgs)).
 :- use_module(library(lists)).
-:- use_module(library(charsio), [read_term_from_chars/2]).
+:- use_module(library(charsio), [read_from_chars/2]).
 
 current_time(T) :-
         '$current_time'(T0),
-        read_term_from_chars(T0, T).
+        read_from_chars(T0, T).
 
 format_time([], _) --> [].
 format_time(['%','%'|Fs], T) --> !, "%", format_time(Fs, T).
 format_time(['%',Spec|Fs], T) --> !,
         (   { member(Spec=Value, T) } ->
-            list(Value)
+            seq(Value)
         ;   { domain_error(time_specifier, Spec, format_time//2) }
         ),
         format_time(Fs, T).
 format_time([F|Fs], T) --> [F], format_time(Fs, T).
 
-list([]) --> [].
-list([L|Ls]) --> [L], list(Ls).
-
 max_sleep_time(0xfffffffffffffbff).
 
 sleep(T) :-
@@ -83,47 +79,74 @@ sleep(T) :-
 
 % '$cpu_now' can be replaced by statistics/2 once that is implemented.
 
+:- meta_predicate time(0).
+
+:- dynamic(time_id/1).
+:- dynamic(time_state/2).
+
+time_next_id(N) :-
+        (   retract(time_id(N0)) ->
+            N is N0 + 1
+        ;   N = 0
+        ),
+        asserta(time_id(N)).
+
 time(Goal) :-
         '$cpu_now'(T0),
-        setup_call_cleanup(true,
-                           (   Goal,
-                               report_time(T0)
+        time_next_id(ID),
+        setup_call_cleanup(asserta(time_state(ID, T0)),
+                           (   call_cleanup(catch(Goal, E, (report_time(ID),throw(E))),
+                                            Det = true),
+                               time_true(ID),
+                               (   Det == true -> !
+                               ;   true
+                               )
+                           ;   report_time(ID),
+                               false
                            ),
-                           report_time(T0)).
+                           retract(time_state(ID, _))).
 
-report_time(T0) :-
+time_true(ID) :-
+        report_time(ID).
+time_true(ID)  :-
+        % on backtracking, update the stored CPU time for this ID
+        retract(time_state(ID, _)),
+        '$cpu_now'(T0),
+        asserta(time_state(ID, T0)),
+        false.
+
+report_time(ID) :-
+        time_state(ID, 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])
-        ).
+        (   bb_get('$answer_count', 0) ->
+            Pre = "   ", Post = ""
+        ;   Pre = "", Post = "   "
+        ),
+        format("~s% CPU time: ~3fs~n~s", [Pre,Time,Post]).
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 ?- time((true;false)).
-   % CPU time: 0.000 seconds
-   true
-;  % CPU time: 0.001 seconds
-   false.
+%@    % CPU time: 0.006s
+%@    true
+%@ ;  % CPU time: 0.001s
+%@    false.
 
 :- time(use_module(library(clpz))).
-   % CPU time: 2.762 seconds
-   true
-;  false.
+%@    % CPU time: 3.711s
+%@    true.
 
 :- time(use_module(library(lists))).
-   % CPU time: 0.000 seconds
-   true
-;  % CPU time: 0.001 seconds
-   false.
+%@    % CPU time: 0.006s
+%@    true.
 
-?- 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.
+?- time(member(X, "abc")).
+%@    % CPU time: 0.005s
+%@    X = a
+%@ ;  % CPU time: 0.000s
+%@    X = b
+%@ ;  % CPU time: 0.000s
+%@    X = c
+%@ ;  % CPU time: 0.000s
+%@    false.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

src/lib/tls.pl

@@ -0,0 +1,110 @@
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   Negotiation of TLS connections.
+   Written Dec. 2021 by Markus Triska (triska@metalevel.at)
+   Part of Scryer Prolog.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+:- module(tls, [tls_client_context/2,   % -Context, +Options
+                tls_client_negotiate/3, % +Context, +Stream0, -Stream
+                tls_server_context/2,   % -Context, +Options
+                tls_server_negotiate/3  % +Context, +Stream0, -Stream
+               ]).
+
+:- use_module(library(lists)).
+:- use_module(library(error)).
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   TLS Clients
+   ===========
+
+   Use tls_client_context/2 to create a TLS context, for example with:
+
+   tls_client_context(Context, [hostname("metalevel.at")])
+
+   Using the context and an existing stream S0 (for example, the
+   result of socket_client_open/3), a TLS stream S can be negotiated
+   with:
+
+   tls_client_negotiate(Context, S0, S)
+
+   S will be an encrypted and authenticated stream with the server.
+
+   The advantage of separating the creation of the client context from
+   negotiating a connection is that the context can be created only once,
+   and quickly reused if needed. This is currently not implemented: In
+   the present implementation, a new internal "Connector" is created for
+   every connection, using the specified hostname.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+tls_client_context(tls_context(Host), Options) :-
+        must_be(list, Options),
+        (   member(hostname(Host), Options) ->
+            must_be(chars, Host)
+        ;   Host = ""
+        ).
+
+tls_client_negotiate(tls_context(Host), S0, S) :-
+        '$tls_client_connect'(Host, S0, S).
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   TLS Servers
+   ===========
+
+   Use tls_server_context/2 to create a TLS context, for example with:
+
+   tls_server_context(Context, [pkcs12(Chars)])
+
+   where Chars is a list of characters with the contents of a
+   DER-formatted PKCS #12 archive. The option password(Ps) can be used
+   to specify the password Ps (also a string) for decrypting the key.
+   On some versions of OSX, and potentially also on other platforms,
+   empty passwords are not supported.
+
+   The archive should contain a leaf certificate and its private key,
+   as well any intermediate certificates that should be sent to
+   clients to allow them to build a chain to a trusted root. The chain
+   certificates should be in order from the leaf certificate towards
+   the root.
+
+   PKCS #12 archives typically have the file extension .p12 or .pfx,
+   and can be created with the OpenSSL pkcs12 tool:
+
+   $ openssl pkcs12 -export -out identity.pfx \
+                    -inkey key.pem -in cert.pem -certfile chain_certs.pem
+
+
+   You can use phrase_from_file/3 from library(pio) and seq//1 from
+   library(dcgs) to read the contents of "identity.pfx" into a string:
+
+   phrase_from_file(seq(Chars), "identity.pfx", [type(binary)])
+
+   The obtained context should be treated as an opaque Prolog term.
+
+   Using the context and an existing stream S0 (for example, the
+   result of socket_server_accept/4), a TLS stream S can be negotiated
+   by a Prolog-based server with:
+
+   tls_server_negotiate(Context, S0, S)
+
+   S will be an encrypted and authenticated stream with the client.
+
+   The advantage of separating the creation of the server context from
+   negotiating a connection is that the context can be created only
+   once, and quickly cloned for every incoming connection. This is
+   currently not implemented: In the present implementation, a new context
+   is created for every connection, using the specified parameters.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+tls_server_context(tls_context(Cert,Password), Options) :-
+        (   member(pcks12(Cert), Options) ->
+            must_be(chars, Cert)
+        ;   domain_error(contains_pcks12, Options, tls_server_context/2)
+        ),
+        (   member(password(Password), Options) ->
+            must_be(chars, Password)
+        ;   Password = ""
+        ).
+
+tls_server_negotiate(tls_context(Cert,Password), S0, S) :-
+        '$tls_accept_client'(Cert, Password, S0, S).
+

src/lib/ugraphs.pl

@@ -0,0 +1,630 @@
+/*  Author:        R.A.O'Keefe, Vitor Santos Costa, Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  1984-2021, VU University Amsterdam
+                              CWI, Amsterdam
+                              SWI-Prolog Solutions .b.v
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+:- module(ugraphs,
+          [ add_edges/3,                % +Graph, +Edges, -NewGraph
+            add_vertices/3,             % +Graph, +Vertices, -NewGraph
+            complement/2,               % +Graph, -NewGraph
+            compose/3,                  % +LeftGraph, +RightGraph, -NewGraph
+            del_edges/3,                % +Graph, +Edges, -NewGraph
+            del_vertices/3,             % +Graph, +Vertices, -NewGraph
+            edges/2,                    % +Graph, -Edges
+            neighbors/3,                % +Vertex, +Graph, -Vertices
+            neighbours/3,               % +Vertex, +Graph, -Vertices
+            reachable/3,                % +Vertex, +Graph, -Vertices
+            top_sort/2,                 % +Graph, -Sort
+            top_sort/3,                 % +Graph, -Sort0, -Sort
+            transitive_closure/2,       % +Graph, -Closure
+            transpose_ugraph/2,         % +Graph, -NewGraph
+            vertices/2,                 % +Graph, -Vertices
+            vertices_edges_to_ugraph/3, % +Vertices, +Edges, -Graph
+            ugraph_union/3,             % +Graph1, +Graph2, -Graph
+            connect_ugraph/3            % +Graph1, -Start, -Graph
+          ]).
+
+/** <module> Graph manipulation library
+
+The S-representation of a graph is  a list of (vertex-neighbours) pairs,
+where the pairs are in standard order   (as produced by keysort) and the
+neighbours of each vertex are also  in   standard  order (as produced by
+sort). This form is convenient for many calculations.
+
+A   new   UGraph   from    raw    data     can    be    created    using
+vertices_edges_to_ugraph/3.
+
+Adapted to support some of  the   functionality  of  the SICStus ugraphs
+library by Vitor Santos Costa.
+
+Ported from YAP 5.0.1 to SWI-Prolog by Jan Wielemaker.
+
+@author R.A.O'Keefe
+@author Vitor Santos Costa
+@author Jan Wielemaker
+@license BSD-2 or Artistic 2.0
+*/
+
+:- use_module(library(lists)).
+:- use_module(library(pairs)).
+:- use_module(library(ordsets)).
+
+%!  vertices(+Graph, -Vertices)
+%
+%   Unify Vertices with all vertices appearing in Graph. Example:
+%
+%       ?- vertices([1-[3,5],2-[4],3-[],4-[5],5-[]], L).
+%       L = [1, 2, 3, 4, 5]
+
+vertices([], []) :- !.
+vertices([Vertex-_|Graph], [Vertex|Vertices]) :-
+    vertices(Graph, Vertices).
+
+
+%!  vertices_edges_to_ugraph(+Vertices, +Edges, -UGraph) is det.
+%
+%   Create a UGraph from Vertices and edges.   Given  a graph with a
+%   set of Vertices and a set of   Edges,  Graph must unify with the
+%   corresponding S-representation. Note that   the vertices without
+%   edges will appear in Vertices but not  in Edges. Moreover, it is
+%   sufficient for a vertice to appear in Edges.
+%
+%   ==
+%   ?- vertices_edges_to_ugraph([],[1-3,2-4,4-5,1-5], L).
+%   L = [1-[3,5], 2-[4], 3-[], 4-[5], 5-[]]
+%   ==
+%
+%   In this case all  vertices  are   defined  implicitly.  The next
+%   example shows three unconnected vertices:
+%
+%   ==
+%   ?- vertices_edges_to_ugraph([6,7,8],[1-3,2-4,4-5,1-5], L).
+%   L = [1-[3,5], 2-[4], 3-[], 4-[5], 5-[], 6-[], 7-[], 8-[]]
+%   ==
+
+vertices_edges_to_ugraph(Vertices, Edges, Graph) :-
+    sort(Edges, EdgeSet),
+    p_to_s_vertices(EdgeSet, IVertexBag),
+    append(Vertices, IVertexBag, VertexBag),
+    sort(VertexBag, VertexSet),
+    p_to_s_group(VertexSet, EdgeSet, Graph).
+
+
+%!  add_vertices(+Graph, +Vertices, -NewGraph)
+%
+%   Unify NewGraph with a new  graph  obtained   by  adding  the list of
+%   Vertices to Graph. Example:
+%
+%   ```
+%   ?- add_vertices([1-[3,5],2-[]], [0,1,2,9], NG).
+%   NG = [0-[], 1-[3,5], 2-[], 9-[]]
+%   ```
+
+% replace with real msort/2 when available
+msort_(List, Sorted) :-
+    pairs_keys(Pairs, List),
+    keysort(Pairs, SortedPairs),
+    pairs_keys(SortedPairs, Sorted).
+
+add_vertices(Graph, Vertices, NewGraph) :-
+    % msort/2 not available in Scryer Prolog yet: msort(Vertices, V1),
+    msort_(Vertices, V1),
+    add_vertices_to_s_graph(V1, Graph, NewGraph).
+
+add_vertices_to_s_graph(L, [], NL) :-
+    !,
+    add_empty_vertices(L, NL).
+add_vertices_to_s_graph([], L, L) :- !.
+add_vertices_to_s_graph([V1|VL], [V-Edges|G], NGL) :-
+    compare(Res, V1, V),
+    add_vertices_to_s_graph(Res, V1, VL, V, Edges, G, NGL).
+
+add_vertices_to_s_graph(=, _, VL, V, Edges, G, [V-Edges|NGL]) :-
+    add_vertices_to_s_graph(VL, G, NGL).
+add_vertices_to_s_graph(<, V1, VL, V, Edges, G, [V1-[]|NGL]) :-
+    add_vertices_to_s_graph(VL, [V-Edges|G], NGL).
+add_vertices_to_s_graph(>, V1, VL, V, Edges, G, [V-Edges|NGL]) :-
+    add_vertices_to_s_graph([V1|VL], G, NGL).
+
+add_empty_vertices([], []).
+add_empty_vertices([V|G], [V-[]|NG]) :-
+    add_empty_vertices(G, NG).
+
+%!  del_vertices(+Graph, +Vertices, -NewGraph) is det.
+%
+%   Unify NewGraph with a new graph obtained by deleting the list of
+%   Vertices and all the edges that start from  or go to a vertex in
+%   Vertices to the Graph. Example:
+%
+%   ==
+%   ?- del_vertices([1-[3,5],2-[4],3-[],4-[5],5-[],6-[],7-[2,6],8-[]],
+%                   [2,1],
+%                   NL).
+%   NL = [3-[],4-[5],5-[],6-[],7-[6],8-[]]
+%   ==
+%
+%   @compat Upto 5.6.48 the argument order was (+Vertices, +Graph,
+%   -NewGraph). Both YAP and SWI-Prolog have changed the argument
+%   order for compatibility with recent SICStus as well as
+%   consistency with del_edges/3.
+
+del_vertices(Graph, Vertices, NewGraph) :-
+    sort(Vertices, V1),             % JW: was msort
+    (   V1 = []
+    ->  Graph = NewGraph
+    ;   del_vertices(Graph, V1, V1, NewGraph)
+    ).
+
+del_vertices(G, [], V1, NG) :-
+    !,
+    del_remaining_edges_for_vertices(G, V1, NG).
+del_vertices([], _, _, []).
+del_vertices([V-Edges|G], [V0|Vs], V1, NG) :-
+    compare(Res, V, V0),
+    split_on_del_vertices(Res, V,Edges, [V0|Vs], NVs, V1, NG, NGr),
+    del_vertices(G, NVs, V1, NGr).
+
+del_remaining_edges_for_vertices([], _, []).
+del_remaining_edges_for_vertices([V0-Edges|G], V1, [V0-NEdges|NG]) :-
+    ord_subtract(Edges, V1, NEdges),
+    del_remaining_edges_for_vertices(G, V1, NG).
+
+split_on_del_vertices(<, V, Edges, Vs, Vs, V1, [V-NEdges|NG], NG) :-
+    ord_subtract(Edges, V1, NEdges).
+split_on_del_vertices(>, V, Edges, [_|Vs], Vs, V1, [V-NEdges|NG], NG) :-
+    ord_subtract(Edges, V1, NEdges).
+split_on_del_vertices(=, _, _, [_|Vs], Vs, _, NG, NG).
+
+%!  add_edges(+Graph, +Edges, -NewGraph)
+%
+%   Unify NewGraph with a new graph obtained by adding the list of Edges
+%   to Graph. Example:
+%
+%   ```
+%   ?- add_edges([1-[3,5],2-[4],3-[],4-[5],
+%                 5-[],6-[],7-[],8-[]],
+%                [1-6,2-3,3-2,5-7,3-2,4-5],
+%                NL).
+%   NL = [1-[3,5,6], 2-[3,4], 3-[2], 4-[5],
+%         5-[7], 6-[], 7-[], 8-[]]
+%   ```
+
+add_edges(Graph, Edges, NewGraph) :-
+    p_to_s_graph(Edges, G1),
+    ugraph_union(Graph, G1, NewGraph).
+
+%!  ugraph_union(+Graph1, +Graph2, -NewGraph)
+%
+%   NewGraph is the union of Graph1 and Graph2. Example:
+%
+%   ```
+%   ?- ugraph_union([1-[2],2-[3]],[2-[4],3-[1,2,4]],L).
+%   L = [1-[2], 2-[3,4], 3-[1,2,4]]
+%   ```
+
+ugraph_union(Set1, [], Set1) :- !.
+ugraph_union([], Set2, Set2) :- !.
+ugraph_union([Head1-E1|Tail1], [Head2-E2|Tail2], Union) :-
+    compare(Order, Head1, Head2),
+    ugraph_union(Order, Head1-E1, Tail1, Head2-E2, Tail2, Union).
+
+ugraph_union(=, Head-E1, Tail1, _-E2, Tail2, [Head-Es|Union]) :-
+    ord_union(E1, E2, Es),
+    ugraph_union(Tail1, Tail2, Union).
+ugraph_union(<, Head1, Tail1, Head2, Tail2, [Head1|Union]) :-
+    ugraph_union(Tail1, [Head2|Tail2], Union).
+ugraph_union(>, Head1, Tail1, Head2, Tail2, [Head2|Union]) :-
+    ugraph_union([Head1|Tail1], Tail2, Union).
+
+%!  del_edges(+Graph, +Edges, -NewGraph)
+%
+%   Unify NewGraph with a new graph  obtained   by  removing the list of
+%   Edges from Graph. Notice that no vertices are deleted. Example:
+%
+%   ```
+%   ?- del_edges([1-[3,5],2-[4],3-[],4-[5],5-[],6-[],7-[],8-[]],
+%                [1-6,2-3,3-2,5-7,3-2,4-5,1-3],
+%                NL).
+%   NL = [1-[5],2-[4],3-[],4-[],5-[],6-[],7-[],8-[]]
+%   ```
+
+del_edges(Graph, Edges, NewGraph) :-
+    p_to_s_graph(Edges, G1),
+    graph_subtract(Graph, G1, NewGraph).
+
+%!  graph_subtract(+Set1, +Set2, ?Difference)
+%
+%   Is based on ord_subtract
+
+graph_subtract(Set1, [], Set1) :- !.
+graph_subtract([], _, []).
+graph_subtract([Head1-E1|Tail1], [Head2-E2|Tail2], Difference) :-
+    compare(Order, Head1, Head2),
+    graph_subtract(Order, Head1-E1, Tail1, Head2-E2, Tail2, Difference).
+
+graph_subtract(=, H-E1,     Tail1, _-E2,     Tail2, [H-E|Difference]) :-
+    ord_subtract(E1,E2,E),
+    graph_subtract(Tail1, Tail2, Difference).
+graph_subtract(<, Head1, Tail1, Head2, Tail2, [Head1|Difference]) :-
+    graph_subtract(Tail1, [Head2|Tail2], Difference).
+graph_subtract(>, Head1, Tail1, _,     Tail2, Difference) :-
+    graph_subtract([Head1|Tail1], Tail2, Difference).
+
+%!  edges(+Graph, -Edges)
+%
+%   Unify Edges with all edges appearing in Graph. Example:
+%
+%       ?- edges([1-[3,5],2-[4],3-[],4-[5],5-[]], L).
+%       L = [1-3, 1-5, 2-4, 4-5]
+
+edges(Graph, Edges) :-
+    s_to_p_graph(Graph, Edges).
+
+p_to_s_graph(P_Graph, S_Graph) :-
+    sort(P_Graph, EdgeSet),
+    p_to_s_vertices(EdgeSet, VertexBag),
+    sort(VertexBag, VertexSet),
+    p_to_s_group(VertexSet, EdgeSet, S_Graph).
+
+
+p_to_s_vertices([], []).
+p_to_s_vertices([A-Z|Edges], [A,Z|Vertices]) :-
+    p_to_s_vertices(Edges, Vertices).
+
+
+p_to_s_group([], _, []).
+p_to_s_group([Vertex|Vertices], EdgeSet, [Vertex-Neibs|G]) :-
+    p_to_s_group(EdgeSet, Vertex, Neibs, RestEdges),
+    p_to_s_group(Vertices, RestEdges, G).
+
+
+p_to_s_group([V1-X|Edges], V2, [X|Neibs], RestEdges) :- V1 == V2,
+    !,
+    p_to_s_group(Edges, V2, Neibs, RestEdges).
+p_to_s_group(Edges, _, [], Edges).
+
+
+
+s_to_p_graph([], []) :- !.
+s_to_p_graph([Vertex-Neibs|G], P_Graph) :-
+    s_to_p_graph(Neibs, Vertex, P_Graph, Rest_P_Graph),
+    s_to_p_graph(G, Rest_P_Graph).
+
+
+s_to_p_graph([], _, P_Graph, P_Graph) :- !.
+s_to_p_graph([Neib|Neibs], Vertex, [Vertex-Neib|P], Rest_P) :-
+    s_to_p_graph(Neibs, Vertex, P, Rest_P).
+
+%!  transitive_closure(+Graph, -Closure)
+%
+%   Generate the graph Closure  as  the   transitive  closure  of Graph.
+%   Example:
+%
+%   ```
+%   ?- transitive_closure([1-[2,3],2-[4,5],4-[6]],L).
+%   L = [1-[2,3,4,5,6], 2-[4,5,6], 4-[6]]
+%   ```
+
+transitive_closure(Graph, Closure) :-
+    warshall(Graph, Graph, Closure).
+
+warshall([], Closure, Closure) :- !.
+warshall([V-_|G], E, Closure) :-
+    memberchk(V-Y, E),      %  Y := E(v)
+    warshall(E, V, Y, NewE),
+    warshall(G, NewE, Closure).
+
+
+warshall([X-Neibs|G], V, Y, [X-NewNeibs|NewG]) :-
+    memberchk(V, Neibs),
+    !,
+    ord_union(Neibs, Y, NewNeibs),
+    warshall(G, V, Y, NewG).
+warshall([X-Neibs|G], V, Y, [X-Neibs|NewG]) :-
+    !,
+    warshall(G, V, Y, NewG).
+warshall([], _, _, []).
+
+%!  transpose_ugraph(Graph, NewGraph) is det.
+%
+%   Unify NewGraph with a new graph obtained from Graph by replacing
+%   all edges of the form V1-V2 by edges of the form V2-V1. The cost
+%   is O(|V|*log(|V|)). Notice that an undirected   graph is its own
+%   transpose. Example:
+%
+%     ==
+%     ?- transpose([1-[3,5],2-[4],3-[],4-[5],
+%                   5-[],6-[],7-[],8-[]], NL).
+%     NL = [1-[],2-[],3-[1],4-[2],5-[1,4],6-[],7-[],8-[]]
+%     ==
+%
+%   @compat  This  predicate  used  to   be  known  as  transpose/2.
+%   Following  SICStus  4,  we  reserve    transpose/2   for  matrix
+%   transposition    and    renamed    ugraph    transposition    to
+%   transpose_ugraph/2.
+
+transpose_ugraph(Graph, NewGraph) :-
+    edges(Graph, Edges),
+    vertices(Graph, Vertices),
+    flip_edges(Edges, TransposedEdges),
+    vertices_edges_to_ugraph(Vertices, TransposedEdges, NewGraph).
+
+flip_edges([], []).
+flip_edges([Key-Val|Pairs], [Val-Key|Flipped]) :-
+    flip_edges(Pairs, Flipped).
+
+%!  compose(+LeftGraph, +RightGraph, -NewGraph)
+%
+%   Compose NewGraph by connecting the  _drains_   of  LeftGraph  to the
+%   _sources_ of RightGraph. Example:
+%
+%       ?- compose([1-[2],2-[3]],[2-[4],3-[1,2,4]],L).
+%       L = [1-[4], 2-[1,2,4], 3-[]]
+
+compose(G1, G2, Composition) :-
+    vertices(G1, V1),
+    vertices(G2, V2),
+    ord_union(V1, V2, V),
+    compose(V, G1, G2, Composition).
+
+compose([], _, _, []) :- !.
+compose([Vertex|Vertices], [Vertex-Neibs|G1], G2,
+        [Vertex-Comp|Composition]) :-
+    !,
+    compose1(Neibs, G2, [], Comp),
+    compose(Vertices, G1, G2, Composition).
+compose([Vertex|Vertices], G1, G2, [Vertex-[]|Composition]) :-
+    compose(Vertices, G1, G2, Composition).
+
+
+compose1([V1|Vs1], [V2-N2|G2], SoFar, Comp) :-
+    compare(Rel, V1, V2),
+    !,
+    compose1(Rel, V1, Vs1, V2, N2, G2, SoFar, Comp).
+compose1(_, _, Comp, Comp).
+
+
+compose1(<, _, Vs1, V2, N2, G2, SoFar, Comp) :-
+    !,
+    compose1(Vs1, [V2-N2|G2], SoFar, Comp).
+compose1(>, V1, Vs1, _, _, G2, SoFar, Comp) :-
+    !,
+    compose1([V1|Vs1], G2, SoFar, Comp).
+compose1(=, V1, Vs1, V1, N2, G2, SoFar, Comp) :-
+    ord_union(N2, SoFar, Next),
+    compose1(Vs1, G2, Next, Comp).
+
+%!  top_sort(+Graph, -Sorted) is semidet.
+%!  top_sort(+Graph, -Sorted, ?Tail) is semidet.
+%
+%   Sorted is a  topological  sorted  list   of  nodes  in  Graph. A
+%   toplogical sort is possible  if  the   graph  is  connected  and
+%   acyclic. In the example we show   how  topological sorting works
+%   for a linear graph:
+%
+%   ==
+%   ?- top_sort([1-[2], 2-[3], 3-[]], L).
+%   L = [1, 2, 3]
+%   ==
+%
+%   The  predicate  top_sort/3  is  a  difference  list  version  of
+%   top_sort/2.
+
+top_sort(Graph, Sorted) :-
+    vertices_and_zeros(Graph, Vertices, Counts0),
+    count_edges(Graph, Vertices, Counts0, Counts1),
+    select_zeros(Counts1, Vertices, Zeros),
+    top_sort(Zeros, Sorted, Graph, Vertices, Counts1).
+
+top_sort(Graph, Sorted0, Sorted) :-
+    vertices_and_zeros(Graph, Vertices, Counts0),
+    count_edges(Graph, Vertices, Counts0, Counts1),
+    select_zeros(Counts1, Vertices, Zeros),
+    top_sort(Zeros, Sorted, Sorted0, Graph, Vertices, Counts1).
+
+
+vertices_and_zeros([], [], []) :- !.
+vertices_and_zeros([Vertex-_|Graph], [Vertex|Vertices], [0|Zeros]) :-
+    vertices_and_zeros(Graph, Vertices, Zeros).
+
+
+count_edges([], _, Counts, Counts) :- !.
+count_edges([_-Neibs|Graph], Vertices, Counts0, Counts2) :-
+    incr_list(Neibs, Vertices, Counts0, Counts1),
+    count_edges(Graph, Vertices, Counts1, Counts2).
+
+
+incr_list([], _, Counts, Counts) :- !.
+incr_list([V1|Neibs], [V2|Vertices], [M|Counts0], [N|Counts1]) :-
+    V1 == V2,
+    !,
+    N is M+1,
+    incr_list(Neibs, Vertices, Counts0, Counts1).
+incr_list(Neibs, [_|Vertices], [N|Counts0], [N|Counts1]) :-
+    incr_list(Neibs, Vertices, Counts0, Counts1).
+
+
+select_zeros([], [], []) :- !.
+select_zeros([0|Counts], [Vertex|Vertices], [Vertex|Zeros]) :-
+    !,
+    select_zeros(Counts, Vertices, Zeros).
+select_zeros([_|Counts], [_|Vertices], Zeros) :-
+    select_zeros(Counts, Vertices, Zeros).
+
+
+
+top_sort([], [], Graph, _, Counts) :-
+    !,
+    vertices_and_zeros(Graph, _, Counts).
+top_sort([Zero|Zeros], [Zero|Sorted], Graph, Vertices, Counts1) :-
+    graph_memberchk(Zero-Neibs, Graph),
+    decr_list(Neibs, Vertices, Counts1, Counts2, Zeros, NewZeros),
+    top_sort(NewZeros, Sorted, Graph, Vertices, Counts2).
+
+top_sort([], Sorted0, Sorted0, Graph, _, Counts) :-
+    !,
+    vertices_and_zeros(Graph, _, Counts).
+top_sort([Zero|Zeros], [Zero|Sorted], Sorted0, Graph, Vertices, Counts1) :-
+    graph_memberchk(Zero-Neibs, Graph),
+    decr_list(Neibs, Vertices, Counts1, Counts2, Zeros, NewZeros),
+    top_sort(NewZeros, Sorted, Sorted0, Graph, Vertices, Counts2).
+
+graph_memberchk(Element1-Edges, [Element2-Edges2|_]) :-
+    Element1 == Element2,
+    !,
+    Edges = Edges2.
+graph_memberchk(Element, [_|Rest]) :-
+    graph_memberchk(Element, Rest).
+
+
+decr_list([], _, Counts, Counts, Zeros, Zeros) :- !.
+decr_list([V1|Neibs], [V2|Vertices], [1|Counts1], [0|Counts2], Zi, Zo) :-
+    V1 == V2,
+    !,
+    decr_list(Neibs, Vertices, Counts1, Counts2, [V2|Zi], Zo).
+decr_list([V1|Neibs], [V2|Vertices], [N|Counts1], [M|Counts2], Zi, Zo) :-
+    V1 == V2,
+    !,
+    M is N-1,
+    decr_list(Neibs, Vertices, Counts1, Counts2, Zi, Zo).
+decr_list(Neibs, [_|Vertices], [N|Counts1], [N|Counts2], Zi, Zo) :-
+    decr_list(Neibs, Vertices, Counts1, Counts2, Zi, Zo).
+
+
+%!  neighbors(+Vertex, +Graph, -Neigbours) is det.
+%!  neighbours(+Vertex, +Graph, -Neigbours) is det.
+%
+%   Neigbours is a sorted list of  the   neighbours  of Vertex in Graph.
+%   Example:
+%
+%   ```
+%   ?- neighbours(4,[1-[3,5],2-[4],3-[],
+%                    4-[1,2,7,5],5-[],6-[],7-[],8-[]], NL).
+%   NL = [1,2,7,5]
+%   ```
+
+neighbors(Vertex, Graph, Neig) :-
+    neighbours(Vertex, Graph, Neig).
+
+neighbours(V,[V0-Neig|_],Neig) :-
+    V == V0,
+    !.
+neighbours(V,[_|G],Neig) :-
+    neighbours(V,G,Neig).
+
+
+%!  connect_ugraph(+UGraphIn, -Start, -UGraphOut) is det.
+%
+%   Adds Start as an additional vertex that is connected to all vertices
+%   in UGraphIn. This can be used to   create  an topological sort for a
+%   not connected graph. Start is before any   vertex in UGraphIn in the
+%   standard order of terms.  No vertex in UGraphIn can be a variable.
+%
+%   Can be used to order a not-connected graph as follows:
+%
+%   ```
+%   top_sort_unconnected(Graph, Vertices) :-
+%       (   top_sort(Graph, Vertices)
+%       ->  true
+%       ;   connect_ugraph(Graph, Start, Connected),
+%           top_sort(Connected, Ordered0),
+%           Ordered0 = [Start|Vertices]
+%       ).
+%   ```
+
+connect_ugraph([], 0, []) :- !.
+connect_ugraph(Graph, Start, [Start-Vertices|Graph]) :-
+    vertices(Graph, Vertices),
+    Vertices = [First|_],
+    before(First, Start).
+
+%!  before(+Term, -Before) is det.
+%
+%   Unify Before to a term that comes   before  Term in the standard
+%   order of terms.
+%
+%   @error instantiation_error if Term is unbound.
+
+before(X, _) :-
+    var(X),
+    !,
+    instantiation_error(X).
+before(Number, Start) :-
+    number(Number),
+    !,
+    Start is Number - 1.
+before(_, 0).
+
+
+%!  complement(+UGraphIn, -UGraphOut)
+%
+%   UGraphOut is a ugraph with an  edge   between  all vertices that are
+%   _not_ connected in UGraphIn and  all   edges  from UGraphIn removed.
+%   Example:
+%
+%   ```
+%   ?- complement([1-[3,5],2-[4],3-[],
+%                  4-[1,2,7,5],5-[],6-[],7-[],8-[]], NL).
+%   NL = [1-[2,4,6,7,8],2-[1,3,5,6,7,8],3-[1,2,4,5,6,7,8],
+%         4-[3,5,6,8],5-[1,2,3,4,6,7,8],6-[1,2,3,4,5,7,8],
+%         7-[1,2,3,4,5,6,8],8-[1,2,3,4,5,6,7]]
+%   ```
+%
+%   @tbd Simple two-step algorithm. You could be smarter, I suppose.
+
+complement(G, NG) :-
+    vertices(G,Vs),
+    complement(G,Vs,NG).
+
+complement([], _, []).
+complement([V-Ns|G], Vs, [V-INs|NG]) :-
+    ord_add_element(Ns,V,Ns1),
+    ord_subtract(Vs,Ns1,INs),
+    complement(G, Vs, NG).
+
+%!  reachable(+Vertex, +UGraph, -Vertices)
+%
+%   True when Vertices is  an  ordered   set  of  vertices  reachable in
+%   UGraph, including Vertex.  Example:
+%
+%       ?- reachable(1,[1-[3,5],2-[4],3-[],4-[5],5-[]],V).
+%       V = [1, 3, 5]
+
+reachable(N, G, Rs) :-
+    reachable([N], G, [N], Rs).
+
+reachable([], _, Rs, Rs).
+reachable([N|Ns], G, Rs0, RsF) :-
+    neighbours(N, G, Nei),
+    ord_union(Rs0, Nei, Rs1, D),
+    append(Ns, D, Nsi),
+    reachable(Nsi, G, Rs1, RsF).

src/lib/uuid.pl

@@ -0,0 +1,107 @@
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   Written in February 2021 by Adrián Arroyo (adrian.arroyocalle@gmail.com)
+   Part of Scryer-Prolog
+   This library provides reasoning about UUID (only version 4 right now).
+   There are three predicates:
+    * uuidv4/1, to generate a new UUIDv4
+    * uuidv4_string/1, to generate a new UUIDv4 in string hex representation
+    * uuid_string/2, to converte between UUID list of bytes and UUID hex representation
+
+   Examples:
+   ?- uuidv4(X).
+      X = [42,147,248,242,117,196,79,2,129,159|...].
+   ?- uuidv4_string(X).
+      X = "428499fc-76e3-4240- ...".
+   ?- uuidv4(X), uuid_string(X, S).
+      X = [173,12,244,152,139,118,64,139,137,4|...], S = "ad0cf498-8b76-408b- ...".
+   ?- uuid_string(X, "61ae692e-eaf6-4199-8dd3-9f01db70a20b").
+      X = [97,174,105,46,234,246,65,153,141,211|...].
+
+   I place this code in the public domain. Use it in any way you want.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+:- module(uuid, [
+    uuidv4/1,
+    uuidv4_string/1,
+    uuid_string/2
+]).
+
+:- use_module(library(crypto)).
+:- use_module(library(dcgs)).
+:- use_module(library(lists)).
+
+/*
+An UUID is made of 16 bytes, composed of 5 sections:
+time_low - 4
+time_mid - 2
+time_hi_and_version - 2
+clock_seq_hi_and_res_clock_seq_low - 2
+node - 6
+UUID v4 can be generated from a set of 16 random bytes: https://www.rfc-archive.org/getrfc.php?rfc=4122#gsc.tab=0 (section 4.4)
+*/
+uuidv4(Uuid) :-
+    crypto_n_random_bytes(16, Bytes),
+    Bytes = [B1, B2, B3, B4, B5, B6, B7, B8, B9, B10, B11, B12, B13, B14, B15, B16],
+    byte_bits(B9, BitsClockSeqHi0),
+    BitsClockSeqHi0 = [_X7, _X6, X5, X4, X3, X2, X1, X0],
+    NewBitsClockSeqHi0 = [1, 0, X5, X4, X3, X2, X1, X0],
+    byte_bits(NewClockSeqHi0, NewBitsClockSeqHi0),
+    byte_bits(B7, BitsTimeHi),
+    BitsTimeHi = [_Y7, _Y6, _Y5, _Y4, Y3, Y2, Y1, Y0],
+    NewBitsTimeHi = [0, 1, 0, 0, Y3, Y2, Y1, Y0],
+    byte_bits(NewTimeHi, NewBitsTimeHi),
+    Uuid = [B1, B2, B3, B4, B5, B6, NewTimeHi, B8, NewClockSeqHi0, B10, B11, B12, B13, B14, B15, B16].
+
+uuidv4_string(String) :- uuidv4(Uuid), uuid_string(Uuid, String).
+
+uuid_string(Uuid, String) :-
+    Uuid = [B1, B2, B3, B4, B5, B6, B7, B8, B9, B10, B11, B12, B13, B14, B15, B16],
+    phrase(uuid_([S1, S2, S3, S4, S5]), String),
+    hex_bytes(S1, [B1, B2, B3, B4]),
+    hex_bytes(S2, [B5, B6]),
+    hex_bytes(S3, [B7, B8]),
+    hex_bytes(S4, [B9, B10]),
+    hex_bytes(S5, [B11, B12, B13, B14, B15, B16]).
+
+uuid_([S1, S2, S3, S4, S5]) -->
+    {
+        length(S1, 8),
+        length(S2, 4),
+        length(S3, 4),
+        length(S4, 4),
+        length(S5, 12)
+    },
+    S1,
+    "-",
+    S2,
+    "-",
+    S3,
+    "-",
+    S4,
+    "-",
+    S5.
+
+byte_bits(Byte, Bits) :-
+    \+ var(Byte),
+    byte_bits_(Byte, Bits),
+    length(Bits, 8),!.
+
+byte_bits(Byte, Bits) :-
+    \+ var(Bits),
+    length(Bits, 8),
+    byte_bits__(Byte, Bits),!.
+
+byte_bits_(0, [0]).
+byte_bits_(1, [1]).
+byte_bits_(Byte, Bits) :-
+    R is Byte // 2,
+    M is Byte mod 2,
+    byte_bits_(R, Bits0),
+    append(Bits0, [M], Bits).
+
+byte_bits__(0, []).
+byte_bits__(Byte, Bits) :-
+    length(Bits, N),
+    Bits = [Bit|Bits0],
+    byte_bits__(Byte0, Bits0),
+    Byte is Byte0 + Bit*(2 ^ (N-1)).

src/lib/xpath.pl

@@ -26,22 +26,22 @@
 
       :- use_module(library(http/http_open)).
       :- use_module(library(sgml)).
-      :- use_module(library(lists)).
       :- use_module(library(xpath)).
+      :- use_module(library(dcgs)).
 
       link_to_pl_file(File) :-
           http_open("https://github.com/mthom/scryer-prolog", S, []),
           load_html(stream(S), DOM, []),
           xpath(DOM, //a(@href), File),
-          append(_, ".pl", File).
+          phrase((...,".pl"), File).
 
    Yielding:
 
       ?- link_to_pl_file(File).
-      %@    File = "/mthom/scryer-prolog/blob/master/src/lib/tabling.pl"
-      %@ ;  File = "/mthom/scryer-prolog/blob/master/src/lib/dif.pl"
-      %@ ;  File = "/mthom/scryer-prolog/blob/master/src/lib/freeze.pl"
-      %@ ;  ...
+      %@    File = "/mthom/scryer-prolog/blob/master/src/lib/dcgs.pl"
+      %@ ;  File = "/mthom/scryer-prolog/blob/master/src/lib/pio.pl"
+      %@ ;  File = "/mthom/scryer-prolog/blob/master/src/lib/tabling.pl"
+      %@ ;  ... .
 
    Parts of the original functionality may not yet work. Please
    consider such parts opportunities for improvements, and file
@@ -540,7 +540,7 @@ xpath_condition(contains(Haystack, Needle), Value) :-          % contains(Haysta
     !,
     val_or_function(Haystack, Value, HaystackValue),
     val_or_function(Needle, Value, NeedleValue),
-    (   phrase((list(_),list(NeedleValue),list(_)), HaystackValue)
+    (   phrase((...,seq(NeedleValue),...), HaystackValue)
     ->  true
     ).
 xpath_condition(Spec, Dom) :-
@@ -626,10 +626,7 @@ text_of_list([H|T]) -->
 
 text_of_1(element(_,_,Content)) -->
         text_of_list(Content).
-text_of_1([C|Cs]) --> list([C|Cs]).
-
-list([]) --> [].
-list([L|Ls]) --> [L], list(Ls).
+text_of_1([C|Cs]) --> seq([C|Cs]).
 
 % For now, we use number_chars/2 to parse XML numbers.
 % If the need arises, we can extend this to additional

src/machine/args.rs

@@ -0,0 +1,16 @@
+use std::collections::BTreeSet;
+use std::env;
+
+#[derive(Debug)]
+pub struct MachineArgs {
+    pub add_history: bool,
+}
+
+impl MachineArgs {
+    pub fn new() -> Self {
+        let args: BTreeSet<String> = env::args().collect();
+        Self {
+            add_history: !args.contains("--no-add-history"),
+        }
+    }
+}

src/machine/attributed_variables.pl

@@ -1,9 +1,11 @@
 :- module('$atts', []).
 
+
 driver(Vars, Values) :-
     iterate(Vars, Values, ListOfListsOfGoalLists),
     !,
     call_goals(ListOfListsOfGoalLists),
+    '$reset_attr_var_state',
     '$return_from_verify_attr'.
 
 iterate([Var|VarBindings], [Value|ValueBindings], [ListOfGoalLists | ListsCubed]) :-
@@ -13,9 +15,9 @@ iterate([Var|VarBindings], [Value|ValueBindings], [ListOfGoalLists | ListsCubed]
     iterate(VarBindings, ValueBindings, ListsCubed).
 iterate([], [], []).
 
+
 gather_modules(Attrs, []) :- var(Attrs), !.
-gather_modules([Attr|Attrs], [Module|Modules]) :-
-    '$module_of'(Module, Attr),  % write the owning module of Attr to Module.
+gather_modules([Module:_|Attrs], [Module|Modules]) :-
     gather_modules(Attrs, Modules).
 
 call_verify_attributes(Attrs, _, _, []) :-
@@ -26,27 +28,32 @@ call_verify_attributes([Attr|Attrs], Var, Value, ListOfGoalLists) :-
     sort(Modules0, Modules),
     verify_attrs(Modules, Var, Value, ListOfGoalLists).
 
-verify_attrs([Module|Modules], Var, Value, [Goals|ListOfGoalLists]) :-
+error_handler(M, evaluation_error((M:verify_attributes)/3), []).
+% error_handler(_, existence_error(procedure, verify_attributes/3), []).
+
+verify_attrs([Module|Modules], Var, Value, [Module-Goals|ListOfGoalLists]) :-
     catch(Module:verify_attributes(Var, Value, Goals),
-          error(evaluation_error((Module:verify_attributes)/3), verify_attributes/3),
-          Goals = []),
+          error(E, verify_attributes/3),
+          error_handler(Module, E, Goals)),
     verify_attrs(Modules, Var, Value, ListOfGoalLists).
 verify_attrs([], _, _, []).
 
+
 call_goals([ListOfGoalLists | ListsCubed]) :-
     call_goals_0(ListOfGoalLists),
     call_goals(ListsCubed).
 call_goals([]).
 
-call_goals_0([GoalList | GoalLists]) :-
-    (  var(GoalList), throw(error(instantiation_error, call_goals_0/1))
+call_goals_0([Module-GoalList | GoalLists]) :-
+    (  var(GoalList),
+       throw(error(instantiation_error, call_goals_0/1))
     ;  true
     ),
-    call_goals_1(GoalList),
+    call_goals_1(GoalList, Module),
     call_goals_0(GoalLists).
 call_goals_0([]).
 
-call_goals_1([Goal | Goals]) :-
-    call(Goal),
-    call_goals_1(Goals).
-call_goals_1([]).
+call_goals_1([Goal | Goals], Module) :-
+    call(Module:Goal),
+    call_goals_1(Goals, Module).
+call_goals_1([], _).

src/machine/attributed_variables.rs

@@ -1,97 +1,78 @@
 use crate::heap_iter::*;
 use crate::machine::*;
+use crate::parser::ast::*;
+use crate::temp_v;
+use crate::types::*;
 
-use crate::indexmap::IndexSet;
+use indexmap::IndexSet;
 
 use std::cmp::Ordering;
 use std::vec::IntoIter;
 
-pub static VERIFY_ATTRS: &str = include_str!("attributed_variables.pl");
-pub static PROJECT_ATTRS: &str = include_str!("project_attributes.pl");
-
-pub(super) type Bindings = Vec<(usize, Addr)>;
+pub(super) type Bindings = Vec<(usize, HeapCellValue)>;
 
 #[derive(Debug)]
 pub(super) struct AttrVarInitializer {
-    pub(super) attribute_goals: Vec<Addr>,
     pub(super) attr_var_queue: Vec<usize>,
     pub(super) bindings: Bindings,
-    pub(super) cp: LocalCodePtr,
-    pub(super) instigating_p: LocalCodePtr,
+    pub(super) p: usize,
+    pub(super) cp: usize,
+    // pub(super) instigating_p: usize,
     pub(super) verify_attrs_loc: usize,
-    pub(super) project_attrs_loc: usize,
 }
 
 impl AttrVarInitializer {
-    pub(super)
-    fn new(verify_attrs_loc: usize, project_attrs_loc: usize) -> Self {
+    pub(super) fn new(verify_attrs_loc: usize) -> Self {
         AttrVarInitializer {
-            attribute_goals: vec![],
             attr_var_queue: vec![],
             bindings: vec![],
-            instigating_p: LocalCodePtr::default(),
-            cp: LocalCodePtr::default(),
+            p: 0,
+            cp: 0,
             verify_attrs_loc,
-            project_attrs_loc,
         }
     }
 
     #[inline]
-    pub(super)
-    fn reset(&mut self) {
-	    self.attribute_goals.clear();
+    pub(super) fn reset(&mut self) {
         self.attr_var_queue.clear();
         self.bindings.clear();
     }
-
-    #[inline]
-    pub(super)
-    fn backtrack(&mut self, queue_b: usize, bindings_b: usize) {
-        self.attr_var_queue.truncate(queue_b);
-        self.bindings.truncate(bindings_b);
-    }
 }
 
 impl MachineState {
-    pub(super)
-    fn push_attr_var_binding(&mut self, h: usize, addr: Addr) {
+    pub(super) fn push_attr_var_binding(&mut self, h: usize, addr: HeapCellValue) {
         if self.attr_var_init.bindings.is_empty() {
-            self.attr_var_init.instigating_p = self.p.local();
+            // save self.p and self.cp and ensure that the next
+            // instruction is InstallVerifyAttrInterrupt.
 
-            if self.last_call {
-                self.attr_var_init.cp = self.cp;
-            } else {
-                self.attr_var_init.cp = self.p.local() + 1;
-            }
+            self.attr_var_init.p = self.p;
+            self.attr_var_init.cp = self.cp;
 
-            self.p = CodePtr::VerifyAttrInterrupt(self.attr_var_init.verify_attrs_loc);
+            self.p = INSTALL_VERIFY_ATTR_INTERRUPT - 1;
+            self.cp = INSTALL_VERIFY_ATTR_INTERRUPT;
         }
 
         self.attr_var_init.bindings.push((h, addr));
     }
 
-    fn populate_var_and_value_lists(&mut self) -> (Addr, Addr) {
+    fn populate_var_and_value_lists(&mut self) -> (HeapCellValue, HeapCellValue) {
         let iter = self
             .attr_var_init
             .bindings
             .iter()
-            .map(|(ref h, _)| HeapCellValue::Addr(Addr::AttrVar(*h)));
+            .map(|(ref h, _)| attr_var_as_cell!(*h));
 
-        let var_list_addr = Addr::HeapCell(self.heap.to_list(iter));
+        let var_list_addr = heap_loc_as_cell!(iter_to_heap_list(&mut self.heap, iter));
 
-        let iter = self
-            .attr_var_init
-            .bindings
-            .drain(0 ..)
-            .map(|(_, addr)| HeapCellValue::Addr(addr));
+        let iter = self.attr_var_init.bindings.drain(0..).map(|(_, ref v)| *v);
 
-        let value_list_addr = Addr::HeapCell(self.heap.to_list(iter));
+        let value_list_addr = heap_loc_as_cell!(iter_to_heap_list(&mut self.heap, iter));
         (var_list_addr, value_list_addr)
     }
 
     fn verify_attributes(&mut self) {
         for (h, _) in &self.attr_var_init.bindings {
-            self.heap[*h] = HeapCellValue::Addr(Addr::AttrVar(*h));
+            self.heap[*h] = attr_var_as_cell!(*h);
         }
 
         let (var_list_addr, value_list_addr) = self.populate_var_and_value_lists();
@@ -100,75 +81,104 @@ impl MachineState {
         self[temp_v!(2)] = value_list_addr;
     }
 
-    pub(super)
-    fn gather_attr_vars_created_since(&self, b: usize) -> IntoIter<Addr> {
-        let mut attr_vars: Vec<_> = self.attr_var_init.attr_var_queue[b..]
-            .iter()
-            .filter_map(|h| match self.store(self.deref(Addr::HeapCell(*h))) {
-                Addr::AttrVar(h) => Some(Addr::AttrVar(h)),
-                _ => None,
-            })
-            .collect();
+    pub(super) fn gather_attr_vars_created_since(&mut self, b: usize) -> IntoIter<HeapCellValue> {
+        let mut attr_vars: Vec<_> = if b >= self.attr_var_init.attr_var_queue.len() {
+            vec![]
+        } else {
+            self.attr_var_init.attr_var_queue[b..]
+                .iter()
+                .filter_map(|h| {
+                    read_heap_cell!(self.store(self.deref(heap_loc_as_cell!(*h))),
+                        (HeapCellValueTag::AttrVar, h) => {
+                            Some(attr_var_as_cell!(h))
+                        }
+                        _ => {
+                            None
+                        }
+                    )
+                })
+                .collect()
+        };
 
         attr_vars.sort_unstable_by(|a1, a2| {
-            self.compare_term_test(a1, a2).unwrap_or(Ordering::Less)
+            compare_term_test!(self, *a1, *a2).unwrap_or(Ordering::Less)
         });
 
-        self.term_dedup(&mut attr_vars);
+        attr_vars.dedup();
         attr_vars.into_iter()
     }
 
-    pub(super)
-    fn verify_attr_interrupt(&mut self, p: usize) {
-        self.allocate(self.num_of_args + 2);
+    pub(super) fn verify_attr_interrupt(&mut self, p: usize, arity: usize) {
+        self.allocate(arity + 3);
 
         let e = self.e;
-        self.stack.index_and_frame_mut(e).prelude.interrupt_cp = self.attr_var_init.cp;
+        let and_frame = self.stack.index_and_frame_mut(e);
 
-        for i in 1 .. self.num_of_args + 1 {
-            self.stack.index_and_frame_mut(e)[i] = self[RegType::Temp(i)].clone();
+        for i in 1..arity + 1 {
+            and_frame[i] = self.registers[i];
         }
 
-        self.stack.index_and_frame_mut(e)[self.num_of_args + 1] =
-            Addr::CutPoint(self.b0);
-        self.stack.index_and_frame_mut(e)[self.num_of_args + 2] =
-            Addr::Usize(self.num_of_args);
+        and_frame[arity + 1] =
+            fixnum_as_cell!(Fixnum::build_with(self.b0 as i64));
+        and_frame[arity + 2] =
+            fixnum_as_cell!(Fixnum::build_with(self.num_of_args as i64));
+        and_frame[arity + 3] =
+            fixnum_as_cell!(Fixnum::build_with(self.attr_var_init.cp as i64));
 
         self.verify_attributes();
 
-        self.num_of_args = 2;
+        self.num_of_args = 3;
         self.b0 = self.b;
-        self.p = CodePtr::Local(LocalCodePtr::DirEntry(p));
+        self.p = p;
     }
 
-    pub(super)
-    fn attr_vars_of_term(&self, addr: Addr) -> Vec<Addr> {
-        let mut seen_set  = IndexSet::new();
+    pub(super) fn attr_vars_of_term(&mut self, cell: HeapCellValue) -> Vec<HeapCellValue> {
+        let mut seen_set = IndexSet::new();
         let mut seen_vars = vec![];
 
-        let mut iter = self.acyclic_pre_order_iter(addr);
+        let mut iter = stackful_preorder_iter(&mut self.heap, cell);
 
-        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;
+        while let Some(value) = iter.next() {
+            read_heap_cell!(value,
+                (HeapCellValueTag::AttrVar, h) => {
+                    if seen_set.contains(&h) {
+                        continue;
+                    }
+
+                    let value = unmark_cell_bits!(value);
+
+                    seen_vars.push(value);
+                    seen_set.insert(h);
+
+                    let mut l = h + 1;
+                    // let mut list_elements = vec![];
+                    // let iter_stack_len = iter.stack_len();
+
+                    loop {
+                        read_heap_cell!(iter.heap[l],
+                            (HeapCellValueTag::Lis) => {
+                                iter.push_stack(l);
+                                // l = elem + 1;
+                                break;
+                            }
+                            (HeapCellValueTag::Var | HeapCellValueTag::AttrVar, h) => {
+                                if h == l {
+                                    break;
+                                } else {
+                                    l = h;
+                                }
+                            }
+                            _ => {
+                                break;
+                            }
+                        )
+                    }
+
+                    // iter.stack_slice_from(iter_stack_len ..).reverse();
                 }
-
-                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

src/machine/code_repo.rs

@@ -1,177 +0,0 @@
-use crate::clause_types::*;
-use crate::codegen::*;
-use crate::debray_allocator::*;
-use crate::forms::*;
-use crate::instructions::*;
-use crate::machine::compile::*;
-use crate::machine::machine_errors::*;
-use crate::machine::machine_indices::*;
-
-use crate::indexmap::IndexSet;
-
-use std::collections::VecDeque;
-use std::mem;
-
-#[derive(Debug)]
-pub struct CodeRepo {
-    pub(super) cached_query: Code,
-    pub(super) goal_expanders: Code,
-    pub(super) term_expanders: Code,
-    pub(super) code: Code,
-    pub(super) in_situ_code: Code,
-    pub(super) term_dir: TermDir,
-}
-
-impl CodeRepo {
-    #[inline]
-    pub(super) fn new() -> Self {
-        CodeRepo {
-            cached_query: vec![],
-            goal_expanders: Code::new(),
-            term_expanders: Code::new(),
-            code: Code::new(),
-            in_situ_code: Code::new(),
-            term_dir: TermDir::new(),
-        }
-    }
-
-    #[inline]
-    pub fn term_dir_entry_len(&self, key: PredicateKey) -> (usize, usize) {
-        self.term_dir
-            .get(&key)
-            .map(|entry| ((entry.0).0.len(), entry.1.len()))
-            .unwrap_or((0, 0))
-    }
-
-    #[inline]
-    pub fn truncate_terms(
-        &mut self,
-        key: PredicateKey,
-        len: usize,
-        queue_len: usize,
-    ) -> (Predicate, VecDeque<TopLevel>) {
-        self.term_dir
-            .get_mut(&key)
-            .map(|entry| {
-                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::new()))
-    }
-
-    pub(crate)
-    fn add_in_situ_result(
-        &mut self,
-        result: &CompiledResult,
-        in_situ_code_dir: &mut InSituCodeDir,
-        in_situ_module_dir: &mut ModuleStubDir,
-        non_counted_bt_preds: &IndexSet<PredicateKey>,
-    ) -> Result<(), SessionError> {
-        let (ref decl, ref queue) = result;
-        let (name, arity) = decl
-            .0
-            .first()
-            .and_then(|cl| {
-                let arity = cl.arity();
-                cl.name().map(|name| (name, arity))
-            })
-            .ok_or(SessionError::NamelessEntry)?;
-
-        let non_counted_bt = non_counted_bt_preds.contains(&(name.clone(), arity));
-        let module_name = name.owning_module();
-
-        let p = self.in_situ_code.len();
-
-        match in_situ_module_dir.get_mut(&module_name) {
-            Some(ref mut module_stub) if name.has_table(&module_stub.atom_tbl) => {
-                module_stub.in_situ_code_dir.insert((name, arity), p);
-            }
-            _ => {
-                in_situ_code_dir.insert((name, arity), p);
-            }
-        }
-
-        let mut cg = CodeGenerator::<DebrayAllocator>::new(non_counted_bt);
-        let mut decl_code = cg.compile_predicate(&decl.0)?;
-
-        compile_appendix(&mut decl_code, queue, non_counted_bt)?;
-
-        Ok(self.in_situ_code.extend(decl_code.into_iter()))
-    }
-
-    #[inline]
-    pub(super)
-    fn size_of_cached_query(&self) -> usize {
-        self.cached_query.len()
-    }
-
-    #[inline]
-    pub(super)
-    fn take_in_situ_code(&mut self) -> Code {
-        mem::replace(&mut self.in_situ_code, Code::new())
-    }
-
-    pub(super)
-    fn lookup_instr<'a>(
-        &'a self,
-        last_call: bool,
-        p: &CodePtr,
-    ) -> Option<RefOrOwned<'a, Line>> {
-        match p {
-            &CodePtr::Local(LocalCodePtr::UserGoalExpansion(p)) => {
-                if p < self.goal_expanders.len() {
-                    Some(RefOrOwned::Borrowed(&self.goal_expanders[p]))
-                } else {
-                    None
-                }
-            }
-            &CodePtr::Local(LocalCodePtr::UserTermExpansion(p)) => {
-                if p < self.term_expanders.len() {
-                    Some(RefOrOwned::Borrowed(&self.term_expanders[p]))
-                } else {
-                    None
-                }
-            }
-            &CodePtr::Local(LocalCodePtr::TopLevel(_, p)) => {
-                if p < self.cached_query.len() {
-                    Some(RefOrOwned::Borrowed(&self.cached_query[p]))
-                } else {
-                    None
-                }
-            }
-            &CodePtr::Local(LocalCodePtr::InSituDirEntry(p)) => {
-                Some(RefOrOwned::Borrowed(&self.in_situ_code[p]))
-            }
-            &CodePtr::Local(LocalCodePtr::DirEntry(p)) => Some(RefOrOwned::Borrowed(&self.code[p])),
-            &CodePtr::REPL(..) => None,
-            &CodePtr::BuiltInClause(ref built_in, _) => {
-                let call_clause = call_clause!(
-                    ClauseType::BuiltIn(built_in.clone()),
-                    built_in.arity(),
-                    0,
-                    last_call
-                );
-                Some(RefOrOwned::Owned(call_clause))
-            }
-            &CodePtr::CallN(arity, _, last_call) => {
-                let call_clause = call_clause!(ClauseType::CallN, arity, 0, last_call);
-                Some(RefOrOwned::Owned(call_clause))
-            }
-            &CodePtr::VerifyAttrInterrupt(p) => Some(RefOrOwned::Borrowed(&self.code[p])),
-            &CodePtr::DynamicTransaction(..) => None,
-        }
-    }
-}

src/machine/code_walker.rs

@@ -1,63 +1,75 @@
 use crate::instructions::*;
 
-use std::collections::VecDeque;
+use indexmap::IndexSet;
 
-fn scan_for_trust_me(code: &Code, jmp_offsets: &mut VecDeque<usize>, after_idx: &mut usize) {
-    for (idx, instr) in code[*after_idx..].iter().enumerate() {
-        match instr {
-            &Line::Choice(ChoiceInstruction::TrustMe)
-          | &Line::IndexedChoice(IndexedChoiceInstruction::Trust(..)) => {
-                *after_idx += idx;
-                return;
-            }
-            &Line::Control(ControlInstruction::JmpBy(_, offset, ..)) => {
-                jmp_offsets.push_back(*after_idx + idx + offset)
-            }
-            _ => {}
+fn capture_offset(line: &Instruction, index: usize, stack: &mut Vec<usize>) -> bool {
+    match line {
+        &Instruction::TryMeElse(offset) if offset > 0 => {
+            stack.push(index + offset);
         }
-    }
-}
+        &Instruction::DefaultRetryMeElse(offset) |
+        &Instruction::RetryMeElse(offset)
+            if offset > 0 =>
+        {
+            stack.push(index + offset);
+        }
+        &Instruction::DynamicElse(_, _, NextOrFail::Next(offset))
+            if offset > 0 =>
+        {
+            stack.push(index + offset);
+        }
+        &Instruction::DynamicInternalElse(_, _, NextOrFail::Next(offset))
+            if offset > 0 =>
+        {
+            stack.push(index + offset);
+        }
+        &Instruction::JmpByCall(_, offset, _) => {
+            stack.push(index + offset);
+        }
+        &Instruction::JmpByExecute(_, offset, _) => {
+            stack.push(index + offset);
+            return true;
+        }
+        &Instruction::Proceed => {
+            return true;
+        }
+        &Instruction::RevJmpBy(offset) => {
+            if offset > 0 {
+                stack.push(index - offset);
+            } else {
+                return true;
+            }
+        }
+        instr if instr.is_execute() => {
+            return true;
+        }
+        _ => {}
+    };
 
-fn capture_next_range(code: &Code, queue: &mut VecDeque<usize>, last_idx: &mut usize) {
-    loop {
-        match &code[*last_idx] {
-            &Line::Choice(ChoiceInstruction::TryMeElse(..))
-          | &Line::IndexedChoice(IndexedChoiceInstruction::Try(..)) => {
-                    *last_idx += 1;
-                    scan_for_trust_me(code, queue, last_idx);
-                }
-            &Line::Control(ControlInstruction::JmpBy(_, offset, _, false)) => {
-                queue.push_back(*last_idx + offset);
-                *last_idx += 1;
-            }
-            &Line::Control(ControlInstruction::JmpBy(_, offset, _, true)) => {
-                queue.push_back(*last_idx + offset);
-                break;
-            }
-            &Line::Control(ControlInstruction::Proceed)
-          | &Line::Control(ControlInstruction::CallClause(_, _, _, true, _)) =>
-                break,
-            _ =>
-                *last_idx += 1,
-        };
-    }
+    false
 }
 
 /* This function walks the code of a single predicate, supposed to
  * begin in code at the offset p. Each instruction is passed to the
  * walker function.
  */
-pub fn walk_code(code: &Code, p: usize, mut walker: impl FnMut(&Line))
-{
-    let mut queue = VecDeque::from(vec![p]);
+pub(crate) fn walk_code(code: &Code, p: usize, mut walker: impl FnMut(&Instruction)) {
+    let mut stack = vec![p];
+    let mut visited_indices = IndexSet::new();
 
-    while let Some(first_idx) = queue.pop_front() {
-        let mut last_idx = first_idx;
+    while let Some(first_index) = stack.pop() {
+        if visited_indices.contains(&first_index) {
+            continue;
+        } else {
+            visited_indices.insert(first_index);
+        }
 
-        capture_next_range(code, &mut queue, &mut last_idx);
-
-        for instr in &code[first_idx .. last_idx + 1] {
+        for (index, instr) in code[first_index..].iter().enumerate() {
             walker(instr);
+
+            if capture_offset(instr, first_index + index, &mut stack) {
+                break;
+            }
         }
     }
 }
@@ -65,7 +77,8 @@ pub fn walk_code(code: &Code, p: usize, mut walker: impl FnMut(&Line))
 /* A function for code walking that might result in modification to
  * the code. Otherwise identical to walk_code.
  */
-pub fn walk_code_mut(code: &mut Code, p: usize, mut walker: impl FnMut(&mut Line))
+/*
+pub(crate) fn walk_code_mut(code: &mut Code, p: usize, mut walker: impl FnMut(&mut Line))
 {
     let mut queue = VecDeque::from(vec![p]);
 
@@ -79,3 +92,4 @@ pub fn walk_code_mut(code: &mut Code, p: usize, mut walker: impl FnMut(&mut Line
         }
     }
 }
+*/

src/machine/copier.rs

@@ -1,5 +1,7 @@
-use crate::machine::machine_indices::*;
+use crate::atom_table::*;
+use crate::machine::get_structure_index;
 use crate::machine::stack::*;
+use crate::types::*;
 
 use std::mem;
 use std::ops::IndexMut;
@@ -9,20 +11,22 @@ type Trail = Vec<(Ref, HeapCellValue)>;
 #[derive(Debug, Clone, Copy)]
 pub enum AttrVarPolicy {
     DeepCopy,
-    StripAttributes
+    StripAttributes,
 }
 
-pub(crate)
-trait CopierTarget: IndexMut<usize, Output = HeapCellValue> {
-    fn deref(&self, val: Addr) -> Addr;
-    fn push(&mut self, val: HeapCellValue);
+pub trait CopierTarget: IndexMut<usize, Output = HeapCellValue> {
+    fn store(&self, value: HeapCellValue) -> HeapCellValue;
+    fn deref(&self, value: HeapCellValue) -> HeapCellValue;
+    fn push(&mut self, value: HeapCellValue);
     fn stack(&mut self) -> &mut Stack;
-    fn store(&self, val: Addr) -> Addr;
     fn threshold(&self) -> usize;
 }
 
-pub(crate)
-fn copy_term<T: CopierTarget>(target: T, addr: Addr, attr_var_policy: AttrVarPolicy) {
+pub(crate) fn copy_term<T: CopierTarget>(
+    target: T,
+    addr: HeapCellValue,
+    attr_var_policy: AttrVarPolicy,
+) {
     let mut copy_term_state = CopyTermState::new(target, attr_var_policy);
     copy_term_state.copy_term_impl(addr);
 }
@@ -43,57 +47,57 @@ impl<T: CopierTarget> CopyTermState<T> {
             scan: 0,
             old_h: target.threshold(),
             target,
-            attr_var_policy
+            attr_var_policy,
         }
     }
 
     #[inline]
     fn value_at_scan(&mut self) -> &mut HeapCellValue {
-        let scan = self.scan;
-        &mut self.target[scan]
+        &mut self.target[self.scan]
     }
 
     fn trail_list_cell(&mut self, addr: usize, threshold: usize) {
-        let trail_item = mem::replace(
-            &mut self.target[addr],
-            HeapCellValue::Addr(Addr::Lis(threshold)),
-        );
-
-        self.trail.push((
-            Ref::HeapCell(addr),
-            trail_item,
-        ));
+        let trail_item = mem::replace(&mut self.target[addr], list_loc_as_cell!(threshold));
+        self.trail.push((Ref::heap_cell(addr), trail_item));
     }
 
     fn copy_list(&mut self, addr: usize) {
-        for offset in 0 .. 2 {
-            if let Addr::Lis(h) = self.target[addr + offset].as_addr(addr + offset) {
-                if h >= self.old_h {
-                    *self.value_at_scan() = HeapCellValue::Addr(Addr::Lis(h));
-                    self.scan += 1;
+        for offset in 0..2 {
+            read_heap_cell!(self.target[addr + offset],
+                (HeapCellValueTag::Lis, h) => {
+                    if h >= self.old_h {
+                        *self.value_at_scan() = list_loc_as_cell!(h);
+                        self.scan += 1;
 
-                    return;
+                        return;
+                    }
                 }
-            }
+                _ => {
+                }
+            )
         }
 
         let threshold = self.target.threshold();
 
-        *self.value_at_scan() = HeapCellValue::Addr(Addr::Lis(threshold));
+        *self.value_at_scan() = list_loc_as_cell!(threshold);
 
-        for i in 0 .. 2 {
-            let hcv = self.target[addr + i].context_free_clone();
+        for i in 0..2 {
+            let hcv = self.target[addr + i];
             self.target.push(hcv);
         }
 
-        let cdr = self.target.store(self.target.deref(Addr::HeapCell(addr + 1)));
+        let cdr = self
+            .target
+            .store(self.target.deref(heap_loc_as_cell!(addr + 1)));
 
-        if !cdr.is_ref() {
+        if !cdr.is_var() {
             self.trail_list_cell(addr + 1, threshold);
         } else {
-            let car = self.target.store(self.target.deref(Addr::HeapCell(addr)));
+            let car = self
+                .target
+                .store(self.target.deref(heap_loc_as_cell!(addr)));
 
-            if !car.is_ref() {
+            if !car.is_var() {
                 self.trail_list_cell(addr, threshold);
             }
         }
@@ -101,201 +105,198 @@ impl<T: CopierTarget> CopyTermState<T> {
         self.scan += 1;
     }
 
-    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));
+    fn copy_partial_string(&mut self, scan_tag: HeapCellValueTag, pstr_loc: usize) {
+        read_heap_cell!(self.target[pstr_loc],
+            (HeapCellValueTag::PStrLoc, h) => {
+                debug_assert!(h >= self.old_h);
+
+                *self.value_at_scan() = match scan_tag {
+                    HeapCellValueTag::PStrLoc => {
+                        pstr_loc_as_cell!(h)
+                    }
+                    tag => {
+                        debug_assert_eq!(tag, HeapCellValueTag::PStrOffset);
+                        pstr_offset_as_cell!(h)
+                    }
+                };
+
+                self.scan += 1;
+                return;
+            }
+            (HeapCellValueTag::Var, h) => {
+                debug_assert!(h >= self.old_h);
+                debug_assert_eq!(scan_tag, HeapCellValueTag::PStrOffset);
+
+                *self.value_at_scan() = pstr_offset_as_cell!(h);
                 self.scan += 1;
 
                 return;
             }
-        }
+            _ => {}
+        );
 
         let threshold = self.target.threshold();
 
-        *self.value_at_scan() =
-            HeapCellValue::Addr(Addr::PStrLocation(threshold, n));
+        let replacement = read_heap_cell!(self.target[pstr_loc],
+            (HeapCellValueTag::CStr) => {
+                debug_assert_eq!(scan_tag, HeapCellValueTag::PStrOffset);
+
+                *self.value_at_scan() = pstr_offset_as_cell!(threshold);
+                self.target.push(self.target[pstr_loc]);
+
+                heap_loc_as_cell!(threshold)
+            }
+            _ => {
+                *self.value_at_scan() = if scan_tag == HeapCellValueTag::PStrLoc {
+                    pstr_loc_as_cell!(threshold)
+                } else {
+                    debug_assert_eq!(scan_tag, HeapCellValueTag::PStrOffset);
+                    pstr_offset_as_cell!(threshold)
+                };
+
+                self.target.push(self.target[pstr_loc]);
+                self.target.push(self.target[pstr_loc + 1]);
+
+                pstr_loc_as_cell!(threshold)
+            }
+        );
 
         self.scan += 1;
 
-        let (pstr, has_tail) =
-            match &self.target[addr] {
-                &HeapCellValue::PartialString(ref pstr, has_tail) => {
-                    (pstr.clone_from_offset(0), has_tail)
-                }
-                _ => {
-                    unreachable!()
-                }
-            };
-
-        self.target.push(HeapCellValue::PartialString(pstr, has_tail));
-
-        let replacement = HeapCellValue::Addr(Addr::PStrLocation(threshold, n));
-
-        let trail_item = mem::replace(
-            &mut self.target[addr],
-            replacement,
-        );
-
-        self.trail.push((
-            Ref::HeapCell(addr),
-            trail_item,
-        ));
-
-        if has_tail {
-            let tail_addr = self.target[addr + 1].as_addr(addr + 1);
-            self.target.push(HeapCellValue::Addr(tail_addr));
-        }
+        let trail_item = mem::replace(&mut self.target[pstr_loc], replacement);
+        self.trail.push((Ref::heap_cell(pstr_loc), trail_item));
     }
 
-    fn reinstantiate_var(&mut self, addr: Addr, frontier: usize) {
-        match addr {
-            Addr::HeapCell(h) => {
-                self.target[frontier] = HeapCellValue::Addr(Addr::HeapCell(frontier));
-                self.target[h] = HeapCellValue::Addr(Addr::HeapCell(frontier));
+    fn reinstantiate_var(&mut self, addr: HeapCellValue, frontier: usize) {
+        read_heap_cell!(addr,
+            (HeapCellValueTag::Var, h) => {
+                self.target[frontier] = heap_loc_as_cell!(frontier);
+                self.target[h] = heap_loc_as_cell!(frontier);
 
-                self.trail.push((
-                    Ref::HeapCell(h),
-                    HeapCellValue::Addr(Addr::HeapCell(h)),
-                ));
+                self.trail.push((Ref::heap_cell(h), heap_loc_as_cell!(h)));
             }
-            Addr::StackCell(fr, sc) => {
-                self.target[frontier] = HeapCellValue::Addr(Addr::HeapCell(frontier));
-                self.target.stack().index_and_frame_mut(fr)[sc] = Addr::HeapCell(frontier);
+            (HeapCellValueTag::StackVar, s) => {
+                self.target[frontier] = heap_loc_as_cell!(frontier);
+                self.target.stack()[s] = heap_loc_as_cell!(frontier);
 
-                self.trail.push((
-                    Ref::StackCell(fr, sc),
-                    HeapCellValue::Addr(Addr::StackCell(fr, sc)),
-                ));
+                self.trail.push((Ref::stack_cell(s), stack_loc_as_cell!(s)));
             }
-            Addr::AttrVar(h) => {
+            (HeapCellValueTag::AttrVar, h) => {
                 let threshold = if let AttrVarPolicy::DeepCopy = self.attr_var_policy {
                     self.target.threshold()
                 } else {
                     frontier
                 };
 
-                self.target[frontier] = HeapCellValue::Addr(Addr::HeapCell(threshold));
-                self.target[h] = HeapCellValue::Addr(Addr::HeapCell(threshold));
+                self.target[frontier] = heap_loc_as_cell!(threshold);
+                self.target[h] = heap_loc_as_cell!(threshold);
 
-                self.trail.push((
-                    Ref::AttrVar(h),
-                    HeapCellValue::Addr(Addr::AttrVar(h)),
-                ));
+                self.trail.push((Ref::attr_var(h), attr_var_as_cell!(h)));
 
                 if let AttrVarPolicy::DeepCopy = self.attr_var_policy {
-                    self.target.push(HeapCellValue::Addr(Addr::AttrVar(threshold)));
+                    self.target.push(attr_var_as_cell!(threshold));
 
-                    let list_val = self.target[h + 1].context_free_clone();
+                    let list_val = self.target[h + 1];
                     self.target.push(list_val);
                 }
             }
             _ => {
                 unreachable!()
             }
-        }
+        );
     }
 
-    fn copy_var(&mut self, addr: Addr) {
-        let rd = self.target.store(self.target.deref(addr));
+    fn copy_var(&mut self, addr: HeapCellValue) {
+        let rd = self.target.deref(addr);
+        let ra = self.target.store(rd);
 
-        match rd {
-            Addr::AttrVar(h) | Addr::HeapCell(h) if h >= self.old_h => {
-                *self.value_at_scan() = HeapCellValue::Addr(rd);
-                self.scan += 1;
-            }
-            _ if addr == rd => {
-                self.reinstantiate_var(addr, self.scan);
-                self.scan += 1;
-            }
-            _ => {
-                *self.value_at_scan() = HeapCellValue::Addr(rd);
+        read_heap_cell!(ra,
+            (HeapCellValueTag::AttrVar | HeapCellValueTag::Var, h) => {
+                if h >= self.old_h {
+                    *self.value_at_scan() = ra;
+                    self.scan += 1;
+
+                    return;
+                }
             }
+            _ => {}
+        );
+
+        if rd == ra {
+            self.reinstantiate_var(ra, self.scan);
+            self.scan += 1;
+        } else {
+            *self.value_at_scan() = ra;
         }
     }
 
     fn copy_structure(&mut self, addr: usize) {
-        match self.target[addr].context_free_clone() {
-            HeapCellValue::NamedStr(arity, name, fixity) => {
+        read_heap_cell!(self.target[addr],
+            (HeapCellValueTag::Atom, (name, arity)) => {
                 let threshold = self.target.threshold();
 
-                *self.value_at_scan() = HeapCellValue::Addr(Addr::Str(threshold));
+                *self.value_at_scan() = str_loc_as_cell!(threshold);
 
                 let trail_item = mem::replace(
                     &mut self.target[addr],
-                    HeapCellValue::Addr(Addr::Str(threshold)),
+                    str_loc_as_cell!(threshold),
                 );
 
-                self.trail.push((
-                    Ref::HeapCell(addr),
-                    trail_item,
-                ));
-
-                self.target.push(HeapCellValue::NamedStr(arity, name, fixity));
+                self.trail.push((Ref::heap_cell(addr), trail_item));
+                self.target.push(atom_as_cell!(name, arity));
 
                 for i in 0..arity {
-                    let hcv = self.target[addr + 1 + i].context_free_clone();
+                    let hcv = self.target[addr + 1 + i];
                     self.target.push(hcv);
                 }
+
+                let index_cell = self.target[addr + 1 + arity];
+
+                if get_structure_index(index_cell).is_some() {
+                    // copy the index pointer trailing this
+                    // inlined or expanded goal.
+                    self.target.push(index_cell);
+                }
             }
-            HeapCellValue::Addr(Addr::Str(addr)) => {
-                *self.value_at_scan() = HeapCellValue::Addr(Addr::Str(addr))
+            (HeapCellValueTag::Str, h) => {
+                *self.value_at_scan() = str_loc_as_cell!(h);
             }
             _ => {
                 unreachable!()
             }
-        }
+        );
 
         self.scan += 1;
     }
 
-    fn copy_term_impl(&mut self, addr: Addr) {
+    fn copy_term_impl(&mut self, addr: HeapCellValue) {
         self.scan = self.target.threshold();
-        self.target.push(HeapCellValue::Addr(addr));
+        self.target.push(addr);
 
         while self.scan < self.target.threshold() {
-            match self.value_at_scan() {
-                &mut HeapCellValue::Addr(addr) => {
-                    match addr {
-                        Addr::Con(h) => {
-                            let addr = self.target[h].as_addr(h);
+            let addr = *self.value_at_scan();
 
-                            if addr == Addr::Con(h) {
-                                *self.value_at_scan() = self.target[h].context_free_clone();
-                            } else {
-                                *self.value_at_scan() = HeapCellValue::Addr(addr);
-                            }
-                        }
-                        Addr::Lis(h) => {
-                            if h >= self.old_h {
-                                self.scan += 1;
-                            } else {
-                                self.copy_list(h);
-                            }
-                        }
-                        addr @ Addr::AttrVar(_) |
-                        addr @ Addr::HeapCell(_) |
-                        addr @ Addr::StackCell(..) => {
-                            self.copy_var(addr);
-                        }
-                        Addr::Str(addr) => {
-                            self.copy_structure(addr);
-                        }
-                        Addr::PStrLocation(addr, n) => {
-                            self.copy_partial_string(addr, n);
-                        }
-                        Addr::Stream(h) => {
-                            *self.value_at_scan() = self.target[h].context_free_clone();
-                        }
-                        _ => {
-                            self.scan += 1;
-                        }
+            read_heap_cell!(addr,
+                (HeapCellValueTag::Lis, h) => {
+                    if h >= self.old_h {
+                        self.scan += 1;
+                    } else {
+                        self.copy_list(h);
                     }
                 }
+                (HeapCellValueTag::AttrVar | HeapCellValueTag::Var) => {
+                    self.copy_var(addr);
+                }
+                (HeapCellValueTag::Str, h) => {
+                    self.copy_structure(h);
+                }
+                (HeapCellValueTag::PStrLoc | HeapCellValueTag::PStrOffset, pstr_loc) => {
+                    self.copy_partial_string(addr.get_tag(), pstr_loc);
+                }
                 _ => {
                     self.scan += 1;
                 }
-            }
+            );
         }
 
         self.unwind_trail();
@@ -303,12 +304,117 @@ impl<T: CopierTarget> CopyTermState<T> {
 
     fn unwind_trail(&mut self) {
         for (r, value) in self.trail.drain(0..) {
-            match r {
-                Ref::AttrVar(h) | Ref::HeapCell(h) =>
-                    self.target[h] = value,
-                Ref::StackCell(fr, sc) =>
-                    self.target.stack().index_and_frame_mut(fr)[sc] = value.as_addr(0),
+            let index = r.get_value() as usize;
+
+            match r.get_tag() {
+                RefTag::AttrVar | RefTag::HeapCell => self.target[index] = value,
+                RefTag::StackCell => self.target.stack()[index] = value,
             }
         }
     }
 }
+
+#[cfg(test)]
+mod tests {
+    use super::*;
+    use crate::machine::mock_wam::*;
+
+    #[test]
+    fn copier_tests() {
+        let mut wam = MockWAM::new();
+
+        let f_atom = atom!("f");
+        let a_atom = atom!("a");
+        let b_atom = atom!("b");
+
+        wam.machine_st.heap
+           .extend(functor!(f_atom, [atom(a_atom), atom(b_atom)]));
+
+        assert_eq!(wam.machine_st.heap[0], atom_as_cell!(f_atom, 2));
+        assert_eq!(wam.machine_st.heap[1], atom_as_cell!(a_atom));
+        assert_eq!(wam.machine_st.heap[2], atom_as_cell!(b_atom));
+
+        {
+            let wam = TermCopyingMockWAM { wam: &mut wam };
+            copy_term(wam, str_loc_as_cell!(0), AttrVarPolicy::DeepCopy);
+        }
+
+        // check that the original heap state is still intact.
+        assert_eq!(wam.machine_st.heap[0], atom_as_cell!(f_atom, 2));
+        assert_eq!(wam.machine_st.heap[1], atom_as_cell!(a_atom));
+        assert_eq!(wam.machine_st.heap[2], atom_as_cell!(b_atom));
+
+        assert_eq!(wam.machine_st.heap[3], str_loc_as_cell!(4));
+        assert_eq!(wam.machine_st.heap[4], atom_as_cell!(f_atom, 2));
+        assert_eq!(wam.machine_st.heap[5], atom_as_cell!(a_atom));
+        assert_eq!(wam.machine_st.heap[6], atom_as_cell!(b_atom));
+
+        wam.machine_st.heap.clear();
+
+        let pstr_var_cell = put_partial_string(&mut wam.machine_st.heap, "abc ", &mut wam.machine_st.atom_tbl);
+        let pstr_cell = wam.machine_st.heap[pstr_var_cell.get_value() as usize];
+
+        wam.machine_st.heap.pop();
+        wam.machine_st.heap.push(pstr_loc_as_cell!(2));
+
+        let pstr_second_var_cell = put_partial_string(&mut wam.machine_st.heap, "def", &mut wam.machine_st.atom_tbl);
+        let pstr_second_cell = wam.machine_st.heap[pstr_second_var_cell.get_value() as usize];
+
+        wam.machine_st.heap.pop();
+        wam.machine_st.heap.push(pstr_loc_as_cell!(wam.machine_st.heap.len() + 1));
+
+        wam.machine_st.heap.push(pstr_offset_as_cell!(0));
+        wam.machine_st.heap.push(fixnum_as_cell!(Fixnum::build_with(0i64)));
+
+        {
+            let wam = TermCopyingMockWAM { wam: &mut wam };
+            copy_term(wam, pstr_loc_as_cell!(0), AttrVarPolicy::DeepCopy);
+        }
+
+        print_heap_terms(wam.machine_st.heap[6..].iter(), 6);
+
+        assert_eq!(wam.machine_st.heap[0], pstr_cell);
+        assert_eq!(wam.machine_st.heap[1], pstr_loc_as_cell!(2));
+        assert_eq!(wam.machine_st.heap[2], pstr_second_cell);
+        assert_eq!(wam.machine_st.heap[3], pstr_loc_as_cell!(4));
+        assert_eq!(wam.machine_st.heap[4], pstr_offset_as_cell!(0));
+        assert_eq!(wam.machine_st.heap[5], fixnum_as_cell!(Fixnum::build_with(0i64)));
+
+        assert_eq!(wam.machine_st.heap[7], pstr_cell);
+        assert_eq!(wam.machine_st.heap[8], pstr_loc_as_cell!(9));
+        assert_eq!(wam.machine_st.heap[9], pstr_second_cell);
+        assert_eq!(wam.machine_st.heap[10], pstr_loc_as_cell!(11));
+        assert_eq!(wam.machine_st.heap[11], pstr_offset_as_cell!(7));
+        assert_eq!(wam.machine_st.heap[12], fixnum_as_cell!(Fixnum::build_with(0i64)));
+
+        wam.machine_st.heap.clear();
+
+        wam.machine_st.heap.extend(functor!(
+            f_atom,
+            [
+                atom(a_atom),
+                atom(b_atom),
+                atom(a_atom),
+                cell(str_loc_as_cell!(0))
+            ]
+        ));
+
+        {
+            let wam = TermCopyingMockWAM { wam: &mut wam };
+            copy_term(wam, str_loc_as_cell!(0), AttrVarPolicy::DeepCopy);
+        }
+
+        assert_eq!(wam.machine_st.heap[0], atom_as_cell!(f_atom, 4));
+        assert_eq!(wam.machine_st.heap[1], atom_as_cell!(a_atom));
+        assert_eq!(wam.machine_st.heap[2], atom_as_cell!(b_atom));
+        assert_eq!(wam.machine_st.heap[3], atom_as_cell!(a_atom));
+        assert_eq!(wam.machine_st.heap[4], str_loc_as_cell!(0));
+
+        assert_eq!(wam.machine_st.heap[5], str_loc_as_cell!(6));
+        assert_eq!(wam.machine_st.heap[6], atom_as_cell!(f_atom, 4));
+        assert_eq!(wam.machine_st.heap[7], atom_as_cell!(a_atom));
+        assert_eq!(wam.machine_st.heap[8], atom_as_cell!(b_atom));
+        assert_eq!(wam.machine_st.heap[9], atom_as_cell!(a_atom));
+        assert_eq!(wam.machine_st.heap[10], str_loc_as_cell!(6));
+    }
+}

src/machine/dynamic_database.rs

@@ -1,396 +0,0 @@
-use crate::prolog_parser::ast::*;
-
-use crate::heap_print::*;
-use crate::machine::*;
-use crate::machine::compile::*;
-use crate::machine::machine_errors::*;
-use crate::machine::streams::*;
-
-use std::convert::TryFrom;
-
-impl Machine {
-    pub(super) fn atom_tbl_of(&self, name: &ClauseName) -> TabledData<Atom> {
-        match name {
-            &ClauseName::User(ref rc) => rc.table.clone(),
-            _ => self.indices.atom_tbl(),
-        }
-    }
-
-    fn compile_into_machine(
-        &mut self,
-        src: Stream,
-        name: ClauseName,
-        arity: usize,
-    ) -> EvalSession {
-        match name.owning_module().as_str() {
-            "user" => match self.indices.code_dir.get(&(name.clone(), arity)).cloned() {
-                Some(idx) => {
-                    let module = idx.0.borrow().1.clone();
-
-                    match module.as_str() {
-                        "user" => compile_user_module(self, src, true, ListingSource::User),
-                        _ => compile_into_module(self, module, src, name)
-                    }
-                }
-                None => compile_user_module(self, src, true, ListingSource::User),
-            },
-            _ => compile_into_module(self, name.owning_module(), src, name),
-        }
-    }
-
-    fn get_predicate_key(&self, name: RegType, arity: RegType) -> PredicateKey {
-        let name = self.machine_st[name].clone();
-        let arity = self.machine_st[arity].clone();
-
-        let name = match self.machine_st.store(self.machine_st.deref(name)) {
-            Addr::Con(h) =>
-                if let HeapCellValue::Atom(ref name, _) = &self.machine_st.heap[h] {
-                    name.clone()
-                } else {
-                    unreachable!()
-                },
-            _ => unreachable!(),
-        };
-
-        let arity = match self.machine_st.store(self.machine_st.deref(arity)) {
-            Addr::Con(h) => {
-                match &self.machine_st.heap[h] {
-                    HeapCellValue::Integer(ref arity) => {
-                        arity.to_usize().unwrap()
-                    }
-                    HeapCellValue::Addr(Addr::Fixnum(arity)) => {
-                        usize::try_from(*arity).unwrap()
-                    }
-                    _ => {
-                        unreachable!()
-                    }
-                }
-            }
-            Addr::Fixnum(arity) => {
-                usize::try_from(arity).unwrap()
-            }
-            Addr::Usize(n) => {
-                n
-            }
-            _ => {
-                unreachable!()
-            }
-        };
-
-        (name, arity)
-    }
-
-    fn print_new_dynamic_clause(
-        &self,
-        addrs: VecDeque<Addr>,
-        name: ClauseName,
-        arity: usize,
-    ) -> String {
-        let mut output = PrinterOutputter::new();
-        output.append(format!(":- dynamic({}/{}). ", name.as_str(), arity).as_str());
-
-        for addr in addrs {
-            let mut printer = HCPrinter::new(&self.machine_st, &self.indices.op_dir, output);
-            printer.quoted = true;
-
-            output = printer.print(addr);
-            output.append(". ");
-        }
-
-        output.result()
-    }
-
-    fn make_undefined(&mut self, name: ClauseName, arity: usize) {
-        let module_name = name.owning_module();
-
-        match self.indices.modules.get(&module_name) {
-            Some(ref module) => {
-                if let Some(idx) = module.code_dir.get(&(name.clone(), arity)) {
-                    set_code_index!(idx, IndexPtr::DynamicUndefined, module_name);
-                }
-            }
-            None => {
-            }
-        }
-
-        if let Some(idx) = self.indices.code_dir.get(&(name, arity)) {
-            set_code_index!(idx, IndexPtr::DynamicUndefined, clause_name!("user"));
-        }
-    }
-
-    fn make_undefined_in_module(&mut self, module_name: ClauseName, name: ClauseName, arity: usize) {
-        if let Some(idx) = self.indices.code_dir.get(&(name, arity)) {
-            if idx.module_name() == module_name {
-                set_code_index!(idx, IndexPtr::DynamicUndefined, clause_name!("user"));
-            }
-        }
-    }
-
-    fn abolish_dynamic_clause(&mut self, name: RegType, arity: RegType) {
-        let (name, arity) = self.get_predicate_key(name, arity);
-
-        self.make_undefined(name.clone(), arity);
-
-        self.indices.remove_code_index((name.clone(), arity));
-        self.indices.remove_clause_subsection(name.owning_module(), name, arity);
-    }
-
-    fn abolish_dynamic_clause_in_module(&mut self, name: RegType, arity: RegType, module: RegType) {
-        let (name, arity) = self.get_predicate_key(name, arity);
-        let module_addr = self.machine_st[module].clone();
-
-        let module_name = match self.machine_st.store(self.machine_st.deref(module_addr)) {
-            Addr::Con(h) =>
-                if let HeapCellValue::Atom(ref module, _) = &self.machine_st.heap[h] {
-                    match self.indices.modules.get_mut(module) {
-                        Some(ref mut module) => {
-                            module.code_dir.remove(&(name.clone(), arity));
-                            module.module_decl.name.clone()
-                        }
-                        _ => {
-                            self.machine_st.fail = true;
-                            return;
-                        }
-                    }
-                } else {
-                    unreachable!()
-                },
-            _ => unreachable!(),
-        };
-
-        self.make_undefined_in_module(module_name.clone(), name.clone(), arity);
-
-        self.indices.remove_code_index((name.clone(), arity));
-        self.indices.remove_clause_subsection(module_name, name, arity);
-    }
-
-    fn handle_eval_result_from_dynamic_compile(
-        &mut self,
-        pred_str: String,
-        name: ClauseName,
-        arity: usize,
-        src: ClauseName,
-    ) {
-        let machine_st = mem::replace(&mut self.machine_st, MachineState::new());
-
-        let result = self.compile_into_machine(
-            Stream::from(pred_str),
-            name,
-            arity,
-        );
-
-        self.machine_st = machine_st;
-
-        if let EvalSession::Error(err) = result {
-            let h = self.machine_st.heap.h();
-            let stub = MachineError::functor_stub(src, 1);
-            let err = MachineError::session_error(h, err);
-            let err = self.machine_st.error_form(err, stub);
-
-            self.machine_st.throw_exception(err);
-        }
-    }
-
-    fn recompile_dynamic_predicate_impl(
-        &mut self,
-        place: DynamicAssertPlace,
-        name: ClauseName,
-        arity: usize,
-    ) {
-        let stub = MachineError::functor_stub(place.predicate_name(), 1);
-        let pred_str = match self.machine_st.try_from_list(temp_v!(2), stub) {
-            Ok(addrs) => {
-                let mut addrs = VecDeque::from(addrs);
-                let added_clause = self.machine_st[temp_v!(1)].clone();
-
-                place.push_to_queue(&mut addrs, added_clause);
-                self.print_new_dynamic_clause(addrs, name.clone(), arity)
-            }
-            Err(err) => {
-                return self.machine_st.throw_exception(err);
-            }
-        };
-
-        self.handle_eval_result_from_dynamic_compile(
-            pred_str,
-            name,
-            arity,
-            place.predicate_name(),
-        );
-    }
-
-    fn set_module_atom_tbl(&mut self, module_addr: Addr, name: &mut ClauseName) -> bool {
-        let atom_tbl = match self.machine_st.store(self.machine_st.deref(module_addr)) {
-            Addr::Con(h) =>
-                if let HeapCellValue::Atom(ref module, _) = &self.machine_st.heap[h] {
-                    match self.indices.modules.get(module) {
-                        Some(ref module) => module.atom_tbl.clone(),
-                        None => {
-                            self.machine_st.fail = true;
-                            return false;
-                        }
-                    }
-                } else {
-                    self.machine_st.fail = true;
-                    return false;
-                },
-            _ => unreachable!(),
-        };
-
-        if let &mut ClauseName::User(ref mut rc) = name {
-            rc.table = atom_tbl;
-        }
-
-        true
-    }
-
-    fn recompile_dynamic_predicate_in_module(&mut self, place: DynamicAssertPlace) {
-        let (mut name, arity) = self.get_predicate_key(temp_v!(3), temp_v!(4));
-        let module_addr = self.machine_st[temp_v!(5)].clone();
-
-        if self.set_module_atom_tbl(module_addr, &mut name) {
-            self.recompile_dynamic_predicate_impl(place, name, arity);
-        }
-    }
-
-    fn recompile_dynamic_predicate(&mut self, place: DynamicAssertPlace) {
-        let (name, arity) = self.get_predicate_key(temp_v!(3), temp_v!(4));
-        self.recompile_dynamic_predicate_impl(place, name, arity);
-    }
-
-    fn retract_from_dynamic_predicate_in_module(&mut self) {
-        let index = self.machine_st[temp_v!(3)].clone();
-        let index = match self.machine_st.store(self.machine_st.deref(index)) {
-            Addr::Con(h) =>
-                match &self.machine_st.heap[h] {
-                    HeapCellValue::Integer(ref arity) => {
-                        arity.to_usize().unwrap()
-                    }
-                    HeapCellValue::Addr(Addr::Fixnum(arity)) => {
-                        usize::try_from(*arity).unwrap()
-                    }
-                    _ => {
-                        unreachable!()
-                    }
-                }
-            Addr::Fixnum(arity) => {
-                usize::try_from(arity).unwrap()
-            }
-            _ => {
-                unreachable!()
-            }
-        };
-
-        let (mut name, arity) = self.get_predicate_key(temp_v!(1), temp_v!(2));
-        let module_addr = self.machine_st[temp_v!(5)].clone();
-
-        if self.set_module_atom_tbl(module_addr, &mut name) {
-            let stub = MachineError::functor_stub(clause_name!("retract"), 1);
-            let pred_str = match self.machine_st.try_from_list(temp_v!(4), stub) {
-                Ok(addrs) => {
-                    let mut addrs = VecDeque::from(addrs);
-                    addrs.remove(index);
-
-                    if addrs.is_empty() {
-                        self.make_undefined(name.clone(), arity);
-                    }
-
-                    self.print_new_dynamic_clause(addrs, name.clone(), arity)
-                }
-                Err(err) => {
-                    return self.machine_st.throw_exception(err);
-                }
-            };
-
-            self.handle_eval_result_from_dynamic_compile(
-                pred_str,
-                name,
-                arity,
-                clause_name!("retract"),
-            );
-        }
-    }
-
-    fn retract_from_dynamic_predicate(&mut self) {
-        let index = self.machine_st[temp_v!(3)].clone();
-        let index = match self.machine_st.store(self.machine_st.deref(index)) {
-            Addr::Con(h) => {
-                match &self.machine_st.heap[h] {
-                    HeapCellValue::Integer(ref arity) => {
-                        arity.to_usize().unwrap()
-                    }
-                    HeapCellValue::Addr(Addr::Fixnum(arity)) => {
-                        usize::try_from(*arity).unwrap()
-                    }
-                    _ => {
-                        unreachable!()
-                    }
-                }
-            }
-            Addr::Usize(n) => {
-                n
-            }
-            Addr::Fixnum(n) => {
-                usize::try_from(n).unwrap()
-            }
-            _ => {
-                unreachable!()
-            }
-        };
-
-        let (name, arity) = self.get_predicate_key(temp_v!(1), temp_v!(2));
-
-        let stub = MachineError::functor_stub(clause_name!("retract"), 1);
-        let pred_str = match self.machine_st.try_from_list(temp_v!(4), stub) {
-            Ok(addrs) => {
-                let mut addrs = VecDeque::from(addrs);
-                addrs.remove(index);
-
-                if addrs.is_empty() {
-                    self.make_undefined(name.clone(), arity);
-                }
-
-                self.print_new_dynamic_clause(addrs, name.clone(), arity)
-            }
-            Err(err) => {
-                return self.machine_st.throw_exception(err);
-            }
-        };
-
-        self.handle_eval_result_from_dynamic_compile(
-            pred_str,
-            name,
-            arity,
-            clause_name!("retract"),
-        );
-    }
-
-    pub(super) fn dynamic_transaction(
-        &mut self,
-        trans_type: DynamicTransactionType,
-        p: LocalCodePtr,
-    ) {
-        match trans_type {
-            DynamicTransactionType::Abolish => {
-                self.abolish_dynamic_clause(temp_v!(1), temp_v!(2))
-            }
-            DynamicTransactionType::Assert(place) => {
-                self.recompile_dynamic_predicate(place)
-            }
-            DynamicTransactionType::ModuleAbolish => {
-                self.abolish_dynamic_clause_in_module(temp_v!(1), temp_v!(2), temp_v!(3))
-            }
-            DynamicTransactionType::ModuleAssert(place) => {
-                self.recompile_dynamic_predicate_in_module(place)
-            }
-            DynamicTransactionType::ModuleRetract => {
-                self.retract_from_dynamic_predicate_in_module()
-            }
-            DynamicTransactionType::Retract => {
-                self.retract_from_dynamic_predicate()
-            }
-        }
-
-        self.machine_st.p = CodePtr::Local(p);
-    }
-}

src/machine/heap.rs

@@ -1,544 +1,284 @@
-use core::marker::PhantomData;
-
-use crate::prolog_parser::ast::Constant;
-
+use crate::arena::*;
+use crate::atom_table::*;
+use crate::forms::*;
 use crate::machine::machine_indices::*;
 use crate::machine::partial_string::*;
-use crate::machine::raw_block::*;
+use crate::parser::ast::*;
+use crate::types::*;
+
+use crate::parser::rug::{Integer, Rational};
 
 use std::convert::TryFrom;
-use std::mem;
-use std::ops::{Index, IndexMut};
-use std::ptr;
 
-#[derive(Debug)]
-pub(crate) struct StandardHeapTraits {}
+pub(crate) type Heap = Vec<HeapCellValue>;
 
-impl RawBlockTraits for StandardHeapTraits {
+impl From<Literal> for HeapCellValue {
     #[inline]
-    fn init_size() -> usize {
-        256 * mem::size_of::<HeapCellValue>()
-    }
-
-    #[inline]
-    fn align() -> usize {
-        mem::align_of::<HeapCellValue>()
-    }
-}
-
-#[derive(Debug)]
-pub(crate) struct HeapTemplate<T: RawBlockTraits> {
-    buf: RawBlock<T>,
-    _marker: PhantomData<HeapCellValue>,
-}
-
-pub(crate) type Heap = HeapTemplate<StandardHeapTraits>;
-
-impl<T: RawBlockTraits> Drop for HeapTemplate<T> {
-    fn drop(&mut self) {
-        self.clear();
-        self.buf.deallocate();
-    }
-}
-
-#[derive(Debug)]
-pub(crate)
-struct HeapIntoIter<T: RawBlockTraits> {
-    offset: usize,
-    buf: RawBlock<T>,
-}
-
-impl<T: RawBlockTraits> Drop for HeapIntoIter<T> {
-    fn drop(&mut self) {
-        let mut heap =
-            HeapTemplate { buf: self.buf.take(), _marker: PhantomData };
-
-        heap.truncate(self.offset / mem::size_of::<HeapCellValue>());
-        heap.buf.deallocate();
-    }
-}
-
-impl<T: RawBlockTraits> Iterator for HeapIntoIter<T> {
-    type Item = HeapCellValue;
-
-    fn next(&mut self) -> Option<Self::Item> {
-        let ptr = self.buf.base as usize + self.offset;
-        self.offset += mem::size_of::<HeapCellValue>();
-
-        if ptr < self.buf.top as usize {
-            unsafe {
-                Some(ptr::read(ptr as *const HeapCellValue))
+    fn from(literal: Literal) -> Self {
+        match literal {
+            Literal::Atom(name) => atom_as_cell!(name),
+            Literal::Char(c) => char_as_cell!(c),
+            Literal::CodeIndex(ptr) => {
+                untyped_arena_ptr_as_cell!(UntypedArenaPtr::from(ptr))
+            }
+            Literal::Fixnum(n) => fixnum_as_cell!(n),
+            Literal::Integer(bigint_ptr) => {
+                typed_arena_ptr_as_cell!(bigint_ptr)
+            }
+            Literal::Rational(bigint_ptr) => {
+                typed_arena_ptr_as_cell!(bigint_ptr)
+            }
+            Literal::Float(f) => HeapCellValue::from(f.as_ptr()),
+            Literal::String(s) => {
+                if s == atom!("") {
+                    empty_list_as_cell!()
+                } else {
+                    string_as_cstr_cell!(s)
+                }
             }
-        } else {
-            None
         }
     }
 }
 
-#[derive(Debug)]
-pub(crate)
-struct HeapIter<'a, T: RawBlockTraits> {
-    offset: usize,
-    buf: &'a RawBlock<T>,
-}
+impl TryFrom<HeapCellValue> for Literal {
+    type Error = ();
 
-impl<'a, T: RawBlockTraits> HeapIter<'a, T> {
-    pub(crate)
-    fn new(buf: &'a RawBlock<T>, offset: usize) -> Self {
-        HeapIter { buf, offset }
-    }
-}
-
-impl<'a, T: RawBlockTraits> Iterator for HeapIter<'a, T> {
-    type Item = &'a HeapCellValue;
-
-    fn next(&mut self) -> Option<Self::Item> {
-        let ptr = self.buf.base as usize + self.offset;
-        self.offset += mem::size_of::<HeapCellValue>();
-
-        if ptr < self.buf.top as usize {
-            unsafe {
-                Some(&*(ptr as *const _))
+    fn try_from(value: HeapCellValue) -> Result<Literal, ()> {
+        read_heap_cell!(value,
+            (HeapCellValueTag::Atom, (name, arity)) => {
+                if arity == 0 {
+                    Ok(Literal::Atom(name))
+                } else {
+                    Err(())
+                }
             }
-        } else {
-            None
-        }
+            (HeapCellValueTag::Char, c) => {
+                Ok(Literal::Char(c))
+            }
+            (HeapCellValueTag::Fixnum, n) => {
+                Ok(Literal::Fixnum(n))
+            }
+            (HeapCellValueTag::F64, f) => {
+                Ok(Literal::Float(f.as_offset()))
+            }
+            (HeapCellValueTag::Cons, cons_ptr) => {
+                match_untyped_arena_ptr!(cons_ptr,
+                     (ArenaHeaderTag::Integer, n) => {
+                         Ok(Literal::Integer(n))
+                     }
+                     (ArenaHeaderTag::Rational, n) => {
+                         Ok(Literal::Rational(n))
+                     }
+                     (ArenaHeaderTag::IndexPtr, _ip) => {
+                         Ok(Literal::CodeIndex(CodeIndex::from(cons_ptr)))
+                     }
+                     _ => {
+                         Err(())
+                     }
+                )
+            }
+            (HeapCellValueTag::CStr, cstr_atom) => {
+                Ok(Literal::String(cstr_atom))
+            }
+            _ => {
+                Err(())
+            }
+        )
     }
 }
 
+// sometimes we need to dereference variables that are found only in
+// the heap without access to the full WAM (e.g., while detecting
+// cycles in terms), and which therefore may only point other cells in
+// the heap (thanks to the design of the WAM).
+pub fn heap_bound_deref(heap: &[HeapCellValue], mut value: HeapCellValue) -> HeapCellValue {
+    loop {
+        let new_value = read_heap_cell!(value,
+            (HeapCellValueTag::AttrVar | HeapCellValueTag::Var, h) => {
+                heap[h]
+            }
+            _ => {
+                value
+            }
+        );
+
+        if new_value != value && new_value.is_var() {
+            value = new_value;
+            continue;
+        }
+
+        return value;
+    }
+}
+
+pub fn heap_bound_store(heap: &[HeapCellValue], value: HeapCellValue) -> HeapCellValue {
+    read_heap_cell!(value,
+        (HeapCellValueTag::AttrVar | HeapCellValueTag::Var, h) => {
+            heap[h]
+        }
+        _ => {
+            value
+        }
+    )
+}
+
 #[allow(dead_code)]
-pub(crate)
-fn print_heap_terms<'a, I: Iterator<Item = &'a HeapCellValue>>(heap: I, h: usize) {
+pub fn print_heap_terms<'a, I: Iterator<Item = &'a HeapCellValue>>(heap: I, h: usize) {
     for (index, term) in heap.enumerate() {
-        println!("{} : {}", h + index, term);
+        println!("{} : {:?}", h + index, term);
     }
 }
 
-#[derive(Debug)]
-pub(crate)
-struct HeapIterMut<'a, T: RawBlockTraits> {
-    offset: usize,
-    buf: &'a mut RawBlock<T>,
-}
+#[inline]
+pub(crate) fn put_complete_string(
+    heap: &mut Heap,
+    s: &str,
+    atom_tbl: &mut AtomTable,
+) -> HeapCellValue {
+    match allocate_pstr(heap, s, atom_tbl) {
+        Some(h) => {
+            heap.pop(); // pop the trailing variable cell from the heap planted by allocate_pstr.
 
-impl<'a, T: RawBlockTraits> HeapIterMut<'a, T> {
-    pub(crate)
-    fn new(buf: &'a mut RawBlock<T>, offset: usize) -> Self {
-        HeapIterMut { buf, offset }
-    }
-}
-
-impl<'a, T: RawBlockTraits> Iterator for HeapIterMut<'a, T> {
-    type Item = &'a mut HeapCellValue;
-
-    fn next(&mut self) -> Option<Self::Item> {
-        let ptr = self.buf.base as usize + self.offset;
-        self.offset += mem::size_of::<HeapCellValue>();
-
-        if ptr < self.buf.top as usize {
-            unsafe {
-                Some(&mut *(ptr as *mut _))
-            }
-        } else {
-            None
-        }
-    }
-}
-
-impl<T: RawBlockTraits> HeapTemplate<T> {
-    #[inline]
-    pub(crate)
-    fn new() -> Self {
-        HeapTemplate { buf: RawBlock::new(), _marker: PhantomData }
-    }
-
-    #[inline]
-    pub(crate)
-    fn clone(&self, h: usize) -> HeapCellValue {
-        match &self[h] {
-            &HeapCellValue::Addr(addr) => {
-                HeapCellValue::Addr(addr)
-            }
-            &HeapCellValue::Atom(ref name, ref op) => {
-                HeapCellValue::Atom(name.clone(), op.clone())
-            }
-            &HeapCellValue::DBRef(ref db_ref) => {
-                HeapCellValue::DBRef(db_ref.clone())
-            }
-            &HeapCellValue::Integer(ref n) => {
-                HeapCellValue::Integer(n.clone())
-            }
-            &HeapCellValue::NamedStr(arity, ref name, ref op) => {
-                HeapCellValue::NamedStr(arity, name.clone(), op.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();
-
-        let h = self.h();
-
-        match &mut self[h - 1] {
-            &mut HeapCellValue::PartialString(_, ref mut has_tail) => {
-                *has_tail = false;
-            }
-            _ => {
-                unreachable!()
-            }
-        }
-
-        addr
-    }
-
-    #[inline]
-    pub(crate)
-    fn put_constant(&mut self, c: Constant) -> Addr {
-        match c {
-            Constant::Atom(name, op) => {
-                Addr::Con(self.push(HeapCellValue::Atom(name, op)))
-            }
-            Constant::Char(c) => {
-                Addr::Char(c)
-            }
-            Constant::EmptyList => {
-                Addr::EmptyList
-            }
-            Constant::Fixnum(n) => {
-                Addr::Fixnum(n)
-            }
-            Constant::Integer(n) => {
-                Addr::Con(self.push(HeapCellValue::Integer(n)))
-            }
-            Constant::Rational(r) => {
-                Addr::Con(self.push(HeapCellValue::Rational(r)))
-            }
-            Constant::Float(f) => {
-                Addr::Float(f)
-            }
-            Constant::String(s) => {
-                if s.is_empty() {
-                    Addr::EmptyList
-                } else {
-                    self.put_complete_string(&s)
-                }
-            }
-            Constant::Usize(n) => {
-                Addr::Usize(n)
-            }
-        }
-    }
-
-    #[inline]
-    pub(crate)
-    fn pop(&mut self) {
-        let h = self.h();
-
-        if h > 0 {
-            self.truncate(h - 1);
-        }
-    }
-
-    #[inline]
-    pub(crate)
-    fn push(&mut self, val: HeapCellValue) -> usize {
-        let h = self.h();
-
-        unsafe {
-            let new_top = self.buf.new_block(mem::size_of::<HeapCellValue>());
-            ptr::write(self.buf.top as *mut _, val);
-            self.buf.top = new_top;
-        }
-
-        h
-    }
-
-    #[inline]
-    pub(crate)
-    fn atom_at(&self, h: usize) -> bool {
-        if let HeapCellValue::Atom(..) = &self[h] {
-            true
-        } else {
-            false
-        }
-    }
-
-    #[inline]
-    pub(crate)
-    fn to_unifiable(&mut self, non_heap_value: HeapCellValue) -> Addr {
-        match non_heap_value {
-            HeapCellValue::Addr(addr) => {
-                addr
-            }
-            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))
-            }
-            HeapCellValue::PartialString(pstr, has_tail) => {
-                let h = self.push(HeapCellValue::PartialString(pstr, has_tail));
-
-                if has_tail {
-                    self.push(HeapCellValue::Addr(Addr::EmptyList));
-                }
-
-                Addr::Con(h)
-            }
-            val @ HeapCellValue::Stream(..) => {
-                Addr::Stream(self.push(val))
-            }
-            val @ HeapCellValue::TcpListener(..) => {
-                Addr::TcpListener(self.push(val))
-            }
-        }
-    }
-
-    #[inline]
-    pub(crate)
-    fn allocate_pstr(&mut self, src: &str) -> Addr {
-        self.write_pstr(src)
-            .unwrap_or_else(|| Addr::EmptyList)
-    }
-
-    #[inline]
-    fn write_pstr(&mut self, mut src: &str) -> Option<Addr> {
-        let orig_h = self.h();
-
-        loop {
-            if src == "" {
-                return if orig_h == self.h() {
-                    None
-                } else {
-                    let tail_h = self.h() - 1;
-                    self[tail_h] = HeapCellValue::Addr(Addr::HeapCell(tail_h));
-
-                    Some(Addr::PStrLocation(orig_h, 0))
-                };
-            }
-
-            let h = self.h();
-
-            let (pstr, rest_src) =
-                match PartialString::new(src) {
-                    Some(tuple) => {
-                        tuple
-                    }
-                    None => {
-                        if src.len() > '\u{0}'.len_utf8() {
-                            src = &src['\u{0}'.len_utf8() ..];
-                            continue;
-                        } else if orig_h == h {
-                            return None;
-                        } else {
-                            self[h - 1] = HeapCellValue::Addr(Addr::HeapCell(h - 1));
-                            return Some(Addr::PStrLocation(orig_h, 0));
-                        }
-                    }
-                };
-
-            self.push(HeapCellValue::PartialString(pstr, true));
-
-            if rest_src != "" {
-                self.push(HeapCellValue::Addr(Addr::PStrLocation(h + 2, 0)));
-                src = rest_src;
+            if heap.len() == h + 1 {
+                let pstr_atom = cell_as_atom!(heap[h]);
+                heap[h] = atom_as_cstr_cell!(pstr_atom);
+                heap_loc_as_cell!(h)
             } else {
-                self.push(HeapCellValue::Addr(Addr::HeapCell(h + 1)));
-                return Some(Addr::PStrLocation(orig_h, 0));
+                heap.push(empty_list_as_cell!());
+                pstr_loc_as_cell!(h)
             }
         }
-    }
-
-    #[inline]
-    pub(crate)
-    fn take(&mut self) -> Self {
-        HeapTemplate {
-            buf: self.buf.take(),
-            _marker: PhantomData,
+        None => {
+            let h = heap.len();
+            heap.push(empty_list_as_cell!());
+            heap_loc_as_cell!(h)
         }
     }
+}
 
-    #[inline]
-    pub(crate)
-    fn truncate(&mut self, h: usize) {
-        let new_top = h * mem::size_of::<HeapCellValue>() + self.buf.base as usize;
-        let mut h = new_top;
-
-        unsafe {
-            while h as *const _ < self.buf.top {
-                let val = h as *mut HeapCellValue;
-                ptr::drop_in_place(val);
-                h += mem::size_of::<HeapCellValue>();
-            }
+#[inline]
+pub(crate) fn put_partial_string(
+    heap: &mut Heap,
+    s: &str,
+    atom_tbl: &mut AtomTable,
+) -> HeapCellValue {
+    match allocate_pstr(heap, s, atom_tbl) {
+        Some(h) => {
+            pstr_loc_as_cell!(h)
         }
-
-        self.buf.top = new_top as *const _;
-    }
-
-    #[inline]
-    pub(crate)
-    fn h(&self) -> usize {
-        (self.buf.top as usize - self.buf.base as usize) / mem::size_of::<HeapCellValue>()
-    }
-
-    pub(crate)
-    fn append(&mut self, vals: Vec<HeapCellValue>) {
-        for val in vals {
-            self.push(val);
+        None => {
+            empty_list_as_cell!()
         }
     }
+}
 
-    pub(crate)
-    fn clear(&mut self) {
-        if !self.buf.base.is_null() {
-            self.truncate(0);
-            self.buf.top = self.buf.base;
-        }
-    }
+#[inline]
+pub(crate) fn allocate_pstr(
+    heap: &mut Heap,
+    mut src: &str,
+    atom_tbl: &mut AtomTable,
+) -> Option<usize> {
+    let orig_h = heap.len();
 
-    pub(crate)
-    fn to_list<Iter, SrcT>(&mut self, values: Iter) -> usize
-        where Iter: Iterator<Item = SrcT>,
-              SrcT: Into<HeapCellValue>
-    {
-        let head_addr = self.h();
-        let mut h = head_addr;
+    loop {
+        if src == "" {
+            return if orig_h == heap.len() {
+                None
+            } else {
+                let tail_h = heap.len() - 1;
+                heap[tail_h] = heap_loc_as_cell!(tail_h);
 
-        for value in values.map(|v| v.into()) {
-            self.push(HeapCellValue::Addr(Addr::Lis(h + 1)));
-            self.push(value);
-
-            h += 2;
+                Some(orig_h)
+            };
         }
 
-        self.push(HeapCellValue::Addr(Addr::EmptyList));
+        let h = heap.len();
 
-        head_addr
-    }
-
-    /* Create an iterator starting from the passed offset. */
-    pub(crate)
-    fn iter_from<'a>(&'a self, offset: usize) -> HeapIter<'a, T> {
-        HeapIter::new(&self.buf, offset * mem::size_of::<HeapCellValue>())
-    }
-
-    pub(crate)
-    fn iter_mut_from<'a>(&'a mut self, offset: usize) -> HeapIterMut<'a, T> {
-        HeapIterMut::new(&mut self.buf, offset * mem::size_of::<HeapCellValue>())
-    }
-
-    pub(crate)
-    fn into_iter(mut self) -> HeapIntoIter<T> {
-        HeapIntoIter { buf: self.buf.take(), offset: 0 }
-    }
-
-    pub(crate)
-    fn extend<Iter: Iterator<Item = HeapCellValue>>(&mut self, iter: Iter) {
-        for hcv in iter {
-            self.push(hcv);
-        }
-    }
-
-    pub(crate)
-    fn to_local_code_ptr(&self, addr: &Addr) -> Option<LocalCodePtr> {
-        let extract_integer = |s: usize| -> Option<usize> {
-            match &self[s] {
-                &HeapCellValue::Addr(Addr::Fixnum(n)) => usize::try_from(n).ok(),
-                &HeapCellValue::Integer(ref n) => n.to_usize(),
-                _ => None
+        let (pstr, rest_src) = match PartialString::new(src, atom_tbl) {
+            Some(tuple) => tuple,
+            None => {
+                if src.len() > '\u{0}'.len_utf8() {
+                    src = &src['\u{0}'.len_utf8()..];
+                    continue;
+                } else if orig_h == h {
+                    return None;
+                } else {
+                    heap[h - 1] = heap_loc_as_cell!(h - 1);
+                    return Some(orig_h);
+                }
             }
         };
 
-        match addr {
-            Addr::Str(s) => {
-                match &self[*s] {
-                    HeapCellValue::NamedStr(arity, ref name, _) => {
-                        match (name.as_str(), *arity) {
-                            ("dir_entry", 1) => {
-                                extract_integer(s+1).map(LocalCodePtr::DirEntry)
-                            }
-                            ("in_situ_dir_entry", 1) => {
-                                extract_integer(s+1).map(LocalCodePtr::InSituDirEntry)
-                            }
-                            ("top_level", 2) => {
-                                if let Some(chunk_num) = extract_integer(s+1) {
-                                    if let Some(p) = extract_integer(s+2) {
-                                        return Some(LocalCodePtr::TopLevel(chunk_num, p));
-                                    }
-                                }
+        heap.push(string_as_pstr_cell!(pstr));
 
-                                None
-                            }
-                            ("user_goal_expansion", 1) => {
-                                extract_integer(s+1).map(LocalCodePtr::UserGoalExpansion)
-                            }
-                            ("user_term_expansion", 1) => {
-                                extract_integer(s+1).map(LocalCodePtr::UserTermExpansion)
-                            }
-                            _ => None
-                        }
-                    }
-                    _ => unreachable!()
-                }
-            }
-            _ => None
-        }
-    }
-
-    #[inline]
-    pub
-    fn index_addr<'a>(&'a self, addr: &Addr) -> RefOrOwned<'a, HeapCellValue> {
-        match addr {
-            &Addr::Con(h) | &Addr::Str(h) | &Addr::Stream(h) | &Addr::TcpListener(h) => {
-                RefOrOwned::Borrowed(&self[h])
-            }
-            addr => {
-                RefOrOwned::Owned(HeapCellValue::Addr(*addr))
-            }
+        if rest_src != "" {
+            heap.push(pstr_loc_as_cell!(h + 2));
+            src = rest_src;
+        } else {
+            heap.push(heap_loc_as_cell!(h + 1));
+            return Some(orig_h);
         }
     }
 }
 
-impl<T: RawBlockTraits> Index<usize> for HeapTemplate<T> {
-    type Output = HeapCellValue;
+pub fn filtered_iter_to_heap_list<SrcT: Into<HeapCellValue>>(
+    heap: &mut Heap,
+    values: impl Iterator<Item = SrcT>,
+    filter_fn: impl Fn(&Heap, HeapCellValue) -> bool,
+) -> usize {
+    let head_addr = heap.len();
+    let mut h = head_addr;
 
-    #[inline]
-    fn index(&self, index: usize) -> &Self::Output {
-        unsafe {
-            let ptr = self.buf.base as usize + index * mem::size_of::<HeapCellValue>();
-            &*(ptr as *const HeapCellValue)
+    for value in values {
+        let value = value.into();
+
+        if filter_fn(heap, value) {
+            heap.push(list_loc_as_cell!(h + 1));
+            heap.push(value);
+
+            h += 2;
         }
     }
+
+    heap.push(empty_list_as_cell!());
+
+    head_addr
 }
 
-impl<T: RawBlockTraits> IndexMut<usize> for HeapTemplate<T> {
-    #[inline]
-    fn index_mut(&mut self, index: usize) -> &mut Self::Output {
-        unsafe {
-            let ptr = self.buf.base as usize + index * mem::size_of::<HeapCellValue>();
-            &mut *(ptr as *mut HeapCellValue)
-        }
-    }
+#[inline(always)]
+pub fn iter_to_heap_list<Iter, SrcT>(heap: &mut Heap, values: Iter) -> usize
+where
+    Iter: Iterator<Item = SrcT>,
+    SrcT: Into<HeapCellValue>,
+{
+    filtered_iter_to_heap_list(heap, values, |_, _| true)
+}
+
+pub(crate) fn to_local_code_ptr(heap: &Heap, addr: HeapCellValue) -> Option<usize> {
+    let extract_integer = |s: usize| -> Option<usize> {
+        match Number::try_from(heap[s]) {
+            Ok(Number::Fixnum(n)) => usize::try_from(n.get_num()).ok(),
+            Ok(Number::Integer(n)) => n.to_usize(),
+            _ => None,
+        }
+    };
+
+    read_heap_cell!(addr,
+        (HeapCellValueTag::Str, s) => {
+            let (name, arity) = cell_as_atom_cell!(heap[s]).get_name_and_arity();
+
+            if name == atom!("dir_entry") && arity == 1 {
+                extract_integer(s+1)
+            } else {
+                panic!(
+                    "to_local_code_ptr crashed with p.i. {}/{}",
+                    name.as_str(),
+                    arity,
+                );
+            }
+        }
+        _ => {
+            None
+        }
+    )
 }