rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

restore setup_call_cleanup/3

Browse Source
This commit is contained in:
Mark Thom
2018-08-04 16:12:37 -06:00
parent ae11e82040
commit 707e5fcf8b
9 changed files with 143 additions and 64 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
src/prolog/ast.rs
View File

@@ -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<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))))

3
src/prolog/compile.rs
View File

@@ -98,7 +98,7 @@ fn compile_query(terms: Vec<QueryTerm>, queue: Vec<TopLevel>) -> 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<Module>, submodule: &Module, indices: &mut MachineCodeIndices)

19
src/prolog/lib/builtins.pl
View File

@@ -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'.

4
src/prolog/lib/control.pl
View File

@@ -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.

81
src/prolog/machine/machine_state.rs
View File

@@ -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 {
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)
}
}

33
src/prolog/machine/machine_state_impl.rs
View File

@@ -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;
}
}

29
src/prolog/machine/system_calls.rs
View File

@@ -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) =>
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(())
}
}

18
src/tests.rs
View File

@@ -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"]]);
[["Y = 1", "X = 1"]]);
}
/*
#[test]
fn test_queries_on_call_with_inference_limit()
{