From d3ab4b5def3f9722d4f09f956757aaec5fd6427b Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sun, 23 Aug 2020 22:49:10 -0300 Subject: [PATCH] flatten passage of cut point B in (,)/2, (->)/2 and (;)/2 (#685, #683) --- Cargo.lock | 2 + src/lib/builtins.pl | 162 ++++++++++++++++++++++++++++---------------- 2 files changed, 107 insertions(+), 57 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)) + ). + -:- 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) :- '$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) +';'(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. +','((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)). + + :- non_counted_backtracking (;)/3. -;(G1, G4, B) :- - ( ( G1 = (_ -> _) - ; G1 = (_ , _) - ; G1 = (_ ; _) - ) -> - !, - semicolon_compound_selector(G1, G4, B) - ). -;(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)). +';'((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)) + ). + :- 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. -- 2.54.0