greatly reduce the number of goal expansions done in callable if/then/else

diff --git a/src/clause_types.rs b/src/clause_types.rs
index e7c2c8534890867db76853585a2359d22c80df45..d3ba917c0916474f163c06500327825e032a4387 100644 (file)
--- a/src/clause_types.rs
+++ b/src/clause_types.rs
@@ -284,6 +284,7 @@ pub enum SystemClauseType {
     GetBall,
     GetCurrentBlock,
     GetCutPoint,
+    GetStaggeredCutPoint,
     GetDoubleQuotes,
     InstallNewBlock,
     Maybe,
@@ -525,6 +526,7 @@ impl SystemClauseType {
             &SystemClauseType::Fail => atom!("$fail"),
             &SystemClauseType::GetBall => atom!("$get_ball"),
             &SystemClauseType::GetCutPoint => atom!("$get_cp"),
+            &SystemClauseType::GetStaggeredCutPoint => atom!("$get_staggered_cp"),
             &SystemClauseType::GetCurrentBlock => atom!("$get_current_block"),
             &SystemClauseType::InstallNewBlock => atom!("$install_new_block"),
             &SystemClauseType::NextEP => atom!("$nextEP"),
@@ -705,6 +707,7 @@ impl SystemClauseType {
             (atom!("$get_cont_chunk"), 3) => Some(SystemClauseType::GetContinuationChunk),
             (atom!("$get_current_block"), 1) => Some(SystemClauseType::GetCurrentBlock),
             (atom!("$get_cp"), 1) => Some(SystemClauseType::GetCutPoint),
+            (atom!("$get_staggered_cp"), 1) => Some(SystemClauseType::GetStaggeredCutPoint),
             (atom!("$install_new_block"), 1) => Some(SystemClauseType::InstallNewBlock),
             (atom!("$quoted_token"), 1) => Some(SystemClauseType::QuotedToken),
             (atom!("$nextEP"), 3) => Some(SystemClauseType::NextEP),

diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl
index 0c9d33f9b78f83b9811ee384cfd870942521ebf6..534edb06d750921780116f6750fe0b3843029458 100644 (file)
--- a/src/lib/builtins.pl
+++ b/src/lib/builtins.pl
@@ -1,4 +1,4 @@
-:- module(builtins, [(=)/2, (\=)/2, (\+)/1, (',')/2, (->)/2, (;)/2,
+:- module(builtins, [(=)/2, (\=)/2, (\+)/1, !/0, (',')/2, (->)/2, (;)/2,
                      (=..)/2, (:)/2, (:)/3, (:)/4, (:)/5, (:)/6,
                      (:)/7, (:)/8, (:)/9, (:)/10, (:)/11, (:)/12,
                      abolish/1, asserta/1, assertz/1,
@@ -61,10 +61,8 @@ call(G, A, B, C, D, E, F, G, H) :- '$call'(G, A, B, C, D, E, F, G, H).
 
 
 Module : Predicate :-
-    ( atom(Module) ->
-      '$module_call'(Module, Predicate)
-    ;
-      throw(error(type_error(atom, Module), (:)/2))
+    ( atom(Module) -> '$module_call'(Module, Predicate)
+    ; throw(error(type_error(atom, Module), (:)/2))
     ).
 
 
@@ -205,142 +203,115 @@ repeat.
 repeat :- repeat.
 
 
+:- meta_predicate ','(0,0).
 
-:- meta_predicate ','(0, 0).
-
-:- meta_predicate ','(0, +, +).
-
-:- meta_predicate ;(0, 0).
-
-:- meta_predicate ;(0, 0, +).
-
-:- meta_predicate ->(0, 0).
-
-:- meta_predicate ->(0, 0, +).
-
-
-','(G1, G2) :-
-    '$get_b_value'(B),
-    (  '$call_with_default_policy'(var(G1)) ->
-       throw(error(instantiation_error, (',')/2))
-    ;  '$call_with_default_policy'(','(G1, G2, B))
-    ).
-
-
-';'(G1, G2) :-
-    '$get_b_value'(B),
-    (  '$call_with_default_policy'(var(G1)) ->
-       throw(error(instantiation_error, (';')/2))
-    ;  '$call_with_default_policy'(';'(G1, G2, B))
-    ).
-
-
-G1 -> G2 :-
-    '$get_b_value'(B),
-    (  '$call_with_default_policy'(var(G1)) ->
-       throw(error(instantiation_error, (->)/2))
-    ;  '$call_with_default_policy'(->(G1, G2, B))
-    ).
-
-
-:-non_counted_backtracking call_or_cut/3.
-
-call_or_cut(G, B, ErrorPI) :-
-    (  '$call_with_default_policy'(var(G)) ->
-       throw(error(instantiation_error, ErrorPI))
-    ;  '$call_with_default_policy'(call_or_cut(G, B))
-    ).
-
-
-:- non_counted_backtracking control_functor/1.
-
-control_functor(_:G) :- nonvar(G), control_functor(G).
-control_functor(call(_:C)) :- C == !.
-control_functor(!).
-control_functor((_,_)).
-control_functor((_;_)).
-control_functor((_->_)).
-
-
-:- non_counted_backtracking call_or_cut/2.
+:- meta_predicate ;(0,0).
 
-call_or_cut(G, B) :-
-    (  nonvar(G),
-       '$call_with_default_policy'(control_functor(G)) ->
-       '$call_with_default_policy'(call_or_cut_interp(G, B))
-    ;  call(G)
-    ).
+:- meta_predicate ->(0,0).
 
+% '!' is for internal use as a callable no-op within if/then/else.
+% Where it shouldn't be a no-op, it's interpreted under the expected
+% semantics by comma_dispatch/3.
 
-:- non_counted_backtracking call_or_cut_interp/2.
+! :- '$get_staggered_cp'(B), '$set_cp'(B).
 
-call_or_cut_interp(_ : G, B) :-
-    call_or_cut_interp(G, B).
-call_or_cut_interp(call(_ : !), B) :-
-    !. % '$set_cp'(B).
-call_or_cut_interp(!, B) :-
-    '$set_cp'(B).
-call_or_cut_interp((G1, G2), B) :-
-    '$call_with_default_policy'(','(G1, G2, B)).
-call_or_cut_interp((G1 ; G2), B) :-
-    '$call_with_default_policy'(';'(G1, G2, B)).
-call_or_cut_interp((G1 -> G2), B) :-
-    '$call_with_default_policy'(->(G1, G2, B)).
+G1 -> G2 :- '$get_staggered_cp'(B), call('$call'(G1)), '$set_cp'(B), call('$call'(G2)).
 
+G ; _ :- call('$call'(G)).
+_ ; G :- call('$call'(G)).
 
-:- non_counted_backtracking (',')/3.
+','(G1, G2) :- '$get_staggered_cp'(B), comma_dispatch(G1,G2,B).
 
-','(G1, G2, B) :-
-    (  nonvar(G1),
-       '$call_with_default_policy'(control_functor(G1)) ->
-       '$call_with_default_policy'(call_or_cut_interp(G1, B)),
-       '$call_with_default_policy'(call_or_cut(G2, B, (',')/2))
-    ;  call(G1),
-       '$call_with_default_policy'(call_or_cut(G2, B, (',')/2))
-    ).
+set_cp(B) :- '$set_cp'(B).
 
-:- non_counted_backtracking (;)/3.
+:- non_counted_backtracking comma_dispatch_prep/3.
 
-';'(G1, G2, B) :-
-    (  nonvar(G1),
-       '$call_with_default_policy'(control_functor(G1)) ->
-       '$call_with_default_policy'(';-interp'(G1, G2, B))
-    ;  call(G1)
-    ;  '$call_with_default_policy'(call_or_cut(G2, B, (;)/2))
+comma_dispatch_prep(Gs, B, [Cont|Conts]) :-
+    (  callable(Gs) ->
+       (  functor(Gs, ',', 2) ->
+          arg(1, Gs, G1),
+          arg(2, Gs, G2),
+          (  G1 == ! ->
+             Cont = builtins:set_cp(B)
+          ;  callable(G1) ->
+             Cont = G1
+          ;  Cont = throw(error(type_error(callable, G1), call/1))
+          ),
+          comma_dispatch_prep(G2, B, Conts)
+       ;  Cont = Gs,
+          Conts = []
+       )
+    ;  Gs == ! ->
+       Cont = builtins:set_cp(B),
+       Conts = []
+    ;  Cont = throw(error(type_error(callable, Gs), call/1)),
+       Conts = []
     ).
 
 
-:- non_counted_backtracking ';-interp'/3.
+:- non_counted_backtracking comma_dispatch_call_list/1.
 
-';-interp'((G1 -> G2), G3, B) :-
+comma_dispatch_call_list([]).
+comma_dispatch_call_list([G1,G2,G3,G4,G5,G6,G7,G8|Gs]) :-
     !,
-    (  '$call_with_default_policy'(call_or_cut(G1, B, (->)/2)) ->
-       '$call_with_default_policy'(call_or_cut(G2, B, (->)/2))
-    ;  '$call_with_default_policy'(call_or_cut(G3, B, (;)/2))
-    ).
-';-interp'(_:(G1 -> G2), G3, B) :-
+    '$call'(G1),
+    '$call'(G2),
+    '$call'(G3),
+    '$call'(G4),
+    '$call'(G5),
+    '$call'(G6),
+    '$call'(G7),
+    '$call'(G8),
+    comma_dispatch_call_list(Gs).
+comma_dispatch_call_list([G1,G2,G3,G4,G5,G6,G7]) :-
     !,
-    (  '$call_with_default_policy'(call_or_cut(G1, B, (->)/2)) ->
-       '$call_with_default_policy'(call_or_cut(G2, B, (->)/2))
-    ;  '$call_with_default_policy'(call_or_cut(G3, B, (;)/2))
-    ).
-';-interp'(G1, G2, B) :-
-    (  '$call_with_default_policy'(call_or_cut_interp(G1, B))
-    ;  '$call_with_default_policy'(call_or_cut(G2, B, (;)/2))
-    ).
+    '$call'(G1),
+    '$call'(G2),
+    '$call'(G3),
+    '$call'(G4),
+    '$call'(G5),
+    '$call'(G6),
+    '$call'(G7).
+comma_dispatch_call_list([G1,G2,G3,G4,G5,G6]) :-
+    !,
+    '$call'(G1),
+    '$call'(G2),
+    '$call'(G3),
+    '$call'(G4),
+    '$call'(G5),
+    '$call'(G6).
+comma_dispatch_call_list([G1,G2,G3,G4,G5]) :-
+    !,
+    '$call'(G1),
+    '$call'(G2),
+    '$call'(G3),
+    '$call'(G4),
+    '$call'(G5).
+comma_dispatch_call_list([G1,G2,G3,G4]) :-
+    !,
+    '$call'(G1),
+    '$call'(G2),
+    '$call'(G3),
+    '$call'(G4).
+comma_dispatch_call_list([G1,G2,G3]) :-
+    !,
+    '$call'(G1),
+    '$call'(G2),
+    '$call'(G3).
+comma_dispatch_call_list([G1,G2]) :-
+    !,
+    '$call'(G1),
+    '$call'(G2).
+comma_dispatch_call_list([G1]) :-
+    '$call'(G1).
 
 
-:- non_counted_backtracking (->)/3.
+:- non_counted_backtracking comma_dispatch/3.
+
+comma_dispatch(G1, G2, B) :-
+    comma_dispatch_prep((G1, G2), B, Conts),
+    comma_dispatch_call_list(Conts).
 
-->(G1, G2, B) :-
-    (  nonvar(G1),
-       '$call_with_default_policy'(control_functor(G1)) ->
-       (  '$call_with_default_policy'(call_or_cut_interp(G1, B)) ->
-          '$call_with_default_policy'(call_or_cut(G2, B, (->)/2))
-       )
-    ;  call(G1) ->
-       '$call_with_default_policy'(call_or_cut(G2, B, (->)/2))
-    ).
 
 % univ.
 

diff --git a/src/loader.pl b/src/loader.pl
index 722d413a96bb97e4c86cea981769b8e5e8ee9dfc..87d758be4fd9073ad03538493d6a145e7dd67e09 100644 (file)
--- a/src/loader.pl
+++ b/src/loader.pl
@@ -629,6 +629,8 @@ expand_module_name(ESG0, M, ESG) :-
        ESG = M:ESG0
     ;  ESG0 = _:_ ->
        ESG = ESG0
+    ;  predicate_property(ESG0, built_in) ->
+       ESG = ESG0
     ;  ESG = M:ESG0
     ).
 
@@ -656,7 +658,8 @@ expand_module_names(Goals, MetaSpecs, Module, ExpandedGoals, HeadVars) :-
     (  GoalFunctor == (:),
        SubGoals = [M, SubGoal] ->
        expand_module_names(SubGoal, MetaSpecs, M, ExpandedSubGoal, HeadVars),
-       ExpandedGoals = M:ExpandedSubGoal
+       expand_module_name(ExpandedSubGoal, M, ExpandedGoals)
+       % ExpandedGoals = M:ExpandedSubGoal
     ;  expand_meta_predicate_subgoals(SubGoals, MetaSpecs, Module, ExpandedGoalList, HeadVars),
        ExpandedGoals =.. [GoalFunctor | ExpandedGoalList]
     ).

diff --git a/src/machine/machine_state_impl.rs b/src/machine/machine_state_impl.rs
index 8f4dc44dc35235f3879d612f1e049a4e74846a26..89dd42697c7e57681176b3c65d268d1f95405651 100644 (file)
--- a/src/machine/machine_state_impl.rs
+++ b/src/machine/machine_state_impl.rs
@@ -202,9 +202,9 @@ impl MachineState {
                 RefTag::HeapCell => {
                     self.heap[r1.get_value() as usize] = t2;
                 }
-               RefTag::AttrVar => {
-                   self.bind_attr_var(r1.get_value() as usize, t2);
-               }
+                RefTag::AttrVar => {
+                    self.bind_attr_var(r1.get_value() as usize, t2);
+                }
             };
 
             self.trail(TrailRef::Ref(r1));
@@ -1457,7 +1457,7 @@ impl MachineState {
             let order_cat_v2 = v2.order_category();
 
             if order_cat_v1 != order_cat_v2 {
-                       self.pdl.clear();
+                self.pdl.clear();
                 return Some(order_cat_v1.cmp(&order_cat_v2));
             }
 
@@ -1467,7 +1467,7 @@ impl MachineState {
                     let v2 = v2.as_var().unwrap();
 
                     if v1 != v2 {
-                                   self.pdl.clear();
+                        self.pdl.clear();
                         return Some(v1.cmp(&v2));
                     }
                 }
@@ -1476,7 +1476,7 @@ impl MachineState {
                     let v2 = cell_as_f64_ptr!(v2);
 
                     if v1 != v2 {
-                                   self.pdl.clear();
+                        self.pdl.clear();
                         return Some(v1.cmp(&v2));
                     }
                 }
@@ -1485,7 +1485,7 @@ impl MachineState {
                     let v2 = Number::try_from(v2).unwrap();
 
                     if v1 != v2 {
-                                   self.pdl.clear();
+                        self.pdl.clear();
                         return Some(v1.cmp(&v2));
                     }
                 }
@@ -1495,18 +1495,18 @@ impl MachineState {
                             read_heap_cell!(v2,
                                 (HeapCellValueTag::Atom, (n2, _a2)) => {
                                     if n1 != n2 {
-                                                           self.pdl.clear();
+                                        self.pdl.clear();
                                         return Some(n1.cmp(&n2));
                                     }
                                 }
                                 (HeapCellValueTag::Char, c2) => {
                                     if let Some(c1) = n1.as_char() {
                                         if c1 != c2 {
-                                                               self.pdl.clear();
+                                            self.pdl.clear();
                                             return Some(c1.cmp(&c2));
                                         }
                                     } else {
-                                                           self.pdl.clear();
+                                        self.pdl.clear();
                                         return Some(Ordering::Greater);
                                     }
                                 }
@@ -1520,17 +1520,17 @@ impl MachineState {
                                 (HeapCellValueTag::Atom, (n2, _a2)) => {
                                     if let Some(c2) = n2.as_char() {
                                         if c1 != c2 {
-                                                               self.pdl.clear();
+                                            self.pdl.clear();
                                             return Some(c1.cmp(&c2));
                                         }
                                     } else {
-                                                           self.pdl.clear();
+                                        self.pdl.clear();
                                         return Some(Ordering::Less);
                                     }
                                 }
                                 (HeapCellValueTag::Char, c2) => {
                                     if c1 != c2 {
-                                                           self.pdl.clear();
+                                        self.pdl.clear();
                                         return Some(c1.cmp(&c2));
                                     }
                                 }
@@ -1634,7 +1634,7 @@ impl MachineState {
                                             self.heap.pop();
                                             self.heap.pop();
 
-                                                               self.pdl.clear();
+                                            self.pdl.clear();
 
                                             return Some(ordering);
                                         }
@@ -1675,7 +1675,7 @@ impl MachineState {
                                             self.pdl.push(self.heap[l1]);
                                         }
                                         ordering => {
-                                                               self.pdl.clear();
+                                            self.pdl.clear();
                                             return Some(ordering);
                                         }
                                     }
@@ -1698,7 +1698,7 @@ impl MachineState {
                                     self.heap.pop();
                                     self.heap.pop();
 
-                                                   self.pdl.clear();
+                                    self.pdl.clear();
 
                                     return Some(ordering);
                                 }
@@ -1730,7 +1730,7 @@ impl MachineState {
                                             }
                                         }
                                         ordering => {
-                                                               self.pdl.clear();
+                                            self.pdl.clear();
                                             return Some(ordering);
                                         }
                                     }
@@ -1754,7 +1754,7 @@ impl MachineState {
                                             self.pdl.push(self.heap[s1+2]);
                                         }
                                         ordering => {
-                                                               self.pdl.clear();
+                                            self.pdl.clear();
                                             return Some(ordering);
                                         }
                                     }
@@ -1772,7 +1772,7 @@ impl MachineState {
                                             self.heap.pop();
                                             self.heap.pop();
 
-                                                               self.pdl.clear();
+                                            self.pdl.clear();
 
                                             return Some(ordering);
                                         }
@@ -1793,7 +1793,7 @@ impl MachineState {
                 }
                 None => {
                     if v1 != v2 {
-                                   self.pdl.clear();
+                        self.pdl.clear();
                         return None;
                     }
                 }
@@ -1873,8 +1873,8 @@ impl MachineState {
                         None => unreachable!(),
                     }
                 }
-               TrailEntryTag::TrailedAttachedValue => {
-               }
+        TrailEntryTag::TrailedAttachedValue => {
+        }
             }
         }
     }
@@ -3307,11 +3307,11 @@ impl MachineState {
             self.heap.push(atom_as_cell!(name, arity));
 
             for i in 0..arity {
-               self.heap.push(heap_loc_as_cell!(h + i + 1));
-           }
+        self.heap.push(heap_loc_as_cell!(h + i + 1));
+        }
 
             str_loc_as_cell!(h)
-       };
+    };
 
         (self.bind_fn)(self, r, f_a);
     }
@@ -3441,10 +3441,10 @@ impl MachineState {
                     Err(self.error_form(err, stub_gen()))
                 }
             }
