From 707e5fcf8b0869ffdb040f58fc4d44d1e9ab2cc5 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sat, 4 Aug 2018 16:12:37 -0600 Subject: [PATCH] restore setup_call_cleanup/3 --- README.md | 4 +- src/prolog/ast.rs | 16 ++++- src/prolog/compile.rs | 3 +- src/prolog/lib/builtins.pl | 19 +++--- src/prolog/lib/control.pl | 4 +- src/prolog/machine/machine_state.rs | 81 +++++++++++++++++++----- src/prolog/machine/machine_state_impl.rs | 33 ++++------ src/prolog/machine/system_calls.rs | 29 +++++++-- src/tests.rs | 16 +++-- 9 files changed, 142 insertions(+), 63 deletions(-) diff --git a/README.md b/README.md index 155e930e..b29e8435 100644 --- a/README.md +++ b/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` diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index b4f033cd..a23f7cc6 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -700,7 +700,7 @@ pub struct Rule { #[derive(Copy, Clone, PartialEq)] pub enum SystemClauseType { - CheckCutPoint, + CheckCutPoint, GetSCCCleaner, InstallSCCCleaner, InstallInferenceCounter, @@ -718,6 +718,7 @@ pub enum SystemClauseType { InstallNewBlock, ResetBlock, SetBall, + SetCutPointByDefault(RegType), SkipMaxList, Succeed, UnwindStack @@ -739,7 +740,7 @@ impl SystemClauseType { clause_name!("$remove_call_policy_check"), &SystemClauseType::RemoveInferenceCounter => clause_name!("$remove_inference_counter"), - &SystemClauseType::RestoreCutPolicy => clause_name!("$restore_cut_policy"), + &SystemClauseType::RestoreCutPolicy => clause_name!("$restore_cut_policy"), &SystemClauseType::SetCutPoint(_) => clause_name!("$set_cp"), &SystemClauseType::InferenceLevel => clause_name!("$inference_level"), &SystemClauseType::CleanUpBlock => clause_name!("$clean_up_block"), @@ -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 { + match self.0 { + IndexPtr::Index(i) => Some(i), + _ => None + } + } +} + impl From for CodeIndex { fn from(value: ModuleCodeIndex) -> Self { CodeIndex(Rc::new(RefCell::new((value.0, value.1)))) diff --git a/src/prolog/compile.rs b/src/prolog/compile.rs index c6691676..a8553a51 100644 --- a/src/prolog/compile.rs +++ b/src/prolog/compile.rs @@ -98,7 +98,7 @@ fn compile_query(terms: Vec, queue: Vec) -> Result<(Code, A let mut code = try!(cg.compile_query(&terms)); compile_appendix(&mut code, queue)?; - + Ok((code, cg.take_vars())) } @@ -202,7 +202,6 @@ impl<'a> ListingCompiler<'a> { self.wam.add_batched_ops(op_dir); } } - } fn use_module(module: &mut Option, submodule: &Module, indices: &mut MachineCodeIndices) diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index 94334f2c..1327ace1 100644 --- a/src/prolog/lib/builtins.pl +++ b/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) :- - S, !, '$get_current_block'(Bb), +setup_call_cleanup(S, G, C) :- '$get_cp'(B), + S, '$set_cp_by_default'(B), '$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'. diff --git a/src/prolog/lib/control.pl b/src/prolog/lib/control.pl index 94090a05..6e896b3b 100644 --- a/src/prolog/lib/control.pl +++ b/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. diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index ce63ccf6..418c14ea 100644 --- a/src/prolog/machine/machine_state.rs +++ b/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 { + 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 { - SCCCutPolicy { cont_pts: vec![] } + pub(crate) fn new(r_c_w_h: usize, r_c_wo_h: usize) -> Self { + 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() { - if machine_st.b < b_cutoff { - machine_st.block = prev_block; - machine_st.unwind_stack(); - } - } + self.run_cleaners(machine_st) } } diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 290c4137..4d975919 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -193,7 +193,7 @@ impl MachineState { (Addr::Con(c1), Addr::Con(c2)) => if c1 != c2 { self.fail = true; - }, + }, (Addr::Str(a1), Addr::Str(a2)) => { let r1 = &self.heap[a1]; let r2 = &self.heap[a2]; @@ -1118,14 +1118,14 @@ impl MachineState { Some((name, arity + narity - 1)) } - + pub(super) fn unwind_stack(&mut self) { self.b = self.block; self.or_stack.truncate(self.b); self.fail = true; } - + fn heap_ball_boundary_diff(&self) -> usize { if self.ball.boundary > self.heap.h { self.ball.boundary - self.heap.h @@ -1184,10 +1184,10 @@ impl MachineState { // 8.5.2.3 e) let n = Addr::Con(Constant::Number(Number::Integer(n))); let dom_err = MachineError::domain_error(DomainError::NotLessThanZero, n); - + return Err(self.error_form(dom_err, stub)); } - + let n = match n.to_usize() { Some(n) => n, None => { @@ -1206,7 +1206,7 @@ impl MachineState { HeapCellValue::NamedStr(arity, _, _) if 1 <= n && n <= arity => { let a3 = self[temp_v!(3)].clone(); let h_a = Addr::HeapCell(o + n); - + self.unify(a3, h_a); }, _ => self.fail = true @@ -1215,7 +1215,7 @@ impl MachineState { if n == 1 || n == 2 { let a3 = self[temp_v!(3)].clone(); let h_a = Addr::HeapCell(l + n - 1); - + self.unify(a3, h_a); } else { self.fail = true; @@ -1224,8 +1224,8 @@ impl MachineState { return Err(self.error_form(MachineError::type_error(ValidType::Compound, term), stub)) } - - + + }, _ => // 8.5.2.3 c) return Err(self.error_form(MachineError::type_error(ValidType::Integer, n), stub)) @@ -1236,7 +1236,7 @@ impl MachineState { fn compare_numbers(&mut self, cmp: CompareNumberQT, n1: Number, n2: Number) { let ordering = n1.cmp(&n2); - + self.fail = match cmp { CompareNumberQT::GreaterThan if ordering == Ordering::Greater => false, CompareNumberQT::GreaterThanOrEqual if ordering != Ordering::Less => false, @@ -1537,7 +1537,7 @@ impl MachineState { let f_a = if name.as_str() == "." && arity == 2 { Addr::Lis(self.heap.h) } else { - let h = self.heap.h; + let h = self.heap.h; self.heap.push(HeapCellValue::NamedStr(arity as usize, name, None)); Addr::Str(h) }; @@ -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)); - - if self.last_call { - self.p = CodePtr::Local(self.cp.clone()); - } else { - self.p += 1; - } + try_or_fail!(self, self.system_call(ct, code_dirs, call_policy, cut_policy)); }, &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) => { - cut_policy.cut(self, r); + &CutInstruction::Cut(r) => if !cut_policy.cut(self, r) { self.p += 1; } } diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index cd78785f..1754fe75 100644 --- a/src/prolog/machine/system_calls.rs +++ b/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, cut_policy: &mut Box,) -> 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::().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::().ok() @@ -306,8 +318,13 @@ impl MachineState { *cut_policy = Box::new(DefaultCutPolicy {}); } }, - &SystemClauseType::SetCutPoint(r) => - cut_policy.cut(self, r), + &SystemClauseType::SetCutPoint(r) => if 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(()) } } diff --git a/src/tests.rs b/src/tests.rs index 9f9c059b..823aa74b 100644 --- a/src/tests.rs +++ b/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, -"?- 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).", + "?- 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).", + 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"]]); } +/* #[test] fn test_queries_on_call_with_inference_limit() { -- 2.54.0