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

check for control functors (,/;/->) before jumping to internal interpretation (#815)

Browse Source
This commit is contained in:
Mark Thom
2021-02-09 16:40:25 -07:00
parent 547c63b28e
commit 4d29a3ae3c
2 changed files with 20 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

28
src/lib/builtins.pl
View File

@@ -243,18 +243,26 @@ call_or_cut(G, B, ErrorPI) :-
). ).
:- non_counted_backtracking control_functor/1.
control_functor(!).
control_functor((_,_)).
control_functor((_;_)).
control_functor((_->_)).
:- non_counted_backtracking call_or_cut/2. :- non_counted_backtracking call_or_cut/2.
call_or_cut(M:G, B) :- call_or_cut(M:G, B) :-
!, !,
( nonvar(G), ( nonvar(G),
'$call_with_default_policy'(call_or_cut_interp(G, B)) -> '$call_with_default_policy'(control_functor(G)) ->
true '$call_with_default_policy'(call_or_cut_interp(G, B))
; call(M:G) ; call(M:G)
). ).
call_or_cut(G, B) :- call_or_cut(G, B) :-
( '$call_with_default_policy'(call_or_cut_interp(G, B)) -> ( '$call_with_default_policy'(control_functor(G)) ->
true '$call_with_default_policy'(call_or_cut_interp(G, B))
; call(G) ; call(G)
). ).
@@ -276,8 +284,8 @@ call_or_cut_interp((G1 -> G2), B) :-
','(M:G1, G2, B) :- ','(M:G1, G2, B) :-
!, !,
( nonvar(G1), ( nonvar(G1),
'$call_with_default_policy'(',-interp'(G1, G2, B)) -> '$call_with_default_policy'(control_functor(G1)) ->
true '$call_with_default_policy'(',-interp'(G1, G2, B))
; call(M:G1), ; call(M:G1),
'$call_with_default_policy'(call_or_cut(G2, B, (',')/2)) '$call_with_default_policy'(call_or_cut(G2, B, (',')/2))
). ).
@@ -304,8 +312,8 @@ call_or_cut_interp((G1 -> G2), B) :-
';'(M:G1, G2, B) :- ';'(M:G1, G2, B) :-
!, !,
( nonvar(G1), ( nonvar(G1),
'$call_with_default_policy'(';-interp'(G1, G2, B)) -> '$call_with_default_policy'(control_functor(G1)) ->
true '$call_with_default_policy'(';-interp'(G1, G2, B))
; call(M:G1) ; call(M:G1)
; '$call_with_default_policy'(call_or_cut(G2, B, (;)/2)) ; '$call_with_default_policy'(call_or_cut(G2, B, (;)/2))
). ).
@@ -337,8 +345,8 @@ call_or_cut_interp((G1 -> G2), B) :-
->(M:G1, G2, B) :- ->(M:G1, G2, B) :-
!, !,
( nonvar(G1), ( nonvar(G1),
'$call_with_default_policy'('->-interp'(G1, G2, B)) -> '$call_with_default_policy'(control_functor(G1)) ->
true '$call_with_default_policy'('->-interp'(G1, G2, B))
; call(M:G1) -> ; call(M:G1) ->
'$call_with_default_policy'(call_or_cut(G2, B, (->)/2)) '$call_with_default_policy'(call_or_cut(G2, B, (->)/2))
). ).

4
src/loader.pl
View File

@@ -92,7 +92,7 @@ file_load(Stream, Path, Evacuable) :-
catch(loader:load_loop(Stream, Evacuable), catch(loader:load_loop(Stream, Evacuable),
E, E,
builtins:(loader:unload_evacuable(Evacuable), builtins:(loader:unload_evacuable(Evacuable),
builtins:throw(E))), builtins:throw(E))),
run_initialization_goals, run_initialization_goals,
'$pop_load_context'. '$pop_load_context'.
@@ -102,7 +102,7 @@ load(Stream) :-
catch(loader:load_loop(Stream, Evacuable), catch(loader:load_loop(Stream, Evacuable),
E, E,
builtins:(loader:unload_evacuable(Evacuable), builtins:(loader:unload_evacuable(Evacuable),
builtins:throw(E))), builtins:throw(E))),
run_initialization_goals, run_initialization_goals,
'$pop_load_context'. '$pop_load_context'.