From: Mark Thom Date: Sun, 11 Dec 2022 23:11:57 +0000 (-0700) Subject: fix mishandled if-then-else interpretation (#1659) X-Git-Tag: v0.9.2~251^2 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=refs%2Fremotes%2Forigin%2Finterpreting_disj;p=scryer-prolog.git fix mishandled if-then-else interpretation (#1659) --- diff --git a/build/instructions_template.rs b/build/instructions_template.rs index bc1ca703..8bc5d630 100644 --- a/build/instructions_template.rs +++ b/build/instructions_template.rs @@ -412,8 +412,6 @@ enum SystemClauseType { GetCurrentBlock, #[strum_discriminants(strum(props(Arity = "1", Name = "$get_cp")))] GetCutPoint, - #[strum_discriminants(strum(props(Arity = "1", Name = "$get_staggered_cp")))] - GetStaggeredCutPoint, #[strum_discriminants(strum(props(Arity = "1", Name = "$get_double_quotes")))] GetDoubleQuotes, #[strum_discriminants(strum(props(Arity = "1", Name = "$install_new_block")))] @@ -1688,7 +1686,6 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::CallGetBall(_) | &Instruction::CallGetCurrentBlock(_) | &Instruction::CallGetCutPoint(_) | - &Instruction::CallGetStaggeredCutPoint(_) | &Instruction::CallGetDoubleQuotes(_) | &Instruction::CallInstallNewBlock(_) | &Instruction::CallMaybe(_) | @@ -1902,7 +1899,6 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::ExecuteGetBall(_) | &Instruction::ExecuteGetCurrentBlock(_) | &Instruction::ExecuteGetCutPoint(_) | - &Instruction::ExecuteGetStaggeredCutPoint(_) | &Instruction::ExecuteGetDoubleQuotes(_) | &Instruction::ExecuteInstallNewBlock(_) | &Instruction::ExecuteMaybe(_) | diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl index 1d2d0aed..11a76238 100644 --- a/src/lib/builtins.pl +++ b/src/lib/builtins.pl @@ -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([]). diff --git a/src/machine/dispatch.rs b/src/machine/dispatch.rs index ee57a83e..c9db5966 100644 --- a/src/machine/dispatch.rs +++ b/src/machine/dispatch.rs @@ -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); diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 275c0ce7..be24526e 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -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);