diff --git a/Cargo.lock b/Cargo.lock index 041ddfa9..3b662efa 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.68" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1fa8dbe0881bcc9a247db279802701d87bbe9d4c6604bb0e5cad3dd3314f241d" +checksum = "520bf98dcd386ef320ef11239415c9a11856d3b28fab0d8dc0b61b0d7e65ffe5" 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 6ac8ebe4..4912155f 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.68", default-features = false } ref_thread_local = "0.0.0" rug = { version = "1.4.0", optional = true } rustyline = "6.0.0" @@ -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..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. @@ -450,14 +450,14 @@ 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 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..339c7d38 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"), @@ -708,13 +710,14 @@ 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), - ("$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), ("$getenv", 2) => Some(SystemClauseType::GetEnv), 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/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/lib/builtins.pl b/src/lib/builtins.pl index 3e1c8d28..3d7aa79f 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, [>, <, =\=, =:=, >=, =<]). @@ -189,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. @@ -916,6 +966,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/lib/clpb.pl b/src/lib/clpb.pl index 6b74e272..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) -> @@ -1558,9 +1557,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)] ). diff --git a/src/lib/clpz.pl b/src/lib/clpz.pl index e4c8e897..4fa4b846 100644 --- a/src/lib/clpz.pl +++ b/src/lib/clpz.pl @@ -4925,97 +4925,229 @@ run_propagator(ptzdiv(X,Y,Z), MState) --> %% % Z = X mod Y run_propagator(pmod(X,Y,Z), MState) --> - ( nonvar(X) -> - ( nonvar(Y) -> kill(MState), Y =\= 0, Z is X mod Y + ( Y == 0 -> { false } + ; Y == Z -> { false } + % ; nonvar(Y), Z == X -> true + ; X == Y -> kill(MState), queue_goal(Z = 0) + ; true + ), + ( nonvar(X), nonvar(Y) -> + kill(MState), + Z is X mod Y + ; nonvar(Y), nonvar(Z) -> + ( Y > 0 -> Z >= 0, Z < Y + ; Y < 0 -> Z =< 0, Z > Y + ), + ( { fd_get(X, _, n(XL), _, _) } -> + ( (XL - Z) mod Y =\= 0 -> + XMin is Z + Y * ((XL - Z) div Y + 1) + ; XMin is XL + ), + { fd_get(X, XD0, XPs), + domain_remove_smaller_than(XD0, XMin, XD2) }, + fd_put(X, XD2, XPs) + % queue_goal(X #>= XMin) + ; true + ), + ( { fd_get(X, _, _, n(XU), _) } -> + XMax is Z + Y * ((XU - Z) div Y), + { fd_get(X, XD1, XPs), + domain_remove_greater_than(XD1, XMax, XD3) }, + fd_put(X, XD3, XPs) + % queue_goal(X #=< XMax) ; true ) - ; nonvar(Y) -> - Y =\= 0, - ( abs(Y) =:= 1 -> kill(MState), Z = 0 - ; var(Z) -> - YP is abs(Y) - 1, - ( Y > 0, { fd_get(X, _, n(XL), n(XU), _) } -> - ( XL >= 0, XU < Y -> - kill(MState), Z = X, ZL = XL, ZU = XU - ; ZL = 0, ZU = YP - ) - ; Y > 0 -> ZL = 0, ZU = YP - ; YN is -YP, ZL = YN, ZU = 0 - ), - ( { fd_get(Z, ZD, ZPs) } -> - { domains_intersection(ZD, from_to(n(ZL), n(ZU)), ZD1), - domain_infimum(ZD1, n(ZMin)), - domain_supremum(ZD1, n(ZMax)) }, - fd_put(Z, ZD1, ZPs) - ; ZMin = Z, ZMax = Z - ), - ( { fd_get(X, XD, XPs), domain_infimum(XD, n(XMin)) } -> - Z1 is XMin mod Y, - ( { between(ZMin, ZMax, Z1) } -> true - ; Y > 0 -> - Next is ((XMin - ZMin + Y - 1) div Y)*Y + ZMin, - { domain_remove_smaller_than(XD, Next, XD1) }, - fd_put(X, XD1, XPs) - ; neq_num(X, XMin) - ) - ; true - ), - ( { fd_get(X, XD2, XPs2), domain_supremum(XD2, n(XMax)) } -> - Z2 is XMax mod Y, - ( { between(ZMin, ZMax, Z2) } -> true - ; Y > 0 -> - Prev is ((XMax - ZMin) div Y)*Y + ZMax, - { domain_remove_greater_than(XD2, Prev, XD3) }, - fd_put(X, XD3, XPs2) - ; neq_num(X, XMax) - ) - ; true + % kill(MState), + % queue_goal(X #= Z + Y * _) % Add a variable to be efficient. + ; nonvar(Z), nonvar(X) -> + ( Z > 0 -> + ( X < 0 -> true + ; X >= Z ) - ; { fd_get(X, XD, XPs) }, - % if possible, propagate at the boundaries - ( { domain_infimum(XD, n(Min)) } -> - ( Min mod Y =:= Z -> true - ; Y > 0 -> - Next is ((Min - Z + Y - 1) div Y)*Y + Z, - { domain_remove_smaller_than(XD, Next, XD1) }, - fd_put(X, XD1, XPs) - ; neq_num(X, Min) + ; Z < 0 -> + ( X > 0 -> true + ; X =< Z + ) + ; Z =:= 0 % Multiple solutions so do nothing special. + ), + ( 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), + true + ). + +run_propagator(pmodz(X,Y,Z), MState) --> + ( nonvar(Z) -> true % Nothing to do. + ; nonvar(X) -> + ( X =:= 0 -> kill(MState), queue_goal(Z = X) + ; ( X > 0 -> + ( { fd_get(Y, _, n(YL), _, _), YL > X } -> + kill(MState), + queue_goal(Z = X) + ; { fd_get(Z, ZD0, ZPs), + domain_remove_greater_than(ZD0, X, ZD2) }, + fd_put(Z, ZD2, ZPs) + % queue_goal(Z #=< X) + ) + ; X < 0 -> + ( { fd_get(Y, _, _, n(YU), _), YU < X } -> + kill(MState), + queue_goal(Z = X) + ; { fd_get(Z, ZD0, ZPs), + domain_remove_smaller_than(ZD0, X, ZD2) }, + fd_put(Z, ZD2, ZPs) + % queue_goal(Z #>= X) ) - ; 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 - ) + ( { fd_get(Y, _, n(YL), n(YU), _), YL > 0 } -> + ZMax is YU - 1, + { fd_get(Z, ZD1, ZPs), + domain_remove_smaller_than(ZD1, 0, ZD3), + domain_remove_greater_than(ZD3, ZMax, ZD5) }, + fd_put(Z, ZD5, ZPs) + % queue_goal(Z in 0..ZMax) + ; { fd_get(Y, _, n(YL), n(YU), _), YU < 0 } -> + ZMin is YL + 1, + { fd_get(Z, ZD1, ZPs), + domain_remove_greater_than(ZD1, 0, ZD3), + domain_remove_smaller_than(ZD3, ZMin, ZD5) }, + fd_put(Z, ZD5, ZPs) + % queue_goal(Z in ZMin..0) + ; true + ) + ) + ; nonvar(Y) -> + ( abs(Y) =:= 1 -> kill(MState), queue_goal(Z = 0) + ; Y < 0 -> + ( { fd_get(X, _, n(XL), n(XU), _), XU =< 0, Y < XL } -> + kill(MState), + queue_goal(Z = X) + ; ZMin is Y + 1, + { fd_get(Z, ZD1, ZPs), + domain_remove_greater_than(ZD1, 0, ZD3), + domain_remove_smaller_than(ZD3, ZMin, ZD5) }, + fd_put(Z, ZD5, ZPs) + % queue_goal(Z in ZMin..0) + ) + ; Y > 0 -> + ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0, Y > XU } -> + kill(MState), + queue_goal(Z = X) + ; ZMax is Y - 1, + { fd_get(Z, ZD1, ZPs), + domain_remove_smaller_than(ZD1, 0, ZD3), + domain_remove_greater_than(ZD3, ZMax, ZD5) }, + fd_put(Z, ZD5, ZPs) + % queue_goal(Z in 0..ZMax) + ) + ) + ; ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0, + fd_get(Y, _, n(YL), _, _), XU < YL } -> + kill(MState), + queue_goal(Z = X) + ; { fd_get(X, _, n(XL), n(XU), _), XU =< 0, + fd_get(Y, _, _, n(YU), _), XL > YU } -> + kill(MState), + queue_goal(Z = X) + ; ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0 } -> + { fd_get(Z, ZD0, ZPs), + domain_remove_greater_than(ZD0, XU, ZD2) }, + fd_put(Z, ZD2, ZPs) + % queue_goal(Z #=< XU) + ; { fd_get(X, _, n(XL), n(XU), _), XU =< 0 } -> + { fd_get(Z, ZD0, ZPs), + domain_remove_smaller_than(ZD0, XL, ZD2) }, + fd_put(Z, ZD2, ZPs) + % queue_goal(Z #>= XL) + ; true + ), + ( { fd_get(Y, _, n(YL), n(YU), _), YL > 0 } -> + ZMax is YU - 1, + { fd_get(Z, ZD1, ZPs), + domain_remove_smaller_than(ZD1, 0, ZD3), + domain_remove_greater_than(ZD3, ZMax, ZD5) }, + fd_put(Z, ZD5, ZPs) + % queue_goal(Z in 0..ZMax) + ; { fd_get(Y, _, n(YL), n(YU), _), YU < 0 } -> + ZMin is YL + 1, + { fd_get(Z, ZD1, ZPs), + domain_remove_greater_than(ZD1, 0, ZD3), + domain_remove_smaller_than(ZD3, ZMin, ZD5) }, + fd_put(Z, ZD5, ZPs) + % queue_goal(Z in ZMin..0) + ; { fd_get(Y, _, n(YL), n(YU), _) } -> + ZMin is YL + 1, + ZMax is YU - 1, + { fd_get(Z, ZD1, ZPs), + domain_remove_greater_than(ZD1, ZMax, ZD3), + domain_remove_smaller_than(ZD3, ZMin, ZD5) }, + fd_put(Z, ZD5, ZPs) + % queue_goal(Z in ZMin..ZMax) + %/* 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 ) ) - ; 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(pmody(X,Y,Z), MState) --> + ( nonvar(Y) -> true % Nothing to do. + % ; nonvar(X) -> true + ; nonvar(Z) -> + ( Z > 0 -> % queue_goal(Y #> Z) + { fd_get(Y, YD, YPs), + YMin is Z + 1, + domain_remove_smaller_than(YD, YMin, YD1) }, + fd_put(Y, YD1, YPs) + ; Z < 0 -> % queue_goal(Y #< Z) + { fd_get(Y, YD, YPs), + YMax is Z - 1, + domain_remove_greater_than(YD, YMax, YD1) }, + fd_put(Y, YD1, YPs) + ; Z =:= 0 -> kill(MState), queue_goal(X / Y #= _) + ) + ; ( { fd_get(Z, _, n(ZL), _, _), ZL > 0 } -> + { fd_get(Y, YD, YPs), + YMin is ZL + 1, + domain_remove_smaller_than(YD, YMin, YD1) }, + fd_put(Y, YD1, YPs) + % queue_goal(Y #> ZL) + ; { fd_get(Z, _, _, n(ZU), _), ZU < 0 } -> + { fd_get(Y, YD, YPs), + YMax is ZU - 1, + domain_remove_greater_than(YD, YMax, YD1) }, + fd_put(Y, YD1, YPs) + % queue_goal(Y #< ZU) + ; true + ) + ). + + %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% % Z = X rem Y diff --git a/src/lib/crypto.pl b/src/lib/crypto.pl index 5058658d..e88113c7 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. @@ -279,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), @@ -412,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) -> @@ -489,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_, @@ -530,13 +539,20 @@ crypto_data_encrypt(PlainText0, Algorithm, Key, IV, CipherText, Options) :- must_be_bytes(Tag, crypto_data_encrypt/6) ; true ), + option(aad(AAD0), Options, []), + encoding_chars(Encoding, AAD0, AAD), must_be_bytes(Key, crypto_data_encrypt/6), must_be_bytes(IV, crypto_data_encrypt/6), must_be(atom, Algorithm), ( Algorithm = 'chacha20-poly1305' -> true ; domain_error('chacha20-poly1305', Algorithm, crypto_data_encrypt/6) ), - '$crypto_data_encrypt'(PlainText, Encoding, Key, IV, Tag, CipherText). + algorithm_key_iv(Algorithm, Key, IV), + '$crypto_data_encrypt'(PlainText, AAD, Encoding, Key, IV, Tag, CipherText). + +algorithm_key_iv('chacha20-poly1305', Key, IV) :- + length(Key, 32), + length(IV, 12). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - crypto_data_decrypt(+CipherText, @@ -564,6 +580,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) :- @@ -573,16 +593,18 @@ crypto_data_decrypt(CipherText0, Algorithm, Key, IV, PlainText, Options) :- must_be_bytes(IV, crypto_data_decrypt/6), must_be(atom, Algorithm), option(encoding(Encoding), Options, utf8), + option(aad(AAD0), Options, []), + encoding_chars(Encoding, AAD0, AAD), must_be(atom, Encoding), member(Encoding, [utf8,octet]), - must_be(list, CipherText0), encoding_chars(octet, CipherText0, CipherText1), maplist(char_code, TagChars, Tag), append(CipherText1, TagChars, CipherText), ( Algorithm = 'chacha20-poly1305' -> true ; domain_error('chacha20-poly1305', Algorithm, crypto_data_decrypt/6) ), - '$crypto_data_decrypt'(CipherText, octet, Key, IV, Encoding, PlainText). + algorithm_key_iv(Algorithm, Key, IV), + '$crypto_data_decrypt'(CipherText, AAD, Key, IV, Encoding, PlainText). encoding_chars(octet, Bs, Cs) :- @@ -634,19 +656,73 @@ 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 + ========================================= + + 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) -> + 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 +739,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/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/lib/dif.pl b/src/lib/dif.pl index 347e9d13..bb92979a 100644 --- a/src/lib/dif.pl +++ b/src/lib/dif.pl @@ -38,15 +38,20 @@ 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]) --> - [dif(X, Y)], + ( { X \= Y } -> [] + ; [dif(X, Y)] + ), gather_dif_goals(Goals). attribute_goals(X) --> 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). 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. 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)). 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), 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_indices.rs b/src/machine/machine_indices.rs index 6407d3d1..13fb6ae7 100644 --- a/src/machine/machine_indices.rs +++ b/src/machine/machine_indices.rs @@ -272,18 +272,6 @@ impl Addr { &Addr::Float(f) => { Some(Constant::Float(f)) } - addr @ &Addr::PStrLocation(..) | addr @ &Addr::Lis(_) => { - let mut heap_pstr_iter = machine_st.heap_pstr_iter(*addr); - - 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)) } 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..1375cb65 100644 --- a/src/machine/streams.rs +++ b/src/machine/streams.rs @@ -11,8 +11,10 @@ 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,87 @@ 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 { +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 < 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) => { + 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 +195,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 +356,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 +487,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 +568,6 @@ impl Stream { pub(crate) fn is_stdin(&self) -> bool { match self.stream_inst.0.borrow().1 { - //StreamInstance::Stdin | StreamInstance::ReadlineStream(_) => { true } @@ -523,12 +597,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 +629,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 +783,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 +1007,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 +1169,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 +1195,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 +1225,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 5a1f9d53..da31e966 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; @@ -373,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; @@ -1027,20 +1136,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, @@ -1669,6 +1782,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!() } @@ -1694,6 +1813,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!() } @@ -2119,7 +2244,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); } @@ -2468,10 +2593,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(); @@ -3349,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!() @@ -3367,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()); @@ -3753,6 +3794,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!() } }; @@ -4473,16 +4520,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, ) { @@ -5387,23 +5428,13 @@ 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) => { - 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))))) } @@ -5426,7 +5457,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 } @@ -5441,27 +5472,19 @@ 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); 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 = 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() } @@ -5476,7 +5499,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 } @@ -5501,15 +5524,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(()); + } } } _ => { @@ -5529,11 +5557,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(); @@ -5541,7 +5571,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(()); } }; @@ -5554,29 +5584,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); @@ -5585,12 +5604,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 } @@ -5606,26 +5625,17 @@ 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!() } }; + 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) } @@ -5664,7 +5674,7 @@ impl MachineState { self.unify(self[temp_v!(1)], complete_string); } &SystemClauseType::Ed25519KeyPairPublicKey => { - let bytes = self.string_encoding_bytes(1, 2); + let bytes = self.string_encoding_bytes(1, "octet"); let key_pair = match signature::Ed25519KeyPair::from_pkcs8(&bytes) { Ok(kp) => { kp } @@ -5676,11 +5686,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, 2); - let data = self.string_encoding_bytes(3, 4); + let key = self.string_encoding_bytes(1, "octet"); + 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 } @@ -5692,13 +5703,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, 2); - let data = self.string_encoding_bytes(3, 4); + let key = self.string_encoding_bytes(1, "octet"); + 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) { @@ -5706,6 +5718,21 @@ 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 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); + } &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(); @@ -5747,32 +5774,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 @@ -5785,10 +5798,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); } @@ -5844,17 +5854,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!() } @@ -5862,9 +5869,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![]; @@ -5883,7 +5899,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); @@ -5920,9 +5939,6 @@ impl MachineState { self.heap.push(HeapCellValue::Addr(children)); result - } else { - let string = String::from(node.text().unwrap()); - self.heap.put_complete_string(&string) } } 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 803102bf..e468dfbd 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) => { @@ -157,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/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. 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]) ).