rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

flatten passage of cut point B in (,)/2, (->)/2 and (;)/2 (#685, #683)

Browse Source
This commit is contained in:
Mark Thom
2020-08-23 22:49:10 -03:00
parent cdeb07520f
commit d3ab4b5def
2 changed files with 104 additions and 54 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
Cargo.lock generated
View File

@@ -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",

156
src/lib/builtins.pl
View File

@@ -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.