fix mishandled if-then-else interpretation (#1659)

diff --git a/build/instructions_template.rs b/build/instructions_template.rs
index bc1ca7030b4f3dc5d4a5ea1307f3f2c88d0a89ef..8bc5d6309fa0f17f52277c3b8d5c4a516d163d2b 100644 (file)
--- 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 1d2d0aed670b2fc2cf2cd9f5c65a0bcb22d7dfee..11a7623838056c12ac63e5edd181f93f73b05371 100644 (file)
--- 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 ee57a83ef86def43da17e4d73075a281a236097d..c9db5966c86a9fbc501d76b9cc4f1250fbd2c047 100644 (file)
--- 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 275c0ce79ccd3998548bf5e8974221c7eff6c701..be24526e866321d74c3c50f631a94390cf6f2231 100644 (file)
--- 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);