restore setup_call_cleanup/3

README.md

@@ -29,7 +29,7 @@ Extend rusty-wam to include the following, among other features:
 * A revised, not-terrible module system (_done, I think_).
 * Built-in predicates for list processing and top-level declarative
   control (`setup_call_control/3`, `call_with_inference_limit/3`,
-  etc.) (NEEDS REVISION)
+  etc.) (_IN REVISION_)
 * Definite Clause Grammars
 * Attributed variables using the SICStus Prolog interface and
   semantics. Adding coroutines like `dif/2`, `freeze/2`, etc.
@@ -130,6 +130,7 @@ The following predicates are built-in to rusty-wam.
 * `atomic/1`
 * `between/3`
 * `call/1..62`
+* `call_cleanup/2`
 * `catch/3`
 * `compare/3`
 * `compound/1`
@@ -153,6 +154,7 @@ The following predicates are built-in to rusty-wam.
 * `repeat/0`
 * `reverse/2`
 * `select/3`
+* `setup_call_cleanup/3`
 * `sort/2`
 * `string/1`
 * `throw/1`

src/prolog/ast.rs

@@ -718,6 +718,7 @@ pub enum SystemClauseType {
     InstallNewBlock,
     ResetBlock,
     SetBall,
+    SetCutPointByDefault(RegType),
     SkipMaxList,
     Succeed,
     UnwindStack
@@ -751,6 +752,7 @@ impl SystemClauseType {
             &SystemClauseType::InstallNewBlock => clause_name!("$install_new_block"),
             &SystemClauseType::ResetBlock => clause_name!("$reset_block"),
             &SystemClauseType::SetBall => clause_name!("$set_ball"),
+            &SystemClauseType::SetCutPointByDefault(_) => clause_name!("$set_cp_by_default"),
             &SystemClauseType::SkipMaxList => clause_name!("$skip_max_list"),
             &SystemClauseType::Succeed => clause_name!("$succeed"),
             &SystemClauseType::UnwindStack => clause_name!("$unwind_stack"),
@@ -781,6 +783,7 @@ impl SystemClauseType {
             ("$install_new_block", 1) => Some(SystemClauseType::InstallNewBlock),
             ("$reset_block", 1) => Some(SystemClauseType::ResetBlock),
             ("$set_ball", 1) => Some(SystemClauseType::SetBall),
+            ("$set_cp_by_default", 1) => Some(SystemClauseType::SetCutPointByDefault(temp_v!(1))),
             ("$skip_max_list", 4) => Some(SystemClauseType::SkipMaxList),
             ("$unwind_stack", 0) => Some(SystemClauseType::UnwindStack),
             _ => None
@@ -1562,6 +1565,15 @@ impl CodeIndex {
 #[derive(Clone)]
 pub struct ModuleCodeIndex(pub IndexPtr, pub ClauseName);
 
+impl ModuleCodeIndex {
+    pub fn local(&self) -> Option<usize> {
+        match self.0 {
+            IndexPtr::Index(i) => Some(i),
+            _ => None
+        }
+    }
+}
+
 impl From<ModuleCodeIndex> for CodeIndex {
     fn from(value: ModuleCodeIndex) -> Self {
         CodeIndex(Rc::new(RefCell::new((value.0, value.1))))

src/prolog/compile.rs

@@ -202,7 +202,6 @@ impl<'a> ListingCompiler<'a> {
             self.wam.add_batched_ops(op_dir);
         }
     }
-
 }
 
 fn use_module(module: &mut Option<Module>, submodule: &Module, indices: &mut MachineCodeIndices)

src/prolog/lib/builtins.pl

@@ -5,7 +5,7 @@
 	(>>)/2, (mod)/2, (rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2,
 	(-)/1, (>=)/2, (=<)/2, (,)/2, (->)/2, (;)/2, (=..)/2, (==)/2,
 	(\==)/2, (@=<)/2, (@>=)/2, (@<)/2, (@>)/2, (=@=)/2, (\=@=)/2,
-	(:)/2, catch/3, throw/1, true/0, false/0]).
+	(:)/2, catch/3, setup_call_cleanup/3, throw/1, true/0, false/0]).
 
 % arithmetic operators.
 :- op(700, xfx, is).
@@ -149,10 +149,8 @@ univ_worker(Term, List, _) :-
 
 % setup_call_cleanup.
 
-/* past work on setup_call_cleanup.
+setup_call_cleanup(S, G, C) :- '$get_cp'(B),
-
+    S, '$set_cp_by_default'(B), '$get_current_block'(Bb),
-setup_call_cleanup(S, G, C) :-
-    S, !, '$get_current_block'(Bb),
     ( var(C) -> throw(error(instantiation_error, setup_call_cleanup/3))
     ; scc_helper(C, G, Bb) ).
 
@@ -168,17 +166,16 @@ scc_helper(_, _, _) :-
     run_cleaners_without_handling(Cp), false.
 
 run_cleaners_with_handling :-
-    '$get_scc_cleaner'(C), catch(C, _, true), !,
+    '$get_scc_cleaner'(C), '$get_level'(B), catch(C, _, true), '$set_cp_by_default'(B),
     run_cleaners_with_handling.
 run_cleaners_with_handling :-
     '$restore_cut_policy'.
 
 run_cleaners_without_handling(Cp) :-
-    '$get_scc_cleaner'(C), C, !, run_cleaners_without_handling(Cp).
+    '$get_scc_cleaner'(C), '$get_level'(B), C, '$set_cp_by_default'(B),
+    run_cleaners_without_handling(Cp).
 run_cleaners_without_handling(Cp) :-
-    '$set_cp'(Cp), '$restore_cut_policy'.
+    '$set_cp_by_default'(Cp), '$restore_cut_policy'.
-
-*/
 
 % exceptions.
 
@@ -190,7 +187,7 @@ catch(G,C,R,Bb) :- '$reset_block'(Bb), '$get_ball'(Ball), handle_ball(Ball, C, R
 end_block(Bb, NBb) :- '$clean_up_block'(NBb), '$reset_block'(Bb).
 end_block(Bb, NBb) :- '$reset_block'(NBb), '$fail'.
 
-handle_ball(Ball, C, R) :- Ball = C, !, '$erase_ball', call(R).
+handle_ball(Ball, C, R) :- Ball = C, '$get_level'(B), '$set_cp_by_default'(B), '$erase_ball', call(R).
 handle_ball(_, _, _) :- '$unwind_stack'.
 
 throw(Ball) :- '$set_ball'(Ball), '$unwind_stack'.

src/prolog/lib/control.pl

@@ -1,4 +1,4 @@
-:- module(control, [(\=)/2, (\+)/1, between/3, once/1, repeat/0]).
+:- module(control, [(\=)/2, (\+)/1, between/3, call_cleanup/2, once/1, repeat/0]).
 
 :- op(900, fy, \+).
 :- op(700, xfx, \=).
@@ -11,7 +11,7 @@ once(G) :- G, !.
 X \= X :- !, false.
 _ \= _.
 
-% call_cleanup(G, C) :- setup_call_cleanup(true, G, C).
+call_cleanup(G, C) :- setup_call_cleanup(true, G, C).
 
 between(Lower, Upper, Lower) :-
     Lower =< Upper.

src/prolog/machine/machine_state.rs

@@ -54,6 +54,30 @@ impl<'a> CodeDirs<'a> {
                 }
         }
     }
