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

Merge pull request #1662 from mthom/interpreting_disj

Browse Source 
Fix mishandled if-then-else interpretation (#1659)
This commit is contained in:
Mark Thom
2022-12-16 04:36:02 +01:00
committed by GitHub
parent a5054c0064 4dc0114c52
commit b4b72a3166
4 changed files with 37 additions and 109 deletions
Download Patch File Download Diff File Expand all files Collapse all files

78
src/lib/builtins.pl
View File

@@ -158,9 +158,8 @@ G1 -> G2 :- control_entry_point((G1 -> G2)).
:- non_counted_backtracking staggered_if_then/2.
staggered_if_then(G1, G2) :-
'$get_staggered_cp'(B),
call(G1),
'$set_cp'(B),
!,
call(G2).
G1 ; G2 :- control_entry_point((G1 ; G2)).
@@ -168,10 +167,16 @@ G1 ; G2 :- control_entry_point((G1 ; G2)).
:- non_counted_backtracking staggered_sc/2.
staggered_sc(G, _) :- call(G).
staggered_sc(G, _) :-
( nonvar(G),
G = '$call'(builtins:staggered_if_then(G1, G2)) ->
call(G1),
!,
call(G2)
; call(G)
).
staggered_sc(_, G) :- call(G).
!.
:- non_counted_backtracking set_cp/1.
@@ -180,6 +185,7 @@ set_cp(B) :- '$set_cp'(B).
','(G1, G2) :- control_entry_point((G1, G2)).
:- non_counted_backtracking control_entry_point/1.
control_entry_point(G) :-
@@ -203,47 +209,15 @@ cont_list_goal([Cont], Cont) :- !.
cont_list_goal(Conts, '$call'(builtins:dispatch_call_list(Conts))).
:- non_counted_backtracking module_qualified_cut/1.
module_qualified_cut(Gs) :-
( functor(Gs, call, 1) ->
arg(1, Gs, G1)
; Gs = G1
),
functor(G1, (:), 2),
arg(2, G1, G2),
G2 == !.
:- non_counted_backtracking dispatch_prep/3.
dispatch_prep(Gs, B, [Cont|Conts]) :-
( callable(Gs) ->
( functor(Gs, ',', 2) ->
arg(1, Gs, G1),
arg(2, Gs, G2),
dispatch_prep(G1, B, IConts1),
cont_list_goal(IConts1, Cont),
dispatch_prep(G2, B, Conts)
; functor(Gs, ';', 2) ->
arg(1, Gs, G1),
arg(2, Gs, G2),
dispatch_prep(G1, B, IConts0),
dispatch_prep(G2, B, IConts1),
cont_list_goal(IConts0, Cont0),
cont_list_goal(IConts1, Cont1),
Cont = '$call'(builtins:staggered_sc(Cont0, Cont1)),
Conts = []
; functor(Gs, ->, 2) ->
arg(1, Gs, G1),
arg(2, Gs, G2),
dispatch_prep(G1, B, IConts1),
dispatch_prep(G2, B, IConts2),
cont_list_goal(IConts1, Cont1),
cont_list_goal(IConts2, Cont2),
Cont = '$call'(builtins:staggered_if_then(Cont1, Cont2)),
Conts = []
; ( Gs == ! ; module_qualified_cut(Gs) ) ->
strip_module(Gs, M, Gs0),
( nonvar(Gs0),
dispatch_prep_(Gs0, B, [Cont|Conts]) ->
true
; Gs0 == ! ->
Cont = '$call'(builtins:set_cp(B)),
Conts = []
; Cont = Gs,
@@ -256,6 +230,28 @@ dispatch_prep(Gs, B, [Cont|Conts]) :-
).
:- non_counted_backtracking dispatch_prep_/3.
dispatch_prep_((G1, G2), B, [Cont|Conts]) :-
dispatch_prep(G1, B, IConts1),
cont_list_goal(IConts1, Cont),
dispatch_prep(G2, B, Conts).
dispatch_prep_((G1 ; G2), B, [Cont|Conts]) :-
dispatch_prep(G1, B, IConts0),
dispatch_prep(G2, B, IConts1),
cont_list_goal(IConts0, Cont0),
cont_list_goal(IConts1, Cont1),
Cont = '$call'(builtins:staggered_sc(Cont0, Cont1)),
Conts = [].
dispatch_prep_((G1 -> G2), B, [Cont|Conts]) :-
dispatch_prep(G1, B, IConts1),
dispatch_prep(G2, B, IConts2),
cont_list_goal(IConts1, Cont1),
cont_list_goal(IConts2, Cont2),
Cont = '$call'(builtins:staggered_if_then(Cont1, Cont2)),
Conts = [].
:- non_counted_backtracking dispatch_call_list/1.
dispatch_call_list([]).

8
src/machine/dispatch.rs
View File

@@ -4152,14 +4152,6 @@ impl Machine {
self.get_cut_point();
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallGetStaggeredCutPoint(_) => {
self.get_staggered_cut_point();
step_or_fail!(self, self.machine_st.p += 1);
}
&Instruction::ExecuteGetStaggeredCutPoint(_) => {
self.get_staggered_cut_point();
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallGetDoubleQuotes(_) => {
self.get_double_quotes();
step_or_fail!(self, self.machine_st.p += 1);

56
src/machine/system_calls.rs
View File

@@ -4850,62 +4850,6 @@ impl Machine {
self.machine_st.unify_fixnum(n, self.machine_st.registers[1]);
}
#[inline(always)]
pub(crate) fn get_staggered_cut_point(&mut self) {
use std::sync::Once;
let b = self.deref_register(1);
static mut SEMICOLON_SECOND_BRANCH_LOC: usize = 0;
static LOC_INIT: Once = Once::new();
let semicolon_second_clause_p = unsafe {
LOC_INIT.call_once(|| {
if let Some(builtins) = self.indices.modules.get(&atom!("builtins")) {
match builtins.code_dir.get(&(atom!("staggered_sc"), 2)).map(|cell| cell.get()) {
Some(ip) if ip.tag() == IndexPtrTag::Index => {
let p = ip.p() as usize;
match &self.code[p] {
&Instruction::TryMeElse(o) => {
SEMICOLON_SECOND_BRANCH_LOC = p + o;
}
_ => {
unreachable!();
}
}
}
_ => {
unreachable!();
}
}
} else {
unreachable!();
}
});
SEMICOLON_SECOND_BRANCH_LOC
};
let staggered_b0 = if self.machine_st.b > 0 {
let or_frame = self.machine_st.stack.index_or_frame(self.machine_st.b);
if or_frame.prelude.bp == semicolon_second_clause_p {
or_frame.prelude.b0
} else {
self.machine_st.b0
}
} else {
self.machine_st.b0
};
let staggered_b0 = integer_as_cell!(
Number::arena_from(staggered_b0, &mut self.machine_st.arena)
);
self.machine_st.bind(b.as_var().unwrap(), staggered_b0);
}
#[inline(always)]
pub(crate) fn next_ep(&mut self) {
let first_arg = self.deref_register(1);