Compare commits
1 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
3fc5be0d03 |
4
.gitattributes
vendored
4
.gitattributes
vendored
@@ -1,4 +0,0 @@
|
||||
*.png binary
|
||||
*.pl text eol=lf
|
||||
*.rs text eol=lf diff=rust
|
||||
*.md text eol=lf diff=markdown
|
||||
179
.github/workflows/ci.yml
vendored
179
.github/workflows/ci.yml
vendored
@@ -1,179 +0,0 @@
|
||||
name: CI
|
||||
|
||||
on:
|
||||
push:
|
||||
branches: [master]
|
||||
tags:
|
||||
- "v**"
|
||||
pull_request:
|
||||
schedule:
|
||||
- cron: '0 0 * * 3' # At 12:00 AM, only on Wednesday
|
||||
workflow_dispatch:
|
||||
|
||||
jobs:
|
||||
build-test:
|
||||
runs-on: ${{ matrix.os }}
|
||||
strategy:
|
||||
fail-fast: false
|
||||
matrix:
|
||||
include:
|
||||
# operating systems
|
||||
- { os: windows-latest, rust-version: stable, publish: true, target: 'x86_64-pc-windows-msvc'}
|
||||
- { os: macos-11, rust-version: stable, publish: true, target: 'x86_64-apple-darwin' }
|
||||
- { os: ubuntu-20.04, rust-version: stable, publish: true, target: 'x86_64-unknown-linux-gnu' }
|
||||
# architectures
|
||||
- { os: ubuntu-22.04, rust-version: stable, publish: true, target: 'x86_64-unknown-linux-gnu', extra: true }
|
||||
- { os: ubuntu-22.04, rust-version: stable, publish: true, target: 'i686-unknown-linux-gnu' }
|
||||
- { os: ubuntu-22.04, rust-version: nightly, publish: true, target: 'wasm32-unknown-unknown', args: '--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
|
||||
- uses: dtolnay/rust-toolchain@master
|
||||
id: toolchain
|
||||
with:
|
||||
toolchain: ${{ matrix.rust-version }}
|
||||
targets: ${{ matrix.target }}
|
||||
components: clippy, rustfmt
|
||||
- name: Install i686 dependencies
|
||||
if: "contains(matrix.target,'i686')"
|
||||
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: ${{ matrix.os }}_${{ matrix.target }}_rustc-${{ steps.toolchain.outputs.cachekey }}_cargo-${{ hashFiles('**/Cargo.lock') }}
|
||||
|
||||
# Build and test.
|
||||
- name: Build library
|
||||
run: cargo rustc --lib --target ${{ matrix.target }} ${{ matrix.args }} --verbose
|
||||
- name: Test
|
||||
if: "!matrix.extra"
|
||||
run: cargo test --target ${{ matrix.target }} ${{ matrix.args }} --all --verbose || echo "::warning ::Tests failed"
|
||||
|
||||
# Extra steps only run once to avoid duplication, when matrix.extra is true
|
||||
- name: Test and report
|
||||
if: matrix.extra
|
||||
run: |
|
||||
cargo install cargo2junit --force
|
||||
RUSTC_BOOTSTRAP=1 cargo test --all -- -Z unstable-options --format json --report-time | cargo2junit > cargo_test_results.xml
|
||||
- name: Publish cargo test results artifact
|
||||
if: matrix.extra
|
||||
uses: actions/upload-artifact@v3
|
||||
with:
|
||||
name: cargo-test-results
|
||||
path: cargo_test_results.xml
|
||||
- name: Publish cargo test summary
|
||||
if: matrix.extra
|
||||
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
|
||||
- name: Check formatting
|
||||
if: matrix.extra
|
||||
run: cargo fmt --check || echo "::warning ::cargo fmt found some formatting changes that may improve readability"
|
||||
- name: Check clippy
|
||||
if: matrix.extra
|
||||
run: cargo clippy --no-deps || echo "::warning ::cargo clippy found some code style changes that may be more idiomatic"
|
||||
|
||||
# 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
|
||||
|
||||
# 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
|
||||
55
.github/workflows/docker-publish.yml
vendored
55
.github/workflows/docker-publish.yml
vendored
@@ -1,55 +0,0 @@
|
||||
name: Docker Publish
|
||||
|
||||
on:
|
||||
push:
|
||||
branches:
|
||||
- 'master'
|
||||
tags:
|
||||
- 'v*.*.*'
|
||||
|
||||
jobs:
|
||||
build:
|
||||
|
||||
runs-on: ubuntu-latest
|
||||
|
||||
steps:
|
||||
- name: Checkout repository
|
||||
uses: actions/checkout@v3
|
||||
|
||||
# Workaround: https://github.com/docker/build-push-action/issues/461
|
||||
- name: Setup Docker buildx
|
||||
# https://github.com/docker/setup-buildx-action
|
||||
uses: docker/setup-buildx-action@v2.2.1
|
||||
|
||||
# Login against Docker registry
|
||||
- name: Log into registry
|
||||
# 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". The "latest" tag reflects the most recent build on
|
||||
# master.
|
||||
- name: Extract Docker metadata
|
||||
id: meta
|
||||
# https://github.com/docker/metadata-action
|
||||
uses: docker/metadata-action@v4.1.1
|
||||
with:
|
||||
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
|
||||
- name: Build and push Docker image
|
||||
id: build-and-push
|
||||
# https://github.com/docker/build-push-action
|
||||
uses: docker/build-push-action@v3.2.0
|
||||
with:
|
||||
context: .
|
||||
push: true
|
||||
tags: ${{ steps.meta.outputs.tags }}
|
||||
labels: ${{ steps.meta.outputs.labels }}
|
||||
2
.gitignore
vendored
2
.gitignore
vendored
@@ -1,5 +1,3 @@
|
||||
src/static_atoms.rs
|
||||
target/
|
||||
|
||||
|
||||
|
||||
|
||||
31
.travis.yml
Normal file
31
.travis.yml
Normal file
@@ -0,0 +1,31 @@
|
||||
language: rust
|
||||
cache: cargo
|
||||
os: linux
|
||||
dist: xenial
|
||||
|
||||
before_script:
|
||||
- cargo fetch
|
||||
|
||||
jobs:
|
||||
allow_failures:
|
||||
env:
|
||||
- CAN_FAIL=true
|
||||
include:
|
||||
- stage: "Stable: Build"
|
||||
rust: stable
|
||||
script: cargo rustc --verbose -- -D warnings
|
||||
name: "Build Stable"
|
||||
- stage: "Stable: Tests"
|
||||
rust: stable
|
||||
script: cargo test --verbose --all
|
||||
name: "Tests Stable"
|
||||
- stage: "Features"
|
||||
rust: stable
|
||||
script: cargo test --verbose --all --no-default-features --features num
|
||||
name: "num Tests"
|
||||
env: CAN_FAIL=true
|
||||
- stage: "Beta: Build"
|
||||
# - #
|
||||
rust: beta
|
||||
script: cargo rustc --verbose -- -D warnings
|
||||
name: "Build Beta"
|
||||
2832
Cargo.lock
generated
2832
Cargo.lock
generated
File diff suppressed because it is too large
Load Diff
111
Cargo.toml
111
Cargo.toml
@@ -1,115 +1,50 @@
|
||||
[package]
|
||||
name = "scryer-prolog"
|
||||
version = "0.9.3"
|
||||
version = "0.8.127"
|
||||
authors = ["Mark Thom <markjordanthom@gmail.com>"]
|
||||
edition = "2021"
|
||||
edition = "2018"
|
||||
description = "A modern Prolog implementation written mostly in Rust."
|
||||
readme = "README.md"
|
||||
repository = "https://github.com/mthom/scryer-prolog"
|
||||
license = "BSD-3-Clause"
|
||||
keywords = ["prolog", "prolog-interpreter", "prolog-system"]
|
||||
categories = ["command-line-utilities"]
|
||||
build = "build/main.rs"
|
||||
rust-version = "1.70"
|
||||
|
||||
[lib]
|
||||
crate-type = ["cdylib", "rlib"]
|
||||
|
||||
[features]
|
||||
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 = "build.rs"
|
||||
|
||||
[build-dependencies]
|
||||
indexmap = "1.0.2"
|
||||
proc-macro2 = "1.0.36"
|
||||
quote = "1.0.15"
|
||||
strum = "0.23"
|
||||
strum_macros = "0.23"
|
||||
syn = { version = "2.0.32", features = ['full', 'visit', 'extra-traits'] }
|
||||
to-syn-value = "0.1.1"
|
||||
to-syn-value_derive = "0.1.1"
|
||||
walkdir = "2"
|
||||
|
||||
[features]
|
||||
default = ["rug", "prolog_parser/rug"]
|
||||
num = ["num-rug-adapter", "prolog_parser/num"]
|
||||
|
||||
[dependencies]
|
||||
bit-set = "0.5.3"
|
||||
bitvec = "1"
|
||||
cpu-time = "1.0.0"
|
||||
dirs-next = "2.0.0"
|
||||
crossterm = "0.16.0"
|
||||
dirs = "2.0.2"
|
||||
divrem = "0.1.0"
|
||||
fxhash = "0.2.1"
|
||||
downcast = "0.10.0"
|
||||
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"
|
||||
ordered-float = "2.6.0"
|
||||
phf = { version = "0.9", features = ["macros"] }
|
||||
nix = "0.15.0"
|
||||
num-rug-adapter = { optional = true, version = "0.1.3" }
|
||||
ordered-float = "0.5.0"
|
||||
prolog_parser = { version = "0.8.65", default-features = false }
|
||||
ref_thread_local = "0.0.0"
|
||||
rug = { version = "1.4.0", optional = true }
|
||||
rustyline = "6.0.0"
|
||||
unicode_reader = "1.0.0"
|
||||
ring = "0.16.13"
|
||||
ripemd160 = "0.8.0"
|
||||
sha3 = "0.8.2"
|
||||
blake2 = "0.8.1"
|
||||
crrl = "0.6.0"
|
||||
openssl = { version = "0.10.29", features = ["vendored"] }
|
||||
native-tls = "0.2.4"
|
||||
chrono = "0.4.11"
|
||||
select = "0.6.0"
|
||||
select = "0.4.3"
|
||||
roxmltree = "0.11.0"
|
||||
base64 = "0.12.3"
|
||||
smallvec = "1.8.0"
|
||||
static_assertions = "1.1.0"
|
||||
ryu = "1.0.9"
|
||||
futures = "0.3"
|
||||
regex = "1.9.1"
|
||||
libloading = "0.7"
|
||||
derive_deref = "1.1.1"
|
||||
bytes = "1"
|
||||
dashu = "0.4.0"
|
||||
num-order = { version = "1.2.0" }
|
||||
rand = "0.8.5"
|
||||
|
||||
[target.'cfg(not(target_arch = "wasm32"))'.dependencies]
|
||||
libffi = { version = "3.2.0", optional = true }
|
||||
hostname = { version = "0.3.1", optional = true }
|
||||
crossterm = { version = "0.20.0", optional = true }
|
||||
ctrlc = { version = "3.2.2", optional = true }
|
||||
rustyline = { version = "12.0.0", optional = true }
|
||||
native-tls = { version = "0.2.4", optional = true }
|
||||
warp = { version = "=0.3.5", features = ["tls"], optional = true }
|
||||
reqwest = { version = "0.11.18", features = ["blocking"], optional = true }
|
||||
tokio = { version = "1.28.2", features = ["full"] }
|
||||
|
||||
[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"
|
||||
console_log = "1.0"
|
||||
wasm-bindgen = "0.2.87"
|
||||
wasm-bindgen-futures = "0.4"
|
||||
serde-wasm-bindgen = "0.5"
|
||||
web-sys = { version = "0.3", features = [
|
||||
"Document",
|
||||
"Window",
|
||||
"Element",
|
||||
]}
|
||||
|
||||
[target.'cfg(target_os = "wasi")'.dependencies]
|
||||
ring-wasi = { version = "0.16.25" }
|
||||
|
||||
[target.'cfg(not(target_os = "wasi"))'.dependencies]
|
||||
ring = { version = "0.16.13" }
|
||||
|
||||
[dev-dependencies]
|
||||
assert_cmd = "1.0.3"
|
||||
predicates-core = "1.0.2"
|
||||
maplit = "1.0.2"
|
||||
serial_test = "2.0.0"
|
||||
|
||||
[patch.crates-io]
|
||||
modular-bitfield = { git = "https://github.com/mthom/modular-bitfield" }
|
||||
sodiumoxide = "0.2.6"
|
||||
|
||||
61
Dockerfile
61
Dockerfile
@@ -1,31 +1,30 @@
|
||||
# See https://github.com/LukeMathWalker/cargo-chef
|
||||
ARG RUST_VERSION=1-buster
|
||||
FROM rust:${RUST_VERSION} as planner
|
||||
WORKDIR /scryer-prolog
|
||||
RUN cargo install cargo-chef
|
||||
COPY . .
|
||||
RUN cargo chef prepare --recipe-path recipe.json
|
||||
|
||||
FROM rust:${RUST_VERSION} as cacher
|
||||
WORKDIR /scryer-prolog
|
||||
RUN cargo install cargo-chef
|
||||
COPY --from=planner /scryer-prolog/recipe.json recipe.json
|
||||
RUN cargo chef cook --release --recipe-path recipe.json
|
||||
|
||||
FROM rust:${RUST_VERSION} as builder
|
||||
WORKDIR /scryer-prolog
|
||||
COPY . .
|
||||
# Copy over the cached dependencies
|
||||
COPY --from=cacher /scryer-prolog/target target
|
||||
COPY --from=cacher $CARGO_HOME $CARGO_HOME
|
||||
RUN cargo build --release --bin scryer-prolog
|
||||
|
||||
# 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"]
|
||||
# Based on https://hub.docker.com/_/rust?tab=description and https://blog.sedrik.se/posts/my-docker-setup-for-rust/
|
||||
|
||||
# The first container is for build purposes only.
|
||||
FROM rust as builder
|
||||
|
||||
WORKDIR /usr/src/scryer-prolog
|
||||
|
||||
# Using a dummy build.rs and src/main.rs with your Cargo.toml lets Docker cache your Rust dependencies and not rebuild
|
||||
# them every time.
|
||||
COPY Cargo.toml .
|
||||
COPY Cargo.lock .
|
||||
RUN mkdir -p src
|
||||
RUN echo "fn main() {}" > src/main.rs
|
||||
RUN echo "fn main() {}" > build.rs
|
||||
RUN cargo build --release
|
||||
|
||||
# We need to touch our real main.rs and build.rs files or else
|
||||
# docker will use the cached ones.
|
||||
COPY . .
|
||||
RUN touch src/main.rs
|
||||
RUN touch build.rs
|
||||
|
||||
RUN cargo build --release
|
||||
|
||||
RUN ls ./target/release
|
||||
|
||||
# Finally, copy the scryer-prolog executable to a slimmer container.
|
||||
FROM debian:buster-slim
|
||||
COPY --from=builder /usr/src/scryer-prolog/target/release/scryer-prolog /usr/local/bin/scryer-prolog
|
||||
CMD ["scryer-prolog"]
|
||||
|
||||
83
INDEX.dj
83
INDEX.dj
@@ -1,83 +0,0 @@
|
||||
# Scryer Prolog
|
||||
|
||||
```
|
||||
?- append("Hello, ", X, "Hello, Scryer Prolog!").
|
||||
X = "Scryer Prolog!".
|
||||
```
|
||||
|
||||
``` =html
|
||||
<div style="border: solid #00007f 3px;padding-left: 15px;padding-right: 15px;font-style: italic;background-color: #00007f30;">
|
||||
<h4>Scryer Prolog Meetup 2023</h4>
|
||||
<p>The first annual Scryer Prolog meetup is going to happen in Düsseldorf (Germany) on the 9th and 10th of November 2023. Join us to discover the present and future of Scryer Prolog! Participation is free, registration not required. <a href="https://hsd-pbsa.de/veranstaltung/scryer-prolog-meetup-2023/">More details here.</a></p>
|
||||
</div>
|
||||
```
|
||||
|
||||
{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
|
||||
* 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.2*. And it's already useful for lots of tasks.
|
||||
|
||||
| Windows | [Download](https://github.com/mthom/scryer-prolog/releases/download/v0.9.2/scryer-prolog_windows-latest.zip) |
|
||||
| macOS (Intel) | [Download](https://github.com/mthom/scryer-prolog/releases/download/v0.9.2/scryer-prolog_macos-11.zip) |
|
||||
| Linux | [Download](https://github.com/mthom/scryer-prolog/releases/download/v0.9.2/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)!
|
||||
379
README.md
379
README.md
@@ -1,4 +1,3 @@
|
||||
|
||||
# Scryer Prolog
|
||||
|
||||
Scryer Prolog aims to become to ISO Prolog what GHC is to Haskell: an open
|
||||
@@ -6,17 +5,14 @@ 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.
|
||||
|
||||
As of July 2023, **Scryer Prolog passes all [syntactic conformity tests](https://www.complang.tuwien.ac.at/ulrich/iso-prolog/conformity_testing)**.
|
||||
|
||||
The homepage of the project is: [**https://www.scryer.pl**](https://www.scryer.pl)
|
||||
|
||||

|
||||
|
||||
## 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 Reconstruction](https://github.com/mthom/scryer-prolog/blob/master/wambook/wambook.pdf).
|
||||
Machine: A Tutorial
|
||||
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
|
||||
@@ -47,7 +43,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`](https://arxiv.org/abs/1607.01590)".
|
||||
paper "Indexing `dif/2`".
|
||||
- [x] All-solutions predicates (`findall/{3,4}`, `bagof/3`, `setof/3`, `forall/2`).
|
||||
- [x] Clause creation and destruction (`asserta/1`, `assertz/1`,
|
||||
`retract/1`, `abolish/1`) with logical update semantics.
|
||||
@@ -55,24 +51,18 @@ 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](https://biblio.ugent.be/publication/5646080/file/5646081)").
|
||||
"Delimited Continuations for Prolog").
|
||||
- [x] Tabling library based on delimited continuations
|
||||
(documented in "[Tabling as a Library with Delimited Control](https://biblio.ugent.be/publication/6880648/file/6885145.pdf)").
|
||||
(documented in "Tabling as a Library with Delimited Control").
|
||||
- [x] A _redone_ representation of strings as difference lists of
|
||||
characters, using a packed internal representation.
|
||||
- [x] clp(B) and clp(ℤ) as builtin libraries.
|
||||
- [x] Streams and predicates for stream control.
|
||||
- [x] A simple sockets library representing TCP connections as streams.
|
||||
- [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.
|
||||
- [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](https://www.complang.tuwien.ac.at/ulrich/papers/PDF/2008-ciclops.pdf)." (_in progress_)
|
||||
- [x] A simple sockets library representing TCP connections as streams.
|
||||
- [ ] Incremental compilation and loading process, newly written,
|
||||
primarily in Prolog. (_in progress_)
|
||||
- [ ] A compacting garbage collector satisfying the five
|
||||
properties of "Precise Garbage Collection in Prolog."
|
||||
- [ ] Mode declarations.
|
||||
|
||||
## Phase 3
|
||||
@@ -91,12 +81,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
|
||||
Programming?](https://www.info.ucl.ac.be/~pvr/Peter.thesis/Peter.thesis.html)"
|
||||
Roy's thesis, "Can Logic Programming Execute as Fast as Imperative
|
||||
Programming?"
|
||||
|
||||
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](http://www.johngustafson.net/unums.html)."
|
||||
Gustafson's book "The End of Error."
|
||||
|
||||
3. Add concurrent tables to manage shared references to atoms and
|
||||
strings.
|
||||
@@ -105,14 +95,7 @@ strings.
|
||||
|
||||
## Installing Scryer Prolog
|
||||
|
||||
### Binaries
|
||||
|
||||
Precompiled binaries for several platforms are available for download
|
||||
at:
|
||||
|
||||
**https://github.com/mthom/scryer-prolog/releases/tag/v0.9.2**
|
||||
|
||||
### Native Compilation
|
||||
### Native Install (Unix Only)
|
||||
|
||||
First, install the latest stable version of
|
||||
[Rust](https://www.rust-lang.org/en-US/install.html) using your
|
||||
@@ -123,107 +106,31 @@ Rust updated to the latest stable release; any existing Rust
|
||||
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, and compile the system. This
|
||||
can be done as follows:
|
||||
Scryer Prolog can be installed with cargo, like so:
|
||||
|
||||
```
|
||||
$> cargo install scryer-prolog
|
||||
```
|
||||
|
||||
cargo will download and install the libraries Scryer Prolog uses
|
||||
automatically from crates.io. You can find the `scryer-prolog`
|
||||
executable in `~/.cargo/bin`.
|
||||
|
||||
Publishing Rust crates to crates.io and pushing to git are entirely
|
||||
distinct, independent processes, so to be sure you have the latest
|
||||
commit, it is recommended to clone directly from this git repository,
|
||||
which can be done as follows:
|
||||
|
||||
```
|
||||
$> git clone https://github.com/mthom/scryer-prolog
|
||||
$> cd scryer-prolog
|
||||
$> cargo build --release
|
||||
$> cargo run [--release]
|
||||
```
|
||||
|
||||
The `--release` flag performs various optimizations, producing a
|
||||
faster executable.
|
||||
The optional `--release` flag will perform various optimizations,
|
||||
producing a 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,
|
||||
the resulting binary does not need MSYS2 to run. When executing Scryer in a shell, it is recommended to use a more advanced shell than mintty (the default MSYS2 shell). The [Windows Terminal](https://github.com/microsoft/terminal) works correctly.
|
||||
|
||||
To build a Windows Installer, you'll need first Scryer Prolog compiled in release mode, then, with WiX Toolset installed, execute:
|
||||
```
|
||||
candle.exe scryer-prolog.wxs
|
||||
light.exe scryer-prolog.wixobj
|
||||
```
|
||||
It will generate a very basic MSI file which installs the main executable and a shortcut in the Start Menu. It can be installed with a double-click. To uninstall, go to the Control Panel and uninstall as usual.
|
||||
|
||||
Scryer Prolog must be built with **Rust 1.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
|
||||
### Docker Install (All Platforms)
|
||||
|
||||
First, install [Docker](https://docs.docker.com/get-docker/) on Linux,
|
||||
Windows, or Mac.
|
||||
@@ -296,16 +203,9 @@ predicates it defines. For example, with the program shown above:
|
||||
; What = pure_world.
|
||||
```
|
||||
|
||||
Press `SPACE` to show further answers, if any exist. Press `RETURN`
|
||||
or `.` to abort the search and return to the
|
||||
toplevel prompt. Press `f` to see up to the next multiple of
|
||||
5 answers, and `a` to see all answers. Press `h` to show a help
|
||||
message.
|
||||
|
||||
Use `TAB` to complete atoms and predicate names in queries. For
|
||||
instance, after consulting the program above, typing `decl` followed
|
||||
by `TAB` yields `declarative_world`. Press `TAB` repeatedly
|
||||
to cycle through alternative completions.
|
||||
Press `SPACE` to show further answers, if any exist. Press `RETURN` or
|
||||
`.` to abort the search and return to the toplevel prompt.
|
||||
Press `h` to show a help message.
|
||||
|
||||
To quit Scryer Prolog, use the standard predicate `halt/0`:
|
||||
|
||||
@@ -326,62 +226,11 @@ arithmetic operators with the usual precedences,
|
||||
|
||||
New operators can be defined using the `op` declaration.
|
||||
|
||||
### First instantiated argument indexing
|
||||
|
||||
Scryer Prolog indexes on the leftmost argument that is not a variable
|
||||
in all clauses of a predicate's definition. We call this strategy
|
||||
first *instantiated* argument indexing.
|
||||
|
||||
A key motivation for first instantiated argument indexing is to enable
|
||||
indexing for meta-predicates such as `maplist/N` and `foldl/N`, whose
|
||||
first argument is a partial goal that is a variable in the definition
|
||||
of these predicates and therefore cannot be used for indexing.
|
||||
|
||||
For example, a natural definition of `maplist/2` reads:
|
||||
|
||||
```
|
||||
maplist(_, []).
|
||||
maplist(Goal_1, [L|Ls]) :-
|
||||
call(Goal_1, L),
|
||||
maplist(Goal_1, Ls).
|
||||
```
|
||||
|
||||
In this case, first instantiated argument indexing automatically uses
|
||||
the *second* argument for indexing, and thus prevents choicepoints for
|
||||
calls with lists of fixed lengths (and deterministic goals).
|
||||
Conveniently, no auxiliary predicates with reordered arguments are
|
||||
needed to benefit from indexing in such cases.
|
||||
|
||||
Conventional first argument indexing naturally arises as a
|
||||
special case of this strategy, if the first argument is instantiated
|
||||
in any clause of a predicate's definition.
|
||||
|
||||
### Strings and partial strings
|
||||
|
||||
A very compact internal representation of *strings* is one of the key
|
||||
innovations of Scryer Prolog. This means that terms which appear as
|
||||
lists of characters to Prolog programs are stored in packed
|
||||
UTF-8 encoding by the engine.
|
||||
|
||||
Without this innovation, storing a list of characters in memory would
|
||||
use one WAM memory cell per character, one cell per list
|
||||
constructor, and one cell for each tail that occurs in the list. Since
|
||||
one cell takes 8 bytes in the WAM as implemented by
|
||||
Scryer Prolog, the packed representation yields an up to
|
||||
**24-fold reduction** of memory usage, and corresponding
|
||||
reduction of memory accesses when creating and processing
|
||||
strings.
|
||||
|
||||
Scryer Prolog's compact internal string representation makes it
|
||||
ideally suited for the use case Prolog was originally developed for:
|
||||
efficient and convenient text processing, especially with definite
|
||||
clause grammars (DCGs) as provided by
|
||||
[`library(dcgs)`](src/lib/dcgs.pl) and
|
||||
[`library(pio)`](src/lib/pio.pl) to transparently apply DCGs to files.
|
||||
|
||||
In Scryer Prolog, the default value of the Prolog flag `double_quotes`
|
||||
is `chars`, which is also the recommended setting. This means that
|
||||
lists of characters can be written as double-quoted strings, in the
|
||||
double-quoted strings are interpreted as lists of *characters*, in the
|
||||
tradition of Marseille Prolog.
|
||||
|
||||
For example, the following query succeeds:
|
||||
@@ -391,9 +240,15 @@ For example, the following query succeeds:
|
||||
true.
|
||||
```
|
||||
|
||||
This shows that the string `"abc"`, which is represented as a sequence
|
||||
of 3 bytes internally, appears to Prolog programs as a list of
|
||||
characters.
|
||||
Internally, strings are represented very compactly in packed
|
||||
UTF-8 encoding. A naive representation of strings as lists of
|
||||
characters would use one memory cell per character, one
|
||||
memory cell per list constructor, and one memory cell for
|
||||
each tail that occurs in the list. Since one memory cell takes
|
||||
8 bytes on 64-bit machines, the packed representation used by
|
||||
Scryer Prolog yields an up to **24-fold reduction** of
|
||||
memory usage, and corresponding reduction of memory accesses when
|
||||
creating and processing strings.
|
||||
|
||||
Scryer Prolog uses the same efficient encoding for *partial* strings,
|
||||
which appear to Prolog code as partial lists of characters. The
|
||||
@@ -416,58 +271,13 @@ the above example, posting <tt>Ls0 = [a,b,c|Ls]</tt> yields
|
||||
the exact same internal representation, and has the advantage that
|
||||
only the standard predicate `(=)/2` is used.
|
||||
|
||||
The efficient internal representation of strings and partial strings
|
||||
was first proposed and explained by Ulrich Neumerkel in
|
||||
issues [#24](https://github.com/mthom/scryer-prolog/issues/24)
|
||||
and [#95](https://github.com/mthom/scryer-prolog/issues/95), and
|
||||
Scryer Prolog is the first Prolog system that implements it.
|
||||
Definite clause grammars as provided by
|
||||
[`library(dcgs)`](src/lib/lists.pl), and the predicates from
|
||||
[`library(lists)`](src/lib/lists.pl), are ideally suited for reasoning
|
||||
about strings.
|
||||
|
||||
### Occurs check and cyclic terms
|
||||
|
||||
The *occurs check* is an element of algorithms that perform
|
||||
syntactic unification, causing the unification to fail if a variable
|
||||
is unified with a term that contains that variable as a proper
|
||||
subterm. For efficiency, the *occurs check* is omitted by default
|
||||
in Scryer Prolog and many other Prolog systems.
|
||||
|
||||
In Scryer Prolog, performing unifications which succeed only if the
|
||||
*occurs check* is omitted yield *cyclic terms*, also called
|
||||
*rational trees*. For example:
|
||||
|
||||
```
|
||||
?- X = f(X), Y = g(X,Y).
|
||||
X = f(X), Y = g(f(X),Y).
|
||||
```
|
||||
|
||||
The creation of cyclic terms often indicates a programming mistake in
|
||||
the formulation of Prolog predicates, and to obtain logically sound
|
||||
results it is desirable to either perform all unifications with
|
||||
*occurs check* enabled, or let Prolog throw an error if enabling
|
||||
the *occurs check* is necessary to prevent a unification.
|
||||
|
||||
Scryer Prolog supports this via the Prolog flag `occurs_check`. It can
|
||||
be set to one of the following values to obtain the desired behaviour:
|
||||
|
||||
- `false`
|
||||
Do not perform the *occurs check*. This is the default.
|
||||
- `true`
|
||||
Perform all unifications with the *occurs check* enabled.
|
||||
- `error`
|
||||
Yield an error if a unification is performed that the
|
||||
*occurs check* would have prevented.
|
||||
|
||||
Especially when starting with Prolog, we recommend to add the
|
||||
following directive to the `~/.scryerrc` configuration file so that
|
||||
programming mistakes in predicates that lead to the creation of cyclic
|
||||
terms are indicated by errors:
|
||||
|
||||
```
|
||||
:- set_prolog_flag(occurs_check, error).
|
||||
```
|
||||
|
||||
Scryer Prolog implements specialized reasoning to make unifications
|
||||
fast in many frequently occurring situations also if the
|
||||
*occurs check* is enabled.
|
||||
Partial strings were first proposed by Ulrich Neumerkel in issue
|
||||
[#95](https://github.com/mthom/scryer-prolog/issues/95).
|
||||
|
||||
### Tabling (SLG resolution)
|
||||
|
||||
@@ -577,10 +387,6 @@ The modules that ship with Scryer Prolog are also called
|
||||
file, reading lazily only as much as is needed. Due to the compact
|
||||
internal string representation, also extremely large files can be
|
||||
efficiently processed with Scryer Prolog in this way.
|
||||
`phrase_to_file/2` and `phrase_to_stream/2` write lists of
|
||||
characters described by DCGs to files and streams, respectively.
|
||||
* [`lambda`](src/lib/lambda.pl)
|
||||
Lambda expressions to simplify higher order programming.
|
||||
* [`charsio`](src/lib/charsio.pl) Various predicates that are useful
|
||||
for parsing and reasoning about characters, notably `char_type/2` to
|
||||
classify characters according to their type, and conversion
|
||||
@@ -624,7 +430,6 @@ The modules that ship with Scryer 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 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 [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 documents
|
||||
as Prolog terms for convenient and efficient reasoning. Use
|
||||
@@ -633,28 +438,19 @@ The modules that ship with Scryer Prolog are also called
|
||||
* [`csv`](src/lib/csv.pl)
|
||||
`parse_csv//1` and `parse_csv//2` can be used with [`phrase_from_file/2`](src/lib/pio.pl)
|
||||
or [`phrase/2`](src/lib/dcgs.pl) to parse csv
|
||||
* [`serialization/abnf`](src/lib/serialization/abnf.pl)
|
||||
DCGs describing the
|
||||
[ABNF grammar core (RFC 5234)](https://tools.ietf.org/html/rfc5234#appendix-B.1),
|
||||
which is used to describe many [IETF](https://www.ietf.org/standards/rfcs/)
|
||||
syntaxes, such as [HTTP v1.1](https://www.rfc-editor.org/rfc/rfc7230.html#page-82),
|
||||
[SMTP](https://www.rfc-editor.org/rfc/rfc5321.html),
|
||||
[iCalendar](https://www.rfc-editor.org/rfc/rfc5545.html), and more.
|
||||
* [`serialization/json`](src/lib/serialization/json.pl)
|
||||
`json_chars//1` can be used with [`phrase_from_file/2`](src/lib/pio.pl)
|
||||
or [`phrase/2`](src/lib/dcgs.pl) to parse and generate
|
||||
[JSON](https://www.json.org/json-en.html).
|
||||
* [`xpath`](src/lib/xpath.pl)
|
||||
The predicate `xpath/3` is used for convenient reasoning about HTML
|
||||
and XML documents, inspired by the XPath language. This library
|
||||
is often used together with [`library(sgml)`](src/lib/sgml.pl).
|
||||
* [`sockets`](src/lib/sockets.pl)
|
||||
Predicates for opening and accepting TCP connections as streams.
|
||||
TLS negotiation is performed via the option `tls(true)` in
|
||||
`socket_client_open/3`, yielding secure encrypted connections.
|
||||
* [`os`](src/lib/os.pl)
|
||||
Predicates for reasoning about environment variables.
|
||||
* [`iso_ext`](src/lib/iso_ext.pl)
|
||||
Conforming extensions to and candidates for inclusion in the Prolog
|
||||
ISO standard, such as `setup_call_cleanup/3`, `call_nth/2` and
|
||||
ISO standard, such as `setup_call_cleanup/3` and
|
||||
`call_with_inference_limit/3`.
|
||||
* [`crypto`](src/lib/crypto.pl)
|
||||
Cryptographically secure random numbers and hashes, HMAC-based key
|
||||
@@ -662,13 +458,6 @@ The modules that ship with Scryer Prolog are also called
|
||||
public key signatures and signature verification with Ed25519,
|
||||
ECDH key exchange over Curve25519 (X25519), authenticated symmetric
|
||||
encryption with ChaCha20-Poly1305, and reasoning about elliptic curves.
|
||||
* [`uuid`](src/lib/uuid.pl) UUIDv4 generation and hex representation
|
||||
* [`tls`](src/lib/tls.pl)
|
||||
Predicates for negotiating TLS connections explicitly.
|
||||
* [`ugraphs`](src/lib/ugraphs.pl) Graph manipulation library
|
||||
* [`simplex`](src/lib/simplex.pl) Providing `assignment/2`,
|
||||
`transportation/4` and other predicates for solving linear
|
||||
programming problems.
|
||||
|
||||
To use predicates provided by the `lists` library, write:
|
||||
|
||||
@@ -727,63 +516,3 @@ For example, a sensible starting point for `~/.scryerrc` is:
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(reif)).
|
||||
```
|
||||
|
||||
### Development environment
|
||||
|
||||
To write and edit Prolog programs, we recommend
|
||||
[GNU Emacs](https://www.gnu.org/software/emacs/) with the
|
||||
[Prolog mode](https://bruda.ca/emacs/prolog_mode_for_emacs)
|
||||
maintained by Stefan Bruda.
|
||||
|
||||
Use [ediprolog](https://www.metalevel.at/ediprolog/) to consult
|
||||
Prolog code and evaluate Prolog queries in arbitrary
|
||||
Emacs buffers.
|
||||
|
||||
Emacs definitions that show Prolog terms as trees are available
|
||||
in [tools](tools).
|
||||
|
||||
To *debug* Prolog code, we recommend the predicates from
|
||||
[**`library(debug)`**](src/lib/debug.pl), most notably:
|
||||
|
||||
- `(*)/1` to *"generalize away"* a Prolog goal. Use it to debug
|
||||
unexpected failures by generalizing your definitions until they
|
||||
succeed. Simply place `*` in front of a goal to generalize it away.
|
||||
- `($)/1` to emit a *trace* of the execution, showing when a goal
|
||||
is invoked, and when it has succeeded. Place `$` in front of a goal
|
||||
to emit this information for that goal.
|
||||
|
||||
This way of debugging Prolog code has several major benefits, such as:
|
||||
It stays close to the actual Prolog code under consideration, it does
|
||||
not need additional tools and formalisms for its application, and
|
||||
further, it encourages declarative reasoning that can in principle
|
||||
also be performed automatically.
|
||||
|
||||
## Applications
|
||||
|
||||
Scryer Prolog's strong commitment to the Prolog ISO standard makes it
|
||||
ideally suited for use in corporations and government agencies
|
||||
that are subject to strict regulations pertaining to interoperability,
|
||||
standards compliance and warranty.
|
||||
|
||||
Successful existing applications of Scryer Prolog include the
|
||||
[DocLog](https://github.com/aarroyoc/doclog) 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 design.
|
||||
|
||||
Scryer Prolog is also very well suited for teaching and learning
|
||||
Prolog, and for testing syntactic conformance and hence portability of
|
||||
existing Prolog programs.
|
||||
|
||||
## 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)!
|
||||
|
||||
55
build.rs
Normal file
55
build.rs
Normal file
@@ -0,0 +1,55 @@
|
||||
extern crate indexmap;
|
||||
|
||||
use std::env;
|
||||
use std::fs;
|
||||
use std::fs::File;
|
||||
use std::io::Write;
|
||||
use std::path::Path;
|
||||
|
||||
fn find_prolog_files(libraries: &mut File, prefix: &str, current_dir: &Path) {
|
||||
let entries = match current_dir.read_dir() {
|
||||
Ok(entries) => entries,
|
||||
Err(_) => return,
|
||||
};
|
||||
for entry in entries.filter_map(Result::ok).map(|e| e.path()) {
|
||||
if entry.is_dir() {
|
||||
if let Some(file_name) = entry.file_name() {
|
||||
let new_prefix =
|
||||
prefix.to_owned() + file_name.to_str().unwrap() + "/";
|
||||
find_prolog_files(libraries, &new_prefix, &entry);
|
||||
}
|
||||
} else if entry.is_file() {
|
||||
let ext = std::ffi::OsStr::new("pl");
|
||||
if entry.extension() == Some(ext) {
|
||||
let contain =
|
||||
String::from_utf8(fs::read(&entry).unwrap()).unwrap();
|
||||
let name = entry.file_stem().unwrap().to_str().unwrap();
|
||||
let line = format!(
|
||||
" m.insert(\"{}\",\n{:?});\n",
|
||||
prefix.to_owned() + name,
|
||||
contain
|
||||
);
|
||||
|
||||
libraries.write_all(line.as_bytes()).unwrap();
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn main() {
|
||||
let out_dir = env::var("OUT_DIR").unwrap();
|
||||
let dest_path = Path::new(&out_dir).join("libraries.rs");
|
||||
|
||||
let mut libraries = File::create(&dest_path).unwrap();
|
||||
let lib_path = Path::new("src/lib");
|
||||
|
||||
libraries
|
||||
.write_all(
|
||||
b"ref_thread_local! {
|
||||
pub static managed LIBRARIES: IndexMap<&'static str, &'static str> = {
|
||||
let mut m = IndexMap::new();\n",
|
||||
)
|
||||
.unwrap();
|
||||
find_prolog_files(&mut libraries, "", &lib_path);
|
||||
libraries.write_all(b"\n m\n };\n}\n").unwrap();
|
||||
}
|
||||
File diff suppressed because it is too large
Load Diff
114
build/main.rs
114
build/main.rs
@@ -1,114 +0,0 @@
|
||||
mod instructions_template;
|
||||
mod static_string_indexing;
|
||||
|
||||
use instructions_template::generate_instructions_rs;
|
||||
use static_string_indexing::index_static_strings;
|
||||
|
||||
use std::env;
|
||||
use std::fs;
|
||||
use std::fs::File;
|
||||
use std::io::Write;
|
||||
use std::path::Path;
|
||||
use std::process::{Command, Stdio};
|
||||
|
||||
fn find_prolog_files(libraries: &mut File, prefix: &str, current_dir: &Path) {
|
||||
let entries = match current_dir.read_dir() {
|
||||
Ok(entries) => entries,
|
||||
Err(_) => return,
|
||||
};
|
||||
|
||||
for entry in entries.filter_map(Result::ok).map(|e| e.path()) {
|
||||
if entry.is_dir() {
|
||||
if let Some(file_name) = entry.file_name() {
|
||||
let new_prefix = prefix.to_owned() + file_name.to_str().unwrap() + "/";
|
||||
find_prolog_files(libraries, &new_prefix, &entry);
|
||||
}
|
||||
} else if entry.is_file() {
|
||||
let ext = std::ffi::OsStr::new("pl");
|
||||
if entry.extension() == Some(ext) {
|
||||
let contain = String::from_utf8(fs::read(&entry).unwrap()).unwrap();
|
||||
let name = entry.file_stem().unwrap().to_str().unwrap();
|
||||
|
||||
let line = format!(
|
||||
" m.insert(\"{}\",\n{:?});\n",
|
||||
prefix.to_owned() + name,
|
||||
contain
|
||||
);
|
||||
|
||||
libraries.write_all(line.as_bytes()).unwrap();
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn main() {
|
||||
let has_rustfmt = Command::new("rustfmt")
|
||||
.arg("--version")
|
||||
.stdin(Stdio::inherit())
|
||||
.status()
|
||||
.is_ok();
|
||||
|
||||
if !has_rustfmt {
|
||||
println!("Failed to run rustfmt, will skip formatting generated files.")
|
||||
}
|
||||
|
||||
let out_dir = env::var("OUT_DIR").unwrap();
|
||||
let dest_path = Path::new(&out_dir).join("libraries.rs");
|
||||
|
||||
let mut libraries = File::create(&dest_path).unwrap();
|
||||
let lib_path = Path::new("src/lib");
|
||||
|
||||
libraries
|
||||
.write_all(
|
||||
b"ref_thread_local::ref_thread_local! {
|
||||
pub(crate) static managed LIBRARIES: IndexMap<&'static str, &'static str> = {
|
||||
let mut m = IndexMap::new();\n",
|
||||
)
|
||||
.unwrap();
|
||||
|
||||
find_prolog_files(&mut libraries, "", &lib_path);
|
||||
libraries.write_all(b"\n m\n };\n}\n").unwrap();
|
||||
|
||||
let instructions_path = Path::new(&out_dir).join("instructions.rs");
|
||||
let mut instructions_file = File::create(&instructions_path).unwrap();
|
||||
|
||||
let quoted_output = generate_instructions_rs();
|
||||
|
||||
instructions_file
|
||||
.write_all(quoted_output.to_string().as_bytes())
|
||||
.unwrap();
|
||||
|
||||
if has_rustfmt {
|
||||
format_generated_file(instructions_path.as_path());
|
||||
}
|
||||
|
||||
let static_atoms_path = Path::new(&out_dir).join("static_atoms.rs");
|
||||
let mut static_atoms_file = File::create(&static_atoms_path).unwrap();
|
||||
|
||||
let quoted_output = index_static_strings(&instructions_path);
|
||||
|
||||
static_atoms_file
|
||||
.write_all(quoted_output.to_string().as_bytes())
|
||||
.unwrap();
|
||||
|
||||
if has_rustfmt {
|
||||
format_generated_file(static_atoms_path.as_path());
|
||||
}
|
||||
|
||||
println!("cargo:rerun-if-changed=src/");
|
||||
}
|
||||
|
||||
fn format_generated_file(path: &Path) {
|
||||
Command::new("rustfmt")
|
||||
.arg(path.as_os_str())
|
||||
.spawn()
|
||||
.unwrap_or_else(|err| {
|
||||
panic!(
|
||||
"{}: rustfmt was detected as available, but failed to format generated file '{}'",
|
||||
err,
|
||||
path.display()
|
||||
);
|
||||
})
|
||||
.wait()
|
||||
.unwrap();
|
||||
}
|
||||
@@ -1,179 +0,0 @@
|
||||
use proc_macro2::TokenStream;
|
||||
use syn::parse::*;
|
||||
use syn::visit::*;
|
||||
use syn::*;
|
||||
|
||||
use indexmap::IndexSet;
|
||||
|
||||
struct StaticStrVisitor {
|
||||
static_strs: IndexSet<String>,
|
||||
}
|
||||
|
||||
impl StaticStrVisitor {
|
||||
fn new() -> Self {
|
||||
Self {
|
||||
static_strs: IndexSet::new(),
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
struct MacroFnArgs {
|
||||
args: Vec<Expr>,
|
||||
}
|
||||
|
||||
struct ReadHeapCellExprAndArms {
|
||||
expr: Expr,
|
||||
arms: Vec<Arm>,
|
||||
}
|
||||
|
||||
impl Parse for ReadHeapCellExprAndArms {
|
||||
fn parse(input: ParseStream) -> Result<Self> {
|
||||
let mut arms = vec![];
|
||||
let expr = input.parse()?;
|
||||
|
||||
input.parse::<Token![,]>()?;
|
||||
arms.push(input.parse()?);
|
||||
|
||||
while !input.is_empty() {
|
||||
if let Ok(_) = input.parse::<Token![,]>() {}
|
||||
arms.push(input.parse()?);
|
||||
}
|
||||
|
||||
Ok(ReadHeapCellExprAndArms { expr, arms })
|
||||
}
|
||||
}
|
||||
|
||||
impl Parse for MacroFnArgs {
|
||||
fn parse(input: ParseStream) -> Result<Self> {
|
||||
let mut args = vec![];
|
||||
|
||||
if !input.is_empty() {
|
||||
args.push(input.parse()?);
|
||||
}
|
||||
|
||||
while !input.is_empty() {
|
||||
if let Ok(_) = input.parse::<Token![,]>() {}
|
||||
args.push(input.parse()?);
|
||||
}
|
||||
|
||||
Ok(MacroFnArgs { args })
|
||||
}
|
||||
}
|
||||
|
||||
impl<'ast> Visit<'ast> for StaticStrVisitor {
|
||||
fn visit_macro(&mut self, m: &'ast Macro) {
|
||||
let Macro { path, .. } = m;
|
||||
|
||||
if path.is_ident("atom") {
|
||||
if let Some(Lit::Str(string)) = m.parse_body::<Lit>().ok() {
|
||||
self.static_strs.insert(string.value());
|
||||
}
|
||||
} else if path.is_ident("read_heap_cell") || path.is_ident("match_untyped_arena_ptr") {
|
||||
if let Some(m) = m.parse_body::<ReadHeapCellExprAndArms>().ok() {
|
||||
self.visit_expr(&m.expr);
|
||||
|
||||
for e in m.arms {
|
||||
self.visit_arm(&e);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
if let Some(m) = m.parse_body::<MacroFnArgs>().ok() {
|
||||
for e in m.args {
|
||||
self.visit_expr(&e);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub fn index_static_strings(instruction_rs_path: &std::path::Path) -> TokenStream {
|
||||
use quote::*;
|
||||
|
||||
use std::ffi::OsStr;
|
||||
use std::fs::File;
|
||||
use std::io::Read;
|
||||
|
||||
use walkdir::WalkDir;
|
||||
|
||||
fn filter_rust_files(e: &walkdir::DirEntry) -> bool {
|
||||
if e.path().is_dir() {
|
||||
return true;
|
||||
}
|
||||
|
||||
e.path().extension().and_then(OsStr::to_str) == Some("rs")
|
||||
}
|
||||
|
||||
let mut visitor = StaticStrVisitor::new();
|
||||
|
||||
fn process_filepath(path: &std::path::Path) -> std::result::Result<syn::File, ()> {
|
||||
let mut src = String::new();
|
||||
|
||||
let mut file = match File::open(path) {
|
||||
Ok(file) => file,
|
||||
Err(_) => return Err(()),
|
||||
};
|
||||
|
||||
match file.read_to_string(&mut src) {
|
||||
Ok(_) => {}
|
||||
Err(e) => {
|
||||
panic!("error reading file: {:?}", e);
|
||||
}
|
||||
}
|
||||
|
||||
let syntax = match syn::parse_file(&src) {
|
||||
Ok(s) => s,
|
||||
Err(e) => {
|
||||
panic!("parse error: {} in file {:?}", e, path);
|
||||
}
|
||||
};
|
||||
Ok(syntax)
|
||||
}
|
||||
|
||||
for entry in WalkDir::new("src/")
|
||||
.into_iter()
|
||||
.filter_entry(filter_rust_files)
|
||||
{
|
||||
let entry = entry.unwrap();
|
||||
|
||||
if entry.path().is_dir() {
|
||||
continue;
|
||||
}
|
||||
|
||||
let syntax = match process_filepath(entry.path()) {
|
||||
Ok(syntax) => syntax,
|
||||
Err(_) => continue,
|
||||
};
|
||||
|
||||
visitor.visit_file(&syntax);
|
||||
}
|
||||
|
||||
match process_filepath(instruction_rs_path) {
|
||||
Ok(syntax) => visitor.visit_file(&syntax),
|
||||
Err(_) => {}
|
||||
}
|
||||
|
||||
let indices = (0..visitor.static_strs.len()).map(|i| (i << 3) as u64);
|
||||
let indices_iter = indices.clone();
|
||||
|
||||
let static_strs_len = visitor.static_strs.len();
|
||||
let static_strs: &Vec<_> = &visitor.static_strs.into_iter().collect();
|
||||
|
||||
quote! {
|
||||
use phf;
|
||||
|
||||
static STRINGS: [&'static str; #static_strs_len] = [
|
||||
#(
|
||||
#static_strs,
|
||||
)*
|
||||
];
|
||||
|
||||
#[macro_export]
|
||||
macro_rules! atom {
|
||||
#((#static_strs) => { Atom { index: #indices_iter } };)*
|
||||
}
|
||||
|
||||
pub static STATIC_ATOMS_MAP: phf::Map<&'static str, Atom> = phf::phf_map! {
|
||||
#(#static_strs => { Atom { index: #indices } },)*
|
||||
};
|
||||
}
|
||||
}
|
||||
491
flamegraph.svg
491
flamegraph.svg
File diff suppressed because one or more lines are too long
|
Before Width: | Height: | Size: 4.8 MiB |
@@ -1,28 +0,0 @@
|
||||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<Wix xmlns="http://schemas.microsoft.com/wix/2006/wi">
|
||||
<Product Name="Scryer Prolog" Manufacturer="Scryer Prolog contributors" Id="*" UpgradeCode="cfb2dee4-5dd5-4d7d-b426-cd7340810559" Language="1033" Codepage="1252" Version="0.9.0">
|
||||
<Package Description="An open source industrial strength production environment for ISO Prolog that is also a testbed for bleeding edge research in logic and constraint programming, which is itself written in a high-level language." Platform="x64" Keywords="prolog" Id="*" Compressed="yes" InstallScope="perMachine" InstallerVersion="300" Languages="1033" SummaryCodepage="1252" Manufacturer="Scryer Prolog contributors"/>
|
||||
<Property Id="APPHELPLINK" Value="https://github.com/mthom/scryer-prolog"/>
|
||||
<Media Id="1" Cabinet="scryer.cab" EmbedCab="yes" />
|
||||
<Directory Id="TARGETDIR" Name="SourceDir">
|
||||
<Directory Id="ProgramFilesFolder" Name="PFiles">
|
||||
<Directory Id="INSTALLDIR" Name="Scryer Prolog">
|
||||
<Component Id="MainExecutable" Guid="1b41ceda-ba18-47f9-911b-ee41b4f20921">
|
||||
<File Id="ScryerPrologEXE" Name="scryer-prolog.exe" DiskId="1" Source="target/release/scryer-prolog.exe" KeyPath="yes" Checksum="yes"/>
|
||||
</Component>
|
||||
</Directory>
|
||||
</Directory>
|
||||
<Directory Id="ProgramMenuFolder">
|
||||
<Component Id="ApplicationShortcut" Guid="8c9b14a3-e7b1-4d30-a892-61d7371dcae2">
|
||||
<Shortcut Id="ApplicationStarMenuShortcut" Name="Scryer Prolog" Description="Launch Scryer Prolog" Target="[#ScryerPrologEXE]" WorkingDirectory="INSTALLDIR"/>
|
||||
<RemoveFolder Id="ApplicationShortcut" On="uninstall"/>
|
||||
<RegistryValue Root="HKCU" Key="Software\Microsoft\ScryerProlog" Name="installed" Type="integer" Value="1" KeyPath="yes"/>
|
||||
</Component>
|
||||
</Directory>
|
||||
</Directory>
|
||||
<Feature Id="Complete" Level="1" Display="expand" ConfigurableDirectory="INSTALLDIR">
|
||||
<ComponentRef Id="MainExecutable"/>
|
||||
<ComponentRef Id="ApplicationShortcut"/>
|
||||
</Feature>
|
||||
</Product>
|
||||
</Wix>
|
||||
115
src/allocator.rs
115
src/allocator.rs
@@ -1,91 +1,90 @@
|
||||
use crate::parser::ast::*;
|
||||
use crate::prolog_parser::ast::*;
|
||||
|
||||
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 {
|
||||
pub trait Allocator<'a> {
|
||||
fn new() -> Self;
|
||||
|
||||
fn mark_anon_var<'a, Target: CompilationTarget<'a>>(
|
||||
fn mark_anon_var<Target>(&mut self, _: Level, _: GenContext, _: &mut Vec<Target>)
|
||||
where
|
||||
Target: CompilationTarget<'a>;
|
||||
fn mark_non_var<Target>(&mut self, _: Level, _: GenContext, _: &'a Cell<RegType>, _: &mut Vec<Target>)
|
||||
where
|
||||
Target: CompilationTarget<'a>;
|
||||
fn mark_reserved_var<Target>(
|
||||
&mut self,
|
||||
lvl: Level,
|
||||
context: GenContext,
|
||||
code: &mut CodeDeque,
|
||||
);
|
||||
|
||||
fn mark_non_var<'a, Target: CompilationTarget<'a>>(
|
||||
&mut self,
|
||||
lvl: Level,
|
||||
context: GenContext,
|
||||
cell: &'a Cell<RegType>,
|
||||
code: &mut CodeDeque,
|
||||
);
|
||||
|
||||
fn mark_reserved_var<'a, Target: CompilationTarget<'a>>(
|
||||
&mut self,
|
||||
var_num: usize,
|
||||
lvl: Level,
|
||||
cell: &'a Cell<VarReg>,
|
||||
term_loc: GenContext,
|
||||
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_num: usize,
|
||||
lvl: Level,
|
||||
cell: &'a Cell<VarReg>,
|
||||
context: GenContext,
|
||||
code: &mut CodeDeque,
|
||||
);
|
||||
_: Rc<Var>,
|
||||
_: Level,
|
||||
_: &'a Cell<VarReg>,
|
||||
_: GenContext,
|
||||
_: &mut Vec<Target>,
|
||||
_: RegType,
|
||||
_: bool,
|
||||
) where
|
||||
Target: CompilationTarget<'a>;
|
||||
fn mark_var<Target>(&mut self, _: Rc<Var>, _: Level, _: &'a Cell<VarReg>, _: GenContext, _: &mut Vec<Target>)
|
||||
where
|
||||
Target: CompilationTarget<'a>;
|
||||
|
||||
fn reset(&mut self);
|
||||
fn reset_arg(&mut self, arg_num: usize);
|
||||
fn reset_at_head(&mut self, args: &Vec<Term>);
|
||||
fn reset_contents(&mut self);
|
||||
fn reset_contents(&mut self) {}
|
||||
fn reset_arg(&mut self, _: usize);
|
||||
fn reset_at_head(&mut self, _: &Vec<Box<Term>>);
|
||||
|
||||
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;
|
||||
|
||||
// TODO: wha.. why?? grrr. it drains the VarStatus data from vs (which it owns!)
|
||||
// into self.bindings and perm_vs after all is computed (i.e. vs.populate_restricting_sets()
|
||||
// and vs.set_perm_vals(has_deep_cut) have both been called).
|
||||
/*
|
||||
fn drain_var_data<'a>(
|
||||
fn drain_var_data(
|
||||
&mut self,
|
||||
vs: VariableFixtures,
|
||||
num_of_chunks: usize,
|
||||
) -> VariableFixtures {
|
||||
vs: VariableFixtures<'a>,
|
||||
num_of_chunks: usize
|
||||
) -> VariableFixtures<'a> {
|
||||
let mut perm_vs = VariableFixtures::new();
|
||||
|
||||
for (var, var_status) in vs.into_iter() {
|
||||
for (var, (var_status, cells)) in vs.into_iter() {
|
||||
match var_status {
|
||||
VarStatus::Temp(chunk_num, tvd) => {
|
||||
self.bindings_mut()
|
||||
.insert(var.clone(), VarAlloc::Temp(chunk_num, 0, tvd));
|
||||
.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(), VarAlloc::Perm(0));
|
||||
perm_vs.insert(var, var_status);
|
||||
self.bindings_mut().insert(var.clone(), VarData::Perm(0));
|
||||
perm_vs.insert(var, (var_status, cells));
|
||||
}
|
||||
};
|
||||
}
|
||||
|
||||
perm_vs
|
||||
}
|
||||
*/
|
||||
|
||||
fn get(&self, var: Rc<Var>) -> RegType {
|
||||
self.bindings()
|
||||
.get(&var)
|
||||
.map_or(temp_v!(0), |v| v.as_reg_type())
|
||||
}
|
||||
|
||||
fn is_unbound(&self, var: Rc<Var>) -> bool {
|
||||
self.get(var).reg_num() == 0
|
||||
}
|
||||
|
||||
fn record_register(&mut self, var: Rc<Var>, 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(),
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
1150
src/arena.rs
1150
src/arena.rs
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -1,471 +0,0 @@
|
||||
use crate::parser::ast::MAX_ARITY;
|
||||
use crate::raw_block::*;
|
||||
use crate::rcu::{Rcu, RcuRef};
|
||||
use crate::types::*;
|
||||
|
||||
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::*;
|
||||
|
||||
#[derive(Copy, Clone, Debug, PartialEq, Eq)]
|
||||
pub struct Atom {
|
||||
pub index: u64,
|
||||
}
|
||||
|
||||
const_assert!(mem::size_of::<Atom>() == 8);
|
||||
|
||||
include!(concat!(env!("OUT_DIR"), "/static_atoms.rs"));
|
||||
|
||||
impl<'a> From<&'a Atom> for Atom {
|
||||
#[inline]
|
||||
fn from(atom: &'a Atom) -> Self {
|
||||
*atom
|
||||
}
|
||||
}
|
||||
|
||||
impl From<bool> for Atom {
|
||||
#[inline]
|
||||
fn from(value: bool) -> Self {
|
||||
if value {
|
||||
atom!("true")
|
||||
} else {
|
||||
atom!("false")
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl indexmap::Equivalent<Atom> for str {
|
||||
fn equivalent(&self, key: &Atom) -> bool {
|
||||
&*key.as_str() == self
|
||||
}
|
||||
}
|
||||
|
||||
const ATOM_TABLE_INIT_SIZE: usize = 1 << 16;
|
||||
const ATOM_TABLE_ALIGN: usize = 8;
|
||||
|
||||
#[inline(always)]
|
||||
fn global_atom_table() -> &'static RwLock<Weak<AtomTable>> {
|
||||
#[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<AtomTable>> = 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<AtomTable>>> = OnceLock::new();
|
||||
GLOBAL_ATOM_TABLE.get_or_init(|| RwLock::new(Weak::new()))
|
||||
}
|
||||
}
|
||||
|
||||
#[inline(always)]
|
||||
fn arc_atom_table() -> Option<Arc<AtomTable>> {
|
||||
global_atom_table().read().unwrap().upgrade()
|
||||
}
|
||||
|
||||
impl RawBlockTraits for AtomTable {
|
||||
#[inline]
|
||||
fn init_size() -> usize {
|
||||
ATOM_TABLE_INIT_SIZE
|
||||
}
|
||||
|
||||
#[inline]
|
||||
fn align() -> usize {
|
||||
ATOM_TABLE_ALIGN
|
||||
}
|
||||
}
|
||||
|
||||
#[bitfield]
|
||||
#[derive(Copy, Clone, Debug)]
|
||||
struct AtomHeader {
|
||||
#[allow(unused)]
|
||||
m: bool,
|
||||
len: B50,
|
||||
#[allow(unused)]
|
||||
padding: B13,
|
||||
}
|
||||
|
||||
impl AtomHeader {
|
||||
fn build_with(len: u64) -> Self {
|
||||
AtomHeader::new().with_len(len).with_m(false)
|
||||
}
|
||||
}
|
||||
|
||||
impl Hash for Atom {
|
||||
#[inline]
|
||||
fn hash<H: Hasher>(&self, hasher: &mut H) {
|
||||
self.as_str().hash(hasher)
|
||||
// hasher.write_usize(self.index)
|
||||
}
|
||||
}
|
||||
|
||||
#[macro_export]
|
||||
macro_rules! is_char {
|
||||
($s:expr) => {
|
||||
!$s.is_empty() && $s.chars().nth(1).is_none()
|
||||
};
|
||||
}
|
||||
|
||||
pub enum AtomString<'a> {
|
||||
Static(&'a str),
|
||||
Dynamic(AtomTableRef<str>),
|
||||
}
|
||||
|
||||
impl AtomString<'_> {
|
||||
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)),
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
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 as usize) < STRINGS.len() << 3
|
||||
}
|
||||
|
||||
#[inline(always)]
|
||||
pub fn as_ptr(self) -> Option<AtomTableRef<u8>> {
|
||||
if self.is_static() {
|
||||
None
|
||||
} else {
|
||||
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)
|
||||
.offset(((self.index as usize) - (STRINGS.len() << 3)) as isize)
|
||||
.as_ref()
|
||||
})
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[inline(always)]
|
||||
pub fn from(index: u64) -> Self {
|
||||
Self { index }
|
||||
}
|
||||
|
||||
#[inline(always)]
|
||||
pub fn len(self) -> usize {
|
||||
if self.is_static() {
|
||||
STRINGS[(self.index >> 3) as usize].len()
|
||||
} else {
|
||||
let ptr = self.as_ptr().unwrap();
|
||||
let ptr = ptr.deref() as *const u8 as *const AtomHeader;
|
||||
unsafe { ptr::read(ptr) }.len() as _
|
||||
}
|
||||
}
|
||||
|
||||
#[inline(always)]
|
||||
pub fn flat_index(self) -> u64 {
|
||||
(self.index >> 3) as u64
|
||||
}
|
||||
|
||||
pub fn as_char(self) -> Option<char> {
|
||||
let s = self.as_str();
|
||||
let mut it = s.chars();
|
||||
|
||||
let c1 = it.next();
|
||||
let c2 = it.next();
|
||||
|
||||
if c2.is_none() {
|
||||
c1
|
||||
} else {
|
||||
None
|
||||
}
|
||||
}
|
||||
|
||||
#[inline]
|
||||
pub fn 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 =
|
||||
unsafe { ptr::read::<AtomHeader>(ptr as *const u8 as *const AtomHeader) };
|
||||
let len = header.len() as usize;
|
||||
let buf =
|
||||
unsafe { (ptr as *const u8).offset(mem::size_of::<AtomHeader>() as isize) };
|
||||
|
||||
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 sub_str = if s.starts_with('(') && s.ends_with(')') {
|
||||
&s['('.len_utf8()..s.len() - ')'.len_utf8()]
|
||||
} else {
|
||||
return *self;
|
||||
};
|
||||
|
||||
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;
|
||||
ptr::copy_nonoverlapping(string.as_ptr(), str_ptr as *mut u8, string.len());
|
||||
}
|
||||
|
||||
impl PartialOrd for Atom {
|
||||
#[inline]
|
||||
fn partial_cmp(&self, other: &Atom) -> Option<Ordering> {
|
||||
Some(self.cmp(other))
|
||||
}
|
||||
}
|
||||
|
||||
impl Ord for Atom {
|
||||
#[inline]
|
||||
fn cmp(&self, other: &Atom) -> Ordering {
|
||||
self.as_str().cmp(&*other.as_str())
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub struct InnerAtomTable {
|
||||
block: RawBlock<AtomTable>,
|
||||
pub table: Rcu<IndexSet<Atom>>,
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub struct AtomTable {
|
||||
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() -> Arc<Self> {
|
||||
let upgraded = global_atom_table().read().unwrap().upgrade();
|
||||
// don't inline upgraded, otherwise temporary will be dropped too late in case of None
|
||||
if let Some(atom_table) = upgraded {
|
||||
atom_table
|
||||
} else {
|
||||
let mut guard = global_atom_table().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 {
|
||||
inner: Rcu::new(InnerAtomTable {
|
||||
block: RawBlock::new(),
|
||||
table: Rcu::new(IndexSet::new()),
|
||||
}),
|
||||
update: Mutex::new(()),
|
||||
});
|
||||
*guard = Arc::downgrade(&atom_table);
|
||||
atom_table
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[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;
|
||||
}
|
||||
|
||||
let size = mem::size_of::<AtomHeader>() + string.len();
|
||||
let align_offset = 8 * mem::align_of::<AtomHeader>();
|
||||
let size = (size & !(align_offset - 1)) + align_offset;
|
||||
|
||||
unsafe {
|
||||
let len_ptr = loop {
|
||||
let ptr = block_epoch.block.alloc(size);
|
||||
|
||||
if ptr.is_null() {
|
||||
// garbage collection would go here
|
||||
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 ptr;
|
||||
}
|
||||
};
|
||||
|
||||
let ptr_base = block_epoch.block.base as usize;
|
||||
|
||||
write_to_ptr(string, len_ptr);
|
||||
|
||||
let atom = Atom {
|
||||
index: ((STRINGS.len() << 3) + len_ptr as usize - ptr_base) as u64,
|
||||
};
|
||||
|
||||
let mut table = table_epoch.clone();
|
||||
table.insert(atom);
|
||||
block_epoch.table.replace(table);
|
||||
|
||||
// expicit drop to ensure we don't accidentally drop it early
|
||||
drop(update_guard);
|
||||
|
||||
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)]
|
||||
m: bool,
|
||||
#[allow(unused)]
|
||||
tag: B6,
|
||||
}
|
||||
|
||||
impl AtomCell {
|
||||
#[inline]
|
||||
pub fn build_with(name: u64, arity: u16, tag: HeapCellValueTag) -> Self {
|
||||
if arity > 0 {
|
||||
debug_assert!(arity as usize <= MAX_ARITY);
|
||||
|
||||
AtomCell::new()
|
||||
.with_name(name)
|
||||
.with_arity(arity)
|
||||
.with_f(false)
|
||||
.with_tag(tag as u8)
|
||||
} else {
|
||||
AtomCell::new()
|
||||
.with_name(name)
|
||||
.with_f(false)
|
||||
.with_tag(tag as u8)
|
||||
}
|
||||
}
|
||||
|
||||
#[inline]
|
||||
pub fn get_index(self) -> usize {
|
||||
self.name() as usize
|
||||
}
|
||||
|
||||
#[inline]
|
||||
pub fn get_name(self) -> Atom {
|
||||
Atom::from((self.get_index() as u64) << 3)
|
||||
}
|
||||
|
||||
#[inline]
|
||||
pub fn get_arity(self) -> usize {
|
||||
self.arity() as usize
|
||||
}
|
||||
|
||||
#[inline]
|
||||
pub fn get_name_and_arity(self) -> (Atom, usize) {
|
||||
(Atom::from((self.get_index() as u64) << 3), self.get_arity())
|
||||
}
|
||||
}
|
||||
@@ -1,28 +0,0 @@
|
||||
fn main() -> std::process::ExitCode {
|
||||
use scryer_prolog::*;
|
||||
use scryer_prolog::atom_table::Atom;
|
||||
use std::sync::atomic::Ordering;
|
||||
|
||||
#[cfg(feature = "repl")]
|
||||
ctrlc::set_handler(move || {
|
||||
scryer_prolog::machine::INTERRUPT.store(true, Ordering::Relaxed);
|
||||
})
|
||||
.unwrap();
|
||||
|
||||
#[cfg(target_arch = "wasm32")]
|
||||
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_top_level(atom!("$toplevel"), (atom!("$repl"), 1))
|
||||
})
|
||||
}
|
||||
851
src/clause_types.rs
Normal file
851
src/clause_types.rs
Normal file
@@ -0,0 +1,851 @@
|
||||
use crate::prolog_parser::ast::*;
|
||||
|
||||
use crate::forms::Number;
|
||||
use crate::machine::machine_indices::*;
|
||||
use crate::rug::rand::RandState;
|
||||
|
||||
use crate::ref_thread_local::RefThreadLocal;
|
||||
|
||||
use std::collections::BTreeMap;
|
||||
|
||||
#[derive(Debug, Clone, Copy, Eq, PartialEq)]
|
||||
pub enum CompareNumberQT {
|
||||
GreaterThan,
|
||||
LessThan,
|
||||
GreaterThanOrEqual,
|
||||
LessThanOrEqual,
|
||||
NotEqual,
|
||||
Equal,
|
||||
}
|
||||
|
||||
impl CompareNumberQT {
|
||||
fn name(self) -> &'static str {
|
||||
match self {
|
||||
CompareNumberQT::GreaterThan => ">",
|
||||
CompareNumberQT::LessThan => "<",
|
||||
CompareNumberQT::GreaterThanOrEqual => ">=",
|
||||
CompareNumberQT::LessThanOrEqual => "=<",
|
||||
CompareNumberQT::NotEqual => "=\\=",
|
||||
CompareNumberQT::Equal => "=:=",
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug, Clone, Copy, PartialEq, Eq)]
|
||||
pub enum CompareTermQT {
|
||||
LessThan,
|
||||
LessThanOrEqual,
|
||||
GreaterThanOrEqual,
|
||||
GreaterThan,
|
||||
}
|
||||
|
||||
impl CompareTermQT {
|
||||
fn name<'a>(self) -> &'a str {
|
||||
match self {
|
||||
CompareTermQT::GreaterThan => "@>",
|
||||
CompareTermQT::LessThan => "@<",
|
||||
CompareTermQT::GreaterThanOrEqual => "@>=",
|
||||
CompareTermQT::LessThanOrEqual => "@=<",
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug, Clone, PartialEq, Eq)]
|
||||
pub enum ArithmeticTerm {
|
||||
Reg(RegType),
|
||||
Interm(usize),
|
||||
Number(Number),
|
||||
}
|
||||
|
||||
impl ArithmeticTerm {
|
||||
pub fn interm_or(&self, interm: usize) -> usize {
|
||||
if let &ArithmeticTerm::Interm(interm) = self {
|
||||
interm
|
||||
} else {
|
||||
interm
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug, Clone, Eq, PartialEq)]
|
||||
pub enum InlinedClauseType {
|
||||
CompareNumber(CompareNumberQT, ArithmeticTerm, ArithmeticTerm),
|
||||
IsAtom(RegType),
|
||||
IsAtomic(RegType),
|
||||
IsCompound(RegType),
|
||||
IsInteger(RegType),
|
||||
IsRational(RegType),
|
||||
IsFloat(RegType),
|
||||
IsNonVar(RegType),
|
||||
IsVar(RegType),
|
||||
}
|
||||
|
||||
ref_thread_local! {
|
||||
pub static managed RANDOM_STATE: RandState<'static> = RandState::new();
|
||||
}
|
||||
|
||||
ref_thread_local! {
|
||||
pub static managed CLAUSE_TYPE_FORMS: BTreeMap<(&'static str, usize), ClauseType> = {
|
||||
let mut m = BTreeMap::new();
|
||||
|
||||
let r1 = temp_v!(1);
|
||||
let r2 = temp_v!(2);
|
||||
|
||||
m.insert((">", 2),
|
||||
ClauseType::Inlined(InlinedClauseType::CompareNumber(CompareNumberQT::GreaterThan, ar_reg!(r1), ar_reg!(r2))));
|
||||
m.insert(("<", 2),
|
||||
ClauseType::Inlined(InlinedClauseType::CompareNumber(CompareNumberQT::LessThan, ar_reg!(r1), ar_reg!(r2))));
|
||||
m.insert((">=", 2), ClauseType::Inlined(InlinedClauseType::CompareNumber(CompareNumberQT::GreaterThanOrEqual, ar_reg!(r1), ar_reg!(r2))));
|
||||
m.insert(("=<", 2), ClauseType::Inlined(InlinedClauseType::CompareNumber(CompareNumberQT::LessThanOrEqual, ar_reg!(r1), ar_reg!(r2))));
|
||||
m.insert(("=:=", 2), ClauseType::Inlined(InlinedClauseType::CompareNumber(CompareNumberQT::Equal, ar_reg!(r1), ar_reg!(r2))));
|
||||
m.insert(("=\\=", 2), ClauseType::Inlined(InlinedClauseType::CompareNumber(CompareNumberQT::NotEqual, ar_reg!(r1), ar_reg!(r2))));
|
||||
m.insert(("atom", 1), ClauseType::Inlined(InlinedClauseType::IsAtom(r1)));
|
||||
m.insert(("atomic", 1), ClauseType::Inlined(InlinedClauseType::IsAtomic(r1)));
|
||||
m.insert(("compound", 1), ClauseType::Inlined(InlinedClauseType::IsCompound(r1)));
|
||||
m.insert(("integer", 1), ClauseType::Inlined(InlinedClauseType::IsInteger(r1)));
|
||||
m.insert(("rational", 1), ClauseType::Inlined(InlinedClauseType::IsRational(r1)));
|
||||
m.insert(("float", 1), ClauseType::Inlined(InlinedClauseType::IsFloat(r1)));
|
||||
m.insert(("nonvar", 1), ClauseType::Inlined(InlinedClauseType::IsNonVar(r1)));
|
||||
m.insert(("var", 1), ClauseType::Inlined(InlinedClauseType::IsVar(r1)));
|
||||
m.insert(("acyclic_term", 1), ClauseType::BuiltIn(BuiltInClauseType::AcyclicTerm));
|
||||
m.insert(("arg", 3), ClauseType::BuiltIn(BuiltInClauseType::Arg));
|
||||
m.insert(("compare", 3), ClauseType::BuiltIn(BuiltInClauseType::Compare));
|
||||
m.insert(("@>", 2), ClauseType::BuiltIn(BuiltInClauseType::CompareTerm(CompareTermQT::GreaterThan)));
|
||||
m.insert(("@<", 2), ClauseType::BuiltIn(BuiltInClauseType::CompareTerm(CompareTermQT::LessThan)));
|
||||
m.insert(("@>=", 2), ClauseType::BuiltIn(BuiltInClauseType::CompareTerm(CompareTermQT::GreaterThanOrEqual)));
|
||||
m.insert(("@=<", 2), ClauseType::BuiltIn(BuiltInClauseType::CompareTerm(CompareTermQT::LessThanOrEqual)));
|
||||
m.insert(("copy_term", 2), ClauseType::BuiltIn(BuiltInClauseType::CopyTerm));
|
||||
m.insert(("==", 2), ClauseType::BuiltIn(BuiltInClauseType::Eq));
|
||||
m.insert(("functor", 3), ClauseType::BuiltIn(BuiltInClauseType::Functor));
|
||||
m.insert(("ground", 1), ClauseType::BuiltIn(BuiltInClauseType::Ground));
|
||||
m.insert(("is", 2), ClauseType::BuiltIn(BuiltInClauseType::Is(r1, ar_reg!(r2))));
|
||||
m.insert(("keysort", 2), ClauseType::BuiltIn(BuiltInClauseType::KeySort));
|
||||
m.insert(("nl", 0), ClauseType::BuiltIn(BuiltInClauseType::Nl));
|
||||
m.insert(("\\==", 2), ClauseType::BuiltIn(BuiltInClauseType::NotEq));
|
||||
m.insert(("read", 1), ClauseType::BuiltIn(BuiltInClauseType::Read));
|
||||
m.insert(("sort", 2), ClauseType::BuiltIn(BuiltInClauseType::Sort));
|
||||
|
||||
m
|
||||
};
|
||||
}
|
||||
|
||||
impl InlinedClauseType {
|
||||
pub fn name(&self) -> &'static str {
|
||||
match self {
|
||||
&InlinedClauseType::CompareNumber(qt, ..) => qt.name(),
|
||||
&InlinedClauseType::IsAtom(..) => "atom",
|
||||
&InlinedClauseType::IsAtomic(..) => "atomic",
|
||||
&InlinedClauseType::IsCompound(..) => "compound",
|
||||
&InlinedClauseType::IsInteger(..) => "integer",
|
||||
&InlinedClauseType::IsRational(..) => "rational",
|
||||
&InlinedClauseType::IsFloat(..) => "float",
|
||||
&InlinedClauseType::IsNonVar(..) => "nonvar",
|
||||
&InlinedClauseType::IsVar(..) => "var",
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug, Copy, Clone, Eq, PartialEq)]
|
||||
pub enum SystemClauseType {
|
||||
AbolishClause,
|
||||
AbolishModuleClause,
|
||||
AssertDynamicPredicateToBack,
|
||||
AssertDynamicPredicateToFront,
|
||||
AtEndOfExpansion,
|
||||
AtomChars,
|
||||
AtomCodes,
|
||||
AtomLength,
|
||||
BindFromRegister,
|
||||
CallContinuation,
|
||||
CharCode,
|
||||
CharType,
|
||||
CharsToNumber,
|
||||
ClearAttributeGoals,
|
||||
CloneAttributeGoals,
|
||||
CodesToNumber,
|
||||
CopyTermWithoutAttrVars,
|
||||
CheckCutPoint,
|
||||
Close,
|
||||
CopyToLiftedHeap,
|
||||
CreatePartialString,
|
||||
CurrentHostname,
|
||||
CurrentInput,
|
||||
CurrentOutput,
|
||||
DirectoryFiles,
|
||||
FileSize,
|
||||
FileExists,
|
||||
DirectoryExists,
|
||||
DirectorySeparator,
|
||||
MakeDirectory,
|
||||
DeleteFile,
|
||||
WorkingDirectory,
|
||||
PathCanonical,
|
||||
FileTime,
|
||||
DeleteAttribute,
|
||||
DeleteHeadAttribute,
|
||||
DynamicModuleResolution(usize),
|
||||
EnqueueAttributeGoal,
|
||||
EnqueueAttributedVar,
|
||||
ExpandGoal,
|
||||
ExpandTerm,
|
||||
FetchGlobalVar,
|
||||
FetchGlobalVarWithOffset,
|
||||
FirstStream,
|
||||
FlushOutput,
|
||||
GetByte,
|
||||
GetChar,
|
||||
GetNChars,
|
||||
GetCode,
|
||||
GetSingleChar,
|
||||
ResetAttrVarState,
|
||||
TruncateIfNoLiftedHeapGrowthDiff,
|
||||
TruncateIfNoLiftedHeapGrowth,
|
||||
GetAttributedVariableList,
|
||||
GetAttrVarQueueDelimiter,
|
||||
GetAttrVarQueueBeyond,
|
||||
GetBValue,
|
||||
GetClause,
|
||||
GetContinuationChunk,
|
||||
GetModuleClause,
|
||||
GetNextDBRef,
|
||||
GetNextOpDBRef,
|
||||
IsPartialString,
|
||||
LookupDBRef,
|
||||
LookupOpDBRef,
|
||||
Halt,
|
||||
ModuleHeadIsDynamic,
|
||||
GetLiftedHeapFromOffset,
|
||||
GetLiftedHeapFromOffsetDiff,
|
||||
GetSCCCleaner,
|
||||
HeadIsDynamic,
|
||||
InstallSCCCleaner,
|
||||
InstallInferenceCounter,
|
||||
LiftedHeapLength,
|
||||
ModuleAssertDynamicPredicateToFront,
|
||||
ModuleAssertDynamicPredicateToBack,
|
||||
ModuleExists,
|
||||
ModuleOf,
|
||||
ModuleRetractClause,
|
||||
NextEP,
|
||||
NoSuchPredicate,
|
||||
NumberToChars,
|
||||
NumberToCodes,
|
||||
OpDeclaration,
|
||||
Open,
|
||||
NextStream,
|
||||
PartialStringTail,
|
||||
PeekByte,
|
||||
PeekChar,
|
||||
PeekCode,
|
||||
PointsToContinuationResetMarker,
|
||||
PutByte,
|
||||
PutChar,
|
||||
PutChars,
|
||||
PutCode,
|
||||
REPL(REPLCodePtr),
|
||||
ReadQueryTerm,
|
||||
ReadTerm,
|
||||
RedoAttrVarBinding,
|
||||
RemoveCallPolicyCheck,
|
||||
RemoveInferenceCounter,
|
||||
ResetContinuationMarker,
|
||||
ResetGlobalVarAtKey,
|
||||
ResetGlobalVarAtOffset,
|
||||
RetractClause,
|
||||
RestoreCutPolicy,
|
||||
SetCutPoint(RegType),
|
||||
SetInput,
|
||||
SetOutput,
|
||||
StoreGlobalVar,
|
||||
StoreGlobalVarWithOffset,
|
||||
StreamProperty,
|
||||
SetStreamPosition,
|
||||
InferenceLevel,
|
||||
CleanUpBlock,
|
||||
EraseBall,
|
||||
Fail,
|
||||
GetBall,
|
||||
GetCurrentBlock,
|
||||
GetCutPoint,
|
||||
GetDoubleQuotes,
|
||||
InstallNewBlock,
|
||||
Maybe,
|
||||
CpuNow,
|
||||
CurrentTime,
|
||||
QuotedToken,
|
||||
ReadTermFromChars,
|
||||
ResetBlock,
|
||||
ReturnFromVerifyAttr,
|
||||
SetBall,
|
||||
SetCutPointByDefault(RegType),
|
||||
SetDoubleQuotes,
|
||||
SetSeed,
|
||||
SkipMaxList,
|
||||
Sleep,
|
||||
SocketClientOpen,
|
||||
SocketServerOpen,
|
||||
SocketServerAccept,
|
||||
SocketServerClose,
|
||||
Succeed,
|
||||
TermAttributedVariables,
|
||||
TermVariables,
|
||||
TruncateLiftedHeapTo,
|
||||
UnifyWithOccursCheck,
|
||||
UnwindEnvironments,
|
||||
UnwindStack,
|
||||
Variant,
|
||||
WAMInstructions,
|
||||
WriteTerm,
|
||||
WriteTermToChars,
|
||||
ScryerPrologVersion,
|
||||
CryptoRandomByte,
|
||||
CryptoDataHash,
|
||||
CryptoDataHKDF,
|
||||
CryptoPasswordHash,
|
||||
CryptoDataEncrypt,
|
||||
CryptoDataDecrypt,
|
||||
CryptoCurveScalarMult,
|
||||
Ed25519Sign,
|
||||
Ed25519Verify,
|
||||
Ed25519NewKeyPair,
|
||||
Ed25519KeyPairPublicKey,
|
||||
Curve25519ScalarMult,
|
||||
LoadHTML,
|
||||
LoadXML,
|
||||
GetEnv,
|
||||
SetEnv,
|
||||
UnsetEnv,
|
||||
CharsBase64,
|
||||
}
|
||||
|
||||
impl SystemClauseType {
|
||||
pub fn name(&self) -> ClauseName {
|
||||
match self {
|
||||
&SystemClauseType::AbolishClause => clause_name!("$abolish_clause"),
|
||||
&SystemClauseType::AbolishModuleClause => clause_name!("$abolish_module_clause"),
|
||||
&SystemClauseType::AssertDynamicPredicateToBack => clause_name!("$assertz"),
|
||||
&SystemClauseType::AssertDynamicPredicateToFront => clause_name!("$asserta"),
|
||||
&SystemClauseType::AtEndOfExpansion => clause_name!("$at_end_of_expansion"),
|
||||
&SystemClauseType::AtomChars => clause_name!("$atom_chars"),
|
||||
&SystemClauseType::AtomCodes => clause_name!("$atom_codes"),
|
||||
&SystemClauseType::AtomLength => clause_name!("$atom_length"),
|
||||
&SystemClauseType::BindFromRegister => clause_name!("$bind_from_register"),
|
||||
&SystemClauseType::CallContinuation => clause_name!("$call_continuation"),
|
||||
&SystemClauseType::CharCode => clause_name!("$char_code"),
|
||||
&SystemClauseType::CharType => clause_name!("$char_type"),
|
||||
&SystemClauseType::CharsToNumber => clause_name!("$chars_to_number"),
|
||||
&SystemClauseType::CheckCutPoint => clause_name!("$check_cp"),
|
||||
&SystemClauseType::ClearAttributeGoals => clause_name!("$clear_attribute_goals"),
|
||||
&SystemClauseType::CloneAttributeGoals => clause_name!("$clone_attribute_goals"),
|
||||
&SystemClauseType::CodesToNumber => clause_name!("$codes_to_number"),
|
||||
&SystemClauseType::CopyTermWithoutAttrVars => clause_name!("$copy_term_without_attr_vars"),
|
||||
&SystemClauseType::CreatePartialString => clause_name!("$create_partial_string"),
|
||||
&SystemClauseType::CurrentInput => clause_name!("$current_input"),
|
||||
&SystemClauseType::CurrentHostname => clause_name!("$current_hostname"),
|
||||
&SystemClauseType::CurrentOutput => clause_name!("$current_output"),
|
||||
&SystemClauseType::DirectoryFiles => clause_name!("$directory_files"),
|
||||
&SystemClauseType::FileSize => clause_name!("$file_size"),
|
||||
&SystemClauseType::FileExists => clause_name!("$file_exists"),
|
||||
&SystemClauseType::DirectoryExists => clause_name!("$directory_exists"),
|
||||
&SystemClauseType::DirectorySeparator => clause_name!("$directory_separator"),
|
||||
&SystemClauseType::MakeDirectory => clause_name!("$make_directory"),
|
||||
&SystemClauseType::DeleteFile => clause_name!("$delete_file"),
|
||||
&SystemClauseType::WorkingDirectory => clause_name!("$working_directory"),
|
||||
&SystemClauseType::PathCanonical => clause_name!("$path_canonical"),
|
||||
&SystemClauseType::FileTime => clause_name!("$file_time"),
|
||||
&SystemClauseType::REPL(REPLCodePtr::CompileBatch) => clause_name!("$compile_batch"),
|
||||
&SystemClauseType::REPL(REPLCodePtr::UseModule) => clause_name!("$use_module"),
|
||||
&SystemClauseType::REPL(REPLCodePtr::UseQualifiedModule) => {
|
||||
clause_name!("$use_qualified_module")
|
||||
}
|
||||
&SystemClauseType::REPL(REPLCodePtr::UseModuleFromFile) => {
|
||||
clause_name!("$use_module_from_file")
|
||||
}
|
||||
&SystemClauseType::REPL(REPLCodePtr::UseQualifiedModuleFromFile) => {
|
||||
clause_name!("$use_qualified_module_from_file")
|
||||
}
|
||||
&SystemClauseType::Close => clause_name!("$close"),
|
||||
&SystemClauseType::CopyToLiftedHeap => clause_name!("$copy_to_lh"),
|
||||
&SystemClauseType::DeleteAttribute => clause_name!("$del_attr_non_head"),
|
||||
&SystemClauseType::DeleteHeadAttribute => clause_name!("$del_attr_head"),
|
||||
&SystemClauseType::DynamicModuleResolution(_) => clause_name!("$module_call"),
|
||||
&SystemClauseType::EnqueueAttributeGoal => clause_name!("$enqueue_attribute_goal"),
|
||||
&SystemClauseType::EnqueueAttributedVar => clause_name!("$enqueue_attr_var"),
|
||||
&SystemClauseType::ExpandTerm => clause_name!("$expand_term"),
|
||||
&SystemClauseType::ExpandGoal => clause_name!("$expand_goal"),
|
||||
&SystemClauseType::FetchGlobalVar => clause_name!("$fetch_global_var"),
|
||||
&SystemClauseType::FetchGlobalVarWithOffset => {
|
||||
clause_name!("$fetch_global_var_with_offset")
|
||||
}
|
||||
&SystemClauseType::FirstStream => clause_name!("$first_stream"),
|
||||
&SystemClauseType::FlushOutput => clause_name!("$flush_output"),
|
||||
&SystemClauseType::GetByte => clause_name!("$get_byte"),
|
||||
&SystemClauseType::GetChar => clause_name!("$get_char"),
|
||||
&SystemClauseType::GetNChars => clause_name!("$get_n_chars"),
|
||||
&SystemClauseType::GetCode => clause_name!("$get_code"),
|
||||
&SystemClauseType::GetSingleChar => clause_name!("$get_single_char"),
|
||||
&SystemClauseType::ResetAttrVarState => clause_name!("$reset_attr_var_state"),
|
||||
&SystemClauseType::TruncateIfNoLiftedHeapGrowth => {
|
||||
clause_name!("$truncate_if_no_lh_growth")
|
||||
}
|
||||
&SystemClauseType::TruncateIfNoLiftedHeapGrowthDiff => {
|
||||
clause_name!("$truncate_if_no_lh_growth_diff")
|
||||
}
|
||||
&SystemClauseType::GetAttributedVariableList => clause_name!("$get_attr_list"),
|
||||
&SystemClauseType::GetAttrVarQueueDelimiter => {
|
||||
clause_name!("$get_attr_var_queue_delim")
|
||||
}
|
||||
&SystemClauseType::GetAttrVarQueueBeyond => clause_name!("$get_attr_var_queue_beyond"),
|
||||
&SystemClauseType::GetContinuationChunk => clause_name!("$get_cont_chunk"),
|
||||
&SystemClauseType::GetLiftedHeapFromOffset => clause_name!("$get_lh_from_offset"),
|
||||
&SystemClauseType::GetLiftedHeapFromOffsetDiff => {
|
||||
clause_name!("$get_lh_from_offset_diff")
|
||||
}
|
||||
&SystemClauseType::GetBValue => clause_name!("$get_b_value"),
|
||||
&SystemClauseType::GetClause => clause_name!("$get_clause"),
|
||||
&SystemClauseType::GetNextDBRef => clause_name!("$get_next_db_ref"),
|
||||
&SystemClauseType::GetNextOpDBRef => clause_name!("$get_next_op_db_ref"),
|
||||
&SystemClauseType::LookupDBRef => clause_name!("$lookup_db_ref"),
|
||||
&SystemClauseType::LookupOpDBRef => clause_name!("$lookup_op_db_ref"),
|
||||
&SystemClauseType::GetDoubleQuotes => clause_name!("$get_double_quotes"),
|
||||
&SystemClauseType::GetModuleClause => clause_name!("$get_module_clause"),
|
||||
&SystemClauseType::GetSCCCleaner => clause_name!("$get_scc_cleaner"),
|
||||
&SystemClauseType::Halt => clause_name!("$halt"),
|
||||
&SystemClauseType::HeadIsDynamic => clause_name!("$head_is_dynamic"),
|
||||
&SystemClauseType::Open => clause_name!("$open"),
|
||||
&SystemClauseType::OpDeclaration => clause_name!("$op"),
|
||||
&SystemClauseType::InstallSCCCleaner => clause_name!("$install_scc_cleaner"),
|
||||
&SystemClauseType::InstallInferenceCounter => {
|
||||
clause_name!("$install_inference_counter")
|
||||
}
|
||||
&SystemClauseType::IsPartialString => clause_name!("$is_partial_string"),
|
||||
&SystemClauseType::PartialStringTail => clause_name!("$partial_string_tail"),
|
||||
&SystemClauseType::PeekByte => clause_name!("$peek_byte"),
|
||||
&SystemClauseType::PeekChar => clause_name!("$peek_char"),
|
||||
&SystemClauseType::PeekCode => clause_name!("$peek_code"),
|
||||
&SystemClauseType::LiftedHeapLength => clause_name!("$lh_length"),
|
||||
&SystemClauseType::Maybe => clause_name!("maybe"),
|
||||
&SystemClauseType::CpuNow => clause_name!("$cpu_now"),
|
||||
&SystemClauseType::CurrentTime => clause_name!("$current_time"),
|
||||
&SystemClauseType::ModuleAssertDynamicPredicateToFront => {
|
||||
clause_name!("$module_asserta")
|
||||
}
|
||||
&SystemClauseType::ModuleAssertDynamicPredicateToBack => {
|
||||
clause_name!("$module_assertz")
|
||||
}
|
||||
&SystemClauseType::ModuleHeadIsDynamic => clause_name!("$module_head_is_dynamic"),
|
||||
&SystemClauseType::ModuleExists => clause_name!("$module_exists"),
|
||||
&SystemClauseType::ModuleOf => clause_name!("$module_of"),
|
||||
&SystemClauseType::NextStream => clause_name!("$next_stream"),
|
||||
&SystemClauseType::NoSuchPredicate => clause_name!("$no_such_predicate"),
|
||||
&SystemClauseType::NumberToChars => clause_name!("$number_to_chars"),
|
||||
&SystemClauseType::NumberToCodes => clause_name!("$number_to_codes"),
|
||||
&SystemClauseType::PointsToContinuationResetMarker => {
|
||||
clause_name!("$points_to_cont_reset_marker")
|
||||
}
|
||||
&SystemClauseType::PutByte => {
|
||||
clause_name!("$put_byte")
|
||||
}
|
||||
&SystemClauseType::PutChar => {
|
||||
clause_name!("$put_char")
|
||||
}
|
||||
&SystemClauseType::PutChars => {
|
||||
clause_name!("$put_chars")
|
||||
}
|
||||
&SystemClauseType::PutCode => {
|
||||
clause_name!("$put_code")
|
||||
}
|
||||
&SystemClauseType::QuotedToken => {
|
||||
clause_name!("$quoted_token")
|
||||
}
|
||||
&SystemClauseType::RedoAttrVarBinding => clause_name!("$redo_attr_var_binding"),
|
||||
&SystemClauseType::RemoveCallPolicyCheck => clause_name!("$remove_call_policy_check"),
|
||||
&SystemClauseType::RemoveInferenceCounter => clause_name!("$remove_inference_counter"),
|
||||
&SystemClauseType::RestoreCutPolicy => clause_name!("$restore_cut_policy"),
|
||||
&SystemClauseType::SetCutPoint(_) => clause_name!("$set_cp"),
|
||||
&SystemClauseType::SetInput => clause_name!("$set_input"),
|
||||
&SystemClauseType::SetOutput => clause_name!("$set_output"),
|
||||
&SystemClauseType::SetSeed => clause_name!("$set_seed"),
|
||||
&SystemClauseType::StreamProperty => clause_name!("$stream_property"),
|
||||
&SystemClauseType::SetStreamPosition => clause_name!("$set_stream_position"),
|
||||
&SystemClauseType::StoreGlobalVar => clause_name!("$store_global_var"),
|
||||
&SystemClauseType::StoreGlobalVarWithOffset => {
|
||||
clause_name!("$store_global_var_with_offset")
|
||||
}
|
||||
&SystemClauseType::InferenceLevel => clause_name!("$inference_level"),
|
||||
&SystemClauseType::CleanUpBlock => clause_name!("$clean_up_block"),
|
||||
&SystemClauseType::EraseBall => clause_name!("$erase_ball"),
|
||||
&SystemClauseType::Fail => clause_name!("$fail"),
|
||||
&SystemClauseType::GetBall => clause_name!("$get_ball"),
|
||||
&SystemClauseType::GetCutPoint => clause_name!("$get_cp"),
|
||||
&SystemClauseType::GetCurrentBlock => clause_name!("$get_current_block"),
|
||||
&SystemClauseType::InstallNewBlock => clause_name!("$install_new_block"),
|
||||
&SystemClauseType::ModuleRetractClause => clause_name!("$module_retract_clause"),
|
||||
&SystemClauseType::NextEP => clause_name!("$nextEP"),
|
||||
&SystemClauseType::ReadQueryTerm => clause_name!("$read_query_term"),
|
||||
&SystemClauseType::ReadTerm => clause_name!("$read_term"),
|
||||
&SystemClauseType::ReadTermFromChars => clause_name!("$read_term_from_chars"),
|
||||
&SystemClauseType::ResetGlobalVarAtKey => clause_name!("$reset_global_var_at_key"),
|
||||
&SystemClauseType::ResetGlobalVarAtOffset => clause_name!("$reset_global_var_at_offset"),
|
||||
&SystemClauseType::RetractClause => clause_name!("$retract_clause"),
|
||||
&SystemClauseType::ResetBlock => clause_name!("$reset_block"),
|
||||
&SystemClauseType::ResetContinuationMarker => clause_name!("$reset_cont_marker"),
|
||||
&SystemClauseType::ReturnFromVerifyAttr => clause_name!("$return_from_verify_attr"),
|
||||
&SystemClauseType::SetBall => clause_name!("$set_ball"),
|
||||
&SystemClauseType::SetCutPointByDefault(_) => clause_name!("$set_cp_by_default"),
|
||||
&SystemClauseType::SetDoubleQuotes => clause_name!("$set_double_quotes"),
|
||||
&SystemClauseType::SkipMaxList => clause_name!("$skip_max_list"),
|
||||
&SystemClauseType::Sleep => clause_name!("$sleep"),
|
||||
&SystemClauseType::SocketClientOpen => clause_name!("$socket_client_open"),
|
||||
&SystemClauseType::SocketServerOpen => clause_name!("$socket_server_open"),
|
||||
&SystemClauseType::SocketServerAccept => clause_name!("$socket_server_accept"),
|
||||
&SystemClauseType::SocketServerClose => clause_name!("$socket_server_close"),
|
||||
&SystemClauseType::Succeed => clause_name!("$succeed"),
|
||||
&SystemClauseType::TermAttributedVariables => clause_name!("$term_attributed_variables"),
|
||||
&SystemClauseType::TermVariables => clause_name!("$term_variables"),
|
||||
&SystemClauseType::TruncateLiftedHeapTo => clause_name!("$truncate_lh_to"),
|
||||
&SystemClauseType::UnifyWithOccursCheck => clause_name!("$unify_with_occurs_check"),
|
||||
&SystemClauseType::UnwindEnvironments => clause_name!("$unwind_environments"),
|
||||
&SystemClauseType::UnwindStack => clause_name!("$unwind_stack"),
|
||||
&SystemClauseType::Variant => clause_name!("$variant"),
|
||||
&SystemClauseType::WAMInstructions => clause_name!("$wam_instructions"),
|
||||
&SystemClauseType::WriteTerm => clause_name!("$write_term"),
|
||||
&SystemClauseType::WriteTermToChars => clause_name!("$write_term_to_chars"),
|
||||
&SystemClauseType::ScryerPrologVersion => clause_name!("$scryer_prolog_version"),
|
||||
&SystemClauseType::CryptoRandomByte => clause_name!("$crypto_random_byte"),
|
||||
&SystemClauseType::CryptoDataHash => clause_name!("$crypto_data_hash"),
|
||||
&SystemClauseType::CryptoDataHKDF => clause_name!("$crypto_data_hkdf"),
|
||||
&SystemClauseType::CryptoPasswordHash => clause_name!("$crypto_password_hash"),
|
||||
&SystemClauseType::CryptoDataEncrypt => clause_name!("$crypto_data_encrypt"),
|
||||
&SystemClauseType::CryptoDataDecrypt => clause_name!("$crypto_data_decrypt"),
|
||||
&SystemClauseType::CryptoCurveScalarMult => clause_name!("$crypto_curve_scalar_mult"),
|
||||
&SystemClauseType::Ed25519Sign => clause_name!("$ed25519_sign"),
|
||||
&SystemClauseType::Ed25519Verify => clause_name!("$ed25519_verify"),
|
||||
&SystemClauseType::Ed25519NewKeyPair => clause_name!("$ed25519_new_keypair"),
|
||||
&SystemClauseType::Ed25519KeyPairPublicKey => clause_name!("$ed25519_keypair_public_key"),
|
||||
&SystemClauseType::Curve25519ScalarMult => clause_name!("$curve25519_scalar_mult"),
|
||||
&SystemClauseType::LoadHTML => clause_name!("$load_html"),
|
||||
&SystemClauseType::LoadXML => clause_name!("$load_xml"),
|
||||
&SystemClauseType::GetEnv => clause_name!("$getenv"),
|
||||
&SystemClauseType::SetEnv => clause_name!("$setenv"),
|
||||
&SystemClauseType::UnsetEnv => clause_name!("$unsetenv"),
|
||||
&SystemClauseType::CharsBase64 => clause_name!("$chars_base64"),
|
||||
}
|
||||
}
|
||||
|
||||
pub fn from(name: &str, arity: usize) -> Option<SystemClauseType> {
|
||||
match (name, arity) {
|
||||
("$abolish_clause", 2) => Some(SystemClauseType::AbolishClause),
|
||||
("$at_end_of_expansion", 0) => Some(SystemClauseType::AtEndOfExpansion),
|
||||
("$atom_chars", 2) => Some(SystemClauseType::AtomChars),
|
||||
("$atom_codes", 2) => Some(SystemClauseType::AtomCodes),
|
||||
("$atom_length", 2) => Some(SystemClauseType::AtomLength),
|
||||
("$abolish_module_clause", 3) => Some(SystemClauseType::AbolishModuleClause),
|
||||
("$bind_from_register", 2) => Some(SystemClauseType::BindFromRegister),
|
||||
("$module_asserta", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToFront),
|
||||
("$module_assertz", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToBack),
|
||||
("$asserta", 4) => Some(SystemClauseType::AssertDynamicPredicateToFront),
|
||||
("$assertz", 4) => Some(SystemClauseType::AssertDynamicPredicateToBack),
|
||||
("$call_continuation", 1) => Some(SystemClauseType::CallContinuation),
|
||||
("$char_code", 2) => Some(SystemClauseType::CharCode),
|
||||
("$char_type", 2) => Some(SystemClauseType::CharType),
|
||||
("$chars_to_number", 2) => Some(SystemClauseType::CharsToNumber),
|
||||
("$clear_attribute_goals", 0) => Some(SystemClauseType::ClearAttributeGoals),
|
||||
("$clone_attribute_goals", 1) => Some(SystemClauseType::CloneAttributeGoals),
|
||||
("$codes_to_number", 2) => Some(SystemClauseType::CodesToNumber),
|
||||
("$copy_term_without_attr_vars", 2) => Some(SystemClauseType::CopyTermWithoutAttrVars),
|
||||
("$create_partial_string", 3) => Some(SystemClauseType::CreatePartialString),
|
||||
("$check_cp", 1) => Some(SystemClauseType::CheckCutPoint),
|
||||
("$compile_batch", 0) => Some(SystemClauseType::REPL(REPLCodePtr::CompileBatch)),
|
||||
("$copy_to_lh", 2) => Some(SystemClauseType::CopyToLiftedHeap),
|
||||
("$close", 2) => Some(SystemClauseType::Close),
|
||||
("$current_hostname", 1) => Some(SystemClauseType::CurrentHostname),
|
||||
("$current_input", 1) => Some(SystemClauseType::CurrentInput),
|
||||
("$current_output", 1) => Some(SystemClauseType::CurrentOutput),
|
||||
("$first_stream", 1) => Some(SystemClauseType::FirstStream),
|
||||
("$next_stream", 2) => Some(SystemClauseType::NextStream),
|
||||
("$flush_output", 1) => Some(SystemClauseType::FlushOutput),
|
||||
("$del_attr_non_head", 1) => Some(SystemClauseType::DeleteAttribute),
|
||||
("$del_attr_head", 1) => Some(SystemClauseType::DeleteHeadAttribute),
|
||||
("$get_next_db_ref", 2) => Some(SystemClauseType::GetNextDBRef),
|
||||
("$get_next_op_db_ref", 2) => Some(SystemClauseType::GetNextOpDBRef),
|
||||
("$lookup_db_ref", 3) => Some(SystemClauseType::LookupDBRef),
|
||||
("$lookup_op_db_ref", 4) => Some(SystemClauseType::LookupOpDBRef),
|
||||
("$module_call", _) => Some(SystemClauseType::DynamicModuleResolution(arity - 2)),
|
||||
("$enqueue_attribute_goal", 1) => Some(SystemClauseType::EnqueueAttributeGoal),
|
||||
("$enqueue_attr_var", 1) => Some(SystemClauseType::EnqueueAttributedVar),
|
||||
("$partial_string_tail", 2) => Some(SystemClauseType::PartialStringTail),
|
||||
("$peek_byte", 2) => Some(SystemClauseType::PeekByte),
|
||||
("$peek_char", 2) => Some(SystemClauseType::PeekChar),
|
||||
("$peek_code", 2) => Some(SystemClauseType::PeekCode),
|
||||
("$is_partial_string", 1) => Some(SystemClauseType::IsPartialString),
|
||||
("$expand_term", 2) => Some(SystemClauseType::ExpandTerm),
|
||||
("$expand_goal", 2) => Some(SystemClauseType::ExpandGoal),
|
||||
("$fetch_global_var", 2) => Some(SystemClauseType::FetchGlobalVar),
|
||||
("$fetch_global_var_with_offset", 3) => Some(SystemClauseType::FetchGlobalVarWithOffset),
|
||||
("$get_byte", 2) => Some(SystemClauseType::GetByte),
|
||||
("$get_char", 2) => Some(SystemClauseType::GetChar),
|
||||
("$get_n_chars", 3) => Some(SystemClauseType::GetNChars),
|
||||
("$get_code", 2) => Some(SystemClauseType::GetCode),
|
||||
("$get_single_char", 1) => Some(SystemClauseType::GetSingleChar),
|
||||
("$points_to_cont_reset_marker", 1) => {
|
||||
Some(SystemClauseType::PointsToContinuationResetMarker)
|
||||
}
|
||||
("$put_byte", 2) => {
|
||||
Some(SystemClauseType::PutByte)
|
||||
}
|
||||
("$put_char", 2) => {
|
||||
Some(SystemClauseType::PutChar)
|
||||
}
|
||||
("$put_chars", 2) => {
|
||||
Some(SystemClauseType::PutChars)
|
||||
}
|
||||
("$put_code", 2) => {
|
||||
Some(SystemClauseType::PutCode)
|
||||
}
|
||||
("$reset_attr_var_state", 0) => Some(SystemClauseType::ResetAttrVarState),
|
||||
("$truncate_if_no_lh_growth", 1) => {
|
||||
Some(SystemClauseType::TruncateIfNoLiftedHeapGrowth)
|
||||
}
|
||||
("$truncate_if_no_lh_growth_diff", 2) => {
|
||||
Some(SystemClauseType::TruncateIfNoLiftedHeapGrowthDiff)
|
||||
}
|
||||
("$get_attr_list", 2) => Some(SystemClauseType::GetAttributedVariableList),
|
||||
("$get_b_value", 1) => Some(SystemClauseType::GetBValue),
|
||||
("$get_clause", 2) => Some(SystemClauseType::GetClause),
|
||||
("$get_module_clause", 3) => Some(SystemClauseType::GetModuleClause),
|
||||
("$get_lh_from_offset", 2) => Some(SystemClauseType::GetLiftedHeapFromOffset),
|
||||
("$get_lh_from_offset_diff", 3) => Some(SystemClauseType::GetLiftedHeapFromOffsetDiff),
|
||||
("$get_double_quotes", 1) => Some(SystemClauseType::GetDoubleQuotes),
|
||||
("$get_scc_cleaner", 1) => Some(SystemClauseType::GetSCCCleaner),
|
||||
("$halt", 1) => Some(SystemClauseType::Halt),
|
||||
("$head_is_dynamic", 1) => Some(SystemClauseType::HeadIsDynamic),
|
||||
("$install_scc_cleaner", 2) => Some(SystemClauseType::InstallSCCCleaner),
|
||||
("$install_inference_counter", 3) => Some(SystemClauseType::InstallInferenceCounter),
|
||||
("$lh_length", 1) => Some(SystemClauseType::LiftedHeapLength),
|
||||
("$maybe", 0) => Some(SystemClauseType::Maybe),
|
||||
("$cpu_now", 1) => Some(SystemClauseType::CpuNow),
|
||||
("$current_time", 1) => Some(SystemClauseType::CurrentTime),
|
||||
("$module_exists", 1) => Some(SystemClauseType::ModuleExists),
|
||||
("$module_of", 2) => Some(SystemClauseType::ModuleOf),
|
||||
("$module_retract_clause", 5) => Some(SystemClauseType::ModuleRetractClause),
|
||||
("$module_head_is_dynamic", 2) => Some(SystemClauseType::ModuleHeadIsDynamic),
|
||||
("$no_such_predicate", 1) => Some(SystemClauseType::NoSuchPredicate),
|
||||
("$number_to_chars", 2) => Some(SystemClauseType::NumberToChars),
|
||||
("$number_to_codes", 2) => Some(SystemClauseType::NumberToCodes),
|
||||
("$op", 3) => Some(SystemClauseType::OpDeclaration),
|
||||
("$open", 7) => Some(SystemClauseType::Open),
|
||||
("$redo_attr_var_binding", 2) => Some(SystemClauseType::RedoAttrVarBinding),
|
||||
("$remove_call_policy_check", 1) => Some(SystemClauseType::RemoveCallPolicyCheck),
|
||||
("$remove_inference_counter", 2) => Some(SystemClauseType::RemoveInferenceCounter),
|
||||
("$restore_cut_policy", 0) => Some(SystemClauseType::RestoreCutPolicy),
|
||||
("$set_cp", 1) => Some(SystemClauseType::SetCutPoint(temp_v!(1))),
|
||||
("$set_input", 1) => Some(SystemClauseType::SetInput),
|
||||
("$set_output", 1) => Some(SystemClauseType::SetOutput),
|
||||
("$stream_property", 3) => Some(SystemClauseType::StreamProperty),
|
||||
("$set_stream_position", 2) => Some(SystemClauseType::SetStreamPosition),
|
||||
("$inference_level", 2) => Some(SystemClauseType::InferenceLevel),
|
||||
("$clean_up_block", 1) => Some(SystemClauseType::CleanUpBlock),
|
||||
("$erase_ball", 0) => Some(SystemClauseType::EraseBall),
|
||||
("$fail", 0) => Some(SystemClauseType::Fail),
|
||||
("$get_attr_var_queue_beyond", 2) => Some(SystemClauseType::GetAttrVarQueueBeyond),
|
||||
("$get_attr_var_queue_delim", 1) => Some(SystemClauseType::GetAttrVarQueueDelimiter),
|
||||
("$get_ball", 1) => Some(SystemClauseType::GetBall),
|
||||
("$get_cont_chunk", 3) => Some(SystemClauseType::GetContinuationChunk),
|
||||
("$get_current_block", 1) => Some(SystemClauseType::GetCurrentBlock),
|
||||
("$get_cp", 1) => Some(SystemClauseType::GetCutPoint),
|
||||
("$install_new_block", 1) => Some(SystemClauseType::InstallNewBlock),
|
||||
("$quoted_token", 1) => Some(SystemClauseType::QuotedToken),
|
||||
("$nextEP", 3) => Some(SystemClauseType::NextEP),
|
||||
("$read_query_term", 5) => Some(SystemClauseType::ReadQueryTerm),
|
||||
("$read_term", 5) => Some(SystemClauseType::ReadTerm),
|
||||
("$read_term_from_chars", 2) => Some(SystemClauseType::ReadTermFromChars),
|
||||
("$reset_block", 1) => Some(SystemClauseType::ResetBlock),
|
||||
("$reset_cont_marker", 0) => Some(SystemClauseType::ResetContinuationMarker),
|
||||
("$reset_global_var_at_key", 1) => Some(SystemClauseType::ResetGlobalVarAtKey),
|
||||
("$reset_global_var_at_offset", 3) => Some(SystemClauseType::ResetGlobalVarAtOffset),
|
||||
("$retract_clause", 4) => Some(SystemClauseType::RetractClause),
|
||||
("$return_from_verify_attr", 0) => Some(SystemClauseType::ReturnFromVerifyAttr),
|
||||
("$set_ball", 1) => Some(SystemClauseType::SetBall),
|
||||
("$set_cp_by_default", 1) => Some(SystemClauseType::SetCutPointByDefault(temp_v!(1))),
|
||||
("$set_double_quotes", 1) => Some(SystemClauseType::SetDoubleQuotes),
|
||||
("$set_seed", 1) => Some(SystemClauseType::SetSeed),
|
||||
("$skip_max_list", 4) => Some(SystemClauseType::SkipMaxList),
|
||||
("$sleep", 1) => Some(SystemClauseType::Sleep),
|
||||
("$socket_client_open", 8) => Some(SystemClauseType::SocketClientOpen),
|
||||
("$socket_server_open", 3) => Some(SystemClauseType::SocketServerOpen),
|
||||
("$socket_server_accept", 7) => Some(SystemClauseType::SocketServerAccept),
|
||||
("$socket_server_close", 1) => Some(SystemClauseType::SocketServerClose),
|
||||
("$store_global_var", 2) => Some(SystemClauseType::StoreGlobalVar),
|
||||
("$store_global_var_with_offset", 2) => Some(SystemClauseType::StoreGlobalVarWithOffset),
|
||||
("$term_attributed_variables", 2) => Some(SystemClauseType::TermAttributedVariables),
|
||||
("$term_variables", 2) => Some(SystemClauseType::TermVariables),
|
||||
("$truncate_lh_to", 1) => Some(SystemClauseType::TruncateLiftedHeapTo),
|
||||
("$unwind_environments", 0) => Some(SystemClauseType::UnwindEnvironments),
|
||||
("$unwind_stack", 0) => Some(SystemClauseType::UnwindStack),
|
||||
("$unify_with_occurs_check", 2) => Some(SystemClauseType::UnifyWithOccursCheck),
|
||||
("$directory_files", 2) => Some(SystemClauseType::DirectoryFiles),
|
||||
("$file_size", 2) => Some(SystemClauseType::FileSize),
|
||||
("$file_exists", 1) => Some(SystemClauseType::FileExists),
|
||||
("$directory_exists", 1) => Some(SystemClauseType::DirectoryExists),
|
||||
("$directory_separator", 1) => Some(SystemClauseType::DirectorySeparator),
|
||||
("$make_directory", 1) => Some(SystemClauseType::MakeDirectory),
|
||||
("$delete_file", 1) => Some(SystemClauseType::DeleteFile),
|
||||
("$working_directory", 2) => Some(SystemClauseType::WorkingDirectory),
|
||||
("$path_canonical", 2) => Some(SystemClauseType::PathCanonical),
|
||||
("$file_time", 3) => Some(SystemClauseType::FileTime),
|
||||
("$use_module", 1) => Some(SystemClauseType::REPL(REPLCodePtr::UseModule)),
|
||||
("$use_module_from_file", 1) =>
|
||||
Some(SystemClauseType::REPL(REPLCodePtr::UseModuleFromFile)),
|
||||
("$use_qualified_module", 2) =>
|
||||
Some(SystemClauseType::REPL(REPLCodePtr::UseQualifiedModule)),
|
||||
("$use_qualified_module_from_file", 2) =>
|
||||
Some(SystemClauseType::REPL(REPLCodePtr::UseQualifiedModuleFromFile)),
|
||||
("$variant", 2) => Some(SystemClauseType::Variant),
|
||||
("$wam_instructions", 3) => Some(SystemClauseType::WAMInstructions),
|
||||
("$write_term", 7) => Some(SystemClauseType::WriteTerm),
|
||||
("$write_term_to_chars", 7) => Some(SystemClauseType::WriteTermToChars),
|
||||
("$scryer_prolog_version", 1) => Some(SystemClauseType::ScryerPrologVersion),
|
||||
("$crypto_random_byte", 1) => Some(SystemClauseType::CryptoRandomByte),
|
||||
("$crypto_data_hash", 4) => Some(SystemClauseType::CryptoDataHash),
|
||||
("$crypto_data_hkdf", 7) => Some(SystemClauseType::CryptoDataHKDF),
|
||||
("$crypto_password_hash", 4) => Some(SystemClauseType::CryptoPasswordHash),
|
||||
("$crypto_data_encrypt", 6) => Some(SystemClauseType::CryptoDataEncrypt),
|
||||
("$crypto_data_decrypt", 6) => Some(SystemClauseType::CryptoDataDecrypt),
|
||||
("$crypto_curve_scalar_mult", 5) => Some(SystemClauseType::CryptoCurveScalarMult),
|
||||
("$ed25519_sign", 5) => Some(SystemClauseType::Ed25519Sign),
|
||||
("$ed25519_verify", 5) => Some(SystemClauseType::Ed25519Verify),
|
||||
("$ed25519_new_keypair", 1) => Some(SystemClauseType::Ed25519NewKeyPair),
|
||||
("$ed25519_keypair_public_key", 3) => Some(SystemClauseType::Ed25519KeyPairPublicKey),
|
||||
("$curve25519_scalar_mult", 3) => Some(SystemClauseType::Curve25519ScalarMult),
|
||||
("$load_html", 3) => Some(SystemClauseType::LoadHTML),
|
||||
("$load_xml", 3) => Some(SystemClauseType::LoadXML),
|
||||
("$getenv", 2) => Some(SystemClauseType::GetEnv),
|
||||
("$setenv", 2) => Some(SystemClauseType::SetEnv),
|
||||
("$unsetenv", 1) => Some(SystemClauseType::UnsetEnv),
|
||||
("$chars_base64", 4) => Some(SystemClauseType::CharsBase64),
|
||||
_ => None,
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug, Clone, Eq, PartialEq)]
|
||||
pub enum BuiltInClauseType {
|
||||
AcyclicTerm,
|
||||
Arg,
|
||||
Compare,
|
||||
CompareTerm(CompareTermQT),
|
||||
CopyTerm,
|
||||
Eq,
|
||||
Functor,
|
||||
Ground,
|
||||
Is(RegType, ArithmeticTerm),
|
||||
KeySort,
|
||||
Nl,
|
||||
NotEq,
|
||||
Read,
|
||||
Sort,
|
||||
}
|
||||
|
||||
#[derive(Debug, Clone, PartialEq, Eq)]
|
||||
pub enum ClauseType {
|
||||
BuiltIn(BuiltInClauseType),
|
||||
CallN,
|
||||
Hook(CompileTimeHook),
|
||||
Inlined(InlinedClauseType),
|
||||
Named(ClauseName, usize, CodeIndex), // name, arity, index.
|
||||
Op(ClauseName, SharedOpDesc, CodeIndex),
|
||||
System(SystemClauseType),
|
||||
}
|
||||
|
||||
impl BuiltInClauseType {
|
||||
pub fn name(&self) -> ClauseName {
|
||||
match self {
|
||||
&BuiltInClauseType::AcyclicTerm => clause_name!("acyclic_term"),
|
||||
&BuiltInClauseType::Arg => clause_name!("arg"),
|
||||
&BuiltInClauseType::Compare => clause_name!("compare"),
|
||||
&BuiltInClauseType::CompareTerm(qt) => clause_name!(qt.name()),
|
||||
&BuiltInClauseType::CopyTerm => clause_name!("copy_term"),
|
||||
&BuiltInClauseType::Eq => clause_name!("=="),
|
||||
&BuiltInClauseType::Functor => clause_name!("functor"),
|
||||
&BuiltInClauseType::Ground => clause_name!("ground"),
|
||||
&BuiltInClauseType::Is(..) => clause_name!("is"),
|
||||
&BuiltInClauseType::KeySort => clause_name!("keysort"),
|
||||
&BuiltInClauseType::Nl => clause_name!("nl"),
|
||||
&BuiltInClauseType::NotEq => clause_name!("\\=="),
|
||||
&BuiltInClauseType::Read => clause_name!("read"),
|
||||
&BuiltInClauseType::Sort => clause_name!("sort"),
|
||||
}
|
||||
}
|
||||
|
||||
pub fn arity(&self) -> usize {
|
||||
match self {
|
||||
&BuiltInClauseType::AcyclicTerm => 1,
|
||||
&BuiltInClauseType::Arg => 3,
|
||||
&BuiltInClauseType::Compare => 2,
|
||||
&BuiltInClauseType::CompareTerm(_) => 2,
|
||||
&BuiltInClauseType::CopyTerm => 2,
|
||||
&BuiltInClauseType::Eq => 2,
|
||||
&BuiltInClauseType::Functor => 3,
|
||||
&BuiltInClauseType::Ground => 1,
|
||||
&BuiltInClauseType::Is(..) => 2,
|
||||
&BuiltInClauseType::KeySort => 2,
|
||||
&BuiltInClauseType::NotEq => 2,
|
||||
&BuiltInClauseType::Nl => 0,
|
||||
&BuiltInClauseType::Read => 1,
|
||||
&BuiltInClauseType::Sort => 2,
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl ClauseType {
|
||||
pub fn spec(&self) -> Option<SharedOpDesc> {
|
||||
match self {
|
||||
&ClauseType::Op(_, ref spec, _) => Some(spec.clone()),
|
||||
&ClauseType::Inlined(InlinedClauseType::CompareNumber(..))
|
||||
| &ClauseType::BuiltIn(BuiltInClauseType::Is(..))
|
||||
| &ClauseType::BuiltIn(BuiltInClauseType::CompareTerm(_))
|
||||
| &ClauseType::BuiltIn(BuiltInClauseType::NotEq)
|
||||
| &ClauseType::BuiltIn(BuiltInClauseType::Eq) => Some(SharedOpDesc::new(700, XFX)),
|
||||
_ => None,
|
||||
}
|
||||
}
|
||||
|
||||
pub fn name(&self) -> ClauseName {
|
||||
match self {
|
||||
&ClauseType::BuiltIn(ref built_in) => built_in.name(),
|
||||
&ClauseType::CallN => clause_name!("call"),
|
||||
&ClauseType::Hook(ref hook) => hook.name(),
|
||||
&ClauseType::Inlined(ref inlined) => clause_name!(inlined.name()),
|
||||
&ClauseType::Op(ref name, ..) => name.clone(),
|
||||
&ClauseType::Named(ref name, ..) => name.clone(),
|
||||
&ClauseType::System(ref system) => system.name(),
|
||||
}
|
||||
}
|
||||
|
||||
pub fn from(name: ClauseName, arity: usize, spec: Option<SharedOpDesc>) -> Self {
|
||||
CLAUSE_TYPE_FORMS
|
||||
.borrow()
|
||||
.get(&(name.as_str(), arity))
|
||||
.cloned()
|
||||
.unwrap_or_else(|| {
|
||||
SystemClauseType::from(name.as_str(), arity)
|
||||
.map(ClauseType::System)
|
||||
.unwrap_or_else(|| {
|
||||
if let Some(spec) = spec {
|
||||
ClauseType::Op(name, spec, CodeIndex::default())
|
||||
} else if name.as_str() == "call" {
|
||||
ClauseType::CallN
|
||||
} else {
|
||||
ClauseType::Named(name, arity, CodeIndex::default())
|
||||
}
|
||||
})
|
||||
})
|
||||
}
|
||||
}
|
||||
|
||||
impl From<InlinedClauseType> for ClauseType {
|
||||
fn from(inlined_ct: InlinedClauseType) -> Self {
|
||||
ClauseType::Inlined(inlined_ct)
|
||||
}
|
||||
}
|
||||
1755
src/codegen.rs
1755
src/codegen.rs
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -1,6 +1,6 @@
|
||||
:- module(bimetatrans_tests, [test_bimetatrans/0]).
|
||||
:- module(bimetatran_tests, [test_bimetatrans/0]).
|
||||
|
||||
:- use_module(bimetatrans).
|
||||
:- use_module('bimetatrans').
|
||||
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(iso_ext)).
|
||||
@@ -21,6 +21,28 @@
|
||||
* order of ascending N.
|
||||
*/
|
||||
|
||||
term_expansion(Term0, Term) :-
|
||||
nonvar(Term0),
|
||||
Term0 = test(N, Assert, Query, XML),
|
||||
integer(N),
|
||||
list_si(Assert),
|
||||
list_si(Query),
|
||||
partial_string(XML),
|
||||
number_chars(N, NChars),
|
||||
atom_chars(NAtom, NChars),
|
||||
atom_concat(prolog2ruleml_, NAtom, Prolog2RuleML),
|
||||
atom_concat(ruleml2prolog_, NAtom, RuleML2Prolog),
|
||||
atom_concat(test_, NAtom, TestN),
|
||||
strip_indentation(XML, XML1),
|
||||
Term = [(Prolog2RuleML :- parse_ruleml(Assert, Query, XML0),
|
||||
XML0 = XML1),
|
||||
(RuleML2Prolog :- parse_ruleml(Assert0, Query0, XML),
|
||||
Assert0 = Assert,
|
||||
Query0 = Query),
|
||||
(TestN :- write(test(N)), nl, Prolog2RuleML, RuleML2Prolog, !),
|
||||
(TestN :- throw(error(test_failure, TestN)))].
|
||||
|
||||
|
||||
until_non_space_or_end([C|Cs], Cs1) :-
|
||||
( C == (' ') ->
|
||||
until_non_space_or_end(Cs, Cs1)
|
||||
@@ -44,28 +66,6 @@ strip_indentation_([C|Cs], Cs0) :-
|
||||
strip_indentation_([], []).
|
||||
|
||||
|
||||
user:term_expansion(Term0, Term) :-
|
||||
nonvar(Term0),
|
||||
Term0 = test(N, Assert, Query, XML),
|
||||
integer(N),
|
||||
list_si(Assert),
|
||||
list_si(Query),
|
||||
partial_string(XML),
|
||||
number_chars(N, NChars),
|
||||
atom_chars(NAtom, NChars),
|
||||
atom_concat(prolog2ruleml_, NAtom, Prolog2RuleML),
|
||||
atom_concat(ruleml2prolog_, NAtom, RuleML2Prolog),
|
||||
atom_concat(test_, NAtom, TestN),
|
||||
strip_indentation(XML, XML1),
|
||||
Term = [(Prolog2RuleML :- parse_ruleml(Assert, Query, XML0),
|
||||
XML0 = XML1),
|
||||
(RuleML2Prolog :- parse_ruleml(Assert0, Query0, XML),
|
||||
Assert0 = Assert,
|
||||
Query0 = Query),
|
||||
(TestN :- write(test(N)), nl, Prolog2RuleML, RuleML2Prolog, !),
|
||||
(TestN :- throw(error(test_failure, TestN)))].
|
||||
|
||||
|
||||
test(1,
|
||||
[people('Alex',male),people('Alex',female),people('Siri',female)],
|
||||
[],
|
||||
|
||||
@@ -11,7 +11,7 @@
|
||||
*/
|
||||
|
||||
:- module(least_time, [find_min_time/2,
|
||||
write_time_nl/1]).
|
||||
write_time_nl/1]).
|
||||
|
||||
|
||||
:- use_module(library(dcgs)).
|
||||
@@ -20,6 +20,12 @@
|
||||
:- use_module(library(reif)).
|
||||
|
||||
|
||||
permutation([], []).
|
||||
permutation([X|Xs], Ys) :-
|
||||
permutation(Xs, Yss),
|
||||
select(X, Ys, Yss).
|
||||
|
||||
|
||||
valid_time([H1,H2,M1,M2], T) :-
|
||||
memberd_t(H1, [0,1,2], TH1),
|
||||
memberd_t(H2, [0,1,2,3,4,5,6,7,8,9], TH2),
|
||||
@@ -27,10 +33,10 @@ valid_time([H1,H2,M1,M2], T) :-
|
||||
memberd_t(M2, [0,1,2,3,4,5,6,7,8,9], TM2),
|
||||
( maplist(=(true), [TH1, TH2, TM1, TM2]) ->
|
||||
( H1 =:= 2 ->
|
||||
( H2 =< 3 ->
|
||||
T = true
|
||||
; T = false
|
||||
)
|
||||
( H2 =< 3 ->
|
||||
T = true
|
||||
; T = false
|
||||
)
|
||||
; T = true
|
||||
)
|
||||
; T = false
|
||||
|
||||
499
src/ffi.rs
499
src/ffi.rs
@@ -1,499 +0,0 @@
|
||||
/* 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 libffi::low::{ffi_abi_FFI_DEFAULT_ABI, ffi_cif, ffi_type, prep_cif, type_tag, 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 mut struct_type: ffi_type = Default::default();
|
||||
struct_type.type_ = type_tag::STRUCT;
|
||||
struct_type.elements = fields.as_mut_ptr();
|
||||
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") => &mut types::sint64,
|
||||
atom!("sint32") => &mut types::sint32,
|
||||
atom!("sint16") => &mut types::sint16,
|
||||
atom!("sint8") => &mut types::sint8,
|
||||
atom!("uint64") => &mut types::uint64,
|
||||
atom!("uint32") => &mut types::uint32,
|
||||
atom!("uint16") => &mut types::uint16,
|
||||
atom!("uint8") => &mut types::uint8,
|
||||
atom!("bool") => &mut types::sint8,
|
||||
atom!("void") => &mut types::void,
|
||||
atom!("cstr") => &mut types::pointer,
|
||||
atom!("ptr") => &mut types::pointer,
|
||||
atom!("f32") => &mut types::float,
|
||||
atom!("f64") => &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 Vec<Value>,
|
||||
type_args: &Vec<*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;
|
||||
|
||||
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 as *mut c_void,
|
||||
struct_size,
|
||||
);
|
||||
field_ptr = field_ptr.add(struct_size);
|
||||
}
|
||||
_ => {
|
||||
unreachable!()
|
||||
}
|
||||
}
|
||||
}
|
||||
return Ok((Box::from_raw(ptr), size, align));
|
||||
} else {
|
||||
return Err(FFIError::InvalidStructName);
|
||||
}
|
||||
}
|
||||
_ => return 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() as *mut *mut c_void,
|
||||
);
|
||||
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() as *mut *mut c_void,
|
||||
);
|
||||
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() as *mut *mut c_void,
|
||||
);
|
||||
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 _ as *mut c_void,
|
||||
pointer_args.pointers.as_mut_ptr() as *mut *mut c_void,
|
||||
);
|
||||
let struct_val = self.read_struct(ptr, name, struct_type);
|
||||
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,
|
||||
}
|
||||
323
src/fixtures.rs
Normal file
323
src/fixtures.rs
Normal file
@@ -0,0 +1,323 @@
|
||||
use crate::prolog_parser::ast::*;
|
||||
|
||||
use crate::forms::*;
|
||||
use crate::instructions::*;
|
||||
use crate::iterators::*;
|
||||
|
||||
use crate::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 enum VarStatus {
|
||||
Perm(usize),
|
||||
Temp(usize, TempVarData), // Perm(chunk_num) | Temp(chunk_num, _)
|
||||
}
|
||||
|
||||
pub type OccurrenceSet = BTreeSet<(GenContext, usize)>;
|
||||
|
||||
// Perm: 0 initially, a stack register once processed.
|
||||
// Temp: labeled with chunk_num and temp offset (unassigned if 0).
|
||||
#[derive(Debug)]
|
||||
pub enum VarData {
|
||||
Perm(usize),
|
||||
Temp(usize, usize, TempVarData),
|
||||
}
|
||||
|
||||
impl VarData {
|
||||
pub fn as_reg_type(&self) -> RegType {
|
||||
match self {
|
||||
&VarData::Temp(_, r, _) => RegType::Temp(r),
|
||||
&VarData::Perm(r) => RegType::Perm(r),
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub struct TempVarData {
|
||||
pub last_term_arity: usize,
|
||||
pub use_set: OccurrenceSet,
|
||||
pub no_use_set: BTreeSet<usize>,
|
||||
pub conflict_set: BTreeSet<usize>,
|
||||
}
|
||||
|
||||
impl TempVarData {
|
||||
pub 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 fn uses_reg(&self, reg: usize) -> bool {
|
||||
for &(_, nreg) in self.use_set.iter() {
|
||||
if reg == nreg {
|
||||
return true;
|
||||
}
|
||||
}
|
||||
|
||||
return false;
|
||||
}
|
||||
|
||||
pub 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(®);
|
||||
}
|
||||
|
||||
self.conflict_set = conflict_set;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
type VariableFixture<'a> = (VarStatus, Vec<&'a Cell<VarReg>>);
|
||||
|
||||
#[derive(Debug)]
|
||||
pub struct VariableFixtures<'a>{
|
||||
perm_vars: IndexMap<Rc<Var>, VariableFixture<'a>>,
|
||||
last_chunk_temp_vars: IndexSet<Rc<Var>>
|
||||
}
|
||||
|
||||
impl<'a> VariableFixtures<'a> {
|
||||
pub fn new() -> Self {
|
||||
VariableFixtures {
|
||||
perm_vars: IndexMap::new(),
|
||||
last_chunk_temp_vars: IndexSet::new()
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
pub fn insert(&mut self, var: Rc<Var>, vs: VariableFixture<'a>) {
|
||||
self.perm_vars.insert(var, vs);
|
||||
}
|
||||
|
||||
pub fn insert_last_chunk_temp_var(&mut self, var: Rc<Var>) {
|
||||
self.last_chunk_temp_vars.insert(var);
|
||||
}
|
||||
|
||||
// computes no_use and conflict sets for all temp vars.
|
||||
pub 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<Var>, 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<Var>) -> Option<&mut VariableFixture<'a>> {
|
||||
self.perm_vars.get_mut(&u)
|
||||
}
|
||||
|
||||
fn iter_mut(&mut self) -> indexmap::map::IterMut<Rc<Var>, 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 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 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 fn into_iter(self) -> indexmap::map::IntoIter<Rc<Var>, VariableFixture<'a>> {
|
||||
self.perm_vars.into_iter()
|
||||
}
|
||||
|
||||
fn values(&self) -> indexmap::map::Values<Rc<Var>, VariableFixture<'a>> {
|
||||
self.perm_vars.values()
|
||||
}
|
||||
|
||||
pub fn size(&self) -> usize {
|
||||
self.perm_vars.len()
|
||||
}
|
||||
|
||||
pub 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 struct UnsafeVarMarker {
|
||||
pub unsafe_vars: IndexMap<RegType, usize>,
|
||||
pub safe_vars: IndexSet<RegType>,
|
||||
}
|
||||
|
||||
impl UnsafeVarMarker {
|
||||
pub fn new() -> Self {
|
||||
UnsafeVarMarker {
|
||||
unsafe_vars: IndexMap::new(),
|
||||
safe_vars: IndexSet::new()
|
||||
}
|
||||
}
|
||||
|
||||
pub fn from_safe_vars(safe_vars: IndexSet<RegType>) -> Self {
|
||||
UnsafeVarMarker {
|
||||
unsafe_vars: IndexMap::new(),
|
||||
safe_vars
|
||||
}
|
||||
}
|
||||
|
||||
pub fn mark_safe_vars(&mut self, query_instr: &QueryInstruction) -> bool {
|
||||
match query_instr {
|
||||
&QueryInstruction::PutVariable(r @ RegType::Temp(_), _)
|
||||
| &QueryInstruction::SetVariable(r) => {
|
||||
self.safe_vars.insert(r);
|
||||
true
|
||||
}
|
||||
_ => {
|
||||
false
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub fn mark_phase(&mut self, query_instr: &QueryInstruction, phase: usize) {
|
||||
match query_instr {
|
||||
&QueryInstruction::PutValue(r @ RegType::Perm(_), _)
|
||||
| &QueryInstruction::SetValue(r) => {
|
||||
let p = self.unsafe_vars.entry(r).or_insert(0);
|
||||
*p = phase;
|
||||
}
|
||||
_ => {}
|
||||
}
|
||||
}
|
||||
|
||||
pub fn mark_unsafe_vars(&mut self, query_instr: &mut QueryInstruction, phase: usize) {
|
||||
match query_instr {
|
||||
&mut QueryInstruction::PutValue(RegType::Perm(i), arg) => {
|
||||
if let Some(p) = self.unsafe_vars.swap_remove(&RegType::Perm(i)) {
|
||||
if p == phase {
|
||||
*query_instr = QueryInstruction::PutUnsafeValue(i, arg);
|
||||
self.safe_vars.insert(RegType::Perm(i));
|
||||
} else {
|
||||
self.unsafe_vars.insert(RegType::Perm(i), p);
|
||||
}
|
||||
}
|
||||
}
|
||||
&mut QueryInstruction::SetValue(r) => {
|
||||
if !self.safe_vars.contains(&r) {
|
||||
*query_instr = QueryInstruction::SetLocalValue(r);
|
||||
|
||||
self.safe_vars.insert(r);
|
||||
self.unsafe_vars.remove(&r);
|
||||
}
|
||||
}
|
||||
_ => {}
|
||||
}
|
||||
}
|
||||
}
|
||||
1261
src/forms.rs
1261
src/forms.rs
File diff suppressed because it is too large
Load Diff
3382
src/heap_iter.rs
3382
src/heap_iter.rs
File diff suppressed because it is too large
Load Diff
2502
src/heap_print.rs
2502
src/heap_print.rs
File diff suppressed because it is too large
Load Diff
23
src/http.rs
23
src/http.rs
@@ -1,23 +0,0 @@
|
||||
use std::sync::{Arc, Mutex, Condvar};
|
||||
use std::io::BufRead;
|
||||
|
||||
use warp::http;
|
||||
|
||||
pub struct HttpListener {
|
||||
pub incoming: std::sync::mpsc::Receiver<HttpRequest>,
|
||||
}
|
||||
|
||||
pub struct HttpRequest {
|
||||
pub request_data: HttpRequestData,
|
||||
pub response: HttpResponse,
|
||||
}
|
||||
|
||||
pub type HttpResponse = Arc<(Mutex<bool>, Mutex<Option<warp::reply::Response>>, Condvar)>;
|
||||
|
||||
pub struct HttpRequestData {
|
||||
pub method: http::Method,
|
||||
pub headers: http::HeaderMap,
|
||||
pub path: String,
|
||||
pub query: String,
|
||||
pub body: Box<dyn BufRead + Send>,
|
||||
}
|
||||
1869
src/indexing.rs
1869
src/indexing.rs
File diff suppressed because it is too large
Load Diff
713
src/instructions.rs
Normal file
713
src/instructions.rs
Normal file
@@ -0,0 +1,713 @@
|
||||
use crate::prolog_parser::ast::*;
|
||||
|
||||
use crate::clause_types::*;
|
||||
use crate::forms::*;
|
||||
use crate::machine::heap::*;
|
||||
use crate::machine::machine_errors::MachineStub;
|
||||
use crate::machine::machine_indices::*;
|
||||
use crate::rug::Integer;
|
||||
|
||||
use crate::indexmap::IndexMap;
|
||||
|
||||
use std::collections::VecDeque;
|
||||
use std::rc::Rc;
|
||||
|
||||
fn reg_type_into_functor(r: RegType) -> MachineStub {
|
||||
match r {
|
||||
RegType::Temp(r) => functor!("x", [integer(r)]),
|
||||
RegType::Perm(r) => functor!("y", [integer(r)]),
|
||||
}
|
||||
}
|
||||
|
||||
impl Level {
|
||||
fn into_functor(self) -> MachineStub {
|
||||
match self {
|
||||
Level::Root => functor!("level", [atom("root")]),
|
||||
Level::Shallow => functor!("level", [atom("shallow")]),
|
||||
Level::Deep => functor!("level", [atom("deep")]),
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl ArithmeticTerm {
|
||||
fn into_functor(&self) -> MachineStub {
|
||||
match self {
|
||||
&ArithmeticTerm::Reg(r) => {
|
||||
reg_type_into_functor(r)
|
||||
}
|
||||
&ArithmeticTerm::Interm(i) => {
|
||||
functor!("intermediate", [integer(i)])
|
||||
}
|
||||
&ArithmeticTerm::Number(ref n) => {
|
||||
vec![n.clone().into()]
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub enum ChoiceInstruction {
|
||||
DefaultRetryMeElse(usize),
|
||||
DefaultTrustMe,
|
||||
RetryMeElse(usize),
|
||||
TrustMe,
|
||||
TryMeElse(usize),
|
||||
}
|
||||
|
||||
impl ChoiceInstruction {
|
||||
pub fn to_functor(&self) -> MachineStub {
|
||||
match self {
|
||||
&ChoiceInstruction::TryMeElse(offset) => {
|
||||
functor!("try_me_else", [integer(offset)])
|
||||
}
|
||||
&ChoiceInstruction::RetryMeElse(offset) => {
|
||||
functor!("retry_me_else", [integer(offset)])
|
||||
}
|
||||
&ChoiceInstruction::TrustMe => {
|
||||
functor!("trust_me")
|
||||
}
|
||||
&ChoiceInstruction::DefaultRetryMeElse(offset) => {
|
||||
functor!("default_retry_me_else", [integer(offset)])
|
||||
}
|
||||
&ChoiceInstruction::DefaultTrustMe => {
|
||||
functor!("default_trust_me")
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub enum CutInstruction {
|
||||
Cut(RegType),
|
||||
GetLevel(RegType),
|
||||
GetLevelAndUnify(RegType),
|
||||
NeckCut,
|
||||
}
|
||||
|
||||
impl CutInstruction {
|
||||
pub fn to_functor(&self, h: usize) -> MachineStub {
|
||||
match self {
|
||||
&CutInstruction::Cut(r) => {
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
functor!("cut", [aux(h, 0)], [rt_stub])
|
||||
}
|
||||
&CutInstruction::GetLevel(r) => {
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
functor!("get_level", [aux(h, 0)], [rt_stub])
|
||||
}
|
||||
&CutInstruction::GetLevelAndUnify(r) => {
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
functor!("get_level_and_unify", [aux(h, 0)], [rt_stub])
|
||||
}
|
||||
&CutInstruction::NeckCut => {
|
||||
functor!("neck_cut")
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub enum IndexedChoiceInstruction {
|
||||
Retry(usize),
|
||||
Trust(usize),
|
||||
Try(usize),
|
||||
}
|
||||
|
||||
impl From<IndexedChoiceInstruction> for Line {
|
||||
fn from(i: IndexedChoiceInstruction) -> Self {
|
||||
Line::IndexedChoice(i)
|
||||
}
|
||||
}
|
||||
|
||||
impl IndexedChoiceInstruction {
|
||||
pub fn offset(&self) -> usize {
|
||||
match self {
|
||||
&IndexedChoiceInstruction::Retry(offset) => offset,
|
||||
&IndexedChoiceInstruction::Trust(offset) => offset,
|
||||
&IndexedChoiceInstruction::Try(offset) => offset,
|
||||
}
|
||||
}
|
||||
|
||||
pub fn to_functor(&self) -> MachineStub {
|
||||
match self {
|
||||
&IndexedChoiceInstruction::Try(offset) => {
|
||||
functor!("try", [integer(offset)])
|
||||
}
|
||||
&IndexedChoiceInstruction::Trust(offset) => {
|
||||
functor!("trust", [integer(offset)])
|
||||
}
|
||||
&IndexedChoiceInstruction::Retry(offset) => {
|
||||
functor!("retry", [integer(offset)])
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub enum Line {
|
||||
Arithmetic(ArithmeticInstruction),
|
||||
Choice(ChoiceInstruction),
|
||||
Control(ControlInstruction),
|
||||
Cut(CutInstruction),
|
||||
Fact(FactInstruction),
|
||||
Indexing(IndexingInstruction),
|
||||
IndexedChoice(IndexedChoiceInstruction),
|
||||
Query(QueryInstruction),
|
||||
}
|
||||
|
||||
impl Line {
|
||||
pub fn is_head_instr(&self) -> bool {
|
||||
match self {
|
||||
&Line::Cut(_) => true,
|
||||
&Line::Fact(_) => true,
|
||||
&Line::Query(_) => true,
|
||||
_ => false,
|
||||
}
|
||||
}
|
||||
|
||||
pub fn to_functor(&self, h: usize) -> MachineStub {
|
||||
match self {
|
||||
&Line::Arithmetic(ref arith_instr) => arith_instr.to_functor(h),
|
||||
&Line::Choice(ref choice_instr) => choice_instr.to_functor(),
|
||||
&Line::Control(ref control_instr) => control_instr.to_functor(),
|
||||
&Line::Cut(ref cut_instr) => cut_instr.to_functor(h),
|
||||
&Line::Fact(ref fact_instr) => fact_instr.to_functor(h),
|
||||
&Line::Indexing(ref indexing_instr) => indexing_instr.to_functor(),
|
||||
&Line::IndexedChoice(ref indexed_choice_instr) => indexed_choice_instr.to_functor(),
|
||||
&Line::Query(ref query_instr) => query_instr.to_functor(h),
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug, Clone)]
|
||||
pub enum ArithmeticInstruction {
|
||||
Add(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
Sub(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
Mul(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
Pow(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
IntPow(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
IDiv(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
Max(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
Min(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
IntFloorDiv(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
RDiv(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
Div(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
Shl(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
Shr(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
Xor(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
And(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
Or(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
Mod(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
Rem(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
Gcd(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
Sign(ArithmeticTerm, usize),
|
||||
Cos(ArithmeticTerm, usize),
|
||||
Sin(ArithmeticTerm, usize),
|
||||
Tan(ArithmeticTerm, usize),
|
||||
Log(ArithmeticTerm, usize),
|
||||
Exp(ArithmeticTerm, usize),
|
||||
ACos(ArithmeticTerm, usize),
|
||||
ASin(ArithmeticTerm, usize),
|
||||
ATan(ArithmeticTerm, usize),
|
||||
ATan2(ArithmeticTerm, ArithmeticTerm, usize),
|
||||
Sqrt(ArithmeticTerm, usize),
|
||||
Abs(ArithmeticTerm, usize),
|
||||
Float(ArithmeticTerm, usize),
|
||||
Truncate(ArithmeticTerm, usize),
|
||||
Round(ArithmeticTerm, usize),
|
||||
Ceiling(ArithmeticTerm, usize),
|
||||
Floor(ArithmeticTerm, usize),
|
||||
Neg(ArithmeticTerm, usize),
|
||||
Plus(ArithmeticTerm, usize),
|
||||
BitwiseComplement(ArithmeticTerm, usize),
|
||||
}
|
||||
|
||||
fn arith_instr_unary_functor(
|
||||
h: usize,
|
||||
name: &'static str,
|
||||
at: &ArithmeticTerm,
|
||||
t: usize,
|
||||
) -> MachineStub {
|
||||
let at_stub = at.into_functor();
|
||||
|
||||
functor!(
|
||||
name,
|
||||
[aux(h, 0), integer(t)],
|
||||
[at_stub]
|
||||
)
|
||||
}
|
||||
|
||||
fn arith_instr_bin_functor(
|
||||
h: usize,
|
||||
name: &'static str,
|
||||
at_1: &ArithmeticTerm,
|
||||
at_2: &ArithmeticTerm,
|
||||
t: usize,
|
||||
) -> MachineStub {
|
||||
let at_1_stub = at_1.into_functor();
|
||||
let at_2_stub = at_2.into_functor();
|
||||
|
||||
functor!(
|
||||
name,
|
||||
[aux(h, 0), aux(h, 1), integer(t)],
|
||||
[at_1_stub, at_2_stub]
|
||||
)
|
||||
}
|
||||
|
||||
impl ArithmeticInstruction {
|
||||
pub fn to_functor(&self, h: usize) -> MachineStub {
|
||||
match self {
|
||||
&ArithmeticInstruction::Add(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "add", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::Sub(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "sub", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::Mul(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "mul", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::IntPow(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "int_pow", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::Pow(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "pow", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::IDiv(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "idiv", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::Max(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "max", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::Min(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "min", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::IntFloorDiv(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "int_floor_div", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::RDiv(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "rdiv", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::Div(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "div", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::Shl(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "shl", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::Shr(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "shr", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::Xor(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "xor", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::And(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "and", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::Or(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "or", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::Mod(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "mod", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::Rem(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "rem", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::ATan2(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "rem", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::Gcd(ref at_1, ref at_2, t) => {
|
||||
arith_instr_bin_functor(h, "gcd", at_1, at_2, t)
|
||||
}
|
||||
&ArithmeticInstruction::Sign(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "sign", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Cos(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "cos", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Sin(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "sin", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Tan(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "tan", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Log(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "log", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Exp(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "exp", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::ACos(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "acos", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::ASin(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "asin", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::ATan(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "atan", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Sqrt(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "sqrt", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Abs(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "abs", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Float(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "float", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Truncate(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "truncate", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Round(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "round", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Ceiling(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "ceiling", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Floor(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "floor", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Neg(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "-", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::Plus(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "+", at, t)
|
||||
}
|
||||
&ArithmeticInstruction::BitwiseComplement(ref at, t) => {
|
||||
arith_instr_unary_functor(h, "\\", at, t)
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub enum ControlInstruction {
|
||||
Allocate(usize), // num_frames.
|
||||
// name, arity, perm_vars after threshold, last call, use default call policy.
|
||||
CallClause(ClauseType, usize, usize, bool, bool),
|
||||
Deallocate,
|
||||
JmpBy(usize, usize, usize, bool), // arity, global_offset, perm_vars after threshold, last call.
|
||||
Proceed,
|
||||
}
|
||||
|
||||
impl ControlInstruction {
|
||||
pub fn perm_vars(&self) -> Option<usize> {
|
||||
match self {
|
||||
ControlInstruction::CallClause(_, _, num_cells, ..) =>
|
||||
Some(*num_cells),
|
||||
ControlInstruction::JmpBy(_, _, num_cells, ..) =>
|
||||
Some(*num_cells),
|
||||
_ =>
|
||||
None
|
||||
}
|
||||
}
|
||||
|
||||
pub fn to_functor(&self) -> MachineStub {
|
||||
match self {
|
||||
&ControlInstruction::Allocate(num_frames) => {
|
||||
functor!("allocate", [integer(num_frames)])
|
||||
}
|
||||
&ControlInstruction::CallClause(ref ct, arity, _, false, _) => {
|
||||
functor!("call", [clause_name(ct.name()), integer(arity)])
|
||||
}
|
||||
&ControlInstruction::CallClause(ref ct, arity, _, true, _) => {
|
||||
functor!("execute", [clause_name(ct.name()), integer(arity)])
|
||||
}
|
||||
&ControlInstruction::Deallocate => {
|
||||
functor!("deallocate")
|
||||
}
|
||||
&ControlInstruction::JmpBy(_, offset, ..) => {
|
||||
functor!("jmp_by", [integer(offset)])
|
||||
}
|
||||
&ControlInstruction::Proceed => {
|
||||
functor!("proceed")
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub enum IndexingInstruction {
|
||||
SwitchOnTerm(usize, usize, usize, usize),
|
||||
SwitchOnConstant(usize, IndexMap<Constant, usize>),
|
||||
SwitchOnStructure(usize, IndexMap<(ClauseName, usize), usize>),
|
||||
}
|
||||
|
||||
impl From<IndexingInstruction> for Line {
|
||||
fn from(i: IndexingInstruction) -> Self {
|
||||
Line::Indexing(i)
|
||||
}
|
||||
}
|
||||
|
||||
impl IndexingInstruction {
|
||||
pub fn to_functor(&self) -> MachineStub {
|
||||
match self {
|
||||
&IndexingInstruction::SwitchOnTerm(vars, constants, lists, structures) => {
|
||||
functor!(
|
||||
"switch_on_term",
|
||||
[integer(vars),
|
||||
integer(constants),
|
||||
integer(lists),
|
||||
integer(structures)]
|
||||
)
|
||||
}
|
||||
&IndexingInstruction::SwitchOnConstant(constants, _) => {
|
||||
functor!(
|
||||
"switch_on_constant",
|
||||
[integer(constants)]
|
||||
)
|
||||
}
|
||||
&IndexingInstruction::SwitchOnStructure(structures, _) => {
|
||||
functor!(
|
||||
"switch_on_structure",
|
||||
[integer(structures)]
|
||||
)
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug, Clone)]
|
||||
pub enum FactInstruction {
|
||||
GetConstant(Level, Constant, RegType),
|
||||
GetList(Level, RegType),
|
||||
GetPartialString(Level, String, RegType, bool),
|
||||
GetStructure(ClauseType, usize, RegType),
|
||||
GetValue(RegType, usize),
|
||||
GetVariable(RegType, usize),
|
||||
UnifyConstant(Constant),
|
||||
UnifyLocalValue(RegType),
|
||||
UnifyVariable(RegType),
|
||||
UnifyValue(RegType),
|
||||
UnifyVoid(usize),
|
||||
}
|
||||
|
||||
impl FactInstruction {
|
||||
pub fn to_functor(&self, h: usize) -> MachineStub {
|
||||
match self {
|
||||
&FactInstruction::GetConstant(lvl, ref c, r) => {
|
||||
let lvl_stub = lvl.into_functor();
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"get_constant",
|
||||
[aux(h, 0), constant(h, c), aux(h, 1)],
|
||||
[lvl_stub, rt_stub]
|
||||
)
|
||||
}
|
||||
&FactInstruction::GetList(lvl, r) => {
|
||||
let lvl_stub = lvl.into_functor();
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"get_list",
|
||||
[aux(h, 0), aux(h, 1)],
|
||||
[lvl_stub, rt_stub]
|
||||
)
|
||||
}
|
||||
&FactInstruction::GetPartialString(lvl, ref s, r, has_tail) => {
|
||||
let lvl_stub = lvl.into_functor();
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"get_partial_string",
|
||||
[aux(h, 0), string(h, s), aux(h, 1), boolean(has_tail)],
|
||||
[lvl_stub, rt_stub]
|
||||
)
|
||||
}
|
||||
&FactInstruction::GetStructure(ref ct, arity, r) => {
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"get_structure",
|
||||
[clause_name(ct.name()), integer(arity), aux(h, 0)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&FactInstruction::GetValue(r, arg) => {
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"get_value",
|
||||
[aux(h, 0), integer(arg)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&FactInstruction::GetVariable(r, arg) => {
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"get_variable",
|
||||
[aux(h, 0), integer(arg)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&FactInstruction::UnifyConstant(ref c) => {
|
||||
functor!("unify_constant", [constant(h, c)], [])
|
||||
}
|
||||
&FactInstruction::UnifyLocalValue(r) => {
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"unify_local_value",
|
||||
[aux(h, 0)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&FactInstruction::UnifyVariable(r) => {
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"unify_variable",
|
||||
[aux(h, 0)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&FactInstruction::UnifyValue(r) => {
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"unify_value",
|
||||
[aux(h, 0)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&FactInstruction::UnifyVoid(vars) => {
|
||||
functor!("unify_void", [integer(vars)])
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug, Clone)]
|
||||
pub enum QueryInstruction {
|
||||
GetVariable(RegType, usize),
|
||||
PutConstant(Level, Constant, RegType),
|
||||
PutList(Level, RegType),
|
||||
PutPartialString(Level, String, RegType, bool),
|
||||
PutStructure(ClauseType, usize, RegType),
|
||||
PutUnsafeValue(usize, usize),
|
||||
PutValue(RegType, usize),
|
||||
PutVariable(RegType, usize),
|
||||
SetConstant(Constant),
|
||||
SetLocalValue(RegType),
|
||||
SetVariable(RegType),
|
||||
SetValue(RegType),
|
||||
SetVoid(usize),
|
||||
}
|
||||
|
||||
impl QueryInstruction {
|
||||
pub fn to_functor(&self, h: usize) -> MachineStub {
|
||||
match self {
|
||||
&QueryInstruction::PutUnsafeValue(norm, arg) => functor!(
|
||||
"put_unsafe_value",
|
||||
[integer(norm), integer(arg)]
|
||||
),
|
||||
&QueryInstruction::PutConstant(lvl, ref c, r) => {
|
||||
let lvl_stub = lvl.into_functor();
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"put_constant",
|
||||
[aux(h, 0), constant(h, c), aux(h, 1)],
|
||||
[lvl_stub, rt_stub]
|
||||
)
|
||||
}
|
||||
&QueryInstruction::PutList(lvl, r) => {
|
||||
let lvl_stub = lvl.into_functor();
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"put_list",
|
||||
[aux(h, 0), aux(h, 1)],
|
||||
[lvl_stub, rt_stub]
|
||||
)
|
||||
}
|
||||
&QueryInstruction::PutPartialString(lvl, ref s, r, has_tail) => {
|
||||
let lvl_stub = lvl.into_functor();
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"put_partial_string",
|
||||
[aux(h, 0), string(h, s), aux(h, 1), boolean(has_tail)],
|
||||
[lvl_stub, rt_stub]
|
||||
)
|
||||
}
|
||||
&QueryInstruction::PutStructure(ref ct, arity, r) => {
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"put_structure",
|
||||
[clause_name(ct.name()), integer(arity), aux(h, 0)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&QueryInstruction::PutValue(r, arg) => {
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"put_value",
|
||||
[aux(h, 0), integer(arg)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&QueryInstruction::GetVariable(r, arg) => {
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"get_variable",
|
||||
[aux(h, 0), integer(arg)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&QueryInstruction::PutVariable(r, arg) => {
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"put_variable",
|
||||
[aux(h, 0), integer(arg)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&QueryInstruction::SetConstant(ref c) => {
|
||||
functor!("set_constant", [constant(h, c)], [])
|
||||
}
|
||||
&QueryInstruction::SetLocalValue(r) => {
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"set_local_value",
|
||||
[aux(h, 0)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&QueryInstruction::SetVariable(r) => {
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"set_variable",
|
||||
[aux(h, 0)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&QueryInstruction::SetValue(r) => {
|
||||
let rt_stub = reg_type_into_functor(r);
|
||||
|
||||
functor!(
|
||||
"set_value",
|
||||
[aux(h, 0)],
|
||||
[rt_stub]
|
||||
)
|
||||
}
|
||||
&QueryInstruction::SetVoid(vars) => {
|
||||
functor!("set_void", [integer(vars)])
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
pub type CompiledFact = Vec<FactInstruction>;
|
||||
|
||||
pub type ThirdLevelIndex = Vec<IndexedChoiceInstruction>;
|
||||
|
||||
pub type Code = Vec<Line>;
|
||||
|
||||
pub type CodeDeque = VecDeque<Line>;
|
||||
627
src/iterators.rs
627
src/iterators.rs
@@ -1,75 +1,137 @@
|
||||
use crate::atom_table::*;
|
||||
use crate::prolog_parser::ast::*;
|
||||
|
||||
use crate::clause_types::*;
|
||||
use crate::forms::*;
|
||||
use crate::instructions::*;
|
||||
use crate::parser::ast::*;
|
||||
use crate::machine::machine_indices::*;
|
||||
|
||||
use std::cell::Cell;
|
||||
use std::collections::VecDeque;
|
||||
use std::fmt;
|
||||
use std::iter::*;
|
||||
use std::rc::Rc;
|
||||
use std::vec::Vec;
|
||||
|
||||
#[derive(Debug, Clone)]
|
||||
pub(crate) enum TermRef<'a> {
|
||||
pub enum TermRef<'a> {
|
||||
AnonVar(Level),
|
||||
Cons(Level, &'a Cell<RegType>, &'a Term, &'a Term),
|
||||
Literal(Level, &'a Cell<RegType>, &'a Literal),
|
||||
Clause(Level, &'a Cell<RegType>, Atom, &'a Vec<Term>),
|
||||
PartialString(Level, &'a Cell<RegType>, &'a String, &'a Box<Term>),
|
||||
CompleteString(Level, &'a Cell<RegType>, Atom),
|
||||
Var(Level, &'a Cell<VarReg>, VarPtr),
|
||||
Constant(Level, &'a Cell<RegType>, &'a Constant),
|
||||
Clause(Level, &'a Cell<RegType>, ClauseType, &'a Vec<Box<Term>>),
|
||||
PartialString(Level, &'a Cell<RegType>, String, Option<&'a Term>),
|
||||
Var(Level, &'a Cell<VarReg>, Rc<Var>),
|
||||
}
|
||||
|
||||
/*
|
||||
impl<'a> TermRef<'a> {
|
||||
pub(crate) fn level(&self) -> Level {
|
||||
pub fn level(self) -> Level {
|
||||
match self {
|
||||
TermRef::AnonVar(lvl) |
|
||||
TermRef::Cons(lvl, ..) |
|
||||
TermRef::Literal(lvl, ..) |
|
||||
TermRef::Var(lvl, ..) |
|
||||
TermRef::Clause(lvl, ..) |
|
||||
TermRef::CompleteString(lvl, ..) |
|
||||
TermRef::PartialString(lvl, ..) => *lvl,
|
||||
TermRef::AnonVar(lvl)
|
||||
| TermRef::Cons(lvl, ..)
|
||||
| TermRef::Constant(lvl, ..)
|
||||
| TermRef::Var(lvl, ..)
|
||||
| TermRef::Clause(lvl, ..) => lvl,
|
||||
| TermRef::PartialString(lvl, ..) => lvl,
|
||||
}
|
||||
}
|
||||
}
|
||||
*/
|
||||
|
||||
#[derive(Debug)]
|
||||
pub(crate) enum TermIterState<'a> {
|
||||
pub enum TermIterState<'a> {
|
||||
AnonVar(Level),
|
||||
Clause(Level, usize, &'a Cell<RegType>, Atom, &'a Vec<Term>),
|
||||
Literal(Level, &'a Cell<RegType>, &'a Literal),
|
||||
Constant(Level, &'a Cell<RegType>, &'a Constant),
|
||||
Clause(
|
||||
Level,
|
||||
usize,
|
||||
&'a Cell<RegType>,
|
||||
ClauseType,
|
||||
&'a Vec<Box<Term>>,
|
||||
),
|
||||
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>, VarPtr),
|
||||
PartialString(Level, &'a Cell<RegType>, String, Option<&'a Term>),
|
||||
Var(Level, &'a Cell<VarReg>, Rc<Var>),
|
||||
}
|
||||
|
||||
fn is_partial_string<'a>(
|
||||
head: &'a Term,
|
||||
mut tail: &'a Term,
|
||||
) -> Option<(String, Option<&'a Term>)>
|
||||
{
|
||||
let mut string =
|
||||
match head {
|
||||
&Term::Constant(_, Constant::Atom(ref atom, _)) if atom.is_char() => {
|
||||
atom.as_str().chars().next().unwrap().to_string()
|
||||
}
|
||||
&Term::Constant(_, Constant::Char(c)) => {
|
||||
c.to_string()
|
||||
}
|
||||
_ => {
|
||||
return None;
|
||||
}
|
||||
};
|
||||
|
||||
while let Term::Cons(_, ref head, ref succ) = tail {
|
||||
match head.as_ref() {
|
||||
&Term::Constant(_, Constant::Atom(ref atom, _)) if atom.is_char() => {
|
||||
string.push(atom.as_str().chars().next().unwrap());
|
||||
}
|
||||
&Term::Constant(_, Constant::Char(c)) => {
|
||||
string.push(c);
|
||||
}
|
||||
_ => {
|
||||
return None;
|
||||
}
|
||||
};
|
||||
|
||||
tail = succ.as_ref();
|
||||
}
|
||||
|
||||
match tail {
|
||||
Term::AnonVar | Term::Var(..) => {
|
||||
return Some((string, Some(tail)));
|
||||
}
|
||||
Term::Constant(_, Constant::EmptyList) => {
|
||||
return Some((string, None));
|
||||
}
|
||||
Term::Constant(_, Constant::String(tail)) => {
|
||||
string += &tail;
|
||||
return Some((string, None));
|
||||
}
|
||||
_ => {
|
||||
return None;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> TermIterState<'a> {
|
||||
pub(crate) fn subterm_to_state(lvl: Level, term: &'a Term) -> TermIterState<'a> {
|
||||
pub fn subterm_to_state(lvl: Level, term: &'a Term) -> TermIterState<'a> {
|
||||
match term {
|
||||
Term::AnonVar => TermIterState::AnonVar(lvl),
|
||||
Term::Clause(cell, name, subterms) => {
|
||||
TermIterState::Clause(lvl, 0, cell, *name, subterms)
|
||||
&Term::AnonVar => {
|
||||
TermIterState::AnonVar(lvl)
|
||||
}
|
||||
Term::Cons(cell, head, tail) => {
|
||||
&Term::Clause(ref cell, ref name, ref subterms, ref spec) => {
|
||||
let ct = if let Some(spec) = spec {
|
||||
ClauseType::Op(name.clone(), spec.clone(), CodeIndex::default())
|
||||
} else {
|
||||
ClauseType::Named(name.clone(), subterms.len(), CodeIndex::default())
|
||||
};
|
||||
|
||||
TermIterState::Clause(lvl, 0, cell, ct, subterms)
|
||||
}
|
||||
&Term::Cons(ref cell, ref head, ref tail) => {
|
||||
TermIterState::InitialCons(lvl, cell, head.as_ref(), tail.as_ref())
|
||||
}
|
||||
Term::Literal(cell, constant) => TermIterState::Literal(lvl, cell, constant),
|
||||
Term::PartialString(cell, string_buf, tail) => {
|
||||
TermIterState::InitialPartialString(lvl, cell, string_buf, tail)
|
||||
&Term::Constant(ref cell, ref constant) => {
|
||||
TermIterState::Constant(lvl, cell, constant)
|
||||
}
|
||||
&Term::Var(ref cell, ref var) => {
|
||||
TermIterState::Var(lvl, cell, var.clone())
|
||||
}
|
||||
Term::CompleteString(cell, atom) => TermIterState::CompleteString(lvl, cell, *atom),
|
||||
Term::Var(cell, var_ptr) => TermIterState::Var(lvl, cell, var_ptr.clone()),
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub(crate) struct QueryIterator<'a> {
|
||||
pub struct QueryIterator<'a> {
|
||||
state_stack: Vec<TermIterState<'a>>,
|
||||
}
|
||||
|
||||
@@ -79,31 +141,42 @@ impl<'a> QueryIterator<'a> {
|
||||
.push(TermIterState::subterm_to_state(lvl, term));
|
||||
}
|
||||
|
||||
/*
|
||||
fn from_rule_head_clause(terms: &'a Vec<Term>) -> Self {
|
||||
fn from_rule_head_clause(terms: &'a Vec<Box<Term>>) -> Self {
|
||||
let state_stack = terms
|
||||
.iter()
|
||||
.rev()
|
||||
.map(|bt| TermIterState::subterm_to_state(Level::Shallow, bt))
|
||||
.map(|bt| TermIterState::subterm_to_state(Level::Shallow, bt.as_ref()))
|
||||
.collect();
|
||||
|
||||
QueryIterator { state_stack }
|
||||
}
|
||||
*/
|
||||
|
||||
fn from_term(term: &'a Term) -> Self {
|
||||
let state = match term {
|
||||
Term::AnonVar
|
||||
| Term::Cons(..)
|
||||
| Term::Literal(..)
|
||||
| Term::PartialString(..)
|
||||
| Term::CompleteString(..) => {
|
||||
&Term::AnonVar => {
|
||||
return QueryIterator {
|
||||
state_stack: vec![],
|
||||
}
|
||||
}
|
||||
Term::Clause(r, name, terms) => TermIterState::Clause(Level::Root, 0, r, *name, terms),
|
||||
Term::Var(cell, var_ptr) => TermIterState::Var(Level::Root, cell, var_ptr.clone()),
|
||||
&Term::Clause(ref r, ref name, ref terms, ref fixity) => TermIterState::Clause(
|
||||
Level::Root,
|
||||
0,
|
||||
r,
|
||||
ClauseType::from(name.clone(), terms.len(), fixity.clone()),
|
||||
terms,
|
||||
),
|
||||
&Term::Cons(..) => {
|
||||
return QueryIterator {
|
||||
state_stack: vec![],
|
||||
}
|
||||
}
|
||||
&Term::Constant(_, _) => {
|
||||
return QueryIterator {
|
||||
state_stack: vec![],
|
||||
}
|
||||
}
|
||||
&Term::Var(ref cell, ref var) =>
|
||||
TermIterState::Var(Level::Root, cell, (*var).clone()),
|
||||
};
|
||||
|
||||
QueryIterator {
|
||||
@@ -111,26 +184,45 @@ impl<'a> QueryIterator<'a> {
|
||||
}
|
||||
}
|
||||
|
||||
fn extend_state(&mut self, lvl: Level, term: &'a QueryTerm) {
|
||||
fn new(term: &'a QueryTerm) -> Self {
|
||||
match term {
|
||||
&QueryTerm::Clause(ref cell, ClauseType::CallN(_), ref terms, _) => {
|
||||
self.state_stack
|
||||
.push(TermIterState::Clause(lvl, 1, cell, atom!("$call"), terms));
|
||||
&QueryTerm::Clause(ref cell, ClauseType::CallN, ref terms, _) => {
|
||||
let state = TermIterState::Clause(Level::Root, 1, cell, ClauseType::CallN, terms);
|
||||
QueryIterator {
|
||||
state_stack: vec![state],
|
||||
}
|
||||
}
|
||||
&QueryTerm::Clause(ref cell, ref ct, ref terms, _) => {
|
||||
self.state_stack
|
||||
.push(TermIterState::Clause(lvl, 0, cell, ct.name(), terms));
|
||||
let state = TermIterState::Clause(Level::Root, 0, cell, ct.clone(), terms);
|
||||
QueryIterator {
|
||||
state_stack: vec![state],
|
||||
}
|
||||
}
|
||||
_ => {}
|
||||
}
|
||||
}
|
||||
&QueryTerm::UnblockedCut(ref cell) => {
|
||||
let state = TermIterState::Var(Level::Root, cell, rc_atom!("!"));
|
||||
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();
|
||||
|
||||
pub fn new(term: &'a QueryTerm) -> Self {
|
||||
let mut iter = QueryIterator {
|
||||
state_stack: vec![],
|
||||
};
|
||||
iter.extend_state(Level::Root, term);
|
||||
iter
|
||||
QueryIterator { state_stack }
|
||||
}
|
||||
&QueryTerm::BlockedCut => QueryIterator {
|
||||
state_stack: vec![],
|
||||
},
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -143,57 +235,64 @@ impl<'a> Iterator for QueryIterator<'a> {
|
||||
TermIterState::AnonVar(lvl) => {
|
||||
return Some(TermRef::AnonVar(lvl));
|
||||
}
|
||||
TermIterState::Clause(lvl, child_num, cell, name, child_terms) => {
|
||||
TermIterState::Clause(lvl, child_num, cell, ct, child_terms) => {
|
||||
if child_num == child_terms.len() {
|
||||
match name {
|
||||
atom!("$call") if lvl == Level::Root => {
|
||||
self.push_subterm(Level::Shallow, &child_terms[0]);
|
||||
match ct {
|
||||
ClauseType::CallN => {
|
||||
self.push_subterm(Level::Shallow, child_terms[0].as_ref())
|
||||
}
|
||||
_ => {
|
||||
ClauseType::Named(..) | ClauseType::Op(..) => {
|
||||
return match lvl {
|
||||
Level::Root => None,
|
||||
lvl => Some(TermRef::Clause(lvl, cell, name, child_terms)),
|
||||
lvl => Some(TermRef::Clause(lvl, cell, ct, child_terms)),
|
||||
}
|
||||
}
|
||||
_ => {
|
||||
return None;
|
||||
}
|
||||
};
|
||||
} else {
|
||||
self.state_stack.push(TermIterState::Clause(
|
||||
lvl,
|
||||
child_num + 1,
|
||||
cell,
|
||||
name,
|
||||
ct,
|
||||
child_terms,
|
||||
));
|
||||
|
||||
self.push_subterm(lvl.child_level(), &child_terms[child_num]);
|
||||
self.push_subterm(lvl.child_level(), child_terms[child_num].as_ref());
|
||||
}
|
||||
}
|
||||
TermIterState::InitialCons(lvl, cell, head, tail) => {
|
||||
self.state_stack
|
||||
.push(TermIterState::FinalCons(lvl, cell, head, tail));
|
||||
if let Some((string, tail)) = is_partial_string(head, tail) {
|
||||
self.state_stack.push(TermIterState::PartialString(
|
||||
lvl,
|
||||
cell,
|
||||
string,
|
||||
tail,
|
||||
));
|
||||
|
||||
self.push_subterm(lvl.child_level(), tail);
|
||||
self.push_subterm(lvl.child_level(), head);
|
||||
if let Some(tail) = tail {
|
||||
self.push_subterm(lvl.child_level(), tail);
|
||||
}
|
||||
} else {
|
||||
self.state_stack.push(TermIterState::FinalCons(lvl, cell, head, tail));
|
||||
|
||||
self.push_subterm(lvl.child_level(), tail);
|
||||
self.push_subterm(lvl.child_level(), head);
|
||||
}
|
||||
}
|
||||
TermIterState::InitialPartialString(lvl, cell, string, tail) => {
|
||||
self.state_stack
|
||||
.push(TermIterState::FinalPartialString(lvl, cell, string, tail));
|
||||
self.push_subterm(lvl.child_level(), tail);
|
||||
}
|
||||
TermIterState::FinalPartialString(lvl, cell, atom, tail) => {
|
||||
return Some(TermRef::PartialString(lvl, cell, atom, tail));
|
||||
}
|
||||
TermIterState::CompleteString(lvl, cell, atom) => {
|
||||
return Some(TermRef::CompleteString(lvl, cell, atom));
|
||||
TermIterState::PartialString(lvl, cell, string, tail) => {
|
||||
return Some(TermRef::PartialString(lvl, cell, string, tail));
|
||||
}
|
||||
TermIterState::FinalCons(lvl, cell, head, tail) => {
|
||||
return Some(TermRef::Cons(lvl, cell, head, tail));
|
||||
}
|
||||
TermIterState::Literal(lvl, cell, constant) => {
|
||||
return Some(TermRef::Literal(lvl, cell, constant));
|
||||
TermIterState::Constant(lvl, cell, constant) => {
|
||||
return Some(TermRef::Constant(lvl, cell, constant));
|
||||
}
|
||||
TermIterState::Var(lvl, cell, var_ptr) => {
|
||||
return Some(TermRef::Var(lvl, cell, var_ptr));
|
||||
TermIterState::Var(lvl, cell, var) => {
|
||||
return Some(TermRef::Var(lvl, cell, var));
|
||||
}
|
||||
};
|
||||
}
|
||||
@@ -203,59 +302,48 @@ impl<'a> Iterator for QueryIterator<'a> {
|
||||
}
|
||||
|
||||
#[derive(Debug)]
|
||||
pub(crate) struct FactIterator<'a> {
|
||||
pub struct FactIterator<'a> {
|
||||
state_queue: VecDeque<TermIterState<'a>>,
|
||||
iterable_root: RootIterationPolicy,
|
||||
iterable_root: bool,
|
||||
}
|
||||
|
||||
impl<'a> FactIterator<'a> {
|
||||
fn push_subterm(&mut self, lvl: Level, term: &'a Term) {
|
||||
self.state_queue
|
||||
.push_back(TermIterState::subterm_to_state(lvl, term));
|
||||
self.state_queue.push_back(TermIterState::subterm_to_state(lvl, term));
|
||||
}
|
||||
|
||||
pub(crate) fn from_rule_head_clause(terms: &'a Vec<Term>) -> Self {
|
||||
pub fn from_rule_head_clause(terms: &'a Vec<Box<Term>>) -> Self {
|
||||
let state_queue = terms
|
||||
.iter()
|
||||
.map(|bt| TermIterState::subterm_to_state(Level::Shallow, bt))
|
||||
.map(|bt| TermIterState::subterm_to_state(Level::Shallow, bt.as_ref()))
|
||||
.collect();
|
||||
|
||||
FactIterator {
|
||||
state_queue,
|
||||
iterable_root: RootIterationPolicy::NotIterated,
|
||||
iterable_root: false,
|
||||
}
|
||||
}
|
||||
|
||||
fn new(term: &'a Term, iterable_root: RootIterationPolicy) -> Self {
|
||||
fn new(term: &'a Term, iterable_root: bool) -> Self {
|
||||
let states = match term {
|
||||
Term::AnonVar => {
|
||||
&Term::AnonVar => {
|
||||
vec![TermIterState::AnonVar(Level::Root)]
|
||||
}
|
||||
Term::Clause(cell, name, terms) => {
|
||||
vec![TermIterState::Clause(Level::Root, 0, cell, *name, terms)]
|
||||
&Term::Clause(ref cell, ref name, ref terms, ref fixity) => {
|
||||
let ct = ClauseType::from(name.clone(), terms.len(), fixity.clone());
|
||||
vec![TermIterState::Clause(Level::Root, 0, cell, ct, terms)]
|
||||
}
|
||||
Term::Cons(cell, head, tail) => vec![TermIterState::InitialCons(
|
||||
&Term::Cons(ref cell, ref head, ref tail) => vec![TermIterState::InitialCons(
|
||||
Level::Root,
|
||||
cell,
|
||||
head.as_ref(),
|
||||
tail.as_ref(),
|
||||
)],
|
||||
Term::PartialString(cell, string_buf, tail) => {
|
||||
vec![TermIterState::InitialPartialString(
|
||||
Level::Root,
|
||||
cell,
|
||||
string_buf,
|
||||
tail,
|
||||
)]
|
||||
&Term::Constant(ref cell, ref constant) => {
|
||||
vec![TermIterState::Constant(Level::Root, cell, constant)]
|
||||
}
|
||||
Term::CompleteString(cell, atom) => {
|
||||
vec![TermIterState::CompleteString(Level::Root, cell, *atom)]
|
||||
}
|
||||
Term::Literal(cell, constant) => {
|
||||
vec![TermIterState::Literal(Level::Root, cell, constant)]
|
||||
}
|
||||
Term::Var(cell, var_ptr) => {
|
||||
vec![TermIterState::Var(Level::Root, cell, var_ptr.clone())]
|
||||
&Term::Var(ref cell, ref var) => {
|
||||
vec![TermIterState::Var(Level::Root, cell, var.clone())]
|
||||
}
|
||||
};
|
||||
|
||||
@@ -275,36 +363,38 @@ impl<'a> Iterator for FactIterator<'a> {
|
||||
TermIterState::AnonVar(lvl) => {
|
||||
return Some(TermRef::AnonVar(lvl));
|
||||
}
|
||||
TermIterState::Clause(lvl, _, cell, name, child_terms) => {
|
||||
TermIterState::Clause(lvl, _, cell, ct, child_terms) => {
|
||||
for child_term in child_terms {
|
||||
self.push_subterm(lvl.child_level(), child_term);
|
||||
}
|
||||
|
||||
match lvl {
|
||||
Level::Root if !self.iterable_root.iterable() => continue,
|
||||
_ => return Some(TermRef::Clause(lvl, cell, name, child_terms)),
|
||||
Level::Root if !self.iterable_root => continue,
|
||||
_ => return Some(TermRef::Clause(lvl, cell, ct, child_terms)),
|
||||
};
|
||||
}
|
||||
TermIterState::InitialCons(lvl, cell, head, tail) => {
|
||||
self.push_subterm(Level::Deep, head);
|
||||
self.push_subterm(Level::Deep, tail);
|
||||
if let Some((string, tail)) = is_partial_string(head, tail) {
|
||||
if let Some(tail) = tail {
|
||||
self.push_subterm(Level::Deep, tail);
|
||||
}
|
||||
|
||||
return Some(TermRef::Cons(lvl, cell, head, tail));
|
||||
return Some(TermRef::PartialString(lvl, cell, string, tail));
|
||||
} else {
|
||||
self.push_subterm(Level::Deep, head);
|
||||
self.push_subterm(Level::Deep, tail);
|
||||
|
||||
return Some(TermRef::Cons(lvl, cell, head, tail));
|
||||
}
|
||||
}
|
||||
TermIterState::InitialPartialString(lvl, cell, string_buf, tail) => {
|
||||
self.push_subterm(Level::Deep, tail);
|
||||
return Some(TermRef::PartialString(lvl, cell, string_buf, tail));
|
||||
TermIterState::Constant(lvl, cell, constant) => {
|
||||
return Some(TermRef::Constant(lvl, cell, constant))
|
||||
}
|
||||
TermIterState::CompleteString(lvl, cell, atom) => {
|
||||
return Some(TermRef::CompleteString(lvl, cell, atom));
|
||||
TermIterState::Var(lvl, cell, var) => {
|
||||
return Some(TermRef::Var(lvl, cell, var));
|
||||
}
|
||||
TermIterState::Literal(lvl, cell, constant) => {
|
||||
return Some(TermRef::Literal(lvl, cell, constant))
|
||||
_ => {
|
||||
}
|
||||
TermIterState::Var(lvl, cell, var_ptr) => {
|
||||
return Some(TermRef::Var(lvl, cell, var_ptr));
|
||||
}
|
||||
_ => {}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -312,138 +402,203 @@ impl<'a> Iterator for FactIterator<'a> {
|
||||
}
|
||||
}
|
||||
|
||||
pub(crate) fn post_order_iter<'a>(term: &'a Term) -> QueryIterator<'a> {
|
||||
pub fn post_order_iter(term: &Term) -> QueryIterator {
|
||||
QueryIterator::from_term(term)
|
||||
}
|
||||
|
||||
pub(crate) fn breadth_first_iter<'a>(
|
||||
term: &'a Term,
|
||||
iterable_root: RootIterationPolicy,
|
||||
) -> FactIterator<'a> {
|
||||
pub fn breadth_first_iter(term: &Term, iterable_root: bool) -> 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) struct ClauseIterator<'a> {
|
||||
state_stack: Vec<ClauseIteratorState<'a>>,
|
||||
remaining_chunks_on_stack: usize,
|
||||
pub enum ChunkedTerm<'a> {
|
||||
HeadClause(ClauseName, &'a Vec<Box<Term>>),
|
||||
BodyTerm(&'a QueryTerm),
|
||||
}
|
||||
|
||||
fn state_from_chunked_terms<'a>(chunk_vec: &'a VecDeque<ChunkedTerms>) -> ClauseIteratorState<'a> {
|
||||
if chunk_vec.len() == 1 {
|
||||
if let Some(ChunkedTerms::Branch(ref branches)) = chunk_vec.front() {
|
||||
return ClauseIteratorState::RemainingBranches(branches, 0);
|
||||
pub fn query_term_post_order_iter<'a>(query_term: &'a QueryTerm) -> QueryIterator<'a> {
|
||||
QueryIterator::new(query_term)
|
||||
}
|
||||
|
||||
impl<'a> ChunkedTerm<'a> {
|
||||
pub fn post_order_iter(&self) -> QueryIterator<'a> {
|
||||
match self {
|
||||
&ChunkedTerm::BodyTerm(ref qt) => QueryIterator::new(qt),
|
||||
&ChunkedTerm::HeadClause(_, terms) => QueryIterator::from_rule_head_clause(terms),
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fn contains_cut_var<'a, Iter: Iterator<Item = &'a Term>>(terms: Iter) -> bool {
|
||||
for term in terms {
|
||||
if let &Term::Var(_, ref var) = term {
|
||||
if var.as_str() == "!" {
|
||||
return true;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
ClauseIteratorState::RemainingChunks(chunk_vec, 0)
|
||||
false
|
||||
}
|
||||
|
||||
impl<'a> ClauseIterator<'a> {
|
||||
pub fn new(clauses: &'a ChunkedTermVec) -> Self {
|
||||
match state_from_chunked_terms(&clauses.chunk_vec) {
|
||||
state @ ClauseIteratorState::RemainingBranches(..) => Self {
|
||||
state_stack: vec![state],
|
||||
remaining_chunks_on_stack: 0,
|
||||
},
|
||||
state @ ClauseIteratorState::RemainingChunks(..) => Self {
|
||||
state_stack: vec![state],
|
||||
remaining_chunks_on_stack: 1,
|
||||
},
|
||||
pub struct ChunkedIterator<'a> {
|
||||
pub 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>>);
|
||||
type RuleBodyIteratorItem<'a> = (usize, usize, Vec<&'a QueryTerm>);
|
||||
|
||||
impl<'a> ChunkedIterator<'a> {
|
||||
pub fn rule_body_iter(self) -> Box<dyn Iterator<Item = RuleBodyIteratorItem<'a>> + 'a> {
|
||||
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 fn from_term_sequence(terms: &'a [QueryTerm]) -> Self {
|
||||
ChunkedIterator {
|
||||
chunk_num: 0,
|
||||
iter: Box::new(terms.iter().map(|t| ChunkedTerm::BodyTerm(t))),
|
||||
deep_cut_encountered: false,
|
||||
cut_var_in_head: false,
|
||||
}
|
||||
}
|
||||
|
||||
#[inline(always)]
|
||||
pub fn in_tail_position(&self) -> bool {
|
||||
self.remaining_chunks_on_stack == 0
|
||||
pub 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,
|
||||
}
|
||||
}
|
||||
|
||||
fn branch_end_depth(&mut self) -> usize {
|
||||
let mut depth = 1;
|
||||
pub fn from_rule(rule: &'a Rule) -> Self {
|
||||
let &Rule {
|
||||
head: (ref name, ref args, ref p1),
|
||||
ref clauses,
|
||||
} = rule;
|
||||
|
||||
while let Some(state) = self.state_stack.pop() {
|
||||
match state {
|
||||
ClauseIteratorState::RemainingBranches(terms, focus) if terms.len() == focus => {
|
||||
depth += 1;
|
||||
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 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().map(|t| t.as_ref())) {
|
||||
self.cut_var_in_head = true;
|
||||
}
|
||||
|
||||
result.push(term);
|
||||
}
|
||||
_ => {
|
||||
self.state_stack.push(state);
|
||||
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(..)) => 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();
|
||||
}
|
||||
|
||||
depth
|
||||
let chunk_num = self.chunk_num;
|
||||
self.chunk_num += 1;
|
||||
|
||||
(chunk_num, arity, result)
|
||||
}
|
||||
}
|
||||
|
||||
impl<'a> Iterator for ClauseIterator<'a> {
|
||||
type Item = ClauseItem<'a>;
|
||||
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> {
|
||||
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
|
||||
self.iter.next().map(|term| self.take_chunk(term))
|
||||
}
|
||||
}
|
||||
|
||||
57
src/lib.rs
57
src/lib.rs
@@ -1,57 +0,0 @@
|
||||
#![recursion_limit = "4112"]
|
||||
|
||||
#[macro_use]
|
||||
extern crate static_assertions;
|
||||
#[cfg(test)]
|
||||
#[macro_use] extern crate maplit;
|
||||
|
||||
#[macro_use]
|
||||
pub mod macros;
|
||||
#[macro_use]
|
||||
pub mod atom_table;
|
||||
#[macro_use]
|
||||
pub mod arena;
|
||||
#[macro_use]
|
||||
pub mod parser;
|
||||
mod allocator;
|
||||
mod arithmetic;
|
||||
pub mod codegen;
|
||||
mod debray_allocator;
|
||||
#[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"));
|
||||
}
|
||||
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::*;
|
||||
|
||||
let mut wam = Machine::with_test_streams();
|
||||
let bytes = wam.test_load_string(s);
|
||||
String::from_utf8_lossy(&bytes).to_string()
|
||||
}
|
||||
@@ -1,20 +1,11 @@
|
||||
/** 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,
|
||||
:- module(arithmetic, [expmod/4, lsb/2, msb/2, number_to_rational/2,
|
||||
number_to_rational/3,
|
||||
rational_numerator_denominator/3]).
|
||||
|
||||
:- use_module(library(charsio), [write_term_to_chars/3]).
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(lists), [append/3, member/2]).
|
||||
|
||||
|
||||
%% expmod(+Base, +Expo, +Mod, -R).
|
||||
%
|
||||
% 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) ->
|
||||
@@ -37,25 +28,6 @@ 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)
|
||||
@@ -65,9 +37,6 @@ 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)
|
||||
@@ -83,9 +52,6 @@ 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
|
||||
@@ -128,6 +94,12 @@ number_to_rational(Eps0, Real0, Fraction) :-
|
||||
),
|
||||
!.
|
||||
|
||||
number(X) :-
|
||||
( integer(X)
|
||||
; float(X)
|
||||
; rational(X)
|
||||
).
|
||||
|
||||
stern_brocot_(Qnn/Qnd, Qpn/Qpd, A/B, C/D, Fraction) :-
|
||||
Fn1 is A + C,
|
||||
Fd1 is B + D,
|
||||
@@ -144,20 +116,8 @@ 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).
|
||||
|
||||
132
src/lib/assoc.pl
132
src/lib/assoc.pl
@@ -54,27 +54,31 @@
|
||||
|
||||
:- use_module(library(lists)).
|
||||
|
||||
/** Binary associations
|
||||
/** <module> Binary associations
|
||||
|
||||
Assocs are Key-Value associations implemented as a balanced binary tree
|
||||
(AVL tree).
|
||||
|
||||
Authors: R.A.O'Keefe, L.Damas, V.S.Costa and Jan Wielemaker
|
||||
@see library(pairs), library(rbtrees)
|
||||
@author R.A.O'Keefe, L.Damas, V.S.Costa and Jan Wielemaker
|
||||
*/
|
||||
|
||||
:- meta_predicate map_assoc(1, ?).
|
||||
:- meta_predicate map_assoc(2, ?, ?).
|
||||
/*
|
||||
:- meta_predicate
|
||||
map_assoc(1, ?),
|
||||
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
|
||||
% in Pairs are sorted in ascending order.
|
||||
% Translate Assoc to a list Pairs of Key-Value pairs. The keys
|
||||
% in Pairs are sorted in ascending order.
|
||||
|
||||
assoc_to_list(Assoc, List) :-
|
||||
assoc_to_list(Assoc, List, []).
|
||||
@@ -85,10 +89,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
|
||||
% in ascending order.
|
||||
% True if Keys is the list of keys in Assoc. The keys are sorted
|
||||
% in ascending order.
|
||||
|
||||
assoc_to_keys(Assoc, List) :-
|
||||
assoc_to_keys(Assoc, List, []).
|
||||
@@ -99,11 +103,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
|
||||
% ordered in ascending order of the key to which they were
|
||||
% associated. Values may contain duplicates.
|
||||
% True if Values is the list of values in Assoc. Values are
|
||||
% ordered in ascending order of the key to which they were
|
||||
% associated. Values may contain duplicates.
|
||||
|
||||
assoc_to_values(Assoc, List) :-
|
||||
assoc_to_values(Assoc, List, []).
|
||||
@@ -113,12 +117,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
|
||||
% that the structure is valid, elements are in order, and tree
|
||||
% is balanced to the extent guaranteed by AVL trees. I.e.,
|
||||
% branches of each subtree differ in depth by at most 1.
|
||||
% True if Assoc is an association list. This predicate checks
|
||||
% that the structure is valid, elements are in order, and tree
|
||||
% is balanced to the extent guaranteed by AVL trees. I.e.,
|
||||
% branches of each subtree differ in depth by at most 1.
|
||||
|
||||
is_assoc(Assoc) :-
|
||||
is_assoc(Assoc, _Min, _Max, _Depth).
|
||||
@@ -150,10 +154,12 @@ 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
|
||||
% ascending order on backtracking.
|
||||
% True if Key-Value is an association in Assoc. Enumerates keys in
|
||||
% ascending order on backtracking.
|
||||
%
|
||||
% @see get_assoc/3.
|
||||
|
||||
gen_assoc(Key, Assoc, Value) :-
|
||||
( ground(Key)
|
||||
@@ -168,11 +174,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.
|
||||
%
|
||||
% Throws error: `type_error(assoc, Assoc)` if Assoc is not an association list.
|
||||
% @error type_error(assoc, Assoc) if Assoc is not an association list.
|
||||
|
||||
get_assoc(Key, Assoc, Val) :-
|
||||
must_be(assoc, Assoc),
|
||||
@@ -198,9 +204,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),
|
||||
@@ -213,12 +219,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
|
||||
% must not contain duplicate keys.
|
||||
% Create an association from a list Pairs of Key-Value pairs. List
|
||||
% must not contain duplicate keys.
|
||||
%
|
||||
% Throws error: `domain_error(unique_key_pairs, List)` if List contains duplicate keys
|
||||
% @error domain_error(unique_key_pairs, List) if List contains duplicate keys
|
||||
|
||||
list_to_assoc(List, Assoc) :-
|
||||
( List = [] -> Assoc = t
|
||||
@@ -243,13 +249,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
|
||||
% pairs. The pairs must occur in strictly ascending order of
|
||||
% their keys.
|
||||
% Assoc is created from an ordered list Pairs of Key-Value
|
||||
% pairs. The pairs must occur in strictly ascending order of
|
||||
% their keys.
|
||||
%
|
||||
% Throws error: `domain_error(key_ordered_pairs, List)` if pairs are not ordered.
|
||||
% @error domain_error(key_ordered_pairs, List) if pairs are not ordered.
|
||||
|
||||
ord_list_to_assoc(Sorted, Assoc) :-
|
||||
( Sorted = [] -> Assoc = t
|
||||
@@ -260,9 +266,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).
|
||||
@@ -271,9 +277,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).
|
||||
@@ -284,10 +290,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
|
||||
% applied to all corresponding pairs of of values.
|
||||
% Map corresponding values. True if Assoc is Assoc0 with Pred
|
||||
% applied to all corresponding pairs of of values.
|
||||
|
||||
map_assoc(Pred, T0, T) :-
|
||||
map_assoc_(T0, Pred, T).
|
||||
@@ -299,9 +305,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).
|
||||
@@ -311,9 +317,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).
|
||||
@@ -323,10 +329,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
|
||||
% Value. This can be used to insert and change associations.
|
||||
% Assoc is Assoc0, except that Key is associated with
|
||||
% Value. This can be used to insert and change associations.
|
||||
|
||||
put_assoc(Key, A0, Value, A) :-
|
||||
insert(A0, Key, Value, A, _).
|
||||
@@ -358,11 +364,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.
|
||||
% Assoc is Assoc0 with Key-Value removed. Warning: This will
|
||||
% succeed with _no_ bindings for Key or Val if Assoc0 is empty.
|
||||
% True if Key-Value is in Assoc0 and Key is the smallest key.
|
||||
% Assoc is Assoc0 with Key-Value removed. Warning: This will
|
||||
% 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).
|
||||
@@ -372,11 +378,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.
|
||||
% Assoc is Assoc0 with Key-Value removed. Warning: This will
|
||||
% succeed with _no_ bindings for Key or Val if Assoc0 is empty.
|
||||
% True if Key-Value is in Assoc0 and Key is the greatest key.
|
||||
% Assoc is Assoc0 with Key-Value removed. Warning: This will
|
||||
% 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).
|
||||
@@ -386,10 +392,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
|
||||
% Key-Value removed.
|
||||
% True if Key-Value is in Assoc0. Assoc is Assoc0 with
|
||||
% Key-Value removed.
|
||||
|
||||
del_assoc(Key, A0, Value, A) :-
|
||||
delete(A0, Key, Value, A, _).
|
||||
|
||||
184
src/lib/atts.pl
184
src/lib/atts.pl
@@ -1,6 +1,10 @@
|
||||
:- module(atts, [op(1199, fx, attribute),
|
||||
call_residue_vars/2,
|
||||
term_attributed_variables/2]).
|
||||
:- module(atts, [op(1199, fx, attribute), call_residue_vars/2,
|
||||
term_attributed_variables/2,
|
||||
'$absent_attr'/2, '$copy_attr_list'/2, '$get_attr'/2,
|
||||
'$put_attr'/2, '$absent_from_list'/2,
|
||||
'$get_from_list'/3, '$add_to_list'/3, '$del_attr'/3,
|
||||
'$del_attr_step'/3, '$del_attr_buried'/4,
|
||||
'$default_attr_list'/4]).
|
||||
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(terms)).
|
||||
@@ -15,93 +19,135 @@
|
||||
).
|
||||
|
||||
'$default_attr_list'([PG | PGs], Module, AttrVar) -->
|
||||
[Module:put_atts(AttrVar, PG)],
|
||||
( { '$module_of'(Module, PG) } -> [Module:put_atts(AttrVar, PG)]
|
||||
; { true }
|
||||
),
|
||||
'$default_attr_list'(PGs, Module, AttrVar).
|
||||
'$default_attr_list'([], _, _) --> [].
|
||||
|
||||
'$absent_attr'(V, Module, Attr) :-
|
||||
( '$get_from_attr_list'(V, Module, Attr) ->
|
||||
false
|
||||
; true
|
||||
'$absent_attr'(V, Attr) :-
|
||||
'$get_attr_list'(V, Ls),
|
||||
'$absent_from_list'(Ls, Attr).
|
||||
|
||||
'$absent_from_list'(X, Attr) :-
|
||||
( var(X) -> true
|
||||
; X = [L|Ls], L \= Attr -> '$absent_from_list'(Ls, Attr)
|
||||
).
|
||||
|
||||
'$copy_attr_list'(L, _Module, []) :- var(L), !.
|
||||
'$copy_attr_list'([Module0:Att|Atts], Module, CopiedAtts) :-
|
||||
( Module0 == Module ->
|
||||
CopiedAtts = [Att|CopiedAtts0],
|
||||
'$copy_attr_list'(Atts, Module, CopiedAtts0)
|
||||
; '$copy_attr_list'(Atts, Module, CopiedAtts)
|
||||
'$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, []) :- var(L), !.
|
||||
'$copy_attr_list'([Att|Atts], [Att|CopiedAtts]) :-
|
||||
'$copy_attr_list'(Atts, CopiedAtts).
|
||||
|
||||
user:term_expansion(Term0, Terms) :-
|
||||
nonvar(Term0),
|
||||
Term0 = (:- attribute Atts),
|
||||
nonvar(Atts),
|
||||
prolog_load_context(module, Module),
|
||||
phrase(expand_terms(Atts, Module), Terms).
|
||||
phrase(expand_terms(Atts), Terms).
|
||||
|
||||
expand_terms(Atts, Module) -->
|
||||
expand_terms(Atts) -->
|
||||
put_attrs_var_check,
|
||||
put_attrs(Atts, Module),
|
||||
get_attrs_var_check(Module),
|
||||
get_attrs(Atts, Module).
|
||||
put_attrs(Atts),
|
||||
get_attrs_var_check,
|
||||
get_attrs(Atts).
|
||||
|
||||
put_attrs_var_check -->
|
||||
[(put_atts(Var, Attr) :- nonvar(Var),
|
||||
throw(error(uninstantiation_error(Var), put_atts/2))),
|
||||
(put_atts(Var, Attr) :- var(Attr),
|
||||
throw(error(instantiation_error, put_atts/2)))].
|
||||
{ numbervars([Var, Attr], 0, _) },
|
||||
[(put_atts(Var, Attr) :- nonvar(Var), throw(error(type_error(variable, Var), put_atts/2))),
|
||||
(put_atts(Var, Attr) :- var(Attr), throw(error(instantiation_error, put_atts/2)))].
|
||||
|
||||
get_attrs_var_check(Module) -->
|
||||
[(get_atts(Var, Attr) :- nonvar(Var),
|
||||
throw(error(uninstantiation_error(Var), get_atts/2))),
|
||||
(get_atts(Var, Attr) :- var(Attr),
|
||||
!,
|
||||
'$get_attr_list'(Var, Ls),
|
||||
nonvar(Ls),
|
||||
atts:'$copy_attr_list'(Ls, Module, Attr))].
|
||||
get_attrs_var_check -->
|
||||
{ numbervars([Var, Ls, Attr], 0, _) },
|
||||
[(get_atts(Var, Attr) :- nonvar(Var), throw(error(type_error(variable, Var), get_atts/2))),
|
||||
(get_atts(Var, Attr) :- var(Attr), !, '$get_attr_list'(Var, Ls), nonvar(Ls),
|
||||
'$copy_attr_list'(Ls, Attr))].
|
||||
|
||||
put_attrs(Name/Arity, Module) -->
|
||||
put_attr(Name, Arity, Module),
|
||||
[(put_atts(Var, Attr) :- lists:maplist(Module:put_atts(Var), Attr), !)].
|
||||
put_attrs((Name/Arity, Atts), Module) -->
|
||||
put_attrs(Name/Arity) -->
|
||||
put_attr(Name, Arity),
|
||||
{ numbervars([Var, Attr], 0, _) },
|
||||
[(put_atts(Var, Attr) :- lists:maplist(put_atts(Var), Attr), !)].
|
||||
put_attrs((Name/Arity, Atts)) -->
|
||||
{ nonvar(Atts) },
|
||||
put_attr(Name, Arity, Module),
|
||||
put_attrs(Atts, Module).
|
||||
put_attr(Name, Arity),
|
||||
put_attrs(Atts).
|
||||
|
||||
get_attrs(Name/Arity, Module) -->
|
||||
get_attr(Name, Arity, Module).
|
||||
get_attrs((Name/Arity, Atts), Module) -->
|
||||
get_attrs(Name/Arity) -->
|
||||
get_attr(Name, Arity).
|
||||
get_attrs((Name/Arity, Atts)) -->
|
||||
{ nonvar(Atts) },
|
||||
get_attr(Name, Arity, Module),
|
||||
get_attrs(Atts, Module).
|
||||
get_attr(Name, Arity),
|
||||
get_attrs(Atts).
|
||||
|
||||
put_attr(Name, Arity, Module) -->
|
||||
{ functor(Attr, Name, Arity) },
|
||||
[(put_atts(V, +Attr) :-
|
||||
!,
|
||||
'$put_to_attr_list'(V, Module, Attr)),
|
||||
(put_atts(V, Attr) :-
|
||||
!,
|
||||
'$put_to_attr_list'(V, Module, Attr)),
|
||||
(put_atts(V, -Attr) :-
|
||||
!,
|
||||
'$del_from_attr_list'(V, Module, Attr))].
|
||||
put_attr(Name, Arity) -->
|
||||
{ functor(Attr, Name, Arity),
|
||||
numbervars(Attr, 0, Arity),
|
||||
V = '$VAR'(Arity) },
|
||||
[(put_atts(V, +Attr) :- !, functor(Attr, Head, Arity),
|
||||
functor(AttrForm, Head, Arity),
|
||||
'$get_attr_list'(V, Ls),
|
||||
'$del_attr'(Ls, V, AttrForm),
|
||||
'$put_attr'(V, Attr)),
|
||||
(put_atts(V, Attr) :- !, functor(Attr, Head, Arity),
|
||||
functor(AttrForm, Head, Arity),
|
||||
'$get_attr_list'(V, Ls),
|
||||
'$del_attr'(Ls, V, AttrForm),
|
||||
'$put_attr'(V, Attr)),
|
||||
(put_atts(V, -Attr) :- !, functor(Attr, _, _),
|
||||
'$get_attr_list'(V, Ls),
|
||||
'$del_attr'(Ls, V, Attr))].
|
||||
|
||||
get_attr(Name, Arity, Module) -->
|
||||
{ functor(Attr, Name, Arity) },
|
||||
[(get_atts(V, +Attr) :-
|
||||
!,
|
||||
functor(Attr, _, _),
|
||||
atts:'$get_from_attr_list'(V, Module, Attr)),
|
||||
(get_atts(V, Attr) :-
|
||||
!,
|
||||
functor(Attr, _, _),
|
||||
atts:'$get_from_attr_list'(V, Module, Attr)),
|
||||
(get_atts(V, -Attr) :-
|
||||
!,
|
||||
functor(Attr, _, _),
|
||||
atts:'$absent_attr'(V, Module, Attr))].
|
||||
get_attr(Name, Arity) -->
|
||||
{ functor(Attr, Name, Arity),
|
||||
numbervars(Attr, 0, Arity),
|
||||
V = '$VAR'(Arity) },
|
||||
[(get_atts(V, +Attr) :- !, functor(Attr, _, _), '$get_attr'(V, Attr)),
|
||||
(get_atts(V, Attr) :- !, functor(Attr, _, _), '$get_attr'(V, Attr)),
|
||||
(get_atts(V, -Attr) :- !, functor(Attr, _, _), '$absent_attr'(V, Attr))].
|
||||
|
||||
user:goal_expansion(Term, M:put_atts(Var, Attr)) :-
|
||||
nonvar(Term),
|
||||
@@ -110,8 +156,6 @@ 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),
|
||||
|
||||
@@ -1,10 +1,3 @@
|
||||
/** 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.
|
||||
@@ -12,24 +5,6 @@ integers that may also be interesting.
|
||||
:- 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),
|
||||
@@ -37,27 +12,21 @@ between(Lower, Upper, X) :-
|
||||
( nonvar(X) ->
|
||||
Lower =< X,
|
||||
X =< Upper
|
||||
; Lower =< Upper,
|
||||
between_(Lower, Upper, X)
|
||||
; between_(Lower, Upper, X)
|
||||
).
|
||||
|
||||
between_(Lower, Upper, Lower1) :-
|
||||
Lower < Upper,
|
||||
!,
|
||||
( Lower1 = Lower
|
||||
; Lower0 is Lower + 1,
|
||||
between_(Lower0, Upper, Lower1)
|
||||
).
|
||||
between_(Lower, Lower, Lower).
|
||||
between_(Lower, Upper, Lower) :-
|
||||
Lower =< Upper.
|
||||
between_(Lower1, Upper, X) :-
|
||||
Lower1 < Upper,
|
||||
Lower2 is Lower1 + 1,
|
||||
between_(Lower2, Upper, X).
|
||||
|
||||
enumerate_nats(I, I).
|
||||
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)
|
||||
@@ -72,9 +41,6 @@ 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)
|
||||
@@ -86,24 +52,9 @@ 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)
|
||||
@@ -152,14 +103,5 @@ 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).
|
||||
|
||||
2174
src/lib/builtins.pl
2174
src/lib/builtins.pl
File diff suppressed because it is too large
Load Diff
@@ -1,18 +1,8 @@
|
||||
/** 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,
|
||||
get_line_to_chars/3,
|
||||
read_from_chars/2,
|
||||
read_term_from_chars/3,
|
||||
read_line_to_chars/3,
|
||||
read_term_from_chars/2,
|
||||
write_term_to_chars/3,
|
||||
chars_base64/3]).
|
||||
|
||||
@@ -20,7 +10,6 @@ read and write chars.
|
||||
:- use_module(library(iso_ext)).
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(iso_ext), [partial_string/1,partial_string/3]).
|
||||
|
||||
fabricate_var_name(VarType, VarName, N) :-
|
||||
char_code('A', AC),
|
||||
@@ -64,7 +53,7 @@ extend_var_list(Vars, VarList, NewVarList, VarType) :-
|
||||
extend_var_list_(Vars, 0, VarList, NewVarList0, VarType),
|
||||
append(VarList, NewVarList0, NewVarList).
|
||||
|
||||
extend_var_list_([], _, _, [], _).
|
||||
extend_var_list_([], _, VarList, [], _).
|
||||
extend_var_list_([V|Vs], N, VarList, NewVarList, VarType) :-
|
||||
( var_list_contains_variable(VarList, V) ->
|
||||
extend_var_list_(Vs, N, VarList, NewVarList, VarType)
|
||||
@@ -74,65 +63,9 @@ extend_var_list_([V|Vs], N, VarList, NewVarList, VarType) :-
|
||||
).
|
||||
|
||||
|
||||
%% char_type(+Char, -Type).
|
||||
%
|
||||
% Given a Char, Type is one of the categories that char fits in.
|
||||
% 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),
|
||||
( var(Char) -> instantiation_error(char_type/2)
|
||||
; atom_length(Char, 1) ->
|
||||
( ground(Type) ->
|
||||
( ctype(Type) ->
|
||||
'$char_type'(Char, Type)
|
||||
@@ -140,13 +73,14 @@ char_type(Char, Type) :-
|
||||
)
|
||||
; ctype(Type),
|
||||
'$char_type'(Char, Type)
|
||||
).
|
||||
)
|
||||
; type_error(in_character, Char, char_type/2)
|
||||
).
|
||||
|
||||
|
||||
ctype(alnum).
|
||||
ctype(alpha).
|
||||
ctype(alphabetic).
|
||||
ctype(alphanumeric).
|
||||
ctype(ascii).
|
||||
ctype(ascii_graphic).
|
||||
ctype(ascii_punctuation).
|
||||
@@ -155,81 +89,48 @@ ctype(control).
|
||||
ctype(decimal_digit).
|
||||
ctype(exponent).
|
||||
ctype(graphic).
|
||||
ctype(graphic_token).
|
||||
ctype(hexadecimal_digit).
|
||||
ctype(layout).
|
||||
ctype(lower).
|
||||
ctype(meta).
|
||||
ctype(numeric).
|
||||
ctype(octal_digit).
|
||||
ctype(octet).
|
||||
ctype(prolog).
|
||||
ctype(sign).
|
||||
ctype(solo).
|
||||
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),
|
||||
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).
|
||||
read_term_from_chars(Chars, Term) :-
|
||||
( var(Chars) ->
|
||||
instantiation_error(read_term_from_chars/2)
|
||||
; nonvar(Term) ->
|
||||
throw(error(uninstantiation_error(Term), read_term_from_chars/2))
|
||||
; '$skip_max_list'(_, -1, Chars, Chars0),
|
||||
Chars0 == [],
|
||||
partial_string(Chars) ->
|
||||
true
|
||||
;
|
||||
type_error(complete_string, Chars, read_term_from_chars/2)
|
||||
),
|
||||
'$read_term_from_chars'(Chars, Term).
|
||||
|
||||
|
||||
%% write_term_to_chars(+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,
|
||||
[DoubleQuotes, IgnoreOps, MaxDepth, NumberVars, Quoted, VNNames],
|
||||
[IgnoreOps, MaxDepth, NumberVars, Quoted, VNNames],
|
||||
write_term_to_chars/3),
|
||||
( nonvar(Chars) ->
|
||||
throw(error(uninstantiation_error(Chars), write_term_to_chars/3))
|
||||
@@ -238,7 +139,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, DoubleQuotes).
|
||||
'$write_term_to_chars'(Chars, Term, IgnoreOps, NumberVars, Quoted, NewVarNames, MaxDepth).
|
||||
|
||||
% Encodes Ch character to list of Bytes.
|
||||
char_utf8bytes(Ch, Bytes) :-
|
||||
@@ -258,17 +159,6 @@ 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))
|
||||
@@ -295,66 +185,36 @@ 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).
|
||||
%
|
||||
% 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) :-
|
||||
|
||||
read_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
|
||||
; get_line_to_chars(Stream, Rest, Cs)
|
||||
; read_line_to_chars(Stream, Rest, Cs)
|
||||
)
|
||||
).
|
||||
|
||||
%% get_n_chars(+Stream, ?N, -Chars).
|
||||
%
|
||||
% Read N chars from stream Stream. N can be an integer, in that case
|
||||
% only N chars are read, or a variable, unifying N with the number of chars
|
||||
% read until it found EOF.
|
||||
get_n_chars(Stream, N, Cs) :-
|
||||
can_be(integer, N),
|
||||
( var(N) ->
|
||||
get_to_eof(Stream, Cs),
|
||||
length(Cs, N)
|
||||
; N >= 0,
|
||||
'$get_n_chars'(Stream, N, Cs)
|
||||
).
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Relation between a list of characters Cs and its Base64 encoding Bs,
|
||||
also a list of characters.
|
||||
|
||||
get_n_chars_wrapper(Stream, N, Cs) :-
|
||||
'$get_n_chars'(Stream, N, Cs).
|
||||
At least one of the arguments must be instantiated.
|
||||
|
||||
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),
|
||||
get_to_eof(Stream, Rest)
|
||||
).
|
||||
Options are:
|
||||
|
||||
%% chars_base64(?Chars, ?Base64, +Options).
|
||||
%
|
||||
% 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.
|
||||
%
|
||||
% Options are:
|
||||
%
|
||||
% - `padding(Boolean)`
|
||||
% Whether to use padding: true (the default) or false.
|
||||
% - `charset(C)`
|
||||
% Either 'standard' (RFC 4648 §4, the default) or 'url' (RFC 4648 §5).
|
||||
%
|
||||
% Example:
|
||||
%
|
||||
% ```
|
||||
% ?- chars_base64("hello", Bs, []).
|
||||
% Bs = "aGVsbG8=".
|
||||
% ```
|
||||
- padding(Boolean)
|
||||
Whether to use padding: true (the default) or false.
|
||||
- charset(C)
|
||||
Either 'standard' (RFC 4648 §4, the default) or 'url' (RFC 4648 §5).
|
||||
|
||||
Example:
|
||||
|
||||
?- chars_base64("hello", Bs, []).
|
||||
Bs = "aGVsbG8="
|
||||
; false.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
chars_base64(Cs, Bs, Options) :-
|
||||
must_be(list, Options),
|
||||
@@ -373,11 +233,10 @@ chars_base64(Cs, Bs, Options) :-
|
||||
; domain_error(charset, Charset, chars_base64/3)
|
||||
),
|
||||
( var(Cs) ->
|
||||
must_be(chars, Bs),
|
||||
must_be(list, Bs),
|
||||
maplist(must_be(character), Bs),
|
||||
'$chars_base64'(Cs, Bs, Padding, Charset)
|
||||
; must_be(list, Cs),
|
||||
maplist(must_be(character), Cs),
|
||||
'$chars_base64'(Cs, Bs, Padding, Charset)
|
||||
; must_be(chars, Cs),
|
||||
( '$first_non_octet'(Cs, N) ->
|
||||
domain_error(octet_character, N, chars_base64/3)
|
||||
; '$chars_base64'(Cs, Bs, Padding, Charset)
|
||||
)
|
||||
).
|
||||
|
||||
471
src/lib/clpb.pl
471
src/lib/clpb.pl
@@ -1,29 +1,10 @@
|
||||
/* CLP(B): Constraint Logic Programming over Boolean Variables
|
||||
|
||||
Author: Markus Triska
|
||||
Copyright (C): 2019 Markus Triska
|
||||
All rights reserved.
|
||||
|
||||
E-mail: triska@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.
|
||||
WWW: http://www.metalevel.at
|
||||
|
||||
*/
|
||||
|
||||
@@ -36,8 +17,8 @@
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
:- module(clpb, [op(300, fy, ~),
|
||||
op(500, yfx, #),
|
||||
sat/1,
|
||||
op(500, yfx, #),
|
||||
sat/1,
|
||||
taut/2,
|
||||
labeling/1,
|
||||
sat_count/2,
|
||||
@@ -68,6 +49,17 @@
|
||||
Compatibility predicates.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
group_pairs_by_key([], []).
|
||||
group_pairs_by_key([M-N|T0], [M-[N|TN]|T]) :-
|
||||
same_key(M, T0, TN, T1),
|
||||
group_pairs_by_key(T1, T).
|
||||
|
||||
same_key(M0, [M-N|T0], [N|TN], T) :-
|
||||
M0 == M,
|
||||
!,
|
||||
same_key(M, T0, TN, T).
|
||||
same_key(_, L, [], L).
|
||||
|
||||
must_be(What, Term) :- must_be(What, unknown(Term)-1, Term).
|
||||
|
||||
must_be(acyclic, Where, Term) :- !,
|
||||
@@ -110,46 +102,6 @@ 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).
|
||||
@@ -164,262 +116,6 @@ 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:
|
||||
@@ -506,10 +202,6 @@ 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.
|
||||
@@ -1150,8 +842,9 @@ verify_attributes(Var, Other, Gs) :-
|
||||
( integer(Other) ->
|
||||
( between(0, 1, Other) ->
|
||||
root_get_formula_bdd(Root, Sat, BDD0),
|
||||
bdd_restriction(BDD0, I, Other, BDD),
|
||||
root_put_formula_bdd(Root, Sat, BDD),
|
||||
Gs = [bdd_restriction(BDD0,I,Other,BDD),satisfiable_bdd(BDD)]
|
||||
Gs = [satisfiable_bdd(BDD)]
|
||||
; no_truth_value(Other)
|
||||
)
|
||||
; atom(Other) ->
|
||||
@@ -1427,19 +1120,19 @@ indomain(1).
|
||||
%
|
||||
% Examples:
|
||||
%
|
||||
% ```
|
||||
% ==
|
||||
% ?- sat(A =< B), Vs = [A,B], sat_count(+[1|Vs], Count).
|
||||
% Vs = [A,B], Count = 3, clpb:sat(A=:=A*B).
|
||||
% Vs = [A, B],
|
||||
% Count = 3,
|
||||
% sat(A=:=A*B).
|
||||
%
|
||||
% ?- length(Vs, 120),
|
||||
% sat_count(+Vs, CountOr),
|
||||
% sat_count(*(Vs), CountAnd).
|
||||
% Vs = [...],
|
||||
% CountOr = 1329227995784915872903807060280344575,
|
||||
% CountAnd = 1.
|
||||
% ```
|
||||
|
||||
|
||||
% Vs = [...],
|
||||
% CountOr = 1329227995784915872903807060280344575,
|
||||
% CountAnd = 1.
|
||||
% ==
|
||||
|
||||
sat_count(Sat0, N) :-
|
||||
catch((parse_sat(Sat0, Sat),
|
||||
@@ -1565,7 +1258,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.
|
||||
%
|
||||
@@ -1574,10 +1267,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),
|
||||
@@ -1595,18 +1288,13 @@ weighted_maximum(Ws, Vars, Max) :-
|
||||
maplist(var_with_index, Vars, IVs),
|
||||
pairs_keys_values(Pairs0, IVs, Ws),
|
||||
keysort(Pairs0, Pairs1),
|
||||
% sum linear combinations of repeated variables
|
||||
group_pairs_by_key(Pairs1, Groups),
|
||||
maplist(group_sumweights_pair, Groups, Pairs2),
|
||||
pairs_keys_values(Pairs2, IVs1, WeightsIndexOrder),
|
||||
pairs_keys_values(Pairs1, IVs1, WeightsIndexOrder),
|
||||
pairs_values(IVs1, VarsIndexOrder),
|
||||
% Pairs is a list of Var-Weight terms, in index order of Vars
|
||||
pairs_keys_values(Pairs, VarsIndexOrder, WeightsIndexOrder),
|
||||
bdd_maximum(BDD, Pairs, Max),
|
||||
max_labeling(BDD, Pairs).
|
||||
|
||||
group_sumweights_pair((I-V)-Ws, (I-V)-W) :- sum_list(Ws, W).
|
||||
|
||||
max_labeling(1, Pairs) :- max_upto(Pairs, _, _).
|
||||
max_labeling(node(_,Var,Low,High,Aux), Pairs0) :-
|
||||
max_upto(Pairs0, Var, Pairs),
|
||||
@@ -1690,14 +1378,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)]
|
||||
; { phrase(sat_ands(Formula), Ands0),
|
||||
; { prepare_global_variables(BDD),
|
||||
phrase(sat_ands(Formula), Ands0),
|
||||
ands_fusion(Ands0, Ands),
|
||||
maplist(formula_anf, Ands, ANFs0),
|
||||
sort(ANFs0, ANFs1),
|
||||
@@ -1717,24 +1405,39 @@ 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_atom).
|
||||
del_attr(Var, clpb_hash).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
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.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
@@ -1826,8 +1529,8 @@ pairs_([], _) --> [].
|
||||
pairs_([B|Bs], A) --> [A-B], pairs_(Bs, A).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Assert clpb:clpb_residuals(bdd) to obtain the BDD nodes as
|
||||
residuals. Note that they cannot be used as regular goals.
|
||||
Set the Prolog flag clpb_residuals to bdd to obtain the BDD nodes
|
||||
as residuals. Note that they cannot be used as regular goals.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
nodes([]) --> [].
|
||||
@@ -1855,12 +1558,10 @@ sats([]) --> [].
|
||||
sats([A|As]) --> [clpb:sat(A)], sats(As).
|
||||
|
||||
booleans([]) --> [].
|
||||
booleans([B|Bs]) --> boolean(B), booleans(Bs).
|
||||
booleans([B|Bs]) --> boolean(B), { del_clpb(B) }, booleans(Bs).
|
||||
|
||||
boolean(Var) -->
|
||||
{ del_clpb(Var) },
|
||||
( { get_attr(Var, clpb_omit_boolean, true) } ->
|
||||
{ put_atts(Var, -clpb_omit_boolean(_)) }
|
||||
( { get_attr(Var, clpb_omit_boolean, true) } -> []
|
||||
; [clpb:sat(Var =:= Var)]
|
||||
).
|
||||
|
||||
@@ -1962,3 +1663,49 @@ 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).
|
||||
|
||||
2013
src/lib/clpz.pl
2013
src/lib/clpz.pl
File diff suppressed because it is too large
Load Diff
@@ -1,7 +1,5 @@
|
||||
:- module(cont, [reset/3, shift/1]).
|
||||
|
||||
:- meta_predicate reset(0, ?, ?).
|
||||
|
||||
reset(Goal, Ball, Cont) :-
|
||||
call(Goal),
|
||||
'$reset_cont_marker',
|
||||
@@ -13,7 +11,7 @@ shift(Ball) :-
|
||||
get_chunks(E, P, L),
|
||||
( L == [] ->
|
||||
Cont = cont(true)
|
||||
; Cont = cont(cont:call_continuation(L))
|
||||
; Cont = cont(call_continuation(L))
|
||||
),
|
||||
'$write_cont_and_term'(_, _, Cont, Ball),
|
||||
'$unwind_environments'.
|
||||
|
||||
@@ -1,20 +1,20 @@
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Written 2020-2023 by Markus Triska (triska@metalevel.at)
|
||||
Written May 2020 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
|
||||
Especially for cryptographic applications, it as an advantage that
|
||||
using strings leaves little trace of what was processed in the system.
|
||||
|
||||
For predicates that accept an `encoding/1` option to specify the encoding
|
||||
of the input data, if `encoding(octet)` is used, then the input can also
|
||||
be specified as a list of _bytes_, i.e., integers between 0 and 255.
|
||||
*/
|
||||
For predicates that accept an encoding/1 option to specify the encoding
|
||||
of the input data, if encoding(octet) is used, then the input can also
|
||||
be specified as a list of bytes, i.e., integers between 0 and 255.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
:- module(crypto,
|
||||
[hex_bytes/2, % ?Hex, ?Bytes
|
||||
@@ -46,26 +46,27 @@
|
||||
:- use_module(library(format)).
|
||||
:- use_module(library(charsio)).
|
||||
:- use_module(library(si)).
|
||||
:- use_module(library(iso_ext), [partial_string/3]).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
hex_bytes(?Hex, ?Bytes) is det.
|
||||
|
||||
Relation between a hexadecimal sequence and a list of bytes. Hex
|
||||
is a string of hexadecimal numbers. Bytes is a list of *integers*
|
||||
between 0 and 255 that represent the sequence as a list of bytes.
|
||||
At least one of the arguments must be instantiated.
|
||||
|
||||
Example:
|
||||
|
||||
?- hex_bytes("501ACE", Bs).
|
||||
Bs = [80,26,206]
|
||||
; false.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
%% hex_bytes(?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) ->
|
||||
must_be(chars, Hs),
|
||||
must_be(list, Hs),
|
||||
maplist(must_be(atom), Hs),
|
||||
( phrase(hex_bytes(Hs), Bytes) ->
|
||||
true
|
||||
; domain_error(hex_encoding, Hs, hex_bytes/2)
|
||||
@@ -103,62 +104,60 @@ must_be_bytes(Bytes, Context) :-
|
||||
).
|
||||
|
||||
|
||||
must_be_octet_chars(Chars, Context) :-
|
||||
must_be(chars, Chars),
|
||||
( '$first_non_octet'(Chars, F) ->
|
||||
domain_error(octet_character, F, Context)
|
||||
must_be_byte_chars(Chars, Context) :-
|
||||
must_be(list, Chars),
|
||||
( member(Char, Chars),
|
||||
char_code(Char, Code),
|
||||
\+ between(0, 255, Code) ->
|
||||
domain_error(byte_char, Char, Context)
|
||||
; true
|
||||
).
|
||||
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Cryptographically secure random numbers
|
||||
=======================================
|
||||
|
||||
crypto_n_random_bytes(+N, -Bytes) is det
|
||||
|
||||
Bytes is unified with a list of N cryptographically secure
|
||||
pseudo-random bytes. Each byte is an integer between 0 and 255. If
|
||||
the internal pseudo-random number generator (PRNG) has not been
|
||||
seeded with enough entropy to ensure an unpredictable byte
|
||||
sequence, an exception is thrown.
|
||||
|
||||
One way to relate such a list of bytes to an _integer_ is to use
|
||||
CLP(ℤ) constraints as follows:
|
||||
|
||||
:- use_module(library(clpz)).
|
||||
:- use_module(library(lists)).
|
||||
|
||||
bytes_integer(Bs, N) :-
|
||||
foldl(pow, Bs, 0-0, N-_).
|
||||
|
||||
pow(B, N0-I0, N-I) :-
|
||||
B in 0..255,
|
||||
N #= N0 + B*256^I0,
|
||||
I #= I0 + 1.
|
||||
|
||||
With this definition, we can generate a random 256-bit integer
|
||||
_from_ a list of 32 random _bytes_:
|
||||
|
||||
?- crypto_n_random_bytes(32, Bs),
|
||||
bytes_integer(Bs, I).
|
||||
Bs = [146,166,162,210,242,7,25,132,64,94|...],
|
||||
I = 337420085690608915485...(56 digits omitted)
|
||||
|
||||
The above relation also works in the other direction, letting you
|
||||
translate an integer _to_ a list of bytes. In addition, you can
|
||||
use hex_bytes/2 to convert bytes to _tokens_ that can be easily
|
||||
exchanged in your applications.
|
||||
|
||||
?- crypto_n_random_bytes(12, Bs),
|
||||
hex_bytes(Hex, Bs).
|
||||
Bs = [34,25,50,72,58,63,50,172,32,46|...], Hex = "221932483a3f32ac202 ..."
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
%% crypto_n_random_bytes(+N, -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),
|
||||
@@ -170,33 +169,30 @@ 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.
|
||||
|
||||
Example:
|
||||
|
||||
?- crypto_data_hash("abc", Hs, [algorithm(sha256)]).
|
||||
Hs = "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad"
|
||||
; false.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
SHA256 is the current default for several hash-related predicates.
|
||||
@@ -247,36 +243,38 @@ hash_algorithm(blake2s256).
|
||||
hash_algorithm(blake2b512).
|
||||
|
||||
|
||||
%% crypto_data_hkdf(+Data, +Length, -Bytes, +Options) is det.
|
||||
%
|
||||
% Concentrate possibly dispersed entropy of Data and then expand it
|
||||
% to the desired length. Data is a list of characters.
|
||||
%
|
||||
% Bytes is unified with a list of bytes of length Length, and is
|
||||
% suitable as input keying material and initialization vectors to
|
||||
% symmetric encryption algorithms.
|
||||
%
|
||||
% Admissible options are:
|
||||
%
|
||||
% - `algorithm(+Algorithm)`
|
||||
% One of `sha256`, `sha384` or `sha512`. If you specify a variable,
|
||||
% then it is unified with the algorithm that was used, which is a
|
||||
% cryptographically secure algorithm by default.
|
||||
% - `info(+Info)`
|
||||
% Optional context and application specific information,
|
||||
% specified as a list of characters. The default is `[]`.
|
||||
% - `salt(+List)`
|
||||
% Optionally, a list of bytes that are used as salt. The
|
||||
% default is all zeroes.
|
||||
% - `encoding(+Encoding)`
|
||||
% The default encoding is `utf8`. The alternative is `octet`,
|
||||
% to treat the input as a list of raw bytes.
|
||||
%
|
||||
% The `info/1` option can be used to generate multiple keys from a
|
||||
% single master key, using for example values such as "key" and
|
||||
% "iv", or the name of a file that is to be encrypted.
|
||||
%
|
||||
% See `crypto_n_random_bytes/2` to obtain a suitable salt.
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
crypto_data_hkdf(+Data, +Length, -Bytes, +Options) is det.
|
||||
|
||||
Concentrate possibly dispersed entropy of Data and then expand it
|
||||
to the desired length. Data is a list of characters.
|
||||
|
||||
Bytes is unified with a list of bytes of length Length, and is
|
||||
suitable as input keying material and initialization vectors to
|
||||
symmetric encryption algorithms.
|
||||
|
||||
Admissible options are:
|
||||
|
||||
- algorithm(+Algorithm)
|
||||
One of sha256, sha384 or sha512. If you specify a variable,
|
||||
then it is unified with the algorithm that was used, which is a
|
||||
cryptographically secure algorithm by default.
|
||||
- info(+Info)
|
||||
Optional context and application specific information,
|
||||
specified as a list of characters. The default is [].
|
||||
- salt(+List)
|
||||
Optionally, a list of bytes that are used as salt. The
|
||||
default is all zeroes.
|
||||
- encoding(+Encoding)
|
||||
The default encoding is utf8. The alternative is octet,
|
||||
to treat the input as a list of raw bytes.
|
||||
|
||||
The `info/1` option can be used to generate multiple keys from a
|
||||
single master key, using for example values such as "key" and
|
||||
"iv", or the name of a file that is to be encrypted.
|
||||
|
||||
See crypto_n_random_bytes/2 to obtain a suitable salt.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
crypto_data_hkdf(Data0, L, Bytes, Options0) :-
|
||||
functor_hash_options(algorithm, Algorithm, Options0, Options),
|
||||
@@ -284,7 +282,7 @@ crypto_data_hkdf(Data0, L, Bytes, Options0) :-
|
||||
; domain_error(hkdf_algorithm, Algorithm, crypto_data_hkdf/4)
|
||||
),
|
||||
must_be(integer, L),
|
||||
L #>= 0,
|
||||
L >= 0,
|
||||
options_data_chars(Options, Data0, Data, Encoding),
|
||||
option(salt(SaltBytes), Options, []),
|
||||
must_be_bytes(SaltBytes, crypto_data_hkdf/4),
|
||||
@@ -330,12 +328,14 @@ chars_bytes_(Cs, Bytes, Context) :-
|
||||
know if you need to rely on any specifics of this format.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
%% crypto_password_hash(+Password, ?Hash) is semidet.
|
||||
%
|
||||
% If Hash is instantiated, the predicate succeeds _iff_ the hash
|
||||
% matches the given password. Otherwise, the call is equivalent to
|
||||
% `crypto_password_hash(Password, Hash, [])` and computes a
|
||||
% password-based hash using the default options.
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
crypto_password_hash(+Password, ?Hash) is semidet.
|
||||
|
||||
If Hash is instantiated, the predicate succeeds _iff_ the hash
|
||||
matches the given password. Otherwise, the call is equivalent to
|
||||
crypto_password_hash(Password, Hash, []) and computes a
|
||||
password-based hash using the default options.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
crypto_password_hash(Password0, Hash) :-
|
||||
( nonvar(Hash) ->
|
||||
@@ -358,62 +358,64 @@ dollar_segments(Ls, Segments) :-
|
||||
).
|
||||
|
||||
|
||||
%% crypto_password_hash(+Password, -Hash, +Options) is det.
|
||||
%
|
||||
% Derive Hash based on Password. This predicate is similar to
|
||||
% `crypto_data_hash/3` in that it derives a hash from given data.
|
||||
% However, it is tailored for the specific use case of _passwords_.
|
||||
% One essential distinction is that for this use case, the derivation
|
||||
% of a hash should be _as slow as possible_ to counteract brute-force
|
||||
% attacks over possible passwords.
|
||||
%
|
||||
% Another important distinction is that equal passwords must yield,
|
||||
% with very high probability, _different_ hashes. For this reason,
|
||||
% cryptographically strong random numbers are automatically added to
|
||||
% the password before a hash is derived.
|
||||
%
|
||||
% Hash is unified with a string that contains the computed hash and
|
||||
% all parameters that were used, except for the password. Instead of
|
||||
% storing passwords, store these hashes. Later, you can verify the
|
||||
% validity of a password with `crypto_password_hash/2`, comparing the
|
||||
% then entered password to the stored hash. If you need to export this
|
||||
% atom, you should treat it as opaque ASCII data with up to 255 bytes
|
||||
% of length. The maximal length may increase in the future.
|
||||
%
|
||||
% Admissible options are:
|
||||
%
|
||||
% - `algorithm(+Algorithm)`
|
||||
% The algorithm to use. Currently, the only available algorithm
|
||||
% is `'pbkdf2-sha512'`, which is therefore also the default.
|
||||
% - `cost(+C)`
|
||||
% C is an integer, denoting the binary logarithm of the number
|
||||
% of _iterations_ used for the derivation of the hash. This
|
||||
% means that the number of iterations is set to 2^C. Currently,
|
||||
% the default is 17, and thus more than one hundred _thousand_
|
||||
% iterations. You should set this option as high as your server
|
||||
% and users can tolerate. The default is subject to change and
|
||||
% will likely increase in the future or adapt to new algorithms.
|
||||
% - `salt(+Salt)`
|
||||
% Use the given list of bytes as salt. By default,
|
||||
% cryptographically secure random numbers are generated for this
|
||||
% purpose. The default is intended to be secure, and constitutes
|
||||
% the typical use case of this predicate.
|
||||
%
|
||||
% Currently, PBKDF2 with SHA-512 is used as the hash derivation
|
||||
% function, using 128 bits of salt. All default parameters, including
|
||||
% the algorithm, are subject to change, and other algorithms will also
|
||||
% become available in the future. Since computed hashes store all
|
||||
% parameters that were used during their derivation, such changes will
|
||||
% not affect the operation of existing deployments. Note though that
|
||||
% new hashes will then be computed with the new default parameters.
|
||||
%
|
||||
% See `crypto_data_hkdf/4` for generating keys from Hash.
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
crypto_password_hash(+Password, -Hash, +Options) is det.
|
||||
|
||||
Derive Hash based on Password. This predicate is similar to
|
||||
crypto_data_hash/3 in that it derives a hash from given data.
|
||||
However, it is tailored for the specific use case of _passwords_.
|
||||
One essential distinction is that for this use case, the derivation
|
||||
of a hash should be _as slow as possible_ to counteract brute-force
|
||||
attacks over possible passwords.
|
||||
|
||||
Another important distinction is that equal passwords must yield,
|
||||
with very high probability, _different_ hashes. For this reason,
|
||||
cryptographically strong random numbers are automatically added to
|
||||
the password before a hash is derived.
|
||||
|
||||
Hash is unified with a string that contains the computed hash and
|
||||
all parameters that were used, except for the password. Instead of
|
||||
storing passwords, store these hashes. Later, you can verify the
|
||||
validity of a password with crypto_password_hash/2, comparing the
|
||||
then entered password to the stored hash. If you need to export this
|
||||
atom, you should treat it as opaque ASCII data with up to 255 bytes
|
||||
of length. The maximal length may increase in the future.
|
||||
|
||||
Admissible options are:
|
||||
|
||||
- algorithm(+Algorithm)
|
||||
The algorithm to use. Currently, the only available algorithm
|
||||
is 'pbkdf2-sha512', which is therefore also the default.
|
||||
- cost(+C)
|
||||
C is an integer, denoting the binary logarithm of the number
|
||||
of _iterations_ used for the derivation of the hash. This
|
||||
means that the number of iterations is set to 2^C. Currently,
|
||||
the default is 17, and thus more than one hundred _thousand_
|
||||
iterations. You should set this option as high as your server
|
||||
and users can tolerate. The default is subject to change and
|
||||
will likely increase in the future or adapt to new algorithms.
|
||||
- salt(+Salt)
|
||||
Use the given list of bytes as salt. By default,
|
||||
cryptographically secure random numbers are generated for this
|
||||
purpose. The default is intended to be secure, and constitutes
|
||||
the typical use case of this predicate.
|
||||
|
||||
Currently, PBKDF2 with SHA-512 is used as the hash derivation
|
||||
function, using 128 bits of salt. All default parameters, including
|
||||
the algorithm, are subject to change, and other algorithms will also
|
||||
become available in the future. Since computed hashes store all
|
||||
parameters that were used during their derivation, such changes will
|
||||
not affect the operation of existing deployments. Note though that
|
||||
new hashes will then be computed with the new default parameters.
|
||||
|
||||
See crypto_data_hkdf/4 for generating keys from Hash.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
crypto_password_hash(Password0, Hash, Options) :-
|
||||
chars_bytes_(Password0, Password, crypto_password_hash/3),
|
||||
must_be(list, Options),
|
||||
option(cost(C), Options, 17),
|
||||
Iterations #= 2^C,
|
||||
Iterations is 2^C,
|
||||
Algorithm = 'pbkdf2-sha512', % current default and only option
|
||||
option(algorithm(Algorithm), Options, Algorithm),
|
||||
( member(salt(SaltBytes), Options) ->
|
||||
@@ -438,94 +440,91 @@ bytes_base64(Bytes, Base64) :-
|
||||
chars_base64(Chars, Base64, [padding(false)])
|
||||
).
|
||||
|
||||
%% crypto_data_encrypt(+PlainText, +Algorithm, +Key, +IV, -CipherText, +Options).
|
||||
%
|
||||
% Encrypt the given PlainText, using the symmetric algorithm
|
||||
% Algorithm, key Key, and initialization vector (or nonce) IV, to
|
||||
% give CipherText.
|
||||
%
|
||||
% PlainText must be a list of characters, Key and IV must be lists of
|
||||
% bytes, and CipherText is created as a list of characters.
|
||||
%
|
||||
% Keys and IVs can be chosen at random (using for example
|
||||
% `crypto_n_random_bytes/2`) or derived from input keying material (IKM)
|
||||
% using for example `crypto_data_hkdf/4`. This input is often a shared
|
||||
% secret, such as a negotiated point on an elliptic curve, or the hash
|
||||
% that was computed from a password via `crypto_password_hash/3` with a
|
||||
% freshly generated and specified _salt_.
|
||||
%
|
||||
% Reusing the same combination of Key and IV typically leaks at least
|
||||
% _some_ information about the plaintext. For example, identical
|
||||
% plaintexts will then correspond to identical ciphertexts. For some
|
||||
% algorithms, reusing an IV with the same Key has disastrous results
|
||||
% and can cause the loss of all properties that are otherwise
|
||||
% guaranteed. Especially in such cases, an IV is also called a
|
||||
% _nonce_ (number used once).
|
||||
%
|
||||
% It is safe to store and transfer the used initialization vector (or
|
||||
% nonce) in plain text, but the key _must be kept secret_.
|
||||
%
|
||||
% Currently, the only supported algorithm is 'chacha20-poly1305', a
|
||||
% powerful and efficient _authenticated_ encryption scheme, providing
|
||||
% secrecy and at the same time reliable protection against undetected
|
||||
% _modifications_ of the encrypted data. This is a very good choice
|
||||
% for virtually all use cases. It is a stream cipher and can encrypt
|
||||
% data of any length up to 256 GB. Further, the encrypted data has
|
||||
% exactly the same length as the original, and no padding is used.
|
||||
%
|
||||
% Options:
|
||||
%
|
||||
% - `encoding(+Encoding)`
|
||||
% Encoding to use for PlainText. Default is utf8. The alternative
|
||||
% is octet to treat PlainText as raw bytes.
|
||||
%
|
||||
% - `tag(-List)`
|
||||
% For authenticated encryption schemes, List is unified with a
|
||||
% list of _bytes_ holding the tag. This tag must be provided for
|
||||
% decryption.
|
||||
%
|
||||
% - `aad(+Data)`
|
||||
% Data is additional authenticated data (AAD), a list of
|
||||
% characters. It is authenticated in that it influences the tag,
|
||||
% but it is not encrypted. The `encoding/1` option also specifies
|
||||
% the encoding of Data.
|
||||
%
|
||||
% Here is an example encryption and decryption, using the ChaCha20
|
||||
% stream cipher with the Poly1305 authenticator. This cipher uses a
|
||||
% 256-bit key and a 96-bit nonce, i.e., 32 and 12 _bytes_,
|
||||
% respectively:
|
||||
%
|
||||
% ```
|
||||
% ?- Algorithm = 'chacha20-poly1305',
|
||||
% crypto_n_random_bytes(32, Key),
|
||||
% crypto_n_random_bytes(12, IV),
|
||||
% crypto_data_encrypt("this text is to be encrypted", Algorithm,
|
||||
% Key, IV, CipherText, [tag(Tag)]),
|
||||
% crypto_data_decrypt(CipherText, Algorithm,
|
||||
% Key, IV, RecoveredText, [tag(Tag)]).
|
||||
% ```
|
||||
%
|
||||
% Yielding:
|
||||
%
|
||||
% ```
|
||||
% Algorithm = 'chacha20-poly1305',
|
||||
% Key = [113,247,153,134,177,220,13,193,50,150|...],
|
||||
% IV = [135,20,149,153,63,35,68,114,247,171|...],
|
||||
% CipherText = "\x94\0Ej\x94\®Â\x95\óÑÆXÃn¾ð©b\x1c\ ...",
|
||||
% RecoveredText = "this text is to be ...",
|
||||
% Tag = [152,117,152,17,162,75,150,206,144,40|...]
|
||||
% ```
|
||||
%
|
||||
% In this example, we use `crypto_n_random_bytes/2` to generate a key
|
||||
% and nonce from cryptographically secure random numbers. For
|
||||
% repeated applications, you must ensure that a nonce is only used
|
||||
% _once_ together with the same key. Note that for _authenticated_
|
||||
% encryption schemes, the _tag_ that was computed during encryption
|
||||
% is necessary for decryption. It is safe to store and transfer the
|
||||
% tag in plain text.
|
||||
%
|
||||
% See also `crypto_data_decrypt/6`, and `hex_bytes/2` for conversion
|
||||
% between bytes and hex encoding.
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
crypto_data_encrypt(+PlainText,
|
||||
+Algorithm,
|
||||
+Key,
|
||||
+IV,
|
||||
-CipherText,
|
||||
+Options).
|
||||
|
||||
Encrypt the given PlainText, using the symmetric algorithm
|
||||
Algorithm, key Key, and initialization vector (or nonce) IV, to
|
||||
give CipherText.
|
||||
|
||||
PlainText must be a list of characters, Key and IV must be lists of
|
||||
bytes, and CipherText is created as a list of characters.
|
||||
|
||||
Keys and IVs can be chosen at random (using for example
|
||||
crypto_n_random_bytes/2) or derived from input keying material (IKM)
|
||||
using for example crypto_data_hkdf/4. This input is often a shared
|
||||
secret, such as a negotiated point on an elliptic curve, or the hash
|
||||
that was computed from a password via crypto_password_hash/3 with a
|
||||
freshly generated and specified _salt_.
|
||||
|
||||
Reusing the same combination of Key and IV typically leaks at least
|
||||
_some_ information about the plaintext. For example, identical
|
||||
plaintexts will then correspond to identical ciphertexts. For some
|
||||
algorithms, reusing an IV with the same Key has disastrous results
|
||||
and can cause the loss of all properties that are otherwise
|
||||
guaranteed. Especially in such cases, an IV is also called a
|
||||
_nonce_ (number used once).
|
||||
|
||||
It is safe to store and transfer the used initialization vector (or
|
||||
nonce) in plain text, but the key _must be kept secret_.
|
||||
|
||||
Currently, the only supported algorithm is 'chacha20-poly1305', a
|
||||
powerful and efficient _authenticated_ encryption scheme, providing
|
||||
secrecy and at the same time reliable protection against undetected
|
||||
_modifications_ of the encrypted data. This is a very good choice
|
||||
for virtually all use cases. It is a stream cipher and can encrypt
|
||||
data of any length up to 256 GB. Further, the encrypted data has
|
||||
exactly the same length as the original, and no padding is used.
|
||||
|
||||
Options:
|
||||
|
||||
- encoding(+Encoding)
|
||||
Encoding to use for PlainText. Default is utf8. The alternative
|
||||
is octet to treat PlainText as raw bytes.
|
||||
|
||||
- tag(-List)
|
||||
For authenticated encryption schemes, List is unified with a
|
||||
list of _bytes_ holding the tag. This tag must be provided for
|
||||
decryption.
|
||||
|
||||
Here is an example encryption and decryption, using the ChaCha20
|
||||
stream cipher with the Poly1305 authenticator. This cipher uses a
|
||||
256-bit key and a 96-bit nonce, i.e., 32 and 12 _bytes_,
|
||||
respectively:
|
||||
|
||||
?- Algorithm = 'chacha20-poly1305',
|
||||
crypto_n_random_bytes(32, Key),
|
||||
crypto_n_random_bytes(12, IV),
|
||||
crypto_data_encrypt("this text is to be encrypted", Algorithm,
|
||||
Key, IV, CipherText, [tag(Tag)]),
|
||||
crypto_data_decrypt(CipherText, Algorithm,
|
||||
Key, IV, RecoveredText, [tag(Tag)]).
|
||||
|
||||
Yielding:
|
||||
|
||||
Algorithm = 'chacha20-poly1305',
|
||||
Key = [113,247,153,134,177,220,13,193,50,150|...],
|
||||
IV = [135,20,149,153,63,35,68,114,247,171|...],
|
||||
CipherText = "\x94\0Ej\x94\®Â\x95\óÑÆXÃn¾ð©b\x1c\ ...",
|
||||
RecoveredText = "this text is to be ...",
|
||||
Tag = [152,117,152,17,162,75,150,206,144,40|...]
|
||||
|
||||
In this example, we use crypto_n_random_bytes/2 to generate a key
|
||||
and nonce from cryptographically secure random numbers. For
|
||||
repeated applications, you must ensure that a nonce is only used
|
||||
_once_ together with the same key. Note that for _authenticated_
|
||||
encryption schemes, the _tag_ that was computed during encryption
|
||||
is necessary for decryption. It is safe to store and transfer the
|
||||
tag in plain text.
|
||||
|
||||
See also crypto_data_decrypt/6, and hex_bytes/2 for conversion
|
||||
between bytes and hex encoding.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
crypto_data_encrypt(PlainText0, Algorithm, Key, IV, CipherText, Options) :-
|
||||
options_data_chars(Options, PlainText0, PlainText, Encoding),
|
||||
@@ -534,45 +533,41 @@ crypto_data_encrypt(PlainText0, Algorithm, Key, IV, CipherText, Options) :-
|
||||
must_be_bytes(Tag, crypto_data_encrypt/6)
|
||||
; true
|
||||
),
|
||||
option(aad(AAD0), Options, []),
|
||||
encoding_chars(Encoding, AAD0, AAD),
|
||||
must_be_bytes(Key, crypto_data_encrypt/6),
|
||||
must_be_bytes(IV, crypto_data_encrypt/6),
|
||||
must_be(atom, Algorithm),
|
||||
( Algorithm = 'chacha20-poly1305' -> true
|
||||
; domain_error('chacha20-poly1305', Algorithm, crypto_data_encrypt/6)
|
||||
),
|
||||
algorithm_key_iv(Algorithm, Key, IV),
|
||||
'$crypto_data_encrypt'(PlainText, AAD, Encoding, Key, IV, Tag, CipherText).
|
||||
'$crypto_data_encrypt'(PlainText, Encoding, Key, IV, Tag, CipherText).
|
||||
|
||||
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, +Key, +IV, -PlainText, +Options).
|
||||
%
|
||||
% Decrypt the given CipherText, using the symmetric algorithm
|
||||
% Algorithm, key Key, and initialization vector IV, to give
|
||||
% PlainText. CipherText must be a list of characters, and Key and IV
|
||||
% must be lists of bytes. PlainText is created as a list of
|
||||
% characters.
|
||||
%
|
||||
% Currently, the only supported algorithm is 'chacha20-poly1305',
|
||||
% a very secure, fast and versatile authenticated encryption method.
|
||||
%
|
||||
% Options is a list of:
|
||||
%
|
||||
% - `encoding(+Encoding)`
|
||||
% Encoding to use for PlainText. The default is utf8. The
|
||||
% alternative is octet, which is used if the data are raw bytes.
|
||||
%
|
||||
% - `tag(+Tag)`
|
||||
% For authenticated encryption schemes, the tag must be specified as
|
||||
% a list of bytes exactly as they were generated upon encryption.
|
||||
%
|
||||
% - `aad(+Data)`
|
||||
% Any additional authenticated data (AAD) must be specified. The
|
||||
% `encoding/1` option also specifies the encoding of Data.
|
||||
Decrypt the given CipherText, using the symmetric algorithm
|
||||
Algorithm, key Key, and initialization vector IV, to give
|
||||
PlainText. CipherText must be a list of characters, and Key and IV
|
||||
must be lists of bytes. PlainText is created as a list of
|
||||
characters.
|
||||
|
||||
Currently, the only supported algorithm is 'chacha20-poly1305',
|
||||
a very secure, fast and versatile authenticated encryption method.
|
||||
|
||||
Options is a list of:
|
||||
|
||||
- encoding(+Encoding)
|
||||
Encoding to use for PlainText. The default is utf8. The
|
||||
alternative is octet, which is used if the data are raw bytes.
|
||||
|
||||
- tag(+Tag)
|
||||
For authenticated encryption schemes, the tag must be specified as
|
||||
a list of bytes exactly as they were generated upon encryption.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
crypto_data_decrypt(CipherText0, Algorithm, Key, IV, PlainText, Options) :-
|
||||
option(tag(Tag), Options, []),
|
||||
@@ -581,20 +576,16 @@ crypto_data_decrypt(CipherText0, Algorithm, Key, IV, PlainText, Options) :-
|
||||
must_be_bytes(IV, crypto_data_decrypt/6),
|
||||
must_be(atom, Algorithm),
|
||||
option(encoding(Encoding), Options, utf8),
|
||||
option(aad(AAD0), Options, []),
|
||||
encoding_chars(Encoding, AAD0, AAD),
|
||||
must_be(atom, Encoding),
|
||||
member(Encoding, [utf8,octet]),
|
||||
must_be(list, CipherText0),
|
||||
encoding_chars(octet, CipherText0, CipherText1),
|
||||
maplist(char_code, TagChars, Tag),
|
||||
% we append the tag very efficiently, retaining a compact
|
||||
% internal string representation of the ciphertext
|
||||
partial_string(CipherText1, CipherText, TagChars),
|
||||
append(CipherText1, TagChars, CipherText),
|
||||
( Algorithm = 'chacha20-poly1305' -> true
|
||||
; domain_error('chacha20-poly1305', Algorithm, crypto_data_decrypt/6)
|
||||
),
|
||||
algorithm_key_iv(Algorithm, Key, IV),
|
||||
'$crypto_data_decrypt'(CipherText, AAD, Key, IV, Encoding, PlainText).
|
||||
'$crypto_data_decrypt'(CipherText, octet, Key, IV, Encoding, PlainText).
|
||||
|
||||
|
||||
encoding_chars(octet, Bs, Cs) :-
|
||||
@@ -603,76 +594,91 @@ encoding_chars(octet, Bs, Cs) :-
|
||||
maplist(char_code, Cs, Bs)
|
||||
; Bs = Cs
|
||||
),
|
||||
must_be_octet_chars(Cs, crypto_encoding).
|
||||
must_be_byte_chars(Cs, crypto_encoding).
|
||||
encoding_chars(utf8, Cs, Cs) :-
|
||||
must_be(chars, Cs).
|
||||
must_be(list, Cs),
|
||||
maplist(must_be(character), 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_new_keypair(-Pair)
|
||||
Yields a new Ed25519 key pair Pair, a list of characters. The
|
||||
pair contains the private key and must be kept absolutely secret.
|
||||
Pair can be used for signing. Its public key can be obtained
|
||||
with ed25519_keypair_public_key/2.
|
||||
|
||||
- ed25519_keypair_public_key(+Pair, -PublicKey)
|
||||
PublicKey is the public key of the given key pair. The public key
|
||||
can be used for signature verification, and can be shared freely.
|
||||
The public key is represented as a list of characters.
|
||||
|
||||
- ed25519_sign(+Key, +Data, -Signature, +Options)
|
||||
Key and Data must be lists of characters. Key is a key pair in
|
||||
PKCS#8 v2 format as generated by ed25519_new_keypair/1. Sign Data
|
||||
with Key, yielding Signature as a list of hexadecimal characters.
|
||||
|
||||
- ed25519_verify(+Key, +Data, +Signature, +Options)
|
||||
Key and Data must be lists of characters. Key is a public key.
|
||||
Succeeds if Data was signed with the private key corresponding to
|
||||
Key, where Signature is a list of hexadecimal characters as
|
||||
generated by ed25519_sign/4. Fails otherwise.
|
||||
|
||||
Currently, the only option for signing and verifying is:
|
||||
|
||||
- encoding(+Encoding)
|
||||
The default encoding of Data is utf8. The alternative is octet,
|
||||
which treats Data as a list of raw bytes.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
ed25519_new_keypair(Pair) :-
|
||||
'$ed25519_new_keypair'(Pair).
|
||||
|
||||
%% ed25519_keypair_public_key(+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),
|
||||
'$ed25519_keypair_public_key'(Pair, PublicKey).
|
||||
|
||||
%% 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.
|
||||
must_be_byte_chars(Pair, ed25519_keypair_public_key),
|
||||
'$ed25519_keypair_public_key'(Pair, octet, PublicKey).
|
||||
|
||||
ed25519_sign(Key, Data0, Signature, Options) :-
|
||||
must_be_octet_chars(Key, ed25519_sign),
|
||||
must_be_byte_chars(Key, ed25519_sign),
|
||||
options_data_chars(Options, Data0, Data, Encoding),
|
||||
'$ed25519_sign'(Key, Data, Encoding, Signature0),
|
||||
'$ed25519_sign'(Key, octet, 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_byte_chars(Key, ed25519_verify),
|
||||
options_data_chars(Options, Data0, Data, Encoding),
|
||||
hex_bytes(Signature0, Signature),
|
||||
'$ed25519_verify'(Key, Data, Encoding, Signature).
|
||||
'$ed25519_verify'(Key, octet, Data, Encoding, Signature).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
X25519: ECDH key exchange over Curve25519
|
||||
=========================================
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
%% 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.
|
||||
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) :-
|
||||
length(Gs0, 32),
|
||||
@@ -680,54 +686,26 @@ curve25519_generator(Gs) :-
|
||||
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) ->
|
||||
Scalar #>= 0,
|
||||
Scalar #< 2^256,
|
||||
length(ScalarBytes, 32),
|
||||
bytes_integer(ScalarBytes, Scalar)
|
||||
; ScalarBytes = Scalar,
|
||||
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).
|
||||
|
||||
bytes_integer(Bs, N) :-
|
||||
foldl(pow, Bs, t(0,0,N), t(N,_,_)).
|
||||
foldl(pow, Bs, 0-0, N-_).
|
||||
|
||||
pow(B, t(N0,P0,I0), t(N,P,I)) :-
|
||||
( integer(I0) ->
|
||||
B #= I0 mod 256,
|
||||
I #= I0 >> 8
|
||||
; true
|
||||
),
|
||||
pow(B, N0-I0, N-I) :-
|
||||
B in 0..255,
|
||||
N #= N0 + B*256^P0,
|
||||
P #= P0 + 1.
|
||||
N #= N0 + B*256^I0,
|
||||
I #= I0 + 1.
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Operations on Elliptic Curves
|
||||
@@ -770,15 +748,11 @@ crypto_curve_scalar_mult(Curve, Scalar, point(X,Y), point(RX, RY)) :-
|
||||
curve_name(Curve, Name),
|
||||
curve_field_length(Curve, L0),
|
||||
L #= 2*L0, % for hex encoding
|
||||
phrase(format_("04~|~`0t~16r~*+~`0t~16r~*+", [X,L,Y,L]), PointHex),
|
||||
hex_bytes(PointHex, PointBytes),
|
||||
once(bytes_integer(ScalarBytes, Scalar)),
|
||||
'$crypto_curve_scalar_mult'(Name, ScalarBytes, PointBytes, [_|Us]),
|
||||
maplist(char_code, Us, Bs),
|
||||
length(XBs, 32),
|
||||
append(XBs, YBs, Bs),
|
||||
maplist(reverse, [XBs,YBs], RBs),
|
||||
maplist(bytes_integer, RBs, [RX,RY]).
|
||||
phrase(format_("04~|~`0t~16r~*+~`0t~16r~*+", [X,L,Y,L]), Hex),
|
||||
hex_bytes(Hex, Bytes),
|
||||
'$crypto_curve_scalar_mult'(Name, Scalar, Bytes, SX, SY),
|
||||
number_chars(RX, SX),
|
||||
number_chars(RY, SY).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
?- crypto_name_curve(secp256k1, Curve),
|
||||
@@ -830,6 +804,16 @@ fitting_exponent(N, E0, E) :-
|
||||
fitting_exponent(N, E1, E)
|
||||
).
|
||||
|
||||
crypto_name_curve(secp112r1,
|
||||
curve(secp112r1,
|
||||
0x00db7c2abf62e35e668076bead208b,
|
||||
0x00db7c2abf62e35e668076bead2088,
|
||||
0x659ef8ba043916eede8911702b22,
|
||||
point(0x09487239995a5ee76b55f9c2f098,
|
||||
0xa89ce5af8724c0a23e0e0ff77500),
|
||||
0x00db7c2abf62e35e7628dfac6561c5,
|
||||
14,
|
||||
1)).
|
||||
crypto_name_curve(secp256k1,
|
||||
curve(secp256k1,
|
||||
0x00fffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc2f,
|
||||
|
||||
@@ -1,67 +1,54 @@
|
||||
/** Predicates for parsing CSV data
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Predicates for parsing CSV data
|
||||
|
||||
## Read CSV files.
|
||||
|
||||
Only two options with default values:
|
||||
Read csv files
|
||||
|
||||
- `token_separator(',')`
|
||||
- `with_header(true)`
|
||||
Only two options with default values :
|
||||
- token_separator(',')
|
||||
- with_header(true)
|
||||
|
||||
### Examples:
|
||||
Examples
|
||||
|
||||
Parsing a CSV string:
|
||||
* parsing a csv string:
|
||||
|
||||
```
|
||||
?- use_module(library(csv)).
|
||||
?- use_module(library(dcgs)).
|
||||
?- phrase(parse_csv(Data), "col1,col2,col3,col4\none,2,,three").
|
||||
Data = frame(["col1","col2","col3","col4"],[["one",2,[],"three"]]).
|
||||
```
|
||||
?- use_module(library(csv)).
|
||||
?- use_module(library(dcgs)).
|
||||
?- 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)).
|
||||
?- phrase_from_file(parse_csv(frame(Header, Rows)), './test.csv').
|
||||
```
|
||||
?- use_module(library(csv)).
|
||||
?- use_module(library(pio)).
|
||||
?- phrase_from_file(parse_csv(frame(Header, Rows)), './test.csv').
|
||||
|
||||
## Write CSV files
|
||||
|
||||
Four options with default values :
|
||||
Write csv files
|
||||
|
||||
- `line_separator('\n')`
|
||||
- `token_separator(',')`
|
||||
- `with_header(true)`
|
||||
- `null_value(empty)`
|
||||
Four options with default values :
|
||||
- line_separator('\n')
|
||||
- token_separator(',')
|
||||
- with_header(true)
|
||||
- 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,
|
||||
|
||||
156
src/lib/dcgs.pl
156
src/lib/dcgs.pl
@@ -1,80 +1,46 @@
|
||||
/** 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,
|
||||
seq//1,
|
||||
seqq//1,
|
||||
... //0
|
||||
]).
|
||||
phrase/2,
|
||||
phrase/3]).
|
||||
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(iso_ext)).
|
||||
:- use_module(library(lists), [append/3, member/2]).
|
||||
:- use_module(library(loader), [strip_module/3]).
|
||||
|
||||
:- meta_predicate phrase(2, ?).
|
||||
|
||||
:- meta_predicate phrase(2, ?, ?).
|
||||
|
||||
%% phrase(+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.
|
||||
% ```
|
||||
:- use_module(library(lists), [append/3]).
|
||||
|
||||
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) ->
|
||||
instantiation_error(phrase/3)
|
||||
; nonvar(GRBody1),
|
||||
dcg_constr(GRBody1),
|
||||
dcg_body(GRBody1, S0, S, GRBody2) ->
|
||||
call(M:GRBody2)
|
||||
; call(M:GRBody1, S0, S)
|
||||
( var(GRBody) -> throw(error(instantiation_error, phrase/3))
|
||||
; dcg_constr(GRBody) -> phrase_(GRBody, S0, S)
|
||||
; functor(GRBody, _, _) -> call(GRBody, S0, S)
|
||||
; throw(error(type_error(callable, GRBody), phrase/3))
|
||||
).
|
||||
|
||||
phrase_([], S, S).
|
||||
phrase_(!, S, S).
|
||||
phrase_((A, B), S0, S) :-
|
||||
phrase(A, S0, S1), phrase(B, S1, S).
|
||||
phrase_((A -> B ; C), S0, S) :-
|
||||
!,
|
||||
( phrase(A, S0, S1) ->
|
||||
phrase(B, S1, S)
|
||||
; phrase(C, S0, S)
|
||||
).
|
||||
phrase_((A ; B), S0, S) :-
|
||||
( phrase(A, S0, S) ; phrase(B, S0, S) ).
|
||||
phrase_((A | B), S0, S) :-
|
||||
( phrase(A, S0, S) ; phrase(B, S0, S) ).
|
||||
phrase_({G}, S0, S) :-
|
||||
( call(G), S0 = S ).
|
||||
phrase_(call(G), S0, S) :-
|
||||
call(G, S0, S).
|
||||
phrase_((A -> B), S0, S) :-
|
||||
phrase((A -> B ; fail), S0, S).
|
||||
phrase_(phrase(NonTerminal), S0, S) :-
|
||||
phrase(NonTerminal, S0, S).
|
||||
phrase_([T|Ts], S0, S) :-
|
||||
append([T|Ts], S, S0).
|
||||
|
||||
% The same version of the below two dcg_rule clauses, but with module scoping.
|
||||
dcg_rule(( M:NonTerminal, Terminals --> GRBody ), ( M:Head :- Body )) :-
|
||||
dcg_non_terminal(NonTerminal, S0, S, Head),
|
||||
@@ -113,17 +79,12 @@ dcg_body(GRBody, S0, S, Body) :-
|
||||
nonvar(GRBody),
|
||||
dcg_constr(GRBody),
|
||||
dcg_cbody(GRBody, S0, S, Body).
|
||||
dcg_body(NonTerminal, S0, S, Goal1) :-
|
||||
dcg_body(NonTerminal, S0, S, Goal) :-
|
||||
nonvar(NonTerminal),
|
||||
\+ dcg_constr(NonTerminal),
|
||||
NonTerminal \= ( _ -> _ ),
|
||||
NonTerminal \= ( \+ _ ),
|
||||
loader:strip_module(NonTerminal, M, NonTerminal0),
|
||||
dcg_non_terminal(NonTerminal0, S0, S, Goal0),
|
||||
( functor(NonTerminal, (:), 2) ->
|
||||
Goal1 = M:Goal0
|
||||
; Goal1 = Goal0
|
||||
).
|
||||
dcg_non_terminal(NonTerminal, S0, S, Goal).
|
||||
|
||||
% The following constructs in a grammar rule body
|
||||
% are defined in the corresponding subclauses.
|
||||
@@ -170,50 +131,5 @@ dcg_cbody(( GRIf -> GRThen ), S0, S, ( If -> Then )) :-
|
||||
|
||||
user:term_expansion(Term0, Term) :-
|
||||
nonvar(Term0),
|
||||
dcg_rule(Term0, Term).
|
||||
|
||||
|
||||
%% seq(Seq)//
|
||||
%
|
||||
% Describes a sequence
|
||||
seq(Xs, Cs0,Cs) :-
|
||||
var(Xs),
|
||||
Cs0 == [],
|
||||
!,
|
||||
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 == [],
|
||||
!,
|
||||
Cs0 = Cs.
|
||||
... --> [] | [_], ... .
|
||||
|
||||
error_goal(error(E, must_be/2), error(E, must_be/2)).
|
||||
error_goal(error(E, (=..)/2), error(E, (=..)/2)).
|
||||
error_goal(E, _) :- throw(E).
|
||||
|
||||
user:goal_expansion(phrase(GRBody, S, S0), GRBody2) :-
|
||||
loader:strip_module(GRBody, M, GRBody0),
|
||||
nonvar(GRBody0),
|
||||
catch(dcgs:dcg_body(GRBody0, S, S0, GRBody1),
|
||||
E,
|
||||
dcgs:error_goal(E, GRBody1)
|
||||
),
|
||||
( GRBody = (_:_) ->
|
||||
GRBody2 = M:GRBody1
|
||||
; GRBody2 = GRBody1
|
||||
).
|
||||
|
||||
user:goal_expansion(phrase(GRBody, S), phrase(GRBody, S, [])).
|
||||
dcg_rule(Term0, (Head :- Body)),
|
||||
Term = (Head :- Body).
|
||||
|
||||
@@ -1,22 +1,4 @@
|
||||
/** 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)
|
||||
|
||||
*/
|
||||
|
||||
|
||||
% Source: https://stackoverflow.com/a/30791637
|
||||
|
||||
:- module(debug, [
|
||||
op(900, fx, $),
|
||||
@@ -29,29 +11,12 @@
|
||||
|
||||
:- use_module(library(format), [portray_clause/1]).
|
||||
|
||||
:- meta_predicate *(0).
|
||||
:- 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.
|
||||
|
||||
|
||||
*(_).
|
||||
|
||||
185
src/lib/diag.pl
185
src/lib/diag.pl
@@ -1,187 +1,14 @@
|
||||
:- 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(...),...].
|
||||
```
|
||||
*/
|
||||
|
||||
:- module(diag, [wam_instructions/2]).
|
||||
|
||||
:- use_module(library(error)).
|
||||
|
||||
%% wam_instructions(+PI, -Instrs)
|
||||
%
|
||||
% _Instrs_ are the WAM instructions corresponding to predicate indicator _PI_.
|
||||
|
||||
wam_instructions(Clause, Listing) :-
|
||||
( nonvar(Clause) ->
|
||||
( Clause = Name / Arity ->
|
||||
fetch_instructions(user, Name, Arity, Listing)
|
||||
; Clause = Module : (Name / Arity) ->
|
||||
fetch_instructions(Module, Name, Arity, Listing)
|
||||
Clause = Name / Arity,
|
||||
must_be(atom, Name),
|
||||
must_be(integer, Arity),
|
||||
( Arity >= 0 -> '$wam_instructions'(Name, Arity, Listing)
|
||||
; throw(error(domain_error(not_less_than_zero, Arity), wam_instructions/2))
|
||||
)
|
||||
; 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),
|
||||
must_be(atom, Name),
|
||||
must_be(integer, Arity),
|
||||
( Arity >= 0 ->
|
||||
'$wam_instructions'(Module, Name, Arity, Listing)
|
||||
; throw(error(domain_error(not_less_than_zero, Arity), wam_instructions/2))
|
||||
).
|
||||
|
||||
@@ -1,20 +1,15 @@
|
||||
/**
|
||||
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, maplist/3]).
|
||||
:- use_module(library(lists), [append/3]).
|
||||
|
||||
:- attribute dif/1.
|
||||
|
||||
put_dif_att(Var, X, Y) :-
|
||||
( get_atts(Var, +dif(Z)) ->
|
||||
sort([X \== Y | Z], NewZ),
|
||||
put_atts(Var, +dif(NewZ))
|
||||
sort([X \== Y | Z], NewZ),
|
||||
put_atts(Var, +dif(NewZ))
|
||||
; put_atts(Var, +dif([X \== Y]))
|
||||
).
|
||||
|
||||
@@ -23,83 +18,38 @@ 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))
|
||||
),
|
||||
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)) ->
|
||||
append(Goals, VarGoals, NewGoals0),
|
||||
sort(NewGoals0, NewGoals)
|
||||
append(Goals, VarGoals, NewGoals0),
|
||||
sort(NewGoals0, NewGoals)
|
||||
; NewGoals = Goals
|
||||
),
|
||||
put_atts(Var, +dif(NewGoals)),
|
||||
append_goals(Vars, Goals).
|
||||
|
||||
verify_attributes(Var, Value, Goals) :-
|
||||
( get_atts(Var, +dif(Goals0)) ->
|
||||
term_variables(Value, ValueVars),
|
||||
append_goals(ValueVars, Goals0),
|
||||
maplist(reinforce_goal, Goals0, Goals)
|
||||
( get_atts(Var, +dif(Goals)) ->
|
||||
term_variables(Value, ValueVars),
|
||||
append_goals(ValueVars, Goals)
|
||||
; Goals = []
|
||||
).
|
||||
|
||||
%% dif(?X, ?Y).
|
||||
%
|
||||
% 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(dif(X,Y), Vars),
|
||||
dif_set_variables(Vars, X, Y)
|
||||
).
|
||||
% Probably the world's worst dif/2 implementation. I'm open to
|
||||
% suggestions for improvement.
|
||||
|
||||
gather_dif_goals(_, []) --> [].
|
||||
gather_dif_goals(V, [(X \== Y) | Goals]) -->
|
||||
( { term_variables(X-Y, [V0 | _]),
|
||||
V == V0 } ->
|
||||
[dif:dif(X, Y)]
|
||||
; []
|
||||
),
|
||||
gather_dif_goals(V, Goals).
|
||||
dif(X, Y) :- X \== Y,
|
||||
( term_variables(X, XVars), term_variables(Y, YVars),
|
||||
dif_set_variables(XVars, X, Y),
|
||||
dif_set_variables(YVars, X, Y)
|
||||
).
|
||||
|
||||
gather_dif_goals([]) --> [].
|
||||
gather_dif_goals([(X \== Y) | Goals]) -->
|
||||
[dif(X, Y)],
|
||||
gather_dif_goals(Goals).
|
||||
|
||||
attribute_goals(X) -->
|
||||
{ get_atts(X, +dif(Goals)) },
|
||||
gather_dif_goals(X, Goals),
|
||||
gather_dif_goals(Goals),
|
||||
{ put_atts(X, -dif(_)) }.
|
||||
|
||||
141
src/lib/error.pl
141
src/lib/error.pl
@@ -1,8 +1,3 @@
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Written 2018-2023 by Markus Triska (triska@metalevel.at)
|
||||
I place this code in the public domain. Use it in any way you want.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
:- module(error, [must_be/2,
|
||||
can_be/2,
|
||||
instantiation_error/1,
|
||||
@@ -10,8 +5,10 @@
|
||||
type_error/3
|
||||
]).
|
||||
|
||||
|
||||
:- meta_predicate check_(1, ?, ?).
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Written September 2018 by Markus Triska (triska@metalevel.at)
|
||||
I place this code in the public domain. Use it in any way you want.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
@@ -28,16 +25,10 @@
|
||||
|
||||
Currently, the following types are supported:
|
||||
|
||||
- atom
|
||||
- boolean
|
||||
- character
|
||||
- chars
|
||||
- in_character
|
||||
- integer
|
||||
- atom
|
||||
- list
|
||||
- octet_character
|
||||
- octet_chars
|
||||
- term
|
||||
- boolean
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
must_be(Type, Term) :-
|
||||
@@ -49,56 +40,14 @@ must_be_(Type, _) :-
|
||||
instantiation_error(must_be/2).
|
||||
must_be_(var, Term) :-
|
||||
( var(Term) -> true
|
||||
; throw(error(uninstantiation_error(Term), must_be/2))
|
||||
; throw(error(uninstantiation_error, must_be/2))
|
||||
).
|
||||
must_be_(integer, Term) :- check_(integer, integer, Term).
|
||||
must_be_(not_less_than_zero, N) :-
|
||||
must_be(integer, N),
|
||||
( N >= 0 -> true
|
||||
; domain_error(not_less_than_zero, N, must_be/2)
|
||||
).
|
||||
must_be_(atom, Term) :- check_(atom, atom, Term).
|
||||
must_be_(character, T) :- check_(error:character, character, T).
|
||||
must_be_(in_character, T) :- check_(error:in_character, in_character, T).
|
||||
must_be_(chars, Ls) :-
|
||||
can_be(chars, Ls), % prioritize type errors over instantiation errors
|
||||
must_be(list, Ls),
|
||||
( '$is_partial_string'(Ls) ->
|
||||
% The expected case (success) uses a very fast test.
|
||||
% We cannot use partial_string/1 from library(iso_ext),
|
||||
% because that library itself imports library(error).
|
||||
true
|
||||
; all_characters(Ls)
|
||||
).
|
||||
must_be_(octet_character, C) :-
|
||||
must_be(character, C),
|
||||
( octet_character(C) -> true
|
||||
; domain_error(octet_character, C, must_be/2)
|
||||
).
|
||||
must_be_(octet_chars, Cs) :-
|
||||
must_be(chars, Cs),
|
||||
( '$first_non_octet'(Cs, C) ->
|
||||
domain_error(octet_character, C, must_be/2)
|
||||
; true
|
||||
).
|
||||
must_be_(list, Term) :- check_(error:ilist, list, Term).
|
||||
must_be_(type, Term) :- check_(error:type, type, Term).
|
||||
must_be_(boolean, Term) :- check_(error:boolean, boolean, Term).
|
||||
must_be_(term, Term) :-
|
||||
( acyclic_term(Term) ->
|
||||
( ground(Term) -> true
|
||||
; instantiation_error(must_be/2)
|
||||
)
|
||||
; type_error(term, Term, must_be/2)
|
||||
).
|
||||
|
||||
% We cannot use maplist(must_be(character), Cs), because library(lists)
|
||||
% uses library(error), so importing it would create a cyclic dependency.
|
||||
|
||||
all_characters([]).
|
||||
all_characters([C|Cs]) :-
|
||||
must_be(character, C),
|
||||
all_characters(Cs).
|
||||
must_be_(character, T) :- check_(character, character, T).
|
||||
must_be_(list, Term) :- check_(ilist, list, Term).
|
||||
must_be_(type, Term) :- check_(type, type, Term).
|
||||
must_be_(boolean, Term) :- check_(boolean, boolean, Term).
|
||||
|
||||
check_(Pred, Type, Term) :-
|
||||
( var(Term) -> instantiation_error(must_be/2)
|
||||
@@ -112,35 +61,17 @@ character(C) :-
|
||||
atom(C),
|
||||
atom_length(C, 1).
|
||||
|
||||
octet_character(C) :-
|
||||
char_code(C, Code),
|
||||
0 =< Code, Code =< 0xff.
|
||||
|
||||
in_character(C) :-
|
||||
( character(C)
|
||||
; C == end_of_file
|
||||
).
|
||||
|
||||
ilist(Ls) :-
|
||||
'$skip_max_list'(_, _, Ls, Rs),
|
||||
( var(Rs) ->
|
||||
instantiation_error(must_be/2)
|
||||
; Rs == []
|
||||
).
|
||||
ilist(V) :- var(V), instantiation_error(must_be/2).
|
||||
ilist([]).
|
||||
ilist([_|Ls]) :- ilist(Ls).
|
||||
|
||||
type(type).
|
||||
type(integer).
|
||||
type(atom).
|
||||
type(character).
|
||||
type(in_character).
|
||||
type(octet_character).
|
||||
type(octet_chars).
|
||||
type(chars).
|
||||
type(list).
|
||||
type(var).
|
||||
type(boolean).
|
||||
type(term).
|
||||
type(not_less_than_zero).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
can_be(Type, Term)
|
||||
@@ -164,51 +95,15 @@ can_be(Type, Term) :-
|
||||
).
|
||||
|
||||
can_(integer, Term) :- integer(Term).
|
||||
can_(not_less_than_zero, N) :-
|
||||
( integer(N) ->
|
||||
( N >= 0 -> true
|
||||
; domain_error(not_less_than_zero, N, can_be/2)
|
||||
)
|
||||
; type_error(integer, N, can_be/2)
|
||||
).
|
||||
can_(atom, Term) :- atom(Term).
|
||||
can_(character, T) :- character(T).
|
||||
can_(in_character, T) :- in_character(T).
|
||||
can_(chars, Ls) :-
|
||||
( '$is_partial_string'(Ls) -> true
|
||||
; can_be(list, Ls),
|
||||
can_be_chars(Ls)
|
||||
).
|
||||
can_(octet_character, C) :-
|
||||
( octet_character(C) -> true
|
||||
; domain_error(octet_character, C, can_be/2)
|
||||
).
|
||||
can_(octet_chars, Cs) :-
|
||||
can_be(chars, Cs),
|
||||
( '$skip_max_list'(_, _, Cs, []), % temporarily turn Cs into a list
|
||||
'$first_non_octet'(Cs, C) ->
|
||||
domain_error(octet_character, C, can_be/2)
|
||||
; true
|
||||
).
|
||||
can_(list, Term) :- list_or_partial_list(Term).
|
||||
can_(boolean, Term) :- boolean(Term).
|
||||
can_(term, Term) :-
|
||||
( acyclic_term(Term) ->
|
||||
true
|
||||
; type_error(term, Term, can_be/2)
|
||||
).
|
||||
|
||||
can_be_chars(Var) :- var(Var), !.
|
||||
can_be_chars([]).
|
||||
can_be_chars([X|Xs]) :-
|
||||
can_be(character, X),
|
||||
can_be_chars(Xs).
|
||||
|
||||
list_or_partial_list(Ls) :-
|
||||
'$skip_max_list'(_, _, Ls, Rs),
|
||||
( var(Rs) -> true
|
||||
; Rs == []
|
||||
).
|
||||
list_or_partial_list(Var) :- var(Var).
|
||||
list_or_partial_list([]).
|
||||
list_or_partial_list([_|Ls]) :-
|
||||
list_or_partial_list(Ls).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Shorthands for throwing ISO errors.
|
||||
|
||||
104
src/lib/ffi.pl
104
src/lib/ffi.pl
@@ -1,104 +0,0 @@
|
||||
:- 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).
|
||||
233
src/lib/files.pl
233
src/lib/files.pl
@@ -1,24 +1,5 @@
|
||||
/** 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)
|
||||
Written June 2020 by Markus Triska (triska@metalevel.at)
|
||||
Part of Scryer Prolog.
|
||||
|
||||
Predicates for reasoning about files and directories.
|
||||
@@ -70,11 +51,7 @@ _lists of characters_. This is an ideal representation:
|
||||
file_exists/1,
|
||||
directory_exists/1,
|
||||
delete_file/1,
|
||||
rename_file/2,
|
||||
file_copy/2,
|
||||
delete_directory/1,
|
||||
make_directory/1,
|
||||
make_directory_path/1,
|
||||
working_directory/2,
|
||||
path_canonical/2,
|
||||
path_segments/2,
|
||||
@@ -85,127 +62,66 @@ _lists of characters_. This is an ideal representation:
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(lists)).
|
||||
:- 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.
|
||||
list_of_chars(Cs) :-
|
||||
must_be(list, Cs),
|
||||
maplist(must_be(character), Cs).
|
||||
|
||||
directory_files(Directory, Files) :-
|
||||
must_be(chars, Directory),
|
||||
list_of_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),
|
||||
list_of_chars(File),
|
||||
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),
|
||||
list_of_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),
|
||||
list_of_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),
|
||||
list_of_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),
|
||||
list_of_chars(File),
|
||||
'$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).
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Dir0 is the current working directory, and the working directory
|
||||
is changed to Dir.
|
||||
|
||||
%% 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),
|
||||
'$delete_directory'(Directory).
|
||||
|
||||
file_must_exist(File, Context) :-
|
||||
( file_exists(File) -> true
|
||||
; throw(error(existence_error(file, File), Context))
|
||||
).
|
||||
|
||||
directory_must_exist(Directory, Context) :-
|
||||
( directory_exists(Directory) -> true
|
||||
; throw(error(existence_error(directory, Directory), Context))
|
||||
).
|
||||
|
||||
%% workind_directory(Dir0, Dir).
|
||||
%
|
||||
% Dir0 is the current working directory, and the working directory
|
||||
% is changed to Dir.
|
||||
%
|
||||
% Use `working_directory/2` to determine the current working directory,
|
||||
% and leave it as is.
|
||||
Use working_directory(Ds, Ds) 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.
|
||||
%
|
||||
% 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:
|
||||
%
|
||||
% 1. Ps is a path that does not exist.
|
||||
% 2. A non-final component in Ps is not a directory.
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
True iff Cs is the canonical, absolute path of Ps.
|
||||
|
||||
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:
|
||||
|
||||
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),
|
||||
must_be(list, Ps),
|
||||
maplist(must_be(character), Ps),
|
||||
can_be(list, Cs),
|
||||
'$path_canonical'(Ps, Cs).
|
||||
|
||||
@@ -216,80 +132,65 @@ 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).
|
||||
|
||||
file_time_(File, Which, T) :-
|
||||
file_must_exist(File, file_time_/3),
|
||||
'$file_time'(File, Which, T0),
|
||||
read_from_chars(T0, T).
|
||||
read_term_from_chars(T0, T).
|
||||
|
||||
|
||||
%% path_segments(Ps, Segments).
|
||||
%
|
||||
% 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
|
||||
% segment is a list of characters.
|
||||
%
|
||||
% At least one of the arguments must be instantiated.
|
||||
%
|
||||
% Examples:
|
||||
%
|
||||
% ```
|
||||
% ?- path_segments("/hello/there", Segments).
|
||||
% Segments = [[],"hello","there"].
|
||||
% ?- path_segments(Path, ["hello","there"]).
|
||||
% Path = "hello/there".
|
||||
% ```
|
||||
%
|
||||
% To obtain the platform-specific directory separator, you can use:
|
||||
%
|
||||
% ```
|
||||
% ?- path_segments(Separator, ["",""]).
|
||||
% Separator = "/".
|
||||
% ```
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
path_segments(Ps, Segments): 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
|
||||
segment is a list of characters.
|
||||
|
||||
At least one of the arguments must be instantiated.
|
||||
|
||||
Examples:
|
||||
|
||||
?- path_segments("/hello/there", Segments).
|
||||
Segments = [[],"hello","there"]
|
||||
; false.
|
||||
|
||||
?- path_segments(Path, ["hello","there"]).
|
||||
Path = "hello/there"
|
||||
; false.
|
||||
|
||||
|
||||
To obtain the platform-specific directory separator, you can use:
|
||||
|
||||
?- path_segments(Separator, ["",""]).
|
||||
Separator = "/"
|
||||
; false.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
path_segments(Path, Segments) :-
|
||||
'$directory_separator'(Sep),
|
||||
( var(Path) ->
|
||||
must_be(list, Segments),
|
||||
maplist(must_be(chars), Segments),
|
||||
phrase(append_with_separator(Segments, Sep), Path)
|
||||
; must_be(chars, Path),
|
||||
maplist(list_of_chars, Segments),
|
||||
append_with_separator(Segments, Sep, Path)
|
||||
; list_of_chars(Path),
|
||||
path_to_segments(Path, Sep, Segments)
|
||||
).
|
||||
|
||||
append_with_separator([], _) --> [].
|
||||
append_with_separator([Segment|Segments], Sep) -->
|
||||
append_with_separator_(Segments, Segment, Sep).
|
||||
append_with_separator([], _, []).
|
||||
append_with_separator([Segment|Segments], Sep, Path) :-
|
||||
append_with_separator_(Segments, Segment, Sep, Path).
|
||||
|
||||
append_with_separator_([], Segment, _) --> seq(Segment).
|
||||
append_with_separator_([Segment|Segments], Prev, Sep) -->
|
||||
seq(Prev), [Sep],
|
||||
append_with_separator_(Segments, Segment, Sep).
|
||||
append_with_separator_([], Segment, _, Segment).
|
||||
append_with_separator_([Segment|Segments], Prev, Sep, Path) :-
|
||||
append(Prev, [Sep|Rest], Path),
|
||||
append_with_separator_(Segments, Segment, Sep, Rest).
|
||||
|
||||
path_to_segments(Path, Sep, Segments) :-
|
||||
( append(Front, [Sep|Ps], Path) ->
|
||||
|
||||
@@ -1,21 +1,78 @@
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Written 2020-2023 by Markus Triska (triska@metalevel.at)
|
||||
Written March 2020 by Markus Triska (triska@metalevel.at)
|
||||
Part of Scryer Prolog.
|
||||
|
||||
This library provides the nonterminal format_//2 to describe
|
||||
formatted strings. format/[2,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)
|
||||
~Nr where N is an integer between 2 and 36: format the
|
||||
next argument, which must be an integer, in radix N.
|
||||
The characters "a" to "z" are used for radices 10 to 36.
|
||||
~NR like ~Nr, except that "A" to "Z" are used for radices > 9
|
||||
~| place a tab stop at this position
|
||||
~N| where N is an integer: place a tab stop at text column N
|
||||
~N+ where N is an integer: place a tab stop N characters
|
||||
after the previous tab stop (or start of line)
|
||||
~t distribute spaces evenly between the two closest tab stops
|
||||
~`Ct like ~t, use character C instead of spaces to fill the space
|
||||
~n newline
|
||||
~Nn N newlines
|
||||
~i ignore the next argument
|
||||
~~ the literal ~
|
||||
|
||||
Instead of ~N, you can write ~* to use the next argument from Arguments
|
||||
as the numeric argument.
|
||||
|
||||
The predicate format/2 is like format_//2, except that it outputs
|
||||
the text on the terminal instead of describing it declaratively.
|
||||
|
||||
format/3, used as format(Stream, FormatString, Arguments), outputs
|
||||
the described string to the given Stream. If Stream is a binary
|
||||
stream, then the code of each emitted character must be in 0..255.
|
||||
|
||||
If at all possible, format_//2 should be used, to stress pure parts
|
||||
that enable easy testing etc. If necessary, you can emit the list Ls
|
||||
with maplist(write, Ls).
|
||||
|
||||
The entire library only works if the Prolog flag double_quotes
|
||||
is set to chars, the default value in Scryer Prolog. This should
|
||||
also stay that way, to encourage a sensible environment.
|
||||
|
||||
Example:
|
||||
|
||||
?- phrase(format_("~s~n~`.t~w!~12|", ["hello",there]), Cs).
|
||||
%@ Cs = "hello\n......there!"
|
||||
%@ ; false.
|
||||
|
||||
I place this code in the public domain. Use it in any way you want.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
/** 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,
|
||||
portray_clause_//1,
|
||||
portray_clause/1,
|
||||
portray_clause/2,
|
||||
listing/1
|
||||
@@ -26,68 +83,11 @@
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(charsio)).
|
||||
:- 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),
|
||||
unique_variable_names(Args, VNs),
|
||||
phrase(cells(Fs,Args,0,[],VNs), Cells) },
|
||||
phrase(cells(Fs,Args,0,[]), Cells) },
|
||||
format_cells(Cells).
|
||||
|
||||
format_cells([]) --> [].
|
||||
@@ -120,11 +120,14 @@ format_elements([E|Es]) -->
|
||||
format_element(E),
|
||||
format_elements(Es).
|
||||
|
||||
format_element(chars(Cs)) --> seq(Cs).
|
||||
format_element(chars(Cs)) --> list(Cs).
|
||||
format_element(glue(Fill,Num)) -->
|
||||
{ length(Ls, Num),
|
||||
maplist(=(Fill), Ls) },
|
||||
seq(Ls).
|
||||
list(Ls).
|
||||
|
||||
list([]) --> [].
|
||||
list([L|Ls]) --> [L], list(Ls).
|
||||
|
||||
elements_gluevars([], N, N) --> [].
|
||||
elements_gluevars([E|Es], N0, N) -->
|
||||
@@ -138,7 +141,7 @@ element_gluevar(glue(_,V), N, N) --> [V].
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Our key datastructure is a list of cells and newlines.
|
||||
A cell has the shape cell(From,To,Elements), where
|
||||
A cell has the shape from_to(From,To,Elements), where
|
||||
From and To denote the positions of surrounding tab stops.
|
||||
|
||||
Elements is a list of elements that occur in a cell,
|
||||
@@ -150,26 +153,26 @@ element_gluevar(glue(_,V), N, N) --> [V].
|
||||
available space is distributed.
|
||||
|
||||
newline is used if ~n occurs in a format string.
|
||||
It is used because a newline character does not
|
||||
It is is used because a newline character does not
|
||||
consume whitespace in the sense of format strings.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
cells([], Args, Tab, Es, _) --> !,
|
||||
cells([], Args, Tab, Es) -->
|
||||
( { Args == [] } -> cell(Tab, Tab, Es)
|
||||
; { domain_error(empty_list, Args, format_//2) }
|
||||
).
|
||||
cells([~,~|Fs], Args, Tab, Es, VNs) --> !,
|
||||
cells(Fs, Args, Tab, [chars("~")|Es], VNs).
|
||||
cells([~,w|Fs], [Arg|Args], Tab, Es, VNs) --> !,
|
||||
{ write_term_to_chars(Arg, [numbervars(true),variable_names(VNs)], Chars) },
|
||||
cells(Fs, Args, Tab, [chars(Chars)|Es], VNs).
|
||||
cells([~,q|Fs], [Arg|Args], Tab, Es, VNs) --> !,
|
||||
{ write_term_to_chars(Arg, [quoted(true),numbervars(true),variable_names(VNs)], Chars) },
|
||||
cells(Fs, Args, Tab, [chars(Chars)|Es], VNs).
|
||||
cells([~,a|Fs], [Arg|Args], Tab, Es, VNs) --> !,
|
||||
cells([~,~|Fs], Args, Tab, Es) --> !,
|
||||
cells(Fs, Args, Tab, [chars("~")|Es]).
|
||||
cells([~,w|Fs], [Arg|Args], Tab, Es) --> !,
|
||||
{ write_term_to_chars(Arg, [], Chars) },
|
||||
cells(Fs, Args, Tab, [chars(Chars)|Es]).
|
||||
cells([~,q|Fs], [Arg|Args], Tab, Es) --> !,
|
||||
{ write_term_to_chars(Arg, [quoted(true)], Chars) },
|
||||
cells(Fs, Args, Tab, [chars(Chars)|Es]).
|
||||
cells([~,a|Fs], [Arg|Args], Tab, Es) --> !,
|
||||
{ atom_chars(Arg, Chars) },
|
||||
cells(Fs, Args, Tab, [chars(Chars)|Es], VNs).
|
||||
cells([~|Fs0], Args0, Tab, Es, VNs) -->
|
||||
cells(Fs, Args, Tab, [chars(Chars)|Es]).
|
||||
cells([~|Fs0], Args0, Tab, Es) -->
|
||||
{ numeric_argument(Fs0, Num, [d|Fs], Args0, [Arg0|Args]) },
|
||||
!,
|
||||
{ Arg is Arg0, % evaluate compound expression
|
||||
@@ -181,52 +184,44 @@ cells([~|Fs0], Args0, Tab, Es, VNs) -->
|
||||
Delta is Num - L,
|
||||
length(Zs, Delta),
|
||||
maplist(=('0'), Zs),
|
||||
phrase(("0.",seq(Zs),seq(Cs0)), Cs)
|
||||
phrase(("0.",list(Zs),list(Cs0)), Cs)
|
||||
; BeforeComma is L - Num,
|
||||
length(Bs, BeforeComma),
|
||||
append(Bs, Ds, Cs0),
|
||||
phrase((seq(Bs),".",seq(Ds)), Cs)
|
||||
phrase((list(Bs),".",list(Ds)), Cs)
|
||||
) }
|
||||
),
|
||||
cells(Fs, Args, Tab, [chars(Cs)|Es], VNs).
|
||||
cells([~|Fs0], Args0, Tab, Es, VNs) -->
|
||||
cells(Fs, Args, Tab, [chars(Cs)|Es]).
|
||||
cells([~|Fs0], Args0, Tab, Es) -->
|
||||
{ numeric_argument(Fs0, Num, ['D'|Fs], Args0, [Arg|Args]) },
|
||||
!,
|
||||
{ separate_digits_fractional(Arg, ',', Num, Cs) },
|
||||
cells(Fs, Args, Tab, [chars(Cs)|Es], VNs).
|
||||
cells([~|Fs0], Args0, Tab, Es, VNs) -->
|
||||
{ numeric_argument(Fs0, Num, ['U'|Fs], Args0, [Arg|Args]) },
|
||||
!,
|
||||
{ separate_digits_fractional(Arg, '_', Num, Cs) },
|
||||
cells(Fs, Args, Tab, [chars(Cs)|Es], VNs).
|
||||
cells([~|Fs0], Args0, Tab, Es, VNs) -->
|
||||
{ numeric_argument(Fs0, Num0, ['L'|Fs], Args0, [Arg|Args]) },
|
||||
!,
|
||||
{ ( Num0 =:= 0 ->
|
||||
Num = 72
|
||||
; Num = Num0
|
||||
),
|
||||
phrase(format_("~d", [Arg]), Cs0),
|
||||
phrase(split_lines_width(Cs0, Num), Cs) },
|
||||
cells(Fs, Args, Tab, [chars(Cs)|Es], VNs).
|
||||
cells([~,i|Fs], [_|Args], Tab, Es, VNs) --> !,
|
||||
cells(Fs, Args, Tab, Es, VNs).
|
||||
cells([~,n|Fs], Args, Tab, Es, VNs) --> !,
|
||||
{ number_chars(Num, NCs),
|
||||
phrase(("~",list(NCs),"d"), FStr),
|
||||
phrase(format_(FStr, [Arg]), Cs0),
|
||||
phrase(upto_what(Bs0, .), Cs0, Ds),
|
||||
reverse(Bs0, Bs1),
|
||||
phrase(groups_of_three(Bs1), Bs2),
|
||||
reverse(Bs2, Bs),
|
||||
append(Bs, Ds, Cs) },
|
||||
cells(Fs, Args, Tab, [chars(Cs)|Es]).
|
||||
cells([~,i|Fs], [_|Args], Tab, Es) --> !,
|
||||
cells(Fs, Args, Tab, Es).
|
||||
cells([~,n|Fs], Args, Tab, Es) --> !,
|
||||
cell(Tab, Tab, Es),
|
||||
n_newlines(1),
|
||||
cells(Fs, Args, 0, [], VNs).
|
||||
cells([~|Fs0], Args0, Tab, Es, VNs) -->
|
||||
cells(Fs, Args, 0, []).
|
||||
cells([~|Fs0], Args0, Tab, Es) -->
|
||||
{ numeric_argument(Fs0, Num, [n|Fs], Args0, Args) },
|
||||
!,
|
||||
cell(Tab, Tab, Es),
|
||||
n_newlines(Num),
|
||||
cells(Fs, Args, 0, [], VNs).
|
||||
cells([~,s|Fs], [Arg|Args], Tab, Es, VNs) --> !,
|
||||
cells(Fs, Args, Tab, [chars(Arg)|Es], VNs).
|
||||
cells([~,f|Fs], [Arg|Args], Tab, Es, VNs) --> !,
|
||||
cells(Fs, Args, 0, []).
|
||||
cells([~,s|Fs], [Arg|Args], Tab, Es) --> !,
|
||||
cells(Fs, Args, Tab, [chars(Arg)|Es]).
|
||||
cells([~,f|Fs], [Arg|Args], Tab, Es) --> !,
|
||||
{ format_number_chars(Arg, Chars) },
|
||||
cells(Fs, Args, Tab, [chars(Chars)|Es], VNs).
|
||||
cells([~|Fs0], Args0, Tab, Es, VNs) -->
|
||||
cells(Fs, Args, Tab, [chars(Chars)|Es]).
|
||||
cells([~|Fs0], Args0, Tab, Es) -->
|
||||
{ numeric_argument(Fs0, Num, [f|Fs], Args0, [Arg|Args]) },
|
||||
!,
|
||||
{ format_number_chars(Arg, Cs0),
|
||||
@@ -253,50 +248,39 @@ cells([~|Fs0], Args0, Tab, Es, VNs) -->
|
||||
),
|
||||
append(Bs, ['.'|Ds], Chars)
|
||||
) },
|
||||
cells(Fs, Args, Tab, [chars(Chars)|Es], VNs).
|
||||
cells([~,r|Fs], Args, Tab, Es, VNs) --> !,
|
||||
cells([~,'8',r|Fs], Args, Tab, Es, VNs).
|
||||
cells([~|Fs0], Args0, Tab, Es, VNs) -->
|
||||
cells(Fs, Args, Tab, [chars(Chars)|Es]).
|
||||
cells([~|Fs0], Args0, Tab, Es) -->
|
||||
{ numeric_argument(Fs0, Num, [r|Fs], Args0, [Arg|Args]) },
|
||||
!,
|
||||
{ integer_to_radix(Arg, Num, lowercase, Cs) },
|
||||
cells(Fs, Args, Tab, [chars(Cs)|Es], VNs).
|
||||
cells([~,'R'|Fs], Args, Tab, Es, VNs) --> !,
|
||||
cells([~,'8','R'|Fs], Args, Tab, Es, VNs).
|
||||
cells([~|Fs0], Args0, Tab, Es, VNs) -->
|
||||
cells(Fs, Args, Tab, [chars(Cs)|Es]).
|
||||
cells([~|Fs0], Args0, Tab, Es) -->
|
||||
{ numeric_argument(Fs0, Num, ['R'|Fs], Args0, [Arg|Args]) },
|
||||
!,
|
||||
{ integer_to_radix(Arg, Num, uppercase, Cs) },
|
||||
cells(Fs, Args, Tab, [chars(Cs)|Es], VNs).
|
||||
cells([~,'`',Char,t|Fs], Args, Tab, Es, VNs) --> !,
|
||||
cells(Fs, Args, Tab, [glue(Char,_)|Es], VNs).
|
||||
cells([~,t|Fs], Args, Tab, Es, VNs) --> !,
|
||||
cells(Fs, Args, Tab, [glue(' ',_)|Es], VNs).
|
||||
cells([~,'|'|Fs], Args, Tab0, Es, VNs) --> !,
|
||||
{ phrase(elements_gluevars(Es, 0, Width), _),
|
||||
Tab is Tab0 + Width },
|
||||
cell(Tab0, Tab, Es),
|
||||
cells(Fs, Args, Tab, [], VNs).
|
||||
cells([~|Fs0], Args0, Tab, Es, VNs) -->
|
||||
cells(Fs, Args, Tab, [chars(Cs)|Es]).
|
||||
cells([~,'`',Char,t|Fs], Args, Tab, Es) --> !,
|
||||
cells(Fs, Args, Tab, [glue(Char,_)|Es]).
|
||||
cells([~,t|Fs], Args, Tab, Es) --> !,
|
||||
cells(Fs, Args, Tab, [glue(' ',_)|Es]).
|
||||
cells([~|Fs0], Args0, Tab, Es) -->
|
||||
{ numeric_argument(Fs0, Num, ['|'|Fs], Args0, Args) },
|
||||
!,
|
||||
cell(Tab, Num, Es),
|
||||
cells(Fs, Args, Num, [], VNs).
|
||||
cells([~|Fs0], Args0, Tab0, Es, VNs) -->
|
||||
cells(Fs, Args, Num, []).
|
||||
cells([~|Fs0], Args0, Tab0, Es) -->
|
||||
{ numeric_argument(Fs0, Num, [+|Fs], Args0, Args) },
|
||||
!,
|
||||
{ Tab is Tab0 + Num },
|
||||
cell(Tab0, Tab, Es),
|
||||
cells(Fs, Args, Tab, [], VNs).
|
||||
cells([~|Cs], Args, _, _, _) -->
|
||||
( { Args == [] } ->
|
||||
{ domain_error(non_empty_list, [], format_//2) }
|
||||
; { domain_error(format_string, [~|Cs], format_//2) }
|
||||
).
|
||||
cells(Fs0, Args, Tab, Es, VNs) -->
|
||||
cells(Fs, Args, Tab, []).
|
||||
cells([~,C|_], _, _, _) -->
|
||||
{ atom_chars(A, [~,C]),
|
||||
domain_error(format_string, A, format_//2) }.
|
||||
cells(Fs0, Args, Tab, Es) -->
|
||||
{ phrase(upto_what(Fs1, ~), Fs0, Fs),
|
||||
Fs1 = [_|_] },
|
||||
cells(Fs, Args, Tab, [chars(Fs1)|Es], VNs).
|
||||
cells(Fs, Args, Tab, [chars(Fs1)|Es]).
|
||||
|
||||
format_number_chars(N0, Chars) :-
|
||||
N is N0, % evaluate compound expression
|
||||
@@ -312,30 +296,12 @@ Cs = [a,b,c], Rest = [~,t,e,s,t].
|
||||
Cs = [a,b,c], Rest = [].
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
separate_digits_fractional(Arg, Sep, Num, Cs) :-
|
||||
number_chars(Num, NCs),
|
||||
phrase(("~",seq(NCs),"d"), FStr),
|
||||
phrase(format_(FStr, [Arg]), Cs0),
|
||||
phrase(upto_what(Bs0, .), Cs0, Ds),
|
||||
reverse(Bs0, Bs1),
|
||||
phrase(groups_of_three(Bs1,Sep), Bs2),
|
||||
reverse(Bs2, Bs),
|
||||
append(Bs, Ds, Cs).
|
||||
|
||||
upto_what([], W), [W] --> [W], !.
|
||||
upto_what([C|Cs], W) --> [C], !, upto_what(Cs, W).
|
||||
upto_what([], _) --> [].
|
||||
|
||||
groups_of_three([A,B,C,D|Rs], Sep) --> !, [A,B,C,Sep], groups_of_three([D|Rs], Sep).
|
||||
groups_of_three(Ls, _) --> seq(Ls).
|
||||
|
||||
split_lines_width(Cs, Num) -->
|
||||
( { length(Prefix, Num),
|
||||
append(Prefix, [R|Rs], Cs) } ->
|
||||
seq(Prefix), "_\n",
|
||||
split_lines_width([R|Rs], Num)
|
||||
; seq(Cs)
|
||||
).
|
||||
groups_of_three([A,B,C,D|Rs]) --> !, [A,B,C], ",", groups_of_three([D|Rs]).
|
||||
groups_of_three(Ls) --> list(Ls).
|
||||
|
||||
cell(From, To, Es0) -->
|
||||
( { Es0 == [] } -> []
|
||||
@@ -343,39 +309,37 @@ cell(From, To, Es0) -->
|
||||
[cell(From,To,Es)]
|
||||
).
|
||||
|
||||
%?- format:numeric_argument("2f", Num, [f|Fs], Args0, Args).
|
||||
%?- numeric_argument("2f", Num, ['f'|Fs], Args0, Args).
|
||||
|
||||
%?- format:numeric_argument("100b", Num, Rs, Args0, Args).
|
||||
%?- numeric_argument("100b", Num, Rs, Args0, Args).
|
||||
|
||||
numeric_argument(Ds, Num, Rest, Args0, Args) :-
|
||||
( Ds = [*|Rest] ->
|
||||
Args0 = [Num|Args]
|
||||
; phrase(numeric_argument_(Ds, Rest), Ns),
|
||||
foldl(plus_times10, Ns, 0, Num),
|
||||
; numeric_argument_(Ds, [], Ns, Rest),
|
||||
foldl(pow10, Ns, 0-0, Num-_),
|
||||
Args0 = Args
|
||||
).
|
||||
|
||||
numeric_argument_([D|Ds], Rest) -->
|
||||
( { member(D, "0123456789") } ->
|
||||
{ number_chars(N, [D]) },
|
||||
[N],
|
||||
numeric_argument_(Ds, Rest)
|
||||
; { Rest = [D|Ds] }
|
||||
numeric_argument_([D|Ds], Ns0, Ns, Rest) :-
|
||||
( member(D, "0123456789") ->
|
||||
number_chars(N, [D]),
|
||||
numeric_argument_(Ds, [N|Ns0], Ns, Rest)
|
||||
; Ns = Ns0,
|
||||
Rest = [D|Ds]
|
||||
).
|
||||
|
||||
|
||||
plus_times10(D, N0, N) :- N is D + N0*10.
|
||||
|
||||
radix_error(lowercase, R) --> format_("~~~dr", [R]).
|
||||
radix_error(uppercase, R) --> format_("~~~dR", [R]).
|
||||
pow10(D, N0-Pow0, N-Pow) :-
|
||||
N is N0 + D*10^Pow0,
|
||||
Pow is Pow0 + 1.
|
||||
|
||||
integer_to_radix(I0, R, Which, Cs) :-
|
||||
I is I0, % evaluate compound expression
|
||||
must_be(integer, I),
|
||||
must_be(integer, R),
|
||||
( \+ between(2, 36, R) ->
|
||||
phrase(radix_error(Which,R), Es),
|
||||
domain_error(format_string, Es, format_//2)
|
||||
domain_error(radix, R, format_//2)
|
||||
; true
|
||||
),
|
||||
digits(Which, Ds),
|
||||
@@ -391,7 +355,8 @@ integer_to_radix_(0, _, _) --> !.
|
||||
integer_to_radix_(I0, R, Ds) -->
|
||||
{ M is I0 mod R,
|
||||
nth0(M, Ds, D),
|
||||
I is I0 // R },
|
||||
I is I0 // R
|
||||
},
|
||||
[D],
|
||||
integer_to_radix_(I, R, Ds).
|
||||
|
||||
@@ -403,81 +368,67 @@ 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),
|
||||
phrase(format_(Fs, Args), Cs),
|
||||
% we use a specialised internal predicate that uses only a
|
||||
% single "write" operation for efficiency. It is equivalent to
|
||||
% maplist(put_char(Stream), Cs). It also works for binary streams.
|
||||
'$put_chars'(Stream, Cs),
|
||||
flush_output(Stream).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
?- phrase(format:cells("hello", [], 0, [], []), Cs).
|
||||
?- phrase(cells("hello", [], 0, []), Cs).
|
||||
|
||||
?- phrase(format:cells("hello~10|", [], 0, [], []), Cs).
|
||||
?- phrase(format:cells("~ta~t~10|", [], 0, [], []), Cs).
|
||||
?- phrase(cells("hello~10|", [], 0, []), Cs).
|
||||
?- phrase(cells("~ta~t~10|", [], 0, []), Cs).
|
||||
|
||||
?- phrase(format_("~`at~50|", []), Ls).
|
||||
|
||||
?- phrase(format:cells("~`at~50|", [], 0, [], []), Cs),
|
||||
phrase(format:format_cells(Cs), Ls).
|
||||
?- phrase(format:cells("~ta~t~tb~tc~21|", [], 0, [], []), Cs).
|
||||
Cs = [cell(0,21,[glue(' ',_A),chars("a"),glue(' ',_B),glue(' ',_C),chars("b"),glue(' ',_D),chars("c ...")])]
|
||||
?- phrase(format:cells("~ta~t~4|", [], 0, [], []), Cs).
|
||||
Cs = [cell(0,4,[glue(' ',_A),chars("a"),glue(' ',_B)])]
|
||||
?- phrase(cells("~`at~50|", [], 0, []), Cs),
|
||||
phrase(format_cells(Cs), Ls).
|
||||
?- phrase(cells("~ta~t~tb~tc~21|", [], 0, []), Cs).
|
||||
Cs = [cell(0,21,[glue(' ',_38),chars([a]),glue(' ',_62),glue(' ',_67),chars([b]),glue(' ',_91),chars([c])])].
|
||||
?- phrase(cells("~ta~t~4|", [], 0, []), Cs).
|
||||
Cs = [cell(0,4,[glue(' ',_38),chars([a]),glue(' ',_62)])].
|
||||
|
||||
?- phrase(format:format_cell(cell(0,1,[glue(a,_94)])), Ls).
|
||||
?- phrase(format_cell(cell(0,1,[glue(a,_94)])), Ls).
|
||||
|
||||
?- phrase(format:format_cell(cell(0,50,[chars("hello")])), Ls).
|
||||
?- phrase(format_cell(cell(0,50,[chars("hello")])), Ls).
|
||||
|
||||
?- phrase(format_("~`at~50|~n", []), Ls).
|
||||
?- phrase(format_("hello~n~tthere~6|", []), Ls).
|
||||
|
||||
?- format("~ta~t~4|", []).
|
||||
a true.
|
||||
a true
|
||||
; false.
|
||||
|
||||
?- format("~ta~tb~tc~10|", []).
|
||||
a b c true.
|
||||
a b c true
|
||||
; false.
|
||||
|
||||
?- format("~tabc~3|", []).
|
||||
|
||||
?- format("~ta~t~4|", []).
|
||||
|
||||
?- format("~ta~t~tb~tc~20|", []).
|
||||
a b c true.
|
||||
a b c true
|
||||
; false.
|
||||
|
||||
?- format("~2f~n", [3]).
|
||||
3.00
|
||||
true.
|
||||
true
|
||||
|
||||
?- format("~20f", [0.1]).
|
||||
0.10000000000000000000 true.
|
||||
0.10000000000000000000 true % this should use higher accuracy!
|
||||
; false.
|
||||
|
||||
?- X is atan(2), format("~7f~n", [X]).
|
||||
1.1071487
|
||||
X = 1.1071487177940906.
|
||||
X = 1.1071487177940906
|
||||
|
||||
?- format("~`at~50|~n", []).
|
||||
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
|
||||
@@ -486,10 +437,10 @@ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
|
||||
?- format("~t~N", []).
|
||||
|
||||
?- format("~q", [.]).
|
||||
'.' true.
|
||||
'.' true
|
||||
|
||||
?- format("~12r", [300]).
|
||||
210 true.
|
||||
210 true
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
@@ -497,37 +448,31 @@ 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).
|
||||
|
||||
portray_clause(Stream, Term) :-
|
||||
phrase_to_stream(portray_clause_(Term), Stream),
|
||||
flush_output(Stream).
|
||||
phrase(portray_clause_(Term), Ls),
|
||||
format(Stream, "~s", [Ls]).
|
||||
|
||||
portray_clause_(Term) -->
|
||||
{ unique_variable_names(Term, VNs) },
|
||||
{ term_variables(Term, Vs),
|
||||
foldl(var_name, Vs, VNs, 0, _) },
|
||||
portray_(Term, VNs), ".\n".
|
||||
|
||||
unique_variable_names(Term, VNs) :-
|
||||
term_variables(Term, Vs),
|
||||
foldl(var_name, Vs, VNs, 0, _).
|
||||
|
||||
var_name(V, Name=V, Num0, Num) :-
|
||||
charsio:fabricate_var_name(numbervars, Name, Num0),
|
||||
Num is Num0 + 1.
|
||||
|
||||
literal(Lit, VNs) -->
|
||||
{ write_term_to_chars(Lit, [quoted(true),variable_names(VNs),double_quotes(true)], Ls) },
|
||||
seq(Ls).
|
||||
{ write_term_to_chars(Lit, [quoted(true),variable_names(VNs)], Ls) },
|
||||
list(Ls).
|
||||
|
||||
portray_(Var, VNs) --> { var(Var) }, !, literal(Var, VNs).
|
||||
portray_((Head :- Body), VNs) --> !,
|
||||
@@ -545,50 +490,35 @@ body_(Var, C, I, VNs) --> { var(Var) }, !,
|
||||
body_((A,B), C, I, VNs) --> !,
|
||||
body_(A, C, I, VNs), ",\n",
|
||||
body_(B, 0, I, VNs).
|
||||
body_(Body, C, I, VNs) -->
|
||||
{ body_if_then_else(Body, If, Then, Else) },
|
||||
body_((A ; Else), C, I, VNs) --> % ( If -> Then ; Else )
|
||||
{ nonvar(A), A = (If -> Then) },
|
||||
!,
|
||||
indent_to(C, I),
|
||||
"( ",
|
||||
{ C1 is I + 3 },
|
||||
body_(If, C1, C1, VNs), " ->\n",
|
||||
body_(Then, 0, C1, VNs), "\n",
|
||||
else_branch(Else, I, VNs).
|
||||
else_branch(Else, C1, I, VNs).
|
||||
body_((A;B), C, I, VNs) --> !,
|
||||
indent_to(C, I),
|
||||
"( ",
|
||||
{ C1 is I + 3 },
|
||||
body_(A, C1, C1, VNs), "\n",
|
||||
else_branch(B, I, VNs).
|
||||
else_branch(B, C1, I, VNs).
|
||||
body_(Goal, C, I, VNs) -->
|
||||
indent_to(C, I), literal(Goal, VNs).
|
||||
|
||||
|
||||
% True iff Body has the shape ( If -> Then ; Else ).
|
||||
body_if_then_else(Body, If, Then, Else) :-
|
||||
nonvar(Body),
|
||||
Body = (A ; Else),
|
||||
nonvar(A),
|
||||
A = (If -> Then).
|
||||
|
||||
else_branch(Else, I, VNs) -->
|
||||
else_branch(Else, C, I, VNs) -->
|
||||
indent_to(0, I),
|
||||
"; ",
|
||||
{ C is I + 3 },
|
||||
( { body_if_then_else(Else, If, Then, NextElse) } ->
|
||||
body_(If, C, C, VNs), " ->\n",
|
||||
body_(Then, 0, C, VNs), "\n",
|
||||
else_branch(NextElse, I, VNs)
|
||||
; { nonvar(Else), Else = ( A ; B ) } ->
|
||||
body_(A, C, C, VNs), "\n",
|
||||
else_branch(B, I, VNs)
|
||||
; body_(Else, C, C, VNs), "\n",
|
||||
indent_to(0, I),
|
||||
")"
|
||||
).
|
||||
body_(Else, C, C, VNs), "\n",
|
||||
indent_to(0, I),
|
||||
")".
|
||||
|
||||
indent_to(CurrentColumn, Indent) -->
|
||||
format_("~t~*|", [Indent-CurrentColumn]).
|
||||
{ Delta is Indent - CurrentColumn },
|
||||
format_("~t~*|", [Delta]).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
?- portray_clause(a).
|
||||
@@ -603,7 +533,7 @@ a :-
|
||||
b,
|
||||
c,
|
||||
d.
|
||||
true.
|
||||
true
|
||||
|
||||
|
||||
?- portray_clause([a,b,c,d]).
|
||||
|
||||
@@ -1,13 +1,8 @@
|
||||
:- module(freeze, [freeze/2]).
|
||||
|
||||
/** Provides the constraint `freeze/2`.
|
||||
*/
|
||||
|
||||
:- use_module(library(atts)).
|
||||
:- use_module(library(dcgs)).
|
||||
|
||||
:- meta_predicate freeze(-, 0).
|
||||
|
||||
:- attribute frozen/1.
|
||||
|
||||
verify_attributes(Var, Other, Goals) :-
|
||||
@@ -22,15 +17,6 @@ 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.
|
||||
@@ -38,5 +24,5 @@ freeze(X, Goal) :-
|
||||
attribute_goals(Var) -->
|
||||
{ get_atts(Var, frozen(Goals)),
|
||||
put_atts(Var, -frozen(_)) },
|
||||
[freeze:freeze(Var, Goals)].
|
||||
[freeze(Var, Goals)].
|
||||
|
||||
|
||||
@@ -19,14 +19,14 @@ gensym(Base, Unique) :-
|
||||
must_be(var, Unique),
|
||||
atom_si(Base),
|
||||
gensym_key(Base, BaseKey),
|
||||
( bb_get(BaseKey, UniqueID0) -> true
|
||||
; UniqueID0 = 0
|
||||
),
|
||||
UniqueID is UniqueID0 + 1,
|
||||
append_id(Base, UniqueID, Unique),
|
||||
bb_put(BaseKey, UniqueID).
|
||||
( bb_get(BaseKey, UniqueID0) ->
|
||||
UniqueID is UniqueID0 + 1,
|
||||
bb_put(BaseKey, UniqueID),
|
||||
append_id(Base, UniqueID, Unique)
|
||||
; bb_put(BaseKey, 1),
|
||||
append_id(Base, 1, Unique)
|
||||
).
|
||||
|
||||
reset_gensym(Base) :-
|
||||
atom_si(Base),
|
||||
gensym_key(Base, BaseKey),
|
||||
bb_put(BaseKey, 0).
|
||||
bb_put(Base, 0).
|
||||
|
||||
@@ -1,73 +1,84 @@
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Written 2022 by Adrián Arroyo Calle (adrian.arroyocalle@gmail.com)
|
||||
Written June 2020 by Markus Triska (triska@metalevel.at)
|
||||
Part of Scryer Prolog.
|
||||
*/
|
||||
|
||||
/** Make HTTP requests.
|
||||
http_open(+Address, -Stream, +Options)
|
||||
======================================
|
||||
|
||||
This library contains the predicate `http_open/3` which allows you to perform HTTP(S) calls.
|
||||
Useful for making API calls, or parsing websites. It uses Hyper underneath.
|
||||
*/
|
||||
Yields Stream to read the body of an HTTP reply from Address.
|
||||
Address is a list of characters, and includes the method. Both HTTP
|
||||
and HTTPS are supported. Redirects are followed.
|
||||
|
||||
Currently, Options must be the empty list. Options may be
|
||||
added in the future to give more control over the connection.
|
||||
|
||||
We use HTTP/1.0 until we can read chunked transfer-encoding.
|
||||
|
||||
Example:
|
||||
|
||||
?- http_open("https://github.com/mthom/scryer-prolog", S, []).
|
||||
%@ S = '$stream'(0x7f86f94a6cd0)
|
||||
%@ ; false.
|
||||
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
:- module(http_open, [http_open/3]).
|
||||
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(sockets)).
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(format)).
|
||||
:- use_module(library(charsio)).
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(lists), [member/2]).
|
||||
|
||||
%% 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),
|
||||
( member(data(Data), OptionValues) -> true; Data = []),
|
||||
( member(request_headers(RequestHeaders), OptionValues) -> true; RequestHeaders = ['user-agent'("Scryer Prolog")]),
|
||||
( member(status_code(Code), OptionValues) -> true; true),
|
||||
( member(headers(Headers), OptionValues) -> true; true),
|
||||
( member(size(Size), OptionValues) -> member('content-length'(Size), Headers); true),
|
||||
'$http_open'(Address, Response, Method, Code, Data, Headers, RequestHeaders).
|
||||
http_open(Address, Stream, Options) :-
|
||||
must_be(list, Options),
|
||||
must_be(list, Address),
|
||||
once(phrase((list(SchemeCs), "://", list(Rest)), Address)),
|
||||
atom_chars(Scheme, SchemeCs),
|
||||
chars_host_url(Rest, Host, URL),
|
||||
connect(Scheme, Host, Stream0),
|
||||
format(Stream0, "\
|
||||
GET ~s HTTP/1.0\r\n\
|
||||
Host: ~w\r\n\
|
||||
User-Agent: Scryer Prolog\r\n\
|
||||
Connection: close\r\n\r\n\
|
||||
", [URL,Host]),
|
||||
read_line_to_chars(Stream0, StatusLine, []),
|
||||
once(phrase(("HTTP/1.",(['0']|['1'])," ",[D1]), StatusLine, _)),
|
||||
read_header_lines(Stream0, HeaderLines),
|
||||
handle_response(D1, HeaderLines, Stream0, Stream).
|
||||
|
||||
parse_http_options(Options, OptionValues) :-
|
||||
maplist(parse_http_options_, Options, OptionValues).
|
||||
list([]) --> [].
|
||||
list([L|Ls]) --> [L], list(Ls).
|
||||
|
||||
parse_http_options_(method(Method), method(Method)) :-
|
||||
( var(Method) ->
|
||||
throw(error(instantiation_error, http_open/3))
|
||||
;
|
||||
member(Method, [get, post, put, delete, patch, head]) -> true
|
||||
;
|
||||
throw(error(domain_error(http_option, method(Method)), _))
|
||||
).
|
||||
handle_response('2', _, Stream, Stream). % ok
|
||||
handle_response('3', HeaderLines, Stream0, Stream) :- % redirect
|
||||
close(Stream0),
|
||||
once((member(Line, HeaderLines),
|
||||
phrase(("Location: ",list(Location),"\r\n"), Line))),
|
||||
http_open(Location, Stream, []).
|
||||
|
||||
parse_http_options_(data(Data), data(Data)) :-
|
||||
( var(Data) ->
|
||||
throw(error(instantiation_error, http_open/3))
|
||||
; true
|
||||
).
|
||||
% Status-Line = HTTP-Version SP Status-Code SP Reason-Phrase CRLF
|
||||
|
||||
parse_http_options_(request_headers(Headers), request_headers(Headers)) :-
|
||||
( var(Headers) ->
|
||||
throw(error(instantiation_error, http_open/3))
|
||||
; true
|
||||
).
|
||||
read_header_lines(Stream, Hs) :-
|
||||
read_line_to_chars(Stream, Cs, []),
|
||||
( Cs == "" -> Hs = []
|
||||
; Cs == "\r\n" -> Hs = []
|
||||
; Hs = [Cs|Rest],
|
||||
read_header_lines(Stream, Rest)
|
||||
).
|
||||
|
||||
chars_host_url(Cs, Host, [/|Us]) :-
|
||||
( phrase((list(Hs),"/",list(Us)), Cs) ->
|
||||
true
|
||||
; Hs = Cs,
|
||||
Us = []
|
||||
),
|
||||
atom_chars(Host, Hs).
|
||||
|
||||
connect(https, Host, Stream) :-
|
||||
socket_client_open(Host:443, Stream, [tls(true)]).
|
||||
connect(http, Host, Stream) :-
|
||||
socket_client_open(Host:80, Stream, []).
|
||||
|
||||
parse_http_options_(size(Size), size(Size)).
|
||||
parse_http_options_(status_code(Code), status_code(Code)).
|
||||
parse_http_options_(headers(Headers), headers(Headers)).
|
||||
|
||||
@@ -1,437 +0,0 @@
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
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.
|
||||
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_basic_auth/4
|
||||
]).
|
||||
|
||||
:- meta_predicate http_listen(?, :).
|
||||
:- meta_predicate http_listen(?, :, ?).
|
||||
|
||||
:- meta_predicate http_basic_auth(:, :, ?, ?).
|
||||
|
||||
:- use_module(library(charsio)).
|
||||
:- use_module(library(crypto)).
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(format)).
|
||||
:- use_module(library(iso_ext)).
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(pio)).
|
||||
:- use_module(library(time)).
|
||||
|
||||
%% http_listen(+Port, +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, +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, Options) :-
|
||||
parse_options(Options, TLSKey, TLSCert, ContentLengthLimit),
|
||||
phrase(format_("0.0.0.0:~d", [Port]), Addr),
|
||||
'$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),
|
||||
phrase(format_time("%Y-%m-%d (%H:%M:%S)", Time), TimeString),
|
||||
format("~s ~w ~s\n", [TimeString, RequestMethod, RequestPath]),
|
||||
maplist(map_header_kv, RequestHeaders, RequestHeadersKV),
|
||||
phrase(parse_queries(RequestQueries), RequestQuery),
|
||||
(
|
||||
match_handler(Handlers, RequestMethod, RequestPath, Handler) ->
|
||||
(
|
||||
HttpRequest = http_request(RequestHeadersKV, stream(RequestStream), RequestQueries),
|
||||
HttpResponse = http_response(_, _, _),
|
||||
(call(Handler, HttpRequest, HttpResponse) ->
|
||||
send_response(ResponseHandle, HttpResponse)
|
||||
; (
|
||||
'$http_answer'(ResponseHandle, 500, [], ResponseStream),
|
||||
call_cleanup(format(ResponseStream, "Internal Server Error", []), close(ResponseStream)))
|
||||
)
|
||||
)
|
||||
; (
|
||||
'$http_answer'(ResponseHandle, 404, [], ResponseStream),
|
||||
call_cleanup(format(ResponseStream, "Not Found", []), close(ResponseStream)))
|
||||
),
|
||||
http_loop(HttpListener, Handlers).
|
||||
|
||||
send_response(ResponseHandle, http_response(StatusCode0, text(ResponseText), ResponseHeaders0)) :-
|
||||
default(StatusCode0, 200, StatusCode),
|
||||
maplist(map_header_kv_2, ResponseHeaders, ResponseHeaders0),
|
||||
'$http_answer'(ResponseHandle, StatusCode, ResponseHeaders, ResponseStream0),
|
||||
open(stream(ResponseStream0), write, ResponseStream, [type(text)]),
|
||||
catch(
|
||||
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),
|
||||
catch(
|
||||
call_cleanup(format(ResponseStream, "~s", [ResponseBytes]),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),
|
||||
catch(
|
||||
call_cleanup(
|
||||
setup_call_cleanup(
|
||||
open(Filename, read, FileStream, [type(binary)]),
|
||||
(
|
||||
get_n_chars(FileStream, _, FileCs),
|
||||
format(ResponseStream, "~s", [FileCs])
|
||||
),
|
||||
close(FileStream)
|
||||
),
|
||||
close(ResponseStream)
|
||||
),
|
||||
error(existence_error(stream, _), _),
|
||||
true
|
||||
).
|
||||
|
||||
|
||||
default(Var, Default, Out) :-
|
||||
(var(Var) -> Out = Default
|
||||
; Var = Out
|
||||
).
|
||||
|
||||
map_header_kv(T, K-V) :-
|
||||
T =.. [K0, V],
|
||||
atom_chars(K0, K).
|
||||
|
||||
map_header_kv_2(T, K-V) :-
|
||||
atom_chars(K0, K),
|
||||
T =.. [K0, V].
|
||||
|
||||
match_handler(Handlers, Method, "/", Handler) :-
|
||||
member(H, Handlers),
|
||||
H =.. [Method, /, Handler].
|
||||
match_handler(Handlers, Method, Path, Handler) :-
|
||||
member(H, Handlers),
|
||||
copy_term(H, H1),
|
||||
H1 =.. [Method, Pattern, Handler],
|
||||
\+ var(Pattern),
|
||||
phrase(path(Pattern), Path).
|
||||
match_handler(Handlers, Method, Path, Handler) :-
|
||||
member(H, Handlers),
|
||||
copy_term(H, H1),
|
||||
H1 =.. [Method, Var, Handler],
|
||||
var(Var),
|
||||
Var = Path.
|
||||
|
||||
path(Pattern) -->
|
||||
{
|
||||
Pattern =.. Parts,
|
||||
length(Parts, 3),
|
||||
nth0(1, Parts, Pattern0),
|
||||
nth0(2, Parts, PartAtom),
|
||||
(var(PartAtom) -> Part = PartAtom; atom_chars(PartAtom, Part))
|
||||
},
|
||||
path(Pattern0),
|
||||
"/",
|
||||
string_without("/", Part).
|
||||
|
||||
path(Pattern) -->
|
||||
{
|
||||
Pattern =.. Parts,
|
||||
Parts = [PartAtom],
|
||||
(var(PartAtom) -> Part = PartAtom; atom_chars(PartAtom, Part))
|
||||
},
|
||||
"/",
|
||||
string_without("/", Part).
|
||||
|
||||
path([]) --> [].
|
||||
|
||||
string_without(Not, [Char|String]) -->
|
||||
[Char],
|
||||
{
|
||||
\+ member(Char, Not)
|
||||
},
|
||||
string_without(Not, String).
|
||||
|
||||
string_without(_, []) -->
|
||||
[].
|
||||
|
||||
%% http_headers(?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)) :-
|
||||
member("content-type"-"application/x-www-form-urlencoded", Headers),
|
||||
get_n_chars(StreamBody, _, TextBody),
|
||||
phrase(parse_queries(FormBody), TextBody).
|
||||
http_body(http_request(_, Body, _), Body).
|
||||
http_body(http_response(_, Body, _), Body).
|
||||
|
||||
%% http_status_code(?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),
|
||||
"=",
|
||||
string_without("&", Value0),
|
||||
"&",
|
||||
parse_queries(Queries),
|
||||
{
|
||||
phrase(url_decode(Key), Key0),
|
||||
phrase(url_decode(Value), Value0)
|
||||
}.
|
||||
|
||||
parse_queries([Key-Value]) -->
|
||||
string_without("=", Key0),
|
||||
"=",
|
||||
string_without(" ", Value0),
|
||||
{
|
||||
phrase(url_decode(Key), Key0),
|
||||
phrase(url_decode(Value), Value0)
|
||||
}.
|
||||
|
||||
parse_queries([]) -->
|
||||
[].
|
||||
|
||||
% Decodes a UTF-8 URL Encoded string: RFC-1738
|
||||
url_decode([Char|Chars]) -->
|
||||
[Char],
|
||||
{
|
||||
Char \= '%',
|
||||
Char \= (+)
|
||||
},
|
||||
url_decode(Chars).
|
||||
url_decode([' '|Chars]) -->
|
||||
"+",
|
||||
url_decode(Chars).
|
||||
url_decode([Char|Chars]) -->
|
||||
"%",
|
||||
[A],
|
||||
[B],
|
||||
{
|
||||
hex_bytes([A,B], Bytes),
|
||||
Bytes = [FirstByte|_],
|
||||
FirstByte < 128,
|
||||
chars_utf8bytes(Chars0, Bytes),
|
||||
Chars0 = [Char]
|
||||
},
|
||||
url_decode(Chars).
|
||||
url_decode([Char|Chars]) -->
|
||||
"%",
|
||||
[A, B],
|
||||
"%",
|
||||
[C, D],
|
||||
{
|
||||
hex_bytes([A,B,C,D], Bytes),
|
||||
Bytes = [FirstByte|_],
|
||||
FirstByte < 224,
|
||||
chars_utf8bytes(Chars0, Bytes),
|
||||
Chars0 = [Char]
|
||||
},
|
||||
url_decode(Chars).
|
||||
url_decode([Char|Chars]) -->
|
||||
"%",
|
||||
[A, B],
|
||||
"%",
|
||||
[C, D],
|
||||
"%",
|
||||
[E, F],
|
||||
{
|
||||
hex_bytes([A,B,C,D,E,F], Bytes),
|
||||
Bytes = [FirstByte|_],
|
||||
FirstByte < 240,
|
||||
chars_utf8bytes(Chars0, Bytes),
|
||||
Chars0 = [Char]
|
||||
},
|
||||
url_decode(Chars).
|
||||
url_decode([Char|Chars]) -->
|
||||
"%",
|
||||
[A, B],
|
||||
"%",
|
||||
[C, D],
|
||||
"%",
|
||||
[E, F],
|
||||
"%",
|
||||
[H, I],
|
||||
{
|
||||
hex_bytes([A,B,C,D,E,F,H,I], Bytes),
|
||||
chars_utf8bytes(Chars0, Bytes),
|
||||
Chars0 = [Char]
|
||||
},
|
||||
url_decode(Chars).
|
||||
|
||||
url_decode([]) --> [].
|
||||
|
||||
%% 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")).
|
||||
|
||||
@@ -1,404 +1,163 @@
|
||||
/** Useful general predicates that are not ISO standard yet
|
||||
%% for builtins that are not part of the ISO standard.
|
||||
%% must be loaded at the REPL with
|
||||
|
||||
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.
|
||||
*/
|
||||
%% ?- use_module(library(iso_ext)).
|
||||
|
||||
:- module(iso_ext, [bb_b_put/2,
|
||||
bb_get/2,
|
||||
bb_put/2,
|
||||
call_cleanup/2,
|
||||
call_with_inference_limit/3,
|
||||
forall/2,
|
||||
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,
|
||||
assertz/2]).
|
||||
:- module(iso_ext, [bb_b_put/2, bb_get/2, bb_put/2, call_cleanup/2,
|
||||
call_with_inference_limit/3, forall/2,
|
||||
partial_string/1, partial_string/3,
|
||||
partial_string_tail/2, setup_call_cleanup/3,
|
||||
variant/2]).
|
||||
|
||||
:- use_module(library(error), [can_be/2,
|
||||
domain_error/3,
|
||||
instantiation_error/1,
|
||||
type_error/3]).
|
||||
|
||||
:- use_module(library(lists), [maplist/3]).
|
||||
|
||||
:- 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)
|
||||
bb_put(Key, Value) :- atom(Key), !, '$store_global_var'(Key, Value).
|
||||
bb_put(Key, _) :- throw(error(type_error(atom, Key), bb_put/2)).
|
||||
|
||||
%% backtrackable global variables.
|
||||
|
||||
bb_b_put(Key, NewValue) :-
|
||||
( '$bb_get_with_offset'(Key, OldValue, OldOffset) ->
|
||||
call_cleanup((store_global_var_with_offset(Key, NewValue) ; false),
|
||||
reset_global_var_at_offset(Key, OldValue, OldOffset))
|
||||
; call_cleanup((store_global_var_with_offset(Key, NewValue) ; false),
|
||||
reset_global_var_at_key(Key))
|
||||
).
|
||||
|
||||
% backtrackable global variables.
|
||||
store_global_var_with_offset(Key, Value) :- '$store_global_var_with_offset'(Key, Value).
|
||||
|
||||
%% 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)
|
||||
).
|
||||
store_global_var(Key, Value) :- '$store_global_var'(Key, Value).
|
||||
|
||||
%% 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)
|
||||
; type_error(atom, Key, bb_get/2)
|
||||
).
|
||||
reset_global_var_at_key(Key) :- '$reset_global_var_at_key'(Key).
|
||||
|
||||
reset_global_var_at_offset(Key, Value, Offset) :- '$reset_global_var_at_offset'(Key, Value, Offset).
|
||||
|
||||
%% succ(?I, ?S).
|
||||
%
|
||||
% True iff S is the successor of the non-negative integer I.
|
||||
% At least one of the arguments must be instantiated.
|
||||
'$bb_get_with_offset'(Key, OldValue, Offset) :-
|
||||
atom(Key), !, '$fetch_global_var_with_offset'(Key, OldValue, Offset).
|
||||
'$bb_get_with_offset'(Key, _, _) :-
|
||||
throw(error(type_error(atom, Key), bb_b_put/2)).
|
||||
|
||||
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)
|
||||
).
|
||||
bb_get(Key, Value) :- atom(Key), !, '$fetch_global_var'(Key, Value).
|
||||
bb_get(Key, _) :- throw(error(type_error(atom, Key), bb_get/2)).
|
||||
|
||||
call_cleanup(G, C) :- setup_call_cleanup(true, G, C).
|
||||
|
||||
|
||||
% 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)),
|
||||
call(S),
|
||||
'$set_cp_by_default'(B),
|
||||
'$get_current_scc_block'(Bb),
|
||||
( C = _:CC,
|
||||
var(CC) ->
|
||||
instantiation_error(setup_call_cleanup/3)
|
||||
; scc_helper(C, G, Bb)
|
||||
'$get_current_block'(Bb),
|
||||
( '$call_with_default_policy'(var(C)) ->
|
||||
throw(error(instantiation_error, setup_call_cleanup/3))
|
||||
; '$call_with_default_policy'(scc_helper(C, G, Bb))
|
||||
).
|
||||
|
||||
:- meta_predicate(scc_helper(?,0,?)).
|
||||
|
||||
:- non_counted_backtracking scc_helper/3.
|
||||
|
||||
scc_helper(C, G, Bb) :-
|
||||
'$get_cp'(Cp),
|
||||
'$install_scc_cleaner'(C),
|
||||
'$call_with_inference_counting'(call(G)),
|
||||
( '$check_cp'(Cp) ->
|
||||
'$reset_scc_block'(Bb),
|
||||
run_cleaners_without_handling(Cp)
|
||||
; true
|
||||
; '$fail'
|
||||
).
|
||||
'$get_cp'(Cp), '$install_scc_cleaner'(C, NBb), call(G),
|
||||
( '$check_cp'(Cp) ->
|
||||
'$reset_block'(Bb),
|
||||
'$call_with_default_policy'(run_cleaners_without_handling(Cp))
|
||||
; '$call_with_default_policy'(true)
|
||||
; '$reset_block'(NBb),
|
||||
'$fail').
|
||||
scc_helper(_, _, Bb) :-
|
||||
'$reset_scc_block'(Bb),
|
||||
'$push_ball_stack',
|
||||
run_cleaners_with_handling,
|
||||
'$pop_from_ball_stack',
|
||||
'$unwind_stack'.
|
||||
'$reset_block'(Bb),
|
||||
'$get_ball'(Ball),
|
||||
'$call_with_default_policy'(run_cleaners_with_handling),
|
||||
'$erase_ball',
|
||||
'$call_with_default_policy'(throw(Ball)).
|
||||
scc_helper(_, _, _) :-
|
||||
'$get_cp'(Cp),
|
||||
run_cleaners_without_handling(Cp),
|
||||
'$call_with_default_policy'(run_cleaners_without_handling(Cp)),
|
||||
'$fail'.
|
||||
|
||||
:- non_counted_backtracking run_cleaners_with_handling/0.
|
||||
|
||||
run_cleaners_with_handling :-
|
||||
'$get_scc_cleaner'(C),
|
||||
'$get_cp'(B),
|
||||
catch(C, _, true),
|
||||
'$get_scc_cleaner'(C), '$get_level'(B),
|
||||
'$call_with_default_policy'(catch(C, _, true)),
|
||||
'$set_cp_by_default'(B),
|
||||
run_cleaners_with_handling.
|
||||
'$call_with_default_policy'(run_cleaners_with_handling).
|
||||
run_cleaners_with_handling :-
|
||||
'$restore_cut_policy'.
|
||||
|
||||
:- non_counted_backtracking run_cleaners_without_handling/1.
|
||||
|
||||
run_cleaners_without_handling(Cp) :-
|
||||
'$get_scc_cleaner'(C),
|
||||
'$get_cp'(B),
|
||||
'$get_level'(B),
|
||||
call(C),
|
||||
'$set_cp_by_default'(B),
|
||||
run_cleaners_without_handling(Cp).
|
||||
'$call_with_default_policy'(run_cleaners_without_handling(Cp)).
|
||||
run_cleaners_without_handling(Cp) :-
|
||||
'$set_cp_by_default'(Cp),
|
||||
'$restore_cut_policy'.
|
||||
|
||||
% call_with_inference_limit
|
||||
|
||||
:- meta_predicate(call_with_inference_limit(0, ?, ?)).
|
||||
:- 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 call_with_inference_limit/3.
|
||||
:- non_counted_backtracking handle_ile/3.
|
||||
handle_ile(B, inference_limit_exceeded(B), inference_limit_exceeded) :- !.
|
||||
handle_ile(B, E, _) :-
|
||||
'$remove_call_policy_check'(B),
|
||||
'$call_with_default_policy'(throw(E)).
|
||||
|
||||
%% 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 ->
|
||||
domain_error(not_less_than_zero, L, call_with_inference_limit/3)
|
||||
; true
|
||||
)
|
||||
; var(L) ->
|
||||
instantiation_error(call_with_inference_limit/3)
|
||||
; type_error(integer, L, call_with_inference_limit/3)
|
||||
),
|
||||
'$get_current_block'(Bb),
|
||||
'$get_b_value'(B),
|
||||
call_with_inference_limit(G, L, R, Bb, B),
|
||||
'$call_with_default_policy'(call_with_inference_limit(G, L, R, Bb, B)),
|
||||
'$remove_call_policy_check'(B).
|
||||
|
||||
|
||||
:- meta_predicate(call_with_inference_limit(0,?,?,?,?)).
|
||||
|
||||
:- non_counted_backtracking call_with_inference_limit/5.
|
||||
|
||||
call_with_inference_limit(G, L, R, Bb, B) :-
|
||||
'$install_new_block'(NBb),
|
||||
'$install_inference_counter'(NBb, L, Count0),
|
||||
'$call_with_inference_counting'(call(G)),
|
||||
'$install_inference_counter'(B, L, Count0),
|
||||
call(G),
|
||||
'$inference_level'(R, B),
|
||||
'$remove_inference_counter'(NBb, Count1),
|
||||
Diff is L - (Count1 - Count0),
|
||||
( '$clean_up_block'(NBb),
|
||||
'$reset_block'(Bb)
|
||||
; '$install_inference_counter'(NBb, Diff, _),
|
||||
'$reset_block'(NBb),
|
||||
'$fail'
|
||||
).
|
||||
'$remove_inference_counter'(B, Count1),
|
||||
'$call_with_default_policy'(is(Diff, L - (Count1 - Count0))),
|
||||
'$call_with_default_policy'(end_block(B, Bb, NBb, Diff)).
|
||||
call_with_inference_limit(_, _, R, Bb, B) :-
|
||||
( '$inference_limit_exceeded' ->
|
||||
R = inference_limit_exceeded
|
||||
; true
|
||||
),
|
||||
'$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)
|
||||
).
|
||||
'$remove_inference_counter'(B, _),
|
||||
( '$get_ball'(Ball),
|
||||
'$get_level'(Cp),
|
||||
'$set_cp_by_default'(Cp)
|
||||
; '$remove_call_policy_check'(B),
|
||||
'$fail'
|
||||
),
|
||||
'$erase_ball',
|
||||
'$call_with_default_policy'(handle_ile(B, Ball, R)).
|
||||
|
||||
variant(X, Y) :- '$variant'(X, Y).
|
||||
|
||||
%% 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
|
||||
; catch(atom_chars(Atom, String),
|
||||
error(E, _),
|
||||
throw(error(E, partial_string/3))),
|
||||
error(E, _),
|
||||
throw(error(E, partial_string/3))),
|
||||
'$create_partial_string'(Atom, L, L0)
|
||||
).
|
||||
|
||||
%% 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)
|
||||
; throw(error(type_error(partial_string, String), partial_string_tail/2))
|
||||
).
|
||||
|
||||
:- dynamic(i_call_nth_nesting/2).
|
||||
:- dynamic(i_call_nth_counter/1).
|
||||
|
||||
:- meta_predicate(call_nth(0, ?)).
|
||||
|
||||
%% call_nth(Goal, N).
|
||||
%
|
||||
% Succeeds when Goal succeeded for the Nth time (there are at least N solutions)
|
||||
call_nth(Goal, N) :-
|
||||
can_be(integer, N),
|
||||
( integer(N) ->
|
||||
( N < 0 ->
|
||||
domain_error(not_less_than_zero, N, call_nth/2)
|
||||
; N > 0
|
||||
)
|
||||
; true
|
||||
),
|
||||
setup_call_cleanup(call_nth_nesting(C, ID),
|
||||
( Goal,
|
||||
bb_get(ID, N0),
|
||||
N1 is N0 + 1,
|
||||
bb_put(ID, N1),
|
||||
( integer(N) ->
|
||||
N = N1,
|
||||
!
|
||||
; N = N1
|
||||
)
|
||||
),
|
||||
( bb_get(i_call_nth_counter, C) ->
|
||||
C1 is C - 1,
|
||||
bb_put(i_call_nth_counter, C1)
|
||||
; true
|
||||
)).
|
||||
|
||||
call_nth_nesting(C, ID) :-
|
||||
( bb_get(i_call_nth_counter, C0) ->
|
||||
C is C0 + 1
|
||||
; C = 0
|
||||
),
|
||||
number_chars(C, Cs),
|
||||
atom_chars(Atom, Cs),
|
||||
atom_concat(i_call_nth_nesting_, Atom, ID),
|
||||
bb_put(ID, 0),
|
||||
bb_put(i_call_nth_counter, C).
|
||||
|
||||
%% 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).
|
||||
|
||||
%% asserta(Module, Rule_Fact).
|
||||
%
|
||||
% Similar to `asserta/1` but allows specifying a Module
|
||||
asserta(Module, (Head :- Body)) :-
|
||||
!,
|
||||
'$asserta'(Module, Head, Body).
|
||||
asserta(Module, Fact) :-
|
||||
'$asserta'(Module, Fact, true).
|
||||
|
||||
%% assertz(Module, Rule_Fact).
|
||||
%
|
||||
% Similar to `assertz/1` but allows specifying a Module
|
||||
assertz(Module, (Head :- Body)) :-
|
||||
!,
|
||||
'$assertz'(Module, Head, Body).
|
||||
assertz(Module, Fact) :-
|
||||
'$assertz'(Module, Fact, true).
|
||||
|
||||
|
||||
@@ -1,233 +0,0 @@
|
||||
/*
|
||||
Author: Ulrich Neumerkel
|
||||
E-mail: ulrich@complang.tuwien.ac.at
|
||||
Copyright (C): 2009 Ulrich Neumerkel. All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are
|
||||
met:
|
||||
|
||||
1. Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
|
||||
2. Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions and the following disclaimer in the
|
||||
documentation and/or other materials provided with the distribution.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY Ulrich Neumerkel ``AS IS'' AND ANY
|
||||
EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL Ulrich Neumerkel OR
|
||||
CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
|
||||
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
|
||||
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
|
||||
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
|
||||
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
|
||||
NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
|
||||
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
The views and conclusions contained in the software and documentation
|
||||
are those of the authors and should not be interpreted as representing
|
||||
official policies, either expressed or implied, of Ulrich Neumerkel.
|
||||
|
||||
|
||||
|
||||
*/
|
||||
|
||||
:- module(lambda, [
|
||||
(^)/3, (^)/4, (^)/5, (^)/6, (^)/7, (^)/8, (^)/9, (^)/10,
|
||||
(\)/1, (\)/2, (\)/3, (\)/4, (\)/5, (\)/6, (\)/7, (\)/8,
|
||||
(+\)/2, (+\)/3, (+\)/4, (+\)/5, (+\)/6, (+\)/7, (+\)/8,
|
||||
(+\)/9, op(201,xfx,+\)]).
|
||||
|
||||
:- use_module(library(iso_ext)).
|
||||
|
||||
/** <module> Lambda expressions
|
||||
|
||||
This library provides lambda expressions to simplify higher order
|
||||
programming based on call/N.
|
||||
|
||||
Lambda expressions are represented by ordinary Prolog terms.
|
||||
There are two kinds of lambda expressions:
|
||||
|
||||
```
|
||||
Free+\X1^X2^ ..^XN^Goal
|
||||
|
||||
\X1^X2^ ..^XN^Goal
|
||||
```
|
||||
|
||||
The second is a shorthand for `t+\X1^X2^..^XN^Goal`.
|
||||
|
||||
Xi are the parameters.
|
||||
|
||||
Goal is a goal or continuation. Syntax note: Operators within Goal
|
||||
require parentheses due to the low precedence of the ^ operator.
|
||||
|
||||
Free contains variables that are valid outside the scope of the lambda
|
||||
expression. They are thus free variables within.
|
||||
|
||||
All other variables of Goal are considered local variables. They must
|
||||
not appear outside the lambda expression. This restriction is
|
||||
currently not checked. Violations may lead to unexpected bindings.
|
||||
|
||||
In the following example the parentheses around X>3 are necessary.
|
||||
|
||||
```
|
||||
?- use_module(library(lambda)).
|
||||
?- use_module(library(lists)).
|
||||
|
||||
?- maplist(\X^(X>3),[4,5,9]).
|
||||
true.
|
||||
```
|
||||
|
||||
In the following X is a variable that is shared by both instances of
|
||||
the lambda expression. The second query illustrates the cooperation of
|
||||
continuations and lambdas. The lambda expression is in this case a
|
||||
continuation expecting a further argument.
|
||||
|
||||
```
|
||||
?- use_module(library(dif)).
|
||||
true.
|
||||
|
||||
?- Xs = [A,B], maplist(X+\Y^dif(X,Y), Xs).
|
||||
Xs = [A,B], dif:dif(X,A), dif:dif(X,B).
|
||||
|
||||
?- Xs = [A,B], maplist(X+\dif(X), Xs).
|
||||
Xs = [A,B], dif:dif(X,A), dif:dif(X,B).
|
||||
```
|
||||
|
||||
The following queries are all equivalent. To see this, use
|
||||
the fact `f(x,y)`.
|
||||
|
||||
```
|
||||
?- call(f,A1,A2).
|
||||
?- call(\X^f(X),A1,A2).
|
||||
?- call(\X^Y^f(X,Y), A1,A2).
|
||||
?- call(\X^(X+\Y^f(X,Y)), A1,A2).
|
||||
?- call(call(f, A1),A2).
|
||||
?- call(f(A1),A2).
|
||||
?- f(A1,A2).
|
||||
A1 = x, A2 = y.
|
||||
```
|
||||
|
||||
Further discussions
|
||||
[http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/ISO-Hiord](http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/ISO-Hiord)
|
||||
|
||||
@tbd Static expansion similar to apply_macros.
|
||||
@author Ulrich Neumerkel
|
||||
*/
|
||||
|
||||
:- meta_predicate ^(?,0,?).
|
||||
:- meta_predicate ^(?,1,?,?).
|
||||
:- meta_predicate ^(?,2,?,?,?).
|
||||
:- meta_predicate ^(?,3,?,?,?,?).
|
||||
:- meta_predicate ^(?,4,?,?,?,?,?).
|
||||
:- meta_predicate ^(?,5,?,?,?,?,?,?).
|
||||
:- meta_predicate ^(?,6,?,?,?,?,?,?,?).
|
||||
:- meta_predicate ^(?,7,?,?,?,?,?,?,?,?).
|
||||
:- meta_predicate \(0).
|
||||
:- meta_predicate \(1,?).
|
||||
:- meta_predicate \(2,?,?).
|
||||
:- meta_predicate \(3,?,?,?).
|
||||
:- meta_predicate \(4,?,?,?,?).
|
||||
:- meta_predicate \(5,?,?,?,?,?).
|
||||
:- meta_predicate \(6,?,?,?,?,?,?).
|
||||
:- meta_predicate \(7,?,?,?,?,?,?,?).
|
||||
:- meta_predicate +\(?,0).
|
||||
:- meta_predicate +\(?,1,?).
|
||||
:- meta_predicate +\(?,2,?,?).
|
||||
:- meta_predicate +\(?,3,?,?,?).
|
||||
:- meta_predicate +\(?,4,?,?,?,?).
|
||||
:- meta_predicate +\(?,5,?,?,?,?,?).
|
||||
:- meta_predicate +\(?,6,?,?,?,?,?,?).
|
||||
:- meta_predicate +\(?,7,?,?,?,?,?,?,?).
|
||||
|
||||
:- meta_predicate no_hat_call(0).
|
||||
|
||||
^(V1,C_0,V1) :-
|
||||
no_hat_call(C_0).
|
||||
^(V1,C_1,V1,V2) :-
|
||||
call(C_1,V2).
|
||||
^(V1,C_2,V1,V2,V3) :-
|
||||
call(C_2,V2,V3).
|
||||
^(V1,C_3,V1,V2,V3,V4) :-
|
||||
call(C_3,V2,V3,V4).
|
||||
^(V1,C_4,V1,V2,V3,V4,V5) :-
|
||||
call(C_4,V2,V3,V4,V5).
|
||||
^(V1,C_5,V1,V2,V3,V4,V5,V6) :-
|
||||
call(C_5,V2,V3,V4,V5,V6).
|
||||
^(V1,C_6,V1,V2,V3,V4,V5,V6,V7) :-
|
||||
call(C_6,V2,V3,V4,V5,V6,V7).
|
||||
^(V1,C_7,V1,V2,V3,V4,V5,V6,V7,V8) :-
|
||||
call(C_7,V2,V3,V4,V5,V6,V7,V8).
|
||||
|
||||
\(FC_0) :-
|
||||
copy_term_nat(FC_0,C_0),
|
||||
no_hat_call(C_0).
|
||||
\(FC_1,V1) :-
|
||||
copy_term_nat(FC_1,C_1),
|
||||
call(C_1,V1).
|
||||
\(FC_2,V1,V2) :-
|
||||
copy_term_nat(FC_2,C_2),
|
||||
call(C_2,V1,V2).
|
||||
\(FC_3,V1,V2,V3) :-
|
||||
copy_term_nat(FC_3,C_3),
|
||||
call(C_3,V1,V2,V3).
|
||||
\(FC_4,V1,V2,V3,V4) :-
|
||||
copy_term_nat(FC_4,C_4),
|
||||
call(C_4,V1,V2,V3,V4).
|
||||
\(FC_5,V1,V2,V3,V4,V5) :-
|
||||
copy_term_nat(FC_5,C_5),
|
||||
call(C_5,V1,V2,V3,V4,V5).
|
||||
\(FC_6,V1,V2,V3,V4,V5,V6) :-
|
||||
copy_term_nat(FC_6,C_6),
|
||||
call(C_6,V1,V2,V3,V4,V5,V6).
|
||||
\(FC_7,V1,V2,V3,V4,V5,V6,V7) :-
|
||||
copy_term_nat(FC_7,C_7),
|
||||
call(C_7,V1,V2,V3,V4,V5,V6,V7).
|
||||
|
||||
|
||||
+\(GV,FC_0) :-
|
||||
copy_term_nat(GV+FC_0,GV+C_0),
|
||||
no_hat_call(C_0).
|
||||
+\(GV,FC_1,V1) :-
|
||||
copy_term_nat(GV+FC_1,GV+C_1),
|
||||
call(C_1,V1).
|
||||
+\(GV,FC_2,V1,V2) :-
|
||||
copy_term_nat(GV+FC_2,GV+C_2),
|
||||
call(C_2,V1,V2).
|
||||
+\(GV,FC_3,V1,V2,V3) :-
|
||||
copy_term_nat(GV+FC_3,GV+C_3),
|
||||
call(C_3,V1,V2,V3).
|
||||
+\(GV,FC_4,V1,V2,V3,V4) :-
|
||||
copy_term_nat(GV+FC_4,GV+C_4),
|
||||
call(C_4,V1,V2,V3,V4).
|
||||
+\(GV,FC_5,V1,V2,V3,V4,V5) :-
|
||||
copy_term_nat(GV+FC_5,GV+C_5),
|
||||
call(C_5,V1,V2,V3,V4,V5).
|
||||
+\(GV,FC_6,V1,V2,V3,V4,V5,V6) :-
|
||||
copy_term_nat(GV+FC_6,GV+C_6),
|
||||
call(C_6,V1,V2,V3,V4,V5,V6).
|
||||
+\(GV,FC_7,V1,V2,V3,V4,V5,V6,V7) :-
|
||||
copy_term_nat(GV+FC_7,GV+C_7),
|
||||
call(C_7,V1,V2,V3,V4,V5,V6,V7).
|
||||
|
||||
|
||||
%% no_hat_call(:Goal_0)
|
||||
%
|
||||
% Like call, but issues an error for a goal (^)/2. Such goals are
|
||||
% likely the result of an insufficient number of arguments.
|
||||
|
||||
no_hat_call(MGoal_0) :-
|
||||
strip_module(MGoal_0, _, Goal_0),
|
||||
( nonvar(Goal_0),
|
||||
Goal_0 = (_^_)
|
||||
-> throw(
|
||||
error(
|
||||
existence_error(lambda_parameter,MGoal_0),
|
||||
_))
|
||||
; call(MGoal_0)
|
||||
).
|
||||
|
||||
% I would like to replace this by:
|
||||
% V1^Goal :- throw(error(existence_error(lambda_parameter,V1^Goal),_)).
|
||||
476
src/lib/lists.pl
476
src/lib/lists.pl
@@ -1,183 +1,62 @@
|
||||
/**
|
||||
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,
|
||||
maplist/7, maplist/8, maplist/9, same_length/2, nth0/3, nth0/4, nth1/3, nth1/4,
|
||||
sum_list/2, transpose/2, list_to_set/2, list_max/2,
|
||||
list_min/2, permutation/2]).
|
||||
|
||||
/* Author: Mark Thom, Jan Wielemaker, and Richard O'Keefe
|
||||
Copyright (c) 2018-2021, Mark Thom
|
||||
Copyright (c) 2002-2020, University of Amsterdam
|
||||
VU University Amsterdam
|
||||
SWI-Prolog Solutions b.v.
|
||||
All rights reserved.
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions
|
||||
are met:
|
||||
1. Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
2. Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions and the following disclaimer in
|
||||
the documentation and/or other materials provided with the
|
||||
distribution.
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
|
||||
FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
|
||||
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
|
||||
BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
|
||||
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||||
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
|
||||
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGE.
|
||||
*/
|
||||
memberchk/2, reverse/2, length/2, maplist/2,
|
||||
maplist/3, maplist/4, maplist/5, maplist/6,
|
||||
maplist/7, maplist/8, maplist/9, same_length/2, nth0/3,
|
||||
sum_list/2, transpose/2, list_to_set/2]).
|
||||
|
||||
|
||||
:- use_module(library(error)).
|
||||
|
||||
|
||||
:- meta_predicate maplist(1, ?).
|
||||
:- meta_predicate maplist(2, ?, ?).
|
||||
:- meta_predicate maplist(3, ?, ?, ?).
|
||||
:- meta_predicate maplist(4, ?, ?, ?, ?).
|
||||
:- meta_predicate maplist(5, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate maplist(6, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate maplist(7, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate maplist(8, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
|
||||
:- meta_predicate foldl(3, ?, ?, ?).
|
||||
:- meta_predicate foldl(4, ?, ?, ?, ?).
|
||||
|
||||
:- use_module(library(error)).
|
||||
|
||||
:- meta_predicate(resource_error(+,:)).
|
||||
|
||||
resource_error(Resource, Context) :-
|
||||
throw(error(resource_error(Resource), Context)).
|
||||
|
||||
%% length(?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),
|
||||
!,
|
||||
( Xs == [] -> N = M
|
||||
; nonvar(Xs) -> var(N), Xs = [_|_], resource_error(finite_memory,length/2)
|
||||
; nonvar(N) -> R is N-M, length_rundown(Xs, R)
|
||||
; N == Xs -> failingvarskip(Xs), resource_error(finite_memory,length/2)
|
||||
; length_addendum(Xs, N, M)
|
||||
).
|
||||
length(Xs, N) :-
|
||||
var(N), !,
|
||||
'$skip_max_list'(M, -1, Xs, Xs0),
|
||||
( Xs0 == [] -> N = M
|
||||
; var(Xs0) -> length_addendum(Xs0, N, M)).
|
||||
length(Xs, N) :-
|
||||
integer(N),
|
||||
N >= 0, !,
|
||||
'$skip_max_list'(M, N, Xs, Xs0),
|
||||
( Xs0 == [] -> N = M
|
||||
; var(Xs0) -> R is N-M, length_rundown(Xs0, R)).
|
||||
length(_, N) :-
|
||||
integer(N), !,
|
||||
domain_error(not_less_than_zero, N, length/2).
|
||||
integer(N), !,
|
||||
domain_error(not_less_than_zero, N, length/2).
|
||||
length(_, N) :-
|
||||
type_error(integer, N, length/2).
|
||||
|
||||
length_rundown(Xs, 0) :- !, Xs = [].
|
||||
length_rundown(Vs, N) :-
|
||||
'$unattributed_var'(Vs), % unconstrained
|
||||
!,
|
||||
'$det_length_rundown'(Vs, N).
|
||||
length_rundown([_|Xs], N) :- % force unification
|
||||
N1 is N-1,
|
||||
length(Xs, N1). % maybe some new info on Xs
|
||||
|
||||
failingvarskip(Xs) :-
|
||||
'$unattributed_var'(Xs), % unconstrained
|
||||
!.
|
||||
failingvarskip([_|Xs0]) :- % force unification
|
||||
'$skip_max_list'(_, _, Xs0,Xs),
|
||||
( nonvar(Xs) -> Xs = [_|_]
|
||||
; failingvarskip(Xs)
|
||||
).
|
||||
type_error(integer, N, length/2).
|
||||
|
||||
length_addendum([], N, N).
|
||||
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
|
||||
% ; ... .
|
||||
% ```
|
||||
length_rundown(Xs, 0) :- !, Xs = [].
|
||||
length_rundown([_|Xs], N) :-
|
||||
N1 is N-1,
|
||||
length_rundown(Xs, N1).
|
||||
|
||||
member(X, [L|Ls]) :-
|
||||
member_(Ls, L, X).
|
||||
|
||||
member_(_, X, X).
|
||||
member_([L|Ls], _, X) :-
|
||||
member_(Ls, L, X).
|
||||
member(X, [X|_]).
|
||||
member(X, [_|Xs]) :- member(X, Xs).
|
||||
|
||||
|
||||
%% 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)
|
||||
@@ -187,164 +66,93 @@ 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).
|
||||
foldl(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(_, [], A, A).
|
||||
foldl(G_3, [L|Ls], A0, A) :-
|
||||
foldl(Goal_3, Ls, A0, A) :-
|
||||
foldl_(Ls, Goal_3, A0, A).
|
||||
|
||||
foldl_([], _, A, A).
|
||||
foldl_([L|Ls], G_3, A0, A) :-
|
||||
call(G_3, L, A0, A1),
|
||||
foldl(G_3, Ls, A1, A).
|
||||
foldl_(Ls, G_3, A1, A).
|
||||
|
||||
%% foldl(+Predicate, ?Ls0, ?Ls1, +A0, ?A).
|
||||
%
|
||||
% Same as `foldl/4` but with an extra list
|
||||
|
||||
foldl(_, [], [], A, A).
|
||||
foldl(G_4, [X|Xs], [Y|Ys], A0, A) :-
|
||||
foldl(Goal_4, Xs, Ys, A0, A) :-
|
||||
foldl_(Xs, Ys, Goal_4, A0, A).
|
||||
|
||||
foldl_([], [], _, A, A).
|
||||
foldl_([X|Xs], [Y|Ys], G_4, A0, A) :-
|
||||
call(G_4, X, Y, A0, A1),
|
||||
foldl(G_4, Xs, Ys, A1, A).
|
||||
foldl_(Xs, Ys, G_4, 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).
|
||||
|
||||
lists_transpose([], []).
|
||||
lists_transpose([L|Ls], Ts) :-
|
||||
maplist(lists:same_length(L), Ls),
|
||||
foldl(lists:transpose_, L, Ts, [L|Ls], _).
|
||||
maplist(same_length(L), Ls),
|
||||
foldl(transpose_, L, Ts, [L|Ls], _).
|
||||
|
||||
transpose_(_, Fs, Lists0, Lists) :-
|
||||
maplist(lists:list_first_rest, Lists0, Fs, Lists).
|
||||
maplist(list_first_rest, Lists0, Fs, 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),
|
||||
maplist(with_var, Ls0, LVs0),
|
||||
keysort(LVs0, LVs),
|
||||
same_elements(LVs),
|
||||
pick_firsts(LVs0, Ls).
|
||||
@@ -362,7 +170,7 @@ with_var(E, E-_).
|
||||
|
||||
same_elements([]).
|
||||
same_elements([EV|EVs]) :-
|
||||
foldl(lists:unify_same, EVs, EV, _).
|
||||
foldl(unify_same, EVs, EV, _).
|
||||
|
||||
unify_same(E-V, Prev-Var, E-V) :-
|
||||
( Prev == E ->
|
||||
@@ -370,171 +178,25 @@ 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),
|
||||
!,
|
||||
( Skip == N
|
||||
-> Es1 = [E|_]
|
||||
; ( var(Es1) ; Es1 = [_|_] ) % a partial or infinite list
|
||||
-> R is N-Skip,
|
||||
skipn(R,Es1,Es2),
|
||||
Es2 = [E|_]
|
||||
).
|
||||
nth0(N, Es0, E) :-
|
||||
can_be(not_less_than_zero, N),
|
||||
Es0 = [E0|Es1],
|
||||
nth0_el(0,N, E0,E, Es1).
|
||||
|
||||
skipn(N0, Es0,Es) :-
|
||||
N0>0,
|
||||
N1 is N0-1,
|
||||
Es0 = [_|Es1],
|
||||
skipn(N1, Es1,Es).
|
||||
skipn(0, Es,Es).
|
||||
nth0(N, Es, E) :-
|
||||
can_be(integer, N),
|
||||
can_be(list, Es),
|
||||
( integer(N) ->
|
||||
nth0_index(N, Es, E)
|
||||
; nth0_search(N, Es, E)
|
||||
).
|
||||
|
||||
nth0_el(N0,N, E0,E, Es0) :-
|
||||
Es0 == [],
|
||||
!, % indexing
|
||||
N0 = N,
|
||||
E0 = E.
|
||||
nth0_el(N,N, E,E, _).
|
||||
nth0_el(N0,N, _,E, [E0|Es0]) :-
|
||||
N1 is N0+1,
|
||||
nth0_el(N1,N, E0,E, Es0).
|
||||
nth0_index(0, [E|_], E) :- !.
|
||||
nth0_index(N, [_|Es], E) :-
|
||||
N > 0,
|
||||
N1 is N - 1,
|
||||
nth0_index(N1, Es, E).
|
||||
|
||||
%% 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),
|
||||
N \== 0.
|
||||
nth0_search(N, Es, E) :-
|
||||
nth0_search(0, N, Es, E).
|
||||
|
||||
skipn(N0, Es0,Es, Xs0,Xs) :-
|
||||
N0>0,
|
||||
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,
|
||||
!,
|
||||
skipn(N, Es0,Es1, Es,Es2),
|
||||
Es1 = [E|Es2].
|
||||
nth0(N, Es0, E, Es) :-
|
||||
can_be(not_less_than_zero, N),
|
||||
Es0 = [E0|Es1],
|
||||
nth0_elx(0,N, E0,E, Es1, Es).
|
||||
|
||||
nth0_elx(N0,N, E0,E, Es0, Es) :-
|
||||
Es0 == [],
|
||||
!,
|
||||
N0 = N,
|
||||
E0 = E,
|
||||
Es0 = Es.
|
||||
nth0_elx(N,N, E,E, Es, Es).
|
||||
nth0_elx(N0,N, E0,E, [E1|Es0], [E0|Es]) :-
|
||||
N1 is N0+1,
|
||||
nth0_elx(N1,N, E1,E, Es0, Es).
|
||||
|
||||
% p.p.8.5
|
||||
|
||||
%% nth1(?N, ?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.
|
||||
%
|
||||
% True when Xs is a permutation of Ys. This can solve for Ys given
|
||||
% Xs or Xs given Ys, or even enumerate Xs and Ys together. The
|
||||
% predicate `permutation/2` is primarily intended to generate
|
||||
% permutations. Note that a list of length N has N! permutations,
|
||||
% and unbounded permutation generation becomes prohibitively
|
||||
% expensive, even for rather short lists (10! = 3,628,800).
|
||||
%
|
||||
% The example below illustrates that Xs and Ys being proper lists
|
||||
% is not a sufficient condition to use the above replacement.
|
||||
%
|
||||
% ```
|
||||
% ?- permutation([1,2], [X,Y]).
|
||||
% X = 1, Y = 2
|
||||
% ; X = 2, Y = 1
|
||||
% ; false.
|
||||
% ```
|
||||
%
|
||||
% Throws `type_error(list, Arg)` if either argument is not a proper
|
||||
% or partial list.
|
||||
|
||||
permutation(Xs, Ys) :-
|
||||
'$skip_max_list'(Xlen, _, Xs, XTail),
|
||||
'$skip_max_list'(Ylen, _, Ys, YTail),
|
||||
( XTail == [], YTail == [] % both proper lists
|
||||
-> Xlen == Ylen
|
||||
; var(XTail), YTail == [] % partial, proper
|
||||
-> length(Xs, Ylen)
|
||||
; XTail == [], var(YTail) % proper, partial
|
||||
-> length(Ys, Xlen)
|
||||
; var(XTail), var(YTail) % partial, partial
|
||||
-> length(Xs, Len),
|
||||
length(Ys, Len)
|
||||
; must_be(list, Xs), % either is not a list
|
||||
must_be(list, Ys)
|
||||
),
|
||||
perm(Xs, Ys).
|
||||
|
||||
perm([], []).
|
||||
perm(List, [First|Perm]) :-
|
||||
select(First, List, Rest),
|
||||
perm(Rest, Perm).
|
||||
nth0_search(N, N, [E|_], E).
|
||||
nth0_search(N0, N, [_|Es], E) :-
|
||||
N1 is N0 + 1,
|
||||
nth0_search(N1, N, Es, E).
|
||||
|
||||
@@ -1,129 +0,0 @@
|
||||
:- op(400, yfx, /).
|
||||
|
||||
% module resolution operator.
|
||||
:- op(600, xfy, :).
|
||||
|
||||
:- op(1199, fx, meta_predicate).
|
||||
|
||||
/* this is an implementation specific declarative operator used to implement call_with_inference_limit/3
|
||||
and setup_call_cleanup/3. switches to the default trust_me and retry_me_else. Indexing choice
|
||||
instructions are unchanged. */
|
||||
:- op(700, fx, non_counted_backtracking).
|
||||
|
||||
% arithmetic operators.
|
||||
:- op(700, xfx, is).
|
||||
:- op(500, yfx, +).
|
||||
:- op(500, yfx, -).
|
||||
:- op(400, yfx, *).
|
||||
:- op(200, xfx, **).
|
||||
:- op(200, xfy, ^).
|
||||
:- op(500, yfx, /\).
|
||||
:- op(500, yfx, \/).
|
||||
:- op(500, yfx, xor).
|
||||
:- op(400, yfx, div).
|
||||
:- op(400, yfx, //).
|
||||
:- op(400, yfx, rdiv).
|
||||
:- op(400, yfx, <<).
|
||||
:- op(400, yfx, >>).
|
||||
:- op(400, yfx, mod).
|
||||
:- op(400, yfx, rem).
|
||||
:- op(200, fy, +).
|
||||
:- op(200, fy, -).
|
||||
:- op(200, fy, \).
|
||||
|
||||
% arithmetic comparison operators.
|
||||
:- op(700, xfx, >).
|
||||
:- op(700, xfx, <).
|
||||
:- op(700, xfx, =\=).
|
||||
:- op(700, xfx, =:=).
|
||||
:- op(700, xfx, >=).
|
||||
:- op(700, xfx, =<).
|
||||
|
||||
% term comparison.
|
||||
:- op(700, xfx, ==).
|
||||
:- op(700, xfx, \==).
|
||||
:- op(700, xfx, @=<).
|
||||
:- op(700, xfx, @>=).
|
||||
:- op(700, xfx, @<).
|
||||
:- op(700, xfx, @>).
|
||||
|
||||
% conditional operators.
|
||||
:- op(1050, xfy, ->).
|
||||
:- op(1100, xfy, ;).
|
||||
|
||||
% control.
|
||||
:- op(700, xfx, =).
|
||||
:- op(700, xfx, =..).
|
||||
:- op(700, xfx, \=).
|
||||
:- op(900, fy, \+).
|
||||
|
||||
:- op(1200, xfx, -->).
|
||||
|
||||
% meta_predicate declarations for call/{1, 66}.
|
||||
:- meta_predicate call(0).
|
||||
:- meta_predicate call(1, ?).
|
||||
:- meta_predicate call(2, ?, ?).
|
||||
:- meta_predicate call(3, ?, ?, ?).
|
||||
:- meta_predicate call(4, ?, ?, ?, ?).
|
||||
:- meta_predicate call(5, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(6, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(7, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(8, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(9, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(10, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(11, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(12, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(13, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(14, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(15, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(16, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(17, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(18, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(19, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(20, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(21, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(22, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(23, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(24, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(25, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(26, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(27, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(28, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(29, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(30, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(31, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(32, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(33, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(34, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(35, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(36, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(37, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(38, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(39, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(40, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(41, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(42, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(43, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(44, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(45, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(46, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(47, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(48, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(49, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(50, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(51, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(52, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(53, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(54, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(55, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(56, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(57, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(58, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(59, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(60, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(60, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(61, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(62, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(63, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(64, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
:- meta_predicate call(65, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?).
|
||||
@@ -54,41 +54,42 @@
|
||||
|
||||
:- use_module(library(lists)).
|
||||
|
||||
/** Ordered set manipulation
|
||||
|
||||
/** <module> 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.
|
||||
compatible with common practice in the Prolog community. The
|
||||
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
|
||||
`ord_memberchk/2`.
|
||||
|
||||
clear you are operating on ordered sets. An exception is member/2. See
|
||||
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
|
||||
% expect ordered sets as input arguments. Failing to fullfil this
|
||||
% assumption results in undefined behaviour. Typically, ordered
|
||||
% sets are created by predicates from this library, `sort/2` or
|
||||
% `setof/3`.
|
||||
% True if Term is an ordered set. All predicates in this library
|
||||
% expect ordered sets as input arguments. Failing to fullfil this
|
||||
% assumption results in undefined behaviour. Typically, ordered
|
||||
% sets are created by predicates from this library, sort/2 or
|
||||
% setof/3.
|
||||
|
||||
is_ordset(Term) :-
|
||||
'$skip_max_list'(_, _, Term, Tail), Tail == [], %% is_list(Term),
|
||||
'$skip_max_list'(_, -1, Term, Tail), Tail == [], %% is_list(Term),
|
||||
is_ordset2(Term).
|
||||
|
||||
is_ordset2([]).
|
||||
@@ -101,35 +102,37 @@ 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
|
||||
% with the empty list. Not part of Quintus.
|
||||
% True when List is the empty ordered set. Simply unifies list
|
||||
% 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
|
||||
% canonical sorted lists, this is the same as `==/2`.
|
||||
% True if Set1 and Set2 have the same elements. As both are
|
||||
% 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
|
||||
% sorting the list.
|
||||
% Transform a list into an ordered set. This is the same as
|
||||
% 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).
|
||||
@@ -145,29 +148,31 @@ 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
|
||||
% negation of `ord_intersect/2`.
|
||||
% True if Set1 and Set2 have no common elements. This is the
|
||||
% 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.
|
||||
%
|
||||
% This predicate is *deprecated*. Use `ord_intersection/3`
|
||||
% @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
|
||||
% set holding all elements common to all sets in PowerSet.
|
||||
% Intersection of a powerset. True when Intersection is an ordered
|
||||
% set holding all elements common to all sets in PowerSet.
|
||||
%
|
||||
% @compat sicstus
|
||||
|
||||
ord_intersection(PowerSet, Intersection) :-
|
||||
key_by_length(PowerSet, Pairs),
|
||||
@@ -185,10 +190,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
|
||||
% `ord_disjoint/2` if Intersection is bound to `[]` on entry.
|
||||
% Intersection holds the common elements of Set1 and Set2. Uses
|
||||
% ord_disjoint/2 if Intersection is bound to `[]` on entry.
|
||||
|
||||
ord_intersection(Set1, Set2, Intersection) :-
|
||||
( Intersection == []
|
||||
@@ -197,11 +202,13 @@ 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 is the intersection between Set1 and Set2, while
|
||||
% Difference is defined by `ord_subtract(Set2, Set1, Difference)`.
|
||||
% Intersection and difference between two ordered sets.
|
||||
% Intersection is the intersection between Set1 and Set2, while
|
||||
% Difference is defined by ord_subtract(Set2, Set1, Difference).
|
||||
%
|
||||
% @see ord_intersection/3 and ord_subtract/3.
|
||||
|
||||
ord_intersection([], L, [], L) :- !.
|
||||
ord_intersection([_|_], [], [], []) :- !.
|
||||
@@ -217,35 +224,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
|
||||
% `ord_union(Set1, [Element], Set2)`.
|
||||
% Insert an element into the set. This is the same as
|
||||
% 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
|
||||
% `ord_subtract(Set, [Element], NewSet)`.
|
||||
% Delete an element from an ordered set. This is the same as
|
||||
% 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
|
||||
% select(Item, Set1, Set2) and Set1, Set2 are both sorted lists
|
||||
% without duplicates. This implementation is only expected to work
|
||||
% for Item ground and either Set1 or Set2 ground. The "chk" suffix
|
||||
% is meant to remind you of `memberchk/2`, which also expects its
|
||||
% first argument to be ground. `ord_selectchk(X, S, T) =>
|
||||
% ord_memberchk(X, S) & \+ ord_memberchk(X, T).`
|
||||
% Selectchk/3, specialised for ordered sets. Is true when
|
||||
% select(Item, Set1, Set2) and Set1, Set2 are both sorted lists
|
||||
% without duplicates. This implementation is only expected to work
|
||||
% for Item ground and either Set1 or Set2 ground. The "chk" suffix
|
||||
% is meant to remind you of memberchk/2, which also expects its
|
||||
% first argument to be ground. ord_selectchk(X, S, 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,
|
||||
@@ -259,19 +266,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
|
||||
% that _enumerating_ elements of an ordered set can be done using
|
||||
% `member/2`.
|
||||
% True if Element is a member of OrdSet, compared using ==. Note
|
||||
% that _enumerating_ elements of an ordered set can be done using
|
||||
% member/2.
|
||||
%
|
||||
% Some Prolog implementations also provide `ord_member/2`, with the
|
||||
% same semantics as `ord_memberchk/2`. We believe that having a
|
||||
% semidet `ord_member/2` is unacceptably inconsistent with the \*\_chk
|
||||
% convention. Portable code should use `ord_memberchk/2` or
|
||||
% `member/2`.
|
||||
% Some Prolog implementations also provide ord_member/2, with the
|
||||
% same semantics as ord_memberchk/2. We believe that having a
|
||||
% semidet ord_member/2 is unacceptably inconsistent with the *_chk
|
||||
% convention. Portable code should use ord_memberchk/2 or
|
||||
% member/2.
|
||||
%
|
||||
% Author: Richard O'Keefe
|
||||
% @author Richard O'Keefe
|
||||
|
||||
ord_memberchk(Item, [X1,X2,X3,X4|Xs]) :-
|
||||
!,
|
||||
@@ -296,9 +303,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]) :-
|
||||
@@ -312,20 +319,22 @@ 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
|
||||
% NotInOSet.
|
||||
% Diff is the set holding all elements of InOSet that are not in
|
||||
% 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
|
||||
% SetOfSets. Each member of SetOfSets must be an ordered set, the
|
||||
% sets need not be ordered in any way.
|
||||
% True if Union is the union of all elements in the superset
|
||||
% SetOfSets. Each member of SetOfSets must be an ordered set, the
|
||||
% 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) :-
|
||||
@@ -346,18 +355,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
|
||||
% `ord_subtract(Set2, Set1, New)`.
|
||||
% True iff ord_union(Set1, Set2, Union) and
|
||||
% ord_subtract(Set2, Set1, New).
|
||||
|
||||
ord_union([], Set2, Set2, Set2).
|
||||
ord_union([H|T], Set2, Union, New) :-
|
||||
@@ -381,26 +390,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
|
||||
% Set2. I.e., Difference contains all elements that are not in the
|
||||
% intersection of Set1 and Set2. The semantics is the same as the
|
||||
% sequence below (but the actual implementation requires only a
|
||||
% single scan).
|
||||
% Is true when Difference is the symmetric difference of Set1 and
|
||||
% Set2. I.e., Difference contains all elements that are not in the
|
||||
% intersection of Set1 and Set2. The semantics is the same as the
|
||||
% sequence below (but the actual implementation requires only a
|
||||
% single scan).
|
||||
%
|
||||
% ```
|
||||
% ord_union(Set1, Set2, Union),
|
||||
% ord_intersection(Set1, Set2, Intersection),
|
||||
% ord_subtract(Union, Intersection, Difference).
|
||||
% ```
|
||||
% ==
|
||||
% ord_union(Set1, Set2, Union),
|
||||
% ord_intersection(Set1, Set2, Intersection),
|
||||
% ord_subtract(Union, Intersection, Difference).
|
||||
% ==
|
||||
%
|
||||
% For example:
|
||||
% For example:
|
||||
%
|
||||
% ```
|
||||
% ?- ord_symdiff([1,2], [2,3], X).
|
||||
% X = [1,3].
|
||||
% ```
|
||||
% ==
|
||||
% ?- ord_symdiff([1,2], [2,3], X).
|
||||
% X = [1,3].
|
||||
% ==
|
||||
|
||||
ord_symdiff([], Set2, Set2).
|
||||
ord_symdiff([H1|T1], Set2, Difference) :-
|
||||
@@ -448,7 +457,7 @@ ord_symdiff(>, H1, T1, H2, Set2, [H2|Difference]) :-
|
||||
*/
|
||||
|
||||
|
||||
/* Ordered set manipulation
|
||||
/** <module> Ordered set manipulation
|
||||
|
||||
This library defines set operations on sets represented as ordered
|
||||
lists.
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Predicates for reasoning about the operating system (OS) environment.
|
||||
Written July 2020 by Markus Triska (triska@metalevel.at).
|
||||
|
||||
@@ -7,87 +7,33 @@
|
||||
Example:
|
||||
|
||||
?- getenv("LANG", Ls).
|
||||
Ls = "en_US.UTF-8".
|
||||
Ls = "en_US.UTF-8"
|
||||
; false.
|
||||
|
||||
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]).
|
||||
unsetenv/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).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
For now, we only support a restricted subset of variable names.
|
||||
|
||||
|
||||
@@ -1,10 +1,3 @@
|
||||
/** 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,
|
||||
@@ -12,27 +5,12 @@
|
||||
map_list_to_pairs/3]).
|
||||
|
||||
|
||||
:- 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) :-
|
||||
|
||||
229
src/lib/pio.pl
229
src/lib/pio.pl
@@ -1,61 +1,19 @@
|
||||
/** Pure I/O.
|
||||
|
||||
Our goal is to encourage the use of definite clause grammars (DCGs)
|
||||
for describing strings. The predicates `phrase_from_file/[2,3]`,
|
||||
`phrase_to_file/[2,3]` and `phrase_to_stream/2` let us apply DCGs
|
||||
transparently to files and streams, and therefore decouple side-effects
|
||||
from declarative descriptions.
|
||||
*/
|
||||
|
||||
:- module(pio, [phrase_from_file/2,
|
||||
phrase_from_file/3,
|
||||
phrase_from_stream/2,
|
||||
phrase_to_file/2,
|
||||
phrase_to_file/3,
|
||||
phrase_to_stream/2
|
||||
]).
|
||||
phrase_from_file/3]).
|
||||
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(freeze)).
|
||||
:- use_module(library(gensym)).
|
||||
:- 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_stream(+GRBody, +Stream)
|
||||
%
|
||||
% 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.
|
||||
:- use_module(library(iso_ext), [setup_call_cleanup/3, partial_string/3]).
|
||||
:- use_module(library(lists), [member/2]).
|
||||
|
||||
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)
|
||||
; (\+ atom(File) ; File = []) ->
|
||||
domain_error(source_sink, File, phrase_from_file/3)
|
||||
; must_be(list, Options),
|
||||
( member(Var, Options), var(Var) -> instantiation_error(phrase_from_file/3)
|
||||
; member(type(Type), Options) ->
|
||||
@@ -63,167 +21,22 @@ phrase_from_file(NT, File, Options) :-
|
||||
member(Type, [text,binary])
|
||||
; Type = text
|
||||
),
|
||||
setup_call_cleanup(
|
||||
open(File, read, Stream, Options),
|
||||
phrase_from_stream(NT, Stream),
|
||||
close(Stream)
|
||||
)
|
||||
).
|
||||
|
||||
% How many chars to read from stream and buffer in each step
|
||||
chars_to_read(4096).
|
||||
|
||||
stream_to_lazy_list(Stream, Ls) :-
|
||||
get_stream_buffer_position(Stream, Pos),
|
||||
freeze(Ls, render_step(Stream, Pos, Ls)).
|
||||
|
||||
render_step(Stream, Pos, Ls) :-
|
||||
set_stream_buffer_position(Stream, Pos),
|
||||
( buffer_at_end_of_stream(Stream) ->
|
||||
Ls = []
|
||||
; chars_to_read(CharsToRead),
|
||||
buffer_get_n_chars(Stream, CharsToRead, Chars),
|
||||
partial_string(Chars, Ls, Ls0),
|
||||
stream_to_lazy_list(Stream, Ls0)
|
||||
).
|
||||
|
||||
buffer_at_end_of_stream(Stream) :-
|
||||
stream_bufferids(Stream, _, BufferPosId, _),
|
||||
bb_get(BufferPosId, Pos),
|
||||
Pos = eof.
|
||||
|
||||
get_stream_buffer_position(Stream, Pos) :-
|
||||
stream_bufferids(Stream, _, BufferPosId, _),
|
||||
bb_get(BufferPosId, Pos).
|
||||
|
||||
set_stream_buffer_position(Stream, Pos) :-
|
||||
stream_bufferids(Stream, _, BufferPosId, _),
|
||||
bb_put(BufferPosId, Pos).
|
||||
|
||||
buffer_get_n_chars(Stream, N, Chars) :-
|
||||
stream_bufferids(Stream, BufferId, BufferPosId, BufferLenId),
|
||||
buffer_prepare_for_n(Stream, BufferId, BufferPosId, BufferLenId, N),
|
||||
bb_get(BufferId, Buffer),
|
||||
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),
|
||||
must_be(chars, Cs),
|
||||
( stream_property(Stream, type(binary)) ->
|
||||
( '$first_non_octet'(Cs, N) ->
|
||||
domain_error(octet_character, N, phrase_to_stream/2)
|
||||
; true
|
||||
)
|
||||
; true
|
||||
),
|
||||
% we use a specialised internal predicate that uses only a
|
||||
% single "write" operation for efficiency. It is equivalent to
|
||||
% maplist(put_char(Stream), Cs). It also works for binary streams.
|
||||
'$put_chars'(Stream, Cs).
|
||||
|
||||
%% phrase_to_file(+GRBody, +File)
|
||||
%
|
||||
% Write the string described by GRBody to File.
|
||||
|
||||
phrase_to_file(GRBody, File) :-
|
||||
phrase_to_file(GRBody, File, []).
|
||||
setup_call_cleanup(open(File, read, Stream, [reposition(true)|Options]),
|
||||
( stream_to_lazy_list(Stream, Xs),
|
||||
phrase(NT, Xs) ),
|
||||
close(Stream))
|
||||
).
|
||||
|
||||
|
||||
%% phrase_to_file(+GRBody, +File, +Options)
|
||||
%
|
||||
% Like `phrase_to_file/2`, using Options to open the file.
|
||||
stream_to_lazy_list(Stream, Xs) :-
|
||||
stream_property(Stream, position(Pos)),
|
||||
freeze(Xs, reader_step(Stream, Pos, Xs)).
|
||||
|
||||
phrase_to_file(GRBody, File, Options) :-
|
||||
setup_call_cleanup(open(File, write, Stream, Options),
|
||||
phrase_to_stream(GRBody, Stream),
|
||||
close(Stream)).
|
||||
reader_step(Stream, Pos, Xs0) :-
|
||||
set_stream_position(Stream, Pos),
|
||||
( at_end_of_stream(Stream)
|
||||
-> Xs0 = []
|
||||
; '$get_n_chars'(Stream, 4096, Cs),
|
||||
partial_string(Cs, Xs0, Xs),
|
||||
stream_to_lazy_list(Stream, Xs)
|
||||
).
|
||||
|
||||
@@ -1,46 +1,32 @@
|
||||
/**
|
||||
This library provides probabilistic predicates and random number generators.
|
||||
|
||||
To retain desirable declarative properties, predicates that internally
|
||||
use random numbers should be equipped with an argument that specifies
|
||||
the random seed. This makes everything completely reproducible.
|
||||
*/
|
||||
|
||||
:- module(random, [maybe/0, random/1, random_integer/3, set_random/1]).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
To retain desirable declarative properties, predicates that internally
|
||||
use random numbers should be equipped with an argument that specifies
|
||||
the random seed. This makes everything completely reproducible.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
:- use_module(library(error)).
|
||||
|
||||
%% maybe.
|
||||
%
|
||||
% Succeeds with probability 0.5.
|
||||
% 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)) ->
|
||||
instantiation_error(random_integer/3)
|
||||
instantiation_error(random_integer/3)
|
||||
; \+ integer(Lower) ->
|
||||
type_error(integer, Lower, random_integer/3)
|
||||
domain_error(integer, Lower, random_integer/3)
|
||||
; \+ integer(Upper) ->
|
||||
type_error(integer, Upper, random_integer/3)
|
||||
domain_error(integer, Upper, random_integer/3)
|
||||
; Upper > Lower,
|
||||
random(R0),
|
||||
R is floor((Upper - Lower) * R0 + Lower)
|
||||
@@ -60,10 +46,6 @@ 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) ->
|
||||
|
||||
@@ -1,24 +1,9 @@
|
||||
/** 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]).
|
||||
memberd_t/3, tfilter/3, tmember/2, tmember_t/3,
|
||||
tpartition/4]).
|
||||
|
||||
:- use_module(library(dif)).
|
||||
|
||||
:- meta_predicate(if_(1, 0, 0)).
|
||||
|
||||
if_(If_1, Then_0, Else_0) :-
|
||||
call(If_1, T),
|
||||
( T == true -> call(Then_0)
|
||||
@@ -41,14 +26,13 @@ dif(X, Y, T) :-
|
||||
non(true, false).
|
||||
non(false, true).
|
||||
|
||||
:- meta_predicate(tfilter(2, ?, ?)).
|
||||
tfilter(C_2, Es, Fs) :-
|
||||
i_tfilter(Es, C_2, Fs).
|
||||
|
||||
tfilter(_, [], []).
|
||||
tfilter(C_2, [E|Es], Fs0) :-
|
||||
i_tfilter([], _, []).
|
||||
i_tfilter([E|Es], C_2, Fs0) :-
|
||||
if_(call(C_2, E), Fs0 = [E|Fs], Fs0 = Fs),
|
||||
tfilter(C_2, Es, Fs).
|
||||
|
||||
:- meta_predicate(tpartition(2, ?, ?, ?)).
|
||||
i_tfilter(Es, C_2, Fs).
|
||||
|
||||
tpartition(P_2, Xs, Ts, Fs) :-
|
||||
i_tpartition(Xs, P_2, Ts, Fs).
|
||||
@@ -60,18 +44,12 @@ i_tpartition([X|Xs], P_2, Ts0, Fs0) :-
|
||||
, ( Fs0 = [X|Fs], Ts0 = Ts ) ),
|
||||
i_tpartition(Xs, P_2, Ts, Fs).
|
||||
|
||||
:- meta_predicate(','(1, 1, ?)).
|
||||
|
||||
','(A_1, B_1, T) :-
|
||||
if_(A_1, call(B_1, T), T = false).
|
||||
|
||||
:- meta_predicate(';'(1, 1, ?)).
|
||||
|
||||
';'(A_1, B_1, T) :-
|
||||
if_(A_1, T = true, call(B_1, T)).
|
||||
|
||||
:- meta_predicate(cond_t(1, 0, ?)).
|
||||
|
||||
cond_t(If_1, Then_0, T) :-
|
||||
if_(If_1, ( Then_0, T = true ), T = false ).
|
||||
|
||||
@@ -82,13 +60,8 @@ i_memberd_t([], _, false).
|
||||
i_memberd_t([X|Xs], E, T) :-
|
||||
if_( X = E, T = true, i_memberd_t(Xs, E, T) ).
|
||||
|
||||
:- meta_predicate(tmember(2, ?)).
|
||||
|
||||
tmember(P_2, [X|Xs]) :-
|
||||
if_( call(P_2, X), true, tmember(P_2, Xs) ).
|
||||
|
||||
:- meta_predicate(tmember_t(2, ?, ?)).
|
||||
|
||||
tmember_t(_P_2, [], false).
|
||||
tmember_t(P_2, [X|Xs], T) :-
|
||||
if_( call(P_2, X), T = true, tmember_t(P_2, Xs, T) ).
|
||||
|
||||
@@ -1,166 +0,0 @@
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Written Apr 2021 by Aram Panasenco (panasenco@ucla.edu)
|
||||
Part of Scryer Prolog.
|
||||
|
||||
[Core Rules](https://tools.ietf.org/html/rfc5234#appendix-B.1) of the
|
||||
Augmented Backus-Naur Form specification (ABNF - RFC 5234). ABNF commonly
|
||||
serves as the definition language for IETF communication protocols, so
|
||||
having these DCGs can be extremely useful for reasoning about most IETF
|
||||
syntaxes. The DCGs are presented in the order they appear in the RFC.
|
||||
While some DCGs below use `char_type/2`, the most common ones are defined
|
||||
manually in order to take advantage of Prolog's first-argument indexing.
|
||||
|
||||
BSD 3-Clause License
|
||||
|
||||
Copyright (c) 2021, Aram Panasenco
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
* Redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer.
|
||||
|
||||
* Redistributions in binary form must reproduce the above copyright notice,
|
||||
this list of conditions and the following disclaimer in the documentation
|
||||
and/or other materials provided with the distribution.
|
||||
|
||||
* Neither the name of the copyright holder nor the names of its
|
||||
contributors may be used to endorse or promote products derived from
|
||||
this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
:- module(abnf, [abnf_alpha//1,
|
||||
abnf_bit//1,
|
||||
abnf_char//1,
|
||||
abnf_cr//0,
|
||||
abnf_crlf//0,
|
||||
abnf_ctl//1,
|
||||
abnf_digit//1,
|
||||
abnf_dquote//0,
|
||||
abnf_hexdig//1,
|
||||
abnf_htab//0,
|
||||
abnf_lf//0,
|
||||
abnf_lwsp//0,
|
||||
abnf_octet//1,
|
||||
abnf_sp//0,
|
||||
abnf_vchar//1,
|
||||
abnf_wsp//0 ]).
|
||||
|
||||
:- use_module(library(charsio)).
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(dif)).
|
||||
:- use_module(library(lists)).
|
||||
|
||||
abnf_alpha('a') --> "a".
|
||||
abnf_alpha('b') --> "b".
|
||||
abnf_alpha('c') --> "c".
|
||||
abnf_alpha('d') --> "d".
|
||||
abnf_alpha('e') --> "e".
|
||||
abnf_alpha('f') --> "f".
|
||||
abnf_alpha('g') --> "g".
|
||||
abnf_alpha('h') --> "h".
|
||||
abnf_alpha('i') --> "i".
|
||||
abnf_alpha('j') --> "j".
|
||||
abnf_alpha('k') --> "k".
|
||||
abnf_alpha('l') --> "l".
|
||||
abnf_alpha('m') --> "m".
|
||||
abnf_alpha('n') --> "n".
|
||||
abnf_alpha('o') --> "o".
|
||||
abnf_alpha('p') --> "p".
|
||||
abnf_alpha('q') --> "q".
|
||||
abnf_alpha('r') --> "r".
|
||||
abnf_alpha('s') --> "s".
|
||||
abnf_alpha('t') --> "t".
|
||||
abnf_alpha('u') --> "u".
|
||||
abnf_alpha('v') --> "v".
|
||||
abnf_alpha('w') --> "w".
|
||||
abnf_alpha('x') --> "x".
|
||||
abnf_alpha('y') --> "y".
|
||||
abnf_alpha('z') --> "z".
|
||||
abnf_alpha('A') --> "A".
|
||||
abnf_alpha('B') --> "B".
|
||||
abnf_alpha('C') --> "C".
|
||||
abnf_alpha('D') --> "D".
|
||||
abnf_alpha('E') --> "E".
|
||||
abnf_alpha('F') --> "F".
|
||||
abnf_alpha('G') --> "G".
|
||||
abnf_alpha('H') --> "H".
|
||||
abnf_alpha('I') --> "I".
|
||||
abnf_alpha('J') --> "J".
|
||||
abnf_alpha('K') --> "K".
|
||||
abnf_alpha('L') --> "L".
|
||||
abnf_alpha('M') --> "M".
|
||||
abnf_alpha('N') --> "N".
|
||||
abnf_alpha('O') --> "O".
|
||||
abnf_alpha('P') --> "P".
|
||||
abnf_alpha('Q') --> "Q".
|
||||
abnf_alpha('R') --> "R".
|
||||
abnf_alpha('S') --> "S".
|
||||
abnf_alpha('T') --> "T".
|
||||
abnf_alpha('U') --> "U".
|
||||
abnf_alpha('V') --> "V".
|
||||
abnf_alpha('W') --> "W".
|
||||
abnf_alpha('X') --> "X".
|
||||
abnf_alpha('Y') --> "Y".
|
||||
abnf_alpha('Z') --> "Z".
|
||||
|
||||
abnf_bit('0') --> "0".
|
||||
abnf_bit('1') --> "1".
|
||||
|
||||
abnf_char(Char) --> [Char], { dif(Char, '\x0000\'), char_type(Char, ascii) }. %'
|
||||
|
||||
abnf_cr --> "\r".
|
||||
|
||||
abnf_crlf --> "\r\n".
|
||||
|
||||
abnf_ctl(Char) --> [Char], { char_type(Char, ascii), char_type(Char, control) }.
|
||||
|
||||
abnf_digit('0') --> "0".
|
||||
abnf_digit('1') --> "1".
|
||||
abnf_digit('2') --> "2".
|
||||
abnf_digit('3') --> "3".
|
||||
abnf_digit('4') --> "4".
|
||||
abnf_digit('5') --> "5".
|
||||
abnf_digit('6') --> "6".
|
||||
abnf_digit('7') --> "7".
|
||||
abnf_digit('8') --> "8".
|
||||
abnf_digit('9') --> "9".
|
||||
|
||||
abnf_dquote --> "\"".
|
||||
|
||||
abnf_hexdig(Char) --> abnf_digit(Char).
|
||||
abnf_hexdig('A') --> "A".
|
||||
abnf_hexdig('B') --> "B".
|
||||
abnf_hexdig('C') --> "C".
|
||||
abnf_hexdig('D') --> "D".
|
||||
abnf_hexdig('E') --> "E".
|
||||
abnf_hexdig('F') --> "F".
|
||||
|
||||
abnf_htab --> "\t".
|
||||
|
||||
abnf_lf --> "\n".
|
||||
|
||||
abnf_lwsp --> "".
|
||||
abnf_lwsp --> abnf_wsp, abnf_lwsp.
|
||||
abnf_lwsp --> abnf_crlf, abnf_wsp, abnf_lwsp.
|
||||
|
||||
abnf_octet(Char) --> [Char], char_type(Char, octet).
|
||||
|
||||
abnf_sp --> " ".
|
||||
|
||||
abnf_vchar(Char) --> [Char], char_type(Char, ascii_graphic).
|
||||
|
||||
abnf_wsp --> abnf_sp.
|
||||
abnf_wsp --> abnf_htab.
|
||||
@@ -1,273 +0,0 @@
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Written Apr 2021 by Aram Panasenco (panasenco@ucla.edu)
|
||||
Part of Scryer Prolog.
|
||||
|
||||
`json_chars//1` can be used with [`phrase_from_file/2`](src/lib/pio.pl)
|
||||
or [`phrase/2`](src/lib/dcgs.pl) to parse and generate [JSON](https://www.json.org/json-en.html).
|
||||
|
||||
BSD 3-Clause License
|
||||
|
||||
Copyright (c) 2021, Aram Panasenco
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
* Redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer.
|
||||
|
||||
* Redistributions in binary form must reproduce the above copyright notice,
|
||||
this list of conditions and the following disclaimer in the documentation
|
||||
and/or other materials provided with the distribution.
|
||||
|
||||
* Neither the name of the copyright holder nor the names of its
|
||||
contributors may be used to endorse or promote products derived from
|
||||
this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
:- module(json, [
|
||||
json_chars//1
|
||||
]).
|
||||
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(dif)).
|
||||
:- use_module(library(lists)).
|
||||
|
||||
/* The DCGs are written to match the McKeeman form presented on the right side of https://www.json.org/json-en.html
|
||||
as closely as possible. Note that the names in the McKeeman form conflict with the pictures on the site. */
|
||||
json_chars(Internal) --> json_element(Internal).
|
||||
|
||||
/* Because it's impossible to distinguish between an empty array [] and an empty string "", we distinguish between
|
||||
different types of values based on their principal functor. The principal functors match the types defined in
|
||||
the JSON Schema spec here: https://json-schema.org/draft/2020-12/json-schema-validation.html#rfc.section.6.1.1
|
||||
EXCEPT we don't yet support the integer type. There are plans for more JSON Schema support in the near future. */
|
||||
json_value(pairs(Pairs)) --> json_object(Pairs).
|
||||
json_value(list(List)) --> json_array(List).
|
||||
json_value(string(Chars)) --> json_string(Chars).
|
||||
json_value(number(Number)) --> json_number(Number).
|
||||
json_value(boolean(Bool)) --> json_boolean(Bool).
|
||||
json_value(null) --> "null".
|
||||
|
||||
/* We pull json_boolean out into its own predicate in order to take advantage of first argument indexing and not leave
|
||||
choice points. For more details, watch this video on decomposing arguments: https://youtu.be/FZLofckPu4A?t=1648 */
|
||||
json_boolean(true) --> "true".
|
||||
json_boolean(false) --> "false".
|
||||
|
||||
json_object([]) --> "{", json_ws, "}".
|
||||
json_object([Pair|Pairs]) -->
|
||||
"{",
|
||||
json_members(Pairs, Pair),
|
||||
"}".
|
||||
|
||||
/* `json_members//2` below is implemented with a lagged argument to take advantage of first argument indexing.
|
||||
This is a pure performance-driven decision that doesn't affect the logic. The predicate could equivalently be
|
||||
implementes as `json_members//1` below:
|
||||
```
|
||||
json_members([Key-Value, Pair2 | Pairs]) --> json_member(Key, Value), ",", json_members([Pair2 | Pairs]).
|
||||
```
|
||||
That's a logically equivalent and equally clean representation to the lagged argument. However, it leaves
|
||||
choice points, while using the lagged argument doesn't. For more info, watch: https://youtu.be/FZLofckPu4A?t=1737
|
||||
*/
|
||||
json_members([], Key-Value) --> json_member(Key, Value).
|
||||
json_members([NextPair|Pairs], Key-Value) -->
|
||||
json_member(Key, Value),
|
||||
",",
|
||||
json_members(Pairs, NextPair).
|
||||
|
||||
json_member(string(Key), Value) --> json_ws, json_string(Key), json_ws, ":", json_element(Value).
|
||||
|
||||
json_array([]) --> "[", json_ws, "]".
|
||||
json_array([Value|Values]) --> "[", json_elements(Values, Value), "]".
|
||||
|
||||
/* Also using a lagged argument with `json_elements//2` to take advantage of first-argument indexing */
|
||||
json_elements([], Value) --> json_element(Value).
|
||||
json_elements([NextValue|Values], Value) -->
|
||||
json_element(Value),
|
||||
",",
|
||||
json_elements(Values, NextValue).
|
||||
|
||||
json_element(Value) --> json_ws, json_value(Value), json_ws.
|
||||
|
||||
json_string(Chars) --> "\"", json_characters(Chars), "\"".
|
||||
|
||||
json_characters("") --> "".
|
||||
json_characters([Char|Chars]) --> json_character(Char), json_characters(Chars).
|
||||
|
||||
/* Note on variable instantiation checks (`var/1` and `nonvar/1`) used below and in Prolog in general.
|
||||
Instantiation checks should never be used to change the logic of your program. Instead, they are one of
|
||||
many tools to adjust the 'control' or 'search strategy' used by Prolog to execute the logic of your program.
|
||||
For a general overview of the idea, read Bob Kowalski's "Algorithm = Logic + Control":
|
||||
https://www.doc.ic.ac.uk/~rak/papers/algorithm%20=%20logic%20+%20control.pdf
|
||||
For an introduction to search strategies in Prolog, read: https://www.metalevel.at/prolog/sorting#searching
|
||||
It's tempting to use instantiation checks to be more strict while generating and more relaxed while parsing.
|
||||
In fact, the early version of this library aimed to return exactly one result when generating. However, doing that
|
||||
is **wrong** and leads to difficult-to-catch bugs. Instead, adjust the search strategy to return the most ideal
|
||||
and strictest answer FIRST and then return less ideal answers on backtracking.
|
||||
As an example, consider a string containing just the forward slash. The JSON standard recommends the forward slash
|
||||
be escaped with a backslash, but allows it to not be escaped. Attempting to force stricter behavior with
|
||||
instantiation checks can lead to this confusing mess:
|
||||
```
|
||||
phrase(json:json_characters("/"), External).
|
||||
External = "\\/".
|
||||
?- phrase(json:json_characters(Internal), "/").
|
||||
Internal = "/"
|
||||
; false.
|
||||
?- phrase(json:json_characters("/"), "/").
|
||||
false.
|
||||
```
|
||||
To avoid such bugs, never use instantiation checks to reduce the number of right answers, but rather to adjust
|
||||
the *path* used to traverse those answers. */
|
||||
|
||||
escape_char('"', '"').
|
||||
escape_char('\\', '\\').
|
||||
escape_char('/', '/').
|
||||
escape_char('\b', 'b').
|
||||
escape_char('\f', 'f').
|
||||
escape_char('\n', 'n').
|
||||
escape_char('\r', 'r').
|
||||
escape_char('\t', 't').
|
||||
|
||||
json_character(EscapeChar) -->
|
||||
{ escape_char(EscapeChar, PrintChar) },
|
||||
"\\",
|
||||
[PrintChar].
|
||||
json_character(PrintChar) -->
|
||||
[PrintChar],
|
||||
{ dif(PrintChar, '\\'),
|
||||
dif(PrintChar, '"'),
|
||||
char_code(PrintChar, PrintCharCode),
|
||||
PrintCharCode >= 32 }.
|
||||
json_character(EscapeChar) -->
|
||||
"\\u",
|
||||
json_hex(H1),
|
||||
json_hex(H2),
|
||||
json_hex(H3),
|
||||
json_hex(H4),
|
||||
{ ( nonvar(H1) ->
|
||||
EscapeCharCode is H1 * 16^3 + H2 * 16^2 + H3 * 16 + H4,
|
||||
char_code(EscapeChar, EscapeCharCode)
|
||||
; char_code(EscapeChar, EscapeCharCode),
|
||||
H1 is (EscapeCharCode // 16^3) mod 16,
|
||||
H2 is (EscapeCharCode // 16^2) mod 16,
|
||||
H3 is (EscapeCharCode // 16^1) mod 16,
|
||||
H4 is (EscapeCharCode // 16^0) mod 16
|
||||
) }.
|
||||
|
||||
json_hex(Digit) --> json_digit(Digit).
|
||||
json_hex(10) --> "a".
|
||||
json_hex(11) --> "b".
|
||||
json_hex(12) --> "c".
|
||||
json_hex(13) --> "d".
|
||||
json_hex(14) --> "e".
|
||||
json_hex(15) --> "f".
|
||||
json_hex(10) --> "A".
|
||||
json_hex(11) --> "B".
|
||||
json_hex(12) --> "C".
|
||||
json_hex(13) --> "D".
|
||||
json_hex(14) --> "E".
|
||||
json_hex(15) --> "F".
|
||||
|
||||
/* I can't think of any alternatives to using `number_chars/2` when generating, though this leads
|
||||
to under-reporting of correct solutions. At least matching solutions unify when both are instantiated...
|
||||
```
|
||||
?- phrase(json:json_number(N), "123E2").
|
||||
N = 12300
|
||||
; false.
|
||||
?- phrase(json:json_number(12300), Cs).
|
||||
Cs = "12300".
|
||||
?- phrase(json:json_number(12300), "123E2").
|
||||
true
|
||||
; false.
|
||||
```
|
||||
*/
|
||||
parsing, [C] --> [C], { nonvar(C) }.
|
||||
|
||||
json_number(Number) -->
|
||||
( parsing ->
|
||||
json_sign_noplus(Sign),
|
||||
json_integer(Integer),
|
||||
json_fraction(Fraction),
|
||||
json_exponent(Exponent),
|
||||
{ ( Exponent >= 0 ->
|
||||
Base = 10
|
||||
; Base = 10.0
|
||||
),
|
||||
Number is Sign * (Integer + Fraction) * Base ^ Exponent }
|
||||
; { number_chars(Number, NumberChars) },
|
||||
NumberChars
|
||||
).
|
||||
|
||||
json_integer(Digit) --> json_digit(Digit).
|
||||
json_integer(TotalValue) -->
|
||||
json_onenine(FirstDigit),
|
||||
json_digits(RemainingValue, Power),
|
||||
{ TotalValue is FirstDigit * 10 ^ (Power + 1) + RemainingValue }.
|
||||
|
||||
json_digits(Digit, 0) --> json_digit(Digit).
|
||||
json_digits(Value, Power) -->
|
||||
json_digit(FirstDigit),
|
||||
json_digits(RemainingValue, NextPower),
|
||||
{ Power is NextPower + 1,
|
||||
Value is FirstDigit * 10^Power + RemainingValue }.
|
||||
|
||||
json_digit(0) --> "0".
|
||||
json_digit(Digit) --> json_onenine(Digit).
|
||||
|
||||
json_onenine(1) --> "1".
|
||||
json_onenine(2) --> "2".
|
||||
json_onenine(3) --> "3".
|
||||
json_onenine(4) --> "4".
|
||||
json_onenine(5) --> "5".
|
||||
json_onenine(6) --> "6".
|
||||
json_onenine(7) --> "7".
|
||||
json_onenine(8) --> "8".
|
||||
json_onenine(9) --> "9".
|
||||
|
||||
json_fraction(0) --> "".
|
||||
json_fraction(Fraction) -->
|
||||
".",
|
||||
json_digits(Value, Power),
|
||||
{ Fraction is Value / 10.0 ^ (Power + 1) }.
|
||||
|
||||
json_exponent(0) --> "".
|
||||
json_exponent(Exponent) -->
|
||||
json_exponent_signifier,
|
||||
json_sign(Sign),
|
||||
json_digits(Value, _),
|
||||
{ Exponent is Sign * Value }.
|
||||
|
||||
json_exponent_signifier --> "E".
|
||||
json_exponent_signifier --> "e".
|
||||
|
||||
json_sign_noplus(1) --> "".
|
||||
json_sign_noplus(-1) --> "-".
|
||||
|
||||
json_sign(Sign) --> json_sign_noplus(Sign).
|
||||
json_sign(1) --> "+".
|
||||
|
||||
/* Make `json_ws/0` greedy when parsing, lazy when generating */
|
||||
json_ws_empty --> "".
|
||||
json_ws_nonempty --> " ".
|
||||
json_ws_nonempty --> "\n".
|
||||
json_ws_nonempty --> "\r".
|
||||
json_ws_nonempty --> "\t".
|
||||
json_ws_greedy --> json_ws_nonempty, json_ws_greedy.
|
||||
json_ws_greedy --> json_ws_empty.
|
||||
json_ws_lazy --> json_ws_empty.
|
||||
json_ws_lazy --> json_ws_nonempty, json_ws_lazy.
|
||||
json_ws -->
|
||||
( parsing ->
|
||||
json_ws_greedy
|
||||
; json_ws_lazy
|
||||
).
|
||||
143
src/lib/sgml.pl
143
src/lib/sgml.pl
@@ -1,71 +1,56 @@
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Predicates for parsing HTML and XML documents.
|
||||
Written 2020-2022 by Markus Triska (triska@metalevel.at)
|
||||
Written June 2020 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 a stream, specified as stream(S), or a file,
|
||||
specified as file(Name), where Name is a list of characters, or a
|
||||
list of characters with the document contents.
|
||||
|
||||
Es is unified with the abstract syntax tree of the parsed document,
|
||||
represented as a list of elements where each is of the form:
|
||||
|
||||
* a list of characters, representing text
|
||||
* element(Name, Attrs, Children)
|
||||
- Name is the name of the tag
|
||||
- Attrs is a list of Key=Value pairs:
|
||||
Key is an atom, and Value is a list of characters
|
||||
- Children is a list of elements as specified here.
|
||||
|
||||
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]).
|
||||
|
||||
@@ -73,37 +58,35 @@ web servers via streams.
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(pio)).
|
||||
:- use_module(library(charsio)).
|
||||
|
||||
load_html(Source, Es, Options) :-
|
||||
must_be_source(Source, load_html/3),
|
||||
must_be(list, Options),
|
||||
load_structure_(Source, Es, Options, html).
|
||||
load_xml(Source, Es, Options) :-
|
||||
must_be_source(Source, load_xml/3),
|
||||
must_be(list, Options),
|
||||
load_structure_(Source, Es, Options, xml).
|
||||
|
||||
must_be_source(Source, Context) :-
|
||||
( var(Source) -> instantiation_error(Context)
|
||||
; is_sgml_source(Source) -> true
|
||||
; domain_error(sgml_source, Source, Context)
|
||||
).
|
||||
|
||||
is_sgml_source(file(Fs)) :- must_be(chars, Fs).
|
||||
is_sgml_source(stream(_)).
|
||||
is_sgml_source([]).
|
||||
is_sgml_source([C|Cs]) :- must_be(chars, [C|Cs]).
|
||||
list([]) --> [].
|
||||
list([L|Ls]) --> [L], list(Ls).
|
||||
|
||||
load_structure_([], [], _, _).
|
||||
load_structure_([C|Cs], [E], Options, What) :-
|
||||
load_(What, [C|Cs], E, Options).
|
||||
load_structure_(file(Fs), [E], Options, What) :-
|
||||
once(phrase_from_file(seq(Cs), Fs)),
|
||||
must_be(list, Options),
|
||||
must_be(list, Fs),
|
||||
atom_chars(File, Fs),
|
||||
once(phrase_from_file(list(Cs), File)),
|
||||
load_(What, Cs, E, Options).
|
||||
load_structure_(stream(Stream), [E], Options, What) :-
|
||||
get_n_chars(Stream, _, Cs),
|
||||
must_be(list, Options),
|
||||
read_to_end(Stream, Cs),
|
||||
load_(What, Cs, E, Options).
|
||||
|
||||
load_(html, Cs, E, Options) :- '$load_html'(Cs, E, Options).
|
||||
load_(xml, Cs, E, Options) :- '$load_xml'(Cs, E, Options).
|
||||
|
||||
read_to_end(Stream, Cs) :-
|
||||
'$get_n_chars'(Stream, 4096, Cs0),
|
||||
( Cs0 = [] -> Cs = []
|
||||
; partial_string(Cs0, Cs, Rest),
|
||||
read_to_end(Stream, Rest)
|
||||
).
|
||||
|
||||
@@ -1,44 +1,33 @@
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
|
||||
/** Safe type tests.
|
||||
Safe type tests
|
||||
===============
|
||||
|
||||
"si" stands for "sufficiently instantiated". It can also be read as
|
||||
"safe inference", so possibly also other predicates are candidates
|
||||
for this library.
|
||||
"si" stands for "sufficiently instantiated".
|
||||
|
||||
A safe type test:
|
||||
These predicates:
|
||||
|
||||
- throws an *instantiation error* if the argument is
|
||||
- throw instantiation errors if the argument is
|
||||
not sufficiently instantiated to make a sound decision
|
||||
- *succeeds* if the argument is of the specified type
|
||||
- *fails* otherwise.
|
||||
- succeed if the argument is of the specified type
|
||||
- fail 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 [Safer type tests in Prolog](https://stackoverflow.com/questions/27306453/safer-type-tests-in-prolog).
|
||||
The definitions are taken from:
|
||||
|
||||
Examples:
|
||||
https://stackoverflow.com/questions/27306453/safer-type-tests-in-prolog
|
||||
|
||||
```
|
||||
?- 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.
|
||||
```
|
||||
*/
|
||||
"si" can also be read as "safe inference", so possibly also other
|
||||
predicates are candidates for this library.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
:- module(si, [atom_si/1,
|
||||
integer_si/1,
|
||||
atomic_si/1,
|
||||
list_si/1,
|
||||
character_si/1,
|
||||
chars_si/1,
|
||||
dif_si/2]).
|
||||
list_si/1]).
|
||||
|
||||
:- use_module(library(lists)).
|
||||
|
||||
@@ -53,42 +42,6 @@ integer_si(I) :-
|
||||
atomic_si(AC) :-
|
||||
functor(AC,_,0).
|
||||
|
||||
% list_si(L) :-
|
||||
% \+ \+ length(L, _),
|
||||
% sort(L, _).
|
||||
|
||||
list_si(L0) :-
|
||||
'$skip_max_list'(_,_, L0,L),
|
||||
( nonvar(L) -> L = []
|
||||
; throw(error(instantiation_error, list_si/1))
|
||||
).
|
||||
|
||||
character_si(Ch) :-
|
||||
functor(Ch,Ch,0),
|
||||
atom(Ch),
|
||||
atom_length(Ch,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))
|
||||
).
|
||||
list_si(L) :-
|
||||
\+ \+ length(L, _),
|
||||
sort(L, _).
|
||||
|
||||
1379
src/lib/simplex.pl
1379
src/lib/simplex.pl
File diff suppressed because it is too large
Load Diff
@@ -1,9 +1,4 @@
|
||||
/**
|
||||
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,
|
||||
@@ -11,19 +6,17 @@ In both cases, with a stream, you can use the usual predicates to read and write
|
||||
current_hostname/1]).
|
||||
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(lists)).
|
||||
|
||||
parse_socket_options_(tls(TLS), tls-TLS) :-
|
||||
must_be(boolean, TLS), !.
|
||||
parse_socket_options_(Option, OptionPair) :-
|
||||
builtins:parse_stream_options_(Option, OptionPair).
|
||||
|
||||
parse_socket_options(Options, OptionValues, Stub) :-
|
||||
DefaultOptions = [alias-[], eof_action-eof_code, reposition-false, tls-false, type-text],
|
||||
builtins:parse_options_list(Options, parse_socket_options_, DefaultOptions, OptionValues, Stub).
|
||||
|
||||
%% socket_client_open(+Addr, -Stream, +Options).
|
||||
%
|
||||
% 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))
|
||||
@@ -39,16 +32,12 @@ socket_client_open(Addr, Stream, Options) :-
|
||||
;
|
||||
throw(error(type_error(socket_address, Addr), socket_client_open/3))
|
||||
),
|
||||
builtins:parse_stream_options(Options,
|
||||
[Alias, EOFAction, Reposition, Type],
|
||||
socket_client_open/3),
|
||||
'$socket_client_open'(Address, Port, Stream, Alias, EOFAction, Reposition, Type).
|
||||
parse_socket_options(Options,
|
||||
[Alias, EOFAction, Reposition, TLS, Type],
|
||||
socket_client_open/3),
|
||||
'$socket_client_open'(Address, Port, Stream, Alias, EOFAction, Reposition, Type, TLS).
|
||||
|
||||
|
||||
%% 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) ) ->
|
||||
@@ -60,19 +49,7 @@ 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),
|
||||
@@ -81,14 +58,10 @@ 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).
|
||||
|
||||
@@ -1,29 +1,3 @@
|
||||
/** 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.
|
||||
@@ -37,9 +11,9 @@
|
||||
:- use_module(library(tabling/double_linked_list)).
|
||||
:- use_module(library(tabling/table_data_structure)).
|
||||
:- use_module(library(tabling/batched_worklist)).
|
||||
:- use_module(library(tabling/wrapper)).
|
||||
:- use_module(library(tabling/global_worklist)).
|
||||
:- use_module(library(tabling/table_link_manager)).
|
||||
:- use_module(library(tabling/wrapper)).
|
||||
|
||||
:- use_module(library(cont)).
|
||||
:- use_module(library(lists)).
|
||||
@@ -92,9 +66,6 @@ table_and_status_for_variant(V,T,S) :-
|
||||
table_for_variant(V,T),
|
||||
tbd_table_status(T,S).
|
||||
|
||||
|
||||
:- meta_predicate start_tabling(?, :).
|
||||
|
||||
start_tabling(Wrapper,Worker) :-
|
||||
put_new_trie_table_link,
|
||||
put_new_global_worklist,
|
||||
@@ -164,9 +135,7 @@ activate(Wrapper,Worker,T) :-
|
||||
|
||||
delim(Wrapper,Worker,Table) :-
|
||||
% debug(tabling, 'ACT: ~p on ~p', [Wrapper, Table]),
|
||||
catch(reset(Worker,SourceCall,Continuation),
|
||||
_,
|
||||
fail),
|
||||
reset(Worker,SourceCall,Continuation),
|
||||
( Continuation = none ->
|
||||
( add_answer(Table,Wrapper)
|
||||
-> true %debug(tabling, 'ADD: ~p', [Wrapper])
|
||||
|
||||
@@ -49,20 +49,10 @@
|
||||
:- 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
|
||||
@@ -171,8 +161,6 @@ wkl_p_swap_answer_continuation(Worklist,InnerAnswerClusterPointer,SuspensionClus
|
||||
wkl_p_update_righmost_inner_answer_cluster_pointer(Worklist,InnerAnswerClusterPointer).
|
||||
|
||||
% Update the pointer if the answer cluster it points to is no longer the rightmost inner answer cluster.
|
||||
% Strangely, this predicate was intentionally named "wkl_p_update_righmost_inner_answer_cluster_pointer"
|
||||
% in the original library.
|
||||
wkl_p_update_righmost_inner_answer_cluster_pointer(Worklist,InnerAnswerClusterPointer) :-
|
||||
( wkl_p_answer_cluster_currently_moved_completely(Worklist,InnerAnswerClusterPointer) ->
|
||||
wkl_p_find_new_rightmost_inner_answer_cluster_pointer(Worklist,InnerAnswerClusterPointer,NewRiacPointer),
|
||||
|
||||
@@ -49,15 +49,9 @@
|
||||
]).
|
||||
|
||||
:- 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
|
||||
% =============================
|
||||
|
||||
|
||||
@@ -9,15 +9,10 @@
|
||||
]).
|
||||
|
||||
:- 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
|
||||
|
||||
@@ -56,18 +56,11 @@
|
||||
:- use_module(library(tabling/batched_worklist)).
|
||||
|
||||
:- use_module(library(atts)).
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(gensym)).
|
||||
:- use_module(library(iso_ext)).
|
||||
|
||||
:- attribute table_status/1, newly_created_table_identifiers/1.
|
||||
|
||||
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:
|
||||
|
||||
@@ -43,7 +43,6 @@
|
||||
]).
|
||||
|
||||
:- use_module(library(atts)).
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(iso_ext)).
|
||||
:- use_module(library(terms)).
|
||||
@@ -52,11 +51,6 @@
|
||||
|
||||
:- attribute trie_table_link/1.
|
||||
|
||||
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
|
||||
|
||||
@@ -41,21 +41,12 @@
|
||||
trie_get_all_values/2 % +Trie, -Value
|
||||
]).
|
||||
|
||||
:- use_module(library(format)).
|
||||
|
||||
:- 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 %
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
|
||||
|
||||
@@ -40,8 +40,6 @@
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(error)).
|
||||
|
||||
:- multifile(tabled/2).
|
||||
|
||||
%%:- multifile
|
||||
%% system:term_expansion/2,
|
||||
%% tabled/2.
|
||||
@@ -56,8 +54,8 @@
|
||||
%% table(PIList) :-
|
||||
%% throw(error(context_error(nodirective, table(PIList)), _)).
|
||||
|
||||
%% instantiation_error(Var) :-
|
||||
%% throw(error(instantiation_error(Var), _)).
|
||||
instantiation_error(Var) :-
|
||||
throw(error(instantiation_error(Var), _)).
|
||||
|
||||
wrappers(Var) -->
|
||||
{ var(Var), !,
|
||||
@@ -77,7 +75,7 @@ wrappers(Name/Arity) -->
|
||||
atom_concat(Name, ' tabled', WrapName),
|
||||
Head =.. [Name|Args],
|
||||
WrappedHead =.. [WrapName|Args],
|
||||
prolog_load_context(module, Module)
|
||||
'$module_of'(Module, Name) %prolog_load_context(module, Module)
|
||||
},
|
||||
[ ( Head :-
|
||||
start_tabling(Module:Head, WrappedHead)
|
||||
@@ -95,15 +93,10 @@ rename((Head --> Body), (NewHead --> Body), Module) :- !,
|
||||
functor(Head, Name, Arity),
|
||||
PlainArity is Arity+1,
|
||||
functor(PlainHead, Name, PlainArity),
|
||||
catch(table_wrapper:tabled(PlainHead, Module),
|
||||
error(existence_error(procedure, tabled/2), _),
|
||||
false),
|
||||
table_wrapper:tabled(PlainHead, Module),
|
||||
rename_term(Head, NewHead).
|
||||
rename(Head, NewHead, Module) :-
|
||||
catch(table_wrapper:tabled(Head, Module),
|
||||
error(existence_error(procedure, tabled/2), _),
|
||||
false),
|
||||
!,
|
||||
table_wrapper:tabled(Head, Module), !,
|
||||
rename_term(Head, NewHead).
|
||||
|
||||
rename_term(Compound0, Compound) :-
|
||||
@@ -116,10 +109,10 @@ rename_term(Name, WrapName) :-
|
||||
|
||||
|
||||
user:term_expansion(Term0, Clauses) :-
|
||||
nonvar(Term0),
|
||||
nonvar(Term0),
|
||||
Term0 = (:- table Preds),
|
||||
phrase(wrappers(Preds), Clauses).
|
||||
user:term_expansion(Clause, NewClause) :-
|
||||
nonvar(Clause),
|
||||
prolog_load_context(module, Module),
|
||||
nonvar(Clause),
|
||||
'$module_of'(Module, Clause),
|
||||
rename(Clause, NewClause, Module).
|
||||
|
||||
@@ -4,8 +4,8 @@
|
||||
|
||||
numbervars(Term, N0, N) :-
|
||||
catch(internal_numbervars(Term, N0, N),
|
||||
error(E,Ctx),
|
||||
( ( var(Ctx) -> Ctx = numbervars/3 ; true ), throw(error(E,Ctx) ) ) ).
|
||||
error(E,Ctx),
|
||||
( ( var(Ctx) -> Ctx = numbervars/3 ; true ), throw(error(E,Ctx) ) ) ).
|
||||
|
||||
internal_numbervars(Term, N0, N) :-
|
||||
must_be(integer, N0),
|
||||
|
||||
192
src/lib/time.pl
192
src/lib/time.pl
@@ -1,10 +1,47 @@
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Written 2020-2023 by Markus Triska (triska@metalevel.at)
|
||||
Written 2020 by Markus Triska (triska@metalevel.at)
|
||||
Part of Scryer Prolog.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
/** This library provides predicates for reasoning about time.
|
||||
*/
|
||||
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)"
|
||||
; false.
|
||||
|
||||
sleep(S) sleeps for S seconds (a floating point number).
|
||||
|
||||
time(Goal) reports the execution time of Goal.
|
||||
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
:- module(time, [max_sleep_time/1, sleep/1, time/1, current_time/1, format_time//2]).
|
||||
|
||||
@@ -13,74 +50,27 @@
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(dcgs)).
|
||||
:- 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.
|
||||
:- use_module(library(charsio), [read_term_from_chars/2]).
|
||||
|
||||
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)".
|
||||
% ```
|
||||
read_term_from_chars(T0, T).
|
||||
|
||||
format_time([], _) --> [].
|
||||
format_time(['%','%'|Fs], T) --> !, "%", format_time(Fs, T).
|
||||
format_time(['%',Spec|Fs], T) --> !,
|
||||
( { member(Spec=Value, T) } ->
|
||||
seq(Value)
|
||||
list(Value)
|
||||
; { domain_error(time_specifier, Spec, format_time//2) }
|
||||
),
|
||||
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`.
|
||||
list([]) --> [].
|
||||
list([L|Ls]) --> [L], list(Ls).
|
||||
|
||||
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 ->
|
||||
@@ -93,79 +83,47 @@ sleep(T) :-
|
||||
|
||||
% '$cpu_now' can be replaced by statistics/2 once that is implemented.
|
||||
|
||||
:- meta_predicate time(0).
|
||||
|
||||
:- dynamic(time_id/1).
|
||||
:- dynamic(time_state/2).
|
||||
|
||||
time_next_id(N) :-
|
||||
( retract(time_id(N0)) ->
|
||||
N is N0 + 1
|
||||
; N = 0
|
||||
),
|
||||
asserta(time_id(N)).
|
||||
|
||||
|
||||
%% time(Goal)
|
||||
%
|
||||
% Reports the execution time of Goal.
|
||||
|
||||
time(Goal) :-
|
||||
'$cpu_now'(T0),
|
||||
time_next_id(ID),
|
||||
setup_call_cleanup(asserta(time_state(ID, T0)),
|
||||
( call_cleanup(catch(Goal, E, (report_time(ID),throw(E))),
|
||||
Det = true),
|
||||
time_true(ID),
|
||||
( Det == true -> !
|
||||
; true
|
||||
)
|
||||
; report_time(ID),
|
||||
false
|
||||
setup_call_cleanup(true,
|
||||
( Goal,
|
||||
report_time(T0)
|
||||
),
|
||||
retract(time_state(ID, _))).
|
||||
report_time(T0)).
|
||||
|
||||
time_true(ID) :-
|
||||
report_time(ID).
|
||||
time_true(ID) :-
|
||||
% on backtracking, update the stored CPU time for this ID
|
||||
retract(time_state(ID, _)),
|
||||
'$cpu_now'(T0),
|
||||
asserta(time_state(ID, T0)),
|
||||
false.
|
||||
|
||||
report_time(ID) :-
|
||||
time_state(ID, T0),
|
||||
report_time(T0) :-
|
||||
'$cpu_now'(T),
|
||||
Time is T - T0,
|
||||
( bb_get('$answer_count', 0) ->
|
||||
Pre = " ", Post = ""
|
||||
; Pre = "", Post = " "
|
||||
),
|
||||
format("~s% CPU time: ~3fs~n~s", [Pre,Time,Post]).
|
||||
( bb_get('$first_answer', true) ->
|
||||
format(" % CPU time: ~3f seconds~n", [Time])
|
||||
; format("% CPU time: ~3f seconds~n ", [Time])
|
||||
).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
?- time((true;false)).
|
||||
%@ % CPU time: 0.006s
|
||||
%@ true
|
||||
%@ ; % CPU time: 0.001s
|
||||
%@ false.
|
||||
% CPU time: 0.000 seconds
|
||||
true
|
||||
; % CPU time: 0.001 seconds
|
||||
false.
|
||||
|
||||
:- time(use_module(library(clpz))).
|
||||
%@ % CPU time: 3.711s
|
||||
%@ true.
|
||||
% CPU time: 2.762 seconds
|
||||
true
|
||||
; false.
|
||||
|
||||
:- time(use_module(library(lists))).
|
||||
%@ % CPU time: 0.006s
|
||||
%@ true.
|
||||
% CPU time: 0.000 seconds
|
||||
true
|
||||
; % CPU time: 0.001 seconds
|
||||
false.
|
||||
|
||||
?- time(member(X, "abc")).
|
||||
%@ % CPU time: 0.005s
|
||||
%@ X = a
|
||||
%@ ; % CPU time: 0.000s
|
||||
%@ X = b
|
||||
%@ ; % CPU time: 0.000s
|
||||
%@ X = c
|
||||
%@ ; % CPU time: 0.000s
|
||||
%@ false.
|
||||
?- time(member(X, [a,b,c])).
|
||||
% CPU time: 0.000 seconds
|
||||
X = a
|
||||
; % CPU time: 0.002 seconds
|
||||
X = b
|
||||
; % CPU time: 0.004 seconds
|
||||
X = c
|
||||
; % CPU time: 0.007 seconds
|
||||
false.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
110
src/lib/tls.pl
110
src/lib/tls.pl
@@ -1,110 +0,0 @@
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Negotiation of TLS connections.
|
||||
Written Dec. 2021 by Markus Triska (triska@metalevel.at)
|
||||
Part of Scryer Prolog.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
:- module(tls, [tls_client_context/2, % -Context, +Options
|
||||
tls_client_negotiate/3, % +Context, +Stream0, -Stream
|
||||
tls_server_context/2, % -Context, +Options
|
||||
tls_server_negotiate/3 % +Context, +Stream0, -Stream
|
||||
]).
|
||||
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(error)).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
TLS Clients
|
||||
===========
|
||||
|
||||
Use tls_client_context/2 to create a TLS context, for example with:
|
||||
|
||||
tls_client_context(Context, [hostname("metalevel.at")])
|
||||
|
||||
Using the context and an existing stream S0 (for example, the
|
||||
result of socket_client_open/3), a TLS stream S can be negotiated
|
||||
with:
|
||||
|
||||
tls_client_negotiate(Context, S0, S)
|
||||
|
||||
S will be an encrypted and authenticated stream with the server.
|
||||
|
||||
The advantage of separating the creation of the client context from
|
||||
negotiating a connection is that the context can be created only once,
|
||||
and quickly reused if needed. This is currently not implemented: In
|
||||
the present implementation, a new internal "Connector" is created for
|
||||
every connection, using the specified hostname.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
tls_client_context(tls_context(Host), Options) :-
|
||||
must_be(list, Options),
|
||||
( member(hostname(Host), Options) ->
|
||||
must_be(chars, Host)
|
||||
; Host = ""
|
||||
).
|
||||
|
||||
tls_client_negotiate(tls_context(Host), S0, S) :-
|
||||
'$tls_client_connect'(Host, S0, S).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
TLS Servers
|
||||
===========
|
||||
|
||||
Use tls_server_context/2 to create a TLS context, for example with:
|
||||
|
||||
tls_server_context(Context, [pkcs12(Chars)])
|
||||
|
||||
where Chars is a list of characters with the contents of a
|
||||
DER-formatted PKCS #12 archive. The option password(Ps) can be used
|
||||
to specify the password Ps (also a string) for decrypting the key.
|
||||
On some versions of OSX, and potentially also on other platforms,
|
||||
empty passwords are not supported.
|
||||
|
||||
The archive should contain a leaf certificate and its private key,
|
||||
as well any intermediate certificates that should be sent to
|
||||
clients to allow them to build a chain to a trusted root. The chain
|
||||
certificates should be in order from the leaf certificate towards
|
||||
the root.
|
||||
|
||||
PKCS #12 archives typically have the file extension .p12 or .pfx,
|
||||
and can be created with the OpenSSL pkcs12 tool:
|
||||
|
||||
$ openssl pkcs12 -export -out identity.pfx \
|
||||
-inkey key.pem -in cert.pem -certfile chain_certs.pem
|
||||
|
||||
|
||||
You can use phrase_from_file/3 from library(pio) and seq//1 from
|
||||
library(dcgs) to read the contents of "identity.pfx" into a string:
|
||||
|
||||
phrase_from_file(seq(Chars), "identity.pfx", [type(binary)])
|
||||
|
||||
The obtained context should be treated as an opaque Prolog term.
|
||||
|
||||
Using the context and an existing stream S0 (for example, the
|
||||
result of socket_server_accept/4), a TLS stream S can be negotiated
|
||||
by a Prolog-based server with:
|
||||
|
||||
tls_server_negotiate(Context, S0, S)
|
||||
|
||||
S will be an encrypted and authenticated stream with the client.
|
||||
|
||||
The advantage of separating the creation of the server context from
|
||||
negotiating a connection is that the context can be created only
|
||||
once, and quickly cloned for every incoming connection. This is
|
||||
currently not implemented: In the present implementation, a new context
|
||||
is created for every connection, using the specified parameters.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
tls_server_context(tls_context(Cert,Password), Options) :-
|
||||
( member(pcks12(Cert), Options) ->
|
||||
must_be(chars, Cert)
|
||||
; domain_error(contains_pcks12, Options, tls_server_context/2)
|
||||
),
|
||||
( member(password(Password), Options) ->
|
||||
must_be(chars, Password)
|
||||
; Password = ""
|
||||
).
|
||||
|
||||
tls_server_negotiate(tls_context(Cert,Password), S0, S) :-
|
||||
'$tls_accept_client'(Cert, Password, S0, S).
|
||||
|
||||
@@ -1,633 +0,0 @@
|
||||
/* Author: R.A.O'Keefe, Vitor Santos Costa, Jan Wielemaker
|
||||
E-mail: J.Wielemaker@vu.nl
|
||||
WWW: http://www.swi-prolog.org
|
||||
Copyright (c) 1984-2021, VU University Amsterdam
|
||||
CWI, Amsterdam
|
||||
SWI-Prolog Solutions .b.v
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions
|
||||
are met:
|
||||
|
||||
1. Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
|
||||
2. Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions and the following disclaimer in
|
||||
the documentation and/or other materials provided with the
|
||||
distribution.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
|
||||
FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
|
||||
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
|
||||
BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
|
||||
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||||
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
|
||||
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGE.
|
||||
*/
|
||||
|
||||
:- module(ugraphs,
|
||||
[ add_edges/3, % +Graph, +Edges, -NewGraph
|
||||
add_vertices/3, % +Graph, +Vertices, -NewGraph
|
||||
complement/2, % +Graph, -NewGraph
|
||||
compose/3, % +LeftGraph, +RightGraph, -NewGraph
|
||||
del_edges/3, % +Graph, +Edges, -NewGraph
|
||||
del_vertices/3, % +Graph, +Vertices, -NewGraph
|
||||
edges/2, % +Graph, -Edges
|
||||
neighbors/3, % +Vertex, +Graph, -Vertices
|
||||
neighbours/3, % +Vertex, +Graph, -Vertices
|
||||
reachable/3, % +Vertex, +Graph, -Vertices
|
||||
top_sort/2, % +Graph, -Sort
|
||||
top_sort/3, % +Graph, -Sort0, -Sort
|
||||
transitive_closure/2, % +Graph, -Closure
|
||||
transpose_ugraph/2, % +Graph, -NewGraph
|
||||
vertices/2, % +Graph, -Vertices
|
||||
vertices_edges_to_ugraph/3, % +Vertices, +Edges, -Graph
|
||||
ugraph_union/3, % +Graph1, +Graph2, -Graph
|
||||
connect_ugraph/3 % +Graph1, -Start, -Graph
|
||||
]).
|
||||
|
||||
/** Graph manipulation library
|
||||
|
||||
The S-representation of a graph is a list of (vertex-neighbours) pairs,
|
||||
where the pairs are in standard order (as produced by keysort) and the
|
||||
neighbours of each vertex are also in standard order (as produced by
|
||||
sort). This form is convenient for many calculations.
|
||||
|
||||
A new UGraph from raw data can be created using
|
||||
`vertices_edges_to_ugraph/3`.
|
||||
|
||||
Adapted to support some of the functionality of the SICStus ugraphs
|
||||
library by Vitor Santos Costa.
|
||||
|
||||
Ported from YAP 5.0.1 to SWI-Prolog by Jan Wielemaker.
|
||||
|
||||
Ported from SWI-Prolog to Scryer by [Adrián Arroyo Calle](https://adrianistan.eu)
|
||||
|
||||
License: BSD-2 or Artistic 2.0
|
||||
*/
|
||||
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(pairs)).
|
||||
:- use_module(library(ordsets)).
|
||||
|
||||
%% vertices(+Graph, -Vertices)
|
||||
%
|
||||
% Unify Vertices with all vertices appearing in Graph. Example:
|
||||
%
|
||||
% ```
|
||||
% ?- vertices([1-[3,5],2-[4],3-[],4-[5],5-[]], L).
|
||||
% L = [1, 2, 3, 4, 5]
|
||||
% ```
|
||||
|
||||
vertices([], []) :- !.
|
||||
vertices([Vertex-_|Graph], [Vertex|Vertices]) :-
|
||||
vertices(Graph, Vertices).
|
||||
|
||||
|
||||
%% vertices_edges_to_ugraph(+Vertices, +Edges, -UGraph) is det.
|
||||
%
|
||||
% Create a UGraph from Vertices and edges. Given a graph with a
|
||||
% set of Vertices and a set of Edges, Graph must unify with the
|
||||
% corresponding S-representation. Note that the vertices without
|
||||
% edges will appear in Vertices but not in Edges. Moreover, it is
|
||||
% sufficient for a vertice to appear in Edges.
|
||||
%
|
||||
% ```
|
||||
% ?- vertices_edges_to_ugraph([],[1-3,2-4,4-5,1-5], L).
|
||||
% L = [1-[3,5], 2-[4], 3-[], 4-[5], 5-[]]
|
||||
% ```
|
||||
%
|
||||
% In this case all vertices are defined implicitly. The next
|
||||
% example shows three unconnected vertices:
|
||||
%
|
||||
% ```
|
||||
% ?- vertices_edges_to_ugraph([6,7,8],[1-3,2-4,4-5,1-5], L).
|
||||
% L = [1-[3,5], 2-[4], 3-[], 4-[5], 5-[], 6-[], 7-[], 8-[]]
|
||||
% ```
|
||||
|
||||
vertices_edges_to_ugraph(Vertices, Edges, Graph) :-
|
||||
sort(Edges, EdgeSet),
|
||||
p_to_s_vertices(EdgeSet, IVertexBag),
|
||||
append(Vertices, IVertexBag, VertexBag),
|
||||
sort(VertexBag, VertexSet),
|
||||
p_to_s_group(VertexSet, EdgeSet, Graph).
|
||||
|
||||
|
||||
%% add_vertices(+Graph, +Vertices, -NewGraph)
|
||||
%
|
||||
% Unify NewGraph with a new graph obtained by adding the list of
|
||||
% Vertices to Graph. Example:
|
||||
%
|
||||
% ```
|
||||
% ?- add_vertices([1-[3,5],2-[]], [0,1,2,9], NG).
|
||||
% NG = [0-[], 1-[3,5], 2-[], 9-[]]
|
||||
% ```
|
||||
|
||||
% replace with real msort/2 when available
|
||||
msort_(List, Sorted) :-
|
||||
pairs_keys(Pairs, List),
|
||||
keysort(Pairs, SortedPairs),
|
||||
pairs_keys(SortedPairs, Sorted).
|
||||
|
||||
add_vertices(Graph, Vertices, NewGraph) :-
|
||||
% msort/2 not available in Scryer Prolog yet: msort(Vertices, V1),
|
||||
msort_(Vertices, V1),
|
||||
add_vertices_to_s_graph(V1, Graph, NewGraph).
|
||||
|
||||
add_vertices_to_s_graph(L, [], NL) :-
|
||||
!,
|
||||
add_empty_vertices(L, NL).
|
||||
add_vertices_to_s_graph([], L, L) :- !.
|
||||
add_vertices_to_s_graph([V1|VL], [V-Edges|G], NGL) :-
|
||||
compare(Res, V1, V),
|
||||
add_vertices_to_s_graph(Res, V1, VL, V, Edges, G, NGL).
|
||||
|
||||
add_vertices_to_s_graph(=, _, VL, V, Edges, G, [V-Edges|NGL]) :-
|
||||
add_vertices_to_s_graph(VL, G, NGL).
|
||||
add_vertices_to_s_graph(<, V1, VL, V, Edges, G, [V1-[]|NGL]) :-
|
||||
add_vertices_to_s_graph(VL, [V-Edges|G], NGL).
|
||||
add_vertices_to_s_graph(>, V1, VL, V, Edges, G, [V-Edges|NGL]) :-
|
||||
add_vertices_to_s_graph([V1|VL], G, NGL).
|
||||
|
||||
add_empty_vertices([], []).
|
||||
add_empty_vertices([V|G], [V-[]|NG]) :-
|
||||
add_empty_vertices(G, NG).
|
||||
|
||||
%% del_vertices(+Graph, +Vertices, -NewGraph) is det.
|
||||
%
|
||||
% Unify NewGraph with a new graph obtained by deleting the list of
|
||||
% Vertices and all the edges that start from or go to a vertex in
|
||||
% Vertices to the Graph. Example:
|
||||
%
|
||||
% ```
|
||||
% ?- del_vertices([1-[3,5],2-[4],3-[],4-[5],5-[],6-[],7-[2,6],8-[]],
|
||||
% [2,1],
|
||||
% NL).
|
||||
% NL = [3-[],4-[5],5-[],6-[],7-[6],8-[]]
|
||||
% ```
|
||||
|
||||
del_vertices(Graph, Vertices, NewGraph) :-
|
||||
sort(Vertices, V1), % JW: was msort
|
||||
( V1 = []
|
||||
-> Graph = NewGraph
|
||||
; del_vertices(Graph, V1, V1, NewGraph)
|
||||
).
|
||||
|
||||
del_vertices(G, [], V1, NG) :-
|
||||
!,
|
||||
del_remaining_edges_for_vertices(G, V1, NG).
|
||||
del_vertices([], _, _, []).
|
||||
del_vertices([V-Edges|G], [V0|Vs], V1, NG) :-
|
||||
compare(Res, V, V0),
|
||||
split_on_del_vertices(Res, V,Edges, [V0|Vs], NVs, V1, NG, NGr),
|
||||
del_vertices(G, NVs, V1, NGr).
|
||||
|
||||
del_remaining_edges_for_vertices([], _, []).
|
||||
del_remaining_edges_for_vertices([V0-Edges|G], V1, [V0-NEdges|NG]) :-
|
||||
ord_subtract(Edges, V1, NEdges),
|
||||
del_remaining_edges_for_vertices(G, V1, NG).
|
||||
|
||||
split_on_del_vertices(<, V, Edges, Vs, Vs, V1, [V-NEdges|NG], NG) :-
|
||||
ord_subtract(Edges, V1, NEdges).
|
||||
split_on_del_vertices(>, V, Edges, [_|Vs], Vs, V1, [V-NEdges|NG], NG) :-
|
||||
ord_subtract(Edges, V1, NEdges).
|
||||
split_on_del_vertices(=, _, _, [_|Vs], Vs, _, NG, NG).
|
||||
|
||||
%% add_edges(+Graph, +Edges, -NewGraph)
|
||||
%
|
||||
% Unify NewGraph with a new graph obtained by adding the list of Edges
|
||||
% to Graph. Example:
|
||||
%
|
||||
% ```
|
||||
% ?- add_edges([1-[3,5],2-[4],3-[],4-[5],
|
||||
% 5-[],6-[],7-[],8-[]],
|
||||
% [1-6,2-3,3-2,5-7,3-2,4-5],
|
||||
% NL).
|
||||
% NL = [1-[3,5,6], 2-[3,4], 3-[2], 4-[5],
|
||||
% 5-[7], 6-[], 7-[], 8-[]]
|
||||
% ```
|
||||
|
||||
add_edges(Graph, Edges, NewGraph) :-
|
||||
p_to_s_graph(Edges, G1),
|
||||
ugraph_union(Graph, G1, NewGraph).
|
||||
|
||||
%% ugraph_union(+Graph1, +Graph2, -NewGraph)
|
||||
%
|
||||
% NewGraph is the union of Graph1 and Graph2. Example:
|
||||
%
|
||||
% ```
|
||||
% ?- ugraph_union([1-[2],2-[3]],[2-[4],3-[1,2,4]],L).
|
||||
% L = [1-[2], 2-[3,4], 3-[1,2,4]]
|
||||
% ```
|
||||
|
||||
ugraph_union(Set1, [], Set1) :- !.
|
||||
ugraph_union([], Set2, Set2) :- !.
|
||||
ugraph_union([Head1-E1|Tail1], [Head2-E2|Tail2], Union) :-
|
||||
compare(Order, Head1, Head2),
|
||||
ugraph_union(Order, Head1-E1, Tail1, Head2-E2, Tail2, Union).
|
||||
|
||||
ugraph_union(=, Head-E1, Tail1, _-E2, Tail2, [Head-Es|Union]) :-
|
||||
ord_union(E1, E2, Es),
|
||||
ugraph_union(Tail1, Tail2, Union).
|
||||
ugraph_union(<, Head1, Tail1, Head2, Tail2, [Head1|Union]) :-
|
||||
ugraph_union(Tail1, [Head2|Tail2], Union).
|
||||
ugraph_union(>, Head1, Tail1, Head2, Tail2, [Head2|Union]) :-
|
||||
ugraph_union([Head1|Tail1], Tail2, Union).
|
||||
|
||||
%% del_edges(+Graph, +Edges, -NewGraph)
|
||||
%
|
||||
% Unify NewGraph with a new graph obtained by removing the list of
|
||||
% Edges from Graph. Notice that no vertices are deleted. Example:
|
||||
%
|
||||
% ```
|
||||
% ?- del_edges([1-[3,5],2-[4],3-[],4-[5],5-[],6-[],7-[],8-[]],
|
||||
% [1-6,2-3,3-2,5-7,3-2,4-5,1-3],
|
||||
% NL).
|
||||
% NL = [1-[5],2-[4],3-[],4-[],5-[],6-[],7-[],8-[]]
|
||||
% ```
|
||||
|
||||
del_edges(Graph, Edges, NewGraph) :-
|
||||
p_to_s_graph(Edges, G1),
|
||||
graph_subtract(Graph, G1, NewGraph).
|
||||
|
||||
%% graph_subtract(+Set1, +Set2, ?Difference)
|
||||
%
|
||||
% Is based on `ord_subtract/3`
|
||||
|
||||
graph_subtract(Set1, [], Set1) :- !.
|
||||
graph_subtract([], _, []).
|
||||
graph_subtract([Head1-E1|Tail1], [Head2-E2|Tail2], Difference) :-
|
||||
compare(Order, Head1, Head2),
|
||||
graph_subtract(Order, Head1-E1, Tail1, Head2-E2, Tail2, Difference).
|
||||
|
||||
graph_subtract(=, H-E1, Tail1, _-E2, Tail2, [H-E|Difference]) :-
|
||||
ord_subtract(E1,E2,E),
|
||||
graph_subtract(Tail1, Tail2, Difference).
|
||||
graph_subtract(<, Head1, Tail1, Head2, Tail2, [Head1|Difference]) :-
|
||||
graph_subtract(Tail1, [Head2|Tail2], Difference).
|
||||
graph_subtract(>, Head1, Tail1, _, Tail2, Difference) :-
|
||||
graph_subtract([Head1|Tail1], Tail2, Difference).
|
||||
|
||||
%% edges(+Graph, -Edges)
|
||||
%
|
||||
% Unify Edges with all edges appearing in Graph. Example:
|
||||
%
|
||||
% ```
|
||||
% ?- edges([1-[3,5],2-[4],3-[],4-[5],5-[]], L).
|
||||
% L = [1-3, 1-5, 2-4, 4-5]
|
||||
% ```
|
||||
|
||||
edges(Graph, Edges) :-
|
||||
s_to_p_graph(Graph, Edges).
|
||||
|
||||
p_to_s_graph(P_Graph, S_Graph) :-
|
||||
sort(P_Graph, EdgeSet),
|
||||
p_to_s_vertices(EdgeSet, VertexBag),
|
||||
sort(VertexBag, VertexSet),
|
||||
p_to_s_group(VertexSet, EdgeSet, S_Graph).
|
||||
|
||||
|
||||
p_to_s_vertices([], []).
|
||||
p_to_s_vertices([A-Z|Edges], [A,Z|Vertices]) :-
|
||||
p_to_s_vertices(Edges, Vertices).
|
||||
|
||||
|
||||
p_to_s_group([], _, []).
|
||||
p_to_s_group([Vertex|Vertices], EdgeSet, [Vertex-Neibs|G]) :-
|
||||
p_to_s_group(EdgeSet, Vertex, Neibs, RestEdges),
|
||||
p_to_s_group(Vertices, RestEdges, G).
|
||||
|
||||
|
||||
p_to_s_group([V1-X|Edges], V2, [X|Neibs], RestEdges) :- V1 == V2,
|
||||
!,
|
||||
p_to_s_group(Edges, V2, Neibs, RestEdges).
|
||||
p_to_s_group(Edges, _, [], Edges).
|
||||
|
||||
|
||||
|
||||
s_to_p_graph([], []) :- !.
|
||||
s_to_p_graph([Vertex-Neibs|G], P_Graph) :-
|
||||
s_to_p_graph(Neibs, Vertex, P_Graph, Rest_P_Graph),
|
||||
s_to_p_graph(G, Rest_P_Graph).
|
||||
|
||||
|
||||
s_to_p_graph([], _, P_Graph, P_Graph) :- !.
|
||||
s_to_p_graph([Neib|Neibs], Vertex, [Vertex-Neib|P], Rest_P) :-
|
||||
s_to_p_graph(Neibs, Vertex, P, Rest_P).
|
||||
|
||||
%% transitive_closure(+Graph, -Closure)
|
||||
%
|
||||
% Generate the graph Closure as the transitive closure of Graph.
|
||||
% Example:
|
||||
%
|
||||
% ```
|
||||
% ?- transitive_closure([1-[2,3],2-[4,5],4-[6]],L).
|
||||
% L = [1-[2,3,4,5,6], 2-[4,5,6], 4-[6]]
|
||||
% ```
|
||||
|
||||
transitive_closure(Graph, Closure) :-
|
||||
warshall(Graph, Graph, Closure).
|
||||
|
||||
warshall([], Closure, Closure) :- !.
|
||||
warshall([V-_|G], E, Closure) :-
|
||||
memberchk(V-Y, E), % Y := E(v)
|
||||
warshall(E, V, Y, NewE),
|
||||
warshall(G, NewE, Closure).
|
||||
|
||||
|
||||
warshall([X-Neibs|G], V, Y, [X-NewNeibs|NewG]) :-
|
||||
memberchk(V, Neibs),
|
||||
!,
|
||||
ord_union(Neibs, Y, NewNeibs),
|
||||
warshall(G, V, Y, NewG).
|
||||
warshall([X-Neibs|G], V, Y, [X-Neibs|NewG]) :-
|
||||
!,
|
||||
warshall(G, V, Y, NewG).
|
||||
warshall([], _, _, []).
|
||||
|
||||
%% transpose_ugraph(Graph, NewGraph) is det.
|
||||
%
|
||||
% Unify NewGraph with a new graph obtained from Graph by replacing
|
||||
% all edges of the form V1-V2 by edges of the form V2-V1. The cost
|
||||
% is O(|V|\*log(|V|)). Notice that an undirected graph is its own
|
||||
% transpose. Example:
|
||||
%
|
||||
% ```
|
||||
% ?- transpose([1-[3,5],2-[4],3-[],4-[5],
|
||||
% 5-[],6-[],7-[],8-[]], NL).
|
||||
% NL = [1-[],2-[],3-[1],4-[2],5-[1,4],6-[],7-[],8-[]]
|
||||
% ```
|
||||
|
||||
transpose_ugraph(Graph, NewGraph) :-
|
||||
edges(Graph, Edges),
|
||||
vertices(Graph, Vertices),
|
||||
flip_edges(Edges, TransposedEdges),
|
||||
vertices_edges_to_ugraph(Vertices, TransposedEdges, NewGraph).
|
||||
|
||||
flip_edges([], []).
|
||||
flip_edges([Key-Val|Pairs], [Val-Key|Flipped]) :-
|
||||
flip_edges(Pairs, Flipped).
|
||||
|
||||
%% compose(+LeftGraph, +RightGraph, -NewGraph)
|
||||
%
|
||||
% Compose NewGraph by connecting the _drains_ of LeftGraph to the
|
||||
% _sources_ of RightGraph. Example:
|
||||
%
|
||||
% ```
|
||||
% ?- compose([1-[2],2-[3]],[2-[4],3-[1,2,4]],L).
|
||||
% L = [1-[4], 2-[1,2,4], 3-[]]
|
||||
% ```
|
||||
|
||||
compose(G1, G2, Composition) :-
|
||||
vertices(G1, V1),
|
||||
vertices(G2, V2),
|
||||
ord_union(V1, V2, V),
|
||||
compose(V, G1, G2, Composition).
|
||||
|
||||
compose([], _, _, []) :- !.
|
||||
compose([Vertex|Vertices], [Vertex-Neibs|G1], G2,
|
||||
[Vertex-Comp|Composition]) :-
|
||||
!,
|
||||
compose1(Neibs, G2, [], Comp),
|
||||
compose(Vertices, G1, G2, Composition).
|
||||
compose([Vertex|Vertices], G1, G2, [Vertex-[]|Composition]) :-
|
||||
compose(Vertices, G1, G2, Composition).
|
||||
|
||||
|
||||
compose1([V1|Vs1], [V2-N2|G2], SoFar, Comp) :-
|
||||
compare(Rel, V1, V2),
|
||||
!,
|
||||
compose1(Rel, V1, Vs1, V2, N2, G2, SoFar, Comp).
|
||||
compose1(_, _, Comp, Comp).
|
||||
|
||||
|
||||
compose1(<, _, Vs1, V2, N2, G2, SoFar, Comp) :-
|
||||
!,
|
||||
compose1(Vs1, [V2-N2|G2], SoFar, Comp).
|
||||
compose1(>, V1, Vs1, _, _, G2, SoFar, Comp) :-
|
||||
!,
|
||||
compose1([V1|Vs1], G2, SoFar, Comp).
|
||||
compose1(=, V1, Vs1, V1, N2, G2, SoFar, Comp) :-
|
||||
ord_union(N2, SoFar, Next),
|
||||
compose1(Vs1, G2, Next, Comp).
|
||||
|
||||
%% top_sort(+Graph, -Sorted) is semidet.
|
||||
%
|
||||
% Sorted is a topological sorted list of nodes in Graph. A
|
||||
% toplogical sort is possible if the graph is connected and
|
||||
% acyclic. In the example we show how topological sorting works
|
||||
% for a linear graph:
|
||||
%
|
||||
% ```
|
||||
% ?- top_sort([1-[2], 2-[3], 3-[]], L).
|
||||
% L = [1, 2, 3]
|
||||
% ```
|
||||
|
||||
top_sort(Graph, Sorted) :-
|
||||
vertices_and_zeros(Graph, Vertices, Counts0),
|
||||
count_edges(Graph, Vertices, Counts0, Counts1),
|
||||
select_zeros(Counts1, Vertices, Zeros),
|
||||
top_sort(Zeros, Sorted, Graph, Vertices, Counts1).
|
||||
|
||||
%% top_sort(+Graph, -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),
|
||||
select_zeros(Counts1, Vertices, Zeros),
|
||||
top_sort(Zeros, Sorted, Sorted0, Graph, Vertices, Counts1).
|
||||
|
||||
|
||||
vertices_and_zeros([], [], []) :- !.
|
||||
vertices_and_zeros([Vertex-_|Graph], [Vertex|Vertices], [0|Zeros]) :-
|
||||
vertices_and_zeros(Graph, Vertices, Zeros).
|
||||
|
||||
|
||||
count_edges([], _, Counts, Counts) :- !.
|
||||
count_edges([_-Neibs|Graph], Vertices, Counts0, Counts2) :-
|
||||
incr_list(Neibs, Vertices, Counts0, Counts1),
|
||||
count_edges(Graph, Vertices, Counts1, Counts2).
|
||||
|
||||
|
||||
incr_list([], _, Counts, Counts) :- !.
|
||||
incr_list([V1|Neibs], [V2|Vertices], [M|Counts0], [N|Counts1]) :-
|
||||
V1 == V2,
|
||||
!,
|
||||
N is M+1,
|
||||
incr_list(Neibs, Vertices, Counts0, Counts1).
|
||||
incr_list(Neibs, [_|Vertices], [N|Counts0], [N|Counts1]) :-
|
||||
incr_list(Neibs, Vertices, Counts0, Counts1).
|
||||
|
||||
|
||||
select_zeros([], [], []) :- !.
|
||||
select_zeros([0|Counts], [Vertex|Vertices], [Vertex|Zeros]) :-
|
||||
!,
|
||||
select_zeros(Counts, Vertices, Zeros).
|
||||
select_zeros([_|Counts], [_|Vertices], Zeros) :-
|
||||
select_zeros(Counts, Vertices, Zeros).
|
||||
|
||||
|
||||
|
||||
top_sort([], [], Graph, _, Counts) :-
|
||||
!,
|
||||
vertices_and_zeros(Graph, _, Counts).
|
||||
top_sort([Zero|Zeros], [Zero|Sorted], Graph, Vertices, Counts1) :-
|
||||
graph_memberchk(Zero-Neibs, Graph),
|
||||
decr_list(Neibs, Vertices, Counts1, Counts2, Zeros, NewZeros),
|
||||
top_sort(NewZeros, Sorted, Graph, Vertices, Counts2).
|
||||
|
||||
top_sort([], Sorted0, Sorted0, Graph, _, Counts) :-
|
||||
!,
|
||||
vertices_and_zeros(Graph, _, Counts).
|
||||
top_sort([Zero|Zeros], [Zero|Sorted], Sorted0, Graph, Vertices, Counts1) :-
|
||||
graph_memberchk(Zero-Neibs, Graph),
|
||||
decr_list(Neibs, Vertices, Counts1, Counts2, Zeros, NewZeros),
|
||||
top_sort(NewZeros, Sorted, Sorted0, Graph, Vertices, Counts2).
|
||||
|
||||
graph_memberchk(Element1-Edges, [Element2-Edges2|_]) :-
|
||||
Element1 == Element2,
|
||||
!,
|
||||
Edges = Edges2.
|
||||
graph_memberchk(Element, [_|Rest]) :-
|
||||
graph_memberchk(Element, Rest).
|
||||
|
||||
|
||||
decr_list([], _, Counts, Counts, Zeros, Zeros) :- !.
|
||||
decr_list([V1|Neibs], [V2|Vertices], [1|Counts1], [0|Counts2], Zi, Zo) :-
|
||||
V1 == V2,
|
||||
!,
|
||||
decr_list(Neibs, Vertices, Counts1, Counts2, [V2|Zi], Zo).
|
||||
decr_list([V1|Neibs], [V2|Vertices], [N|Counts1], [M|Counts2], Zi, Zo) :-
|
||||
V1 == V2,
|
||||
!,
|
||||
M is N-1,
|
||||
decr_list(Neibs, Vertices, Counts1, Counts2, Zi, Zo).
|
||||
decr_list(Neibs, [_|Vertices], [N|Counts1], [N|Counts2], Zi, Zo) :-
|
||||
decr_list(Neibs, Vertices, Counts1, Counts2, Zi, Zo).
|
||||
|
||||
|
||||
|
||||
%% neighbours(+Vertex, +Graph, -Neigbours) is det.
|
||||
%
|
||||
% Neigbours is a sorted list of the neighbours of Vertex in Graph.
|
||||
% Example:
|
||||
%
|
||||
% ```
|
||||
% ?- neighbours(4,[1-[3,5],2-[4],3-[],
|
||||
% 4-[1,2,7,5],5-[],6-[],7-[],8-[]], NL).
|
||||
% NL = [1,2,7,5]
|
||||
% ```
|
||||
|
||||
%% neighbors(+Vertex, +Graph, -Neigbours) is det.
|
||||
%
|
||||
% Same as `neighbours/3`.
|
||||
|
||||
neighbors(Vertex, Graph, Neig) :-
|
||||
neighbours(Vertex, Graph, Neig).
|
||||
|
||||
neighbours(V,[V0-Neig|_],Neig) :-
|
||||
V == V0,
|
||||
!.
|
||||
neighbours(V,[_|G],Neig) :-
|
||||
neighbours(V,G,Neig).
|
||||
|
||||
|
||||
%% connect_ugraph(+UGraphIn, -Start, -UGraphOut) is det.
|
||||
%
|
||||
% Adds Start as an additional vertex that is connected to all vertices
|
||||
% in UGraphIn. This can be used to create an topological sort for a
|
||||
% not connected graph. Start is before any vertex in UGraphIn in the
|
||||
% standard order of terms. No vertex in UGraphIn can be a variable.
|
||||
%
|
||||
% Can be used to order a not-connected graph as follows:
|
||||
%
|
||||
% ```
|
||||
% top_sort_unconnected(Graph, Vertices) :-
|
||||
% ( top_sort(Graph, Vertices)
|
||||
% -> true
|
||||
% ; connect_ugraph(Graph, Start, Connected),
|
||||
% top_sort(Connected, Ordered0),
|
||||
% Ordered0 = [Start|Vertices]
|
||||
% ).
|
||||
% ```
|
||||
|
||||
connect_ugraph([], 0, []) :- !.
|
||||
connect_ugraph(Graph, Start, [Start-Vertices|Graph]) :-
|
||||
vertices(Graph, Vertices),
|
||||
Vertices = [First|_],
|
||||
before(First, Start).
|
||||
|
||||
%% before(+Term, -Before) is det.
|
||||
%
|
||||
% Unify Before to a term that comes before Term in the standard
|
||||
% order of terms.
|
||||
%
|
||||
% Throws `instantiation_error` if Term is unbound.
|
||||
|
||||
before(X, _) :-
|
||||
var(X),
|
||||
!,
|
||||
instantiation_error(X).
|
||||
before(Number, Start) :-
|
||||
number(Number),
|
||||
!,
|
||||
Start is Number - 1.
|
||||
before(_, 0).
|
||||
|
||||
|
||||
%% complement(+UGraphIn, -UGraphOut)
|
||||
%
|
||||
% UGraphOut is a ugraph with an edge between all vertices that are
|
||||
% _not_ connected in UGraphIn and all edges from UGraphIn removed.
|
||||
% Example:
|
||||
%
|
||||
% ```
|
||||
% ?- complement([1-[3,5],2-[4],3-[],
|
||||
% 4-[1,2,7,5],5-[],6-[],7-[],8-[]], NL).
|
||||
% NL = [1-[2,4,6,7,8],2-[1,3,5,6,7,8],3-[1,2,4,5,6,7,8],
|
||||
% 4-[3,5,6,8],5-[1,2,3,4,6,7,8],6-[1,2,3,4,5,7,8],
|
||||
% 7-[1,2,3,4,5,6,8],8-[1,2,3,4,5,6,7]]
|
||||
% ```
|
||||
|
||||
|
||||
% TODO: Simple two-step algorithm. You could be smarter, I suppose.
|
||||
|
||||
complement(G, NG) :-
|
||||
vertices(G,Vs),
|
||||
complement(G,Vs,NG).
|
||||
|
||||
complement([], _, []).
|
||||
complement([V-Ns|G], Vs, [V-INs|NG]) :-
|
||||
ord_add_element(Ns,V,Ns1),
|
||||
ord_subtract(Vs,Ns1,INs),
|
||||
complement(G, Vs, NG).
|
||||
|
||||
%% reachable(+Vertex, +UGraph, -Vertices)
|
||||
%
|
||||
% True when Vertices is an ordered set of vertices reachable in
|
||||
% UGraph, including Vertex. Example:
|
||||
%
|
||||
% ```
|
||||
% ?- reachable(1,[1-[3,5],2-[4],3-[],4-[5],5-[]],V).
|
||||
% V = [1, 3, 5]
|
||||
% ```
|
||||
|
||||
reachable(N, G, Rs) :-
|
||||
reachable([N], G, [N], Rs).
|
||||
|
||||
reachable([], _, Rs, Rs).
|
||||
reachable([N|Ns], G, Rs0, RsF) :-
|
||||
neighbours(N, G, Nei),
|
||||
ord_union(Rs0, Nei, Rs1, D),
|
||||
append(Ns, D, Nsi),
|
||||
reachable(Nsi, G, Rs1, RsF).
|
||||
125
src/lib/uuid.pl
125
src/lib/uuid.pl
@@ -1,125 +0,0 @@
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Written in February 2021 by Adrián Arroyo (adrian.arroyocalle@gmail.com)
|
||||
Part of Scryer-Prolog
|
||||
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,
|
||||
uuid_string/2
|
||||
]).
|
||||
|
||||
:- use_module(library(crypto)).
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(lists)).
|
||||
|
||||
/*
|
||||
An UUID is made of 16 bytes, composed of 5 sections:
|
||||
time_low - 4
|
||||
time_mid - 2
|
||||
time_hi_and_version - 2
|
||||
clock_seq_hi_and_res_clock_seq_low - 2
|
||||
node - 6
|
||||
UUID v4 can be generated from a set of 16 random bytes: https://www.rfc-archive.org/getrfc.php?rfc=4122#gsc.tab=0 (section 4.4)
|
||||
*/
|
||||
|
||||
%% uuidv4(-Uuid).
|
||||
%
|
||||
% 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],
|
||||
byte_bits(B9, BitsClockSeqHi0),
|
||||
BitsClockSeqHi0 = [_X7, _X6, X5, X4, X3, X2, X1, X0],
|
||||
NewBitsClockSeqHi0 = [1, 0, X5, X4, X3, X2, X1, X0],
|
||||
byte_bits(NewClockSeqHi0, NewBitsClockSeqHi0),
|
||||
byte_bits(B7, BitsTimeHi),
|
||||
BitsTimeHi = [_Y7, _Y6, _Y5, _Y4, Y3, Y2, Y1, Y0],
|
||||
NewBitsTimeHi = [0, 1, 0, 0, Y3, Y2, Y1, Y0],
|
||||
byte_bits(NewTimeHi, NewBitsTimeHi),
|
||||
Uuid = [B1, B2, B3, B4, B5, B6, NewTimeHi, B8, NewClockSeqHi0, B10, B11, B12, B13, B14, B15, B16].
|
||||
|
||||
%% uuidv4_string(-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),
|
||||
hex_bytes(S1, [B1, B2, B3, B4]),
|
||||
hex_bytes(S2, [B5, B6]),
|
||||
hex_bytes(S3, [B7, B8]),
|
||||
hex_bytes(S4, [B9, B10]),
|
||||
hex_bytes(S5, [B11, B12, B13, B14, B15, B16]).
|
||||
|
||||
uuid_([S1, S2, S3, S4, S5]) -->
|
||||
{
|
||||
length(S1, 8),
|
||||
length(S2, 4),
|
||||
length(S3, 4),
|
||||
length(S4, 4),
|
||||
length(S5, 12)
|
||||
},
|
||||
S1,
|
||||
"-",
|
||||
S2,
|
||||
"-",
|
||||
S3,
|
||||
"-",
|
||||
S4,
|
||||
"-",
|
||||
S5.
|
||||
|
||||
byte_bits(Byte, Bits) :-
|
||||
\+ var(Byte),
|
||||
byte_bits_(Byte, Bits),
|
||||
length(Bits, 8),!.
|
||||
|
||||
byte_bits(Byte, Bits) :-
|
||||
\+ var(Bits),
|
||||
length(Bits, 8),
|
||||
byte_bits__(Byte, Bits),!.
|
||||
|
||||
byte_bits_(0, [0]).
|
||||
byte_bits_(1, [1]).
|
||||
byte_bits_(Byte, Bits) :-
|
||||
R is Byte // 2,
|
||||
M is Byte mod 2,
|
||||
byte_bits_(R, Bits0),
|
||||
append(Bits0, [M], Bits).
|
||||
|
||||
byte_bits__(0, []).
|
||||
byte_bits__(Byte, Bits) :-
|
||||
length(Bits, N),
|
||||
Bits = [Bit|Bits0],
|
||||
byte_bits__(Byte0, Bits0),
|
||||
Byte is Byte0 + Bit*(2 ^ (N-1)).
|
||||
371
src/lib/xpath.pl
371
src/lib/xpath.pl
@@ -26,22 +26,22 @@
|
||||
|
||||
:- use_module(library(http/http_open)).
|
||||
:- use_module(library(sgml)).
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(xpath)).
|
||||
:- use_module(library(dcgs)).
|
||||
|
||||
link_to_pl_file(File) :-
|
||||
http_open("https://github.com/mthom/scryer-prolog", S, []),
|
||||
load_html(stream(S), DOM, []),
|
||||
xpath(DOM, //a(@href), File),
|
||||
phrase((...,".pl"), File).
|
||||
append(_, ".pl", File).
|
||||
|
||||
Yielding:
|
||||
|
||||
?- link_to_pl_file(File).
|
||||
%@ File = "/mthom/scryer-prolog/blob/master/src/lib/dcgs.pl"
|
||||
%@ ; File = "/mthom/scryer-prolog/blob/master/src/lib/pio.pl"
|
||||
%@ ; File = "/mthom/scryer-prolog/blob/master/src/lib/tabling.pl"
|
||||
%@ ; ... .
|
||||
%@ File = "/mthom/scryer-prolog/blob/master/src/lib/tabling.pl"
|
||||
%@ ; File = "/mthom/scryer-prolog/blob/master/src/lib/dif.pl"
|
||||
%@ ; File = "/mthom/scryer-prolog/blob/master/src/lib/freeze.pl"
|
||||
%@ ; ...
|
||||
|
||||
Parts of the original functionality may not yet work. Please
|
||||
consider such parts opportunities for improvements, and file
|
||||
@@ -95,221 +95,219 @@
|
||||
op(200, fy, @)
|
||||
]).
|
||||
|
||||
:- use_module(library(lists),[member/2,memberchk/2,reverse/2]).
|
||||
:- use_module(library(charsio)).
|
||||
:- use_module(library(lists),[member/2,memberchk/2]).
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(si)).
|
||||
|
||||
/** Select nodes in an XML DOM
|
||||
/** <module> 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
|
||||
[XPath language](http://www.w3.org/TR/xpath).
|
||||
tree as produced by library(sgml) based on descriptions inspired by the
|
||||
XPath language.
|
||||
|
||||
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
|
||||
% XPath, using () rather than [] to select inside an element.
|
||||
% First we can construct paths using / and //:
|
||||
% Match an element in a DOM structure. The syntax is inspired by
|
||||
% XPath, using () rather than [] to select inside an element.
|
||||
% First we can construct paths using / and //:
|
||||
%
|
||||
% - *//Term*
|
||||
% Select any node in the DOM matching term.
|
||||
% $ =|//|=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.
|
||||
%
|
||||
% - */Term*
|
||||
% Match the root against Term.
|
||||
% 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:
|
||||
%
|
||||
% - *Term*
|
||||
% Select the immediate children of the root matching Term.
|
||||
% $ index(?Index) :
|
||||
% True if the element is the Index-th child of its parent,
|
||||
% 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).
|
||||
%
|
||||
% 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:
|
||||
% Defined function argument values are:
|
||||
%
|
||||
% - *`index(?Index)`*
|
||||
% True if the element is the Index-th child of its parent,
|
||||
% where 1 denotes the first child. Index can be one of:
|
||||
% $ =self= :
|
||||
% Evaluate to the entire element
|
||||
% $ =content= :
|
||||
% 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:
|
||||
%
|
||||
% - *`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)`.
|
||||
% - number
|
||||
% 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.
|
||||
%
|
||||
% Defined function argument values are:
|
||||
% In addition, the argument-list can be _conditions_:
|
||||
%
|
||||
% - *`self`*
|
||||
% Evaluate to the entire element
|
||||
% - *`content`*
|
||||
% 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:
|
||||
% $ Left = Right :
|
||||
% Succeeds if the left-hand unifies with the right-hand.
|
||||
% If the left-hand side is a function, this is evaluated.
|
||||
% The right-hand side is _never_ evaluated, and thus the
|
||||
% 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.
|
||||
%
|
||||
% - *`number`*
|
||||
% 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.
|
||||
% ==
|
||||
% //div(h2/strong)/h3
|
||||
% ==
|
||||
%
|
||||
% In addition, the argument-list can be _conditions_:
|
||||
% This is equivalent to the conjunction of XPath goals below.
|
||||
%
|
||||
% - *`Left = Right`*
|
||||
% Succeeds if the left-hand unifies with the right-hand.
|
||||
% If the left-hand side is a function, this is evaluated.
|
||||
% The right-hand side is _never_ evaluated, and thus the
|
||||
% 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.
|
||||
% ==
|
||||
% ...,
|
||||
% xpath(DOM, //(div), Div),
|
||||
% xpath(Div, h2/strong, _),
|
||||
% xpath(Div, h3, Result)
|
||||
% ==
|
||||
%
|
||||
% ```
|
||||
% //div(h2/strong)/h3
|
||||
% ```
|
||||
% **Examples**:
|
||||
%
|
||||
% This is equivalent to the conjunction of XPath goals below.
|
||||
% Match each table-row in DOM:
|
||||
%
|
||||
% ```
|
||||
% ...,
|
||||
% xpath(DOM, //(div), Div),
|
||||
% xpath(Div, h2/strong, _),
|
||||
% xpath(Div, h3, Result)
|
||||
% ```
|
||||
% ==
|
||||
% xpath(DOM, //tr, TR)
|
||||
% ==
|
||||
%
|
||||
% #### Examples
|
||||
% Match the last cell of each tablerow in DOM. This example
|
||||
% 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)
|
||||
% ==
|
||||
%
|
||||
% ```
|
||||
% xpath(DOM, //tr, TR)
|
||||
% ```
|
||||
% Match each =href= attribute in an <a> element
|
||||
%
|
||||
% Match the last cell of each tablerow in DOM. This example
|
||||
% 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:
|
||||
% ==
|
||||
% xpath(DOM, //a(@href), HREF)
|
||||
% ==
|
||||
%
|
||||
% ```
|
||||
% xpath(DOM, //tr, TR),
|
||||
% xpath(TR, /td(last), TD)
|
||||
% ```
|
||||
% 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
|
||||
% is the price (a number). The following predicate matches the
|
||||
% 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).
|
||||
% ==
|
||||
%
|
||||
% ```
|
||||
% xpath(DOM, //a(@href), HREF)
|
||||
% ```
|
||||
% Suppose we want to select books with genre="thriller" from a
|
||||
% tree containing elements =|<book genre=...>|=
|
||||
%
|
||||
% 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
|
||||
% is the price (a number). The following predicate matches the
|
||||
% name, URL and price:
|
||||
% ==
|
||||
% thriller(DOM, Book) :-
|
||||
% xpath(DOM, //book(@genre=thiller), Book).
|
||||
% ==
|
||||
%
|
||||
% ```
|
||||
% 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).
|
||||
% ```
|
||||
% Match the elements =|<table align="center">|= _and_ =|<table
|
||||
% align="CENTER">|=:
|
||||
%
|
||||
% Suppose we want to select books with genre="thriller" from a
|
||||
% tree containing elements `<book genre=...>`
|
||||
% ```prolog
|
||||
% //table(@align(lower) = center)
|
||||
% ```
|
||||
%
|
||||
% ```
|
||||
% thriller(DOM, Book) :-
|
||||
% xpath(DOM, //book(@genre=thiller), Book).
|
||||
% ```
|
||||
% Get the `width` and `height` of a `div` element as a number,
|
||||
% and the `div` node itself:
|
||||
%
|
||||
% Match the elements `<table align="center">` _and_ `<table
|
||||
% align="CENTER">`:
|
||||
% ==
|
||||
% xpath(DOM, //div(@width(number)=W, @height(number)=H), Div)
|
||||
% ==
|
||||
%
|
||||
% ```
|
||||
% //table(@align(lower) = center)
|
||||
% ```
|
||||
% Note that `div` is an infix operator, so parentheses must be
|
||||
% used in cases like the following:
|
||||
%
|
||||
% Get the `width` and `height` of a `div` element as a number,
|
||||
% 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, //(div), Div)
|
||||
% ==
|
||||
|
||||
xpath(DOM, Spec, Content) :-
|
||||
in_dom(Spec, DOM, Content).
|
||||
@@ -542,7 +540,7 @@ xpath_condition(contains(Haystack, Needle), Value) :- % contains(Haysta
|
||||
!,
|
||||
val_or_function(Haystack, Value, HaystackValue),
|
||||
val_or_function(Needle, Value, NeedleValue),
|
||||
( phrase((...,seq(NeedleValue),...), HaystackValue)
|
||||
( phrase((list(_),list(NeedleValue),list(_)), HaystackValue)
|
||||
-> true
|
||||
).
|
||||
xpath_condition(Spec, Dom) :-
|
||||
@@ -628,7 +626,10 @@ text_of_list([H|T]) -->
|
||||
|
||||
text_of_1(element(_,_,Content)) -->
|
||||
text_of_list(Content).
|
||||
text_of_1([C|Cs]) --> seq([C|Cs]).
|
||||
text_of_1([C|Cs]) --> list([C|Cs]).
|
||||
|
||||
list([]) --> [].
|
||||
list([L|Ls]) --> [L], list(Ls).
|
||||
|
||||
% For now, we use number_chars/2 to parse XML numbers.
|
||||
% If the need arises, we can extend this to additional
|
||||
@@ -637,27 +638,5 @@ text_of_1([C|Cs]) --> seq([C|Cs]).
|
||||
xsd_number_chars(Number, Chars) :-
|
||||
number_chars(Number, Chars).
|
||||
|
||||
normalize_space(Cs0, Cs) :-
|
||||
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)
|
||||
).
|
||||
normalize_space(Text0, Text) :-
|
||||
Text0 = Text. % no conversion for the moment.
|
||||
|
||||
1812
src/loader.pl
1812
src/loader.pl
File diff suppressed because it is too large
Load Diff
@@ -1,16 +0,0 @@
|
||||
use std::collections::BTreeSet;
|
||||
use std::env;
|
||||
|
||||
#[derive(Debug)]
|
||||
pub struct MachineArgs {
|
||||
pub add_history: bool,
|
||||
}
|
||||
|
||||
impl MachineArgs {
|
||||
pub fn new() -> Self {
|
||||
let args: BTreeSet<String> = env::args().collect();
|
||||
Self {
|
||||
add_history: !args.contains("--no-add-history"),
|
||||
}
|
||||
}
|
||||
}
|
||||
File diff suppressed because it is too large
Load Diff
@@ -13,9 +13,9 @@ iterate([Var|VarBindings], [Value|ValueBindings], [ListOfGoalLists | ListsCubed]
|
||||
iterate(VarBindings, ValueBindings, ListsCubed).
|
||||
iterate([], [], []).
|
||||
|
||||
|
||||
gather_modules(Attrs, []) :- var(Attrs), !.
|
||||
gather_modules([Module:_|Attrs], [Module|Modules]) :-
|
||||
gather_modules([Attr|Attrs], [Module|Modules]) :-
|
||||
'$module_of'(Module, Attr), % write the owning module of Attr to Module.
|
||||
gather_modules(Attrs, Modules).
|
||||
|
||||
call_verify_attributes(Attrs, _, _, []) :-
|
||||
@@ -26,32 +26,27 @@ call_verify_attributes([Attr|Attrs], Var, Value, ListOfGoalLists) :-
|
||||
sort(Modules0, Modules),
|
||||
verify_attrs(Modules, Var, Value, ListOfGoalLists).
|
||||
|
||||
error_handler(M, evaluation_error((M:verify_attributes)/3), []).
|
||||
% error_handler(_, existence_error(procedure, verify_attributes/3), []).
|
||||
|
||||
verify_attrs([Module|Modules], Var, Value, [Module-Goals|ListOfGoalLists]) :-
|
||||
verify_attrs([Module|Modules], Var, Value, [Goals|ListOfGoalLists]) :-
|
||||
catch(Module:verify_attributes(Var, Value, Goals),
|
||||
error(E, verify_attributes/3),
|
||||
error_handler(Module, E, Goals)),
|
||||
error(evaluation_error((Module:verify_attributes)/3), verify_attributes/3),
|
||||
Goals = []),
|
||||
verify_attrs(Modules, Var, Value, ListOfGoalLists).
|
||||
verify_attrs([], _, _, []).
|
||||
|
||||
|
||||
call_goals([ListOfGoalLists | ListsCubed]) :-
|
||||
call_goals_0(ListOfGoalLists),
|
||||
call_goals(ListsCubed).
|
||||
call_goals([]).
|
||||
|
||||
call_goals_0([Module-GoalList | GoalLists]) :-
|
||||
( var(GoalList),
|
||||
throw(error(instantiation_error, call_goals_0/1))
|
||||
call_goals_0([GoalList | GoalLists]) :-
|
||||
( var(GoalList), throw(error(instantiation_error, call_goals_0/1))
|
||||
; true
|
||||
),
|
||||
call_goals_1(GoalList, Module),
|
||||
call_goals_1(GoalList),
|
||||
call_goals_0(GoalLists).
|
||||
call_goals_0([]).
|
||||
|
||||
call_goals_1([Goal | Goals], Module) :-
|
||||
call(Module:Goal),
|
||||
call_goals_1(Goals, Module).
|
||||
call_goals_1([], _).
|
||||
call_goals_1([Goal | Goals]) :-
|
||||
call(Goal),
|
||||
call_goals_1(Goals).
|
||||
call_goals_1([]).
|
||||
|
||||
@@ -1,78 +1,97 @@
|
||||
use crate::heap_iter::*;
|
||||
use crate::machine::*;
|
||||
use crate::parser::ast::*;
|
||||
use crate::temp_v;
|
||||
use crate::types::*;
|
||||
|
||||
use indexmap::IndexSet;
|
||||
use crate::indexmap::IndexSet;
|
||||
|
||||
use std::cmp::Ordering;
|
||||
use std::vec::IntoIter;
|
||||
|
||||
pub(super) type Bindings = Vec<(usize, HeapCellValue)>;
|
||||
pub static VERIFY_ATTRS: &str = include_str!("attributed_variables.pl");
|
||||
pub static PROJECT_ATTRS: &str = include_str!("project_attributes.pl");
|
||||
|
||||
pub(super) type Bindings = Vec<(usize, Addr)>;
|
||||
|
||||
#[derive(Debug)]
|
||||
pub(super) struct AttrVarInitializer {
|
||||
pub(super) attribute_goals: Vec<Addr>,
|
||||
pub(super) attr_var_queue: Vec<usize>,
|
||||
pub(super) bindings: Bindings,
|
||||
pub(super) p: usize,
|
||||
pub(super) cp: usize,
|
||||
// pub(super) instigating_p: usize,
|
||||
pub(super) cp: LocalCodePtr,
|
||||
pub(super) instigating_p: LocalCodePtr,
|
||||
pub(super) verify_attrs_loc: usize,
|
||||
pub(super) project_attrs_loc: usize,
|
||||
}
|
||||
|
||||
impl AttrVarInitializer {
|
||||
pub(super) fn new(verify_attrs_loc: usize) -> Self {
|
||||
pub(super)
|
||||
fn new(verify_attrs_loc: usize, project_attrs_loc: usize) -> Self {
|
||||
AttrVarInitializer {
|
||||
attribute_goals: vec![],
|
||||
attr_var_queue: vec![],
|
||||
bindings: vec![],
|
||||
p: 0,
|
||||
cp: 0,
|
||||
instigating_p: LocalCodePtr::default(),
|
||||
cp: LocalCodePtr::default(),
|
||||
verify_attrs_loc,
|
||||
project_attrs_loc,
|
||||
}
|
||||
}
|
||||
|
||||
#[inline]
|
||||
pub(super) fn reset(&mut self, len: usize) {
|
||||
self.attr_var_queue.truncate(len);
|
||||
pub(super)
|
||||
fn reset(&mut self) {
|
||||
self.attribute_goals.clear();
|
||||
self.attr_var_queue.clear();
|
||||
self.bindings.clear();
|
||||
}
|
||||
|
||||
#[inline]
|
||||
pub(super)
|
||||
fn backtrack(&mut self, queue_b: usize, bindings_b: usize) {
|
||||
self.attr_var_queue.truncate(queue_b);
|
||||
self.bindings.truncate(bindings_b);
|
||||
}
|
||||
}
|
||||
|
||||
impl MachineState {
|
||||
pub(super) fn push_attr_var_binding(&mut self, h: usize, addr: HeapCellValue) {
|
||||
pub(super)
|
||||
fn push_attr_var_binding(&mut self, h: usize, addr: Addr) {
|
||||
if self.attr_var_init.bindings.is_empty() {
|
||||
// save self.p and self.cp and ensure that the next
|
||||
// instruction is InstallVerifyAttrInterrupt.
|
||||
self.attr_var_init.instigating_p = self.p.local();
|
||||
|
||||
self.attr_var_init.p = self.p;
|
||||
self.attr_var_init.cp = self.cp;
|
||||
if self.last_call {
|
||||
self.attr_var_init.cp = self.cp;
|
||||
} else {
|
||||
self.attr_var_init.cp = self.p.local() + 1;
|
||||
}
|
||||
|
||||
self.p = INSTALL_VERIFY_ATTR_INTERRUPT - 1;
|
||||
self.cp = INSTALL_VERIFY_ATTR_INTERRUPT;
|
||||
self.p = CodePtr::VerifyAttrInterrupt(self.attr_var_init.verify_attrs_loc);
|
||||
}
|
||||
|
||||
debug_assert_eq!(self.heap[h].get_tag(), HeapCellValueTag::AttrVar);
|
||||
self.attr_var_init.bindings.push((h, addr));
|
||||
}
|
||||
|
||||
fn populate_var_and_value_lists(&mut self) -> (HeapCellValue, HeapCellValue) {
|
||||
fn populate_var_and_value_lists(&mut self) -> (Addr, Addr) {
|
||||
let iter = self
|
||||
.attr_var_init
|
||||
.bindings
|
||||
.iter()
|
||||
.map(|(ref h, _)| attr_var_as_cell!(*h));
|
||||
.map(|(ref h, _)| HeapCellValue::Addr(Addr::AttrVar(*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));
|
||||
let var_list_addr = Addr::HeapCell(self.heap.to_list(iter));
|
||||
|
||||
let iter = self
|
||||
.attr_var_init
|
||||
.bindings
|
||||
.drain(0 ..)
|
||||
.map(|(_, addr)| HeapCellValue::Addr(addr));
|
||||
|
||||
let value_list_addr = Addr::HeapCell(self.heap.to_list(iter));
|
||||
(var_list_addr, value_list_addr)
|
||||
}
|
||||
|
||||
fn verify_attributes(&mut self) {
|
||||
for (h, _) in &self.attr_var_init.bindings {
|
||||
self.heap[*h] = attr_var_as_cell!(*h);
|
||||
self.heap[*h] = HeapCellValue::Addr(Addr::AttrVar(*h));
|
||||
}
|
||||
|
||||
let (var_list_addr, value_list_addr) = self.populate_var_and_value_lists();
|
||||
@@ -81,112 +100,75 @@ impl MachineState {
|
||||
self[temp_v!(2)] = value_list_addr;
|
||||
}
|
||||
|
||||
pub(super) fn gather_attr_vars_created_since(&mut self, b: usize) -> IntoIter<HeapCellValue> {
|
||||
let mut attr_vars: Vec<_> = if b >= self.attr_var_init.attr_var_queue.len() {
|
||||
vec![]
|
||||
} else {
|
||||
self.attr_var_init.attr_var_queue[b..]
|
||||
.iter()
|
||||
.filter_map(|h| {
|
||||
read_heap_cell!(self.store(self.deref(heap_loc_as_cell!(*h))),
|
||||
(HeapCellValueTag::AttrVar, h) => {
|
||||
Some(attr_var_as_cell!(h))
|
||||
}
|
||||
_ => {
|
||||
None
|
||||
}
|
||||
)
|
||||
})
|
||||
.collect()
|
||||
};
|
||||
pub(super)
|
||||
fn gather_attr_vars_created_since(&self, b: usize) -> IntoIter<Addr> {
|
||||
let mut attr_vars: Vec<_> = self.attr_var_init.attr_var_queue[b..]
|
||||
.iter()
|
||||
.filter_map(|h| match self.store(self.deref(Addr::HeapCell(*h))) {
|
||||
Addr::AttrVar(h) => Some(Addr::AttrVar(h)),
|
||||
_ => None,
|
||||
})
|
||||
.collect();
|
||||
|
||||
attr_vars.sort_unstable_by(|a1, a2| {
|
||||
compare_term_test!(self, *a1, *a2).unwrap_or(Ordering::Less)
|
||||
self.compare_term_test(a1, a2).unwrap_or(Ordering::Less)
|
||||
});
|
||||
|
||||
attr_vars.dedup();
|
||||
self.term_dedup(&mut attr_vars);
|
||||
attr_vars.into_iter()
|
||||
}
|
||||
|
||||
pub(super) fn verify_attr_interrupt(&mut self, p: usize, arity: usize) {
|
||||
self.allocate(arity + 3);
|
||||
pub(super)
|
||||
fn verify_attr_interrupt(&mut self, p: usize) {
|
||||
self.allocate(self.num_of_args + 2);
|
||||
|
||||
let e = self.e;
|
||||
let and_frame = self.stack.index_and_frame_mut(e);
|
||||
self.stack.index_and_frame_mut(e).prelude.interrupt_cp = self.attr_var_init.cp;
|
||||
|
||||
for i in 1..arity + 1 {
|
||||
and_frame[i] = self.registers[i];
|
||||
for i in 1 .. self.num_of_args + 1 {
|
||||
self.stack.index_and_frame_mut(e)[i] = self[RegType::Temp(i)].clone();
|
||||
}
|
||||
|
||||
and_frame[arity + 1] = fixnum_as_cell!(Fixnum::build_with(self.b0 as i64));
|
||||
and_frame[arity + 2] = fixnum_as_cell!(Fixnum::build_with(self.num_of_args as i64));
|
||||
and_frame[arity + 3] = fixnum_as_cell!(Fixnum::build_with(self.attr_var_init.cp as i64));
|
||||
self.stack.index_and_frame_mut(e)[self.num_of_args + 1] =
|
||||
Addr::CutPoint(self.b0);
|
||||
self.stack.index_and_frame_mut(e)[self.num_of_args + 2] =
|
||||
Addr::Usize(self.num_of_args);
|
||||
|
||||
self.verify_attributes();
|
||||
|
||||
self.num_of_args = 3;
|
||||
self.num_of_args = 2;
|
||||
self.b0 = self.b;
|
||||
self.p = p;
|
||||
self.p = CodePtr::Local(LocalCodePtr::DirEntry(p));
|
||||
}
|
||||
|
||||
pub(super) fn attr_vars_of_term(&mut self, cell: HeapCellValue) -> Vec<HeapCellValue> {
|
||||
let mut seen_set = IndexSet::new();
|
||||
pub(super)
|
||||
fn attr_vars_of_term(&self, addr: Addr) -> Vec<Addr> {
|
||||
let mut seen_set = IndexSet::new();
|
||||
let mut seen_vars = vec![];
|
||||
|
||||
let mut iter = stackful_preorder_iter::<NonListElider>
|
||||
(&mut self.heap, &mut self.stack, cell);
|
||||
let mut iter = self.acyclic_pre_order_iter(addr);
|
||||
|
||||
while let Some(value) = iter.next() {
|
||||
read_heap_cell!(value,
|
||||
(HeapCellValueTag::AttrVar, h) => {
|
||||
if seen_set.contains(&h) {
|
||||
continue;
|
||||
}
|
||||
|
||||
let value = unmark_cell_bits!(value);
|
||||
|
||||
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);
|
||||
|
||||
let mut l = h + 1;
|
||||
// let mut list_elements = vec![];
|
||||
// let iter_stack_len = iter.stack_len();
|
||||
|
||||
loop {
|
||||
read_heap_cell!(iter.heap[l],
|
||||
(HeapCellValueTag::Lis) => {
|
||||
iter.push_stack(IterStackLoc::iterable_loc(l, HeapOrStackTag::Heap));
|
||||
// l = elem + 1;
|
||||
break;
|
||||
}
|
||||
(HeapCellValueTag::Var | HeapCellValueTag::AttrVar, h) => {
|
||||
if h == l {
|
||||
break;
|
||||
} else {
|
||||
l = h;
|
||||
}
|
||||
}
|
||||
_ => {
|
||||
break;
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
// iter.stack_slice_from(iter_stack_len ..).reverse();
|
||||
while let Some(addr) = iter.next() {
|
||||
if let HeapCellValue::Addr(Addr::AttrVar(h)) = self.heap.index_addr(&addr).as_ref() {
|
||||
if seen_set.contains(h) {
|
||||
continue;
|
||||
}
|
||||
_ => {
|
||||
|
||||
seen_vars.push(addr);
|
||||
seen_set.insert(*h);
|
||||
|
||||
let mut l = h + 1;
|
||||
let mut list_elements = vec![];
|
||||
|
||||
while let Addr::Lis(elem) = self.store(self.deref(Addr::HeapCell(l))) {
|
||||
list_elements.push(self.heap[elem].as_addr(elem));
|
||||
l = elem + 1;
|
||||
}
|
||||
);
|
||||
|
||||
for element in list_elements.into_iter().rev() {
|
||||
iter.stack().push(element);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
seen_vars
|
||||
|
||||
177
src/machine/code_repo.rs
Normal file
177
src/machine/code_repo.rs
Normal file
@@ -0,0 +1,177 @@
|
||||
use crate::clause_types::*;
|
||||
use crate::codegen::*;
|
||||
use crate::debray_allocator::*;
|
||||
use crate::forms::*;
|
||||
use crate::instructions::*;
|
||||
use crate::machine::compile::*;
|
||||
use crate::machine::machine_errors::*;
|
||||
use crate::machine::machine_indices::*;
|
||||
|
||||
use crate::indexmap::IndexSet;
|
||||
|
||||
use std::collections::VecDeque;
|
||||
use std::mem;
|
||||
|
||||
#[derive(Debug)]
|
||||
pub struct CodeRepo {
|
||||
pub(super) cached_query: Code,
|
||||
pub(super) goal_expanders: Code,
|
||||
pub(super) term_expanders: Code,
|
||||
pub(super) code: Code,
|
||||
pub(super) in_situ_code: Code,
|
||||
pub(super) term_dir: TermDir,
|
||||
}
|
||||
|
||||
impl CodeRepo {
|
||||
#[inline]
|
||||
pub(super) fn new() -> Self {
|
||||
CodeRepo {
|
||||
cached_query: vec![],
|
||||
goal_expanders: Code::new(),
|
||||
term_expanders: Code::new(),
|
||||
code: Code::new(),
|
||||
in_situ_code: Code::new(),
|
||||
term_dir: TermDir::new(),
|
||||
}
|
||||
}
|
||||
|
||||
#[inline]
|
||||
pub fn term_dir_entry_len(&self, key: PredicateKey) -> (usize, usize) {
|
||||
self.term_dir
|
||||
.get(&key)
|
||||
.map(|entry| ((entry.0).0.len(), entry.1.len()))
|
||||
.unwrap_or((0, 0))
|
||||
}
|
||||
|
||||
#[inline]
|
||||
pub fn truncate_terms(
|
||||
&mut self,
|
||||
key: PredicateKey,
|
||||
len: usize,
|
||||
queue_len: usize,
|
||||
) -> (Predicate, VecDeque<TopLevel>) {
|
||||
self.term_dir
|
||||
.get_mut(&key)
|
||||
.map(|entry| {
|
||||
let terms =
|
||||
if len < (entry.0).0.len() {
|
||||
(entry.0).0.drain(len ..).collect()
|
||||
} else {
|
||||
vec![]
|
||||
};
|
||||
|
||||
let queue =
|
||||
if queue_len < entry.1.len() {
|
||||
entry.1.drain(queue_len ..).collect()
|
||||
} else {
|
||||
VecDeque::new()
|
||||
};
|
||||
|
||||
(Predicate(terms), queue)
|
||||
})
|
||||
.unwrap_or((Predicate::new(), VecDeque::new()))
|
||||
}
|
||||
|
||||
pub(crate)
|
||||
fn add_in_situ_result(
|
||||
&mut self,
|
||||
result: &CompiledResult,
|
||||
in_situ_code_dir: &mut InSituCodeDir,
|
||||
in_situ_module_dir: &mut ModuleStubDir,
|
||||
non_counted_bt_preds: &IndexSet<PredicateKey>,
|
||||
) -> Result<(), SessionError> {
|
||||
let (ref decl, ref queue) = result;
|
||||
let (name, arity) = decl
|
||||
.0
|
||||
.first()
|
||||
.and_then(|cl| {
|
||||
let arity = cl.arity();
|
||||
cl.name().map(|name| (name, arity))
|
||||
})
|
||||
.ok_or(SessionError::NamelessEntry)?;
|
||||
|
||||
let non_counted_bt = non_counted_bt_preds.contains(&(name.clone(), arity));
|
||||
let module_name = name.owning_module();
|
||||
|
||||
let p = self.in_situ_code.len();
|
||||
|
||||
match in_situ_module_dir.get_mut(&module_name) {
|
||||
Some(ref mut module_stub) if name.has_table(&module_stub.atom_tbl) => {
|
||||
module_stub.in_situ_code_dir.insert((name, arity), p);
|
||||
}
|
||||
_ => {
|
||||
in_situ_code_dir.insert((name, arity), p);
|
||||
}
|
||||
}
|
||||
|
||||
let mut cg = CodeGenerator::<DebrayAllocator>::new(non_counted_bt);
|
||||
let mut decl_code = cg.compile_predicate(&decl.0)?;
|
||||
|
||||
compile_appendix(&mut decl_code, queue, non_counted_bt)?;
|
||||
|
||||
Ok(self.in_situ_code.extend(decl_code.into_iter()))
|
||||
}
|
||||
|
||||
#[inline]
|
||||
pub(super)
|
||||
fn size_of_cached_query(&self) -> usize {
|
||||
self.cached_query.len()
|
||||
}
|
||||
|
||||
#[inline]
|
||||
pub(super)
|
||||
fn take_in_situ_code(&mut self) -> Code {
|
||||
mem::replace(&mut self.in_situ_code, Code::new())
|
||||
}
|
||||
|
||||
pub(super)
|
||||
fn lookup_instr<'a>(
|
||||
&'a self,
|
||||
last_call: bool,
|
||||
p: &CodePtr,
|
||||
) -> Option<RefOrOwned<'a, Line>> {
|
||||
match p {
|
||||
&CodePtr::Local(LocalCodePtr::UserGoalExpansion(p)) => {
|
||||
if p < self.goal_expanders.len() {
|
||||
Some(RefOrOwned::Borrowed(&self.goal_expanders[p]))
|
||||
} else {
|
||||
None
|
||||
}
|
||||
}
|
||||
&CodePtr::Local(LocalCodePtr::UserTermExpansion(p)) => {
|
||||
if p < self.term_expanders.len() {
|
||||
Some(RefOrOwned::Borrowed(&self.term_expanders[p]))
|
||||
} else {
|
||||
None
|
||||
}
|
||||
}
|
||||
&CodePtr::Local(LocalCodePtr::TopLevel(_, p)) => {
|
||||
if p < self.cached_query.len() {
|
||||
Some(RefOrOwned::Borrowed(&self.cached_query[p]))
|
||||
} else {
|
||||
None
|
||||
}
|
||||
}
|
||||
&CodePtr::Local(LocalCodePtr::InSituDirEntry(p)) => {
|
||||
Some(RefOrOwned::Borrowed(&self.in_situ_code[p]))
|
||||
}
|
||||
&CodePtr::Local(LocalCodePtr::DirEntry(p)) => Some(RefOrOwned::Borrowed(&self.code[p])),
|
||||
&CodePtr::REPL(..) => None,
|
||||
&CodePtr::BuiltInClause(ref built_in, _) => {
|
||||
let call_clause = call_clause!(
|
||||
ClauseType::BuiltIn(built_in.clone()),
|
||||
built_in.arity(),
|
||||
0,
|
||||
last_call
|
||||
);
|
||||
Some(RefOrOwned::Owned(call_clause))
|
||||
}
|
||||
&CodePtr::CallN(arity, _, last_call) => {
|
||||
let call_clause = call_clause!(ClauseType::CallN, arity, 0, last_call);
|
||||
Some(RefOrOwned::Owned(call_clause))
|
||||
}
|
||||
&CodePtr::VerifyAttrInterrupt(p) => Some(RefOrOwned::Borrowed(&self.code[p])),
|
||||
&CodePtr::DynamicTransaction(..) => None,
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -1,64 +1,81 @@
|
||||
use crate::instructions::*;
|
||||
|
||||
use fxhash::FxBuildHasher;
|
||||
use indexmap::IndexSet;
|
||||
use std::collections::VecDeque;
|
||||
|
||||
fn capture_offset(line: &Instruction, index: usize, stack: &mut Vec<usize>) -> bool {
|
||||
match line {
|
||||
&Instruction::TryMeElse(offset) if offset > 0 => {
|
||||
stack.push(index + offset);
|
||||
}
|
||||
&Instruction::DefaultRetryMeElse(offset) | &Instruction::RetryMeElse(offset)
|
||||
if offset > 0 =>
|
||||
{
|
||||
stack.push(index + offset);
|
||||
}
|
||||
&Instruction::DynamicElse(_, _, NextOrFail::Next(offset)) if offset > 0 => {
|
||||
stack.push(index + offset);
|
||||
}
|
||||
&Instruction::DynamicInternalElse(_, _, NextOrFail::Next(offset)) if offset > 0 => {
|
||||
stack.push(index + offset);
|
||||
}
|
||||
&Instruction::Proceed | &Instruction::JmpByCall(_) => {
|
||||
return true;
|
||||
}
|
||||
&Instruction::RevJmpBy(offset) => {
|
||||
if offset > 0 {
|
||||
stack.push(index - offset);
|
||||
fn scan_for_trust_me(code: &Code, jmp_offsets: &mut VecDeque<usize>, after_idx: &mut usize) {
|
||||
for (idx, instr) in code[*after_idx..].iter().enumerate() {
|
||||
match instr {
|
||||
&Line::Choice(ChoiceInstruction::TrustMe)
|
||||
| &Line::IndexedChoice(IndexedChoiceInstruction::Trust(..)) => {
|
||||
*after_idx += idx;
|
||||
return;
|
||||
}
|
||||
|
||||
return true;
|
||||
&Line::Control(ControlInstruction::JmpBy(_, offset, ..)) => {
|
||||
jmp_offsets.push_back(*after_idx + idx + offset)
|
||||
}
|
||||
_ => {}
|
||||
}
|
||||
instr if instr.is_execute() => {
|
||||
return true;
|
||||
}
|
||||
_ => {}
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
false
|
||||
fn capture_next_range(code: &Code, queue: &mut VecDeque<usize>, last_idx: &mut usize) {
|
||||
loop {
|
||||
match &code[*last_idx] {
|
||||
&Line::Choice(ChoiceInstruction::TryMeElse(..))
|
||||
| &Line::IndexedChoice(IndexedChoiceInstruction::Try(..)) => {
|
||||
*last_idx += 1;
|
||||
scan_for_trust_me(code, queue, last_idx);
|
||||
}
|
||||
&Line::Control(ControlInstruction::JmpBy(_, offset, _, false)) => {
|
||||
queue.push_back(*last_idx + offset);
|
||||
*last_idx += 1;
|
||||
}
|
||||
&Line::Control(ControlInstruction::JmpBy(_, offset, _, true)) => {
|
||||
queue.push_back(*last_idx + offset);
|
||||
break;
|
||||
}
|
||||
&Line::Control(ControlInstruction::Proceed)
|
||||
| &Line::Control(ControlInstruction::CallClause(_, _, _, true, _)) =>
|
||||
break,
|
||||
_ =>
|
||||
*last_idx += 1,
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
/* This function walks the code of a single predicate, supposed to
|
||||
* begin in code at the offset p. Each instruction is passed to the
|
||||
* walker function.
|
||||
*/
|
||||
pub(crate) fn walk_code(code: &Code, p: usize, mut walker: impl FnMut(&Instruction)) {
|
||||
let mut stack = vec![p];
|
||||
let mut visited_indices = IndexSet::with_hasher(FxBuildHasher::default());
|
||||
pub fn walk_code(code: &Code, p: usize, mut walker: impl FnMut(&Line))
|
||||
{
|
||||
let mut queue = VecDeque::from(vec![p]);
|
||||
|
||||
while let Some(first_index) = stack.pop() {
|
||||
if visited_indices.contains(&first_index) {
|
||||
continue;
|
||||
} else {
|
||||
visited_indices.insert(first_index);
|
||||
}
|
||||
while let Some(first_idx) = queue.pop_front() {
|
||||
let mut last_idx = first_idx;
|
||||
|
||||
for (index, instr) in code[first_index..].iter().enumerate() {
|
||||
capture_next_range(code, &mut queue, &mut last_idx);
|
||||
|
||||
for instr in &code[first_idx .. last_idx + 1] {
|
||||
walker(instr);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* A function for code walking that might result in modification to
|
||||
* the code. Otherwise identical to walk_code.
|
||||
*/
|
||||
pub fn walk_code_mut(code: &mut Code, p: usize, mut walker: impl FnMut(&mut Line))
|
||||
{
|
||||
let mut queue = VecDeque::from(vec![p]);
|
||||
|
||||
while let Some(first_idx) = queue.pop_front() {
|
||||
let mut last_idx = first_idx;
|
||||
|
||||
capture_next_range(code, &mut queue, &mut last_idx);
|
||||
|
||||
for instr in &mut code[first_idx .. last_idx + 1] {
|
||||
walker(instr);
|
||||
|
||||
if capture_offset(instr, first_index + index, &mut stack) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,32 +0,0 @@
|
||||
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
|
||||
}
|
||||
}
|
||||
@@ -1,7 +1,5 @@
|
||||
use crate::atom_table::*;
|
||||
use crate::machine::get_structure_index;
|
||||
use crate::machine::machine_indices::*;
|
||||
use crate::machine::stack::*;
|
||||
use crate::types::*;
|
||||
|
||||
use std::mem;
|
||||
use std::ops::IndexMut;
|
||||
@@ -11,27 +9,22 @@ type Trail = Vec<(Ref, HeapCellValue)>;
|
||||
#[derive(Debug, Clone, Copy)]
|
||||
pub enum AttrVarPolicy {
|
||||
DeepCopy,
|
||||
StripAttributes,
|
||||
StripAttributes
|
||||
}
|
||||
|
||||
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);
|
||||
pub(crate)
|
||||
trait CopierTarget: IndexMut<usize, Output = HeapCellValue> {
|
||||
fn deref(&self, val: Addr) -> Addr;
|
||||
fn push(&mut self, val: HeapCellValue);
|
||||
fn stack(&mut self) -> &mut Stack;
|
||||
fn store(&self, val: Addr) -> Addr;
|
||||
fn threshold(&self) -> usize;
|
||||
}
|
||||
|
||||
pub(crate) fn copy_term<T: CopierTarget>(
|
||||
target: T,
|
||||
addr: HeapCellValue,
|
||||
attr_var_policy: AttrVarPolicy,
|
||||
) {
|
||||
pub(crate)
|
||||
fn copy_term<T: CopierTarget>(target: T, addr: Addr, 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)]
|
||||
@@ -41,7 +34,6 @@ 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> {
|
||||
@@ -51,58 +43,57 @@ impl<T: CopierTarget> CopyTermState<T> {
|
||||
scan: 0,
|
||||
old_h: target.threshold(),
|
||||
target,
|
||||
attr_var_policy,
|
||||
attr_var_list_locs: vec![],
|
||||
attr_var_policy
|
||||
}
|
||||
}
|
||||
|
||||
#[inline]
|
||||
fn value_at_scan(&mut self) -> &mut HeapCellValue {
|
||||
&mut self.target[self.scan]
|
||||
let scan = self.scan;
|
||||
&mut self.target[scan]
|
||||
}
|
||||
|
||||
fn trail_list_cell(&mut self, addr: usize, threshold: usize) {
|
||||
let trail_item = mem::replace(&mut self.target[addr], list_loc_as_cell!(threshold));
|
||||
self.trail.push((Ref::heap_cell(addr), trail_item));
|
||||
let trail_item = mem::replace(
|
||||
&mut self.target[addr],
|
||||
HeapCellValue::Addr(Addr::Lis(threshold)),
|
||||
);
|
||||
|
||||
self.trail.push((
|
||||
Ref::HeapCell(addr),
|
||||
trail_item,
|
||||
));
|
||||
}
|
||||
|
||||
fn copy_list(&mut self, addr: usize) {
|
||||
for offset in 0..2 {
|
||||
read_heap_cell!(self.target[addr + offset],
|
||||
(HeapCellValueTag::Lis, h) => {
|
||||
if h >= self.old_h {
|
||||
*self.value_at_scan() = list_loc_as_cell!(h);
|
||||
self.scan += 1;
|
||||
for offset in 0 .. 2 {
|
||||
if let Addr::Lis(h) = self.target[addr + offset].as_addr(addr + offset) {
|
||||
if h >= self.old_h {
|
||||
*self.value_at_scan() = HeapCellValue::Addr(Addr::Lis(h));
|
||||
self.scan += 1;
|
||||
|
||||
return;
|
||||
}
|
||||
return;
|
||||
}
|
||||
_ => {
|
||||
}
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
let threshold = self.target.threshold();
|
||||
|
||||
*self.value_at_scan() = list_loc_as_cell!(threshold);
|
||||
*self.value_at_scan() = HeapCellValue::Addr(Addr::Lis(threshold));
|
||||
|
||||
for i in 0..2 {
|
||||
let hcv = self.target[addr + i];
|
||||
for i in 0 .. 2 {
|
||||
let hcv = self.target[addr + i].context_free_clone();
|
||||
self.target.push(hcv);
|
||||
}
|
||||
|
||||
let cdr = self
|
||||
.target
|
||||
.store(self.target.deref(heap_loc_as_cell!(addr + 1)));
|
||||
let cdr = self.target.store(self.target.deref(Addr::HeapCell(addr + 1)));
|
||||
|
||||
if !cdr.is_var() {
|
||||
if !cdr.is_ref() {
|
||||
self.trail_list_cell(addr + 1, threshold);
|
||||
} else {
|
||||
let car = self
|
||||
.target
|
||||
.store(self.target.deref(heap_loc_as_cell!(addr)));
|
||||
let car = self.target.store(self.target.deref(Addr::HeapCell(addr)));
|
||||
|
||||
if !car.is_var() {
|
||||
if !car.is_ref() {
|
||||
self.trail_list_cell(addr, threshold);
|
||||
}
|
||||
}
|
||||
@@ -110,378 +101,214 @@ impl<T: CopierTarget> CopyTermState<T> {
|
||||
self.scan += 1;
|
||||
}
|
||||
|
||||
fn copy_partial_string(&mut self, scan_tag: HeapCellValueTag, pstr_loc: usize) {
|
||||
read_heap_cell!(self.target[pstr_loc],
|
||||
(HeapCellValueTag::PStrLoc, h) => {
|
||||
debug_assert!(h >= self.old_h);
|
||||
|
||||
*self.value_at_scan() = match scan_tag {
|
||||
HeapCellValueTag::PStrLoc => {
|
||||
pstr_loc_as_cell!(h)
|
||||
}
|
||||
tag => {
|
||||
debug_assert_eq!(tag, HeapCellValueTag::PStrOffset);
|
||||
pstr_offset_as_cell!(h)
|
||||
}
|
||||
};
|
||||
|
||||
self.scan += 1;
|
||||
return;
|
||||
}
|
||||
(HeapCellValueTag::Var, h) => {
|
||||
debug_assert!(h >= self.old_h);
|
||||
debug_assert_eq!(scan_tag, HeapCellValueTag::PStrOffset);
|
||||
|
||||
*self.value_at_scan() = pstr_offset_as_cell!(h);
|
||||
fn copy_partial_string(&mut self, addr: usize, n: usize) {
|
||||
if let &HeapCellValue::Addr(Addr::PStrLocation(h, _)) = &self.target[addr] {
|
||||
if h >= self.old_h {
|
||||
*self.value_at_scan() = HeapCellValue::Addr(Addr::PStrLocation(h, n));
|
||||
self.scan += 1;
|
||||
|
||||
return;
|
||||
}
|
||||
_ => {}
|
||||
);
|
||||
}
|
||||
|
||||
let threshold = self.target.threshold();
|
||||
|
||||
let replacement = read_heap_cell!(self.target[pstr_loc],
|
||||
(HeapCellValueTag::CStr) => {
|
||||
debug_assert_eq!(scan_tag, HeapCellValueTag::PStrOffset);
|
||||
|
||||
*self.value_at_scan() = pstr_offset_as_cell!(threshold);
|
||||
self.target.push(self.target[pstr_loc]);
|
||||
|
||||
heap_loc_as_cell!(threshold)
|
||||
}
|
||||
_ => {
|
||||
*self.value_at_scan() = if scan_tag == HeapCellValueTag::PStrLoc {
|
||||
pstr_loc_as_cell!(threshold)
|
||||
} else {
|
||||
debug_assert_eq!(scan_tag, HeapCellValueTag::PStrOffset);
|
||||
pstr_offset_as_cell!(threshold)
|
||||
};
|
||||
|
||||
self.target.push(self.target[pstr_loc]);
|
||||
self.target.push(self.target[pstr_loc + 1]);
|
||||
|
||||
pstr_loc_as_cell!(threshold)
|
||||
}
|
||||
);
|
||||
*self.value_at_scan() =
|
||||
HeapCellValue::Addr(Addr::PStrLocation(threshold, n));
|
||||
|
||||
self.scan += 1;
|
||||
|
||||
let trail_item = mem::replace(&mut self.target[pstr_loc], replacement);
|
||||
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 = mem::replace(&mut self.attr_var_list_locs, vec![]);
|
||||
|
||||
for (threshold, list_loc) in iter {
|
||||
self.target[threshold] = list_loc_as_cell!(self.target.threshold());
|
||||
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]);
|
||||
let (pstr, has_tail) =
|
||||
match &self.target[addr] {
|
||||
&HeapCellValue::PartialString(ref pstr, has_tail) => {
|
||||
(pstr.clone_from_offset(0), has_tail)
|
||||
}
|
||||
_ => {
|
||||
unreachable!();
|
||||
unreachable!()
|
||||
}
|
||||
);
|
||||
};
|
||||
|
||||
list_addr = self.target[heap_loc + 1];
|
||||
self.target.push(HeapCellValue::PartialString(pstr, has_tail));
|
||||
|
||||
if HeapCellValueTag::Lis == list_addr.get_tag() {
|
||||
self.target[threshold + 1] = list_loc_as_cell!(self.target.threshold());
|
||||
}
|
||||
let replacement = HeapCellValue::Addr(Addr::PStrLocation(threshold, n));
|
||||
|
||||
let trail_item = mem::replace(
|
||||
&mut self.target[addr],
|
||||
replacement,
|
||||
);
|
||||
|
||||
self.trail.push((
|
||||
Ref::HeapCell(addr),
|
||||
trail_item,
|
||||
));
|
||||
|
||||
if has_tail {
|
||||
let tail_addr = self.target[addr + 1].as_addr(addr + 1);
|
||||
self.target.push(HeapCellValue::Addr(tail_addr));
|
||||
}
|
||||
}
|
||||
|
||||
fn reinstantiate_var(&mut self, addr: HeapCellValue, frontier: usize) {
|
||||
read_heap_cell!(addr,
|
||||
(HeapCellValueTag::Var, h) => {
|
||||
self.target[frontier] = heap_loc_as_cell!(frontier);
|
||||
self.target[h] = heap_loc_as_cell!(frontier);
|
||||
fn reinstantiate_var(&mut self, addr: Addr, frontier: usize) {
|
||||
match addr {
|
||||
Addr::HeapCell(h) => {
|
||||
self.target[frontier] = HeapCellValue::Addr(Addr::HeapCell(frontier));
|
||||
self.target[h] = HeapCellValue::Addr(Addr::HeapCell(frontier));
|
||||
|
||||
self.trail.push((Ref::heap_cell(h), heap_loc_as_cell!(h)));
|
||||
self.trail.push((
|
||||
Ref::HeapCell(h),
|
||||
HeapCellValue::Addr(Addr::HeapCell(h)),
|
||||
));
|
||||
}
|
||||
(HeapCellValueTag::StackVar, s) => {
|
||||
self.target[frontier] = heap_loc_as_cell!(frontier);
|
||||
self.target.stack()[s] = heap_loc_as_cell!(frontier);
|
||||
Addr::StackCell(fr, sc) => {
|
||||
self.target[frontier] = HeapCellValue::Addr(Addr::HeapCell(frontier));
|
||||
self.target.stack().index_and_frame_mut(fr)[sc] = Addr::HeapCell(frontier);
|
||||
|
||||
self.trail.push((Ref::stack_cell(s), stack_loc_as_cell!(s)));
|
||||
self.trail.push((
|
||||
Ref::StackCell(fr, sc),
|
||||
HeapCellValue::Addr(Addr::StackCell(fr, sc)),
|
||||
));
|
||||
}
|
||||
(HeapCellValueTag::AttrVar, h) => {
|
||||
Addr::AttrVar(h) => {
|
||||
let threshold = if let AttrVarPolicy::DeepCopy = self.attr_var_policy {
|
||||
self.target.threshold()
|
||||
} else {
|
||||
frontier
|
||||
};
|
||||
|
||||
self.target[frontier] = heap_loc_as_cell!(threshold);
|
||||
self.target[h] = heap_loc_as_cell!(threshold);
|
||||
self.target[frontier] = HeapCellValue::Addr(Addr::HeapCell(threshold));
|
||||
self.target[h] = HeapCellValue::Addr(Addr::HeapCell(threshold));
|
||||
|
||||
self.trail.push((Ref::attr_var(h), attr_var_as_cell!(h)));
|
||||
self.trail.push((
|
||||
Ref::AttrVar(h),
|
||||
HeapCellValue::Addr(Addr::AttrVar(h)),
|
||||
));
|
||||
|
||||
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));
|
||||
self.target.push(HeapCellValue::Addr(Addr::AttrVar(threshold)));
|
||||
|
||||
let old_list_link = self.target[h + 1];
|
||||
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));
|
||||
}
|
||||
let list_val = self.target[h + 1].context_free_clone();
|
||||
self.target.push(list_val);
|
||||
}
|
||||
}
|
||||
_ => {
|
||||
unreachable!()
|
||||
}
|
||||
);
|
||||
}
|
||||
}
|
||||
|
||||
fn copy_var(&mut self, addr: HeapCellValue) {
|
||||
let rd = self.target.deref(addr);
|
||||
let ra = self.target.store(rd);
|
||||
fn copy_var(&mut self, addr: Addr) {
|
||||
let rd = self.target.store(self.target.deref(addr));
|
||||
|
||||
read_heap_cell!(ra,
|
||||
(HeapCellValueTag::AttrVar | HeapCellValueTag::Var, h) => {
|
||||
if h >= self.old_h {
|
||||
*self.value_at_scan() = ra;
|
||||
self.scan += 1;
|
||||
|
||||
return;
|
||||
}
|
||||
match rd {
|
||||
Addr::AttrVar(h) | Addr::HeapCell(h) if h >= self.old_h => {
|
||||
*self.value_at_scan() = HeapCellValue::Addr(rd);
|
||||
self.scan += 1;
|
||||
}
|
||||
_ if addr == rd => {
|
||||
self.reinstantiate_var(addr, self.scan);
|
||||
self.scan += 1;
|
||||
}
|
||||
_ => {
|
||||
*self.value_at_scan() = HeapCellValue::Addr(rd);
|
||||
}
|
||||
_ => {}
|
||||
);
|
||||
|
||||
if rd == ra {
|
||||
self.reinstantiate_var(ra, self.scan);
|
||||
self.scan += 1;
|
||||
} else {
|
||||
*self.value_at_scan() = ra;
|
||||
}
|
||||
}
|
||||
|
||||
fn copy_structure(&mut self, addr: usize) {
|
||||
read_heap_cell!(self.target[addr],
|
||||
(HeapCellValueTag::Atom, (name, arity)) => {
|
||||
match self.target[addr].context_free_clone() {
|
||||
HeapCellValue::NamedStr(arity, name, fixity) => {
|
||||
let threshold = self.target.threshold();
|
||||
|
||||
*self.value_at_scan() = str_loc_as_cell!(threshold);
|
||||
*self.value_at_scan() = HeapCellValue::Addr(Addr::Str(threshold));
|
||||
|
||||
let trail_item = mem::replace(
|
||||
&mut self.target[addr],
|
||||
str_loc_as_cell!(threshold),
|
||||
HeapCellValue::Addr(Addr::Str(threshold)),
|
||||
);
|
||||
|
||||
self.trail.push((Ref::heap_cell(addr), trail_item));
|
||||
self.target.push(atom_as_cell!(name, arity));
|
||||
self.trail.push((
|
||||
Ref::HeapCell(addr),
|
||||
trail_item,
|
||||
));
|
||||
|
||||
self.target.push(HeapCellValue::NamedStr(arity, name, fixity));
|
||||
|
||||
for i in 0..arity {
|
||||
let hcv = self.target[addr + 1 + i];
|
||||
let hcv = self.target[addr + 1 + i].context_free_clone();
|
||||
self.target.push(hcv);
|
||||
}
|
||||
|
||||
let index_cell = self.target[addr + 1 + arity];
|
||||
|
||||
if get_structure_index(index_cell).is_some() {
|
||||
// copy the index pointer trailing this
|
||||
// inlined or expanded goal.
|
||||
self.target.push(index_cell);
|
||||
}
|
||||
}
|
||||
(HeapCellValueTag::Str, h) => {
|
||||
*self.value_at_scan() = str_loc_as_cell!(h);
|
||||
HeapCellValue::Addr(Addr::Str(addr)) => {
|
||||
*self.value_at_scan() = HeapCellValue::Addr(Addr::Str(addr))
|
||||
}
|
||||
_ => {
|
||||
unreachable!()
|
||||
}
|
||||
);
|
||||
}
|
||||
|
||||
self.scan += 1;
|
||||
}
|
||||
|
||||
fn copy_term_impl(&mut self, addr: HeapCellValue) {
|
||||
fn copy_term_impl(&mut self, addr: Addr) {
|
||||
self.scan = self.target.threshold();
|
||||
self.target.push(addr);
|
||||
self.target.push(HeapCellValue::Addr(addr));
|
||||
|
||||
while self.scan < self.target.threshold() {
|
||||
let addr = *self.value_at_scan();
|
||||
match self.value_at_scan() {
|
||||
&mut HeapCellValue::Addr(addr) => {
|
||||
match addr {
|
||||
Addr::Con(h) => {
|
||||
let addr = self.target[h].as_addr(h);
|
||||
|
||||
read_heap_cell!(addr,
|
||||
(HeapCellValueTag::Lis, h) => {
|
||||
if h >= self.old_h {
|
||||
self.scan += 1;
|
||||
} else {
|
||||
self.copy_list(h);
|
||||
if addr == Addr::Con(h) {
|
||||
*self.value_at_scan() = self.target[h].context_free_clone();
|
||||
} else {
|
||||
*self.value_at_scan() = HeapCellValue::Addr(addr);
|
||||
}
|
||||
}
|
||||
Addr::Lis(h) => {
|
||||
if h >= self.old_h {
|
||||
self.scan += 1;
|
||||
} else {
|
||||
self.copy_list(h);
|
||||
}
|
||||
}
|
||||
addr @ Addr::AttrVar(_) |
|
||||
addr @ Addr::HeapCell(_) |
|
||||
addr @ Addr::StackCell(..) => {
|
||||
self.copy_var(addr);
|
||||
}
|
||||
Addr::Str(addr) => {
|
||||
self.copy_structure(addr);
|
||||
}
|
||||
Addr::PStrLocation(addr, n) => {
|
||||
self.copy_partial_string(addr, n);
|
||||
}
|
||||
Addr::Stream(h) => {
|
||||
*self.value_at_scan() = self.target[h].context_free_clone();
|
||||
}
|
||||
_ => {
|
||||
self.scan += 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
(HeapCellValueTag::AttrVar | HeapCellValueTag::Var) => {
|
||||
self.copy_var(addr);
|
||||
}
|
||||
(HeapCellValueTag::Str, h) => {
|
||||
self.copy_structure(h);
|
||||
}
|
||||
(HeapCellValueTag::PStrLoc | HeapCellValueTag::PStrOffset, pstr_loc) => {
|
||||
self.copy_partial_string(addr.get_tag(), pstr_loc);
|
||||
}
|
||||
_ => {
|
||||
self.scan += 1;
|
||||
}
|
||||
);
|
||||
}
|
||||
}
|
||||
|
||||
self.unwind_trail();
|
||||
}
|
||||
|
||||
fn unwind_trail(&mut self) {
|
||||
for (r, value) in self.trail.drain(0..) {
|
||||
let index = r.get_value() as usize;
|
||||
|
||||
match r.get_tag() {
|
||||
RefTag::AttrVar | RefTag::HeapCell => self.target[index] = value,
|
||||
RefTag::StackCell => self.target.stack()[index] = value,
|
||||
match r {
|
||||
Ref::AttrVar(h) | Ref::HeapCell(h) =>
|
||||
self.target[h] = value,
|
||||
Ref::StackCell(fr, sc) =>
|
||||
self.target.stack().index_and_frame_mut(fr)[sc] = value.as_addr(0),
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#[cfg(test)]
|
||||
mod tests {
|
||||
use super::*;
|
||||
use crate::machine::mock_wam::*;
|
||||
|
||||
#[test]
|
||||
fn copier_tests() {
|
||||
let mut wam = MockWAM::new();
|
||||
|
||||
let f_atom = atom!("f");
|
||||
let a_atom = atom!("a");
|
||||
let b_atom = atom!("b");
|
||||
|
||||
wam.machine_st
|
||||
.heap
|
||||
.extend(functor!(f_atom, [atom(a_atom), atom(b_atom)]));
|
||||
|
||||
assert_eq!(wam.machine_st.heap[0], atom_as_cell!(f_atom, 2));
|
||||
assert_eq!(wam.machine_st.heap[1], atom_as_cell!(a_atom));
|
||||
assert_eq!(wam.machine_st.heap[2], atom_as_cell!(b_atom));
|
||||
|
||||
{
|
||||
let wam = TermCopyingMockWAM { wam: &mut wam };
|
||||
copy_term(wam, str_loc_as_cell!(0), AttrVarPolicy::DeepCopy);
|
||||
}
|
||||
|
||||
// check that the original heap state is still intact.
|
||||
assert_eq!(wam.machine_st.heap[0], atom_as_cell!(f_atom, 2));
|
||||
assert_eq!(wam.machine_st.heap[1], atom_as_cell!(a_atom));
|
||||
assert_eq!(wam.machine_st.heap[2], atom_as_cell!(b_atom));
|
||||
|
||||
assert_eq!(wam.machine_st.heap[3], str_loc_as_cell!(4));
|
||||
assert_eq!(wam.machine_st.heap[4], atom_as_cell!(f_atom, 2));
|
||||
assert_eq!(wam.machine_st.heap[5], atom_as_cell!(a_atom));
|
||||
assert_eq!(wam.machine_st.heap[6], atom_as_cell!(b_atom));
|
||||
|
||||
wam.machine_st.heap.clear();
|
||||
|
||||
let pstr_var_cell =
|
||||
put_partial_string(&mut wam.machine_st.heap, "abc ", &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", &wam.machine_st.atom_tbl);
|
||||
let pstr_second_cell = wam.machine_st.heap[pstr_second_var_cell.get_value() as usize];
|
||||
|
||||
wam.machine_st.heap.pop();
|
||||
wam.machine_st
|
||||
.heap
|
||||
.push(pstr_loc_as_cell!(wam.machine_st.heap.len() + 1));
|
||||
|
||||
wam.machine_st.heap.push(pstr_offset_as_cell!(0));
|
||||
wam.machine_st
|
||||
.heap
|
||||
.push(fixnum_as_cell!(Fixnum::build_with(0i64)));
|
||||
|
||||
{
|
||||
let wam = TermCopyingMockWAM { wam: &mut wam };
|
||||
copy_term(wam, pstr_loc_as_cell!(0), AttrVarPolicy::DeepCopy);
|
||||
}
|
||||
|
||||
print_heap_terms(wam.machine_st.heap[6..].iter(), 6);
|
||||
|
||||
assert_eq!(wam.machine_st.heap[0], pstr_cell);
|
||||
assert_eq!(wam.machine_st.heap[1], pstr_loc_as_cell!(2));
|
||||
assert_eq!(wam.machine_st.heap[2], pstr_second_cell);
|
||||
assert_eq!(wam.machine_st.heap[3], pstr_loc_as_cell!(4));
|
||||
assert_eq!(wam.machine_st.heap[4], pstr_offset_as_cell!(0));
|
||||
assert_eq!(
|
||||
wam.machine_st.heap[5],
|
||||
fixnum_as_cell!(Fixnum::build_with(0i64))
|
||||
);
|
||||
|
||||
assert_eq!(wam.machine_st.heap[7], pstr_cell);
|
||||
assert_eq!(wam.machine_st.heap[8], pstr_loc_as_cell!(9));
|
||||
assert_eq!(wam.machine_st.heap[9], pstr_second_cell);
|
||||
assert_eq!(wam.machine_st.heap[10], pstr_loc_as_cell!(11));
|
||||
assert_eq!(wam.machine_st.heap[11], pstr_offset_as_cell!(7));
|
||||
assert_eq!(
|
||||
wam.machine_st.heap[12],
|
||||
fixnum_as_cell!(Fixnum::build_with(0i64))
|
||||
);
|
||||
|
||||
wam.machine_st.heap.clear();
|
||||
|
||||
wam.machine_st.heap.extend(functor!(
|
||||
f_atom,
|
||||
[
|
||||
atom(a_atom),
|
||||
atom(b_atom),
|
||||
atom(a_atom),
|
||||
cell(str_loc_as_cell!(0))
|
||||
]
|
||||
));
|
||||
|
||||
{
|
||||
let wam = TermCopyingMockWAM { wam: &mut wam };
|
||||
copy_term(wam, str_loc_as_cell!(0), AttrVarPolicy::DeepCopy);
|
||||
}
|
||||
|
||||
assert_eq!(wam.machine_st.heap[0], atom_as_cell!(f_atom, 4));
|
||||
assert_eq!(wam.machine_st.heap[1], atom_as_cell!(a_atom));
|
||||
assert_eq!(wam.machine_st.heap[2], atom_as_cell!(b_atom));
|
||||
assert_eq!(wam.machine_st.heap[3], atom_as_cell!(a_atom));
|
||||
assert_eq!(wam.machine_st.heap[4], str_loc_as_cell!(0));
|
||||
|
||||
assert_eq!(wam.machine_st.heap[5], str_loc_as_cell!(6));
|
||||
assert_eq!(wam.machine_st.heap[6], atom_as_cell!(f_atom, 4));
|
||||
assert_eq!(wam.machine_st.heap[7], atom_as_cell!(a_atom));
|
||||
assert_eq!(wam.machine_st.heap[8], atom_as_cell!(b_atom));
|
||||
assert_eq!(wam.machine_st.heap[9], atom_as_cell!(a_atom));
|
||||
assert_eq!(wam.machine_st.heap[10], str_loc_as_cell!(6));
|
||||
}
|
||||
}
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user