use scryer-modular-bitfield on github, version bump

Iron-out edge cases for library use-case, adding extensive real-world test assertions

.git-blame-ignore-revs

@@ -0,0 +1,2 @@
+# Resolved all lints and formatted the codebase
+9444e62df9820d6bfd96dbd8849e177bc5cecc2e

.github/actions/setup-rust/action.yml

@@ -0,0 +1,52 @@
+name: 'Setup Rust'
+inputs:
+  rust-version:
+    required: true
+    type: string
+  targets:
+    required: true
+    type: string
+  components:
+    required: false
+    default:
+  cache-context:
+    required: true
+    type: string
+
+runs:
+  using: "composite"
+  steps:
+  - uses: dtolnay/rust-toolchain@master
+    id: toolchain
+    with:
+      toolchain: ${{ inputs.rust-version }}
+      targets: ${{ inputs.targets }}
+      components: ${{ inputs.components }}
+
+  - name: Install i686 dependencies
+    if: "contains(inputs.targets,'i686')"
+    shell: bash
+    run: |
+      sudo dpkg --add-architecture i386
+      sudo apt-get update
+      sudo apt-get install libssl-dev:i386 gcc-multilib clang -y
+      echo "CC=clang" >> $GITHUB_ENV
+      echo "PKG_CONFIG_SYSROOT_DIR=/" >> $GITHUB_ENV
+
+  - uses: actions/cache@v3
+    with:
+      path: |
+        ~/.cargo/bin/
+        ~/.cargo/registry/index/
+        ~/.cargo/registry/cache/
+        ~/.cargo/git/db/
+        target/
+      key: ${{ inputs.cache-context }}_${{ inputs.targets }}_rustc-${{ steps.toolchain.outputs.cachekey }}_cargo-${{ hashFiles('**/Cargo.lock') }}
+
+  # Remove build artifacts for the current crate, since it will be rebuilt every
+  # run anyway, but keep dependency artifacts to cache them.
+  # Must be placed after actions/cache so its post step runs first.
+  - uses: pyTooling/Actions/with-post-step@v0.4.6
+    with:
+      main: bash ./.github/actions/setup-rust/cleanup.sh
+      post: bash ./.github/actions/setup-rust/cleanup.sh

.github/actions/setup-rust/cleanup.sh

@@ -0,0 +1,13 @@
+#!/usr/bin/env bash
+set -e
+
+echo Cleanup workspace build artifacts and extra target output
+
+# clean just the direct members of the current workspace, use cargo metadata to generalize to all rust projects
+cargo clean -p `cargo metadata --no-deps --offline --format-version 1 | jq -r '[.workspace_members[]|split(" ")|.[0]]|join(" ")'`
+
+# remove directories in /target/ that are not named `debug` or `release`
+before=`du -s target | awk '{print $1}'`
+find ./target -maxdepth 1 -type d ! -name debug ! -name release ! -name target -exec rm -r {} \;
+after=`du -s target | awk '{print $1}'`
+echo Deleted $(($before - $after)) bytes from target directory

.github/workflows/ci.yml

@@ -0,0 +1,202 @@
+name: CI
+
+on:
+  push:
+    branches: [master]
+    tags:
+      - "v**"
+  pull_request:
+  schedule:
+    - cron: '0 0 * * 3' # At 12:00 AM, only on Wednesday
+  workflow_dispatch:
+
+permissions:
+  checks: write
+
+jobs:
+  style:
+    runs-on: ubuntu-22.04
+    steps:
+      - uses: actions/checkout@v3
+      - name: Setup Rust
+        uses: ./.github/actions/setup-rust
+        with:
+          rust-version: stable
+          targets: x86_64-unknown-linux-gnu
+          components: clippy, rustfmt
+          cache-context: style
+
+      - name: Check formatting
+        run: cargo fmt --check
+      - name: Check clippy
+        run: cargo clippy --no-deps --all-targets
+
+  build-test:
+    runs-on: ${{ matrix.os }}
+    strategy:
+      fail-fast: false
+      matrix:
+        include:
+          # operating systems
+          - { os: windows-latest, rust-version: stable,  target: 'x86_64-pc-windows-msvc',   publish: true }
+          - { os: macos-11,       rust-version: stable,  target: 'x86_64-apple-darwin',      publish: true }
+          - { os: ubuntu-20.04,   rust-version: stable,  target: 'x86_64-unknown-linux-gnu', publish: true }
+          # architectures
+          - { os: ubuntu-22.04,   rust-version: stable,  target: 'x86_64-unknown-linux-gnu', publish: true }
+          - { os: ubuntu-22.04,   rust-version: stable,  target: 'i686-unknown-linux-gnu',   publish: true }
+          # FIXME(issue #2138): run wasm tests, failing to run since https://github.com/mthom/scryer-prolog/pull/2137 removed wasm-pack
+          - { os: ubuntu-22.04,   rust-version: nightly, target: 'wasm32-unknown-unknown',   publish: true, args: '--no-default-features' , test-args: '--no-run --no-default-features' }
+          # rust versions
+          - { os: ubuntu-22.04,   rust-version: "1.70",  target: 'x86_64-unknown-linux-gnu'}
+          - { os: ubuntu-22.04,   rust-version: beta,    target: 'x86_64-unknown-linux-gnu'}
+          - { os: ubuntu-22.04,   rust-version: nightly, target: 'x86_64-unknown-linux-gnu'}
+    defaults:
+      run:
+        shell: bash
+    steps:
+      - uses: actions/checkout@v3
+      - name: Setup Rust
+        uses: ./.github/actions/setup-rust
+        with:
+          rust-version: ${{ matrix.rust-version }}
+          targets: ${{ matrix.target }}
+          cache-context: ${{ matrix.os }}
+
+      # Build and test.
+      - name: Build library
+        run: cargo build --all-targets --target ${{ matrix.target }} ${{ matrix.args }} --verbose
+      - name: Test
+        run: cargo test --target ${{ matrix.target }} ${{ matrix.test-args }} --all
+
+      # On stable rust builds, build a binary and publish as a github actions
+      # artifact. These binaries could be useful for testing the pipeline but
+      # are only retained by github for 90 days.
+      - name: Build release binary
+        if: matrix.publish
+        run: |
+          cargo rustc --target ${{ matrix.target }} ${{ matrix.args }} --verbose --bin scryer-prolog --release
+          echo "$PWD/target/release" >> $GITHUB_PATH
+      - name: Publish release binary artifact
+        if: matrix.publish
+        uses: actions/upload-artifact@v3
+        with:
+          path: target/${{ matrix.target }}/release/scryer-prolog*
+          name: scryer-prolog_${{ matrix.os }}_${{ matrix.target }}
+
+  logtalk-test:
+    # if: false # uncomment to disable job
+    runs-on: ubuntu-20.04
+    needs: [build-test]
+    steps:
+      # Download prebuilt ubuntu binary from build-test job, setup logtalk
+      - uses: actions/download-artifact@v3
+        with:
+          name: scryer-prolog_ubuntu-20.04_x86_64-unknown-linux-gnu
+      - run: |
+          chmod +x scryer-prolog
+          echo "$PWD" >> "$GITHUB_PATH"
+      - name: Install Logtalk
+        uses: logtalk-actions/setup-logtalk@master
+        with:
+          logtalk-version: "3.70.0"
+          logtalk-tool-dependencies: false
+
+      # Run logtalk  tests.
+      - name: Run Logtalk's prolog compliance test suite
+        working-directory: ${{ env.LOGTALKUSER }}/tests/prolog/
+        run: |
+          pwd
+          scryerlgt -g '{ack(tester)},halt.'
+          logtalk_tester -p scryer -g "set_logtalk_flag(clean,off)" -w -t 360 \
+            -f xunit \
+            -s "$LOGTALKUSER/tests/prolog" \
+            || echo "::warning ::logtalk compliance suite failed"
+            # -u "https://github.com/LogtalkDotOrg/logtalk3/tree/$LOGTALK_GIT_HASH/tests/prolog/" \
+      - name: Publish Logtalk test logs
+        uses: actions/upload-artifact@v3
+        with:
+          name: logtalk-test-logs
+          path: '${{ env.LOGTALKUSER }}/tests/prolog/logtalk_tester_logs'
+      - name: Publish Logtalk test results artifact
+        uses: actions/upload-artifact@v3
+        with:
+          name: logtalk-test-results
+          path: '${{ env.LOGTALKUSER }}/tests/prolog/**/*.xml'
+      - name: Publish Logtalk test summary
+        uses: EnricoMi/publish-unit-test-result-action/composite@master
+        with:
+          check_name: Logtalk test summary
+          files: '${{ env.LOGTALKUSER }}/tests/prolog/**/*.xml'
+          fail_on: nothing
+          comment_mode: off
+
+  report:
+    runs-on: ubuntu-22.04
+    steps:
+      - uses: actions/checkout@v3
+      - name: Setup Rust
+        uses: ./.github/actions/setup-rust
+        with:
+          rust-version: stable
+          targets: x86_64-unknown-linux-gnu
+          cache-context: report
+      - run: |
+          cargo install cargo2junit --force
+          # cargo install iai-callgrind-runner --force --version `cargo metadata --format-version 1 | jq -r '.resolve.nodes[].id|split(" ")|select(.[0]=="iai-callgrind")|.[1]'`
+          cargo install iai-callgrind-runner --force --git https://github.com/iai-callgrind/iai-callgrind --rev c77bc3c83d7f4e976cc42d4597236a8db259e772
+          sudo apt install valgrind -y
+
+      - name: Test and report
+        run: |
+          RUSTC_BOOTSTRAP=1 cargo test --all -- -Z unstable-options --format json --report-time | cargo2junit > cargo_test_results.xml
+      - name: Publish cargo test results artifact
+        uses: actions/upload-artifact@v3
+        with:
+          name: cargo-test-results
+          path: cargo_test_results.xml
+      - name: Publish cargo test summary
+        uses: EnricoMi/publish-unit-test-result-action/composite@master
+        with:
+          check_name: Cargo test summary
+          files: cargo_test_results.xml
+          fail_on: nothing
+          comment_mode: off
+
+      - run: cargo build --all-targets --release
+      - run: cargo test --bench setup --release
+      - run: cargo bench --bench run_iai -- --save-summary=json
+      - run: cargo bench --bench run_criterion
+      - run: cargo bench --bench run_criterion -- --profile-time 60
+
+      - name: Publish benchmark results
+        uses: actions/upload-artifact@v3
+        with:
+          name: benchmark-results
+          path: |
+            target/criterion/*
+            target/iai/*
+            target/benchmark_inference_counts.json
+
+  # Publish binaries when building for a tag
+  release:
+    runs-on: ubuntu-20.04
+    needs: [build-test]
+    if: startsWith(github.ref, 'refs/tags/v')
+    steps:
+      - uses: actions/download-artifact@v3
+      - name: Zip binaries for release
+        run: |
+          zip scryer-prolog_macos-11.zip ./scryer-prolog_macos-11_x86_64-apple-darwin/scryer-prolog
+          zip scryer-prolog_ubuntu-20.04.zip ./scryer-prolog_ubuntu-20.04_x86_64-unknown-linux-gnu/scryer-prolog
+          zip scryer-prolog_ubuntu-22.04.zip ./scryer-prolog_ubuntu-22.04_x86_64-unknown-linux-gnu/scryer-prolog
+          zip scryer-prolog_windows-latest.zip ./scryer-prolog_windows-latest_x86_64-pc-windows-msvc/scryer-prolog.exe
+          zip scryer-prolog_wasm32.zip ./scryer-prolog_ubuntu-22.04_wasm32-unknown-unknown/scryer-prolog.wasm
+      - name: Release
+        uses: softprops/action-gh-release@v1
+        with:
+          files: |
+            scryer-prolog_macos-11.zip
+            scryer-prolog_ubuntu-20.04.zip
+            scryer-prolog_ubuntu-22.04.zip
+            scryer-prolog_windows-latest.zip
+            scryer-prolog_wasm32.zip

.github/workflows/docker-publish.yml

@@ -2,10 +2,10 @@ name: Docker Publish
 
 on:
   push:
-    tags: [ 'v*.*.*' ]
+    branches: 
-
+      - 'master'
-env:
+    tags: 
-  IMAGE_NAME: mjt128/scryer-prolog
+      - 'v*.*.*'
 
 jobs:
   build:
@@ -18,33 +18,36 @@ jobs:
 
       # Workaround: https://github.com/docker/build-push-action/issues/461
       - name: Setup Docker buildx
-        uses: docker/setup-buildx-action@79abd3f86f79a9d68a23c75a09a9a85889262adf
+        # https://github.com/docker/setup-buildx-action
+        uses: docker/setup-buildx-action@v2.2.1
 
       # Login against Docker registry
-      # https://github.com/docker/login-action
       - name: Log into registry
-        uses: docker/login-action@28218f9b04b4f3f62068d7b6ce6ca5b26e35336c
+        # https://github.com/docker/login-action
+        uses: docker/login-action@v2.1.0
         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
+      # Docker image tag "0.19.1". The "latest" tag reflects the most recent build on
-      # version.
+      # master.
-      # https://github.com/docker/metadata-action
       - name: Extract Docker metadata
         id: meta
-        uses: docker/metadata-action@98669ae865ea3cffbcbaa878cf57c20bbf1c6c38
+        # https://github.com/docker/metadata-action
+        uses: docker/metadata-action@v4.1.1
         with:
-          images: docker.io/${{ env.IMAGE_NAME }}
+          images: docker.io/${{ secrets.DOCKERHUB_USERNAME }}/scryer-prolog
           tags: |
             type=semver,pattern={{version}}
+            type=raw,value=latest,enable={{is_default_branch}}
+            # type=raw,value=latest,enable=${{ github.ref == format('refs/heads/{0}', 'master') }}
 
       # 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
+        # https://github.com/docker/build-push-action
+        uses: docker/build-push-action@v3.2.0
         with:
           context: .
           push: true

.github/workflows/test.yml

@@ -1,71 +0,0 @@
-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

Cargo.toml

@@ -1,6 +1,6 @@
 [package]
 name = "scryer-prolog"
-version = "0.9.1"
+version = "0.9.4"
 authors = ["Mark Thom <markjordanthom@gmail.com>"]
 edition = "2021"
 description = "A modern Prolog implementation written mostly in Rust."
@@ -10,10 +10,20 @@ license = "BSD-3-Clause"
 keywords = ["prolog", "prolog-interpreter", "prolog-system"]
 categories = ["command-line-utilities"]
 build = "build/main.rs"
-rust-version = "1.61"
+rust-version = "1.70"
+
+[lib]
+crate-type = ["cdylib", "rlib"]
 
 [features]
-default = ["rug"]
+default = ["ffi", "repl", "hostname", "tls", "http", "crypto-full"]
+ffi = ["dep:libffi"]
+repl = ["dep:crossterm", "dep:ctrlc", "dep:rustyline"]
+hostname = ["dep:hostname"]
+tls = ["dep:native-tls"]
+http = ["dep:warp", "dep:reqwest"]
+rust_beta_channel = []
+crypto-full = []
 
 [build-dependencies]
 indexmap = "1.0.2"
@@ -21,56 +31,111 @@ 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'] }
+syn = { version = "2.0.32", features = ['full', 'visit', 'extra-traits'] }
-to-syn-value = "0.1.0"
+to-syn-value = "0.1.1"
-to-syn-value_derive = "0.1.0"
+to-syn-value_derive = "0.1.1"
 walkdir = "2"
 
 [dependencies]
+base64 = "0.12.3"
+bit-set = "0.5.3"
+bitvec = "1"
+blake2 = "0.8.1"
+bytes = "1"
+chrono = "0.4.11"
 cpu-time = "1.0.0"
-crossterm = "0.20.0"
+crrl = "0.6.0"
+dashu = "0.4.0"
+derive_deref = "1.1.1"
 dirs-next = "2.0.0"
 divrem = "0.1.0"
+futures = "0.3"
 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"
-modular-bitfield = "0.11.2"
+libloading = "0.7"
-ctrlc = "3.2.2"
+scryer-modular-bitfield = "0.11.4"
+num-order = { version = "1.2.0" }
 ordered-float = "2.6.0"
-phf = { version = "0.9",  features = ["macros"] }
+phf = { version = "0.9", features = ["macros"] }
+rand = "0.8.5"
 ref_thread_local = "0.0.0"
-rug = { version = "1.15.0", optional = true }
+regex = "1.9.1"
-rustyline = "9.0.0"
+ring = { version = "0.17.5", features = ["wasm32_unknown_unknown_js"] }
-ring = "0.16.13"
 ripemd160 = "0.8.0"
-sha3 = "0.8.2"
-blake2 = "0.8.1"
-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"] }
+select = "0.6.0"
-hyper-tls = "0.5.0"
+sha3 = "0.8.2"
-tokio = { version = "1", features = ["full"] }
+smallvec = "1.8.0"
-futures = "0.3"
+static_assertions = "1.1.0"
+
+serde_json = "1.0.95"
+serde = "1.0.159"
+
+[target.'cfg(not(target_arch = "wasm32"))'.dependencies]
+crossterm = { version = "0.20.0", optional = true }
+ctrlc = { version = "3.2.2", optional = true }
+hostname = { version = "0.3.1", optional = true }
+libffi = { version = "3.2.0", optional = true }
+native-tls = { version = "0.2.4", optional = true }
+reqwest = { version = "0.11.18", optional = true }
+rustyline = { version = "12.0.0", optional = true }
+tokio = { version = "1.28.2", features = ["full"] }
+warp = { version = "=0.3.5", features = ["tls"], optional = true }
+
+[target.'cfg(target_arch = "wasm32")'.dependencies]
+getrandom = { version = "0.2.10", features = ["js"] }
+tokio = { version = "1.28.2", features = [
+    "sync",
+    "macros",
+    "io-util",
+    "rt",
+    "time",
+] }
+
+[target.'cfg(all(target_arch = "wasm32", target_os = "unknown"))'.dependencies]
+console_error_panic_hook = "0.1"
+wasm-bindgen = "0.2.87"
+wasm-bindgen-futures = "0.4"
+serde-wasm-bindgen = "0.5"
+web-sys = { version = "0.3", features = [
+    "Document",
+    "Window",
+    "Element",
+    "Performance",
+] }
+js-sys = "0.3"
 
 [dev-dependencies]
-assert_cmd = "1.0.3"
+maplit = "1.0.2"
 predicates-core = "1.0.2"
-serial_test = "0.5.1"
+serial_test = "2.0.0"
 
-[patch.crates-io]
+[target.'cfg(not(all(target_arch = "wasm32", target_os = "unknown")))'.dev-dependencies]
-modular-bitfield = { git = "https://github.com/mthom/modular-bitfield" }
+assert_cmd = "1.0.3"
+criterion = "0.5.1"
+iai-callgrind = "0.9.0"
+trycmd = "0.14.19"
+
+[target.'cfg(not(any(target_os = "windows", all(target_arch = "wasm32", target_os = "unknown"))))'.dev-dependencies]
+pprof = { version = "0.13.0", features = ["criterion", "flamegraph"] }
+
+[profile.bench]
+lto = true
+opt-level = 3
 
 [profile.release]
-debug = true
+lto = true
+opt-level = 3
+
+[[bench]]
+name = "run_criterion"
+harness = false
+
+[[bench]]
+name = "run_iai"
+harness = false

Dockerfile

@@ -1,5 +1,5 @@
 # See https://github.com/LukeMathWalker/cargo-chef
-ARG RUST_VERSION=1.60-buster
+ARG RUST_VERSION=1-buster
 FROM rust:${RUST_VERSION} as planner
 WORKDIR /scryer-prolog
 RUN cargo install cargo-chef 
@@ -20,7 +20,12 @@ 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
+# Newer versions of Debian (i.e. bookworm) contain libssl3 instead of libssl1.1 
+# which we depend on.
+FROM debian:bullseye-slim
 COPY --from=builder /scryer-prolog/target/release/scryer-prolog /usr/local/bin
 ENV RUST_BACKTRACE=1
+# Sanity check the binary: if it can't be executed (e.g. if there are missing libraries) 
+# then fail the build
+RUN scryer-prolog --version
 ENTRYPOINT ["/usr/local/bin/scryer-prolog"]

INDEX.dj

@@ -0,0 +1,77 @@
+# Scryer Prolog
+
+```
+?- append("Hello, ", X, "Hello, Scryer Prolog!").
+   X = "Scryer Prolog!".
+```
+
+![scryer](scryer.png){width=128 style=float:right;} [Scryer Prolog](https://github.com/mthom/scryer-prolog) is a free software ISO Prolog system intended to be an industrial
+strength production environment *and* a testbed for bleeding edge research in
+logic and constraint programming.
+
+Some of the Scryer Prolog features are:
+
+* ISO standard compliant
+* Integrated constraint programming libraries: [clp(B)](/clpb.html), [clp(Z)](/clpz.html).
+* [Definite Clause Grammars](/dcgs.html)
+* Coroutining support ([`dif/2`](/dif.html), [`freeze/2`](/freeze.html), ...)
+* [Tabling and SLG resolution](/tabling.html)
+* Compact string representation
+* Network libraries ([TCP sockets](/sockets.html), [HTTP server](/http/http_server.html), [HTTP client](/http/http_open.html), ...)
+* [Cryptographical predicates](/crypto.html)
+* [Foreign Function Interface](/ffi.html)
+* WebAssembly support
+* Usable as a library
+* WAM based engine, cross-platform made in Rust
+* _and more..._
+
+Try Scryer Prolog without any installation! Use [Scryer Playground](https://play.scryer.pl), which uses the WASM version of Scryer Prolog.
+
+## What is Prolog?
+
+Prolog is a logic programming language created by [Alain Colmerauer](https://en.wikipedia.org/wiki/Alain_Colmerauer) and [Robert Kowalski](https://en.wikipedia.org/wiki/Robert_Kowalski) in 1972.
+The idea behind Prolog is try to express a task in language similar to First Order Logic.
+Prolog systems include _unification_ and _non-determinism_ as key concepts upon which we build programs.
+
+A Prolog program is made up of predicates which define a relation between its arguments. A predicate
+is made from clauses. A clause can be either a fact or a rule. There's also a toplevel, which we
+can use to ask and reason about our task.
+
+It's still to this day one of the best examples and one of the most popular languages in the field
+of logic programming. That's because Prolog allows us to elegantly solve many tasks with short and
+general programs.
+
+If you want a more detailed description of Prolog, check [A Tour of Prolog](https://www.youtube.com/watch?v=8XUutFBbUrg).
+
+If you want to learn more about Prolog history, check the videos [l'Aventure Prolog](https://www.youtube.com/watch?v=74Ig_QKndvE) and [50 years of Prolog and beyond](https://prologyear.logicprogramming.org/videos/PrologDay_Session_1_talk.mp4).
+
+## Where can I learn Prolog?
+
+There are a lot of classical Prolog books. Those books can teach you the basics of Prolog. Some
+examples are: _The Art of Prolog (Shapiro)_, _Programming in Prolog (Clocksin, Mellish)_ and _The Craft
+of Prolog (O'Keefe)_. However, most of them are not updated to _modern_ Prolog.
+We recommend _[The Power of Prolog (Markus Triska)](https://www.metalevel.at/prolog)_ for modern Prolog. For reference about
+the builtin Prolog modules and libraries in Scryer, check the documentation site. It's this!
+
+## Downloads
+
+The latest version of Scryer Prolog is *0.9.3*. And it's already useful for lots of tasks.
+
+| Windows | [Download](https://github.com/mthom/scryer-prolog/releases/download/v0.9.3/scryer-prolog_windows-latest.zip) |
+| macOS (Intel) | [Download](https://github.com/mthom/scryer-prolog/releases/download/v0.9.3/scryer-prolog_macos-11.zip) |
+| Linux | [Download](https://github.com/mthom/scryer-prolog/releases/download/v0.9.3/scryer-prolog_ubuntu-20.04.zip) |
+
+Scryer Prolog can also be compiled from source, instructions are on the [GitHub README](https://github.com/mthom/scryer-prolog). It runs on Linux, macOS and Windows. Other operating systems may work but they're not regularly tested.
+
+If you're in Linux, maybe your distribution already has an Scryer Prolog package.
+
+There's also a [Docker image](https://github.com/mthom/scryer-prolog#docker-install) available.
+
+## Support and discussions
+
+If Scryer Prolog crashes or yields unexpected errors, consider filing
+an [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)
+or visit our #scryer IRC channel on [Libera](https://libera.chat)!

README.md

@@ -6,14 +6,20 @@ source industrial strength production environment that is also a
 testbed for bleeding edge research in logic and constraint
 programming, which is itself written in a high-level language.
 
+**Scryer Prolog passes all tests** of
+[syntactic conformity](https://www.complang.tuwien.ac.at/ulrich/iso-prolog/conformity_testing),
+[`variable_names/1`](https://www.complang.tuwien.ac.at/ulrich/iso-prolog/variable_names) and
+[`dif/2`](https://www.complang.tuwien.ac.at/ulrich/iso-prolog/dif).
+
+The homepage of the project is: [**https://www.scryer.pl**](https://www.scryer.pl)
+
 ![Scryer Logo: Cryer](logo/scryer.png)
 
 ## Phase 1
 
 Produce an implementation of the Warren Abstract Machine in Rust, done
 according to the progression of languages in [Warren's Abstract
-Machine: A Tutorial
+Machine: A Tutorial Reconstruction](https://github.com/mthom/scryer-prolog/blob/master/wambook/wambook.pdf).
-Reconstruction](http://wambook.sourceforge.net/wambook.pdf).
 
 Phase 1 has been completed in that Scryer Prolog implements in some form
 all of the WAM book, including lists, cuts, Debray allocation, first
@@ -44,7 +50,7 @@ Extend Scryer Prolog to include the following, among other features:
   - [x] Support for `attribute_goals/2` and `project_attributes/2`
   - [x] `call_residue_vars/2`
 - [x] `if_/3` and related predicates, following the developments of the
-      paper "Indexing `dif/2`".
+      paper "[Indexing `dif/2`](https://arxiv.org/abs/1607.01590)".
 - [x] All-solutions predicates (`findall/{3,4}`, `bagof/3`, `setof/3`, `forall/2`).
 - [x] Clause creation and destruction (`asserta/1`, `assertz/1`,
       `retract/1`, `abolish/1`) with logical update semantics.
@@ -52,24 +58,24 @@ Extend Scryer Prolog to include the following, among other features:
       `bb_put/2` (non-backtrackable) and `bb_b_put/2`
       (backtrackable).
 - [x] Delimited continuations based on reset/3, shift/1 (documented in
-      "Delimited Continuations for Prolog").
+      "[Delimited Continuations for Prolog](https://biblio.ugent.be/publication/5646080/file/5646081)").
 - [x] Tabling library based on delimited continuations
-      (documented in "Tabling as a Library with Delimited Control").
+      (documented in "[Tabling as a Library with Delimited Control](https://biblio.ugent.be/publication/6880648/file/6885145.pdf)").
 - [x] A _redone_ representation of strings as difference lists of
       characters, using a packed internal representation.
 - [x] clp(B) and clp(ℤ) as builtin libraries.
 - [x] Streams and predicates for stream control.
-  - [x] A simple sockets library representing TCP connections as streams.  
+  - [x] A simple sockets library representing TCP connections as streams.
 - [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.
+  - [x] 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_)
+      "[Precise Garbage Collection in Prolog](https://www.complang.tuwien.ac.at/ulrich/papers/PDF/2008-ciclops.pdf)." (_in progress_)
 - [ ] Mode declarations.
 
 ## Phase 3
@@ -88,12 +94,12 @@ nice to have in the future. They'd make a good project for anyone wanting
 to contribute code to Scryer Prolog.
 
 1. Implement the global analysis techniques described in Peter van
-Roy's thesis, "Can Logic Programming Execute as Fast as Imperative
+Roy's thesis, "[Can Logic Programming Execute as Fast as Imperative
-Programming?"
+Programming?](https://www.info.ucl.ac.be/~pvr/Peter.thesis/Peter.thesis.html)"
 
 2. Add unum representation and arithmetic, using either an existing
 unum implementation or an ad hoc one. Unums are described in
-Gustafson's book "The End of Error."
+Gustafson's book "[The End of Error](http://www.johngustafson.net/unums.html)."
 
 3. Add concurrent tables to manage shared references to atoms and
 strings.
@@ -102,7 +108,14 @@ strings.
 
 ## Installing Scryer Prolog
 
-### Native Install
+### Binaries
+
+Precompiled binaries for several platforms are available for download
+at:
+
+**https://github.com/mthom/scryer-prolog/releases/tag/v0.9.3**
+
+### Native Compilation
 
 First, install the latest stable version of
 [Rust](https://www.rust-lang.org/en-US/install.html) using your
@@ -114,19 +127,23 @@ distribution should be uninstalled from your system before rustup is
 used.
 
 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:
+clone directly from this git repository, and compile the system. This
+can be done as follows:
 
 ```
 $> git clone https://github.com/mthom/scryer-prolog
 $> cd scryer-prolog
-$> cargo run [--release]
+$> cargo build --release
 ```
 
-The optional `--release` flag will perform various optimizations,
+The `--release` flag performs various optimizations, producing a
-producing a faster executable.
+faster executable.
+
+After compilation, the executable `scryer-prolog` is available in the
+directory `target/release` and can be invoked to run the system.
 
 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, 
+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:
@@ -136,7 +153,78 @@ 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**.
+Scryer Prolog must be built with **Rust 1.70 and up**.
+
+### Building WebAssembly
+
+Scryer Prolog has basic WebAssembly support. You can follow `wasm-pack`'s [official instructions](https://rustwasm.github.io/docs/wasm-pack/quickstart.html) to install `wasm-pack` and build it in any way you like.
+
+However, none of the [default features](https://doc.rust-lang.org/cargo/reference/features.html#the-default-feature) are currently supported. The preferred way of disabling them is passing [extra options](https://rustwasm.github.io/wasm-pack/book/commands/build.html#extra-options) to `wasm-pack`.
+
+For example, if you want a minimal working package without using any bundler like `webpack`, you can do this:
+```
+wasm-pack build --target web -- --no-default-features
+```
+Then a `pkg` directory will be created, containing everything you need for a webapp. You can test whether the package is successfully built by creating an html file, adapted from `wasm-bindgen`'s [official example](https://rustwasm.github.io/wasm-bindgen/examples/without-a-bundler.html) like this:
+
+```html
+<!DOCTYPE html>
+<html>
+    <head>
+        <meta charset="UTF-8" />
+        <title>Scryer Prolog - Sudoku Solver Example</title>
+        <script type="module">
+        import init, { eval_code } from './pkg/scryer_prolog.js';
+
+        const run = async () => {
+            await init("./pkg/scryer_prolog_bg.wasm");
+            let code = `
+            :- use_module(library(format)).
+            :- use_module(library(clpz)).
+            :- use_module(library(lists)).
+            
+            sudoku(Rows) :-
+            length(Rows, 9), maplist(same_length(Rows), Rows),
+            append(Rows, Vs), Vs ins 1..9,
+            maplist(all_distinct, Rows),
+            transpose(Rows, Columns),
+            maplist(all_distinct, Columns),
+            Rows = [As,Bs,Cs,Ds,Es,Fs,Gs,Hs,Is],
+            blocks(As, Bs, Cs),
+            blocks(Ds, Es, Fs),
+            blocks(Gs, Hs, Is).
+            
+            blocks([], [], []).
+            blocks([N1,N2,N3|Ns1], [N4,N5,N6|Ns2], [N7,N8,N9|Ns3]) :-
+            all_distinct([N1,N2,N3,N4,N5,N6,N7,N8,N9]),
+            blocks(Ns1, Ns2, Ns3).
+            
+            problem(1, [[_,_,_,_,_,_,_,_,_],
+                        [_,_,_,_,_,3,_,8,5],
+                        [_,_,1,_,2,_,_,_,_],
+                        [_,_,_,5,_,7,_,_,_],
+                        [_,_,4,_,_,_,1,_,_],
+                        [_,9,_,_,_,_,_,_,_],
+                        [5,_,_,_,_,_,_,7,3],
+                        [_,_,2,_,1,_,_,_,_],
+                        [_,_,_,_,4,_,_,_,9]]).
+            
+            main :-
+            problem(1, Rows), sudoku(Rows), maplist(portray_clause, Rows).
+            
+            :- initialization(main).
+            `;
+            const result = eval_code(code);
+            document.write(`<p>Sudoku solver returns:</p><pre>${result}</pre>`);
+        }
+        run();
+        </script>    
+    </head>
+    <body></body>
+</html>
+```
+
+Then you can serve it with your favorite http server like `python -m http.server` or `npx serve`, and access the page with your browser.
 
 ### Docker Install
 
@@ -228,6 +316,35 @@ To quit Scryer Prolog, use the standard predicate `halt/0`:
 ?- halt.
 ```
 
+### Starting Scryer Prolog
+
+Scryer Prolog can be started from the command line by specifying
+options, files and additional arguments. All components are optional:
+
+<pre>
+scryer-prolog [OPTIONS] [FILES] [-- ARGUMENTS]
+</pre>
+
+The supported options are:
+
+```
+   -h, --help             Display help message
+   -v, --version          Print version information and exit
+   -g, --goal GOAL        Run the query GOAL after consulting files
+   -f                     Fast startup. Do not load initialization file (~/.scryerrc)
+   --no-add-history       Prevent adding input to history file (~/.scryer_history)
+```
+
+All specified Prolog files are consulted.
+
+After Prolog files, application-specific arguments can be specified on
+the command line. These arguments can be accessed from within Prolog
+applications with the predicate&nbsp;`argv/1`, which yields the list
+of arguments represented as strings.
+
+Prolog files can also be turned into *shell&nbsp;scripts* as explained in
+https://github.com/mthom/scryer-prolog/issues/2170#issuecomment-1821713993.
+
 ### Dynamic operators
 
 Scryer supports dynamic operators. Using the built-in
@@ -278,14 +395,14 @@ innovations of Scryer Prolog. This means that terms which appear as
 lists of characters to Prolog programs are stored in packed
 UTF-8&nbsp;encoding by the engine.
 
-Without this innovation, storing a list of characters in memory
+Without this innovation, storing a list of characters in memory would
-would use one memory&nbsp;cell per character, one memory&nbsp;cell per
+use one WAM memory&nbsp;cell per character, one cell per list
-list constructor, and one memory&nbsp;cell for each tail that occurs
+constructor, and one cell for each tail that occurs in the list. Since
-in the list. Since one memory&nbsp;cell takes 8&nbsp;bytes on 64-bit
+one cell takes 8&nbsp;bytes in the WAM as implemented by
-machines, the packed representation used by Scryer&nbsp;Prolog yields
+Scryer&nbsp;Prolog, the packed representation yields an up&nbsp;to
-an up&nbsp;to **24-fold&nbsp;reduction** of memory usage, and
+**24-fold&nbsp;reduction** of memory usage, and corresponding
-corresponding reduction of memory&nbsp;accesses when creating and
+reduction of memory&nbsp;accesses when creating and processing
-processing strings.
+strings.
 
 Scryer Prolog's compact internal string representation makes it
 ideally suited for the use case Prolog was originally developed for:
@@ -539,7 +656,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.
+* [`http/http_server`](src/lib/http/http_server.pl) Runs a HTTP/1.1 and HTTP/2.0 web server. Uses [Warp](https://github.com/seanmonstar/warp) 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
@@ -673,10 +790,33 @@ not need additional tools and formalisms for its application, and
 further, it encourages declarative reasoning that can in principle
 also be performed automatically.
 
+## Applications
+
+Scryer Prolog's strong commitment to the Prolog ISO standard makes it
+ideally suited for use in corporations and government&nbsp;agencies
+that are subject to strict regulations pertaining to interoperability,
+standards&nbsp;compliance and warranty.
+
+Successful existing applications of Scryer Prolog include the
+[DocLog](https://github.com/aarroyoc/doclog)&nbsp;system which
+generates Scryer's own documentation and homepage, [Symbolic
+Analysis of Grants](https://www.brz.gv.at/en/BRZ-Tech-Blog/Tech-Blog-7-Symbolic-Analysis-of-Grants.html)
+by the Austrian Federal Computing Center, and parts of the
+[precautionary](https://github.com/dcnorris/precautionary/tree/main/exec/prolog)
+package for the analysis of dose-escalation trials in the
+safety-critical and highly regulated domain of oncology
+trial&nbsp;design, described in [*An Executable Specification of
+Oncology Dose-Escalation Protocols with&nbsp;Prolog*](https://arxiv.org/abs/2402.08334).
+
+Scryer Prolog is also very well suited for teaching and learning
+Prolog, and for testing syntactic conformance and hence portability of
+existing Prolog&nbsp;programs.
+
 ## 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)!
+[discussions](https://github.com/mthom/scryer-prolog/discussions)
+or visit our #scryer IRC channel on [Libera](https://libera.chat)!

benches/README.md

@@ -0,0 +1,95 @@
+# About benches
+
+The `benches` directory contains benchmarks that test scryer-prolog performance.
+
+Benchmarks are run via two harnesses:
+
+* `criterion` - criterion performs statistical analysis of benchmark runs and is
+  great for benchmarking locally.
+* `iai-callgrind` - this runs the benchmark with callgrind, which is able to
+  precisely track the number of instructions executed during the run. This is
+  especially helpful in a public CI runner context where neighboring VMs can
+  cause a very high wall time variance. While instructions executed is only
+  correlated with the desired metric (wall time), this is a good tradeoff for CI
+  where that metric is unreliable.
+
+Run benchmarks with the following commands:
+
+```
+cargo bench --bench run_criterion
+
+# run a particular criterion benchmark
+cargo bench --bench run_criterion -- <benchmark_name>
+
+# run in profiling mode which outputs flamegraphs. Set profile time in seconds:
+cargo bench --bench run_criterion -- --profile-time <time>
+
+# to run iai, you need valgrind installed and to install iai-callgrind-runner
+# at the same version as is in Cargo.toml:
+cargo install iai-callgrind-runner --version 0.7.3
+
+cargo bench --bench run_iai
+```
+
+For consistency, both runners -- `run_iai.rs` and `run_criterion.rs` -- import
+the same setup code from `setup.rs`.
+
+## Setup
+
+`setup.rs` contains the setup code to run benchmarks. `fn prolog_benches()` at
+the top of the file is where the benchmarks are defined.
+
+Benchmarks are organized around running queries against a prolog module file.
+Before a benchmark starts, `benchmark.setup()` is called which reads the module
+file and initializes a new `scryer_prolog::machine::Machine`.
+
+Each benchmark measurement is done by running a query against the machine. In
+the case of criterion each query is run many times, in the case of iai it's run
+once.
+
+## Adding benchmarks
+
+This design is meant to suppoort defining lots of benchmarks.
+
+To add a new benchmark:
+
+* Add a new file `benches/[module].pl` that contains setup prolog code. Import
+  libraries, define predicates, etc.
+* Add a new section in `setup.rs::prolog_benchmarks()` that refers to to the
+  file and write a query to be benchmarked.
+* If the query mutates the machine, then use `Strategy::Fresh` so the criterion
+  benchmark will recreate a new machine for each benchmark run, otherwise use
+  `Strategy::Reuse` which has lower overhead. (This is not used by the iai
+  benchmark because it only runs once anyway.)
+
+Some tips:
+
+* The goal of benchmarking is to know if a library or engine change improved
+  performance or not.
+* Once a benchmark is defined and named, avoid changing it's definition. If a
+  benchmark needs to change to be more useful, give the new definition a new
+  name instead. This will prevent charts from showing wild changes in
+  performance just because the definition changed (see previous).
+* Aim for queries to execute in less than 0.5s realtime. Longer runtimes make it
+  easier for humans to see big differences, but benchmarks either run 10x slower
+  (iai) or execute repeatedly to attain statistical significance (criterion) and
+  in both cases benchmarking queries that take longer than about 0.5s are
+  cumbersome to run.
+* Consider that the library runtime actually parses the text output of the top
+  level. So don't use custom outputs or it will fail to parse. Also keep the
+  output small so it doesn't just benchmark the ouput parsing code.
+* DO test the output of the benchmark run, we don't want to count broken
+  benchmarks.
+
+## CI
+
+Both benchmark harnesses are run in `.github/workflows/ci.yaml` in the `report`
+job, and the results are published as build artifacts.
+
+## Todo
+
+- [ ] Currently, the execution time to load a module is not benchmarked. It
+  would be nice to have at least one benchmark for loading a module (probably a
+  big one).
+- [ ] Write a new action that downloads the test and benchmark results
+  artifacts, plots them over time, and publishes a report to github pages.

benches/edges.pl

@@ -0,0 +1,130 @@
+:- use_module(library(clpb)).
+:- use_module(library(assoc)).
+:- use_module(library(lists)).
+:- use_module(library(pairs)).
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    Contiguous United States and DC as they appear in SGB:
+    http://www-cs-faculty.stanford.edu/~uno/sgb.html
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+edge(al, fl).
+edge(al, ga).
+edge(al, ms).
+edge(al, tn).
+edge(ar, la).
+edge(ar, mo).
+edge(ar, ms).
+edge(ar, ok).
+edge(ar, tn).
+edge(ar, tx).
+edge(az, ca).
+edge(az, nm).
+edge(az, nv).
+edge(az, ut).
+edge(ca, nv).
+edge(ca, or).
+edge(co, ks).
+edge(co, ne).
+edge(co, nm).
+edge(co, ok).
+edge(co, ut).
+edge(co, wy).
+edge(ct, ma).
+edge(ct, ny).
+edge(ct, ri).
+edge(dc, md).
+edge(dc, va).
+edge(de, md).
+edge(de, nj).
+edge(de, pa).
+edge(fl, ga).
+edge(ga, nc).
+edge(ga, sc).
+edge(ga, tn).
+edge(ia, il).
+edge(ia, mn).
+edge(ia, mo).
+edge(ia, ne).
+edge(ia, sd).
+edge(ia, wi).
+edge(id, mt).
+edge(id, nv).
+edge(id, or).
+edge(id, ut).
+edge(id, wa).
+edge(id, wy).
+edge(il, in).
+edge(il, ky).
+edge(il, mo).
+edge(il, wi).
+edge(in, ky).
+edge(in, mi).
+edge(in, oh).
+edge(ks, mo).
+edge(ks, ne).
+edge(ks, ok).
+edge(ky, mo).
+edge(ky, oh).
+edge(ky, tn).
+edge(ky, va).
+edge(ky, wv).
+edge(la, ms).
+edge(la, tx).
+edge(ma, nh).
+edge(ma, ny).
+edge(ma, ri).
+edge(ma, vt).
+edge(md, pa).
+edge(md, va).
+edge(md, wv).
+edge(me, nh).
+edge(mi, oh).
+edge(mi, wi).
+edge(mn, nd).
+edge(mn, sd).
+edge(mn, wi).
+edge(mo, ne).
+edge(mo, ok).
+edge(mo, tn).
+edge(ms, tn).
+edge(mt, nd).
+edge(mt, sd).
+edge(mt, wy).
+edge(nc, sc).
+edge(nc, tn).
+edge(nc, va).
+edge(nd, sd).
+edge(ne, sd).
+edge(ne, wy).
+edge(nh, vt).
+edge(nj, ny).
+edge(nj, pa).
+edge(nm, ok).
+edge(nm, tx).
+edge(nv, or).
+edge(nv, ut).
+edge(ny, pa).
+edge(ny, vt).
+edge(oh, pa).
+edge(oh, wv).
+edge(ok, tx).
+edge(or, wa).
+edge(pa, wv).
+edge(sd, wy).
+edge(tn, va).
+edge(ut, wy).
+edge(va, wv).
+
+independent_set(G, *(NBs)) :-
+        findall(U-V, (edge(U, V),G@<U), Edges),
+        setof(U, V^(member(U-V, Edges);member(V-U, Edges)), Nodes),
+        pairs_keys_values(Pairs, Nodes, _),
+        list_to_assoc(Pairs, Assoc),
+        maplist(not_both(Assoc), Edges, NBs).
+
+not_both(Assoc, U-V, ~BU + ~BV) :-
+        get_assoc(U, Assoc, BU),
+        get_assoc(V, Assoc, BV).
+
+independent_set_count(G, Count) :- independent_set(G, Sat), sat_count(Sat, Count).

benches/numlist.pl

@@ -0,0 +1,2 @@
+:- use_module(library(between)).
+run_numlist(Upper, Head) :- numlist(1, Upper, L), L = [Head|_].

benches/run_criterion.rs

@@ -0,0 +1,46 @@
+#[cfg(not(all(target_arch = "wasm32", target_os = "unknown")))]
+use criterion::{criterion_group, criterion_main, BatchSize, Criterion};
+
+#[cfg(not(all(target_arch = "wasm32", target_os = "unknown")))]
+#[cfg(not(target_os = "windows"))]
+use pprof::criterion::{Output, PProfProfiler};
+
+#[cfg(not(all(target_arch = "wasm32", target_os = "unknown")))]
+mod setup;
+
+#[cfg(not(all(target_arch = "wasm32", target_os = "unknown")))]
+fn bench_criterion(c: &mut Criterion) {
+    for (&name, bench) in setup::prolog_benches().iter() {
+        match bench.strategy {
+            setup::Strategy::Fresh => c.bench_function(name, |b| {
+                b.iter_batched(|| bench.setup(), |mut r| r(), BatchSize::LargeInput)
+            }),
+            setup::Strategy::Reuse => c.bench_function(name, |b| b.iter(bench.setup())),
+        };
+    }
+}
+#[cfg(not(all(target_arch = "wasm32", target_os = "unknown")))]
+#[cfg(not(target_os = "windows"))]
+fn config() -> Criterion {
+    Criterion::default()
+        .sample_size(20)
+        .with_profiler(PProfProfiler::new(100, Output::Flamegraph(None)))
+}
+
+#[cfg(target_os = "windows")]
+fn config() -> Criterion {
+    Criterion::default().sample_size(20)
+}
+
+#[cfg(not(all(target_arch = "wasm32", target_os = "unknown")))]
+criterion_group!(
+    name = benches;
+    config = config();
+    targets = bench_criterion
+);
+
+#[cfg(not(all(target_arch = "wasm32", target_os = "unknown")))]
+criterion_main!(benches);
+
+#[cfg(all(target_arch = "wasm32", target_os = "unknown"))]
+fn main() {}

benches/run_iai.rs

@@ -0,0 +1,38 @@
+#[cfg(not(all(target_arch = "wasm32", target_os = "unknown")))]
+mod setup;
+
+#[cfg(not(all(target_arch = "wasm32", target_os = "unknown")))]
+mod iai {
+    use iai_callgrind::{library_benchmark, library_benchmark_group, main};
+
+    use scryer_prolog::machine::parsed_results::QueryResolution;
+
+    use super::setup;
+
+    #[library_benchmark]
+    #[bench::count_edges(setup::prolog_benches()["count_edges"].setup())]
+    #[bench::numlist(setup::prolog_benches()["numlist"].setup())]
+    #[bench::csv_codename(setup::prolog_benches()["csv_codename"].setup())]
+    fn bench(mut run: impl FnMut() -> QueryResolution) -> QueryResolution {
+        run()
+    }
+
+    library_benchmark_group!(
+        name = benches;
+        benchmarks = bench
+    );
+
+    main!(library_benchmark_groups = benches);
+
+    pub fn call_main() {
+        main()
+    }
+}
+
+#[cfg(not(all(target_arch = "wasm32", target_os = "unknown")))]
+fn main() {
+    iai::call_main();
+}
+
+#[cfg(all(target_arch = "wasm32", target_os = "unknown"))]
+fn main() {}

benches/setup.rs

@@ -0,0 +1,133 @@
+use std::{collections::BTreeMap, fs, path::Path};
+
+use maplit::btreemap;
+use scryer_prolog::machine::{
+    parsed_results::{QueryResolution, Value},
+    Machine,
+};
+
+pub fn prolog_benches() -> BTreeMap<&'static str, PrologBenchmark> {
+    [
+        (
+            "count_edges",                       // name of the benchmark
+            "benches/edges.pl", // name of the prolog module file to load. use the same file in multiple benchmarks
+            "independent_set_count(ky, Count).", // query to benchmark in the context of the loaded module. consider making the query adjustable to tune the run time to ~0.1s
+            Strategy::Reuse,
+            btreemap! { "Count" => Value::try_from("2869176".to_string()).unwrap() },
+        ),
+        (
+            "numlist",
+            "benches/numlist.pl",
+            "run_numlist(1000000, Head).",
+            Strategy::Reuse,
+            btreemap! { "Head" => Value::try_from("1".to_string()).unwrap()},
+        ),
+        (
+            "csv_codename",
+            "benches/csv.pl",
+            "get_codename(\"0020\",Name).",
+            Strategy::Reuse,
+            btreemap! { "Name" => Value::try_from("SPACE".to_string()).unwrap()},
+        ),
+    ]
+    .map(|b| {
+        (
+            b.0,
+            PrologBenchmark {
+                name: b.0,
+                filename: b.1,
+                query: b.2,
+                strategy: b.3,
+                bindings: b.4,
+            },
+        )
+    })
+    .into()
+}
+
+pub enum Strategy {
+    #[allow(dead_code)]
+    Fresh,
+    Reuse,
+}
+
+pub struct PrologBenchmark {
+    pub name: &'static str,
+    pub filename: &'static str,
+    pub query: &'static str,
+    pub strategy: Strategy,
+    pub bindings: BTreeMap<&'static str, Value>,
+}
+
+impl PrologBenchmark {
+    pub fn make_machine(&self) -> Machine {
+        let program = fs::read_to_string(self.filename).unwrap();
+        let module_name = Path::new(self.filename)
+            .file_stem()
+            .and_then(|s| s.to_str())
+            .unwrap();
+        let mut machine = Machine::new_lib();
+        machine.load_module_string(module_name, program);
+        machine
+    }
+
+    #[cfg(not(all(target_arch = "wasm32", target_os = "unknown")))]
+    pub fn setup(&self) -> impl FnMut() -> QueryResolution {
+        let mut machine = self.make_machine();
+        let query = self.query;
+        move || {
+            use criterion::black_box;
+            black_box(machine.run_query(black_box(query.to_string()))).unwrap()
+        }
+    }
+}
+
+#[cfg(test)]
+mod test {
+    #[test]
+    fn validate_benchmarks() {
+        use super::prolog_benches;
+        use scryer_prolog::machine::parsed_results::{QueryMatch, QueryResolution};
+        use std::{fmt::Write, fs};
+
+        struct BenchResult {
+            pub name: &'static str,
+            pub setup_inference_count: u64,
+            pub query_inference_count: u64,
+        }
+
+        let mut results: Vec<BenchResult> = vec![];
+
+        for (_, r) in prolog_benches() {
+            let mut machine = r.make_machine();
+            let setup_inference_count = machine.get_inference_count();
+
+            let result = machine.run_query(r.query.to_string()).unwrap();
+            let query_inference_count = machine.get_inference_count() - setup_inference_count;
+
+            let expected = QueryResolution::Matches(vec![QueryMatch::from(r.bindings.clone())]);
+            assert_eq!(result, expected, "validating benchmark {}", r.name);
+
+            results.push(BenchResult {
+                name: r.name,
+                setup_inference_count,
+                query_inference_count,
+            })
+        }
+
+        let mut json: String = Default::default();
+        json.push('[');
+        for r in results {
+            json.push('\n');
+            write!(
+                json,
+                r#"{{"name":"{}","setup_inference_count":{},"query_inference_count":{}}},"#,
+                r.name, r.setup_inference_count, r.query_inference_count
+            )
+            .unwrap();
+        }
+        json.pop(); // trailing comma
+        json.push_str("\n]");
+        fs::write("target/benchmark_inference_counts.json", json).expect("Unable to write file");
+    }
+}

build/main.rs

@@ -55,7 +55,7 @@ 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 mut libraries = File::create(dest_path).unwrap();
     let lib_path = Path::new("src/lib");
 
     libraries
@@ -66,7 +66,7 @@ fn main() {
         )
         .unwrap();
 
-    find_prolog_files(&mut libraries, "", &lib_path);
+    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");

build/static_string_indexing.rs

@@ -1,7 +1,7 @@
 use proc_macro2::TokenStream;
-use syn::*;
 use syn::parse::*;
 use syn::visit::*;
+use syn::*;
 
 use indexmap::IndexSet;
 
@@ -11,7 +11,9 @@ struct StaticStrVisitor {
 
 impl StaticStrVisitor {
     fn new() -> Self {
-        Self { static_strs: IndexSet::new() }
+        Self {
+            static_strs: IndexSet::new(),
+        }
     }
 }
 
@@ -33,7 +35,7 @@ impl Parse for ReadHeapCellExprAndArms {
         arms.push(input.parse()?);
 
         while !input.is_empty() {
-            if let Ok(_) = input.parse::<Token![,]>() {}
+            let _ = input.parse::<Token![,]>();
             arms.push(input.parse()?);
         }
 
@@ -50,7 +52,7 @@ impl Parse for MacroFnArgs {
         }
 
         while !input.is_empty() {
-            if let Ok(_) = input.parse::<Token![,]>() {}
+            let _ = input.parse::<Token![,]>();
             args.push(input.parse()?);
         }
 
@@ -63,22 +65,20 @@ impl<'ast> Visit<'ast> for StaticStrVisitor {
         let Macro { path, .. } = m;
 
         if path.is_ident("atom") {
-            if let Some(Lit::Str(string)) = m.parse_body::<Lit>().ok() {
+            if let Ok(Lit::Str(string)) = m.parse_body::<Lit>() {
                 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() {
+            if let Ok(m) = m.parse_body::<ReadHeapCellExprAndArms>() {
                 self.visit_expr(&m.expr);
 
                 for e in m.arms {
                     self.visit_arm(&e);
                 }
             }
-        } else {
+        } else if let Ok(m) = m.parse_body::<MacroFnArgs>() {
-            if let Some(m) = m.parse_body::<MacroFnArgs>().ok() {
+            for e in m.args {
-                for e in m.args {
+                self.visit_expr(&e);
-                    self.visit_expr(&e);
-                }
             }
         }
     }
@@ -145,12 +145,11 @@ pub fn index_static_strings(instruction_rs_path: &std::path::Path) -> TokenStrea
         visitor.visit_file(&syntax);
     }
 
-    match process_filepath(instruction_rs_path) {
+    if let Ok(syntax) = process_filepath(instruction_rs_path) {
-        Ok(syntax) => visitor.visit_file(&syntax),
+        visitor.visit_file(&syntax)
-        Err(_) => {}
     }
 
-    let indices = (0..visitor.static_strs.len()).map(|i| i << 3);
+    let indices = (0..visitor.static_strs.len()).map(|i| (i << 3) as u64);
     let indices_iter = indices.clone();
 
     let static_strs_len = visitor.static_strs.len();
@@ -159,7 +158,7 @@ pub fn index_static_strings(instruction_rs_path: &std::path::Path) -> TokenStrea
     quote! {
         use phf;
 
-        static STRINGS: [&'static str; #static_strs_len] = [
+        static STRINGS: [&str; #static_strs_len] = [
             #(
                 #static_strs,
             )*

scryer-prolog.wxs

@@ -1,31 +1,28 @@
-<?xml version="1.0" encoding="utf-8"?>
+<?xml version="1.0" encoding="utf-8"?>
-<Wix xmlns="http://schemas.microsoft.com/wix/2006/wi">
+<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">
+  <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"/>
+    <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"/>
+    <Property Id="APPHELPLINK" Value="https://github.com/mthom/scryer-prolog"/>
-    <Media Id="1" Cabinet="scryer.cab" EmbedCab="yes" />
+    <Media Id="1" Cabinet="scryer.cab" EmbedCab="yes" />
-    
+    <Directory Id="TARGETDIR" Name="SourceDir">
-    <Directory Id="TARGETDIR" Name="SourceDir">
+      <Directory Id="ProgramFilesFolder" Name="PFiles">
-      <Directory Id="ProgramFilesFolder" Name="PFiles">
+        <Directory Id="INSTALLDIR" Name="Scryer Prolog">
-        <Directory Id="INSTALLDIR" Name="Scryer Prolog">
+          <Component Id="MainExecutable" Guid="1b41ceda-ba18-47f9-911b-ee41b4f20921">
-          <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"/>
-            <File Id="ScryerPrologEXE" Name="scryer-prolog.exe" DiskId="1" Source="target/release/scryer-prolog.exe" KeyPath="yes" Checksum="yes"/>
+          </Component>
-          </Component>
+        </Directory>
-        </Directory>
+      </Directory>
-      </Directory>
+      <Directory Id="ProgramMenuFolder">
-      <Directory Id="ProgramMenuFolder">
+        <Component Id="ApplicationShortcut" Guid="8c9b14a3-e7b1-4d30-a892-61d7371dcae2">
-	<Component Id="ApplicationShortcut" Guid="8c9b14a3-e7b1-4d30-a892-61d7371dcae2">
+          <Shortcut Id="ApplicationStarMenuShortcut" Name="Scryer Prolog" Description="Launch Scryer Prolog" Target="[#ScryerPrologEXE]" WorkingDirectory="INSTALLDIR"/>
-          <Shortcut Id="ApplicationStarMenuShortcut" Name="Scryer Prolog" Description="Launch Scryer Prolog" Target="[#ScryerPrologEXE]" WorkingDirectory="INSTALLDIR"/>
+          <RemoveFolder Id="ApplicationShortcut" On="uninstall"/>
-	  <RemoveFolder Id="ApplicationShortcut" On="uninstall"/>
+          <RegistryValue Root="HKCU" Key="Software\Microsoft\ScryerProlog" Name="installed" Type="integer" Value="1" KeyPath="yes"/>
-	  <RegistryValue Root="HKCU" Key="Software\Microsoft\ScryerProlog" Name="installed" Type="integer" Value="1" KeyPath="yes"/>
+        </Component>
-	</Component>
+      </Directory>
-      </Directory>
+    </Directory>
-    </Directory>
+    <Feature Id="Complete" Level="1" Display="expand" ConfigurableDirectory="INSTALLDIR">
-
+      <ComponentRef Id="MainExecutable"/>
-    <Feature Id="Complete" Level="1" Display="expand" ConfigurableDirectory="INSTALLDIR">
+      <ComponentRef Id="ApplicationShortcut"/>
-      <ComponentRef Id="MainExecutable"/>
+    </Feature>
-      <ComponentRef Id="ApplicationShortcut"/>
+  </Product>
-    </Feature>
+</Wix>
-  </Product>
-</Wix>
-  

src/allocator.rs

@@ -1,14 +1,10 @@
 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(crate) trait Allocator {
     fn new() -> Self;
@@ -17,7 +13,7 @@ pub(crate) trait Allocator {
         &mut self,
         lvl: Level,
         context: GenContext,
-        code: &mut Code,
+        code: &mut CodeDeque,
     );
 
     fn mark_non_var<'a, Target: CompilationTarget<'a>>(
@@ -25,83 +21,37 @@ pub(crate) trait Allocator {
         lvl: Level,
         context: GenContext,
         cell: &'a Cell<RegType>,
-        code: &mut Code,
+        code: &mut CodeDeque,
     );
 
+    #[allow(clippy::too_many_arguments)]
     fn mark_reserved_var<'a, Target: CompilationTarget<'a>>(
         &mut self,
-        var_name: Rc<String>,
+        var_num: usize,
         lvl: Level,
-        cell: &'a Cell<VarReg>,
+        cell: &Cell<VarReg>,
         term_loc: GenContext,
-        code: &mut Code,
+        code: &mut CodeDeque,
         r: RegType,
         is_new_var: bool,
     );
 
+    fn mark_cut_var(&mut self, var_num: usize, chunk_num: usize) -> RegType;
+
     fn mark_var<'a, Target: CompilationTarget<'a>>(
         &mut self,
-        var_name: Rc<String>,
+        var_num: usize,
         lvl: Level,
-        cell: &'a Cell<VarReg>,
+        cell: &Cell<VarReg>,
         context: GenContext,
-        code: &mut Code,
+        code: &mut CodeDeque,
     );
 
     fn reset(&mut self);
-    fn reset_contents(&mut self) {}
     fn reset_arg(&mut self, arg_num: usize);
-    fn reset_at_head(&mut self, args: &Vec<Term>);
+    fn reset_at_head(&mut self, args: &[Term]);
+    fn reset_contents(&mut self);
 
     fn advance_arg(&mut self);
-
-    fn bindings(&self) -> &AllocVarDict;
-    fn bindings_mut(&mut self) -> &mut AllocVarDict;
-
-    fn take_bindings(self) -> AllocVarDict;
     fn max_reg_allocated(&self) -> usize;
-
-    fn drain_var_data<'a>(
-        &mut self,
-        vs: VariableFixtures<'a>,
-        num_of_chunks: usize,
-    ) -> VariableFixtures<'a> {
-        let mut perm_vs = VariableFixtures::new();
-
-        for (var, (var_status, cells)) in vs.into_iter() {
-            match var_status {
-                VarStatus::Temp(chunk_num, tvd) => {
-                    self.bindings_mut()
-                        .insert(var.clone(), VarData::Temp(chunk_num, 0, tvd));
-
-                    if chunk_num + 1 == num_of_chunks {
-                        perm_vs.insert_last_chunk_temp_var(var);
-                    }
-                }
-                VarStatus::Perm(_) => {
-                    self.bindings_mut().insert(var.clone(), VarData::Perm(0));
-                    perm_vs.insert(var, (var_status, cells));
-                }
-            };
-        }
-
-        perm_vs
-    }
-
-    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<String>) -> bool {
-        self.get(var).reg_num() == 0
-    }
-
-    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/arena.rs

@@ -1,27 +1,34 @@
+#[cfg(feature = "http")]
 use crate::http::{HttpListener, HttpResponse};
 use crate::machine::loader::LiveLoadState;
 use crate::machine::machine_indices::*;
 use crate::machine::streams::*;
 use crate::raw_block::*;
+use crate::rcu::Rcu;
+use crate::rcu::RcuRef;
 use crate::read::*;
 
+use crate::parser::dashu::{Integer, Rational};
 use ordered_float::OrderedFloat;
-use crate::parser::rug::{Integer, Rational};
 
 use std::alloc;
+use std::cell::UnsafeCell;
 use std::fmt;
 use std::hash::{Hash, Hasher};
 use std::mem;
 use std::net::TcpListener;
 use std::ops::{Deref, DerefMut};
 use std::ptr;
+use std::sync::RwLock;
 
 #[macro_export]
 macro_rules! arena_alloc {
     ($e:expr, $arena:expr) => {{
         let result = $e;
         #[allow(unused_unsafe)]
-        unsafe { ArenaAllocated::alloc($arena, result) }
+        unsafe {
+            ArenaAllocated::alloc($arena, result)
+        }
     }};
 }
 
@@ -30,24 +37,36 @@ macro_rules! float_alloc {
     ($e:expr, $arena:expr) => {{
         let result = $e;
         #[allow(unused_unsafe)]
-        unsafe { $arena.f64_tbl.build_with(result) }
+        unsafe {
+            $arena.f64_tbl.build_with(result).as_ptr()
+        }
     }};
 }
 
-#[cfg(test)]
+use std::sync::Arc;
-use std::cell::RefCell;
+use std::sync::Mutex;
+use std::sync::Weak;
 
 const F64_TABLE_INIT_SIZE: usize = 1 << 16;
 const F64_TABLE_ALIGN: usize = 8;
 
-#[cfg(test)]
+#[inline(always)]
-thread_local! {
+fn global_f64table() -> &'static RwLock<Weak<F64Table>> {
-    static F64_TABLE_BUF_BASE: RefCell<*const u8> = RefCell::new(ptr::null_mut());
+    #[cfg(feature = "rust_beta_channel")]
+    {
+        // const Weak::new will be stabilized in 1.73 which is currently in beta,
+        // till then we need a OnceLock for initialization
+        static GLOBAL_ATOM_TABLE: RwLock<Weak<F64Table>> = RwLock::const_new(Weak::new());
+        &GLOBAL_ATOM_TABLE
+    }
+    #[cfg(not(feature = "rust_beta_channel"))]
+    {
+        use std::sync::OnceLock;
+        static GLOBAL_ATOM_TABLE: OnceLock<RwLock<Weak<F64Table>>> = OnceLock::new();
+        GLOBAL_ATOM_TABLE.get_or_init(|| RwLock::new(Weak::new()))
+    }
 }
 
-#[cfg(not(test))]
-static mut F64_TABLE_BUF_BASE: *const u8 = ptr::null_mut();
-
 impl RawBlockTraits for F64Table {
     #[inline]
     fn init_size() -> usize {
@@ -62,69 +81,86 @@ impl RawBlockTraits for F64Table {
 
 #[derive(Debug)]
 pub struct F64Table {
-    block: RawBlock<F64Table>,
+    block: Rcu<RawBlock<F64Table>>,
-}
+    update: Mutex<()>,
-
-impl Drop for F64Table {
-    fn drop(&mut self) {
-        self.block.deallocate();
-    }
-}
-
-#[cfg(test)]
-fn set_f64_tbl_buf_base(ptr: *const u8) {
-    F64_TABLE_BUF_BASE.with(|f64_table_buf_base| {
-        *f64_table_buf_base.borrow_mut() = ptr;
-    });
-}
-
-#[cfg(test)]
-pub(crate) fn get_f64_tbl_buf_base() -> *const u8 {
-    F64_TABLE_BUF_BASE.with(|f64_table_buf_base| *f64_table_buf_base.borrow())
-}
-
-#[cfg(not(test))]
-fn set_f64_tbl_buf_base(ptr: *const u8) {
-    unsafe {
-        F64_TABLE_BUF_BASE = ptr;
-    }
-}
-
-#[cfg(not(test))]
-pub(crate) fn get_f64_tbl_buf_base() -> *const u8 {
-    unsafe { F64_TABLE_BUF_BASE }
 }
 
 #[inline(always)]
-pub fn lookup_float(offset: usize) -> *mut OrderedFloat<f64> {
+pub fn lookup_float(
-    let base = get_f64_tbl_buf_base() as usize;
+    offset: F64Offset,
-    (base + offset) as *mut _
+) -> RcuRef<RawBlock<F64Table>, UnsafeCell<OrderedFloat<f64>>> {
+    let f64table = global_f64table()
+        .read()
+        .unwrap()
+        .upgrade()
+        .expect("We should only be looking up floats while there is a float table");
+
+    RcuRef::try_map(f64table.block.active_epoch(), |raw_block| unsafe {
+        raw_block
+            .base
+            .add(offset.0)
+            .cast_mut()
+            .cast::<UnsafeCell<OrderedFloat<f64>>>()
+            .as_ref()
+    })
+    .expect("The offset should result in a non-null pointer")
 }
 
 impl F64Table {
     #[inline]
-    pub fn new() -> Self {
+    pub fn new() -> Arc<Self> {
-        let table = Self { block: RawBlock::new() };
+        let upgraded = global_f64table().read().unwrap().upgrade();
-        set_f64_tbl_buf_base(table.block.base);
+        // don't inline upgraded, otherwise temporary will be dropped too late in case of None
-        table
+        if let Some(atom_table) = upgraded {
+            atom_table
+        } else {
+            let mut guard = global_f64table().write().unwrap();
+            // try to upgrade again in case we lost the race on the write lock
+            if let Some(atom_table) = guard.upgrade() {
+                atom_table
+            } else {
+                let atom_table = Arc::new(Self {
+                    block: Rcu::new(RawBlock::new()),
+                    update: Mutex::new(()),
+                });
+                *guard = Arc::downgrade(&atom_table);
+                atom_table
+            }
+        }
     }
 
-    pub unsafe fn build_with(&mut self, value: f64) -> F64Ptr {
+    #[allow(clippy::missing_safety_doc)]
+    pub unsafe fn build_with(&self, value: f64) -> F64Offset {
+        let update_guard = self.update.lock();
+
+        // we don't have an index table for lookups as AtomTable does so
+        // just get the epoch after we take the upgrade lock
+        let mut block_epoch = self.block.active_epoch();
+
         let mut ptr;
 
         loop {
-            ptr = self.block.alloc(mem::size_of::<f64>());
+            ptr = block_epoch.alloc(mem::size_of::<f64>());
 
             if ptr.is_null() {
-                self.block.grow();
+                let new_block = block_epoch.grow_new().unwrap();
-                set_f64_tbl_buf_base(self.block.base);
+                self.block.replace(new_block);
+                block_epoch = self.block.active_epoch();
             } else {
                 break;
             }
         }
 
         ptr::write(ptr as *mut OrderedFloat<f64>, OrderedFloat(value));
-        F64Ptr(ptr::NonNull::new_unchecked(ptr as *mut _))
+
+        let float = F64Offset(ptr as usize - block_epoch.base as usize);
+
+        // atometable would have to update the index table at this point
+
+        // expicit drop to ensure we don't accidentally drop it early
+        drop(update_guard);
+
+        float
     }
 }
 
@@ -133,14 +169,13 @@ impl F64Table {
 pub enum ArenaHeaderTag {
     Integer = 0b10,
     Rational = 0b11,
-    OssifiedOpDir = 0b0000100,
     LiveLoadState = 0b0001000,
     InactiveLoadState = 0b1011000,
     InputFileStream = 0b10000,
     OutputFileStream = 0b10100,
     NamedTcpStream = 0b011100,
     NamedTlsStream = 0b100000,
-    HttpReadStream =  0b100001,
+    HttpReadStream = 0b100001,
     HttpWriteStream = 0b100010,
     ReadlineStream = 0b110000,
     StaticStringStream = 0b110100,
@@ -194,7 +229,7 @@ impl<T: ?Sized + PartialOrd> PartialOrd for TypedArenaPtr<T> {
 
 impl<T: ?Sized + PartialEq> PartialEq for TypedArenaPtr<T> {
     fn eq(&self, other: &TypedArenaPtr<T>) -> bool {
-        self.0 == other.0 || &**self == &**other
+        self.0 == other.0 || **self == **other
     }
 }
 
@@ -209,13 +244,13 @@ impl<T: ?Sized + Ord> Ord for TypedArenaPtr<T> {
 impl<T: ?Sized + Hash> Hash for TypedArenaPtr<T> {
     #[inline(always)]
     fn hash<H: Hasher>(&self, hasher: &mut H) {
-        (&*self as &T).hash(hasher)
+        (self as &T).hash(hasher)
     }
 }
 
 impl<T: ?Sized> Clone for TypedArenaPtr<T> {
     fn clone(&self) -> Self {
-        TypedArenaPtr(self.0)
+        *self
     }
 }
 
@@ -242,6 +277,8 @@ impl<T: fmt::Display> fmt::Display for TypedArenaPtr<T> {
 }
 
 impl<T: ?Sized + ArenaAllocated> TypedArenaPtr<T> {
+    // data must be allocated in the arena already.
+    #[allow(clippy::not_unsafe_ptr_arg_deref)]
     #[inline]
     pub const fn new(data: *mut T) -> Self {
         unsafe { TypedArenaPtr(ptr::NonNull::new_unchecked(data)) }
@@ -273,7 +310,9 @@ impl<T: ?Sized + ArenaAllocated> TypedArenaPtr<T> {
 
     #[inline]
     pub fn set_tag(&mut self, tag: ArenaHeaderTag) {
-        unsafe { (*self.header_ptr_mut()).set_tag(tag); }
+        unsafe {
+            (*self.header_ptr_mut()).set_tag(tag);
+        }
     }
 
     #[inline]
@@ -304,12 +343,17 @@ pub trait ArenaAllocated: Sized {
     fn copy_to_arena(self, dst: *mut Self) -> Self::PtrToAllocated;
 
     fn header_offset_from_payload() -> usize {
-        mem::size_of::<*const ArenaHeader>()
+        mem::size_of::<ArenaHeader>()
     }
 
+    #[allow(clippy::missing_safety_doc)]
     unsafe fn alloc(arena: &mut Arena, value: Self) -> Self::PtrToAllocated {
         let size = value.size() + mem::size_of::<AllocSlab>();
 
+        #[cfg(target_pointer_width = "32")]
+        let align = mem::align_of::<AllocSlab>() * 2;
+
+        #[cfg(target_pointer_width = "64")]
         let align = mem::align_of::<AllocSlab>();
         let layout = alloc::Layout::from_size_align_unchecked(size, align);
 
@@ -319,7 +363,7 @@ pub trait ArenaAllocated: Sized {
         (*slab).header = ArenaHeader::build_with(value.size() as u64, Self::tag());
 
         let offset = (*slab).payload_offset();
-        let result = value.copy_to_arena(offset as *mut Self);
+        let result = value.copy_to_arena(offset);
 
         arena.base = slab;
 
@@ -327,12 +371,18 @@ pub trait ArenaAllocated: Sized {
     }
 }
 
-#[derive(Copy, Clone, Debug)]
+#[derive(Debug)]
-pub struct F64Ptr(pub ptr::NonNull<OrderedFloat<f64>>);
+pub struct F64Ptr(RcuRef<RawBlock<F64Table>, UnsafeCell<OrderedFloat<f64>>>);
+
+impl Clone for F64Ptr {
+    fn clone(&self) -> Self {
+        Self(RcuRef::clone(&self.0))
+    }
+}
 
 impl PartialEq for F64Ptr {
     fn eq(&self, other: &F64Ptr) -> bool {
-        self.0 == other.0 || &**self == &**other
+        RcuRef::ptr_eq(&self.0, &other.0) || self.deref() == other.deref()
     }
 }
 
@@ -340,7 +390,7 @@ impl Eq for F64Ptr {}
 
 impl PartialOrd for F64Ptr {
     fn partial_cmp(&self, other: &Self) -> Option<std::cmp::Ordering> {
-        (**self).partial_cmp(&**other)
+        Some(self.cmp(other))
     }
 }
 
@@ -353,13 +403,13 @@ impl Ord for F64Ptr {
 impl Hash for F64Ptr {
     #[inline(always)]
     fn hash<H: Hasher>(&self, hasher: &mut H) {
-        (&*self as &OrderedFloat<f64>).hash(hasher)
+        (self as &OrderedFloat<f64>).hash(hasher)
     }
 }
 
 impl fmt::Display for F64Ptr {
     fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
-        write!(f, "{}", *self)
+        write!(f, "{}", self as &OrderedFloat<f64>)
     }
 }
 
@@ -368,28 +418,26 @@ impl Deref for F64Ptr {
 
     #[inline]
     fn deref(&self) -> &Self::Target {
-        unsafe { &*self.0.as_ptr() }
+        unsafe { self.0.get().as_ref().unwrap() }
     }
 }
 
 impl DerefMut for F64Ptr {
     #[inline]
     fn deref_mut(&mut self) -> &mut Self::Target {
-        unsafe { &mut *self.0.as_ptr() }
+        unsafe { &mut *self.0.get().as_mut().unwrap() }
     }
 }
 
 impl F64Ptr {
     #[inline(always)]
-    pub fn from_offset(offset: usize) -> Self {
+    pub fn from_offset(offset: F64Offset) -> Self {
-        unsafe {
+        Self(lookup_float(offset))
-            F64Ptr(ptr::NonNull::new_unchecked(lookup_float(offset)))
-        }
     }
 
     #[inline(always)]
     pub fn as_offset(&self) -> F64Offset {
-        F64Offset(self.0.as_ptr() as usize - get_f64_tbl_buf_base() as usize)
+        F64Offset(self.0.get() as usize - RcuRef::get_root(&self.0).base as usize)
     }
 }
 
@@ -409,7 +457,7 @@ impl F64Offset {
 
     #[inline(always)]
     pub fn as_ptr(self) -> F64Ptr {
-        F64Ptr::from_offset(self.0)
+        F64Ptr::from_offset(self)
     }
 
     #[inline(always)]
@@ -430,7 +478,7 @@ impl Eq for F64Offset {}
 impl PartialOrd for F64Offset {
     #[inline(always)]
     fn partial_cmp(&self, other: &Self) -> Option<std::cmp::Ordering> {
-        self.as_ptr().partial_cmp(&other.as_ptr())
+        Some(self.cmp(other))
     }
 }
 
@@ -467,11 +515,12 @@ impl ArenaAllocated for Integer {
         mem::size_of::<Self>()
     }
 
+    #[allow(clippy::not_unsafe_ptr_arg_deref)]
     #[inline]
     fn copy_to_arena(self, dst: *mut Self) -> Self::PtrToAllocated {
         unsafe {
             ptr::write(dst, self);
-            TypedArenaPtr::new(dst as *mut Self)
+            TypedArenaPtr::new(dst)
         }
     }
 }
@@ -489,33 +538,12 @@ impl ArenaAllocated for Rational {
         mem::size_of::<Self>()
     }
 
+    #[allow(clippy::not_unsafe_ptr_arg_deref)]
     #[inline]
     fn copy_to_arena(self, dst: *mut Self) -> Self::PtrToAllocated {
         unsafe {
             ptr::write(dst, self);
-            TypedArenaPtr::new(dst as *mut Self)
+            TypedArenaPtr::new(dst)
-        }
-    }
-}
-
-impl ArenaAllocated for OssifiedOpDir {
-    type PtrToAllocated = TypedArenaPtr<OssifiedOpDir>;
-
-    #[inline]
-    fn tag() -> ArenaHeaderTag {
-        ArenaHeaderTag::OssifiedOpDir
-    }
-
-    #[inline]
-    fn size(&self) -> usize {
-        mem::size_of::<Self>()
-    }
-
-    #[inline]
-    fn copy_to_arena(self, dst: *mut Self) -> Self::PtrToAllocated {
-        unsafe {
-            ptr::write(dst, self);
-            TypedArenaPtr::new(dst as *mut Self)
         }
     }
 }
@@ -533,11 +561,12 @@ impl ArenaAllocated for LiveLoadState {
         mem::size_of::<Self>()
     }
 
+    #[allow(clippy::not_unsafe_ptr_arg_deref)]
     #[inline]
     fn copy_to_arena(self, dst: *mut Self) -> Self::PtrToAllocated {
         unsafe {
             ptr::write(dst, self);
-            TypedArenaPtr::new(dst as *mut Self)
+            TypedArenaPtr::new(dst)
         }
     }
 }
@@ -555,56 +584,61 @@ impl ArenaAllocated for TcpListener {
         mem::size_of::<Self>()
     }
 
+    #[allow(clippy::not_unsafe_ptr_arg_deref)]
     #[inline]
     fn copy_to_arena(self, dst: *mut Self) -> Self::PtrToAllocated {
         unsafe {
             ptr::write(dst, self);
-            TypedArenaPtr::new(dst as *mut Self)
+            TypedArenaPtr::new(dst)
         }
     }
 }
 
+#[cfg(feature = "http")]
 impl ArenaAllocated for HttpListener {
     type PtrToAllocated = TypedArenaPtr<HttpListener>;
 
     #[inline]
     fn tag() -> ArenaHeaderTag {
-	ArenaHeaderTag::HttpListener
+        ArenaHeaderTag::HttpListener
     }
 
     #[inline]
     fn size(&self) -> usize {
-	mem::size_of::<Self>()
+        mem::size_of::<Self>()
     }
 
+    #[allow(clippy::not_unsafe_ptr_arg_deref)]
     #[inline]
     fn copy_to_arena(self, dst: *mut Self) -> Self::PtrToAllocated {
-	unsafe {
+        unsafe {
-	    ptr::write(dst, self);
+            ptr::write(dst, self);
-	    TypedArenaPtr::new(dst as *mut Self)
+            TypedArenaPtr::new(dst)
-	}
+        }
     }
 }
 
+#[cfg(feature = "http")]
 impl ArenaAllocated for HttpResponse {
     type PtrToAllocated = TypedArenaPtr<HttpResponse>;
 
     #[inline]
     fn tag() -> ArenaHeaderTag {
-	ArenaHeaderTag::HttpResponse
+        ArenaHeaderTag::HttpResponse
     }
 
     #[inline]
     fn size(&self) -> usize {
-	mem::size_of::<Self>()
+        mem::size_of::<Self>()
     }
 
+    #[allow(clippy::not_unsafe_ptr_arg_deref)]
     #[inline]
     fn copy_to_arena(self, dst: *mut Self) -> Self::PtrToAllocated {
-	unsafe {
+        unsafe {
-	    ptr::write(dst, self);
+            ptr::write(dst, self);
-	    TypedArenaPtr::new(dst as *mut Self)
+            TypedArenaPtr::new(dst)
-	}
+        }
     }
 }
 
@@ -621,11 +655,12 @@ impl ArenaAllocated for IndexPtr {
         mem::size_of::<Self>()
     }
 
+    #[allow(clippy::not_unsafe_ptr_arg_deref)]
     #[inline]
     fn copy_to_arena(self, dst: *mut Self) -> Self::PtrToAllocated {
         unsafe {
             ptr::write(dst, self);
-            TypedArenaPtr::new(dst as *mut Self)
+            TypedArenaPtr::new(dst)
         }
     }
 
@@ -644,32 +679,42 @@ impl ArenaAllocated for IndexPtr {
 
         (*slab).next = arena.base;
 
-        let result = value.copy_to_arena(mem::transmute::<_, *mut IndexPtr>(&(*slab).header));
+        let result = value.copy_to_arena(
+            &(*slab).header as *const crate::arena::ArenaHeader
+                as *mut crate::machine::machine_indices::IndexPtr,
+        );
         arena.base = slab;
 
         result
     }
 }
 
+#[repr(C)]
 #[derive(Clone, Copy, Debug)]
 struct AllocSlab {
     next: *mut AllocSlab,
+    #[cfg(target_pointer_width = "32")]
+    _padding: u32,
     header: ArenaHeader,
 }
 
 #[derive(Debug)]
 pub struct Arena {
     base: *mut AllocSlab,
-    pub f64_tbl: F64Table,
+    pub f64_tbl: Arc<F64Table>,
 }
 
 unsafe impl Send for Arena {}
 unsafe impl Sync for Arena {}
 
+#[allow(clippy::new_without_default)]
 impl Arena {
     #[inline]
     pub fn new() -> Self {
-        Arena { base: ptr::null_mut(), f64_tbl: F64Table::new() }
+        Arena {
+            base: ptr::null_mut(),
+            f64_tbl: F64Table::new(),
+        }
     }
 }
 
@@ -693,14 +738,17 @@ unsafe fn drop_slab_in_place(value: &mut AllocSlab) {
             ptr::drop_in_place(value.payload_offset::<StreamLayout<CharReader<NamedTcpStream>>>());
         }
         ArenaHeaderTag::NamedTlsStream => {
+            #[cfg(feature = "tls")]
             ptr::drop_in_place(value.payload_offset::<StreamLayout<CharReader<NamedTlsStream>>>());
         }
         ArenaHeaderTag::HttpReadStream => {
+            #[cfg(feature = "http")]
             ptr::drop_in_place(value.payload_offset::<StreamLayout<CharReader<HttpReadStream>>>());
         }
-	ArenaHeaderTag::HttpWriteStream => {
+        ArenaHeaderTag::HttpWriteStream => {
-	    ptr::drop_in_place(value.payload_offset::<StreamLayout<CharReader<HttpWriteStream>>>());
+            #[cfg(feature = "http")]
-	}
+            ptr::drop_in_place(value.payload_offset::<StreamLayout<CharReader<HttpWriteStream>>>());
+        }
         ArenaHeaderTag::ReadlineStream => {
             ptr::drop_in_place(value.payload_offset::<StreamLayout<ReadlineStream>>());
         }
@@ -710,33 +758,32 @@ unsafe fn drop_slab_in_place(value: &mut AllocSlab) {
         ArenaHeaderTag::ByteStream => {
             ptr::drop_in_place(value.payload_offset::<StreamLayout<CharReader<ByteStream>>>());
         }
-        ArenaHeaderTag::OssifiedOpDir => {
-            ptr::drop_in_place(value.payload_offset::<OssifiedOpDir>());
-        }
         ArenaHeaderTag::LiveLoadState | ArenaHeaderTag::InactiveLoadState => {
             ptr::drop_in_place(value.payload_offset::<LiveLoadState>());
         }
-        ArenaHeaderTag::Dropped => {
+        ArenaHeaderTag::Dropped => {}
-        }
         ArenaHeaderTag::TcpListener => {
             ptr::drop_in_place(value.payload_offset::<TcpListener>());
         }
-	ArenaHeaderTag::HttpListener => {
+        ArenaHeaderTag::HttpListener => {
-	    ptr::drop_in_place(value.payload_offset::<HttpListener>());
+            #[cfg(feature = "http")]
-	}
+            ptr::drop_in_place(value.payload_offset::<HttpListener>());
-	ArenaHeaderTag::HttpResponse => {
+        }
-	    ptr::drop_in_place(value.payload_offset::<HttpResponse>());
+        ArenaHeaderTag::HttpResponse => {
-	}
+            #[cfg(feature = "http")]
+            ptr::drop_in_place(value.payload_offset::<HttpResponse>());
+        }
         ArenaHeaderTag::StandardOutputStream => {
             ptr::drop_in_place(value.payload_offset::<StreamLayout<StandardOutputStream>>());
         }
         ArenaHeaderTag::StandardErrorStream => {
             ptr::drop_in_place(value.payload_offset::<StreamLayout<StandardErrorStream>>());
         }
-        ArenaHeaderTag::NullStream | ArenaHeaderTag::IndexPtrUndefined |
+        ArenaHeaderTag::NullStream
-        ArenaHeaderTag::IndexPtrDynamicUndefined | ArenaHeaderTag::IndexPtrDynamicIndex |
+        | ArenaHeaderTag::IndexPtrUndefined
-        ArenaHeaderTag::IndexPtrIndex => {
+        | ArenaHeaderTag::IndexPtrDynamicUndefined
-        }
+        | ArenaHeaderTag::IndexPtrDynamicIndex
+        | ArenaHeaderTag::IndexPtrIndex => {}
     }
 }
 
@@ -774,9 +821,9 @@ impl AllocSlab {
     }
 
     fn payload_offset<T>(&self) -> *mut T {
-        let mut ptr = (self as *const AllocSlab) as usize;
+        // This looks really scary, should this method be marked as unsafe?
-        ptr += mem::size_of::<AllocSlab>();
+        // Also, this seems to cause UB.
-        ptr as *mut T
+        unsafe { (self as *const AllocSlab).add(1) as *mut T }
     }
 }
 
@@ -784,27 +831,29 @@ const_assert!(mem::size_of::<OrderedFloat<f64>>() == 8);
 
 #[cfg(test)]
 mod tests {
+    use std::ops::Deref;
+
     use crate::machine::mock_wam::*;
     use crate::machine::partial_string::*;
 
+    use crate::parser::dashu::{Integer, Rational};
     use ordered_float::OrderedFloat;
-    use crate::parser::rug::{Integer, Rational};
 
     #[test]
     fn float_ptr_cast() {
-        let mut wam = MockWAM::new();
+        let wam = MockWAM::new();
 
         let f = 0f64;
         let fp = float_alloc!(f, wam.machine_st.arena);
-        let mut cell = HeapCellValue::from(fp);
+        let mut cell = HeapCellValue::from(fp.clone());
 
         assert_eq!(cell.get_tag(), HeapCellValueTag::F64);
-        assert_eq!(cell.get_mark_bit(), false);
+        assert!(!cell.get_mark_bit());
-        assert_eq!(*fp, OrderedFloat(f));
+        assert_eq!(fp.deref(), &OrderedFloat(f));
 
         cell.set_mark_bit(true);
 
-        assert_eq!(cell.get_mark_bit(), true);
+        assert!(cell.get_mark_bit());
 
         read_heap_cell!(cell,
             (HeapCellValueTag::F64, ptr) => {
@@ -815,8 +864,15 @@ mod tests {
     }
 
     #[test]
+    #[cfg_attr(miri, ignore = "blocked on streams.rs UB")]
     fn heap_cell_value_const_cast() {
         let mut wam = MockWAM::new();
+        #[cfg(target_pointer_width = "32")]
+        let const_value = HeapCellValue::from(ConsPtr::build_with(
+            0x0000_0431 as *const _,
+            ConsPtrMaskTag::Cons,
+        ));
+        #[cfg(target_pointer_width = "64")]
         let const_value = HeapCellValue::from(ConsPtr::build_with(
             0x0000_5555_ff00_0431 as *const _,
             ConsPtrMaskTag::Cons,
@@ -824,10 +880,13 @@ mod tests {
 
         match const_value.to_untyped_arena_ptr() {
             Some(arena_ptr) => {
-                assert_eq!(arena_ptr.into_bytes(), const_value.into_bytes());
+                assert_eq!(
+                    arena_ptr.into_bytes(),
+                    const_value.to_untyped_arena_ptr_bytes()
+                );
             }
             None => {
-                assert!(false);
+                unreachable!();
             }
         }
 
@@ -837,23 +896,26 @@ mod tests {
 
         match stream_cell.to_untyped_arena_ptr() {
             Some(arena_ptr) => {
-                assert_eq!(arena_ptr.into_bytes(), stream_cell.into_bytes());
+                assert_eq!(
+                    arena_ptr.into_bytes(),
+                    stream_cell.to_untyped_arena_ptr_bytes()
+                );
             }
             None => {
-                assert!(false);
+                unreachable!();
             }
         }
     }
 
     #[test]
+    #[cfg_attr(miri, ignore = "blocked on arena.rs UB")]
     fn heap_put_literal_tests() {
         let mut wam = MockWAM::new();
 
         // integer
 
         let big_int: Integer = 2 * Integer::from(1u64 << 63);
-        let big_int_ptr: TypedArenaPtr<Integer> =
+        let big_int_ptr: TypedArenaPtr<Integer> = arena_alloc!(big_int, &mut wam.machine_st.arena);
-            arena_alloc!(big_int, &mut wam.machine_st.arena);
 
         assert!(!big_int_ptr.as_ptr().is_null());
 
@@ -863,7 +925,6 @@ mod tests {
         let untyped_arena_ptr = match cell.to_untyped_arena_ptr() {
             Some(ptr) => ptr,
             None => {
-                assert!(false);
                 unreachable!()
             }
         };
@@ -889,7 +950,7 @@ mod tests {
 
         // rational
 
-        let big_rat = 2 * Rational::from(1u64 << 63);
+        let big_rat = Rational::from(2) * Rational::from(1u64 << 63);
         let big_rat_ptr: TypedArenaPtr<Rational> = arena_alloc!(big_rat, &mut wam.machine_st.arena);
 
         assert!(!big_rat_ptr.as_ptr().is_null());
@@ -905,7 +966,7 @@ mod tests {
                 );
             }
             None => {
-                assert!(false); // we fail.
+                unreachable!();
             }
         }
 
@@ -915,7 +976,7 @@ mod tests {
           (HeapCellValueTag::Cons, cons_ptr) => {
               match_untyped_arena_ptr!(cons_ptr,
                  (ArenaHeaderTag::Rational, n) => {
-                     assert_eq!(&*n, &(2 * Rational::from(1u64 << 63)));
+                     assert_eq!(&*n, &(Rational::from(2) * Rational::from(1u64 << 63)));
                  }
                  _ => unreachable!()
               )
@@ -928,8 +989,8 @@ mod tests {
         let f_atom = atom!("f");
         let g_atom = atom!("g");
 
-        assert_eq!(f_atom.as_str(), "f");
+        assert_eq!(&*f_atom.as_str(), "f");
-        assert_eq!(g_atom.as_str(), "g");
+        assert_eq!(&*g_atom.as_str(), "g");
 
         let f_atom_cell = atom_as_cell!(f_atom);
         let g_atom_cell = atom_as_cell!(g_atom);
@@ -939,10 +1000,10 @@ mod tests {
         match f_atom_cell.to_atom() {
             Some(atom) => {
                 assert_eq!(f_atom, atom);
-                assert_eq!(atom.as_str(), "f");
+                assert_eq!(&*atom.as_str(), "f");
             }
             None => {
-                assert!(false);
+                unreachable!();
             }
         }
 
@@ -950,7 +1011,7 @@ mod tests {
             (HeapCellValueTag::Atom, (atom, arity)) => {
                 assert_eq!(f_atom, atom);
                 assert_eq!(arity, 0);
-                assert_eq!(atom.as_str(), "f");
+                assert_eq!(&*atom.as_str(), "f");
             }
             _ => { unreachable!() }
         );
@@ -959,31 +1020,32 @@ mod tests {
             (HeapCellValueTag::Atom, (atom, arity)) => {
                 assert_eq!(g_atom, atom);
                 assert_eq!(arity, 0);
-                assert_eq!(atom.as_str(), "g");
+                assert_eq!(&*atom.as_str(), "g");
             }
             _ => { unreachable!() }
         );
 
         // complete string
 
-        let pstr_var_cell = put_partial_string(&mut wam.machine_st.heap, "ronan", &mut wam.machine_st.atom_tbl);
+        let pstr_var_cell =
+            put_partial_string(&mut wam.machine_st.heap, "ronan", &wam.machine_st.atom_tbl);
         let pstr_cell = wam.machine_st.heap[pstr_var_cell.get_value() as usize];
 
         assert_eq!(pstr_cell.get_tag(), HeapCellValueTag::PStr);
 
         match pstr_cell.to_pstr() {
             Some(pstr) => {
-                assert_eq!(pstr.as_str_from(0), "ronan");
+                assert_eq!(&*pstr.as_str_from(0), "ronan");
             }
             None => {
-                assert!(false);
+                unreachable!();
             }
         }
 
         read_heap_cell!(pstr_cell,
             (HeapCellValueTag::PStr, pstr_atom) => {
                 let pstr = PartialString::from(pstr_atom);
-                assert_eq!(pstr.as_str_from(0), "ronan");
+                assert_eq!(&*pstr.as_str_from(0), "ronan");
             }
             _ => { unreachable!() }
         );
@@ -996,7 +1058,7 @@ mod tests {
 
         match fixnum_cell.to_fixnum() {
             Some(n) => assert_eq!(n.get_num(), 3),
-            None => assert!(false),
+            None => unreachable!(),
         }
 
         read_heap_cell!(fixnum_cell,
@@ -1012,52 +1074,48 @@ mod tests {
 
         match fixnum_b_cell.to_fixnum() {
             Some(n) => assert_eq!(n.get_num(), 1 << 54),
-            None => assert!(false),
+            None => unreachable!(),
         }
 
-        match Fixnum::build_with_checked(1 << 56) {
+        if Fixnum::build_with_checked(1 << 56).is_ok() {
-            Ok(_) => assert!(false),
+            unreachable!()
-            _ => assert!(true),
         }
 
-        match Fixnum::build_with_checked(i64::MAX) {
+        if Fixnum::build_with_checked(i64::MAX).is_ok() {
-            Ok(_) => assert!(false),
+            unreachable!()
-            _ => assert!(true),
         }
 
-        match Fixnum::build_with_checked(i64::MIN) {
+        if Fixnum::build_with_checked(i64::MIN).is_ok() {
-            Ok(_) => assert!(false),
+            unreachable!()
-            _ => assert!(true),
         }
 
         match Fixnum::build_with_checked(-1) {
             Ok(n) => assert_eq!(n.get_num(), -1),
-            _ => assert!(false),
+            _ => unreachable!(),
         }
 
         match Fixnum::build_with_checked((1 << 55) - 1) {
             Ok(n) => assert_eq!(n.get_num(), (1 << 55) - 1),
-            _ => assert!(false),
+            _ => unreachable!(),
         }
 
         match Fixnum::build_with_checked(-(1 << 55)) {
             Ok(n) => assert_eq!(n.get_num(), -(1 << 55)),
-            _ => assert!(false),
+            _ => unreachable!(),
         }
 
-        match Fixnum::build_with_checked(-(1 << 55) - 1) {
+        if Fixnum::build_with_checked(-(1 << 55) - 1).is_ok() {
-            Ok(_n) => assert!(false),
+            unreachable!()
-            _ => assert!(true),
         }
 
         match Fixnum::build_with_checked(-1) {
             Ok(n) => assert_eq!(-n, Fixnum::build_with(1)),
-            _ => assert!(false),
+            _ => unreachable!(),
         }
 
         // float
 
-        let float = 3.1415926f64;
+        let float = std::f64::consts::PI;
         let float_ptr = float_alloc!(float, wam.machine_st.arena);
         let cell = HeapCellValue::from(float_ptr);
 
@@ -1091,8 +1149,8 @@ mod tests {
 
         read_heap_cell!(cell,
             (HeapCellValueTag::Atom, (el, _arity)) => {
-                assert_eq!(el.flat_index() as usize, empty_list_as_cell!().get_value());
+                assert_eq!(el.flat_index(), empty_list_as_cell!().get_value());
-                assert_eq!(el.as_str(), "[]");
+                assert_eq!(&*el.as_str(), "[]");
             }
             _ => { unreachable!() }
         );

src/arithmetic.rs

@@ -9,11 +9,13 @@ use crate::targets::QueryInstruction;
 use crate::types::*;
 
 use crate::parser::ast::*;
-use crate::parser::rug::ops::PowAssign;
+use crate::parser::dashu::{Integer, Rational};
-use crate::parser::rug::{Assign, Integer, Rational};
 
 use crate::machine::machine_errors::*;
 
+use dashu::base::Abs;
+use dashu::base::BitTest;
+use num_order::NumOrd;
 use ordered_float::*;
 
 use std::cell::Cell;
@@ -22,7 +24,6 @@ use std::convert::TryFrom;
 use std::f64;
 use std::num::FpCategory;
 use std::ops::Div;
-use std::rc::Rc;
 use std::vec::Vec;
 
 #[derive(Debug, Copy, Clone, PartialEq, Eq)]
@@ -53,7 +54,7 @@ pub(crate) struct ArithInstructionIterator<'a> {
     state_stack: Vec<TermIterState<'a>>,
 }
 
-pub(crate) type ArithCont = (Code, Option<ArithmeticTerm>);
+pub(crate) type ArithCont = (CodeDeque, Option<ArithmeticTerm>);
 
 impl<'a> ArithInstructionIterator<'a> {
     fn push_subterm(&mut self, lvl: Level, term: &'a Term) {
@@ -67,19 +68,6 @@ impl<'a> ArithInstructionIterator<'a> {
             Term::Clause(cell, name, terms) => {
                 TermIterState::Clause(Level::Shallow, 0, cell, *name, terms)
             }
-            /* match ClauseType::from(*name, terms.len()) {
-                ct @ ClauseType::Named(..) => {
-                    Ok(TermIterState::Clause(Level::Shallow, 0, cell, ct, terms))
-                }
-                ct @ ClauseType::Inlined(InlinedClauseType::IsFloat(_)) => {
-                    // let ct = ClauseType::Named(1, atom!("float"), CodeIndex::default());
-                    Ok(TermIterState::Clause(Level::Shallow, 0, cell, ct, terms))
-                }
-                _ => Err(ArithmeticError::NonEvaluableFunctor(
-                    Literal::Atom(*name),
-                    terms.len(),
-                )),
-            }?,*/
             Term::Literal(cell, cons) => TermIterState::Literal(Level::Shallow, cell, cons),
             Term::Cons(..) | Term::PartialString(..) | Term::CompleteString(..) => {
                 return Err(ArithmeticError::NonEvaluableFunctor(
@@ -87,7 +75,7 @@ impl<'a> ArithInstructionIterator<'a> {
                     2,
                 ))
             }
-            Term::Var(cell, var) => TermIterState::Var(Level::Shallow, cell, var.clone()),
+            Term::Var(cell, var_ptr) => TermIterState::Var(Level::Shallow, cell, var_ptr.clone()),
         };
 
         Ok(ArithInstructionIterator {
@@ -100,7 +88,7 @@ impl<'a> ArithInstructionIterator<'a> {
 pub(crate) enum ArithTermRef<'a> {
     Literal(&'a Literal),
     Op(Atom, usize), // name, arity.
-    Var(Level, &'a Cell<VarReg>, Rc<String>),
+    Var(Level, &'a Cell<VarReg>, VarPtr),
 }
 
 impl<'a> Iterator for ArithInstructionIterator<'a> {
@@ -128,8 +116,8 @@ impl<'a> Iterator for ArithInstructionIterator<'a> {
                     }
                 }
                 TermIterState::Literal(_, _, c) => return Some(Ok(ArithTermRef::Literal(c))),
-                TermIterState::Var(lvl, cell, var) => {
+                TermIterState::Var(lvl, cell, var_ptr) => {
-                    return Some(Ok(ArithTermRef::Var(lvl, cell, var.clone())));
+                    return Some(Ok(ArithTermRef::Var(lvl, cell, var_ptr)));
                 }
                 _ => {
                     return Some(Err(ArithmeticError::NonEvaluableFunctor(
@@ -172,13 +160,13 @@ fn push_literal(interm: &mut Vec<ArithmeticTerm>, c: &Literal) -> Result<(), Ari
         Literal::Float(n) => interm.push(ArithmeticTerm::Number(Number::Float(*n.as_ptr()))),
         Literal::Rational(n) => interm.push(ArithmeticTerm::Number(Number::Rational(*n))),
         Literal::Atom(name) if name == &atom!("e") => interm.push(ArithmeticTerm::Number(
-            Number::Float(OrderedFloat(std::f64::consts::E))
+            Number::Float(OrderedFloat(std::f64::consts::E)),
         )),
         Literal::Atom(name) if name == &atom!("pi") => interm.push(ArithmeticTerm::Number(
-            Number::Float(OrderedFloat(std::f64::consts::PI))
+            Number::Float(OrderedFloat(std::f64::consts::PI)),
         )),
         Literal::Atom(name) if name == &atom!("epsilon") => interm.push(ArithmeticTerm::Number(
-            Number::Float(OrderedFloat(std::f64::EPSILON))
+            Number::Float(OrderedFloat(std::f64::EPSILON)),
         )),
         _ => return Err(ArithmeticError::NonEvaluableFunctor(*c, 0)),
     }
@@ -219,6 +207,8 @@ impl<'a> ArithmeticEvaluator<'a> {
             atom!("round") => Ok(Instruction::Round(a1, t)),
             atom!("ceiling") => Ok(Instruction::Ceiling(a1, t)),
             atom!("floor") => Ok(Instruction::Floor(a1, t)),
+            atom!("float_integer_part") => Ok(Instruction::FloatIntegerPart(a1, t)),
+            atom!("float_fractional_part") => Ok(Instruction::FloatFractionalPart(a1, t)),
             atom!("sign") => Ok(Instruction::Sign(a1, t)),
             atom!("\\") => Ok(Instruction::BitwiseComplement(a1, t)),
             _ => Err(ArithmeticError::NonEvaluableFunctor(Literal::Atom(name), 1)),
@@ -278,7 +268,7 @@ impl<'a> ArithmeticEvaluator<'a> {
                 let ninterm = if a1.interm_or(0) == 0 {
                     self.incr_interm()
                 } else {
-                    self.interm.push(a1.clone());
+                    self.interm.push(a1);
                     a1.interm_or(0)
                 };
 
@@ -320,41 +310,39 @@ impl<'a> ArithmeticEvaluator<'a> {
         src: &'a Term,
         term_loc: GenContext,
         arg: usize,
-    ) -> Result<ArithCont, ArithmeticError>
+    ) -> Result<ArithCont, ArithmeticError> {
-    {
+        let mut code = CodeDeque::new();
-        let mut code = vec![];
-        let mut iter = src.iter()?;
 
-        while let Some(term_ref) = iter.next() {
+        for term_ref in src.iter()? {
             match term_ref? {
                 ArithTermRef::Literal(c) => push_literal(&mut self.interm, c)?,
                 ArithTermRef::Var(lvl, cell, name) => {
-                    let r = if lvl == Level::Shallow {
+                    let var_num = name.to_var_num().unwrap();
-                        self.marker.mark_non_callable(
-                            name.clone(),
-                            arg,
-                            term_loc,
-                            cell,
-                            &mut code,
-                        )
-                    } else if term_loc.is_last() || cell.get().norm().reg_num() == 0 {
-                        self.marker.mark_var::<QueryInstruction>(
-                            name.clone(),
-                            lvl,
-                            cell,
-                            term_loc,
-                            &mut code,
-                        );
 
-                        self.marker.get_binding(&name).unwrap()
+                    let r = if lvl == Level::Shallow {
+                        self.marker
+                            .mark_non_callable(var_num, arg, term_loc, cell, &mut code)
+                    } else if term_loc.is_last() || cell.get().norm().reg_num() == 0 {
+                        let r = self.marker.get_binding(var_num);
+
+                        if r.reg_num() == 0 {
+                            self.marker.mark_var::<QueryInstruction>(
+                                var_num, lvl, cell, term_loc, &mut code,
+                            );
+                            cell.get().norm()
+                        } else {
+                            self.marker.increment_running_count(var_num);
+                            r
+                        }
                     } else {
+                        self.marker.increment_running_count(var_num);
                         cell.get().norm()
                     };
 
                     self.interm.push(ArithmeticTerm::Reg(r));
                 }
                 ArithTermRef::Op(name, arity) => {
-                    code.push(self.instr_from_clause(name, arity)?);
+                    code.push_back(self.instr_from_clause(name, arity)?);
                 }
             }
         }
@@ -364,16 +352,17 @@ impl<'a> ArithmeticEvaluator<'a> {
 }
 
 // integer division rounding function -- 9.1.3.1.
-pub(crate) fn rnd_i<'a>(n: &'a Number, arena: &mut Arena) -> Number {
+pub(crate) fn rnd_i(n: &'_ Number, arena: &mut Arena) -> Number {
     match n {
         &Number::Integer(i) => {
-            if let Some(n) = i.to_i64() {
+            let result = (&*i).try_into();
-                fixnum!(Number, n, arena)
+            if let Ok(value) = result {
+                fixnum!(Number, value, arena)
             } else {
                 *n
             }
         }
-        &Number::Fixnum(_) => *n,
+        Number::Fixnum(_) => *n,
         &Number::Float(f) => {
             let f = f.floor();
 
@@ -383,16 +372,14 @@ pub(crate) fn rnd_i<'a>(n: &'a Number, arena: &mut Arena) -> Number {
             if I64_MIN_TO_F <= f && f <= I64_MAX_TO_F {
                 fixnum!(Number, f.into_inner() as i64, arena)
             } else {
-                Number::Integer(arena_alloc!(Integer::from_f64(f.into_inner()).unwrap(), arena))
+                Number::Integer(arena_alloc!(Integer::from(f.0 as i64), arena))
             }
         }
-        &Number::Rational(ref r) => {
+        Number::Rational(ref r) => {
-            let r_ref = r.fract_floor_ref();
+            let (_, floor) = (r.fract(), r.floor());
-            let (mut fract, mut floor) = (Rational::new(), Integer::new());
-            (&mut fract, &mut floor).assign(r_ref);
 
-            if let Some(floor) = floor.to_i64() {
+            if let Ok(value) = (&floor).try_into() {
-                fixnum!(Number, floor, arena)
+                fixnum!(Number, value, arena)
             } else {
                 Number::Integer(arena_alloc!(floor, arena))
             }
@@ -411,9 +398,9 @@ impl From<Fixnum> for Integer {
 pub(crate) fn rnd_f(n: &Number) -> f64 {
     match n {
         &Number::Fixnum(n) => n.get_num() as f64,
-        &Number::Integer(ref n) => n.to_f64(),
+        Number::Integer(ref n) => n.to_f64().value(),
         &Number::Float(OrderedFloat(f)) => f,
-        &Number::Rational(ref r) => r.to_f64(),
+        Number::Rational(ref r) => r.to_f64().value(),
     }
 }
 
@@ -433,7 +420,7 @@ fn classify_float(f: f64) -> Result<f64, EvalError> {
             }
         }
         FpCategory::Nan => Err(EvalError::Undefined),
-        _ => Ok(f)
+        _ => Ok(f),
     }
 }
 
@@ -444,12 +431,12 @@ pub(crate) fn float_fn_to_f(n: i64) -> Result<f64, EvalError> {
 
 #[inline]
 pub(crate) fn float_i_to_f(n: &Integer) -> Result<f64, EvalError> {
-    classify_float(n.to_f64())
+    classify_float(n.to_f64().value())
 }
 
 #[inline]
 pub(crate) fn float_r_to_f(r: &Rational) -> Result<f64, EvalError> {
-    classify_float(r.to_f64())
+    classify_float(r.to_f64().value())
 }
 
 #[inline]
@@ -541,39 +528,51 @@ impl PartialEq for Number {
     fn eq(&self, rhs: &Self) -> bool {
         match (self, rhs) {
             (&Number::Fixnum(n1), &Number::Fixnum(n2)) => n1.eq(&n2),
-            (&Number::Fixnum(n1), &Number::Integer(ref n2)) => n1.get_num().eq(&**n2),
+            (&Number::Fixnum(n1), Number::Integer(ref n2)) => n1.get_num().num_eq(&**n2),
-            (&Number::Integer(ref n1), &Number::Fixnum(n2)) => (&**n1).eq(&n2.get_num()),
+            (Number::Integer(ref n1), &Number::Fixnum(n2)) => n1.num_eq(&n2.get_num()),
-            (&Number::Fixnum(n1), &Number::Rational(ref n2)) => n1.get_num().eq(&**n2),
+            (&Number::Fixnum(n1), Number::Rational(ref n2)) => {
-            (&Number::Rational(ref n1), &Number::Fixnum(n2)) => (&**n1).eq(&n2.get_num()),
+                Integer::from(n1.get_num()).num_eq(&**n2)
+            }
+            (Number::Rational(ref n1), &Number::Fixnum(n2)) => {
+                n1.num_eq(&Integer::from(n2.get_num()))
+            }
             (&Number::Fixnum(n1), &Number::Float(n2)) => OrderedFloat(n1.get_num() as f64).eq(&n2),
             (&Number::Float(n1), &Number::Fixnum(n2)) => n1.eq(&OrderedFloat(n2.get_num() as f64)),
-            (&Number::Integer(ref n1), &Number::Integer(ref n2)) => n1.eq(n2),
+            (Number::Integer(ref n1), Number::Integer(ref n2)) => n1.eq(n2),
-            (&Number::Integer(ref n1), Number::Float(n2)) => OrderedFloat(n1.to_f64()).eq(n2),
+            (Number::Integer(ref n1), Number::Float(n2)) => {
-            (&Number::Float(n1), &Number::Integer(ref n2)) => n1.eq(&OrderedFloat(n2.to_f64())),
+                OrderedFloat(n1.to_f64().value()).eq(n2)
-            (&Number::Integer(ref n1), &Number::Rational(ref n2)) => {
+            }
+            (&Number::Float(n1), Number::Integer(ref n2)) => {
+                n1.eq(&OrderedFloat(n2.to_f64().value()))
+            }
+            (Number::Integer(ref n1), Number::Rational(ref n2)) => {
                 #[cfg(feature = "num")]
                 {
                     &Rational::from(&**n1) == &**n2
                 }
                 #[cfg(not(feature = "num"))]
                 {
-                    &**n1 == &**n2
+                    n1.num_eq(&**n2)
                 }
             }
-            (&Number::Rational(ref n1), &Number::Integer(ref n2)) => {
+            (Number::Rational(ref n1), Number::Integer(ref n2)) => {
                 #[cfg(feature = "num")]
                 {
-                    &**n1 == &Rational::from(&**n2)
+                    n1 == &Rational::from(&**n2)
                 }
                 #[cfg(not(feature = "num"))]
                 {
-                    &**n1 == &**n2
+                    n1.num_eq(&**n2)
                 }
             }
-            (&Number::Rational(ref n1), &Number::Float(n2)) => OrderedFloat(n1.to_f64()).eq(&n2),
+            (Number::Rational(ref n1), &Number::Float(n2)) => {
-            (&Number::Float(n1), &Number::Rational(ref n2)) => n1.eq(&OrderedFloat(n2.to_f64())),
+                OrderedFloat(n1.to_f64().value()).eq(&n2)
+            }
+            (&Number::Float(n1), Number::Rational(ref n2)) => {
+                n1.eq(&OrderedFloat(n2.to_f64().value()))
+            }
             (&Number::Float(f1), &Number::Float(f2)) => f1.eq(&f2),
-            (&Number::Rational(ref r1), &Number::Rational(ref r2)) => r1.eq(&r2),
+            (Number::Rational(ref r1), Number::Rational(ref r2)) => r1.eq(r2),
         }
     }
 }
@@ -593,8 +592,8 @@ impl PartialOrd<usize> for Number {
                     (n as usize).partial_cmp(rhs)
                 }
             }
-            Number::Integer(n) => (&**n).partial_cmp(rhs),
+            Number::Integer(n) => Some((n).num_cmp(rhs)),
-            Number::Rational(r) => (&**r).partial_cmp(rhs),
+            Number::Rational(r) => Some((r).num_cmp(&Integer::from(*rhs))),
             Number::Float(f) => f.partial_cmp(&OrderedFloat(*rhs as f64)),
         }
     }
@@ -613,8 +612,8 @@ impl PartialEq<usize> for Number {
                     (n as usize).eq(rhs)
                 }
             }
-            Number::Integer(n) => (&**n).eq(rhs),
+            Number::Integer(n) => (n).num_eq(rhs),
-            Number::Rational(r) => (&**r).eq(rhs),
+            Number::Rational(r) => (r).num_eq(&Integer::from(*rhs)),
             Number::Float(f) => f.eq(&OrderedFloat(*rhs as f64)),
         }
     }
@@ -630,17 +629,19 @@ impl Ord for Number {
     fn cmp(&self, rhs: &Number) -> Ordering {
         match (self, rhs) {
             (&Number::Fixnum(n1), &Number::Fixnum(n2)) => n1.get_num().cmp(&n2.get_num()),
-            (&Number::Fixnum(n1), Number::Integer(n2)) => Integer::from(n1.get_num()).cmp(&*n2),
+            (&Number::Fixnum(n1), Number::Integer(n2)) => Integer::from(n1.get_num()).cmp(n2),
-            (Number::Integer(n1), &Number::Fixnum(n2)) => (&**n1).cmp(&Integer::from(n2.get_num())),
+            (Number::Integer(n1), &Number::Fixnum(n2)) => (**n1).cmp(&Integer::from(n2.get_num())),
-            (&Number::Fixnum(n1), Number::Rational(n2)) => Rational::from(n1.get_num()).cmp(&*n2),
+            (&Number::Fixnum(n1), Number::Rational(n2)) => Rational::from(n1.get_num()).cmp(n2),
             (Number::Rational(n1), &Number::Fixnum(n2)) => {
-                (&**n1).cmp(&Rational::from(n2.get_num()))
+                (**n1).cmp(&Rational::from(n2.get_num()))
             }
             (&Number::Fixnum(n1), &Number::Float(n2)) => OrderedFloat(n1.get_num() as f64).cmp(&n2),
             (&Number::Float(n1), &Number::Fixnum(n2)) => n1.cmp(&OrderedFloat(n2.get_num() as f64)),
             (&Number::Integer(n1), &Number::Integer(n2)) => (*n1).cmp(&*n2),
-            (&Number::Integer(n1), Number::Float(n2)) => OrderedFloat(n1.to_f64()).cmp(n2),
+            (&Number::Integer(n1), Number::Float(n2)) => OrderedFloat(n1.to_f64().value()).cmp(n2),
-            (&Number::Float(n1), &Number::Integer(ref n2)) => n1.cmp(&OrderedFloat(n2.to_f64())),
+            (&Number::Float(n1), Number::Integer(ref n2)) => {
+                n1.cmp(&OrderedFloat(n2.to_f64().value()))
+            }
             (&Number::Integer(n1), &Number::Rational(n2)) => {
                 #[cfg(feature = "num")]
                 {
@@ -648,7 +649,7 @@ impl Ord for Number {
                 }
                 #[cfg(not(feature = "num"))]
                 {
-                    (&*n1).partial_cmp(&*n2).unwrap_or(Ordering::Less)
+                    (*n1).num_partial_cmp(&*n2).unwrap_or(Ordering::Less)
                 }
             }
             (&Number::Rational(n1), &Number::Integer(n2)) => {
@@ -658,11 +659,15 @@ impl Ord for Number {
                 }
                 #[cfg(not(feature = "num"))]
                 {
-                    (&*n1).partial_cmp(&*n2).unwrap_or(Ordering::Less)
+                    (*n1).num_partial_cmp(&*n2).unwrap_or(Ordering::Less)
                 }
             }
-            (&Number::Rational(n1), &Number::Float(n2)) => OrderedFloat(n1.to_f64()).cmp(&n2),
+            (&Number::Rational(n1), &Number::Float(n2)) => {
-            (&Number::Float(n1), &Number::Rational(n2)) => n1.cmp(&OrderedFloat(n2.to_f64())),
+                OrderedFloat(n1.to_f64().value()).cmp(&n2)
+            }
+            (&Number::Float(n1), &Number::Rational(n2)) => {
+                n1.cmp(&OrderedFloat(n2.to_f64().value()))
+            }
             (&Number::Float(f1), &Number::Float(f2)) => f1.cmp(&f2),
             (&Number::Rational(r1), &Number::Rational(r2)) => (*r1).cmp(&*r2),
         }
@@ -691,7 +696,7 @@ impl TryFrom<HeapCellValue> for Number {
            (HeapCellValueTag::F64, n) => {
                Ok(Number::Float(*n))
            }
-           (HeapCellValueTag::Fixnum, n) => {
+           (HeapCellValueTag::Fixnum | HeapCellValueTag::CutPoint, n) => {
                Ok(Number::Fixnum(n))
            }
            _ => {
@@ -703,20 +708,20 @@ impl TryFrom<HeapCellValue> for Number {
 
 // Computes n ^ power. Ignores the sign of power.
 pub(crate) fn binary_pow(mut n: Integer, power: &Integer) -> Integer {
-    let mut power = Integer::from(power.abs_ref());
+    let mut power = power.abs();
 
-    if power == 0 {
+    if power.is_zero() {
-        return Integer::from(1);
+        return Integer::ONE;
     }
 
-    let mut oddand = Integer::from(1);
+    let mut oddand = Integer::ONE;
 
-    while power > 1 {
+    while power.num_gt(&1) {
-        if power.is_odd() {
+        if power.bit(0) {
             oddand *= &n;
         }
 
-        n.pow_assign(2);
+        n = n.pow(2);
         power >>= 1;
     }
 

src/atom_table.rs

@@ -1,22 +1,27 @@
 use crate::parser::ast::MAX_ARITY;
 use crate::raw_block::*;
+use crate::rcu::{Rcu, RcuRef};
 use crate::types::*;
 
-use std::borrow::Borrow;
 use std::cmp::Ordering;
 use std::hash::{Hash, Hasher};
 use std::mem;
+use std::ops::Deref;
 use std::ptr;
 use std::slice;
 use std::str;
+use std::sync::Arc;
+use std::sync::Mutex;
+use std::sync::RwLock;
+use std::sync::Weak;
 
 use indexmap::IndexSet;
 
-use modular_bitfield::prelude::*;
+use scryer_modular_bitfield::prelude::*;
 
 #[derive(Copy, Clone, Debug, PartialEq, Eq)]
 pub struct Atom {
-    pub index: usize,
+    pub index: u64,
 }
 
 const_assert!(mem::size_of::<Atom>() == 8);
@@ -33,46 +38,43 @@ impl<'a> From<&'a Atom> for Atom {
 impl From<bool> for Atom {
     #[inline]
     fn from(value: bool) -> Self {
-        if value { atom!("true") } else { atom!("false") }
+        if value {
+            atom!("true")
+        } else {
+            atom!("false")
+        }
     }
 }
 
-#[cfg(test)]
+impl indexmap::Equivalent<Atom> for str {
-use std::cell::RefCell;
+    fn equivalent(&self, key: &Atom) -> bool {
+        &*key.as_str() == self
+    }
+}
 
 const ATOM_TABLE_INIT_SIZE: usize = 1 << 16;
 const ATOM_TABLE_ALIGN: usize = 8;
 
-#[cfg(test)]
+#[inline(always)]
-thread_local! {
+fn global_atom_table() -> &'static RwLock<Weak<AtomTable>> {
-    static ATOM_TABLE_BUF_BASE: RefCell<*const u8> = RefCell::new(ptr::null_mut());
+    #[cfg(feature = "rust_beta_channel")]
-}
+    {
-
+        // const Weak::new will be stabilized in 1.73 which is currently in beta,
-#[cfg(not(test))]
+        // till then we need a OnceLock for initialization
-static mut ATOM_TABLE_BUF_BASE: *const u8 = ptr::null_mut();
+        static GLOBAL_ATOM_TABLE: RwLock<Weak<AtomTable>> = RwLock::const_new(Weak::new());
-
+        &GLOBAL_ATOM_TABLE
-#[cfg(test)]
+    }
-fn set_atom_tbl_buf_base(ptr: *const u8) {
+    #[cfg(not(feature = "rust_beta_channel"))]
-    ATOM_TABLE_BUF_BASE.with(|atom_table_buf_base| {
+    {
-        *atom_table_buf_base.borrow_mut() = ptr;
+        use std::sync::OnceLock;
-    });
+        static GLOBAL_ATOM_TABLE: OnceLock<RwLock<Weak<AtomTable>>> = OnceLock::new();
-}
+        GLOBAL_ATOM_TABLE.get_or_init(|| RwLock::new(Weak::new()))
-
-#[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))]
+#[inline(always)]
-pub(crate) fn get_atom_tbl_buf_base() -> *const u8 {
+fn arc_atom_table() -> Option<Arc<AtomTable>> {
-    unsafe { ATOM_TABLE_BUF_BASE }
+    global_atom_table().read().unwrap().upgrade()
 }
 
 impl RawBlockTraits for AtomTable {
@@ -90,9 +92,11 @@ impl RawBlockTraits for AtomTable {
 #[bitfield]
 #[derive(Copy, Clone, Debug)]
 struct AtomHeader {
-    #[allow(unused)] m: bool,
+    #[allow(unused)]
+    m: bool,
     len: B50,
-    #[allow(unused)] padding: B13,
+    #[allow(unused)]
+    padding: B13,
 }
 
 impl AtomHeader {
@@ -101,13 +105,6 @@ impl AtomHeader {
     }
 }
 
-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) {
@@ -123,49 +120,102 @@ macro_rules! is_char {
     };
 }
 
-impl Atom {
+pub enum AtomString<'a> {
-    #[inline]
+    Static(&'a str),
-    pub fn buf(self) -> *const u8 {
+    Dynamic(AtomTableRef<str>),
-        let ptr = self.as_ptr();
+}
 
-        if ptr.is_null() {
+impl AtomString<'_> {
-            return ptr::null();
+    pub fn map<F>(self, f: F) -> Self
+    where
+        for<'a> F: FnOnce(&'a str) -> &'a str,
+    {
+        match self {
+            Self::Static(reference) => Self::Static(f(reference)),
+            Self::Dynamic(guard) => Self::Dynamic(AtomTableRef::map(guard, f)),
         }
+    }
+}
 
-        (ptr as usize + mem::size_of::<AtomHeader>()) as *const u8
+impl std::fmt::Debug for AtomString<'_> {
+    fn fmt(&self, f: &mut std::fmt::Formatter) -> std::fmt::Result {
+        std::fmt::Debug::fmt(self.deref(), f)
+    }
+}
+
+impl std::fmt::Display for AtomString<'_> {
+    fn fmt(&self, f: &mut std::fmt::Formatter) -> std::fmt::Result {
+        std::fmt::Display::fmt(self.deref(), f)
+    }
+}
+
+impl std::ops::Deref for AtomString<'_> {
+    type Target = str;
+    fn deref(&self) -> &Self::Target {
+        match self {
+            Self::Static(reference) => reference,
+            Self::Dynamic(guard) => guard.deref(),
+        }
+    }
+}
+
+#[cfg(feature = "repl")]
+impl rustyline::completion::Candidate for AtomString<'_> {
+    fn display(&self) -> &str {
+        self.deref()
     }
 
+    fn replacement(&self) -> &str {
+        self.deref()
+    }
+}
+
+impl Atom {
     #[inline(always)]
     pub fn is_static(self) -> bool {
-        self.index < STRINGS.len() << 3
+        (self.index as usize) < STRINGS.len() << 3
     }
 
     #[inline(always)]
-    pub fn as_ptr(self) -> *const u8 {
+    pub fn as_ptr(self) -> Option<AtomTableRef<u8>> {
         if self.is_static() {
-            ptr::null()
+            None
         } else {
-            (get_atom_tbl_buf_base() as usize + self.index - (STRINGS.len() << 3)) as *const u8
+            let atom_table =
+                arc_atom_table().expect("We should only have an Atom while there is an AtomTable");
+            unsafe {
+                AtomTableRef::try_map(atom_table.buf(), |buf| {
+                    (buf as *const u8)
+                        .add((self.index as usize) - (STRINGS.len() << 3))
+                        .as_ref()
+                })
+            }
         }
     }
 
     #[inline(always)]
-    pub fn from(index: usize) -> Self {
+    pub fn from(index: u64) -> Self {
         Self { index }
     }
 
     #[inline(always)]
     pub fn len(self) -> usize {
         if self.is_static() {
-            STRINGS[self.index >> 3].len()
+            STRINGS[(self.index >> 3) as usize].len()
         } else {
-            unsafe { ptr::read(self.as_ptr() as *const AtomHeader).len() as _ }
+            let ptr = self.as_ptr().unwrap();
+            let ptr = ptr.deref() as *const u8 as *const AtomHeader;
+            unsafe { ptr::read(ptr) }.len() as _
         }
     }
 
+    pub fn is_empty(self) -> bool {
+        self.len() == 0
+    }
+
     #[inline(always)]
     pub fn flat_index(self) -> u64 {
-        (self.index >> 3) as u64
+        self.index >> 3
     }
 
     pub fn as_char(self) -> Option<char> {
@@ -175,48 +225,49 @@ impl Atom {
         let c1 = it.next();
         let c2 = it.next();
 
-        if c2.is_none() { c1 } else { None }
+        if c2.is_none() {
-    }
+            c1
-
+        } else {
-    #[inline]
+            None
-    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 {
+    #[inline]
+    pub fn as_str(&self) -> AtomString<'static> {
+        if self.is_static() {
+            AtomString::Static(STRINGS[(self.index >> 3) as usize])
+        } else if let Some(ptr) = self.as_ptr() {
+            AtomString::Dynamic(AtomTableRef::map(ptr, |ptr| {
+                let header =
+                    // Miri seems to hit this line a lot
+                    unsafe { ptr::read::<AtomHeader>(ptr as *const u8 as *const AtomHeader) };
+                let len = header.len() as usize;
+                let buf = unsafe { (ptr as *const u8).add(mem::size_of::<AtomHeader>()) };
+
+                unsafe { str::from_utf8_unchecked(slice::from_raw_parts(buf, len)) }
+            }))
+        } else {
+            AtomString::Static(STRINGS[(self.index >> 3) as usize])
+        }
+    }
+
+    pub fn defrock_brackets(&self, atom_tbl: &AtomTable) -> Self {
         let s = self.as_str();
 
-        let s = if s.starts_with('(') && s.ends_with(')') {
+        let sub_str = if s.starts_with('(') && s.ends_with(')') {
             &s['('.len_utf8()..s.len() - ')'.len_utf8()]
         } else {
             return *self;
         };
 
-        atom_tbl.build_with(s)
+        AtomTable::build_with(atom_tbl, sub_str)
     }
 }
 
 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;
+    let str_ptr = ptr.add(mem::size_of::<AtomHeader>());
-    ptr::copy_nonoverlapping(string.as_ptr(), str_ptr as *mut u8, string.len());
+    ptr::copy_nonoverlapping(string.as_ptr(), str_ptr, string.len());
 }
 
 impl PartialOrd for Atom {
@@ -229,100 +280,156 @@ impl PartialOrd for Atom {
 impl Ord for Atom {
     #[inline]
     fn cmp(&self, other: &Atom) -> Ordering {
-        self.as_str().cmp(other.as_str())
+        self.as_str().cmp(&*other.as_str())
     }
 }
 
 #[derive(Debug)]
-pub struct AtomTable {
+pub struct InnerAtomTable {
     block: RawBlock<AtomTable>,
-    pub table: IndexSet<Atom>,
+    pub table: Rcu<IndexSet<Atom>>,
 }
 
-impl Drop for AtomTable {
+#[derive(Debug)]
-    fn drop(&mut self) {
+pub struct AtomTable {
-        self.block.deallocate();
+    inner: Rcu<InnerAtomTable>,
+    // this lock is taking during resizing
+    update: Mutex<()>,
+}
+
+pub type AtomTableRef<M> = RcuRef<InnerAtomTable, M>;
+
+impl InnerAtomTable {
+    #[inline(always)]
+    fn lookup_str(self: &InnerAtomTable, string: &str) -> Option<Atom> {
+        STATIC_ATOMS_MAP
+            .get(string)
+            .cloned()
+            .or_else(|| self.table.active_epoch().get(string).cloned())
     }
 }
 
 impl AtomTable {
     #[inline]
-    pub fn new() -> Self {
+    pub fn new() -> Arc<Self> {
-        let table = Self {
+        let upgraded = global_atom_table().read().unwrap().upgrade();
-            block: RawBlock::new(),
+        // don't inline upgraded, otherwise temporary will be dropped too late in case of None
-            table: IndexSet::new(),
+        if let Some(atom_table) = upgraded {
-        };
+            atom_table
-
+        } else {
-        set_atom_tbl_buf_base(table.block.base);
+            let mut guard = global_atom_table().write().unwrap();
-        table
+            // try to upgrade again in case we lost the race on the write lock
-    }
+            if let Some(atom_table) = guard.upgrade() {
-
+                atom_table
-    #[inline]
+            } else {
-    pub fn buf(&self) -> *const u8 {
+                let atom_table = Arc::new(Self {
-        self.block.base as *const u8
+                    inner: Rcu::new(InnerAtomTable {
-    }
+                        block: RawBlock::new(),
-
+                        table: Rcu::new(IndexSet::new()),
-    #[inline]
+                    }),
-    pub fn top(&self) -> *const u8 {
+                    update: Mutex::new(()),
-        self.block.top
+                });
-    }
+                *guard = Arc::downgrade(&atom_table);
-
+                atom_table
-    #[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;
         }
+    }
+
+    #[inline]
+    pub fn buf(&self) -> AtomTableRef<u8> {
+        AtomTableRef::<InnerAtomTable>::map(self.inner.active_epoch(), |inner| {
+            unsafe { inner.block.base.as_ref() }.unwrap()
+        })
+    }
+
+    pub fn active_table(&self) -> RcuRef<IndexSet<Atom>, IndexSet<Atom>> {
+        self.inner.active_epoch().table.active_epoch()
+    }
+
+    pub fn build_with(atom_table: &AtomTable, string: &str) -> Atom {
+        loop {
+            let mut block_epoch = atom_table.inner.active_epoch();
+            let mut table_epoch = block_epoch.table.active_epoch();
+
+            if let Some(atom) = block_epoch.lookup_str(string) {
+                return atom;
+            }
+
+            // take a lock to prevent concurrent updates
+            let update_guard = atom_table.update.lock().unwrap();
+
+            let is_same_allocation =
+                RcuRef::same_epoch(&block_epoch, &atom_table.inner.active_epoch());
+            let is_same_atom_list =
+                RcuRef::same_epoch(&table_epoch, &block_epoch.table.active_epoch());
+
+            if !(is_same_allocation && is_same_atom_list) {
+                // some other thread raced us between our lookup and
+                // us aquring the update lock,
+                // try again
+                continue;
+            }
 
-        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 = {
+            unsafe {
-                let mut ptr;
+                let len_ptr = loop {
-
+                    let ptr = block_epoch.block.alloc(size);
-                loop {
-                    ptr = self.block.alloc(size);
 
                     if ptr.is_null() {
-                        self.block.grow();
+                        // garbage collection would go here
-                        set_atom_tbl_buf_base(self.block.base);
+                        let new_block = block_epoch.block.grow_new().unwrap();
+                        let new_table = Rcu::new(table_epoch.clone());
+                        let new_alloc = InnerAtomTable {
+                            block: new_block,
+                            table: new_table,
+                        };
+                        atom_table.inner.replace(new_alloc);
+                        block_epoch = atom_table.inner.active_epoch();
+                        table_epoch = block_epoch.table.active_epoch();
                     } else {
-                        break;
+                        break ptr;
                     }
-                }
+                };
 
-                ptr
+                let ptr_base = block_epoch.block.base as usize;
-            };
 
-            let ptr_base = self.block.base as usize;
+                write_to_ptr(string, len_ptr);
 
-            write_to_ptr(string, len_ptr);
+                let atom = Atom {
+                    index: ((STRINGS.len() << 3) + len_ptr as usize - ptr_base) as u64,
+                };
 
-            let atom = Atom {
+                let mut table = table_epoch.clone();
-                index: (STRINGS.len() << 3) + len_ptr as usize - ptr_base,
+                table.insert(atom);
-            };
+                block_epoch.table.replace(table);
 
-            self.table.insert(atom);
+                // expicit drop to ensure we don't accidentally drop it early
+                drop(update_guard);
 
-            atom
+                return atom;
+            }
         }
     }
 }
 
+unsafe impl Send for AtomTable {}
+unsafe impl Sync for AtomTable {}
+
 #[bitfield]
 #[repr(u64)]
 #[derive(Copy, Clone, Debug)]
 pub struct AtomCell {
     name: B46,
     arity: B10,
-    #[allow(unused)] f: bool,
+    #[allow(unused)]
-    #[allow(unused)] m: bool,
+    f: bool,
-    #[allow(unused)] tag: B6,
+    #[allow(unused)]
+    m: bool,
+    #[allow(unused)]
+    tag: B6,
 }
 
 impl AtomCell {
@@ -351,7 +458,7 @@ impl AtomCell {
 
     #[inline]
     pub fn get_name(self) -> Atom {
-        Atom::from(self.get_index() << 3)
+        Atom::from((self.get_index() as u64) << 3)
     }
 
     #[inline]
@@ -361,6 +468,6 @@ impl AtomCell {
 
     #[inline]
     pub fn get_name_and_arity(self) -> (Atom, usize) {
-        (Atom::from(self.get_index() << 3), self.get_arity())
+        (Atom::from((self.get_index() as u64) << 3), self.get_arity())
     }
 }

src/bin/scryer-prolog.rs

@@ -1,11 +1,27 @@
-fn main() {
+fn main() -> std::process::ExitCode {
-    use std::sync::atomic::Ordering;
+    use scryer_prolog::atom_table::Atom;
     use scryer_prolog::*;
 
+    #[cfg(feature = "repl")]
     ctrlc::set_handler(move || {
-        scryer_prolog::machine::INTERRUPT.store(true, Ordering::Relaxed);
+        scryer_prolog::machine::INTERRUPT.store(true, std::sync::atomic::Ordering::Relaxed);
-    }).unwrap();
+    })
+    .unwrap();
 
-    let mut wam = machine::Machine::new();
+    #[cfg(target_arch = "wasm32")]
-    wam.run_top_level();
+    let runtime = tokio::runtime::Builder::new_current_thread()
+        .enable_all()
+        .build()
+        .unwrap();
+
+    #[cfg(not(target_arch = "wasm32"))]
+    let runtime = tokio::runtime::Builder::new_multi_thread()
+        .enable_all()
+        .build()
+        .unwrap();
+
+    runtime.block_on(async move {
+        let mut wam = machine::Machine::new(Default::default());
+        wam.run_module_predicate(atom!("$toplevel"), (atom!("$repl"), 0))
+    })
 }

src/debray_allocator.rs

@@ -1,42 +1,277 @@
-use indexmap::IndexMap;
-
 use crate::allocator::*;
-use crate::fixtures::*;
+use crate::codegen::SubsumedBranchHits;
 use crate::forms::Level;
 use crate::instructions::*;
-use crate::machine::machine_indices::*;
+use crate::machine::disjuncts::VarData;
 use crate::parser::ast::*;
-use crate::targets::CompilationTarget;
+use crate::targets::*;
-
+use crate::variable_records::*;
-use crate::temp_v;
 
+use bit_set::*;
+use bitvec::prelude::*;
 use fxhash::FxBuildHasher;
+use indexmap::IndexMap;
 
 use std::cell::Cell;
-use std::collections::BTreeSet;
+use std::collections::VecDeque;
-use std::rc::Rc;
+use std::ops::{Deref, DerefMut};
+
+pub type BranchHits = IndexMap<usize, BitVec, FxBuildHasher>; // key: var_num, value: branch arm occurrences.
+
+#[derive(Debug, Default)]
+pub struct BranchOccurrences {
+    pub hits: BranchHits,
+    pub shallow_safety: BitSet<usize>, // unset means safe, set means unsafe (after the branch merge)
+    pub deep_safety: BitSet<usize>,
+    pub num_branches: usize,
+    pub current_branch: usize,
+    pub subsumed_hits: SubsumedBranchHits,
+}
+
+impl BranchOccurrences {
+    fn new(num_branches: usize) -> Self {
+        Self {
+            hits: BranchHits::with_hasher(FxBuildHasher::default()),
+            shallow_safety: BitSet::default(),
+            deep_safety: BitSet::default(),
+            num_branches,
+            current_branch: 0,
+            subsumed_hits: SubsumedBranchHits::with_hasher(FxBuildHasher::default()),
+        }
+    }
+
+    pub(crate) fn add_branch_occurrence(&mut self, var_num: usize) {
+        debug_assert!(self.current_branch < self.num_branches);
+        let num_branches = self.num_branches;
+
+        let entry = self
+            .hits
+            .entry(var_num)
+            .or_insert_with(|| BitVec::repeat(false, num_branches));
+
+        entry.set(self.current_branch, true);
+        self.subsumed_hits.insert(var_num);
+    }
+}
+
+#[derive(Debug)]
+pub(crate) struct BranchStack {
+    stack: Vec<BranchOccurrences>,
+}
+
+impl Deref for BranchStack {
+    type Target = Vec<BranchOccurrences>;
+
+    #[inline]
+    fn deref(&self) -> &Self::Target {
+        &self.stack
+    }
+}
+
+impl DerefMut for BranchStack {
+    #[inline]
+    fn deref_mut(&mut self) -> &mut Self::Target {
+        &mut self.stack
+    }
+}
+
+impl BranchStack {
+    fn branch_subsumes(&self, branch: &BranchDesignator, sub_branch: &BranchDesignator) -> bool {
+        if branch.branch_stack_num < sub_branch.branch_stack_num {
+            if branch.branch_stack_num == 0 {
+                true
+            } else {
+                let idx = branch.branch_stack_num - 1;
+                self[idx].current_branch == branch.branch_num
+            }
+        } else {
+            branch == sub_branch
+        }
+    }
+
+    fn safety_unneeded_in_branch(
+        &self,
+        safety: &VarSafetyStatus,
+        branch: &BranchDesignator,
+    ) -> bool {
+        match safety {
+            VarSafetyStatus::Needed => false,
+            VarSafetyStatus::LocallyUnneeded(planter_branch) => {
+                self.branch_subsumes(planter_branch, branch)
+            }
+            VarSafetyStatus::GloballyUnneeded => true,
+        }
+    }
+
+    pub(crate) fn add_branch_occurrence(&mut self, var_num: usize) {
+        if let Some(occurrences) = self.last_mut() {
+            occurrences.add_branch_occurrence(var_num);
+        }
+    }
+
+    pub(crate) fn add_branch_stack(&mut self, num_branches: usize) {
+        self.push(BranchOccurrences::new(num_branches));
+    }
+
+    pub(crate) fn current_branch_designator(&self) -> BranchDesignator {
+        let branch_stack_num = self.len();
+        let branch_num = self
+            .last()
+            .map(|occurrences| occurrences.current_branch)
+            .unwrap_or(0);
+
+        BranchDesignator {
+            branch_stack_num,
+            branch_num,
+        }
+    }
+
+    #[inline]
+    pub(crate) fn incr_current_branch(&mut self) {
+        let branch_occurrences = self.last_mut().unwrap();
+        branch_occurrences.current_branch += 1;
+    }
+
+    #[inline]
+    pub(crate) fn drain_branches(&mut self, depth: usize) -> std::vec::Drain<BranchOccurrences> {
+        let start_idx = self.len() - depth;
+        self.drain(start_idx..)
+    }
+}
 
 #[derive(Debug)]
 pub(crate) struct DebrayAllocator {
-    bindings: IndexMap<Rc<String>, VarData, FxBuildHasher>,
+    pub(crate) var_data: VarData, // var_data replaces bindings.
+    pub(crate) branch_stack: BranchStack,
+    pub(crate) in_tail_position: bool,
     arg_c: usize,
     temp_lb: usize,
+    perm_lb: usize,
     arity: usize, // 0 if not at head.
-    contents: IndexMap<usize, Rc<String>, FxBuildHasher>,
+    shallow_temp_mappings: IndexMap<usize, usize, FxBuildHasher>,
-    in_use: BTreeSet<usize>,
+    in_use: BitSet<usize>, // deep and non-var allocations
+    temp_free_list: Vec<usize>,
+    perm_free_list: VecDeque<(usize, usize)>, // chunk_num, var_num
 }
 
 impl DebrayAllocator {
-    fn is_curr_arg_distinct_from(&self, var: &String) -> bool {
+    pub(crate) fn add_branch(&mut self) {
-        match self.contents.get(&self.arg_c) {
+        let branch_designator = self.branch_stack.current_branch_designator();
-            Some(t_var) if **t_var != *var => true,
+        let subsumed_hits = {
+            let branch_occurrences = self.branch_stack.last_mut().unwrap();
+
+            std::mem::replace(
+                &mut branch_occurrences.subsumed_hits,
+                SubsumedBranchHits::with_hasher(FxBuildHasher::default()),
+            )
+        };
+
+        for var_num in subsumed_hits {
+            match &mut self.var_data.records[var_num].allocation {
+                VarAlloc::Perm(_, ref mut allocation) => {
+                    if let PermVarAllocation::Done {
+                        shallow_safety,
+                        deep_safety,
+                        ..
+                    } = allocation
+                    {
+                        if !self
+                            .branch_stack
+                            .safety_unneeded_in_branch(shallow_safety, &branch_designator)
+                        {
+                            let branch_occurrences = self.branch_stack.last_mut().unwrap();
+                            branch_occurrences.shallow_safety.insert(var_num);
+                        }
+
+                        if !self
+                            .branch_stack
+                            .safety_unneeded_in_branch(deep_safety, &branch_designator)
+                        {
+                            let branch_occurrences = self.branch_stack.last_mut().unwrap();
+                            branch_occurrences.deep_safety.insert(var_num);
+                        }
+                    }
+
+                    *allocation = PermVarAllocation::Pending;
+                }
+                _ => unreachable!(),
+            }
+        }
+    }
+
+    pub(crate) fn pop_branch(&mut self, depth: usize, subsumed_hits: SubsumedBranchHits) {
+        let removed_branches = self.branch_stack.drain_branches(depth);
+
+        let (deep_safety, shallow_safety) = removed_branches.into_iter().fold(
+            (BitSet::default(), BitSet::default()),
+            |(mut deep_safety, mut shallow_safety), branch_occurrences| {
+                deep_safety.union_with(&branch_occurrences.deep_safety);
+                shallow_safety.union_with(&branch_occurrences.shallow_safety);
+
+                (deep_safety, shallow_safety)
+            },
+        );
+
+        let branch_designator = self.branch_stack.current_branch_designator();
+
+        let (deep_safety, shallow_safety) = match self.branch_stack.last_mut() {
+            Some(latest_branch) => {
+                latest_branch.deep_safety.union_with(&deep_safety);
+                latest_branch.shallow_safety.union_with(&shallow_safety);
+
+                (&latest_branch.deep_safety, &latest_branch.shallow_safety)
+            }
+            None => (&deep_safety, &shallow_safety),
+        };
+
+        for var_num in subsumed_hits.iter().cloned() {
+            let running_count = self.var_data.records[var_num].running_count;
+            let num_occurrences = self.var_data.records[var_num].num_occurrences;
+
+            match &mut self.var_data.records[var_num].allocation {
+                VarAlloc::Perm(_, allocation) => {
+                    let shallow_safety = VarSafetyStatus::needed_if(
+                        shallow_safety.contains(var_num),
+                        branch_designator,
+                    );
+
+                    let deep_safety = VarSafetyStatus::needed_if(
+                        deep_safety.contains(var_num),
+                        branch_designator,
+                    );
+
+                    if running_count < num_occurrences {
+                        *allocation = PermVarAllocation::Done {
+                            shallow_safety,
+                            deep_safety,
+                        };
+                    }
+                }
+                _ => unreachable!(),
+            }
+        }
+
+        if self.branch_stack.len() > 0 {
+            for var_num in subsumed_hits {
+                self.branch_stack.add_branch_occurrence(var_num);
+            }
+        }
+    }
+
+    fn is_curr_arg_distinct_from(&self, var_num: usize) -> bool {
+        match self.shallow_temp_mappings.get(&self.arg_c).cloned() {
+            Some(t_var) => t_var != var_num,
             _ => false,
         }
     }
 
-    fn occurs_shallowly_in_head(&self, var: &String, r: usize) -> bool {
+    fn occurs_shallowly_in_head(&self, var_num: usize, r: usize) -> bool {
-        match self.bindings.get(var).unwrap() {
+        match &self.var_data.records[var_num].allocation {
-            &VarData::Temp(_, _, ref tvd) => tvd.use_set.contains(&(GenContext::Head, r)),
+            VarAlloc::Temp {
+                temp_var_data,
+                term_loc: GenContext::Head,
+                ..
+            } => temp_var_data.use_set.contains(&(GenContext::Head, r)),
             _ => false,
         }
     }
@@ -44,13 +279,13 @@ impl DebrayAllocator {
     #[inline]
     fn is_in_use(&self, r: usize) -> bool {
         let in_use_range = r <= self.arity && r >= self.arg_c;
-        in_use_range || self.in_use.contains(&r)
+        in_use_range || self.in_use.contains(r)
     }
 
-    fn alloc_with_cr(&self, var: &String) -> usize {
+    fn alloc_with_cr(&self, var_num: usize) -> usize {
-        match self.bindings.get(var) {
+        match &self.var_data.records[var_num].allocation {
-            Some(&VarData::Temp(_, _, ref tvd)) => {
+            VarAlloc::Temp { temp_var_data, .. } => {
-                for &(_, reg) in tvd.use_set.iter() {
+                for &(_, reg) in temp_var_data.use_set.iter() {
                     if !self.is_in_use(reg) {
                         return reg;
                     }
@@ -59,11 +294,9 @@ impl DebrayAllocator {
                 let mut result = 0;
 
                 for reg in self.temp_lb.. {
-                    if !self.is_in_use(reg) {
+                    if !self.is_in_use(reg) && !temp_var_data.no_use_set.contains(reg) {
-                        if !tvd.no_use_set.contains(&reg) {
+                        result = reg;
-                            result = reg;
+                        break;
-                            break;
-                        }
                     }
                 }
 
@@ -73,10 +306,10 @@ impl DebrayAllocator {
         }
     }
 
-    fn alloc_with_ca(&self, var: &String) -> usize {
+    fn alloc_with_ca(&self, var_num: usize) -> usize {
-        match self.bindings.get(var) {
+        match &self.var_data.records[var_num].allocation {
-            Some(&VarData::Temp(_, _, ref tvd)) => {
+            VarAlloc::Temp { temp_var_data, .. } => {
-                for &(_, reg) in tvd.use_set.iter() {
+                for &(_, reg) in temp_var_data.use_set.iter() {
                     if !self.is_in_use(reg) {
                         return reg;
                     }
@@ -85,13 +318,12 @@ impl DebrayAllocator {
                 let mut result = 0;
 
                 for reg in self.temp_lb.. {
-                    if !self.is_in_use(reg) {
+                    if !self.is_in_use(reg)
-                        if !tvd.no_use_set.contains(&reg) {
+                        && !temp_var_data.no_use_set.contains(reg)
-                            if !tvd.conflict_set.contains(&reg) {
+                        && !temp_var_data.conflict_set.contains(reg)
-                                result = reg;
+                    {
-                                break;
+                        result = reg;
-                            }
+                        break;
-                        }
                     }
                 }
 
@@ -101,22 +333,26 @@ impl DebrayAllocator {
         }
     }
 
-    fn alloc_in_last_goal_hint(&self, chunk_num: usize) -> Option<(Rc<String>, usize)> {
+    fn alloc_in_last_goal_hint(&self, chunk_num: usize) -> Option<(usize, 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;
 
-        match self.contents.get(&k) {
+        match self.shallow_temp_mappings.get(&k).cloned() {
             Some(t_var) => {
                 // suppose this branch fires. then t_var is a
                 // temp. var. belonging to the current chunk.
                 // consider its use set. T == par_k iff
                 // (GenContext::Last(_), k) is in t_var.use_set.
 
-                let tvd = self.bindings.get(t_var).unwrap();
+                if let VarAlloc::Temp { temp_var_data, .. } =
-                if let &VarData::Temp(_, _, ref tvd) = tvd {
+                    &self.var_data.records[t_var].allocation
-                    if !tvd.use_set.contains(&(GenContext::Last(chunk_num), k)) {
+                {
-                        return Some((t_var.clone(), self.alloc_with_ca(t_var)));
+                    if !temp_var_data
+                        .use_set
+                        .contains(&(GenContext::Last(chunk_num), k))
+                    {
+                        return Some((t_var, self.alloc_with_ca(t_var)));
                     }
                 }
 
@@ -129,51 +365,50 @@ impl DebrayAllocator {
     fn evacuate_arg<'a, Target: CompilationTarget<'a>>(
         &mut self,
         chunk_num: usize,
-        code: &mut Code,
+        code: &mut CodeDeque,
     ) {
-        match self.alloc_in_last_goal_hint(chunk_num) {
+        if let Some((var_num, r)) = self.alloc_in_last_goal_hint(chunk_num) {
-            Some((var, r)) => {
+            let k = self.arg_c;
-                let k = self.arg_c;
 
-                if r != k {
+            if r != k {
-                    let r = RegType::Temp(r);
+                let r = RegType::Temp(r);
 
-                    code.push(Target::move_to_register(r, k));
+                code.push_back(Target::move_to_register(r, k));
 
-                    self.contents.swap_remove(&k);
+                self.shallow_temp_mappings.swap_remove(&k);
-                    self.contents.insert(r.reg_num(), var.clone());
+                self.shallow_temp_mappings.insert(r.reg_num(), var_num);
 
-                    self.record_register(var, r);
+                self.var_data.records[var_num]
-                    self.in_use.insert(r.reg_num());
+                    .allocation
-                }
+                    .set_register(r.reg_num());
+                self.in_use.insert(r.reg_num());
             }
-            _ => {}
         };
     }
 
     fn alloc_reg_to_var<'a, Target: CompilationTarget<'a>>(
         &mut self,
-        var: &String,
+        var_num: usize,
         lvl: Level,
         term_loc: GenContext,
-        target: &mut Vec<Instruction>,
+        target: &mut CodeDeque,
     ) -> usize {
         match term_loc {
             GenContext::Head => {
                 if let Level::Shallow = lvl {
                     self.evacuate_arg::<Target>(0, target);
-                    self.alloc_with_cr(var)
+                    self.alloc_with_cr(var_num)
                 } else {
-                    self.alloc_with_ca(var)
+                    self.alloc_with_ca(var_num)
                 }
             }
-            GenContext::Mid(_) => self.alloc_with_ca(var),
+            GenContext::Mid(_) => self.alloc_with_ca(var_num),
             GenContext::Last(chunk_num) => {
                 if let Level::Shallow = lvl {
                     self.evacuate_arg::<Target>(chunk_num, target);
-                    self.alloc_with_cr(var)
+                    self.alloc_with_cr(var_num)
                 } else {
-                    self.alloc_with_ca(var)
+                    self.alloc_with_ca(var_num)
                 }
             }
         }
@@ -182,38 +417,260 @@ impl DebrayAllocator {
     fn alloc_reg_to_non_var(&mut self) -> usize {
         let mut final_index = 0;
 
+        while let Some(r) = self.temp_free_list.pop() {
+            if !self.is_in_use(r) {
+                self.in_use.insert(r);
+                return r;
+            }
+        }
+
         for index in self.temp_lb.. {
-            if !self.in_use.contains(&index) {
+            if !self.in_use.contains(index) {
                 final_index = index;
+                self.in_use.insert(final_index);
                 break;
             }
         }
 
-        self.in_use.insert(final_index);
         self.temp_lb = final_index + 1;
         final_index
     }
 
-    fn in_place(&self, var: &String, term_loc: GenContext, r: RegType, k: usize) -> bool {
+    fn in_place(&self, var_num: usize, 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() {
+            _ => match &self.var_data.records[var_num].allocation {
-                &VarData::Temp(_, o, _) if r.reg_num() == k => o == k,
+                &VarAlloc::Temp { temp_reg, .. } if r.reg_num() == k => temp_reg == k,
                 _ => false,
             },
         }
     }
+
+    fn alloc_perm_var(&mut self, var_num: usize, chunk_num: usize) -> usize {
+        let p = if let Some(p) = self.pop_free_perm(chunk_num) {
+            p
+        } else {
+            let p = self.perm_lb;
+            self.perm_lb += 1;
+
+            p
+        };
+
+        self.var_data.records[var_num].allocation = VarAlloc::Perm(p, PermVarAllocation::done());
+        p
+    }
+
+    pub(crate) fn add_reg_to_free_list(&mut self, r: RegType) {
+        if let RegType::Temp(r) = r {
+            self.in_use.remove(r);
+            self.temp_free_list.push(r);
+        }
+    }
+
+    pub fn reset_free_list(&mut self) {
+        self.temp_free_list.clear();
+    }
+
+    #[inline(always)]
+    pub fn get_binding(&self, var_num: usize) -> RegType {
+        self.var_data.records[var_num].allocation.as_reg_type()
+    }
+
+    pub fn num_perm_vars(&self) -> usize {
+        self.perm_lb - 1
+    }
+
+    pub fn increment_running_count(&mut self, var_num: usize) {
+        self.var_data.records[var_num].running_count += 1;
+    }
+
+    fn add_perm_to_free_list(&mut self, chunk_num: usize, var_num: usize) {
+        if let VarAlloc::Perm(..) = &self.var_data.records[var_num].allocation {
+            self.perm_free_list.push_back((chunk_num, var_num));
+        }
+    }
+
+    fn pop_free_perm(&mut self, chunk_num: usize) -> Option<usize> {
+        while let Some((perm_chunk_num, var_num)) = self.perm_free_list.front().cloned() {
+            if chunk_num > perm_chunk_num {
+                self.perm_free_list.pop_front();
+
+                match &mut self.var_data.records[var_num].allocation {
+                    VarAlloc::Perm(p, PermVarAllocation::Pending) if *p > 0 => {
+                        return Some(std::mem::replace(p, 0));
+                    }
+                    _ => {}
+                }
+            } else {
+                return None;
+            }
+        }
+
+        None
+    }
+
+    pub(crate) fn free_var(&mut self, chunk_num: usize, var_num: usize) {
+        if let VarAlloc::Perm(_, allocation) = &mut self.var_data.records[var_num].allocation {
+            *allocation = PermVarAllocation::Pending;
+            self.add_perm_to_free_list(chunk_num, var_num);
+        }
+    }
+
+    pub(crate) fn mark_safe_var_unconditionally(&mut self, var_num: usize) {
+        let branch_designator = self.branch_stack.current_branch_designator();
+
+        match &mut self.var_data.records[var_num].allocation {
+            VarAlloc::Perm(
+                _,
+                PermVarAllocation::Done {
+                    deep_safety,
+                    shallow_safety,
+                    ..
+                },
+            ) => {
+                *deep_safety = VarSafetyStatus::unneeded(branch_designator);
+                *shallow_safety = VarSafetyStatus::unneeded(branch_designator);
+            }
+            VarAlloc::Temp { safety, .. } => {
+                *safety = VarSafetyStatus::unneeded(branch_designator);
+            }
+            _ => unreachable!(),
+        }
+    }
+
+    fn mark_safe_var(&mut self, var_num: usize, lvl: Level, term_loc: GenContext) {
+        let branch_designator = self.branch_stack.current_branch_designator();
+
+        match &mut self.var_data.records[var_num].allocation {
+            VarAlloc::Perm(
+                _,
+                PermVarAllocation::Done {
+                    deep_safety,
+                    shallow_safety,
+                    ..
+                },
+            ) => {
+                // GetVariable in head chunk is considered safe.
+                if lvl == Level::Deep {
+                    *deep_safety = VarSafetyStatus::unneeded(branch_designator);
+                    *shallow_safety = VarSafetyStatus::unneeded(branch_designator);
+                } else if term_loc == GenContext::Head {
+                    *shallow_safety = VarSafetyStatus::GloballyUnneeded;
+                } else if let Some(&temp_var_num) = self.shallow_temp_mappings.get(&self.arg_c) {
+                    match &mut self.var_data.records[temp_var_num].allocation {
+                        VarAlloc::Temp {
+                            ref mut to_perm_var_num,
+                            ..
+                        } => {
+                            *to_perm_var_num = Some(var_num);
+                        }
+                        _ => unreachable!(),
+                    }
+                }
+            }
+            VarAlloc::Temp { ref mut safety, .. } => {
+                *safety = VarSafetyStatus::GloballyUnneeded;
+            }
+            _ => {
+                unreachable!()
+            }
+        }
+    }
+
+    fn argument_to_value<'a, Target: CompilationTarget<'a>>(
+        &mut self,
+        var_num: usize,
+        r: RegType,
+        arg_c: usize,
+    ) -> Instruction {
+        let branch_designator = self.branch_stack.current_branch_designator();
+
+        match &mut self.var_data.records[var_num].allocation {
+            VarAlloc::Perm(
+                _,
+                PermVarAllocation::Done {
+                    ref mut shallow_safety,
+                    ..
+                },
+            ) => {
+                if !self.in_tail_position
+                    || self
+                        .branch_stack
+                        .safety_unneeded_in_branch(shallow_safety, &branch_designator)
+                {
+                    Target::argument_to_value(r, arg_c)
+                } else {
+                    *shallow_safety = VarSafetyStatus::unneeded(branch_designator);
+                    Target::unsafe_argument_to_value(r, arg_c)
+                }
+            }
+            VarAlloc::Temp { .. } => {
+                debug_assert!(matches!(r, RegType::Temp(_)));
+                Target::argument_to_value(r, arg_c)
+            }
+            _ => {
+                unreachable!()
+            }
+        }
+    }
+
+    fn subterm_to_value<'a, Target: CompilationTarget<'a>>(
+        &mut self,
+        var_num: usize,
+        r: RegType,
+    ) -> Instruction {
+        let branch_designator = self.branch_stack.current_branch_designator();
+
+        match &mut self.var_data.records[var_num].allocation {
+            VarAlloc::Perm(
+                _,
+                PermVarAllocation::Done {
+                    ref mut deep_safety,
+                    ..
+                },
+            ) => {
+                if self
+                    .branch_stack
+                    .safety_unneeded_in_branch(deep_safety, &branch_designator)
+                {
+                    Target::subterm_to_value(r)
+                } else {
+                    *deep_safety = VarSafetyStatus::unneeded(branch_designator);
+                    Target::unsafe_subterm_to_value(r)
+                }
+            }
+            VarAlloc::Temp { ref mut safety, .. } => {
+                if self
+                    .branch_stack
+                    .safety_unneeded_in_branch(safety, &branch_designator)
+                {
+                    Target::subterm_to_value(r)
+                } else {
+                    *safety = VarSafetyStatus::unneeded(branch_designator);
+                    Target::unsafe_subterm_to_value(r)
+                }
+            }
+            _ => {
+                unreachable!()
+            }
+        }
+    }
 }
 
 impl Allocator for DebrayAllocator {
     fn new() -> DebrayAllocator {
-        DebrayAllocator {
+        Self {
+            var_data: VarData::default(),
+            in_tail_position: false,
             arity: 0,
             arg_c: 1,
             temp_lb: 1,
-            bindings: IndexMap::with_hasher(FxBuildHasher::default()),
+            perm_lb: 1,
-            contents: IndexMap::with_hasher(FxBuildHasher::default()),
+            shallow_temp_mappings: IndexMap::with_hasher(FxBuildHasher::default()),
-            in_use: BTreeSet::new(),
+            in_use: BitSet::default(),
+            temp_free_list: vec![],
+            perm_free_list: VecDeque::new(),
+            branch_stack: BranchStack { stack: vec![] },
         }
     }
 
@@ -221,12 +678,12 @@ impl Allocator for DebrayAllocator {
         &mut self,
         lvl: Level,
         term_loc: GenContext,
-        code: &mut Code,
+        code: &mut CodeDeque,
     ) {
         let r = RegType::Temp(self.alloc_reg_to_non_var());
 
         match lvl {
-            Level::Deep => code.push(Target::subterm_to_variable(r)),
+            Level::Deep => code.push_back(Target::subterm_to_variable(r)),
             Level::Root | Level::Shallow => {
                 let k = self.arg_c;
 
@@ -236,7 +693,7 @@ impl Allocator for DebrayAllocator {
 
                 self.arg_c += 1;
 
-                code.push(Target::argument_to_variable(r, k));
+                code.push_back(Target::argument_to_variable(r, k));
             }
         };
     }
@@ -246,7 +703,7 @@ impl Allocator for DebrayAllocator {
         lvl: Level,
         term_loc: GenContext,
         cell: &'a Cell<RegType>,
-        code: &mut Code,
+        code: &mut CodeDeque,
     ) {
         let r = cell.get();
 
@@ -273,39 +730,51 @@ impl Allocator for DebrayAllocator {
 
     fn mark_var<'a, Target: CompilationTarget<'a>>(
         &mut self,
-        var: Rc<String>,
+        var_num: usize,
         lvl: Level,
-        cell: &'a Cell<VarReg>,
+        cell: &Cell<VarReg>,
         term_loc: GenContext,
-        code: &mut Code,
+        code: &mut CodeDeque,
     ) {
-        let (r, is_new_var) = match self.get(var.clone()) {
+        let (r, is_new_var) = match self.get_binding(var_num) {
             RegType::Temp(0) => {
-                // here, r is temporary *and* unassigned.
+                let o = self.alloc_reg_to_var::<Target>(var_num, lvl, term_loc, code);
-                let o = self.alloc_reg_to_var::<Target>(&var, lvl, term_loc, code);
                 cell.set(VarReg::Norm(RegType::Temp(o)));
-
                 (RegType::Temp(o), true)
             }
             RegType::Perm(0) => {
-                let pr = cell.get().norm();
+                let p = self.alloc_perm_var(var_num, term_loc.chunk_num());
-                self.record_register(var.clone(), pr);
+                cell.set(VarReg::Norm(RegType::Perm(p)));
+                (RegType::Perm(p), true)
+            }
+            r @ RegType::Perm(_) => {
+                let is_new_var = match &mut self.var_data.records[var_num].allocation {
+                    VarAlloc::Perm(_, allocation) => {
+                        if allocation.pending() {
+                            *allocation = PermVarAllocation::done();
+                            true
+                        } else {
+                            false
+                        }
+                    }
+                    _ => unreachable!(),
+                };
 
-                (pr, true)
+                (r, is_new_var)
             }
             r => (r, false),
         };
 
-        self.mark_reserved_var::<Target>(var, lvl, cell, term_loc, code, r, is_new_var);
+        self.mark_reserved_var::<Target>(var_num, lvl, cell, term_loc, code, r, is_new_var);
     }
 
     fn mark_reserved_var<'a, Target: CompilationTarget<'a>>(
         &mut self,
-        var: Rc<String>,
+        var_num: usize,
         lvl: Level,
-        cell: &'a Cell<VarReg>,
+        cell: &Cell<VarReg>,
         term_loc: GenContext,
-        code: &mut Code,
+        code: &mut CodeDeque,
         r: RegType,
         is_new_var: bool,
     ) {
@@ -313,84 +782,114 @@ impl Allocator for DebrayAllocator {
             Level::Root | Level::Shallow => {
                 let k = self.arg_c;
 
-                if self.is_curr_arg_distinct_from(&var) {
+                if self.is_curr_arg_distinct_from(var_num) {
                     self.evacuate_arg::<Target>(term_loc.chunk_num(), code);
                 }
 
-                self.arg_c += 1;
-
                 cell.set(VarReg::ArgAndNorm(r, k));
 
-                if !self.in_place(&var, term_loc, r, k) {
+                if !self.in_place(var_num, term_loc, r, k) {
                     if is_new_var {
-                        code.push(Target::argument_to_variable(r, k));
+                        self.mark_safe_var(var_num, lvl, term_loc);
+                        code.push_back(Target::argument_to_variable(r, k));
                     } else {
-                        code.push(Target::argument_to_value(r, k));
+                        code.push_back(self.argument_to_value::<Target>(var_num, r, k));
                     }
                 }
+
+                self.arg_c += 1;
             }
             Level::Deep if is_new_var => {
                 if let GenContext::Head = term_loc {
-                    if self.occurs_shallowly_in_head(&var, r.reg_num()) {
+                    if self.occurs_shallowly_in_head(var_num, r.reg_num()) {
-                        code.push(Target::subterm_to_value(r));
+                        code.push_back(self.subterm_to_value::<Target>(var_num, r));
                     } else {
-                        code.push(Target::subterm_to_variable(r));
+                        self.mark_safe_var(var_num, lvl, term_loc);
+                        code.push_back(Target::subterm_to_variable(r));
                     }
                 } else {
-                    code.push(Target::subterm_to_variable(r));
+                    self.mark_safe_var(var_num, lvl, term_loc);
+                    code.push_back(Target::subterm_to_variable(r));
                 }
             }
-            Level::Deep => code.push(Target::subterm_to_value(r)),
+            Level::Deep => code.push_back(self.subterm_to_value::<Target>(var_num, r)),
-        };
+        }
+
+        let o = r.reg_num();
 
         if !r.is_perm() {
-            let o = r.reg_num();
+            self.shallow_temp_mappings.insert(o, var_num);
+        } else if r.is_perm() && is_new_var {
+            self.branch_stack.add_branch_occurrence(var_num);
+        }
 
-            self.contents.insert(o, var.clone());
+        let record = &mut self.var_data.records[var_num];
-            self.record_register(var.clone(), r);
+
-            self.in_use.insert(o);
+        record.allocation.set_register(o);
+
+        if record.running_count < record.num_occurrences {
+            record.running_count += 1;
+        } else {
+            self.free_var(term_loc.chunk_num(), var_num);
+        }
+
+        self.in_use.insert(o);
+    }
+
+    fn mark_cut_var(&mut self, var_num: usize, chunk_num: usize) -> RegType {
+        match self.get_binding(var_num) {
+            RegType::Perm(0) => RegType::Perm(self.alloc_perm_var(var_num, chunk_num)),
+            RegType::Temp(0) => {
+                let t = self.alloc_reg_to_non_var();
+
+                match &mut self.var_data.records[var_num].allocation {
+                    VarAlloc::Temp {
+                        temp_reg, safety, ..
+                    } => {
+                        *temp_reg = t;
+                        *safety = VarSafetyStatus::GloballyUnneeded;
+                    }
+                    _ => unreachable!(),
+                };
+
+                RegType::Temp(t)
+            }
+            r => r,
         }
     }
 
     fn reset(&mut self) {
-        self.bindings.clear();
+        self.perm_lb = 1;
-        self.contents.clear();
+        self.shallow_temp_mappings.clear();
         self.in_use.clear();
+        self.temp_free_list.clear();
     }
 
     fn reset_contents(&mut self) {
-        self.contents.clear();
         self.in_use.clear();
+        self.shallow_temp_mappings.clear();
+        self.temp_free_list.clear();
     }
 
     fn advance_arg(&mut self) {
         self.arg_c += 1;
     }
 
-    fn bindings(&self) -> &AllocVarDict {
+    fn reset_at_head(&mut self, args: &[Term]) {
-        &self.bindings
-    }
-
-    fn bindings_mut(&mut self) -> &mut AllocVarDict {
-        &mut self.bindings
-    }
-
-    fn take_bindings(self) -> AllocVarDict {
-        self.bindings
-    }
-
-    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 {
+            if let Term::Var(_, ref var) = arg {
-                let r = self.get(var.clone());
+                let var_num = var.to_var_num().unwrap();
+                let r = self.get_binding(var_num);
 
                 if !r.is_perm() && r.reg_num() == 0 {
                     self.in_use.insert(idx + 1);
-                    self.contents.insert(idx + 1, var.clone());
+                    self.shallow_temp_mappings.insert(idx + 1, var_num);
-                    self.record_register(var.clone(), temp_v!(idx + 1));
+                    self.var_data.records[var_num]
+                        .allocation
+                        .set_register(idx + 1);
                 }
             }
         }

src/ffi.rs

@@ -0,0 +1,502 @@
+/* How does FFI work?
+
+Each WAM machine has a ForeignFunctionTable instance that contains a table of functions and structs.
+
+Structs are defined via foreign_struct/2. Basic types are defined by libffi, but struct types need to
+be manually defined to get an ffi_type. Additionally, to recover structs from return arguments, we store
+fields and atom_fields, as a way to lookup the content of the struct (fields) and the nested structs (atom_fields).
+
+Functions are defined via use_foreign_module/2. It opens a library and leaks the memory of the library,
+to prevent Rust freeing the memory. There's no way to recover that memory at the moment. We get a pointer for
+each function and we build a CIF for each one, with the input arguments and the return argument.
+
+Exec happens via '$foreign_call', we find the function, we try to cast the values that we have to the definition
+of the function, we reserve memory for them and we build an array of pointers. To get the return argument, we
+reserve enough memory for the return and we build the Scryer values from them.
+
+Structs are a bit tricky as they need to be aligned. For that, we reserve enough memory (libffi calculates that)
+and for each field: we add to the pointer until we're aligned to the next data type we're going to write, we write it,
+and finally we add the pointer the size of what we've written.
+*/
+
+use crate::atom_table::Atom;
+
+use std::alloc::{alloc, Layout};
+use std::any::Any;
+use std::collections::HashMap;
+use std::convert::TryFrom;
+use std::error::Error;
+use std::ffi::{c_void, CString};
+use std::ptr::addr_of_mut;
+
+use libffi::low::type_tag::STRUCT;
+use libffi::low::{ffi_abi_FFI_DEFAULT_ABI, ffi_cif, ffi_type, prep_cif, types, CodePtr};
+use libloading::{Library, Symbol};
+
+pub struct FunctionDefinition {
+    pub name: String,
+    pub return_value: Atom,
+    pub args: Vec<Atom>,
+}
+
+#[derive(Debug)]
+pub struct FunctionImpl {
+    cif: ffi_cif,
+    args: Vec<*mut ffi_type>,
+    code_ptr: CodePtr,
+    return_struct_name: Option<String>,
+}
+
+#[derive(Debug, Default)]
+pub struct ForeignFunctionTable {
+    table: HashMap<String, FunctionImpl>,
+    structs: HashMap<String, StructImpl>,
+}
+
+#[derive(Debug, Clone)]
+struct StructImpl {
+    ffi_type: ffi_type,
+    fields: Vec<*mut ffi_type>,
+    atom_fields: Vec<Atom>,
+}
+
+struct PointerArgs {
+    pointers: Vec<*mut c_void>,
+    _memory: Vec<Box<dyn Any>>,
+}
+
+impl ForeignFunctionTable {
+    pub fn merge(&mut self, other: ForeignFunctionTable) {
+        self.table.extend(other.table);
+    }
+
+    pub fn define_struct(&mut self, name: &str, atom_fields: Vec<Atom>) {
+        let mut fields: Vec<_> = atom_fields.iter().map(|x| self.map_type_ffi(x)).collect();
+        fields.push(std::ptr::null_mut::<ffi_type>());
+        let struct_type = ffi_type {
+            type_: STRUCT,
+            elements: fields.as_mut_ptr(),
+            ..Default::default()
+        };
+        self.structs.insert(
+            name.to_string(),
+            StructImpl {
+                ffi_type: struct_type,
+                fields,
+                atom_fields,
+            },
+        );
+    }
+
+    fn map_type_ffi(&mut self, source: &Atom) -> *mut ffi_type {
+        unsafe {
+            match source {
+                atom!("sint64") => addr_of_mut!(types::sint64),
+                atom!("sint32") => addr_of_mut!(types::sint32),
+                atom!("sint16") => addr_of_mut!(types::sint16),
+                atom!("sint8") => addr_of_mut!(types::sint8),
+                atom!("uint64") => addr_of_mut!(types::uint64),
+                atom!("uint32") => addr_of_mut!(types::uint32),
+                atom!("uint16") => addr_of_mut!(types::uint16),
+                atom!("uint8") => addr_of_mut!(types::uint8),
+                atom!("bool") => addr_of_mut!(types::sint8),
+                atom!("void") => addr_of_mut!(types::void),
+                atom!("cstr") => addr_of_mut!(types::pointer),
+                atom!("ptr") => addr_of_mut!(types::pointer),
+                atom!("f32") => addr_of_mut!(types::float),
+                atom!("f64") => addr_of_mut!(types::double),
+                struct_name => match self.structs.get_mut(&*struct_name.as_str()) {
+                    Some(ref mut struct_type) => &mut struct_type.ffi_type,
+                    None => unreachable!(),
+                },
+            }
+        }
+    }
+
+    pub(crate) fn load_library(
+        &mut self,
+        library_name: &str,
+        functions: &Vec<FunctionDefinition>,
+    ) -> Result<(), Box<dyn Error>> {
+        let mut ff_table: ForeignFunctionTable = Default::default();
+        unsafe {
+            let library = Library::new(library_name)?;
+            for function in functions {
+                let symbol_name: CString = CString::new(function.name.clone())?;
+                let code_ptr: Symbol<*mut c_void> =
+                    library.get(&symbol_name.into_bytes_with_nul())?;
+                let mut args: Vec<_> = function.args.iter().map(|x| self.map_type_ffi(x)).collect();
+                let mut cif: ffi_cif = Default::default();
+                prep_cif(
+                    &mut cif,
+                    ffi_abi_FFI_DEFAULT_ABI,
+                    args.len(),
+                    self.map_type_ffi(&function.return_value),
+                    args.as_mut_ptr(),
+                )
+                .unwrap();
+
+                let return_struct_name = if (*self.map_type_ffi(&function.return_value)).type_
+                    as u32
+                    == libffi::raw::FFI_TYPE_STRUCT
+                {
+                    Some(function.return_value.as_str().to_string())
+                } else {
+                    None
+                };
+
+                ff_table.table.insert(
+                    function.name.clone(),
+                    FunctionImpl {
+                        cif,
+                        args,
+                        code_ptr: CodePtr(code_ptr.into_raw().into_raw() as *mut _),
+                        return_struct_name,
+                    },
+                );
+            }
+            std::mem::forget(library);
+        }
+        self.merge(ff_table);
+        Ok(())
+    }
+
+    fn build_pointer_args(
+        args: &mut [Value],
+        type_args: &[*mut ffi_type],
+        structs_table: &mut HashMap<String, StructImpl>,
+    ) -> Result<PointerArgs, FFIError> {
+        let mut pointers = Vec::with_capacity(args.len());
+        let mut _memory = Vec::new();
+        for i in 0..args.len() {
+            let field_type = type_args[i];
+            unsafe {
+                macro_rules! push_int {
+                    ($type:ty) => {{
+                        let n: $type = <$type>::try_from(args[i].as_int()?)
+                            .map_err(|_| FFIError::ValueDontFit)?;
+                        let mut box_value = Box::new(n) as Box<dyn Any>;
+                        pointers.push(&mut *box_value as *mut _ as *mut c_void);
+                        _memory.push(box_value);
+                    }};
+                }
+
+                match (*field_type).type_ as u32 {
+                    libffi::raw::FFI_TYPE_UINT8 => push_int!(u8),
+                    libffi::raw::FFI_TYPE_SINT8 => push_int!(i8),
+                    libffi::raw::FFI_TYPE_UINT16 => push_int!(u16),
+                    libffi::raw::FFI_TYPE_SINT16 => push_int!(i16),
+                    libffi::raw::FFI_TYPE_UINT32 => push_int!(u32),
+                    libffi::raw::FFI_TYPE_SINT32 => push_int!(i32),
+                    libffi::raw::FFI_TYPE_UINT64 => push_int!(u64),
+                    libffi::raw::FFI_TYPE_SINT64 => push_int!(i64),
+                    libffi::raw::FFI_TYPE_FLOAT => {
+                        let n: f32 = args[i].as_float()? as f32;
+                        let mut box_value = Box::new(n) as Box<dyn Any>;
+                        pointers.push(&mut *box_value as *mut _ as *mut c_void);
+                        _memory.push(box_value);
+                    }
+                    libffi::raw::FFI_TYPE_DOUBLE => {
+                        let n: f64 = args[i].as_float()?;
+                        let mut box_value = Box::new(n) as Box<dyn Any>;
+                        pointers.push(&mut *box_value as *mut _ as *mut c_void);
+                        _memory.push(box_value);
+                    }
+                    libffi::raw::FFI_TYPE_POINTER => {
+                        let ptr: *mut c_void = args[i].as_ptr()?;
+                        pointers.push(ptr);
+                    }
+                    libffi::raw::FFI_TYPE_STRUCT => {
+                        let (mut ptr, _size, _align) =
+                            Self::build_struct(&mut args[i], structs_table)?;
+                        pointers.push(&mut *ptr as *mut _ as *mut c_void);
+                        _memory.push(ptr);
+                    }
+                    _ => return Err(FFIError::InvalidFFIType),
+                }
+            }
+        }
+        Ok(PointerArgs { pointers, _memory })
+    }
+
+    fn build_struct(
+        arg: &mut Value,
+        structs_table: &mut HashMap<String, StructImpl>,
+    ) -> Result<(Box<dyn Any>, usize, usize), FFIError> {
+        unsafe {
+            match arg {
+                Value::Struct(ref name, ref mut struct_args) => {
+                    if let Some(ref mut struct_type) = structs_table.clone().get_mut(name) {
+                        let layout = Layout::from_size_align(
+                            struct_type.ffi_type.size,
+                            struct_type.ffi_type.alignment.into(),
+                        )
+                        .unwrap();
+                        let align = struct_type.ffi_type.alignment as usize;
+                        let size = struct_type.ffi_type.size;
+                        let ptr = alloc(layout) as *mut c_void;
+                        let mut field_ptr = ptr;
+
+                        #[allow(clippy::needless_range_loop)]
+                        for i in 0..(struct_type.fields.len() - 1) {
+                            macro_rules! try_write_int {
+                                ($type:ty) => {{
+                                    field_ptr = field_ptr
+                                        .add(field_ptr.align_offset(std::mem::align_of::<$type>()));
+                                    let n: $type = <$type>::try_from(struct_args[i].as_int()?)
+                                        .map_err(|_| FFIError::ValueDontFit)?;
+                                    std::ptr::write(field_ptr as *mut $type, n);
+                                    field_ptr = field_ptr.add(std::mem::size_of::<$type>());
+                                }};
+                            }
+
+                            macro_rules! write {
+                                ($type:ty, $value:expr) => {{
+                                    let data: $type = $value;
+                                    std::ptr::write(field_ptr as *mut $type, data);
+                                    field_ptr = field_ptr.add(align);
+                                }};
+                            }
+
+                            let field = struct_type.fields[i];
+                            match (*field).type_ as u32 {
+                                libffi::raw::FFI_TYPE_UINT8 => try_write_int!(u8),
+                                libffi::raw::FFI_TYPE_SINT8 => try_write_int!(i8),
+                                libffi::raw::FFI_TYPE_UINT16 => try_write_int!(u16),
+                                libffi::raw::FFI_TYPE_SINT16 => try_write_int!(i16),
+                                libffi::raw::FFI_TYPE_UINT32 => try_write_int!(u32),
+                                libffi::raw::FFI_TYPE_SINT32 => try_write_int!(i32),
+                                libffi::raw::FFI_TYPE_UINT64 => try_write_int!(u64),
+                                libffi::raw::FFI_TYPE_SINT64 => try_write_int!(i64),
+                                libffi::raw::FFI_TYPE_POINTER => {
+                                    write!(*mut c_void, struct_args[i].as_ptr()?)
+                                }
+                                libffi::raw::FFI_TYPE_FLOAT => {
+                                    write!(f32, struct_args[i].as_float()? as f32)
+                                }
+                                libffi::raw::FFI_TYPE_DOUBLE => {
+                                    write!(f64, struct_args[i].as_float()?)
+                                }
+                                libffi::raw::FFI_TYPE_STRUCT => {
+                                    let (struct_ptr, struct_size, struct_align) =
+                                        Self::build_struct(&mut struct_args[i], structs_table)?;
+                                    field_ptr = field_ptr.add(field_ptr.align_offset(struct_align));
+
+                                    std::ptr::copy(
+                                        &*struct_ptr as *const _ as *const c_void,
+                                        field_ptr,
+                                        struct_size,
+                                    );
+                                    field_ptr = field_ptr.add(struct_size);
+                                }
+                                _ => {
+                                    unreachable!()
+                                }
+                            }
+                        }
+                        #[allow(clippy::from_raw_with_void_ptr)]
+                        Ok((Box::from_raw(ptr), size, align))
+                    } else {
+                        Err(FFIError::InvalidStructName)
+                    }
+                }
+                _ => Err(FFIError::ValueCast),
+            }
+        }
+    }
+
+    pub fn exec(&mut self, name: &str, mut args: Vec<Value>) -> Result<Value, FFIError> {
+        let function_impl = self.table.get_mut(name).ok_or(FFIError::FunctionNotFound)?;
+        let mut pointer_args =
+            Self::build_pointer_args(&mut args, &function_impl.args, &mut self.structs)?;
+
+        return unsafe {
+            macro_rules! call_and_return {
+                ($type:ty) => {{
+                    let mut n: Box<u8> = Box::new(0);
+                    libffi::raw::ffi_call(
+                        &mut function_impl.cif,
+                        Some(*function_impl.code_ptr.as_safe_fun()),
+                        &mut *n as *mut _ as *mut c_void,
+                        pointer_args.pointers.as_mut_ptr() as *mut *mut c_void,
+                    );
+                    Ok(Value::Int(i64::from(*n)))
+                }};
+            }
+
+            match (*function_impl.cif.rtype).type_ as u32 {
+                libffi::raw::FFI_TYPE_VOID => call_and_return!(i32),
+                libffi::raw::FFI_TYPE_UINT8 => call_and_return!(u8),
+                libffi::raw::FFI_TYPE_SINT8 => call_and_return!(i8),
+                libffi::raw::FFI_TYPE_UINT16 => call_and_return!(u16),
+                libffi::raw::FFI_TYPE_SINT16 => call_and_return!(i16),
+                libffi::raw::FFI_TYPE_UINT32 => call_and_return!(u32),
+                libffi::raw::FFI_TYPE_SINT32 => call_and_return!(i32),
+                libffi::raw::FFI_TYPE_UINT64 => {
+                    let mut n: Box<u64> = Box::new(0);
+                    libffi::raw::ffi_call(
+                        &mut function_impl.cif,
+                        Some(*function_impl.code_ptr.as_safe_fun()),
+                        &mut *n as *mut _ as *mut c_void,
+                        pointer_args.pointers.as_mut_ptr(),
+                    );
+                    Ok(Value::Int(
+                        i64::try_from(*n).map_err(|_| FFIError::ValueDontFit)?,
+                    ))
+                }
+                libffi::raw::FFI_TYPE_SINT64 => call_and_return!(i64),
+                libffi::raw::FFI_TYPE_POINTER => call_and_return!(*mut c_void),
+                libffi::raw::FFI_TYPE_FLOAT => {
+                    let mut n: Box<f32> = Box::new(0.0);
+                    libffi::raw::ffi_call(
+                        &mut function_impl.cif,
+                        Some(*function_impl.code_ptr.as_safe_fun()),
+                        &mut *n as *mut _ as *mut c_void,
+                        pointer_args.pointers.as_mut_ptr(),
+                    );
+                    Ok(Value::Float((*n).into()))
+                }
+                libffi::raw::FFI_TYPE_DOUBLE => {
+                    let mut n: Box<f64> = Box::new(0.0);
+                    libffi::raw::ffi_call(
+                        &mut function_impl.cif,
+                        Some(*function_impl.code_ptr.as_safe_fun()),
+                        &mut *n as *mut _ as *mut c_void,
+                        pointer_args.pointers.as_mut_ptr(),
+                    );
+                    Ok(Value::Float(*n))
+                }
+                libffi::raw::FFI_TYPE_STRUCT => {
+                    let name = &function_impl
+                        .return_struct_name
+                        .clone()
+                        .ok_or(FFIError::StructNotFound)?;
+                    let struct_type = self.structs.get(name).ok_or(FFIError::StructNotFound)?;
+                    let layout = Layout::from_size_align(
+                        struct_type.ffi_type.size,
+                        struct_type.ffi_type.alignment.into(),
+                    )
+                    .unwrap();
+                    let ptr = alloc(layout) as *mut c_void;
+
+                    libffi::raw::ffi_call(
+                        &mut function_impl.cif,
+                        Some(*function_impl.code_ptr.as_safe_fun()),
+                        &mut *ptr as *mut _,
+                        pointer_args.pointers.as_mut_ptr(),
+                    );
+                    let struct_val = self.read_struct(ptr, name, struct_type);
+                    #[allow(clippy::from_raw_with_void_ptr)]
+                    drop(Box::from_raw(ptr));
+                    struct_val
+                }
+                _ => unreachable!(),
+            }
+        };
+    }
+
+    fn read_struct(
+        &self,
+        ptr: *mut c_void,
+        name: &str,
+        struct_type: &StructImpl,
+    ) -> Result<Value, FFIError> {
+        unsafe {
+            let mut returns = Vec::new();
+            let mut field_ptr = ptr;
+
+            for i in 0..(struct_type.fields.len() - 1) {
+                let field = struct_type.fields[i];
+
+                macro_rules! read_and_push_int {
+                    ($type:ty) => {{
+                        field_ptr =
+                            field_ptr.add(field_ptr.align_offset(std::mem::align_of::<$type>()));
+                        let n = std::ptr::read(field_ptr as *mut $type);
+                        returns.push(Value::Int(i64::from(n)));
+                        field_ptr = field_ptr.add(std::mem::size_of::<$type>());
+                    }};
+                }
+
+                match (*field).type_ as u32 {
+                    libffi::raw::FFI_TYPE_UINT8 => read_and_push_int!(u8),
+                    libffi::raw::FFI_TYPE_SINT8 => read_and_push_int!(i8),
+                    libffi::raw::FFI_TYPE_UINT16 => read_and_push_int!(u16),
+                    libffi::raw::FFI_TYPE_SINT16 => read_and_push_int!(i16),
+                    libffi::raw::FFI_TYPE_UINT32 => read_and_push_int!(u32),
+                    libffi::raw::FFI_TYPE_SINT32 => read_and_push_int!(i32),
+                    libffi::raw::FFI_TYPE_UINT64 => {
+                        field_ptr =
+                            field_ptr.add(field_ptr.align_offset(std::mem::align_of::<u64>()));
+                        let n = std::ptr::read(field_ptr as *mut u64);
+                        returns.push(Value::Int(
+                            i64::try_from(n).map_err(|_| FFIError::ValueDontFit)?,
+                        ));
+                        field_ptr = field_ptr.add(std::mem::size_of::<u64>());
+                    }
+                    libffi::raw::FFI_TYPE_SINT64 => read_and_push_int!(i64),
+                    libffi::raw::FFI_TYPE_POINTER => read_and_push_int!(i64),
+                    libffi::raw::FFI_TYPE_STRUCT => {
+                        let substruct = struct_type.atom_fields[i].as_str();
+                        let struct_type = self
+                            .structs
+                            .get(&*substruct)
+                            .ok_or(FFIError::StructNotFound)?;
+                        field_ptr = field_ptr
+                            .add(field_ptr.align_offset(struct_type.ffi_type.alignment as usize));
+                        let struct_val = self.read_struct(field_ptr, &substruct, struct_type);
+                        returns.push(struct_val?);
+                        field_ptr = field_ptr.add(struct_type.ffi_type.size);
+                    }
+                    _ => {
+                        unreachable!()
+                    }
+                }
+            }
+            Ok(Value::Struct(name.into(), returns))
+        }
+    }
+}
+
+#[derive(Clone, Debug)]
+pub enum Value {
+    Int(i64),
+    Float(f64),
+    CString(CString),
+    Struct(String, Vec<Value>),
+}
+
+impl Value {
+    fn as_int(&self) -> Result<i64, FFIError> {
+        match self {
+            Value::Int(n) => Ok(*n),
+            _ => Err(FFIError::ValueCast),
+        }
+    }
+
+    fn as_float(&self) -> Result<f64, FFIError> {
+        match self {
+            Value::Float(n) => Ok(*n),
+            Value::Int(n) => Ok(*n as f64),
+            _ => Err(FFIError::ValueCast),
+        }
+    }
+
+    fn as_ptr(&mut self) -> Result<*mut c_void, FFIError> {
+        match self {
+            Value::CString(ref mut cstr) => Ok(&mut *cstr as *mut _ as *mut c_void),
+            Value::Int(n) => Ok(*n as *mut c_void),
+            _ => Err(FFIError::ValueCast),
+        }
+    }
+}
+
+#[derive(Debug)]
+pub enum FFIError {
+    ValueCast,
+    ValueDontFit,
+    InvalidFFIType,
+    InvalidStructName,
+    FunctionNotFound,
+    StructNotFound,
+}

src/fixtures.rs

@@ -1,320 +0,0 @@
-use crate::parser::ast::*;
-
-use crate::forms::*;
-use crate::instructions::*;
-use crate::iterators::*;
-
-use indexmap::{IndexMap, IndexSet};
-
-use std::cell::Cell;
-use std::collections::BTreeSet;
-use std::mem::swap;
-use std::rc::Rc;
-use std::vec::Vec;
-
-// labeled with chunk numbers.
-#[derive(Debug)]
-pub(crate) enum VarStatus {
-    Perm(usize),
-    Temp(usize, TempVarData), // Perm(chunk_num) | Temp(chunk_num, _)
-}
-
-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(crate) enum VarData {
-    Perm(usize),
-    Temp(usize, usize, TempVarData),
-}
-
-impl VarData {
-    pub(crate) fn as_reg_type(&self) -> RegType {
-        match self {
-            &VarData::Temp(_, r, _) => RegType::Temp(r),
-            &VarData::Perm(r) => RegType::Perm(r),
-        }
-    }
-}
-
-#[derive(Debug)]
-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(crate) fn new(last_term_arity: usize) -> Self {
-        TempVarData {
-            last_term_arity: last_term_arity,
-            use_set: BTreeSet::new(),
-            no_use_set: BTreeSet::new(),
-            conflict_set: BTreeSet::new(),
-        }
-    }
-
-    pub(crate) fn uses_reg(&self, reg: usize) -> bool {
-        for &(_, nreg) in self.use_set.iter() {
-            if reg == nreg {
-                return true;
-            }
-        }
-
-        return false;
-    }
-
-    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();
-
-            for &(_, reg) in self.use_set.iter() {
-                conflict_set.remove(&reg);
-            }
-
-            self.conflict_set = conflict_set;
-        }
-    }
-}
-
-type VariableFixture<'a> = (VarStatus, Vec<&'a Cell<VarReg>>);
-
-#[derive(Debug)]
-pub(crate) struct VariableFixtures<'a> {
-    perm_vars: IndexMap<Rc<String>, VariableFixture<'a>>,
-    last_chunk_temp_vars: IndexSet<Rc<String>>,
-}
-
-impl<'a> VariableFixtures<'a> {
-    pub(crate) fn new() -> Self {
-        VariableFixtures {
-            perm_vars: IndexMap::new(),
-            last_chunk_temp_vars: IndexSet::new(),
-        }
-    }
-
-    pub(crate) fn insert(&mut self, var: Rc<String>, vs: VariableFixture<'a>) {
-        self.perm_vars.insert(var, vs);
-    }
-
-    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(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).
-        // 2. drain use_set. For each use set of U, add into the
-        // no-use sets of appropriate variables T =/= U.
-        // 3. Move the use sets back to their original locations in the fixture.
-        // Compute the conflict set of u.
-
-        // 1.
-        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 {
-                let mut use_set = OccurrenceSet::new();
-
-                swap(&mut var_data.use_set, &mut use_set);
-                use_sets.insert((*var).clone(), use_set);
-            }
-        }
-
-        for (u, use_set) in use_sets.drain(..) {
-            // 2.
-            for &(term_loc, reg) in use_set.iter() {
-                if let GenContext::Last(cn_u) = term_loc {
-                    for (ref t, &mut (ref mut var_status, _)) in self.iter_mut() {
-                        if let &mut VarStatus::Temp(cn_t, ref mut t_data) = var_status {
-                            if cn_u == cn_t && *u != ***t {
-                                if !t_data.uses_reg(reg) {
-                                    t_data.no_use_set.insert(reg);
-                                }
-                            }
-                        }
-                    }
-                }
-            }
-
-            // 3.
-            match self.get_mut(u).unwrap() {
-                &mut (VarStatus::Temp(_, ref mut u_data), _) => {
-                    u_data.use_set = use_set;
-                    u_data.populate_conflict_set();
-                }
-                _ => {}
-            };
-        }
-    }
-
-    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<String>, VariableFixture<'a>> {
-        self.perm_vars.iter_mut()
-    }
-
-    fn record_temp_info(&mut self, tvd: &mut TempVarData, arg_c: usize, term_loc: GenContext) {
-        match term_loc {
-            GenContext::Head | GenContext::Last(_) => {
-                tvd.use_set.insert((term_loc, arg_c));
-            }
-            _ => {}
-        };
-    }
-
-    pub(crate) fn vars_above_threshold(&self, index: usize) -> usize {
-        let mut var_count = 0;
-
-        for &(ref var_status, _) in self.values() {
-            if let &VarStatus::Perm(i) = var_status {
-                if i > index {
-                    var_count += 1;
-                }
-            }
-        }
-
-        var_count
-    }
-
-    pub(crate) fn mark_vars_in_chunk<I>(&mut self, iter: I, lt_arity: usize, term_loc: GenContext)
-    where
-        I: Iterator<Item = TermRef<'a>>,
-    {
-        let chunk_num = term_loc.chunk_num();
-        let mut arg_c = 1;
-
-        for term_ref in iter {
-            if let &TermRef::Var(lvl, cell, ref var) = &term_ref {
-                let mut status = self.perm_vars.swap_remove(var).unwrap_or((
-                    VarStatus::Temp(chunk_num, TempVarData::new(lt_arity)),
-                    Vec::new(),
-                ));
-
-                status.1.push(cell);
-
-                match status.0 {
-                    VarStatus::Temp(cn, ref mut tvd) if cn == chunk_num => {
-                        if let Level::Shallow = lvl {
-                            self.record_temp_info(tvd, arg_c, term_loc);
-                        }
-                    }
-                    _ => status.0 = VarStatus::Perm(chunk_num),
-                };
-
-                self.perm_vars.insert(var.clone(), status);
-            }
-
-            if let Level::Shallow = term_ref.level() {
-                arg_c += 1;
-            }
-        }
-    }
-
-    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<String>, VariableFixture<'a>> {
-        self.perm_vars.values()
-    }
-
-    pub(crate) fn size(&self) -> usize {
-        self.perm_vars.len()
-    }
-
-    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 {
-                &VarStatus::Perm(i) => Some((i, &v.1)),
-                _ => None,
-            })
-            .collect();
-
-        values_vec.sort_by_key(|ref v| v.0);
-
-        let offset = has_deep_cuts as usize;
-
-        for (i, (_, cells)) in values_vec.into_iter().rev().enumerate() {
-            for cell in cells {
-                cell.set(VarReg::Norm(RegType::Perm(i + 1 + offset)));
-            }
-        }
-    }
-}
-
-#[derive(Debug)]
-pub(crate) struct UnsafeVarMarker {
-    pub(crate) unsafe_vars: IndexMap<RegType, usize>,
-    pub(crate) safe_vars: IndexSet<RegType>,
-}
-
-impl UnsafeVarMarker {
-    pub(crate) fn new() -> Self {
-        UnsafeVarMarker {
-            unsafe_vars: IndexMap::new(),
-            safe_vars: IndexSet::new(),
-        }
-    }
-
-    pub(crate) fn from_safe_vars(safe_vars: IndexSet<RegType>) -> Self {
-        UnsafeVarMarker {
-            unsafe_vars: IndexMap::new(),
-            safe_vars,
-        }
-    }
-
-    pub(crate) fn mark_safe_vars(&mut self, query_instr: &Instruction) -> bool {
-        match query_instr {
-            &Instruction::PutVariable(r @ RegType::Temp(_), _) |
-            &Instruction::SetVariable(r) => {
-                self.safe_vars.insert(r);
-                true
-            }
-            _ => false,
-        }
-    }
-
-    pub(crate) fn mark_phase(&mut self, query_instr: &Instruction, phase: usize) {
-        match query_instr {
-            &Instruction::PutValue(r @ RegType::Perm(_), _) |
-            &Instruction::SetValue(r) => {
-                let p = self.unsafe_vars.entry(r).or_insert(0);
-                *p = phase;
-            }
-            _ => {}
-        }
-    }
-
-    pub(crate) fn mark_unsafe_vars(&mut self, query_instr: &mut Instruction, phase: usize) {
-        match query_instr {
-            &mut Instruction::PutValue(RegType::Perm(i), arg) => {
-                if let Some(p) = self.unsafe_vars.swap_remove(&RegType::Perm(i)) {
-                    if p == phase {
-                        *query_instr = Instruction::PutUnsafeValue(i, arg);
-                        self.safe_vars.insert(RegType::Perm(i));
-                    } else {
-                        self.unsafe_vars.insert(RegType::Perm(i), p);
-                    }
-                }
-            }
-            &mut Instruction::SetValue(r) => {
-                if !self.safe_vars.contains(&r) {
-                    *query_instr = Instruction::SetLocalValue(r);
-
-                    self.safe_vars.insert(r);
-                    self.unsafe_vars.remove(&r);
-                }
-            }
-            _ => {}
-        }
-    }
-}

src/forms.rs

@@ -1,15 +1,17 @@
 use crate::arena::*;
 use crate::atom_table::*;
 use crate::instructions::*;
+use crate::machine::disjuncts::VarData;
 use crate::machine::heap::*;
 use crate::machine::loader::PredicateQueue;
 use crate::machine::machine_errors::*;
 use crate::machine::machine_indices::*;
 use crate::parser::ast::*;
+use crate::parser::dashu::{Integer, Rational};
 use crate::parser::parser::CompositeOpDesc;
-use crate::parser::rug::{Integer, Rational};
 use crate::types::*;
 
+use dashu::base::Signed;
 use fxhash::FxBuildHasher;
 
 use indexmap::{IndexMap, IndexSet};
@@ -19,26 +21,23 @@ use std::cell::Cell;
 use std::collections::VecDeque;
 use std::convert::TryFrom;
 use std::fmt;
-use std::ops::AddAssign;
+use std::ops::{AddAssign, Deref, DerefMut};
 use std::path::PathBuf;
-use std::rc::Rc;
 
 use crate::{is_infix, is_postfix};
 
 pub type PredicateKey = (Atom, usize); // name, arity.
 
-pub type Predicate = Vec<PredicateClause>;
+/*
-
 // vars of predicate, toplevel offset.  Vec<Term> is always a vector
 // of vars (we get their adjoining cells this way).
 pub type JumpStub = Vec<Term>;
+*/
 
-#[derive(Debug, Clone)]
+#[derive(Debug)]
 pub enum TopLevel {
-    Fact(Term), // Term, line_num, col_num
+    Fact(Fact, VarData), // Term, line_num, col_num
-    Predicate(Predicate),
+    Rule(Rule, VarData), // Rule, line_num, col_num
-    Query(Vec<QueryTerm>),
-    Rule(Rule), // Rule, line_num, col_num
 }
 
 #[derive(Debug, Clone, Copy)]
@@ -57,7 +56,13 @@ impl AppendOrPrepend {
     }
 }
 
-#[derive(Debug, Clone, Copy, PartialEq, Eq)]
+#[derive(Debug, Clone, Copy)]
+pub enum VarComparison {
+    Indistinct,
+    Distinct,
+}
+
+#[derive(Debug, Clone, Copy, PartialEq, Eq, Hash)]
 pub enum Level {
     Deep,
     Root,
@@ -79,38 +84,147 @@ pub enum CallPolicy {
     Counted,
 }
 
-#[derive(Debug, Clone)]
+#[derive(Debug, Clone, Copy, PartialEq, Eq, Hash)]
+pub enum ChunkType {
+    Head,
+    Mid,
+    Last,
+}
+
+#[derive(Debug)]
+pub enum RootIterationPolicy {
+    Iterated,
+    NotIterated,
+}
+
+impl RootIterationPolicy {
+    #[inline(always)]
+    pub fn iterable(&self) -> bool {
+        matches!(self, RootIterationPolicy::Iterated)
+    }
+}
+
+impl ChunkType {
+    #[inline(always)]
+    pub fn to_gen_context(self, chunk_num: usize) -> GenContext {
+        match self {
+            ChunkType::Head => GenContext::Head,
+            ChunkType::Mid => GenContext::Mid(chunk_num),
+            ChunkType::Last => GenContext::Last(chunk_num),
+        }
+    }
+
+    #[inline(always)]
+    pub fn is_last(self) -> bool {
+        self == ChunkType::Last
+    }
+}
+
+#[derive(Debug)]
+pub enum ChunkedTerms {
+    Branch(Vec<VecDeque<ChunkedTerms>>),
+    Chunk(VecDeque<QueryTerm>),
+}
+
+#[derive(Debug)]
+pub struct ChunkedTermVec {
+    pub chunk_vec: VecDeque<ChunkedTerms>,
+}
+
+impl Deref for ChunkedTermVec {
+    type Target = VecDeque<ChunkedTerms>;
+
+    #[inline(always)]
+    fn deref(&self) -> &Self::Target {
+        &self.chunk_vec
+    }
+}
+
+impl DerefMut for ChunkedTermVec {
+    #[inline(always)]
+    fn deref_mut(&mut self) -> &mut Self::Target {
+        &mut self.chunk_vec
+    }
+}
+
+impl ChunkedTermVec {
+    #[allow(clippy::new_without_default)]
+    #[inline]
+    pub fn new() -> Self {
+        Self {
+            chunk_vec: VecDeque::new(),
+        }
+    }
+
+    pub fn reserve_branch(&mut self, capacity: usize) {
+        self.chunk_vec
+            .push_back(ChunkedTerms::Branch(Vec::with_capacity(capacity)));
+    }
+
+    pub fn push_branch_arm(&mut self, branch: VecDeque<ChunkedTerms>) {
+        match self.chunk_vec.back_mut().unwrap() {
+            ChunkedTerms::Branch(branches) => {
+                branches.push(branch);
+            }
+            ChunkedTerms::Chunk(_) => {
+                self.chunk_vec.push_back(ChunkedTerms::Branch(vec![branch]));
+            }
+        }
+    }
+
+    #[inline]
+    pub fn add_chunk(&mut self) {
+        self.chunk_vec
+            .push_back(ChunkedTerms::Chunk(VecDeque::from(vec![])));
+    }
+
+    pub fn push_chunk_term(&mut self, term: QueryTerm) {
+        match self.chunk_vec.back_mut() {
+            Some(ChunkedTerms::Branch(_)) => {
+                self.chunk_vec
+                    .push_back(ChunkedTerms::Chunk(VecDeque::from(vec![term])));
+            }
+            Some(ChunkedTerms::Chunk(chunk)) => {
+                chunk.push_back(term);
+            }
+            None => {
+                self.chunk_vec
+                    .push_back(ChunkedTerms::Chunk(VecDeque::from(vec![term])));
+            }
+        }
+    }
+}
+
+#[derive(Debug)]
 pub enum QueryTerm {
     // register, clause type, subterms, clause call policy.
     Clause(Cell<RegType>, ClauseType, Vec<Term>, CallPolicy),
-    BlockedCut, // a cut which is 'blocked by letters', like the P term in P -> Q.
+    Fail,
-    UnblockedCut(Cell<VarReg>),
+    LocalCut { var_num: usize, cut_prev: bool }, // var_num
-    GetLevelAndUnify(Cell<VarReg>, Rc<String>),
+    GlobalCut(usize),                            // var_num
-    Jump(JumpStub),
+    GetCutPoint { var_num: usize, prev_b: bool },
+    GetLevel(usize), // var_num
 }
 
 impl QueryTerm {
-    pub(crate) fn set_call_policy(&mut self, cp: CallPolicy) {
-        match self {
-            &mut QueryTerm::Clause(_, _, _, ref mut clause_cp) => *clause_cp = cp,
-            _ => {}
-        }
-    }
-
     pub(crate) fn arity(&self) -> usize {
         match self {
-            &QueryTerm::Clause(_, _, ref subterms, ..) => subterms.len(),
+            QueryTerm::Clause(_, _, subterms, ..) => subterms.len(),
-            &QueryTerm::BlockedCut | &QueryTerm::UnblockedCut(..) => 0,
+            &QueryTerm::GetLevel(_) | &QueryTerm::GetCutPoint { .. } => 1,
-            &QueryTerm::Jump(ref vars) => vars.len(),
+            _ => 0,
-            &QueryTerm::GetLevelAndUnify(..) => 1,
         }
     }
 }
 
-#[derive(Debug, Clone)]
+#[derive(Debug)]
+pub struct Fact {
+    pub(crate) head: Term,
+}
+
+#[derive(Debug)]
 pub struct Rule {
-    pub(crate) head: (Atom, Vec<Term>, QueryTerm),
+    pub(crate) head: (Atom, Vec<Term>),
-    pub(crate) clauses: Vec<QueryTerm>,
+    pub(crate) clauses: ChunkedTermVec,
 }
 
 #[derive(Clone, Debug, Hash)]
@@ -156,11 +270,10 @@ impl ClauseInfo for Term {
     fn name(&self) -> Option<Atom> {
         match self {
             Term::Clause(_, name, terms) => {
-
                 match name {
                     atom!(":-") => {
                         match terms.len() {
-                            1 => None,            // a declaration.
+                            1 => None, // a declaration.
                             2 => terms[0].name(),
                             _ => Some(*name),
                         }
@@ -175,7 +288,7 @@ impl ClauseInfo for Term {
 
     fn arity(&self) -> usize {
         match self {
-            Term::Clause(_, name, terms) => match name.as_str() {
+            Term::Clause(_, name, terms) => match &*name.as_str() {
                 ":-" => match terms.len() {
                     1 => 0,
                     2 => terms[0].arity(),
@@ -201,30 +314,30 @@ impl ClauseInfo for Rule {
 impl ClauseInfo for PredicateClause {
     fn name(&self) -> Option<Atom> {
         match self {
-            &PredicateClause::Fact(ref term, ..) => term.name(),
+            PredicateClause::Fact(ref term, ..) => term.head.name(),
-            &PredicateClause::Rule(ref rule, ..) => rule.name(),
+            PredicateClause::Rule(ref rule, ..) => rule.name(),
         }
     }
 
     fn arity(&self) -> usize {
         match self {
-            &PredicateClause::Fact(ref term, ..) => term.arity(),
+            PredicateClause::Fact(ref term, ..) => term.head.arity(),
-            &PredicateClause::Rule(ref rule, ..) => rule.arity(),
+            PredicateClause::Rule(ref rule, ..) => rule.arity(),
         }
     }
 }
 
-#[derive(Debug, Clone)]
+#[derive(Debug)]
 pub enum PredicateClause {
-    Fact(Term),
+    Fact(Fact, VarData),
-    Rule(Rule),
+    Rule(Rule, VarData),
 }
 
 impl PredicateClause {
     pub(crate) fn args(&self) -> Option<&[Term]> {
         match self {
-            PredicateClause::Fact(term, ..) => match term {
+            PredicateClause::Fact(term, ..) => match &term.head {
-                Term::Clause(_, _, args) => Some(&args),
+                Term::Clause(_, _, args) => Some(args),
                 _ => None,
             },
             PredicateClause::Rule(rule, ..) => {
@@ -300,7 +413,6 @@ pub(crate) fn fixity(spec: u32) -> Fixity {
     }
 }
 
-
 impl OpDecl {
     #[inline]
     pub(crate) fn new(op_desc: OpDesc, name: Atom) -> Self {
@@ -319,13 +431,10 @@ impl OpDecl {
     pub(crate) fn insert_into_op_dir(&self, op_dir: &mut OpDir) -> Option<OpDesc> {
         let key = (self.name, fixity(self.op_desc.get_spec() as u32));
 
-        match op_dir.get_mut(&key) {
+        if let Some(cell) = op_dir.get_mut(&key) {
-            Some(cell) => {
+            let (old_prec, old_spec) = cell.get();
-                let (old_prec, old_spec) = cell.get();
+            cell.set(self.op_desc.get_prec(), self.op_desc.get_spec());
-                cell.set(self.op_desc.get_prec(), self.op_desc.get_spec());
+            return Some(OpDesc::build_with(old_prec, old_spec));
-                return Some(OpDesc::build_with(old_prec, old_spec));
-            }
-            None => {}
         }
 
         op_dir.insert(key, self.op_desc)
@@ -336,7 +445,7 @@ impl OpDecl {
         existing_desc: Option<CompositeOpDesc>,
         op_dir: &mut OpDir,
     ) -> Result<(), SessionError> {
-        let (spec, name) = (self.op_desc.get_spec(), self.name.clone());
+        let (spec, name) = (self.op_desc.get_spec(), self.name);
 
         if is_infix!(spec as u32) {
             if let Some(desc) = existing_desc {
@@ -367,35 +476,28 @@ pub enum AtomOrString {
 
 impl AtomOrString {
     #[inline]
-    pub fn as_atom(&self, atom_tbl: &mut AtomTable) -> Atom {
+    pub fn as_atom(&self, atom_tbl: &AtomTable) -> Atom {
         match self {
-            &AtomOrString::Atom(atom) => {
+            &AtomOrString::Atom(atom) => atom,
-                atom
+            AtomOrString::String(string) => AtomTable::build_with(atom_tbl, string),
-            }
-            AtomOrString::String(string) => {
-                atom_tbl.build_with(&string)
-            }
         }
     }
 
     #[inline]
-    pub fn as_str(&self) -> &str {
+    pub fn as_str(&self) -> AtomString<'_> {
         match self {
-            AtomOrString::Atom(atom) if atom == &atom!("[]") => "",
+            AtomOrString::Atom(atom) if atom == &atom!("[]") => AtomString::Static(""),
             AtomOrString::Atom(atom) => atom.as_str(),
-            AtomOrString::String(string) => string.as_str(),
+            AtomOrString::String(string) => AtomString::Static(string.as_str()),
         }
     }
+}
 
-    #[inline]
+impl From<AtomOrString> for String {
-    pub fn to_string(self) -> String {
+    fn from(val: AtomOrString) -> Self {
-        match self {
+        match val {
-            AtomOrString::Atom(atom) => {
+            AtomOrString::Atom(atom) => atom.as_str().to_owned(),
-                atom.as_str().to_owned()
+            AtomOrString::String(string) => string,
-            }
-            AtomOrString::String(string) => {
-                string
-            }
         }
     }
 }
@@ -437,7 +539,7 @@ pub(crate) fn fetch_op_spec(name: Atom, arity: usize, op_dir: &OpDir) -> Option<
             }
         }),
         1 => {
-            if let Some(op_desc) = op_dir.get(&(name.clone(), Fixity::Pre)) {
+            if let Some(op_desc) = op_dir.get(&(name, Fixity::Pre)) {
                 if op_desc.get_prec() > 0 {
                     return Some(*op_desc);
                 }
@@ -451,9 +553,7 @@ pub(crate) fn fetch_op_spec(name: Atom, arity: usize, op_dir: &OpDir) -> Option<
                 }
             })
         }
-        0 => {
+        0 => fetch_atom_op_spec(name, None, op_dir),
-            fetch_atom_op_spec(name, None, op_dir)
-        }
         _ => None,
     }
 }
@@ -485,10 +585,7 @@ pub struct Module {
 
 // Module's and related types are defined in forms.
 impl Module {
-    pub(crate) fn new(
+    pub(crate) fn new(module_decl: ModuleDecl, listing_src: ListingSource) -> Self {
-        module_decl: ModuleDecl,
-        listing_src: ListingSource,
-    ) -> Self {
         Module {
             module_decl,
             code_dir: CodeDir::with_hasher(FxBuildHasher::default()),
@@ -510,7 +607,7 @@ impl Module {
             meta_predicates: MetaPredicateDir::with_hasher(FxBuildHasher::default()),
             extensible_predicates: ExtensiblePredicates::with_hasher(FxBuildHasher::default()),
             local_extensible_predicates: LocalExtensiblePredicates::with_hasher(
-                FxBuildHasher::default()
+                FxBuildHasher::default(),
             ),
             listing_src: ListingSource::DynamicallyGenerated,
         }
@@ -643,11 +740,15 @@ impl ArenaFrom<Number> for HeapCellValue {
 impl Number {
     pub(crate) fn sign(&self) -> Number {
         match self {
-            &Number::Float(f) if f == 0.0 => Number::Float(OrderedFloat(0f64)),
+            Number::Float(f) if *f == 0.0 => Number::Float(OrderedFloat(0f64)),
-            &Number::Float(f) => Number::Float(OrderedFloat(f.signum())),
+            Number::Float(f) => Number::Float(OrderedFloat(f.signum())),
             _ => {
                 if self.is_positive() {
-                    Number::Fixnum(Fixnum::build_with(1))
+                    if self.is_zero() {
+                        Number::Fixnum(Fixnum::build_with(0))
+                    } else {
+                        Number::Fixnum(Fixnum::build_with(1))
+                    }
                 } else if self.is_negative() {
                     Number::Fixnum(Fixnum::build_with(-1))
                 } else {
@@ -660,39 +761,36 @@ impl Number {
     #[inline]
     pub(crate) fn is_positive(&self) -> bool {
         match self {
-            &Number::Fixnum(n) => n.get_num() > 0,
+            Number::Fixnum(n) => n.get_num() > 0,
-            &Number::Integer(ref n) => &**n > &0,
+            Number::Integer(ref n) => n.is_positive(),
-            &Number::Float(f) => f.is_sign_positive(),
+            Number::Float(f) => f.is_sign_positive(),
-            &Number::Rational(ref r) => &**r > &0,
+            Number::Rational(ref r) => r.is_positive(),
         }
     }
 
     #[inline]
     pub(crate) fn is_negative(&self) -> bool {
         match self {
-            &Number::Fixnum(n) => n.get_num() < 0,
+            Number::Fixnum(n) => n.get_num() < 0,
-            &Number::Integer(ref n) => &**n < &0,
+            Number::Integer(ref n) => n.is_negative(),
-            &Number::Float(OrderedFloat(f)) => f.is_sign_negative() && OrderedFloat(f) != -0f64,
+            &Number::Float(OrderedFloat(f)) => f.is_sign_negative() && f != -0f64,
-            &Number::Rational(ref r) => &**r < &0,
+            Number::Rational(ref r) => r.is_negative(),
         }
     }
 
     #[inline]
     pub(crate) fn is_zero(&self) -> bool {
         match self {
-            &Number::Fixnum(n) => n.get_num() == 0,
+            Number::Fixnum(n) => n.get_num() == 0,
-            &Number::Integer(ref n) => &**n == &0,
+            Number::Integer(ref n) => n.is_zero(),
-            &Number::Float(f) => f == OrderedFloat(0f64) || f == OrderedFloat(-0f64),
+            &Number::Float(OrderedFloat(f)) => f == 0.0 || f == -0.0,
-            &Number::Rational(ref r) => &**r == &0,
+            Number::Rational(ref r) => r.is_zero(),
         }
     }
 
     #[inline]
     pub(crate) fn is_integer(&self) -> bool {
-        match self {
+        matches!(self, Number::Fixnum(_) | Number::Integer(_))
-            Number::Fixnum(_) | Number::Integer(_) => true,
-            _ => false,
-        }
     }
 }
 
@@ -782,7 +880,7 @@ impl ClauseIndexInfo {
     }
 }
 
-#[derive(Clone, Copy, Debug)]
+#[derive(Clone, Copy, Debug, Default)]
 pub(crate) struct PredicateInfo {
     pub(crate) is_extensible: bool,
     pub(crate) is_discontiguous: bool,
@@ -791,19 +889,6 @@ pub(crate) struct PredicateInfo {
     pub(crate) has_clauses: bool,
 }
 
-impl Default for PredicateInfo {
-    #[inline]
-    fn default() -> Self {
-        PredicateInfo {
-            is_extensible: false,
-            is_discontiguous: false,
-            is_dynamic: false,
-            is_multifile: false,
-            has_clauses: false,
-        }
-    }
-}
-
 impl PredicateInfo {
     #[inline]
     pub(crate) fn compile_incrementally(&self) -> bool {
@@ -812,8 +897,11 @@ impl PredicateInfo {
     }
 
     #[inline]
-    pub(crate) fn must_retract_local_clauses(&self) -> bool {
+    pub(crate) fn must_retract_local_clauses(&self, is_cross_module_clause: bool) -> bool {
-        self.is_extensible && self.has_clauses && !self.is_discontiguous
+        self.is_extensible
+            && self.has_clauses
+            && !self.is_discontiguous
+            && !(self.is_multifile && is_cross_module_clause)
     }
 }
 
@@ -859,7 +947,7 @@ impl LocalPredicateSkeleton {
 
     #[inline]
     pub(crate) fn add_retracted_dynamic_clause_info(&mut self, clause_info: ClauseIndexInfo) {
-        debug_assert_eq!(self.is_dynamic, true);
+        debug_assert!(self.is_dynamic);
 
         if self.retracted_dynamic_clauses.is_none() {
             self.retracted_dynamic_clauses = Some(vec![]);
@@ -902,19 +990,17 @@ impl PredicateSkeleton {
         &mut self,
         clause_clause_loc: usize,
     ) -> Option<usize> {
-        let search_result = self.core.clause_clause_locs
+        let search_result = self.core.clause_clause_locs.make_contiguous()
-            .make_contiguous()[0..self.core.clause_assert_margin]
+            [0..self.core.clause_assert_margin]
-            .binary_search_by(|loc| clause_clause_loc.cmp(&loc));
+            .binary_search_by(|loc| clause_clause_loc.cmp(loc));
 
         match search_result {
             Ok(loc) => Some(loc),
-            Err(_) => {
+            Err(_) => self.core.clause_clause_locs.make_contiguous()
-                self.core.clause_clause_locs
+                [self.core.clause_assert_margin..]
-                    .make_contiguous()[self.core.clause_assert_margin..]
+                .binary_search_by(|loc| loc.cmp(&clause_clause_loc))
-                    .binary_search_by(|loc| loc.cmp(&clause_clause_loc))
+                .map(|loc| loc + self.core.clause_assert_margin)
-                    .map(|loc| loc + self.core.clause_assert_margin)
+                .ok(),
-                    .ok()
-            }
         }
     }
 }

src/http.rs

@@ -1,25 +1,23 @@
-use std::sync::Arc;
+use std::io::BufRead;
-use std::convert::Infallible;
+use std::sync::{Arc, Condvar, Mutex};
 
-use hyper::{Response, Request, Body};
+use warp::http;
-use tokio::sync::Mutex;
-use tokio::sync::mpsc::{channel, Receiver, Sender};
 
 pub struct HttpListener {
-    pub incoming: Receiver<HttpRequest>
+    pub incoming: std::sync::mpsc::Receiver<HttpRequest>,
 }
 
-#[derive(Debug)]
 pub struct HttpRequest {
-    pub request: Request<Body>,
+    pub request_data: HttpRequestData,
     pub response: HttpResponse,
 }
 
-pub type HttpResponse = Sender<Response<Body>>;
+pub type HttpResponse = Arc<(Mutex<bool>, Mutex<Option<warp::reply::Response>>, Condvar)>;
 
-pub async fn serve_req(req: Request<Body>, tx: Arc<Mutex<Sender<HttpRequest>>>) -> Result<Response<Body>, Infallible> {
+pub struct HttpRequestData {
-    let (response_tx, mut rx) = channel(1);
+    pub method: http::Method,
-    let http_request = HttpRequest { request: req, response: response_tx };
+    pub headers: http::HeaderMap,
-    tx.lock().await.send(http_request).await.unwrap();
+    pub path: String,
-    Ok(rx.recv().await.unwrap())
+    pub query: String,
+    pub body: Box<dyn BufRead + Send>,
 }

src/indexing.rs

@@ -150,17 +150,20 @@ impl<'a> IndexingCodeMergingPtr<'a> {
         let third_level_index = if self.append_or_prepend.is_append() {
             vec![
                 IndexedChoiceInstruction::Try(external),
-                IndexedChoiceInstruction::Trust(index)
+                IndexedChoiceInstruction::Trust(index),
-            ].into()
+            ]
+            .into()
         } else {
             vec![
                 IndexedChoiceInstruction::Try(index),
-                IndexedChoiceInstruction::Trust(external)
+                IndexedChoiceInstruction::Trust(external),
-            ].into()
+            ]
+            .into()
         };
 
         let indexing_code_len = self.indexing_code.len();
-        self.indexing_code.push(IndexingLine::IndexedChoice(third_level_index));
+        self.indexing_code
+            .push(IndexingLine::IndexedChoice(third_level_index));
 
         match &mut self.indexing_code[self.offset] {
             IndexingLine::Indexing(IndexingInstruction::SwitchOnConstant(ref mut constants)) => {
@@ -188,7 +191,8 @@ impl<'a> IndexingCodeMergingPtr<'a> {
         };
 
         let indexing_code_len = self.indexing_code.len();
-        self.indexing_code.push(IndexingLine::DynamicIndexedChoice(third_level_index));
+        self.indexing_code
+            .push(IndexingLine::DynamicIndexedChoice(third_level_index));
 
         match &mut self.indexing_code[self.offset] {
             IndexingLine::Indexing(IndexingInstruction::SwitchOnConstant(ref mut constants)) => {
@@ -275,10 +279,8 @@ impl<'a> IndexingCodeMergingPtr<'a> {
                             );
                         }
                         None | Some(IndexingCodePtr::Fail) => {
-                            constants.insert(
+                            constants
-                                overlapping_constant,
+                                .insert(overlapping_constant, IndexingCodePtr::External(index));
-                                IndexingCodePtr::External(index),
-                            );
                         }
                         Some(IndexingCodePtr::DynamicExternal(o)) => {
                             self.add_dynamic_indexed_choice_for_constant(
@@ -345,16 +347,10 @@ impl<'a> IndexingCodeMergingPtr<'a> {
                 IndexingLine::Indexing(IndexingInstruction::SwitchOnConstant(constants)) => {
                     match constants.get(&constant).cloned() {
                         None | Some(IndexingCodePtr::Fail) if self.is_dynamic => {
-                            constants.insert(
+                            constants.insert(constant, IndexingCodePtr::DynamicExternal(index));
-                                constant,
-                                IndexingCodePtr::DynamicExternal(index),
-                            );
                         }
                         None | Some(IndexingCodePtr::Fail) => {
-                            constants.insert(
+                            constants.insert(constant, IndexingCodePtr::External(index));
-                                constant,
-                                IndexingCodePtr::External(index),
-                            );
                         }
                         Some(IndexingCodePtr::DynamicExternal(o)) => {
                             self.add_dynamic_indexed_choice_for_constant(o, constant, index);
@@ -432,17 +428,20 @@ impl<'a> IndexingCodeMergingPtr<'a> {
         let third_level_index = if self.append_or_prepend.is_append() {
             vec![
                 IndexedChoiceInstruction::Try(external),
-                IndexedChoiceInstruction::Trust(index)
+                IndexedChoiceInstruction::Trust(index),
-            ].into()
+            ]
+            .into()
         } else {
             vec![
                 IndexedChoiceInstruction::Try(index),
-                IndexedChoiceInstruction::Trust(external)
+                IndexedChoiceInstruction::Trust(external),
-            ].into()
+            ]
+            .into()
         };
 
         let indexing_code_len = self.indexing_code.len();
-        self.indexing_code.push(IndexingLine::IndexedChoice(third_level_index));
+        self.indexing_code
+            .push(IndexingLine::IndexedChoice(third_level_index));
 
         match &mut self.indexing_code[self.offset] {
             IndexingLine::Indexing(IndexingInstruction::SwitchOnStructure(ref mut structures)) => {
@@ -470,7 +469,8 @@ impl<'a> IndexingCodeMergingPtr<'a> {
         };
 
         let indexing_code_len = self.indexing_code.len();
-        self.indexing_code.push(IndexingLine::DynamicIndexedChoice(third_level_index));
+        self.indexing_code
+            .push(IndexingLine::DynamicIndexedChoice(third_level_index));
 
         match &mut self.indexing_code[self.offset] {
             IndexingLine::Indexing(IndexingInstruction::SwitchOnStructure(ref mut structures)) => {
@@ -584,13 +584,15 @@ impl<'a> IndexingCodeMergingPtr<'a> {
                         let third_level_index = if self.append_or_prepend.is_append() {
                             vec![
                                 IndexedChoiceInstruction::Try(o),
-                                IndexedChoiceInstruction::Trust(index)
+                                IndexedChoiceInstruction::Trust(index),
-                            ].into()
+                            ]
+                            .into()
                         } else {
                             vec![
                                 IndexedChoiceInstruction::Try(index),
-                                IndexedChoiceInstruction::Trust(o)
+                                IndexedChoiceInstruction::Trust(o),
-                            ].into()
+                            ]
+                            .into()
                         };
 
                         self.indexing_code
@@ -613,7 +615,7 @@ pub(crate) fn merge_clause_index(
     target_indexing_code: &mut Vec<IndexingLine>,
     skeleton: &mut [ClauseIndexInfo], // the clause to be merged is the last element in the skeleton.
     retracted_clauses: &Option<Vec<ClauseIndexInfo>>,
-    new_clause_loc: usize,            // the absolute location of the new clause in the code vector.
+    new_clause_loc: usize, // the absolute location of the new clause in the code vector.
     append_or_prepend: AppendOrPrepend,
 ) {
     let opt_arg_index_key = match append_or_prepend {
@@ -636,11 +638,7 @@ pub(crate) fn merge_clause_index(
             for overlapping_constant in overlapping_constants {
                 merging_ptr.offset = 0;
 
-                merging_ptr.index_overlapping_constant(
+                merging_ptr.index_overlapping_constant(*constant, *overlapping_constant, offset);
-                    *constant,
-                    *overlapping_constant,
-                    offset,
-                );
             }
         }
         OptArgIndexKey::Structure(_, index_loc, name, arity) => {
@@ -667,7 +665,7 @@ pub(crate) fn merge_clause_index(
 pub(crate) fn remove_constant_indices(
     constant: Literal,
     overlapping_constants: &[Literal],
-    indexing_code: &mut Vec<IndexingLine>,
+    indexing_code: &mut [IndexingLine],
     offset: usize,
 ) {
     let mut index = 0;
@@ -813,7 +811,7 @@ pub(crate) fn remove_constant_indices(
 pub(crate) fn remove_structure_index(
     name: Atom,
     arity: usize,
-    indexing_code: &mut Vec<IndexingLine>,
+    indexing_code: &mut [IndexingLine],
     offset: usize,
 ) {
     let mut index = 0;
@@ -845,10 +843,10 @@ pub(crate) fn remove_structure_index(
             IndexingLine::Indexing(IndexingInstruction::SwitchOnStructure(ref mut structures)) => {
                 structures_index = index;
 
-                match structures.get(&(name.clone(), arity)).cloned() {
+                match structures.get(&(name, arity)).cloned() {
                     Some(IndexingCodePtr::DynamicExternal(_))
                     | Some(IndexingCodePtr::External(_)) => {
-                        structures.remove(&(name.clone(), arity));
+                        structures.remove(&(name, arity));
                         break;
                     }
                     Some(IndexingCodePtr::Internal(o)) => {
@@ -879,7 +877,7 @@ pub(crate) fn remove_structure_index(
                             IndexingLine::Indexing(IndexingInstruction::SwitchOnStructure(
                                 ref mut structures,
                             )) => {
-                                structures.insert((name.clone(), arity), ext);
+                                structures.insert((name, arity), ext);
                             }
                             _ => {
                                 unreachable!()
@@ -910,7 +908,7 @@ pub(crate) fn remove_structure_index(
                             IndexingLine::Indexing(IndexingInstruction::SwitchOnStructure(
                                 ref mut structures,
                             )) => {
-                                structures.insert((name.clone(), arity), ext);
+                                structures.insert((name, arity), ext);
                             }
                             _ => {
                                 unreachable!()
@@ -950,7 +948,7 @@ pub(crate) fn remove_structure_index(
     }
 }
 
-pub(crate) fn remove_list_index(indexing_code: &mut Vec<IndexingLine>, offset: usize) {
+pub(crate) fn remove_list_index(indexing_code: &mut [IndexingLine], offset: usize) {
     let mut index = 0;
 
     match &mut indexing_code[index] {
@@ -1030,7 +1028,7 @@ pub(crate) fn remove_list_index(indexing_code: &mut Vec<IndexingLine>, offset: u
 
 pub(crate) fn remove_index(
     opt_arg_index_key: &OptArgIndexKey,
-    indexing_code: &mut Vec<IndexingLine>,
+    indexing_code: &mut [IndexingLine],
     clause_loc: usize,
 ) {
     match opt_arg_index_key {
@@ -1051,43 +1049,55 @@ pub(crate) fn remove_index(
 
 #[inline]
 fn cap_choice_seq(prelude: &mut [IndexedChoiceInstruction]) {
-    prelude.first_mut().map(|instr| {
+    if let Some(instr) = prelude.first_mut() {
         *instr = IndexedChoiceInstruction::Try(instr.offset());
-    });
+    }
 
     cap_choice_seq_with_trust(prelude);
 }
 
 #[inline]
 fn cap_choice_seq_with_trust(prelude: &mut [IndexedChoiceInstruction]) {
-    prelude.last_mut().map(|instr| {
+    if let Some(instr) = prelude.last_mut() {
-        if let IndexedChoiceInstruction::Retry(i) = instr {
+        match instr {
-            *instr = IndexedChoiceInstruction::Trust(*i);
+            IndexedChoiceInstruction::Retry(i) => {
+                *instr = IndexedChoiceInstruction::Trust(*i);
+            }
+            IndexedChoiceInstruction::DefaultRetry(i) => {
+                *instr = IndexedChoiceInstruction::DefaultTrust(*i);
+            }
+            _ => {}
         }
-    });
+    }
 }
 
 #[inline]
 fn uncap_choice_seq_with_trust(prelude: &mut [IndexedChoiceInstruction]) {
-    prelude.last_mut().map(|instr| {
+    if let Some(instr) = prelude.last_mut() {
-        if let IndexedChoiceInstruction::Trust(i) = instr {
+        match instr {
-            *instr = IndexedChoiceInstruction::Retry(*i);
+            IndexedChoiceInstruction::Trust(i) => {
+                *instr = IndexedChoiceInstruction::Retry(*i);
+            }
+            IndexedChoiceInstruction::DefaultTrust(i) => {
+                *instr = IndexedChoiceInstruction::DefaultRetry(*i);
+            }
+            _ => {}
         }
-    });
+    }
 }
 
 #[inline]
 fn uncap_choice_seq_with_try(prelude: &mut [IndexedChoiceInstruction]) {
-    prelude.first_mut().map(|instr| {
+    if let Some(instr) = prelude.first_mut() {
         if let IndexedChoiceInstruction::Try(i) = instr {
             *instr = IndexedChoiceInstruction::Retry(*i);
         }
-    });
+    }
 }
 
 pub(crate) fn constant_key_alternatives(
     constant: Literal,
-    atom_tbl: &mut AtomTable,
+    atom_tbl: &AtomTable,
     // arena: &mut Arena,
 ) -> Vec<Literal> {
     let mut constants = vec![];
@@ -1099,7 +1109,7 @@ pub(crate) fn constant_key_alternatives(
             }
         }
         Literal::Char(c) => {
-            let atom = atom_tbl.build_with(&c.to_string());
+            let atom = AtomTable::build_with(atom_tbl, &c.to_string());
             constants.push(Literal::Atom(atom));
         }
         /*
@@ -1116,10 +1126,13 @@ pub(crate) fn constant_key_alternatives(
         }
         */
         Literal::Integer(ref n) => {
-            if let Some(n) = n.to_isize() {
+            let result = (&**n).try_into();
-                Fixnum::build_with_checked(n as i64).map(|n| {
+            if let Ok(value) = result {
-                    constants.push(Literal::Fixnum(n));
+                Fixnum::build_with_checked(value)
-                }).unwrap();
+                    .map(|n| {
+                        constants.push(Literal::Fixnum(n));
+                    })
+                    .unwrap();
             }
         }
         _ => {}
@@ -1147,11 +1160,19 @@ pub(crate) trait Indexer {
 
     fn new() -> Self;
 
-    fn constants(&mut self) -> &mut IndexMap<Literal, VecDeque<Self::ThirdLevelIndex>, FxBuildHasher>;
+    fn constants(
+        &mut self,
+    ) -> &mut IndexMap<Literal, VecDeque<Self::ThirdLevelIndex>, FxBuildHasher>;
     fn lists(&mut self) -> &mut VecDeque<Self::ThirdLevelIndex>;
-    fn structures(&mut self) -> &mut IndexMap<(Atom, usize), VecDeque<Self::ThirdLevelIndex>, FxBuildHasher>;
+    fn structures(
+        &mut self,
+    ) -> &mut IndexMap<(Atom, usize), VecDeque<Self::ThirdLevelIndex>, FxBuildHasher>;
 
-    fn compute_index(is_initial_index: bool, index: usize) -> Self::ThirdLevelIndex;
+    fn compute_index(
+        is_initial_index: bool,
+        index: usize,
+        non_counted_bt: bool,
+    ) -> Self::ThirdLevelIndex;
 
     fn second_level_index<IndexKey: Eq + Hash>(
         indices: IndexMap<IndexKey, VecDeque<Self::ThirdLevelIndex>, FxBuildHasher>,
@@ -1187,7 +1208,9 @@ impl Indexer for StaticCodeIndices {
     }
 
     #[inline]
-    fn constants(&mut self) -> &mut IndexMap<Literal, VecDeque<IndexedChoiceInstruction>, FxBuildHasher> {
+    fn constants(
+        &mut self,
+    ) -> &mut IndexMap<Literal, VecDeque<IndexedChoiceInstruction>, FxBuildHasher> {
         &mut self.constants
     }
 
@@ -1197,13 +1220,21 @@ impl Indexer for StaticCodeIndices {
     }
 
     #[inline]
-    fn structures(&mut self) -> &mut IndexMap<(Atom, usize), VecDeque<IndexedChoiceInstruction>, FxBuildHasher> {
+    fn structures(
+        &mut self,
+    ) -> &mut IndexMap<(Atom, usize), VecDeque<IndexedChoiceInstruction>, FxBuildHasher> {
         &mut self.structures
     }
 
-    fn compute_index(is_initial_index: bool, index: usize) -> IndexedChoiceInstruction {
+    fn compute_index(
+        is_initial_index: bool,
+        index: usize,
+        non_counted_bt: bool,
+    ) -> IndexedChoiceInstruction {
         if is_initial_index {
             IndexedChoiceInstruction::Try(index + 1)
+        } else if non_counted_bt {
+            IndexedChoiceInstruction::DefaultRetry(index + 1)
         } else {
             IndexedChoiceInstruction::Retry(index + 1)
         }
@@ -1220,10 +1251,8 @@ impl Indexer for StaticCodeIndices {
                 index_locs.insert(key, IndexingCodePtr::Internal(prelude.len() + 1));
                 cap_choice_seq_with_trust(code.make_contiguous());
                 prelude.push_back(IndexingLine::from(code));
-            } else {
+            } else if let Some(i) = code.front() {
-                code.front().map(|i| {
+                index_locs.insert(key, IndexingCodePtr::External(i.offset()));
-                    index_locs.insert(key, IndexingCodePtr::External(i.offset()));
-                });
             }
         }
 
@@ -1231,7 +1260,9 @@ impl Indexer for StaticCodeIndices {
     }
 
     fn switch_on<IndexKey: Eq + Hash>(
-        mut instr_fn: impl FnMut(IndexMap<IndexKey, IndexingCodePtr, FxBuildHasher>) -> IndexingInstruction,
+        mut instr_fn: impl FnMut(
+            IndexMap<IndexKey, IndexingCodePtr, FxBuildHasher>,
+        ) -> IndexingInstruction,
         index: &mut IndexMap<IndexKey, VecDeque<IndexedChoiceInstruction>, FxBuildHasher>,
         prelude: &mut VecDeque<IndexingLine>,
     ) -> IndexingCodePtr {
@@ -1258,7 +1289,7 @@ impl Indexer for StaticCodeIndices {
     ) -> IndexingCodePtr {
         if lists.len() > 1 {
             cap_choice_seq_with_trust(lists.make_contiguous());
-            let lists = mem::replace(lists, VecDeque::new());
+            let lists = std::mem::take(lists);
             prelude.push_back(IndexingLine::from(lists));
 
             IndexingCodePtr::Internal(1)
@@ -1318,7 +1349,7 @@ impl Indexer for DynamicCodeIndices {
     }
 
     #[inline]
-    fn compute_index(_: bool, index: usize) -> usize {
+    fn compute_index(_: bool, index: usize, _: bool) -> usize {
         index + 1
     }
 
@@ -1331,11 +1362,11 @@ impl Indexer for DynamicCodeIndices {
         for (key, code) in indices.into_iter() {
             if code.len() > 1 {
                 index_locs.insert(key, IndexingCodePtr::Internal(prelude.len() + 1));
-                prelude.push_back(IndexingLine::DynamicIndexedChoice(code.into_iter().collect()));
+                prelude.push_back(IndexingLine::DynamicIndexedChoice(
-            } else {
+                    code.into_iter().collect(),
-                code.front().map(|i| {
+                ));
-                    index_locs.insert(key, IndexingCodePtr::DynamicExternal(*i));
+            } else if let Some(i) = code.front() {
-                });
+                index_locs.insert(key, IndexingCodePtr::DynamicExternal(*i));
             }
         }
 
@@ -1343,7 +1374,9 @@ impl Indexer for DynamicCodeIndices {
     }
 
     fn switch_on<IndexKey: Eq + Hash>(
-        mut instr_fn: impl FnMut(IndexMap<IndexKey, IndexingCodePtr, FxBuildHasher>) -> IndexingInstruction,
+        mut instr_fn: impl FnMut(
+            IndexMap<IndexKey, IndexingCodePtr, FxBuildHasher>,
+        ) -> IndexingInstruction,
         index: &mut IndexMap<IndexKey, VecDeque<usize>, FxBuildHasher>,
         prelude: &mut VecDeque<IndexingLine>,
     ) -> IndexingCodePtr {
@@ -1369,8 +1402,10 @@ impl Indexer for DynamicCodeIndices {
         prelude: &mut VecDeque<IndexingLine>,
     ) -> IndexingCodePtr {
         if lists.len() > 1 {
-            let lists = mem::replace(lists, VecDeque::new());
+            let lists = std::mem::take(lists);
-            prelude.push_back(IndexingLine::DynamicIndexedChoice(lists.into_iter().collect()));
+            prelude.push_back(IndexingLine::DynamicIndexedChoice(
+                lists.into_iter().collect(),
+            ));
             IndexingCodePtr::Internal(1)
         } else {
             lists
@@ -1400,43 +1435,45 @@ impl Indexer for DynamicCodeIndices {
 pub(crate) struct CodeOffsets<I: Indexer> {
     indices: I,
     optimal_index: usize,
+    non_counted_bt: bool,
 }
 
 impl<I: Indexer> CodeOffsets<I> {
-    pub(crate) fn new(indices: I, optimal_index: usize) -> Self {
+    pub(crate) fn new(indices: I, optimal_index: usize, non_counted_bt: bool) -> Self {
         CodeOffsets {
             indices,
             optimal_index,
+            non_counted_bt,
         }
     }
 
     fn index_list(&mut self, index: usize) {
         let is_initial_index = self.indices.lists().is_empty();
-        let index = I::compute_index(is_initial_index, index);
+        let index = I::compute_index(is_initial_index, index, self.non_counted_bt);
         self.indices.lists().push_back(index);
     }
 
     fn index_constant(
         &mut self,
-        atom_tbl: &mut AtomTable,
+        atom_tbl: &AtomTable,
         constant: Literal,
         index: usize,
     ) -> Vec<Literal> {
         let overlapping_constants = constant_key_alternatives(constant, atom_tbl);
-        let code = self.indices.constants().entry(constant).or_insert(VecDeque::new());
+        let code = self.indices.constants().entry(constant).or_default();
 
         let is_initial_index = code.is_empty();
-        code.push_back(I::compute_index(is_initial_index, index));
+        code.push_back(I::compute_index(
+            is_initial_index,
+            index,
+            self.non_counted_bt,
+        ));
 
         for constant in &overlapping_constants {
-            let code = self
+            let code = self.indices.constants().entry(*constant).or_default();
-                .indices
-                .constants()
-                .entry(*constant)
-                .or_insert(VecDeque::new());
 
             let is_initial_index = code.is_empty();
-            let index = I::compute_index(is_initial_index, index);
+            let index = I::compute_index(is_initial_index, index, self.non_counted_bt);
 
             code.push_back(index);
         }
@@ -1445,16 +1482,16 @@ impl<I: Indexer> CodeOffsets<I> {
     }
 
     fn index_structure(&mut self, name: Atom, arity: usize, index: usize) -> usize {
-        let code = self
+        let code = self.indices.structures().entry((name, arity)).or_default();
-            .indices
-            .structures()
-            .entry((name.clone(), arity))
-            .or_insert(VecDeque::new());
 
         let code_len = code.len();
         let is_initial_index = code.is_empty();
 
-        code.push_back(I::compute_index(is_initial_index, index));
+        code.push_back(I::compute_index(
+            is_initial_index,
+            index,
+            self.non_counted_bt,
+        ));
         code_len
     }
 
@@ -1463,7 +1500,7 @@ impl<I: Indexer> CodeOffsets<I> {
         optimal_arg: &Term,
         index: usize,
         clause_index_info: &mut ClauseIndexInfo,
-        atom_tbl: &mut AtomTable,
+        atom_tbl: &AtomTable,
     ) {
         match optimal_arg {
             &Term::Clause(_, atom!("."), ref terms) if terms.len() == 2 => {
@@ -1476,7 +1513,7 @@ impl<I: Indexer> CodeOffsets<I> {
             }
             &Term::Clause(_, name, ref terms) => {
                 clause_index_info.opt_arg_index_key =
-                    OptArgIndexKey::Structure(self.optimal_index, 0, name.clone(), terms.len());
+                    OptArgIndexKey::Structure(self.optimal_index, 0, name, terms.len());
 
                 self.index_structure(name, terms.len(), index);
             }
@@ -1528,20 +1565,14 @@ impl<I: Indexer> CodeOffsets<I> {
             &mut prelude,
         );
 
-        match &mut str_loc {
+        if let IndexingCodePtr::Internal(ref mut i) = &mut str_loc {
-            IndexingCodePtr::Internal(ref mut i) => {
+            *i += emitted_switch_on_constant as usize; // con_loc.is_internal() as usize;
-                *i += emitted_switch_on_constant as usize; // con_loc.is_internal() as usize;
+        }
-            }
-            _ => {}
-        };
 
-        match &mut lst_loc {
+        if let IndexingCodePtr::Internal(ref mut i) = &mut lst_loc {
-            IndexingCodePtr::Internal(ref mut i) => {
+            *i += emitted_switch_on_constant as usize; // con_loc.is_internal() as usize;
-                *i += emitted_switch_on_constant as usize; // con_loc.is_internal() as usize;
+            *i += emitted_switch_on_structure as usize; // str_loc.is_internal() as usize;
-                *i += emitted_switch_on_structure as usize; // str_loc.is_internal() as usize;
+        }
-            }
-            _ => {}
-        };
 
         let var_offset = 1 + skip_stub_try_me_else as usize;
 

src/iterators.rs

@@ -5,11 +5,10 @@ use crate::parser::ast::*;
 
 use std::cell::Cell;
 use std::collections::VecDeque;
-use std::fmt;
 use std::iter::*;
-use std::rc::Rc;
 use std::vec::Vec;
 
+#[allow(clippy::borrowed_box)]
 #[derive(Debug, Clone)]
 pub(crate) enum TermRef<'a> {
     AnonVar(Level),
@@ -18,34 +17,37 @@ pub(crate) enum TermRef<'a> {
     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>),
+    Var(Level, &'a Cell<VarReg>, VarPtr),
 }
 
+/*
 impl<'a> TermRef<'a> {
-    pub(crate) fn level(self) -> Level {
+    pub(crate) fn level(&self) -> Level {
         match self {
-            TermRef::AnonVar(lvl)
+            TermRef::AnonVar(lvl) |
-            | TermRef::Cons(lvl, ..)
+            TermRef::Cons(lvl, ..) |
-            | TermRef::Literal(lvl, ..)
+            TermRef::Literal(lvl, ..) |
-            | TermRef::Var(lvl, ..)
+            TermRef::Var(lvl, ..) |
-            | TermRef::Clause(lvl, ..)
+            TermRef::Clause(lvl, ..) |
-            | TermRef::CompleteString(lvl, ..)
+            TermRef::CompleteString(lvl, ..) |
-            | TermRef::PartialString(lvl, ..) => lvl,
+            TermRef::PartialString(lvl, ..) => *lvl,
         }
     }
 }
+*/
 
+#[allow(clippy::borrowed_box)]
 #[derive(Debug)]
 pub(crate) enum TermIterState<'a> {
     AnonVar(Level),
-    Literal(Level, &'a Cell<RegType>, &'a Literal),
     Clause(Level, usize, &'a Cell<RegType>, Atom, &'a Vec<Term>),
+    Literal(Level, &'a Cell<RegType>, &'a Literal),
     InitialCons(Level, &'a Cell<RegType>, &'a Term, &'a Term),
     FinalCons(Level, &'a Cell<RegType>, &'a Term, &'a Term),
     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>),
+    Var(Level, &'a Cell<VarReg>, VarPtr),
 }
 
 impl<'a> TermIterState<'a> {
@@ -62,10 +64,8 @@ impl<'a> TermIterState<'a> {
             Term::PartialString(cell, string_buf, tail) => {
                 TermIterState::InitialPartialString(lvl, cell, string_buf, tail)
             }
-            Term::CompleteString(cell, atom) => {
+            Term::CompleteString(cell, atom) => TermIterState::CompleteString(lvl, cell, *atom),
-                TermIterState::CompleteString(lvl, cell, *atom)
+            Term::Var(cell, var_ptr) => TermIterState::Var(lvl, cell, var_ptr.clone()),
-            }
-            Term::Var(cell, var) => TermIterState::Var(lvl, cell, var.clone()),
         }
     }
 }
@@ -81,6 +81,7 @@ impl<'a> QueryIterator<'a> {
             .push(TermIterState::subterm_to_state(lvl, term));
     }
 
+    /*
     fn from_rule_head_clause(terms: &'a Vec<Term>) -> Self {
         let state_stack = terms
             .iter()
@@ -90,23 +91,21 @@ impl<'a> QueryIterator<'a> {
 
         QueryIterator { state_stack }
     }
+    */
 
     fn from_term(term: &'a Term) -> Self {
         let state = match term {
-            Term::AnonVar | Term::Cons(..) | Term::Literal(..) |
+            Term::AnonVar
-            Term::PartialString(..) | Term::CompleteString(..) => {
+            | Term::Cons(..)
+            | Term::Literal(..)
+            | Term::PartialString(..)
+            | Term::CompleteString(..) => {
                 return QueryIterator {
                     state_stack: vec![],
                 }
             }
-            Term::Clause(r, name, terms) => TermIterState::Clause(
+            Term::Clause(r, name, terms) => TermIterState::Clause(Level::Root, 0, r, *name, terms),
-                Level::Root,
+            Term::Var(cell, var_ptr) => TermIterState::Var(Level::Root, cell, var_ptr.clone()),
-                0,
-                r,
-                *name,
-                terms,
-            ),
-            Term::Var(cell, var) => TermIterState::Var(Level::Root, cell, var.clone()),
         };
 
         QueryIterator {
@@ -114,46 +113,27 @@ impl<'a> QueryIterator<'a> {
         }
     }
 
-    fn new(term: &'a QueryTerm) -> Self {
+    fn extend_state(&mut self, lvl: Level, term: &'a QueryTerm) {
         match term {
-            &QueryTerm::Clause(ref cell, ClauseType::CallN(_), ref terms, _) => {
+            QueryTerm::Clause(ref cell, ClauseType::CallN(_), ref terms, _) => {
-                let state = TermIterState::Clause(Level::Root, 1, cell, atom!("$call"), terms);
+                self.state_stack
-                QueryIterator {
+                    .push(TermIterState::Clause(lvl, 1, cell, atom!("$call"), terms));
-                    state_stack: vec![state],
-                }
             }
-            &QueryTerm::Clause(ref cell, ref ct, ref terms, _) => {
+            QueryTerm::Clause(ref cell, ref ct, ref terms, _) => {
-                let state = TermIterState::Clause(Level::Root, 0, cell, ct.name(), terms);
+                self.state_stack
-                QueryIterator {
+                    .push(TermIterState::Clause(lvl, 0, cell, ct.name(), terms));
-                    state_stack: vec![state],
-                }
             }
-            &QueryTerm::UnblockedCut(ref cell) => {
+            _ => {}
-                let state = TermIterState::Var(Level::Root, cell, Rc::new("!".to_string()));
-                QueryIterator {
-                    state_stack: vec![state],
-                }
-            }
-            &QueryTerm::GetLevelAndUnify(ref cell, ref var) => {
-                let state = TermIterState::Var(Level::Root, cell, var.clone());
-                QueryIterator {
-                    state_stack: vec![state],
-                }
-            }
-            &QueryTerm::Jump(ref vars) => {
-                let state_stack = vars
-                    .iter()
-                    .rev()
-                    .map(|t| TermIterState::subterm_to_state(Level::Shallow, t))
-                    .collect();
-
-                QueryIterator { state_stack }
-            }
-            &QueryTerm::BlockedCut => QueryIterator {
-                state_stack: vec![],
-            },
         }
     }
+
+    pub fn new(term: &'a QueryTerm) -> Self {
+        let mut iter = QueryIterator {
+            state_stack: vec![],
+        };
+        iter.extend_state(Level::Root, term);
+        iter
+    }
 }
 
 impl<'a> Iterator for QueryIterator<'a> {
@@ -191,13 +171,15 @@ impl<'a> Iterator for QueryIterator<'a> {
                     }
                 }
                 TermIterState::InitialCons(lvl, cell, head, tail) => {
-                    self.state_stack.push(TermIterState::FinalCons(lvl, cell, head, tail));
+                    self.state_stack
+                        .push(TermIterState::FinalCons(lvl, cell, head, tail));
 
                     self.push_subterm(lvl.child_level(), tail);
                     self.push_subterm(lvl.child_level(), head);
                 }
                 TermIterState::InitialPartialString(lvl, cell, string, tail) => {
-                    self.state_stack.push(TermIterState::FinalPartialString(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) => {
@@ -212,8 +194,8 @@ impl<'a> Iterator for QueryIterator<'a> {
                 TermIterState::Literal(lvl, cell, constant) => {
                     return Some(TermRef::Literal(lvl, cell, constant));
                 }
-                TermIterState::Var(lvl, cell, var) => {
+                TermIterState::Var(lvl, cell, var_ptr) => {
-                    return Some(TermRef::Var(lvl, cell, var));
+                    return Some(TermRef::Var(lvl, cell, var_ptr));
                 }
             };
         }
@@ -225,7 +207,7 @@ impl<'a> Iterator for QueryIterator<'a> {
 #[derive(Debug)]
 pub(crate) struct FactIterator<'a> {
     state_queue: VecDeque<TermIterState<'a>>,
-    iterable_root: bool,
+    iterable_root: RootIterationPolicy,
 }
 
 impl<'a> FactIterator<'a> {
@@ -234,7 +216,7 @@ impl<'a> FactIterator<'a> {
             .push_back(TermIterState::subterm_to_state(lvl, term));
     }
 
-    pub(crate) fn from_rule_head_clause(terms: &'a Vec<Term>) -> Self {
+    pub(crate) fn from_rule_head_clause(terms: &'a [Term]) -> Self {
         let state_queue = terms
             .iter()
             .map(|bt| TermIterState::subterm_to_state(Level::Shallow, bt))
@@ -242,11 +224,11 @@ impl<'a> FactIterator<'a> {
 
         FactIterator {
             state_queue,
-            iterable_root: false,
+            iterable_root: RootIterationPolicy::NotIterated,
         }
     }
 
-    fn new(term: &'a Term, iterable_root: bool) -> Self {
+    fn new(term: &'a Term, iterable_root: RootIterationPolicy) -> Self {
         let states = match term {
             Term::AnonVar => {
                 vec![TermIterState::AnonVar(Level::Root)]
@@ -269,17 +251,13 @@ impl<'a> FactIterator<'a> {
                 )]
             }
             Term::CompleteString(cell, atom) => {
-                vec![TermIterState::CompleteString(
+                vec![TermIterState::CompleteString(Level::Root, cell, *atom)]
-                    Level::Root,
-                    cell,
-                    *atom,
-                )]
             }
             Term::Literal(cell, constant) => {
                 vec![TermIterState::Literal(Level::Root, cell, constant)]
             }
-            Term::Var(cell, var) => {
+            Term::Var(cell, var_ptr) => {
-                vec![TermIterState::Var(Level::Root, cell, var.clone())]
+                vec![TermIterState::Var(Level::Root, cell, var_ptr.clone())]
             }
         };
 
@@ -305,7 +283,7 @@ impl<'a> Iterator for FactIterator<'a> {
                     }
 
                     match lvl {
-                        Level::Root if !self.iterable_root => continue,
+                        Level::Root if !self.iterable_root.iterable() => continue,
                         _ => return Some(TermRef::Clause(lvl, cell, name, child_terms)),
                     };
                 }
@@ -325,8 +303,8 @@ impl<'a> Iterator for FactIterator<'a> {
                 TermIterState::Literal(lvl, cell, constant) => {
                     return Some(TermRef::Literal(lvl, cell, constant))
                 }
-                TermIterState::Var(lvl, cell, var) => {
+                TermIterState::Var(lvl, cell, var_ptr) => {
-                    return Some(TermRef::Var(lvl, cell, var));
+                    return Some(TermRef::Var(lvl, cell, var_ptr));
                 }
                 _ => {}
             }
@@ -336,197 +314,138 @@ impl<'a> Iterator for FactIterator<'a> {
     }
 }
 
-pub(crate) fn post_order_iter<'a>(term: &'a Term) -> QueryIterator<'a> {
+pub(crate) fn post_order_iter(term: &'_ Term) -> QueryIterator {
     QueryIterator::from_term(term)
 }
 
-pub(crate) fn breadth_first_iter<'a>(term: &'a Term, iterable_root: bool) -> FactIterator<'a> {
+pub(crate) fn breadth_first_iter(
+    term: &'_ Term,
+    iterable_root: RootIterationPolicy,
+) -> FactIterator {
     FactIterator::new(term, iterable_root)
 }
 
+#[derive(Debug, Copy, Clone)]
+enum ClauseIteratorState<'a> {
+    RemainingChunks(&'a VecDeque<ChunkedTerms>, usize),
+    RemainingBranches(&'a Vec<VecDeque<ChunkedTerms>>, usize),
+}
+
+#[derive(Debug, Clone)]
+pub(crate) enum ClauseItem<'a> {
+    FirstBranch(usize),
+    NextBranch,
+    BranchEnd(usize),
+    Chunk(&'a VecDeque<QueryTerm>),
+}
+
 #[derive(Debug)]
-pub(crate) enum ChunkedTerm<'a> {
+pub(crate) struct ClauseIterator<'a> {
-    HeadClause(Atom, &'a Vec<Term>),
+    state_stack: Vec<ClauseIteratorState<'a>>,
-    BodyTerm(&'a QueryTerm),
+    remaining_chunks_on_stack: usize,
 }
 
-pub(crate) fn query_term_post_order_iter<'a>(query_term: &'a QueryTerm) -> QueryIterator<'a> {
+fn state_from_chunked_terms(chunk_vec: &'_ VecDeque<ChunkedTerms>) -> ClauseIteratorState {
-    QueryIterator::new(query_term)
+    if chunk_vec.len() == 1 {
-}
+        if let Some(ChunkedTerms::Branch(ref branches)) = chunk_vec.front() {
-
+            return ClauseIteratorState::RemainingBranches(branches, 0);
-impl<'a> ChunkedTerm<'a> {
-    pub(crate) fn post_order_iter(&self) -> QueryIterator<'a> {
-        match self {
-            &ChunkedTerm::BodyTerm(qt) => QueryIterator::new(qt),
-            &ChunkedTerm::HeadClause(_, terms) => QueryIterator::from_rule_head_clause(terms),
         }
     }
+
+    ClauseIteratorState::RemainingChunks(chunk_vec, 0)
 }
 
-fn contains_cut_var<'a, Iter: Iterator<Item = &'a Term>>(terms: Iter) -> bool {
+impl<'a> ClauseIterator<'a> {
-    for term in terms {
+    pub fn new(clauses: &'a ChunkedTermVec) -> Self {
-        if let &Term::Var(_, ref var) = term {
+        match state_from_chunked_terms(&clauses.chunk_vec) {
-            if var.as_str() == "!" {
+            state @ ClauseIteratorState::RemainingBranches(..) => Self {
-                return true;
+                state_stack: vec![state],
+                remaining_chunks_on_stack: 0,
+            },
+            state @ ClauseIteratorState::RemainingChunks(..) => Self {
+                state_stack: vec![state],
+                remaining_chunks_on_stack: 1,
+            },
+        }
+    }
+
+    #[inline(always)]
+    pub fn in_tail_position(&self) -> bool {
+        self.remaining_chunks_on_stack == 0
+    }
+
+    fn branch_end_depth(&mut self) -> usize {
+        let mut depth = 1;
+
+        while let Some(state) = self.state_stack.pop() {
+            match state {
+                ClauseIteratorState::RemainingBranches(terms, focus) if terms.len() == focus => {
+                    depth += 1;
+                }
+                _ => {
+                    self.state_stack.push(state);
+                    break;
+                }
             }
         }
-    }
 
-    false
+        depth
-}
-
-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,
-}
-
-impl<'a> fmt::Debug for ChunkedIterator<'a> {
-    fn fmt(&self, fmt: &mut fmt::Formatter<'_>) -> fmt::Result {
-        fmt.debug_struct("ChunkedIterator")
-            .field("chunk_num", &self.chunk_num)
-            // Hacky solution.
-            .field("iter", &"Box<dyn Iterator<Item = ChunkedTerm<'a>> + 'a>")
-            .field("deep_cut_encountered", &self.deep_cut_encountered)
-            .field("cut_var_in_head", &self.cut_var_in_head)
-            .finish()
     }
 }
 
-type ChunkedIteratorItem<'a> = (usize, usize, Vec<ChunkedTerm<'a>>);
+impl<'a> Iterator for ClauseIterator<'a> {
-type RuleBodyIteratorItem<'a> = (usize, usize, Vec<&'a QueryTerm>);
+    type Item = ClauseItem<'a>;
-
-impl<'a> ChunkedIterator<'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()
-                .filter_map(|ct| match ct {
-                    ChunkedTerm::BodyTerm(qt) => Some(qt),
-                    _ => None,
-                })
-                .collect();
-
-            if filtered_terms.is_empty() {
-                None
-            } else {
-                Some((cn, lt_arity, filtered_terms))
-            }
-        }))
-    }
-
-    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)));
-
-        ChunkedIterator {
-            chunk_num: 0,
-            iter: Box::new(iter),
-            deep_cut_encountered: false,
-            cut_var_in_head: false,
-        }
-    }
-
-    pub(crate) fn from_rule(rule: &'a Rule) -> Self {
-        let &Rule {
-            head: (ref name, ref args, ref p1),
-            ref clauses,
-        } = rule;
-
-        let iter = once(ChunkedTerm::HeadClause(name.clone(), args));
-        let inner_iter = Box::new(once(ChunkedTerm::BodyTerm(p1)));
-        let iter = iter.chain(inner_iter.chain(clauses.iter().map(|t| ChunkedTerm::BodyTerm(t))));
-
-        ChunkedIterator {
-            chunk_num: 0,
-            iter: Box::new(iter),
-            deep_cut_encountered: false,
-            cut_var_in_head: false,
-        }
-    }
-
-    pub(crate) fn encountered_deep_cut(&self) -> bool {
-        self.deep_cut_encountered
-    }
-
-    fn take_chunk(&mut self, term: ChunkedTerm<'a>) -> (usize, usize, Vec<ChunkedTerm<'a>>) {
-        let mut arity = 0;
-        let mut item = Some(term);
-        let mut result = Vec::new();
-
-        while let Some(term) = item {
-            match term {
-                ChunkedTerm::HeadClause(_, terms) => {
-                    if contains_cut_var(terms.iter()) {
-                        self.cut_var_in_head = true;
-                    }
-
-                    result.push(term);
-                }
-                ChunkedTerm::BodyTerm(&QueryTerm::Jump(ref vars)) => {
-                    result.push(term);
-                    arity = vars.len();
-
-                    if contains_cut_var(vars.iter()) && !self.cut_var_in_head {
-                        self.deep_cut_encountered = true;
-                    }
-
-                    break;
-                }
-                ChunkedTerm::BodyTerm(&QueryTerm::BlockedCut) => {
-                    result.push(term);
-
-                    if self.chunk_num > 0 {
-                        self.deep_cut_encountered = true;
-                    }
-                }
-                ChunkedTerm::BodyTerm(&QueryTerm::GetLevelAndUnify(..)) => {
-                    self.deep_cut_encountered = true;
-
-                    result.push(term);
-                    arity = 1;
-                    break;
-                }
-                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(_),
-                    ref subterms,
-                    _,
-                )) => {
-                    result.push(term);
-                    arity = subterms.len() + 1;
-                    break;
-                }
-                ChunkedTerm::BodyTerm(qt) => {
-                    result.push(term);
-                    arity = qt.arity();
-                    break;
-                }
-            };
-
-            item = self.iter.next();
-        }
-
-        let chunk_num = self.chunk_num;
-        self.chunk_num += 1;
-
-        (chunk_num, arity, result)
-    }
-}
-
-impl<'a> Iterator for ChunkedIterator<'a> {
-    // the chunk number, last term arity, and vector of references.
-    type Item = ChunkedIteratorItem<'a>;
 
     fn next(&mut self) -> Option<Self::Item> {
-        self.iter.next().map(|term| self.take_chunk(term))
+        while let Some(state) = self.state_stack.pop() {
+            match state {
+                ClauseIteratorState::RemainingChunks(chunks, focus) if focus < chunks.len() => {
+                    if focus + 1 < chunks.len() {
+                        self.state_stack
+                            .push(ClauseIteratorState::RemainingChunks(chunks, focus + 1));
+                    } else {
+                        self.remaining_chunks_on_stack -= 1;
+                    }
+
+                    match &chunks[focus] {
+                        ChunkedTerms::Branch(branches) => {
+                            self.state_stack
+                                .push(ClauseIteratorState::RemainingBranches(branches, 0));
+                        }
+                        ChunkedTerms::Chunk(chunk) => {
+                            return Some(ClauseItem::Chunk(chunk));
+                        }
+                    }
+                }
+                ClauseIteratorState::RemainingChunks(chunks, focus) => {
+                    debug_assert_eq!(chunks.len(), focus);
+                }
+                ClauseIteratorState::RemainingBranches(branches, focus)
+                    if focus < branches.len() =>
+                {
+                    self.state_stack
+                        .push(ClauseIteratorState::RemainingBranches(branches, focus + 1));
+                    let state = state_from_chunked_terms(&branches[focus]);
+
+                    if let ClauseIteratorState::RemainingChunks(..) = &state {
+                        self.remaining_chunks_on_stack += 1;
+                    }
+
+                    self.state_stack.push(state);
+
+                    return if focus == 0 {
+                        Some(ClauseItem::FirstBranch(branches.len()))
+                    } else {
+                        Some(ClauseItem::NextBranch)
+                    };
+                }
+                ClauseIteratorState::RemainingBranches(branches, focus) => {
+                    debug_assert_eq!(branches.len(), focus);
+                    return Some(ClauseItem::BranchEnd(self.branch_end_depth()));
+                }
+            }
+        }
+
+        None
     }
 }

src/lib.rs

@@ -2,6 +2,9 @@
 
 #[macro_use]
 extern crate static_assertions;
+#[cfg(test)]
+#[macro_use]
+extern crate maplit;
 
 #[macro_use]
 pub mod macros;
@@ -15,12 +18,15 @@ mod allocator;
 mod arithmetic;
 pub mod codegen;
 mod debray_allocator;
-mod fixtures;
+#[cfg(feature = "ffi")]
+mod ffi;
 mod forms;
 mod heap_iter;
 pub mod heap_print;
+#[cfg(feature = "http")]
 mod http;
 mod indexing;
+mod variable_records;
 #[macro_use]
 pub mod instructions {
     include!(concat!(env!("OUT_DIR"), "/instructions.rs"));
@@ -29,8 +35,26 @@ mod iterators;
 pub mod machine;
 mod raw_block;
 pub mod read;
+#[cfg(feature = "repl")]
 mod repl_helper;
 mod targets;
 pub mod types;
 
 use instructions::instr;
+
+mod rcu;
+
+#[cfg(target_arch = "wasm32")]
+use wasm_bindgen::prelude::*;
+
+#[cfg(target_arch = "wasm32")]
+#[wasm_bindgen]
+pub fn eval_code(s: &str) -> String {
+    use machine::mock_wam::*;
+
+    console_error_panic_hook::set_once();
+
+    let mut wam = Machine::with_test_streams();
+    let bytes = wam.test_load_string(s);
+    String::from_utf8_lossy(&bytes).to_string()
+}

src/lib/arithmetic.pl

@@ -1,4 +1,9 @@
-:- module(arithmetic, [expmod/4, lsb/2, msb/2, number_to_rational/2,
+/** Arithmetic predicates
+
+These predicates are additions to standard the arithmetic functions provided by `is/2`.
+*/
+
+:- module(arithmetic, [expmod/4, lcm/3, lsb/2, msb/2, number_to_rational/2,
                        number_to_rational/3, popcount/2,
                        rational_numerator_denominator/3]).
 
@@ -6,6 +11,10 @@
 :- use_module(library(error)).
 :- use_module(library(lists), [append/3, member/2]).
 
+
+%% expmod(+Base, +Expo, +Mod, -R).
+%
+% Modular exponentiation. Base, Expo and Mod must be integers.
 expmod(Base, Expo, Mod, R) :-
     (   member(N, [Base, Expo, Mod]), var(N) -> instantiation_error(expmod/4)
     ;   member(N, [Base, Expo, Mod]), \+ integer(N) ->
@@ -28,6 +37,25 @@ expmod_(Base0, Expo0, Mod, C, R) :-
     Base is (Base0 * Base0) mod Mod,
     expmod_(Base, Expo, Mod, C, R).
 
+%% lcm(+A, +B, -Lcm) is det.
+%
+% Calculates the Least common multiple for A and B: the smallest positive integer
+% that is divisible by both A and B.
+% 
+% A and B need to be integers.
+lcm(A, B, X) :-
+    builtins:must_be_number(A, lcm/2),
+    builtins:must_be_number(B, lcm/2),
+    (   \+ integer(A) -> type_error(integer, A, lcm/2)
+    ;   \+ integer(B) -> type_error(integer, B, lcm/2)
+    ;   (A = 0, B = 0) -> X = 0
+    ;   builtins:can_be_number(X, lcm/2),
+	X is abs(B) // gcd(A,B) * abs(A)
+    ).
+
+%% lsb(+X, -N).
+%
+% True iff N is the least significat bit of integer X
 lsb(X, N) :-
     builtins:must_be_number(X, lsb/2),
     (   \+ integer(X) -> type_error(integer, X, lsb/2)
@@ -37,6 +65,9 @@ lsb(X, N) :-
         msb_(X1, -1, N)
     ).
 
+%% msb(+X, -N).
+%
+% True iff N is the most significant bit of integer X
 msb(X, N) :-
     builtins:must_be_number(X, msb/2),
     (   \+ integer(X) -> type_error(integer, X, msb/2)
@@ -52,6 +83,9 @@ msb_(X, M, N) :-
     M1 is M + 1,
     msb_(X1, M1, N).
 
+%% number_to_rational(+Real, -Fraction).
+%
+% True iff given a number Real, Fraction is the same number represented as a fraction.
 number_to_rational(Real, Fraction) :-
     (   var(Real) -> instantiation_error(number_to_rational/2)
     ;   integer(Real) -> Fraction is Real rdiv 1
@@ -110,12 +144,20 @@ simplify_fraction(A0/B0, A/B) :-
     A is A0 // G,
     B is B0 // G.
 
+%% rational_numerator_denominator(+Fraction, -Numerator, -Denominator).
+%
+% True iff given a fraction Fraction, Numerator is the numerator of that fraction
+% and Denominator the denominator.
 rational_numerator_denominator(R, N, D) :-
     write_term_to_chars(R, [], Cs),
     append(Ns, [' ', r, d, i, v, ' '|Ds], Cs),
     number_chars(N, Ns),
     number_chars(D, Ds).
 
+%% popcount(+Number, -Bits1).
+%
+% True iff given an integer Number, Bits1 is the amount of 1 bits the binary representation
+% of that number has.
 popcount(X, N) :-
     must_be(integer, X),
     '$popcount'(X, N).

src/lib/assoc.pl

@@ -54,28 +54,27 @@
 
 :- use_module(library(lists)).
 
-/** <module> Binary associations
+/** Binary associations
 
 Assocs are Key-Value associations implemented as  a balanced binary tree
 (AVL tree).
 
-@see            library(pairs), library(rbtrees)
+Authors: R.A.O'Keefe, L.Damas, V.S.Costa and Jan Wielemaker
-@author         R.A.O'Keefe, L.Damas, V.S.Costa and Jan Wielemaker
 */
 
 :- meta_predicate map_assoc(1, ?).
 :- meta_predicate map_assoc(2, ?, ?).
 
-%!  empty_assoc(?Assoc) is semidet.
+%% empty_assoc(?Assoc) is semidet.
 %
-%   Is true if Assoc is the empty association list.
+% Is true if Assoc is the empty association list.
 
 empty_assoc(t).
 
-%!  assoc_to_list(+Assoc, -Pairs) is det.
+%% assoc_to_list(+Assoc, -Pairs) is det.
 %
-%   Translate Assoc to a list Pairs of Key-Value pairs.  The keys
+% Translate Assoc to a list Pairs of Key-Value pairs.  The keys
-%   in Pairs are sorted in ascending order.
+% in Pairs are sorted in ascending order.
 
 assoc_to_list(Assoc, List) :-
     assoc_to_list(Assoc, List, []).
@@ -86,10 +85,10 @@ assoc_to_list(t(Key,Val,_,L,R), List, Rest) :-
 assoc_to_list(t, List, List).
 
 
-%!  assoc_to_keys(+Assoc, -Keys) is det.
+%% assoc_to_keys(+Assoc, -Keys) is det.
 %
-%   True if Keys is the list of keys   in Assoc. The keys are sorted
+% True if Keys is the list of keys   in Assoc. The keys are sorted
-%   in ascending order.
+% in ascending order.
 
 assoc_to_keys(Assoc, List) :-
     assoc_to_keys(Assoc, List, []).
@@ -100,11 +99,11 @@ assoc_to_keys(t(Key,_,_,L,R), List, Rest) :-
 assoc_to_keys(t, List, List).
 
 
-%!  assoc_to_values(+Assoc, -Values) is det.
+%% assoc_to_values(+Assoc, -Values) is det.
 %
-%   True if Values is the  list  of   values  in  Assoc.  Values are
+% True if Values is the  list  of   values  in  Assoc.  Values are
-%   ordered in ascending  order  of  the   key  to  which  they were
+% ordered in ascending  order  of  the   key  to  which  they were
-%   associated.  Values may contain duplicates.
+% associated.  Values may contain duplicates.
 
 assoc_to_values(Assoc, List) :-
     assoc_to_values(Assoc, List, []).
@@ -114,12 +113,12 @@ assoc_to_values(t(_,Value,_,L,R), List, Rest) :-
     assoc_to_values(R, More, Rest).
 assoc_to_values(t, List, List).
 
-%!  is_assoc(+Assoc) is semidet.
+%% is_assoc(+Assoc) is semidet.
 %
-%   True if Assoc is an association list. This predicate checks
+% True if Assoc is an association list. This predicate checks
-%   that the structure is valid, elements are in order, and tree
+% that the structure is valid, elements are in order, and tree
-%   is balanced to the extent guaranteed by AVL trees.  I.e.,
+% is balanced to the extent guaranteed by AVL trees.  I.e.,
-%   branches of each subtree differ in depth by at most 1.
+% branches of each subtree differ in depth by at most 1.
 
 is_assoc(Assoc) :-
     is_assoc(Assoc, _Min, _Max, _Depth).
@@ -151,12 +150,10 @@ balance(=,-).
 balance(<,<).
 balance(>,>).
 
-%!  gen_assoc(?Key, +Assoc, ?Value) is nondet.
+%% gen_assoc(?Key, +Assoc, ?Value) is nondet.
 %
-%   True if Key-Value is an association in Assoc. Enumerates keys in
+% True if Key-Value is an association in Assoc. Enumerates keys in
-%   ascending order on backtracking.
+% ascending order on backtracking.
-%
-%   @see get_assoc/3.
 
 gen_assoc(Key, Assoc, Value) :-
     (   ground(Key)
@@ -171,11 +168,11 @@ gen_assoc_(Key, t(_,_,_,_,R), Val) :-
     gen_assoc_(Key, R, Val).
 
 
-%!  get_assoc(+Key, +Assoc, -Value) is semidet.
+%% get_assoc(+Key, +Assoc, -Value) is semidet.
 %
-%   True if Key-Value is an association in Assoc.
+% True if Key-Value is an association in Assoc.
 %
-%   @error type_error(assoc, Assoc) if Assoc is not an association list.
+% Throws error: `type_error(assoc, Assoc)` if Assoc is not an association list.
 
 get_assoc(Key, Assoc, Val) :-
     must_be(assoc, Assoc),
@@ -201,9 +198,9 @@ get_assoc(>, Key, _, _, Tree, Val) :-
 % :- endif.
 
 
-%!  get_assoc(+Key, +Assoc0, ?Val0, ?Assoc, ?Val) is semidet.
+%% get_assoc(+Key, +Assoc0, ?Val0, ?Assoc, ?Val) is semidet.
 %
-%   True if Key-Val0 is in Assoc0 and Key-Val is in Assoc.
+% True if Key-Val0 is in Assoc0 and Key-Val is in Assoc.
 
 get_assoc(Key, t(K,V,B,L,R), Val, t(K,NV,B,NL,NR), NVal) :-
     compare(Rel, Key, K),
@@ -216,12 +213,12 @@ get_assoc(>, Key, V, L, R, Val, V, L, NR, NVal) :-
     get_assoc(Key, R, Val, NR, NVal).
 
 
-%!  list_to_assoc(+Pairs, -Assoc) is det.
+%% list_to_assoc(+Pairs, -Assoc) is det.
 %
-%   Create an association from a list Pairs of Key-Value pairs. List
+% Create an association from a list Pairs of Key-Value pairs. List
-%   must not contain duplicate keys.
+% must not contain duplicate keys.
 %
-%   @error domain_error(unique_key_pairs, List) if List contains duplicate keys
+% Throws error: `domain_error(unique_key_pairs, List)` if List contains duplicate keys
 
 list_to_assoc(List, Assoc) :-
     (  List = [] -> Assoc = t
@@ -246,13 +243,13 @@ list_to_assoc(N, List, More, Depth, t(K,V,Balance,L,R)) :-
     compare(B, RDepth, LDepth),
     balance(B, Balance).
 
-%!  ord_list_to_assoc(+Pairs, -Assoc) is det.
+%% ord_list_to_assoc(+Pairs, -Assoc) is det.
 %
-%   Assoc is created from an ordered list Pairs of Key-Value
+% Assoc is created from an ordered list Pairs of Key-Value
-%   pairs. The pairs must occur in strictly ascending order of
+% pairs. The pairs must occur in strictly ascending order of
-%   their keys.
+% their keys.
 %
-%   @error domain_error(key_ordered_pairs, List) if pairs are not ordered.
+% Throws error: `domain_error(key_ordered_pairs, List)` if pairs are not ordered.
 
 ord_list_to_assoc(Sorted, Assoc) :-
     (  Sorted = [] -> Assoc = t
@@ -263,9 +260,9 @@ ord_list_to_assoc(Sorted, Assoc) :-
            )
     ).
 
-%!  ord_pairs(+Pairs) is semidet
+%% ord_pairs(+Pairs) is semidet
 %
-%   True if Pairs is a list of Key-Val pairs strictly ordered by key.
+% True if Pairs is a list of Key-Val pairs strictly ordered by key.
 
 ord_pairs([K-_V|Rest]) :-
     ord_pairs(Rest, K).
@@ -274,9 +271,9 @@ ord_pairs([K-_V|Rest], K0) :-
     K0 @< K,
     ord_pairs(Rest, K).
 
-%!  map_assoc(:Pred, +Assoc) is semidet.
+%% map_assoc(:Pred, +Assoc) is semidet.
 %
-%   True if Pred(Value) is true for all values in Assoc.
+% True if Pred(Value) is true for all values in Assoc.
 
 map_assoc(Pred, T) :-
     map_assoc_(T, Pred).
@@ -287,10 +284,10 @@ map_assoc_(t(_,Val,_,L,R), Pred) :-
     call(Pred, Val),
     map_assoc_(R, Pred).
 
-%!  map_assoc(:Pred, +Assoc0, ?Assoc) is semidet.
+%% map_assoc(:Pred, +Assoc0, ?Assoc) is semidet.
 %
-%   Map corresponding values. True if Assoc is Assoc0 with Pred
+% Map corresponding values. True if Assoc is Assoc0 with Pred
-%   applied to all corresponding pairs of of values.
+% applied to all corresponding pairs of of values.
 
 map_assoc(Pred, T0, T) :-
     map_assoc_(T0, Pred, T).
@@ -302,9 +299,9 @@ map_assoc_(t(Key,Val,B,L0,R0), Pred, t(Key,Ans,B,L1,R1)) :-
     map_assoc_(R0, Pred, R1).
 
 
-%!  max_assoc(+Assoc, -Key, -Value) is semidet.
+%%  max_assoc(+Assoc, -Key, -Value) is semidet.
 %
-%   True if Key-Value is in Assoc and Key is the largest key.
+% True if Key-Value is in Assoc and Key is the largest key.
 
 max_assoc(t(K,V,_,_,R), Key, Val) :-
     max_assoc(R, K, V, Key, Val).
@@ -314,9 +311,9 @@ max_assoc(t(K,V,_,_,R), _, _, Key, Val) :-
     max_assoc(R, K, V, Key, Val).
 
 
-%!  min_assoc(+Assoc, -Key, -Value) is semidet.
+%% min_assoc(+Assoc, -Key, -Value) is semidet.
 %
-%   True if Key-Value is in assoc and Key is the smallest key.
+% True if Key-Value is in assoc and Key is the smallest key.
 
 min_assoc(t(K,V,_,L,_), Key, Val) :-
     min_assoc(L, K, V, Key, Val).
@@ -326,10 +323,10 @@ min_assoc(t(K,V,_,L,_), _, _, Key, Val) :-
     min_assoc(L, K, V, Key, Val).
 
 
-%!  put_assoc(+Key, +Assoc0, +Value, -Assoc) is det.
+%% put_assoc(+Key, +Assoc0, +Value, -Assoc) is det.
 %
-%   Assoc is Assoc0, except that Key is associated with
+% Assoc is Assoc0, except that Key is associated with
-%   Value. This can be used to insert and change associations.
+% Value. This can be used to insert and change associations.
 
 put_assoc(Key, A0, Value, A) :-
     insert(A0, Key, Value, A, _).
@@ -361,11 +358,11 @@ table(<      , right   , -      , no        , no    ) :- !.
 table(>      , left    , -      , no        , no    ) :- !.
 table(>      , right   , -      , no        , yes   ) :- !.
 
-%!  del_min_assoc(+Assoc0, ?Key, ?Val, -Assoc) is semidet.
+%% del_min_assoc(+Assoc0, ?Key, ?Val, -Assoc) is semidet.
 %
-%   True if Key-Value  is  in  Assoc0   and  Key  is  the smallest key.
+% True if Key-Value  is  in  Assoc0   and  Key  is  the smallest key.
-%   Assoc is Assoc0 with Key-Value   removed. Warning: This will
+% Assoc is Assoc0 with Key-Value   removed. Warning: This will
-%   succeed with _no_ bindings for Key or Val if Assoc0 is empty.
+% succeed with _no_ bindings for Key or Val if Assoc0 is empty.
 
 del_min_assoc(Tree, Key, Val, NewTree) :-
     del_min_assoc(Tree, Key, Val, NewTree, _DepthChanged).
@@ -375,11 +372,11 @@ del_min_assoc(t(K,V,B,L,R), Key, Val, NewTree, Changed) :-
     del_min_assoc(L, Key, Val, NewL, LeftChanged),
     deladjust(LeftChanged, t(K,V,B,NewL,R), left, NewTree, Changed).
 
-%!  del_max_assoc(+Assoc0, ?Key, ?Val, -Assoc) is semidet.
+%% del_max_assoc(+Assoc0, ?Key, ?Val, -Assoc) is semidet.
 %
-%   True if Key-Value  is  in  Assoc0   and  Key  is  the greatest key.
+% True if Key-Value  is  in  Assoc0   and  Key  is  the greatest key.
-%   Assoc is Assoc0 with Key-Value   removed. Warning: This will
+% Assoc is Assoc0 with Key-Value   removed. Warning: This will
-%   succeed with _no_ bindings for Key or Val if Assoc0 is empty.
+% succeed with _no_ bindings for Key or Val if Assoc0 is empty.
 
 del_max_assoc(Tree, Key, Val, NewTree) :-
     del_max_assoc(Tree, Key, Val, NewTree, _DepthChanged).
@@ -389,10 +386,10 @@ del_max_assoc(t(K,V,B,L,R), Key, Val, NewTree, Changed) :-
     del_max_assoc(R, Key, Val, NewR, RightChanged),
     deladjust(RightChanged, t(K,V,B,L,NewR), right, NewTree, Changed).
 
-%!  del_assoc(+Key, +Assoc0, ?Value, -Assoc) is semidet.
+%% del_assoc(+Key, +Assoc0, ?Value, -Assoc) is semidet.
 %
-%   True if Key-Value is  in  Assoc0.   Assoc  is  Assoc0 with
+% True if Key-Value is  in  Assoc0.   Assoc  is  Assoc0 with
-%   Key-Value removed.
+% Key-Value removed.
 
 del_assoc(Key, A0, Value, A) :-
     delete(A0, Key, Value, A, _).

src/lib/atts.pl

@@ -1,8 +1,8 @@
 :- module(atts, [op(1199, fx, attribute),
-                 call_residue_vars/2,
                  term_attributed_variables/2]).
 
 :- use_module(library(dcgs)).
+:- use_module(library(error)).
 :- use_module(library(terms)).
 
 /* represent the list of attributes belonging to a variable,
@@ -19,77 +19,12 @@
     '$default_attr_list'(PGs, Module, AttrVar).
 '$default_attr_list'([], _, _) --> [].
 
-'$absent_attr'(V, Attr) :-
+'$absent_attr'(V, Module, Attr) :-
-    '$get_attr_list'(V, Ls),
+    (  '$get_from_attr_list'(V, Module, Attr) ->
-    '$absent_from_list'(Ls, Attr).
+       false
-
-'$absent_from_list'(X, Attr) :-
-    (  var(X) ->
-       true
-    ;  X = [L|Ls],
-       L \= Attr ->
-       '$absent_from_list'(Ls, Attr)
-    ).
-
-'$get_attr'(V, Attr) :-
-    '$get_attr_list'(V, Ls),
-    nonvar(Ls),
-    '$get_from_list'(Ls, V, Attr).
-
-'$get_from_list'([L|Ls], V, Attr) :-
-    nonvar(L),
-    (  L \= Attr ->
-       nonvar(Ls),
-       '$get_from_list'(Ls, V, Attr)
-    ;  L = Attr,
-       '$enqueue_attr_var'(V)
-    ).
-
-'$put_attr'(V, Attr) :-
-    '$get_attr_list'(V, Ls),
-    '$add_to_list'(Ls, V, Attr).
-
-'$add_to_list'(Ls, V, Attr) :-
-    (  var(Ls) ->
-       Ls = [Attr | _],
-       '$enqueue_attr_var'(V)
-    ;  Ls = [_ | Ls0],
-       '$add_to_list'(Ls0, V, Attr)
-    ).
-
-'$del_attr'(Ls0, _, _) :-
-    var(Ls0),
-    !.
-'$del_attr'(Ls0, V, Attr) :-
-    Ls0 = [Att | Ls1],
-    nonvar(Att),
-    (  Att \= Attr ->
-       '$del_attr_buried'(Ls0, Ls1, V, Attr)
-    ;  '$enqueue_attr_var'(V),
-       '$del_attr_head'(V),
-       '$del_attr'(Ls1, V, Attr)
-    ).
-
-'$del_attr_step'(Ls1, V, Attr) :-
-    (  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)
-       ;  '$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)
-       )
-    ).
-
 '$copy_attr_list'(L, _Module, []) :- var(L), !.
 '$copy_attr_list'([Module0:Att|Atts], Module, CopiedAtts) :-
     (  Module0 == Module ->
@@ -145,38 +80,28 @@ put_attr(Name, Arity, Module) -->
     { functor(Attr, Name, Arity) },
     [(put_atts(V, +Attr) :-
           !,
-          functor(Attr, Head, Arity),
+          '$put_to_attr_list'(V, Module, Attr)),
-	      functor(AttrForm, Head, Arity),
+     (put_atts(V, Attr) :-
-	      '$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),
+          '$put_to_attr_list'(V, Module, Attr)),
-	      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, _, _),
+          '$del_from_attr_list'(V, Module, Attr))].
-	      '$get_attr_list'(V, Ls),
-	      atts:'$del_attr'(Ls, V, Module:Attr))].
 
 get_attr(Name, Arity, Module) -->
     { functor(Attr, Name, Arity) },
     [(get_atts(V, +Attr) :-
           !,
           functor(Attr, _, _),
-          atts:'$get_attr'(V, Module:Attr)),
+          atts:'$get_from_attr_list'(V, Module, Attr)),
      (get_atts(V,  Attr) :-
           !,
           functor(Attr, _, _),
-          atts:'$get_attr'(V, Module:Attr)),
+          atts:'$get_from_attr_list'(V, Module, Attr)),
      (get_atts(V, -Attr) :-
           !,
           functor(Attr, _, _),
-          atts:'$absent_attr'(V, Module:Attr))].
+          atts:'$absent_attr'(V, Module, Attr))].
 
 user:goal_expansion(Term, M:put_atts(Var, Attr)) :-
     nonvar(Term),
@@ -185,12 +110,5 @@ 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),
-    '$get_attr_var_queue_beyond'(B, Vars).
-
 term_attributed_variables(Term, Vars) :-
     '$term_attributed_variables'(Term, Vars).

src/lib/between.pl

@@ -1,3 +1,10 @@
+/** Predicates that generate integers
+
+These predicates can be used to reason about integers in a reduced domain that
+follow some property. `library(clpz)` provides another way of reasoning about
+integers that may also be interesting.
+*/
+
 :- module(between, [between/3, gen_int/1, gen_nat/1, numlist/2, numlist/3, repeat/1]).
 
 %% TODO: numlist/5.
@@ -5,6 +12,24 @@
 :- use_module(library(lists), [length/2]).
 :- use_module(library(error)).
 
+%% between(+Lower, +Upper, -X).
+%
+% Given Lower and Upper are both integer numbers, true iff X is an integer so that _Lower =< X =< Upper_.
+% Can be used both to check if X is between Lower and Upper or to generate an integer between
+% Lower and Upper.
+%
+% Examples:
+%
+% ```
+% ?- between(10, 20, 15).
+%    true.
+% ?- between(10, 20, 25).
+%    false.
+% ?- between(3, 5, X).
+%    X = 3
+% ;  X = 4
+% ;  X = 5.
+% ```
 between(Lower, Upper, X) :-
     must_be(integer, Lower),
     must_be(integer, Upper),
@@ -30,6 +55,9 @@ enumerate_nats(I0, N) :-
     I1 is I0 + 1,
     enumerate_nats(I1, N).
 
+%% gen_nat(?N)
+%
+% True iff N is a natural number.
 gen_nat(N) :-
     can_be(integer, N),
     (   var(N) -> enumerate_nats(0, N)
@@ -44,6 +72,9 @@ enumerate_ints(I0, N) :-
     I1 is I0 + 1,
     enumerate_ints(I1, N).
 
+%% gen_int(?N)
+%
+% True iff N is an integer.
 gen_int(N) :-
     can_be(integer, N),
     (   var(N) -> enumerate_ints(0, N)
@@ -55,9 +86,24 @@ repeat_integer(N) :-
 repeat_integer(N0) :-
     N0 > 0, N1 is N0 - 1, repeat_integer(N1).
 
+%% repeat(+N)
+%
+% Succeeds N times. This predicate is only included for compatibility and *should not be used*
+% because it lacks a declarative interpretation.
 repeat(N) :-
     must_be(integer, N), repeat_integer(N).
 
+%% numlist(?Upper, ?List)
+%
+% True iff List is the list of integers _[1, ..., Upper]_. Example:
+%
+% ```
+% ?- numlist(X, Y).
+%    X = 1, Y = [1],
+% ;  X = 2, Y = [1,2]
+% ;  X = 3, Y = [1,2,3]
+% ; ... .
+% ```
 numlist(Upper, List) :-
     (  integer(Upper) -> findall(X, between(1, Upper, X), List)
     ;  List = [_|_], length(List, Upper), findall(X, between(1, Upper, X), List)
@@ -106,5 +152,14 @@ gen_ints(L, U) :-
     ),
     L =< U.
 
+%% numlist(?Lower, ?Upper, ?List).
+%
+% True iff List is a list of the form _[Lower, ..., Upper]_.
+% Example:
+%
+% ```
+% ?- numlist(5, 10, X).
+%    X = [5,6,7,8,9,10].
+% ```
 numlist(Lower, Upper, List) :-
     gen_ints(Lower, Upper), findall(X, between(Lower, Upper, X), List).

src/lib/charsio.pl

@@ -1,9 +1,18 @@
+/** High-level predicates to work with chars and strings
+
+This module contains predicates that relates strings of chars
+to other representations, as well as high-level predicates to
+read and write chars.
+
+*/
+
 :- module(charsio, [char_type/2,
                     chars_utf8bytes/2,
                     get_single_char/1,
                     get_n_chars/3,
-                    read_line_to_chars/3,
+                    get_line_to_chars/3,
                     read_from_chars/2,
+                    read_term_from_chars/3,
                     write_term_to_chars/3,
                     chars_base64/3]).
 
@@ -11,6 +20,7 @@
 :- use_module(library(iso_ext)).
 :- use_module(library(error)).
 :- use_module(library(lists)).
+:- use_module(library(between)).
 :- use_module(library(iso_ext), [partial_string/1,partial_string/3]).
 
 fabricate_var_name(VarType, VarName, N) :-
@@ -65,18 +75,86 @@ extend_var_list_([V|Vs], N, VarList, NewVarList, VarType) :-
     ).
 
 
+%% char_type(?Char, ?Type).
+%
+% Type is one of the categories that Char fits in.
+% At least one of the arguments must be ground.
+% Possible categories are:
+%
+% - `alnum`
+% - `alpha`
+% - `alphabetic`
+% - `alphanumeric`
+% - `ascii`
+% - `ascii_graphic`
+% - `ascii_punctuation`
+% - `binary_digit`
+% - `control`
+% - `decimal_digit`
+% - `exponent`
+% - `graphic`
+% - `graphic_token`
+% - `hexadecimal_digit`
+% - `layout`
+% - `lower`
+% - `meta`
+% - `numeric`
+% - `octal_digit`
+% - `octet`
+% - `prolog`
+% - `sign`
+% - `solo`
+% - `symbolic_control`
+% - `symbolic_hexadecimal`
+% - `upper`
+% - `lower(Lower)`
+% - `upper(Upper)`
+% - `whitespace`
+%
+% An example:
+%
+% ```
+% ?- char_type(a, Type).
+%    Type = alnum
+% ;  Type = alpha
+% ;  Type = alphabetic
+% ;  Type = alphanumeric
+% ;  Type = ascii
+% ;  Type = ascii_graphic
+% ;  Type = hexadecimal_digit
+% ;  Type = lower
+% ;  Type = octet
+% ;  Type = prolog
+% ;  Type = symbolic_control
+% ;  Type = lower("a")
+% ;  Type = upper("A")
+% ;  false.
+% ```
+%
+% Note that uppercase and lowercase transformations use a string. This is because
+% some characters do not map 1:1 between lowercase and uppercase.
 char_type(Char, Type) :-
-        must_be(character, Char),
+        can_be(character, Char),
-        (   ground(Type) ->
+        (   \+ ctype(Type) ->
-            (   ctype(Type) ->
+            domain_error(char_type, Type, char_type/2)
-                '$char_type'(Char, Type)
+        ;   true
-            ;   domain_error(char_type, Type, char_type/2)
+        ),
-            )
+        (   ground(Char) ->
-        ;   ctype(Type),
+            ctype(Type),
             '$char_type'(Char, Type)
+        ;   ground(Type) ->
+            ccode(Code),
+            char_code(Char, Code),
+            '$char_type'(Char, Type)
+        ;   must_be(character, Char)
         ).
 
 
+% 0xD800 to 0xDFFF are surrogate code points used by UTF-16.
+
+ccode(Code) :- between(0, 0xD7FF, Code).
+ccode(Code) :- between(0xE000, 0x10FFFF, Code).
+
 ctype(alnum).
 ctype(alpha).
 ctype(alphabetic).
@@ -102,27 +180,68 @@ ctype(sign).
 ctype(solo).
 ctype(symbolic_control).
 ctype(symbolic_hexadecimal).
+ctype(lower(_)).
+ctype(upper(_)).
 ctype(upper).
 ctype(whitespace).
 
 
+%% get_single_char(-Char).
+%
+% Gets a single char from the current input stream.
 get_single_char(C) :-
     (  var(C) -> '$get_single_char'(C)
     ;  atom_length(C, 1) -> '$get_single_char'(C)
     ;  type_error(in_character, C, get_single_char/1)
     ).
 
-
+%% read_from_chars(+Chars, -Term).
+%
+% Given a string made of chars which contains a representation of
+% a Prolog term, Term is the Prolog term represented. Example:
+%
+% ```
+% ?- read_from_chars("f(x,y).", X).
+%    X = f(x,y).
+% ```
 read_from_chars(Chars, Term) :-
     must_be(chars, Chars),
-    '$read_term_from_chars'(Chars, Term).
+    must_be(var, Term),
+    '$read_from_chars'(Chars, Term).
 
+%% read_term_from_chars(+Chars, -Term, +Options).
+%
+% Like `read_from_chars`, except the reader is configured according to
+% `Options` which are those of `read_term`.
+%
+% ```
+% ?- read_term_from_chars("f(X,y).", T, [variable_names(['X'=X])]).
+%    T = f(X,y).
+% ```
+read_term_from_chars(Chars, Term, Options) :-
+    must_be(chars, Chars),
+    must_be(var, Term),
+    builtins:parse_read_term_options(Options, [Singletons, VariableNames, Variables], read_term_from_chars/3),
+    '$read_term_from_chars'(Chars, Term, Singletons, Variables, VariableNames).
 
+%% write_term_to_chars(+Term, +Options, -Chars).
+%
+% Given a Term which is a Prolog term and a set of options, Chars is
+% string representation of that term. Options available are:
+%
+%  * `ignore_ops(+Boolean)` if `true`, the generic term representation is used everywhere. In `false`
+%    (default), operators do not use that generic term representation.
+%  * `max_depth(+N)` if the term is nested deeper than N, print the reminder as ellipses.
+%    If N = 0 (default), there's no limit.
+%  * `numbervars(+Boolean)` if true, replaces `$VAR(N)` variables with letters, in order. Default is false.
+%  * `quoted(+Boolean)` if true, strings and atoms that need quotes to be valid Prolog syntax, are quoted. Default is false.
+%  * `variable_names(+List)` assign names to variables in term. List should be a list of terms of format `Name=Var`.
+%  * `double_quotes(+Boolean)` if true, strings are printed in double quotes rather than with list notation. Default is false.
 write_term_to_chars(_, Options, _) :-
     var(Options), instantiation_error(write_term_to_chars/3).
 write_term_to_chars(Term, Options, Chars) :-
     builtins:parse_write_options(Options,
-                                 [IgnoreOps, MaxDepth, NumberVars, Quoted, VNNames],
+                                 [DoubleQuotes, IgnoreOps, MaxDepth, NumberVars, Quoted, VNNames],
                                  write_term_to_chars/3),
     (  nonvar(Chars)  ->
        throw(error(uninstantiation_error(Chars), write_term_to_chars/3))
@@ -131,7 +250,7 @@ write_term_to_chars(Term, Options, Chars) :-
     ),
     term_variables(Term, Vars),
     extend_var_list(Vars, VNNames, NewVarNames, numbervars),
-    '$write_term_to_chars'(Chars, Term, IgnoreOps, NumberVars, Quoted, NewVarNames, MaxDepth).
+    '$write_term_to_chars'(Chars, Term, IgnoreOps, NumberVars, Quoted, NewVarNames, MaxDepth, DoubleQuotes).
 
 % Encodes Ch character to list of Bytes.
 char_utf8bytes(Ch, Bytes) :-
@@ -151,6 +270,17 @@ encode(Code, Prefix, Nb) -->
 % Maps characters and UTF-8 bytes.
 % If Cs is a variable, parses Bs as a list of UTF-8 bytes.
 % Otherwise, transform the list of characters Cs to UTF-8 bytes.
+
+%% chars_utf8bytes(?Chars, ?Bytes).
+%
+% Maps a string made of chars with a list of UTF-8 bytes. Some examples:
+%
+% ```
+% ?- chars_utf8bytes("Prolog", X).
+%   X = [80,114,111,108,111,103].
+% ?- chars_utf8bytes(X, [226, 136, 145]).
+%    X = "∑".
+% ```
 chars_utf8bytes(Cs, Bs) :-
   var(Cs), must_be(list, Bs) ->
     once(phrase(decode_utf8(Cs), Bs))
@@ -177,58 +307,66 @@ continuation(Code, Chars, Nb) --> [Byte],
 % each remaining continuation byte (if any) will raise 0xFFFD too
 continuation(_, ['\xFFFD\'|T], _) --> [_], decode_utf8(T).
 
-
+%% get_line_to_chars(+Stream, -Chars, +InitialChars).
-read_line_to_chars(Stream, Cs0, Cs) :-
+%
+% Reads chars from stream Stream until it finds a `\n` character.
+% InitialChars will be appended at the end of Chars
+get_line_to_chars(Stream, Cs0, Cs) :-
         '$get_n_chars'(Stream, 1, Char), % this also works for binary streams
         (   Char == [] -> Cs0 = Cs
         ;   Char = [C],
             Cs0 = [C|Rest],
             (   C == '\n' -> Rest = Cs
-            ;   read_line_to_chars(Stream, Rest, Cs)
+            ;   get_line_to_chars(Stream, Rest, Cs)
             )
         ).
 
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+%% get_n_chars(+Stream, ?N, -Chars).
-   Read N characters from Stream.
+%
-
+% Read N chars from stream Stream. N can be an integer, in that case
-   If N is a variable, read until EOF, unifying N with the number of
+% only N chars are read, or a variable, unifying N with the number of chars
-   characters read.
+% read until it found EOF.
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
-
 get_n_chars(Stream, N, Cs) :-
         can_be(integer, N),
         (   var(N) ->
-            read_to_eof(Stream, Cs),
+            get_to_eof(Stream, Cs),
             length(Cs, N)
         ;   N >= 0,
             '$get_n_chars'(Stream, N, Cs)
         ).
 
-read_to_eof(Stream, Cs) :-
+get_n_chars_wrapper(Stream, N, Cs) :-
-        '$get_n_chars'(Stream, 512, Cs0),
+        '$get_n_chars'(Stream, N, Cs).
+
+get_to_eof(Stream, Cs) :-
+        catch(get_n_chars_wrapper(Stream, 512, Cs0),
+              error(syntax_error(unexpected_end_of_file), _),
+              Cs0 = []),
         (   Cs0 == [] -> Cs = []
         ;   partial_string(Cs0, Cs, Rest),
-            read_to_eof(Stream, Rest)
+            get_to_eof(Stream, Rest)
         ).
 
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+%% chars_base64(?Chars, ?Base64, +Options).
-   Relation between a list of characters Cs and its Base64 encoding Bs,
+%
-   also a list of characters.
+% Relation between a list of characters Cs and its Base64 encoding Bs,
-
+% also a list of characters.
-   At least one of the arguments must be instantiated.
+%
-
+% At least one of the arguments must be instantiated.
-   Options are:
+%
-
+% Options are:
-      - padding(Boolean)
+%
-        Whether to use padding: true (the default) or false.
+% - `padding(Boolean)`
-      - charset(C)
+%   Whether to use padding: true (the default) or false.
-        Either 'standard' (RFC 4648 §4, the default) or 'url' (RFC 4648 §5).
+% - `charset(C)`
-
+%   Either 'standard' (RFC 4648 §4, the default) or 'url' (RFC 4648 §5).
-   Example:
+%
-
+% Example:
-      ?- chars_base64("hello", Bs, []).
+%
-         Bs = "aGVsbG8=".
+% ```
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+% ?- chars_base64("hello", Bs, []).
+%    Bs = "aGVsbG8=".
+% ```
 
 chars_base64(Cs, Bs, Options) :-
         must_be(list, Options),

src/lib/clpb.pl

@@ -1,10 +1,29 @@
 /*  CLP(B): Constraint Logic Programming over Boolean Variables
 
-    Copyright (C): 2019 Markus Triska
+    Author:        Markus Triska
-    All rights reserved.
-
     E-mail:        triska@metalevel.at
-    WWW:           http://www.metalevel.at
+    WWW:           https://www.metalevel.at
+    Copyright (C): 2019-2023 Markus Triska
+
+    Permission is hereby granted, free of charge, to any person
+    obtaining a copy of this software and associated documentation
+    files (the "Software"), to deal in the Software without
+    restriction, including without limitation the rights to use, copy,
+    modify, merge, publish, distribute, sublicense, and/or sell copies
+    of the Software, and to permit persons to whom the Software is
+    furnished to do so, subject to the following conditions:
+
+    The above copyright notice and this permission notice shall be
+    included in all copies or substantial portions of the Software.
+
+    THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+    EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+    MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+    NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+    HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+    WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+    OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+    DEALINGS IN THE SOFTWARE.
 
 */
 
@@ -17,8 +36,8 @@
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 :- module(clpb, [op(300, fy, ~),
-		         op(500, yfx, #),
+                 op(500, yfx, #),
-		         sat/1,
+                 sat/1,
                  taut/2,
                  labeling/1,
                  sat_count/2,
@@ -91,6 +110,46 @@ domain_error(Expectation, Term) :-
 type_error(Expectation, Term) :-
         type_error(Expectation, Term, unknown(Term)-1).
 
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+Compatibility predicates.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+:- meta_predicate(include(1, ?, ?)).
+
+include(_, [], []).
+include(Goal, [L|Ls0], Ls) :-
+        (   call(Goal, L) ->
+            Ls = [L|Rest]
+        ;   Ls = Rest
+        ),
+        include(Goal, Ls0, Rest).
+
+:- meta_predicate(exclude(1, ?, ?)).
+
+exclude(_, [], []).
+exclude(Goal, [L|Ls0], Ls) :-
+        (   call(Goal, L) ->
+            Ls = Rest
+        ;   Ls = [L|Rest]
+        ),
+        exclude(Goal, Ls0, Rest).
+
+:- meta_predicate(partition(2,?,?,?,?)).
+
+partition(_, [], [], [], []).
+partition(Pred, [H|T], L, E, G) :-
+    call(Pred, H, Diff),
+    partition_(Diff, H, Pred, T, L, E, G).
+
+partition_(<, H, Pred, T, [H|Rest], E, G) :-
+    partition(Pred, T, Rest, E, G).
+partition_(=, H, Pred, T, L, [H|Rest], G) :-
+    partition(Pred, T, L, Rest, G).
+partition_(>, H, Pred, T, L, E, [H|Rest]) :-
+    partition(Pred, T, L, E, Rest).
+
+:- meta_predicate(partition(1,?,?,?)).
+
 partition(Pred, Ls0, As, Bs) :-
         include(Pred, Ls0, As),
         exclude(Pred, Ls0, Bs).
@@ -105,6 +164,262 @@ goal_expansion(del_attr(Var, Module), (var(Var) -> put_atts(Var, -Access);true))
         Access =.. [Module,_].
 
 
+/** Constraint Logic Programming over Boolean variables
+
+## Introduction
+
+This library provides CLP(B), Constraint Logic Programming over
+Boolean variables. It can be used to model and solve combinatorial
+problems such as verification, allocation and covering tasks.
+
+CLP(B) is an instance of the general CLP(_X_) scheme,
+extending logic programming with reasoning over specialised domains.
+
+The implementation is based on reduced and ordered Binary Decision
+Diagrams (BDDs).
+
+Benchmarks and usage examples of this library are available from:
+[*https://www.metalevel.at/clpb/*](https://www.metalevel.at/clpb/)
+
+## Boolean expressions
+
+A _Boolean expression_ is one of:
+
+| `0`                | false                                |
+| `1`                | true                                 |
+| _variable_         | unknown truth value                  |
+| _atom_             | universally quantified variable      |
+| `~` _Expr_           | logical NOT                          |
+| _Expr_ `+` _Expr_    | logical OR                           |
+| _Expr_ `*` _Expr_    | logical AND                          |
+| _Expr_ `#` _Expr_    | exclusive OR                         |
+| _Var_ `^` _Expr_     | existential quantification           |
+| _Expr_ `=:=` _Expr_  | equality                             |
+| _Expr_ `=\=` _Expr_  | disequality (same as #)              |
+| _Expr_ `=<` _Expr_   | less or equal (implication)          |
+| _Expr_ `>=` _Expr_   | greater or equal                     |
+| _Expr_ `<` _Expr_    | less than                            |
+| _Expr_ `>` _Expr_    | greater than                         |
+| `card(Is,Exprs)`     | cardinality constraint (_see below_) |
+| `+(Exprs)`         | n-fold disjunction (_see below_)     |
+| `*(Exprs)`         | n-fold conjunction (_see below_)     |
+
+where _Expr_ again denotes a Boolean expression.
+
+The Boolean expression `card(Is,Exprs)` is true iff the number of true
+expressions in the list `Exprs` is a member of the list `Is` of
+integers and integer ranges of the form `From-To`. For example, to
+state that precisely two of the three variables `X`, `Y` and `Z` are
+`true`, you can use `sat(card([2],[X,Y,Z]))`.
+
+`+(Exprs)` and `*(Exprs)` denote, respectively, the disjunction and
+conjunction of all elements in the list `Exprs` of Boolean
+expressions.
+
+Atoms denote parametric values that are universally quantified. All
+universal quantifiers appear implicitly in front of the entire
+expression. In residual goals, universally quantified variables always
+appear on the right-hand side of equations. Therefore, they can be
+used to express functional dependencies on input variables.
+
+## Interface predicates
+
+The most frequently used CLP(B) predicates are:
+
+    * `sat(+Expr)`
+      True iff the Boolean expression Expr is satisfiable.
+
+    * `taut(+Expr, -T)`
+      If Expr is a tautology with respect to the posted constraints, succeeds
+      with *T = 1*. If Expr cannot be satisfied, succeeds with *T = 0*.
+      Otherwise, it fails.
+
+    * `labeling(+Vs)`
+      Assigns truth values to the variables Vs such that all constraints
+      are satisfied.
+
+The unification of a CLP(B) variable _X_ with a term _T_ is equivalent
+to posting the constraint sat(X=:=T).
+
+## Examples
+
+Here is an example session with a few queries and their answers:
+
+```
+?- use_module(library(clpb)).
+   true.
+
+?- sat(X*Y).
+   X = 1, Y = 1.
+
+?- sat(X * ~X).
+   false.
+
+?- taut(X * ~X, T).
+   T = 0, clpb:sat(X=:=X).
+
+?- sat(X^Y^(X+Y)).
+   clpb:sat(X=:=X), clpb:sat(Y=:=Y).
+
+?- sat(X*Y + X*Z), labeling([X,Y,Z]).
+   X = 1, Y = 0, Z = 1
+;  X = 1, Y = 1, Z = 0
+;  X = 1, Y = 1, Z = 1.
+
+?- sat(X =< Y), sat(Y =< Z), taut(X =< Z, T).
+   T = 1, clpb:sat(X=:=X*Y), clpb:sat(Y=:=Y*Z).
+
+?- sat(1#X#a#b).
+   clpb:sat(X=:=a#b).
+```
+
+The pending residual goals constrain remaining variables to Boolean
+expressions and are declaratively equivalent to the original query.
+The last example illustrates that when applicable, remaining variables
+are expressed as functions of universally quantified variables.
+
+## Obtaining BDDs
+
+By default, CLP(B) residual goals appear in (approximately) algebraic
+normal form (ANF). This projection is often computationally expensive.
+We can assert `clpb:clpb_residuals(bdd)` to see the BDD representation
+of all constraints. This results in faster projection to residual
+goals, and is also useful for learning more about BDDs. For example:
+
+```
+?- asserta(clpb:clpb_residuals(bdd)).
+   true.
+
+?- sat(X#Y).
+node(3)- (v(X, 0)->node(2);node(1)),
+node(1)- (v(Y, 1)->true;false),
+node(2)- (v(Y, 1)->false;true).
+```
+
+Note that this representation cannot be pasted back on the toplevel,
+and its details are subject to change. Use copy_term/3 to obtain
+such answers as Prolog terms.
+
+The variable order of the BDD is determined by the order in which the
+variables first appear in constraints. To obtain different orders,
+we can for example use:
+
+```
+?- sat(+[1,Y,X]), sat(X#Y).
+node(3)- (v(Y, 0)->node(2);node(1)),
+node(1)- (v(X, 1)->true;false),
+node(2)- (v(X, 1)->false;true).
+```
+
+## Enabling monotonic CLP(B)
+
+In the default execution mode, CLP(B) constraints are _not_ monotonic.
+This means that _adding_ constraints can yield new solutions. For
+example:
+
+```
+?-          sat(X=:=1), X = 1+0.
+   false.
+
+?- X = 1+0, sat(X=:=1), X = 1+0.
+   X = 1+0.
+```
+
+This behaviour is highly problematic from a logical point of view, and
+it may render [*declarative
+debugging*](https://www.metalevel.at/prolog/debugging)
+techniques inapplicable.
+
+Assert `clpb:monotonic` to make CLP(B) *monotonic*. If this mode is
+enabled, then you must wrap CLP(B) variables with the functor
+`v/1`. For example:
+
+```
+?- asserta(clpb:monotonic).
+   true.
+
+?- sat(v(X)=:=1#1).
+   X = 0.
+```
+
+## Example: Pigeons
+
+In this example, we are attempting to place _I_ pigeons into _J_ holes
+in such a way that each hole contains at most one pigeon. One
+interesting property of this task is that it can be formulated using
+only _cardinality constraints_ (`card/2`). Another interesting aspect
+is that this task has no short resolution refutations in general.
+
+In the following, we use [*Prolog DCG
+notation*](https://www.metalevel.at/prolog/dcg) to describe a
+list `Cs` of CLP(B) constraints that must all be satisfied.
+
+```
+:- use_module(library(clpb)).
+:- use_module(library(clpz)).
+:- use_module(library(lists)).
+:- use_module(library(dcgs)).
+
+pigeon(I, J, Rows, Cs) :-
+        length(Rows, I), length(Row, J),
+        maplist(same_length(Row), Rows),
+        transpose(Rows, TRows),
+        phrase((all_cards(Rows,[1]),all_cards(TRows,[0,1])), Cs).
+
+all_cards([], _) --> [].
+all_cards([Ls|Lss], Cs) --> [card(Cs,Ls)], all_cards(Lss, Cs).
+```
+
+Example queries:
+
+```
+?- pigeon(9, 8, Rows, Cs), sat(*(Cs)).
+   false.
+
+?- pigeon(2, 3, Rows, Cs), sat(*(Cs)),
+   append(Rows, Vs), labeling(Vs),
+   maplist(portray_clause, Rows).
+[0,0,1].
+[0,1,0].
+etc.
+```
+
+## Example: Boolean circuit
+
+Consider a Boolean circuit that express the Boolean function =|XOR|=
+with 4 =|NAND|= gates. We can model such a circuit with CLP(B)
+constraints as follows:
+
+```
+:- use_module(library(clpb)).
+
+nand_gate(X, Y, Z) :- sat(Z =:= ~(X*Y)).
+
+xor(X, Y, Z) :-
+        nand_gate(X, Y, T1),
+        nand_gate(X, T1, T2),
+        nand_gate(Y, T1, T3),
+        nand_gate(T2, T3, Z).
+```
+
+Using universally quantified variables, we can show that the circuit
+does compute =|XOR|= as intended:
+
+```
+?- xor(x, y, Z).
+   clpb:sat(Z=:=x#y).
+```
+
+## Acknowledgments
+
+The interface predicates of this library follow the example of
+[*SICStus Prolog*](https://sicstus.sics.se).
+
+Use SICStus Prolog for higher performance in many cases.
+
+*/
+
+
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Each CLP(B) variable belongs to exactly one BDD. Each CLP(B)
    variable gets an attribute (in module "clpb") of the form:
@@ -191,6 +506,10 @@ non_monotonic(X) :-
         ;   true
         ).
 
+:- meta_predicate(bdd_nodes(1, ?, ?)).
+:- meta_predicate(bdd_nodes_(1, ?, ?, ?)).
+:- meta_predicate(with_aux(1, ?)).
+
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Rewriting to canonical expressions.
    Atoms are converted to variables with a special attribute.
@@ -932,7 +1251,7 @@ bdd_restriction_(Node, VI, Value, Res) -->
                   node_id(Node, ID) },
                 (   { I0 =:= VI } ->
                     (   { Value =:= 0 } -> { Res = Low }
-                    ;   { Value =:= 1 } -> { Res = High }
+                    ;   { Res = High }
                     )
                 ;   { I0 > VI } -> { Res = Node }
                 ;   state(G0), { get_assoc(ID, G0, Res) } -> []
@@ -1108,19 +1427,17 @@ indomain(1).
 %
 % Examples:
 %
-% ==
+% ```
 % ?- sat(A =< B), Vs = [A,B], sat_count(+[1|Vs], Count).
-% Vs = [A, B],
+%    Vs = [A,B], Count = 3, clpb:sat(A=:=A*B).
-% Count = 3,
-% sat(A=:=A*B).
 %
 % ?- length(Vs, 120),
 %    sat_count(+Vs, CountOr),
 %    sat_count(*(Vs), CountAnd).
-% Vs = [...],
+%    Vs = [...],
-% CountOr = 1329227995784915872903807060280344575,
+%    CountOr = 1329227995784915872903807060280344575,
-% CountAnd = 1.
+%    CountAnd = 1.
-% ==
+% ```
 
 
 
@@ -1248,7 +1565,7 @@ random_bindings(VNum, Node) -->
 % linear objective function over Boolean variables Vs with integer
 % coefficients Weights. This predicate assigns 0 and 1 to the
 % variables in Vs such that all stated constraints are satisfied, and
-% Maximum is the maximum of sum(Weight_i*V_i) over all admissible
+% Maximum is the maximum of `sum(Weight_i*V_i)` over all admissible
 % assignments.  On backtracking, all admissible assignments that
 % attain the optimum are generated.
 %
@@ -1257,10 +1574,10 @@ random_bindings(VNum, Node) -->
 %
 % Example:
 %
-% ==
+% ```
 % ?- sat(A#B), weighted_maximum([1,2,1], [A,B,C], Maximum).
-% A = 0, B = 1, C = 1, Maximum = 3.
+%    A = 0, B = 1, C = 1, Maximum = 3.
-% ==
+% ```
 
 weighted_maximum(Ws, Vars, Max) :-
         must_be(list(integer), Ws),
@@ -1373,14 +1690,14 @@ skip_to_var_(Var, Weight, [Var0-Weight0|VWs0], VWs) -->
 
 attribute_goals(Var) -->
         { var_index_root(Var, _, Root) },
+        !,
         (   { root_get_formula_bdd(Root, Formula, BDD) } ->
             { del_bdd(Root) },
             (   { clpb_residuals(bdd) } ->
                 { bdd_nodes(BDD, Nodes),
                   phrase(nodes(Nodes), Ns) },
                 [clpb:'$clpb_bdd'(Ns)]
-            ;   { prepare_global_variables(BDD),
+            ;   { phrase(sat_ands(Formula), Ands0),
-                  phrase(sat_ands(Formula), Ands0),
                   ands_fusion(Ands0, Ands),
                   maplist(formula_anf, Ands, ANFs0),
                   sort(ANFs0, ANFs1),
@@ -1400,39 +1717,24 @@ attribute_goals(Var) -->
             booleans(RestVs)
         ;   boolean(Var)  % the variable may have occurred only in taut/2
         ).
+attribute_goals(Var) -->
+        { get_atts(Var, clpb_max(_)),
+          !,
+          put_atts(Var, -clpb_max(_)) }.
+attribute_goals(Var) -->
+        { get_atts(Var, clpb_bdd(BDD)),
+          ground(BDD),
+          put_atts(Var, -clpb_bdd(_)) }.
 
 del_clpb(Var) :-
         del_attr(Var, clpb),
-        del_attr(Var, clpb_hash).
+        del_attr(Var, clpb_hash),
-
+        del_attr(Var, clpb_atom).
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-   To make residual projection work with recorded constraints, the
-   global counters must be adjusted so that new variables and nodes
-   also get new IDs. Also, clpb_next_id/2 is used to actually create
-   these counters, because creating them with b_setval/2 would make
-   them [] on backtracking, which is quite unfortunate in itself.
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 b_setval(K, T) :- bb_b_put(K, T).
 nb_setval(K, T) :- bb_put(K, T).
 b_getval(K, T) :- bb_get(K, T).
 
-prepare_global_variables(BDD) :-
-        clpb_next_id('$clpb_next_var', V0),
-        clpb_next_id('$clpb_next_node', N0),
-        bdd_nodes(BDD, Nodes),
-        foldl(max_variable_node, Nodes, V0-N0, MaxV0-MaxN0),
-        MaxV is MaxV0 + 1,
-        MaxN is MaxN0 + 1,
-        b_setval('$clpb_next_var', MaxV),
-        b_setval('$clpb_next_node', MaxN).
-
-max_variable_node(Node, V0-N0, V-N) :-
-        node_id(Node, N1),
-        node_varindex(Node, V1),
-        N is max(N0,N1),
-        V is max(V0,V1).
-
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Fuse formulas that share the same variables into single conjunctions.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
@@ -1557,7 +1859,8 @@ booleans([B|Bs]) --> boolean(B), booleans(Bs).
 
 boolean(Var) -->
         { del_clpb(Var) },
-        (   { get_attr(Var, clpb_omit_boolean, true) } -> []
+        (   { get_attr(Var, clpb_omit_boolean, true) } ->
+            { put_atts(Var, -clpb_omit_boolean(_)) }
         ;   [clpb:sat(Var =:= Var)]
         ).
 
@@ -1659,49 +1962,3 @@ clpb_atom_var(Atom, Var) :-
             put_assoc(Atom, A0, Var, A),
             b_setval('$clpb_atoms', A)
         ).
-
-
-
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-Compatibility predicates.
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
-
-
-include(Goal, List, Is) :-
-        include_(List, Goal, Is).
-
-include_([], _, []).
-include_([X1|Xs1], P, Is) :-
-        (   call(P, X1)
-        ->  Is = [X1|Is1]
-        ;   Is = Is1
-        ),
-        include_(Xs1, P, Is1).
-
-
-exclude(Goal, List, Is) :-
-        exclude_(List, Goal, Is).
-
-exclude_([], _, []).
-exclude_([X1|Xs1], P, Is) :-
-        (   call(P, X1)
-        ->  Is = Is1
-        ;   Is = [X1|Is1]
-        ),
-        exclude_(Xs1, P, Is1).
-
-
-partition(Pred, List, Less, Equal, Greater) :-
-    partition_(List, Pred, Less, Equal, Greater).
-
-partition_([], _, [], [], []).
-partition_([H|T], Pred, L, E, G) :-
-    call(Pred, H, Diff),
-    partition_(Diff, H, Pred, T, L, E, G).
-
-partition_(<, H, Pred, T, [H|Rest], E, G) :-
-    partition_(T, Pred, Rest, E, G).
-partition_(=, H, Pred, T, L, [H|Rest], G) :-
-    partition_(T, Pred, L, Rest, G).
-partition_(>, H, Pred, T, L, E, [H|Rest]) :-
-    partition_(T, Pred, L, E, Rest).

src/lib/crypto.pl

@@ -1,20 +1,20 @@
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-   Written 2020, 2021, 2022 by Markus Triska (triska@metalevel.at)
+   Written 2020-2024 by Markus Triska (triska@metalevel.at)
    Part of Scryer Prolog.
 
-   Predicates for cryptographic applications.
+/** Predicates for cryptographic applications.
 
-   This library assumes that the Prolog flag double_quotes is set to chars.
+   This library assumes that the Prolog flag `double_quotes` is set to `chars`.
    In Scryer Prolog, lists of characters are very efficiently represented,
    and strings have the advantage that the atom table remains unmodified.
 
    Especially for cryptographic applications, it 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
+   For predicates that accept an `encoding/1` option to specify the encoding
-   of the input data, if encoding(octet) is used, then the input can also
+   of the input data, if `encoding(octet)` is used, then the input can also
-   be specified as a list of bytes, i.e., integers between 0 and 255.
+   be specified as a list of _bytes_, i.e., integers between 0 and 255.
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+*/
 
 :- module(crypto,
           [hex_bytes/2,                  % ?Hex, ?Bytes
@@ -25,6 +25,7 @@
            crypto_password_hash/3,       % +Password, -Hash, +Options
            crypto_data_encrypt/6,        % +PlainText, +Algorithm, +Key, +IV, -CipherText, +Options
            crypto_data_decrypt/6,        % +CipherText, +Algorithm, +Key, +IV, -PlainText, +Options
+           ed25519_seed_keypair/2,       % +Seed, -KeyPair
            ed25519_new_keypair/1,        % -KeyPair
            ed25519_keypair_public_key/2, % +KeyPair, +PublicKey
            ed25519_sign/4,               % +KeyPair, +Data, -Signature, +Options
@@ -48,20 +49,20 @@
 :- use_module(library(si)).
 :- use_module(library(iso_ext), [partial_string/3]).
 
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-   hex_bytes(?Hex, ?Bytes) is det.
-
-   Relation between a hexadecimal sequence and a list of bytes. Hex
-   is a string of hexadecimal numbers. Bytes is a list of *integers*
-   between 0 and 255 that represent the sequence as a list of bytes.
-   At least one of the arguments must be instantiated.
-
-   Example:
-
-   ?- hex_bytes("501ACE", Bs).
-      Bs = [80,26,206].
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
+%% hex_bytes(?Hex, ?Bytes) is det.
+%
+%  Relation between a hexadecimal sequence and a list of bytes. Hex
+%  is a string of hexadecimal numbers. Bytes is a list of _integers_
+%  between 0 and 255 that represent the sequence as a list of bytes.
+%  At least one of the arguments must be instantiated.
+%
+%   Example:
+%
+% ```
+%   ?- hex_bytes("501ACE", Bs).
+%      Bs = [80,26,206].
+% ```
 
 hex_bytes(Hs, Bytes) :-
         (   ground(Hs) ->
@@ -113,47 +114,52 @@ must_be_octet_chars(Chars, Context) :-
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Cryptographically secure random numbers
    =======================================
-
-   crypto_n_random_bytes(+N, -Bytes) is det
-
-   Bytes is unified with a list of N cryptographically secure
-   pseudo-random bytes. Each byte is an integer between 0 and 255. If
-   the internal pseudo-random number generator (PRNG) has not been
-   seeded with enough entropy to ensure an unpredictable byte
-   sequence, an exception is thrown.
-
-   One way to relate such a list of bytes to an _integer_ is to use
-   CLP(ℤ) constraints as follows:
-
-   :- use_module(library(clpz)).
-   :- use_module(library(lists)).
-
-   bytes_integer(Bs, N) :-
-           foldl(pow, Bs, 0-0, N-_).
-
-   pow(B, N0-I0, N-I) :-
-           B in 0..255,
-           N #= N0 + B*256^I0,
-           I #= I0 + 1.
-
-   With this definition, we can generate a random 256-bit integer
-   _from_ a list of 32 random _bytes_:
-
-   ?- crypto_n_random_bytes(32, Bs),
-      bytes_integer(Bs, I).
-      Bs = [146,166,162,210,242,7,25,132,64,94|...],
-      I = 337420085690608915485...(56 digits omitted).
-
-   The above relation also works in the other direction, letting you
-   translate an integer _to_ a list of bytes. In addition, you can
-   use hex_bytes/2 to convert bytes to _tokens_ that can be easily
-   exchanged in your applications.
-
-   ?- crypto_n_random_bytes(12, Bs),
-      hex_bytes(Hex, Bs).
-      Bs = [34,25,50,72,58,63,50,172,32,46|...], Hex = "221932483a3f32ac202 ...".
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
+%% crypto_n_random_bytes(+N, -Bytes) is det.
+%
+%  Bytes is unified with a list of N cryptographically secure
+%  pseudo-random bytes. Each byte is an integer between 0 and 255. If
+%  the internal pseudo-random number generator (PRNG) has not been
+%  seeded with enough entropy to ensure an unpredictable byte
+%  sequence, an exception is thrown.
+%
+%  One way to relate such a list of bytes to an _integer_ is to use
+%  CLP(ℤ) constraints as follows:
+%
+% ```
+%  :- use_module(library(clpz)).
+%  :- use_module(library(lists)).
+%
+%  bytes_integer(Bs, N) :-
+%          foldl(pow, Bs, 0-0, N-_).
+%
+%  pow(B, N0-I0, N-I) :-
+%          B in 0..255,
+%          N #= N0 + B*256^I0,
+%          I #= I0 + 1.
+% ```
+%
+%  With this definition, we can generate a random 256-bit integer
+%  _from_ a list of 32 random _bytes_:
+%
+% ```
+%  ?- crypto_n_random_bytes(32, Bs),
+%     bytes_integer(Bs, I).
+%     Bs = [146,166,162,210,242,7,25,132,64,94|...],
+%     I = 337420085690608915485...(56 digits omitted).
+% ```
+%
+%  The above relation also works in the other direction, letting you
+%  translate an integer _to_ a list of bytes. In addition, you can
+%  use `hex_bytes/2` to convert bytes to _tokens_ that can be easily
+%  exchanged in your applications.
+%
+% ```
+%  ?- crypto_n_random_bytes(12, Bs),
+%     hex_bytes(Hex, Bs).
+%     Bs = [34,25,50,72,58,63,50,172,32,46|...], Hex = "221932483a3f32ac202 ...".
+% ```
 
 crypto_n_random_bytes(N, Bs) :-
         must_be(integer, N),
@@ -165,30 +171,39 @@ crypto_random_byte(B) :- '$crypto_random_byte'(B).
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Hashing
    =======
-
-   crypto_data_hash(+Data, -Hash, +Options)
-
-   Where Data is a list of characters, and Hash is the computed hash
-   as a list of hexadecimal characters.
-
-   Options is a list of:
-
-     - algorithm(+A)
-       where A is one of ripemd160, sha256, sha384, sha512, sha512_256,
-       sha3_224, sha3_256, sha3_384, sha3_512, blake2s256, blake2b512,
-       or a variable. If A is a variable, then it is unified with the
-       default algorithm, which is an algorithm that is considered
-       cryptographically secure at the time of this writing.
-     - encoding(+Encoding)
-       The default encoding is utf8. The alternative is octet,
-       to treat the input as a list of raw bytes.
-
-   Example:
-
-   ?- crypto_data_hash("abc", Hs, [algorithm(sha256)]).
-      Hs = "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad".
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
+%% crypto_data_hash(+Data, -Hash, +Options)
+%
+%  Where Data is a list of characters, and Hash is the computed hash
+%  as a list of hexadecimal characters.
+%
+%  Options is a list of:
+%
+%    - `algorithm(+A)`
+%      where `A` is one of `ripemd160`, `sha256`, `sha384`, `sha512`,
+%      `sha512_256`, `sha3_224`, `sha3_256`, `sha3_384`,
+%      `sha3_512`, `blake2s256`, `blake2b512`, or a variable. If `A` is
+%      a variable, then it is unified with the default algorithm,
+%      which is an algorithm that is considered cryptographically
+%      secure at the time of this writing.
+%
+%    - `encoding(+Encoding)`
+%      The default encoding is `utf8`. The alternative is `octet`, to
+%      treat the input as a list of raw bytes.
+%
+%    - `hmac(+Key)`
+%      Compute a hash-based message authentication code (HMAC) using
+%      Key, a list of bytes. This option is currently supported for
+%      algorithms `sha256`, `sha384` and `sha512`.
+%
+%  Example:
+%
+% ```
+%  ?- crypto_data_hash("abc", Hs, [algorithm(sha256)]).
+%     Hs = "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad".
+% ```
+
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    SHA256 is the current default for several hash-related predicates.
    It is deemed sufficiently secure for the foreseeable future.  Yet,
@@ -204,9 +219,18 @@ crypto_data_hash(Data0, Hash, Options0) :-
         (   hash_algorithm(A) -> true
         ;   domain_error(hash_algorithm, A, crypto_data_hash/3)
         ),
-        '$crypto_data_hash'(Data, Encoding, HashBytes, A),
+        (   member(HMAC, Options0), nonvar(HMAC), HMAC = hmac(Ks) ->
+            must_be_bytes(Ks, crypto_data_hash/3),
+            hmac_algorithm(A),
+            '$crypto_hmac'(Data, Encoding, Ks, HashBytes, A)
+        ;   '$crypto_data_hash'(Data, Encoding, HashBytes, A)
+        ),
         hex_bytes(Hash, HashBytes).
 
+hmac_algorithm(sha256).
+hmac_algorithm(sha384).
+hmac_algorithm(sha512).
+
 options_data_chars(Options, Data, Chars, Encoding) :-
         option(encoding(Encoding), Options, utf8),
         must_be(atom, Encoding),
@@ -238,38 +262,36 @@ hash_algorithm(blake2s256).
 hash_algorithm(blake2b512).
 
 
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+%% crypto_data_hkdf(+Data, +Length, -Bytes, +Options) is det.
-   crypto_data_hkdf(+Data, +Length, -Bytes, +Options) is det.
+%
-
+%  Concentrate possibly dispersed entropy of Data and then expand it
-   Concentrate possibly dispersed entropy of Data and then expand it
+%  to the desired length. Data is a list of characters.
-   to the desired length. Data is a list of characters.
+%
-
+%  Bytes is unified with a list of bytes of length Length, and is
-   Bytes is unified with a list of bytes of length Length, and is
+%  suitable as input keying material and initialization vectors to
-   suitable as input keying material and initialization vectors to
+%  symmetric encryption algorithms.
-   symmetric encryption algorithms.
+%
-
+%  Admissible options are:
-   Admissible options are:
+%
-
+%    - `algorithm(+Algorithm)`
-     - algorithm(+Algorithm)
+%      One of `sha256`, `sha384` or `sha512`. If you specify a variable,
-       One of sha256, sha384 or sha512. If you specify a variable,
+%      then it is unified with the algorithm that was used, which is a
-       then it is unified with the algorithm that was used, which is a
+%      cryptographically secure algorithm by default.
-       cryptographically secure algorithm by default.
+%    - `info(+Info)`
-     - info(+Info)
+%      Optional context and application specific information,
-       Optional context and application specific information,
+%      specified as a list of characters. The default is `[]`.
-       specified as a list of characters. The default is [].
+%    - `salt(+List)`
-     - salt(+List)
+%      Optionally, a list of bytes that are used as salt. The
-       Optionally, a list of bytes that are used as salt. The
+%      default is all zeroes.
-       default is all zeroes.
+%    - `encoding(+Encoding)`
-     - encoding(+Encoding)
+%      The default encoding is `utf8`. The alternative is `octet`,
-       The default encoding is utf8. The alternative is octet,
+%      to treat the input as a list of raw bytes.
-       to treat the input as a list of raw bytes.
+%
-
+%  The `info/1`  option can be  used to  generate multiple keys  from a
-   The `info/1`  option can be  used to  generate multiple keys  from a
+%  single  master key,  using for  example values  such as  "key" and
-   single  master key,  using for  example values  such as  "key" and
+%  "iv", or the name of a file that is to be encrypted.
-   "iv", or the name of a file that is to be encrypted.
+%
-
+%  See `crypto_n_random_bytes/2` to obtain a suitable salt.
-   See crypto_n_random_bytes/2 to obtain a suitable salt.
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 crypto_data_hkdf(Data0, L, Bytes, Options0) :-
         functor_hash_options(algorithm, Algorithm, Options0, Options),
@@ -323,14 +345,12 @@ chars_bytes_(Cs, Bytes, Context) :-
    know if you need to rely on any specifics of this format.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+%% crypto_password_hash(+Password, ?Hash) is semidet.
-   crypto_password_hash(+Password, ?Hash) is semidet.
+%
-
+%  If Hash is instantiated, the predicate succeeds _iff_ the hash
-   If Hash is instantiated, the predicate succeeds _iff_ the hash
+%  matches the given password. Otherwise, the call is equivalent to
-   matches the given password. Otherwise, the call is equivalent to
+%  `crypto_password_hash(Password, Hash, [])` and computes a
-   crypto_password_hash(Password, Hash, []) and computes a
+%  password-based hash using the default options.
-   password-based hash using the default options.
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 crypto_password_hash(Password0, Hash) :-
         (   nonvar(Hash) ->
@@ -353,58 +373,56 @@ dollar_segments(Ls, Segments) :-
         ).
 
 
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+%% crypto_password_hash(+Password, -Hash, +Options) is det.
-   crypto_password_hash(+Password, -Hash, +Options) is det.
+%
-
+%  Derive Hash based on Password. This predicate is similar to
-   Derive Hash based on Password. This predicate is similar to
+%  `crypto_data_hash/3` in that it derives a hash from given data.
-   crypto_data_hash/3 in that it derives a hash from given data.
+%  However, it is tailored for the specific use case of _passwords_.
-   However, it is tailored for the specific use case of _passwords_.
+%  One essential distinction is that for this use case, the derivation
-   One essential distinction is that for this use case, the derivation
+%  of a hash should be _as slow as possible_ to counteract brute-force
-   of a hash should be _as slow as possible_ to counteract brute-force
+%  attacks over possible passwords.
-   attacks over possible passwords.
+%
-
+%  Another important distinction is that equal passwords must yield,
-   Another important distinction is that equal passwords must yield,
+%  with very high probability, _different_ hashes. For this reason,
-   with very high probability, _different_ hashes. For this reason,
+%  cryptographically strong random numbers are automatically added to
-   cryptographically strong random numbers are automatically added to
+%  the password before a hash is derived.
-   the password before a hash is derived.
+%
-
+%  Hash is unified with a string that contains the computed hash and
-   Hash is unified with a string that contains the computed hash and
+%  all parameters that were used, except for the password. Instead of
-   all parameters that were used, except for the password. Instead of
+%  storing passwords, store these hashes. Later, you can verify the
-   storing passwords, store these hashes. Later, you can verify the
+%  validity of a password with `crypto_password_hash/2`, comparing the
-   validity of a password with crypto_password_hash/2, comparing the
+%  then entered password to the stored hash. If you need to export this
-   then entered password to the stored hash. If you need to export this
+%  atom, you should treat it as opaque ASCII data with up to 255 bytes
-   atom, you should treat it as opaque ASCII data with up to 255 bytes
+%  of length. The maximal length may increase in the future.
-   of length. The maximal length may increase in the future.
+%
-
+%  Admissible options are:
-   Admissible options are:
+%
-
+%    - `algorithm(+Algorithm)`
-     - algorithm(+Algorithm)
+%      The algorithm to use. Currently, the only available algorithm
-       The algorithm to use. Currently, the only available algorithm
+%      is `'pbkdf2-sha512'`, which is therefore also the default.
-       is 'pbkdf2-sha512', which is therefore also the default.
+%    - `cost(+C)`
-     - cost(+C)
+%      C is an integer, denoting the binary logarithm of the number
-       C is an integer, denoting the binary logarithm of the number
+%      of _iterations_ used for the derivation of the hash. This
-       of _iterations_ used for the derivation of the hash. This
+%      means that the number of iterations is set to 2^C. Currently,
-       means that the number of iterations is set to 2^C. Currently,
+%      the default is 17, and thus more than one hundred _thousand_
-       the default is 17, and thus more than one hundred _thousand_
+%      iterations. You should set this option as high as your server
-       iterations. You should set this option as high as your server
+%      and users can tolerate. The default is subject to change and
-       and users can tolerate. The default is subject to change and
+%      will likely increase in the future or adapt to new algorithms.
-       will likely increase in the future or adapt to new algorithms.
+%    - `salt(+Salt)`
-     - salt(+Salt)
+%      Use the given list of bytes as salt. By default,
-       Use the given list of bytes as salt. By default,
+%      cryptographically secure random numbers are generated for this
-       cryptographically secure random numbers are generated for this
+%      purpose. The default is intended to be secure, and constitutes
-       purpose. The default is intended to be secure, and constitutes
+%      the typical use case of this predicate.
-       the typical use case of this predicate.
+%
-
+%  Currently, PBKDF2 with SHA-512 is used as the hash derivation
-   Currently, PBKDF2 with SHA-512 is used as the hash derivation
+%  function, using 128 bits of salt. All default parameters, including
-   function, using 128 bits of salt. All default parameters, including
+%  the algorithm, are subject to change, and other algorithms will also
-   the algorithm, are subject to change, and other algorithms will also
+%  become available in the future. Since computed hashes store all
-   become available in the future. Since computed hashes store all
+%  parameters that were used during their derivation, such changes will
-   parameters that were used during their derivation, such changes will
+%  not affect the operation of existing deployments. Note though that
-   not affect the operation of existing deployments. Note though that
+%  new hashes will then be computed with the new default parameters.
-   new hashes will then be computed with the new default parameters.
+%
-
+%  See `crypto_data_hkdf/4` for generating keys from Hash.
-   See crypto_data_hkdf/4 for generating keys from Hash.
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 crypto_password_hash(Password0, Hash, Options) :-
         chars_bytes_(Password0, Password, crypto_password_hash/3),
@@ -435,97 +453,94 @@ bytes_base64(Bytes, Base64) :-
             chars_base64(Chars, Base64, [padding(false)])
         ).
 
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+%% crypto_data_encrypt(+PlainText, +Algorithm, +Key, +IV, -CipherText, +Options).
-   crypto_data_encrypt(+PlainText,
+%
-                       +Algorithm,
+%  Encrypt the given PlainText, using the symmetric algorithm
-                       +Key,
+%  Algorithm, key Key, and initialization vector (or nonce) IV, to
-                       +IV,
+%  give CipherText.
-                       -CipherText,
+%
-                       +Options).
+%  PlainText must be a list of characters, Key and IV must be lists of
-
+%  bytes, and CipherText is created as a list of characters.
-   Encrypt the given PlainText, using the symmetric algorithm
+%
-   Algorithm, key Key, and initialization vector (or nonce) IV, to
+%  Keys and IVs can be chosen at random (using for example
-   give CipherText.
+%  `crypto_n_random_bytes/2`) or derived from input keying material (IKM)
-
+%  using for example `crypto_data_hkdf/4`. This input is often a shared
-   PlainText must be a list of characters, Key and IV must be lists of
+%  secret, such as a negotiated point on an elliptic curve, or the hash
-   bytes, and CipherText is created as a list of characters.
+%  that was computed from a password via `crypto_password_hash/3` with a
-
+%  freshly generated and specified _salt_.
-   Keys and IVs can be chosen at random (using for example
+%
-   crypto_n_random_bytes/2) or derived from input keying material (IKM)
+%  Reusing the same combination of Key and IV typically leaks at least
-   using for example crypto_data_hkdf/4. This input is often a shared
+%  _some_ information about the plaintext. For example, identical
-   secret, such as a negotiated point on an elliptic curve, or the hash
+%  plaintexts will then correspond to identical ciphertexts. For some
-   that was computed from a password via crypto_password_hash/3 with a
+%  algorithms, reusing an IV with the same Key has disastrous results
-   freshly generated and specified _salt_.
+%  and can cause the loss of all properties that are otherwise
-
+%  guaranteed. Especially in such cases, an IV is also called a
-   Reusing the same combination of Key and IV typically leaks at least
+%  _nonce_ (number used once).
-   _some_ information about the plaintext. For example, identical
+%
-   plaintexts will then correspond to identical ciphertexts. For some
+%  It is safe to store and  transfer the used initialization vector (or
-   algorithms, reusing an IV with the same Key has disastrous results
+%  nonce) in plain text, but the key _must be kept secret_.
-   and can cause the loss of all properties that are otherwise
+%
-   guaranteed. Especially in such cases, an IV is also called a
+%  Currently, the only supported algorithm is 'chacha20-poly1305', a
-   _nonce_ (number used once).
+%  powerful and efficient _authenticated_ encryption scheme, providing
-
+%  secrecy and at the same time reliable protection against undetected
-   It is safe to store and  transfer the used initialization vector (or
+%  _modifications_ of the encrypted data. This is a very good choice
-   nonce) in plain text, but the key _must be kept secret_.
+%  for virtually all use cases. It is a stream cipher and can encrypt
-
+%  data of any length up to 256 GB. Further, the encrypted data has
-   Currently, the only supported algorithm is 'chacha20-poly1305', a
+%  exactly the same length as the original, and no padding is used.
-   powerful and efficient _authenticated_ encryption scheme, providing
+%
-   secrecy and at the same time reliable protection against undetected
+%  Options:
-   _modifications_ of the encrypted data. This is a very good choice
+%
-   for virtually all use cases. It is a stream cipher and can encrypt
+%     - `encoding(+Encoding)`
-   data of any length up to 256 GB. Further, the encrypted data has
+%     Encoding to use for PlainText. Default is utf8. The alternative
-   exactly the same length as the original, and no padding is used.
+%     is octet to treat PlainText as raw bytes.
-
+%
-   Options:
+%     - `tag(-List)`
-
+%     For authenticated encryption schemes, List is unified with a
-      - encoding(+Encoding)
+%     list of _bytes_ holding the tag. This tag must be provided for
-      Encoding to use for PlainText. Default is utf8. The alternative
+%     decryption.
-      is octet to treat PlainText as raw bytes.
+%
-
+%     - `aad(+Data)`
-      - tag(-List)
+%     Data is additional authenticated data (AAD), a list of
-      For authenticated encryption schemes, List is unified with a
+%     characters. It is authenticated in that it influences the tag,
-      list of _bytes_ holding the tag. This tag must be provided for
+%     but it is not encrypted. The `encoding/1` option also specifies
-      decryption.
+%     the encoding of Data.
-
+%
-      - aad(+Data)
+%  Here is an example encryption and decryption, using the ChaCha20
-      Data is additional authenticated data (AAD), a list of
+%  stream cipher with the Poly1305 authenticator. This cipher uses a
-      characters. It is authenticated in that it influences the tag,
+%  256-bit key and a 96-bit nonce, i.e., 32 and 12 _bytes_,
-      but it is not encrypted. The encoding/1 option also specifies
+%  respectively:
-      the encoding of Data.
+%
-
+% ```
-   Here is an example encryption and decryption, using the ChaCha20
+%   ?- Algorithm = 'chacha20-poly1305',
-   stream cipher with the Poly1305 authenticator. This cipher uses a
+%      crypto_n_random_bytes(32, Key),
-   256-bit key and a 96-bit nonce, i.e., 32 and 12 _bytes_,
+%      crypto_n_random_bytes(12, IV),
-   respectively:
+%      crypto_data_encrypt("this text is to be encrypted", Algorithm,
-
+%                  Key, IV, CipherText, [tag(Tag)]),
-    ?- Algorithm = 'chacha20-poly1305',
+%      crypto_data_decrypt(CipherText, Algorithm,
-       crypto_n_random_bytes(32, Key),
+%                  Key, IV, RecoveredText, [tag(Tag)]).
-       crypto_n_random_bytes(12, IV),
+% ```
-       crypto_data_encrypt("this text is to be encrypted", Algorithm,
+%
-                   Key, IV, CipherText, [tag(Tag)]),
+%  Yielding:
-       crypto_data_decrypt(CipherText, Algorithm,
+%
-                   Key, IV, RecoveredText, [tag(Tag)]).
+% ```
-
+%      Algorithm = 'chacha20-poly1305',
-   Yielding:
+%      Key = [113,247,153,134,177,220,13,193,50,150|...],
-
+%      IV = [135,20,149,153,63,35,68,114,247,171|...],
-       Algorithm = 'chacha20-poly1305',
+%      CipherText = "\x94\0Ej\x94\®Â\x95\óÑÆXÃn¾ð©b\x1c\ ...",
-       Key = [113,247,153,134,177,220,13,193,50,150|...],
+%      RecoveredText = "this text is to be  ...",
-       IV = [135,20,149,153,63,35,68,114,247,171|...],
+%      Tag = [152,117,152,17,162,75,150,206,144,40|...]
-       CipherText = "\x94\0Ej\x94\®Â\x95\óÑÆXÃn¾ð©b\x1c\ ...",
+% ```
-       RecoveredText = "this text is to be  ...",
+%
-       Tag = [152,117,152,17,162,75,150,206,144,40|...]
+%  In this example, we use `crypto_n_random_bytes/2` to generate a key
-
+%  and nonce from cryptographically secure random numbers. For
-   In this example, we use crypto_n_random_bytes/2 to generate a key
+%  repeated applications, you must ensure that a nonce is only used
-   and nonce from cryptographically secure random numbers. For
+%  _once_ together with the same key. Note that for _authenticated_
-   repeated applications, you must ensure that a nonce is only used
+%  encryption schemes, the _tag_ that was computed during encryption
-   _once_ together with the same key. Note that for _authenticated_
+%  is necessary for decryption. It is safe to store and transfer the
-   encryption schemes, the _tag_ that was computed during encryption
+%  tag in plain text.
-   is necessary for decryption. It is safe to store and transfer the
+%
-   tag in plain text.
+%  See also `crypto_data_decrypt/6`, and `hex_bytes/2` for conversion
-
+%  between bytes and hex encoding.
-   See also crypto_data_decrypt/6, and hex_bytes/2 for conversion
-   between bytes and hex encoding.
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 crypto_data_encrypt(PlainText0, Algorithm, Key, IV, CipherText, Options) :-
         options_data_chars(Options, PlainText0, PlainText, Encoding),
@@ -549,37 +564,30 @@ algorithm_key_iv('chacha20-poly1305', Key, IV) :-
         length(Key, 32),
         length(IV, 12).
 
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+%% crypto_data_decrypt(+CipherText, +Algorithm, +Key, +IV, -PlainText, +Options).
-  crypto_data_decrypt(+CipherText,
+%
-                      +Algorithm,
+%  Decrypt the given CipherText, using the symmetric algorithm
-                      +Key,
+%  Algorithm, key Key, and initialization vector IV, to give
-                      +IV,
+%  PlainText. CipherText must be a list of characters, and Key and IV
-                      -PlainText,
+%  must be lists of bytes. PlainText is created as a list of
-                      +Options).
+%  characters.
-
+%
-   Decrypt the given CipherText, using the symmetric algorithm
+%  Currently, the only supported algorithm is 'chacha20-poly1305',
-   Algorithm, key Key, and initialization vector IV, to give
+%  a very secure, fast and versatile authenticated encryption method.
-   PlainText. CipherText must be a list of characters, and Key and IV
+%
-   must be lists of bytes. PlainText is created as a list of
+%  Options is a list of:
-   characters.
+%
-
+%   - `encoding(+Encoding)`
-   Currently, the only supported algorithm is 'chacha20-poly1305',
+%   Encoding to use for PlainText. The default is utf8. The
-   a very secure, fast and versatile authenticated encryption method.
+%   alternative is octet, which is used if the data are raw bytes.
-
+%
-   Options is a list of:
+%   - `tag(+Tag)`
-
+%   For authenticated encryption schemes, the tag must be specified as
-    - encoding(+Encoding)
+%   a list of bytes exactly as they were generated upon encryption.
-    Encoding to use for PlainText. The default is utf8. The
+%
-    alternative is octet, which is used if the data are raw bytes.
+%   - `aad(+Data)`
-
+%   Any additional authenticated data (AAD) must be specified. The
-    - tag(+Tag)
+%   `encoding/1` option also specifies the encoding of Data.
-    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) :-
         option(tag(Tag), Options, []),
@@ -617,90 +625,151 @@ encoding_chars(utf8, Cs, Cs) :-
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Digital signatures with Ed25519
    ===============================
-
-   - ed25519_new_keypair(-Pair)
-     Yields a new Ed25519 key pair Pair, a list of characters. The
-     pair contains the private key and must be kept absolutely secret.
-     Pair can be used for signing. Its public key can be obtained
-     with ed25519_keypair_public_key/2.
-
-   - ed25519_keypair_public_key(+Pair, -PublicKey)
-     PublicKey is the public key of the given key pair. The public key
-     can be used for signature verification, and can be shared freely.
-     The public key is represented as a list of characters.
-
-   - ed25519_sign(+Key, +Data, -Signature, +Options)
-     Key and Data must be lists of characters. Key is a key pair in
-     PKCS#8 v2 format as generated by ed25519_new_keypair/1. Sign Data
-     with Key, yielding Signature as a list of hexadecimal characters.
-
-   - ed25519_verify(+Key, +Data, +Signature, +Options)
-     Key and Data must be lists of characters. Key is a public key.
-     Succeeds if Data was signed with the private key corresponding to
-     Key, where Signature is a list of hexadecimal characters as
-     generated by ed25519_sign/4. Fails otherwise.
-
-   Currently, the only option for signing and verifying is:
-
-     - encoding(+Encoding)
-       The default encoding of Data is utf8. The alternative is octet,
-       which treats Data as a list of raw bytes.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
+%% ed25519_seed_keypair(+Seed, -Pair)
+%
+% Use Seed to deterministically generate an Ed25519 key pair Pair, a
+% list of characters. Seed must be a list of 32 bytes.  It can be
+% chosen at random (using for example `crypto_n_random_bytes/2`) or
+% derived from input keying material (IKM) using for example
+% `crypto_data_hkdf/4`.  The pair contains the private key and must be
+% kept absolutely secret.  Pair can be used for signing. Its public
+% key can be obtained with `ed25519_keypair_public_key/2`.
+
+ed25519_seed_keypair(Seed, Pair) :-
+        must_be_bytes(Seed, ed25519_keypair_from_seed/2),
+        length(Seed, 32),
+        '$ed25519_seed_to_public_key'(Seed, Public),
+        maplist(char_code, Public, PublicBytes),
+        phrase(ed25519_PKCS8v2(Seed,PublicBytes), DERs),
+        maplist(char_code, Pair, DERs).
+
+% DER (and hence BER) encoding of an Ed25519 private key and
+% corresponding public key in PKCS#8v2 format (RFC 5958) as specified
+% in RFC 8410.
+
+ed25519_PKCS8v2(Seed, PublicBytes) -->
+        [0x30,81],    % a SEQUENCE of 81 bytes follows
+
+        % the publicKey is present, hence we set version to v2
+        [2,1,1],      % the integer 1 denoting version 2 (awesome design!)
+
+        % privateKeyAlgorithm: SEQUENCE
+        [0x30,5],     % a SEQUENCE of 5 bytes follows
+        [6,3],        % an OBJECT IDENTIFIER of 3 bytes follows
+        [43,101,112], % OID of Ed25519
+
+        % privateKey: OCTET STRING
+        [4,34],       % an OCTET STRING of 34 bytes follows
+        [4,32],       % an OCTET STRING of 32 bytes follows
+        seq(Seed),    % the seed is the private key
+
+        % publicKey: [1] IMPLICIT BIT STRING; context-specific, hence bit 7 set
+        [0b10000001], % the public key follows
+        [33],         % a BIT STRING of length 33 follows
+        [0],          % 32 bytes is divisible by 8, hence 0 unused bits
+        seq(PublicBytes).
+
+%% ed25519_new_keypair(-Pair)
+%
+%  Yields a new Ed25519 key pair Pair, a list of characters. The
+%  pair contains the private key and must be kept absolutely secret.
+%  Pair can be used for signing. Its public key can be obtained
+%  with `ed25519_keypair_public_key/2`.
+
 ed25519_new_keypair(Pair) :-
-        '$ed25519_new_keypair'(Pair).
+        crypto_n_random_bytes(32, Bytes),
+        ed25519_seed_keypair(Bytes, Pair).
+
+%% ed25519_keypair_public_key(+Pair, -PublicKey)
+%
+%  PublicKey is the public key of the given key pair. The public key
+%  can be used for signature verification, and can be shared freely.
+%  The public key is represented as a list of characters.
 
 ed25519_keypair_public_key(Pair, PublicKey) :-
-        must_be_octet_chars(Pair, ed25519_keypair_public_key),
+        must_be_octet_chars(Pair, ed25519_keypair_public_key/2),
-        '$ed25519_keypair_public_key'(Pair, PublicKey).
+        reverse(Pair, RPs),
+        length(RPublicKey, 32),
+        phrase((seq(RPublicKey),...), RPs),
+        reverse(RPublicKey, PublicKey).
 
-ed25519_sign(Key, Data0, Signature, Options) :-
+%% ed25519_sign(+Key, +Data, -Signature, +Options)
-        must_be_octet_chars(Key, ed25519_sign),
+%
+%  Key and Data must be lists of characters. Key is a key pair in
+%  PKCS#8 v2 format as generated by `ed25519_new_keypair/1`. Sign Data
+%  with Key, yielding Signature as a list of hexadecimal characters.
+
+ed25519_sign(KeyPair, Data0, Signature, Options) :-
+        must_be_octet_chars(KeyPair, ed25519_sign/4),
+        length(Prefix, 16),
+        length(PrivateKeyChars, 32),
+        phrase((seq(Prefix),seq(PrivateKeyChars),...), KeyPair),
+        maplist(char_code, PrivateKeyChars, PrivateKey),
         options_data_chars(Options, Data0, Data, Encoding),
-        '$ed25519_sign'(Key, Data, Encoding, Signature0),
+        '$ed25519_sign_raw'(PrivateKey, Data, Encoding, Signature0),
         hex_bytes(Signature, Signature0).
 
+%% ed25519_verify(+Key, +Data, +Signature, +Options)
+%
+%  Key and Data must be lists of characters. Key is a public key.
+%  Succeeds if Data was signed with the private key corresponding to
+%  Key, where Signature is a list of hexadecimal characters as
+%  generated by `ed25519_sign/4`. Fails otherwise.
+%
+%  Currently, the only option for signing and verifying is:
+%
+%  - `encoding(+Encoding)`
+%    The default encoding of Data is `utf8`. The alternative is `octet`,
+%    which treats Data as a list of raw bytes.
+
 ed25519_verify(Key, Data0, Signature0, Options) :-
-        must_be_octet_chars(Key, ed25519_verify),
+        must_be_octet_chars(Key, ed25519_verify/4),
         options_data_chars(Options, Data0, Data, Encoding),
         hex_bytes(Signature0, Signature),
-        '$ed25519_verify'(Key, Data, Encoding, Signature).
+        '$ed25519_verify_raw'(Key, Data, Encoding, Signature).
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    X25519: ECDH key exchange over Curve25519
    =========================================
-
-   Points on Curve25519 are represented as lists of characters that denote
-   the u-coordinate of the Montgomery curve.
-
-   - curve25519_generator(-Gs)
-     Gs is the generator point of Curve25519.
-
-   - curve25519_scalar_mult(+Scalar, +Ps, -Rs)
-     Scalar must be an integer between 0 and 2^256-1,
-     or a list of 32 bytes, and Ps must be a point on the curve.
-     Computes the point Rs = Scalar*Ps as mandated by X25519.
-
-   Alice and Bob can use this to establish a shared secret as follows,
-   where Gs is the generator point of Curve25519:
-
-     1. Alice creates a random integer a and sends As = a*Gs to Bob.
-     2. Bob creates a random integer b and sends Bs = b*Gs to Alice.
-     3. Alice computes Rs = a*Bs.
-     4. Bob computes Rs = b*As.
-     5. Alice and Bob use crypto_data_hkdf/4 on Rs with suitable
-        (same) parameters to obtain lists of bytes that can be used as
-        keys and initialization vectors for symmetric encryption.
-
-   If a and b are kept secret, this method is considered very secure.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
+%% curve25519_generator(-Gs)
+%
+%  Points on Curve25519 are represented as lists of characters that
+%  denote the u-coordinate of the Montgomery curve. Gs is the
+%  generator point of Curve25519.
+
 curve25519_generator(Gs) :-
         length(Gs0, 32),
         Gs0 = [9|Zs],
         maplist(=(0), Zs),
         maplist(char_code, Gs, Gs0).
 
+%% curve25519_scalar_mult(+Scalar, +Ps, -Rs)
+%
+%  Scalar must be an integer between 0 and 2^256-1,
+%  or a list of 32 bytes, and Ps must be a point on the curve.
+%  Computes the point _Rs = Scalar*Ps as_ mandated by X25519.
+%
+%  Alice and Bob can use this to establish a shared secret as follows,
+%  where Gs is the generator point of Curve25519:
+%
+%    1. Alice creates a random integer _a_ and sends _As = a*Gs_ to Bob.
+%
+%    2. Bob creates a random integer _b_ and sends _Bs = b*Gs_ to Alice.
+%
+%    3. Alice computes _Rs = a*Bs_.
+%
+%    4. Bob computes _Rs = b*As_.
+%
+%    5. Alice and Bob use `crypto_data_hkdf/4` on Rs with suitable
+%       (same) parameters to obtain lists of bytes that can be used as
+%       keys and initialization vectors for symmetric encryption.
+%
+%  If _a_ and _b_ are kept secret, this method is considered very secure.
+
 curve25519_scalar_mult(Scalar, Point, Result) :-
         (   integer_si(Scalar) ->
             length(ScalarBytes, 32),
@@ -709,6 +778,8 @@ curve25519_scalar_mult(Scalar, Point, Result) :-
             must_be_bytes(ScalarBytes, curve25519_scalar_mult/3),
             length(ScalarBytes, 32)
         ),
+        must_be(chars, Point),
+        length(Point, 32),
         maplist(char_code, Point, PointBytes),
         '$curve25519_scalar_mult'(ScalarBytes, PointBytes, Result).
 
@@ -757,9 +828,26 @@ curve_a(curve(_,_,A,_,_,_,_,_), A).
 curve_b(curve(_,_,_,B,_,_,_,_), B).
 curve_field_length(curve(_,_,_,_,_,_,FieldLength,_), FieldLength).
 
+%% crypto_curve_generator(+Curve, -G)
+%
+%  Yields the generator point G of Curve.
+
 crypto_curve_generator(curve(_,_,_,_,G,_,_,_), G).
+
+%% crypto_curve_order(+Curve, -Order)
+%
+%  Yields the order of Curve.
+
 crypto_curve_order(curve(_,_,_,_,_,Order,_,_), Order).
 
+%% crypto_curve_scalar_mult(+Curve, +Scalar, +Point, -Result)
+%
+%  Computes the point _Result = Scalar*Point_. Scalar must be an
+%  integer, and Point must be a point on Curve. This operation can be
+%  used to negotiate a shared secret over a public channel. Consider
+%  using `curve25519_scalar_mult/3` instead for more desirable
+%  security properties.
+
 crypto_curve_scalar_mult(Curve, Scalar, point(X,Y), point(RX, RY)) :-
         must_be(integer, Scalar),
         must_be_on_curve(Curve, point(X,Y)),
@@ -826,6 +914,12 @@ fitting_exponent(N, E0, E) :-
             fitting_exponent(N, E1, E)
         ).
 
+%% crypto_name_curve(+Name, -Curve)
+%
+%  Yields a representation of the elliptic curve with name Name.
+%  Currently, the only supported name is `secp256k1`, a Koblitz curve
+%  regarded as secure.
+
 crypto_name_curve(secp256k1,
                   curve(secp256k1,
                         0x00fffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc2f,

src/lib/csv.pl

@@ -1,54 +1,67 @@
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+/** Predicates for parsing CSV data
-  Predicates for parsing CSV data
 
+## Read CSV files.
 
-  Read csv files
+Only two options with default values:
 
-  Only two options with default values :
+- `token_separator(',')`
-  - token_separator(',')
+- `with_header(true)`
-  - with_header(true)
 
-  Examples
+### Examples:
 
-  * parsing a csv string:
+Parsing a CSV string:
 
-  ?- use_module(library(csv)).
+```
-  ?- use_module(library(dcgs)).
+?- use_module(library(csv)).
-  ?- phrase(parse_csv(Data), "col1,col2,col3,col4\none,2,,three").
+?- use_module(library(dcgs)).
-    Data = frame(["col1","col2","col3","col4"],[["one",2,[],"three"]]).
+?- phrase(parse_csv(Data), "col1,col2,col3,col4\none,2,,three").
+   Data = frame(["col1","col2","col3","col4"],[["one",2,[],"three"]]).
+```
 
-  * with some options:
+With some options:
 
-  ?- phrase(parse_csv(Data, [with_header(false), token_separator(';')]), "one;2;;three").
+```
-    Data = frame([],[["one",2,[],"three"]]).
+?- phrase(parse_csv(Data, [with_header(false), token_separator(';')]), "one;2;;three").
+   Data = frame([],[["one",2,[],"three"]]).
+```
 
-  * parsing a csv file:
+Parsing a CSV file:
 
-  ?- use_module(library(csv)).
+```
-  ?- use_module(library(pio)).
+?- use_module(library(csv)).
-  ?- phrase_from_file(parse_csv(frame(Header, Rows)), './test.csv').
+?- use_module(library(pio)).
+?- phrase_from_file(parse_csv(frame(Header, Rows)), './test.csv').
+```
 
+## Write CSV files
 
-  Write csv files
+Four options with default values :
 
-  Four options with default values :
+- `line_separator('\n')`
-  - line_separator('\n')
+- `token_separator(',')`
-  - token_separator(',')
+- `with_header(true)`
-  - with_header(true)
+- `null_value(empty)`
-  - null_value(empty)
 
-  Examples
+### Examples
 
-  * writing a csv file:
+Writing a CSV file:
 
-  ?- use_module(library(csv)).
+```
-  ?- write_csv('./test.csv', frame(["col1","col2","col3","col4"], [["one",2,[],"three"]])).
+?- use_module(library(csv)).
+?- write_csv('./test.csv', frame(["col1","col2","col3","col4"], [["one",2,[],"three"]])).
+```
 
-  * with some options
+With some options
 
-  ?- use_module(library(csv)).
+```
-  ?- write_csv('./test.csv', frame(["col1","col2","col3","col4"], [["one",2,[],"three"]]), [with_header(false), line_separator('\r\n'), token_separator(';'), null_value('\\N')]).
+?- use_module(library(csv)).
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+?- write_csv('./test.csv', frame(
+      ["col1","col2","col3","col4"],
+      [["one",2,[],"three"]]
+    ),
+    [with_header(false), line_separator('\r\n'), token_separator(';'), null_value('\\N')]).
+```
+*/
 
 :- module(csv, [
   parse_csv//1,
@@ -208,7 +221,7 @@ row([X | Y], Opt) -->
   !,
   ( separator(Opt) ->
     row(Y, Opt)
-  ; end_token ->
+  ; end_token,
     { Y = [] }).
 
 

src/lib/dcgs.pl

@@ -1,10 +1,23 @@
+/** Support for Definite Clause Grammars.
+
+A Prolog definite clause grammar (DCG) describes a sequence. Operationally, DCGs
+can be used to parse, generate, complete and check sequences manifested as lists.
+
+Check [The Power of Prolog chapter on DCGs](https://www.metalevel.at/prolog/dcg)
+to learn more about them.
+*/
+
+
 :- module(dcgs,
           [op(1105, xfy, '|'),
            phrase/2,
            phrase/3,
+           phrase/4,
+           phrase/5,
            seq//1,
            seqq//1,
-           ... //0
+           ... //0,
+           (-->)/2
           ]).
 
 :- use_module(library(error)).
@@ -16,9 +29,48 @@
 
 :- meta_predicate phrase(2, ?, ?).
 
+:- meta_predicate phrase(2, ?, ?, ?).
+
+:- meta_predicate phrase(2, ?, ?, ?, ?).
+
+%% phrase(+Body, ?Ls).
+%
+% True iff Body describes the list Ls. Body must be a DCG body.
+% It is equivalent to `phrase(Body, Ls, [])`.
+%
+% Examples:
+%
+% ```
+% as --> [].
+% as --> [a], as.
+%
+% ?- phrase(as, Ls).
+%    Ls = []
+% ;  Ls = "a"
+% ;  Ls = "aa"
+% ;  Ls = "aaa"
+% ;  ... .
+%
+% ?- phrase(as, "aaa").
+%    true.
+% ```
+
 phrase(GRBody, S0) :-
     phrase(GRBody, S0, []).
 
+%% phrase(+Body, ?Ls, ?Ls0).
+%
+% True iff Body describes part of the list Ls and the rest of Ls is Ls0.
+%
+% Example:
+%
+% ```
+% ?- phrase(seq(X), "aaa", Y).
+%    X = [], Y = "aaa"
+% ;  X = "a", Y = "aa"
+% ;  X = "aa", Y = "a"
+% ;  X = "aaa", Y = [].
+% ```
 phrase(GRBody, S0, S) :-
     strip_module(GRBody, M, GRBody1),
     (  var(GRBody) ->
@@ -30,12 +82,33 @@ phrase(GRBody, S0, S) :-
     ;  call(M:GRBody1, S0, S)
     ).
 
-
+phrase(GRBody, Arg, S0, S) :-
-module_call_qualified(M, Call, Call1) :-
+    strip_module(GRBody, M, GRBody1),
-    (  nonvar(M) -> Call1 = M:Call
+    (  var(GRBody) ->
-    ;  Call = Call1
+       instantiation_error(phrase/4)
+    ;  nonvar(GRBody1),
+       GRBody1 =.. GRBodys1,
+       append(GRBodys1, [Arg], GRBodys2),
+       GRBody2 =.. GRBodys2,
+       dcg_constr(GRBody2),
+       dcg_body(GRBody2, S0, S, GRBody3) ->
+       call(M:GRBody3)
+    ;  call(M:GRBody1, Arg, S0, S)
     ).
 
+phrase(GRBody, Arg1, Arg2, S0, S) :-
+    strip_module(GRBody, M, GRBody1),
+    (  var(GRBody) ->
+       instantiation_error(phrase/5)
+    ;  nonvar(GRBody1),
+       GRBody1 =.. GRBodys1,
+       append(GRBodys1, [Arg1,Arg2], GRBodys2),
+       GRBody2 =.. GRBodys2,
+       dcg_constr(GRBody2),
+       dcg_body(GRBody2, S0, S, GRBody3) ->
+       call(M:GRBody3)
+    ;  call(M:GRBody1, Arg1, Arg2, S0, S)
+    ).
 
 % The same version of the below two dcg_rule clauses, but with module scoping.
 dcg_rule(( M:NonTerminal, Terminals --> GRBody ), ( M:Head :- Body )) :-
@@ -63,7 +136,10 @@ dcg_rule(( NonTerminal --> GRBody ), ( Head :- Body )) :-
 dcg_non_terminal(NonTerminal, S0, S, Goal) :-
     NonTerminal =.. NonTerminalUniv,
     append(NonTerminalUniv, [S0, S], GoalUniv),
-    Goal =.. GoalUniv.
+    (  callable(NonTerminal) ->
+       Goal =.. GoalUniv
+    ;  Goal = NonTerminal % let call/N throw an error instead of throwing one here.
+    ).
 
 dcg_terminals(Terminals, S0, S, S0 = List) :-
     append(Terminals, S, List).
@@ -78,11 +154,12 @@ dcg_body(GRBody, S0, S, Body) :-
 dcg_body(NonTerminal, S0, S, Goal1) :-
     nonvar(NonTerminal),
     \+ dcg_constr(NonTerminal),
-    NonTerminal \= ( _ -> _ ),
-    NonTerminal \= ( \+ _ ),
     loader:strip_module(NonTerminal, M, NonTerminal0),
     dcg_non_terminal(NonTerminal0, S0, S, Goal0),
-    module_call_qualified(M, Goal0, Goal1).
+    (  functor(NonTerminal, (:), 2) ->
+       Goal1 = M:Goal0
+    ;  Goal1 = Goal0
+    ).
 
 % The following constructs in a grammar rule body
 % are defined in the corresponding subclauses.
@@ -94,9 +171,13 @@ dcg_constr(( _'|'_ )). % 7.14.6 - alternative
 dcg_constr({_}). % 7.14.7
 dcg_constr(call(_)). % 7.14.8
 dcg_constr(phrase(_)). % 7.14.9
+dcg_constr(phrase(_,_)). % extension of 7.14.9
+dcg_constr(phrase(_,_,_)). % extension of 7.14.9
 dcg_constr(!). % 7.14.10
-%% dcg_constr(\+ _). % 7.14.11 - not (existence implementation dep.)
+dcg_constr(\+ G_0) :- % 7.14.11 - not (existence implementation def.)
-dcg_constr((_->_)). % 7.14.12 - if-then (existence implementation dep.)
+    throw(error(representation_error(dcg_body), [culprit- (\+ G_0)])).
+dcg_constr((If->Then)) :- % 7.14.12 - if-then (existence implementation def.)
+    throw(error(representation_error(dcg_body), [culprit- (If->Then)])).
 
 % The principal functor of the first argument indicates
 % the construct to be expanded.
@@ -121,8 +202,10 @@ dcg_cbody(( GREither '|' GROr ), S0, S, ( Either ; Or )) :-
 dcg_cbody({Goal}, S0, S, ( Goal, S0 = S )).
 dcg_cbody(call(Cont), S0, S, call(Cont, S0, S)).
 dcg_cbody(phrase(Body), S0, S, phrase(Body, S0, S)).
+dcg_cbody(phrase(Body, Arg), S0, S, phrase(Body, Arg, S0, S)).
+dcg_cbody(phrase(Body, Arg1, Arg2), S0, S, phrase(Body, Arg1, Arg2, S0, S)).
 dcg_cbody(!, S0, S, ( !, S0 = S )).
-dcg_cbody(\+ GRBody, S0, S, ( \+ phrase(GRBody,S0,_), S0 = S )).
+% dcg_cbody(\+ GRBody, S0, S, ( \+ phrase(GRBody,S0,_), S0 = S )).
 dcg_cbody(( GRIf -> GRThen ), S0, S, ( If -> Then )) :-
     dcg_body(GRIf, S0, S1, If),
     dcg_body(GRThen, S1, S, Then).
@@ -131,6 +214,9 @@ user:term_expansion(Term0, Term) :-
     nonvar(Term0),
     dcg_rule(Term0, Term).
 
+
+%% seq(Seq)//
+% 
 % Describes a sequence
 seq(Xs, Cs0,Cs) :-
    var(Xs),
@@ -141,10 +227,14 @@ seq(Xs, Cs0,Cs) :-
 seq([]) --> [].
 seq([E|Es]) --> [E], seq(Es).
 
+%% seqq(SeqOfSeqs)//
+%
 % Describes a sequence of sequences
 seqq([]) --> [].
 seqq([Es|Ess]) --> seq(Es), seqq(Ess).
 
+%% ...//
+%
 % Describes an arbitrary number of elements
 ...(Cs0,Cs) :-
    Cs0 == [],
@@ -154,6 +244,8 @@ seqq([Es|Ess]) --> seq(Es), seqq(Ess).
 
 error_goal(error(E, must_be/2), error(E, must_be/2)).
 error_goal(error(E, (=..)/2), error(E, (=..)/2)).
+error_goal(error(representation_error(dcg_body), Context),
+           error(representation_error(dcg_body), Context)).
 error_goal(E, _) :- throw(E).
 
 user:goal_expansion(phrase(GRBody, S, S0), GRBody2) :-
@@ -163,6 +255,16 @@ user:goal_expansion(phrase(GRBody, S, S0), GRBody2) :-
           E,
           dcgs:error_goal(E, GRBody1)
          ),
-    module_call_qualified(M, GRBody1, GRBody2).
+    (  GRBody = (_:_) ->
+       GRBody2 = M:GRBody1
+    ;  GRBody2 = GRBody1
+    ).
 
 user:goal_expansion(phrase(GRBody, S), phrase(GRBody, S, [])).
+
+
+% (-->)/2 behaves as if it didn't exist. We export (and define) it
+% only so that clauses for (-->)/2 cannot be asserted when
+% library(dcgs) is loaded.
+
+(_-->_) :- throw(error(existence_error(procedure,(-->)/2),(-->)/2)).

src/lib/debug.pl

@@ -1,4 +1,22 @@
-% Source: https://stackoverflow.com/a/30791637
+/** Declarative debugging.
+
+  This library provides three predicates with associated operators.
+  The operators can be placed in front of goals to debug Prolog
+  programs.
+
+  Of these predicates, the most frequently used is `(*)/1`, with
+  associated prefix operator `*` (star). Placing `*` in front of a
+  goal means to _generalize away_ the goal. `* Goal` acts as if `Goal`
+  did not appear at all in the source code. It is declaratively
+  equivalent to _commenting out_ the goal, and easier to write,
+  because `*` can also be placed in front of the last goal in a clause
+  without any additional changes.
+
+  Source: [https://stackoverflow.com/a/30791637](https://stackoverflow.com/a/30791637)
+
+*/
+
+
 
 :- module(debug, [
     op(900, fx, $),
@@ -15,12 +33,24 @@
 :- meta_predicate $(0).
 :- meta_predicate $-(0).
 
+%% $-(Goal)
+%
+%  Portray exceptions thrown by Goal.
+
 $-(G_0) :-
    catch(G_0, Ex, ( portray_clause(exception:Ex:G_0), throw(Ex) ) ).
 
+%% $(Goal)
+%
+%  Provide a _trace_ for calls of Goal.
+
 $(G_0) :-
    portray_clause(call:G_0),
    $-G_0,
    portray_clause(exit:G_0).
 
+%% *(Goal)
+%
+%  Generalize away Goal.
+
 *(_).

src/lib/diag.pl

@@ -1,7 +1,160 @@
-:- module(diag, [wam_instructions/2]).
+:- module(diag, [wam_instructions/2, inlined_instructions/2]).
+
+/** Diagnostics library
+
+  The predicate `wam_instructions/2` _decompiles_ a predicate so that
+  we can inspect its Warren Abstract Machine (WAM) instructions.
+  In this way, we can verify and reason about compiled programs,
+  and detect opportunities for optimization.
+
+  For example, we have:
+
+```
+?- use_module(library(lists)).
+   true.
+?- use_module(library(diag)).
+   true.
+?- use_module(library(format)).
+   true.
+?- wam_instructions(append/3, Is),
+   maplist(portray_clause, Is).
+switch_on_term(1,external(1),external(2),external(6),fail).
+try_me_else(4).
+get_constant(level(shallow),[],x(1)).
+get_value(x(2),3).
+proceed.
+trust_me(0).
+get_list(level(shallow),x(1)).
+unify_variable(x(4)).
+unify_variable(x(1)).
+get_list(level(shallow),x(3)).
+unify_value(x(4)).
+unify_variable(x(3)).
+execute(append,3).
+   Is = [switch_on_term(1,external(1),external(2),external(6),fail)|...].
+```
+
+  `inlined_instructions/2` decompiles predicates at the code offset in
+  its first argument.
+
+  For example, given the program
+
+```
+?- [user].
+:- use_module(library(clpz)).
+
+all_eq(Vs, E) :- maplist(#=(E), Vs).
+
+```
+
+  we inspect the code of `all_eqs/2` using `wam_instructions/2`,
+  revealing:
+
+```
+?- wam_instructions(all_eq/2, Is),
+   maplist(portray_clause, Is).
+put_structure('$aux',2,x(3)).
+set_local_value(x(2)).
+set_void(1).
+set_constant('$index_ptr'(115334)).
+get_variable(x(4),1).
+put_structure(:,2,x(1)).
+set_constant(user).
+set_local_value(x(3)).
+get_variable(x(5),2).
+put_value(x(4),2).
+execute(maplist,2).
+   Is = [put_structure('$aux',2,x(3)),set_local_value(x(2)),set_void(1),set_constant('$index_ptr'(115334)),get_variable(x(4),1),put_structure(:,2,x(1)),set_constant(user),set_local_value(x(3)),get_variable(x(5),2),put_value(x(4),2),execute(maplist,2)].
+```
+
+  The `'$index_ptr(115334)` functor gives a code offset to an inlined
+  predicate compiled for the use of maplist/2. `inlined_instructions/2`
+  can be used to decompile its source code:
+
+```
+?- inlined_instructions(115334, Is),
+   maplist(portray_clause, Is).
+allocate(1).
+get_level(y(1)).
+get_variable(x(5),2).
+put_value(x(3),2).
+get_variable(x(6),3).
+put_value(x(5),3).
+put_unsafe_value(1,4).
+deallocate.
+jmp_by_execute(1).
+try_me_else(8).
+call(integer,1).
+neck_cut.
+get_variable(x(5),1).
+put_value(x(2),1).
+get_variable(x(6),2).
+put_value(x(5),2).
+jmp_by_execute(7).
+try_me_else(12).
+allocate(3).
+get_level(y(1)).
+get_variable(y(3),1).
+get_variable(y(2),2).
+call_default(true,0).
+call(var,1).
+cut(y(1)).
+put_unsafe_value(3,1).
+put_unsafe_value(2,2).
+deallocate.
+execute_default(is,2).
+default_retry_me_else(4).
+call(integer,1).
+neck_cut.
+execute(=:=,2).
+default_trust_me(0).
+allocate(2).
+get_variable(y(1),1).
+get_variable(y(2),3).
+put_value(y(2),1).
+call_default(is,2).
+put_unsafe_value(2,1).
+put_unsafe_value(1,2).
+deallocate.
+execute_default(clpz_equal,2).
+default_retry_me_else(4).
+call(integer,1).
+neck_cut.
+jmp_by_execute(29).
+try_me_else(12).
+allocate(3).
+get_level(y(1)).
+get_variable(y(3),1).
+get_variable(y(2),2).
+call_default(true,0).
+call(var,1).
+cut(y(1)).
+put_unsafe_value(3,1).
+put_unsafe_value(2,2).
+deallocate.
+execute_default(is,2).
+default_trust_me(0).
+allocate(2).
+get_variable(y(2),1).
+get_variable(y(1),3).
+put_value(y(1),1).
+call_default(is,2).
+put_unsafe_value(2,1).
+put_unsafe_value(1,2).
+deallocate.
+execute_default(clpz_equal,2).
+default_trust_me(0).
+execute_default(clpz_equal,2).
+   Is = [allocate(1),get_level(y(1)),get_variable(x(5),2),put_value(x(3),2),get_variable(x(6),3),put_value(x(5),3),put_unsafe_value(1,4),deallocate,jmp_by_execute(1),try_me_else(8),call(integer,1),neck_cut,get_variable(x(5),1),put_value(x(2),1),get_variable(x(6),2),put_value(x(5),2),jmp_by_execute(7),try_me_else(12),allocate(3),get_level(...),...].
+```
+*/
+
 
 :- use_module(library(error)).
 
+%% wam_instructions(+PI, -Instrs)
+%
+%  _Instrs_ are the WAM instructions corresponding to predicate indicator _PI_.
 
 wam_instructions(Clause, Listing) :-
     (  nonvar(Clause) ->
@@ -13,6 +166,16 @@ wam_instructions(Clause, Listing) :-
     ;  throw(error(instantiation_error, wam_instructions/2))
     ).
 
+%% inlined_instructions(+IndexPtr, -Instrs)
+%
+%  _Instrs_ are the WAM instructions corresponding to code offset _IndexPtr_.
+
+inlined_instructions(IndexPtr, Listing) :-
+    must_be(integer, IndexPtr),
+    (  IndexPtr >= 0 ->
+       '$inlined_instructions'(IndexPtr, Listing)
+    ;  throw(error(domain_error(not_less_than_zero, IndexPtr), inlined_instructions/2))
+    ).
 
 fetch_instructions(Module, Name, Arity, Listing) :-
     must_be(atom, Module),

src/lib/dif.pl

@@ -1,8 +1,13 @@
+/**
+Provides predicate `dif/2`. `dif/2` is a constraint that is true only if both of its
+arguments are different terms.
+*/
+
 :- module(dif, [dif/2]).
 
 :- use_module(library(atts)).
 :- use_module(library(dcgs)).
-:- use_module(library(lists), [append/3]).
+:- use_module(library(lists), [append/3, maplist/3]).
 
 :- attribute dif/1.
 
@@ -18,6 +23,34 @@ dif_set_variables([Var|Vars], X, Y) :-
     put_dif_att(Var, X, Y),
     dif_set_variables(Vars, X, Y).
 
+remove_goal([], _, []).
+remove_goal([G0|G0s], Goal0, Goals) :-
+    (   G0 == Goal0 ->
+        remove_goal(G0s, Goal0, Goals)
+    ;   Goals = [G0|Goals1],
+        remove_goal(G0s, Goal0, Goals1)
+    ).
+
+vars_remove_goal([], _).
+vars_remove_goal([Var|Vars], Goal0) :-
+    (  get_atts(Var, +dif(Goals0)) ->
+       remove_goal(Goals0, Goal0, Goals),
+       (   Goals = [] ->
+           put_atts(Var, -dif(_))
+       ;   put_atts(Var, +dif(Goals))
+       )
+    ;  true
+    ),
+    vars_remove_goal(Vars, Goal0).
+
+reinforce_goal(Goal0, Goal) :-
+    Goal = (
+        term_variables(Goal0, Vars),
+        dif:vars_remove_goal(Vars, Goal0),
+        Goal0 = (L \== R),
+        dif:dif(L, R)
+    ).
+
 append_goals([], _).
 append_goals([Var|Vars], Goals) :-
     (   get_atts(Var, +dif(VarGoals)) ->
@@ -29,31 +62,46 @@ append_goals([Var|Vars], Goals) :-
     append_goals(Vars, Goals).
 
 verify_attributes(Var, Value, Goals) :-
-    (   get_atts(Var, +dif(Goals)) ->
+    (   get_atts(Var, +dif(Goals0)) ->
 	    term_variables(Value, ValueVars),
-	    append_goals(ValueVars, Goals)
+	    append_goals(ValueVars, Goals0),
+        maplist(reinforce_goal, Goals0, Goals)
     ;   Goals = []
     ).
 
-% Probably the world's worst dif/2 implementation. I'm open to
+%% dif(?X, ?Y).
-% suggestions for improvement.
+%
-
+% True iff X and Y are different terms. Unlike `\=/2`, `dif/2` is more declarative because if X and Y can
+% unify but they're not yet equal, the decision is delayed, and prevents X and Y to become equal later.
+% Examples:
+%
+% ```
+% ?- dif(a, a).
+%    false.
+% ?- dif(a, b).
+%    true.
+% ?- dif(X, b).
+%    dif:dif(X,b).
+% ?- dif(X, b), X = b.
+%    false.
+% ```
 dif(X, Y) :-
     X \== Y,
     (   X \= Y -> true
-    ;   (   term_variables(X, XVars),
+    ;   term_variables(dif(X,Y), Vars),
-            term_variables(Y, YVars),
+        dif_set_variables(Vars, X, Y)
-            dif_set_variables(XVars, X, Y),
-            dif_set_variables(YVars, X, Y)
-        )
     ).
 
-gather_dif_goals([]) --> [].
+gather_dif_goals(_, []) --> [].
-gather_dif_goals([(X \== Y) | Goals]) -->
+gather_dif_goals(V, [(X \== Y) | Goals]) -->
-    [dif:dif(X, Y)],
+    (  { term_variables(X-Y, [V0 | _]),
-    gather_dif_goals(Goals).
+         V == V0 } ->
+       [dif:dif(X, Y)]
+    ;  []
+    ),
+    gather_dif_goals(V, Goals).
 
 attribute_goals(X) -->
     { get_atts(X, +dif(Goals)) },
-    gather_dif_goals(Goals),
+    gather_dif_goals(X, Goals),
     { put_atts(X, -dif(_)) }.

src/lib/error.pl

@@ -1,5 +1,5 @@
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-   Written 2018-2022 by Markus Triska (triska@metalevel.at)
+   Written 2018-2023 by Markus Triska (triska@metalevel.at)
    I place this code in the public domain. Use it in any way you want.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
@@ -85,11 +85,11 @@ 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) ->
+        (   acyclic_term(Term) ->
-            instantiation_error(must_be/2)
+            (   ground(Term) ->  true
-        ;   \+ acyclic_term(Term) ->
+            ;   instantiation_error(must_be/2)
-            type_error(term, Term, must_be/2)
+            )
-        ;   true
+        ;   type_error(term, Term, must_be/2)
         ).
 
 % We cannot use maplist(must_be(character), Cs), because library(lists)

src/lib/ffi.pl

@@ -0,0 +1,104 @@
+:- module(ffi, [use_foreign_module/2, foreign_struct/2]).
+
+/** Foreign Function Interface
+
+This module contains predicates used to call native code (exposed by the C ABI).
+It uses [libffi](https://sourceware.org/libffi/) under the hood. The bridge is very simple
+and is very unsafe and should be used with care. FFI isn't the only way to communicate with
+the outside world in Prolog: sockets, pipes and HTTP may be good enough for your use case.
+
+The main predicate is `use_foreign_module/2`. It takes a library name (which depending on the
+operating system could be a `.so`, `.dylib` or `.dll` file). and a list of functions. Each
+function is defined by its name, a list of the type of the arguments, and the return argument.
+
+Types available are: `sint8`, `uint8`, `sint16`, `uint16`, `sint32`, `uint32`, `sint64`,
+`uint64`, `f32`, `f64`, `cstr`, `void`, `bool`, `ptr` and custom structs, which can be defined
+with `foreign_struct/2`.
+
+After that, each function on the lists maps to a predicate created in the ffi module which
+are used to call the native code.
+The predicate takes the functor name after the function name. Then, the arguments are the input
+arguments followed by a return argument. However, functions with return type `void` or `bool`
+don't have that return argument. Predicates with `void` always succeed and `bool` predicates depend
+on the return value on the native side.
+
+```
+ffi:FUNCTION_NAME(+InputArg1, ..., +InputArgN, -ReturnArg). % for all return types except void and bool
+ffi:FUNCTION_NAME(+InputArg1, ..., +InputArgN). % for void and bool
+```
+
+## Example
+
+For example, let's see how to define a function from the [raylib](https://www.raylib.com/) library.
+
+```
+?- use_foreign_module("./libraylib.so", ['InitWindow'([sint32, sint32, cstr], void)]).
+```
+
+This creates a `'InitWindow'` predicate under the ffi module. Now, we can call it:
+
+```
+?- ffi:'InitWindow'(800, 600, "Scryer Prolog + Raylib").
+```
+
+And a new window should pop up!
+*/
+
+:- use_module(library(lists)).
+:- use_module(library(error)).
+
+%% foreign_struct(+Name, +Elements).
+%
+% Defines a new struct type with name Name, composed of the elements Elements, which is a list
+% of other types.
+%
+% The name of the types doesn't matter, but the order of Elements must match the ones in the
+% native code.
+%
+% Example:
+%
+% ```
+% ?- foreign_struct(color, [uint8, uint8, uint8, uint8]).
+% ```
+foreign_struct(Name, Elements) :-
+    '$define_foreign_struct'(Name, Elements).
+
+use_foreign_module(LibName, Predicates) :-
+    '$load_foreign_lib'(LibName, Predicates),
+    maplist(assert_predicate, Predicates).
+
+assert_predicate(PredicateDefinition) :-
+    PredicateDefinition =.. [Name, Inputs, void],
+    length(Inputs, NumInputs),
+    functor(Head, Name, NumInputs),
+    term_variables(Head, TermList),
+    Body = (
+	'$foreign_call'(Name, TermList, _),!
+    ),
+    Predicate = (Head:-Body),
+    assertz(ffi:Predicate).
+
+assert_predicate(PredicateDefinition) :-
+    PredicateDefinition =.. [Name, Inputs, bool],
+    length(Inputs, NumInputs),
+    functor(Head, Name, NumInputs),
+    term_variables(Head, TermList),
+    Body = (
+	'$foreign_call'(Name, TermList, 1),!
+    ),
+    Predicate = (Head:-Body),
+    assertz(ffi:Predicate).
+
+assert_predicate(PredicateDefinition) :-
+    PredicateDefinition =.. [Name, Inputs, Return],
+    \+ member(Return, [void, bool]),
+    length(Inputs, NumInputs),
+    NumArgs is NumInputs + 1,
+    functor(Head, Name, NumArgs),
+    term_variables(Head, TermList),
+    Body = (
+	lists:append(TermListInputs, [TermListReturn], TermList),
+	'$foreign_call'(Name, TermListInputs, TermListReturn),!
+    ),
+    Predicate = (Head:-Body),
+    assertz(ffi:Predicate).

src/lib/files.pl

@@ -1,3 +1,22 @@
+/** Predicates for reasoning about files and directories.
+
+In this library, directories and files are represented as
+_lists of characters_. This is an ideal representation:
+
+* Lists of characters can be conveniently reasoned about with DCGs
+   and built-in Prolog predicates from `library(lists)`. This alone
+   is already a very compelling argument to use them.
+* Other Scryer libraries such as `library(http/http_open)` also already
+   use lists of characters to represent paths.
+* File names are mostly ephemeral, so it is good for efficiency
+   that they can quickly allocated transiently on the heap, leaving the
+   atom table mostly unaffected. Indexing is almost never needed
+   for file names. If needed, it should be added to the engine.
+* The previous point is also good for security, since the system
+   leaves little trace of which files were even accessed.
+* Scryer Prolog represents lists of characters extremely compactly.
+*/
+
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Written 2020, 2022 by Markus Triska (triska@metalevel.at)
    Part of Scryer Prolog.
@@ -51,8 +70,9 @@
                   file_exists/1,
                   directory_exists/1,
                   delete_file/1,
-				  rename_file/2,
+		          rename_file/2,
-				  delete_directory/1,
+		          file_copy/2,
+		          delete_directory/1,
                   make_directory/1,
                   make_directory_path/1,
                   working_directory/2,
@@ -67,41 +87,82 @@
 :- use_module(library(charsio)).
 :- use_module(library(dcgs)).
 
+%% directory_files(+Directory, -Files).
+%
+% Returns the list of files *and* directories available at a specific
+% directory in the current system.
+
 directory_files(Directory, Files) :-
         must_be(chars, Directory),
         can_be(list, Files),
         '$directory_files'(Directory, Files).
 
+%% file_size(+File, -Size).
+%
+% Returns the size (in bytes) of a file. The file must exist.
+
 file_size(File, Size) :-
         file_must_exist(File, file_size/2),
         can_be(integer, Size),
         '$file_size'(File, Size).
 
+%% file_exists(+File).
+%
+% Succeeds if File is a file that exists in the current system.
 file_exists(File) :-
         must_be(chars, File),
         '$file_exists'(File).
 
+%% directory_exists(+Directory).
+%
+% Succeeds if Directory is a directory that exists in the current system.
 directory_exists(Directory) :-
         must_be(chars, Directory),
         '$directory_exists'(Directory).
 
+%% make_directory(+Directory).
+%
+% Succeeds if it creates a new directory named Directory in the current system.
+% If you want to create a nested directory, use `make_directory_path/1`.
 make_directory(Directory) :-
         must_be(chars, Directory),
         '$make_directory'(Directory).
 
+%% make_directory_path(+Directory).
+%
+% Similar to `make_directory/1` but recursively creates directories if they're missing.
+% Equivalent to mkdir -p in Unix.
 make_directory_path(Directory) :-
         must_be(chars, Directory),
         '$make_directory_path'(Directory).
 
+%% delete_file(+File).
+%
+% Succeeds if deletes File from the current system.
 delete_file(File) :-
         file_must_exist(File, delete_file/1),
         '$delete_file'(File).
 
+%% rename_file(+File, +Renamed).
+%
+% Succeeds if File is renamed to Renamed
 rename_file(File, Renamed) :-
         file_must_exist(File, rename_file/2),
         must_be(chars, Renamed),
         '$rename_file'(File, Renamed).
 
+%% file_copy(+File, +Copied).
+%
+% Succeeds if File is copied to Copied
+file_copy(File, Copied) :-
+	file_must_exist(File, file_copy/2),
+	must_be(chars, Copied),
+	'$file_copy'(File, Copied).
+
+%% delete_directory(+Directory).
+%
+% Succeeds if Directory is deleted from the current system.
+% Directory must be empty.
 delete_directory(Directory) :-
         directory_must_exist(Directory, delete_directory/1),
         must_be(chars, Directory),
@@ -117,31 +178,31 @@ directory_must_exist(Directory, Context) :-
         ;   throw(error(existence_error(directory, Directory), Context))
         ).
 
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+%% working_directory(Dir0, Dir).
-   Dir0 is the current working directory, and the working directory
+%
-   is changed to Dir.
+% Dir0 is the current working directory, and the working directory
-
+% is changed to Dir.
-   Use working_directory(Ds, Ds) to determine the current working directory,
+% 
-   and leave it as is.
+% Use `working_directory/2` to determine the current working directory,
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+% and leave it as is.
 
 working_directory(Dir0, Dir) :-
         can_be(list, Dir0),
         can_be(list, Dir),
         '$working_directory'(Dir0, Dir).
 
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+%% path_canonical(Ps, Cs).
-   True iff Cs is the canonical, absolute path of Ps.
+%
-
+% True iff Cs is the canonical, absolute path of Ps.
-   All intermediate components are normalized, and all symbolic links
+%
-   are resolved.
+% All intermediate components are normalized, and all symbolic links
-
+% are resolved.
-   The predicate fails in the following situations, though not
+%
-   necessarily *only* in these cases:
+% The predicate fails in the following situations, though not
-
+% necessarily *only* in these cases:
-      1. Ps is a path that does not exist.
+%
-      2. A non-final component in Ps is not a directory.
+% 1. Ps is a path that does not exist.
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+% 2. A non-final component in Ps is not a directory.
 
 path_canonical(Ps, Cs) :-
         must_be(chars, Ps),
@@ -155,12 +216,27 @@ path_canonical(Ps, Cs) :-
    For two time stamps A and B, if A precedes B, then A @< B holds.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
+%% file_modification_time(+File, -T).
+%
+% For a file File that must exist, it returns a time stamp  T with the modification time
+%
+% T is a time stamp compatible with `library(time)`. 
 file_modification_time(File, T) :-
         file_time_(File, modification, T).
 
+%% file_access_time(+File, -T).
+%
+% For a file File that must exist, it returns a time stamp  T with the access time
+%
+% T is a time stamp compatible with `library(time)`.
 file_access_time(File, T) :-
         file_time_(File, access, T).
 
+%% file_creation_time(+File, -T).
+%
+% For a file File that must exist, it returns a time stamp  T with the creation time
+%
+% T is a time stamp compatible with `library(time)`.
 file_creation_time(File, T) :-
         file_time_(File, creation, T).
 
@@ -170,29 +246,31 @@ file_time_(File, Which, T) :-
         read_from_chars(T0, T).
 
 
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+%% path_segments(Ps, Segments).
-   path_segments(Ps, Segments): True iff Segments are the segments of Ps.
+%
-
+% True iff Segments are the segments of Ps.
-   Segments is the list of components of the path Ps that are
+%
-   separated by the platform-specific directory separator. Each
+% Segments is the list of components of the path Ps that are
-   segment is a list of characters.
+% separated by the platform-specific directory separator. Each
-
+% segment is a list of characters.
-   At least one of the arguments must be instantiated.
+%
-
+% At least one of the arguments must be instantiated.
-   Examples:
+%
-
+% Examples:
-      ?- path_segments("/hello/there", Segments).
+%
-         Segments = [[],"hello","there"].
+% ```
-
+% ?- path_segments("/hello/there", Segments).
-      ?- path_segments(Path, ["hello","there"]).
+%    Segments = [[],"hello","there"].
-         Path = "hello/there".
+% ?- path_segments(Path, ["hello","there"]).
-
+%    Path = "hello/there".
-
+% ```
-   To obtain the platform-specific directory separator, you can use:
+% 
-
+% To obtain the platform-specific directory separator, you can use:
-      ?- path_segments(Separator, ["",""]).
+%
-         Separator = "/".
+% ```
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+% ?- path_segments(Separator, ["",""]).
+%    Separator = "/".
+% ```
 
 path_segments(Path, Segments) :-
         '$directory_separator'(Sep),

src/lib/format.pl

@@ -1,83 +1,17 @@
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-   Written 2020, 2021, 2022 by Markus Triska (triska@metalevel.at)
+   Written 2020-2024 by Markus Triska (triska@metalevel.at)
    Part of Scryer Prolog.
-
-   This library provides the nonterminal format_//2 to describe
-   formatted strings. format/[2,3] are provided for impure output.
-
-   Usage:
-   ======
-
-   phrase(format_(FormatString, Arguments), Ls)
-
-   format_//2 describes a list of characters Ls that are formatted
-   according to FormatString. FormatString is a string (i.e.,
-   a list of characters) that specifies the layout of Ls.
-   The characters in FormatString are used literally, except
-   for the following tokens with special meaning:
-
-     ~w    use the next available argument from Arguments here
-     ~q    use the next argument here, formatted as by writeq/1
-     ~a    use the next argument here, which must be an atom
-     ~s    use the next argument here, which must be a string
-     ~d    use the next argument here, which must be an integer
-     ~f    use the next argument here, a floating point number
-     ~Nf   where N is an integer: format the float argument
-           using N digits after the decimal point
-     ~Nd   like ~d, placing the last N digits after a decimal point;
-           if N is 0 or omitted, no decimal point is used.
-     ~ND   like ~Nd, separating digits to the left of the decimal point
-           in groups of three, using the character "," (comma)
-     ~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
-     ~N+   where N is an integer: place a tab stop N characters
-           after the previous tab stop (or start of line)
-     ~t    distribute spaces evenly between the two closest tab stops
-     ~`Ct  like ~t, use character C instead of spaces to fill the space
-     ~n    newline
-     ~Nn   N newlines
-     ~i    ignore the next argument
-     ~~    the literal ~
-
-   Instead of ~N, you can write ~* to use the next argument from Arguments
-   as the numeric argument.
-
-   The predicate format/2 is like format_//2, except that it outputs
-   the text on the terminal instead of describing it declaratively.
-
-   format/3, used as format(Stream, FormatString, Arguments), outputs
-   the described string to the given Stream. If Stream is a binary
-   stream, then the code of each emitted character must be in 0..255.
-
-   If at all possible, format_//2 should be used, to stress pure parts
-   that enable easy testing etc. If necessary, you can emit the list Ls
-   with maplist(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
-   also stay that way, to encourage a sensible environment.
-
-   Example:
-
-   ?- phrase(format_("~s~n~`.t~w!~12|", ["hello",there]), Cs).
-   %@    Cs = "hello\n......there!".
-
    I place this code in the public domain. Use it in any way you want.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
+/** This library provides the nonterminal `format_//2` to describe
+    formatted strings. `format/[2,3]` are provided for _impure_ output.
+
+    The entire library only works if the Prolog flag `double_quotes`
+    is set to `chars`, the default value in Scryer Prolog. This should
+    also stay that way, to encourage a sensible environment.
+*/
+
 :- module(format, [format_//2,
                    format/2,
                    format/3,
@@ -94,6 +28,61 @@
 :- use_module(library(between)).
 :- use_module(library(pio)).
 
+%% format_(+FormatString, +Arguments)//
+%
+% Usage:
+%
+% ```
+% phrase(format_(FormatString, Arguments), Ls)
+% ```
+%
+% `format_//2` describes a list of characters Ls that are formatted
+% according to FormatString. FormatString is a string (i.e., a list of
+% characters) that specifies the layout of Ls. The characters in
+% FormatString are used literally, except for the following tokens
+% with special meaning:
+%
+% | `~w`     |  use the next available argument from Arguments here           |
+% | `~q`     |  use the next argument here, formatted as by `writeq/1`        |
+% | `~a`     |  use the next argument here, which must be an atom             |
+% | `~s`     |  use the next argument here, which must be a string            |
+% | `~d`     |  use the next argument here, which must be an integer          |
+% | `~f`     |  use the next argument here, a floating point number           |
+% | `~Nf`    |  where N is an integer: format the float argument              |
+% |          |  using N digits after the decimal point                        |
+% | `~Nd`    |  like ~d, placing the last N digits after a decimal point;     |
+% |          |  if N is 0 or omitted, no decimal point is used.               |
+% | `~ND`    |  like ~Nd, separating digits to the left of the decimal point  |
+% |          |  in groups of three, using the character "," (comma)           |
+% | `~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      |
+% | `~N+`    |  where N is an integer: place a tab stop N characters          |
+% |          |  after the previous tab stop (or start of line)                |
+% | `~t`     |  distribute spaces evenly between the two closest tab stops    |
+% | ``~`Ct`` |  like ~t, use character C instead of spaces to fill the space  |
+% | `~n`     |  newline                                                       |
+% | `~Nn`    |  N newlines                                                    |
+% | `~i`     |  ignore the next argument                                      |
+% | `~~`     |  the literal ~                                                 |
+%
+% Instead of `~N`, you can write `~*` to use the next argument from
+% Arguments as the numeric argument.
+%
+% Example:
+%
+% ```
+% ?- phrase(format_("~s~n~`.t~w!~12|", ["hello",there]), Cs).
+%    Cs = "hello\n......there!".
+% ```
+
 format_(Fs, Args) -->
         { must_be(list, Fs),
           must_be(list, Args),
@@ -313,14 +302,14 @@ format_number_chars(N0, Chars) :-
         N is N0, % evaluate compound expression
         number_chars(N, Chars).
 
-n_newlines(0) --> !.
 n_newlines(N0) --> { N0 > 0, N is N0 - 1 }, [newline], n_newlines(N).
+n_newlines(0)  --> [].
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-?- phrase(upto_what(Cs, ~), "abc~test", Rest).
+?- phrase(format:upto_what(Cs, ~), "abc~test", Rest).
-Cs = [a,b,c], Rest = [~,t,e,s,t].
+   Cs = "abc", Rest = "~test".
-?- phrase(upto_what(Cs, ~), "abc", Rest).
+?- phrase(format:upto_what(Cs, ~), "abc", Rest).
-Cs = [a,b,c], Rest = [].
+   Cs = "abc", Rest = [].
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 separate_digits_fractional(Arg, Sep, Num, Cs) :-
@@ -414,10 +403,32 @@ digits(uppercase, "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ").
    Impure I/O, implemented as a small wrapper over format_//2.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
+%% format(+Fs, +Args)
+%
+%  The predicate `format/2` is like `format_//2`, except that it
+%  outputs the text on the terminal instead of describing it
+%  declaratively as a list of characters.
+%
+%  If at all possible, `format_//2` should be used, to stress pure
+%  parts that enable easy testing etc. If necessary, you can emit the
+%  described list of characters `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.
+
 format(Fs, Args) :-
         current_output(Stream),
         format(Stream, Fs, Args).
 
+%% format(Stream, FormatString, Arguments)
+%
+%  Output the described string to the given Stream. If Stream is a
+%  binary stream, then the code of each emitted character must be in
+%  0..255.
+
 format(Stream, Fs, Args) :-
         phrase_to_stream(format_(Fs, Args), Stream),
         flush_output(Stream).
@@ -433,9 +444,9 @@ format(Stream, Fs, Args) :-
 ?- 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 ...")])]
+   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)])]
+   Cs = [cell(0,4,[glue(' ',_A),chars("a"),glue(' ',_B)])].
 
 ?- phrase(format:format_cell(cell(0,1,[glue(a,_94)])), Ls).
 
@@ -486,11 +497,14 @@ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
 
    In the eventual library organization, portray_clause/1 and
    related predicates may be placed in their own dedicated library.
-
-   portray_clause/1 is useful for printing solutions in such a way
-   that they can be read back with read/1.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
+
+%% portray_clause(+Term)
+%
+%  `portray_clause/1` is useful for printing solutions in such a way
+%  that they can be read back with `read/1`.
+
 portray_clause(Term) :-
         current_output(Out),
         portray_clause(Out, Term).
@@ -512,7 +526,7 @@ var_name(V, Name=V, Num0, Num) :-
         Num is Num0 + 1.
 
 literal(Lit, VNs) -->
-        { write_term_to_chars(Lit, [quoted(true),variable_names(VNs)], Ls) },
+        { write_term_to_chars(Lit, [quoted(true),variable_names(VNs),double_quotes(true)], Ls) },
         seq(Ls).
 
 portray_(Var, VNs) --> { var(Var) }, !, literal(Var, VNs).

src/lib/freeze.pl

@@ -1,5 +1,8 @@
 :- module(freeze, [freeze/2]).
 
+/** Provides the constraint `freeze/2`.
+*/
+
 :- use_module(library(atts)).
 :- use_module(library(dcgs)).
 
@@ -19,6 +22,15 @@ verify_attributes(Var, Other, Goals) :-
         ).
 verify_attributes(_, _, []).
 
+%% freeze(Var, Goal)
+%
+%  Schedules Goal to be executed when Var is instantiated. This can
+%  be useful to observe the exact moment a variable becomes bound to a
+%  more concrete term, for example when creating animations of search
+%  processes. Higher-level constructs such as `phrase_from_file/2` can
+%  also be implemented with `freeze/2`, by scheduling a goal that
+%  reads additional data from a file as soon as it is needed.
+
 freeze(X, Goal) :-
     put_atts(Fresh, frozen(Goal)),
     Fresh = X.
@@ -26,5 +38,5 @@ freeze(X, Goal) :-
 attribute_goals(Var) -->
     { get_atts(Var, frozen(Goals)),
       put_atts(Var, -frozen(_)) },
-    [freeze(Var, Goals)].
+    [freeze:freeze(Var, Goals)].
 

src/lib/gensym.pl

@@ -19,14 +19,14 @@ gensym(Base, Unique) :-
     must_be(var, Unique),
     atom_si(Base),
     gensym_key(Base, BaseKey),
-    (  bb_get(BaseKey, UniqueID0) ->
+    (  bb_get(BaseKey, UniqueID0) -> true
-       UniqueID is UniqueID0 + 1,
+    ;  UniqueID0 = 0
-       bb_put(BaseKey, UniqueID),
+    ),
-       append_id(Base, UniqueID, Unique)
+    UniqueID is UniqueID0 + 1,
-    ;  bb_put(BaseKey, 1),
+    append_id(Base, UniqueID, Unique),
-       append_id(Base, 1, Unique)
+    bb_put(BaseKey, UniqueID).
-    ).
 
 reset_gensym(Base) :-
     atom_si(Base),
-    bb_put(Base, 0).
+    gensym_key(Base, BaseKey),
+    bb_put(BaseKey, 0).

src/lib/http/http_open.pl

@@ -1,34 +1,39 @@
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Written 2022 by Adrián Arroyo Calle (adrian.arroyocalle@gmail.com)
    Part of Scryer Prolog.
+*/
 
-   http_open(+Address, -Stream, +Options)
+/** Make HTTP requests.
-   ======================================
 
-   Yields Stream to read the body of an HTTP reply from Address.
+This library contains the predicate `http_open/3` which allows you to perform HTTP(S) calls.
-   Address is a list of characters, and includes the method. Both HTTP
+Useful for making API calls, or parsing websites. It uses Hyper underneath.
-   and HTTPS are supported.
+*/
-
-   Options supported:
-
-     * 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'(0x7fcfc9e00f00).
-
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 :- module(http_open, [http_open/3]).
 
 :- use_module(library(lists)).
 
+%% http_open(+Address, -Stream, +Options).
+%
+% 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.
+%
+% Options supported:
+%
+%   * `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://www.example.com", S, []), get_n_chars(S, N, HTML).
+%    S = '$stream'(0x7fb548001be8), N = 1256, HTML = "<!doctype html>\n<ht ...".
+% ```
 http_open(Address, Response, Options) :-
     parse_http_options(Options, OptionValues),
     ( member(method(Method), OptionValues) -> true; Method = get),
@@ -65,4 +70,4 @@ parse_http_options_(request_headers(Headers), request_headers(Headers)) :-
 
 parse_http_options_(size(Size), size(Size)).
 parse_http_options_(status_code(Code), status_code(Code)).
-parse_http_options_(headers(Headers), headers(Headers)).
+parse_http_options_(headers(Headers), headers(Headers)).

src/lib/http/http_server.pl

@@ -1,63 +1,71 @@
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    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
+   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.
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+*/
+
+/** This library provides an starting point to build HTTP server based applications.
+It is based on [Warp](https://github.com/seanmonstar/warp), which allows for HTTP/1.0, HTTP/1.1 and HTTP/2. However,
+some advanced features that Warp 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
+   - Session handling via cookies
+   - HTML Templating (but you can use [Teruel](https://github.com/aarroyoc/teruel/), [Marquete](https://github.com/aarroyoc/marquete/) or [Djota](https://github.com/aarroyoc/djota) for that)
+*/
 
 
 :- module(http_server, [
 	      http_listen/2,
+	      http_listen/3,
 	      http_headers/2,
 	      http_status_code/2,
 	      http_body/2,
 	      http_redirect/2,
-	      http_query/3
+	      http_query/3,
+	      http_basic_auth/4
 ]).
 
 :- meta_predicate http_listen(?, :).
+:- meta_predicate http_listen(?, :, ?).
+
+:- meta_predicate http_basic_auth(:, :, ?, ?).
 
 :- use_module(library(charsio)).
 :- use_module(library(crypto)).
@@ -68,22 +76,60 @@
 :- use_module(library(pio)).
 :- use_module(library(time)).
 
+%% http_listen(+Port, +Handlers).
+%
+% Equivalent to `http_listen(Port, Handlers, [])`.
 http_listen(Port, Module:Handlers0) :-
     must_be(integer, Port),
     must_be(list, Handlers0),
     maplist(module_qualification(Module), Handlers0, Handlers),
-    http_listen_(Port, Handlers).
+    http_listen_(Port, Handlers, []).
+
+%% http_listen(+Port, +Handlers, +Options).
+%
+% Listens for HTTP connections on port Port. Each handler on the list Handlers should be of the form: `HttpVerb(PathUnification, Predicate)`.
+% For example: `get(user/User, get_info(User))` will match an HTTP request that is a GET, the path unifies with /user/User (where User is a variable)
+% and it will call `get_info` with three arguments: an `http_request` term, an `http_response` term and User.
+%
+% The following options are supported:
+%
+% - `tls_key(+Key)` - a TLS key for HTTPS (string)
+% - `tls_cert(+Cert)` - a TLS cert for HTTPS (string)
+% - `content_length_limit(+Limit)` - maximum length (in bytes) for the incoming bodies. By default, 32KB.
+%
+% In order to have a HTTPS server (instead of plain HTTP), both `tls_key` and `tls_cert` options must be provided.
+http_listen(Port, Module:Handlers0, Options) :-
+    must_be(integer, Port),
+    must_be(list, Handlers0),
+    must_be(list, Options),
+    maplist(module_qualification(Module), Handlers0, Handlers),
+    http_listen_(Port, Handlers, Options).
 
 module_qualification(M, H0, H) :-
     H0 =.. [Method, Path, Goal],
     H =.. [Method, Path, M:Goal].
 
-http_listen_(Port, Handlers) :-
+http_listen_(Port, Handlers, Options) :-
+    parse_options(Options, TLSKey, TLSCert, ContentLengthLimit),
     phrase(format_("0.0.0.0:~d", [Port]), Addr),
-    '$http_listen'(Addr, HttpListener),!,
+    '$http_listen'(Addr, HttpListener, TLSKey, TLSCert, ContentLengthLimit),!,
     format("Listening at ~s\n", [Addr]),
     http_loop(HttpListener, Handlers).
 
+parse_options(Options, TLSKey, TLSCert, ContentLengthLimit) :-
+    member_option_default(tls_key, Options, "", TLSKey),
+    member_option_default(tls_cert, Options, "", TLSCert),
+    member_option_default(content_length_limit, Options, 32768, ContentLengthLimit),
+    must_be(integer, ContentLengthLimit).
+
+member_option_default(Key, List, _Default, Value) :-
+    X =.. [Key, Value],
+    member(X, List).
+member_option_default(Key, List, Default, Default) :-
+    X =.. [Key, _],
+    \+ member(X, List).
+	
+
 http_loop(HttpListener, Handlers) :-
     '$http_accept'(HttpListener, RequestMethod, RequestPath, RequestHeaders, RequestQuery, RequestStream, ResponseHandle),
     current_time(Time),
@@ -105,44 +151,51 @@ http_loop(HttpListener, Handlers) :-
 	)
     ; (
 	'$http_answer'(ResponseHandle, 404, [], ResponseStream),
-	call_cleanup(format(ResponseStream, "Not Found"), close(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),
+    '$http_answer'(ResponseHandle, StatusCode, ResponseHeaders, ResponseStream0),
-    call_cleanup(
+    open(stream(ResponseStream0), write, ResponseStream, [type(text)]),
-	format(ResponseStream, "~s", [ResponseText]),
+    catch(
-	close(ResponseStream)
+	call_cleanup(format(ResponseStream, "~s", [ResponseText]),close(ResponseStream)),
+	error(existence_error(stream, _), _),
+	true
     ).
 
 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(
+    catch(
-	format(ResponseStream, "~s", [ResponseBytes]),
+        call_cleanup(format(ResponseStream, "~s", [ResponseBytes]),close(ResponseStream)),
-	close(ResponseStream)
+	error(existence_error(stream, _), _),
+	true
     ).
 
 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(
+    catch(
-	setup_call_cleanup(
+	call_cleanup(
-	    open(Filename, read, FileStream, [type(binary)]),
+	    setup_call_cleanup(
-	    (
+		open(Filename, read, FileStream, [type(binary)]),
-		get_n_chars(FileStream, _, FileCs),
+		(
-		format(ResponseStream, "~s", [FileCs])
+		    get_n_chars(FileStream, _, FileCs),
+		    format(ResponseStream, "~s", [FileCs])
+		),
+		close(FileStream)
 	    ),
-	    close(FileStream)
+	    close(ResponseStream)
 	),
-        close(ResponseStream)
+	error(existence_error(stream, _), _),
+	true
     ).
-    
+
 
 default(Var, Default, Out) :-
     (var(Var) -> Out = Default
@@ -206,9 +259,21 @@ string_without(Not, [Char|String]) -->
 string_without(_, []) -->
     [].
 
+%% http_headers(?Request_Response, ?Headers).
+%
+% True iff `Request_Response` is a request or response with headers Headers. Can be used both to get headers (usually in from a request)
+% and to add headers (usually in a response).
 http_headers(http_request(Headers, _, _), Headers).
 http_headers(http_response(_, _, Headers), Headers).
 
+%% http_body(?Request_Response, ?Body).
+%
+% True iff Body is the body of the request or response. A body can be of the following types:
+%
+%  * `bytes(Bytes)` for both requests and responses, interprets the body as bytes
+%  * `text(Bytes)` for both requests and responses, interprets the body as text
+%  * `form(Form)` only for requests, interprets the body as an `application/x-www-form-urlencoded` form.
+%  * `file(File)` only for responses, interprets the body as the content of a file (useful to send static files).
 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)) :- 
@@ -218,31 +283,38 @@ http_body(http_request(Headers, stream(StreamBody), _), form(FormBody)) :-
 http_body(http_request(_, Body, _), Body).
 http_body(http_response(_, Body, _), Body).
 
+%% http_status_code(?Response, ?StatusCode).
+%
+% True iff the status code of the response Response unifies with StatusCode.
 http_status_code(http_response(StatusCode, _, _), StatusCode).
+
+%% http_redirect(-Response, +Uri).
+%
+% True iff Response is a response that redirects the user to the uri Uri.
 http_redirect(http_response(307, text("Moved Temporarily"), ["Location"-Uri]), Uri).
+
+%% http_query(+Request, ?Key, ?Value).
+%
+% True iff there's a query in request Request with key Key and value Value.
 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(Queries),
+    {
+	phrase(url_decode(Key), Key0),
+	phrase(url_decode(Value), Value0)
+    }.
 
 parse_queries([Key-Value]) -->
     string_without("=", Key0),
-    {
-        phrase(url_decode(Key), Key0)
-    },
     "=",
     string_without(" ", Value0),
     {
+	phrase(url_decode(Key), Key0),
         phrase(url_decode(Value), Value0)  
     }.
 
@@ -253,9 +325,13 @@ parse_queries([]) -->
 url_decode([Char|Chars]) -->
     [Char],
     {
-        Char \= '%'
+        Char \= '%',
+	Char \= (+)
     },
     url_decode(Chars).
+url_decode([' '|Chars]) -->
+    "+",
+    url_decode(Chars).
 url_decode([Char|Chars]) -->
     "%",
     [A],
@@ -313,3 +389,49 @@ url_decode([Char|Chars]) -->
     url_decode(Chars).
 
 url_decode([]) --> [].
+
+%% http_basic_auth(+LoginPredicate, +Handler, +Request, -Response)
+%
+% Metapredicate that wraps an existing Handler with an HTTP Basic Auth flow.
+% Checks if a given user + password is authorized to execute that handler, returning 401
+% if it's not satisfied.
+% 
+% `LoginPredicate` must be a predicate of arity 2 that takes a User and a Password.
+% `Handler` will have, in addition to the Request and Response arguments, a User argument
+% containing the User given in the authentication.
+%
+% Example:
+%
+% ```
+% main :-
+%    http_listen(8800,[get('/', http_basic_auth(login, inside_handler("data")))]).
+%
+% login(User, Pass) :-
+%    User = "aarroyoc",
+%    Pass = "123456".
+%
+% inside_handler(Data, User, Request, Response) :-
+%    http_body(Response, text(User)).
+% ```
+http_basic_auth(LoginPredicate, Handler, Request, Response) :-
+    http_headers(Request, Headers),
+    member("authorization"-AuthorizationStr, Headers),
+    append("Basic ", Coded, AuthorizationStr),
+    chars_base64(UserPass, Coded, []),
+    append(User, [':'|Password], UserPass),
+    (
+	call(LoginPredicate, User, Password) ->
+	call(Handler, User, Request, Response)
+    ;   http_basic_auth_unauthorized_response(Response)
+    ).
+
+http_basic_auth(_LoginPredicate, _Handler, Request, Response) :-
+    http_headers(Request, Headers),
+    \+ member("authorization"-_, Headers),
+    http_basic_auth_unauthorized_response(Response).
+
+http_basic_auth_unauthorized_response(Response) :-
+    http_status_code(Response, 401),
+    http_headers(Response, ["www-authenticate"-"Basic realm=\"Scryer Prolog\", charset=\"UTF-8\""]),
+    http_body(Response, text("Unauthorized")).
+	

src/lib/iso_ext.pl

@@ -1,17 +1,25 @@
+/** Useful general predicates that are not ISO standard yet
+
+Predicates available here are similar to the ones defined in builtin.pl,
+but they're not part of the ISO Prolog standard at the moment.
+*/
+
 :- module(iso_ext, [bb_b_put/2,
                     bb_get/2,
                     bb_put/2,
                     call_cleanup/2,
                     call_with_inference_limit/3,
+                    call_residue_vars/2,
                     forall/2,
                     partial_string/1,
                     partial_string/3,
                     partial_string_tail/2,
                     setup_call_cleanup/3,
+                    succ/2,
                     call_nth/2,
+                    countall/2,
                     copy_term_nat/2,
-		    asserta/2,
+		    copy_term/3]).
-		    assertz/2]).
 
 :- use_module(library(error), [can_be/2,
                                domain_error/3,
@@ -20,27 +28,86 @@
 
 :- use_module(library(lists), [maplist/3]).
 
+:- use_module(library('$project_atts')).
+
 :- meta_predicate(forall(0, 0)).
 
+%% forall(Generate, Test).
+%
+% For all bindings possible by Generate, Test must be true.
+%
+% In this example, it checks that all numbers are even:
+%
+% ```
+% ?- Ns = [2,4,6], forall(member(N, Ns), 0 is N mod 2).
+%    Ns = [2,4,6].
+% ```
 forall(Generate, Test) :-
     \+ (Generate, \+ Test).
 
-%% (non-)backtrackable global variables.
+% (non-)backtrackable global variables.
 
+%% bb_put(+Key, +Value).
+%
+% Sets a global variable named Key (must be an atom) with value Value.
+% The global variable isn't backtrackable. Check `bb_b_put/2` for the
+% backtrackable version.
+%
+% ```
+% ?- bb_put(city, "Valladolid").
+%    true.
+% ?- bb_get(city, X).
+%    X = "Valladolid".
+% ```
+%
+% In this example one can understand the difference between `bb_put/2` and
+% `bb_b_put/2`:
+%
+% ```
+% ?- bb_put(city, "Valladolid"), (bb_put(city, "Salamanca"), false);(bb_get(city, X)).
+%    X = "Salamanca".
+% ?- bb_put(city, "Valladolid"), (bb_b_put(city, "Salamanca"), false);(bb_get(city, X)).
+%    X = "Valladolid".
+% ```
 bb_put(Key, Value) :-
     (  atom(Key) ->
        '$store_global_var'(Key, Value)
     ;  type_error(atom, Key, bb_put/2)
     ).
 
-%% backtrackable global variables.
+% backtrackable global variables.
 
+%% bb_b_put(+Key, +Value).
+%
+% Sets a global variable named Key (must be an atom) with value Value.
+% The global variable is backtrackable. Check `bb_put/2` for the
+% non-backtrackable version.
+%
+% ```
+% ?- bb_b_put(city, "Valladolid").
+%    true.
+% ?- bb_get(city, X).
+%    X = "Valladolid".
+% ```
+%
+% In this example one can understand the difference between `bb_put/2` and
+% `bb_b_put/2`:
+%
+% ```
+% ?- bb_put(city, "Valladolid"), (bb_put(city, "Salamanca"), false);(bb_get(city, X)).
+%    X = "Salamanca".
+% ?- bb_put(city, "Valladolid"), (bb_b_put(city, "Salamanca"), false);(bb_get(city, X)).
+%    X = "Valladolid".
+% ```
 bb_b_put(Key, Value) :-
     (  atom(Key) ->
        '$store_backtrackable_global_var'(Key, Value)
     ;  type_error(atom, Key, bb_b_put/2)
     ).
 
+%% bb_get(+Key, -Value).
+%
+% Gets the value Value of a global variable named Key (must be an atom)
 bb_get(Key, Value) :-
     (  atom(Key) ->
        '$fetch_global_var'(Key, Value)
@@ -48,21 +115,51 @@ bb_get(Key, Value) :-
     ).
 
 
+%% succ(?I, ?S).
+%
+% True iff S is the successor of the non-negative integer I.
+% At least one of the arguments must be instantiated.
+
+succ(I, S) :-
+    can_be(not_less_than_zero, I),
+    can_be(not_less_than_zero, S),
+    (   integer(S) ->
+        S > 0,
+        I is S-1
+    ;   integer(I) ->
+        S is I+1
+    ;   instantiation_error(succ/2)
+    ).
+
+
 % setup_call_cleanup.
 
 :- meta_predicate(call_cleanup(0, 0)).
 
+%% call_cleanup(Goal, Cleanup).
+%
+% Executes Goal and then, either on success or failure, executes Cleanup.
+% The success or failure of Cleanup is ignored and choice points created inside are destroyed.
 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(Setup, Goal, Cleanup).
+%
+% If Setup succeeds, Cleanup will be called after the execution of Goal. Goal itself can succeed or not.
+%
+% In this example, we use the predicate to always close an open file:
+%
+% ```
+% ?- setup_call_cleanup(open(File, read, Stream), do_something_with_stream(Stream), close(Stream)).
+% ```
 setup_call_cleanup(S, G, C) :-
     '$get_b_value'(B),
     '$call_with_inference_counting'(call(S)),
     '$set_cp_by_default'(B),
-    '$get_current_block'(Bb),
+    '$get_current_scc_block'(Bb),
     (  C = _:CC,
        var(CC) ->
        instantiation_error(setup_call_cleanup/3)
@@ -75,17 +172,16 @@ setup_call_cleanup(S, G, C) :-
 
 scc_helper(C, G, Bb) :-
     '$get_cp'(Cp),
-    '$install_scc_cleaner'(C, NBb),
+    '$install_scc_cleaner'(C),
     '$call_with_inference_counting'(call(G)),
     (  '$check_cp'(Cp) ->
-       '$reset_block'(Bb),
+       '$reset_scc_block'(Bb),
        run_cleaners_without_handling(Cp)
     ;  true
-    ;  '$reset_block'(NBb),
+    ;  '$fail'
-       '$fail'
     ).
 scc_helper(_, _, Bb) :-
-    '$reset_block'(Bb),
+    '$reset_scc_block'(Bb),
     '$push_ball_stack',
     run_cleaners_with_handling,
     '$pop_from_ball_stack',
@@ -99,7 +195,7 @@ scc_helper(_, _, _) :-
 
 run_cleaners_with_handling :-
     '$get_scc_cleaner'(C),
-    '$get_level'(B),
+    '$get_cp'(B),
     catch(C, _, true),
     '$set_cp_by_default'(B),
     run_cleaners_with_handling.
@@ -110,7 +206,7 @@ run_cleaners_with_handling :-
 
 run_cleaners_without_handling(Cp) :-
     '$get_scc_cleaner'(C),
-    '$get_level'(B),
+    '$get_cp'(B),
     call(C),
     '$set_cp_by_default'(B),
     run_cleaners_without_handling(Cp).
@@ -120,30 +216,13 @@ run_cleaners_without_handling(Cp) :-
 
 % call_with_inference_limit
 
-:- non_counted_backtracking end_block/4.
-
-end_block(_, Bb, NBb, _L) :-
-    '$clean_up_block'(NBb),
-    '$reset_block'(Bb).
-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) :-
-    !,
-    '$pop_ball_stack'.
-handle_ile(B, _, _) :-
-    '$remove_call_policy_check'(B),
-    '$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(Goal, Limit, Result).
+%
+% Similar to `call(Goal)` but it limits the number of inferences for each solution of Goal.
 call_with_inference_limit(G, L, R) :-
     (  integer(L) ->
        (  L < 0 ->
@@ -159,8 +238,6 @@ call_with_inference_limit(G, L, R) :-
     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,?,?,?,?)).
 
@@ -168,24 +245,39 @@ install_inference_counter(B, L, Count0) :-
 
 call_with_inference_limit(G, L, R, Bb, B) :-
     '$install_new_block'(NBb),
-    '$install_inference_counter'(B, L, Count0),
+    '$install_inference_counter'(NBb, L, Count0),
     '$call_with_inference_counting'(call(G)),
     '$inference_level'(R, B),
-    '$remove_inference_counter'(B, Count1),
+    '$remove_inference_counter'(NBb, Count1),
     Diff is L - (Count1 - Count0),
-    end_block(B, Bb, NBb, Diff).
+    (  '$clean_up_block'(NBb),
-call_with_inference_limit(_, _, R, Bb, B) :-
+       '$reset_block'(Bb)
-    '$reset_block'(Bb),
+    ;  '$install_inference_counter'(NBb, Diff, _),
-    '$remove_inference_counter'(B, _),
+       '$reset_block'(NBb),
-    (  '$get_ball'(Ball),
-       '$push_ball_stack',
-       '$get_level'(Cp),
-       '$set_cp_by_default'(Cp)
-    ;  '$remove_call_policy_check'(B),
        '$fail'
+    ).
+call_with_inference_limit(_, _, R, Bb, B) :-
+    (  '$inference_limit_exceeded' ->
+       R = inference_limit_exceeded
+    ;  true
     ),
-    handle_ile(B, Ball, R).
+    '$get_current_block'(NBb),
+    '$remove_inference_counter'(NBb, _),
+    '$reset_block'(Bb),
+    '$remove_call_policy_check'(B),
+    (  '$get_ball'(_),
+       '$push_ball_stack',
+       '$get_cp'(Cp),
+       '$set_cp_by_default'(Cp),
+       '$pop_from_ball_stack',
+       '$unwind_stack'
+    ;  nonvar(R)
+    ).
 
+%% partial_string(String, L, L0)
+%
+% Explicitly construct a partial string "manually". It can be used as an optimized append/3.
+% It's not recommended to use this predicate in application code.
 partial_string(String, L, L0) :-
     (  String == [] ->
        L = L0
@@ -195,9 +287,17 @@ partial_string(String, L, L0) :-
        '$create_partial_string'(Atom, L, L0)
     ).
 
+%% partial_string(+String)
+%
+% Succeeds if String is a _partial string_. A partial string is a string composed of several smaller
+% strings, even just one. That means all strings in Scryer are partial strings.
 partial_string(String) :-
     '$is_partial_string'(String).
 
+%% partial_string_tail(+String, -Tail).
+%
+% Unifies Tail with the last section of the partial string.
+% It's not recommended to use this predicate in application code.
 partial_string_tail(String, Tail) :-
     (  partial_string(String) ->
        '$partial_string_tail'(String, Tail)
@@ -209,6 +309,9 @@ partial_string_tail(String, Tail) :-
 
 :- meta_predicate(call_nth(0, ?)).
 
+%% call_nth(Goal, N).
+%
+% Succeeds when Goal succeeded for the Nth time (there are at least N solutions)
 call_nth(Goal, N) :-
     can_be(integer, N),
     (   integer(N) ->
@@ -246,20 +349,60 @@ call_nth_nesting(C, ID) :-
     bb_put(ID, 0),
     bb_put(i_call_nth_counter, C).
 
+%% countall(G_0, N).
+%
+% countall(G_0, N) is true iff N unifies with the total number of
+% answers of call(G_0).
 
+:- meta_predicate(countall(0, ?)).
+
+countall(Goal, N) :-
+    can_be(integer, N),
+    (   integer(N) ->
+        (   N < 0 ->
+            domain_error(not_less_than_zero, N, countall/2)
+        ;   true
+        )
+    ;   true
+    ),
+    setup_call_cleanup(call_nth_nesting(C, ID),
+                       (   (   Goal,
+                               bb_get(ID, N0),
+                               N1 is N0 + 1,
+                               bb_put(ID, N1),
+                               false
+                           ;   bb_get(ID, N)
+                           )
+                       ),
+                       (   bb_get(i_call_nth_counter, C) ->
+                           C1 is C - 1,
+                           bb_put(i_call_nth_counter, C1)
+                       ;   true
+                       )).
+
+%% copy_term_nat(Source, Dest)
+%
+% Similar to `copy_term/2` but without attribute variables
 copy_term_nat(Source, Dest) :-
     '$copy_term_without_attr_vars'(Source, Dest).
 
+%% copy_term(+Term, -Copy, -Gs).
+%
+% Produce a deep copy of Term and unify it to Copy, without attributes.
+% Unify Gs with a list of goals that represent the attributes of Term.
+% Similar to `copy_term/2` but splitting the attributes.
+copy_term(Term, Copy, Gs) :-
+   can_be(list, Gs),
+   findall(Term-Rs, '$project_atts':term_residual_goals(Term,Rs), [Copy-Gs]),
+   (  var(Gs) ->
+      Gs = []
+   ;  true
+   ).
 
-asserta(Module, (Head :- Body)) :-
+:- meta_predicate call_residue_vars(0, ?).
-    !,
-    '$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).
 
+call_residue_vars(Goal, Vars) :-
+    can_be(list, Vars),
+    '$get_attr_var_queue_delim'(B),
+    call(Goal),
+    '$get_attr_var_queue_beyond'(B, Vars).

src/lib/lambda.pl

@@ -50,11 +50,13 @@ 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.
+The second is a shorthand for `t+\X1^X2^..^XN^Goal`.
 
 Xi are the parameters.
 
@@ -70,20 +72,20 @@ 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.
 
@@ -92,11 +94,12 @@ continuation expecting a further argument.
 
 ?- 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).
+the fact `f(x,y)`.
-==
+
+```
 ?- call(f,A1,A2).
 ?- call(\X^f(X),A1,A2).
 ?- call(\X^Y^f(X,Y), A1,A2).
@@ -105,10 +108,10 @@ the fact f(x,y).
 ?- call(f(A1),A2).
 ?- f(A1,A2).
    A1 = x, A2 = y.
-==
+```
 
 Further discussions
-http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/ISO-Hiord
+[http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/ISO-Hiord](http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/ISO-Hiord)
 
 @tbd Static expansion similar to apply_macros.
 @author Ulrich Neumerkel

src/lib/lists.pl

@@ -1,3 +1,7 @@
+/**
+List manipulation predicates
+*/
+
 :- 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,
@@ -57,6 +61,20 @@
 resource_error(Resource, Context) :-
    throw(error(resource_error(Resource), Context)).
 
+%% length(?Xs, ?N).
+%
+% Relates a list to its length (number of elements). It can be used to count the elements of a current list or
+% to create a list full of free variables with N length.
+%
+% ```
+% ?- length("abc", 3).
+%    true.
+% ?- length("abc", N).
+%    N = 3.
+% ?- length(Xs, 3).
+%    Xs = [_A,_B,_C].
+% ```
+
 length(Xs0, N) :-
    '$skip_max_list'(M, N, Xs0,Xs),
    !,
@@ -74,7 +92,7 @@ length(_, N) :-
 
 length_rundown(Xs, 0) :- !, Xs = [].
 length_rundown(Vs, N) :-
-    \+ \+ '$project_atts':copy_term(Vs,Vs,[]), % unconstrained
+    '$unattributed_var'(Vs), % unconstrained
     !,
     '$det_length_rundown'(Vs, N).
 length_rundown([_|Xs], N) :- % force unification
@@ -82,7 +100,7 @@ length_rundown([_|Xs], N) :- % force unification
     length(Xs, N1). % maybe some new info on Xs
 
 failingvarskip(Xs) :-
-    \+ \+ '$project_atts':copy_term(Xs,Xs,[]), % unconstrained
+    '$unattributed_var'(Xs), % unconstrained
     !.
 failingvarskip([_|Xs0]) :- % force unification
     '$skip_max_list'(_, _, Xs0,Xs),
@@ -95,28 +113,71 @@ length_addendum([_|Xs], N, M) :-
     M1 is M + 1,
     length_addendum(Xs, N, M1).
 
+%% member(?X, ?Xs).
+%
+% Succeeds when X unifies with an item of the list Xs, which can be at any position.
+%
+% ```
+% ?- member(X, "hello world").
+%    X = h
+% ;  ... .
+% ```
 
-member(X, [X|_]).
+member(X, [L|Ls]) :-
-member(X, [_|Xs]) :- member(X, Xs).
+        member_(Ls, L, X).
 
+member_(_, X, X).
+member_([L|Ls], _, X) :-
+        member_(Ls, L, X).
 
+%% select(X, Xs0, Xs1).
+%
+% Succeeds when the list Xs1 is the list Xs0 without the item X
+%
+% ```
+% ?- select(c, "abcd", X).
+%    X = "abd"
+% ;  false.
+% ```
 select(X, [X|Xs], Xs).
 select(X, [Y|Xs], [Y|Ys]) :- select(X, Xs, Ys).
 
-
+%% append(+XsXs, ?Xs).
+%
+% Concatenates a list of lists
+%
+% ```
+% ?- append([[1, 2], [3]], Xs).
+%    Xs = [1,2,3].
+% ```
 append([], []).
 append([L0|Ls0], Ls) :-
     append(L0, Rest, Ls),
     append(Ls0, Rest).
 
-
+%% append(Xs0, Xs1, Xs).
+%
+% List Xs is the concatenation of Xs0 and Xs1
+%
+% ```
+% ?- append([1,2,3], [4,5,6], Xs).
+%    Xs = [1,2,3,4,5,6].
+% ```
 append([], R, R).
 append([X|L], R, [X|S]) :- append(L, R, S).
 
-
+%% memberchk(?X, +Xs).
+%
+% This predicate is similar to `member/2`, but it only provides a single answer
 memberchk(X, Xs) :- member(X, Xs), !.
 
-
+%% reverse(?Xs, ?Ys).
+%
+% Xs is the Ys list in reverse order
+%
+%     ?- reverse([1,2,3], [3,2,1]).
+%        true.
+%
 reverse(Xs, Ys) :-
     (  nonvar(Xs) -> reverse(Xs, Ys, [], Xs)
     ;  reverse(Ys, Xs, [], Ys)
@@ -126,81 +187,141 @@ reverse([], [], YsRev, YsRev).
 reverse([_|Xs], [Y1|Ys], YsPreludeRev, Xss) :-
     reverse(Xs, Ys, [Y1|YsPreludeRev], Xss).
 
+%% maplist(+Predicate, ?Xs0).
+%
+% This is a metapredicate that applies predicate to each element of the list Xs0
+%
+% ```
+% ?- maplist(write, [1,2,3]).
+% 123   true.
+% ```
 maplist(_, []).
 maplist(Cont1, [E1|E1s]) :-
     call(Cont1, E1),
     maplist(Cont1, E1s).
 
+%% maplist(+Predicate, ?Xs0, ?Xs1).
+%
+% This is a metapredicate that applies predicate to each element of the lists Xs0 and Xs1.
+%
+% ```
+% ?- maplist(length, ["hello", "prolog", "marseille"], Xs1).
+%    Xs1 = [5,6,9].
+% ```
 maplist(_, [], []).
 maplist(Cont2, [E1|E1s], [E2|E2s]) :-
     call(Cont2, E1, E2),
     maplist(Cont2, E1s, E2s).
 
+%% maplist(+Predicate, ?Xs0, ?Xs1, ?Xs2).
+%
+% This is a metapredicate that applies predicate to each element of the lists Xs0, Xs1 and Xs2.
 maplist(_, [], [], []).
 maplist(Cont3, [E1|E1s], [E2|E2s], [E3|E3s]) :-
     call(Cont3, E1, E2, E3),
     maplist(Cont3, E1s, E2s, E3s).
 
+%% maplist(+Predicate, ?Xs0, ?Xs1, ?Xs2, ?Xs3).
+%
+% This is a metapredicate that applies predicate to each element of the lists Xs0, Xs1, Xs2 and Xs3.
 maplist(_, [], [], [], []).
 maplist(Cont, [E1|E1s], [E2|E2s], [E3|E3s], [E4|E4s]) :-
     call(Cont, E1, E2, E3, E4),
     maplist(Cont, E1s, E2s, E3s, E4s).
 
-
+%% maplist(+Predicate, ?Xs0, ?Xs1, ?Xs2, ?Xs3, ?Xs4).
+%
+% This is a metapredicate that applies predicate to each element of the lists Xs0, Xs1, Xs2, Xs3 and Xs4.
 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(+Predicate, ?Xs0, ?Xs1, ?Xs2, ?Xs3, ?Xs4, ?Xs5).
+%
+% This is a metapredicate that applies predicate to each element of the lists Xs0, Xs1, Xs2, Xs3, Xs4 and Xs5.
 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(+Predicate, ?Xs0, ?Xs1, ?Xs2, ?Xs3, ?Xs4, ?Xs5, ?Xs6).
+%
+% This is a metapredicate that applies predicate to each element of the lists Xs0, Xs1, Xs2, Xs3, Xs4, Xs5 and Xs6.
 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(+Predicate, ?Xs0, ?Xs1, ?Xs2, ?Xs3, ?Xs4, ?Xs5, ?Xs6, ?Xs7).
+%
+% This is a metapredicate that applies predicate to each element of the lists Xs0, Xs1, Xs2, Xs3, Xs4, Xs5, Xs6 and Xs7.
 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),
     maplist(Cont, E1s, E2s, E3s, E4s, E5s, E6s, E7s, E8s).
 
-
+%% sum_list(+Xs, -Sum).
+%
+% Takes a lists of numbers and unifies Sum with the result of summing all the elements of the list.
+%
+% ```
+% ?- sum_list([2,2,2], 6).
+%    true.
+% ```
 sum_list(Ls, S) :-
         foldl(lists:sum_, Ls, 0, S).
 
 sum_(L, S0, S) :- S is S0 + L.
 
 
-
+%% same_length(?Xs, ?Ys).
+%
+% Succeeds if Xs and Ys are lists of the same length
 same_length([], []).
 same_length([_|As], [_|Bs]) :-
         same_length(As, Bs).
 
+%% foldl(+Predicate, ?Ls, +A0, ?A).
+%
+% foldl, sometimes called reduce, is a metapredicate that takes a predicate, a list of items
+% and a starting value, and outputs a single value. The predicate _Predicate_ must be able to take the current
+% element of the list, the previous value of the computation and the next value of the computation.
+%
+% For example, if we define sum_ as:
+%
+% ```
+% sum_(L, S0, S) :- S is S0 + L.
+% ```
+%
+% Then we can define `sum_list/2` as the following:
+%
+% ```
+% sum_list(Ls, S) :- foldl(sum_, Ls, 0, S).
+% ```
 
-foldl(Goal_3, Ls, A0, A) :-
+foldl(_, [], A, A).
-        foldl_(Ls, Goal_3, A0, A).
+foldl(G_3, [L|Ls], A0, A) :-
-
-foldl_([], _, A, A).
-foldl_([L|Ls], G_3, A0, A) :-
         call(G_3, L, A0, A1),
-        foldl_(Ls, G_3, A1, A).
+        foldl(G_3, Ls, A1, A).
 
+%% foldl(+Predicate, ?Ls0, ?Ls1, +A0, ?A).
+%
+% Same as `foldl/4` but with an extra list
 
-foldl(Goal_4, Xs, Ys, A0, A) :-
+foldl(_, [], [], A, A).
-        foldl_(Xs, Ys, Goal_4, A0, A).
+foldl(G_4, [X|Xs], [Y|Ys], A0, A) :-
-
-
-foldl_([], [], _, A, A).
-foldl_([X|Xs], [Y|Ys], G_4, A0, A) :-
         call(G_4, X, Y, A0, A1),
-        foldl_(Xs, Ys, G_4, A1, A).
+        foldl(G_4, Xs, Ys, A1, A).
 
+%% transpose(?Ls, ?Ts).
+%
+% If Ls is a list of lists, Ts contains the transposition
+%
+% ```
+% ?- transpose([[1,1],[2,2]], Ts).
+%    Ts = [[1,2],[1,2]].
+% ```
 transpose(Ls, Ts) :-
         lists_transpose(Ls, Ts).
 
@@ -214,7 +335,14 @@ transpose_(_, Fs, Lists0, Lists) :-
 
 list_first_rest([L|Ls], L, Ls).
 
-
+%% list_to_set(+Ls0, -Set).
+%
+% Takes a list Ls0 and returns a list Set that doesn't contain any repeated element
+%
+% ```
+% ?- list_to_set([2,3,4,4,1,2], Set).
+%    Set = [2,3,4,1].
+% ```
 list_to_set(Ls0, Ls) :-
         maplist(lists:with_var, Ls0, LVs0),
         keysort(LVs0, LVs),
@@ -242,7 +370,14 @@ unify_same(E-V, Prev-Var, E-V) :-
         ;   true
         ).
 
-
+%% nth0(?N, ?Ls, ?E).
+%
+% Succeeds if in the N position of the list Ls, we found the element E. The elements start counting from zero.
+%
+% ```
+% ?- nth0(2, [1,2,3,4], 3).
+%    true.
+% ```
 nth0(N, Es0, E) :-
    nonvar(N),
    '$skip_max_list'(Skip, N, Es0,Es1),
@@ -261,7 +396,6 @@ nth0(N, Es0, E) :-
 
 skipn(N0, Es0,Es) :-
    N0>0,
-   !, % should not be necessary #1028
    N1 is N0-1,
    Es0 = [_|Es1],
    skipn(N1, Es1,Es).
@@ -277,6 +411,14 @@ nth0_el(N0,N, _,E, [E0|Es0]) :-
    N1 is N0+1,
    nth0_el(N1,N, E0,E, Es0).
 
+%% nth1(?N, ?Ls, ?E).
+%
+% Succeeds if in the N position of the list Ls, we found the element E. The elements start counting from one.
+%
+% ```
+% ?- nth1(2, [1,2,3,4], 2).
+%    true.
+% ```
 nth1(N, Es0, E) :-
    N \== 0,
    nth0(N, [_|Es0], E),
@@ -284,13 +426,20 @@ nth1(N, Es0, E) :-
 
 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, ?Ls, ?E, ?Rs).
+%
+% Succeeds if in the N position of the list Ls, we found the element E and the rest of the list is Rs. The elements start counting from zero.
+%
+% ```
+% ?- nth0(2, [1,2,3,4], 3, [1,2,4]).
+%    true.
+% ```
 nth0(N, Es0, E, Es) :-
    integer(N),
    N >= 0,
@@ -315,45 +464,58 @@ nth0_elx(N0,N, E0,E, [E1|Es0], [E0|Es]) :-
 
 % p.p.8.5
 
+%% nth1(?N, ?Ls, ?E, ?Rs).
+%
+% Succeeds if in the N position of the list Ls, we found the element E and the rest of the list is Rs. The elements start counting from one.
+%
+% ```
+% ?- nth1(2, [1,2,3,4], 2, [1,3,4]).
+%    true.
+% ```
 nth1(N, Es0, E, Es) :-
    N \== 0,
    nth0(N, [_|Es0], E, [_|Es]),
    N \== 0.
 
-
+%% list_max(+Xs, -Max).
+%
+% Takes a list Xs and unifies with the maximum value of the list
 list_max([N|Ns], Max) :-
     foldl(lists:list_max_, Ns, N, Max).
 
 list_max_(N, Max0, Max) :-
     Max is max(N, Max0).
 
+%% list_min(+Xs, -Min).
+%
+% Takes a list Xs and unifies with the minimum value of the list
 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.
+%% permutation(?Xs, ?Ys) is nondet.
 %
-%   True when Xs is a permutation of Ys. This can solve for Ys given
+% 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
+% Xs or Xs given Ys, or  even   enumerate  Xs and Ys together. The
-%   predicate  permutation/2  is  primarily   intended  to  generate
+% predicate  `permutation/2`  is  primarily   intended  to  generate
-%   permutations. Note that a list of  length N has N! permutations,
+% permutations. Note that a list of  length N has N! permutations,
-%   and  unbounded  permutation  generation   becomes  prohibitively
+% and  unbounded  permutation  generation   becomes  prohibitively
-%   expensive, even for rather short lists (10! = 3,628,800).
+% expensive, even for rather short lists (10! = 3,628,800).
 %
-%   The example below illustrates that Xs   and Ys being proper lists
+% The example below illustrates that Xs   and Ys being proper lists
-%   is not a sufficient condition to use the above replacement.
+% is not a sufficient condition to use the above replacement.
 %
-%     ==
+% ```
-%     ?- permutation([1,2], [X,Y]).
+% ?- permutation([1,2], [X,Y]).
-%     X = 1, Y = 2 ;
+%    X = 1, Y = 2
-%     X = 2, Y = 1 ;
+% ;  X = 2, Y = 1
-%     false.
+% ;  false.
-%     ==
+% ```
 %
-%   @error  type_error(list, Arg) if either argument is not a proper
+%   Throws `type_error(list, Arg)` if either argument is not a proper
-%           or partial list.
+%   or partial list.
 
 permutation(Xs, Ys) :-
     '$skip_max_list'(Xlen, _, Xs, XTail),

src/lib/ordsets.pl

@@ -54,39 +54,38 @@
 
 :- use_module(library(lists)).
 
-/** <module> Ordered set manipulation
+/** Ordered set manipulation
+
 Ordered sets are lists with unique elements sorted to the standard order
-of terms (see sort/2). Exploiting ordering,   many of the set operations
+of terms (see `sort/2`). Exploiting ordering,   many of the set operations
 can be expressed in order N rather  than N^2 when dealing with unordered
 sets that may contain duplicates. The library(ordsets) is available in a
 number of Prolog implementations. Our  predicates   are  designed  to be
-compatible  with  common  practice   in    the   Prolog  community.  The
+compatible  with  common  practice   in    the   Prolog  community.
-implementation is incomplete and  relies   partly  on  library(oset), an
-older ordered set library distributed  with SWI-Prolog. New applications
-are advised to use library(ordsets).
 Some  of  these  predicates  match    directly   to  corresponding  list
 operations. It is advised to use the  versions from this library to make
-clear you are operating on ordered sets.   An exception is member/2. See
+clear you are operating on ordered sets.   An exception is `member/2`. See
-ord_memberchk/2.
+`ord_memberchk/2`.
+
 The ordsets library is based  on  the   standard  order  of  terms. This
 implies it can handle  all  Prolog   terms,  including  variables.  Note
 however, that the ordering is not stable  if   a  term inside the set is
 further instantiated. Also  note  that   variable  ordering  changes  if
 variables in the set are unified with each   other  or a variable in the
-set is unified with a variable that  is `older' than the newest variable
+set is unified with a variable that  is _older_ than the newest variable
 in the set. In  practice,  this  implies   that  it  is  allowed  to use
 member(X, OrdSet) on an ordered set that holds  variables only if X is a
 fresh variable. In other cases one should   cease  using it as an ordset
 because the order it relies on may have been changed.
 */
 
-%!  is_ordset(@Term) is semidet.
+%% is_ordset(@Term) is semidet.
 %
-%   True if Term is an ordered set.   All predicates in this library
+% True if Term is an ordered set.   All predicates in this library
-%   expect ordered sets as input arguments.  Failing to fullfil this
+% expect ordered sets as input arguments.  Failing to fullfil this
-%   assumption results in undefined   behaviour.  Typically, ordered
+% assumption results in undefined   behaviour.  Typically, ordered
-%   sets are created by predicates  from   this  library,  sort/2 or
+% sets are created by predicates  from   this  library,  `sort/2` or
-%   setof/3.
+% `setof/3`.
 
 is_ordset(Term) :-
     '$skip_max_list'(_, _, Term, Tail), Tail == [], %% is_list(Term),
@@ -102,37 +101,35 @@ is_ordset3([H2|T], H) :-
     is_ordset3(T, H2).
 
 
-%!  ord_empty(?List) is semidet.
+%% ord_empty(?List) is semidet.
 %
-%   True when List is the  empty   ordered  set. Simply unifies list
+% True when List is the  empty   ordered  set. Simply unifies list
-%   with the empty list. Not part of Quintus.
+% with the empty list. Not part of Quintus.
 
 ord_empty([]).
 
 
-%!  ord_seteq(+Set1, +Set2) is semidet.
+%% ord_seteq(+Set1, +Set2) is semidet.
 %
-%   True if Set1 and Set2  have  the   same  elements.  As  both are
+% True if Set1 and Set2  have  the   same  elements.  As  both are
-%   canonical sorted lists, this is the same as ==/2.
+% canonical sorted lists, this is the same as `==/2`.
-%
-%   @compat sicstus
 
 ord_seteq(Set1, Set2) :-
     Set1 == Set2.
 
 
-%!  list_to_ord_set(+List, -OrdSet) is det.
+%% list_to_ord_set(+List, -OrdSet) is det.
 %
-%   Transform a list into an ordered set.  This is the same as
+% Transform a list into an ordered set.  This is the same as
-%   sorting the list.
+% sorting the list.
 
 list_to_ord_set(List, Set) :-
     sort(List, Set).
 
 
-%!  ord_intersect(+Set1, +Set2) is semidet.
+%% ord_intersect(+Set1, +Set2) is semidet.
 %
-%   True if both ordered sets have a non-empty intersection.
+% True if both ordered sets have a non-empty intersection.
 
 ord_intersect([H1|T1], L2) :-
     ord_intersect_(L2, H1, T1).
@@ -148,31 +145,29 @@ ord_intersect__(>, H1, T1,  _H2, T2) :-
     ord_intersect_(T2, H1, T1).
 
 
-%!  ord_disjoint(+Set1, +Set2) is semidet.
+%% ord_disjoint(+Set1, +Set2) is semidet.
 %
-%   True if Set1 and Set2  have  no   common  elements.  This is the
+% True if Set1 and Set2  have  no   common  elements.  This is the
-%   negation of ord_intersect/2.
+% negation of `ord_intersect/2`.
 
 ord_disjoint(Set1, Set2) :-
     \+ ord_intersect(Set1, Set2).
 
 
-%!  ord_intersect(+Set1, +Set2, -Intersection)
+%% ord_intersect(+Set1, +Set2, -Intersection)
 %
-%   Intersection  holds  the  common  elements  of  Set1  and  Set2.
+% Intersection  holds  the  common  elements  of  Set1  and  Set2.
 %
-%   @deprecated Use ord_intersection/3
+% This predicate is *deprecated*. Use `ord_intersection/3`
 
 ord_intersect(Set1, Set2, Intersection) :-
     oset_int(Set1, Set2, Intersection).
 
 
-%!  ord_intersection(+PowerSet, -Intersection)
+%% ord_intersection(+PowerSet, -Intersection)
 %
-%   Intersection of a powerset. True when Intersection is an ordered
+% Intersection of a powerset. True when Intersection is an ordered
-%   set holding all elements common to all sets in PowerSet.
+% set holding all elements common to all sets in PowerSet.
-%
-%   @compat sicstus
 
 ord_intersection(PowerSet, Intersection) :-
     key_by_length(PowerSet, Pairs),
@@ -190,10 +185,10 @@ l_int([_-H|T], S0, S) :-
     l_int(T, S1, S).
 
 
-%!  ord_intersection(+Set1, +Set2, -Intersection) is det.
+%% ord_intersection(+Set1, +Set2, -Intersection) is det.
 %
-%   Intersection holds the common elements of Set1 and Set2.  Uses
+% Intersection holds the common elements of Set1 and Set2.  Uses
-%   ord_disjoint/2 if Intersection is bound to `[]` on entry.
+% `ord_disjoint/2` if Intersection is bound to `[]` on entry.
 
 ord_intersection(Set1, Set2, Intersection) :-
     (   Intersection == []
@@ -202,13 +197,11 @@ ord_intersection(Set1, Set2, Intersection) :-
     ).
 
 
-%!  ord_intersection(+Set1, +Set2, ?Intersection, ?Difference) is det.
+%% ord_intersection(+Set1, +Set2, ?Intersection, ?Difference) is det.
 %
-%   Intersection  and  difference   between    two   ordered   sets.
+% Intersection  and  difference   between    two   ordered   sets.
-%   Intersection is the intersection between   Set1  and Set2, while
+% Intersection is the intersection between   Set1  and Set2, while
-%   Difference is defined by ord_subtract(Set2, Set1, Difference).
+% Difference is defined by `ord_subtract(Set2, Set1, Difference)`.
-%
-%   @see ord_intersection/3 and ord_subtract/3.
 
 ord_intersection([], L, [], L) :- !.
 ord_intersection([_|_], [], [], []) :- !.
@@ -224,35 +217,35 @@ ord_intersection2(>, H1, T1, H2, T2, Intersection, [H2|HDiff]) :-
     ord_intersection([H1|T1], T2, Intersection, HDiff).
 
 
-%!  ord_add_element(+Set1, +Element, ?Set2) is det.
+%% ord_add_element(+Set1, +Element, ?Set2) is det.
 %
-%   Insert  an  element  into  the  set.    This   is  the  same  as
+% Insert  an  element  into  the  set.    This   is  the  same  as
-%   ord_union(Set1, [Element], Set2).
+% `ord_union(Set1, [Element], Set2)`.
 
 ord_add_element(Set1, Element, Set2) :-
     oset_addel(Set1, Element, Set2).
 
 
-%!  ord_del_element(+Set, +Element, -NewSet) is det.
+%% ord_del_element(+Set, +Element, -NewSet) is det.
 %
-%   Delete an element from an  ordered  set.   This  is  the same as
+% Delete an element from an  ordered  set.   This  is  the same as
-%   ord_subtract(Set, [Element], NewSet).
+% `ord_subtract(Set, [Element], NewSet)`.
 
 ord_del_element(Set, Element, NewSet) :-
     oset_delel(Set, Element, NewSet).
 
 
-%!  ord_selectchk(+Item, ?Set1, ?Set2) is semidet.
+%% ord_selectchk(+Item, ?Set1, ?Set2) is semidet.
 %
-%   Selectchk/3,  specialised  for  ordered  sets.    Is  true  when
+% `selectchk/3`,  specialised  for  ordered  sets.    Is  true  when
-%   select(Item, Set1, Set2) and Set1, Set2   are  both sorted lists
+% select(Item, Set1, Set2) and Set1, Set2   are  both sorted lists
-%   without duplicates. This implementation is only expected to work
+% without duplicates. This implementation is only expected to work
-%   for Item ground and either Set1 or Set2 ground. The "chk" suffix
+% for Item ground and either Set1 or Set2 ground. The "chk" suffix
-%   is meant to remind you of   memberchk/2,  which also expects its
+% is meant to remind you of   `memberchk/2`,  which also expects its
-%   first  argument  to  be  ground.    ord_selectchk(X,  S,  T)  =>
+% first  argument  to  be  ground.    `ord_selectchk(X,  S,  T)  =>
-%   ord_memberchk(X, S) & \+ ord_memberchk(X, T).
+% ord_memberchk(X, S) & \+ ord_memberchk(X, T).`
 %
-%   @author Richard O'Keefe
+% Author: Richard O'Keefe
 
 ord_selectchk(Item, [X|Set1], [X|Set2]) :-
     X @< Item,
@@ -266,19 +259,19 @@ ord_selectchk(Item, [Item|Set1], Set1) :-
     ).
 
 
-%!  ord_memberchk(+Element, +OrdSet) is semidet.
+%% ord_memberchk(+Element, +OrdSet) is semidet.
 %
-%   True if Element is a member of   OrdSet, compared using ==. Note
+% True if Element is a member of   OrdSet, compared using ==. Note
-%   that _enumerating_ elements of an ordered  set can be done using
+% that _enumerating_ elements of an ordered  set can be done using
-%   member/2.
+% `member/2`.
 %
-%   Some Prolog implementations also provide  ord_member/2, with the
+% Some Prolog implementations also provide  `ord_member/2`, with the
-%   same semantics as ord_memberchk/2.  We   believe  that  having a
+% same semantics as `ord_memberchk/2`.  We   believe  that  having a
-%   semidet ord_member/2 is unacceptably inconsistent with the *_chk
+% semidet `ord_member/2` is unacceptably inconsistent with the \*\_chk
-%   convention.  Portable  code  should    use   ord_memberchk/2  or
+% convention.  Portable  code  should    use   `ord_memberchk/2`  or
-%   member/2.
+% `member/2`.
 %
-%   @author Richard O'Keefe
+% Author: Richard O'Keefe
 
 ord_memberchk(Item, [X1,X2,X3,X4|Xs]) :-
     !,
@@ -303,9 +296,9 @@ ord_memberchk(Item, [X1]) :-
     Item == X1.
 
 
-%!  ord_subset(+Sub, +Super) is semidet.
+%% ord_subset(+Sub, +Super) is semidet.
 %
-%   Is true if all elements of Sub are in Super
+% Is true if all elements of Sub are in Super
 
 ord_subset([], _).
 ord_subset([H1|T1], [H2|T2]) :-
@@ -319,22 +312,20 @@ ord_subset_(=, _, T1, T2) :-
     ord_subset(T1, T2).
 
 
-%!  ord_subtract(+InOSet, +NotInOSet, -Diff) is det.
+%% ord_subtract(+InOSet, +NotInOSet, -Diff) is det.
 %
-%   Diff is the set holding all elements of InOSet that are not in
+% Diff is the set holding all elements of InOSet that are not in
-%   NotInOSet.
+% NotInOSet.
 
 ord_subtract(InOSet, NotInOSet, Diff) :-
     oset_diff(InOSet, NotInOSet, Diff).
 
 
-%!  ord_union(+SetOfSets, -Union) is det.
+%% ord_union(+SetOfSets, -Union) is det.
 %
-%   True if Union is the  union  of   all  elements  in the superset
+% True if Union is the  union  of   all  elements  in the superset
-%   SetOfSets. Each member of SetOfSets must  be an ordered set, the
+% SetOfSets. Each member of SetOfSets must  be an ordered set, the
-%   sets need not be ordered in any way.
+% sets need not be ordered in any way.
-%
-%   @author Copied from YAP, probably originally by Richard O'Keefe.
 
 ord_union([], []).
 ord_union([Set|Sets], Union) :-
@@ -355,18 +346,18 @@ ord_union_all(N, Sets0, Union, Sets) :-
     ).
 
 
-%!  ord_union(+Set1, +Set2, ?Union) is det.
+%% ord_union(+Set1, +Set2, ?Union) is det.
 %
-%   Union is the union of Set1 and Set2
+% Union is the union of Set1 and Set2
 
 ord_union(Set1, Set2, Union) :-
     oset_union(Set1, Set2, Union).
 
 
-%!  ord_union(+Set1, +Set2, -Union, -New) is det.
+%% ord_union(+Set1, +Set2, -Union, -New) is det.
 %
-%   True iff ord_union(Set1, Set2, Union) and
+% True iff `ord_union(Set1, Set2, Union)` and
-%   ord_subtract(Set2, Set1, New).
+% `ord_subtract(Set2, Set1, New)`.
 
 ord_union([], Set2, Set2, Set2).
 ord_union([H|T], Set2, Union, New) :-
@@ -390,26 +381,26 @@ ord_union_2([H|T], H2, T2, Union, New) :-
     ord_union(Order, H, T, H2, T2, Union, New).
 
 
-%!  ord_symdiff(+Set1, +Set2, ?Difference) is det.
+%% ord_symdiff(+Set1, +Set2, ?Difference) is det.
 %
-%   Is true when Difference is the  symmetric difference of Set1 and
+% Is true when Difference is the  symmetric difference of Set1 and
-%   Set2. I.e., Difference contains all elements that are not in the
+% Set2. I.e., Difference contains all elements that are not in the
-%   intersection of Set1 and Set2. The semantics  is the same as the
+% intersection of Set1 and Set2. The semantics  is the same as the
-%   sequence below (but the actual   implementation  requires only a
+% sequence below (but the actual   implementation  requires only a
-%   single scan).
+% single scan).
 %
-%     ==
+% ```
-%           ord_union(Set1, Set2, Union),
+% ord_union(Set1, Set2, Union),
-%           ord_intersection(Set1, Set2, Intersection),
+% ord_intersection(Set1, Set2, Intersection),
-%           ord_subtract(Union, Intersection, Difference).
+% ord_subtract(Union, Intersection, Difference).
-%     ==
+% ```
 %
-%   For example:
+% For example:
 %
-%     ==
+% ```
-%     ?- ord_symdiff([1,2], [2,3], X).
+% ?- ord_symdiff([1,2], [2,3], X).
-%     X = [1,3].
+% X = [1,3].
-%     ==
+% ```
 
 ord_symdiff([], Set2, Set2).
 ord_symdiff([H1|T1], Set2, Difference) :-
@@ -457,7 +448,7 @@ ord_symdiff(>, H1, T1, H2, Set2, [H2|Difference]) :-
 */
 
 
-/** <module> Ordered set manipulation
+/* Ordered set manipulation
 
 This library defines set operations on sets represented as ordered
 lists.

src/lib/os.pl

@@ -12,37 +12,80 @@
    Public domain code.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
+/** Predicates for reasoning about the operating system (OS) environment.
+
+This includes predicates about environment variables, calls to shell and
+finding out the PID of the running system.
+*/
+
 :- module(os, [getenv/2,
                setenv/2,
                unsetenv/1,
                shell/1,
                shell/2,
-               pid/1]).
+               pid/1,
+	       raw_argv/1,
+	       argv/1]).
 
 :- use_module(library(error)).
 :- use_module(library(charsio)).
 :- use_module(library(lists)).
 :- use_module(library(si)).
 
+%% getenv(+Key, -Value).
+%
+% True iff Value contains the value of the environment variable Key.
+% Example:
+%
+% ```
+% ?- getenv("LANG", Ls).
+%    Ls = "en_US.UTF-8".
+% ```
 getenv(Key, Value) :-
         must_be_env_var(Key),
         '$getenv'(Key, Value).
 
+%% setenv(+Key, +Value).
+%
+% Sets the environment variable Key to Value
 setenv(Key, Value) :-
         must_be_env_var(Key),
         must_be_chars(Value),
         '$setenv'(Key, Value).
 
+%% unsetenv(+Key).
+%
+% Unsets the environment variable Key
 unsetenv(Key) :-
         must_be_env_var(Key),
         '$unsetenv'(Key).
 
+%% shell(+Command)
+%
+% Equivalent to `shell(Command, 0)`.
 shell(Command) :- shell(Command, 0).
+
+%% shell(+Command, -Status).
+%
+% True iff executes Command in a shell of the operating system and the exit code is Status.
+% Keep in mind the shell syntax is dependant on the operating system, so it should be
+% used very carefully.
+%
+% Example (using Linux and fish shell):
+%
+% ```
+% ?- shell("echo $SHELL", Status).
+% /bin/fish
+%    Status = 0.
+% ```
 shell(Command, Status) :-
     must_be_chars(Command),
     can_be(integer, Status),
     '$shell'(Command, Status).
 
+%% pid(-PID).
+%
+% True iff PID is the process identification number of current Scryer Prolog instance.
 pid(PID) :-
         can_be(integer, PID),
         '$pid'(PID).
@@ -69,3 +112,34 @@ permitted('_').
 must_be_chars(Cs) :-
         must_be(list, Cs),
         maplist(must_be(character), Cs).
+
+%% raw_argv(-Argv)
+%
+% True iff Argv is the list of arguments that this program was started with (usually passed via command line).
+% In contrast to `argv/1`, this version includes every argument, without any postprocessing, just as the operating
+% system reports it to the system. This includes-flags of Scryer itself, which are not needed in general.
+raw_argv(Argv) :-
+    can_be(list, Argv),
+    '$argv'(Argv).
+
+%% argv(-Argv)
+%
+% True if Argv is the list of arguments that this program was started with (usually passed via command line).
+% In this version, only arguments specific to the program are passed. To differentiate between the system
+% arguments and the program arguments, we use `--` as a separator.
+%
+% Example:
+%
+% ```
+% % Call with scryer-prolog -f -- -t hello
+% ?- argv(X).
+%     X = ["-t", "hello"].
+% ```
+argv(Argv) :-
+    can_be(list, Argv),
+    '$argv'(Argv0),
+    ( append(_, ["--"|Argv1], Argv0) ->
+        Argv = Argv1
+    ;
+        Argv = []
+    ).

src/lib/pairs.pl

@@ -1,3 +1,10 @@
+/** Reasoning about pairs.
+
+    Pairs are Prolog terms with principal functor `(-)/2`. A pair
+    often has the form `Key-Value`. The predicates of this library
+    relate pairs to keys and values.
+*/
+
 :- module(pairs, [pairs_keys_values/3,
 		  pairs_keys/2,
 		  pairs_values/2,
@@ -7,12 +14,25 @@
 
 :- meta_predicate map_list_to_pairs(2, ?, ?).
 
+%% pairs_keys_values(?Pairs, ?Keys, ?Values)
+%
+%  The first argument is a list of Pairs, the second the corresponding
+%  Keys, and the third argument the corresponding values.
+
 pairs_keys_values([], [], []).
 pairs_keys_values([A-B|ABs], [A|As], [B|Bs]) :-
         pairs_keys_values(ABs, As, Bs).
 
+%% pairs_keys(?Pairs, ?Keys)
+%
+%  Same as `pairs_keys_values(Pairs, Keys, _)`.
+
 pairs_keys(Ps, Ks) :- pairs_keys_values(Ps, Ks, _).
 
+%% pairs_values(?Pairs, ?Values)
+%
+%  Same as `pairs_keys_values(Pairs, _, Values)`.
+
 pairs_values(Ps, Vs) :- pairs_keys_values(Ps, _, Vs).
 
 map_list_to_pairs(Pred, Ls, Ps) :-

src/lib/pio.pl

@@ -1,16 +1,15 @@
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+/** Pure I/O.
-   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],
+   for describing strings. The predicates `phrase_from_file/[2,3]`,
-   phrase_to_file/[2,3] and phrase_to_stream/2 let us apply DCGs
+   `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_stream/2,
                 phrase_to_file/2,
                 phrase_to_file/3,
                 phrase_to_stream/2
@@ -19,26 +18,42 @@
 :- 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(gensym)).
-:- use_module(library(lists), [member/2, maplist/2]).
+:- use_module(library(iso_ext), [
+    bb_get/2, bb_put/2, setup_call_cleanup/3, partial_string/3, partial_string_tail/2
+]).
+:- use_module(library(lists), [append/3, length/2, 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_from_stream(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,
+%% phrase_from_stream(+GRBody, +Stream)
-   represented as a list of characters.
+%
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+%  True if grammar rule body GRBody covers the contents of the stream,
+%  represented as a list of characters.
+
+phrase_from_stream(GRBody, Stream) :-
+    stream_to_lazy_list(Stream, Ls),
+    phrase(GRBody, Ls).
+
+%% 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(+GRBody, +File, +Options)
+%
+%  Like `phrase_from_file/2`, using Options to open the file.
+
 phrase_from_file(NT, File, Options) :-
     (   var(File) -> instantiation_error(phrase_from_file/3)
     ;   must_be(list, Options),
@@ -48,43 +63,138 @@ phrase_from_file(NT, File, Options) :-
             member(Type, [text,binary])
         ;   Type = text
         ),
-        setup_call_cleanup(open(File, read, Stream, [reposition(true)|Options]),
+        setup_call_cleanup(
-                           (   stream_to_lazy_list(Stream, Xs),
+            open(File, read, Stream, Options),
-                               phrase(NT, Xs) ),
+            phrase_from_stream(NT, Stream),
-                           close(Stream))
+            close(Stream)
-   ).
+        )
+    ).
 
+% How many chars to read from stream and buffer in each step
+chars_to_read(4096).
 
-stream_to_lazy_list(Stream, Xs) :-
+stream_to_lazy_list(Stream, Ls) :-
-        stream_property(Stream, position(Pos)),
+    get_stream_buffer_position(Stream, Pos),
-        freeze(Xs, reader_step(Stream, Pos, Xs)).
+    freeze(Ls, render_step(Stream, Pos, Ls)).
 
-reader_step(Stream, Pos, Xs0) :-
+render_step(Stream, Pos, Ls) :-
-        set_stream_position(Stream, Pos),
+    set_stream_buffer_position(Stream, Pos),
-        (   at_end_of_stream(Stream)
+    (   buffer_at_end_of_stream(Stream) ->
-        ->  Xs0 = []
+        Ls = []
-        ;   get_n_chars(Stream, 4096, Cs),
+    ;   chars_to_read(CharsToRead),
-            partial_string(Cs, Xs0, Xs),
+        buffer_get_n_chars(Stream, CharsToRead, Chars),
-            stream_to_lazy_list(Stream, Xs)
+        partial_string(Chars, Ls, Ls0),
-        ).
+        stream_to_lazy_list(Stream, Ls0)
+    ).
 
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+buffer_at_end_of_stream(Stream) :-
-   phrase_to_stream(+GRBody, +Stream)
+    stream_bufferids(Stream, _, BufferPosId, _),
+    bb_get(BufferPosId, Pos),
+    Pos = eof.
 
-   Emit the list of characters described by the grammar rule body
+get_stream_buffer_position(Stream, Pos) :-
-   GRBody to Stream.
+    stream_bufferids(Stream, _, BufferPosId, _),
+    bb_get(BufferPosId, Pos).
 
-   An ideal implementation of phrase_to_stream/2 writes each character
+set_stream_buffer_position(Stream, Pos) :-
-   as soon as it becomes known and no choice-points remain, and thus
+    stream_bufferids(Stream, _, BufferPosId, _),
-   avoids the manifestation of the entire string in memory. See #691
+    bb_put(BufferPosId, Pos).
-   for more information.
 
-   The current preliminary implementation is provided so that Prolog
+buffer_get_n_chars(Stream, N, Chars) :-
-   programmers can already get used to describing output with DCGs,
+    stream_bufferids(Stream, BufferId, BufferPosId, BufferLenId),
-   and then writing it to a file when necessary. This simple
+    buffer_prepare_for_n(Stream, BufferId, BufferPosId, BufferLenId, N),
-   implementation suffices as long as the entire contents can be
+    bb_get(BufferId, Buffer),
-   represented in memory, and thus covers a large number of use cases.
+    bb_get(BufferPosId, BufferPos),
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+    (   BufferPos = eof ->
+        Chars = []
+    ;   string_get_n_chars(Buffer, BufferPos, N, Chars),
+        length(Chars, NChars),
+        (   NChars = 0 ->
+            BufferPos1 = eof
+        ;   BufferPos1 is BufferPos + NChars
+        ),
+        bb_put(BufferPosId, BufferPos1)
+    ).
+
+buffer_prepare_for_n(Stream, BufferId, BufferPosId, BufferLenId, N) :-
+    bb_get(BufferPosId, BufferPos),
+    bb_get(BufferLenId, BufferLen),
+    (   BufferLen < BufferPos + N ->
+        bb_get(BufferId, Buffer),
+        (
+            (   var(Buffer) ->
+                BufferTail = Buffer
+            ;   partial_string_last_tail(Buffer, BufferTail)
+            ) ->
+            (   at_end_of_stream(Stream) ->
+                BufferTail = [],
+                bb_put(BufferId, Buffer)
+            ;   chars_to_read(CharsToRead),
+                get_n_chars(Stream, CharsToRead, Chars),
+                length(Chars, NChars),
+                partial_string(Chars, BufferTail, _),
+                bb_put(BufferId, Buffer),
+                BufferLen1 is BufferLen + NChars,
+                bb_put(BufferLenId, BufferLen1),
+                buffer_prepare_for_n(Stream, BufferId, BufferPosId, BufferLenId, N)
+            )
+        ;   true
+        )
+    ;   true
+    ).
+
+partial_string_last_tail(PartialString, PartialStringTail) :-
+    partial_string_tail(PartialString, PartialStringTail0),
+    (   var(PartialStringTail0) ->
+        PartialStringTail = PartialStringTail0
+    ;   partial_string_last_tail(PartialStringTail0, PartialStringTail)
+    ).
+
+string_get_n_chars(String, Pos, N, Chars) :-
+    '$skip_max_list'(_, Pos, String, String1),
+    '$skip_max_list'(N1, N, String1, _),
+    length(Chars, N1),
+    append(Chars, _, String1).
+
+stream_bufferids(Stream, BufferId, BufferPosId, BufferLenId) :-
+    (   bb_get(streams_buffers, _) ->
+        true
+    ;   bb_put(streams_buffers, [])
+    ),
+    bb_get(streams_buffers, StreamsBuffers),
+    (   member(
+            stream_buffer(Stream, BufferId, BufferPosId, BufferLenId),
+            StreamsBuffers
+        ) ->
+        true
+    ;   gensym(buffer, BufferId),
+        gensym(buffer_pos, BufferPosId),
+        gensym(buffer_len, BufferLenId),
+        bb_put(
+            streams_buffers,
+            [stream_buffer(Stream, BufferId, BufferPosId, BufferLenId)|StreamsBuffers]
+        ),
+        bb_put(BufferId, _),
+        bb_put(BufferPosId, 0),
+        bb_put(BufferLenId, 0)
+    ).
+
+%% 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](https://github.com/mthom/scryer-prolog/issues/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),
@@ -101,14 +211,18 @@ phrase_to_stream(GRBody, Stream) :-
         % maplist(put_char(Stream), Cs). It also works for binary streams.
         '$put_chars'(Stream, Cs).
 
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+%% phrase_to_file(+GRBody, +File)
-   phrase_to_file(+GRBody, +File), writing the string described
+%
-   by GRBody to File.
+%  Write the string described by GRBody to File.
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 phrase_to_file(GRBody, File) :-
         phrase_to_file(GRBody, File, []).
 
+
+%% phrase_to_file(+GRBody, +File, +Options)
+%
+%  Like `phrase_to_file/2`, using Options to open the file.
+
 phrase_to_file(GRBody, File, Options) :-
         setup_call_cleanup(open(File, write, Stream, Options),
                            phrase_to_stream(GRBody, Stream),

src/lib/random.pl

@@ -1,24 +1,38 @@
-:- module(random, [maybe/0, random/1, random_integer/3, set_random/1]).
+/**
+This library provides probabilistic predicates and random number generators.
 
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+To retain desirable declarative properties, predicates that internally
-   To retain desirable declarative properties, predicates that internally
+use random numbers should be equipped with an argument that specifies
-   use random numbers should be equipped with an argument that specifies
+the random seed. This makes everything completely reproducible.
-   the random seed. This makes everything completely reproducible.
+*/
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+:- module(random, [maybe/0, random/1, random_integer/3, set_random/1]).
 
 :- use_module(library(error)).
 
-% succeeds with probability 0.5.
+%% maybe.
+% 
+% Succeeds with probability 0.5.
 maybe :- '$maybe'.
 
 % The higher the precision, the slower it gets.
 random_number_precision(64).
 
+%% random(-R).
+%
+% Generates a random floating number between 0 (inclusive) and 1 (exclusive).
 random(R) :-
     var(R),
     random_number_precision(N),
     rnd(N, R).
 
+%% random_integer(+Lower, +Upper, -R).
+%
+% Generates a random integer number between Lower (inclusive) and Upper (exclusive).
+%
+% Throws `instantiation_error` if Lower or Upper are variables.
+%
+% Throws `type_error` if Lower or Upper aren't integers.
 random_integer(Lower, Upper, R) :-
     var(R),
     (   (var(Lower) ; var(Upper)) ->
@@ -46,6 +60,10 @@ rnd_(N, R0, R) :-
     R1 is R0 + 1.0 / 2.0 ^ N,
     rnd_(N1, R1, R).
 
+%% set_random(+Seed).
+%
+% Sets a seed that will be used for subsequent random generations in this library.
+% It's necessary to set a seed to provide reproducible executions using this library.
 set_random(Seed) :-
     (   nonvar(Seed) ->
         (  Seed = seed(S) ->

src/lib/reif.pl

@@ -1,3 +1,16 @@
+/** Predicates from [*Indexing dif/2*](https://arxiv.org/abs/1607.01590).
+
+Example:
+
+```
+?- tfilter(=(a), [X,Y], Es).
+   X = a, Y = a, Es = "aa"
+;  X = a, Es = "a", dif:dif(a,Y)
+;  Y = a, Es = "a", dif:dif(a,X)
+;  Es = [], dif:dif(a,X), dif:dif(a,Y).
+```
+*/
+
 :- module(reif, [if_/3, (=)/3, (',')/3, (;)/3, cond_t/3, dif/3,
 		         memberd_t/3, tfilter/3, tmember/2, tmember_t/3,
 		         tpartition/4]).

src/lib/sgml.pl

@@ -2,57 +2,70 @@
    Predicates for parsing HTML and XML documents.
    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)
-
-   These predicates parse HTML and XML documents, respectively.
-
-   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, 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.
-
-   Example:
-
-      ?- load_html("<html><head><title>Hello!</title></head></html>", Es, []).
-
-   Yielding:
-
-         Es = [element(html,[],
-                [element(head,[],
-                  [element(title,[],
-                    ["Hello!"])]),
-                 element(body,[],[])])].
-
-   library(xpath) provides convenient reasoning about parsed documents.
-   For example, to fetch the title of the document above, we can use:
-
-      ?- load_html("<html><head><title>Hello!</title></head></html>", Es, []),
-         xpath(Es, //title(text), T).
-
-   Yielding T = "Hello!".
-
-   Use http_open/3 from library(http/http_open) to read answers from
-   web servers via streams.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
+/** Predicates for parsing HTML and XML documents.
+
+Currently, two predicates are provided:
+
+  -  `load_html(+Source, -Es, +Options)`
+  -  `load_xml(+Source, -Es, +Options)`
+
+These predicates parse HTML and XML documents, respectively.
+
+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`, 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.
+
+Example:
+
+```
+   ?- load_html("<html><head><title>Hello!</title></head></html>", Es, []).
+```
+
+Yielding:
+
+```
+      Es = [element(html,[],
+             [element(head,[],
+               [element(title,[],
+                 ["Hello!"])]),
+              element(body,[],[])])].
+```
+
+`library(xpath)` provides convenient reasoning about parsed documents.
+For example, to fetch the title of the document above, we can use:
+
+```
+   ?- load_html("<html><head><title>Hello!</title></head></html>", Es, []),
+      xpath(Es, //title(text), T).
+```
+
+Yielding `T = "Hello!"`.
+
+Use `http_open/3` from `library(http/http_open)` to read answers from
+web servers via streams.
+*/
+
 :- module(sgml, [load_html/3,
                  load_xml/3]).
 

src/lib/si.pl

@@ -1,34 +1,46 @@
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
-   Safe type tests
+/** Safe type tests.
-   ===============
 
-   "si" stands for "sufficiently instantiated".
+   "si" stands for "sufficiently instantiated". It can also be read as
+   "safe inference", so possibly also other predicates are candidates
+   for this library.
 
-   These predicates:
+   A safe type test:
 
-    - throw instantiation errors if the argument is
+    - throws an *instantiation error* if the argument is
       not sufficiently instantiated to make a sound decision
-    - succeed if the argument is of the specified type
+    - *succeeds* if the argument is of the specified type
-    - fail otherwise.
+    - *fails* otherwise.
 
-   For instance, atom_si(A) yields an *instantiation error* if A is a
+   For instance, `atom_si(A)` yields an *instantiation error* if `A` is a
    variable. This is logically sound, since in that case the argument
    is not sufficiently instantiated to make any decision.
 
-   The definitions are taken from:
+   The definitions are taken from [Safer type tests in Prolog](https://stackoverflow.com/questions/27306453/safer-type-tests-in-prolog).
 
-       https://stackoverflow.com/questions/27306453/safer-type-tests-in-prolog
+   Examples:
 
-   "si" can also be read as "safe inference", so possibly also other
+```
-   predicates are candidates for this library.
+?- chars_si(Cs).
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+   error(instantiation_error,list_si/1).
+?- chars_si([h|Cs]).
+   error(instantiation_error,list_si/1).
+?- chars_si("hello").
+   true.
+?- chars_si(hello).
+   false.
+```
+*/
 
 :- module(si, [atom_si/1,
                integer_si/1,
                atomic_si/1,
                list_si/1,
-               chars_si/1]).
+               character_si/1,
+               term_si/1,
+               chars_si/1,
+               dif_si/2,
+               when_si/2]).
 
 :- use_module(library(lists)).
 
@@ -53,6 +65,65 @@ list_si(L0) :-
    ;  throw(error(instantiation_error, list_si/1))
    ).
 
-chars_si(Cs) :-
+character_si(Ch) :-
-   list_si(Cs),
+   functor(Ch,Ch,0),
-   '$is_partial_string'(Cs).
+   atom(Ch),
+   atom_length(Ch,1).
+
+term_si(Term) :-
+   (   ground(Term) -> acyclic_term(Term)
+   ;   throw(error(instantiation_error, term_si/1))
+   ).
+
+chars_si(Chs0) :-
+   '$skip_max_list'(_,_, Chs0,Chs),
+   ( nonvar(Chs) -> Chs == [] ; true ), % fails for infinite lists too
+   failnochars(Chs0, Uninstantiated),
+   (  nonvar(Uninstantiated)
+   -> throw(error(instantiation_error, chars_si/1))
+   ;  true
+   ).
+
+failnochars(Chs0, U) :-
+   (  var(Chs0) -> U = true
+   ;  Chs0 == [] -> true
+   ;  Chs0 = [Ch|Chs1],
+      (  nonvar(Ch) -> atom(Ch), atom_length(Ch,1)
+      ;  U = true
+      ),
+      failnochars(Chs1, U)
+   ).
+
+dif_si(X, Y) :-
+   X \== Y,
+   ( X \= Y -> true
+   ; throw(error(instantiation_error,dif_si/2))
+   ).
+
+:- meta_predicate(when_si(+, 0)).
+
+%% when_si(Condition, Goal).
+%
+% Executes Goal when Condition becomes true. Throws an instantiation error if
+% it can't decide.
+when_si(Condition, Goal) :-
+    % Taken from https://stackoverflow.com/a/40449516
+    (   when_condition_si(Condition) ->
+        (   Condition ->
+            Goal
+        ;   throw(error(instantiation_error,when_si/2))
+        )
+    ;   throw(error(domain_error(when_condition_si, Condition),_))
+    ).
+
+when_condition_si(Cond) :-
+    var(Cond), !, throw(error(instantiation_error,when_condition_si/2)).
+when_condition_si(ground(_)).
+when_condition_si(nonvar(_)).
+when_condition_si((A, B)) :-
+    when_condition_si(A),
+    when_condition_si(B).
+when_condition_si((A ; B)) :-
+    when_condition_si(A),
+    when_condition_si(B).
+

src/lib/simplex.pl

@@ -77,9 +77,9 @@ thesis project, for example.
 A *linear programming problem* or simply *linear program* (LP)
 consists of:
 
-  - a set of _linear_ **constraints**
+  - a set of _linear_ *constraints*
-  - a set of **variables**
+  - a set of *variables*
-  - a _linear_ **objective function**.
+  - a _linear_ *objective function*.
 
 The goal is to assign values to the variables so as to _maximize_ (or
 minimize) the value of the objective function while satisfying all
@@ -107,10 +107,10 @@ non-negativity constraints should therefore be stated explicitly.
 This is the "radiation therapy" example, taken from _Introduction to
 Operations Research_ by Hillier and Lieberman.
 
-[**Prolog DCG notation**](https://www.metalevel.at/prolog/dcg) is
+[*Prolog DCG notation*](https://www.metalevel.at/prolog/dcg) is
 used to _implicitly_ thread the state through posting the constraints:
 
-==
+```
 :- use_module(library(simplex)).
 :- use_module(library(dcgs)).
 
@@ -125,15 +125,15 @@ post_constraints -->
 	constraint([0.6*x1, 0.4*x2] >= 6),
 	constraint([x1] >= 0),
 	constraint([x2] >= 0).
-==
+```
 
 An example query:
 
-==
+```
 ?- radiation(S), variable_value(S, x1, Val1),
 		 variable_value(S, x2, Val2).
    S = solved(...), Val1 = 15 rdiv 2, Val2 = 9 rdiv 2.
-==
+```
 
 ## Example 2     {#simplex-ex-2}
 
@@ -143,7 +143,7 @@ Here is an instance of the knapsack problem described above, where `C
 variables, `x(1)` and `x(2)` that denote how many items to take of
 each type.
 
-==
+```
 :- use_module(library(simplex)).
 
 knapsack(S) :-
@@ -155,15 +155,15 @@ knapsack_constraints(S) :-
 	constraint([6*x(1), 4*x(2)] =< 8, S0, S1),
 	constraint([x(1)] =< 1, S1, S2),
 	constraint([x(2)] =< 2, S2, S).
-==
+```
 
 An example query yields:
 
-==
+```
 ?- knapsack(S), variable_value(S, x(1), X1),
 	        variable_value(S, x(2), X2).
    S = solved(...), X1 = 1 rdiv 1, X2 = 1 rdiv 2.
-==
+```
 
 That is, we are to take the one item of the first type, and half of one of
 the items of the other type to maximize the total value of items in the
@@ -171,23 +171,23 @@ knapsack.
 
 If items can not be split, integrality constraints have to be imposed:
 
-==
+```
 knapsack_integral(S) :-
 	knapsack_constraints(S0),
 	constraint(integral(x(1)), S0, S1),
 	constraint(integral(x(2)), S1, S2),
 	maximize([7*x(1), 4*x(2)], S2, S).
-==
+```
 
 Now the result is different:
 
-==
+```
 ?- knapsack_integral(S), variable_value(S, x(1), X1),
 			 variable_value(S, x(2), X2).
 
 X1 = 0
 X2 = 2
-==
+```
 
 That is, we are to take only the _two_ items of the second type.
 Notice in particular that always choosing the remaining item with best
@@ -207,7 +207,7 @@ The task is to find a _minimal_ number of these coins that amount to
 111 units in total. We introduce variables `c(1)`, `c(5)` and `c(20)`
 denoting how many coins to take of the respective type:
 
-==
+```
 :- use_module(library(simplex)).
 
 coins(S) :-
@@ -226,16 +226,16 @@ coins -->
 	constraint(integral(c(5))),
 	constraint(integral(c(20))),
 	minimize([c(1), c(5), c(20)]).
-==
+```
 
 An example query:
 
-==
+```
 ?- coins(S), variable_value(S, c(1), C1),
 	     variable_value(S, c(5), C5),
 	     variable_value(S, c(20), C20).
    S = solved(...), C1 = 1 rdiv 1, C5 = 2 rdiv 1, C20 = 5 rdiv 1.
-==
+```
 
 @author [Markus Triska](https://www.metalevel.at)
 */

src/lib/sockets.pl

@@ -1,4 +1,9 @@
-
+/**
+Predicates for handling network sockets, both as a server and as a client.
+As a server, you should open a socket an call `socket_server_accept/4` to get a stream for each connection.
+As a client, you should just open a socket and you will receive a stream.
+In both cases, with a stream, you can use the usual predicates to read and write to the stream.
+*/
 :- module(sockets, [socket_client_open/3,
                     socket_server_open/2,
                     socket_server_accept/4,
@@ -7,6 +12,18 @@
 
 :- use_module(library(error)).
 
+%% socket_client_open(+Addr, -Stream, +Options).
+%
+% Open a socket to a server, returning a stream. Addr must satisfy `Addr = Address:Port`.
+%
+% The following options are available:
+%
+%  * `alias(+Alias)`: Set an alias to the stream
+%  * `eof_action(+Action)`: Defined what happens if the end of the stream is reached. Values: `error`, `eof_code` and `reset`.
+%  * `reposition(+Boolean)`: Specifies whether repositioning is required for the stream. `false` is the default.
+%  * `type(+Type)`: Type can be `text` or `binary`. Defines the type of the stream, if it's optimized for plain text
+%    or just binary
+%
 socket_client_open(Addr, Stream, Options) :-
     (  var(Addr) ->
        throw(error(instantiation_error, socket_client_open/3))
@@ -27,7 +44,11 @@ socket_client_open(Addr, Stream, Options) :-
                                   socket_client_open/3),
     '$socket_client_open'(Address, Port, Stream, Alias, EOFAction, Reposition, Type).
 
-
+%% socket_server_open(+Addr, -ServerSocket).
+%
+% Open a server socket, returning a ServerSocket. Use that ServerSocket to accept incoming connections in
+% `socket_server_accept/4`. Addr must satisfy `Addr = Address:Port`. Depending on the operating system
+% configuration, some ports might be reserved for superusers.
 socket_server_open(Addr, ServerSocket) :-
     must_be(var, ServerSocket),
     (  ( integer(Addr) ; var(Addr) ) ->
@@ -39,7 +60,19 @@ socket_server_open(Addr, ServerSocket) :-
        '$socket_server_open'(Address, Port, ServerSocket)
     ).
 
-
+%% socket_server_accept(+ServerSocket, -Client, -Stream, +Options).
+%
+% Given a ServerSocket and a list of Options, accepts a incoming connection, returning data from the Client and
+% a Stream to read or write data.
+%
+% The following options are available:
+%
+%  * `alias(+Alias)`: Set an alias to the stream
+%  * `eof_action(+Action)`: Defined what happens if the end of the stream is reached. Values: `error`, `eof_code` and `reset`.
+%  * `reposition(+Boolean)`: Specifies whether repositioning is required for the stream. `false` is the default.
+%  * `type(+Type)`: Type can be `text` or `binary`. Defines the type of the stream, if it's optimized for plain text
+%    or just binary
+% 
 socket_server_accept(ServerSocket, Client, Stream, Options) :-
     must_be(var, Client),
     must_be(var, Stream),
@@ -48,10 +81,14 @@ socket_server_accept(ServerSocket, Client, Stream, Options) :-
                                   socket_server_accept/4),
     '$socket_server_accept'(ServerSocket, Client, Stream, Alias, EOFAction, Reposition, Type).
 
-
+%% socket_server_close(+ServerSocket).
+%
+% Stops listening on that ServerSocket. It's recommended to always close a ServerSocket once it's no longer needed
 socket_server_close(ServerSocket) :-
     '$socket_server_close'(ServerSocket).
 
-
+%% current_hostname(-HostName).
+%
+% Returns the current hostname of the computer in which Scryer Prolog is executing right now
 current_hostname(HostName) :-
     '$current_hostname'(HostName).

src/lib/tabling.pl

@@ -1,3 +1,29 @@
+/** Tabling, also called SLG resolution.
+
+    SLG resolution is an alternative execution strategy that sometimes
+    helps to improve termination and performance characters of Prolog
+    predicates.
+
+    To enable this execution strategy for a Prolog predicate, add a
+    `(table)/1` directive, using the prefix operator `table` that this
+    module defines. For example, to enable tabling for the predicate
+    `p/2`, use:
+
+```
+:- use_module(library(tabling)).
+
+:- table p/2.
+
+...
+```
+
+    The possibility to apply different execution strategies is one of
+    the greatest attractions of pure Prolog code, and one of the
+    strongest arguments for keeping to the pure core of Prolog as far
+    as possible.
+
+    Scryer Prolog implements tabling as described by Desouter et al. in [*Tabling as a Library with Delimited Control*](https://www.ijcai.org/Proceedings/16/Papers/619.pdf).
+*/
 
 :- module(tabling,
 	  [ start_tabling/2,		% +Wrapper, :Worker.
@@ -138,7 +164,9 @@ activate(Wrapper,Worker,T) :-
 
 delim(Wrapper,Worker,Table) :-
 %   debug(tabling, 'ACT: ~p on ~p', [Wrapper, Table]),
-    reset(Worker,SourceCall,Continuation),
+    catch(reset(Worker,SourceCall,Continuation),
+          _,
+          fail),
    ( Continuation = none ->
      (	 add_answer(Table,Wrapper)
      ->	 true %debug(tabling, 'ADD: ~p', [Wrapper])

src/lib/tabling/batched_worklist.pl

@@ -49,12 +49,20 @@
 :- use_module(library(tabling/double_linked_list)).
 
 :- use_module(library(atts)).
+:- use_module(library(dcgs)).
 :- use_module(library(lists)).
 
 :- attribute executing_all_work/1, worklist_presence/1, wkl_answer_cluster/1, wkl_suspension_cluster/1, wkl_answer_cluster_pointer_flag/1.
 
 verify_attributes(_, _, []).
 
+attribute_goals(X) -->
+    { put_atts(X, -executing_all_work(_)),
+      put_atts(X, -worklist_presence(_)),
+      put_atts(X, -wkl_answer_cluster(_)),
+      put_atts(X, -wkl_suspension_cluster(_)),
+      put_atts(X, -wkl_answer_cluster_pointer_flag(_)) }.
+
 /** <module> Tabling Worklist management
 
 A batched worklist: a worklist that  clusters suspensions and answers as

src/lib/tabling/double_linked_list.pl

@@ -49,9 +49,15 @@
 	  ]).
 
 :- use_module(library(atts)).
+:- use_module(library(dcgs)).
 
 :- attribute dll_element/1, dll_next/1, dll_prev/1.
 
+attribute_goals(X) -->
+     { put_atts(X, -dll_element(_)),
+       put_atts(X, -dll_next(_)),
+       put_atts(X, -dll_prev(_)) }.
+
 % A circular double linked list
 % =============================
 

src/lib/tabling/global_worklist.pl

@@ -9,12 +9,15 @@
 	  ]).
 
 :- use_module(library(atts)).
+:- use_module(library(dcgs)).
 :- use_module(library(iso_ext)).
 
 :- attribute table_global_worklist/1.
 
 verify_attributes(_, _, []).
 
+attribute_goals(X) --> { put_atts(X, -table_global_worklist(_)) }.
+
 put_new_global_worklist :-
   (  bb_get(table_global_worklist_initialized, _) ->
      true

src/lib/tabling/table_data_structure.pl

@@ -56,6 +56,7 @@
 :- use_module(library(tabling/batched_worklist)).
 
 :- use_module(library(atts)).
+:- use_module(library(dcgs)).
 :- use_module(library(gensym)).
 :- use_module(library(iso_ext)).
 
@@ -63,6 +64,10 @@
 
 verify_attributes(_, _, []).
 
+attribute_goals(X) -->
+    { put_atts(X, -table_status(_)),
+      put_atts(X, -newly_created_table_identifiers(_)) }.
+
 % This file defines the table datastructure.
 %
 % The table datastructure contains the following sub-structures:

src/lib/tabling/table_link_manager.pl

@@ -43,6 +43,7 @@
 	  ]).
 
 :- use_module(library(atts)).
+:- use_module(library(dcgs)).
 :- use_module(library(lists)).
 :- use_module(library(iso_ext)).
 :- use_module(library(terms)).
@@ -53,6 +54,9 @@
 
 verify_attributes(_, _, []).
 
+attribute_goals(X) -->
+    { put_atts(X, -trie_table_link(_)) }.
+
 % This file defines a call pattern trie.
 %
 % This data structure keeps the relation between a variant and the

src/lib/tabling/trie.pl

@@ -45,12 +45,17 @@
 
 :- use_module(library(assoc)).
 :- use_module(library(atts)).
+:- use_module(library(dcgs)).
 :- use_module(library(lists)).
 
 :- attribute maybe_just/1, children/1.
 
 verify_attributes(_, _, []).
 
+attribute_goals(X) -->
+    { put_atts(X, -maybe_just(_)),
+      put_atts(X, -children(_)) }.
+
 % Implementation of a prefix tree, a.k.a. trie %
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 

src/lib/time.pl

@@ -1,47 +1,11 @@
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-   Written 2020, 2021 by Markus Triska (triska@metalevel.at)
+   Written 2020-2023 by Markus Triska (triska@metalevel.at)
    Part of Scryer Prolog.
-
-   This library provides predicates for reasoning about time.
-
-   current_time(T) yields the current system time in an opaque form,
-   called a time stamp. Use format_time//2 to describe strings that
-   contain attributes of the time stamp.
-
-   The nonterminal format_time//2 describes a list of characters that
-   are formatted according to a format string. Usage:
-
-     phrase(format_time(FormatString, TimeStamp), Cs)
-
-   TimeStamp represents a moment in time in an opaque form, as for
-   example obtained by current_time/1.
-
-   FormatString is a list of characters that are interpreted literally,
-   except for the following specifiers (and possibly more in the future):
-
-     %Y    year of the time stamp. Example: 2020.
-     %m    month number (01-12), zero-padded to 2 digits
-     %d    day number (01-31), zero-padded to 2 digits
-     %H    hour number (00-24), zero-padded to 2 digits
-     %M    minute number (00-59), zero-padded to 2 digits
-     %S    second number (00-60), zero-padded to 2 digits
-     %b    abbreviated month name, always 3 letters
-     %a    abbreviated weekday name, always 3 letters
-     %A    full weekday name
-     %j    day of the year (001-366), zero-padded to 3 digits
-     %%    the literal %
-
-   Example:
-
-     ?- current_time(T), phrase(format_time("%d.%m.%Y (%H:%M:%S)", T), Cs).
-        T = [...], Cs = "11.06.2020 (00:24:32)".
-
-   sleep(S) sleeps for S seconds (a floating point number).
-
-   time(Goal) reports the execution time of Goal.
-
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
+/** This library provides predicates for reasoning about time.
+*/
+
 :- module(time, [max_sleep_time/1, sleep/1, time/1, current_time/1, format_time//2]).
 
 :- use_module(library(format)).
@@ -51,10 +15,51 @@
 :- use_module(library(lists)).
 :- use_module(library(charsio), [read_from_chars/2]).
 
+
+%% current_time(-T)
+%
+%  Yields the current system time _T_ in an opaque form, called a
+%  _time stamp_. Use `format_time//2` to describe strings that contain
+%  attributes of the time stamp.
+
 current_time(T) :-
         '$current_time'(T0),
         read_from_chars(T0, T).
 
+%% format_time(FormatString, TimeStamp)//
+%
+% The nonterminal format_time//2 describes a list of characters that
+% are formatted according to a format string. Usage:
+%
+% ```
+%    phrase(format_time(FormatString, TimeStamp), Cs)
+% ```
+%
+% TimeStamp represents a moment in time in an opaque form, as for
+% example obtained by `current_time/1`.
+%
+% FormatString is a list of characters that are interpreted literally,
+% except for the following specifiers (and possibly more in the future):
+%
+% |  `%Y` |  year of the time stamp. Example: 2020.                |
+% |  `%m` |  month number (01-12), zero-padded to 2 digits         |
+% |  `%d` |  day number (01-31), zero-padded to 2 digits           |
+% |  `%H` |  hour number (00-24), zero-padded to 2 digits          |
+% |  `%M` |  minute number (00-59), zero-padded to 2 digits        |
+% |  `%S` |  second number (00-60), zero-padded to 2 digits        |
+% |  `%b` |  abbreviated month name, always 3 letters              |
+% |  `%a` |  abbreviated weekday name, always 3 letters            |
+% |  `%A` |  full weekday name                                     |
+% |  `%j` |  day of the year (001-366), zero-padded to 3 digits    |
+% |  `%%` |  the literal `%`                                       |
+%
+% Example:
+%
+% ```
+%    ?- current_time(T), phrase(format_time("%d.%m.%Y (%H:%M:%S)", T), Cs).
+%       T = [...], Cs = "11.06.2020 (00:24:32)".
+% ```
+
 format_time([], _) --> [].
 format_time(['%','%'|Fs], T) --> !, "%", format_time(Fs, T).
 format_time(['%',Spec|Fs], T) --> !,
@@ -65,8 +70,17 @@ format_time(['%',Spec|Fs], T) --> !,
         format_time(Fs, T).
 format_time([F|Fs], T) --> [F], format_time(Fs, T).
 
+%% max_sleep_time(T)
+%
+%  The maximum admissible time span for `sleep/1`.
+
 max_sleep_time(0xfffffffffffffbff).
 
+
+%% sleep(S)
+%
+%  Sleeps for S seconds (a floating point number or integer).
+
 sleep(T) :-
     builtins:must_be_number(T, sleep),
     (   T < 0 ->
@@ -82,7 +96,7 @@ sleep(T) :-
 :- meta_predicate time(0).
 
 :- dynamic(time_id/1).
-:- dynamic(time_state/2).
+:- dynamic(time_state/3).
 
 time_next_id(N) :-
         (   retract(time_id(N0)) ->
@@ -91,10 +105,15 @@ time_next_id(N) :-
         ),
         asserta(time_id(N)).
 
+
+%% time(Goal)
+%
+%  Reports the execution time of Goal.
+
 time(Goal) :-
-        '$cpu_now'(T0),
+        cputime_inferences(T0, I0),
         time_next_id(ID),
-        setup_call_cleanup(asserta(time_state(ID, T0)),
+        setup_call_cleanup(asserta(time_state(ID, T0, I0)),
                            (   call_cleanup(catch(Goal, E, (report_time(ID),throw(E))),
                                             Det = true),
                                time_true(ID),
@@ -104,49 +123,72 @@ time(Goal) :-
                            ;   report_time(ID),
                                false
                            ),
-                           retract(time_state(ID, _))).
+                           retract(time_state(ID, _, _))).
+
+cputime_inferences(T, I) :-
+        '$cpu_now'(T),
+        '$inference_count'(I).
 
 time_true(ID) :-
         report_time(ID).
 time_true(ID)  :-
         % on backtracking, update the stored CPU time for this ID
-        retract(time_state(ID, _)),
+        retract(time_state(ID, _, _)),
-        '$cpu_now'(T0),
+        cputime_inferences(T0, I0),
-        asserta(time_state(ID, T0)),
+        asserta(time_state(ID, T0, I0)),
         false.
 
 report_time(ID) :-
-        time_state(ID, T0),
+        time_state(ID, T0, I0),
-        '$cpu_now'(T),
+        cputime_inferences(T, I),
         Time is T - T0,
+        Inferences0 is I - I0,
+        % we must subtract the number of inferences that time/1 itself takes;
+        % this may have to be adapted if the implementation changes,
+        % so that (for example) true/1 takes exactly 1 inference.
         (   bb_get('$answer_count', 0) ->
+            Inferences is Inferences0 - 60,
             Pre = "   ", Post = ""
-        ;   Pre = "", Post = "   "
+        ;   Inferences is Inferences0 - 9,
+            Pre = "", Post = "   "
         ),
-        format("~s% CPU time: ~3fs~n~s", [Pre,Time,Post]).
+        phrase((Pre,"% CPU time: ", format_("~3f", [Time]), "s, ",
+                format_("~U", [Inferences])," inference",s_if_necessary(Inferences),"\n",
+                Post), Cs),
+        format("~s", [Cs]).
+
+s_if_necessary(Inferences) -->
+        { compare(C, 1, Inferences) },
+        s_(C).
+
+s_(=) --> "".
+s_(<) --> "s".
+s_(>) --> " (exception?)".
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 ?- time((true;false)).
-%@    % CPU time: 0.006s
+   % CPU time: 0.000s, 1 inference
-%@    true
+   true
-%@ ;  % CPU time: 0.001s
+;  % CPU time: 0.000s, 0 inference (exception?)
-%@    false.
+   false.
 
 :- time(use_module(library(clpz))).
-%@    % CPU time: 3.711s
+   % CPU time: 0.343s, 409_874 inferences
-%@    true.
+   true.
 
 :- time(use_module(library(lists))).
-%@    % CPU time: 0.006s
+   % CPU time: 0.000s, 19 inferences
-%@    true.
+   true.
 
 ?- time(member(X, "abc")).
-%@    % CPU time: 0.005s
+   % CPU time: 0.000s, 1 inference
-%@    X = a
+   X = a
-%@ ;  % CPU time: 0.000s
+;  % CPU time: 0.000s, 3 inferences
-%@    X = b
+   X = b
-%@ ;  % CPU time: 0.000s
+;  % CPU time: 0.000s, 3 inferences
-%@    X = c
+   X = c.
-%@ ;  % CPU time: 0.000s
+
-%@    false.
+?- time((repeat,false)).
+   % CPU time: 2.726s, 53_330_502 inferences
+   error('$interrupt_thrown',repl/0).
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

src/lib/ugraphs.pl

@@ -53,7 +53,7 @@
             connect_ugraph/3            % +Graph1, -Start, -Graph
           ]).
 
-/** <module> Graph manipulation library
+/** 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
@@ -61,55 +61,56 @@ 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.
+`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
+Ported from SWI-Prolog to Scryer by [Adrián Arroyo Calle](https://adrianistan.eu)
-@author Vitor Santos Costa
+
-@author Jan Wielemaker
+License: BSD-2 or Artistic 2.0
-@license BSD-2 or Artistic 2.0
 */
 
 :- use_module(library(lists)).
 :- use_module(library(pairs)).
 :- use_module(library(ordsets)).
 
-%!  vertices(+Graph, -Vertices)
+%% vertices(+Graph, -Vertices)
 %
-%   Unify Vertices with all vertices appearing in Graph. Example:
+% 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([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.
+%% vertices_edges_to_ugraph(+Vertices, +Edges, -UGraph) is det.
 %
-%   Create a UGraph from Vertices and edges.   Given  a graph with a
+% 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
+% set of Vertices and a set of   Edges,  Graph must unify with the
-%   corresponding S-representation. Note that   the vertices without
+% corresponding S-representation. Note that   the vertices without
-%   edges will appear in Vertices but not  in Edges. Moreover, it is
+% edges will appear in Vertices but not  in Edges. Moreover, it is
-%   sufficient for a vertice to appear in Edges.
+% sufficient for a vertice to appear in Edges.
 %
-%   ==
+% ```
-%   ?- vertices_edges_to_ugraph([],[1-3,2-4,4-5,1-5], L).
+% ?- vertices_edges_to_ugraph([],[1-3,2-4,4-5,1-5], L).
-%   L = [1-[3,5], 2-[4], 3-[], 4-[5], 5-[]]
+%    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:
 %
-%   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([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),
@@ -119,15 +120,15 @@ vertices_edges_to_ugraph(Vertices, Edges, Graph) :-
     p_to_s_group(VertexSet, EdgeSet, Graph).
 
 
-%!  add_vertices(+Graph, +Vertices, -NewGraph)
+%% add_vertices(+Graph, +Vertices, -NewGraph)
 %
-%   Unify NewGraph with a new  graph  obtained   by  adding  the list of
+% Unify NewGraph with a new  graph  obtained   by  adding  the list of
-%   Vertices to Graph. Example:
+% Vertices to Graph. Example:
 %
-%   ```
+% ```
-%   ?- add_vertices([1-[3,5],2-[]], [0,1,2,9], NG).
+% ?- add_vertices([1-[3,5],2-[]], [0,1,2,9], NG).
-%   NG = [0-[], 1-[3,5], 2-[], 9-[]]
+%    NG = [0-[], 1-[3,5], 2-[], 9-[]]
-%   ```
+% ```
 
 % replace with real msort/2 when available
 msort_(List, Sorted) :-
@@ -159,23 +160,18 @@ add_empty_vertices([], []).
 add_empty_vertices([V|G], [V-[]|NG]) :-
     add_empty_vertices(G, NG).
 
-%!  del_vertices(+Graph, +Vertices, -NewGraph) is det.
+%% del_vertices(+Graph, +Vertices, -NewGraph) is det.
 %
-%   Unify NewGraph with a new graph obtained by deleting the list of
+% 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 and all the edges that start from  or go to a vertex in
-%   Vertices to the Graph. Example:
+% Vertices to the Graph. Example:
 %
-%   ==
+% ```
-%   ?- del_vertices([1-[3,5],2-[4],3-[],4-[5],5-[],6-[],7-[2,6],8-[]],
+% ?- del_vertices([1-[3,5],2-[4],3-[],4-[5],5-[],6-[],7-[2,6],8-[]],
-%                   [2,1],
+%               [2,1],
-%                   NL).
+%               NL).
-%   NL = [3-[],4-[5],5-[],6-[],7-[6],8-[]]
+%    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
@@ -204,32 +200,32 @@ 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)
+%% add_edges(+Graph, +Edges, -NewGraph)
 %
-%   Unify NewGraph with a new graph obtained by adding the list of Edges
+% Unify NewGraph with a new graph obtained by adding the list of Edges
-%   to Graph. Example:
+% to Graph. Example:
 %
-%   ```
+% ```
-%   ?- add_edges([1-[3,5],2-[4],3-[],4-[5],
+% ?- add_edges([1-[3,5],2-[4],3-[],4-[5],
-%                 5-[],6-[],7-[],8-[]],
+%             5-[],6-[],7-[],8-[]],
-%                [1-6,2-3,3-2,5-7,3-2,4-5],
+%            [1-6,2-3,3-2,5-7,3-2,4-5],
-%                NL).
+%            NL).
-%   NL = [1-[3,5,6], 2-[3,4], 3-[2], 4-[5],
+%    NL = [1-[3,5,6], 2-[3,4], 3-[2], 4-[5],
-%         5-[7], 6-[], 7-[], 8-[]]
+%     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)
+%% ugraph_union(+Graph1, +Graph2, -NewGraph)
 %
-%   NewGraph is the union of Graph1 and Graph2. Example:
+% NewGraph is the union of Graph1 and Graph2. Example:
 %
-%   ```
+% ```
-%   ?- ugraph_union([1-[2],2-[3]],[2-[4],3-[1,2,4]],L).
+% ?- ugraph_union([1-[2],2-[3]],[2-[4],3-[1,2,4]],L).
-%   L = [1-[2], 2-[3,4], 3-[1,2,4]]
+%    L = [1-[2], 2-[3,4], 3-[1,2,4]]
-%   ```
+% ```
 
 ugraph_union(Set1, [], Set1) :- !.
 ugraph_union([], Set2, Set2) :- !.
@@ -245,25 +241,25 @@ ugraph_union(<, Head1, Tail1, Head2, Tail2, [Head1|Union]) :-
 ugraph_union(>, Head1, Tail1, Head2, Tail2, [Head2|Union]) :-
     ugraph_union([Head1|Tail1], Tail2, Union).
 
-%!  del_edges(+Graph, +Edges, -NewGraph)
+%% del_edges(+Graph, +Edges, -NewGraph)
 %
-%   Unify NewGraph with a new graph  obtained   by  removing the list of
+% Unify NewGraph with a new graph  obtained   by  removing the list of
-%   Edges from Graph. Notice that no vertices are deleted. Example:
+% Edges from Graph. Notice that no vertices are deleted. Example:
 %
-%   ```
+% ```
-%   ?- del_edges([1-[3,5],2-[4],3-[],4-[5],5-[],6-[],7-[],8-[]],
+% ?- 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],
+%            [1-6,2-3,3-2,5-7,3-2,4-5,1-3],
-%                NL).
+%            NL).
-%   NL = [1-[5],2-[4],3-[],4-[],5-[],6-[],7-[],8-[]]
+%    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)
+%% graph_subtract(+Set1, +Set2, ?Difference)
 %
-%   Is based on ord_subtract
+% Is based on `ord_subtract/3`
 
 graph_subtract(Set1, [], Set1) :- !.
 graph_subtract([], _, []).
@@ -279,12 +275,14 @@ graph_subtract(<, Head1, Tail1, Head2, Tail2, [Head1|Difference]) :-
 graph_subtract(>, Head1, Tail1, _,     Tail2, Difference) :-
     graph_subtract([Head1|Tail1], Tail2, Difference).
 
-%!  edges(+Graph, -Edges)
+%% edges(+Graph, -Edges)
 %
-%   Unify Edges with all edges appearing in Graph. Example:
+% 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([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).
@@ -324,15 +322,15 @@ 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)
+%% transitive_closure(+Graph, -Closure)
 %
-%   Generate the graph Closure  as  the   transitive  closure  of Graph.
+% Generate the graph Closure  as  the   transitive  closure  of Graph.
-%   Example:
+% Example:
 %
-%   ```
+% ```
-%   ?- transitive_closure([1-[2,3],2-[4,5],4-[6]],L).
+% ?- transitive_closure([1-[2,3],2-[4,5],4-[6]],L).
-%   L = [1-[2,3,4,5,6], 2-[4,5,6], 4-[6]]
+%    L = [1-[2,3,4,5,6], 2-[4,5,6], 4-[6]]
-%   ```
+% ```
 
 transitive_closure(Graph, Closure) :-
     warshall(Graph, Graph, Closure).
@@ -354,23 +352,18 @@ warshall([X-Neibs|G], V, Y, [X-Neibs|NewG]) :-
     warshall(G, V, Y, NewG).
 warshall([], _, _, []).
 
-%!  transpose_ugraph(Graph, NewGraph) is det.
+%% transpose_ugraph(Graph, NewGraph) is det.
 %
-%   Unify NewGraph with a new graph obtained from Graph by replacing
+% 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
+% 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
+% is O(|V|\*log(|V|)). Notice that an undirected   graph is its own
-%   transpose. Example:
+% transpose. Example:
 %
-%     ==
+% ```
-%     ?- transpose([1-[3,5],2-[4],3-[],4-[5],
+% ?- transpose([1-[3,5],2-[4],3-[],4-[5],
-%                   5-[],6-[],7-[],8-[]], NL).
+%               5-[],6-[],7-[],8-[]], NL).
-%     NL = [1-[],2-[],3-[1],4-[2],5-[1,4],6-[],7-[],8-[]]
+%    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),
@@ -382,13 +375,15 @@ flip_edges([], []).
 flip_edges([Key-Val|Pairs], [Val-Key|Flipped]) :-
     flip_edges(Pairs, Flipped).
 
-%!  compose(+LeftGraph, +RightGraph, -NewGraph)
+%% compose(+LeftGraph, +RightGraph, -NewGraph)
 %
-%   Compose NewGraph by connecting the  _drains_   of  LeftGraph  to the
+% Compose NewGraph by connecting the  _drains_   of  LeftGraph  to the
-%   _sources_ of RightGraph. Example:
+% _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([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),
@@ -423,21 +418,17 @@ 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) is semidet.
-%!  top_sort(+Graph, -Sorted, ?Tail) is semidet.
 %
-%   Sorted is a  topological  sorted  list   of  nodes  in  Graph. A
+% Sorted is a  topological  sorted  list   of  nodes  in  Graph. A
-%   toplogical sort is possible  if  the   graph  is  connected  and
+% toplogical sort is possible  if  the   graph  is  connected  and
-%   acyclic. In the example we show   how  topological sorting works
+% acyclic. In the example we show   how  topological sorting works
-%   for a linear graph:
+% for a linear graph:
 %
-%   ==
+% ```
-%   ?- top_sort([1-[2], 2-[3], 3-[]], L).
+% ?- top_sort([1-[2], 2-[3], 3-[]], L).
-%   L = [1, 2, 3]
+%    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),
@@ -445,6 +436,11 @@ top_sort(Graph, Sorted) :-
     select_zeros(Counts1, Vertices, Zeros),
     top_sort(Zeros, Sorted, Graph, Vertices, Counts1).
 
+%% top_sort(+Graph, -Sorted, ?Tail) is semidet.
+%
+% The  predicate  `top_sort/3`  is  a  difference  list  version  of
+% `top_sort/2`.
+
 top_sort(Graph, Sorted0, Sorted) :-
     vertices_and_zeros(Graph, Vertices, Counts0),
     count_edges(Graph, Vertices, Counts0, Counts1),
@@ -520,17 +516,21 @@ 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.
+%% neighbours(+Vertex, +Graph, -Neigbours) is det.
 %
-%   Neigbours is a sorted list of  the   neighbours  of Vertex in Graph.
+% Neigbours is a sorted list of  the   neighbours  of Vertex in Graph.
-%   Example:
+% Example:
 %
-%   ```
+% ```
-%   ?- neighbours(4,[1-[3,5],2-[4],3-[],
+% ?- neighbours(4,[1-[3,5],2-[4],3-[],
-%                    4-[1,2,7,5],5-[],6-[],7-[],8-[]], NL).
+%                4-[1,2,7,5],5-[],6-[],7-[],8-[]], NL).
-%   NL = [1,2,7,5]
+%    NL = [1,2,7,5]
-%   ```
+% ```
+
+%% neighbors(+Vertex, +Graph, -Neigbours) is det.
+%
+% Same as `neighbours/3`.
 
 neighbors(Vertex, Graph, Neig) :-
     neighbours(Vertex, Graph, Neig).
@@ -542,24 +542,24 @@ neighbours(V,[_|G],Neig) :-
     neighbours(V,G,Neig).
 
 
-%!  connect_ugraph(+UGraphIn, -Start, -UGraphOut) is det.
+%% connect_ugraph(+UGraphIn, -Start, -UGraphOut) is det.
 %
-%   Adds Start as an additional vertex that is connected to all vertices
+% 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
+% 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
+% not connected graph. Start is before any   vertex in UGraphIn in the
-%   standard order of terms.  No vertex in UGraphIn can be a variable.
+% standard order of terms.  No vertex in UGraphIn can be a variable.
 %
-%   Can be used to order a not-connected graph as follows:
+% Can be used to order a not-connected graph as follows:
 %
-%   ```
+% ```
-%   top_sort_unconnected(Graph, Vertices) :-
+% top_sort_unconnected(Graph, Vertices) :-
-%       (   top_sort(Graph, Vertices)
+%   (   top_sort(Graph, Vertices)
-%       ->  true
+%   ->  true
-%       ;   connect_ugraph(Graph, Start, Connected),
+%   ;   connect_ugraph(Graph, Start, Connected),
-%           top_sort(Connected, Ordered0),
+%       top_sort(Connected, Ordered0),
-%           Ordered0 = [Start|Vertices]
+%       Ordered0 = [Start|Vertices]
-%       ).
+%   ).
-%   ```
+% ```
 
 connect_ugraph([], 0, []) :- !.
 connect_ugraph(Graph, Start, [Start-Vertices|Graph]) :-
@@ -567,12 +567,12 @@ connect_ugraph(Graph, Start, [Start-Vertices|Graph]) :-
     Vertices = [First|_],
     before(First, Start).
 
-%!  before(+Term, -Before) is det.
+%% before(+Term, -Before) is det.
 %
-%   Unify Before to a term that comes   before  Term in the standard
+% Unify Before to a term that comes   before  Term in the standard
-%   order of terms.
+% order of terms.
 %
-%   @error instantiation_error if Term is unbound.
+% Throws `instantiation_error` if Term is unbound.
 
 before(X, _) :-
     var(X),
@@ -585,21 +585,22 @@ before(Number, Start) :-
 before(_, 0).
 
 
-%!  complement(+UGraphIn, -UGraphOut)
+%% complement(+UGraphIn, -UGraphOut)
 %
-%   UGraphOut is a ugraph with an  edge   between  all vertices that are
+% UGraphOut is a ugraph with an  edge   between  all vertices that are
-%   _not_ connected in UGraphIn and  all   edges  from UGraphIn removed.
+% _not_ connected in UGraphIn and  all   edges  from UGraphIn removed.
-%   Example:
+% Example:
 %
-%   ```
+% ```
-%   ?- complement([1-[3,5],2-[4],3-[],
+% ?- complement([1-[3,5],2-[4],3-[],
-%                  4-[1,2,7,5],5-[],6-[],7-[],8-[]], NL).
+%              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],
+%    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],
+%     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]]
+%     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.
+
+% TODO: Simple two-step algorithm. You could be smarter, I suppose.
 
 complement(G, NG) :-
     vertices(G,Vs),
@@ -611,13 +612,15 @@ complement([V-Ns|G], Vs, [V-INs|NG]) :-
     ord_subtract(Vs,Ns1,INs),
     complement(G, Vs, NG).
 
-%!  reachable(+Vertex, +UGraph, -Vertices)
+%% reachable(+Vertex, +UGraph, -Vertices)
 %
-%   True when Vertices is  an  ordered   set  of  vertices  reachable in
+% True when Vertices is  an  ordered   set  of  vertices  reachable in
-%   UGraph, including Vertex.  Example:
+% UGraph, including Vertex.  Example:
 %
-%       ?- reachable(1,[1-[3,5],2-[4],3-[],4-[5],5-[]],V).
+% ```
-%       V = [1, 3, 5]
+% ?- 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).

src/lib/uuid.pl

@@ -1,25 +1,32 @@
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    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.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
+/**
+This library provides reasoning and working with [UUID](https://en.wikipedia.org/wiki/Universally_unique_identifier)
+(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|...].
+*/
+
 :- module(uuid, [
     uuidv4/1,
     uuidv4_string/1,
@@ -39,6 +46,10 @@ 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).
+%
+% Generates a new UUID v4 (random). It unifies with a list of bytes.
 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],
@@ -52,8 +63,15 @@ uuidv4(Uuid) :-
     byte_bits(NewTimeHi, NewBitsTimeHi),
     Uuid = [B1, B2, B3, B4, B5, B6, NewTimeHi, B8, NewClockSeqHi0, B10, B11, B12, B13, B14, B15, B16].
 
+%% uuidv4_string(-UuidString).
+%
+% Generates a new UUID v4 (random). It unifies with a string representation of the UUID.
+% It is equivalent of calling `uuidv4/1` followed by `uuid_string/2`.
 uuidv4_string(String) :- uuidv4(Uuid), uuid_string(Uuid, String).
 
+%% uuid_string(?UuidBytes, ?UuidString).
+%
+% Translates between the bytes representation and the string representation of the same UUID.
 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),

src/lib/wasm.pl

@@ -0,0 +1,29 @@
+/** Predicates for the WebAssembly platform
+
+This module contains predicates that are only available in
+the WASM (WebAssembly) version of Scryer Prolog.
+*/
+
+:- module(wasm, [js_eval/2]).
+
+:- use_module(library(error)).
+
+%% js_eval(+JsCode, -Result).
+%
+% Executes a JavaScript snippet `JsCode` using the platform
+% `eval` function. `Result` takes the return value of that code.
+% Strings, booleans, numbers, null and undefined are directly mapped to Prolog.
+% Arrays, objects, bigints, symbols and functions are not mapped.
+% Instead, a `js_{type}` atom will be returned.
+%
+% Example (on a browser):
+%
+% ```
+% ?- js_eval("prompt('What is your name?')", Name).
+%    % A prompt is showed, with a textbox.
+%    Name = "Whatever was written on the textbox".
+% ```
+js_eval(JsCode, Result) :-
+    must_be(chars, JsCode),
+    can_be(chars, Result),
+    '$js_eval'(JsCode, Result).

src/lib/when.pl

@@ -0,0 +1,106 @@
+/**
+Provides the predicate `when/2`.
+*/
+
+:- module(when, [when/2]).
+
+:- use_module(library(atts)).
+:- use_module(library(dcgs)).
+:- use_module(library(lists)).
+:- use_module(library(lambda)).
+
+:- use_module(library(format)).
+:- use_module(library(debug)).
+
+:- attribute when_list/1.
+
+:- meta_predicate(when(+, 0)).
+
+%% when(Condition, Goal).
+%
+% Executes Goal when Condition becomes true.
+when(Condition, Goal) :-
+    (   when_condition(Condition) ->
+        (   Condition ->
+            Goal
+        ;   term_variables(Condition, Vars),
+            maplist(
+                [Goal, Condition]+\Var^(
+                    get_atts(Var, when_list(Whens0)) ->
+                    Whens = [when(Condition, Goal) | Whens0],
+                    put_atts(Var, when_list(Whens))
+                ;   put_atts(Var, when_list([when(Condition, Goal)]))
+                ),
+                Vars
+            )
+        )
+    ;   throw(error(domain_error(when_condition, Condition),_))
+    ).
+
+when_condition(Cond) :-
+    % Should this be delayed?
+    var(Cond), !, throw(error(instantiation_error,when_condition/1)).
+when_condition(ground(_)).
+when_condition(nonvar(_)).
+when_condition((A, B)) :-
+    when_condition(A),
+    when_condition(B).
+when_condition((A ; B)) :-
+    when_condition(A),
+    when_condition(B).
+
+remove_goal([], _, []).
+remove_goal([G0|G0s], Goal, Goals) :-
+    (   G0 == Goal ->
+        remove_goal(G0s, Goal, Goals)
+    ;   Goals = [G0|Goals1],
+        remove_goal(G0s, Goal, Goals1)
+    ).
+
+vars_remove_goal(Vars, Goal) :-
+    maplist(
+        Goal+\Var^(
+            get_atts(Var, when_list(Whens0)) ->
+            remove_goal(Whens0, Goal, Whens),
+            (   Whens = [] ->
+                put_atts(Var, -when_list(_))
+            ;   put_atts(Var, when_list(Whens))
+            )
+        ;   true
+        ),
+        Vars
+    ).
+
+reinforce_goal(Goal0, Goal) :-
+    Goal = (
+        term_variables(Goal0, Vars),
+        when:vars_remove_goal(Vars, Goal0),
+        Goal0
+    ).
+
+verify_attributes(Var, Value, Goals) :-
+    (   get_atts(Var, when_list(Whens)) ->
+        (   var(Value) ->
+            (   get_atts(Value, when_list(WhensValue)) ->
+                append(Whens, WhensValue, WhensNew),
+                put_atts(Value, when_list(WhensNew))
+            ;   put_atts(Value, when_list(Whens))
+            ),
+            Goals = []
+        ;   maplist(reinforce_goal, Whens, Goals)
+        )
+    ;   Goals = []
+    ).
+
+gather_when_goals([], _) --> [].
+gather_when_goals([When|Whens], Var) -->
+    ( { term_variables(When, [V0|_]), Var == V0 } ->
+        [when:When]
+    ;   []
+    ),
+    gather_when_goals(Whens, Var).
+
+attribute_goals(Var) -->
+    { get_atts(Var, when_list(Whens)) },
+    gather_when_goals(Whens, Var),
+    { put_atts(Var, -when_list(_)) }.

src/lib/xpath.pl

@@ -95,219 +95,221 @@
             op(200, fy, @)
           ]).
 
-:- use_module(library(lists),[member/2,memberchk/2]).
+:- use_module(library(lists),[member/2,memberchk/2,reverse/2]).
+:- use_module(library(charsio)).
 :- use_module(library(error)).
 :- use_module(library(dcgs)).
 :- use_module(library(si)).
 
-/** <module> Select nodes in an XML DOM
+/** Select nodes in an XML DOM
 
 The library xpath.pl provides predicates to select nodes from an XML DOM
-tree as produced by library(sgml) based  on descriptions inspired by the
+tree as produced by `library(sgml)` based  on descriptions inspired by the
-XPath language.
+[XPath language](http://www.w3.org/TR/xpath).
 
-The   predicate   xpath/3   selects   a   sub-structure   of   the   DOM
+The   predicate   `xpath/3`   selects   a   sub-structure   of   the   DOM
 non-deterministically based on an  XPath-like   specification.  Not  all
-selectors of XPath are implemented, but the ability to mix xpath/3 calls
+selectors of XPath are implemented, but the ability to mix `xpath/3` calls
 with arbitrary Prolog code  provides  a   powerful  tool  for extracting
 information from XML parse-trees.
-
-@see http://www.w3.org/TR/xpath
 */
 
 element_name(element(Name,_,_), Name).
 element_attributes(element(_,Attributes,_), Attributes).
 element_content(element(_,_,Content), Content).
 
-%!  xpath_chk(+DOM, +Spec, ?Content) is semidet.
+%% xpath_chk(+DOM, +Spec, ?Content) is semidet.
 %
-%   Semi-deterministic version of xpath/3.
+% Semi-deterministic version of `xpath/3`.
 
 xpath_chk(DOM, Spec, Content) :-
     xpath(DOM, Spec, Content),
     !.
 
-%!  xpath(+DOM, +Spec, ?Content) is nondet.
+%% xpath(+DOM, +Spec, ?Content) is nondet.
 %
-%   Match an element in a DOM structure.   The syntax is inspired by
+% Match an element in a DOM structure.   The syntax is inspired by
-%   XPath, using () rather than  []   to  select  inside an element.
+% XPath, using () rather than  []   to  select  inside an element.
-%   First we can construct paths using / and //:
+% First we can construct paths using / and //:
 %
-%       $ =|//|=Term :
+% - *//Term*
-%       Select any node in the DOM matching term.
+%   Select any node in the DOM matching term.
-%       $ =|/|=Term :
-%       Match the root against Term.
-%       $ Term :
-%       Select the immediate children of the root matching Term.
 %
-%   The Terms above are of type   _callable_.  The functor specifies
+% - */Term*
-%   the element name. The element name   '*'  refers to any element.
+%   Match the root against Term.
-%   The name =self= refers to the   top-element  itself and is often
-%   used for processing matches of an  earlier xpath/3 query. A term
-%   NS:Term refers to an XML  name   in  the  namespace NS. Optional
-%   arguments specify additional  constraints   and  functions.  The
-%   arguments are processed from left  to right. Defined conditional
-%   argument values are:
 %
-%       $ index(?Index) :
+% - *Term*
-%       True if the element is the Index-th child of its parent,
+%   Select the immediate children of the root matching Term.
-%       where 1 denotes the first child. Index can be one of:
-%         $ `Var` :
-%         `Var` is unified with the index of the matched element.
-%         $ =last= :
-%         True for the last element.
-%         $ =last= - `IntExpr` :
-%         True for the last-minus-nth element. For example,
-%         `last-1` is the element directly preceding the last one.
-%         $ `IntExpr` :
-%         True for the element whose index equals `IntExpr`.
-%       $ Integer :
-%       The N-th element with the given name, with 1 denoting the
-%       first element. Same as index(Integer).
-%       $ =last= :
-%       The last element with the given name. Same as
-%       index(last).
-%       $ =last= - IntExpr :
-%       The IntExpr-th element before the last.
-%       Same as index(last-IntExpr).
 %
-%   Defined function argument values are:
+% The Terms above are of type   _callable_.  The functor specifies
+% the element name. The element name   `*`  refers to any element.
+% The name _self_ refers to the   top-element  itself and is often
+% used for processing matches of an  earlier `xpath/3` query. A term
+% NS:Term refers to an XML  name   in  the  namespace NS. Optional
+% arguments specify additional  constraints   and  functions.  The
+% arguments are processed from left  to right. Defined conditional
+% argument values are:
 %
-%       $ =self= :
+% - *`index(?Index)`*
-%       Evaluate to the entire element
+%   True if the element is the Index-th child of its parent,
-%       $ =content= :
+%   where 1 denotes the first child. Index can be one of:
-%       Evaluate to the content of the element (a list)
-%       $ =text= :
-%       Evaluates to all text from the sub-tree, represented
-%       as a list of characters.
-%       $ `text(atom)` :
-%       Evaluates to all text from the sub-tree as an atom.
-%       $ =normalize_space= :
-%       As =text=, but uses normalize_space/2 to normalise
-%       white-space in the output
-%       $ =number= :
-%       Extract an integer or float from the value.  Ignores
-%       leading and trailing white-space
-%       $ =|@|=Attribute :
-%       Evaluates to the value of the given attribute.  Attribute
-%       can be a compound term. In this case the functor name
-%       denotes the element and arguments perform transformations
-%       on the attribute value.  Defined transformations are:
 %
-%         - number
+%  - *`Var`*
-%         Translate the value into a number using
+%    `Var` is unified with the index of the matched element.
-%         xsd_number_chars/2.
+%  - *`last`*
-%         - integer
+%    True for the last element.
-%         As `number`, but subsequently transform the value
+%  - *`last - IntExpr`*
-%         into an integer using the round/1 function.
+%    True for the last-minus-nth element. For example,
-%         - float
+%    `last-1` is the element directly preceding the last one.
-%         As `number`, but subsequently transform the value
+%  - *`IntExpr`*
-%         into a float using the float/1 function.
+%    True for the element whose index equals `IntExpr`.
-%         - lower
+% - *`Integer`*
-%         Translate the value to lower case, preserving
+%   The N-th element with the given name, with 1 denoting the
-%         the type.
+%   first element. Same as `index(Integer)`.
-%         - upper
+% - *`last`*
-%         Translate the value to upper case, preserving
+%   The last element with the given name. Same as
-%         the type.
+%   `index(last)`.
+% - *`last - IntExpr`*
+%   The IntExpr-th element before the last.
+%   Same as `index(last-IntExpr)`.
 %
-%   In addition, the argument-list can be _conditions_:
+% Defined function argument values are:
 %
-%       $ Left = Right :
+% - *`self`*
-%       Succeeds if the left-hand unifies with the right-hand.
+%   Evaluate to the entire element
-%       If the left-hand side is a function, this is evaluated.
+% - *`content`*
-%       The right-hand side is _never_ evaluated, and thus the
+%   Evaluate to the content of the element (a list)
-%       condition `content = content` defines that the content
+% - *`text`*
-%       of the element is the atom `content`.
+%   Evaluates to all text from the sub-tree, represented
-%       The functions `lower_case` and `upper_case` can be applied
+%   as a list of characters.
-%       to Right (see example below).
+% - *`text(atom)`*
-%       $ contains(Haystack, Needle) :
+%   Evaluates to all text from the sub-tree as an atom.
-%       Succeeds if Needle is a sub-list of Haystack.
+% - *`normalize_space`*
-%       $ XPath :
+%   As `text`, but uses `normalize_space/2` to normalise
-%       Succeeds if XPath matches in the currently selected
+%   white-space in the output
-%       sub-DOM.  For example, the following expression finds
+% - *`number`*
-%       an =h3= element inside a =div= element, where the =div=
+%   Extract an integer or float from the value.  Ignores
-%       element itself contains an =h2= child with a =strong=
+%   leading and trailing white-space
-%       child.
+% - *`@Attribute`*
+%   Evaluates to the value of the given attribute.  Attribute
+%   can be a compound term. In this case the functor name
+%   denotes the element and arguments perform transformations
+%   on the attribute value.  Defined transformations are:
 %
-%         ==
+%   - *`number`*
-%         //div(h2/strong)/h3
+%     Translate the value into a number using
-%         ==
+%     `xsd_number_chars/2`.
+%   - *`integer`*
+%     As `number`, but subsequently transform the value
+%     into an integer using the `round/1` function.
+%   - *`float`*
+%     As `number`, but subsequently transform the value
+%     into a float using the `float/1` function.
+%   - *`lower`*
+%     Translate the value to lower case, preserving
+%     the type.
+%   - *`upper`*
+%     Translate the value to upper case, preserving
+%     the type.
 %
-%       This is equivalent to the conjunction of XPath goals below.
+% In addition, the argument-list can be _conditions_:
 %
-%         ==
+% - *`Left = Right`*
-%            ...,
+%   Succeeds if the left-hand unifies with the right-hand.
-%            xpath(DOM, //(div), Div),
+%   If the left-hand side is a function, this is evaluated.
-%            xpath(Div, h2/strong, _),
+%   The right-hand side is _never_ evaluated, and thus the
-%            xpath(Div, h3, Result)
+%   condition `content = content` defines that the content
-%         ==
+%   of the element is the atom `content`.
+%   The functions `lower_case` and `upper_case` can be applied
+%   to Right (see example below).
+% - *`contains(Haystack, Needle)`*
+%   Succeeds if Needle is a sub-list of Haystack.
+% - *`XPath`*
+%   Succeeds if XPath matches in the currently selected
+%   sub-DOM.  For example, the following expression finds
+%   an `h3` element inside a `div` element, where the `div`
+%   element itself contains an `h2` child with a `strong`
+%   child.
 %
-%   **Examples**:
+%   ```
+%   //div(h2/strong)/h3
+%   ```
 %
-%   Match each table-row in DOM:
+%   This is equivalent to the conjunction of XPath goals below.
 %
-%       ==
+%   ```
-%       xpath(DOM, //tr, TR)
+%   ...,
-%       ==
+%   xpath(DOM, //(div), Div),
+%   xpath(Div, h2/strong, _),
+%   xpath(Div, h3, Result)
+%   ```
 %
-%   Match the last cell  of  each   tablerow  in  DOM.  This example
+% #### Examples
-%   illustrates that a result can be the input of subsequent xpath/3
-%   queries. Using multiple queries  on   the  intermediate  TR term
-%   guarantee that all results come from the same table-row:
 %
-%       ==
+% Match each table-row in DOM:
-%       xpath(DOM, //tr, TR),
-%       xpath(TR,  /td(last), TD)
-%       ==
 %
-%   Match each =href= attribute in an <a> element
+% ```
+% xpath(DOM, //tr, TR)
+% ```
 %
-%       ==
+% Match the last cell  of  each   tablerow  in  DOM.  This example
-%       xpath(DOM, //a(@href), HREF)
+% illustrates that a result can be the input of subsequent `xpath/3`
-%       ==
+% queries. Using multiple queries  on   the  intermediate  TR term
+% guarantee that all results come from the same table-row:
 %
-%   Suppose we have a table containing  rows where each first column
+% ```
-%   is the name of a product with a   link to details and the second
+% xpath(DOM, //tr, TR),
-%   is the price (a number).  The   following  predicate matches the
+% xpath(TR,  /td(last), TD)
-%   name, URL and price:
+% ```
 %
-%       ==
+% Match each `href` attribute in an `<a>` element
-%       product(DOM, Name, URL, Price) :-
-%           xpath(DOM, //tr, TR),
-%           xpath(TR, td(1), C1),
-%           xpath(C1, /self(normalize_space), Name),
-%           xpath(C1, a(@href), URL),
-%           xpath(TR, td(2, number), Price).
-%       ==
 %
-%   Suppose we want to select  books   with  genre="thriller" from a
+% ```
-%   tree containing elements =|<book genre=...>|=
+% xpath(DOM, //a(@href), HREF)
+% ```
 %
-%       ==
+% Suppose we have a table containing  rows where each first column
-%       thriller(DOM, Book) :-
+% is the name of a product with a   link to details and the second
-%           xpath(DOM, //book(@genre=thiller), Book).
+% is the price (a number).  The   following  predicate matches the
-%       ==
+% name, URL and price:
 %
-%   Match the elements =|<table align="center">|= _and_ =|<table
+% ```
-%   align="CENTER">|=:
+% product(DOM, Name, URL, Price) :-
+%     xpath(DOM, //tr, TR),
+%     xpath(TR, td(1), C1),
+%     xpath(C1, /self(normalize_space), Name),
+%     xpath(C1, a(@href), URL),
+%     xpath(TR, td(2, number), Price).
+% ```
 %
-%       ```prolog
+% Suppose we want to select  books   with  genre="thriller" from a
-%           //table(@align(lower) = center)
+% tree containing elements `<book genre=...>`
-%       ```
 %
-%   Get the `width` and `height` of a `div` element as a number,
+% ```
-%   and the `div` node itself:
+% thriller(DOM, Book) :-
+%     xpath(DOM, //book(@genre=thiller), Book).
+% ```
 %
-%       ==
+% Match the elements `<table align="center">` _and_ `<table
-%           xpath(DOM, //div(@width(number)=W, @height(number)=H), Div)
+% align="CENTER">`:
-%       ==
 %
-%   Note that `div` is an infix operator, so parentheses must be
+% ```
-%   used in cases like the following:
+% //table(@align(lower) = center)
+% ```
 %
-%       ==
+% Get the `width` and `height` of a `div` element as a number,
-%           xpath(DOM, //(div), Div)
+% and the `div` node itself:
-%       ==
+%
+% ```
+% xpath(DOM, //div(@width(number)=W, @height(number)=H), Div)
+% ```
+%
+% Note that `div` is an infix operator, so parentheses must be
+% used in cases like the following:
+%
+% ```
+% xpath(DOM, //(div), Div)
+% ```
 
 xpath(DOM, Spec, Content) :-
     in_dom(Spec, DOM, Content).
@@ -635,5 +637,27 @@ text_of_1([C|Cs]) --> seq([C|Cs]).
 xsd_number_chars(Number, Chars) :-
         number_chars(Number, Chars).
 
-normalize_space(Text0, Text) :-
+normalize_space(Cs0, Cs) :-
-        Text0 = Text.           % no conversion for the moment.
+        must_be(chars, Cs0),
+        no_leading_whitespace(Cs0, Cs1),
+        reverse(Cs1, Cs2),
+        no_leading_whitespace(Cs2, Cs3),
+        reverse(Cs3, Cs4),
+        single_intermediate_space(Cs4, Cs).
+
+no_leading_whitespace([], []).
+no_leading_whitespace([C0|Cs0], Cs) :-
+        (   char_type(C0, whitespace) ->
+            no_leading_whitespace(Cs0, Cs)
+        ;   Cs = [C0|Cs0]
+        ).
+
+single_intermediate_space([], []).
+single_intermediate_space([C0|Cs0], [C|Cs]) :-
+        (   char_type(C0, whitespace) ->
+            no_leading_whitespace(Cs0, Cs1),
+            C = ' ',
+            single_intermediate_space(Cs1, Cs)
+        ;   C = C0,
+            single_intermediate_space(Cs0, Cs)
+        ).

src/machine/args.rs

@@ -14,3 +14,9 @@ impl MachineArgs {
         }
     }
 }
+
+impl Default for MachineArgs {
+    fn default() -> Self {
+        Self::new()
+    }
+}

src/machine/arithmetic_ops.rs

@@ -1,4 +1,8 @@
+use dashu::base::{Abs, Gcd, Signed, UnsignedAbs};
+use dashu::integer::fast_div::ConstDivisor;
+use dashu::integer::IBig;
 use divrem::*;
+use num_order::NumOrd;
 
 use crate::arena::*;
 use crate::arithmetic::*;
@@ -8,7 +12,7 @@ use crate::heap_iter::*;
 use crate::machine::machine_errors::*;
 use crate::machine::machine_state::*;
 use crate::parser::ast::*;
-use crate::parser::rug::{Integer, Rational};
+use crate::parser::dashu::{Integer, Rational};
 use crate::types::*;
 
 use crate::fixnum;
@@ -47,9 +51,7 @@ macro_rules! drop_iter_on_err {
     };
 }
 
-fn zero_divisor_eval_error(
+fn zero_divisor_eval_error(stub_gen: impl Fn() -> FunctorStub + 'static) -> MachineStubGen {
-    stub_gen: impl Fn() -> FunctorStub + 'static,
-) -> MachineStubGen {
     Box::new(move |machine_st| {
         let eval_error = machine_st.evaluation_error(EvalError::ZeroDivisor);
         let stub = stub_gen();
@@ -58,9 +60,7 @@ fn zero_divisor_eval_error(
     })
 }
 
-fn undefined_eval_error(
+fn undefined_eval_error(stub_gen: impl Fn() -> FunctorStub + 'static) -> MachineStubGen {
-    stub_gen: impl Fn() -> FunctorStub + 'static,
-) -> MachineStubGen {
     Box::new(move |machine_st| {
         let eval_error = machine_st.evaluation_error(EvalError::Undefined);
         let stub = stub_gen();
@@ -84,18 +84,18 @@ fn numerical_type_error(
 
 fn isize_gcd(n1: isize, n2: isize) -> Option<isize> {
     if n1 == 0 {
-        return n2.checked_abs().map(|n| n as isize);
+        return n2.checked_abs();
     }
 
     if n2 == 0 {
-        return n1.checked_abs().map(|n| n as isize);
+        return n1.checked_abs();
     }
 
     let n1 = n1.checked_abs();
     let n2 = n2.checked_abs();
 
-    let mut n1 = if let Some(n1) = n1 { n1 } else { return None };
+    let mut n1 = n1?;
-    let mut n2 = if let Some(n2) = n2 { n2 } else { return None };
+    let mut n2 = n2?;
 
     let mut shift = 0;
 
@@ -115,9 +115,7 @@ fn isize_gcd(n1: isize, n2: isize) -> Option<isize> {
         }
 
         if n1 > n2 {
-            let t = n2;
+            std::mem::swap(&mut n2, &mut n1);
-            n2 = n1;
-            n1 = t;
         }
 
         n2 -= n1;
@@ -159,16 +157,14 @@ pub(crate) fn add(lhs: Number, rhs: Number, arena: &mut Arena) -> Result<Number,
             Ok(Number::Float(add_f(float_fn_to_f(n1.get_num())?, n2)?))
         }
         (Number::Integer(n1), Number::Integer(n2)) => {
-            Ok(Number::arena_from(Integer::from(&*n1) + &*n2, arena)) // add_i
+            Ok(Number::arena_from(&*n1 + &*n2, arena)) // add_i
         }
         (Number::Integer(n1), Number::Float(OrderedFloat(n2)))
         | (Number::Float(OrderedFloat(n2)), Number::Integer(n1)) => {
             Ok(Number::Float(add_f(float_i_to_f(&n1)?, n2)?))
         }
         (Number::Integer(n1), Number::Rational(n2))
-        | (Number::Rational(n2), Number::Integer(n1)) => {
+        | (Number::Rational(n2), Number::Integer(n1)) => Ok(Number::arena_from(&*n1 + &*n2, arena)),
-            Ok(Number::arena_from(Rational::from(&*n1) + &*n2, arena))
-        }
         (Number::Rational(n1), Number::Float(OrderedFloat(n2)))
         | (Number::Float(OrderedFloat(n2)), Number::Rational(n1)) => {
             Ok(Number::Float(add_f(float_r_to_f(&n1)?, n2)?))
@@ -176,9 +172,7 @@ pub(crate) fn add(lhs: Number, rhs: Number, arena: &mut Arena) -> Result<Number,
         (Number::Float(OrderedFloat(f1)), Number::Float(OrderedFloat(f2))) => {
             Ok(Number::Float(add_f(f1, f2)?))
         }
-        (Number::Rational(r1), Number::Rational(r2)) => {
+        (Number::Rational(r1), Number::Rational(r2)) => Ok(Number::arena_from(&*r1 + &*r2, arena)),
-            Ok(Number::arena_from(Rational::from(&*r1) + &*r2, arena))
-        }
     }
 }
 
@@ -191,9 +185,15 @@ pub(crate) fn neg(n: Number, arena: &mut Arena) -> Number {
                 Number::arena_from(-Integer::from(n.get_num()), arena)
             }
         }
-        Number::Integer(n) => Number::arena_from(-Integer::from(&*n), arena),
+        Number::Integer(n) => {
+            let n_clone: Integer = (*n).clone();
+            Number::arena_from(-Integer::from(n_clone), arena)
+        }
         Number::Float(OrderedFloat(f)) => Number::Float(OrderedFloat(-f)),
-        Number::Rational(r) => Number::arena_from(-Rational::from(&*r), arena),
+        Number::Rational(r) => {
+            let r_clone: Rational = (*r).clone();
+            Number::arena_from(-Rational::from(r_clone), arena)
+        }
     }
 }
 
@@ -203,12 +203,19 @@ pub(crate) fn abs(n: Number, arena: &mut Arena) -> Number {
             if let Some(n) = n.get_num().checked_abs() {
                 fixnum!(Number, n, arena)
             } else {
-                Number::arena_from(Integer::from(n.get_num()).abs(), arena)
+                let arena_int = Integer::from(n.get_num());
+                Number::arena_from(arena_int.abs(), arena)
             }
         }
-        Number::Integer(n) => Number::arena_from(Integer::from(n.abs_ref()), arena),
+        Number::Integer(n) => {
+            let n_clone: Integer = (*n).clone();
+            Number::arena_from(Integer::from(n_clone.abs()), arena)
+        }
         Number::Float(f) => Number::Float(f.abs()),
-        Number::Rational(r) => Number::arena_from(Rational::from(r.abs_ref()), arena),
+        Number::Rational(r) => {
+            let r_clone: Rational = (*r).clone();
+            Number::arena_from(Rational::from(r_clone.abs()), arena)
+        }
     }
 }
 
@@ -247,7 +254,8 @@ pub(crate) fn mul(lhs: Number, rhs: Number, arena: &mut Arena) -> Result<Number,
             Ok(Number::Float(mul_f(float_fn_to_f(n1.get_num())?, n2)?))
         }
         (Number::Integer(n1), Number::Integer(n2)) => {
-            Ok(Number::arena_from(Integer::from(&*n1) * &*n2, arena)) // mul_i
+            let n1_clone: Integer = (*n1).clone();
+            Ok(Number::arena_from(Integer::from(n1_clone) * &*n2, arena)) // mul_i
         }
         (Number::Integer(n1), Number::Float(OrderedFloat(n2)))
         | (Number::Float(OrderedFloat(n2)), Number::Integer(n1)) => {
@@ -255,7 +263,8 @@ pub(crate) fn mul(lhs: Number, rhs: Number, arena: &mut Arena) -> Result<Number,
         }
         (Number::Integer(n1), Number::Rational(n2))
         | (Number::Rational(n2), Number::Integer(n1)) => {
-            Ok(Number::arena_from(Rational::from(&*n1) * &*n2, arena))
+            let n1_clone: Integer = (*n1).clone();
+            Ok(Number::arena_from(Rational::from(n1_clone) * &*n2, arena))
         }
         (Number::Rational(n1), Number::Float(OrderedFloat(n2)))
         | (Number::Float(OrderedFloat(n2)), Number::Rational(n1)) => {
@@ -265,7 +274,8 @@ pub(crate) fn mul(lhs: Number, rhs: Number, arena: &mut Arena) -> Result<Number,
             Ok(Number::Float(mul_f(f1, f2)?))
         }
         (Number::Rational(r1), Number::Rational(r2)) => {
-            Ok(Number::arena_from(Rational::from(&*r1) * &*r2, arena))
+            let r1_clone: Rational = (*r1).clone();
+            Ok(Number::arena_from(Rational::from(r1_clone) * &*r2, arena))
         }
     }
 }
@@ -338,18 +348,18 @@ pub(crate) fn int_pow(n1: Number, n2: Number, arena: &mut Arena) -> Result<Numbe
         (Number::Fixnum(n1), Number::Integer(n2)) => {
             let n1_i = n1.get_num();
 
-            if !(n1_i == 1 || n1_i == 0 || n1_i == -1) && &*n2 < &0 {
+            if !(n1_i == 1 || n1_i == 0 || n1_i == -1) && n2.is_negative() {
                 let n = Number::Fixnum(n1);
                 Err(numerical_type_error(ValidType::Float, n, stub_gen))
             } else {
                 let n1 = Integer::from(n1_i);
-                Ok(Number::arena_from(binary_pow(n1, &*n2), arena))
+                Ok(Number::arena_from(binary_pow(n1, &n2), arena))
             }
         }
         (Number::Integer(n1), Number::Fixnum(n2)) => {
             let n2_i = n2.get_num();
 
-            if !(&*n1 == &1 || &*n1 == &0 || &*n1 == &-1) && n2_i < 0 {
+            if !(n1.is_one() || n1.is_zero() || n1.num_eq(&-1)) && n2_i < 0 {
                 let n = Number::Integer(n1);
                 Err(numerical_type_error(ValidType::Float, n, stub_gen))
             } else {
@@ -358,11 +368,11 @@ pub(crate) fn int_pow(n1: Number, n2: Number, arena: &mut Arena) -> Result<Numbe
             }
         }
         (Number::Integer(n1), Number::Integer(n2)) => {
-            if !(&*n1 == &1 || &*n1 == &0 || &*n1 == &-1) && &*n2 < &0 {
+            if !(n1.is_one() || n1.is_zero() || n1.num_eq(&-1)) && n2.is_negative() {
                 let n = Number::Integer(n1);
                 Err(numerical_type_error(ValidType::Float, n, stub_gen))
             } else {
-                Ok(Number::arena_from(binary_pow((*n1).clone(), &*n2), arena))
+                Ok(Number::arena_from(binary_pow((*n1).clone(), &n2), arena))
             }
         }
         (n1, Number::Integer(n2)) => {
@@ -435,14 +445,14 @@ pub(crate) fn max(n1: Number, n2: Number) -> Result<Number, MachineStubGen> {
             }
         }
         (Number::Fixnum(n1), Number::Integer(n2)) => {
-            if &*n2 > &n1.get_num() {
+            if (*n2).num_gt(&n1.get_num()) {
                 Ok(Number::Integer(n2))
             } else {
                 Ok(Number::Fixnum(n1))
             }
         }
         (Number::Integer(n1), Number::Fixnum(n2)) => {
-            if &*n1 > &n2.get_num() {
+            if (*n1).num_gt(&n2.get_num()) {
                 Ok(Number::Integer(n1))
             } else {
                 Ok(Number::Fixnum(n2))
@@ -479,14 +489,14 @@ pub(crate) fn min(n1: Number, n2: Number) -> Result<Number, MachineStubGen> {
             }
         }
         (Number::Fixnum(n1), Number::Integer(n2)) => {
-            if &*n2 < &n1.get_num() {
+            if (*n2).num_lt(&n1.get_num()) {
                 Ok(Number::Integer(n2))
             } else {
                 Ok(Number::Fixnum(n1))
             }
         }
         (Number::Integer(n1), Number::Fixnum(n2)) => {
-            if &*n1 < &n2.get_num() {
+            if (*n1).num_lt(&n2.get_num()) {
                 Ok(Number::Integer(n1))
             } else {
                 Ok(Number::Fixnum(n2))
@@ -521,7 +531,7 @@ pub fn rational_from_number(
     match n {
         Number::Fixnum(n) => Ok(arena_alloc!(Rational::from(n.get_num()), arena)),
         Number::Rational(r) => Ok(r),
-        Number::Float(OrderedFloat(f)) => match Rational::from_f64(f) {
+        Number::Float(OrderedFloat(f)) => match Rational::simplest_from_f64(f) {
             Some(r) => Ok(arena_alloc!(r, arena)),
             None => Err(Box::new(move |machine_st| {
                 let instantiation_error = machine_st.instantiation_error();
@@ -530,7 +540,10 @@ pub fn rational_from_number(
                 machine_st.error_form(instantiation_error, stub)
             })),
         },
-        Number::Integer(n) => Ok(arena_alloc!(Rational::from(&*n), arena)),
+        Number::Integer(n) => {
+            let n_clone: Integer = (*n).clone();
+            Ok(arena_alloc!(Rational::from(n_clone), arena))
+        }
     }
 }
 
@@ -538,7 +551,7 @@ pub(crate) fn rdiv(
     r1: TypedArenaPtr<Rational>,
     r2: TypedArenaPtr<Rational>,
 ) -> Result<Rational, MachineStubGen> {
-    if &*r2 == &0 {
+    if r2.is_zero() {
         let stub_gen = || {
             let rdiv_atom = atom!("rdiv");
             functor_stub(rdiv_atom, 2)
@@ -560,19 +573,17 @@ pub(crate) fn idiv(n1: Number, n2: Number, arena: &mut Arena) -> Result<Number,
         (Number::Fixnum(n1), Number::Fixnum(n2)) => {
             if n2.get_num() == 0 {
                 Err(zero_divisor_eval_error(stub_gen))
+            } else if let Some(result) = n1.get_num().checked_div(n2.get_num()) {
+                Ok(Number::arena_from(result, arena))
             } else {
-                if let Some(result) = n1.get_num().checked_div(n2.get_num()) {
+                let n1 = Integer::from(n1.get_num());
-                    Ok(Number::arena_from(result, arena))
+                let n2 = Integer::from(n2.get_num());
-                } else {
-                    let n1 = Integer::from(n1.get_num());
-                    let n2 = Integer::from(n2.get_num());
 
-                    Ok(Number::arena_from(n1 / n2, arena))
+                Ok(Number::arena_from(n1 / n2, arena))
-                }
             }
         }
         (Number::Fixnum(n1), Number::Integer(n2)) => {
-            if &*n2 == &0 {
+            if n2.is_zero() {
                 Err(zero_divisor_eval_error(stub_gen))
             } else {
                 Ok(Number::arena_from(Integer::from(n1) / &*n2, arena))
@@ -586,13 +597,10 @@ pub(crate) fn idiv(n1: Number, n2: Number, arena: &mut Arena) -> Result<Number,
             }
         }
         (Number::Integer(n1), Number::Integer(n2)) => {
-            if &*n2 == &0 {
+            if n2.is_zero() {
                 Err(zero_divisor_eval_error(stub_gen))
             } else {
-                Ok(Number::arena_from(
+                Ok(Number::arena_from(&*n1 / &*n2, arena))
-                    <(Integer, Integer)>::from(n1.div_rem_ref(&*n2)).0,
-                    arena,
-                ))
             }
         }
         (Number::Fixnum(_), n2) | (Number::Integer(_), n2) => {
@@ -624,6 +632,10 @@ pub(crate) fn shr(n1: Number, n2: Number, arena: &mut Arena) -> Result<Number, M
         functor_stub(shr_atom, 2)
     };
 
+    if n2.is_integer() && n2.is_negative() {
+        return shl(n1, neg(n2, arena), arena);
+    }
+
     match (n1, n2) {
         (Number::Fixnum(n1), Number::Fixnum(n2)) => {
             let n1_i = n1.get_num();
@@ -631,34 +643,40 @@ pub(crate) fn shr(n1: Number, n2: Number, arena: &mut Arena) -> Result<Number, M
 
             let n1 = Integer::from(n1_i);
 
-            if let Ok(n2) = u32::try_from(n2_i) {
+            if let Ok(n2) = usize::try_from(n2_i) {
-                return Ok(Number::arena_from(n1 >> n2, arena));
+                Ok(Number::arena_from(n1 >> n2, arena))
             } else {
-                return Ok(Number::arena_from(n1 >> u32::max_value(), arena));
+                Ok(Number::arena_from(n1 >> usize::max_value(), arena))
             }
         }
         (Number::Fixnum(n1), Number::Integer(n2)) => {
             let n1 = Integer::from(n1.get_num());
 
-            match n2.to_u32() {
+            let result: Result<usize, _> = (&*n2).try_into();
-                Some(n2) => Ok(Number::arena_from(n1 >> n2, arena)),
+
-                _ => Ok(Number::arena_from(n1 >> u32::max_value(), arena)),
+            match result {
+                Ok(n2) => Ok(Number::arena_from(n1 >> n2, arena)),
+                Err(_) => Ok(Number::arena_from(n1 >> usize::max_value(), arena)),
             }
         }
-        (Number::Integer(n1), Number::Fixnum(n2)) => match u32::try_from(n2.get_num()) {
+        (Number::Integer(n1), Number::Fixnum(n2)) => match usize::try_from(n2.get_num()) {
             Ok(n2) => Ok(Number::arena_from(Integer::from(&*n1 >> n2), arena)),
             _ => Ok(Number::arena_from(
-                Integer::from(&*n1 >> u32::max_value()),
+                Integer::from(&*n1 >> usize::max_value()),
-                arena,
-            )),
-        },
-        (Number::Integer(n1), Number::Integer(n2)) => match n2.to_u32() {
-            Some(n2) => Ok(Number::arena_from(Integer::from(&*n1 >> n2), arena)),
-            _ => Ok(Number::arena_from(
-                Integer::from(&*n1 >> u32::max_value()),
                 arena,
             )),
         },
+        (Number::Integer(n1), Number::Integer(n2)) => {
+            let result: Result<usize, _> = (&*n2).try_into();
+
+            match result {
+                Ok(n2) => Ok(Number::arena_from(Integer::from(&*n1 >> n2), arena)),
+                Err(_) => Ok(Number::arena_from(
+                    Integer::from(&*n1 >> usize::max_value()),
+                    arena,
+                )),
+            }
+        }
         (Number::Integer(_), n2) => Err(numerical_type_error(ValidType::Integer, n2, stub_gen)),
         (Number::Fixnum(_), n2) => Err(numerical_type_error(ValidType::Integer, n2, stub_gen)),
         (n1, _) => Err(numerical_type_error(ValidType::Integer, n1, stub_gen)),
@@ -667,10 +685,14 @@ pub(crate) fn shr(n1: Number, n2: Number, arena: &mut Arena) -> Result<Number, M
 
 pub(crate) fn shl(n1: Number, n2: Number, arena: &mut Arena) -> Result<Number, MachineStubGen> {
     let stub_gen = || {
-        let shl_atom = atom!(">>");
+        let shl_atom = atom!("<<");
         functor_stub(shl_atom, 2)
     };
 
+    if n2.is_integer() && n2.is_negative() {
+        return shr(n1, neg(n2, arena), arena);
+    }
+
     match (n1, n2) {
         (Number::Fixnum(n1), Number::Fixnum(n2)) => {
             let n1_i = n1.get_num();
@@ -678,31 +700,31 @@ pub(crate) fn shl(n1: Number, n2: Number, arena: &mut Arena) -> Result<Number, M
 
             let n1 = Integer::from(n1_i);
 
-            if let Ok(n2) = u32::try_from(n2_i) {
+            if let Ok(n2) = usize::try_from(n2_i) {
-                return Ok(Number::arena_from(n1 << n2, arena));
+                Ok(Number::arena_from(n1 << n2, arena))
             } else {
-                return Ok(Number::arena_from(n1 << u32::max_value(), arena));
+                Ok(Number::arena_from(n1 << usize::max_value(), arena))
             }
         }
         (Number::Fixnum(n1), Number::Integer(n2)) => {
             let n1 = Integer::from(n1.get_num());
 
-            match n2.to_u32() {
+            match (&*n2).try_into() as Result<usize, _> {
-                Some(n2) => Ok(Number::arena_from(n1 << n2, arena)),
+                Ok(n2) => Ok(Number::arena_from(n1 << n2, arena)),
-                _ => Ok(Number::arena_from(n1 << u32::max_value(), arena)),
+                _ => Ok(Number::arena_from(n1 << usize::max_value(), arena)),
             }
         }
-        (Number::Integer(n1), Number::Fixnum(n2)) => match u32::try_from(n2.get_num()) {
+        (Number::Integer(n1), Number::Fixnum(n2)) => match usize::try_from(n2.get_num()) {
             Ok(n2) => Ok(Number::arena_from(Integer::from(&*n1 << n2), arena)),
             _ => Ok(Number::arena_from(
-                Integer::from(&*n1 << u32::max_value()),
+                Integer::from(&*n1 << usize::max_value()),
                 arena,
             )),
         },
-        (Number::Integer(n1), Number::Integer(n2)) => match n2.to_u32() {
+        (Number::Integer(n1), Number::Integer(n2)) => match (&*n2).try_into() as Result<usize, _> {
-            Some(n2) => Ok(Number::arena_from(Integer::from(&*n1 << n2), arena)),
+            Ok(n2) => Ok(Number::arena_from(Integer::from(&*n1 << n2), arena)),
             _ => Ok(Number::arena_from(
-                Integer::from(&*n1 << u32::max_value()),
+                Integer::from(&*n1 << usize::max_value()),
                 arena,
             )),
         },
@@ -803,6 +825,23 @@ pub(crate) fn modulus(x: Number, y: Number, arena: &mut Arena) -> Result<Number,
         functor_stub(mod_atom, 2)
     };
 
+    fn ibig_rem_floor(n1: &Integer, n2: &Integer) -> Integer {
+        let ring = ConstDivisor::new(n2.unsigned_abs());
+        let n1 = n1.clone();
+
+        if n2.is_negative() {
+            let unsigned_result = IBig::from(ring.reduce(n1).residue());
+
+            if unsigned_result.is_zero() {
+                unsigned_result
+            } else {
+                unsigned_result + n2
+            }
+        } else {
+            IBig::from(ring.reduce(n1).residue())
+        }
+    }
+
     match (x, y) {
         (Number::Fixnum(n1), Number::Fixnum(n2)) => {
             let n2_i = n2.get_num();
@@ -815,14 +854,11 @@ pub(crate) fn modulus(x: Number, y: Number, arena: &mut Arena) -> Result<Number,
             }
         }
         (Number::Fixnum(n1), Number::Integer(n2)) => {
-            if &*n2 == &0 {
+            if n2.is_zero() {
                 Err(zero_divisor_eval_error(stub_gen))
             } else {
                 let n1 = Integer::from(n1.get_num());
-                Ok(Number::arena_from(
+                Ok(Number::arena_from(ibig_rem_floor(&n1, &n2), arena))
-                    <(Integer, Integer)>::from(n1.div_rem_floor_ref(&*n2)).1,
-                    arena,
-                ))
             }
         }
         (Number::Integer(n1), Number::Fixnum(n2)) => {
@@ -832,20 +868,14 @@ pub(crate) fn modulus(x: Number, y: Number, arena: &mut Arena) -> Result<Number,
                 Err(zero_divisor_eval_error(stub_gen))
             } else {
                 let n2 = Integer::from(n2_i);
-                Ok(Number::arena_from(
+                Ok(Number::arena_from(ibig_rem_floor(&n1, &n2), arena))
-                    <(Integer, Integer)>::from(n1.div_rem_floor_ref(&n2)).1,
-                    arena,
-                ))
             }
         }
-        (Number::Integer(x), Number::Integer(y)) => {
+        (Number::Integer(n1), Number::Integer(n2)) => {
-            if &*y == &0 {
+            if n2.is_zero() {
                 Err(zero_divisor_eval_error(stub_gen))
             } else {
-                Ok(Number::arena_from(
+                Ok(Number::arena_from(ibig_rem_floor(&n1, &n2), arena))
-                    <(Integer, Integer)>::from(x.div_rem_floor_ref(&*y)).1,
-                    arena,
-                ))
             }
         }
         (Number::Integer(_), n2) | (Number::Fixnum(_), n2) => {
@@ -873,7 +903,7 @@ pub(crate) fn remainder(x: Number, y: Number, arena: &mut Arena) -> Result<Numbe
             }
         }
         (Number::Fixnum(n1), Number::Integer(n2)) => {
-            if &*n2 == &0 {
+            if n2.is_zero() {
                 Err(zero_divisor_eval_error(stub_gen))
             } else {
                 let n1 = Integer::from(n1.get_num());
@@ -891,7 +921,7 @@ pub(crate) fn remainder(x: Number, y: Number, arena: &mut Arena) -> Result<Numbe
             }
         }
         (Number::Integer(n1), Number::Integer(n2)) => {
-            if &*n2 == &0 {
+            if n2.is_zero() {
                 Err(zero_divisor_eval_error(stub_gen))
             } else {
                 Ok(Number::arena_from(Integer::from(&*n1 % &*n2), arena))
@@ -918,18 +948,19 @@ pub(crate) fn gcd(n1: Number, n2: Number, arena: &mut Arena) -> Result<Number, M
             if let Some(result) = isize_gcd(n1_i, n2_i) {
                 Ok(Number::arena_from(result, arena))
             } else {
-                Ok(Number::arena_from(
+                let value: Integer = Integer::from(n1_i).gcd(&Integer::from(n2_i)).into();
-                    Integer::from(n1_i).gcd(&Integer::from(n2_i)),
+                Ok(Number::arena_from(value, arena))
-                    arena,
-                ))
             }
         }
         (Number::Fixnum(n1), Number::Integer(n2)) | (Number::Integer(n2), Number::Fixnum(n1)) => {
             let n1 = Integer::from(n1.get_num());
-            Ok(Number::arena_from(Integer::from(n2.gcd_ref(&n1)), arena))
+            let n2_clone: Integer = (*n2).clone();
+            Ok(Number::arena_from(Integer::from(n2_clone.gcd(&n1)), arena))
         }
         (Number::Integer(n1), Number::Integer(n2)) => {
-            Ok(Number::arena_from(Integer::from(n1.gcd_ref(&n2)), arena))
+            let n2: isize = (&*n2).try_into().unwrap();
+            let value: Integer = (&*n1).gcd(&Integer::from(n2)).into();
+            Ok(Number::arena_from(value, arena))
         }
         (Number::Float(f), _) | (_, Number::Float(f)) => {
             let n = Number::Float(f);
@@ -998,6 +1029,16 @@ pub(crate) fn atan(n1: Number) -> Result<f64, MachineStubGen> {
     unary_float_fn_template(n1, |f| f.atan())
 }
 
+#[inline]
+pub(crate) fn float_fractional_part(n1: Number) -> Result<f64, MachineStubGen> {
+    unary_float_fn_template(n1, |f| f.fract())
+}
+
+#[inline]
+pub(crate) fn float_integer_part(n1: Number) -> Result<f64, MachineStubGen> {
+    unary_float_fn_template(n1, |f| f.trunc())
+}
+
 #[inline]
 pub(crate) fn sqrt(n1: Number) -> Result<f64, MachineStubGen> {
     if n1.is_negative() {
@@ -1069,17 +1110,18 @@ impl MachineState {
     pub fn get_number(&mut self, at: &ArithmeticTerm) -> Result<Number, MachineStub> {
         match at {
             &ArithmeticTerm::Reg(r) => {
-		        let value = self.store(self.deref(self[r]));
+                let value = self.store(self.deref(self[r]));
 
                 match Number::try_from(value) {
                     Ok(n) => Ok(n),
                     Err(_) => self.arith_eval_by_metacall(value),
                 }
             }
-            &ArithmeticTerm::Interm(i) => {
+            &ArithmeticTerm::Interm(i) => Ok(mem::replace(
-                Ok(mem::replace(&mut self.interms[i - 1], Number::Fixnum(Fixnum::build_with(0))))
+                &mut self.interms[i - 1],
-            }
+                Number::Fixnum(Fixnum::build_with(0)),
-            &ArithmeticTerm::Number(n) => Ok(n),
+            )),
+            ArithmeticTerm::Number(n) => Ok(*n),
         }
     }
 
@@ -1092,13 +1134,17 @@ impl MachineState {
 
         match rational_from_number(n, caller, &mut self.arena) {
             Ok(r) => Ok(r),
-            Err(e_gen) => Err(e_gen(self))
+            Err(e_gen) => Err(e_gen(self)),
         }
     }
 
-    pub(crate) fn arith_eval_by_metacall(&mut self, value: HeapCellValue) -> Result<Number, MachineStub> {
+    pub(crate) fn arith_eval_by_metacall(
+        &mut self,
+        value: HeapCellValue,
+    ) -> Result<Number, MachineStub> {
         let stub_gen = || functor_stub(atom!("is"), 2);
-        let mut iter = stackful_post_order_iter(&mut self.heap, value);
+        let mut iter =
+            stackful_post_order_iter::<NonListElider>(&mut self.heap, &mut self.stack, value);
 
         while let Some(value) = iter.next() {
             if value.get_forwarding_bit() {
@@ -1115,7 +1161,7 @@ impl MachineState {
                       HeapCellValueTag::PStrLoc) => {
                          (atom!("."), 2)
                      }
-                     (HeapCellValueTag::AttrVar | HeapCellValueTag::Var) => {
+                     (HeapCellValueTag::AttrVar | HeapCellValueTag::Var | HeapCellValueTag::StackVar) => {
                          let err = self.instantiation_error();
                          return Err(self.error_form(err, stub_gen()));
                      }
@@ -1247,6 +1293,12 @@ impl MachineState {
                             atom!("tan") => self.interms.push(Number::Float(OrderedFloat(
                                 drop_iter_on_err!(self, iter, tan(a1))
                             ))),
+                            atom!("float_fractional_part") => self.interms.push(Number::Float(OrderedFloat(
+                                drop_iter_on_err!(self, iter, float_fractional_part(a1))
+                            ))),
+                            atom!("float_integer_part") => self.interms.push(Number::Float(OrderedFloat(
+                                drop_iter_on_err!(self, iter, float_integer_part(a1))
+                            ))),
                             atom!("sqrt") => self.interms.push(Number::Float(OrderedFloat(
                                 drop_iter_on_err!(self, iter, sqrt(a1))
                             ))),
@@ -1371,30 +1423,16 @@ mod tests {
     use crate::machine::mock_wam::*;
 
     #[test]
+    #[cfg_attr(miri, ignore = "blocked on streams.rs UB")]
     fn arith_eval_by_metacall_tests() {
         let mut wam = MachineState::new();
         let mut op_dir = default_op_dir();
 
-        op_dir.insert(
+        op_dir.insert((atom!("+"), Fixity::In), OpDesc::build_with(500, YFX as u8));
-            (atom!("+"), Fixity::In),
+        op_dir.insert((atom!("-"), Fixity::In), OpDesc::build_with(500, YFX as u8));
-            OpDesc::build_with(500, YFX as u8),
+        op_dir.insert((atom!("-"), Fixity::Pre), OpDesc::build_with(200, FY as u8));
-        );
+        op_dir.insert((atom!("*"), Fixity::In), OpDesc::build_with(400, YFX as u8));
-        op_dir.insert(
+        op_dir.insert((atom!("/"), Fixity::In), OpDesc::build_with(400, YFX as u8));
-            (atom!("-"), Fixity::In),
-            OpDesc::build_with(500, YFX as u8),
-        );
-        op_dir.insert(
-            (atom!("-"), Fixity::Pre),
-            OpDesc::build_with(200, FY as u8),
-        );
-        op_dir.insert(
-            (atom!("*"), Fixity::In),
-            OpDesc::build_with(400, YFX as u8),
-        );
-        op_dir.insert(
-            (atom!("/"), Fixity::In),
-            OpDesc::build_with(400, YFX as u8),
-        );
 
         let term_write_result =
             parse_and_write_parsed_term_to_heap(&mut wam, "3 + 4 - 1 + 2.", &op_dir).unwrap();

src/machine/attributed_variables.pl

@@ -1,11 +1,9 @@
 :- 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]) :-

src/machine/attributed_variables.rs

@@ -33,8 +33,8 @@ impl AttrVarInitializer {
     }
 
     #[inline]
-    pub(super) fn reset(&mut self) {
+    pub(super) fn reset(&mut self, len: usize) {
-        self.attr_var_queue.clear();
+        self.attr_var_queue.truncate(len);
         self.bindings.clear();
     }
 }
@@ -52,6 +52,7 @@ impl MachineState {
             self.cp = INSTALL_VERIFY_ATTR_INTERRUPT;
         }
 
+        debug_assert_eq!(self.heap[h].get_tag(), HeapCellValueTag::AttrVar);
         self.attr_var_init.bindings.push((h, addr));
     }
 
@@ -63,10 +64,9 @@ impl MachineState {
             .map(|(ref h, _)| attr_var_as_cell!(*h));
 
         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(|(_, ref v)| *v);
-
         let value_list_addr = heap_loc_as_cell!(iter_to_heap_list(&mut self.heap, iter));
+
         (var_list_addr, value_list_addr)
     }
 
@@ -118,12 +118,9 @@ impl MachineState {
             and_frame[i] = self.registers[i];
         }
 
-        and_frame[arity + 1] =
+        and_frame[arity + 1] = fixnum_as_cell!(Fixnum::build_with(self.b0 as i64));
-            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 + 2] =
+        and_frame[arity + 3] = fixnum_as_cell!(Fixnum::build_with(self.attr_var_init.cp as i64));
-            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();
 
@@ -136,7 +133,8 @@ impl MachineState {
         let mut seen_set = IndexSet::new();
         let mut seen_vars = vec![];
 
-        let mut iter = stackful_preorder_iter(&mut self.heap, cell);
+        let mut iter =
+            stackful_preorder_iter::<NonListElider>(&mut self.heap, &mut self.stack, cell);
 
         while let Some(value) = iter.next() {
             read_heap_cell!(value,
@@ -147,6 +145,16 @@ impl MachineState {
 
                     let value = unmark_cell_bits!(value);
 
+                    if h != iter.focus().value() as usize {
+                        let deref_value = heap_bound_store(iter.heap, heap_bound_deref(iter.heap, value));
+
+                        if deref_value.is_compound(iter.heap) {
+                            // a cyclic structure is bound to the attributed variable at h.
+                            // it mustn't be included in seen_vars.
+                            continue;
+                        }
+                    }
+
                     seen_vars.push(value);
                     seen_set.insert(h);
 
@@ -157,7 +165,7 @@ impl MachineState {
                     loop {
                         read_heap_cell!(iter.heap[l],
                             (HeapCellValueTag::Lis) => {
-                                iter.push_stack(l);
+                                iter.push_stack(IterStackLoc::iterable_loc(l, HeapOrStackTag::Heap));
                                 // l = elem + 1;
                                 break;
                             }

src/machine/code_walker.rs

@@ -1,5 +1,6 @@
 use crate::instructions::*;
 
+use fxhash::FxBuildHasher;
 use indexmap::IndexSet;
 
 fn capture_offset(line: &Instruction, index: usize, stack: &mut Vec<usize>) -> bool {
@@ -7,38 +8,26 @@ fn capture_offset(line: &Instruction, index: usize, stack: &mut Vec<usize>) -> b
         &Instruction::TryMeElse(offset) if offset > 0 => {
             stack.push(index + offset);
         }
-        &Instruction::DefaultRetryMeElse(offset) |
+        &Instruction::DefaultRetryMeElse(offset) | &Instruction::RetryMeElse(offset)
-        &Instruction::RetryMeElse(offset)
             if offset > 0 =>
         {
             stack.push(index + offset);
         }
-        &Instruction::DynamicElse(_, _, NextOrFail::Next(offset))
+        &Instruction::DynamicElse(_, _, NextOrFail::Next(offset)) if offset > 0 => {
-            if offset > 0 =>
-        {
             stack.push(index + offset);
         }
-        &Instruction::DynamicInternalElse(_, _, NextOrFail::Next(offset))
+        &Instruction::DynamicInternalElse(_, _, NextOrFail::Next(offset)) if offset > 0 => {
-            if offset > 0 =>
-        {
             stack.push(index + offset);
         }
-        &Instruction::JmpByCall(_, offset, _) => {
+        &Instruction::Proceed | &Instruction::JmpByCall(_) => {
-            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;
             }
+
+            return true;
         }
         instr if instr.is_execute() => {
             return true;
@@ -55,7 +44,7 @@ fn capture_offset(line: &Instruction, index: usize, stack: &mut Vec<usize>) -> b
  */
 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();
+    let mut visited_indices = IndexSet::with_hasher(FxBuildHasher::default());
 
     while let Some(first_index) = stack.pop() {
         if visited_indices.contains(&first_index) {
@@ -73,23 +62,3 @@ pub(crate) fn walk_code(code: &Code, p: usize, mut walker: impl FnMut(&Instructi
         }
     }
 }
-
-/* A function for code walking that might result in modification to
- * the code. Otherwise identical to walk_code.
- */
-/*
-pub(crate) fn walk_code_mut(code: &mut Code, p: usize, mut walker: impl FnMut(&mut Line))
-{
-    let mut queue = VecDeque::from(vec![p]);
-
-    while let Some(first_idx) = queue.pop_front() {
-        let mut last_idx = first_idx;
-
-        capture_next_range(code, &mut queue, &mut last_idx);
-
-        for instr in &mut code[first_idx .. last_idx + 1] {
-            walker(instr);
-        }
-    }
-}
-*/

src/machine/config.rs

@@ -0,0 +1,32 @@
+pub struct MachineConfig {
+    pub streams: StreamConfig,
+    pub toplevel: &'static str,
+}
+
+pub enum StreamConfig {
+    Stdio,
+    Memory,
+}
+
+impl Default for MachineConfig {
+    fn default() -> Self {
+        MachineConfig {
+            streams: StreamConfig::Stdio,
+            toplevel: include_str!("../toplevel.pl"),
+        }
+    }
+}
+
+impl MachineConfig {
+    pub fn in_memory() -> Self {
+        MachineConfig {
+            streams: StreamConfig::Memory,
+            ..Default::default()
+        }
+    }
+
+    pub fn with_toplevel(mut self, toplevel: &'static str) -> Self {
+        self.toplevel = toplevel;
+        self
+    }
+}

src/machine/copier.rs

@@ -18,6 +18,7 @@ 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 push_attr_var_queue(&mut self, attr_var_loc: usize);
     fn stack(&mut self) -> &mut Stack;
     fn threshold(&self) -> usize;
 }
@@ -28,7 +29,10 @@ pub(crate) fn copy_term<T: CopierTarget>(
     attr_var_policy: AttrVarPolicy,
 ) {
     let mut copy_term_state = CopyTermState::new(target, attr_var_policy);
+
     copy_term_state.copy_term_impl(addr);
+    copy_term_state.copy_attr_var_lists();
+    copy_term_state.unwind_trail();
 }
 
 #[derive(Debug)]
@@ -38,6 +42,7 @@ struct CopyTermState<T: CopierTarget> {
     old_h: usize,
     target: T,
     attr_var_policy: AttrVarPolicy,
+    attr_var_list_locs: Vec<(usize, HeapCellValue)>,
 }
 
 impl<T: CopierTarget> CopyTermState<T> {
@@ -48,6 +53,7 @@ impl<T: CopierTarget> CopyTermState<T> {
             old_h: target.threshold(),
             target,
             attr_var_policy,
+            attr_var_list_locs: vec![],
         }
     }
 
@@ -68,7 +74,6 @@ impl<T: CopierTarget> CopyTermState<T> {
                     if h >= self.old_h {
                         *self.value_at_scan() = list_loc_as_cell!(h);
                         self.scan += 1;
-
                         return;
                     }
                 }
@@ -91,14 +96,19 @@ impl<T: CopierTarget> CopyTermState<T> {
             .store(self.target.deref(heap_loc_as_cell!(addr + 1)));
 
         if !cdr.is_var() {
+            // mark addr + 1 as a list back edge in the cdr of the list
             self.trail_list_cell(addr + 1, threshold);
+            self.target[addr + 1].set_mark_bit(true);
+            self.target[addr + 1].set_forwarding_bit(true);
         } else {
             let car = self
                 .target
                 .store(self.target.deref(heap_loc_as_cell!(addr)));
 
             if !car.is_var() {
+                // mark addr as a list back edge in the car of the list
                 self.trail_list_cell(addr, threshold);
+                self.target[addr].set_mark_bit(true);
             }
         }
 
@@ -167,6 +177,52 @@ impl<T: CopierTarget> CopyTermState<T> {
         self.trail.push((Ref::heap_cell(pstr_loc), trail_item));
     }
 
+    fn copy_attr_var_lists(&mut self) {
+        while !self.attr_var_list_locs.is_empty() {
+            let iter = std::mem::take(&mut self.attr_var_list_locs);
+
+            for (threshold, list_loc) in iter {
+                self.target[threshold] = list_loc_as_cell!(self.target.threshold());
+                self.target.push_attr_var_queue(threshold - 1);
+                self.copy_attr_var_list(list_loc);
+            }
+        }
+    }
+
+    /*
+     * Attributed variable attribute lists adhere to a particular
+     * structure which is ensured by this function and not at all by
+     * the vanilla copier.
+     */
+    fn copy_attr_var_list(&mut self, mut list_addr: HeapCellValue) {
+        while let HeapCellValueTag::Lis = list_addr.get_tag() {
+            let threshold = self.target.threshold();
+            let heap_loc = list_addr.get_value() as usize;
+            let str_loc = self.target[heap_loc].get_value() as usize;
+
+            self.target.push(heap_loc_as_cell!(threshold + 2));
+            self.target.push(heap_loc_as_cell!(threshold + 1));
+
+            read_heap_cell!(self.target[str_loc],
+                (HeapCellValueTag::Atom) => {
+                    self.target.push(self.target[str_loc]);
+                }
+                (HeapCellValueTag::Str) => {
+                    self.copy_term_impl(self.target[str_loc]);
+                }
+                _ => {
+                    unreachable!();
+                }
+            );
+
+            list_addr = self.target[heap_loc + 1];
+
+            if HeapCellValueTag::Lis == list_addr.get_tag() {
+                self.target[threshold + 1] = list_loc_as_cell!(self.target.threshold());
+            }
+        }
+    }
+
     fn reinstantiate_var(&mut self, addr: HeapCellValue, frontier: usize) {
         read_heap_cell!(addr,
             (HeapCellValueTag::Var, h) => {
@@ -195,9 +251,15 @@ impl<T: CopierTarget> CopyTermState<T> {
 
                 if let AttrVarPolicy::DeepCopy = self.attr_var_policy {
                     self.target.push(attr_var_as_cell!(threshold));
+                    self.target.push(heap_loc_as_cell!(threshold + 1));
 
-                    let list_val = self.target[h + 1];
+                    let old_list_link = self.target[h + 1];
-                    self.target.push(list_val);
+                    self.trail.push((Ref::heap_cell(h + 1), old_list_link));
+                    self.target[h + 1] = heap_loc_as_cell!(threshold + 1);
+
+                    if old_list_link.get_tag() == HeapCellValueTag::Lis {
+                        self.attr_var_list_locs.push((threshold + 1, old_list_link));
+                    }
                 }
             }
             _ => {
@@ -207,6 +269,7 @@ impl<T: CopierTarget> CopyTermState<T> {
     }
 
     fn copy_var(&mut self, addr: HeapCellValue) {
+        let index = addr.get_value() as usize;
         let rd = self.target.deref(addr);
         let ra = self.target.store(rd);
 
@@ -215,7 +278,20 @@ impl<T: CopierTarget> CopyTermState<T> {
                 if h >= self.old_h {
                     *self.value_at_scan() = ra;
                     self.scan += 1;
+                    return;
+                }
+            }
+            (HeapCellValueTag::Lis, h) => {
+                if h >= self.old_h && self.target[index].get_mark_bit() {
+                    *self.value_at_scan() = heap_loc_as_cell!(
+                        if ra.get_forwarding_bit() {
+                            h + 1
+                        } else {
+                            h
+                        }
+                    );
 
+                    self.scan += 1;
                     return;
                 }
             }
@@ -298,16 +374,18 @@ impl<T: CopierTarget> CopyTermState<T> {
                 }
             );
         }
-
-        self.unwind_trail();
     }
 
-    fn unwind_trail(&mut self) {
+    fn unwind_trail(mut self) {
-        for (r, value) in self.trail.drain(0..) {
+        for (r, value) in self.trail {
             let index = r.get_value() as usize;
 
             match r.get_tag() {
-                RefTag::AttrVar | RefTag::HeapCell => self.target[index] = value,
+                RefTag::AttrVar | RefTag::HeapCell => {
+                    self.target[index] = value;
+                    self.target[index].set_mark_bit(false);
+                    self.target[index].set_forwarding_bit(false);
+                }
                 RefTag::StackCell => self.target.stack()[index] = value,
             }
         }
@@ -320,6 +398,7 @@ mod tests {
     use crate::machine::mock_wam::*;
 
     #[test]
+    #[cfg_attr(miri, ignore = "blocked on atom_table.rs UB")]
     fn copier_tests() {
         let mut wam = MockWAM::new();
 
@@ -327,8 +406,9 @@ mod tests {
         let a_atom = atom!("a");
         let b_atom = atom!("b");
 
-        wam.machine_st.heap
+        wam.machine_st
-           .extend(functor!(f_atom, [atom(a_atom), atom(b_atom)]));
+            .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));
@@ -351,20 +431,26 @@ mod tests {
 
         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_var_cell =
+            put_partial_string(&mut wam.machine_st.heap, "abc ", &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_var_cell =
+            put_partial_string(&mut wam.machine_st.heap, "def", &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_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)));
+        wam.machine_st
+            .heap
+            .push(fixnum_as_cell!(Fixnum::build_with(0i64)));
 
         {
             let wam = TermCopyingMockWAM { wam: &mut wam };
@@ -378,14 +464,20 @@ mod tests {
         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[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)));
+        assert_eq!(
+            wam.machine_st.heap[12],
+            fixnum_as_cell!(Fixnum::build_with(0i64))
+        );
 
         wam.machine_st.heap.clear();
 

src/machine/cycle_detection.rs

@@ -0,0 +1,428 @@
+use crate::atom_table::*;
+use crate::types::*;
+
+/* Use the pointer reversal technique of the Deutsch-Schorr-Waite
+ * algorithm to detect cycles in Prolog terms.
+ *
+ * Much of the structure and nomenclature of the GC marking algorithm
+ * is adapted here but there are a few significant changes:
+ *
+ * - Forwarded cells now form a trail of bread crumbs leading back to self.start
+ * - Cells are only marked during the backward phase
+ * - Visiting subterms of a visited compound does not immediately shift to the backward phase
+ * - The heads of LIS structures are both marked and forwarded rather
+ *   than just forwarded to distinguish them from tails;
+ *   continue_forwarding() checks for this before entering the forward
+ *   phase
+ *
+ * Commonalities with the GC marking algorithm:
+ * - The contents of forwarded cells are modified only when they are unforwarded
+ * - Marked (but unforwarded!) cells immediately shift to the backward phase
+ */
+
+#[derive(Debug)]
+pub(crate) struct CycleDetectingIter<'a, const STOP_AT_CYCLES: bool> {
+    pub(crate) heap: &'a mut [HeapCellValue],
+    start: usize,
+    current: usize,
+    next: u64,
+    cycle_found: bool,
+    mark_phase: bool,
+}
+
+impl<'a, const STOP_AT_CYCLES: bool> CycleDetectingIter<'a, STOP_AT_CYCLES> {
+    pub(crate) fn new(heap: &'a mut [HeapCellValue], start: usize) -> Self {
+        heap[start].set_forwarding_bit(true);
+        let next = heap[start].get_value();
+
+        Self {
+            heap,
+            start,
+            current: start,
+            next,
+            cycle_found: false,
+            mark_phase: true,
+        }
+    }
+
+    #[inline]
+    pub(crate) fn cycle_found(&self) -> bool {
+        self.cycle_found
+    }
+
+    #[inline]
+    fn cycle_detection_active(&self) -> bool {
+        STOP_AT_CYCLES && self.mark_phase && !self.cycle_found
+    }
+
+    fn backward_and_return(&mut self) -> HeapCellValue {
+        let mut current = self.heap[self.current];
+        current.set_value(self.next);
+
+        if self.backward() {
+            // set the f and m bits on the heap cell at start
+            // so we invoke backward() and return None next call.
+
+            self.heap[self.current].set_forwarding_bit(false);
+            self.heap[self.current].set_mark_bit(self.mark_phase);
+        }
+
+        current
+    }
+
+    fn traverse_subterm(&mut self, h: usize, arity: usize) -> Option<usize> {
+        let mut last_cell_loc = h + arity - 1;
+
+        for idx in (h..h + arity).rev() {
+            if self.heap[idx].get_forwarding_bit() {
+                if self.cycle_detection_active() {
+                    self.cycle_found = true;
+                    return None;
+                }
+
+                last_cell_loc -= 1;
+            } else if self.heap[idx].get_mark_bit() == self.mark_phase {
+                last_cell_loc -= 1;
+            } else {
+                break;
+            }
+        }
+
+        Some(last_cell_loc)
+    }
+
+    #[inline]
+    fn continue_forwarding(&self) -> bool {
+        self.heap[self.current].get_mark_bit() != self.mark_phase
+            || self.heap[self.current].get_forwarding_bit()
+    }
+
+    fn forward(&mut self) -> Option<HeapCellValue> {
+        loop {
+            if self.continue_forwarding() {
+                match self.heap[self.current].get_tag() {
+                    tag @ HeapCellValueTag::AttrVar | tag @ HeapCellValueTag::Var => {
+                        let next = self.next as usize;
+
+                        if self.heap[next].get_forwarding_bit() {
+                            return if self.current != next {
+                                if self.cycle_detection_active() {
+                                    self.cycle_found = true;
+                                    None
+                                } else {
+                                    Some(self.backward_and_return())
+                                }
+                            } else {
+                                Some(self.backward_and_return())
+                            };
+                        } else if self.heap[next].get_mark_bit() == self.mark_phase {
+                            return Some(self.backward_and_return());
+                        }
+
+                        self.heap[next].set_forwarding_bit(true);
+
+                        let temp = self.heap[next].get_value();
+
+                        self.heap[next].set_value(self.current as u64);
+                        self.current = next;
+                        self.next = temp;
+
+                        if self.next < self.heap.len() as u64 {
+                            return Some(HeapCellValue::build_with(tag, next as u64));
+                        }
+                    }
+                    HeapCellValueTag::Str => {
+                        let h = self.next as usize;
+                        let cell = self.heap[h];
+                        let arity = cell_as_atom_cell!(self.heap[h]).get_arity();
+
+                        let last_cell_loc = match self.traverse_subterm(h + 1, arity) {
+                            Some(last_cell_loc) => last_cell_loc,
+                            None => return None,
+                        };
+
+                        if last_cell_loc == h {
+                            if self.backward() {
+                                return None;
+                            }
+
+                            continue;
+                        }
+
+                        if self.cycle_detection_active() {
+                            for idx in (h + 1..last_cell_loc).rev() {
+                                if self.heap[idx].get_forwarding_bit() {
+                                    self.cycle_found = true;
+                                    return None;
+                                }
+                            }
+                        }
+
+                        self.heap[last_cell_loc].set_forwarding_bit(true);
+
+                        self.next = self.heap[last_cell_loc].get_value();
+                        self.heap[last_cell_loc].set_value(self.current as u64);
+                        self.current = last_cell_loc;
+
+                        return Some(cell);
+                    }
+                    HeapCellValueTag::Lis => {
+                        let mut cell = self.heap[self.current];
+                        cell.set_value(self.next);
+
+                        let last_cell_loc = match self.traverse_subterm(self.next as usize, 2) {
+                            Some(last_cell_loc) => last_cell_loc,
+                            None => return None,
+                        };
+
+                        if self.cycle_detection_active() {
+                            for idx in (self.next as usize..last_cell_loc).rev() {
+                                if self.heap[idx].get_forwarding_bit() {
+                                    self.cycle_found = true;
+                                    return None;
+                                }
+                            }
+                        }
+
+                        if (last_cell_loc + 1) as u64 == self.next {
+                            if self.backward() {
+                                return None;
+                            }
+
+                            continue;
+                        } else if last_cell_loc as u64 == self.next {
+                            // car cells of lists are both marked and forwarded.
+                            self.heap[last_cell_loc].set_mark_bit(self.mark_phase);
+                        }
+
+                        self.heap[last_cell_loc].set_forwarding_bit(true);
+
+                        self.next = self.heap[last_cell_loc].get_value();
+                        self.heap[last_cell_loc].set_value(self.current as u64);
+                        self.current = last_cell_loc;
+
+                        return Some(cell);
+                    }
+                    HeapCellValueTag::PStrLoc => {
+                        let h = self.next as usize;
+                        let cell = self.heap[h];
+                        let last_cell_loc = h + 1;
+
+                        if self.heap[last_cell_loc].get_forwarding_bit() {
+                            if self.cycle_detection_active() {
+                                self.cycle_found = true;
+                                return None;
+                            } else if self.backward() {
+                                return None;
+                            }
+
+                            continue;
+                        }
+
+                        self.heap[last_cell_loc].set_forwarding_bit(true);
+
+                        self.next = self.heap[last_cell_loc].get_value();
+                        self.heap[last_cell_loc].set_value(self.current as u64);
+                        self.current = last_cell_loc;
+
+                        return Some(cell);
+                    }
+                    HeapCellValueTag::PStrOffset => {
+                        let h = self.next as usize;
+                        let cell = self.heap[h];
+                        let last_cell_loc = h + 1;
+
+                        if self.heap[h].get_tag() == HeapCellValueTag::PStr {
+                            if self.heap[last_cell_loc].get_forwarding_bit() {
+                                if self.cycle_detection_active() {
+                                    self.cycle_found = true;
+                                    return None;
+                                } else if self.backward() {
+                                    return None;
+                                }
+
+                                continue;
+                            }
+
+                            self.heap[last_cell_loc].set_forwarding_bit(true);
+
+                            self.next = self.heap[last_cell_loc].get_value();
+                            self.heap[last_cell_loc].set_value(self.current as u64);
+                            self.current = last_cell_loc;
+                        } else {
+                            debug_assert!(self.heap[h].get_tag() == HeapCellValueTag::CStr);
+
+                            self.next = self.heap[h].get_value();
+                            self.heap[h].set_value(self.current as u64);
+                            self.current = h;
+                        }
+
+                        return Some(cell);
+                    }
+                    tag @ HeapCellValueTag::Atom => {
+                        let cell = HeapCellValue::build_with(tag, self.next);
+                        let arity = AtomCell::from_bytes(cell.into_bytes()).get_arity();
+
+                        if arity == 0 {
+                            return Some(self.backward_and_return());
+                        } else if self.backward() {
+                            return None;
+                        }
+                    }
+                    HeapCellValueTag::PStr => {
+                        if self.backward() {
+                            return None;
+                        }
+                    }
+                    _ => {
+                        return Some(self.backward_and_return());
+                    }
+                }
+            } else if self.backward() {
+                return None;
+            }
+        }
+    }
+
+    fn pivot_subterm(&mut self) {
+        self.current -= 1;
+
+        let temp = self.heap[self.current + 1].get_value();
+
+        self.heap[self.current + 1].set_value(self.next);
+        self.next = self.heap[self.current].get_value();
+        self.heap[self.current].set_value(temp);
+
+        self.heap[self.current].set_forwarding_bit(true);
+    }
+
+    fn continue_backward(&mut self) -> bool {
+        self.heap[self.current].set_forwarding_bit(false);
+
+        if self.current == self.start {
+            return false;
+        }
+
+        let temp = self.heap[self.current].get_value();
+
+        match self.heap[temp as usize].get_tag() {
+            HeapCellValueTag::Str => {
+                let mut new_str_back_link = self.current;
+
+                for idx in (0..self.current).rev() {
+                    if self.heap[idx].get_tag() == HeapCellValueTag::Atom
+                        && cell_as_atom_cell!(self.heap[idx]).get_arity() > 0
+                    {
+                        new_str_back_link = idx;
+                        break;
+                    }
+
+                    if self.heap[idx].get_mark_bit() != self.mark_phase
+                        && !self.heap[idx].get_forwarding_bit()
+                    {
+                        new_str_back_link = idx;
+                        break;
+                    }
+                }
+
+                self.heap[self.current].set_mark_bit(self.mark_phase);
+                self.heap[self.current].set_value(self.next);
+
+                let back_link_cell = self.heap[new_str_back_link];
+
+                self.next = back_link_cell.get_value();
+                self.heap[new_str_back_link].set_value(temp);
+                self.current = new_str_back_link;
+
+                read_heap_cell!(back_link_cell,
+                    (HeapCellValueTag::Atom, (_name, arity)) => {
+                        if arity > 0 {
+                            self.heap[self.current].set_mark_bit(self.mark_phase);
+                            return true;
+                        }
+                    }
+                    _ => {}
+                );
+
+                self.heap[self.current].set_forwarding_bit(true);
+                false
+            }
+            HeapCellValueTag::Lis => {
+                if self.heap[self.current].get_mark_bit() == self.mark_phase {
+                    true
+                } else {
+                    self.heap[self.current - 1].set_mark_bit(self.mark_phase);
+                    self.heap[self.current].set_mark_bit(self.mark_phase);
+
+                    if self.heap[self.current - 1].get_forwarding_bit() {
+                        self.heap[self.current].set_value(self.next);
+                        self.next = self.current as u64 - 1;
+                        self.current = temp as usize;
+
+                        true
+                    } else {
+                        self.pivot_subterm();
+                        false
+                    }
+                }
+            }
+            _ => {
+                self.heap[self.current].set_mark_bit(self.mark_phase);
+                true
+            }
+        }
+    }
+
+    fn backward(&mut self) -> bool {
+        while self.continue_backward() {
+            let temp = self.heap[self.current].get_value();
+
+            self.heap[self.current].set_value(self.next);
+            self.next = self.current as u64;
+            self.current = temp as usize;
+        }
+
+        if self.current == self.start {
+            return true;
+        }
+
+        false
+    }
+
+    fn invert_marker(&mut self) {
+        self.cycle_found = false;
+
+        if self.heap[self.start].get_forwarding_bit() {
+            while !self.backward() {}
+        }
+
+        self.mark_phase = false;
+        self.heap[self.start].set_forwarding_bit(true);
+
+        self.next = self.heap[self.start].get_value();
+        self.current = self.start;
+
+        while self.forward().is_some() {}
+    }
+}
+
+impl<'a, const STOP_AT_CYCLES: bool> Iterator for CycleDetectingIter<'a, STOP_AT_CYCLES> {
+    type Item = HeapCellValue;
+
+    #[inline]
+    fn next(&mut self) -> Option<Self::Item> {
+        self.forward()
+    }
+}
+
+impl<'a, const STOP_AT_CYCLES: bool> Drop for CycleDetectingIter<'a, STOP_AT_CYCLES> {
+    fn drop(&mut self) {
+        self.invert_marker();
+
+        if self.current == self.start {
+            return;
+        }
+
+        while !self.backward() {}
+    }
+}

src/machine/disjuncts.rs

@@ -0,0 +1,916 @@
+use crate::atom_table::*;
+use crate::forms::*;
+use crate::instructions::*;
+use crate::iterators::*;
+use crate::machine::loader::*;
+use crate::machine::machine_errors::CompilationError;
+use crate::machine::preprocessor::*;
+use crate::parser::ast::*;
+use crate::parser::dashu::Rational;
+use crate::variable_records::*;
+
+use dashu::Integer;
+use indexmap::{IndexMap, IndexSet};
+
+use std::cell::Cell;
+use std::cmp::Ordering;
+use std::collections::VecDeque;
+use std::hash::{Hash, Hasher};
+use std::ops::{Deref, DerefMut};
+
+#[derive(Debug, Clone)] //, PartialOrd, PartialEq, Eq, Hash)]
+pub struct BranchNumber {
+    branch_num: Rational,
+    delta: Rational,
+}
+
+impl Default for BranchNumber {
+    fn default() -> Self {
+        Self {
+            branch_num: Rational::from(1u64 << 63),
+            delta: Rational::from(1),
+        }
+    }
+}
+
+impl PartialEq<BranchNumber> for BranchNumber {
+    #[inline]
+    fn eq(&self, rhs: &BranchNumber) -> bool {
+        self.branch_num == rhs.branch_num
+    }
+}
+
+impl Eq for BranchNumber {}
+
+impl Hash for BranchNumber {
+    #[inline(always)]
+    fn hash<H: Hasher>(&self, hasher: &mut H) {
+        self.branch_num.hash(hasher)
+    }
+}
+
+impl PartialOrd<BranchNumber> for BranchNumber {
+    #[inline]
+    fn partial_cmp(&self, rhs: &BranchNumber) -> Option<Ordering> {
+        self.branch_num.partial_cmp(&rhs.branch_num)
+    }
+}
+
+impl BranchNumber {
+    fn split(&self) -> BranchNumber {
+        BranchNumber {
+            branch_num: self.branch_num.clone() + &self.delta / Rational::from(2),
+            delta: &self.delta / Rational::from(4),
+        }
+    }
+
+    fn incr_by_delta(&self) -> BranchNumber {
+        BranchNumber {
+            branch_num: self.branch_num.clone() + &self.delta,
+            delta: self.delta.clone(),
+        }
+    }
+
+    fn halve_delta(&self) -> BranchNumber {
+        BranchNumber {
+            branch_num: self.branch_num.clone(),
+            delta: &self.delta / Rational::from(2),
+        }
+    }
+}
+
+#[derive(Debug, Clone, PartialEq, Eq, Hash)]
+pub struct VarInfo {
+    var_ptr: VarPtr,
+    chunk_type: ChunkType,
+    classify_info: ClassifyInfo,
+    lvl: Level,
+}
+
+#[derive(Debug, Clone, PartialEq, Eq, Hash)]
+pub struct ChunkInfo {
+    chunk_num: usize,
+    term_loc: GenContext,
+    // pointer to incidence, term occurrence arity.
+    vars: Vec<VarInfo>,
+}
+
+#[derive(Debug)]
+pub struct BranchArm {
+    pub arm_terms: Vec<QueryTerm>,
+}
+
+#[derive(Debug, Clone, PartialEq, Eq, Hash)]
+pub struct BranchInfo {
+    branch_num: BranchNumber,
+    chunks: Vec<ChunkInfo>,
+}
+
+impl BranchInfo {
+    fn new(branch_num: BranchNumber) -> Self {
+        Self {
+            branch_num,
+            chunks: vec![],
+        }
+    }
+}
+
+type BranchMapInt = IndexMap<VarPtr, Vec<BranchInfo>>;
+
+#[derive(Debug, Clone)]
+pub struct BranchMap(BranchMapInt);
+
+impl Deref for BranchMap {
+    type Target = BranchMapInt;
+
+    #[inline(always)]
+    fn deref(&self) -> &BranchMapInt {
+        &self.0
+    }
+}
+
+impl DerefMut for BranchMap {
+    #[inline(always)]
+    fn deref_mut(&mut self) -> &mut BranchMapInt {
+        &mut self.0
+    }
+}
+
+type RootSet = IndexSet<BranchNumber>;
+
+#[derive(Debug, Clone, Copy, PartialEq, Eq, Hash)]
+pub struct ClassifyInfo {
+    arg_c: usize,
+    arity: usize,
+}
+
+enum TraversalState {
+    // construct a QueryTerm::Branch with number of disjuncts, reset
+    // the chunk type to that of the chunk preceding the disjunct and the chunk_num.
+    BuildDisjunct(usize),
+    // add the last disjunct to a QueryTerm::Branch, continuing from
+    // where it leaves off.
+    BuildFinalDisjunct(usize),
+    Fail,
+    GetCutPoint { var_num: usize, prev_b: bool },
+    Cut { var_num: usize, is_global: bool },
+    CutPrev(usize),
+    ResetCallPolicy(CallPolicy),
+    Term(Term),
+    OverrideGlobalCutVar(usize),
+    ResetGlobalCutVarOverride(Option<usize>),
+    RemoveBranchNum,            // pop the current_branch_num and from the root set.
+    AddBranchNum(BranchNumber), // set current_branch_num, add it to the root set
+    RepBranchNum(BranchNumber), // replace current_branch_num and the latest in the root set
+}
+
+#[derive(Debug)]
+pub struct VariableClassifier {
+    call_policy: CallPolicy,
+    current_branch_num: BranchNumber,
+    current_chunk_num: usize,
+    current_chunk_type: ChunkType,
+    branch_map: BranchMap,
+    var_num: usize,
+    root_set: RootSet,
+    global_cut_var_num: Option<usize>,
+    global_cut_var_num_override: Option<usize>,
+}
+
+#[derive(Debug, Default)]
+pub struct VarData {
+    pub records: VariableRecords,
+    pub global_cut_var_num: Option<usize>,
+    pub allocates: bool,
+}
+
+impl VarData {
+    fn emit_initial_get_level(&mut self, build_stack: &mut ChunkedTermVec) {
+        let global_cut_var_num = if let &Some(global_cut_var_num) = &self.global_cut_var_num {
+            match &self.records[global_cut_var_num].allocation {
+                VarAlloc::Perm(..) => Some(global_cut_var_num),
+                VarAlloc::Temp { term_loc, .. } if term_loc.chunk_num() > 0 => {
+                    Some(global_cut_var_num)
+                }
+                _ => None,
+            }
+        } else {
+            None
+        };
+
+        if let Some(global_cut_var_num) = global_cut_var_num {
+            let term = QueryTerm::GetLevel(global_cut_var_num);
+            self.records[global_cut_var_num].allocation =
+                VarAlloc::Perm(0, PermVarAllocation::Pending);
+
+            match build_stack.front_mut() {
+                Some(ChunkedTerms::Branch(_)) => {
+                    build_stack.push_front(ChunkedTerms::Chunk(VecDeque::from(vec![term])));
+                }
+                Some(ChunkedTerms::Chunk(chunk)) => {
+                    chunk.push_front(term);
+                }
+                None => {
+                    unreachable!()
+                }
+            }
+        }
+    }
+}
+
+pub type ClassifyFactResult = (Term, VarData);
+pub type ClassifyRuleResult = (Term, ChunkedTermVec, VarData);
+
+fn merge_branch_seq(branches: impl Iterator<Item = BranchInfo>) -> BranchInfo {
+    let mut branch_info = BranchInfo::new(BranchNumber::default());
+
+    for mut branch in branches {
+        branch_info.branch_num = branch.branch_num;
+        branch_info.chunks.append(&mut branch.chunks);
+    }
+
+    branch_info.branch_num.delta = branch_info.branch_num.delta * Integer::from(2);
+    branch_info.branch_num.branch_num -= &branch_info.branch_num.delta;
+
+    branch_info
+}
+
+fn flatten_into_disjunct(build_stack: &mut ChunkedTermVec, preceding_len: usize) {
+    let branch_vec = build_stack.drain(preceding_len + 1..).collect();
+
+    if let ChunkedTerms::Branch(ref mut disjuncts) = &mut build_stack[preceding_len] {
+        disjuncts.push(branch_vec);
+    } else {
+        unreachable!();
+    }
+}
+
+impl VariableClassifier {
+    pub fn new(call_policy: CallPolicy) -> Self {
+        Self {
+            call_policy,
+            current_branch_num: BranchNumber::default(),
+            current_chunk_num: 0,
+            current_chunk_type: ChunkType::Head,
+            branch_map: BranchMap(BranchMapInt::new()),
+            root_set: RootSet::new(),
+            var_num: 0,
+            global_cut_var_num: None,
+            global_cut_var_num_override: None,
+        }
+    }
+
+    pub fn classify_fact(mut self, term: Term) -> Result<ClassifyFactResult, CompilationError> {
+        self.classify_head_variables(&term)?;
+        Ok((
+            term,
+            self.branch_map.separate_and_classify_variables(
+                self.var_num,
+                self.global_cut_var_num,
+                self.current_chunk_num,
+            ),
+        ))
+    }
+
+    pub fn classify_rule<'a, LS: LoadState<'a>>(
+        mut self,
+        loader: &mut Loader<'a, LS>,
+        head: Term,
+        body: Term,
+    ) -> Result<ClassifyRuleResult, CompilationError> {
+        self.classify_head_variables(&head)?;
+        self.root_set.insert(self.current_branch_num.clone());
+
+        let mut query_terms = self.classify_body_variables(loader, body)?;
+
+        self.merge_branches();
+
+        let mut var_data = self.branch_map.separate_and_classify_variables(
+            self.var_num,
+            self.global_cut_var_num,
+            self.current_chunk_num,
+        );
+
+        var_data.emit_initial_get_level(&mut query_terms);
+
+        Ok((head, query_terms, var_data))
+    }
+
+    fn merge_branches(&mut self) {
+        for branches in self.branch_map.values_mut() {
+            let mut old_branches = std::mem::take(branches);
+
+            while let Some(last_branch_num) = old_branches.last().map(|bi| &bi.branch_num) {
+                let mut old_branches_len = old_branches.len();
+
+                for (rev_idx, bi) in old_branches.iter().rev().enumerate() {
+                    if &bi.branch_num > last_branch_num {
+                        old_branches_len = old_branches.len() - rev_idx;
+                    }
+                }
+
+                let iter = old_branches.drain(old_branches_len - 1..);
+                branches.push(merge_branch_seq(iter));
+            }
+
+            branches.reverse();
+        }
+    }
+
+    fn try_set_chunk_at_inlined_boundary(&mut self) -> bool {
+        if self.current_chunk_type.is_last() {
+            self.current_chunk_type = ChunkType::Mid;
+            self.current_chunk_num += 1;
+            true
+        } else {
+            false
+        }
+    }
+
+    fn try_set_chunk_at_call_boundary(&mut self) -> bool {
+        if self.current_chunk_type.is_last() {
+            self.current_chunk_num += 1;
+            true
+        } else {
+            self.current_chunk_type = ChunkType::Last;
+            false
+        }
+    }
+
+    fn probe_body_term(&mut self, arg_c: usize, arity: usize, term: &Term) {
+        let classify_info = ClassifyInfo { arg_c, arity };
+
+        // second arg is true to iterate the root, which may be a variable
+        for term_ref in breadth_first_iter(term, RootIterationPolicy::Iterated) {
+            if let TermRef::Var(lvl, _, var_ptr) = term_ref {
+                // root terms are shallow here (since we're iterating a
+                // body term) so take the child level.
+                let lvl = lvl.child_level();
+                self.probe_body_var(VarInfo {
+                    var_ptr,
+                    lvl,
+                    classify_info,
+                    chunk_type: self.current_chunk_type,
+                });
+            }
+        }
+    }
+
+    fn probe_body_var(&mut self, var_info: VarInfo) {
+        let term_loc = self
+            .current_chunk_type
+            .to_gen_context(self.current_chunk_num);
+
+        let branch_info_v = self.branch_map.entry(var_info.var_ptr.clone()).or_default();
+
+        let needs_new_branch = if let Some(last_bi) = branch_info_v.last() {
+            !self.root_set.contains(&last_bi.branch_num)
+        } else {
+            true
+        };
+
+        if needs_new_branch {
+            branch_info_v.push(BranchInfo::new(self.current_branch_num.clone()));
+        }
+
+        let branch_info = branch_info_v.last_mut().unwrap();
+
+        let needs_new_chunk = if let Some(last_ci) = branch_info.chunks.last() {
+            last_ci.chunk_num != self.current_chunk_num
+        } else {
+            true
+        };
+
+        if needs_new_chunk {
+            branch_info.chunks.push(ChunkInfo {
+                chunk_num: self.current_chunk_num,
+                term_loc,
+                vars: vec![],
+            });
+        }
+
+        let chunk_info = branch_info.chunks.last_mut().unwrap();
+        chunk_info.vars.push(var_info);
+    }
+
+    fn probe_in_situ_var(&mut self, var_num: usize) {
+        let classify_info = ClassifyInfo { arg_c: 1, arity: 1 };
+
+        let var_info = VarInfo {
+            var_ptr: VarPtr::from(Var::InSitu(var_num)),
+            classify_info,
+            chunk_type: self.current_chunk_type,
+            lvl: Level::Shallow,
+        };
+
+        self.probe_body_var(var_info);
+    }
+
+    fn classify_head_variables(&mut self, term: &Term) -> Result<(), CompilationError> {
+        match term {
+            Term::Clause(..) | Term::Literal(_, Literal::Atom(_)) => {}
+            _ => return Err(CompilationError::InvalidRuleHead),
+        }
+
+        let mut classify_info = ClassifyInfo {
+            arg_c: 1,
+            arity: term.arity(),
+        };
+
+        if let Term::Clause(_, _, terms) = term {
+            for term in terms.iter() {
+                for term_ref in breadth_first_iter(term, RootIterationPolicy::Iterated) {
+                    if let TermRef::Var(lvl, _, var_ptr) = term_ref {
+                        // a body term, so we need the child level here.
+                        let lvl = lvl.child_level();
+
+                        // the body of the if let here is an inlined
+                        // "probe_head_var". note the difference between it
+                        // and "probe_body_var".
+                        let branch_info_v = self.branch_map.entry(var_ptr.clone()).or_default();
+
+                        let needs_new_branch = branch_info_v.is_empty();
+
+                        if needs_new_branch {
+                            branch_info_v.push(BranchInfo::new(self.current_branch_num.clone()));
+                        }
+
+                        let branch_info = branch_info_v.last_mut().unwrap();
+                        let needs_new_chunk = branch_info.chunks.is_empty();
+
+                        if needs_new_chunk {
+                            branch_info.chunks.push(ChunkInfo {
+                                chunk_num: self.current_chunk_num,
+                                term_loc: GenContext::Head,
+                                vars: vec![],
+                            });
+                        }
+
+                        let chunk_info = branch_info.chunks.last_mut().unwrap();
+                        let var_info = VarInfo {
+                            var_ptr,
+                            classify_info,
+                            chunk_type: self.current_chunk_type,
+                            lvl,
+                        };
+
+                        chunk_info.vars.push(var_info);
+                    }
+                }
+
+                classify_info.arg_c += 1;
+            }
+        }
+
+        Ok(())
+    }
+
+    fn classify_body_variables<'a, LS: LoadState<'a>>(
+        &mut self,
+        loader: &mut Loader<'a, LS>,
+        term: Term,
+    ) -> Result<ChunkedTermVec, CompilationError> {
+        let mut state_stack = vec![TraversalState::Term(term)];
+        let mut build_stack = ChunkedTermVec::new();
+
+        self.current_chunk_type = ChunkType::Mid;
+
+        while let Some(traversal_st) = state_stack.pop() {
+            match traversal_st {
+                TraversalState::AddBranchNum(branch_num) => {
+                    self.root_set.insert(branch_num.clone());
+                    self.current_branch_num = branch_num;
+                }
+                TraversalState::RemoveBranchNum => {
+                    self.root_set.pop();
+                }
+                TraversalState::RepBranchNum(branch_num) => {
+                    self.root_set.pop();
+                    self.root_set.insert(branch_num.clone());
+                    self.current_branch_num = branch_num;
+                }
+                TraversalState::ResetCallPolicy(call_policy) => {
+                    self.call_policy = call_policy;
+                }
+                TraversalState::BuildDisjunct(preceding_len) => {
+                    flatten_into_disjunct(&mut build_stack, preceding_len);
+
+                    self.current_chunk_type = ChunkType::Mid;
+                    self.current_chunk_num += 1;
+                }
+                TraversalState::BuildFinalDisjunct(preceding_len) => {
+                    flatten_into_disjunct(&mut build_stack, preceding_len);
+
+                    self.current_chunk_type = ChunkType::Mid;
+                    self.current_chunk_num += 1;
+                }
+                TraversalState::GetCutPoint { var_num, prev_b } => {
+                    if self.try_set_chunk_at_inlined_boundary() {
+                        build_stack.add_chunk();
+                    }
+
+                    self.probe_in_situ_var(var_num);
+                    build_stack.push_chunk_term(QueryTerm::GetCutPoint { var_num, prev_b });
+                }
+                TraversalState::OverrideGlobalCutVar(var_num) => {
+                    self.global_cut_var_num_override = Some(var_num);
+                }
+                TraversalState::ResetGlobalCutVarOverride(old_override) => {
+                    self.global_cut_var_num_override = old_override;
+                }
+                TraversalState::Cut { var_num, is_global } => {
+                    if self.try_set_chunk_at_inlined_boundary() {
+                        build_stack.add_chunk();
+                    }
+
+                    self.probe_in_situ_var(var_num);
+
+                    build_stack.push_chunk_term(if is_global {
+                        QueryTerm::GlobalCut(var_num)
+                    } else {
+                        QueryTerm::LocalCut {
+                            var_num,
+                            cut_prev: false,
+                        }
+                    });
+                }
+                TraversalState::CutPrev(var_num) => {
+                    if self.try_set_chunk_at_inlined_boundary() {
+                        build_stack.add_chunk();
+                    }
+
+                    self.probe_in_situ_var(var_num);
+
+                    build_stack.push_chunk_term(QueryTerm::LocalCut {
+                        var_num,
+                        cut_prev: true,
+                    });
+                }
+                TraversalState::Fail => {
+                    build_stack.push_chunk_term(QueryTerm::Fail);
+                }
+                TraversalState::Term(term) => {
+                    // return true iff new chunk should be added.
+                    let update_chunk_data = |classifier: &mut Self, predicate_name, arity| {
+                        if ClauseType::is_inlined(predicate_name, arity) {
+                            classifier.try_set_chunk_at_inlined_boundary()
+                        } else {
+                            classifier.try_set_chunk_at_call_boundary()
+                        }
+                    };
+
+                    let mut add_chunk = |classifier: &mut Self, name: Atom, terms: Vec<Term>| {
+                        if update_chunk_data(classifier, name, terms.len()) {
+                            build_stack.add_chunk();
+                        }
+
+                        for (arg_c, term) in terms.iter().enumerate() {
+                            classifier.probe_body_term(arg_c + 1, terms.len(), term);
+                        }
+
+                        build_stack.push_chunk_term(clause_to_query_term(
+                            loader,
+                            name,
+                            terms,
+                            classifier.call_policy,
+                        ));
+                    };
+
+                    match term {
+                        Term::Clause(
+                            _,
+                            name @ (atom!("->") | atom!(";") | atom!(",")),
+                            mut terms,
+                        ) if terms.len() == 3 => {
+                            if let Some(last_arg) = terms.last() {
+                                if let Term::Literal(_, Literal::CodeIndex(_)) = last_arg {
+                                    terms.pop();
+                                    state_stack.push(TraversalState::Term(Term::Clause(
+                                        Cell::default(),
+                                        name,
+                                        terms,
+                                    )));
+                                } else {
+                                    add_chunk(self, name, terms);
+                                }
+                            }
+                        }
+                        Term::Clause(_, atom!(","), mut terms) if terms.len() == 2 => {
+                            let tail = terms.pop().unwrap();
+                            let head = terms.pop().unwrap();
+
+                            let iter = unfold_by_str(tail, atom!(","))
+                                .into_iter()
+                                .rev()
+                                .chain(std::iter::once(head))
+                                .map(TraversalState::Term);
+
+                            state_stack.extend(iter);
+                        }
+                        Term::Clause(_, atom!(";"), mut terms) if terms.len() == 2 => {
+                            let tail = terms.pop().unwrap();
+                            let head = terms.pop().unwrap();
+
+                            let first_branch_num = self.current_branch_num.split();
+                            let branches: Vec<_> = std::iter::once(head)
+                                .chain(unfold_by_str(tail, atom!(";")).into_iter())
+                                .collect();
+
+                            let mut branch_numbers = vec![first_branch_num];
+
+                            for idx in 1..branches.len() {
+                                let succ_branch_number = branch_numbers[idx - 1].incr_by_delta();
+
+                                branch_numbers.push(if idx + 1 < branches.len() {
+                                    succ_branch_number.split()
+                                } else {
+                                    succ_branch_number
+                                });
+                            }
+
+                            let build_stack_len = build_stack.len();
+                            build_stack.reserve_branch(branches.len());
+
+                            state_stack.push(TraversalState::RepBranchNum(
+                                self.current_branch_num.halve_delta(),
+                            ));
+
+                            let iter = branches.into_iter().zip(branch_numbers.into_iter());
+                            let final_disjunct_loc = state_stack.len();
+
+                            for (term, branch_num) in iter.rev() {
+                                state_stack.push(TraversalState::BuildDisjunct(build_stack_len));
+                                state_stack.push(TraversalState::RemoveBranchNum);
+                                state_stack.push(TraversalState::Term(term));
+                                state_stack.push(TraversalState::AddBranchNum(branch_num));
+                            }
+
+                            if let TraversalState::BuildDisjunct(build_stack_len) =
+                                state_stack[final_disjunct_loc]
+                            {
+                                state_stack[final_disjunct_loc] =
+                                    TraversalState::BuildFinalDisjunct(build_stack_len);
+                            }
+
+                            self.current_chunk_type = ChunkType::Mid;
+                            self.current_chunk_num += 1;
+                        }
+                        Term::Clause(_, atom!("->"), mut terms) if terms.len() == 2 => {
+                            let then_term = terms.pop().unwrap();
+                            let if_term = terms.pop().unwrap();
+
+                            let prev_b = if matches!(
+                                state_stack.last(),
+                                Some(TraversalState::RemoveBranchNum)
+                            ) {
+                                // check if the second-to-last element
+                                // is a regular BuildDisjunct, as we
+                                // don't want to add GetPrevLevel in
+                                // case of a TrustMe.
+                                match state_stack.iter().rev().nth(1) {
+                                    Some(&TraversalState::BuildDisjunct(preceding_len)) => {
+                                        preceding_len + 1 == build_stack.len()
+                                    }
+                                    _ => false,
+                                }
+                            } else {
+                                false
+                            };
+
+                            state_stack.push(TraversalState::Term(then_term));
+                            state_stack.push(TraversalState::Cut {
+                                var_num: self.var_num,
+                                is_global: false,
+                            });
+                            state_stack.push(TraversalState::Term(if_term));
+                            state_stack.push(TraversalState::GetCutPoint {
+                                var_num: self.var_num,
+                                prev_b,
+                            });
+
+                            self.var_num += 1;
+                        }
+                        Term::Clause(_, atom!("\\+"), mut terms) if terms.len() == 1 => {
+                            let not_term = terms.pop().unwrap();
+                            let build_stack_len = build_stack.len();
+
+                            build_stack.reserve_branch(2);
+
+                            state_stack.push(TraversalState::BuildFinalDisjunct(build_stack_len));
+                            state_stack.push(TraversalState::Term(Term::Clause(
+                                Cell::default(),
+                                atom!("$succeed"),
+                                vec![],
+                            )));
+                            state_stack.push(TraversalState::BuildDisjunct(build_stack_len));
+                            state_stack.push(TraversalState::Fail);
+                            state_stack.push(TraversalState::CutPrev(self.var_num));
+                            state_stack.push(TraversalState::ResetGlobalCutVarOverride(
+                                self.global_cut_var_num_override,
+                            ));
+                            state_stack.push(TraversalState::Term(not_term));
+                            state_stack.push(TraversalState::OverrideGlobalCutVar(self.var_num));
+                            state_stack.push(TraversalState::GetCutPoint {
+                                var_num: self.var_num,
+                                prev_b: false,
+                            });
+
+                            self.current_chunk_type = ChunkType::Mid;
+                            self.current_chunk_num += 1;
+
+                            self.var_num += 1;
+                        }
+                        Term::Clause(_, atom!(":"), mut terms) if terms.len() == 2 => {
+                            let predicate_name = terms.pop().unwrap();
+                            let module_name = terms.pop().unwrap();
+
+                            match (module_name, predicate_name) {
+                                (
+                                    Term::Literal(_, Literal::Atom(module_name)),
+                                    Term::Literal(_, Literal::Atom(predicate_name)),
+                                ) => {
+                                    if update_chunk_data(self, predicate_name, 0) {
+                                        build_stack.add_chunk();
+                                    }
+
+                                    build_stack.push_chunk_term(qualified_clause_to_query_term(
+                                        loader,
+                                        module_name,
+                                        predicate_name,
+                                        vec![],
+                                        self.call_policy,
+                                    ));
+                                }
+                                (
+                                    Term::Literal(_, Literal::Atom(module_name)),
+                                    Term::Clause(_, name, terms),
+                                ) => {
+                                    if update_chunk_data(self, name, terms.len()) {
+                                        build_stack.add_chunk();
+                                    }
+
+                                    for (arg_c, term) in terms.iter().enumerate() {
+                                        self.probe_body_term(arg_c + 1, terms.len(), term);
+                                    }
+
+                                    build_stack.push_chunk_term(qualified_clause_to_query_term(
+                                        loader,
+                                        module_name,
+                                        name,
+                                        terms,
+                                        self.call_policy,
+                                    ));
+                                }
+                                (module_name, predicate_name) => {
+                                    if update_chunk_data(self, atom!("call"), 2) {
+                                        build_stack.add_chunk();
+                                    }
+
+                                    self.probe_body_term(1, 0, &module_name);
+                                    self.probe_body_term(2, 0, &predicate_name);
+
+                                    terms.push(module_name);
+                                    terms.push(predicate_name);
+
+                                    build_stack.push_chunk_term(clause_to_query_term(
+                                        loader,
+                                        atom!("call"),
+                                        vec![Term::Clause(Cell::default(), atom!(":"), terms)],
+                                        self.call_policy,
+                                    ));
+                                }
+                            }
+                        }
+                        Term::Clause(_, atom!("$call_with_inference_counting"), mut terms)
+                            if terms.len() == 1 =>
+                        {
+                            state_stack.push(TraversalState::ResetCallPolicy(self.call_policy));
+                            state_stack.push(TraversalState::Term(terms.pop().unwrap()));
+
+                            self.call_policy = CallPolicy::Counted;
+                        }
+                        Term::Clause(_, name, terms) => {
+                            add_chunk(self, name, terms);
+                        }
+                        var @ Term::Var(..) => {
+                            if update_chunk_data(self, atom!("call"), 1) {
+                                build_stack.add_chunk();
+                            }
+
+                            self.probe_body_term(1, 1, &var);
+
+                            build_stack.push_chunk_term(clause_to_query_term(
+                                loader,
+                                atom!("call"),
+                                vec![var],
+                                self.call_policy,
+                            ));
+                        }
+                        Term::Literal(_, Literal::Atom(atom!("!")) | Literal::Char('!')) => {
+                            let (var_num, is_global) =
+                                if let Some(var_num) = self.global_cut_var_num_override {
+                                    (var_num, false)
+                                } else if let Some(var_num) = self.global_cut_var_num {
+                                    (var_num, true)
+                                } else {
+                                    let var_num = self.var_num;
+
+                                    self.global_cut_var_num = Some(var_num);
+                                    self.var_num += 1;
+
+                                    (var_num, true)
+                                };
+
+                            self.probe_in_situ_var(var_num);
+
+                            state_stack.push(TraversalState::Cut { var_num, is_global });
+                        }
+                        Term::Literal(_, Literal::Atom(name)) => {
+                            if update_chunk_data(self, name, 0) {
+                                build_stack.add_chunk();
+                            }
+
+                            build_stack.push_chunk_term(clause_to_query_term(
+                                loader,
+                                name,
+                                vec![],
+                                self.call_policy,
+                            ));
+                        }
+                        _ => {
+                            return Err(CompilationError::InadmissibleQueryTerm);
+                        }
+                    }
+                }
+            }
+        }
+
+        Ok(build_stack)
+    }
+}
+
+impl BranchMap {
+    pub fn separate_and_classify_variables(
+        &mut self,
+        var_num: usize,
+        global_cut_var_num: Option<usize>,
+        current_chunk_num: usize,
+    ) -> VarData {
+        let mut var_data = VarData {
+            records: VariableRecords::new(var_num),
+            global_cut_var_num,
+            allocates: current_chunk_num > 0,
+        };
+
+        for (var, branches) in self.iter_mut() {
+            let (mut var_num, var_num_incr) = if let Var::InSitu(var_num) = *var.borrow() {
+                (var_num, false)
+            } else {
+                (var_data.records.len(), true)
+            };
+
+            for branch in branches.iter_mut() {
+                if var_num_incr {
+                    var_num = var_data.records.len();
+                    var_data.records.push(VariableRecord::default());
+                }
+
+                if branch.chunks.len() <= 1 {
+                    // true iff var is a temporary variable.
+                    debug_assert_eq!(branch.chunks.len(), 1);
+
+                    let chunk = &mut branch.chunks[0];
+                    let mut temp_var_data = TempVarData::new();
+
+                    for var_info in chunk.vars.iter_mut() {
+                        if var_info.lvl == Level::Shallow {
+                            let term_loc = var_info.chunk_type.to_gen_context(chunk.chunk_num);
+                            temp_var_data
+                                .use_set
+                                .insert((term_loc, var_info.classify_info.arg_c));
+                        }
+                    }
+
+                    var_data.records[var_num].allocation = VarAlloc::Temp {
+                        term_loc: chunk.term_loc,
+                        temp_reg: 0,
+                        temp_var_data,
+                        safety: VarSafetyStatus::Needed,
+                        to_perm_var_num: None,
+                    };
+                } // else VarAlloc is already a Perm variant, as it's the default.
+
+                for chunk in branch.chunks.iter_mut() {
+                    var_data.records[var_num].num_occurrences += chunk.vars.len();
+
+                    for var_info in chunk.vars.iter_mut() {
+                        var_info.var_ptr.set(Var::Generated(var_num));
+                    }
+                }
+            }
+        }
+
+        var_data.records.populate_restricting_sets();
+        var_data
+    }
+}

src/machine/heap.rs

@@ -6,7 +6,7 @@ use crate::machine::partial_string::*;
 use crate::parser::ast::*;
 use crate::types::*;
 
-use crate::parser::rug::{Integer, Rational};
+use crate::parser::dashu::{Integer, Rational};
 
 use std::convert::TryFrom;
 
@@ -130,11 +130,7 @@ pub fn print_heap_terms<'a, I: Iterator<Item = &'a HeapCellValue>>(heap: I, h: u
 }
 
 #[inline]
-pub(crate) fn put_complete_string(
+pub(crate) fn put_complete_string(heap: &mut Heap, s: &str, atom_tbl: &AtomTable) -> HeapCellValue {
-    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.
@@ -157,11 +153,7 @@ pub(crate) fn put_complete_string(
 }
 
 #[inline]
-pub(crate) fn put_partial_string(
+pub(crate) fn put_partial_string(heap: &mut Heap, s: &str, atom_tbl: &AtomTable) -> HeapCellValue {
-    heap: &mut Heap,
-    s: &str,
-    atom_tbl: &mut AtomTable,
-) -> HeapCellValue {
     match allocate_pstr(heap, s, atom_tbl) {
         Some(h) => {
             pstr_loc_as_cell!(h)
@@ -173,15 +165,11 @@ pub(crate) fn put_partial_string(
 }
 
 #[inline]
-pub(crate) fn allocate_pstr(
+pub(crate) fn allocate_pstr(heap: &mut Heap, mut src: &str, atom_tbl: &AtomTable) -> Option<usize> {
-    heap: &mut Heap,
-    mut src: &str,
-    atom_tbl: &mut AtomTable,
-) -> Option<usize> {
     let orig_h = heap.len();
 
     loop {
-        if src == "" {
+        if src.is_empty() {
             return if orig_h == heap.len() {
                 None
             } else {
@@ -211,7 +199,7 @@ pub(crate) fn allocate_pstr(
 
         heap.push(string_as_pstr_cell!(pstr));
 
-        if rest_src != "" {
+        if !rest_src.is_empty() {
             heap.push(pstr_loc_as_cell!(h + 2));
             src = rest_src;
         } else {
@@ -258,7 +246,10 @@ pub(crate) fn to_local_code_ptr(heap: &Heap, addr: HeapCellValue) -> Option<usiz
     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(),
+            Ok(Number::Integer(n)) => {
+                let value: usize = (&*n).try_into().unwrap();
+                Some(value)
+            }
             _ => None,
         }
     };