-           (HeapCellValueTag::CStr, cstr_atom) => {
-               let cstr = cstr_atom.as_str();
-               Ok(cstr.chars().map(|c| char_as_cell!(c)).collect())            
-           }
+            (HeapCellValueTag::CStr, cstr_atom) => {
+                let cstr = cstr_atom.as_str();
+                Ok(cstr.chars().map(|c| char_as_cell!(c)).collect())
+            }
             _ => {
                 let err = self.type_error(ValidType::List, store_v);
                 Err(self.error_form(err, stub_gen()))

diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs
index 9f3dd089539ffc0a3bea7fdd9ee9e47fdab726d6..7b85f2c4f5d6fd6b6d555516d1b2333d2ba7c13a 100644 (file)
--- a/src/machine/system_calls.rs
+++ b/src/machine/system_calls.rs
@@ -3580,6 +3580,54 @@ impl MachineState {
                 let n = Fixnum::build_with(i64::try_from(self.b0).unwrap());
                 self.unify_fixnum(n, self.registers[1]);
             }
+            &SystemClauseType::GetStaggeredCutPoint => {
+                use std::sync::Once;
+
+                let b = self.store(self.deref(self.registers[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(|| {
+                        match indices.code_dir.get(&(atom!(";"), 2)).map(|cell| cell.get()) {
+                            Some(IndexPtr::Index(p)) => {
+                                match code_repo.code[p] {
+                                    Line::Choice(ChoiceInstruction::TryMeElse(o)) => {
+                                        SEMICOLON_SECOND_BRANCH_LOC = p + o;
+                                    }
+                                    _ => {
+                                        unreachable!();
+                                    }
+                                }
+                            }
+                            _ => {
+                                unreachable!();
+                            }
+                        }
+                    });
+
+                    LocalCodePtr::DirEntry(SEMICOLON_SECOND_BRANCH_LOC)
+                };
+
+                let staggered_b0 = if self.b > 0 {
+                    let or_frame = self.stack.index_or_frame(self.b);
+
+                    if or_frame.prelude.bp == semicolon_second_clause_p {
+                        or_frame.prelude.b0
+                    } else {
+                        self.b0
+                    }
+                } else {
+                    self.b0
+                };
+
+                let staggered_b0 = integer_as_cell!(
+                    Number::arena_from(staggered_b0, &mut self.arena)
+                );
+
+                self.bind(b.as_var().unwrap(), staggered_b0);
+            }
             &SystemClauseType::InstallNewBlock => {
                 self.install_new_block(self.registers[1]);
             }