From 7455c2e9db20d5f8aeaaa01d0ed87371e02f7af9 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sat, 12 May 2018 00:30:34 -0600 Subject: [PATCH] add support for callable if-then and disjunct --- src/main.rs | 4 +- src/prolog/ast.rs | 97 +++++++++----- src/prolog/builtins.rs | 2 +- src/prolog/io.rs | 23 +--- src/prolog/lib/builtins.pl | 45 ++++--- src/prolog/machine/machine_state.rs | 24 ++-- src/prolog/machine/machine_state_impl.rs | 138 ++----------------- src/prolog/machine/mod.rs | 7 +- src/prolog/machine/system_calls.rs | 161 +++++++++++++++++------ src/prolog/macros.rs | 2 +- src/prolog/toplevel.rs | 33 ++--- src/tests.rs | 11 +- 12 files changed, 252 insertions(+), 295 deletions(-) diff --git a/src/main.rs b/src/main.rs index 46aa4add..7bae9750 100644 --- a/src/main.rs +++ b/src/main.rs @@ -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> "); diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index 8137dfe8..4a7f747d 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -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 { 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 { 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 { 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 { 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; #[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 for CodePtr { fn partial_cmp(&self, other: &CodePtr) -> Option { 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 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 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), } } } diff --git a/src/prolog/builtins.rs b/src/prolog/builtins.rs index 6996b6ea..d3796300 100644 --- a/src/prolog/builtins.rs +++ b/src/prolog/builtins.rs @@ -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. diff --git a/src/prolog/io.rs b/src/prolog/io.rs index bab5f0e4..c9bea659 100644 --- a/src/prolog/io.rs +++ b/src/prolog/io.rs @@ -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) -> 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 { diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index 2d1856e8..92bcc6e6 100644 --- a/src/prolog/lib/builtins.pl +++ b/src/prolog/lib/builtins.pl @@ -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) :- '$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. +','(!, ','(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, G2, B) :- G2 == !, call(G1), !, '$set_cp'(B). +->(G1, G2, B) :- call(G1), '$set_cp'(B), call(G2). -->(G1, !, B) :- 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). diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index be859058..59efdc47 100644 --- a/src/prolog/machine/machine_state.rs +++ b/src/prolog/machine/machine_state.rs @@ -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; diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 7958abf2..9cd820b8 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -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, - cut_policy: &mut Box, 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::().is_err() { - *cut_policy = Box::new(SetupCallCleanupCutPolicy::new()); - } - - match cut_policy.downcast_mut::().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::().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::().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::().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::().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::() { - 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, cut_policy: &mut Box, @@ -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; + } } } diff --git a/src/prolog/machine/mod.rs b/src/prolog/machine/mod.rs index 5ef8748a..74b261c8 100644 --- a/src/prolog/machine/mod.rs +++ b/src/prolog/machine/mod.rs @@ -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) => diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index 0662876b..ada82b66 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -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, + cut_policy: &mut Box,) + -> 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::().is_err() { + *cut_policy = Box::new(SetupCallCleanupCutPolicy::new()); + } + + match cut_policy.downcast_mut::().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::().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::().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::().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::().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::() { + 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(()) } } diff --git a/src/prolog/macros.rs b/src/prolog/macros.rs index 7881509c..36a1b438 100644 --- a/src/prolog/macros.rs +++ b/src/prolog/macros.rs @@ -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) ) } diff --git a/src/prolog/toplevel.rs b/src/prolog/toplevel.rs index 27986de4..673167f3 100644 --- a/src/prolog/toplevel.rs +++ b/src/prolog/toplevel.rs @@ -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), diff --git a/src/tests.rs b/src/tests.rs index b19cdf79..81a2064f 100644 --- a/src/tests.rs +++ b/src/tests.rs @@ -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() { -- 2.54.0