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

Merge branch 'master' of http://github.com/mthom/rusty-wam

Browse Source
This commit is contained in:
Mark Thom
2018-09-06 16:34:46 -06:00
parent d1ec089405 6d0ddc1183
commit f35bbeb35e
1 changed files with 13 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
src/prolog/lib/builtins.pl
View File

@@ -128,31 +128,34 @@ comma_errors(G1, G2, B) :- var(G1), throw(error(instantiation_error, (,)/2)).
comma_errors(G1, G2, B) :- '$call_with_default_policy'(','(G1, G2, B)).
:- non_counted_backtracking (,)/3.
','(!, CF, B) :- '$set_cp'(B), compound(CF),
'$call_with_default_policy'(CF =.. [',', G1, G2]),
','(!, 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), G.
','(G, CF, B) :- compound(CF),
'$call_with_default_policy'(CF =.. [',', G1, G2]), !, G,
'$call_with_default_policy'(comma_errors(G1, G2, B)).
'$call_with_default_policy'(CF = ','(G1, G2)), !, G,
'$call_with_default_policy'(comma_errors(G1, G2, B)).
','(G, Atom, B) :- Atom == !, !, G, '$set_cp'(B).
','(G1, G2, _) :- G1, G2.
;(G1, G2) :- '$get_b_value'(B), ;(G1, G2, B).
:- non_counted_backtracking (;)/3.
;(G1, G4, B) :- compound(G1), G1 = ->(G2, G3), (G2 -> G3 ; '$set_cp'(B), G4).
;(G1, G2, B) :- G1 == !, '$set_cp'(B), call(G2).
;(G1, G2, B) :- G2 == !, call(G2), '$set_cp'(B).
;(G1, G4, B) :- compound(G1),
'$call_with_default_policy'(G1 = ->(G2, G3)),
(G2 -> G3 ; '$set_cp'(B), G4).
;(G1, G2, B) :- G1 == !, '$set_cp'(B), G2.
;(G1, G2, B) :- G2 == !, G1, '$set_cp'(B).
;(G, _, _) :- G.
;(_, G, _) :- G.
G1 -> G2 :- '$get_b_value'(B), ->(G1, G2, B).
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, B) :- G2 == !, G1, '$set_cp'(B).
->(G1, G2, B) :- G1, '$set_cp'(B), G2.
% univ.