+
+    fn get_internal(&self, name: ClauseName, arity: usize, in_mod: ClauseName) -> Option<ModuleCodeIndex> {
+        self.modules.get(&in_mod)
+            .and_then(|ref module| module.code_dir.get(&(name, arity)))
+            .cloned()
+    }
+    
+    pub(super) fn get_cleaner_sites(&self) -> (usize, usize) {
+        let r_w_h  = clause_name!("run_cleaners_with_handling");
+        let r_wo_h = clause_name!("run_cleaners_without_handling");
+
+        let builtins = clause_name!("builtins");
+
+        let r_w_h  = self.get_internal(r_w_h, 0, builtins.clone()).and_then(|item| item.local());
+        let r_wo_h = self.get_internal(r_wo_h, 1, builtins).and_then(|item| item.local());
+
+        if let Some(r_w_h) = r_w_h {
+            if let Some(r_wo_h) = r_wo_h {
+                return (r_w_h, r_wo_h);
+            }
+        }
+
+        return (0, 0);
+    }
 }
 
 pub(super) struct DuplicateTerm<'a> {
@@ -502,7 +526,10 @@ pub(crate) trait CallPolicy: Any {
                         let addr = reader.machine_st[temp_v!(1)].clone();
                         reader.machine_st.unify(addr, Addr::HeapCell(offset));
                     },
-                    Err(err) => println!("{:?}", err)
+                    Err(err) => {
+                        println!("{:?}", err);
+                        reader.machine_st.fail = true;
+                    }
                 };
 
                 return_from_clause!(reader.machine_st.last_call, reader.machine_st)
@@ -749,7 +776,8 @@ impl CallWithInferenceLimitCallPolicy {
 }
 
 pub(crate) trait CutPolicy: Any {
-    fn cut(&mut self, &mut MachineState, RegType);
+    // returns true iff we fail or cut redirected the MachineState's p itself
+    fn cut(&mut self, &mut MachineState, RegType) -> bool;
 }
 
 downcast!(CutPolicy);
