* 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.
* `atomic/1`
* `between/3`
* `call/1..62`
+* `call_cleanup/2`
* `catch/3`
* `compare/3`
* `compound/1`
* `repeat/0`
* `reverse/2`
* `select/3`
+* `setup_call_cleanup/3`
* `sort/2`
* `string/1`
* `throw/1`
#[derive(Copy, Clone, PartialEq)]
pub enum SystemClauseType {
- CheckCutPoint,
+ CheckCutPoint,
GetSCCCleaner,
InstallSCCCleaner,
InstallInferenceCounter,
InstallNewBlock,
ResetBlock,
SetBall,
+ SetCutPointByDefault(RegType),
SkipMaxList,
Succeed,
UnwindStack
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"),
&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"),
("$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
#[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))))
let mut code = try!(cg.compile_query(&terms));
compile_appendix(&mut code, queue)?;
-
+
Ok((code, cg.take_vars()))
}
self.wam.add_batched_ops(op_dir);
}
}
-
}
fn use_module(module: &mut Option<Module>, submodule: &Module, indices: &mut MachineCodeIndices)
(>>)/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).
% 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) ).
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.
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'.
-:- 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, \=).
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.
}
}
}
+
+ 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> {
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)
}
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);
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() {
}
} 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 {
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() {
}
} 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)
}
}
(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];
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
// 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 => {
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
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;
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))
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,
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)
};
},
&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) => {
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;
}
}
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
if let Some(r) = dest.as_var() {
self.bind(r, addr.clone());
+ self.set_p();
+
return Ok(());
}
} else {
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()
*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()));
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(())
}
}
*/
}
-/*
#[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, _, _).");
[["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()
{
projects / scryer-prolog.git / commitdiff