From 386f7cf65da589187dd5e37283c6e4e287b4c1e7 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Mon, 27 Jul 2020 16:43:43 -0600 Subject: [PATCH 01/37] the indexer now categorizes partial strings only as lists (#623, #642) --- Cargo.lock | 9 ++++++++- src/indexing.rs | 9 +++------ src/machine/machine_indices.rs | 13 ------------- 3 files changed, 11 insertions(+), 20 deletions(-) diff --git a/Cargo.lock b/Cargo.lock index 41c90cbd..041ddfa9 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -51,6 +51,12 @@ version = "0.11.0" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "b41b7ea54a0c9d92199de89e20e58d49f02f8e699814ef3fdf266f6f748d15c7" +[[package]] +name = "base64" +version = "0.12.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3441f0f7b02788e948e47f457ca01f1d7e6d92c693bc132c22b087d3141c03ff" + [[package]] name = "bit-set" version = "0.5.2" @@ -1157,7 +1163,7 @@ version = "0.7.0" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "2bc8af4bda8e1ff4932523b94d3dd20ee30a87232323eda55903ffd71d2fb017" dependencies = [ - "base64", + "base64 0.11.0", "blake2b_simd", "constant_time_eq", "crossbeam-utils", @@ -1217,6 +1223,7 @@ checksum = "d29ab0c6d3fc0ee92fe66e2d99f700eab17a8d57d1c1d3b748380fb20baa78cd" name = "scryer-prolog" version = "0.8.126" dependencies = [ + "base64 0.12.3", "blake2", "chrono", "cpu-time", diff --git a/src/indexing.rs b/src/indexing.rs index add67bc5..b93b3c93 100644 --- a/src/indexing.rs +++ b/src/indexing.rs @@ -123,10 +123,6 @@ impl CodeOffsets { code.push(Self::add_index(code.is_empty(), index)); } } - &Constant::String(_) => { - let is_initial_index = self.lists.is_empty(); - self.lists.push(Self::add_index(is_initial_index, index)); - } &Constant::Usize(n) => { let code = self.constants .entry(Constant::Integer(Rc::new(Integer::from(n)))) @@ -158,7 +154,7 @@ impl CodeOffsets { let is_initial_index = code.is_empty(); code.push(Self::add_index(is_initial_index, index)); } - &Term::Cons(..) => { + &Term::Cons(..) | &Term::Constant(_, Constant::String(_)) => { let is_initial_index = self.lists.is_empty(); self.lists.push(Self::add_index(is_initial_index, index)); } @@ -172,7 +168,8 @@ impl CodeOffsets { let is_initial_index = code.is_empty(); code.push(Self::add_index(is_initial_index, index)); } - _ => {} + _ => { + } }; } diff --git a/src/machine/machine_indices.rs b/src/machine/machine_indices.rs index 735009f8..13fb6ae7 100644 --- a/src/machine/machine_indices.rs +++ b/src/machine/machine_indices.rs @@ -272,19 +272,6 @@ impl Addr { &Addr::Float(f) => { Some(Constant::Float(f)) } - &Addr::PStrLocation(h, n) => { - let mut heap_pstr_iter = - machine_st.heap_pstr_iter(Addr::PStrLocation(h, n)); - - let buf = heap_pstr_iter.to_string(); - let end_addr = heap_pstr_iter.focus(); - - if end_addr == Addr::EmptyList { - Some(Constant::String(Rc::new(buf))) - } else { - None - } - } &Addr::Usize(n) => { Some(Constant::Usize(n)) } From 32c612b7472a40fc196ed2098c28df1a081dd471 Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Wed, 29 Jul 2020 23:14:16 +0200 Subject: [PATCH 02/37] ADDED: library(crypto): ECDH key exchange over Curve25519 (X25519) --- Cargo.toml | 1 + README.md | 4 +-- src/clause_types.rs | 3 ++ src/lib/crypto.pl | 60 +++++++++++++++++++++++++++++++++++++ src/machine/system_calls.rs | 20 +++++++++++++ 5 files changed, 86 insertions(+), 2 deletions(-) diff --git a/Cargo.toml b/Cargo.toml index 6ac8ebe4..6eaf2128 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -47,3 +47,4 @@ chrono = "0.4.11" select = "0.4.3" roxmltree = "0.11.0" base64 = "0.12.3" +sodiumoxide = "0.2.6" diff --git a/README.md b/README.md index 0cb1a268..dab6a379 100644 --- a/README.md +++ b/README.md @@ -456,8 +456,8 @@ The modules that ship with Scryer Prolog are also called Cryptographically secure random numbers and hashes, HMAC-based key derivation (HKDF), password-based key derivation (PBKDF2), public key signatures and signature verification with Ed25519, - authenticated symmetric encryption with ChaCha20-Poly1305, and - reasoning about elliptic curves. + ECDH key exchange over Curve25519 (X25519), authenticated symmetric + encryption with ChaCha20-Poly1305, and reasoning about elliptic curves. To use predicates provided by the `lists` library, write: diff --git a/src/clause_types.rs b/src/clause_types.rs index ee6ad24c..04509308 100644 --- a/src/clause_types.rs +++ b/src/clause_types.rs @@ -309,6 +309,7 @@ pub enum SystemClauseType { Ed25519Verify, Ed25519NewKeyPair, Ed25519KeyPairPublicKey, + Curve25519ScalarMult, LoadHTML, LoadXML, GetEnv, @@ -522,6 +523,7 @@ impl SystemClauseType { &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"), @@ -715,6 +717,7 @@ impl SystemClauseType { ("$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), diff --git a/src/lib/crypto.pl b/src/lib/crypto.pl index 5058658d..49aae46e 100644 --- a/src/lib/crypto.pl +++ b/src/lib/crypto.pl @@ -29,6 +29,8 @@ ed25519_keypair_public_key/2, % +KeyPair, +PublicKey ed25519_sign/4, % +KeyPair, +Data, -Signature, +Options ed25519_verify/4, % +PublicKey, +Data, +Signature, +Options + curve25519_generator/1, % -Generator + curve25519_scalar_mult/3, % +Scalar, +Point, -Result crypto_name_curve/2, % +Name, -Curve crypto_curve_order/2, % +Curve, -Order crypto_curve_generator/2, % +Curve, -Generator @@ -43,6 +45,7 @@ :- use_module(library(arithmetic)). :- use_module(library(format)). :- use_module(library(charsio)). +:- use_module(library(si)). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - hex_bytes(?Hex, ?Bytes) is det. @@ -648,6 +651,62 @@ ed25519_verify(Key, Data0, Signature0, Options) :- hex_bytes(Signature0, Signature), '$ed25519_verify'(Key, octet, Data, Encoding, Signature). +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + X25519: ECDH key exchange over Curve25519 + ========================================= + + Points on Curve25519 are represented as lists of characters that denote + the u-coordinate of the Montgomery curve. + + - curve25519_generator(-Gs) + Gs is the generator point of Curve25519. + + - curve25519_scalar_mult(+Scalar, +Ps, -Rs) + Scalar must be an integer between 0 and 2^256-1, + or a list of 32 bytes, and Ps must be a point on the curve. + Computes the point Rs = Scalar*Ps as mandated by X25519. + + Alice and Bob can use this to establish a shared secret as follows, + where Gs is the generator point of Curve25519: + + 1. Alice creates a random integer a and sends As = a*Gs to Bob. + 2. Bob creates a random integer b and sends Bs = b*Gs to Alice. + 3. Alice computes Rs = a*Bs. + 4. Bob computes Rs = b*As. + 5. Alice and Bob use crypto_data_hkdf/4 on Rs with suitable + (same) parameters to obtain lists of bytes that can be used as + keys and initialization vectors for symmetric encryption. + + If a and b are kept secret, this method is considered very secure. +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + +curve25519_generator(Gs) :- + length(Gs0, 32), + Gs0 = [9|Zs], + maplist(=(0), Zs), + maplist(char_code, Gs, Gs0). + +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) + ), + maplist(char_code, Point, PointBytes), + '$curve25519_scalar_mult'(ScalarBytes, PointBytes, Result). + +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. + /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Operations on Elliptic Curves ============================= @@ -663,6 +722,7 @@ ed25519_verify(Key, Data0, Signature0, Options) :- crypto_curve_scalar_mult(C, Random, PublicKey, S), crypto_curve_scalar_mult(C, PrivateKey, R, S). + For better security, new code should use Curve25519 instead. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 5a1f9d53..10ae3d7f 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -51,6 +51,8 @@ use crate::openssl::ec::{EcGroup, EcPoint}; use crate::openssl::bn::{BigNum, BigNumContext}; use crate::openssl::nid::Nid; +use sodiumoxide::crypto::scalarmult::curve25519::*; + use crate::native_tls::TlsConnector; extern crate select; @@ -5706,6 +5708,24 @@ impl MachineState { _ => { self.fail = true; return Ok(()); } } } + &SystemClauseType::Curve25519ScalarMult => { + let stub1 = MachineError::functor_stub(clause_name!("curve25519_scalar_mult"), 3); + let scalar_bytes = self.integers_to_bytevec(temp_v!(1), stub1); + let scalar = Scalar(<[u8; 32]>::try_from(&scalar_bytes[..]).unwrap()); + + let stub2 = MachineError::functor_stub(clause_name!("curve25519_scalar_mult"), 3); + let point_bytes = self.integers_to_bytevec(temp_v!(2), stub2); + let point = GroupElement(<[u8; 32]>::try_from(&point_bytes[..]).unwrap()); + + let result = scalarmult(&scalar, &point).unwrap(); + + let mut string = String::new(); + for c in result[..].iter() { + string.push(*c as char); + } + let cstr = self.heap.put_complete_string(&string); + self.unify(self[temp_v!(3)], cstr); + } &SystemClauseType::LoadHTML => { let string = self.heap_pstr_iter(self[temp_v!(1)]).to_string(); let doc = select::document::Document::from_read(string.as_bytes()).unwrap(); From ac00ae4daf5f363226eaa27de10b416fba3fb417 Mon Sep 17 00:00:00 2001 From: notoria Date: Fri, 31 Jul 2020 18:12:38 +0200 Subject: [PATCH 03/37] Improved readline --- src/read.rs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/read.rs b/src/read.rs index 803102bf..9230f76e 100644 --- a/src/read.rs +++ b/src/read.rs @@ -67,7 +67,10 @@ pub mod readline { } } - *self.pending_input.get_mut() += "\n"; + if self.pending_input.get_ref().chars().last() != Some('\n') + { + *self.pending_input.get_mut() += "\n"; + } self.pending_input.read(buf) } Err(ReadlineError::Eof) => { From 4f15802fbc5048fa86e21820dec5381be365acb4 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sun, 2 Aug 2020 23:35:53 -0600 Subject: [PATCH 04/37] reconcile '[]' and [] (#644), solve remaining conformity issues (#648), move (-->) from dcgs.pl to builtins.pl (#649) --- Cargo.lock | 29 ++++- Cargo.toml | 4 +- src/heap_print.rs | 1 + src/lib/builtins.pl | 2 + src/lib/dcgs.pl | 8 +- src/machine/machine_errors.rs | 1 - src/machine/machine_state.rs | 11 +- src/machine/streams.rs | 227 ++++++++++++++++++++++++---------- src/machine/system_calls.rs | 17 +-- src/machine/term_expansion.rs | 2 +- src/read.rs | 21 +++- src/toplevel.pl | 36 +++--- 12 files changed, 241 insertions(+), 118 deletions(-) diff --git a/Cargo.lock b/Cargo.lock index 041ddfa9..531d0e50 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -502,6 +502,17 @@ version = "0.2.69" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "99e85c08494b21a9054e7fe1374a732aeadaff3980b6990b94bfd3a70f690005" +[[package]] +name = "libsodium-sys" +version = "0.2.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a685b64f837b339074115f2e7f7b431ac73681d08d75b389db7498b8892b8a58" +dependencies = [ + "cc", + "libc", + "pkg-config", +] + [[package]] name = "lock_api" version = "0.3.4" @@ -894,9 +905,9 @@ dependencies = [ [[package]] name = "prolog_parser" -version = "0.8.63" +version = "0.8.65" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1fa8dbe0881bcc9a247db279802701d87bbe9d4c6604bb0e5cad3dd3314f241d" +checksum = "fdcfe8260335a150812e36b171ff985ce88f02de16c05f4a13fe4f10e8c247f8" dependencies = [ "lexical", "num-rug-adapter", @@ -1221,7 +1232,7 @@ checksum = "d29ab0c6d3fc0ee92fe66e2d99f700eab17a8d57d1c1d3b748380fb20baa78cd" [[package]] name = "scryer-prolog" -version = "0.8.126" +version = "0.8.127" dependencies = [ "base64 0.12.3", "blake2", @@ -1250,6 +1261,7 @@ dependencies = [ "rustyline", "select", "sha3", + "sodiumoxide", "unicode_reader", ] @@ -1390,6 +1402,17 @@ version = "1.4.0" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "c7cb5678e1615754284ec264d9bb5b4c27d2018577fd90ac0ceb578591ed5ee4" +[[package]] +name = "sodiumoxide" +version = "0.2.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "7038b67c941e23501573cb7242ffb08709abe9b11eb74bceff875bbda024a6a8" +dependencies = [ + "libc", + "libsodium-sys", + "serde", +] + [[package]] name = "spin" version = "0.5.2" diff --git a/Cargo.toml b/Cargo.toml index 6eaf2128..c359e1ba 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -1,6 +1,6 @@ [package] name = "scryer-prolog" -version = "0.8.126" +version = "0.8.127" authors = ["Mark Thom "] edition = "2018" description = "A modern Prolog implementation written mostly in Rust." @@ -32,7 +32,7 @@ libc = "0.2.62" nix = "0.15.0" num-rug-adapter = { optional = true, version = "0.1.3" } ordered-float = "0.5.0" -prolog_parser = { version = "0.8.63", default-features = false } +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" diff --git a/src/heap_print.rs b/src/heap_print.rs index 4a7b3e76..2a51fa91 100644 --- a/src/heap_print.rs +++ b/src/heap_print.rs @@ -1298,6 +1298,7 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> { !iter.immediate_leaf_has_property(|addr, heap| { match heap.index_addr(&addr).as_ref() { &HeapCellValue::Integer(ref n) => &**n >= &0, + &HeapCellValue::Addr(Addr::Fixnum(n)) => n >= 0, &HeapCellValue::Addr(Addr::Float(f)) => f >= OrderedFloat(0f64), &HeapCellValue::Rational(ref r) => &**r >= &0, _ => false diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl index 3e1c8d28..ebfebfff 100644 --- a/src/lib/builtins.pl +++ b/src/lib/builtins.pl @@ -24,6 +24,8 @@ user:term_expansion((:- op(Pred, Spec, [Op | OtherOps])), OpResults) :- :- op(400, yfx, [div, //, rdiv, <<, >>, mod, rem]). :- op(200, fy, [+, -, \]). +:- op(1200, xfx, -->). + % arithmetic comparison operators. :- op(700, xfx, [>, <, =\=, =:=, >=, =<]). diff --git a/src/lib/dcgs.pl b/src/lib/dcgs.pl index 5e8e19d5..942f6b8e 100644 --- a/src/lib/dcgs.pl +++ b/src/lib/dcgs.pl @@ -1,7 +1,7 @@ -:- module(dcgs, [op(1200, xfx, -->), - op(1105, xfy, '|'), - phrase/2, - phrase/3]). +:- module(dcgs, + [op(1105, xfy, '|'), + phrase/2, + phrase/3]). :- use_module(library(error)). :- use_module(library(lists), [append/3]). diff --git a/src/machine/machine_errors.rs b/src/machine/machine_errors.rs index dddc58ac..1dcc1db8 100644 --- a/src/machine/machine_errors.rs +++ b/src/machine/machine_errors.rs @@ -840,5 +840,4 @@ impl From for EvalSession { fn from(err: ParserError) -> Self { EvalSession::from(SessionError::ParserError(err)) } - } diff --git a/src/machine/machine_state.rs b/src/machine/machine_state.rs index 02f7230a..e8799566 100644 --- a/src/machine/machine_state.rs +++ b/src/machine/machine_state.rs @@ -636,11 +636,10 @@ impl MachineState { } let mut orig_stream = stream.clone(); - let mut stream = self.open_parsing_stream(stream, "read_term", 3)?; loop { match self.read( - &mut stream, + stream.clone(), indices.atom_tbl.clone(), &indices.op_dir, ) { @@ -1337,14 +1336,8 @@ pub(crate) trait CallPolicy: Any + fmt::Debug { return_from_clause!(machine_st.last_call, machine_st) } &BuiltInClauseType::Read => { - let mut stream = machine_st.open_parsing_stream( - current_input_stream.clone(), - "read", - 1, - )?; - match machine_st.read( - &mut stream, + current_input_stream.clone(), indices.atom_tbl.clone(), &indices.op_dir, ) { diff --git a/src/machine/streams.rs b/src/machine/streams.rs index f646ff9b..7e07067a 100644 --- a/src/machine/streams.rs +++ b/src/machine/streams.rs @@ -6,13 +6,15 @@ use crate::machine::machine_errors::*; use crate::machine::machine_indices::*; use crate::machine::machine_state::*; -use std::cmp::Ordering; +use std::cmp::{min, Ordering}; use std::cell::RefCell; use std::error::Error; use std::fmt; use std::fs::File; +use std::io; use std::io::{stdout, Cursor, ErrorKind, Read, Seek, SeekFrom, Write}; use std::hash::{Hash, Hasher}; +use std::mem; use std::net::{Shutdown, TcpStream}; use std::ops::DerefMut; use std::rc::Rc; @@ -92,20 +94,83 @@ impl EOFAction { } } +fn parser_top_to_bytes(mut buf: Vec>) -> io::Result> { + let mut str_buf = String::new(); + + while let Some(c) = buf.pop() { + str_buf.push(c?); + } + + unsafe { + let array = str_buf.as_bytes_mut(); + array.reverse(); + Ok(Vec::from(array)) + } +} + /* all these streams are closed automatically when the instance is * dropped. */ pub enum StreamInstance { Bytes(Cursor>), - DynReadSource(Box), InputFile(ClauseName, File), OutputFile(ClauseName, File, bool), // File, append. Null, + PausedPrologStream(Vec, Box), ReadlineStream(ReadlineStream), + StaticStr(Cursor<&'static str>), Stdout, TcpStream(ClauseName, TcpStream), TlsStream(ClauseName, TlsStream) } +impl StreamInstance { + fn read(&mut self, buf: &mut [u8]) -> io::Result { + match self { + StreamInstance::PausedPrologStream(ref mut put_back, ref mut stream) => { + let mut index = 0; + + while index < min(buf.len(), put_back.len()) { + let b = put_back.pop().unwrap(); + buf[index] = b; + index += 1; + } + + if index == buf.len() { + Ok(buf.len()) + } else { + stream.read(&mut buf[index ..]) + } + } + StreamInstance::InputFile(_, ref mut file) => { + file.read(buf) + } + StreamInstance::TcpStream(_, ref mut tcp_stream) => { + tcp_stream.read(buf) + } + StreamInstance::TlsStream(_, ref mut tls_stream) => { + tls_stream.read(buf) + } + StreamInstance::ReadlineStream(ref mut rl_stream) => { + rl_stream.read(buf) + } + StreamInstance::StaticStr(ref mut src) => { + src.read(buf) + } + StreamInstance::Bytes(ref mut cursor) => { + cursor.read(buf) + } + StreamInstance::OutputFile(..) | + StreamInstance::Stdout | + StreamInstance::Null => { + Err(std::io::Error::new( + ErrorKind::PermissionDenied, + StreamError::ReadFromOutputStream, + )) + } + } + } +} + impl Drop for StreamInstance { fn drop(&mut self) { match self { @@ -126,15 +191,20 @@ impl fmt::Debug for StreamInstance { match self { &StreamInstance::Bytes(ref bytes) => write!(fmt, "Bytes({:?})", bytes), - &StreamInstance::DynReadSource(_) => - write!(fmt, "DynReadSource(_)"), // Hacky solution. - &StreamInstance::InputFile(_, ref file) => write!(fmt, "InputFile({:?})", file), - &StreamInstance::OutputFile(_, ref file, _) => write!(fmt, "OutputFile({:?})", file), - &StreamInstance::Null => write!(fmt, "Null"), + &StreamInstance::StaticStr(_) => + write!(fmt, "StaticStr(_)"), // Hacky solution. + &StreamInstance::InputFile(_, ref file) => + write!(fmt, "InputFile({:?})", file), + &StreamInstance::OutputFile(_, ref file, _) => + write!(fmt, "OutputFile({:?})", file), + &StreamInstance::Null => + write!(fmt, "Null"), + &StreamInstance::PausedPrologStream(ref put_back, ref stream) => + write!(fmt, "PausedPrologStream({:?}, {:?})", put_back, stream), &StreamInstance::ReadlineStream(ref readline_stream) => write!(fmt, "ReadlineStream({:?})", readline_stream), - // &StreamInstance::Stdin => write!(fmt, "Stdin"), - &StreamInstance::Stdout => write!(fmt, "Stdout"), + &StreamInstance::Stdout => + write!(fmt, "Stdout"), &StreamInstance::TcpStream(_, ref tcp_stream) => write!(fmt, "TcpStream({:?})", tcp_stream), &StreamInstance::TlsStream(_, ref tls_stream) => @@ -282,7 +352,7 @@ impl From for Stream { impl From<&'static str> for Stream { fn from(src: &'static str) -> Stream { - Stream::from_inst(StreamInstance::DynReadSource(Box::new(src.as_bytes()))) + Stream::from_inst(StreamInstance::StaticStr(Cursor::new(src))) } } @@ -413,8 +483,9 @@ impl Stream { fn mode(&self) -> &'static str { match self.stream_inst.0.borrow().1 { StreamInstance::Bytes(_) | + StreamInstance::PausedPrologStream(..) | StreamInstance::ReadlineStream(_) | - StreamInstance::DynReadSource(_) | + StreamInstance::StaticStr(_) | StreamInstance::InputFile(..) => { "read" } @@ -493,7 +564,6 @@ impl Stream { pub(crate) fn is_stdin(&self) -> bool { match self.stream_inst.0.borrow().1 { - //StreamInstance::Stdin | StreamInstance::ReadlineStream(_) => { true } @@ -523,12 +593,12 @@ impl Stream { pub(crate) fn is_input_stream(&self) -> bool { match self.stream_inst.0.borrow().1 { - // StreamInstance::Stdin | StreamInstance::TcpStream(..) | StreamInstance::TlsStream(..) | StreamInstance::Bytes(_) | + StreamInstance::PausedPrologStream(..) | StreamInstance::ReadlineStream(_) | - StreamInstance::DynReadSource(_) | + StreamInstance::StaticStr(_) | StreamInstance::InputFile(..) => { true } @@ -555,27 +625,49 @@ impl Stream { } } + fn unpause_stream(&mut self) { + let stream_inst = + match self.stream_inst.0.borrow_mut().1 { + StreamInstance::PausedPrologStream(ref put_back, ref mut stream_inst) + if put_back.is_empty() => { + mem::replace(&mut **stream_inst, StreamInstance::Null) + } + _ => { + return; + } + }; + + self.stream_inst.0.borrow_mut().1 = stream_inst; + } + // returns true on success. #[inline] pub(super) fn reset(&mut self) -> bool { self.stream_inst.0.borrow_mut().0 = false; - match self.stream_inst.0.borrow_mut().1 { - StreamInstance::Bytes(ref mut cursor) => { - cursor.set_position(0); - true - } - StreamInstance::InputFile(_, ref mut file) => { - file.seek(SeekFrom::Start(0)).unwrap(); - true - } - StreamInstance::ReadlineStream(_) => { - true - } - _ => { - false + loop { + match self.stream_inst.0.borrow_mut().1 { + StreamInstance::Bytes(ref mut cursor) => { + cursor.set_position(0); + return true; + } + StreamInstance::InputFile(_, ref mut file) => { + file.seek(SeekFrom::Start(0)).unwrap(); + return true; + } + StreamInstance::PausedPrologStream(ref mut put_back, _) => { + put_back.clear(); + } + StreamInstance::ReadlineStream(_) => { + return true; + } + _ => { + return false; + } } + + self.unpause_stream(); } } @@ -687,6 +779,34 @@ impl Stream { } } } + + #[inline] + pub(crate) + fn pause_stream(&mut self, buf: Vec>) -> io::Result<()> { + match self.stream_inst.0.borrow_mut().1 { + StreamInstance::PausedPrologStream(ref mut inner_buf, _) => { + inner_buf.extend(parser_top_to_bytes(buf)?.into_iter()); + return Ok(()); + } + _ => { + } + } + + if !buf.is_empty() { + let stream_inst = mem::replace( + &mut self.stream_inst.0.borrow_mut().1, + StreamInstance::Null, + ); + + self.stream_inst.0.borrow_mut().1 = + StreamInstance::PausedPrologStream( + parser_top_to_bytes(buf)?, + Box::new(stream_inst), + ); + } + + Ok(()) + } } impl MachineState { @@ -883,7 +1003,7 @@ impl MachineState { stub_name: &'static str, stub_arity: usize, ) -> Result { - match parsing_stream(stream.clone()) { + match parsing_stream(stream) { Ok(parsing_stream) => { Ok(parsing_stream) } @@ -1045,38 +1165,11 @@ impl MachineState { } impl Read for Stream { + #[inline] fn read(&mut self, buf: &mut [u8]) -> std::io::Result { - match self.stream_inst.0.borrow_mut().1 { - StreamInstance::InputFile(_, ref mut file) => { - file.read(buf) - } - StreamInstance::TcpStream(_, ref mut tcp_stream) => { - tcp_stream.read(buf) - } - StreamInstance::TlsStream(_, ref mut tls_stream) => { - tls_stream.read(buf) - } - StreamInstance::ReadlineStream(ref mut rl_stream) => { - rl_stream.read(buf) - } - StreamInstance::DynReadSource(ref mut src) => { - src.read(buf) - } - StreamInstance::Bytes(ref mut cursor) => { - cursor.read(buf) - } -/* - StreamInstance::Stdin => { - stdin().read(buf) - } -*/ - StreamInstance::OutputFile(..) | StreamInstance::Stdout | StreamInstance::Null => { - Err(std::io::Error::new( - ErrorKind::PermissionDenied, - StreamError::ReadFromOutputStream, - )) - } - } + let bytes_read = self.stream_inst.0.borrow_mut().1.read(buf)?; + self.unpause_stream(); + Ok(bytes_read) } } @@ -1098,8 +1191,11 @@ impl Write for Stream { StreamInstance::Stdout => { stdout().write(buf) } - StreamInstance::DynReadSource(_) | StreamInstance::ReadlineStream(_) | - StreamInstance::InputFile(..) | StreamInstance::Null => { + StreamInstance::PausedPrologStream(..) | + StreamInstance::StaticStr(_) | + StreamInstance::ReadlineStream(_) | + StreamInstance::InputFile(..) | + StreamInstance::Null => { Err(std::io::Error::new( ErrorKind::PermissionDenied, StreamError::WriteToInputStream, @@ -1125,8 +1221,11 @@ impl Write for Stream { StreamInstance::Stdout => { stdout().flush() } - StreamInstance::DynReadSource(_) | StreamInstance::ReadlineStream(_) | - StreamInstance::InputFile(..) | StreamInstance::Null => { + StreamInstance::PausedPrologStream(..) | + StreamInstance::StaticStr(_) | + StreamInstance::ReadlineStream(_) | + StreamInstance::InputFile(..) | + StreamInstance::Null => { Err(std::io::Error::new( ErrorKind::PermissionDenied, StreamError::FlushToInputStream, diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 10ae3d7f..644f8296 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -2470,10 +2470,11 @@ impl MachineState { string.push(c as char); } } else { - let mut iter = self.open_parsing_stream(stream.clone(), - "get_n_chars", - 2, - )?; + let mut iter = self.open_parsing_stream( + stream.clone(), + "get_n_chars", + 2, + )?; for _ in 0..num { let result = iter.next(); @@ -4475,16 +4476,10 @@ impl MachineState { let mut heap_pstr_iter = self.heap_pstr_iter(self[temp_v!(1)]); let chars = heap_pstr_iter.to_string(); - let mut stream = self.open_parsing_stream( - Stream::from(chars), - "read_term_from_chars", - 2, - )?; - if let Addr::EmptyList = heap_pstr_iter.focus() { let term_write_result = match self.read( - &mut stream, + Stream::from(chars), indices.atom_tbl.clone(), &indices.op_dir, ) { diff --git a/src/machine/term_expansion.rs b/src/machine/term_expansion.rs index f26799b7..6ee8f8d3 100644 --- a/src/machine/term_expansion.rs +++ b/src/machine/term_expansion.rs @@ -165,7 +165,7 @@ impl<'a> TermStream<'a> { #[inline] pub fn eof(&mut self) -> Result { - self.parser.devour_whitespace()?; // eliminate dangling comments before checking for EOF. + self.parser.devour_whitespace()?; // eliminate dangling comments before checking for EOF. Ok(self.stack.is_empty() && self.parser.eof()?) } diff --git a/src/read.rs b/src/read.rs index 9230f76e..e468dfbd 100644 --- a/src/read.rs +++ b/src/read.rs @@ -67,10 +67,10 @@ pub mod readline { } } - if self.pending_input.get_ref().chars().last() != Some('\n') - { + if self.pending_input.get_ref().chars().last() != Some('\n') { *self.pending_input.get_mut() += "\n"; } + self.pending_input.read(buf) } Err(ReadlineError::Eof) => { @@ -160,12 +160,23 @@ pub mod readline { impl MachineState { pub fn read( &mut self, - inner: &mut PrologStream, + mut inner: Stream, atom_tbl: TabledData, op_dir: &OpDir, ) -> Result { - let mut parser = Parser::new(inner, atom_tbl, self.flags); - let term = parser.read_term(composite_op!(op_dir))?; + let mut stream = parsing_stream(inner.clone())?; + + let term = { + let mut parser = Parser::new(&mut stream, atom_tbl, self.flags); + parser.read_term(composite_op!(op_dir))? + }; + + // 'pausing' the stream saves the pending top buffer + // created by the parsing stream, which was created in this + // scope and is about to be destroyed in it. + + let buf = stream.take_buf(); + inner.pause_stream(buf)?; Ok(write_term_to_heap(&term, self)) } diff --git a/src/toplevel.pl b/src/toplevel.pl index dfe53d26..bbada3a2 100644 --- a/src/toplevel.pl +++ b/src/toplevel.pl @@ -108,28 +108,28 @@ read_and_match :- '$read_query_term'(_, Term, _, _, VarList), instruction_match(Term, VarList). + % make compile_batch, a system routine, callable. compile_batch :- '$compile_batch'. instruction_match(Term, VarList) :- ( var(Term) -> throw(error(instantiation_error, repl/0)) - ; - Term = [Item] -> !, - ( atom(Item) -> - ( Item == user -> - catch(compile_batch, E, print_exception_with_check(E)) - ; consult(Item) - ) - ; - catch(throw(error(type_error(atom, Item), repl/0)), - E, - print_exception_with_check(E)) - ) - ; - Term = end_of_file -> halt - ; - submit_query_and_print_results(Term, VarList) + ; Term = [Item] -> + !, + ( atom(Item) -> + ( Item == user -> + catch(compile_batch, E, print_exception_with_check(E)) + ; consult(Item) + ) + ; + catch(throw(error(type_error(atom, Item), repl/0)), + E, + print_exception_with_check(E)) + ) + ; Term = end_of_file -> + halt + ; submit_query_and_print_results(Term, VarList) ). :- use_module(library(iso_ext)). @@ -159,10 +159,10 @@ needs_bracketing(Value, Op) :- false), ( EqPrec < FPrec -> true - ; '$quoted_token'(F) -> - true ; FPrec > 0, F == Value, graphic_token_char(F) -> true + ; F \== '.', '$quoted_token'(F) -> + true ; EqPrec == FPrec, memberchk(EqSpec, [fx,xfx,yfx]) ). From d57a5922730b4a7a95776744dc0dcfdddcdf3036 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Mon, 3 Aug 2020 19:29:53 -0600 Subject: [PATCH 05/37] unify '[]' with proper [] in atom_chars/2 (#569) --- Cargo.lock | 4 ++-- Cargo.toml | 2 +- src/machine/system_calls.rs | 24 ++++++++++++++---------- 3 files changed, 17 insertions(+), 13 deletions(-) diff --git a/Cargo.lock b/Cargo.lock index 531d0e50..526b9644 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -905,9 +905,9 @@ dependencies = [ [[package]] name = "prolog_parser" -version = "0.8.65" +version = "0.8.66" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fdcfe8260335a150812e36b171ff985ce88f02de16c05f4a13fe4f10e8c247f8" +checksum = "e35f5db0eb6725d00be12f3c9550de0dce0a43a1fa25a873f879613d63fcbbd5" dependencies = [ "lexical", "num-rug-adapter", diff --git a/Cargo.toml b/Cargo.toml index c359e1ba..4b4bc1bf 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -32,7 +32,7 @@ libc = "0.2.62" nix = "0.15.0" num-rug-adapter = { optional = true, version = "0.1.3" } ordered-float = "0.5.0" -prolog_parser = { version = "0.8.65", default-features = false } +prolog_parser = { version = "0.8.66", default-features = false } ref_thread_local = "0.0.0" rug = { version = "1.4.0", optional = true } rustyline = "6.0.0" diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 644f8296..ada49a0f 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -1029,20 +1029,24 @@ impl MachineState { match iter.focus() { Addr::EmptyList => { - let chars = clause_name!(string, indices.atom_tbl); - let atom = self.heap.to_unifiable( - HeapCellValue::Atom(chars, None) - ); + if &string == "[]" { + self.unify(addr, Addr::EmptyList); + } else { + let chars = clause_name!(string, indices.atom_tbl); + let atom = self.heap.to_unifiable( + HeapCellValue::Atom(chars, None) + ); - self.unify(addr, atom); + self.unify(addr, atom); + } } focus => { - let stub = MachineError::functor_stub( - clause_name!("atom_chars"), - 2, - ); - if let Addr::Lis(l) = focus { + let stub = MachineError::functor_stub( + clause_name!("atom_chars"), + 2, + ); + let err = MachineError::type_error( self.heap.h(), ValidType::Character, From 79cf0c63c43a590873fe1062722756484d21f60b Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Tue, 4 Aug 2020 23:35:10 -0600 Subject: [PATCH 06/37] update prolog_parser to 0.8.67 (#648) --- Cargo.lock | 4 +--- Cargo.toml | 2 +- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/Cargo.lock b/Cargo.lock index 526b9644..6f819538 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -905,9 +905,7 @@ dependencies = [ [[package]] name = "prolog_parser" -version = "0.8.66" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e35f5db0eb6725d00be12f3c9550de0dce0a43a1fa25a873f879613d63fcbbd5" +version = "0.8.67" dependencies = [ "lexical", "num-rug-adapter", diff --git a/Cargo.toml b/Cargo.toml index 4b4bc1bf..485132a2 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -32,7 +32,7 @@ libc = "0.2.62" nix = "0.15.0" num-rug-adapter = { optional = true, version = "0.1.3" } ordered-float = "0.5.0" -prolog_parser = { version = "0.8.66", default-features = false } +prolog_parser = { version = "0.8.67", default-features = false } ref_thread_local = "0.0.0" rug = { version = "1.4.0", optional = true } rustyline = "6.0.0" From a622ffddfe529a172d2c9a7eb3cf7166fbeccd00 Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Wed, 5 Aug 2020 20:09:07 +0200 Subject: [PATCH 07/37] ADDED: library(crypto): Support for additional authenticated data (AAD). Additional authenticated data can now be specified with the new aad(Chars) option for encryption and decryption. It is authenticated, but not encrypted. --- src/clause_types.rs | 2 +- src/lib/crypto.pl | 18 +++++++- src/machine/system_calls.rs | 88 +++++++++++++++++++------------------ 3 files changed, 62 insertions(+), 46 deletions(-) diff --git a/src/clause_types.rs b/src/clause_types.rs index 04509308..3f1fee68 100644 --- a/src/clause_types.rs +++ b/src/clause_types.rs @@ -710,7 +710,7 @@ impl SystemClauseType { ("$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_encrypt", 7) => Some(SystemClauseType::CryptoDataEncrypt), ("$crypto_data_decrypt", 6) => Some(SystemClauseType::CryptoDataDecrypt), ("$crypto_curve_scalar_mult", 5) => Some(SystemClauseType::CryptoCurveScalarMult), ("$ed25519_sign", 5) => Some(SystemClauseType::Ed25519Sign), diff --git a/src/lib/crypto.pl b/src/lib/crypto.pl index 49aae46e..7daab599 100644 --- a/src/lib/crypto.pl +++ b/src/lib/crypto.pl @@ -492,6 +492,12 @@ bytes_base64(Bytes, Base64) :- list of _bytes_ holding the tag. This tag must be provided for decryption. + - aad(+Data) + Data is additional authenticated data (AAD), a list of + characters. It is authenticated in that it influences the tag, + but it is not encrypted. The encoding/1 option also specifies + the encoding of Data. + Here is an example encryption and decryption, using the ChaCha20 stream cipher with the Poly1305 authenticator. This cipher uses a 256-bit key and a 96-bit nonce, i.e., 32 and 12 _bytes_, @@ -533,13 +539,15 @@ crypto_data_encrypt(PlainText0, Algorithm, Key, IV, CipherText, Options) :- must_be_bytes(Tag, crypto_data_encrypt/6) ; true ), + option(aad(AAD0), Options, []), + encoding_chars(Encoding, AAD0, AAD), must_be_bytes(Key, crypto_data_encrypt/6), must_be_bytes(IV, crypto_data_encrypt/6), must_be(atom, Algorithm), ( Algorithm = 'chacha20-poly1305' -> true ; domain_error('chacha20-poly1305', Algorithm, crypto_data_encrypt/6) ), - '$crypto_data_encrypt'(PlainText, Encoding, Key, IV, Tag, CipherText). + '$crypto_data_encrypt'(PlainText, AAD, Encoding, Key, IV, Tag, CipherText). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - crypto_data_decrypt(+CipherText, @@ -567,6 +575,10 @@ crypto_data_encrypt(PlainText0, Algorithm, Key, IV, CipherText, Options) :- - tag(+Tag) For authenticated encryption schemes, the tag must be specified as a list of bytes exactly as they were generated upon encryption. + + - aad(+Data) + Any additional authenticated data (AAD) must be specified. The + encoding/1 option also specifies the encoding of Data. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ crypto_data_decrypt(CipherText0, Algorithm, Key, IV, PlainText, Options) :- @@ -576,6 +588,8 @@ 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), @@ -585,7 +599,7 @@ crypto_data_decrypt(CipherText0, Algorithm, Key, IV, PlainText, Options) :- ( Algorithm = 'chacha20-poly1305' -> true ; domain_error('chacha20-poly1305', Algorithm, crypto_data_decrypt/6) ), - '$crypto_data_decrypt'(CipherText, octet, Key, IV, Encoding, PlainText). + '$crypto_data_decrypt'(CipherText, AAD, Key, IV, Encoding, PlainText). encoding_chars(octet, Bs, Cs) :- diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index ada49a0f..f938140a 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -5388,7 +5388,8 @@ impl MachineState { self.unify(arg, byte); } &SystemClauseType::CryptoDataHash => { - let bytes = self.string_encoding_bytes(1, 2); + let encoding = self.atom_argument_to_string(2); + let bytes = self.string_encoding_bytes(1, &encoding); let algorithm_str = match self.store(self.deref(self[temp_v!(4)])) { Addr::Con(h) if self.heap.atom_at(h) => { @@ -5442,7 +5443,8 @@ impl MachineState { self.unify(self[temp_v!(3)], ints_list); } &SystemClauseType::CryptoDataHKDF => { - let data = self.string_encoding_bytes(1, 2); + let encoding = self.atom_argument_to_string(2); + let data = self.string_encoding_bytes(1, &encoding); let stub1 = MachineError::functor_stub(clause_name!("crypto_data_hkdf"), 4); let salt = self.integers_to_bytevec(temp_v!(3), stub1); let stub2 = MachineError::functor_stub(clause_name!("crypto_data_hkdf"), 4); @@ -5530,11 +5532,13 @@ impl MachineState { self.unify(self[temp_v!(4)], ints_list); } &SystemClauseType::CryptoDataEncrypt => { - let data = self.string_encoding_bytes(1, 2); - let stub2 = MachineError::functor_stub(clause_name!("crypto_data_encrypt"), 6); - let key = self.integers_to_bytevec(temp_v!(3), stub2); - let stub3 = MachineError::functor_stub(clause_name!("crypto_data_encrypt"), 6); - let iv = self.integers_to_bytevec(temp_v!(4), stub3); + let encoding = self.atom_argument_to_string(3); + let data = self.string_encoding_bytes(1, &encoding); + let aad = self.string_encoding_bytes(2, &encoding); + let stub2 = MachineError::functor_stub(clause_name!("crypto_data_encrypt"), 7); + let key = self.integers_to_bytevec(temp_v!(4), stub2); + let stub3 = MachineError::functor_stub(clause_name!("crypto_data_encrypt"), 7); + let iv = self.integers_to_bytevec(temp_v!(5), stub3); let unbound_key = aead::UnboundKey::new(&aead::CHACHA20_POLY1305, &key).unwrap(); let nonce = aead::Nonce::try_assume_unique_for_key(&iv).unwrap(); @@ -5542,7 +5546,7 @@ impl MachineState { let mut in_out = data.clone(); let tag = - match key.seal_in_place_separate_tag(nonce, aead::Aad::empty(), &mut in_out) { + match key.seal_in_place_separate_tag(nonce, aead::Aad::from(aad), &mut in_out) { Ok(d) => { d } _ => { self.fail = true; return Ok(()); } }; @@ -5555,29 +5559,18 @@ impl MachineState { self.heap.put_complete_string(&buffer) }; - self.unify(self[temp_v!(5)], tag_list); - self.unify(self[temp_v!(6)], complete_string); + self.unify(self[temp_v!(6)], tag_list); + self.unify(self[temp_v!(7)], complete_string); } &SystemClauseType::CryptoDataDecrypt => { - let data = self.string_encoding_bytes(1, 2); - let stub1 = MachineError::functor_stub(clause_name!("crypto_data_decrypt"), 6); + let data = self.string_encoding_bytes(1, "octet"); + let encoding = self.atom_argument_to_string(5); + let aad = self.string_encoding_bytes(2, &encoding); + let stub1 = MachineError::functor_stub(clause_name!("crypto_data_decrypt"), 7); let key = self.integers_to_bytevec(temp_v!(3), stub1); - let stub2 = MachineError::functor_stub(clause_name!("crypto_data_decrypt"), 6); + let stub2 = MachineError::functor_stub(clause_name!("crypto_data_decrypt"), 7); let iv = self.integers_to_bytevec(temp_v!(4), stub2); - let encoding = match self.store(self.deref(self[temp_v!(5)])) { - Addr::Con(h) if self.heap.atom_at(h) => { - if let HeapCellValue::Atom(ref atom, _) = &self.heap[h] { - atom.as_str() - } else { - unreachable!() - } - } - _ => { - unreachable!() - } - }; - let unbound_key = aead::UnboundKey::new(&aead::CHACHA20_POLY1305, &key).unwrap(); let nonce = aead::Nonce::try_assume_unique_for_key(&iv).unwrap(); let key = aead::LessSafeKey::new(unbound_key); @@ -5586,12 +5579,12 @@ impl MachineState { let complete_string = { let decrypted_data = - match key.open_in_place(nonce, aead::Aad::empty(), &mut in_out) { + match key.open_in_place(nonce, aead::Aad::from(aad), &mut in_out) { Ok(d) => { d } _ => { self.fail = true; return Ok(()); } }; - let buffer = match encoding { + let buffer = match encoding.as_str() { "octet" => { String::from_iter(decrypted_data.iter().map(|b| *b as char)) } "utf8" => { match String::from_utf8(decrypted_data.to_vec()) { Ok(str) => { str } @@ -5665,7 +5658,8 @@ impl MachineState { self.unify(self[temp_v!(1)], complete_string); } &SystemClauseType::Ed25519KeyPairPublicKey => { - let bytes = self.string_encoding_bytes(1, 2); + let encoding = self.atom_argument_to_string(2); + let bytes = self.string_encoding_bytes(1, &encoding); let key_pair = match signature::Ed25519KeyPair::from_pkcs8(&bytes) { Ok(kp) => { kp } @@ -5680,8 +5674,9 @@ impl MachineState { self.unify(self[temp_v!(3)], complete_string); } &SystemClauseType::Ed25519Sign => { - let key = self.string_encoding_bytes(1, 2); - let data = self.string_encoding_bytes(3, 4); + let key = self.string_encoding_bytes(1, "octet"); + let encoding = self.atom_argument_to_string(4); + let data = self.string_encoding_bytes(3, &encoding); let key_pair = match signature::Ed25519KeyPair::from_pkcs8(&key) { Ok(kp) => { kp } @@ -5696,8 +5691,9 @@ impl MachineState { self.unify(self[temp_v!(5)], sig_list); } &SystemClauseType::Ed25519Verify => { - let key = self.string_encoding_bytes(1, 2); - let data = self.string_encoding_bytes(3, 4); + let key = self.string_encoding_bytes(1, "octet"); + let encoding = self.atom_argument_to_string(4); + let data = self.string_encoding_bytes(3, &encoding); let stub = MachineError::functor_stub(clause_name!("ed25519_verify"), 5); let signature = self.integers_to_bytevec(temp_v!(5), stub); @@ -5863,17 +5859,14 @@ impl MachineState { } pub(super) - fn string_encoding_bytes( + fn atom_argument_to_string( &mut self, - data_arg: usize, - encoding_arg: usize, - ) -> Vec { - let data = self.heap_pstr_iter(self[temp_v!(data_arg)]).to_string(); - - let encoding_str = match self.store(self.deref(self[temp_v!(encoding_arg)])) { + atom_arg: usize, + ) -> String { + match self.store(self.deref(self[temp_v!(atom_arg)])) { Addr::Con(h) if self.heap.atom_at(h) => { if let HeapCellValue::Atom(ref atom, _) = &self.heap[h] { - atom.as_str() + atom.as_str().to_string() } else { unreachable!() } @@ -5881,9 +5874,18 @@ impl MachineState { _ => { unreachable!() } - }; + } + } - match encoding_str { + pub(super) + fn string_encoding_bytes( + &mut self, + data_arg: usize, + encoding: &str, + ) -> Vec { + let data = self.heap_pstr_iter(self[temp_v!(data_arg)]).to_string(); + + match encoding { "utf8" => { data.into_bytes() } "octet" => { let mut buf = vec![]; From 1c23336cffbcbf09dd0dfba8c7d399189317a02c Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Wed, 5 Aug 2020 20:10:58 +0200 Subject: [PATCH 08/37] use "octet" as a string literal, reducing the number of arguments --- src/clause_types.rs | 6 +++--- src/lib/crypto.pl | 6 +++--- src/machine/system_calls.rs | 17 ++++++++--------- 3 files changed, 14 insertions(+), 15 deletions(-) diff --git a/src/clause_types.rs b/src/clause_types.rs index 3f1fee68..339c7d38 100644 --- a/src/clause_types.rs +++ b/src/clause_types.rs @@ -713,10 +713,10 @@ impl SystemClauseType { ("$crypto_data_encrypt", 7) => 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_sign", 4) => Some(SystemClauseType::Ed25519Sign), + ("$ed25519_verify", 4) => Some(SystemClauseType::Ed25519Verify), ("$ed25519_new_keypair", 1) => Some(SystemClauseType::Ed25519NewKeyPair), - ("$ed25519_keypair_public_key", 3) => Some(SystemClauseType::Ed25519KeyPairPublicKey), + ("$ed25519_keypair_public_key", 2) => Some(SystemClauseType::Ed25519KeyPairPublicKey), ("$curve25519_scalar_mult", 3) => Some(SystemClauseType::Curve25519ScalarMult), ("$load_html", 3) => Some(SystemClauseType::LoadHTML), ("$load_xml", 3) => Some(SystemClauseType::LoadXML), diff --git a/src/lib/crypto.pl b/src/lib/crypto.pl index 7daab599..330368ed 100644 --- a/src/lib/crypto.pl +++ b/src/lib/crypto.pl @@ -651,19 +651,19 @@ ed25519_new_keypair(Pair) :- ed25519_keypair_public_key(Pair, PublicKey) :- must_be_byte_chars(Pair, ed25519_keypair_public_key), - '$ed25519_keypair_public_key'(Pair, octet, PublicKey). + '$ed25519_keypair_public_key'(Pair, PublicKey). ed25519_sign(Key, Data0, Signature, Options) :- must_be_byte_chars(Key, ed25519_sign), options_data_chars(Options, Data0, Data, Encoding), - '$ed25519_sign'(Key, octet, Data, Encoding, Signature0), + '$ed25519_sign'(Key, Data, Encoding, Signature0), hex_bytes(Signature, Signature0). ed25519_verify(Key, Data0, Signature0, Options) :- must_be_byte_chars(Key, ed25519_verify), options_data_chars(Options, Data0, Data, Encoding), hex_bytes(Signature0, Signature), - '$ed25519_verify'(Key, octet, Data, Encoding, Signature). + '$ed25519_verify'(Key, Data, Encoding, Signature). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - X25519: ECDH key exchange over Curve25519 diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index f938140a..2dd584a0 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -5658,8 +5658,7 @@ impl MachineState { self.unify(self[temp_v!(1)], complete_string); } &SystemClauseType::Ed25519KeyPairPublicKey => { - let encoding = self.atom_argument_to_string(2); - let bytes = self.string_encoding_bytes(1, &encoding); + let bytes = self.string_encoding_bytes(1, "octet"); let key_pair = match signature::Ed25519KeyPair::from_pkcs8(&bytes) { Ok(kp) => { kp } @@ -5671,12 +5670,12 @@ impl MachineState { self.heap.put_complete_string(&buffer) }; - self.unify(self[temp_v!(3)], complete_string); + self.unify(self[temp_v!(2)], complete_string); } &SystemClauseType::Ed25519Sign => { let key = self.string_encoding_bytes(1, "octet"); - let encoding = self.atom_argument_to_string(4); - let data = self.string_encoding_bytes(3, &encoding); + let encoding = self.atom_argument_to_string(3); + let data = self.string_encoding_bytes(2, &encoding); let key_pair = match signature::Ed25519KeyPair::from_pkcs8(&key) { Ok(kp) => { kp } @@ -5688,14 +5687,14 @@ impl MachineState { let sig_list = Addr::HeapCell(self.heap.to_list(sig.as_ref().iter().map(|b| HeapCellValue::from(Addr::Fixnum(*b as isize))))); - self.unify(self[temp_v!(5)], sig_list); + self.unify(self[temp_v!(4)], sig_list); } &SystemClauseType::Ed25519Verify => { let key = self.string_encoding_bytes(1, "octet"); - let encoding = self.atom_argument_to_string(4); - let data = self.string_encoding_bytes(3, &encoding); + let encoding = self.atom_argument_to_string(3); + let data = self.string_encoding_bytes(2, &encoding); let stub = MachineError::functor_stub(clause_name!("ed25519_verify"), 5); - let signature = self.integers_to_bytevec(temp_v!(5), stub); + let signature = self.integers_to_bytevec(temp_v!(4), stub); let peer_public_key = signature::UnparsedPublicKey::new(&signature::ED25519, &key); match peer_public_key.verify(&data, &signature) { From 2d3f1e51ec5e707a72b423719a6f6aaa85ae4beb Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Wed, 5 Aug 2020 20:31:56 +0200 Subject: [PATCH 09/37] shorten, and increase readability --- src/lib/crypto.pl | 6 ++---- src/machine/system_calls.rs | 34 +++++++--------------------------- 2 files changed, 9 insertions(+), 31 deletions(-) diff --git a/src/lib/crypto.pl b/src/lib/crypto.pl index 330368ed..af03e7d6 100644 --- a/src/lib/crypto.pl +++ b/src/lib/crypto.pl @@ -282,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), @@ -415,7 +415,7 @@ crypto_password_hash(Password0, Hash, Options) :- chars_bytes_(Password0, Password, crypto_password_hash/3), must_be(list, Options), option(cost(C), Options, 17), - Iterations is 2^C, + Iterations #= 2^C, Algorithm = 'pbkdf2-sha512', % current default and only option option(algorithm(Algorithm), Options, Algorithm), ( member(salt(SaltBytes), Options) -> @@ -702,8 +702,6 @@ curve25519_generator(Gs) :- curve25519_scalar_mult(Scalar, Point, Result) :- ( integer_si(Scalar) -> - Scalar #>= 0, - Scalar #< 2^256, length(ScalarBytes, 32), bytes_integer(ScalarBytes, Scalar) ; ScalarBytes = Scalar, diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 2dd584a0..d8275877 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -5713,10 +5713,7 @@ impl MachineState { let result = scalarmult(&scalar, &point).unwrap(); - let mut string = String::new(); - for c in result[..].iter() { - string.push(*c as char); - } + let string = String::from_iter(result[..].iter().map(|b| *b as char)); let cstr = self.heap.put_complete_string(&string); self.unify(self[temp_v!(3)], cstr); } @@ -5761,32 +5758,18 @@ impl MachineState { env::remove_var(key); } &SystemClauseType::CharsBase64 => { - let mut options = vec![]; - - for i in 3..5 { - match self.store(self.deref(self[temp_v!(i)])) { - Addr::Con(h) if self.heap.atom_at(h) => { - if let HeapCellValue::Atom(ref atom, _) = &self.heap[h] { - options.push(atom.as_str()); - } else { - unreachable!() - } - } - _ => { - unreachable!() - } - }; - } + let padding = self.atom_argument_to_string(3); + let charset = self.atom_argument_to_string(4); let config = - if options[0] == "true" { - if options[1] == "standard" { + if padding == "true" { + if charset == "standard" { base64::STANDARD } else { base64::URL_SAFE } } else { - if options[1] == "standard" { + if charset == "standard" { base64::STANDARD_NO_PAD } else { base64::URL_SAFE_NO_PAD @@ -5799,10 +5782,7 @@ impl MachineState { match bytes { Ok(bs) => { - let mut string = String::new(); - for c in bs { - string.push(c as char); - } + let string = String::from_iter(bs.iter().map(|b| *b as char)); let cstr = self.heap.put_complete_string(&string); self.unify(self[temp_v!(1)], cstr); } From f627b323550dc104b2331454b6b942d89d72949c Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Thu, 6 Aug 2020 00:17:55 -0600 Subject: [PATCH 10/37] fix crash in CryptoPasswordHash (#653), conversion of Rational integers in number_chars/2 (#655) --- Cargo.lock | 2 ++ src/machine/system_calls.rs | 15 +++++++++++++-- 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/Cargo.lock b/Cargo.lock index 6f819538..6f1db7a8 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -906,6 +906,8 @@ dependencies = [ [[package]] name = "prolog_parser" version = "0.8.67" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f16bb270c3f20e0ccd6e0b7f1367d4a1ac9070227e40733512913cdf24fe9152" dependencies = [ "lexical", "num-rug-adapter", diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index ada49a0f..df2187d1 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -1675,6 +1675,12 @@ impl MachineState { Ok(Number::Integer(n)) => { n.to_string() } + Ok(Number::Rational(r)) => { + // n has already been confirmed as an integer, and + // internally, Rational is assumed reduced, so its denominator + // must be 1. + r.numer().to_string() + } _ => { unreachable!() } @@ -5502,15 +5508,20 @@ impl MachineState { let stub2 = MachineError::functor_stub(clause_name!("crypto_password_hash"), 3); let salt = self.integers_to_bytevec(temp_v!(2), stub2); + let iterations = self.store(self.deref(self[temp_v!(3)])); + let iterations = - match Number::try_from((self[temp_v!(3)], &self.heap)) { + match Number::try_from((iterations, &self.heap)) { Ok(Number::Fixnum(n)) => { u64::try_from(n).unwrap() } Ok(Number::Integer(n)) => { match n.to_u64() { Some(i) => { i } - None => { self.fail = true; return Ok(()); } + None => { + self.fail = true; + return Ok(()); + } } } _ => { From 3143468751effdc06dd0f578235dc8a322737832 Mon Sep 17 00:00:00 2001 From: notoria Date: Thu, 6 Aug 2020 11:39:55 +0200 Subject: [PATCH 11/37] Fixed some conversion issues --- src/lib/builtins.pl | 1 + src/machine/system_calls.rs | 12 ++++++++++++ 2 files changed, 13 insertions(+) diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl index ebfebfff..df312708 100644 --- a/src/lib/builtins.pl +++ b/src/lib/builtins.pl @@ -918,6 +918,7 @@ op(Priority, OpSpec, Op) :- halt :- halt(0). halt(N) :- + must_be_number(N, halt/1), ( -2^31 =< N, N =< 2^31 - 1 -> '$halt'(N) ; throw(error(domain_error(exit_code, N), halt/1)) diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index c3488c2b..cfe45e80 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -1706,6 +1706,12 @@ impl MachineState { Ok(Number::Integer(n)) => { n.to_string() } + Ok(Number::Rational(r)) => { + // n has already been confirmed as an integer, and + // internally, Rational is assumed reduced, so its + // denominator must be 1. + r.numer().to_string() + } _ => { unreachable!() } @@ -3766,6 +3772,12 @@ impl MachineState { let code = match Number::try_from((code, &self.heap)) { Ok(Number::Fixnum(n)) => n as i32, Ok(Number::Integer(n)) => n.to_i32().unwrap(), + Ok(Number::Rational(r)) => { + // n has already been confirmed as an integer, and + // internally, Rational is assumed reduced, so its + // denominator must be 1. + r.numer().to_i32().unwrap() + } _ => { unreachable!() } }; From 1b4500339ecf7b8076af034260048d755d2f78a6 Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Thu, 6 Aug 2020 20:12:23 +0200 Subject: [PATCH 12/37] use atom_argument_to_string --- src/machine/system_calls.rs | 47 ++++++------------------------------- 1 file changed, 7 insertions(+), 40 deletions(-) diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index c3488c2b..fa6ea029 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -5397,21 +5397,10 @@ impl MachineState { let encoding = self.atom_argument_to_string(2); let bytes = self.string_encoding_bytes(1, &encoding); - let algorithm_str = match self.store(self.deref(self[temp_v!(4)])) { - Addr::Con(h) if self.heap.atom_at(h) => { - if let HeapCellValue::Atom(ref atom, _) = &self.heap[h] { - atom.as_str() - } else { - unreachable!() - } - } - _ => { - unreachable!() - } - }; + let algorithm = self.atom_argument_to_string(4); let ints_list = - match algorithm_str { + match algorithm.as_str() { "sha3_224" => { let mut context = Sha3_224::new(); context.input(&bytes); Addr::HeapCell(self.heap.to_list(context.result().as_ref().iter().map(|b| HeapCellValue::from(Addr::Fixnum(*b as isize))))) } @@ -5434,7 +5423,7 @@ impl MachineState { context.input(&bytes); Addr::HeapCell(self.heap.to_list(context.result().as_ref().iter().map(|b| HeapCellValue::from(Addr::Fixnum(*b as isize))))) } _ => { let ints = digest::digest( - match algorithm_str { + match algorithm.as_str() { "sha256" => { &digest::SHA256 } "sha384" => { &digest::SHA384 } "sha512" => { &digest::SHA512 } @@ -5456,18 +5445,7 @@ impl MachineState { let stub2 = MachineError::functor_stub(clause_name!("crypto_data_hkdf"), 4); let info = self.integers_to_bytevec(temp_v!(4), stub2); - let algorithm = match self.store(self.deref(self[temp_v!(5)])) { - Addr::Con(h) if self.heap.atom_at(h) => { - if let HeapCellValue::Atom(ref atom, _) = &self.heap[h] { - atom.as_str() - } else { - unreachable!() - } - } - _ => { - unreachable!() - } - }; + let algorithm = self.atom_argument_to_string(5); let length = match Number::try_from((self[temp_v!(6)], &self.heap)) { @@ -5485,7 +5463,7 @@ impl MachineState { let ints_list = { let digest_alg = - match algorithm { + match algorithm.as_str() { "sha256" => { hkdf::HKDF_SHA256 } "sha384" => { hkdf::HKDF_SHA384 } "sha512" => { hkdf::HKDF_SHA512 } @@ -5611,19 +5589,8 @@ impl MachineState { self.unify(self[temp_v!(6)], complete_string); } &SystemClauseType::CryptoCurveScalarMult => { - let curve = match self.store(self.deref(self[temp_v!(1)])) { - Addr::Con(h) if self.heap.atom_at(h) => { - if let HeapCellValue::Atom(ref atom, _) = &self.heap[h] { - atom.as_str() - } else { - unreachable!() - } - } - _ => { - unreachable!() - } - }; - let curve_id = match curve { + let curve = self.atom_argument_to_string(1); + let curve_id = match curve.as_str() { "secp112r1" => { Nid::SECP112R1 } "secp256k1" => { Nid::SECP256K1 } _ => { unreachable!() } From a16f84560dd9fd138dc13e298d0494ee26944f4d Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Thu, 6 Aug 2020 20:12:57 +0200 Subject: [PATCH 13/37] use self.deref(...) (see #653) --- src/machine/system_calls.rs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index fa6ea029..c91b63a7 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -5447,8 +5447,10 @@ impl MachineState { let algorithm = self.atom_argument_to_string(5); + let length = self.store(self.deref(self[temp_v!(6)])); + let length = - match Number::try_from((self[temp_v!(6)], &self.heap)) { + match Number::try_from((length, &self.heap)) { Ok(Number::Fixnum(n)) => { usize::try_from(n).unwrap() } @@ -5596,8 +5598,10 @@ impl MachineState { _ => { unreachable!() } }; + let scalar = self.store(self.deref(self[temp_v!(2)])); + let scalar = - match Number::try_from((self[temp_v!(2)], &self.heap)) { + match Number::try_from((scalar, &self.heap)) { Ok(Number::Fixnum(n)) => { Integer::from(n) } From 674483a4c6efa3f72604df539bc3e1d74eb6b5ec Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Thu, 6 Aug 2020 23:17:08 +0200 Subject: [PATCH 14/37] remove entailed constraint --- src/lib/crypto.pl | 1 - 1 file changed, 1 deletion(-) diff --git a/src/lib/crypto.pl b/src/lib/crypto.pl index af03e7d6..1f78c8cb 100644 --- a/src/lib/crypto.pl +++ b/src/lib/crypto.pl @@ -592,7 +592,6 @@ crypto_data_decrypt(CipherText0, Algorithm, Key, IV, PlainText, Options) :- encoding_chars(Encoding, AAD0, AAD), must_be(atom, Encoding), member(Encoding, [utf8,octet]), - must_be(list, CipherText0), encoding_chars(octet, CipherText0, CipherText1), maplist(char_code, TagChars, Tag), append(CipherText1, TagChars, CipherText), From c55cc3c47200c34437940a7288cba155b0c8cc1a Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Thu, 6 Aug 2020 23:27:49 +0200 Subject: [PATCH 15/37] ensure proper lengths of key and initialization vector This avoids crashes when using unsuitable lengths. --- src/lib/crypto.pl | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/lib/crypto.pl b/src/lib/crypto.pl index 1f78c8cb..e88113c7 100644 --- a/src/lib/crypto.pl +++ b/src/lib/crypto.pl @@ -547,8 +547,13 @@ crypto_data_encrypt(PlainText0, Algorithm, Key, IV, CipherText, Options) :- ( 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). +algorithm_key_iv('chacha20-poly1305', Key, IV) :- + length(Key, 32), + length(IV, 12). + /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - crypto_data_decrypt(+CipherText, +Algorithm, @@ -598,6 +603,7 @@ crypto_data_decrypt(CipherText0, Algorithm, Key, IV, PlainText, Options) :- ( 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). From 6e5d2d6a36dcc1c4cad68c4f9180b8a8339137d6 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sat, 8 Aug 2020 13:11:09 -0600 Subject: [PATCH 16/37] fix bugs in PausedPrologStream (#661) --- src/machine/streams.rs | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/machine/streams.rs b/src/machine/streams.rs index 7e07067a..1375cb65 100644 --- a/src/machine/streams.rs +++ b/src/machine/streams.rs @@ -6,7 +6,7 @@ use crate::machine::machine_errors::*; use crate::machine::machine_indices::*; use crate::machine::machine_state::*; -use std::cmp::{min, Ordering}; +use std::cmp::Ordering; use std::cell::RefCell; use std::error::Error; use std::fmt; @@ -110,7 +110,7 @@ fn parser_top_to_bytes(mut buf: Vec>) -> io::Result> { /* all these streams are closed automatically when the instance is * dropped. */ -pub enum StreamInstance { +enum StreamInstance { Bytes(Cursor>), InputFile(ClauseName, File), OutputFile(ClauseName, File, bool), // File, append. @@ -129,16 +129,20 @@ impl StreamInstance { StreamInstance::PausedPrologStream(ref mut put_back, ref mut stream) => { let mut index = 0; - while index < min(buf.len(), put_back.len()) { - let b = put_back.pop().unwrap(); - buf[index] = b; - index += 1; + while index < buf.len() { + if let Some(b) = put_back.pop() { + buf[index] = b; + index += 1; + } else { + break; + } } if index == buf.len() { Ok(buf.len()) } else { stream.read(&mut buf[index ..]) + .map(|bytes_read| bytes_read + index) } } StreamInstance::InputFile(_, ref mut file) => { From 8203eff47bddfe80d82b3d4055d34f53172e9b8a Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sat, 8 Aug 2020 16:29:35 -0600 Subject: [PATCH 17/37] update prolog_parser version (#657) --- Cargo.lock | 4 +--- Cargo.toml | 2 +- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/Cargo.lock b/Cargo.lock index 6f1db7a8..4faec27c 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -905,9 +905,7 @@ dependencies = [ [[package]] name = "prolog_parser" -version = "0.8.67" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f16bb270c3f20e0ccd6e0b7f1367d4a1ac9070227e40733512913cdf24fe9152" +version = "0.8.68" dependencies = [ "lexical", "num-rug-adapter", diff --git a/Cargo.toml b/Cargo.toml index 485132a2..4912155f 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -32,7 +32,7 @@ libc = "0.2.62" nix = "0.15.0" num-rug-adapter = { optional = true, version = "0.1.3" } ordered-float = "0.5.0" -prolog_parser = { version = "0.8.67", default-features = false } +prolog_parser = { version = "0.8.68", default-features = false } ref_thread_local = "0.0.0" rug = { version = "1.4.0", optional = true } rustyline = "6.0.0" From ad8e2ad4f6f7f64a29dce96931d00cf18657b039 Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Tue, 11 Aug 2020 20:48:37 +0200 Subject: [PATCH 18/37] omit internal attributes in residual goals when using taut/2 Examples: ?- taut(X=:=X,1). clpb:sat(X=:=X) ; false. ?- taut(X=\=X,0). clpb:sat(X=:=X) ; false. --- src/lib/clpb.pl | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/lib/clpb.pl b/src/lib/clpb.pl index 6b74e272..ad49f61c 100644 --- a/src/lib/clpb.pl +++ b/src/lib/clpb.pl @@ -1558,9 +1558,10 @@ sats([]) --> []. sats([A|As]) --> [clpb:sat(A)], sats(As). booleans([]) --> []. -booleans([B|Bs]) --> boolean(B), { del_clpb(B) }, booleans(Bs). +booleans([B|Bs]) --> boolean(B), booleans(Bs). boolean(Var) --> + { del_clpb(Var) }, ( { get_attr(Var, clpb_omit_boolean, true) } -> [] ; [clpb:sat(Var =:= Var)] ). From 099d9aaca6509496ccb28c522659b990f42037f0 Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Tue, 11 Aug 2020 21:00:56 +0200 Subject: [PATCH 19/37] library(sgml): Correctly parse XML leaf nodes that are not text nodes. Example: ?- load_xml("", Node, []). Node = [element(schemaRef,[type="simple"],[])]. This is necessary for example to parse XBRL files. See #665. --- src/machine/system_calls.rs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 2d890877..d2779d1a 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -5877,7 +5877,10 @@ impl MachineState { indices: &mut IndexStore, node: roxmltree::Node, ) -> Addr { - if node.has_children() { + if node.is_text() { + let string = String::from(node.text().unwrap()); + self.heap.put_complete_string(&string) + } else { let mut avec = Vec::new(); for attr in node.attributes() { let chars = clause_name!(String::from(attr.name()), indices.atom_tbl); @@ -5914,9 +5917,6 @@ impl MachineState { self.heap.push(HeapCellValue::Addr(children)); result - } else { - let string = String::from(node.text().unwrap()); - self.heap.put_complete_string(&string) } } From e185b626bdf1a99ab8188ae39875f645c0de90f0 Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Wed, 12 Aug 2020 19:51:25 +0200 Subject: [PATCH 20/37] FIXED: CLP(B): Delay BDD restriction until after the instantiation. This is necessary to actually take the new value into account. Example: ?- sat(A*B>=C*D), A=1,B=0,C=1,D=1. false. This addresses #670. --- src/lib/clpb.pl | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/lib/clpb.pl b/src/lib/clpb.pl index ad49f61c..0b802a46 100644 --- a/src/lib/clpb.pl +++ b/src/lib/clpb.pl @@ -842,9 +842,8 @@ verify_attributes(Var, Other, Gs) :- ( integer(Other) -> ( between(0, 1, Other) -> root_get_formula_bdd(Root, Sat, BDD0), - bdd_restriction(BDD0, I, Other, BDD), root_put_formula_bdd(Root, Sat, BDD), - Gs = [satisfiable_bdd(BDD)] + Gs = [bdd_restriction(BDD0,I,Other,BDD),satisfiable_bdd(BDD)] ; no_truth_value(Other) ) ; atom(Other) -> From a24fbb8f61dc7b6138f62ad70ec47fb7a69284b7 Mon Sep 17 00:00:00 2001 From: notoria Date: Mon, 10 Aug 2020 21:00:54 +0200 Subject: [PATCH 21/37] Improved mod in CLP(Z) This is still a work in progress. --- src/lib/clpz.pl | 113 +++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 112 insertions(+), 1 deletion(-) diff --git a/src/lib/clpz.pl b/src/lib/clpz.pl index e4c8e897..08933a7d 100644 --- a/src/lib/clpz.pl +++ b/src/lib/clpz.pl @@ -4924,7 +4924,7 @@ run_propagator(ptzdiv(X,Y,Z), MState) --> %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% % Z = X mod Y -run_propagator(pmod(X,Y,Z), MState) --> +run_propagator(pmod_(X,Y,Z), MState) --> ( nonvar(X) -> ( nonvar(Y) -> kill(MState), Y =\= 0, Z is X mod Y ; true @@ -5016,6 +5016,117 @@ run_propagator(pmod(X,Y,Z), MState) --> % TODO: propagate more ). +run_propagator(pmod(X,Y,Z), MState) --> + ( Y == 0 -> { false } + ; Y == Z -> { false } + % ; nonvar(Y), Z == X -> true + ; X == Y -> kill(MState), Z = 0 + ; true + ), + ( nonvar(X), nonvar(Y) -> + kill(MState), + Z is X mod Y + ; nonvar(Y), nonvar(Z) -> + ( Y > 0 -> Z >= 0, Z < Y + ; Y < 0 -> Z =< 0, Z > Y + ) + % kill(MState), + % queue_goal(X #= Z + Y * _) % Add a variable to be efficient. + ; nonvar(Z), nonvar(X) -> + ( Z > 0 -> + ( X < 0 -> true + ; X >= Z + ) + ; Z < 0 -> + ( X > 0 -> true + ; X =< Z + ) + ; Z =:= 0 % Multiple solutions so do nothing special. + ), + ( Z > 0 -> queue_goal(Y #> 0) + ; Z < 0 -> queue_goal(Y #< 0) + ; true + ) + ; run_propagator(pmodz(X,Y,Z), MState), + run_propagator(pmody(X,Y,Z), MState), + run_propagator(pmodx(X,Y,Z), MState), + true + ). + +run_propagator(pmodz(X,Y,Z), MState) --> + ( nonvar(Z) -> true % Nothing to do. + ; nonvar(X) -> + ( X =:= 0 -> kill(MState), Z = X + ; X > 0 -> queue_goal(Z #=< X) + ; X < 0 -> queue_goal(Z #>= X) + ), + ( { fd_get(Y, _, n(YL), n(YU), _), YL > 0 } -> + { ZMax is YU - 1 }, + queue_goal(Z in 0..ZMax) + ; { fd_get(Y, _, n(YL), n(YU), _), YU < 0 } -> + { ZMin is YL + 1 }, + queue_goal(Z in ZMin..0) + ; true + ) + ; nonvar(Y) -> + ( abs(Y) =:= 1 -> kill(MState), Z = 0 + ; Y < 0 -> + { ZMin is Y + 1 }, + queue_goal(Z in ZMin..0) + ; Y > 0 -> + { ZMax is Y - 1 }, + queue_goal(Z in 0..ZMax) + ), + ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0 } -> + queue_goal(Z #=< XU) + ; { fd_get(X, _, n(XL), n(XU), _), XU =< 0 } -> + queue_goal(Z #>= XL) + ; true + ) + ; ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0 } -> + queue_goal(Z #=< XU) + ; { fd_get(X, _, n(XL), n(XU), _), XU =< 0 } -> + queue_goal(Z #>= XL) + ; true + ), + ( { fd_get(Y, _, n(YL), n(YU), _), YL > 0 } -> + { ZMax is YU - 1 }, + queue_goal(Z in 0..ZMax) + ; { fd_get(Y, _, n(YL), n(YU), _), YU < 0 } -> + { ZMin is YL + 1 }, + queue_goal(Z in ZMin..0) + ; true + ) + ). + +run_propagator(pmody(X,Y,Z), MState) --> + ( nonvar(Y) -> true % Nothing to do. + % ; nonvar(X) -> true + ; nonvar(Z) -> + ( Z > 0 -> queue_goal(Y #> Z) + ; Z < 0 -> queue_goal(Y #< Z) + ; Z =:= 0 -> kill(MState), queue_goal(X / Y #= _) + ) + ; ( { fd_get(Z, _, n(ZL), _, _), ZL > 0 } -> + queue_goal(Y #> ZL) + ; { fd_get(Z, _, _, n(ZU), _), ZU < 0 } -> + queue_goal(Y #< ZU) + ; true + ) + ). + +run_propagator(pmodx(X,Y,Z), MState) --> + ( nonvar(X) -> true % Nothing to do. + % ; nonvar(Y) -> true + /* + ; nonvar(Z) -> + ( Z =:= 0 -> kill(MState), queue_goal(X / Y #= _) + ; true + ) + % */ + ; true + ). + %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% % Z = X rem Y From 314baabf1d1d54345e8c8596ef369ee4b2c4d693 Mon Sep 17 00:00:00 2001 From: notoria Date: Thu, 13 Aug 2020 10:38:57 +0200 Subject: [PATCH 22/37] More improvement on mod from CLP(Z) --- src/lib/clpz.pl | 259 ++++++++++++++++++---------------- src/tests/clpz/combination.pl | 17 +++ src/tests/clpz/permutation.pl | 27 ++++ src/tests/clpz/test_clpz.pl | 129 +++++++++++++++++ 4 files changed, 310 insertions(+), 122 deletions(-) create mode 100644 src/tests/clpz/combination.pl create mode 100644 src/tests/clpz/permutation.pl create mode 100644 src/tests/clpz/test_clpz.pl diff --git a/src/lib/clpz.pl b/src/lib/clpz.pl index 08933a7d..2844f69f 100644 --- a/src/lib/clpz.pl +++ b/src/lib/clpz.pl @@ -4924,98 +4924,6 @@ run_propagator(ptzdiv(X,Y,Z), MState) --> %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% % Z = X mod Y -run_propagator(pmod_(X,Y,Z), MState) --> - ( nonvar(X) -> - ( nonvar(Y) -> kill(MState), Y =\= 0, Z is X mod Y - ; true - ) - ; nonvar(Y) -> - Y =\= 0, - ( abs(Y) =:= 1 -> kill(MState), Z = 0 - ; var(Z) -> - YP is abs(Y) - 1, - ( Y > 0, { fd_get(X, _, n(XL), n(XU), _) } -> - ( XL >= 0, XU < Y -> - kill(MState), Z = X, ZL = XL, ZU = XU - ; ZL = 0, ZU = YP - ) - ; Y > 0 -> ZL = 0, ZU = YP - ; YN is -YP, ZL = YN, ZU = 0 - ), - ( { fd_get(Z, ZD, ZPs) } -> - { domains_intersection(ZD, from_to(n(ZL), n(ZU)), ZD1), - domain_infimum(ZD1, n(ZMin)), - domain_supremum(ZD1, n(ZMax)) }, - fd_put(Z, ZD1, ZPs) - ; ZMin = Z, ZMax = Z - ), - ( { fd_get(X, XD, XPs), domain_infimum(XD, n(XMin)) } -> - Z1 is XMin mod Y, - ( { between(ZMin, ZMax, Z1) } -> true - ; Y > 0 -> - Next is ((XMin - ZMin + Y - 1) div Y)*Y + ZMin, - { domain_remove_smaller_than(XD, Next, XD1) }, - fd_put(X, XD1, XPs) - ; neq_num(X, XMin) - ) - ; true - ), - ( { fd_get(X, XD2, XPs2), domain_supremum(XD2, n(XMax)) } -> - Z2 is XMax mod Y, - ( { between(ZMin, ZMax, Z2) } -> true - ; Y > 0 -> - Prev is ((XMax - ZMin) div Y)*Y + ZMax, - { domain_remove_greater_than(XD2, Prev, XD3) }, - fd_put(X, XD3, XPs2) - ; neq_num(X, XMax) - ) - ; true - ) - ; { fd_get(X, XD, XPs) }, - % if possible, propagate at the boundaries - ( { domain_infimum(XD, n(Min)) } -> - ( Min mod Y =:= Z -> true - ; Y > 0 -> - Next is ((Min - Z + Y - 1) div Y)*Y + Z, - { domain_remove_smaller_than(XD, Next, XD1) }, - fd_put(X, XD1, XPs) - ; neq_num(X, Min) - ) - ; true - ), - ( { fd_get(X, XD2, XPs2) } -> - ( { domain_supremum(XD2, n(Max)) } -> - ( Max mod Y =:= Z -> true - ; Y > 0 -> - Prev is ((Max - Z) div Y)*Y + Z, - { domain_remove_greater_than(XD2, Prev, XD3) }, - fd_put(X, XD3, XPs2) - ; neq_num(X, Max) - ) - ; true - ) - ; true - ) - ) - ; X == Y -> kill(MState), Z = 0 - ; { fd_get(X, XD, XPs), - fd_get(Y, YD, _), - fd_get(Z, ZD, ZPs) }, - ( { domain_infimum(XD, n(XMin)), XMin >= 0, - domain_infimum(YD, n(YMin)), YMin > 0 } -> - { domain_remove_smaller_than(ZD, 0, ZD1) } - ; ZD1 = ZD - ), - ( { domain_supremum(YD, n(YMax)), YMax > 0 } -> - { Max is YMax - 1, Min is -Max, - domain_remove_smaller_than(ZD1, Min, ZD2), - domain_remove_greater_than(ZD2, Max, ZD3) } - ; ZD3 = ZD1 - ), - fd_put(Z, ZD3, ZPs) - % TODO: propagate more - ). - run_propagator(pmod(X,Y,Z), MState) --> ( Y == 0 -> { false } ; Y == Z -> { false } @@ -5029,6 +4937,25 @@ run_propagator(pmod(X,Y,Z), MState) --> ; nonvar(Y), nonvar(Z) -> ( Y > 0 -> Z >= 0, Z < Y ; Y < 0 -> Z =< 0, Z > Y + ), + ( { fd_get(X, _, n(XL), _, _) } -> + ( (XL - Z) mod Y =\= 0 -> + { XMin is Z + Y * ((XL - Z) div Y + 1) } + ; { XMin is Z + Y * ((XL - Z) div Y) } + ), + { fd_get(X, XD0, XPs), + domain_remove_smaller_than(XD0, XMin, XD2), + fd_put(X, XD2, XPs) } + % queue_goal(X #>= XMin) + ; true + ), + ( { fd_get(X, _, _, n(XU), _) } -> + { XMax is Z + Y * ((XU - Z) div Y) }, + { fd_get(X, XD1, XPs), + domain_remove_greater_than(XD1, XMax, XD3), + fd_put(X, XD3, XPs) } + % queue_goal(X #=< XMax) + ; true ) % kill(MState), % queue_goal(X #= Z + Y * _) % Add a variable to be efficient. @@ -5043,13 +4970,22 @@ run_propagator(pmod(X,Y,Z), MState) --> ) ; Z =:= 0 % Multiple solutions so do nothing special. ), - ( Z > 0 -> queue_goal(Y #> 0) - ; Z < 0 -> queue_goal(Y #< 0) + ( Z > 0 -> + { fd_get(Y, YD, YPs), + YMin is Z + 1, + domain_remove_smaller_than(YD, YMin, YD1), + fd_put(Y, YD1, YPs) } + % queue_goal(Y #> Z) + ; Z < 0 -> + { fd_get(Y, YD, YPs), + YMax is Z - 1, + domain_remove_greater_than(YD, YMax, YD1), + fd_put(Y, YD1, YPs) } + % queue_goal(Y #< Z) ; true ) ; run_propagator(pmodz(X,Y,Z), MState), run_propagator(pmody(X,Y,Z), MState), - run_propagator(pmodx(X,Y,Z), MState), true ). @@ -5057,44 +4993,118 @@ run_propagator(pmodz(X,Y,Z), MState) --> ( nonvar(Z) -> true % Nothing to do. ; nonvar(X) -> ( X =:= 0 -> kill(MState), Z = X - ; X > 0 -> queue_goal(Z #=< X) - ; X < 0 -> queue_goal(Z #>= X) + ; X > 0 -> + ( { fd_get(Y, _, n(YL), _, _), YL > X } -> + kill(MState), + Z = X + ; { fd_get(Z, ZD0, ZPs), + domain_remove_greater_than(ZD0, X, ZD2), + fd_put(Z, ZD2, ZPs) } + % queue_goal(Z #=< X) + ) + ; X < 0 -> + ( { fd_get(Y, _, _, n(YU), _), YU < X } -> + kill(MState), + Z = X + ; { fd_get(Z, ZD0, ZPs), + domain_remove_smaller_than(ZD0, X, ZD2), + fd_put(Z, ZD2, ZPs) } + % queue_goal(Z #>= X) + ) ), ( { fd_get(Y, _, n(YL), n(YU), _), YL > 0 } -> { ZMax is YU - 1 }, - queue_goal(Z in 0..ZMax) + { fd_get(Z, ZD1, ZPs), + domain_remove_smaller_than(ZD1, 0, ZD3), + domain_remove_greater_than(ZD3, ZMax, ZD5), + fd_put(Z, ZD5, ZPs) } + % queue_goal(Z in 0..ZMax) ; { fd_get(Y, _, n(YL), n(YU), _), YU < 0 } -> { ZMin is YL + 1 }, - queue_goal(Z in ZMin..0) + { fd_get(Z, ZD1, ZPs), + domain_remove_greater_than(ZD1, 0, ZD3), + domain_remove_smaller_than(ZD3, ZMin, ZD5), + fd_put(Z, ZD5, ZPs) } + % queue_goal(Z in ZMin..0) ; true ) ; nonvar(Y) -> ( abs(Y) =:= 1 -> kill(MState), Z = 0 ; Y < 0 -> { ZMin is Y + 1 }, - queue_goal(Z in ZMin..0) + { fd_get(Z, ZD1, ZPs), + domain_remove_greater_than(ZD1, 0, ZD3), + domain_remove_smaller_than(ZD3, ZMin, ZD5), + fd_put(Z, ZD5, ZPs) } + % queue_goal(Z in ZMin..0) ; Y > 0 -> { ZMax is Y - 1 }, - queue_goal(Z in 0..ZMax) + { fd_get(Z, ZD1, ZPs), + domain_remove_smaller_than(ZD1, 0, ZD3), + domain_remove_greater_than(ZD3, ZMax, ZD5), + fd_put(Z, ZD5, ZPs) } + % queue_goal(Z in 0..ZMax) ), ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0 } -> - queue_goal(Z #=< XU) + { fd_get(Z, ZD0, ZPs), + domain_remove_greater_than(ZD0, XU, ZD2), + fd_put(Z, ZD2, ZPs) } + % queue_goal(Z #=< XU) ; { fd_get(X, _, n(XL), n(XU), _), XU =< 0 } -> - queue_goal(Z #>= XL) + { fd_get(Z, ZD0, ZPs), + domain_remove_smaller_than(ZD0, XL, ZD2), + fd_put(Z, ZD2, ZPs) } + % queue_goal(Z #>= XL) ; true ) ; ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0 } -> - queue_goal(Z #=< XU) + { fd_get(Z, ZD0, ZPs), + domain_remove_greater_than(ZD0, XU, ZD2), + fd_put(Z, ZD2, ZPs) } + % queue_goal(Z #=< XU) ; { fd_get(X, _, n(XL), n(XU), _), XU =< 0 } -> - queue_goal(Z #>= XL) + { fd_get(Z, ZD0, ZPs), + domain_remove_smaller_than(ZD0, XL, ZD2), + fd_put(Z, ZD2, ZPs) } + % queue_goal(Z #>= XL) ; true ), ( { fd_get(Y, _, n(YL), n(YU), _), YL > 0 } -> { ZMax is YU - 1 }, - queue_goal(Z in 0..ZMax) + { fd_get(Z, ZD1, ZPs), + domain_remove_smaller_than(ZD1, 0, ZD3), + domain_remove_greater_than(ZD3, ZMax, ZD5), + fd_put(Z, ZD5, ZPs) } + % queue_goal(Z in 0..ZMax) ; { fd_get(Y, _, n(YL), n(YU), _), YU < 0 } -> { ZMin is YL + 1 }, - queue_goal(Z in ZMin..0) + { fd_get(Z, ZD1, ZPs), + domain_remove_greater_than(ZD1, 0, ZD3), + domain_remove_smaller_than(ZD3, ZMin, ZD5), + fd_put(Z, ZD5, ZPs) } + % queue_goal(Z in ZMin..0) + ; { fd_get(Y, _, n(YL), n(YU), _) } -> + { ZMin is YL + 1, + ZMax is YU - 1 }, + { fd_get(Z, ZD1, ZPs), + domain_remove_greater_than(ZD1, ZMax, ZD3), + domain_remove_smaller_than(ZD3, ZMin, ZD5), + fd_put(Z, ZD5, ZPs) } + % queue_goal(Z in ZMin..ZMax) + %/* This doesn't work very well. + ; { fd_get(Y, _, _, n(YU), _), YU > 0 } -> + { fd_get(Z, ZD1, ZPs), + ZMax is YU - 1, + domain_remove_greater_than(ZD1, ZMax, ZD3), + fd_put(Z, ZD3, ZPs) } + % queue_goal(Z #< YU) + ; { fd_get(Y, _, n(YL), _, _), YL < 0 } -> + { fd_get(Z, ZD1, ZPs), + ZMin is YL + 1, + domain_remove_smaller_than(ZD1, ZMin, ZD3), + fd_put(Z, ZD3, ZPs) } + % queue_goal(Z #> YL) + % */ ; true ) ). @@ -5103,29 +5113,34 @@ run_propagator(pmody(X,Y,Z), MState) --> ( nonvar(Y) -> true % Nothing to do. % ; nonvar(X) -> true ; nonvar(Z) -> - ( Z > 0 -> queue_goal(Y #> Z) - ; Z < 0 -> queue_goal(Y #< Z) + ( Z > 0 -> % queue_goal(Y #> Z) + { fd_get(Y, YD, YPs), + YMin is Z + 1, + domain_remove_smaller_than(YD, YMin, YD1), + fd_put(Y, YD1, YPs) } + ; Z < 0 -> % queue_goal(Y #< Z) + { fd_get(Y, YD, YPs), + YMax is Z - 1, + domain_remove_greater_than(YD, YMax, YD1), + fd_put(Y, YD1, YPs) } ; Z =:= 0 -> kill(MState), queue_goal(X / Y #= _) ) ; ( { fd_get(Z, _, n(ZL), _, _), ZL > 0 } -> - queue_goal(Y #> ZL) + { fd_get(Y, YD, YPs), + YMin is ZL + 1, + domain_remove_smaller_than(YD, YMin, YD1), + fd_put(Y, YD1, YPs) } + % queue_goal(Y #> ZL) ; { fd_get(Z, _, _, n(ZU), _), ZU < 0 } -> - queue_goal(Y #< ZU) + { fd_get(Y, YD, YPs), + YMax is ZU - 1, + domain_remove_greater_than(YD, YMax, YD1), + fd_put(Y, YD1, YPs) } + % queue_goal(Y #< ZU) ; true ) ). -run_propagator(pmodx(X,Y,Z), MState) --> - ( nonvar(X) -> true % Nothing to do. - % ; nonvar(Y) -> true - /* - ; nonvar(Z) -> - ( Z =:= 0 -> kill(MState), queue_goal(X / Y #= _) - ; true - ) - % */ - ; true - ). %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% % Z = X rem Y diff --git a/src/tests/clpz/combination.pl b/src/tests/clpz/combination.pl new file mode 100644 index 00000000..6c5629cb --- /dev/null +++ b/src/tests/clpz/combination.pl @@ -0,0 +1,17 @@ +:- module(combination, [combination/2, combinationr/2]). + +combination([], []). +combination([L|Ls], [L|Ms]) :- + combination(Ls, Ms). +combination([_|Ls], Ms) :- + combination(Ls, Ms). + +combinationr([], []). +combinationr([L|Ls], Ms) :- + combinationr_(Ms, [L|Ls]). + +combinationr_([], _). +combinationr_([M|Ms], [M|Ls]) :- + combinationr_(Ms, [M|Ls]). +combinationr_([M|Ms], [_|Ls]) :- + combinationr_([M|Ms], Ls). diff --git a/src/tests/clpz/permutation.pl b/src/tests/clpz/permutation.pl new file mode 100644 index 00000000..6d3c1842 --- /dev/null +++ b/src/tests/clpz/permutation.pl @@ -0,0 +1,27 @@ +:- module(permutation, [arrangement/2, arrangementr/2, permutation/2]). +:- use_module(library(lists), [member/2, same_length/2, select/3]). + +permutation(As, Bs) :- + same_length(As, Bs), + permutation_(Bs, As). + +permutation_([B|Bs], As) :- select(B, As, Cs), permutation_(Bs, Cs). +permutation_([], []). + +arrangement([], []). +arrangement([A|As], [B|Bs]) :- + arrangement_([B|Bs], [A|As]). + +arrangement_([], _). +arrangement_([B|Bs], As) :- + select(B, As, Cs), + arrangement_(Bs, Cs). + +arrangementr([], []). +arrangementr([A|As], Bs) :- + arrangementr_(Bs, [A|As]). + +arrangementr_([], _). +arrangementr_([B|Bs], As) :- + member(B, As), + arrangementr_(Bs, As). diff --git a/src/tests/clpz/test_clpz.pl b/src/tests/clpz/test_clpz.pl new file mode 100644 index 00000000..7d91f918 --- /dev/null +++ b/src/tests/clpz/test_clpz.pl @@ -0,0 +1,129 @@ +:- use_module(library(debug)). +:- use_module(library(format)). +:- use_module(library(lists)). +:- use_module(library(tabling)). +:- use_module('../../lib/clpz'). +:- use_module(combination). +:- use_module(permutation). + +nat(N) :- + nat_(0, N). + +nat_(N, N). +nat_(N0, N) :- + N1 #= N0 + 1, + nat_(N1, N). + +n_factorial(0, 1). +n_factorial(N, F) :- + F #= N * F1, + N1 #= N - 1, + n_factorial(N1, F1). + +pmod(G, X, Y, Z) :- G = (X mod Y #= Z). +pplus(G, X, Y, Z) :- G = (X + Y #= Z). +rel(G, X, Y) :- G = (X #=< Y). + +operation(2, Op, [X, Y], G) :- + call(Op, G, X, Y). + +operation(3, Op, [X, Y, Z], G) :- + call(Op, G, X, Y, Z). + +/* +operation(Op, Vs, G) :- + Goal =.. [Op, G|Vs], + call(Goal). +% */ + +conjonction(G1, G2, G) :- + G = (G2, G1). + +run :- + $nat(N), + NegN #= -N, + Settings = [Nv, Niv, Nr, Nm], + + Settings ins 0..N, + Nm #> 0, % Testing Powers. + + label([Nv]), + length(Vs, Nv), + Vs ins inf..sup, % No labeling. + ( Nv > 1 -> + bagof(Pr, (length(Pr, 2), arrangement(Vs, Pr)), V2s) % No repetitions. + ; % Allow repetitions. + bagof(Pr, (length(Pr, 2), arrangementr(Vs, Pr)), V2s) + ), + bagof(Pr, (length(Pr, 3), arrangementr(Vs, Pr)), V3s), + + ( Nv > 1 -> + Nr #=< Nv + ; Nr #= 0 + ), + label([Nm, Nr]), + length(Gs1, Nm), + ( Nv > 1 -> + length(Gs3, Nr) + ; length(Gs3, 0) + ), + append(Gs3, Gs1, Gs4), + + length(MVs, Nm), + combinationr(V3s, MVs), + maplist(operation(3, pmod), MVs, Gs1), + + ( Nv > 1 -> + length(RVs, Nr), + combination(V2s, RVs), + maplist(operation(2, rel), RVs, Gs3) + ; true + ), + + label([Niv]), + length(Vs1, Niv), + length(Vs2, Niv), + combination(Vs, Vs1), + Vs2 ins NegN..N, + label(Vs2), + Vs1 = Vs2, + + % portray_clause([N, Settings, Vs, Gs4]), nl, + catch( + findall( + Ds, + ( permutation(Gs4, Gs), + foldl(conjonction, Gs, true, G), + call(G), + maplist(fd_dom, Vs, Ds) + ), + Dss + ), + E, + ( write('caugth: '), write(E), nl, + portray_clause([N, Settings, Vs, Gs4, Dss]), nl, + false + ) + ), + length(Dss, Dn), + length(Gs4, Gs4n), + ( Dn == 0 -> true % All false. + ; ( n_factorial(Gs4n, Dn) -> true + ; write('Not a factorial: '), write([Gs4n, Dn]), nl, + portray_clause([N, Settings, Vs, Gs4, Dss]), nl, + *halt(1) + ) + ), + ( \+ maplist(=(_), Dss) -> + write('Bound issue:'), nl, + write(Dss), nl, + transpose(Dss, Dss1), + maplist(sort, Dss1, Dss2), + portray_clause(Dss2), + portray_clause([N, Settings, Vs, Gs4]), nl, + % Not easy to solve due to the fact that multiple variables + % can not have the right bound. + *halt(1) + ; true + ), + false. From daaebc59cb7454e4bb79236da27b9d3a565eef78 Mon Sep 17 00:00:00 2001 From: notoria Date: Sat, 15 Aug 2020 12:45:33 +0200 Subject: [PATCH 23/37] Made mod stronger and addressed #675 --- src/lib/clpz.pl | 216 ++++++++++++++++++++++++------------------------ 1 file changed, 109 insertions(+), 107 deletions(-) diff --git a/src/lib/clpz.pl b/src/lib/clpz.pl index 2844f69f..b78a6d84 100644 --- a/src/lib/clpz.pl +++ b/src/lib/clpz.pl @@ -4941,7 +4941,7 @@ run_propagator(pmod(X,Y,Z), MState) --> ( { fd_get(X, _, n(XL), _, _) } -> ( (XL - Z) mod Y =\= 0 -> { XMin is Z + Y * ((XL - Z) div Y + 1) } - ; { XMin is Z + Y * ((XL - Z) div Y) } + ; { XMin is XL } ), { fd_get(X, XD0, XPs), domain_remove_smaller_than(XD0, XMin, XD2), @@ -4993,119 +4993,121 @@ run_propagator(pmodz(X,Y,Z), MState) --> ( nonvar(Z) -> true % Nothing to do. ; nonvar(X) -> ( X =:= 0 -> kill(MState), Z = X - ; X > 0 -> - ( { fd_get(Y, _, n(YL), _, _), YL > X } -> - kill(MState), - Z = X - ; { fd_get(Z, ZD0, ZPs), - domain_remove_greater_than(ZD0, X, ZD2), - fd_put(Z, ZD2, ZPs) } - % queue_goal(Z #=< X) + ; ( X > 0 -> + ( { fd_get(Y, _, n(YL), _, _), YL > X } -> + kill(MState), + Z = X + ; { fd_get(Z, ZD0, ZPs), + domain_remove_greater_than(ZD0, X, ZD2), + fd_put(Z, ZD2, ZPs) } + % queue_goal(Z #=< X) + ) + ; X < 0 -> + ( { fd_get(Y, _, _, n(YU), _), YU < X } -> + kill(MState), + Z = X + ; { fd_get(Z, ZD0, ZPs), + domain_remove_smaller_than(ZD0, X, ZD2), + fd_put(Z, ZD2, ZPs) } + % queue_goal(Z #>= X) + ) + ), + ( { fd_get(Y, _, n(YL), n(YU), _), YL > 0 } -> + { ZMax is YU - 1 }, + { fd_get(Z, ZD1, ZPs), + domain_remove_smaller_than(ZD1, 0, ZD3), + domain_remove_greater_than(ZD3, ZMax, ZD5), + fd_put(Z, ZD5, ZPs) } + % queue_goal(Z in 0..ZMax) + ; { fd_get(Y, _, n(YL), n(YU), _), YU < 0 } -> + { ZMin is YL + 1 }, + { fd_get(Z, ZD1, ZPs), + domain_remove_greater_than(ZD1, 0, ZD3), + domain_remove_smaller_than(ZD3, ZMin, ZD5), + fd_put(Z, ZD5, ZPs) } + % queue_goal(Z in ZMin..0) + ; true ) - ; X < 0 -> - ( { fd_get(Y, _, _, n(YU), _), YU < X } -> - kill(MState), - Z = X - ; { fd_get(Z, ZD0, ZPs), - domain_remove_smaller_than(ZD0, X, ZD2), - fd_put(Z, ZD2, ZPs) } - % queue_goal(Z #>= X) - ) - ), - ( { fd_get(Y, _, n(YL), n(YU), _), YL > 0 } -> - { ZMax is YU - 1 }, - { fd_get(Z, ZD1, ZPs), - domain_remove_smaller_than(ZD1, 0, ZD3), - domain_remove_greater_than(ZD3, ZMax, ZD5), - fd_put(Z, ZD5, ZPs) } - % queue_goal(Z in 0..ZMax) - ; { fd_get(Y, _, n(YL), n(YU), _), YU < 0 } -> - { ZMin is YL + 1 }, - { fd_get(Z, ZD1, ZPs), - domain_remove_greater_than(ZD1, 0, ZD3), - domain_remove_smaller_than(ZD3, ZMin, ZD5), - fd_put(Z, ZD5, ZPs) } - % queue_goal(Z in ZMin..0) - ; true ) ; nonvar(Y) -> ( abs(Y) =:= 1 -> kill(MState), Z = 0 ; Y < 0 -> - { ZMin is Y + 1 }, - { fd_get(Z, ZD1, ZPs), - domain_remove_greater_than(ZD1, 0, ZD3), - domain_remove_smaller_than(ZD3, ZMin, ZD5), - fd_put(Z, ZD5, ZPs) } - % queue_goal(Z in ZMin..0) + ( { fd_get(X, _, n(XL), n(XU), _), XU =< 0, Y < XL } -> + Z = X + ; { ZMin is Y + 1 }, + { fd_get(Z, ZD1, ZPs), + domain_remove_greater_than(ZD1, 0, ZD3), + domain_remove_smaller_than(ZD3, ZMin, ZD5), + fd_put(Z, ZD5, ZPs) } + % queue_goal(Z in ZMin..0) + ) ; Y > 0 -> - { ZMax is Y - 1 }, - { fd_get(Z, ZD1, ZPs), - domain_remove_smaller_than(ZD1, 0, ZD3), - domain_remove_greater_than(ZD3, ZMax, ZD5), - fd_put(Z, ZD5, ZPs) } - % queue_goal(Z in 0..ZMax) - ), - ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0 } -> - { fd_get(Z, ZD0, ZPs), - domain_remove_greater_than(ZD0, XU, ZD2), - fd_put(Z, ZD2, ZPs) } - % queue_goal(Z #=< XU) - ; { fd_get(X, _, n(XL), n(XU), _), XU =< 0 } -> - { fd_get(Z, ZD0, ZPs), - domain_remove_smaller_than(ZD0, XL, ZD2), - fd_put(Z, ZD2, ZPs) } - % queue_goal(Z #>= XL) - ; true + ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0, Y > XU } -> + Z = X + ; { ZMax is Y - 1 }, + { fd_get(Z, ZD1, ZPs), + domain_remove_smaller_than(ZD1, 0, ZD3), + domain_remove_greater_than(ZD3, ZMax, ZD5), + fd_put(Z, ZD5, ZPs) } + % queue_goal(Z in 0..ZMax) + ) ) - ; ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0 } -> - { fd_get(Z, ZD0, ZPs), - domain_remove_greater_than(ZD0, XU, ZD2), - fd_put(Z, ZD2, ZPs) } - % queue_goal(Z #=< XU) - ; { fd_get(X, _, n(XL), n(XU), _), XU =< 0 } -> - { fd_get(Z, ZD0, ZPs), - domain_remove_smaller_than(ZD0, XL, ZD2), - fd_put(Z, ZD2, ZPs) } - % queue_goal(Z #>= XL) - ; true - ), - ( { fd_get(Y, _, n(YL), n(YU), _), YL > 0 } -> - { ZMax is YU - 1 }, - { fd_get(Z, ZD1, ZPs), - domain_remove_smaller_than(ZD1, 0, ZD3), - domain_remove_greater_than(ZD3, ZMax, ZD5), - fd_put(Z, ZD5, ZPs) } - % queue_goal(Z in 0..ZMax) - ; { fd_get(Y, _, n(YL), n(YU), _), YU < 0 } -> - { ZMin is YL + 1 }, - { fd_get(Z, ZD1, ZPs), - domain_remove_greater_than(ZD1, 0, ZD3), - domain_remove_smaller_than(ZD3, ZMin, ZD5), - fd_put(Z, ZD5, ZPs) } - % queue_goal(Z in ZMin..0) - ; { fd_get(Y, _, n(YL), n(YU), _) } -> - { ZMin is YL + 1, - ZMax is YU - 1 }, - { fd_get(Z, ZD1, ZPs), - domain_remove_greater_than(ZD1, ZMax, ZD3), - domain_remove_smaller_than(ZD3, ZMin, ZD5), - fd_put(Z, ZD5, ZPs) } - % queue_goal(Z in ZMin..ZMax) - %/* This doesn't work very well. - ; { fd_get(Y, _, _, n(YU), _), YU > 0 } -> - { fd_get(Z, ZD1, ZPs), - ZMax is YU - 1, - domain_remove_greater_than(ZD1, ZMax, ZD3), - fd_put(Z, ZD3, ZPs) } - % queue_goal(Z #< YU) - ; { fd_get(Y, _, n(YL), _, _), YL < 0 } -> - { fd_get(Z, ZD1, ZPs), - ZMin is YL + 1, - domain_remove_smaller_than(ZD1, ZMin, ZD3), - fd_put(Z, ZD3, ZPs) } - % queue_goal(Z #> YL) - % */ - ; true + ; ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0, + fd_get(Y, _, n(YL), _, _), XU < YL } -> + Z = X + ; { fd_get(X, _, n(XL), n(XU), _), XU =< 0, + fd_get(Y, _, _, n(YU), _), XL > YU } -> + Z = X + ; ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0 } -> + { fd_get(Z, ZD0, ZPs), + domain_remove_greater_than(ZD0, XU, ZD2), + fd_put(Z, ZD2, ZPs) } + % queue_goal(Z #=< XU) + ; { fd_get(X, _, n(XL), n(XU), _), XU =< 0 } -> + { fd_get(Z, ZD0, ZPs), + domain_remove_smaller_than(ZD0, XL, ZD2), + fd_put(Z, ZD2, ZPs) } + % queue_goal(Z #>= XL) + ; true + ), + ( { fd_get(Y, _, n(YL), n(YU), _), YL > 0 } -> + { ZMax is YU - 1 }, + { fd_get(Z, ZD1, ZPs), + domain_remove_smaller_than(ZD1, 0, ZD3), + domain_remove_greater_than(ZD3, ZMax, ZD5), + fd_put(Z, ZD5, ZPs) } + % queue_goal(Z in 0..ZMax) + ; { fd_get(Y, _, n(YL), n(YU), _), YU < 0 } -> + { ZMin is YL + 1 }, + { fd_get(Z, ZD1, ZPs), + domain_remove_greater_than(ZD1, 0, ZD3), + domain_remove_smaller_than(ZD3, ZMin, ZD5), + fd_put(Z, ZD5, ZPs) } + % queue_goal(Z in ZMin..0) + ; { fd_get(Y, _, n(YL), n(YU), _) } -> + { ZMin is YL + 1, + ZMax is YU - 1 }, + { fd_get(Z, ZD1, ZPs), + domain_remove_greater_than(ZD1, ZMax, ZD3), + domain_remove_smaller_than(ZD3, ZMin, ZD5), + fd_put(Z, ZD5, ZPs) } + % queue_goal(Z in ZMin..ZMax) + %/* This doesn't work very well. + ; { fd_get(Y, _, _, n(YU), _), YU > 0 } -> + { fd_get(Z, ZD1, ZPs), + ZMax is YU - 1, + domain_remove_greater_than(ZD1, ZMax, ZD3), + fd_put(Z, ZD3, ZPs) } + % queue_goal(Z #< YU) + ; { fd_get(Y, _, n(YL), _, _), YL < 0 } -> + { fd_get(Z, ZD1, ZPs), + ZMin is YL + 1, + domain_remove_smaller_than(ZD1, ZMin, ZD3), + fd_put(Z, ZD3, ZPs) } + % queue_goal(Z #> YL) + % * / + ; true + ) ) ). From b4b11465a13bfc8b3dab4304feb8a78b3743a260 Mon Sep 17 00:00:00 2001 From: notoria Date: Sat, 15 Aug 2020 13:37:33 +0200 Subject: [PATCH 24/37] Fixed variable bindings in mod from clpz --- src/lib/clpz.pl | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/lib/clpz.pl b/src/lib/clpz.pl index b78a6d84..76f22f95 100644 --- a/src/lib/clpz.pl +++ b/src/lib/clpz.pl @@ -4984,9 +4984,8 @@ run_propagator(pmod(X,Y,Z), MState) --> % queue_goal(Y #< Z) ; true ) - ; run_propagator(pmodz(X,Y,Z), MState), - run_propagator(pmody(X,Y,Z), MState), - true + ; run_propagator(pmody(X,Y,Z), MState), + run_propagator(pmodz(X,Y,Z), MState) % This must be the last one. ). run_propagator(pmodz(X,Y,Z), MState) --> @@ -4996,7 +4995,7 @@ run_propagator(pmodz(X,Y,Z), MState) --> ; ( X > 0 -> ( { fd_get(Y, _, n(YL), _, _), YL > X } -> kill(MState), - Z = X + queue_goal(Z #= X) ; { fd_get(Z, ZD0, ZPs), domain_remove_greater_than(ZD0, X, ZD2), fd_put(Z, ZD2, ZPs) } @@ -5005,7 +5004,7 @@ run_propagator(pmodz(X,Y,Z), MState) --> ; X < 0 -> ( { fd_get(Y, _, _, n(YU), _), YU < X } -> kill(MState), - Z = X + queue_goal(Z #= X) ; { fd_get(Z, ZD0, ZPs), domain_remove_smaller_than(ZD0, X, ZD2), fd_put(Z, ZD2, ZPs) } @@ -5033,6 +5032,7 @@ run_propagator(pmodz(X,Y,Z), MState) --> ( abs(Y) =:= 1 -> kill(MState), Z = 0 ; Y < 0 -> ( { fd_get(X, _, n(XL), n(XU), _), XU =< 0, Y < XL } -> + kill(MState), Z = X ; { ZMin is Y + 1 }, { fd_get(Z, ZD1, ZPs), @@ -5043,6 +5043,7 @@ run_propagator(pmodz(X,Y,Z), MState) --> ) ; Y > 0 -> ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0, Y > XU } -> + kill(MState), Z = X ; { ZMax is Y - 1 }, { fd_get(Z, ZD1, ZPs), @@ -5054,9 +5055,11 @@ run_propagator(pmodz(X,Y,Z), MState) --> ) ; ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0, fd_get(Y, _, n(YL), _, _), XU < YL } -> + kill(MState), Z = X ; { fd_get(X, _, n(XL), n(XU), _), XU =< 0, fd_get(Y, _, _, n(YU), _), XL > YU } -> + kill(MState), Z = X ; ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0 } -> { fd_get(Z, ZD0, ZPs), From d4263cc8b91d24501f35c5e87ef67a77fb4cbd12 Mon Sep 17 00:00:00 2001 From: notoria Date: Sat, 15 Aug 2020 17:06:12 +0200 Subject: [PATCH 25/37] Using queue_goal//1 to correctly bind variables --- src/lib/clpz.pl | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/src/lib/clpz.pl b/src/lib/clpz.pl index 76f22f95..2c8bfdda 100644 --- a/src/lib/clpz.pl +++ b/src/lib/clpz.pl @@ -4928,7 +4928,7 @@ run_propagator(pmod(X,Y,Z), MState) --> ( Y == 0 -> { false } ; Y == Z -> { false } % ; nonvar(Y), Z == X -> true - ; X == Y -> kill(MState), Z = 0 + ; X == Y -> kill(MState), queue_goal(Z = 0) ; true ), ( nonvar(X), nonvar(Y) -> @@ -4984,18 +4984,19 @@ run_propagator(pmod(X,Y,Z), MState) --> % queue_goal(Y #< Z) ; true ) - ; run_propagator(pmody(X,Y,Z), MState), - run_propagator(pmodz(X,Y,Z), MState) % This must be the last one. + ; run_propagator(pmodz(X,Y,Z), MState), + run_propagator(pmody(X,Y,Z), MState), + true ). run_propagator(pmodz(X,Y,Z), MState) --> ( nonvar(Z) -> true % Nothing to do. ; nonvar(X) -> - ( X =:= 0 -> kill(MState), Z = X + ( X =:= 0 -> kill(MState), queue_goal(Z = X) ; ( X > 0 -> ( { fd_get(Y, _, n(YL), _, _), YL > X } -> kill(MState), - queue_goal(Z #= X) + queue_goal(Z = X) ; { fd_get(Z, ZD0, ZPs), domain_remove_greater_than(ZD0, X, ZD2), fd_put(Z, ZD2, ZPs) } @@ -5004,7 +5005,7 @@ run_propagator(pmodz(X,Y,Z), MState) --> ; X < 0 -> ( { fd_get(Y, _, _, n(YU), _), YU < X } -> kill(MState), - queue_goal(Z #= X) + queue_goal(Z = X) ; { fd_get(Z, ZD0, ZPs), domain_remove_smaller_than(ZD0, X, ZD2), fd_put(Z, ZD2, ZPs) } @@ -5029,11 +5030,11 @@ run_propagator(pmodz(X,Y,Z), MState) --> ) ) ; nonvar(Y) -> - ( abs(Y) =:= 1 -> kill(MState), Z = 0 + ( abs(Y) =:= 1 -> kill(MState), queue_goal(Z = 0) ; Y < 0 -> ( { fd_get(X, _, n(XL), n(XU), _), XU =< 0, Y < XL } -> kill(MState), - Z = X + queue_goal(Z = X) ; { ZMin is Y + 1 }, { fd_get(Z, ZD1, ZPs), domain_remove_greater_than(ZD1, 0, ZD3), @@ -5044,7 +5045,7 @@ run_propagator(pmodz(X,Y,Z), MState) --> ; Y > 0 -> ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0, Y > XU } -> kill(MState), - Z = X + queue_goal(Z = X) ; { ZMax is Y - 1 }, { fd_get(Z, ZD1, ZPs), domain_remove_smaller_than(ZD1, 0, ZD3), @@ -5056,11 +5057,11 @@ run_propagator(pmodz(X,Y,Z), MState) --> ; ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0, fd_get(Y, _, n(YL), _, _), XU < YL } -> kill(MState), - Z = X + queue_goal(Z = X) ; { fd_get(X, _, n(XL), n(XU), _), XU =< 0, fd_get(Y, _, _, n(YU), _), XL > YU } -> kill(MState), - Z = X + queue_goal(Z = X) ; ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0 } -> { fd_get(Z, ZD0, ZPs), domain_remove_greater_than(ZD0, XU, ZD2), From bed4afe74f127b2cd224ed3ba21b2baaa1e3b7c2 Mon Sep 17 00:00:00 2001 From: notoria Date: Sat, 15 Aug 2020 17:39:34 +0200 Subject: [PATCH 26/37] Simplified the code --- src/lib/clpz.pl | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/lib/clpz.pl b/src/lib/clpz.pl index 2c8bfdda..148c84ed 100644 --- a/src/lib/clpz.pl +++ b/src/lib/clpz.pl @@ -4940,8 +4940,8 @@ run_propagator(pmod(X,Y,Z), MState) --> ), ( { fd_get(X, _, n(XL), _, _) } -> ( (XL - Z) mod Y =\= 0 -> - { XMin is Z + Y * ((XL - Z) div Y + 1) } - ; { XMin is XL } + XMin is Z + Y * ((XL - Z) div Y + 1) + ; XMin is XL ), { fd_get(X, XD0, XPs), domain_remove_smaller_than(XD0, XMin, XD2), @@ -4950,7 +4950,7 @@ run_propagator(pmod(X,Y,Z), MState) --> ; true ), ( { fd_get(X, _, _, n(XU), _) } -> - { XMax is Z + Y * ((XU - Z) div Y) }, + XMax is Z + Y * ((XU - Z) div Y), { fd_get(X, XD1, XPs), domain_remove_greater_than(XD1, XMax, XD3), fd_put(X, XD3, XPs) } @@ -5013,14 +5013,14 @@ run_propagator(pmodz(X,Y,Z), MState) --> ) ), ( { fd_get(Y, _, n(YL), n(YU), _), YL > 0 } -> - { ZMax is YU - 1 }, + ZMax is YU - 1, { fd_get(Z, ZD1, ZPs), domain_remove_smaller_than(ZD1, 0, ZD3), domain_remove_greater_than(ZD3, ZMax, ZD5), fd_put(Z, ZD5, ZPs) } % queue_goal(Z in 0..ZMax) ; { fd_get(Y, _, n(YL), n(YU), _), YU < 0 } -> - { ZMin is YL + 1 }, + ZMin is YL + 1, { fd_get(Z, ZD1, ZPs), domain_remove_greater_than(ZD1, 0, ZD3), domain_remove_smaller_than(ZD3, ZMin, ZD5), @@ -5035,7 +5035,7 @@ run_propagator(pmodz(X,Y,Z), MState) --> ( { fd_get(X, _, n(XL), n(XU), _), XU =< 0, Y < XL } -> kill(MState), queue_goal(Z = X) - ; { ZMin is Y + 1 }, + ; ZMin is Y + 1, { fd_get(Z, ZD1, ZPs), domain_remove_greater_than(ZD1, 0, ZD3), domain_remove_smaller_than(ZD3, ZMin, ZD5), @@ -5046,7 +5046,7 @@ run_propagator(pmodz(X,Y,Z), MState) --> ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0, Y > XU } -> kill(MState), queue_goal(Z = X) - ; { ZMax is Y - 1 }, + ; ZMax is Y - 1, { fd_get(Z, ZD1, ZPs), domain_remove_smaller_than(ZD1, 0, ZD3), domain_remove_greater_than(ZD3, ZMax, ZD5), @@ -5075,22 +5075,22 @@ run_propagator(pmodz(X,Y,Z), MState) --> ; true ), ( { fd_get(Y, _, n(YL), n(YU), _), YL > 0 } -> - { ZMax is YU - 1 }, + ZMax is YU - 1, { fd_get(Z, ZD1, ZPs), domain_remove_smaller_than(ZD1, 0, ZD3), domain_remove_greater_than(ZD3, ZMax, ZD5), fd_put(Z, ZD5, ZPs) } % queue_goal(Z in 0..ZMax) ; { fd_get(Y, _, n(YL), n(YU), _), YU < 0 } -> - { ZMin is YL + 1 }, + ZMin is YL + 1, { fd_get(Z, ZD1, ZPs), domain_remove_greater_than(ZD1, 0, ZD3), domain_remove_smaller_than(ZD3, ZMin, ZD5), fd_put(Z, ZD5, ZPs) } % queue_goal(Z in ZMin..0) ; { fd_get(Y, _, n(YL), n(YU), _) } -> - { ZMin is YL + 1, - ZMax is YU - 1 }, + ZMin is YL + 1, + ZMax is YU - 1, { fd_get(Z, ZD1, ZPs), domain_remove_greater_than(ZD1, ZMax, ZD3), domain_remove_smaller_than(ZD3, ZMin, ZD5), From 0724c044d67028dccaa2e0454dc9df24624656f1 Mon Sep 17 00:00:00 2001 From: notoria Date: Sat, 15 Aug 2020 17:56:07 +0200 Subject: [PATCH 27/37] Use nonterminal fd_put//3 in mod from clpz --- src/lib/clpz.pl | 84 ++++++++++++++++++++++++------------------------- 1 file changed, 42 insertions(+), 42 deletions(-) diff --git a/src/lib/clpz.pl b/src/lib/clpz.pl index 148c84ed..4fa4b846 100644 --- a/src/lib/clpz.pl +++ b/src/lib/clpz.pl @@ -4944,16 +4944,16 @@ run_propagator(pmod(X,Y,Z), MState) --> ; XMin is XL ), { fd_get(X, XD0, XPs), - domain_remove_smaller_than(XD0, XMin, XD2), - fd_put(X, XD2, XPs) } + domain_remove_smaller_than(XD0, XMin, XD2) }, + fd_put(X, XD2, XPs) % queue_goal(X #>= XMin) ; true ), ( { fd_get(X, _, _, n(XU), _) } -> XMax is Z + Y * ((XU - Z) div Y), { fd_get(X, XD1, XPs), - domain_remove_greater_than(XD1, XMax, XD3), - fd_put(X, XD3, XPs) } + domain_remove_greater_than(XD1, XMax, XD3) }, + fd_put(X, XD3, XPs) % queue_goal(X #=< XMax) ; true ) @@ -4973,14 +4973,14 @@ run_propagator(pmod(X,Y,Z), MState) --> ( Z > 0 -> { fd_get(Y, YD, YPs), YMin is Z + 1, - domain_remove_smaller_than(YD, YMin, YD1), - fd_put(Y, YD1, YPs) } + domain_remove_smaller_than(YD, YMin, YD1) }, + fd_put(Y, YD1, YPs) % queue_goal(Y #> Z) ; Z < 0 -> { fd_get(Y, YD, YPs), YMax is Z - 1, - domain_remove_greater_than(YD, YMax, YD1), - fd_put(Y, YD1, YPs) } + domain_remove_greater_than(YD, YMax, YD1) }, + fd_put(Y, YD1, YPs) % queue_goal(Y #< Z) ; true ) @@ -4998,8 +4998,8 @@ run_propagator(pmodz(X,Y,Z), MState) --> kill(MState), queue_goal(Z = X) ; { fd_get(Z, ZD0, ZPs), - domain_remove_greater_than(ZD0, X, ZD2), - fd_put(Z, ZD2, ZPs) } + domain_remove_greater_than(ZD0, X, ZD2) }, + fd_put(Z, ZD2, ZPs) % queue_goal(Z #=< X) ) ; X < 0 -> @@ -5007,8 +5007,8 @@ run_propagator(pmodz(X,Y,Z), MState) --> kill(MState), queue_goal(Z = X) ; { fd_get(Z, ZD0, ZPs), - domain_remove_smaller_than(ZD0, X, ZD2), - fd_put(Z, ZD2, ZPs) } + domain_remove_smaller_than(ZD0, X, ZD2) }, + fd_put(Z, ZD2, ZPs) % queue_goal(Z #>= X) ) ), @@ -5016,15 +5016,15 @@ run_propagator(pmodz(X,Y,Z), MState) --> ZMax is YU - 1, { fd_get(Z, ZD1, ZPs), domain_remove_smaller_than(ZD1, 0, ZD3), - domain_remove_greater_than(ZD3, ZMax, ZD5), - fd_put(Z, ZD5, ZPs) } + domain_remove_greater_than(ZD3, ZMax, ZD5) }, + fd_put(Z, ZD5, ZPs) % queue_goal(Z in 0..ZMax) ; { fd_get(Y, _, n(YL), n(YU), _), YU < 0 } -> ZMin is YL + 1, { fd_get(Z, ZD1, ZPs), domain_remove_greater_than(ZD1, 0, ZD3), - domain_remove_smaller_than(ZD3, ZMin, ZD5), - fd_put(Z, ZD5, ZPs) } + domain_remove_smaller_than(ZD3, ZMin, ZD5) }, + fd_put(Z, ZD5, ZPs) % queue_goal(Z in ZMin..0) ; true ) @@ -5038,8 +5038,8 @@ run_propagator(pmodz(X,Y,Z), MState) --> ; ZMin is Y + 1, { fd_get(Z, ZD1, ZPs), domain_remove_greater_than(ZD1, 0, ZD3), - domain_remove_smaller_than(ZD3, ZMin, ZD5), - fd_put(Z, ZD5, ZPs) } + domain_remove_smaller_than(ZD3, ZMin, ZD5) }, + fd_put(Z, ZD5, ZPs) % queue_goal(Z in ZMin..0) ) ; Y > 0 -> @@ -5049,8 +5049,8 @@ run_propagator(pmodz(X,Y,Z), MState) --> ; ZMax is Y - 1, { fd_get(Z, ZD1, ZPs), domain_remove_smaller_than(ZD1, 0, ZD3), - domain_remove_greater_than(ZD3, ZMax, ZD5), - fd_put(Z, ZD5, ZPs) } + domain_remove_greater_than(ZD3, ZMax, ZD5) }, + fd_put(Z, ZD5, ZPs) % queue_goal(Z in 0..ZMax) ) ) @@ -5064,13 +5064,13 @@ run_propagator(pmodz(X,Y,Z), MState) --> queue_goal(Z = X) ; ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0 } -> { fd_get(Z, ZD0, ZPs), - domain_remove_greater_than(ZD0, XU, ZD2), - fd_put(Z, ZD2, ZPs) } + domain_remove_greater_than(ZD0, XU, ZD2) }, + fd_put(Z, ZD2, ZPs) % queue_goal(Z #=< XU) ; { fd_get(X, _, n(XL), n(XU), _), XU =< 0 } -> { fd_get(Z, ZD0, ZPs), - domain_remove_smaller_than(ZD0, XL, ZD2), - fd_put(Z, ZD2, ZPs) } + domain_remove_smaller_than(ZD0, XL, ZD2) }, + fd_put(Z, ZD2, ZPs) % queue_goal(Z #>= XL) ; true ), @@ -5078,36 +5078,36 @@ run_propagator(pmodz(X,Y,Z), MState) --> ZMax is YU - 1, { fd_get(Z, ZD1, ZPs), domain_remove_smaller_than(ZD1, 0, ZD3), - domain_remove_greater_than(ZD3, ZMax, ZD5), - fd_put(Z, ZD5, ZPs) } + domain_remove_greater_than(ZD3, ZMax, ZD5) }, + fd_put(Z, ZD5, ZPs) % queue_goal(Z in 0..ZMax) ; { fd_get(Y, _, n(YL), n(YU), _), YU < 0 } -> ZMin is YL + 1, { fd_get(Z, ZD1, ZPs), domain_remove_greater_than(ZD1, 0, ZD3), - domain_remove_smaller_than(ZD3, ZMin, ZD5), - fd_put(Z, ZD5, ZPs) } + domain_remove_smaller_than(ZD3, ZMin, ZD5) }, + fd_put(Z, ZD5, ZPs) % queue_goal(Z in ZMin..0) ; { fd_get(Y, _, n(YL), n(YU), _) } -> ZMin is YL + 1, ZMax is YU - 1, { fd_get(Z, ZD1, ZPs), domain_remove_greater_than(ZD1, ZMax, ZD3), - domain_remove_smaller_than(ZD3, ZMin, ZD5), - fd_put(Z, ZD5, ZPs) } + domain_remove_smaller_than(ZD3, ZMin, ZD5) }, + fd_put(Z, ZD5, ZPs) % queue_goal(Z in ZMin..ZMax) %/* This doesn't work very well. ; { fd_get(Y, _, _, n(YU), _), YU > 0 } -> { fd_get(Z, ZD1, ZPs), ZMax is YU - 1, - domain_remove_greater_than(ZD1, ZMax, ZD3), - fd_put(Z, ZD3, ZPs) } + domain_remove_greater_than(ZD1, ZMax, ZD3) }, + fd_put(Z, ZD3, ZPs) % queue_goal(Z #< YU) ; { fd_get(Y, _, n(YL), _, _), YL < 0 } -> { fd_get(Z, ZD1, ZPs), ZMin is YL + 1, - domain_remove_smaller_than(ZD1, ZMin, ZD3), - fd_put(Z, ZD3, ZPs) } + domain_remove_smaller_than(ZD1, ZMin, ZD3) }, + fd_put(Z, ZD3, ZPs) % queue_goal(Z #> YL) % * / ; true @@ -5122,26 +5122,26 @@ run_propagator(pmody(X,Y,Z), MState) --> ( Z > 0 -> % queue_goal(Y #> Z) { fd_get(Y, YD, YPs), YMin is Z + 1, - domain_remove_smaller_than(YD, YMin, YD1), - fd_put(Y, YD1, YPs) } + domain_remove_smaller_than(YD, YMin, YD1) }, + fd_put(Y, YD1, YPs) ; Z < 0 -> % queue_goal(Y #< Z) { fd_get(Y, YD, YPs), YMax is Z - 1, - domain_remove_greater_than(YD, YMax, YD1), - fd_put(Y, YD1, YPs) } + domain_remove_greater_than(YD, YMax, YD1) }, + fd_put(Y, YD1, YPs) ; Z =:= 0 -> kill(MState), queue_goal(X / Y #= _) ) ; ( { fd_get(Z, _, n(ZL), _, _), ZL > 0 } -> { fd_get(Y, YD, YPs), YMin is ZL + 1, - domain_remove_smaller_than(YD, YMin, YD1), - fd_put(Y, YD1, YPs) } + domain_remove_smaller_than(YD, YMin, YD1) }, + fd_put(Y, YD1, YPs) % queue_goal(Y #> ZL) ; { fd_get(Z, _, _, n(ZU), _), ZU < 0 } -> { fd_get(Y, YD, YPs), YMax is ZU - 1, - domain_remove_greater_than(YD, YMax, YD1), - fd_put(Y, YD1, YPs) } + domain_remove_greater_than(YD, YMax, YD1) }, + fd_put(Y, YD1, YPs) % queue_goal(Y #< ZU) ; true ) From e75ebd9b6e947fdc2bca6dacad88012290a28f19 Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Sat, 22 Aug 2020 17:47:42 +0200 Subject: [PATCH 28/37] dif/2: Succeed unconditionally if the arguments are not unifiable. This addresses one part of #135. --- src/lib/dif.pl | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/lib/dif.pl b/src/lib/dif.pl index 347e9d13..ad3053ec 100644 --- a/src/lib/dif.pl +++ b/src/lib/dif.pl @@ -38,11 +38,14 @@ verify_attributes(Var, Value, Goals) :- % Probably the world's worst dif/2 implementation. I'm open to % suggestions for improvement. -dif(X, Y) :- X \== Y, - ( term_variables(X, XVars), term_variables(Y, YVars), - dif_set_variables(XVars, X, Y), - dif_set_variables(YVars, X, Y) - ). +dif(X, Y) :- + X \== Y, + ( X \= Y -> true + ; ( term_variables(X, XVars), term_variables(Y, YVars), + dif_set_variables(XVars, X, Y), + dif_set_variables(YVars, X, Y) + ) + ). gather_dif_goals([]) --> []. gather_dif_goals([(X \== Y) | Goals]) --> From cc77ef680d270913a85e6b2d062ac1950233a9f2 Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Sat, 22 Aug 2020 17:49:02 +0200 Subject: [PATCH 29/37] dif/2: Omit entailed residual goals, if the arguments are not unifiable. This addresses #135. --- src/lib/dif.pl | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/lib/dif.pl b/src/lib/dif.pl index ad3053ec..bb92979a 100644 --- a/src/lib/dif.pl +++ b/src/lib/dif.pl @@ -49,7 +49,9 @@ dif(X, Y) :- gather_dif_goals([]) --> []. gather_dif_goals([(X \== Y) | Goals]) --> - [dif(X, Y)], + ( { X \= Y } -> [] + ; [dif(X, Y)] + ), gather_dif_goals(Goals). attribute_goals(X) --> From d3ab4b5def3f9722d4f09f956757aaec5fd6427b Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sun, 23 Aug 2020 22:49:10 -0300 Subject: [PATCH 30/37] flatten passage of cut point B in (,)/2, (->)/2 and (;)/2 (#685, #683) --- Cargo.lock | 2 + src/lib/builtins.pl | 156 +++++++++++++++++++++++++++++--------------- 2 files changed, 104 insertions(+), 54 deletions(-) diff --git a/Cargo.lock b/Cargo.lock index 4faec27c..3b662efa 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -906,6 +906,8 @@ dependencies = [ [[package]] name = "prolog_parser" version = "0.8.68" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "520bf98dcd386ef320ef11239415c9a11856d3b28fab0d8dc0b61b0d7e65ffe5" dependencies = [ "lexical", "num-rug-adapter", diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl index df312708..3d7aa79f 100644 --- a/src/lib/builtins.pl +++ b/src/lib/builtins.pl @@ -191,81 +191,129 @@ set_prolog_flag(Flag, _) :- fail :- '$fail'. + \+ G :- call(G), !, false. \+ _. + X \= X :- !, false. _ \= _. + once(G) :- call(G), !. + repeat. repeat :- repeat. -','(G1, G2) :- '$get_b_value'(B), '$call_with_default_policy'(comma_errors(G1, G2, B)). -:- non_counted_backtracking comma_errors/3. -comma_errors(G1, G2, B) :- var(G1), throw(error(instantiation_error, (',')/2)). -comma_errors(G1, G2, B) :- '$call_with_default_policy'(','(G1, G2, B)). +','(G1, G2) :- + '$get_b_value'(B), + ( '$call_with_default_policy'(var(G1)) -> + throw(error(instantiation_error, (',')/2)) + ; '$call_with_default_policy'(','(G1, G2, B)) + ). + + +';'(G1, G2) :- + '$get_b_value'(B), + ( '$call_with_default_policy'(var(G1)) -> + throw(error(instantiation_error, (';')/2)) + ; '$call_with_default_policy'(';'(G1, G2, B)) + ). + + +G1 -> G2 :- + '$get_b_value'(B), + ( '$call_with_default_policy'(var(G1)) -> + throw(error(instantiation_error, (->)/2)) + ; '$call_with_default_policy'(->(G1, G2, B)) + ). + + +call_or_cut(G, B, ErrorPI) :- + ( '$call_with_default_policy'(var(G)) -> + throw(error(instantiation_error, ErrorPI)) + ; '$call_with_default_policy'(call_or_cut(G, B)) + ). + + +call_or_cut(!, B) :- + '$set_cp_by_default'(B). +call_or_cut((G1, G2), B) :- + !, + '$call_with_default_policy'(','(G1, G2, B)). +call_or_cut((G1 ; G2), B) :- + !, + '$call_with_default_policy'(';'(G1, G2, B)). +call_or_cut((G1 -> G2), B) :- + !, + '$call_with_default_policy'(->(G1, G2, B)). +call_or_cut(G, _) :- + '$call_with_default_policy'(G). + :- non_counted_backtracking (',')/3. -','(!, CF, B) :- compound(CF), - '$call_with_default_policy'(CF = ','(G1, G2)), - '$set_cp'(B), - '$call_with_default_policy'(comma_errors(G1, G2, B)). -','(!, Atom, B) :- Atom == !, '$set_cp'(B). -','(!, G, B) :- '$set_cp'(B), call(G). -','(G, CF, B) :- compound(CF), - '$call_with_default_policy'(CF = ','(G1, G2)), - !, - call(G), - '$call_with_default_policy'(comma_errors(G1, G2, B)). -','(G, Atom, B) :- Atom == !, !, call(G), '$set_cp'(B). -','(G1, G2, _) :- call(G1), call(G2). +','((G1, G2), G3, B) :- + !, + '$call_with_default_policy'(','(G1, G2, B)), + '$call_with_default_policy'(call_or_cut(G3, B, (',')/2)). +','((G1; G2), G3, B) :- + !, + '$call_with_default_policy'(';'(G1, G2, B)), + '$call_with_default_policy'(call_or_cut(G3, B, (',')/2)). +','((G1 -> G2), G3, B) :- + !, + '$call_with_default_policy'(->(G1, G2, B)), + '$call_with_default_policy'(call_or_cut(G3, B, (',')/2)). +','(G1, G2, B) :- + '$call_with_default_policy'(call_or_cut(G1, B, (',')/2)), + '$call_with_default_policy'(call_or_cut(G2, B, (',')/2)). -;(G1, G2) :- '$get_b_value'(B), ;(G1, G2, B). - -:- non_counted_backtracking semicolon_compound_selector/3. -semicolon_compound_selector(->(G2, G3), G4, B) :- - ( call(G2) -> - call(G3) - ; '$set_cp'(B), - call(G4) - ). -semicolon_compound_selector(','(G2, G3), G4, B) :- - ( ','(G2, G3, B) - ; '$set_cp'(B), - call(G4) - ). -semicolon_compound_selector(';'(G2, G3), G4, B) :- - ( ';'(G2, G3, B) - ; '$set_cp'(B), - call(G4) - ). :- non_counted_backtracking (;)/3. -;(G1, G4, B) :- - ( ( G1 = (_ -> _) - ; G1 = (_ , _) - ; G1 = (_ ; _) - ) -> - !, - semicolon_compound_selector(G1, G4, B) +';'((G1, G2), G3, B) :- + !, + ( '$call_with_default_policy'(','(G1, G2, B)) + ; '$call_with_default_policy'(call_or_cut(G3, B, (;)/2)) + ). +';'((G1; G2), G3, B) :- + !, + ( '$call_with_default_policy'(';'(G1, G2, B)) + ; '$call_with_default_policy'(call_or_cut(G3, B, (;)/2)) + ). +';'((G1 -> G2), G3, B) :- + !, + ( '$call_with_default_policy'(call_or_cut(G1, B, (->)/2)) -> + '$call_with_default_policy'(call_or_cut(G2, B, (->)/2)) + ; '$call_with_default_policy'(call_or_cut(G3, B, (;)/2)) + ). +';'(G1, G2, B) :- + ( '$call_with_default_policy'(call_or_cut(G1, B, (;)/2)) + ; '$call_with_default_policy'(call_or_cut(G2, B, (;)/2)) ). -;(G1, G2, B) :- - G1 == !, !, '$set_cp'(B), call(G2). -;(G1, G2, B) :- - G2 == !, !, call(G1), '$set_cp'(B). -;(G, _, _) :- - call(G). -;(_, G, _) :- - call(G). -G1 -> G2 :- '$get_b_value'(B), '$call_with_default_policy'(->(G1, G2, B)). :- non_counted_backtracking (->)/3. -->(G1, G2, B) :- G2 == !, call(G1), '$set_cp'(B). -->(G1, G2, B) :- call(G1), '$set_cp'(B), call(G2). +->((G1, G2), G3, B) :- + !, + ( '$call_with_default_policy'(','(G1, G2, B)) -> + '$call_with_default_policy'(call_or_cut(G3, B, (->)/2)) + ). +->((G1 ; G2), G3, B) :- + !, + ( '$call_with_default_policy'(';'(G1, G2, B)) -> + '$call_with_default_policy'(call_or_cut(G3, B, (->)/2)) + ). +->((G1 -> G2), G3, B) :- + !, + ( '$call_with_default_policy'(->(G1, G2, B)) -> + '$call_with_default_policy'(call_or_cut(G3, B, (->)/2)) + ). +->(G1, G2, B) :- + ( '$call_with_default_policy'(call_or_cut(G1, B, (->)/2)) + -> '$call_with_default_policy'(call_or_cut(G2, B, (->)/2)) + ). % univ. From 79cb4cd6a55732b430e5a16ec195a9d051e78be3 Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Sun, 23 Aug 2020 22:13:11 +0200 Subject: [PATCH 31/37] ADDED: First version of call_nth/2. A thread-safe implementation is possible for example with '$nb_setarg'/3 (see #390). --- README.md | 2 +- src/lib/iso_ext.pl | 36 +++++++++++++++++++++++++++++++++++- 2 files changed, 36 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index dab6a379..1ce4b829 100644 --- a/README.md +++ b/README.md @@ -450,7 +450,7 @@ The modules that ship with Scryer Prolog are also called 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` and + ISO standard, such as `setup_call_cleanup/3`, `call_nth/2` and `call_with_inference_limit/3`. * [`crypto`](src/lib/crypto.pl) Cryptographically secure random numbers and hashes, HMAC-based key diff --git a/src/lib/iso_ext.pl b/src/lib/iso_ext.pl index e206fd0b..e5ba94c1 100644 --- a/src/lib/iso_ext.pl +++ b/src/lib/iso_ext.pl @@ -7,7 +7,9 @@ call_with_inference_limit/3, forall/2, partial_string/1, partial_string/3, partial_string_tail/2, setup_call_cleanup/3, - variant/2]). + call_nth/2, variant/2]). + +:- use_module(library(error), [can_be/2,domain_error/3]). forall(Generate, Test) :- \+ (Generate, \+ Test). @@ -161,3 +163,35 @@ partial_string_tail(String, Tail) :- '$partial_string_tail'(String, Tail) ; throw(error(type_error(partial_string, String), partial_string_tail/2)) ). + +:- dynamic(i_call_nth_nesting/2). +:- dynamic(i_call_nth_counter/1). + +call_nth(Goal, N) :- + can_be(integer, N), + ( integer(N), N =< 0, + domain_error(positive_integer, N, call_nth/2) + ; true + ), + setup_call_cleanup(call_nth_nesting(ID), + ( Goal, + retract(i_call_nth_nesting(ID,N0)), + N1 is N0 + 1, + asserta(i_call_nth_nesting(ID,N1)), + ( integer(N) -> + N = N1, + ! + ; N = N1 + ) + ), + ( retract(i_call_nth_nesting(ID,_)), + retract(i_call_nth_counter(ID)) + )). + +call_nth_nesting(ID) :- + ( i_call_nth_counter(ID0) -> + ID is ID0 + 1 + ; ID = 0 + ), + asserta(i_call_nth_nesting(ID, 0)), + asserta(i_call_nth_counter(ID)). From a53b4df8b6f08ad86209894814a2f0694b9c8ed1 Mon Sep 17 00:00:00 2001 From: Matteo Redaelli Date: Tue, 25 Aug 2020 17:19:45 +0200 Subject: [PATCH 32/37] Update README.md wrong link to source file dcgs.pl --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 1ce4b829..12a4874f 100644 --- a/README.md +++ b/README.md @@ -272,7 +272,7 @@ the exact same internal representation, and has the advantage that only the standard predicate `(=)/2` is used. Definite clause grammars as provided by -[`library(dcgs)`](src/lib/lists.pl), and the predicates from +[`library(dcgs)`](src/lib/dcgs.pl), and the predicates from [`library(lists)`](src/lib/lists.pl), are ideally suited for reasoning about strings. From 78656d220bac17cfc5d27be98014c58d99256aea Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Wed, 2 Sep 2020 19:20:49 +0200 Subject: [PATCH 33/37] FIXED: reliably write all characters when using format/3 This addresses #693. Many thanks to @notoria for a brilliant test case, and the suggestion of this correction! --- src/machine/system_calls.rs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index d2779d1a..a4933097 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -2137,7 +2137,7 @@ impl MachineState { bytes = string.into_bytes(); } - match stream.write(&bytes) { + match stream.write_all(&bytes) { Ok(_) => { return return_from_clause!(self.last_call, self); } From 5f3ab823fd99cc779ddc6504050fdbf9d69597be Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Sat, 5 Sep 2020 09:56:32 +0200 Subject: [PATCH 34/37] FIXED: format_//2: Keep different variables distinct. Example: ?- phrase(format_("~w~w", [_,_]), Ls). %@ Ls = "AB" %@ ; false. --- src/lib/format.pl | 106 ++++++++++++++++++++++++---------------------- 1 file changed, 55 insertions(+), 51 deletions(-) diff --git a/src/lib/format.pl b/src/lib/format.pl index 31abe57c..50ea419c 100644 --- a/src/lib/format.pl +++ b/src/lib/format.pl @@ -87,7 +87,8 @@ format_(Fs, Args) --> { must_be(list, Fs), must_be(list, Args), - phrase(cells(Fs,Args,0,[]), Cells) }, + unique_variable_names(Args, VNs), + phrase(cells(Fs,Args,0,[],VNs), Cells) }, format_cells(Cells). format_cells([]) --> []. @@ -157,22 +158,22 @@ element_gluevar(glue(_,V), N, N) --> [V]. consume whitespace in the sense of format strings. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ -cells([], Args, Tab, Es) --> +cells([], Args, Tab, Es, _) --> ( { Args == [] } -> cell(Tab, Tab, Es) ; { domain_error(empty_list, Args, format_//2) } ). -cells([~,~|Fs], Args, Tab, Es) --> !, - cells(Fs, Args, Tab, [chars("~")|Es]). -cells([~,w|Fs], [Arg|Args], Tab, Es) --> !, - { write_term_to_chars(Arg, [], Chars) }, - cells(Fs, Args, Tab, [chars(Chars)|Es]). -cells([~,q|Fs], [Arg|Args], Tab, Es) --> !, - { write_term_to_chars(Arg, [quoted(true)], Chars) }, - cells(Fs, Args, Tab, [chars(Chars)|Es]). -cells([~,a|Fs], [Arg|Args], Tab, Es) --> !, +cells([~,~|Fs], Args, Tab, Es, VNs) --> !, + cells(Fs, Args, Tab, [chars("~")|Es], VNs). +cells([~,w|Fs], [Arg|Args], Tab, Es, VNs) --> !, + { write_term_to_chars(Arg, [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),variable_names(VNs)], Chars) }, + cells(Fs, Args, Tab, [chars(Chars)|Es], VNs). +cells([~,a|Fs], [Arg|Args], Tab, Es, VNs) --> !, { atom_chars(Arg, Chars) }, - cells(Fs, Args, Tab, [chars(Chars)|Es]). -cells([~|Fs0], Args0, Tab, Es) --> + cells(Fs, Args, Tab, [chars(Chars)|Es], VNs). +cells([~|Fs0], Args0, Tab, Es, VNs) --> { numeric_argument(Fs0, Num, [d|Fs], Args0, [Arg0|Args]) }, !, { Arg is Arg0, % evaluate compound expression @@ -191,8 +192,8 @@ cells([~|Fs0], Args0, Tab, Es) --> phrase((list(Bs),".",list(Ds)), Cs) ) } ), - cells(Fs, Args, Tab, [chars(Cs)|Es]). -cells([~|Fs0], Args0, Tab, Es) --> + cells(Fs, Args, Tab, [chars(Cs)|Es], VNs). +cells([~|Fs0], Args0, Tab, Es, VNs) --> { numeric_argument(Fs0, Num, ['D'|Fs], Args0, [Arg|Args]) }, !, { number_chars(Num, NCs), @@ -203,25 +204,25 @@ cells([~|Fs0], Args0, Tab, Es) --> 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) --> !, + cells(Fs, Args, Tab, [chars(Cs)|Es], VNs). +cells([~,i|Fs], [_|Args], Tab, Es, VNs) --> !, + cells(Fs, Args, Tab, Es, VNs). +cells([~,n|Fs], Args, Tab, Es, VNs) --> !, cell(Tab, Tab, Es), n_newlines(1), - cells(Fs, Args, 0, []). -cells([~|Fs0], Args0, Tab, Es) --> + cells(Fs, Args, 0, [], VNs). +cells([~|Fs0], Args0, Tab, Es, VNs) --> { numeric_argument(Fs0, Num, [n|Fs], Args0, Args) }, !, cell(Tab, Tab, Es), n_newlines(Num), - cells(Fs, Args, 0, []). -cells([~,s|Fs], [Arg|Args], Tab, Es) --> !, - cells(Fs, Args, Tab, [chars(Arg)|Es]). -cells([~,f|Fs], [Arg|Args], Tab, Es) --> !, + cells(Fs, Args, 0, [], VNs). +cells([~,s|Fs], [Arg|Args], Tab, Es, VNs) --> !, + cells(Fs, Args, Tab, [chars(Arg)|Es], VNs). +cells([~,f|Fs], [Arg|Args], Tab, Es, VNs) --> !, { format_number_chars(Arg, Chars) }, - cells(Fs, Args, Tab, [chars(Chars)|Es]). -cells([~|Fs0], Args0, Tab, Es) --> + cells(Fs, Args, Tab, [chars(Chars)|Es], VNs). +cells([~|Fs0], Args0, Tab, Es, VNs) --> { numeric_argument(Fs0, Num, [f|Fs], Args0, [Arg|Args]) }, !, { format_number_chars(Arg, Cs0), @@ -248,39 +249,39 @@ cells([~|Fs0], Args0, Tab, Es) --> ), append(Bs, ['.'|Ds], Chars) ) }, - cells(Fs, Args, Tab, [chars(Chars)|Es]). -cells([~|Fs0], Args0, Tab, Es) --> + cells(Fs, Args, Tab, [chars(Chars)|Es], VNs). +cells([~|Fs0], Args0, Tab, Es, VNs) --> { numeric_argument(Fs0, Num, [r|Fs], Args0, [Arg|Args]) }, !, { integer_to_radix(Arg, Num, lowercase, Cs) }, - cells(Fs, Args, Tab, [chars(Cs)|Es]). -cells([~|Fs0], Args0, Tab, Es) --> + cells(Fs, Args, Tab, [chars(Cs)|Es], VNs). +cells([~|Fs0], Args0, Tab, Es, VNs) --> { numeric_argument(Fs0, Num, ['R'|Fs], Args0, [Arg|Args]) }, !, { integer_to_radix(Arg, Num, uppercase, Cs) }, - cells(Fs, Args, Tab, [chars(Cs)|Es]). -cells([~,'`',Char,t|Fs], Args, Tab, Es) --> !, - cells(Fs, Args, Tab, [glue(Char,_)|Es]). -cells([~,t|Fs], Args, Tab, Es) --> !, - cells(Fs, Args, Tab, [glue(' ',_)|Es]). -cells([~|Fs0], Args0, Tab, Es) --> + cells(Fs, Args, Tab, [chars(Cs)|Es], VNs). +cells([~,'`',Char,t|Fs], Args, Tab, Es, VNs) --> !, + cells(Fs, Args, Tab, [glue(Char,_)|Es], VNs). +cells([~,t|Fs], Args, Tab, Es, VNs) --> !, + cells(Fs, Args, Tab, [glue(' ',_)|Es], VNs). +cells([~|Fs0], Args0, Tab, Es, VNs) --> { numeric_argument(Fs0, Num, ['|'|Fs], Args0, Args) }, !, cell(Tab, Num, Es), - cells(Fs, Args, Num, []). -cells([~|Fs0], Args0, Tab0, Es) --> + cells(Fs, Args, Num, [], VNs). +cells([~|Fs0], Args0, Tab0, Es, VNs) --> { numeric_argument(Fs0, Num, [+|Fs], Args0, Args) }, !, { Tab is Tab0 + Num }, cell(Tab0, Tab, Es), - cells(Fs, Args, Tab, []). -cells([~,C|_], _, _, _) --> + cells(Fs, Args, Tab, [], VNs). +cells([~,C|_], _, _, _, _) --> { atom_chars(A, [~,C]), domain_error(format_string, A, format_//2) }. -cells(Fs0, Args, Tab, Es) --> +cells(Fs0, Args, Tab, Es, VNs) --> { phrase(upto_what(Fs1, ~), Fs0, Fs), Fs1 = [_|_] }, - cells(Fs, Args, Tab, [chars(Fs1)|Es]). + cells(Fs, Args, Tab, [chars(Fs1)|Es], VNs). format_number_chars(N0, Chars) :- N is N0, % evaluate compound expression @@ -390,14 +391,14 @@ format(Stream, Fs, Args) :- ?- phrase(cells("~`at~50|", [], 0, []), Cs), phrase(format_cells(Cs), Ls). -?- phrase(cells("~ta~t~tb~tc~21|", [], 0, []), Cs). -Cs = [cell(0,21,[glue(' ',_38),chars([a]),glue(' ',_62),glue(' ',_67),chars([b]),glue(' ',_91),chars([c])])]. -?- phrase(cells("~ta~t~4|", [], 0, []), Cs). -Cs = [cell(0,4,[glue(' ',_38),chars([a]),glue(' ',_62)])]. +?- phrase(format:cells("~ta~t~tb~tc~21|", [], 0, [], []), Cs). +Cs = [cell(0,21,[glue(' ',_A),chars("a"),glue(' ',_B),glue(' ',_C),chars("b"),glue(' ',_D),chars("c ...")])] +?- phrase(format:cells("~ta~t~4|", [], 0, [], []), Cs). +Cs = [cell(0,4,[glue(' ',_A),chars("a"),glue(' ',_B)])] -?- phrase(format_cell(cell(0,1,[glue(a,_94)])), Ls). +?- phrase(format:format_cell(cell(0,1,[glue(a,_94)])), Ls). -?- phrase(format_cell(cell(0,50,[chars("hello")])), Ls). +?- phrase(format:format_cell(cell(0,50,[chars("hello")])), Ls). ?- phrase(format_("~`at~50|~n", []), Ls). ?- phrase(format_("hello~n~tthere~6|", []), Ls). @@ -462,10 +463,13 @@ portray_clause(Stream, Term) :- format(Stream, "~s", [Ls]). portray_clause_(Term) --> - { term_variables(Term, Vs), - foldl(var_name, Vs, VNs, 0, _) }, + { unique_variable_names(Term, VNs) }, portray_(Term, VNs), ".\n". +unique_variable_names(Term, VNs) :- + term_variables(Term, Vs), + foldl(var_name, Vs, VNs, 0, _). + var_name(V, Name=V, Num0, Num) :- charsio:fabricate_var_name(numbervars, Name, Num0), Num is Num0 + 1. From d677d3d2ef27f2984dd25229bd4409a55f612acd Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sat, 5 Sep 2020 18:07:58 -0600 Subject: [PATCH 35/37] preface the 'spelling error' with an explainer comment (#687) --- src/lib/tabling/batched_worklist.pl | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/lib/tabling/batched_worklist.pl b/src/lib/tabling/batched_worklist.pl index f39f8422..99f0619b 100644 --- a/src/lib/tabling/batched_worklist.pl +++ b/src/lib/tabling/batched_worklist.pl @@ -161,6 +161,8 @@ wkl_p_swap_answer_continuation(Worklist,InnerAnswerClusterPointer,SuspensionClus wkl_p_update_righmost_inner_answer_cluster_pointer(Worklist,InnerAnswerClusterPointer). % Update the pointer if the answer cluster it points to is no longer the rightmost inner answer cluster. +% Strangely, this predicate was intentionally named "wkl_p_update_righmost_inner_answer_cluster_pointer" +% in the original library. wkl_p_update_righmost_inner_answer_cluster_pointer(Worklist,InnerAnswerClusterPointer) :- ( wkl_p_answer_cluster_currently_moved_completely(Worklist,InnerAnswerClusterPointer) -> wkl_p_find_new_rightmost_inner_answer_cluster_pointer(Worklist,InnerAnswerClusterPointer,NewRiacPointer), From 323e9c3eb3d4016991cd0da2b973747c08ab49eb Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sat, 5 Sep 2020 18:57:03 -0600 Subject: [PATCH 36/37] refactor SystemClauseType::Open in anticipation of #614 --- src/machine/system_calls.rs | 214 ++++++++++++++++++++---------------- 1 file changed, 118 insertions(+), 96 deletions(-) diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index a4933097..da31e966 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -375,6 +375,113 @@ impl MachineState { Ok(()) } + fn stream_from_file_spec( + &self, + file_spec: ClauseName, + indices: &mut IndexStore, + options: &StreamOptions, + ) -> Result { + if file_spec.as_str().is_empty() { + let stub = MachineError::functor_stub(clause_name!("open"), 4); + let err = MachineError::domain_error( + DomainErrorType::SourceSink, + self[temp_v!(1)], + ); + + return Err(self.error_form(err, stub)); + } + + // 8.11.5.3l) + if let Some(ref alias) = &options.alias { + if indices.stream_aliases.contains_key(alias) { + return Err(self.occupied_alias_permission_error( + alias.clone(), + "open", + 4, + )); + } + } + + let mode = + atom_from!(self, indices, self.store(self.deref(self[temp_v!(2)]))); + + let mut open_options = fs::OpenOptions::new(); + + let (is_input_file, in_append_mode) = + match mode.as_str() { + "read" => { + open_options.read(true).write(false).create(false); + (true, false) + } + "write" => { + open_options.read(false).write(true).truncate(true).create(true); + (false, false) + } + "append" => { + open_options.read(false).write(true).create(true).append(true); + (false, true) + } + _ => { + let stub = MachineError::functor_stub(clause_name!("open"), 4); + let err = MachineError::domain_error( + DomainErrorType::IOMode, + self[temp_v!(2)], + ); + + // 8.11.5.3h) + return Err(self.error_form(err, stub)); + } + }; + + let file = + match open_options.open(file_spec.as_str()) { + Ok(file) => { + file + } + Err(err) => { + match err.kind() { + ErrorKind::NotFound => { + // 8.11.5.3j) + let stub = MachineError::functor_stub( + clause_name!("open"), + 4, + ); + + let err = MachineError::existence_error( + self.heap.h(), + ExistenceError::SourceSink(self[temp_v!(1)]), + ); + + return Err(self.error_form(err, stub)); + } + ErrorKind::PermissionDenied => { + // 8.11.5.3k) + return Err(self.open_permission_error(self[temp_v!(1)], "open", 4)); + } + _ => { + let stub = MachineError::functor_stub( + clause_name!("open"), + 4, + ); + + let err = MachineError::syntax_error( + self.heap.h(), + ParserError::IO(err), + ); + + return Err(self.error_form(err, stub)); + } + } + } + }; + + Ok(if is_input_file { + Stream::from_file_as_input(file_spec, file) + } else { + Stream::from_file_as_output(file_spec, file, in_append_mode) + }) + } + #[inline] fn install_new_block(&mut self, r: RegType) -> usize { self.block = self.b; @@ -3368,12 +3475,12 @@ impl MachineState { let options = self.to_stream_options(alias, eof_action, reposition, stream_type); - let file_spec = + let mut stream = match self.store(self.deref(self[temp_v!(1)])) { Addr::Con(h) if self.heap.atom_at(h) => { match &self.heap[h] { &HeapCellValue::Atom(ref atom, _) => { - atom.clone() + self.stream_from_file_spec(atom.clone(), indices, &options)? } _ => { unreachable!() @@ -3386,109 +3493,24 @@ impl MachineState { let mut heap_pstr_iter = self.heap_pstr_iter(Addr::PStrLocation(h, n)); - clause_name!( - heap_pstr_iter.to_string(), - indices.atom_tbl.clone() - ) + let file_spec = + clause_name!( + heap_pstr_iter.to_string(), + indices.atom_tbl.clone() + ); + + self.stream_from_file_spec(file_spec, indices, &options)? } _ => { - clause_name!("") + self.stream_from_file_spec(clause_name!(""), indices, &options)? } } } _ => { - clause_name!("") + self.stream_from_file_spec(clause_name!(""), indices, &options)? } }; - if file_spec.as_str().is_empty() { - let stub = MachineError::functor_stub(clause_name!("open"), 4); - let err = MachineError::domain_error( - DomainErrorType::SourceSink, - self[temp_v!(1)], - ); - - return Err(self.error_form(err, stub)); - } - - // 8.11.5.3l) - if let Some(ref alias) = &options.alias { - if indices.stream_aliases.contains_key(alias) { - return Err(self.occupied_alias_permission_error( - alias.clone(), - "open", - 4, - )); - } - } - - let mode = - atom_from!(self, indices, self.store(self.deref(self[temp_v!(2)]))); - - let mut open_options = fs::OpenOptions::new(); - - let (is_input_file, in_append_mode) = - match mode.as_str() { - "read" => { - open_options.read(true).write(false).create(false); - (true, false) - } - "write" => { - open_options.read(false).write(true).truncate(true).create(true); - (false, false) - } - "append" => { - open_options.read(false).write(true).create(true).append(true); - (false, true) - } - _ => { - let stub = MachineError::functor_stub(clause_name!("open"), 4); - let err = MachineError::domain_error( - DomainErrorType::IOMode, - self[temp_v!(2)], - ); - - // 8.11.5.3h) - return Err(self.error_form(err, stub)); - } - }; - - let file = - match open_options.open(file_spec.as_str()).map_err(|e| e.kind()) { - Ok(file) => { - file - } - Err(ErrorKind::NotFound) => { - // 8.11.5.3j) - let stub = MachineError::functor_stub( - clause_name!("open"), - 4, - ); - - let err = MachineError::existence_error( - self.heap.h(), - ExistenceError::SourceSink(self[temp_v!(1)]), - ); - - return Err(self.error_form(err, stub)); - } - Err(ErrorKind::PermissionDenied) => { - // 8.11.5.3k) - return Err(self.open_permission_error(self[temp_v!(1)], "open", 4)); - } - Err(_) => { - // for now, just fail. expand to meaningful error messages later. - self.fail = true; - return Ok(()); - } - }; - - let mut stream = if is_input_file { - Stream::from_file_as_input(file_spec, file) - } else { - Stream::from_file_as_output(file_spec, file, in_append_mode) - }; - stream.options = options; indices.streams.insert(stream.clone()); From 46dfaa5b2846c9ec649b2cb65ba18d9b2cbbc4e0 Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Sun, 13 Sep 2020 10:21:57 +0200 Subject: [PATCH 37/37] ENHANCED: library(files): Error handling if requested files do not exist. We now throw exceptions instead of failing silently, or even crashing when using file_size/2 etc. with nonexistent files. --- src/lib/files.pl | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/lib/files.pl b/src/lib/files.pl index bdc38b90..512c757c 100644 --- a/src/lib/files.pl +++ b/src/lib/files.pl @@ -73,6 +73,7 @@ directory_files(Directory, Files) :- '$directory_files'(Directory, Files). file_size(File, Size) :- + file_must_exist(File, file_size/2), list_of_chars(File), can_be(integer, Size), '$file_size'(File, Size). @@ -90,9 +91,15 @@ make_directory(Directory) :- '$make_directory'(Directory). delete_file(File) :- + file_must_exist(File, delete_file/1), list_of_chars(File), '$delete_file'(File). +file_must_exist(File, Context) :- + ( file_exists(File) -> true + ; throw(error(existence_error(file, File), Context)) + ). + /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Dir0 is the current working directory, and the working directory is changed to Dir. @@ -142,6 +149,7 @@ file_creation_time(File, T) :- file_time_(File, creation, T). file_time_(File, Which, T) :- + file_must_exist(File, file_time_/3), '$file_time'(File, Which, T0), read_term_from_chars(T0, T).