@@ -757,7 +785,7 @@ downcast!(CutPolicy);
 pub(crate) struct DefaultCutPolicy {}
 
 impl CutPolicy for DefaultCutPolicy {
-    fn cut(&mut self, machine_st: &mut MachineState, r: RegType) {
+    fn cut(&mut self, machine_st: &mut MachineState, r: RegType) -> bool {
         let b = machine_st.b;
 
         if let Addr::Con(Constant::Usize(b0)) = machine_st[r].clone() {
@@ -768,19 +796,23 @@ impl CutPolicy for DefaultCutPolicy {
             }
         } else {
             machine_st.fail = true;
-            return;
+            return true;
         }
+
+        false
     }
 }
 
 pub(crate) struct SCCCutPolicy {
     // locations of cleaners, cut points, the previous block
-    cont_pts: Vec<(Addr, usize, usize)>
+    cont_pts: Vec<(Addr, usize, usize)>,
+    r_c_w_h:  usize,
+    r_c_wo_h: usize
 }
 
 impl SCCCutPolicy {
-    pub(crate) fn new() -> Self {
+    pub(crate) fn new(r_c_w_h: usize, r_c_wo_h: usize) -> Self {
-        SCCCutPolicy { cont_pts: vec![] }
+        SCCCutPolicy { cont_pts: vec![], r_c_w_h, r_c_wo_h }
     }
 
     pub(crate) fn out_of_cont_pts(&self) -> bool {
@@ -794,10 +826,34 @@ impl SCCCutPolicy {
     pub(crate) fn pop_cont_pt(&mut self) -> Option<(Addr, usize, usize)> {
         self.cont_pts.pop()
     }
+
+    fn run_cleaners(&self, machine_st: &mut MachineState) -> bool {
+        if let Some(&(_, b_cutoff, prev_block)) = self.cont_pts.last() {
+            if machine_st.b < b_cutoff {
+                let builtins = clause_name!("builtins");
+                let (idx, arity) = if machine_st.block < prev_block {
+                    (self.r_c_w_h, 0)
+                } else {
+                    machine_st[temp_v!(1)] = Addr::Con(Constant::Usize(b_cutoff));
+                    (self.r_c_wo_h, 1)
+                };
+
+                if machine_st.last_call {
+                    execute_at_index(machine_st, builtins, arity, idx);
+                } else {
+                    call_at_index(machine_st, builtins, arity, idx);
+                }
+
+                return true;
+            }
+        }
+
+        false
+    }
 }
 
 impl CutPolicy for SCCCutPolicy {
-    fn cut(&mut self, machine_st: &mut MachineState, r: RegType) {
+    fn cut(&mut self, machine_st: &mut MachineState, r: RegType) -> bool {
         let b = machine_st.b;
 
         if let Addr::Con(Constant::Usize(b0)) = machine_st[r].clone() {
@@ -808,14 +864,9 @@ impl CutPolicy for SCCCutPolicy {
             }
         } else {
             machine_st.fail = true;
-            return;
+            return true;
         }
 
-        if let Some(&(_, b_cutoff, prev_block)) = self.cont_pts.last() {
+        self.run_cleaners(machine_st)            
-            if machine_st.b < b_cutoff {
-                machine_st.block = prev_block;
-                machine_st.unwind_stack();
-            }
-        }
     }
 }

src/prolog/machine/machine_state_impl.rs

@@ -1837,13 +1837,7 @@ impl MachineState {
             },
             &ControlInstruction::CallClause(ClauseType::System(ref ct), _, _, lco) => {
                 self.last_call = lco;
-                try_or_fail!(self, self.system_call(ct, call_policy, cut_policy));
+                try_or_fail!(self, self.system_call(ct, code_dirs, call_policy, cut_policy));
-
-                if self.last_call {
-                    self.p = CodePtr::Local(self.cp.clone());
-                } else {
-                    self.p += 1;
-                }
             },
             &ControlInstruction::Deallocate => self.deallocate(),
             &ControlInstruction::JmpBy(arity, offset, _, lco) => {
@@ -1959,8 +1953,7 @@ impl MachineState {
                 self.unify(a, b0);
                 self.p += 1;
             },
-            &CutInstruction::Cut(r) => {
+            &CutInstruction::Cut(r) => if !cut_policy.cut(self, r) {
-                cut_policy.cut(self, r);
                 self.p += 1;
             }
         }

src/prolog/machine/system_calls.rs

@@ -172,7 +172,16 @@ impl MachineState {
         self.block
     }
 
+    fn set_p(&mut self) {
+        if self.last_call {
+            self.p = CodePtr::Local(self.cp.clone());
+        } else {
+            self.p += 1;
+        }        
+    }
+    
     pub(super) fn system_call(&mut self, ct: &SystemClauseType,
+                              code_dirs: CodeDirs,
                               call_policy: &mut Box<CallPolicy>,
                               cut_policy:  &mut Box<CutPolicy>,)
                               -> CallResult
@@ -197,6 +206,8 @@ impl MachineState {
 
                                 if let Some(r) = dest.as_var() {
                                     self.bind(r, addr.clone());
+                                    self.set_p();
+                                    
                                     return Ok(());
                                 }
                             } else {
@@ -214,7 +225,8 @@ impl MachineState {
                 let prev_block = self.block;
 
                 if cut_policy.downcast_ref::<SCCCutPolicy>().is_err() {
-                    *cut_policy = Box::new(SCCCutPolicy::new());
+                    let (r_c_w_h, r_c_wo_h) = code_dirs.get_cleaner_sites();
+                    *cut_policy = Box::new(SCCCutPolicy::new(r_c_w_h, r_c_wo_h));
                 }
 
                 match cut_policy.downcast_mut::<SCCCutPolicy>().ok()
@@ -306,8 +318,13 @@ impl MachineState {
                     *cut_policy = Box::new(DefaultCutPolicy {});
                 }
             },
-            &SystemClauseType::SetCutPoint(r) =>
+            &SystemClauseType::SetCutPoint(r) => if cut_policy.cut(self, r) {
-                cut_policy.cut(self, r),
+                return Ok(());
+            },
+            &SystemClauseType::SetCutPointByDefault(r) => {
+                let mut cut_policy = DefaultCutPolicy {};
+                cut_policy.cut(self, r);
+            },
             &SystemClauseType::InferenceLevel => {
                 let a1 = self[temp_v!(1)].clone();
                 let a2 = self.store(self.deref(self[temp_v!(2)].clone()));
@@ -379,11 +396,15 @@ impl MachineState {
                 self.reset_block(addr);
             },
             &SystemClauseType::SetBall => self.set_ball(),
-            &SystemClauseType::SkipMaxList => return self.skip_max_list(),
+            &SystemClauseType::SkipMaxList => if let Err(err) = self.skip_max_list() {
+                return Err(err);
+            },
             &SystemClauseType::Succeed => {},
             &SystemClauseType::UnwindStack => self.unwind_stack()
         };
 
+        self.set_p();
+
         Ok(())
     }
 }

src/tests.rs

@@ -1558,12 +1558,10 @@ fn test_queries_on_builtins()
    */
 }
 
-/*
 #[test]
 fn test_queries_on_setup_call_cleanup()
 {
     let mut wam = Machine::new();
-    load_init_str_and_include(&mut wam, BUILTINS, "builtins");
     
     // Test examples from the ISO Prolog page for setup_call_catch.
     assert_prolog_failure!(&mut wam, "?- setup_call_cleanup(false, _, _).");
@@ -1606,15 +1604,21 @@ fn test_queries_on_setup_call_cleanup()
                            [["S = 1", "B = 3", "G = 2"]]);
     assert_prolog_failure!(&mut wam,
                            "?- setup_call_cleanup(S=1,(G=2;G=3), writeq(S+G>B)), B=4, !, throw(x).");
+
+    assert_prolog_success!(&mut wam,
+                           "?- catch(setup_call_cleanup(true,throw(goal),throw(cl)), Pat, true).",
+                           [["Pat = goal"]]);
+    assert_prolog_success!(&mut wam,
+                           "?- catch(( setup_call_cleanup(true,(G=1;G=2),throw(cl)), throw(cont)), Pat, true).",
+                           [["Pat = cont", "G = _1"]]);
+    
+    // fails here.
     assert_prolog_success!(&mut wam,
 "?- setup_call_cleanup(true, (X=1;X=2), writeq(a)), setup_call_cleanup(true,(Y=1;Y=2),writeq(b)), !.",
                            [["Y = 1", "X = 1"]]);    
-    assert_prolog_success!(&mut wam, "?- catch(setup_call_cleanup(true,throw(goal),throw(cl)), Pat, true).",
-                           [["Pat = goal"]]);
-    assert_prolog_success!(&mut wam, "?- catch(( setup_call_cleanup(true,(G=1;G=2),throw(cl)), throw(cont)), Pat, true).",
-                           [["Pat = cont", "G = _1"]]);
 }
 
+/*
 #[test]
 fn test_queries_on_call_with_inference_limit()
 {