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

add support for callable if-then and disjunct

Browse Source
This commit is contained in:
Mark Thom
2018-05-12 00:30:34 -06:00
parent ba7e7ac895
commit 7455c2e9db
12 changed files with 252 additions and 295 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/main.rs
View File

@@ -30,9 +30,9 @@ fn prolog_repl() {
let mut wam = Machine::new();
load_init_str_and_include(&mut wam, BUILTINS, "builtins");
// load_init_str(&mut wam, LISTS);
load_init_str(&mut wam, LISTS);
// load_init_str(&mut wam, CONTROL);
// load_init_str(&mut wam, QUEUES);
// load_init_str(&mut wam, QUEUES);
loop {
print!("prolog> ");

97
src/prolog/ast.rs
View File

@@ -601,19 +601,19 @@ impl InlinedClauseType {
&InlinedClauseType::IsInteger (..) => 1,
&InlinedClauseType::IsRational(..) => 1,
&InlinedClauseType::IsString(..) => 1,
&InlinedClauseType::IsFloat (..) => 1,
&InlinedClauseType::IsFloat (..) => 1,
&InlinedClauseType::IsNonVar(..) => 1,
&InlinedClauseType::IsVar(..) => 1
}
}
pub fn from(name: &str, arity: usize) -> Option<Self> {
let r1 = temp_v!(1);
let r2 = temp_v!(2);
let a1 = ArithmeticTerm::Reg(r1);
let a2 = ArithmeticTerm::Reg(r2);
match (name, arity) {
(">", 2) =>
Some(InlinedClauseType::CompareNumber(CompareNumberQT::GreaterThan, a1, a2)),
@@ -715,14 +715,20 @@ pub struct Rule {
#[derive(Copy, Clone, PartialEq)]
pub enum SystemClauseType {
InstallCleaner,
InstallInferenceCounter,
RemoveCallPolicyCheck,
RemoveInferenceCounter,
RestoreCutPolicy,
SetCutPoint(RegType),
GetArg,
InferenceLevel(RegType, RegType),
InferenceLevel,
CleanUpBlock,
EraseBall,
Fail,
GetBall,
GetCurrentBlock,
GetCutPoint(RegType),
GetCutPoint,
InstallNewBlock,
ResetBlock,
SetBall,
@@ -734,14 +740,20 @@ pub enum SystemClauseType {
impl SystemClauseType {
pub fn arity(&self) -> usize {
match self {
&SystemClauseType::InstallCleaner => 1,
&SystemClauseType::InstallInferenceCounter => 3,
&SystemClauseType::RemoveCallPolicyCheck => 1,
&SystemClauseType::RemoveInferenceCounter => 2,
&SystemClauseType::RestoreCutPolicy => 0,
&SystemClauseType::SetCutPoint(_) => 1,
&SystemClauseType::GetArg => 3,
&SystemClauseType::InferenceLevel(..) => 2,
&SystemClauseType::InferenceLevel => 2,
&SystemClauseType::CleanUpBlock => 1,
&SystemClauseType::EraseBall => 0,
&SystemClauseType::Fail => 0,
&SystemClauseType::GetBall => 1,
&SystemClauseType::GetCurrentBlock => 1,
&SystemClauseType::GetCutPoint(_) => 1,
&SystemClauseType::GetCutPoint => 1,
&SystemClauseType::InstallNewBlock => 1,
&SystemClauseType::ResetBlock => 1,
&SystemClauseType::SetBall => 1,
@@ -750,20 +762,29 @@ impl SystemClauseType {
&SystemClauseType::UnwindStack => 0
}
}
pub fn fixity(&self) -> Option<Fixity> {
None
}
pub fn name(&self) -> ClauseName {
match self {
&SystemClauseType::InstallCleaner => clause_name!("$install_cleaner"),
&SystemClauseType::InstallInferenceCounter =>
clause_name!("$install_inference_counter"),
&SystemClauseType::RemoveCallPolicyCheck =>
clause_name!("$remove_call_policy_check"),
&SystemClauseType::RemoveInferenceCounter =>
clause_name!("$remove_inference_counter"),
&SystemClauseType::RestoreCutPolicy => clause_name!("$restore_cut_policy"),
&SystemClauseType::SetCutPoint(_) => clause_name!("$set_cp"),
&SystemClauseType::GetArg => clause_name!("$get_arg"),
&SystemClauseType::InferenceLevel(..) => clause_name!("$inference_level"),
&SystemClauseType::InferenceLevel => clause_name!("$inference_level"),
&SystemClauseType::CleanUpBlock => clause_name!("$clean_up_block"),
&SystemClauseType::EraseBall => clause_name!("$erase_ball"),
&SystemClauseType::Fail => clause_name!("$fail"),
&SystemClauseType::GetBall => clause_name!("$get_ball"),
&SystemClauseType::GetCutPoint(_) => clause_name!("$get_cp"),
&SystemClauseType::GetCutPoint => clause_name!("$get_cp"),
&SystemClauseType::GetCurrentBlock => clause_name!("$get_current_block"),
&SystemClauseType::InstallNewBlock => clause_name!("$install_new_block"),
&SystemClauseType::ResetBlock => clause_name!("$reset_block"),
@@ -776,14 +797,24 @@ impl SystemClauseType {
pub fn from(name: &str, arity: usize) -> Option<SystemClauseType> {
match (name, arity) {
("$install_cleaner", 1) =>
Some(SystemClauseType::InstallCleaner),
("$install_inference_counter", 3) =>
Some(SystemClauseType::InstallInferenceCounter),
("$remove_call_policy_check", 1) =>
Some(SystemClauseType::RemoveCallPolicyCheck),
("$remove_inference_counter", 1) =>
Some(SystemClauseType::RemoveInferenceCounter),
("$restore_cut_policy", 0) => Some(SystemClauseType::RestoreCutPolicy),
("$set_cp", 1) => Some(SystemClauseType::SetCutPoint(temp_v!(1))),
("$get_arg", 3) => Some(SystemClauseType::GetArg),
("$inference_level", 2) => Some(SystemClauseType::InferenceLevel(temp_v!(0), temp_v!(0))),
("$inference_level", 2) => Some(SystemClauseType::InferenceLevel),
("$clean_up_block", 1) => Some(SystemClauseType::CleanUpBlock),
("$erase_ball", 0) => Some(SystemClauseType::EraseBall),
("$fail", 0) => Some(SystemClauseType::Fail),
("$get_ball", 1) => Some(SystemClauseType::GetBall),
("$get_current_block", 1) => Some(SystemClauseType::GetCurrentBlock),
("$get_cp", 1) => Some(SystemClauseType::GetCutPoint(temp_v!(0))),
("$get_cp", 1) => Some(SystemClauseType::GetCutPoint),
("$install_new_block", 1) => Some(SystemClauseType::InstallNewBlock),
("$reset_block", 1) => Some(SystemClauseType::ResetBlock),
("$set_ball", 1) => Some(SystemClauseType::SetBall),
@@ -796,7 +827,7 @@ impl SystemClauseType {
#[derive(Copy, Clone, PartialEq)]
pub enum BuiltInClauseType {
AcyclicTerm,
AcyclicTerm,
Compare,
CompareTerm(CompareTermQT),
CyclicTerm,
@@ -812,10 +843,10 @@ pub enum BuiltInClauseType {
}
#[derive(Clone)]
pub enum ClauseType {
pub enum ClauseType {
BuiltIn(BuiltInClauseType),
CallN,
Inlined(InlinedClauseType),
Inlined(InlinedClauseType),
Op(ClauseName, Fixity, CodeIndex),
Named(ClauseName, CodeIndex),
System(SystemClauseType)
@@ -898,7 +929,7 @@ impl BuiltInClauseType {
pub fn name(&self) -> ClauseName {
match self {
&BuiltInClauseType::AcyclicTerm => clause_name!("acyclic_term"),
&BuiltInClauseType::AcyclicTerm => clause_name!("acyclic_term"),
&BuiltInClauseType::Compare => clause_name!("compare"),
&BuiltInClauseType::CompareTerm(qt) => clause_name!(qt.name()),
&BuiltInClauseType::CyclicTerm => clause_name!("cyclic_term"),
@@ -909,14 +940,14 @@ impl BuiltInClauseType {
&BuiltInClauseType::Ground => clause_name!("ground"),
&BuiltInClauseType::Is => clause_name!("is"),
&BuiltInClauseType::KeySort => clause_name!("keysort"),
&BuiltInClauseType::NotEq => clause_name!("\\=="),
&BuiltInClauseType::Sort => clause_name!("sort"),
&BuiltInClauseType::NotEq => clause_name!("\\=="),
&BuiltInClauseType::Sort => clause_name!("sort"),
}
}
}
pub fn arity(&self) -> usize {
match self {
&BuiltInClauseType::AcyclicTerm => 1,
&BuiltInClauseType::AcyclicTerm => 1,
&BuiltInClauseType::Compare => 2,
&BuiltInClauseType::CompareTerm(_) => 2,
&BuiltInClauseType::CyclicTerm => 1,
@@ -931,7 +962,7 @@ impl BuiltInClauseType {
&BuiltInClauseType::Sort => 2,
}
}
pub fn from(name: &str, arity: usize) -> Option<Self> {
match (name, arity) {
("acyclic_term", 1) => Some(BuiltInClauseType::AcyclicTerm),
@@ -970,7 +1001,7 @@ impl ClauseType {
pub fn name(&self) -> ClauseName {
match self {
&ClauseType::CallN => clause_name!("call"),
&ClauseType::CallN => clause_name!("call"),
&ClauseType::BuiltIn(built_in) => built_in.name(),
&ClauseType::Inlined(ref inlined) => clause_name!(inlined.name()),
&ClauseType::Op(ref name, ..) => name.clone(),
@@ -1371,12 +1402,6 @@ pub enum ArithmeticInstruction {
// call and cut policy exempt instructions.
#[derive(Clone)]
pub enum PEInstruction {
InstallCleaner,
InstallInferenceCounter(RegType, RegType, RegType),
RemoveCallPolicyCheck,
RemoveInferenceCounter(RegType, RegType),
RestoreCutPolicy,
SetCutPoint(RegType),
}
#[derive(Clone)]
@@ -1385,7 +1410,7 @@ pub enum ControlInstruction {
CallClause(ClauseType, usize, usize, bool), // name, arity, perm_vars after threshold, last call.
CheckCpExecute,
Deallocate,
GetCleanerCall,
GetCleanerCall,
IsClause(bool, RegType, ArithmeticTerm), // last call, register of var, term.
JmpBy(usize, usize, usize, bool), // arity, global_offset, perm_vars after threshold, last call.
Proceed
@@ -1453,7 +1478,6 @@ pub type CompiledQuery = Vec<QueryInstruction>;
#[derive(Clone)]
pub enum Line {
Arithmetic(ArithmeticInstruction),
PolicyExempt(PEInstruction),
Choice(ChoiceInstruction),
Control(ControlInstruction),
Cut(CutInstruction),
@@ -1590,6 +1614,7 @@ impl From<(usize, ClauseName)> for CodeIndex {
#[derive(Clone, PartialEq)]
pub enum CodePtr {
BuiltInClause(BuiltInClauseType, LocalCodePtr), // local is the successor call.
CallN(usize, LocalCodePtr), // arity, local.
Local(LocalCodePtr)
}
@@ -1597,6 +1622,7 @@ impl CodePtr {
pub fn local(&self) -> LocalCodePtr {
match self {
&CodePtr::BuiltInClause(_, ref local)
| &CodePtr::CallN(_, ref local)
| &CodePtr::Local(ref local) => local.clone()
}
}
@@ -1618,7 +1644,7 @@ impl LocalCodePtr {
pub fn assign_if_local(&mut self, cp: CodePtr) {
match cp {
CodePtr::Local(local) => *self = local,
CodePtr::Local(local) => *self = local,
_ => {}
}
}
@@ -1627,7 +1653,7 @@ impl LocalCodePtr {
impl PartialOrd<CodePtr> for CodePtr {
fn partial_cmp(&self, other: &CodePtr) -> Option<Ordering> {
match (self, other) {
(&CodePtr::Local(ref l1), &CodePtr::Local(ref l2)) => l1.partial_cmp(l2),
(&CodePtr::Local(ref l1), &CodePtr::Local(ref l2)) => l1.partial_cmp(l2),
_ => Some(Ordering::Greater)
}
}
@@ -1664,7 +1690,7 @@ impl Add<usize> for LocalCodePtr {
fn add(self, rhs: usize) -> Self::Output {
match self {
LocalCodePtr::DirEntry(p, name) => LocalCodePtr::DirEntry(p + rhs, name),
LocalCodePtr::DirEntry(p, name) => LocalCodePtr::DirEntry(p + rhs, name),
LocalCodePtr::TopLevel(cn, p) => LocalCodePtr::TopLevel(cn, p + rhs)
}
}
@@ -1685,7 +1711,8 @@ impl Add<usize> for CodePtr {
fn add(self, rhs: usize) -> Self::Output {
match self {
CodePtr::Local(local) => CodePtr::Local(local + rhs),
CodePtr::BuiltInClause(_, local) => CodePtr::Local(local + rhs),
CodePtr::CallN(_, local) | CodePtr::BuiltInClause(_, local) =>
CodePtr::Local(local + rhs),
}
}
}

2
src/prolog/builtins.rs
View File

@@ -658,7 +658,7 @@ pub fn default_op_dir() -> OpDir
op_dir.insert((clause_name!(":-"), Fixity::In), (XFX, 1200, module_name.clone()));
op_dir.insert((clause_name!(":-"), Fixity::Pre), (FX, 1200, module_name.clone()));
op_dir.insert((clause_name!("?-"), Fixity::Pre), (FX, 1200, module_name.clone()));
// op_dir.insert((clause_name!("/"), Fixity::In), (YFX, 400, module_name.clone()));
op_dir.insert((clause_name!("/"), Fixity::In), (YFX, 400, module_name.clone()));
/*
// control operators.

23
src/prolog/io.rs
View File

@@ -166,25 +166,6 @@ impl fmt::Display for IndexedChoiceInstruction {
}
}
impl fmt::Display for PEInstruction {
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
match self {
&PEInstruction::InstallInferenceCounter(r1, r2, r3) =>
write!(f, "install_inference_counter {}, {}, {}", r1, r2, r3),
&PEInstruction::InstallCleaner =>
write!(f, "install_cleaner"),
&PEInstruction::RemoveCallPolicyCheck =>
write!(f, "remove_call_policy_check"),
&PEInstruction::RemoveInferenceCounter(r1, r2) =>
write!(f, "remove_inference_counter {}, {}", r1, r2),
&PEInstruction::RestoreCutPolicy =>
write!(f, "restore_cut_point"),
&PEInstruction::SetCutPoint(r) =>
write!(f, "set_cp {}", r),
}
}
}
impl fmt::Display for ChoiceInstruction {
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
match self {
@@ -328,8 +309,6 @@ pub fn print_code(code: &Code) {
for fact_instr in fact {
println!("{}", fact_instr);
},
&Line::PolicyExempt(ref instr) =>
println!("{}", instr),
&Line::Cut(ref cut) =>
println!("{}", cut),
&Line::Choice(ref choice) =>
@@ -537,6 +516,8 @@ fn compile_decl(wam: &mut Machine, tl: TopLevel, queue: Vec<TopLevel>) -> EvalSe
decl_info.label_clauses(wam.code_size(), &mut wam.code_dir, &mut code);
print_code(&code);
if !code.is_empty() {
wam.add_user_code(name, tl.arity(), code, tl.as_predicate().ok().unwrap())
} else {

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

@@ -2,8 +2,9 @@
:- module(builtins, [(=)/2, (+)/2, (*)/2, (-)/2, (/)/2, (/\)/2,
(\/)/2, (is)/2, (xor)/2, (div)/2, (//)/2, (rdiv)/2, (<<)/2,
(>>)/2, (mod)/2, (rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2, (-)/1,
(>=)/2, (=<)/2, (->)/2, (;)/2, catch/3, throw/1, true/0, false/0]).
(>>)/2, (mod)/2, (rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2,
(-)/1, (>=)/2, (=<)/2, (->)/2, (;)/2, (==)/2, catch/3,
throw/1, true/0, false/0]).
% arithmetic operators.
:- op(700, xfx, is).
@@ -30,12 +31,15 @@
:- op(700, xfx, >=).
:- op(700, xfx, =<).
% unify.
:- op(700, xfx, =).
% conditional operators.
:- op(1050, xfy, ->).
:- op(1100, xfy, ;).
% unify.
:- op(700, xfx, =).
% term comparison.
:- op(700, xfx, ==).
% unify.
X = X.
@@ -44,33 +48,32 @@ true.
false :- '$fail'.
% conditions.
/*
','(G1, G2) :- get_cp(B), ','(G1, G2, B).
% control operators.
','(!, ','(G1, G2), B) :- set_cp(B), ','(G1, G2, B).
','(!, !, B) :- set_cp(B).
','(!, G, B) :- set_cp(B), G.
','(G1, G2) :- '$get_cp'(B), ','(G1, G2, B).
','(!, ','(G1, G2), B) :- '$set_cp'(B), ','(G1, G2, B).
','(!, !, B) :- '$set_cp'(B).
','(!, G, B) :- '$set_cp'(B), G.
','(G, ','(G2, G3), B) :- !, G, ','(G2, G3, B).
','(G, !, B) :- !, G, set_cp(B).
','(G, !, B) :- !, G, '$set_cp'(B).
','(G1, G2, _) :- G1, G2.
;(G1, G2) :- get_cp(B), ;(G1, G2, B).
;(G1, G2) :- '$get_cp'(B), ;(G1, G2, B).
;(G1 -> G2, _, B) :- ->(G1, G2, B).
;(_ -> _ , G, B) :- set_cp(B), G.
;(!, _, B) :- set_cp(B).
;(_, !, B) :- set_cp(B).
;(G1, G4, B) :- compound(G1), G1 = ->(G2, G3), (G2 -> G3 ; '$set_cp'(B), G4).
;(G1, G2, B) :- G1 == !, '$set_cp'(B), call(G2).
;(G1, G2, B) :- G2 == !, call(G2), '$set_cp'(B).
;(G, _, _) :- G.
;(_, G, _) :- G.
G1 -> G2 :- get_cp(B), ->(G1, G2, B).
G1 -> G2 :- '$get_cp'(B), ->(G1, G2, B).
->(G1, !, B) :- call(G1), set_cp(B).
->(G1, G2, B) :- call(G1), set_cp(B), call(G2).
*/
->(G1, G2, B) :- G2 == !, call(G1), !, '$set_cp'(B).
->(G1, G2, B) :- call(G1), '$set_cp'(B), call(G2).
% exception handling.
% exceptions.
catch(G,C,R) :- '$get_current_block'(Bb), catch(G,C,R,Bb).
catch(G,C,R,Bb) :- '$install_new_block'(NBb), call(G), end_block(Bb, NBb).

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

@@ -324,6 +324,7 @@ pub(crate) trait CallPolicy: Any {
let n = machine_st.or_stack[b].num_args();
for i in 1 .. n + 1 {
let addr = machine_st.store(machine_st.deref(machine_st.or_stack[b][i].clone()));
machine_st.registers[i] = machine_st.or_stack[b][i].clone();
}
@@ -517,40 +518,37 @@ pub(crate) trait CallPolicy: Any {
}
}
fn call_n<'a>(&mut self, machine_st: &mut MachineState, mut arity: usize,
fn call_n<'a>(&mut self, machine_st: &mut MachineState, arity: usize,
code_dirs: CodeDirs<'a>, lco: bool)
-> CallResult
{
while let Some((name, inner_arity)) = machine_st.setup_call_n(arity) {
if let Some((name, arity)) = machine_st.setup_call_n(arity) {
let user = clause_name!("user");
match ClauseType::from(name.clone(), inner_arity, None) {
match ClauseType::from(name.clone(), arity, None) {
ClauseType::CallN => {
machine_st.handle_internal_call_n(inner_arity);
machine_st.handle_internal_call_n(arity);
if machine_st.fail {
return Ok(());
}
arity = inner_arity;
continue;
machine_st.p = CodePtr::CallN(arity, machine_st.p.local());
},
ClauseType::BuiltIn(built_in) =>
machine_st.setup_built_in_call(built_in),
ClauseType::Inlined(inlined) =>
machine_st.execute_inlined(&inlined),
ClauseType::Op(..) | ClauseType::Named(..) =>
if let Some(idx) = code_dirs.get(name.clone(), inner_arity, user) {
self.context_call(machine_st, name, inner_arity, idx, lco)?;
if let Some(idx) = code_dirs.get(name.clone(), arity, user) {
self.context_call(machine_st, name, arity, idx, lco)?;
} else {
return Err(machine_st.existence_error(name, inner_arity));
return Err(machine_st.existence_error(name, arity));
},
ClauseType::System(ct) =>
return Err(machine_st.type_error(ValidType::Callable,
Addr::Con(Constant::Atom(name))))
};
break;
}
Ok(())
@@ -700,8 +698,6 @@ impl CutPolicy for DefaultCutPolicy {
machine_st.fail = true;
return;
}
machine_st.p += 1;
}
}
@@ -743,8 +739,6 @@ impl CutPolicy for SetupCallCleanupCutPolicy {
return;
}
machine_st.p += 1;
if !self.out_of_cont_pts() {
machine_st.cp.assign_if_local(machine_st.p.clone());
machine_st.num_of_args = 0;

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

@@ -1,6 +1,5 @@
use prolog::and_stack::*;
use prolog::ast::*;
use prolog::builtins::*;
use prolog::copier::*;
use prolog::heap_iter::*;
use prolog::heap_print::*;
@@ -670,7 +669,7 @@ impl MachineState {
&ArithmeticInstruction::Xor(ref a1, ref a2, t) => {
let n1 = try_or_fail!(self, self.get_number(a1));
let n2 = try_or_fail!(self, self.get_number(a2));
self.interms[t - 1] = Number::Integer(try_or_fail!(self, self.xor(n1, n2)));
self.p += 1;
},
@@ -956,8 +955,10 @@ impl MachineState {
self.registers[arg] = self.heap[h].as_addr(h);
}
},
&QueryInstruction::PutValue(norm, arg) =>
self.registers[arg] = self[norm].clone(),
&QueryInstruction::PutValue(norm, arg) => {
let addr = self.store(self.deref(self[norm].clone()));
self.registers[arg] = self[norm].clone();
},
&QueryInstruction::PutVariable(norm, arg) => {
match norm {
RegType::Perm(n) => {
@@ -1400,121 +1401,6 @@ impl MachineState {
}
}
pub(super)
fn execute_pe_instr<'a>(&mut self, code_dirs: CodeDirs<'a>, call_policy: &mut Box<CallPolicy>,
cut_policy: &mut Box<CutPolicy>, instr: &PEInstruction)
{
match instr {
&PEInstruction::InstallCleaner => {
let addr = self[temp_v!(1)].clone();
let b = self.b;
let block = self.block;
if cut_policy.downcast_ref::<SetupCallCleanupCutPolicy>().is_err() {
*cut_policy = Box::new(SetupCallCleanupCutPolicy::new());
}
match cut_policy.downcast_mut::<SetupCallCleanupCutPolicy>().ok()
{
Some(cut_policy) => cut_policy.push_cont_pt(addr, b, block),
None => panic!("install_cleaner: should have installed \\
SetupCallCleanupCutPolicy.")
};
self.p += 1;
},
&PEInstruction::InstallInferenceCounter(r1, r2, r3) => { // A1 = B, A2 = L
let a1 = self.store(self.deref(self[r1].clone()));
let a2 = self.store(self.deref(self[r2].clone()));
if call_policy.downcast_ref::<CallWithInferenceLimitCallPolicy>().is_err() {
CallWithInferenceLimitCallPolicy::new_in_place(call_policy);
}
self.p += 1;
match (a1, a2.clone()) {
(Addr::Con(Constant::Usize(bp)),
Addr::Con(Constant::Number(Number::Integer(n)))) =>
match call_policy.downcast_mut::<CallWithInferenceLimitCallPolicy>().ok() {
Some(call_policy) => {
let count = call_policy.add_limit(n, bp);
self[r3] = Addr::Con(Constant::Number(Number::Integer(count)));
},
None => panic!("install_inference_counter: should have installed \\
CallWithInferenceLimitCallPolicy.")
},
_ => {
let stub = self.functor_stub(clause_name!("call_with_inference_limit"), 3);
let type_error = self.error_form(self.type_error(ValidType::Integer, a2),
stub);
self.throw_exception(type_error)
}
};
},
&PEInstruction::RemoveCallPolicyCheck => {
let restore_default =
match call_policy.downcast_mut::<CallWithInferenceLimitCallPolicy>().ok() {
Some(call_policy) => {
let a1 = self.store(self.deref(self[temp_v!(1)].clone()));
if let Addr::Con(Constant::Usize(bp)) = a1 {
if call_policy.is_empty() && bp == self.b {
Some(call_policy.into_inner())
} else {
None
}
} else {
panic!("remove_call_policy_check: expected Usize in A1.");
}
},
None => panic!("remove_call_policy_check: requires \\
CallWithInferenceLimitCallPolicy.")
};
if let Some(new_policy) = restore_default {
*call_policy = new_policy;
}
self.p += 1;
},
&PEInstruction::RemoveInferenceCounter(r1, r2) => { // A1 = B
match call_policy.downcast_mut::<CallWithInferenceLimitCallPolicy>().ok() {
Some(call_policy) => {
let a1 = self.store(self.deref(self[r1].clone()));
if let Addr::Con(Constant::Usize(bp)) = a1 {
let count = call_policy.remove_limit(bp);
self[r2] = Addr::Con(Constant::Number(Number::Integer(count)));
} else {
panic!("remove_inference_counter: expected Usize in A1.");
}
},
None => panic!("remove_inference_counters: requires \\
CallWithInferenceLimitCallPolicy.")
};
self.p += 1;
},
&PEInstruction::RestoreCutPolicy => {
let restore_default =
if let Ok(cut_policy) = cut_policy.downcast_ref::<SetupCallCleanupCutPolicy>() {
cut_policy.out_of_cont_pts()
} else {
false
};
if restore_default {
*cut_policy = Box::new(DefaultCutPolicy {});
}
self.p += 1;
},
&PEInstruction::SetCutPoint(r) =>
cut_policy.cut(self, r),
};
}
pub(super) fn try_functor(&mut self) -> Result<(), MachineError> {
let stub = self.functor_stub(clause_name!("functor"), 3);
let a1 = self.store(self.deref(self[temp_v!(1)].clone()));
@@ -1785,7 +1671,7 @@ impl MachineState {
}
pub(super) fn setup_built_in_call(&mut self, ct: BuiltInClauseType)
{
{
self.num_of_args = ct.arity();
self.b0 = self.b;
@@ -1828,8 +1714,8 @@ impl MachineState {
self.e = self.and_stack[e].e;
self.p += 1;
}
}
pub(super) fn execute_ctrl_instr<'a>(&mut self, code_dirs: CodeDirs<'a>,
call_policy: &mut Box<CallPolicy>,
cut_policy: &mut Box<CutPolicy>,
@@ -1849,7 +1735,7 @@ impl MachineState {
try_or_fail!(self, call_policy.context_call(self, name.clone(), arity, idx.clone(),
lco)),
&ControlInstruction::CallClause(ClauseType::System(ref ct), arity, _, lco) => {
try_or_fail!(self, self.system_call(ct));
try_or_fail!(self, self.system_call(ct, call_policy, cut_policy));
if lco {
self.p = CodePtr::Local(self.cp.clone());
@@ -2011,8 +1897,10 @@ impl MachineState {
self[r] = Addr::Con(Constant::Usize(b0));
self.p += 1;
},
&CutInstruction::Cut(r) =>
cut_policy.cut(self, r),
&CutInstruction::Cut(r) => {
cut_policy.cut(self, r);
self.p += 1;
}
}
}

7
src/prolog/machine/mod.rs
View File

@@ -234,6 +234,8 @@ impl Machine {
Some(self.code[p].clone()),
CodePtr::BuiltInClause(built_in, _) =>
Some(call_clause!(ClauseType::BuiltIn(built_in), built_in.arity(), 0)),
CodePtr::CallN(arity, _) =>
Some(call_clause!(ClauseType::CallN, arity, 0))
}
}
@@ -247,11 +249,6 @@ impl Machine {
match instr {
Line::Arithmetic(ref arith_instr) =>
self.ms.execute_arith_instr(arith_instr),
Line::PolicyExempt(ref built_in_instr) => {
let code_dirs = CodeDirs::new(&self.code_dir, &self.modules);
self.ms.execute_pe_instr(code_dirs, &mut self.call_policy,
&mut self.cut_policy, built_in_instr);
},
Line::Choice(ref choice_instr) =>
self.ms.execute_choice_instr(choice_instr, &mut self.call_policy),
Line::Cut(ref cut_instr) =>

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

@@ -3,7 +3,6 @@ use prolog::machine::machine_errors::*;
use prolog::machine::machine_state::*;
use prolog::num::{ToPrimitive, Zero};
use prolog::num::bigint::BigInt;
use prolog::tabled_rc::*;
use std::rc::Rc;
@@ -153,14 +152,113 @@ impl MachineState {
Ok(())
}
pub(super) fn system_call(&mut self, ct: &SystemClauseType) -> CallResult
pub(super) fn system_call(&mut self, ct: &SystemClauseType, call_policy: &mut Box<CallPolicy>,
cut_policy: &mut Box<CutPolicy>,)
-> CallResult
{
match ct {
&SystemClauseType::InstallCleaner => {
let addr = self[temp_v!(1)].clone();
let b = self.b;
let block = self.block;
if cut_policy.downcast_ref::<SetupCallCleanupCutPolicy>().is_err() {
*cut_policy = Box::new(SetupCallCleanupCutPolicy::new());
}
match cut_policy.downcast_mut::<SetupCallCleanupCutPolicy>().ok()
{
Some(cut_policy) => cut_policy.push_cont_pt(addr, b, block),
None => panic!("install_cleaner: should have installed \\
SetupCallCleanupCutPolicy.")
};
},
&SystemClauseType::InstallInferenceCounter => { // A1 = B, A2 = L
let a1 = self.store(self.deref(self[temp_v!(1)].clone()));
let a2 = self.store(self.deref(self[temp_v!(2)].clone()));
if call_policy.downcast_ref::<CallWithInferenceLimitCallPolicy>().is_err() {
CallWithInferenceLimitCallPolicy::new_in_place(call_policy);
}
match (a1, a2.clone()) {
(Addr::Con(Constant::Usize(bp)),
Addr::Con(Constant::Number(Number::Integer(n)))) =>
match call_policy.downcast_mut::<CallWithInferenceLimitCallPolicy>().ok() {
Some(call_policy) => {
let count = call_policy.add_limit(n, bp);
self[temp_v!(3)] = Addr::Con(Constant::Number(Number::Integer(count)));
},
None => panic!("install_inference_counter: should have installed \\
CallWithInferenceLimitCallPolicy.")
},
_ => {
let stub = self.functor_stub(clause_name!("call_with_inference_limit"), 3);
let type_error = self.error_form(self.type_error(ValidType::Integer, a2),
stub);
self.throw_exception(type_error)
}
};
},
&SystemClauseType::RemoveCallPolicyCheck => {
let restore_default =
match call_policy.downcast_mut::<CallWithInferenceLimitCallPolicy>().ok() {
Some(call_policy) => {
let a1 = self.store(self.deref(self[temp_v!(1)].clone()));
if let Addr::Con(Constant::Usize(bp)) = a1 {
if call_policy.is_empty() && bp == self.b {
Some(call_policy.into_inner())
} else {
None
}
} else {
panic!("remove_call_policy_check: expected Usize in A1.");
}
},
None => panic!("remove_call_policy_check: requires \\
CallWithInferenceLimitCallPolicy.")
};
if let Some(new_policy) = restore_default {
*call_policy = new_policy;
}
},
&SystemClauseType::RemoveInferenceCounter => {
match call_policy.downcast_mut::<CallWithInferenceLimitCallPolicy>().ok() {
Some(call_policy) => {
let a1 = self.store(self.deref(self[temp_v!(1)].clone()));
if let Addr::Con(Constant::Usize(bp)) = a1 {
let count = call_policy.remove_limit(bp);
self[temp_v!(2)] = Addr::Con(Constant::Number(Number::Integer(count)));
} else {
panic!("remove_inference_counter: expected Usize in A1.");
}
},
None => panic!("remove_inference_counters: requires \\
CallWithInferenceLimitCallPolicy.")
};
},
&SystemClauseType::RestoreCutPolicy => {
let restore_default =
if let Ok(cut_policy) = cut_policy.downcast_ref::<SetupCallCleanupCutPolicy>() {
cut_policy.out_of_cont_pts()
} else {
false
};
if restore_default {
*cut_policy = Box::new(DefaultCutPolicy {});
}
},
&SystemClauseType::SetCutPoint(r) =>
cut_policy.cut(self, r),
&SystemClauseType::GetArg =>
self.try_get_arg(),
&SystemClauseType::InferenceLevel(r1, r2) => {
let a1 = self[r1].clone();
let a2 = self.store(self.deref(self[r2].clone()));
return self.try_get_arg(),
&SystemClauseType::InferenceLevel => {
let a1 = self[temp_v!(1)].clone();
let a2 = self.store(self.deref(self[temp_v!(2)].clone()));
match a2 {
Addr::Con(Constant::Usize(bp)) =>
@@ -173,8 +271,6 @@ impl MachineState {
},
_ => self.fail = true
};
Ok(())
},
&SystemClauseType::CleanUpBlock => {
let nb = self.store(self.deref(self[temp_v!(1)].clone()));
@@ -190,17 +286,9 @@ impl MachineState {
},
_ => self.fail = true
};
Ok(())
},
&SystemClauseType::EraseBall => {
self.ball.reset();
Ok(())
},
&SystemClauseType::Fail => {
self.fail = true;
Ok(())
},
&SystemClauseType::EraseBall => self.ball.reset(),
&SystemClauseType::Fail => self.fail = true,
&SystemClauseType::GetBall => {
let addr = self.store(self.deref(self[temp_v!(1)].clone()));
let h = self.heap.h;
@@ -218,20 +306,18 @@ impl MachineState {
Some(r) => self.bind(r, ball),
_ => self.fail = true
};
Ok(())
},
&SystemClauseType::GetCurrentBlock => {
let c = Constant::Usize(self.block);
let addr = self[temp_v!(1)].clone();
self.write_constant_to_var(addr, c);
Ok(())
},
&SystemClauseType::GetCutPoint(r) => {
let c = Constant::Usize(self.b);
self[r] = Addr::Con(c);
Ok(())
&SystemClauseType::GetCutPoint => {
let a1 = self[temp_v!(1)].clone();
let a2 = Addr::Con(Constant::Usize(self.b));
self.unify(a1, a2);
},
&SystemClauseType::InstallNewBlock => {
self.block = self.b;
@@ -240,28 +326,17 @@ impl MachineState {
let addr = self[temp_v!(1)].clone();
self.write_constant_to_var(addr, c);
Ok(())
},
&SystemClauseType::ResetBlock => {
let addr = self.deref(self[temp_v!(1)].clone());
self.reset_block(addr);
Ok(())
},
&SystemClauseType::SetBall => {
self.set_ball();
Ok(())
},
&SystemClauseType::SkipMaxList => {
self.skip_max_list()?;
Ok(())
},
&SystemClauseType::Succeed => {
Ok(())
},
&SystemClauseType::UnwindStack => {
self.unwind_stack();
Ok(())
}
}
&SystemClauseType::SetBall => self.set_ball(),
&SystemClauseType::SkipMaxList => return self.skip_max_list(),
&SystemClauseType::Succeed => {},
&SystemClauseType::UnwindStack => self.unwind_stack()
};
Ok(())
}
}

2
src/prolog/macros.rs
View File

@@ -152,7 +152,7 @@ macro_rules! is_call {
macro_rules! set_cp {
($r:expr) => (
Line::PolicyExempt(PEInstruction::SetCutPoint($r))
call_clause!(ClauseType::System(SystemClauseType::SetCutPoint($r)), 1, 0)
)
}

33
src/prolog/toplevel.rs
View File

@@ -398,27 +398,20 @@ impl RelationWorker {
Term::Var(_, ref v) if v.as_str() == "!" =>
Ok(QueryTerm::UnblockedCut(Cell::default())),
Term::Clause(r, name, mut terms, fixity) =>
if name.as_str() == ";" {
if terms.len() == 2 {
let term = Term::Clause(r, name.clone(), terms, fixity);
let (stub, clauses) = self.fabricate_disjunct(term);
self.queue.push_back(clauses);
Ok(QueryTerm::Jump(stub))
} else {
Err(ParserError::BuiltInArityMismatch(";"))
}
if name.as_str() == ";" && terms.len() == 2 {
let term = Term::Clause(r, name.clone(), terms, fixity);
let (stub, clauses) = self.fabricate_disjunct(term);
self.queue.push_back(clauses);
Ok(QueryTerm::Jump(stub))
} else if name.as_str() == "->" && terms.len() == 2 {
if terms.len() == 2 {
let conq = *terms.pop().unwrap();
let prec = *terms.pop().unwrap();
let (stub, clauses) = self.fabricate_if_then(prec, conq);
self.queue.push_back(clauses);
Ok(QueryTerm::Jump(stub))
} else {
Err(ParserError::BuiltInArityMismatch("->"))
}
let conq = *terms.pop().unwrap();
let prec = *terms.pop().unwrap();
let (stub, clauses) = self.fabricate_if_then(prec, conq);
self.queue.push_back(clauses);
Ok(QueryTerm::Jump(stub))
} else {
Ok(QueryTerm::Clause(Cell::default(),
ClauseType::from(name, terms.len(), fixity),

11
src/tests.rs
View File

@@ -1201,16 +1201,14 @@ fn test_queries_on_skip_max_list() {
[["Xs = non_list", "N = 0"]]);
}
/*
#[test]
fn test_queries_on_conditionals()
{
let mut wam = Machine::new();
submit(&mut wam, "test(A) :- ( A =:= 2 ->
display(\"A is 2\")
; A =:= 3 ->
display(\"A is 3\")
load_init_str_and_include(&mut wam, BUILTINS, "builtins");
submit(&mut wam, "test(A) :- ( A =:= 2 -> display(\"A is 2\")
; A =:= 3 -> display(\"A is 3\")
; A = \"not 2 or 3\"
).");
@@ -1268,6 +1266,7 @@ fn test_queries_on_conditionals()
[["X = a"], ["X = b"]]);
}
/*
#[test]
fn test_queries_on_builtins()
{