From a1bfcf4c9d64a8c28d923b18bd576cb8f58aa3d1 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Mon, 7 May 2018 22:24:59 -0600 Subject: [PATCH 01/20] add system call preliminaries --- src/prolog/machine/system_calls.rs | 162 +++++++++++++++++++++++++++++ 1 file changed, 162 insertions(+) create mode 100644 src/prolog/machine/system_calls.rs diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs new file mode 100644 index 00000000..7f0238b2 --- /dev/null +++ b/src/prolog/machine/system_calls.rs @@ -0,0 +1,162 @@ +use prolog::ast::*; +use prolog::machine::machine_errors::*; +use prolog::machine::machine_state::*; +use prolog::num::{ToPrimitive, Zero}; +use prolog::num::bigint::BigInt; + +use std::rc::Rc; + +struct BrentAlgState { + hare: usize, + tortoise: usize, + power: usize, + steps: usize +} + +impl BrentAlgState { + fn new(hare: usize) -> Self { + BrentAlgState { hare, tortoise: hare, power: 2, steps: 1 } + } +} + +impl MachineState { + // a step in Brent's algorithm. + fn brents_alg_step(&self, brent_st: &mut BrentAlgState) -> Option + { + match self.heap[brent_st.hare].clone() { + HeapCellValue::Addr(Addr::Lis(l)) => { + brent_st.hare = l + 1; + brent_st.steps += 1; + + if brent_st.tortoise == brent_st.hare { + return Some(CycleSearchResult::NotList); + } else if brent_st.steps == brent_st.power { + brent_st.tortoise = brent_st.hare; + brent_st.power <<= 1; + } + + None + }, + HeapCellValue::NamedStr(..) => + Some(CycleSearchResult::NotList), + HeapCellValue::Addr(addr) => + match self.store(self.deref(addr)) { + Addr::Con(Constant::EmptyList) => + Some(CycleSearchResult::ProperList(brent_st.steps)), + Addr::HeapCell(_) | Addr::StackCell(..) => + Some(CycleSearchResult::PartialList(brent_st.steps, brent_st.hare)), + _ => + Some(CycleSearchResult::NotList) + } + } + } + + pub(super) fn detect_cycles_with_max(&self, max_steps: usize, addr: Addr) -> CycleSearchResult + { + let addr = self.store(self.deref(addr)); + + let mut hare = match addr { + Addr::Lis(offset) if max_steps > 0 => offset + 1, + Addr::Lis(offset) => return CycleSearchResult::UntouchedList(offset), + Addr::Con(Constant::EmptyList) => return CycleSearchResult::EmptyList, + _ => return CycleSearchResult::NotList + }; + + let mut brent_st = BrentAlgState::new(hare); + + loop { + if brent_st.steps == max_steps { + return CycleSearchResult::PartialList(brent_st.steps, brent_st.hare); + } + + if let Some(result) = self.brents_alg_step(&mut brent_st) { + return result; + } + } + } + + pub(super) fn detect_cycles(&self, addr: Addr) -> CycleSearchResult + { + let addr = self.store(self.deref(addr)); + + let mut hare = match addr { + Addr::Lis(offset) => offset + 1, + Addr::Con(Constant::EmptyList) => return CycleSearchResult::EmptyList, + _ => return CycleSearchResult::NotList + }; + + let mut brent_st = BrentAlgState::new(hare); + + loop { + if let Some(result) = self.brents_alg_step(&mut brent_st) { + return result; + } + } + } + + fn finalize_skip_max_list(&mut self, n: usize, addr: Addr) { + let target_n = self[temp_v!(1)].clone(); + self.unify(Addr::Con(integer!(n)), target_n); + + if !self.fail { + let xs = self[temp_v!(4)].clone(); + self.unify(addr, xs); + } + } + + pub(super) fn skip_max_list(&mut self) -> Result<(), MachineError> { + let max_steps = self.arith_eval_by_metacall(temp_v!(2))?; + + match max_steps { + Number::Integer(ref max_steps) + if max_steps.to_isize().map(|i| i >= -1).unwrap_or(false) => { + let n = self.store(self.deref(self[temp_v!(1)].clone())); + + match n { + Addr::Con(Constant::Number(Number::Integer(ref n))) if n.is_zero() => { + let xs0 = self[temp_v!(3)].clone(); + let xs = self[temp_v!(4)].clone(); + + self.unify(xs0, xs); + }, + _ => { + let search_result = if let Some(max_steps) = max_steps.to_isize() { + if max_steps == -1 { + self.detect_cycles(self[temp_v!(3)].clone()) + } else { + self.detect_cycles_with_max(max_steps as usize, + self[temp_v!(3)].clone()) + } + } else { + self.detect_cycles(self[temp_v!(3)].clone()) + }; + + match search_result { + CycleSearchResult::UntouchedList(l) => + self.finalize_skip_max_list(0, Addr::Lis(l)), + CycleSearchResult::EmptyList => + self.finalize_skip_max_list(0, Addr::Con(Constant::EmptyList)), + CycleSearchResult::PartialList(n, hc) => + self.finalize_skip_max_list(n, Addr::HeapCell(hc)), + CycleSearchResult::ProperList(n) => + self.finalize_skip_max_list(n, Addr::Con(Constant::EmptyList)), + CycleSearchResult::NotList => { + let xs0 = self[temp_v!(3)].clone(); + self.finalize_skip_max_list(0, xs0); + } + } + } + } + }, + _ => self.fail = true + }; + + Ok(()) + } + + pub(super) fn execute_system(&mut self, ct: &SystemClauseType) -> Result<(), MachineError> { + match ct { + &SystemClauseType::SkipMaxList => self.skip_max_list() + } + } +} From 1a0f50200fa53952c73f3f7b8fc1d61f98ddf7f4 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Mon, 7 May 2018 22:27:58 -0600 Subject: [PATCH 02/20] system calls preliminary --- src/prolog/ast.rs | 43 ++++-- src/prolog/builtins.rs | 2 - src/prolog/machine/machine_state.rs | 24 ++-- src/prolog/machine/machine_state_impl.rs | 169 ++--------------------- src/prolog/machine/mod.rs | 1 + 5 files changed, 52 insertions(+), 187 deletions(-) diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index af5e319b..d3dcfc2c 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -683,6 +683,26 @@ pub struct Rule { pub clauses: Vec } +#[derive(Clone)] +pub enum SystemClauseType { + SkipMaxList +} + +impl SystemClauseType { + pub fn name(&self) -> ClauseName { + match self { + &SystemClauseType::SkipMaxList => clause_name!("$skip_max_list"), + } + } + + pub fn from(name: &str, arity: usize) -> Option { + match (name, arity) { + ("$skip_max_list", 4) => Some(SystemClauseType::SkipMaxList), + _ => None + } + } +} + #[derive(Clone)] pub enum ClauseType { AcyclicTerm, @@ -705,8 +725,8 @@ pub enum ClauseType { Op(ClauseName, Fixity, CodeIndex), Named(ClauseName, CodeIndex), SetupCallCleanup, - SkipMaxList, Sort, + System(SystemClauseType), Throw, } @@ -788,14 +808,14 @@ impl ClauseType { pub fn name(&self) -> ClauseName { match self { - &ClauseType::AcyclicTerm => clause_name!("acyclic_term"), + &ClauseType::AcyclicTerm => clause_name!("$acyclic_term"), &ClauseType::Arg => clause_name!("arg"), &ClauseType::CallN => clause_name!("call"), &ClauseType::CallWithInferenceLimit => clause_name!("call_with_inference_limit"), &ClauseType::Catch => clause_name!("catch"), &ClauseType::Compare => clause_name!("compare"), &ClauseType::CompareTerm(qt) => clause_name!(qt.name()), - &ClauseType::CyclicTerm => clause_name!("cyclic_term"), + &ClauseType::CyclicTerm => clause_name!("$cyclic_term"), &ClauseType::Display => clause_name!("display"), &ClauseType::DuplicateTerm => clause_name!("duplicate_term"), &ClauseType::Eq => clause_name!("=="), @@ -803,26 +823,26 @@ impl ClauseType { &ClauseType::Ground => clause_name!("ground"), &ClauseType::Inlined(inlined) => clause_name!(inlined.name()), &ClauseType::Is => clause_name!("is"), - &ClauseType::KeySort => clause_name!("keysort"), + &ClauseType::KeySort => clause_name!("$keysort"), &ClauseType::NotEq => clause_name!("\\=="), &ClauseType::Op(ref name, ..) => name.clone(), &ClauseType::Named(ref name, ..) => name.clone(), &ClauseType::SetupCallCleanup => clause_name!("setup_call_cleanup"), - &ClauseType::SkipMaxList => clause_name!("$skip_max_list"), - &ClauseType::Sort => clause_name!("sort"), + &ClauseType::System(ref system) => system.name(), + &ClauseType::Sort => clause_name!("$sort"), &ClauseType::Throw => clause_name!("throw") } } pub fn from(name: ClauseName, arity: usize, fixity: Option) -> Self { match (name.as_str(), arity) { - ("acyclic_term", 1) => ClauseType::AcyclicTerm, + ("$acyclic_term", 1) => ClauseType::AcyclicTerm, ("arg", 3) => ClauseType::Arg, ("call", _) => ClauseType::CallN, ("call_with_inference_limit", 3) => ClauseType::CallWithInferenceLimit, ("catch", 3) => ClauseType::Catch, ("compare", 3) => ClauseType::Compare, - ("cyclic_term", 1) => ClauseType::CyclicTerm, + ("$cyclic_term", 1) => ClauseType::CyclicTerm, ("@>", 2) => ClauseType::CompareTerm(CompareTermQT::GreaterThan), ("@<", 2) => ClauseType::CompareTerm(CompareTermQT::LessThan), ("@>=", 2) => ClauseType::CompareTerm(CompareTermQT::GreaterThanOrEqual), @@ -835,11 +855,10 @@ impl ClauseType { ("functor", 3) => ClauseType::Functor, ("ground", 1) => ClauseType::Ground, ("is", 2) => ClauseType::Is, - ("keysort", 2) => ClauseType::KeySort, + ("$keysort", 2) => ClauseType::KeySort, ("\\==", 2) => ClauseType::NotEq, - ("setup_call_cleanup", 3) => ClauseType::SetupCallCleanup, - ("$skip_max_list", 4) => ClauseType::SkipMaxList, - ("sort", 2) => ClauseType::Sort, + ("setup_call_cleanup", 3) => ClauseType::SetupCallCleanup, + ("$sort", 2) => ClauseType::Sort, ("throw", 1) => ClauseType::Throw, _ => if let Some(fixity) = fixity { ClauseType::Op(name, fixity, CodeIndex::default()) diff --git a/src/prolog/builtins.rs b/src/prolog/builtins.rs index f23694f6..6633904c 100644 --- a/src/prolog/builtins.rs +++ b/src/prolog/builtins.rs @@ -736,7 +736,6 @@ fn get_builtins() -> Code { keysort_execute!(), // keysort/2, 484. acyclic_term_execute!(), // acyclic_term/1, 485. cyclic_term_execute!(), // cyclic_term/1, 486. - skip_max_list_execute!() // '$skip_max_list', 487. ] } @@ -856,7 +855,6 @@ pub fn build_code_and_op_dirs() -> (CodeDir, OpDir) code_dir.insert((clause_name!("keysort"), 2), CodeIndex::from((484, builtin.clone()))); code_dir.insert((clause_name!("acyclic_term"), 1), CodeIndex::from((485, builtin.clone()))); code_dir.insert((clause_name!("cyclic_term"), 1), CodeIndex::from((486, builtin.clone()))); - code_dir.insert((clause_name!("$skip_max_list"), 4), CodeIndex::from((487, builtin.clone()))); (code_dir, op_dir) } diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index c5f10f98..90b80afc 100644 --- a/src/prolog/machine/machine_state.rs +++ b/src/prolog/machine/machine_state.rs @@ -17,14 +17,14 @@ use std::rc::Rc; pub(super) struct Ball { pub(super) boundary: usize, // ball.0 - pub(super) stub: MachineStub, // ball.1 + pub(super) stub: MachineStub, // ball.1 } impl Ball { pub(super) fn new() -> Self { Ball { boundary: 0, stub: MachineStub::new() } } - + pub(super) fn reset(&mut self) { self.boundary = 0; self.stub.clear(); @@ -502,10 +502,10 @@ pub(crate) trait CallPolicy: Any { }, &ClauseType::Sort => { machine_st.check_sort_errors()?; - + let stub = machine_st.functor_stub(clause_name!("sort"), 2); - let mut list = machine_st.try_from_list(temp_v!(1), stub)?; - + let mut list = machine_st.try_from_list(temp_v!(1), stub)?; + list.sort_unstable_by(|a1, a2| machine_st.compare_term_test(a1, a2)); machine_st.term_dedup(&mut list); @@ -518,11 +518,11 @@ pub(crate) trait CallPolicy: Any { }, &ClauseType::KeySort => { machine_st.check_keysort_errors()?; - + let stub = machine_st.functor_stub(clause_name!("keysort"), 2); let mut list = machine_st.try_from_list(temp_v!(1), stub)?; - let mut key_pairs = Vec::new(); - + let mut key_pairs = Vec::new(); + for val in list { let key = machine_st.project_onto_key(val.clone())?; key_pairs.push((key, val.clone())); @@ -569,11 +569,9 @@ pub(crate) trait CallPolicy: Any { machine_st.execute_inlined(inlined, &vec![temp_v!(1), temp_v!(2)]); Ok(()) }, - &ClauseType::SkipMaxList => { - machine_st.skip_max_list()?; - machine_st.p += 1; - - Ok(()) + &ClauseType::System(ref system) => { + machine_st.execute_system(system)?; + return_from_clause!(lco, machine_st) } } } diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 2392741d..35534955 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -100,12 +100,12 @@ impl MachineState { where Fmt: HCValueFormatter, Outputter: HCValueOutputter { let orig_len = output.len(); - + output.begin_new_var(); output.append(var.as_str()); output.append(" = "); - + let printer = HCPrinter::from_heap_locs(&self, fmt, output, var_dir); let mut output = printer.print(addr); @@ -125,7 +125,7 @@ impl MachineState { let printer = HCPrinter::from_heap_locs_as_seen(&self, fmt, output, var_dir); printer.print(addr) } - + pub(super) fn print_term(&self, addr: Addr, fmt: Fmt, output: Outputter) -> Outputter where Fmt: HCValueFormatter, Outputter: HCValueOutputter @@ -1106,10 +1106,10 @@ impl MachineState { self.heap.h - self.ball.boundary } } - + pub(super) fn copy_and_align_ball_to_heap(&mut self) -> usize { let diff = self.heap_ball_boundary_diff(); - + for heap_value in self.ball.stub.iter().cloned() { self.heap.push(match heap_value { HeapCellValue::Addr(addr) => HeapCellValue::Addr(addr - diff), @@ -1186,7 +1186,7 @@ impl MachineState { self.p += 1; } - + pub(super) fn compare_term(&mut self, qt: CompareTermQT) { let a1 = self[temp_v!(1)].clone(); let a2 = self[temp_v!(2)].clone(); @@ -1441,7 +1441,7 @@ impl MachineState { try_or_fail!(self, call_policy.trust_me(self)); }, &BuiltInInstruction::EraseBall => { - self.ball.reset(); + self.ball.reset(); self.p += 1; }, &BuiltInInstruction::GetArg(lco) => @@ -1621,7 +1621,7 @@ impl MachineState { let mut duplicator = DuplicateBallTerm::new(self); duplicator.duplicate_term(addr); }; - + self.p += 1; }, &BuiltInInstruction::SetCutPoint(r) => @@ -1841,157 +1841,6 @@ impl MachineState { } } - pub(super) fn detect_cycles_with_max(&self, max_steps: usize, addr: Addr) -> CycleSearchResult - { - let addr = self.store(self.deref(addr)); - - let mut hare = match addr { - Addr::Lis(offset) if max_steps > 0 => offset + 1, - Addr::Lis(offset) => return CycleSearchResult::UntouchedList(offset), - Addr::Con(Constant::EmptyList) => return CycleSearchResult::EmptyList, - _ => return CycleSearchResult::NotList - }; - - // use Brent's algorithm to detect cycles. - let mut tortoise = hare; - let mut power = 2; - let mut steps = 1; - - loop { - if steps == max_steps { - return CycleSearchResult::PartialList(steps, hare); - } - - match self.heap[hare].clone() { - HeapCellValue::Addr(Addr::Lis(l)) => { - hare = l + 1; - steps += 1; - - if tortoise == hare { - return CycleSearchResult::NotList; - } else if steps == power { - tortoise = hare; - power <<= 1; - } - }, - HeapCellValue::NamedStr(..) => - return CycleSearchResult::NotList, - HeapCellValue::Addr(addr) => - match self.store(self.deref(addr)) { - Addr::Con(Constant::EmptyList) => - return CycleSearchResult::ProperList(steps), - Addr::HeapCell(_) | Addr::StackCell(..) => - return CycleSearchResult::PartialList(steps, hare), - _ => - return CycleSearchResult::NotList - } - } - } - } - - pub(super) fn detect_cycles(&self, addr: Addr) -> CycleSearchResult - { - let addr = self.store(self.deref(addr)); - - let mut hare = match addr { - Addr::Lis(offset) => offset + 1, - Addr::Con(Constant::EmptyList) => return CycleSearchResult::EmptyList, - _ => return CycleSearchResult::NotList - }; - - // use Brent's algorithm to detect cycles. - let mut tortoise = hare; - let mut power = 2; - let mut steps = 1; - - loop { - match self.heap[hare].clone() { - HeapCellValue::Addr(Addr::Lis(l)) => { - hare = l + 1; - steps += 1; - - if tortoise == hare { - return CycleSearchResult::NotList; - } else if steps == power { - tortoise = hare; - power <<= 1; - } - }, - HeapCellValue::NamedStr(..) => - return CycleSearchResult::NotList, - HeapCellValue::Addr(addr) => - match self.store(self.deref(addr)) { - Addr::Con(Constant::EmptyList) => - return CycleSearchResult::ProperList(steps), - Addr::HeapCell(_) | Addr::StackCell(..) => - return CycleSearchResult::PartialList(steps, hare), - _ => - return CycleSearchResult::NotList - } - } - } - } - - fn finalize_skip_max_list(&mut self, n: usize, addr: Addr) { - let target_n = self[temp_v!(1)].clone(); - self.unify(Addr::Con(integer!(n)), target_n); - - if !self.fail { - let xs = self[temp_v!(4)].clone(); - self.unify(addr, xs); - } - } - - pub(super) fn skip_max_list(&mut self) -> Result<(), MachineError> { - let max_steps = self.arith_eval_by_metacall(temp_v!(2))?; - - match max_steps { - Number::Integer(ref max_steps) - if max_steps.to_isize().map(|i| i >= -1).unwrap_or(false) => { - let n = self.store(self.deref(self[temp_v!(1)].clone())); - - match n { - Addr::Con(Constant::Number(Number::Integer(ref n))) if n.is_zero() => { - let xs0 = self[temp_v!(3)].clone(); - let xs = self[temp_v!(4)].clone(); - - self.unify(xs0, xs); - }, - _ => { - let search_result = if let Some(max_steps) = max_steps.to_isize() { - if max_steps == -1 { - self.detect_cycles(self[temp_v!(3)].clone()) - } else { - self.detect_cycles_with_max(max_steps as usize, - self[temp_v!(3)].clone()) - } - } else { - self.detect_cycles(self[temp_v!(3)].clone()) - }; - - match search_result { - CycleSearchResult::UntouchedList(l) => - self.finalize_skip_max_list(0, Addr::Lis(l)), - CycleSearchResult::EmptyList => - self.finalize_skip_max_list(0, Addr::Con(Constant::EmptyList)), - CycleSearchResult::PartialList(n, hc) => - self.finalize_skip_max_list(n, Addr::HeapCell(hc)), - CycleSearchResult::ProperList(n) => - self.finalize_skip_max_list(n, Addr::Con(Constant::EmptyList)), - CycleSearchResult::NotList => { - let xs0 = self[temp_v!(3)].clone(); - self.finalize_skip_max_list(0, xs0); - } - } - } - } - }, - _ => self.fail = true - }; - - Ok(()) - } - pub(super) fn duplicate_term(&mut self) { let old_h = self.heap.h; @@ -2330,7 +2179,7 @@ impl MachineState { self.or_stack.clear(); self.registers = vec![Addr::HeapCell(0); 64]; self.block = 0; - + self.ball.reset(); } } diff --git a/src/prolog/machine/mod.rs b/src/prolog/machine/mod.rs index f2a4ad81..5df7085c 100644 --- a/src/prolog/machine/mod.rs +++ b/src/prolog/machine/mod.rs @@ -7,6 +7,7 @@ mod machine_errors; pub(super) mod machine_state; #[macro_use] mod machine_state_impl; +mod system_calls; use prolog::machine::machine_state::*; From 24d6fb16a84e7550275315f6734cf06efd5b8abc Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Mon, 7 May 2018 22:29:02 -0600 Subject: [PATCH 03/20] add system call preliminaries --- src/prolog/macros.rs | 6 ------ src/prolog/toplevel.rs | 5 ++++- 2 files changed, 4 insertions(+), 7 deletions(-) diff --git a/src/prolog/macros.rs b/src/prolog/macros.rs index aff35e35..140791f9 100644 --- a/src/prolog/macros.rs +++ b/src/prolog/macros.rs @@ -769,12 +769,6 @@ macro_rules! cyclic_term_execute { ) } -macro_rules! skip_max_list_execute { - () => ( - Line::Control(ControlInstruction::CallClause(ClauseType::SkipMaxList, 4, 0, true)) - ) -} - macro_rules! return_from_clause { ($lco:expr, $machine_st:expr) => {{ if $lco { diff --git a/src/prolog/toplevel.rs b/src/prolog/toplevel.rs index 10cab7db..abab0688 100644 --- a/src/prolog/toplevel.rs +++ b/src/prolog/toplevel.rs @@ -399,7 +399,10 @@ impl RelationWorker { Term::Var(_, ref v) if v.as_str() == "!" => Ok(QueryTerm::UnblockedCut(Cell::default())), Term::Clause(r, name, mut terms, fixity) => - if let Some(inlined_ct) = InlinedClauseType::from(name.as_str(), terms.len()) { + if let Some(system_ct) = SystemClauseType::from(name.as_str(), terms.len()) { + Ok(QueryTerm::Clause(r, ClauseType::System(system_ct), terms)) + } + else if let Some(inlined_ct) = InlinedClauseType::from(name.as_str(), terms.len()) { Ok(QueryTerm::Clause(r, ClauseType::Inlined(inlined_ct), terms)) } else if name.as_str() == ";" { if terms.len() == 2 { From b09c20670b075eeb983c0f4781be4a95c04e5186 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Tue, 8 May 2018 22:38:49 -0600 Subject: [PATCH 04/20] shift to builtins --- src/main.rs | 15 +++- src/prolog/ast.rs | 30 +++++--- src/prolog/builtins.rs | 94 ++++-------------------- src/prolog/io.rs | 12 +-- src/prolog/machine/machine_errors.rs | 4 +- src/prolog/machine/machine_state.rs | 14 +++- src/prolog/machine/machine_state_impl.rs | 19 ++--- src/prolog/machine/mod.rs | 7 +- src/prolog/parser | 2 +- src/prolog/toplevel.rs | 11 ++- 10 files changed, 86 insertions(+), 122 deletions(-) diff --git a/src/main.rs b/src/main.rs index da05f866..1e4a7e29 100644 --- a/src/main.rs +++ b/src/main.rs @@ -1,6 +1,7 @@ #[macro_use] extern crate downcast; extern crate termion; +#[macro_use] mod prolog; use prolog::ast::*; @@ -10,6 +11,7 @@ use prolog::machine::*; #[cfg(test)] mod tests; +pub static BUILTINS: &str = include_str!("./prolog/lib/builtins.pl"); pub static LISTS: &str = include_str!("./prolog/lib/lists.pl"); pub static CONTROL: &str = include_str!("./prolog/lib/control.pl"); pub static QUEUES: &str = include_str!("./prolog/lib/queues.pl"); @@ -33,12 +35,19 @@ fn load_init_str(wam: &mut Machine, src_str: &str) } } +fn load_init_str_and_include(wam: &mut Machine, src_str: &str, module: &'static str) +{ + load_init_str(wam, src_str); + wam.use_module_in_toplevel(clause_name!(module)); +} + fn prolog_repl() { let mut wam = Machine::new(); - load_init_str(&mut wam, LISTS); - load_init_str(&mut wam, CONTROL); - load_init_str(&mut wam, QUEUES); + load_init_str_and_include(&mut wam, BUILTINS, "builtins"); +// load_init_str(&mut wam, LISTS); +// load_init_str(&mut wam, CONTROL); +// load_init_str(&mut wam, QUEUES); loop { print!("prolog> "); diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index d3dcfc2c..969c587d 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -192,11 +192,13 @@ pub trait SubModuleUser { // returns true on successful import. fn import_decl(&mut self, name: ClauseName, arity: usize, submodule: &Module) -> bool { let name = name.defrock_brackets(); - + let mut found_op = false; + { let mut insert_op_dir = |fix| { if let Some(op_data) = submodule.op_dir.get(&(name.clone(), fix)) { self.op_dir().insert((name.clone(), fix), op_data.clone()); + found_op = true; } }; @@ -212,7 +214,7 @@ pub trait SubModuleUser { self.insert_dir_entry(name, arity, code_data.clone()); true } else { - false + found_op } } @@ -227,7 +229,7 @@ pub trait SubModuleUser { return EvalSession::from(SessionError::ModuleDoesNotContainExport); } } - + EvalSession::EntrySuccess } @@ -594,7 +596,7 @@ impl InlinedClauseType { (">", 2) => Some(InlinedClauseType::CompareNumber(CompareNumberQT::GreaterThan)), ("<", 2) => Some(InlinedClauseType::CompareNumber(CompareNumberQT::LessThan)), (">=", 2) => Some(InlinedClauseType::CompareNumber(CompareNumberQT::GreaterThanOrEqual)), - ("<=", 2) => Some(InlinedClauseType::CompareNumber(CompareNumberQT::LessThanOrEqual)), + ("=<", 2) => Some(InlinedClauseType::CompareNumber(CompareNumberQT::LessThanOrEqual)), ("=\\=", 2) => Some(InlinedClauseType::CompareNumber(CompareNumberQT::NotEqual)), ("=:=", 2) => Some(InlinedClauseType::CompareNumber(CompareNumberQT::Equal)), ("atom", 1) => Some(InlinedClauseType::IsAtom), @@ -808,14 +810,14 @@ impl ClauseType { pub fn name(&self) -> ClauseName { match self { - &ClauseType::AcyclicTerm => clause_name!("$acyclic_term"), + &ClauseType::AcyclicTerm => clause_name!("acyclic_term"), &ClauseType::Arg => clause_name!("arg"), &ClauseType::CallN => clause_name!("call"), &ClauseType::CallWithInferenceLimit => clause_name!("call_with_inference_limit"), &ClauseType::Catch => clause_name!("catch"), &ClauseType::Compare => clause_name!("compare"), &ClauseType::CompareTerm(qt) => clause_name!(qt.name()), - &ClauseType::CyclicTerm => clause_name!("$cyclic_term"), + &ClauseType::CyclicTerm => clause_name!("cyclic_term"), &ClauseType::Display => clause_name!("display"), &ClauseType::DuplicateTerm => clause_name!("duplicate_term"), &ClauseType::Eq => clause_name!("=="), @@ -823,26 +825,30 @@ impl ClauseType { &ClauseType::Ground => clause_name!("ground"), &ClauseType::Inlined(inlined) => clause_name!(inlined.name()), &ClauseType::Is => clause_name!("is"), - &ClauseType::KeySort => clause_name!("$keysort"), + &ClauseType::KeySort => clause_name!("keysort"), &ClauseType::NotEq => clause_name!("\\=="), &ClauseType::Op(ref name, ..) => name.clone(), &ClauseType::Named(ref name, ..) => name.clone(), &ClauseType::SetupCallCleanup => clause_name!("setup_call_cleanup"), &ClauseType::System(ref system) => system.name(), - &ClauseType::Sort => clause_name!("$sort"), + &ClauseType::Sort => clause_name!("sort"), &ClauseType::Throw => clause_name!("throw") } } pub fn from(name: ClauseName, arity: usize, fixity: Option) -> Self { + if let Some(inlined_ct) = InlinedClauseType::from(name.as_str(), arity) { + return ClauseType::Inlined(inlined_ct); + } + match (name.as_str(), arity) { - ("$acyclic_term", 1) => ClauseType::AcyclicTerm, + ("acyclic_term", 1) => ClauseType::AcyclicTerm, ("arg", 3) => ClauseType::Arg, ("call", _) => ClauseType::CallN, ("call_with_inference_limit", 3) => ClauseType::CallWithInferenceLimit, ("catch", 3) => ClauseType::Catch, ("compare", 3) => ClauseType::Compare, - ("$cyclic_term", 1) => ClauseType::CyclicTerm, + ("cyclic_term", 1) => ClauseType::CyclicTerm, ("@>", 2) => ClauseType::CompareTerm(CompareTermQT::GreaterThan), ("@<", 2) => ClauseType::CompareTerm(CompareTermQT::LessThan), ("@>=", 2) => ClauseType::CompareTerm(CompareTermQT::GreaterThanOrEqual), @@ -855,10 +861,10 @@ impl ClauseType { ("functor", 3) => ClauseType::Functor, ("ground", 1) => ClauseType::Ground, ("is", 2) => ClauseType::Is, - ("$keysort", 2) => ClauseType::KeySort, + ("keysort", 2) => ClauseType::KeySort, ("\\==", 2) => ClauseType::NotEq, ("setup_call_cleanup", 3) => ClauseType::SetupCallCleanup, - ("$sort", 2) => ClauseType::Sort, + ("sort", 2) => ClauseType::Sort, ("throw", 1) => ClauseType::Throw, _ => if let Some(fixity) = fixity { ClauseType::Op(name, fixity, CodeIndex::default()) diff --git a/src/prolog/builtins.rs b/src/prolog/builtins.rs index 6633904c..0222ecf7 100644 --- a/src/prolog/builtins.rs +++ b/src/prolog/builtins.rs @@ -739,17 +739,17 @@ fn get_builtins() -> Code { ] } -pub fn build_code_and_op_dirs() -> (CodeDir, OpDir) +pub fn default_op_dir() -> OpDir { - let mut code_dir = HashMap::new(); - let mut op_dir = HashMap::new(); - - let builtin = ClauseName::BuiltIn("builtin"); - - op_dir.insert((clause_name!(":-"), Fixity::In), (XFX, 1200, builtin.clone())); - op_dir.insert((clause_name!(":-"), Fixity::Pre), (FX, 1200, builtin.clone())); - op_dir.insert((clause_name!("?-"), Fixity::Pre), (FX, 1200, builtin.clone())); - + let mut op_dir = HashMap::new(); + let module_name = clause_name!("builtins"); + + 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())); + +/* // control operators. op_dir.insert((clause_name!("\\+"), Fixity::Pre), (FY, 900, builtin.clone())); op_dir.insert((clause_name!("="), Fixity::In), (XFX, 700, builtin.clone())); @@ -761,8 +761,7 @@ pub fn build_code_and_op_dirs() -> (CodeDir, OpDir) op_dir.insert((clause_name!("/\\"), Fixity::In), (YFX, 500, builtin.clone())); op_dir.insert((clause_name!("\\/"), Fixity::In), (YFX, 500, builtin.clone())); op_dir.insert((clause_name!("xor"), Fixity::In), (YFX, 500, builtin.clone())); - op_dir.insert((clause_name!("//"), Fixity::In), (YFX, 400, builtin.clone())); - op_dir.insert((clause_name!("/"), Fixity::In), (YFX, 400, builtin.clone())); + op_dir.insert((clause_name!("//"), Fixity::In), (YFX, 400, builtin.clone())); op_dir.insert((clause_name!("div"), Fixity::In), (YFX, 400, builtin.clone())); op_dir.insert((clause_name!("*"), Fixity::In), (YFX, 400, builtin.clone())); op_dir.insert((clause_name!("-"), Fixity::Pre), (FY, 200, builtin.clone())); @@ -819,7 +818,7 @@ pub fn build_code_and_op_dirs() -> (CodeDir, OpDir) code_dir.insert((clause_name!("integer"), 1), CodeIndex::from((163, builtin.clone()))); code_dir.insert((clause_name!("display"), 1), CodeIndex::from((208, builtin.clone()))); - code_dir.insert((clause_name!("is"), 2), CodeIndex::from((210, builtin.clone()))); + //code_dir.insert((clause_name!("is"), 2), CodeIndex::from((210, builtin.clone()))); code_dir.insert((clause_name!(">"), 2), CodeIndex::from((212, builtin.clone()))); code_dir.insert((clause_name!("<"), 2), CodeIndex::from((214, builtin.clone()))); code_dir.insert((clause_name!(">="), 2), CodeIndex::from((216, builtin.clone()))); @@ -851,14 +850,13 @@ pub fn build_code_and_op_dirs() -> (CodeDir, OpDir) code_dir.insert((clause_name!("\\=@="), 2), CodeIndex::from((408, builtin.clone()))); code_dir.insert((clause_name!("compare"), 3), CodeIndex::from((480, builtin.clone()))); code_dir.insert((clause_name!("atom"), 1), CodeIndex::from((481, builtin.clone()))); - code_dir.insert((clause_name!("sort"), 2), CodeIndex::from((483, builtin.clone()))); - code_dir.insert((clause_name!("keysort"), 2), CodeIndex::from((484, builtin.clone()))); - code_dir.insert((clause_name!("acyclic_term"), 1), CodeIndex::from((485, builtin.clone()))); - code_dir.insert((clause_name!("cyclic_term"), 1), CodeIndex::from((486, builtin.clone()))); (code_dir, op_dir) + */ + op_dir } +/* pub fn default_build() -> (Code, CodeDir, OpDir) { let builtin_code = get_builtins(); @@ -866,64 +864,4 @@ pub fn default_build() -> (Code, CodeDir, OpDir) (builtin_code, code_dir, op_dir) } - -#[allow(dead_code)] -pub fn builtin_module() -> Module -{ - let (code_dir, op_dir) = build_code_and_op_dirs(); - let mut module_decl = module_decl!(clause_name!("builtin"), - vec![(clause_name!("atomic"), 1), - (clause_name!("var"), 1), - (clause_name!("false"), 0), - (clause_name!("catch"), 3), - (clause_name!("throw"), 1), - (clause_name!("(\\+)"), 1), - (clause_name!("duplicate_term"), 2), - (clause_name!("(=)"), 2), - (clause_name!("true"), 0), - (clause_name!("(,)"), 2), - (clause_name!("(;)"), 2), - (clause_name!("->"), 2), - (clause_name!("functor"), 3), - (clause_name!("arg"), 3), - (clause_name!("(=..)"), 3), - (clause_name!("display"), 1), - (clause_name!("is"), 2), - (clause_name!("(>)"), 2), - (clause_name!("(<)"), 2), - (clause_name!("(>=)"), 2), - (clause_name!("(=<)"), 2), - (clause_name!("(=\\=)"), 2), - (clause_name!("(=:=)"), 2), - (clause_name!("(@>)"), 2), - (clause_name!("(@<)"), 2), - (clause_name!("(@>=)"), 2), - (clause_name!("(@=<)"), 2), - (clause_name!("(=@=)"), 2), - (clause_name!("(\\=@=)"), 2), - (clause_name!("(==)"), 2), - (clause_name!("(\\==)"), 2), - (clause_name!("length"), 2), - (clause_name!("compound"), 1), - (clause_name!("rational"), 1), - (clause_name!("integer"), 1), - (clause_name!("string"), 1), - (clause_name!("float"), 1), - (clause_name!("nonvar"), 1), - (clause_name!("ground"), 1), - (clause_name!("setup_call_cleanup"), 3), - (clause_name!("call_with_inference_limit"), 3), - (clause_name!("compare"), 3), - (clause_name!("atom"), 1), - (clause_name!("sort"), 2), - (clause_name!("keysort"), 2), - (clause_name!("acyclic_term"), 1), - (clause_name!("cyclic_term"), 1), - (clause_name!("$skip_max_list"), 4)]); - - for arity in 0 .. 63 { - module_decl.exports.push((clause_name!("call"), arity)); - } - - Module { module_decl, code_dir: as_module_code_dir(code_dir), op_dir } -} +*/ diff --git a/src/prolog/io.rs b/src/prolog/io.rs index e51635d3..eceacfa1 100644 --- a/src/prolog/io.rs +++ b/src/prolog/io.rs @@ -550,7 +550,7 @@ fn compile_query(terms: Vec, queue: Vec, code_size: usize, let mut code = try!(cg.compile_query(&terms)); compile_appendix(&mut code, queue)?; - + let query_info = QueryInfo {}; query_info.label_clauses(code_size, code_dir, &mut code); @@ -617,7 +617,9 @@ pub fn compile_listing(wam: &mut Machine, src_str: &str) -> EvalSession } let mut module: Option = None; - let (mut code_dir, mut op_dir) = build_code_and_op_dirs(); + + let mut code_dir = CodeDir::new(); + let mut op_dir = default_op_dir(); let mut code = Vec::new(); @@ -630,10 +632,10 @@ pub fn compile_listing(wam: &mut Machine, src_str: &str) -> EvalSession return EvalSession::from(ParserError::ExpectedRel), TopLevelPacket::Decl(TopLevel::Declaration(Declaration::Module(module_decl)), _) => if module.is_none() { - let (builtin_code_dir, builtin_op_dir) = build_code_and_op_dirs(); + // let builtin_op_dir = default_module_setup(module_decl.name.clone()); - code_dir.extend(builtin_code_dir.into_iter()); - op_dir.extend(builtin_op_dir.into_iter()); + // code_dir.extend(builtin_code_dir.into_iter()); + // op_dir.extend(builtin_op_dir.into_iter()); module = Some(Module::new(module_decl)); } else { diff --git a/src/prolog/machine/machine_errors.rs b/src/prolog/machine/machine_errors.rs index e16111d8..984cf4d2 100644 --- a/src/prolog/machine/machine_errors.rs +++ b/src/prolog/machine/machine_errors.rs @@ -141,6 +141,8 @@ impl MachineState { self.heap.append(err); self.registers[1] = Addr::HeapCell(h); - self.goto_throw(); + + self.set_ball(); + self.unwind_stack(); } } diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index 90b80afc..f9dad13e 100644 --- a/src/prolog/machine/machine_state.rs +++ b/src/prolog/machine/machine_state.rs @@ -434,10 +434,16 @@ pub(crate) trait CallPolicy: Any { }, &ClauseType::CallN => if let Some((name, arity)) = machine_st.setup_call_n(arity) { - if let Some(idx) = code_dirs.get(name.clone(), arity, clause_name!("user")) { - self.context_call(machine_st, name, arity, idx, lco) - } else { - Err(machine_st.existence_error(name, arity)) + let user = clause_name!("user"); + + match ClauseType::from(name.clone(), arity, None) { + ClauseType::Op(..) | ClauseType::Named(..) => + if let Some(idx) = code_dirs.get(name.clone(), arity, user) { + self.context_call(machine_st, name, arity, idx, lco) + } else { + Err(machine_st.existence_error(name, arity)) + }, + ct => self.try_call_clause(machine_st, code_dirs, &ct, arity, lco), } } else { Ok(()) diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 35534955..5665eea2 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -1041,7 +1041,15 @@ impl MachineState { self.p = CodePtr::DirEntry(59, clause_name!("builtin")); } - fn unwind_stack(&mut self) { + pub(super) fn set_ball(&mut self) { + let addr = self[temp_v!(1)].clone(); + self.ball.boundary = self.heap.h; + + let mut duplicator = DuplicateBallTerm::new(self); + duplicator.duplicate_term(addr); + } + + pub(super) fn unwind_stack(&mut self) { self.b = self.block; self.or_stack.truncate(self.b); @@ -1614,14 +1622,7 @@ impl MachineState { self.p += 1; }, &BuiltInInstruction::SetBall => { - let addr = self[temp_v!(1)].clone(); - self.ball.boundary = self.heap.h; - - { - let mut duplicator = DuplicateBallTerm::new(self); - duplicator.duplicate_term(addr); - }; - + self.set_ball(); self.p += 1; }, &BuiltInInstruction::SetCutPoint(r) => diff --git a/src/prolog/machine/mod.rs b/src/prolog/machine/mod.rs index 5df7085c..5377949e 100644 --- a/src/prolog/machine/mod.rs +++ b/src/prolog/machine/mod.rs @@ -70,14 +70,15 @@ impl<'a> SubModuleUser for MachineCodeIndex<'a> { impl Machine { pub fn new() -> Self { let atom_tbl = Rc::new(RefCell::new(HashSet::new())); - let (code, code_dir, op_dir) = default_build(); + let op_dir = default_op_dir(); //TODO: change to the builtins module once it's done. + //let (code, code_dir, op_dir) = default_build(); Machine { ms: MachineState::new(atom_tbl), call_policy: Box::new(DefaultCallPolicy {}), cut_policy: Box::new(DefaultCutPolicy {}), - code, - code_dir, + code: Code::new(), + code_dir: CodeDir::new(), term_dir: TermDir::new(), op_dir, modules: HashMap::new(), diff --git a/src/prolog/parser b/src/prolog/parser index 1b3bcc77..51e38dd2 160000 --- a/src/prolog/parser +++ b/src/prolog/parser @@ -1 +1 @@ -Subproject commit 1b3bcc77f2b9d264c9753653ae87bfa3b4c11081 +Subproject commit 51e38dd24252431432ec7deb5ad80e2fc11a5753 diff --git a/src/prolog/toplevel.rs b/src/prolog/toplevel.rs index abab0688..3c122dfc 100644 --- a/src/prolog/toplevel.rs +++ b/src/prolog/toplevel.rs @@ -393,17 +393,13 @@ impl RelationWorker { if name.as_str() == "!" || name.as_str() == "blocked_!" { Ok(QueryTerm::BlockedCut) } else { - Ok(QueryTerm::Clause(r, ClauseType::Named(name, CodeIndex::default()), - vec![])) + Ok(QueryTerm::Clause(r, ClauseType::Named(name, CodeIndex::default()), vec![])) }, Term::Var(_, ref v) if v.as_str() == "!" => Ok(QueryTerm::UnblockedCut(Cell::default())), Term::Clause(r, name, mut terms, fixity) => if let Some(system_ct) = SystemClauseType::from(name.as_str(), terms.len()) { Ok(QueryTerm::Clause(r, ClauseType::System(system_ct), terms)) - } - else if let Some(inlined_ct) = InlinedClauseType::from(name.as_str(), terms.len()) { - Ok(QueryTerm::Clause(r, ClauseType::Inlined(inlined_ct), terms)) } else if name.as_str() == ";" { if terms.len() == 2 { let term = Term::Clause(r, name.clone(), terms, fixity); @@ -612,7 +608,10 @@ impl TopLevelWorker { }; } - results.push(deque_to_packet(append_preds(&mut preds), rel_worker.parse_queue()?)); + if !preds.is_empty() { + results.push(deque_to_packet(append_preds(&mut preds), rel_worker.parse_queue()?)); + } + Ok(results) } From bae107f8cdf149f32eac76f19ab5dff238962fcc Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Wed, 9 May 2018 22:58:23 -0600 Subject: [PATCH 05/20] eliminate need for embedded, handwritten WAM code. --- src/prolog/and_stack.rs | 6 +- src/prolog/ast.rs | 387 ++++++++++----- src/prolog/builtins.rs | 7 +- src/prolog/codegen.rs | 25 +- src/prolog/io.rs | 6 - src/prolog/iterators.rs | 3 +- src/prolog/lib/builtins.pl | 29 ++ src/prolog/machine/machine_state.rs | 166 +++---- src/prolog/machine/machine_state_impl.rs | 173 ++++--- src/prolog/machine/mod.rs | 76 +-- src/prolog/macros.rs | 601 ++--------------------- src/prolog/or_stack.rs | 6 +- src/prolog/toplevel.rs | 8 +- 13 files changed, 550 insertions(+), 943 deletions(-) create mode 100644 src/prolog/lib/builtins.pl diff --git a/src/prolog/and_stack.rs b/src/prolog/and_stack.rs index 3e2e653d..fdf22c29 100644 --- a/src/prolog/and_stack.rs +++ b/src/prolog/and_stack.rs @@ -7,12 +7,12 @@ use std::vec::Vec; pub struct Frame { pub global_index: usize, pub e: usize, - pub cp: CodePtr, + pub cp: LocalCodePtr, perms: Vec } impl Frame { - fn new(global_index: usize, fr: usize, e: usize, cp: CodePtr, n: usize) -> Self { + fn new(global_index: usize, fr: usize, e: usize, cp: LocalCodePtr, n: usize) -> Self { Frame { global_index, e: e, @@ -29,7 +29,7 @@ impl AndStack { AndStack(Vec::new()) } - pub fn push(&mut self, global_index: usize, e: usize, cp: CodePtr, n: usize) { + pub fn push(&mut self, global_index: usize, e: usize, cp: LocalCodePtr, n: usize) { let len = self.0.len(); self.0.push(Frame::new(global_index, len, e, cp, n)); } diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index 969c587d..34623fee 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -193,7 +193,7 @@ pub trait SubModuleUser { fn import_decl(&mut self, name: ClauseName, arity: usize, submodule: &Module) -> bool { let name = name.defrock_brackets(); let mut found_op = false; - + { let mut insert_op_dir = |fix| { if let Some(op_data) = submodule.op_dir.get(&(name.clone(), fix)) { @@ -229,7 +229,7 @@ pub trait SubModuleUser { return EvalSession::from(SessionError::ModuleDoesNotContainExport); } } - + EvalSession::EntrySuccess } @@ -561,59 +561,83 @@ pub enum Term { Var(Cell, Rc) } -#[derive(Clone, Copy)] +#[derive(Clone, Copy, PartialEq)] pub enum InlinedClauseType { - CompareNumber(CompareNumberQT), - IsAtom, - IsAtomic, - IsCompound, - IsInteger, - IsRational, - IsString, - IsFloat, - IsNonVar, - IsVar, + CompareNumber(CompareNumberQT, RegType, RegType), + IsAtom(RegType), + IsAtomic(RegType), + IsCompound(RegType), + IsInteger(RegType), + IsRational(RegType), + IsString(RegType), + IsFloat(RegType), + IsNonVar(RegType), + IsVar(RegType), } impl InlinedClauseType { pub fn name(&self) -> &'static str { match self { - &InlinedClauseType::CompareNumber(qt) => qt.name(), - &InlinedClauseType::IsAtom => "atom", - &InlinedClauseType::IsAtomic => "atomic", - &InlinedClauseType::IsCompound => "compound", - &InlinedClauseType::IsInteger => "integer", - &InlinedClauseType::IsRational => "rational", - &InlinedClauseType::IsString => "string", - &InlinedClauseType::IsFloat => "float", - &InlinedClauseType::IsNonVar => "nonvar", - &InlinedClauseType::IsVar => "var" + &InlinedClauseType::CompareNumber(qt, ..) => qt.name(), + &InlinedClauseType::IsAtom(..) => "atom", + &InlinedClauseType::IsAtomic(..) => "atomic", + &InlinedClauseType::IsCompound(..) => "compound", + &InlinedClauseType::IsInteger (..) => "integer", + &InlinedClauseType::IsRational(..) => "rational", + &InlinedClauseType::IsString(..) => "string", + &InlinedClauseType::IsFloat (..) => "float", + &InlinedClauseType::IsNonVar(..) => "nonvar", + &InlinedClauseType::IsVar(..) => "var" } } + pub fn arity(&self) -> usize { + match self { + &InlinedClauseType::CompareNumber(..) => 2, + &InlinedClauseType::IsAtom(..) => 1, + &InlinedClauseType::IsAtomic(..) => 1, + &InlinedClauseType::IsCompound(..) => 1, + &InlinedClauseType::IsInteger (..) => 1, + &InlinedClauseType::IsRational(..) => 1, + &InlinedClauseType::IsString(..) => 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); + match (name, arity) { - (">", 2) => Some(InlinedClauseType::CompareNumber(CompareNumberQT::GreaterThan)), - ("<", 2) => Some(InlinedClauseType::CompareNumber(CompareNumberQT::LessThan)), - (">=", 2) => Some(InlinedClauseType::CompareNumber(CompareNumberQT::GreaterThanOrEqual)), - ("=<", 2) => Some(InlinedClauseType::CompareNumber(CompareNumberQT::LessThanOrEqual)), - ("=\\=", 2) => Some(InlinedClauseType::CompareNumber(CompareNumberQT::NotEqual)), - ("=:=", 2) => Some(InlinedClauseType::CompareNumber(CompareNumberQT::Equal)), - ("atom", 1) => Some(InlinedClauseType::IsAtom), - ("atomic", 1) => Some(InlinedClauseType::IsAtomic), - ("compound", 1) => Some(InlinedClauseType::IsCompound), - ("integer", 1) => Some(InlinedClauseType::IsInteger), - ("rational", 1) => Some(InlinedClauseType::IsRational), - ("string", 1) => Some(InlinedClauseType::IsString), - ("float", 1) => Some(InlinedClauseType::IsFloat), - ("nonvar", 1) => Some(InlinedClauseType::IsNonVar), - ("var", 1) => Some(InlinedClauseType::IsVar), + (">", 2) => + Some(InlinedClauseType::CompareNumber(CompareNumberQT::GreaterThan, r1, r2)), + ("<", 2) => + Some(InlinedClauseType::CompareNumber(CompareNumberQT::LessThan, r1, r2)), + (">=", 2) => + Some(InlinedClauseType::CompareNumber(CompareNumberQT::GreaterThanOrEqual,r1, r2)), + ("=<", 2) => + Some(InlinedClauseType::CompareNumber(CompareNumberQT::LessThanOrEqual, r1, r2)), + ("=\\=", 2) => + Some(InlinedClauseType::CompareNumber(CompareNumberQT::NotEqual, r1, r2)), + ("=:=", 2) => + Some(InlinedClauseType::CompareNumber(CompareNumberQT::Equal, r1, r2)), + ("atom", 1) => Some(InlinedClauseType::IsAtom(r1)), + ("atomic", 1) => Some(InlinedClauseType::IsAtomic(r1)), + ("compound", 1) => Some(InlinedClauseType::IsCompound(r1)), + ("integer", 1) => Some(InlinedClauseType::IsInteger(r1)), + ("rational", 1) => Some(InlinedClauseType::IsRational(r1)), + ("string", 1) => Some(InlinedClauseType::IsString(r1)), + ("float", 1) => Some(InlinedClauseType::IsFloat(r1)), + ("nonvar", 1) => Some(InlinedClauseType::IsNonVar(r1)), + ("var", 1) => Some(InlinedClauseType::IsVar(r1)), _ => None } } } -#[derive(Clone, Copy)] +#[derive(Clone, Copy, PartialEq)] pub enum CompareNumberQT { GreaterThan, LessThan, @@ -636,7 +660,7 @@ impl CompareNumberQT { } } -#[derive(Clone, Copy)] +#[derive(Clone, Copy, PartialEq)] pub enum CompareTermQT { LessThan, LessThanOrEqual, @@ -685,18 +709,28 @@ pub struct Rule { pub clauses: Vec } -#[derive(Clone)] +#[derive(Copy, Clone, PartialEq)] pub enum SystemClauseType { SkipMaxList } impl SystemClauseType { + pub fn arity(&self) -> usize { + match self { + &SystemClauseType::SkipMaxList => 4 + } + } + + pub fn fixity(&self) -> Option { + None + } + pub fn name(&self) -> ClauseName { match self { &SystemClauseType::SkipMaxList => clause_name!("$skip_max_list"), } } - + pub fn from(name: &str, arity: usize) -> Option { match (name, arity) { ("$skip_max_list", 4) => Some(SystemClauseType::SkipMaxList), @@ -705,13 +739,9 @@ impl SystemClauseType { } } -#[derive(Clone)] -pub enum ClauseType { - AcyclicTerm, - Arg, - CallN, - CallWithInferenceLimit, - Catch, +#[derive(Copy, Clone, PartialEq)] +pub enum BuiltInClauseType { + AcyclicTerm, Compare, CompareTerm(CompareTermQT), CyclicTerm, @@ -720,16 +750,20 @@ pub enum ClauseType { Eq, Functor, Ground, - Inlined(InlinedClauseType), Is, KeySort, NotEq, - Op(ClauseName, Fixity, CodeIndex), - Named(ClauseName, CodeIndex), - SetupCallCleanup, Sort, - System(SystemClauseType), - Throw, + System(SystemClauseType) +} + +#[derive(Clone)] +pub enum ClauseType { + BuiltIn(BuiltInClauseType), + CallN, + Inlined(InlinedClauseType), + Op(ClauseName, Fixity, CodeIndex), + Named(ClauseName, CodeIndex) } #[derive(Clone)] @@ -797,12 +831,84 @@ impl ClauseName { } } +impl BuiltInClauseType { + fn fixity(&self) -> Option { + match self { + &BuiltInClauseType::Compare | &BuiltInClauseType::CompareTerm(_) + | &BuiltInClauseType::NotEq | &BuiltInClauseType::Is | &BuiltInClauseType::Eq + => Some(Fixity::In), + _ => None + } + } + + pub fn name(&self) -> ClauseName { + match self { + &BuiltInClauseType::AcyclicTerm => clause_name!("acyclic_term"), + &BuiltInClauseType::Compare => clause_name!("compare"), + &BuiltInClauseType::CompareTerm(qt) => clause_name!(qt.name()), + &BuiltInClauseType::CyclicTerm => clause_name!("cyclic_term"), + &BuiltInClauseType::Display => clause_name!("display"), + &BuiltInClauseType::DuplicateTerm => clause_name!("duplicate_term"), + &BuiltInClauseType::Eq => clause_name!("=="), + &BuiltInClauseType::Functor => clause_name!("functor"), + &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::System(system) => system.name() + } + } + + pub fn arity(&self) -> usize { + match self { + &BuiltInClauseType::AcyclicTerm => 1, + &BuiltInClauseType::Compare => 2, + &BuiltInClauseType::CompareTerm(_) => 2, + &BuiltInClauseType::CyclicTerm => 1, + &BuiltInClauseType::Display => 1, + &BuiltInClauseType::DuplicateTerm => 2, + &BuiltInClauseType::Eq => 2, + &BuiltInClauseType::Functor => 3, + &BuiltInClauseType::Ground => 1, + &BuiltInClauseType::Is => 2, + &BuiltInClauseType::KeySort => 2, + &BuiltInClauseType::NotEq => 2, + &BuiltInClauseType::Sort => 2, + &BuiltInClauseType::System(system) => system.arity() + } + } + + pub fn from(name: &str, arity: usize) -> Option { + match (name, arity) { + ("acyclic_term", 1) => Some(BuiltInClauseType::AcyclicTerm), + ("compare", 3) => Some(BuiltInClauseType::Compare), + ("cyclic_term", 1) => Some(BuiltInClauseType::CyclicTerm), + ("@>", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::GreaterThan)), + ("@<", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::LessThan)), + ("@>=", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::GreaterThanOrEqual)), + ("@<=", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::LessThanOrEqual)), + ("\\=@=", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::NotEqual)), + ("=@=", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::Equal)), + ("display", 1) => Some(BuiltInClauseType::Display), + ("duplicate_term", 2) => Some(BuiltInClauseType::DuplicateTerm), + ("==", 2) => Some(BuiltInClauseType::Eq), + ("functor", 3) => Some(BuiltInClauseType::Functor), + ("ground", 1) => Some(BuiltInClauseType::Ground), + ("is", 2) => Some(BuiltInClauseType::Is), + ("keysort", 2) => Some(BuiltInClauseType::KeySort), + ("\\==", 2) => Some(BuiltInClauseType::NotEq), + ("sort", 2) => Some(BuiltInClauseType::Sort), + _ => SystemClauseType::from(name, arity).map(BuiltInClauseType::System) + } + } +} + impl ClauseType { pub fn fixity(&self) -> Option { match self { - &ClauseType::Compare | &ClauseType::CompareTerm(_) - | &ClauseType::Inlined(InlinedClauseType::CompareNumber(_)) - | &ClauseType::NotEq | &ClauseType::Is | &ClauseType::Eq => Some(Fixity::In), + &ClauseType::BuiltIn(ref built_in) => built_in.fixity(), + &ClauseType::Inlined(InlinedClauseType::CompareNumber(..)) => Some(Fixity::In), &ClauseType::Op(_, fixity, _) => Some(fixity), _ => None } @@ -810,68 +916,30 @@ impl ClauseType { pub fn name(&self) -> ClauseName { match self { - &ClauseType::AcyclicTerm => clause_name!("acyclic_term"), - &ClauseType::Arg => clause_name!("arg"), - &ClauseType::CallN => clause_name!("call"), - &ClauseType::CallWithInferenceLimit => clause_name!("call_with_inference_limit"), - &ClauseType::Catch => clause_name!("catch"), - &ClauseType::Compare => clause_name!("compare"), - &ClauseType::CompareTerm(qt) => clause_name!(qt.name()), - &ClauseType::CyclicTerm => clause_name!("cyclic_term"), - &ClauseType::Display => clause_name!("display"), - &ClauseType::DuplicateTerm => clause_name!("duplicate_term"), - &ClauseType::Eq => clause_name!("=="), - &ClauseType::Functor => clause_name!("functor"), - &ClauseType::Ground => clause_name!("ground"), + &ClauseType::CallN => clause_name!("call"), + &ClauseType::BuiltIn(built_in) => built_in.name(), &ClauseType::Inlined(inlined) => clause_name!(inlined.name()), - &ClauseType::Is => clause_name!("is"), - &ClauseType::KeySort => clause_name!("keysort"), - &ClauseType::NotEq => clause_name!("\\=="), &ClauseType::Op(ref name, ..) => name.clone(), &ClauseType::Named(ref name, ..) => name.clone(), - &ClauseType::SetupCallCleanup => clause_name!("setup_call_cleanup"), - &ClauseType::System(ref system) => system.name(), - &ClauseType::Sort => clause_name!("sort"), - &ClauseType::Throw => clause_name!("throw") } } pub fn from(name: ClauseName, arity: usize, fixity: Option) -> Self { - if let Some(inlined_ct) = InlinedClauseType::from(name.as_str(), arity) { - return ClauseType::Inlined(inlined_ct); - } - - match (name.as_str(), arity) { - ("acyclic_term", 1) => ClauseType::AcyclicTerm, - ("arg", 3) => ClauseType::Arg, - ("call", _) => ClauseType::CallN, - ("call_with_inference_limit", 3) => ClauseType::CallWithInferenceLimit, - ("catch", 3) => ClauseType::Catch, - ("compare", 3) => ClauseType::Compare, - ("cyclic_term", 1) => ClauseType::CyclicTerm, - ("@>", 2) => ClauseType::CompareTerm(CompareTermQT::GreaterThan), - ("@<", 2) => ClauseType::CompareTerm(CompareTermQT::LessThan), - ("@>=", 2) => ClauseType::CompareTerm(CompareTermQT::GreaterThanOrEqual), - ("@<=", 2) => ClauseType::CompareTerm(CompareTermQT::LessThanOrEqual), - ("\\=@=", 2) => ClauseType::CompareTerm(CompareTermQT::NotEqual), - ("=@=", 2) => ClauseType::CompareTerm(CompareTermQT::Equal), - ("display", 1) => ClauseType::Display, - ("duplicate_term", 2) => ClauseType::DuplicateTerm, - ("==", 2) => ClauseType::Eq, - ("functor", 3) => ClauseType::Functor, - ("ground", 1) => ClauseType::Ground, - ("is", 2) => ClauseType::Is, - ("keysort", 2) => ClauseType::KeySort, - ("\\==", 2) => ClauseType::NotEq, - ("setup_call_cleanup", 3) => ClauseType::SetupCallCleanup, - ("sort", 2) => ClauseType::Sort, - ("throw", 1) => ClauseType::Throw, - _ => if let Some(fixity) = fixity { - ClauseType::Op(name, fixity, CodeIndex::default()) - } else { - ClauseType::Named(name, CodeIndex::default()) - } - } + InlinedClauseType::from(name.as_str(), arity) + .map(ClauseType::Inlined) + .unwrap_or_else(|| { + BuiltInClauseType::from(name.as_str(), arity) + .map(ClauseType::BuiltIn) + .unwrap_or_else(|| { + if let Some(fixity) = fixity { + ClauseType::Op(name, fixity, CodeIndex::default()) + } else if name.as_str() == "call" { + ClauseType::CallN + } else { + ClauseType::Named(name, CodeIndex::default()) + } + }) + }) } } @@ -902,18 +970,21 @@ impl<'a> TermRef<'a> { } } +#[derive(Clone)] pub enum ChoiceInstruction { RetryMeElse(usize), TrustMe, TryMeElse(usize) } +#[derive(Clone)] pub enum CutInstruction { Cut(RegType), GetLevel(RegType), NeckCut } +#[derive(Clone)] pub enum IndexedChoiceInstruction { Retry(usize), Trust(usize), @@ -1219,6 +1290,7 @@ impl ArithmeticTerm { } } +#[derive(Clone)] pub enum ArithmeticInstruction { Add(ArithmeticTerm, ArithmeticTerm, usize), Sub(ArithmeticTerm, ArithmeticTerm, usize), @@ -1237,8 +1309,8 @@ pub enum ArithmeticInstruction { Neg(ArithmeticTerm, usize) } +#[derive(Clone)] pub enum BuiltInInstruction { - CallInlined(InlinedClauseType, Vec), CleanUpBlock, CompareNumber(CompareNumberQT, ArithmeticTerm, ArithmeticTerm), DefaultRetryMeElse(usize), @@ -1254,13 +1326,12 @@ pub enum BuiltInInstruction { InstallCleaner, InstallInferenceCounter(RegType, RegType, RegType), InstallNewBlock, - InternalCallN, RemoveCallPolicyCheck, RemoveInferenceCounter(RegType, RegType), ResetBlock, RestoreCutPolicy, SetBall, - SetCutPoint(RegType), + SetCutPoint(RegType), Succeed, Unify, UnwindStack @@ -1292,6 +1363,7 @@ impl ControlInstruction { } } +#[derive(Clone)] pub enum IndexingInstruction { SwitchOnTerm(usize, usize, usize, usize), SwitchOnConstant(usize, HashMap), @@ -1304,6 +1376,7 @@ impl From for Line { } } +#[derive(Clone)] pub enum FactInstruction { GetConstant(Level, Constant, RegType), GetList(Level, RegType), @@ -1317,6 +1390,7 @@ pub enum FactInstruction { UnifyVoid(usize) } +#[derive(Clone)] pub enum QueryInstruction { GetVariable(RegType, usize), PutConstant(Level, Constant, RegType), @@ -1336,6 +1410,7 @@ pub type CompiledFact = Vec; pub type CompiledQuery = Vec; +#[derive(Clone)] pub enum Line { Arithmetic(ArithmeticInstruction), BuiltIn(BuiltInInstruction), @@ -1474,27 +1549,60 @@ impl From<(usize, ClauseName)> for CodeIndex { #[derive(Clone, PartialEq)] pub enum CodePtr { + BuiltInClause(BuiltInClauseType, LocalCodePtr), // local is the successor call. + CallN(usize, LocalCodePtr), // the arity of the call, successor call. + Local(LocalCodePtr) +} + +impl CodePtr { + pub fn local(&self) -> LocalCodePtr { + match self { + &CodePtr::BuiltInClause(_, ref local) + | &CodePtr::CallN(_, ref local) + | &CodePtr::Local(ref local) => local.clone() + } + } +} + +#[derive(Clone, PartialEq)] +pub enum LocalCodePtr { DirEntry(usize, ClauseName), // offset, resident module name. TopLevel(usize, usize) // chunk_num, offset. } -impl CodePtr { +impl LocalCodePtr { pub fn module_name(&self) -> ClauseName { match self { - &CodePtr::DirEntry(_, ref name) => name.clone(), + &LocalCodePtr::DirEntry(_, ref name) => name.clone(), _ => ClauseName::BuiltIn("user") } } + + pub fn assign_if_local(&mut self, cp: CodePtr) { + match cp { + CodePtr::Local(local) => *self = local, + _ => {} + } + } } impl PartialOrd for CodePtr { fn partial_cmp(&self, other: &CodePtr) -> Option { match (self, other) { - (&CodePtr::DirEntry(p1, _), &CodePtr::DirEntry(p2, _)) => + (&CodePtr::Local(ref l1), &CodePtr::Local(ref l2)) => l1.partial_cmp(l2), + _ => Some(Ordering::Greater) + } + } +} + +impl PartialOrd for LocalCodePtr { + fn partial_cmp(&self, other: &LocalCodePtr) -> Option { + match (self, other) { + (&LocalCodePtr::DirEntry(p1, _), &LocalCodePtr::DirEntry(p2, _)) => p1.partial_cmp(&p2), - (&CodePtr::DirEntry(..), &CodePtr::TopLevel(_, _)) => + (&LocalCodePtr::DirEntry(..), &LocalCodePtr::TopLevel(_, _)) => Some(Ordering::Less), - (&CodePtr::TopLevel(_, p1), &CodePtr::TopLevel(_, ref p2)) => + (&LocalCodePtr::TopLevel(_, p1), &LocalCodePtr::TopLevel(_, ref p2)) => p1.partial_cmp(p2), _ => Some(Ordering::Greater) } @@ -1503,7 +1611,33 @@ impl PartialOrd for CodePtr { impl Default for CodePtr { fn default() -> Self { - CodePtr::TopLevel(0, 0) + CodePtr::Local(LocalCodePtr::default()) + } +} + +impl Default for LocalCodePtr { + fn default() -> Self { + LocalCodePtr::TopLevel(0, 0) + } +} + +impl Add for LocalCodePtr { + type Output = LocalCodePtr; + + fn add(self, rhs: usize) -> Self::Output { + match self { + LocalCodePtr::DirEntry(p, name) => LocalCodePtr::DirEntry(p + rhs, name), + LocalCodePtr::TopLevel(cn, p) => LocalCodePtr::TopLevel(cn, p + rhs) + } + } +} + +impl AddAssign for LocalCodePtr { + fn add_assign(&mut self, rhs: usize) { + match self { + &mut LocalCodePtr::DirEntry(ref mut p, _) | + &mut LocalCodePtr::TopLevel(_, ref mut p) => *p += rhs + } } } @@ -1512,8 +1646,9 @@ impl Add for CodePtr { fn add(self, rhs: usize) -> Self::Output { match self { - CodePtr::DirEntry(p, name) => CodePtr::DirEntry(p + rhs, name), - CodePtr::TopLevel(cn, p) => CodePtr::TopLevel(cn, p + rhs) + CodePtr::Local(local) => CodePtr::Local(local + rhs), + CodePtr::BuiltInClause(_, local) => CodePtr::Local(local + rhs), + CodePtr::CallN(_, local) => CodePtr::Local(local + rhs), } } } @@ -1521,8 +1656,8 @@ impl Add for CodePtr { impl AddAssign for CodePtr { fn add_assign(&mut self, rhs: usize) { match self { - &mut CodePtr::DirEntry(ref mut p, _) | - &mut CodePtr::TopLevel(_, ref mut p) => *p += rhs + &mut CodePtr::Local(ref mut local) => *local += rhs, + _ => *self = CodePtr::Local(self.local() + rhs) } } } diff --git a/src/prolog/builtins.rs b/src/prolog/builtins.rs index 0222ecf7..ab9d4903 100644 --- a/src/prolog/builtins.rs +++ b/src/prolog/builtins.rs @@ -1,8 +1,6 @@ use prolog::ast::*; -use prolog::num::bigint::{BigInt}; use std::collections::HashMap; -use std::rc::Rc; // from 7.12.2 b) of 13211-1:1995 #[derive(Clone, Copy)] @@ -92,7 +90,8 @@ impl EvalError { } } -fn get_builtins() -> Code { +/* +fn get_builtins() -> Code { vec![internal_call_n!(), // callN/N, 0. is_atomic!(temp_v!(1)), // atomic/1, 1. proceed!(), @@ -737,7 +736,7 @@ fn get_builtins() -> Code { acyclic_term_execute!(), // acyclic_term/1, 485. cyclic_term_execute!(), // cyclic_term/1, 486. ] -} +} */ pub fn default_op_dir() -> OpDir { diff --git a/src/prolog/codegen.rs b/src/prolog/codegen.rs index 521fbf06..4e6d9ed3 100644 --- a/src/prolog/codegen.rs +++ b/src/prolog/codegen.rs @@ -254,18 +254,18 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator -> Result<(), ParserError> { match ct { - InlinedClauseType::CompareNumber(cmp) => { + InlinedClauseType::CompareNumber(cmp, ..) => { let (mut lcode, at_1) = self.call_arith_eval(terms[0].as_ref(), 1)?; let (mut rcode, at_2) = self.call_arith_eval(terms[1].as_ref(), 2)?; code.append(&mut lcode); code.append(&mut rcode); - + code.push(compare_number_instr!(cmp, at_1.unwrap_or(interm!(1)), at_2.unwrap_or(interm!(2)))); }, - InlinedClauseType::IsAtom => + InlinedClauseType::IsAtom(..) => match terms[0].as_ref() { &Term::Constant(_, Constant::Atom(_)) => { code.push(succeed!()); @@ -278,7 +278,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator code.push(fail!()); } }, - InlinedClauseType::IsAtomic => + InlinedClauseType::IsAtomic(..) => match terms[0].as_ref() { &Term::AnonVar | &Term::Clause(..) | &Term::Cons(..) => { code.push(fail!()); @@ -291,7 +291,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator code.push(is_atomic!(r)); } }, - InlinedClauseType::IsCompound => + InlinedClauseType::IsCompound(..) => match terms[0].as_ref() { &Term::Clause(..) | &Term::Cons(..) => { code.push(succeed!()); @@ -304,7 +304,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator code.push(fail!()); } }, - InlinedClauseType::IsRational => + InlinedClauseType::IsRational(..) => match terms[0].as_ref() { &Term::Constant(_, Constant::Number(Number::Rational(_))) => { code.push(succeed!()); @@ -317,7 +317,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator code.push(fail!()); } }, - InlinedClauseType::IsFloat => + InlinedClauseType::IsFloat(..) => match terms[0].as_ref() { &Term::Constant(_, Constant::Number(Number::Float(_))) => { code.push(succeed!()); @@ -330,7 +330,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator code.push(fail!()); } }, - InlinedClauseType::IsString => + InlinedClauseType::IsString(..) => match terms[0].as_ref() { &Term::Constant(_, Constant::String(_)) => { code.push(succeed!()); @@ -343,7 +343,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator code.push(fail!()); } }, - InlinedClauseType::IsNonVar => + InlinedClauseType::IsNonVar(..) => match terms[0].as_ref() { &Term::AnonVar => { code.push(fail!()); @@ -356,7 +356,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator code.push(succeed!()); } }, - InlinedClauseType::IsInteger => + InlinedClauseType::IsInteger(..) => match terms[0].as_ref() { &Term::Constant(_, Constant::Number(Number::Integer(_))) => { code.push(succeed!()); @@ -369,7 +369,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator code.push(fail!()); }, }, - InlinedClauseType::IsVar => + InlinedClauseType::IsVar(..) => match terms[0].as_ref() { &Term::Constant(..) | &Term::Clause(..) | &Term::Cons(..) => { code.push(fail!()); @@ -416,7 +416,8 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator } else { Line::Cut(CutInstruction::Cut(perm_v!(1))) }), - &QueryTerm::Clause(_, ClauseType::Is, ref terms) => { + &QueryTerm::Clause(_, ClauseType::BuiltIn(BuiltInClauseType::Is), ref terms) => + { let (mut acode, at) = self.call_arith_eval(terms[1].as_ref(), 1)?; code.append(&mut acode); diff --git a/src/prolog/io.rs b/src/prolog/io.rs index eceacfa1..52876615 100644 --- a/src/prolog/io.rs +++ b/src/prolog/io.rs @@ -173,10 +173,6 @@ impl fmt::Display for IndexedChoiceInstruction { impl fmt::Display for BuiltInInstruction { fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { match self { - &BuiltInInstruction::CallInlined(InlinedClauseType::CompareNumber(cmp), ref rs) => - write!(f, "number_test {}, {}, {}", cmp, &rs[0], &rs[1]), - &BuiltInInstruction::CallInlined(ict, ref rs) => - write!(f, "call_inlined_{}, {}", ict.name(), &rs[0]), &BuiltInInstruction::CleanUpBlock => write!(f, "clean_up_block"), &BuiltInInstruction::CompareNumber(cmp, ref at_1, ref at_2) => @@ -209,8 +205,6 @@ impl fmt::Display for BuiltInInstruction { write!(f, "install_cleaner"), &BuiltInInstruction::InstallNewBlock => write!(f, "install_new_block"), - &BuiltInInstruction::InternalCallN => - write!(f, "internal_call_N"), &BuiltInInstruction::RemoveCallPolicyCheck => write!(f, "remove_call_policy_check"), &BuiltInInstruction::RemoveInferenceCounter(r1, r2) => diff --git a/src/prolog/iterators.rs b/src/prolog/iterators.rs index 23c5aad4..5ce7f36e 100644 --- a/src/prolog/iterators.rs +++ b/src/prolog/iterators.rs @@ -341,7 +341,8 @@ impl<'a> ChunkedIterator<'a> result.push(term), ChunkedTerm::BodyTerm(&QueryTerm::Clause(_, ClauseType::Inlined(_), _)) => result.push(term), - ChunkedTerm::BodyTerm(&QueryTerm::Clause(_, ClauseType::CallN, ref subterms)) => { + ChunkedTerm::BodyTerm(&QueryTerm::Clause(_, ClauseType::CallN, ref subterms)) => + { result.push(term); arity = subterms.len() + 1; break; diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl new file mode 100644 index 00000000..7a46bf8d --- /dev/null +++ b/src/prolog/lib/builtins.pl @@ -0,0 +1,29 @@ +:- op(400, yfx, /). + +:- module(builtins, [(+)/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, (>=)/2, (=<)/2]). + +% arithmetic operators. +:- op(700, xfx, is). +:- op(500, yfx, +). +:- op(500, yfx, -). +:- op(400, yfx, *). +:- op(500, yfx, /\). +:- op(500, yfx, \/). +:- op(500, yfx, xor). +:- op(400, yfx, div). +:- op(400, yfx, //). +:- op(400, yfx, rdiv). +:- op(400, yfx, <<). +:- op(400, yfx, >>). +:- op(400, yfx, mod). +:- op(400, yfx, rem). + +% arithmetic comparison operators. +:- op(700, xfx, >). +:- op(700, xfx, <). +:- op(700, xfx, =\=). +:- op(700, xfx, =:=). +:- op(700, xfx, >=). +:- op(700, xfx, =<). diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index f9dad13e..7913137a 100644 --- a/src/prolog/machine/machine_state.rs +++ b/src/prolog/machine/machine_state.rs @@ -209,7 +209,7 @@ pub struct MachineState { pub(super) b0: usize, pub(super) e: usize, pub(super) num_of_args: usize, - pub(super) cp: CodePtr, + pub(super) cp: LocalCodePtr, pub(super) fail: bool, pub(crate) heap: Heap, pub(super) mode: MachineMode, @@ -248,10 +248,10 @@ pub(crate) trait CallPolicy: Any { IndexPtr::Index(compiled_tl_index) => { let module_name = idx.0.borrow().1.clone(); - machine_st.cp = machine_st.p.clone() + 1; + machine_st.cp.assign_if_local(machine_st.p.clone() + 1); machine_st.num_of_args = arity; machine_st.b0 = machine_st.b; - machine_st.p = CodePtr::DirEntry(compiled_tl_index, module_name); + machine_st.p = dir_entry!(compiled_tl_index, module_name); } } @@ -270,7 +270,7 @@ pub(crate) trait CallPolicy: Any { machine_st.num_of_args = arity; machine_st.b0 = machine_st.b; - machine_st.p = CodePtr::DirEntry(compiled_tl_index, module_name); + machine_st.p = dir_entry!(compiled_tl_index, module_name); } } @@ -400,55 +400,66 @@ pub(crate) trait CallPolicy: Any { Ok(()) } - fn try_call_clause<'a>(&mut self, machine_st: &mut MachineState, code_dirs: CodeDirs<'a>, - ct: &ClauseType, arity: usize, lco: bool) - -> CallResult + fn call_n<'a>(&mut self, machine_st: &mut MachineState, arity: usize, + code_dirs: CodeDirs<'a>, lco: bool) + -> CallResult + { + loop { + if let Some((name, mut arity)) = machine_st.setup_call_n(arity) { + let user = clause_name!("user"); + + if machine_st.fail { + return Ok(()); + } + + match ClauseType::from(name.clone(), arity, None) { + ClauseType::CallN => { + machine_st.num_of_args = arity; + machine_st.handle_internal_call_n(); + + continue; + }, + ClauseType::BuiltIn(built_in) => + machine_st.setup_built_in_call(built_in, lco), + ClauseType::Inlined(inlined) => + machine_st.execute_inlined(&inlined), + ClauseType::Op(..) | ClauseType::Named(..) => + 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, arity)); + } + }; + } + + break; + } + + Ok(()) + } + + fn system_call(&mut self, machine_st: &mut MachineState, ct: &SystemClauseType) -> CallResult { match ct { - &ClauseType::AcyclicTerm => { + &SystemClauseType::SkipMaxList => { + machine_st.skip_max_list()?; + machine_st.p += 1; + + Ok(()) + } + } + } + + fn call_builtin<'a>(&mut self, machine_st: &mut MachineState, ct: &BuiltInClauseType, lco: bool) + -> CallResult + { + match ct { + &BuiltInClauseType::AcyclicTerm => { let addr = machine_st[temp_v!(1)].clone(); machine_st.fail = machine_st.is_cyclic_term(addr); return_from_clause!(lco, machine_st) }, - &ClauseType::Arg => { - if !lco { - machine_st.cp = machine_st.p.clone() + 1; - } - - machine_st.num_of_args = 3; - machine_st.b0 = machine_st.b; - machine_st.p = CodePtr::DirEntry(166, clause_name!("builtin")); - - Ok(()) - }, - &ClauseType::Catch => { - if !lco { - machine_st.cp = machine_st.p.clone() + 1; - } - - machine_st.num_of_args = 3; - machine_st.b0 = machine_st.b; - machine_st.p = CodePtr::DirEntry(5, clause_name!("builtin")); - - Ok(()) - }, - &ClauseType::CallN => - if let Some((name, arity)) = machine_st.setup_call_n(arity) { - let user = clause_name!("user"); - - match ClauseType::from(name.clone(), arity, None) { - ClauseType::Op(..) | ClauseType::Named(..) => - if let Some(idx) = code_dirs.get(name.clone(), arity, user) { - self.context_call(machine_st, name, arity, idx, lco) - } else { - Err(machine_st.existence_error(name, arity)) - }, - ct => self.try_call_clause(machine_st, code_dirs, &ct, arity, lco), - } - } else { - Ok(()) - }, - &ClauseType::Compare => { + &BuiltInClauseType::Compare => { let a1 = machine_st[temp_v!(1)].clone(); let a2 = machine_st[temp_v!(2)].clone(); let a3 = machine_st[temp_v!(3)].clone(); @@ -462,7 +473,7 @@ pub(crate) trait CallPolicy: Any { machine_st.unify(a1, c); return_from_clause!(lco, machine_st) }, - &ClauseType::CompareTerm(qt) => { + &BuiltInClauseType::CompareTerm(qt) => { match qt { CompareTermQT::Equal => machine_st.fail = machine_st.structural_eq_test(), @@ -473,12 +484,12 @@ pub(crate) trait CallPolicy: Any { return_from_clause!(lco, machine_st) }, - &ClauseType::CyclicTerm => { + &BuiltInClauseType::CyclicTerm => { let addr = machine_st[temp_v!(1)].clone(); machine_st.fail = !machine_st.is_cyclic_term(addr); return_from_clause!(lco, machine_st) }, - &ClauseType::Display => { + &BuiltInClauseType::Display => { let output = machine_st.print_term(machine_st[temp_v!(1)].clone(), DisplayFormatter {}, PrinterOutputter::new()); @@ -486,27 +497,27 @@ pub(crate) trait CallPolicy: Any { println!("{}", output.result()); return_from_clause!(lco, machine_st) }, - &ClauseType::DuplicateTerm => { + &BuiltInClauseType::DuplicateTerm => { machine_st.duplicate_term(); return_from_clause!(lco, machine_st) }, - &ClauseType::Eq => { + &BuiltInClauseType::Eq => { machine_st.fail = machine_st.eq_test(); return_from_clause!(lco, machine_st) }, - &ClauseType::Ground => { + &BuiltInClauseType::Ground => { machine_st.fail = machine_st.ground_test(); return_from_clause!(lco, machine_st) }, - &ClauseType::Functor => { + &BuiltInClauseType::Functor => { machine_st.try_functor()?; return_from_clause!(lco, machine_st) }, - &ClauseType::NotEq => { + &BuiltInClauseType::NotEq => { machine_st.fail = !machine_st.eq_test(); return_from_clause!(lco, machine_st) }, - &ClauseType::Sort => { + &BuiltInClauseType::Sort => { machine_st.check_sort_errors()?; let stub = machine_st.functor_stub(clause_name!("sort"), 2); @@ -522,7 +533,7 @@ pub(crate) trait CallPolicy: Any { return_from_clause!(lco, machine_st) }, - &ClauseType::KeySort => { + &BuiltInClauseType::KeySort => { machine_st.check_keysort_errors()?; let stub = machine_st.functor_stub(clause_name!("keysort"), 2); @@ -544,25 +555,7 @@ pub(crate) trait CallPolicy: Any { return_from_clause!(lco, machine_st) }, - &ClauseType::Throw => { - if !lco { - machine_st.cp = machine_st.p.clone() + 1; - } - - machine_st.goto_throw(); - Ok(()) - }, - &ClauseType::Named(ref name, ref idx) | &ClauseType::Op(ref name, _, ref idx) => - self.context_call(machine_st, name.clone(), arity, idx.clone(), lco), - &ClauseType::CallWithInferenceLimit => { - machine_st.goto_ptr(CodePtr::DirEntry(409, clause_name!("builtin")), 3, lco); - Ok(()) - }, - &ClauseType::SetupCallCleanup => { - machine_st.goto_ptr(CodePtr::DirEntry(310, clause_name!("builtin")), 3, lco); - Ok(()) - }, - &ClauseType::Is => { + &BuiltInClauseType::Is => { let a = machine_st[temp_v!(1)].clone(); let result = machine_st.arith_eval_by_metacall(temp_v!(2))?; @@ -571,14 +564,8 @@ pub(crate) trait CallPolicy: Any { Ok(()) }, - &ClauseType::Inlined(ref inlined) => { - machine_st.execute_inlined(inlined, &vec![temp_v!(1), temp_v!(2)]); - Ok(()) - }, - &ClauseType::System(ref system) => { - machine_st.execute_system(system)?; - return_from_clause!(lco, machine_st) - } + &BuiltInClauseType::System(ref ct) => + self.system_call(machine_st, ct), } } } @@ -680,11 +667,10 @@ impl CallPolicy for CallWithInferenceLimitCallPolicy { self.increment() } - fn try_call_clause<'a>(&mut self, machine_st: &mut MachineState, code_dirs: CodeDirs<'a>, - ct: &ClauseType, arity: usize, lco: bool) - -> CallResult + fn call_builtin<'a>(&mut self, machine_st: &mut MachineState, ct: &BuiltInClauseType, lco: bool) + -> CallResult { - self.prev_policy.try_call_clause(machine_st, code_dirs, ct, arity, lco)?; + self.prev_policy.call_builtin(machine_st, ct, lco)?; self.increment() } } @@ -757,11 +743,11 @@ impl CutPolicy for SetupCallCleanupCutPolicy { machine_st.p += 1; if !self.out_of_cont_pts() { - machine_st.cp = machine_st.p.clone(); + machine_st.cp.assign_if_local(machine_st.p.clone()); machine_st.num_of_args = 0; machine_st.b0 = machine_st.b; // goto_call run_cleaners_without_handling/0, 370. - machine_st.p = CodePtr::DirEntry(370, clause_name!("builtin")); + machine_st.p = dir_entry!(370, clause_name!("builtin")); } } } diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 5665eea2..bc12c399 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -38,7 +38,7 @@ impl MachineState { b0: 0, e: 0, num_of_args: 0, - cp: CodePtr::default(), + cp: LocalCodePtr::default(), fail: false, heap: Heap::with_capacity(256), mode: MachineMode::Write, @@ -670,7 +670,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; }, @@ -1011,8 +1011,7 @@ impl MachineState { } } - fn handle_internal_call_n<'a>(&mut self, call_policy: &mut Box, - code_dirs: CodeDirs<'a>) + pub(super) fn handle_internal_call_n(&mut self) { let arity = self.num_of_args + 1; let pred = self.registers[1].clone(); @@ -1023,32 +1022,20 @@ impl MachineState { if arity > 1 { self.registers[arity - 1] = pred; - - if let Some((name, arity)) = self.setup_call_n(arity - 1) { - if let Some(idx) = code_dirs.get(name.clone(), arity, self.p.module_name()) { - try_or_fail!(self, call_policy.try_execute(self, name, arity, idx)); - return; - } - } + return; } self.fail = true; } - pub(super) fn goto_throw(&mut self) { - self.num_of_args = 1; - self.b0 = self.b; - self.p = CodePtr::DirEntry(59, clause_name!("builtin")); - } - pub(super) fn set_ball(&mut self) { let addr = self[temp_v!(1)].clone(); self.ball.boundary = self.heap.h; - + let mut duplicator = DuplicateBallTerm::new(self); - duplicator.duplicate_term(addr); + duplicator.duplicate_term(addr); } - + pub(super) fn unwind_stack(&mut self) { self.b = self.block; self.or_stack.truncate(self.b); @@ -1071,7 +1058,6 @@ impl MachineState { self.error_form(self.representation_error(RepFlag::MaxArity), stub); self.throw_exception(representation_error); - return None; } @@ -1334,20 +1320,15 @@ impl MachineState { }; } - pub(super) fn execute_inlined(&mut self, inlined: &InlinedClauseType, rs: &Vec) - { - let r1 = rs[0].clone(); - + pub(super) fn execute_inlined(&mut self, inlined: &InlinedClauseType) { match inlined { - &InlinedClauseType::CompareNumber(cmp) => { - let r2 = rs[1].clone(); - + &InlinedClauseType::CompareNumber(cmp, r1, r2) => { let n1 = try_or_fail!(self, self.arith_eval_by_metacall(r1)); let n2 = try_or_fail!(self, self.arith_eval_by_metacall(r2)); self.compare_numbers(cmp, n1, n2); }, - &InlinedClauseType::IsAtom => { + &InlinedClauseType::IsAtom(r1) => { let d = self.store(self.deref(self[r1].clone())); match d { @@ -1355,7 +1336,7 @@ impl MachineState { _ => self.fail = true }; }, - &InlinedClauseType::IsAtomic => { + &InlinedClauseType::IsAtomic(r1) => { let d = self.store(self.deref(self[r1].clone())); match d { @@ -1363,7 +1344,7 @@ impl MachineState { _ => self.fail = true }; }, - &InlinedClauseType::IsInteger => { + &InlinedClauseType::IsInteger(r1) => { let d = self.store(self.deref(self[r1].clone())); match d { @@ -1371,7 +1352,7 @@ impl MachineState { _ => self.fail = true }; }, - &InlinedClauseType::IsCompound => { + &InlinedClauseType::IsCompound(r1) => { let d = self.store(self.deref(self[r1].clone())); match d { @@ -1379,7 +1360,7 @@ impl MachineState { _ => self.fail = true }; }, - &InlinedClauseType::IsFloat => { + &InlinedClauseType::IsFloat(r1) => { let d = self.store(self.deref(self[r1].clone())); match d { @@ -1387,7 +1368,7 @@ impl MachineState { _ => self.fail = true }; }, - &InlinedClauseType::IsRational => { + &InlinedClauseType::IsRational(r1) => { let d = self.store(self.deref(self[r1].clone())); match d { @@ -1395,7 +1376,7 @@ impl MachineState { _ => self.fail = true }; }, - &InlinedClauseType::IsString => { + &InlinedClauseType::IsString(r1) => { let d = self.store(self.deref(self[r1].clone())); match d { @@ -1403,7 +1384,7 @@ impl MachineState { _ => self.fail = true }; }, - &InlinedClauseType::IsNonVar => { + &InlinedClauseType::IsNonVar(r1) => { let d = self.store(self.deref(self[r1].clone())); match d { @@ -1411,7 +1392,7 @@ impl MachineState { _ => self.p += 1 }; }, - &InlinedClauseType::IsVar => { + &InlinedClauseType::IsVar(r1) => { let d = self.store(self.deref(self[r1].clone())); match d { @@ -1428,8 +1409,6 @@ impl MachineState { instr: &BuiltInInstruction) { match instr { - &BuiltInInstruction::CallInlined(ref inlined, ref rs) => - self.execute_inlined(inlined, rs), &BuiltInInstruction::CompareNumber(cmp, ref at_1, ref at_2) => { let n1 = try_or_fail!(self, self.get_number(at_1)); let n2 = try_or_fail!(self, self.get_number(at_2)); @@ -1457,7 +1436,7 @@ impl MachineState { let val = self.try_get_arg(); if lco { - self.p = self.cp.clone(); + self.p = CodePtr::Local(self.cp.clone()); } else { self.p += 1; } @@ -1658,8 +1637,6 @@ impl MachineState { }, &BuiltInInstruction::UnwindStack => self.unwind_stack(), - &BuiltInInstruction::InternalCallN => - self.handle_internal_call_n(call_policy, code_dirs), &BuiltInInstruction::Fail => { self.fail = true; self.p += 1; @@ -1946,66 +1923,86 @@ impl MachineState { false } + pub(super) fn setup_built_in_call(&mut self, ct: BuiltInClauseType, lco: bool) + { + self.num_of_args = ct.arity(); + self.b0 = self.b; + + self.p = CodePtr::BuiltInClause(ct, self.p.local()); + } + + pub(super) fn allocate(&mut self, num_cells: usize) { + let gi = self.next_global_index(); + + self.p += 1; + + if self.e + 1 < self.and_stack.len() { + let and_gi = self.and_stack[self.e].global_index; + let or_gi = self.or_stack.top() + .map(|or_fr| or_fr.global_index) + .unwrap_or(0); + + if and_gi > or_gi { + let index = self.e + 1; + + self.and_stack[index].e = self.e; + self.and_stack[index].cp = self.cp.clone(); + self.and_stack[index].global_index = gi; + + self.and_stack.resize(index, num_cells); + self.e = index; + + return; + } + } + + self.and_stack.push(gi, self.e, self.cp.clone(), num_cells); + self.e = self.and_stack.len() - 1; + } + + fn deallocate(&mut self) { + let e = self.e; + + self.cp = self.and_stack[e].cp.clone(); + 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, instr: &ControlInstruction) { match instr { - &ControlInstruction::Allocate(num_cells) => { - let gi = self.next_global_index(); - - self.p += 1; - - if self.e + 1 < self.and_stack.len() { - let and_gi = self.and_stack[self.e].global_index; - let or_gi = self.or_stack.top() - .map(|or_fr| or_fr.global_index) - .unwrap_or(0); - - if and_gi > or_gi { - let index = self.e + 1; - - self.and_stack[index].e = self.e; - self.and_stack[index].cp = self.cp.clone(); - self.and_stack[index].global_index = gi; - - self.and_stack.resize(index, num_cells); - - self.e = index; - - return; - } - } - - self.and_stack.push(gi, self.e, self.cp.clone(), num_cells); - self.e = self.and_stack.len() - 1; - }, - &ControlInstruction::CallClause(ref ct, arity, _, lco) => - try_or_fail!(self, call_policy.try_call_clause(self, code_dirs, ct, arity, lco)), + &ControlInstruction::Allocate(num_cells) => + self.allocate(num_cells), + &ControlInstruction::CallClause(ClauseType::CallN, arity, _, lco) => + try_or_fail!(self, call_policy.call_n(self, arity, code_dirs, lco)), + &ControlInstruction::CallClause(ClauseType::BuiltIn(ref ct), _, _, lco) => + try_or_fail!(self, call_policy.call_builtin(self, ct, lco)), + &ControlInstruction::CallClause(ClauseType::Inlined(ref ct), _, _, lco) => + self.execute_inlined(ct), + &ControlInstruction::CallClause(ClauseType::Named(ref name, ref idx), arity, _, lco) + | &ControlInstruction::CallClause(ClauseType::Op(ref name, _, ref idx), arity, _, lco) => + try_or_fail!(self, call_policy.context_call(self, name.clone(), arity, idx.clone(), + lco)), &ControlInstruction::CheckCpExecute => { let a = self.store(self.deref(self[temp_v!(2)].clone())); match a { Addr::Con(Constant::Usize(old_b)) if self.b > old_b + 1 => { - self.p = self.cp.clone(); + self.p = CodePtr::Local(self.cp.clone()); }, _ => { self.num_of_args = 2; self.b0 = self.b; // goto sgc_on_success/2, 382. - self.p = CodePtr::DirEntry(382, clause_name!("builtin")); + self.p = dir_entry!(382, clause_name!("builtin")); } }; }, - &ControlInstruction::Deallocate => { - let e = self.e; - - self.cp = self.and_stack[e].cp.clone(); - self.e = self.and_stack[e].e; - - self.p += 1; - }, + &ControlInstruction::Deallocate => self.deallocate(), &ControlInstruction::GetCleanerCall => { let dest = self[temp_v!(1)].clone(); @@ -2032,7 +2029,7 @@ impl MachineState { self.fail = true; }, &ControlInstruction::Goto(p, arity, lco) => - self.goto_ptr(CodePtr::DirEntry(p, clause_name!("builtin")), arity, lco), + self.goto_ptr(dir_entry!(p, clause_name!("builtin")), arity, lco), &ControlInstruction::IsClause(lco, r, ref at) => { let a1 = self[r].clone(); let a2 = try_or_fail!(self, self.get_number(at)); @@ -2042,7 +2039,7 @@ impl MachineState { }, &ControlInstruction::JmpBy(arity, offset, _, lco) => { if !lco { - self.cp = self.p.clone() + 1; + self.cp.assign_if_local(self.p.clone() + 1); } self.num_of_args = arity; @@ -2050,13 +2047,13 @@ impl MachineState { self.p += offset; }, &ControlInstruction::Proceed => - self.p = self.cp.clone(), + self.p = CodePtr::Local(self.cp.clone()) }; } pub(super) fn goto_ptr(&mut self, p: CodePtr, arity: usize, lco:bool) { if !lco { - self.cp = self.p.clone() + 1; + self.cp.assign_if_local(self.p.clone() + 1); } self.num_of_args = arity; @@ -2169,7 +2166,7 @@ impl MachineState { self.s = 0; self.tr = 0; self.p = CodePtr::default(); - self.cp = CodePtr::default(); + self.cp = LocalCodePtr::default(); self.num_of_args = 0; self.fail = false; diff --git a/src/prolog/machine/mod.rs b/src/prolog/machine/mod.rs index 5377949e..163c0b16 100644 --- a/src/prolog/machine/mod.rs +++ b/src/prolog/machine/mod.rs @@ -34,18 +34,18 @@ pub struct Machine { cached_query: Option } -impl Index for Machine { +impl Index for Machine { type Output = Line; - fn index(&self, ptr: CodePtr) -> &Self::Output { + fn index(&self, ptr: LocalCodePtr) -> &Self::Output { match ptr { - CodePtr::TopLevel(_, p) => { + LocalCodePtr::TopLevel(_, p) => { match &self.cached_query { &Some(ref cq) => &cq[p], &None => panic!("Out-of-bounds top level index.") } }, - CodePtr::DirEntry(p, _) => &self.code[p] + LocalCodePtr::DirEntry(p, _) => &self.code[p] } } } @@ -223,36 +223,47 @@ impl Machine { } } + fn lookup_instr(&self, p: CodePtr) -> Option { + match p { + CodePtr::Local(LocalCodePtr::TopLevel(_, p)) => + match &self.cached_query { + &Some(ref cq) => Some(cq[p].clone()), + &None => None + }, + CodePtr::Local(LocalCodePtr::DirEntry(p, _)) => + 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)) + } + } + fn execute_instr(&mut self) { - let instr = match self.ms.p { - CodePtr::TopLevel(_, p) => { - match &self.cached_query { - &Some(ref cq) => &cq[p], - &None => return - } - }, - CodePtr::DirEntry(p, _) => &self.code[p] + let instr = match self.lookup_instr(self.ms.p.clone()) { + Some(instr) => instr, + None => return }; match instr { - &Line::Arithmetic(ref arith_instr) => + Line::Arithmetic(ref arith_instr) => self.ms.execute_arith_instr(arith_instr), - &Line::BuiltIn(ref built_in_instr) => { + Line::BuiltIn(ref built_in_instr) => { let code_dirs = CodeDirs::new(&self.code_dir, &self.modules); self.ms.execute_built_in_instr(code_dirs, &mut self.call_policy, &mut self.cut_policy, built_in_instr); }, - &Line::Choice(ref choice_instr) => + Line::Choice(ref choice_instr) => self.ms.execute_choice_instr(choice_instr, &mut self.call_policy), - &Line::Cut(ref cut_instr) => + Line::Cut(ref cut_instr) => self.ms.execute_cut_instr(cut_instr, &mut self.cut_policy), - &Line::Control(ref control_instr) => { + Line::Control(ref control_instr) => { let code_dirs = CodeDirs::new(&self.code_dir, &self.modules); self.ms.execute_ctrl_instr(code_dirs, &mut self.call_policy, &mut self.cut_policy, control_instr) }, - &Line::Fact(ref fact) => { + Line::Fact(ref fact) => { for fact_instr in fact { if self.failed() { break; @@ -263,11 +274,11 @@ impl Machine { self.ms.p += 1; }, - &Line::Indexing(ref indexing_instr) => + Line::Indexing(ref indexing_instr) => self.ms.execute_indexing_instr(&indexing_instr), - &Line::IndexedChoice(ref choice_instr) => + Line::IndexedChoice(ref choice_instr) => self.ms.execute_indexed_choice_instr(choice_instr, &mut self.call_policy), - &Line::Query(ref query) => { + Line::Query(ref query) => { for query_instr in query { if self.failed() { break; @@ -289,13 +300,13 @@ impl Machine { self.ms.b0 = self.ms.or_stack[b].b0; self.ms.p = self.ms.or_stack[b].bp.clone(); - if let CodePtr::TopLevel(_, p) = self.ms.p { + if let CodePtr::Local(LocalCodePtr::TopLevel(_, p)) = self.ms.p { self.ms.fail = p == 0; } else { self.ms.fail = false; } } else { - self.ms.p = CodePtr::TopLevel(0, 0); + self.ms.p = CodePtr::Local(LocalCodePtr::TopLevel(0, 0)); } } @@ -309,8 +320,9 @@ impl Machine { } match self.ms.p { - CodePtr::DirEntry(p, _) if p < self.code.len() => {}, - _ => break + CodePtr::Local(LocalCodePtr::DirEntry(p, _)) if p < self.code.len() => {}, + CodePtr::Local(_) => break, + _ => {} }; } } @@ -342,11 +354,11 @@ impl Machine { fn run_query(&mut self, alloc_locs: &AllocVarDict, heap_locs: &mut HeapVarDict) { - let end_ptr = CodePtr::TopLevel(0, self.cached_query_size()); + let end_ptr = top_level_code_ptr!(0, self.cached_query_size()); while self.ms.p < end_ptr { - if let CodePtr::TopLevel(mut cn, p) = self.ms.p { - match &self[CodePtr::TopLevel(cn, p)] { + if let CodePtr::Local(LocalCodePtr::TopLevel(mut cn, p)) = self.ms.p { + match &self[LocalCodePtr::TopLevel(cn, p)] { &Line::Control(ref ctrl_instr) if ctrl_instr.is_jump_instr() => { self.record_var_places(cn, alloc_locs, heap_locs); cn += 1; @@ -354,13 +366,13 @@ impl Machine { _ => {} } - self.ms.p = CodePtr::TopLevel(cn, p); + self.ms.p = top_level_code_ptr!(cn, p); } self.query_stepper(); match self.ms.p { - CodePtr::TopLevel(_, p) if p > 0 => {}, + CodePtr::Local(LocalCodePtr::TopLevel(_, p)) if p > 0 => {}, _ => { if heap_locs.is_empty() { self.record_var_places(0, alloc_locs, heap_locs); @@ -377,7 +389,7 @@ impl Machine { if self.ms.ball.stub.len() > 0 { let h = self.ms.heap.h; self.ms.copy_and_align_ball_to_heap(); - + let error_str = self.ms.print_exception(Addr::HeapCell(h), &heap_locs, TermFormatter {}, @@ -410,7 +422,7 @@ impl Machine { let b = self.ms.b - 1; self.ms.p = self.ms.or_stack[b].bp.clone(); - if let CodePtr::TopLevel(_, 0) = self.ms.p { + if let CodePtr::Local(LocalCodePtr::TopLevel(_, 0)) = self.ms.p { return EvalSession::from(SessionError::QueryFailure); } diff --git a/src/prolog/macros.rs b/src/prolog/macros.rs index 140791f9..a665add2 100644 --- a/src/prolog/macros.rs +++ b/src/prolog/macros.rs @@ -19,24 +19,6 @@ macro_rules! atom { ) } -macro_rules! internal_call_n { - () => ( - Line::BuiltIn(BuiltInInstruction::InternalCallN) - ) -} - -macro_rules! allocate { - ($cells:expr) => ( - Line::Control(ControlInstruction::Allocate($cells)) - ) -} - -macro_rules! deallocate { - () => ( - Line::Control(ControlInstruction::Deallocate) - ) -} - macro_rules! compare_number_instr { ($cmp: expr, $at_1: expr, $at_2: expr) => ( Line::BuiltIn(BuiltInInstruction::CompareNumber($cmp, $at_1, $at_2)) @@ -88,12 +70,6 @@ macro_rules! functor { ) } -macro_rules! fact { - [$($x:expr),+] => ( - Line::Fact(vec![$($x),+]) - ) -} - macro_rules! temp_v { ($x:expr) => ( RegType::Temp($x) @@ -106,150 +82,58 @@ macro_rules! perm_v { ) } -macro_rules! get_var_in_query { - ($r:expr, $arg:expr) => ( - QueryInstruction::GetVariable($r, $arg) - ) -} - - -macro_rules! get_value { - ($r:expr, $arg:expr) => ( - FactInstruction::GetValue($r, $arg) - ) -} - -macro_rules! set_void { - ($n:expr) => ( - QueryInstruction::SetVoid($n) - ) -} - -macro_rules! set_value { - ($r:expr) => ( - QueryInstruction::SetValue($r) - ) -} - -macro_rules! get_var_in_fact { - ($r:expr, $arg:expr) => ( - FactInstruction::GetVariable($r, $arg) - ) -} - -macro_rules! put_var { - ($r:expr, $arg:expr) => ( - QueryInstruction::PutVariable($r, $arg) - ) -} - -macro_rules! put_structure { - ($atom:expr, $arity:expr, $r:expr, Some($fix:expr)) => ( - QueryInstruction::PutStructure(ClauseType::Op(clause_name!($atom), $fix, CodeIndex::default()), - $arity, - $r) - ); - ($atom:expr, $arity:expr, $r:expr, None) => ( - QueryInstruction::PutStructure(ClauseType::Named(clause_name!($atom), CodeIndex::default()), - $arity, - $r) - ) -} - -macro_rules! put_constant { - ($lvl:expr, $cons:expr, $r:expr) => ( - QueryInstruction::PutConstant($lvl, $cons, $r) - ) -} - -macro_rules! set_constant { - ($cons:expr) => ( - QueryInstruction::SetConstant($cons) - ) -} - -macro_rules! put_value { - ($r:expr, $arg:expr) => ( - QueryInstruction::PutValue($r, $arg) - ) -} - -macro_rules! put_unsafe_value { - ($r:expr, $arg:expr) => ( - QueryInstruction::PutUnsafeValue($r, $arg) - ) -} - -macro_rules! try_me_else { - ($o:expr) => ( - Line::Choice(ChoiceInstruction::TryMeElse($o)) - ) -} - -macro_rules! retry_me_else { - ($o:expr) => ( - Line::Choice(ChoiceInstruction::RetryMeElse($o)) - ) -} - macro_rules! is_atom { ($r:expr) => ( - Line::BuiltIn(BuiltInInstruction::CallInlined(InlinedClauseType::IsAtom, vec![$r])) + call_clause!(ClauseType::Inlined(InlinedClauseType::IsAtom($r)), 1, 0) ) } macro_rules! is_atomic { ($r:expr) => ( - Line::BuiltIn(BuiltInInstruction::CallInlined(InlinedClauseType::IsAtomic, vec![$r])) + call_clause!(ClauseType::Inlined(InlinedClauseType::IsAtomic($r)), 1, 0) ) } macro_rules! is_integer { ($r:expr) => ( - Line::BuiltIn(BuiltInInstruction::CallInlined(InlinedClauseType::IsInteger, vec![$r])) + call_clause!(ClauseType::Inlined(InlinedClauseType::IsInteger($r)), 1, 0) ) } macro_rules! is_compound { ($r:expr) => ( - Line::BuiltIn(BuiltInInstruction::CallInlined(InlinedClauseType::IsCompound, vec![$r])) + call_clause!(ClauseType::Inlined(InlinedClauseType::IsCompound($r)), 1, 0) ) } macro_rules! is_float { ($r:expr) => ( - Line::BuiltIn(BuiltInInstruction::CallInlined(InlinedClauseType::IsFloat, vec![$r])) + call_clause!(ClauseType::Inlined(InlinedClauseType::IsFloat($r)), 1, 0) ) } macro_rules! is_rational { ($r:expr) => ( - Line::BuiltIn(BuiltInInstruction::CallInlined(InlinedClauseType::IsRational, vec![$r])) + call_clause!(ClauseType::Inlined(InlinedClauseType::IsRational($r)), 1, 0) ) } macro_rules! is_nonvar { ($r:expr) => ( - Line::BuiltIn(BuiltInInstruction::CallInlined(InlinedClauseType::IsNonVar, vec![$r])) + call_clause!(ClauseType::Inlined(InlinedClauseType::IsNonVar($r)), 1, 0) ) } macro_rules! is_string { ($r:expr) => ( - Line::BuiltIn(BuiltInInstruction::CallInlined(InlinedClauseType::IsString, vec![$r])) + call_clause!(ClauseType::Inlined(InlinedClauseType::IsString($r)), 1, 0) ) } macro_rules! is_var { ($r:expr) => ( - Line::BuiltIn(BuiltInInstruction::CallInlined(InlinedClauseType::IsVar, vec![$r])) - ) -} - -macro_rules! trust_me { - () => ( - Line::Choice(ChoiceInstruction::TrustMe) + call_clause!(ClauseType::Inlined(InlinedClauseType::IsVar($r)), 1, 0) ) } @@ -259,84 +143,12 @@ macro_rules! call_clause { ) } -macro_rules! call_n { - ($arity:expr) => ( - Line::Control(ControlInstruction::CallClause(ClauseType::CallN, $arity, 0, false)) - ) -} - -macro_rules! execute_n { - ($arity:expr) => ( - Line::Control(ControlInstruction::CallClause(ClauseType::CallN, $arity, 0, true)) - ) -} - macro_rules! proceed { () => ( Line::Control(ControlInstruction::Proceed) ) } -macro_rules! cut { - ($r:expr) => ( - Line::Cut(CutInstruction::Cut($r)) - ) -} - -macro_rules! neck_cut { - () => ( - Line::Cut(CutInstruction::NeckCut) - ) -} - -macro_rules! get_current_block { - () => ( - Line::BuiltIn(BuiltInInstruction::GetCurrentBlock) - ) -} - -macro_rules! install_new_block { - () => ( - Line::BuiltIn(BuiltInInstruction::InstallNewBlock) - ) -} - -macro_rules! goto_call { - ($line:expr, $arity:expr) => ( - Line::Control(ControlInstruction::Goto($line, $arity, false)) - ) -} - -macro_rules! goto_execute { - ($line:expr, $arity:expr) => ( - Line::Control(ControlInstruction::Goto($line, $arity, true)) - ) -} - -macro_rules! reset_block { - () => ( - Line::BuiltIn(BuiltInInstruction::ResetBlock) - ) -} - -macro_rules! get_ball { - () => ( - Line::BuiltIn(BuiltInInstruction::GetBall) - ) -} - -macro_rules! erase_ball { - () => ( - Line::BuiltIn(BuiltInInstruction::EraseBall) - ) -} - -macro_rules! unify { - () => ( - Line::BuiltIn(BuiltInInstruction::Unify) - ) -} - macro_rules! is_call { ($r:expr, $at:expr) => ( Line::Control(ControlInstruction::IsClause(false, $r, $at)) @@ -344,24 +156,6 @@ macro_rules! is_call { ) } -macro_rules! unwind_stack { - () => ( - Line::BuiltIn(BuiltInInstruction::UnwindStack) - ) -} - -macro_rules! clean_up_block { - () => ( - Line::BuiltIn(BuiltInInstruction::CleanUpBlock) - ) -} - -macro_rules! set_ball { - () => ( - Line::BuiltIn(BuiltInInstruction::SetBall) - ) -} - macro_rules! fail { () => ( Line::BuiltIn(BuiltInInstruction::Fail) @@ -374,133 +168,18 @@ macro_rules! succeed { ) } -macro_rules! duplicate_term { - () => ( - Line::Control(ControlInstruction::CallClause(ClauseType::DuplicateTerm, 2, 0, false)) - ) -} - -macro_rules! get_level { - ($r:expr) => ( - Line::Cut(CutInstruction::GetLevel($r)) - ) -} - -macro_rules! switch_on_term { - ($v:expr, $c:expr, $l:expr, $s:expr) => ( - Line::Indexing(IndexingInstruction::SwitchOnTerm($v, $c, $l, $s)) - ) -} - -macro_rules! indexed_try { - ($i:expr) => ( - Line::IndexedChoice(IndexedChoiceInstruction::Try($i)) - ) -} - -macro_rules! retry { - ($i:expr) => ( - Line::IndexedChoice(IndexedChoiceInstruction::Retry($i)) - ) -} - -macro_rules! trust { - ($i:expr) => ( - Line::IndexedChoice(IndexedChoiceInstruction::Trust($i)) - ) -} - -macro_rules! get_constant { - ($c:expr, $r:expr) => ( - FactInstruction::GetConstant(Level::Shallow, $c, $r) - ) -} - -macro_rules! get_structure { - ($atom:expr, $arity:expr, $r:expr, Some($fix:expr)) => ( - FactInstruction::GetStructure(ClauseType::Op(clause_name!($atom), $fix, CodeIndex::default()), - $arity, - $r) - ); - ($atom:expr, $arity:expr, $r:expr, None) => ( - FactInstruction::GetStructure(ClauseType::Named(clause_name!($atom), CodeIndex::default()), - $arity, - $r) - ) -} - -macro_rules! functor_call { - () => ( - Line::Control(ControlInstruction::CallClause(ClauseType::Functor, 3, 0, false)) - ) -} - -macro_rules! functor_execute { - () => ( - Line::Control(ControlInstruction::CallClause(ClauseType::Functor, 3, 0, true)) - ) -} - -macro_rules! unify_value { - ($r:expr) => ( - FactInstruction::UnifyValue($r) - ) -} - -macro_rules! unify_variable { - ($r:expr) => ( - FactInstruction::UnifyVariable($r) - ) -} - -macro_rules! unify_void { - ($n:expr) => ( - FactInstruction::UnifyVoid($n) - ) -} - macro_rules! set_cp { ($r:expr) => ( Line::BuiltIn(BuiltInInstruction::SetCutPoint($r)) ) } -macro_rules! get_cp { - ($r:expr) => ( - Line::BuiltIn(BuiltInInstruction::GetCutPoint($r)) - ) -} - macro_rules! integer { ($i:expr) => ( Constant::Number(Number::Integer(Rc::new(BigInt::from($i)))) ) } -macro_rules! add { - ($at_1:expr, $at_2:expr, $o:expr) => ( - Line::Arithmetic(ArithmeticInstruction::Add($at_1, $at_2, $o)) - ) -} - -macro_rules! sub { - ($at_1:expr, $at_2:expr, $o:expr) => ( - Line::Arithmetic(ArithmeticInstruction::Sub($at_1, $at_2, $o)) - ) -} - -macro_rules! get_arg_call { - () => ( - Line::BuiltIn(BuiltInInstruction::GetArg(false)) - ) -} - -macro_rules! get_arg_execute { - () => ( - Line::BuiltIn(BuiltInInstruction::GetArg(true)) - ) -} - macro_rules! rc_integer { ($e:expr) => ( Number::Integer(Rc::new(BigInt::from($e))) @@ -513,229 +192,12 @@ macro_rules! rc_atom { ) } -macro_rules! infix { - () => ( - Fixity::In - ) -} - -macro_rules! display { - () => ( - Line::Control(ControlInstruction::CallClause(ClauseType::Display, 1, 0, false)) - ) -} - -macro_rules! dynamic_is { - () => ( - Line::Control(ControlInstruction::CallClause(ClauseType::Is, 2, 0, false)) - ) -} - -macro_rules! dynamic_num_test { - ($cmp:expr) => ( - Line::BuiltIn(BuiltInInstruction::CallInlined(InlinedClauseType::CompareNumber($cmp), - vec![temp_v!(1), temp_v!(2)])) - ) -} - -macro_rules! cmp_gt { - () => ( - CompareNumberQT::GreaterThan - ) -} - -macro_rules! cmp_lt { - () => ( - CompareNumberQT::LessThan - ) -} - -macro_rules! cmp_gte { - () => ( - CompareNumberQT::GreaterThanOrEqual - ) -} - -macro_rules! cmp_lte { - () => ( - CompareNumberQT::LessThanOrEqual - ) -} - -macro_rules! cmp_ne { - () => ( - CompareNumberQT::NotEqual - ) -} - -macro_rules! cmp_eq { - () => ( - CompareNumberQT::Equal - ) -} - macro_rules! jmp_call { ($arity:expr, $offset:expr, $pvs:expr) => ( Line::Control(ControlInstruction::JmpBy($arity, $offset, $pvs, false)) ) } -macro_rules! jmp_execute { - ($arity:expr, $offset:expr, $pvs:expr) => ( - Line::Control(ControlInstruction::JmpBy($arity, $offset, $pvs, true)) - ) -} - -macro_rules! get_list { - ($lvl:expr, $r:expr) => ( - FactInstruction::GetList($lvl, $r) - ) -} - -macro_rules! unify_constant { - ($c:expr) => ( - FactInstruction::UnifyConstant($c) - ) -} - -macro_rules! install_cleaner { - () => ( - Line::BuiltIn(BuiltInInstruction::InstallCleaner) - ) -} - -macro_rules! check_cp_execute { - () => ( - Line::Control(ControlInstruction::CheckCpExecute) - ) -} - -macro_rules! get_cleaner_call { - () => ( - Line::Control(ControlInstruction::GetCleanerCall) - ) -} - -macro_rules! restore_cut_policy { - () => ( - Line::BuiltIn(BuiltInInstruction::RestoreCutPolicy) - ) -} - -macro_rules! ground_execute { - () => ( - Line::Control(ControlInstruction::CallClause(ClauseType::Ground, 1, 0, true)) - ) -} - -macro_rules! eq_execute { - () => ( - Line::Control(ControlInstruction::CallClause(ClauseType::Eq, 2, 0, true)) - ) -} - -macro_rules! not_eq_execute { - () => ( - Line::Control(ControlInstruction::CallClause(ClauseType::NotEq, 2, 0, true)) - ) -} - -macro_rules! compare_term_execute { - ($qt:expr) => ( - Line::Control(ControlInstruction::CallClause(ClauseType::CompareTerm($qt), 2, 0, true)) - ) -} - -macro_rules! term_cmp_gt { - () => ( - CompareTermQT::GreaterThan - ) -} - -macro_rules! term_cmp_lt { - () => ( - CompareTermQT::LessThan - ) -} - -macro_rules! term_cmp_gte { - () => ( - CompareTermQT::GreaterThanOrEqual - ) -} - -macro_rules! term_cmp_lte { - () => ( - CompareTermQT::LessThanOrEqual - ) -} - -macro_rules! term_cmp_ne { - () => ( - CompareTermQT::NotEqual - ) -} - -macro_rules! term_cmp_eq { - () => ( - CompareTermQT::Equal - ) -} - -macro_rules! install_inference_counter { - ($r1:expr, $r2:expr, $r3:expr) => ( - Line::BuiltIn(BuiltInInstruction::InstallInferenceCounter($r1, $r2, $r3)) - ) -} - -macro_rules! remove_inference_counter { - ($r1:expr, $r2:expr) => ( - Line::BuiltIn(BuiltInInstruction::RemoveInferenceCounter($r1, $r2)) - ) -} - -macro_rules! inference_level { - ($r1:expr, $r2:expr) => ( - Line::BuiltIn(BuiltInInstruction::InferenceLevel($r1, $r2)) - ) -} - -macro_rules! default_set_cp { - ($r:expr) => ( - Line::BuiltIn(BuiltInInstruction::DefaultSetCutPoint($r)) - ) -} - -macro_rules! default_retry_me_else { - ($o:expr) => ( - Line::BuiltIn(BuiltInInstruction::DefaultRetryMeElse($o)) - ) -} - -macro_rules! default_trust_me { - () => ( - Line::BuiltIn(BuiltInInstruction::DefaultTrustMe) - ) -} - -macro_rules! remove_call_policy_check { - () => ( - Line::BuiltIn(BuiltInInstruction::RemoveCallPolicyCheck) - ) -} - -macro_rules! compare_execute { - () => ( - Line::Control(ControlInstruction::CallClause(ClauseType::Compare, 2, 0, true)) - ) -} - -macro_rules! module_decl { - ($name:expr, $decls:expr) => ( - ModuleDecl { name: $name, exports: $decls } - ) -} - macro_rules! try_eval_session { ($e:expr) => ( match $e { @@ -744,35 +206,10 @@ macro_rules! try_eval_session { } ) } - -macro_rules! sort_execute { - () => ( - Line::Control(ControlInstruction::CallClause(ClauseType::Sort, 2, 0, true)) - ) -} - -macro_rules! keysort_execute { - () => ( - Line::Control(ControlInstruction::CallClause(ClauseType::KeySort, 2, 0, true)) - ) -} - -macro_rules! acyclic_term_execute { - () => ( - Line::Control(ControlInstruction::CallClause(ClauseType::AcyclicTerm, 1, 0, true)) - ) -} - -macro_rules! cyclic_term_execute { - () => ( - Line::Control(ControlInstruction::CallClause(ClauseType::CyclicTerm, 1, 0, true)) - ) -} - macro_rules! return_from_clause { ($lco:expr, $machine_st:expr) => {{ if $lco { - $machine_st.p = $machine_st.cp.clone(); + $machine_st.p = CodePtr::Local($machine_st.cp.clone()); } else { $machine_st.p += 1; } @@ -781,6 +218,12 @@ macro_rules! return_from_clause { }} } +macro_rules! dir_entry { + ($idx:expr, $module_name:expr) => ( + CodePtr::Local(LocalCodePtr::DirEntry($idx, $module_name)) + ) +} + macro_rules! set_code_index { ($idx:expr, $ip:expr, $mod_name:expr) => {{ let mut idx = $idx.0.borrow_mut(); @@ -795,3 +238,15 @@ macro_rules! machine_code_index { MachineCodeIndex { code_dir: $code_dir, op_dir: $op_dir } ) } + +macro_rules! put_constant { + ($lvl:expr, $cons:expr, $r:expr) => ( + QueryInstruction::PutConstant($lvl, $cons, $r) + ) +} + +macro_rules! top_level_code_ptr { + ($p:expr, $q_sz:expr) => ( + CodePtr::Local(LocalCodePtr::TopLevel($p, $q_sz)) + ) +} diff --git a/src/prolog/or_stack.rs b/src/prolog/or_stack.rs index 07041ed3..d32c490f 100644 --- a/src/prolog/or_stack.rs +++ b/src/prolog/or_stack.rs @@ -6,7 +6,7 @@ use std::vec::Vec; pub struct Frame { pub global_index: usize, pub e: usize, - pub cp: CodePtr, + pub cp: LocalCodePtr, pub b: usize, pub bp: CodePtr, pub tr: usize, @@ -18,7 +18,7 @@ pub struct Frame { impl Frame { fn new(global_index: usize, e: usize, - cp: CodePtr, + cp: LocalCodePtr, b: usize, bp: CodePtr, tr: usize, @@ -55,7 +55,7 @@ impl OrStack { pub fn push(&mut self, global_index: usize, e: usize, - cp: CodePtr, + cp: LocalCodePtr, b: usize, bp: CodePtr, tr: usize, diff --git a/src/prolog/toplevel.rs b/src/prolog/toplevel.rs index 3c122dfc..addb26e9 100644 --- a/src/prolog/toplevel.rs +++ b/src/prolog/toplevel.rs @@ -233,7 +233,7 @@ fn unfold_by_str(mut term: Term, s: &str) -> Vec terms.push(fst); term = snd; } - + terms.push(term); terms } @@ -397,10 +397,8 @@ impl RelationWorker { }, Term::Var(_, ref v) if v.as_str() == "!" => Ok(QueryTerm::UnblockedCut(Cell::default())), - Term::Clause(r, name, mut terms, fixity) => - if let Some(system_ct) = SystemClauseType::from(name.as_str(), terms.len()) { - Ok(QueryTerm::Clause(r, ClauseType::System(system_ct), terms)) - } else if name.as_str() == ";" { + 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); From 954c29b103787b2db750b334111a8d5a75d11e19 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Thu, 10 May 2018 01:43:36 -0600 Subject: [PATCH 06/20] add catch/throw support, make exceptions and arithmetic tests pass. --- src/main.rs | 15 -- src/prolog/ast.rs | 40 +++++- src/prolog/io.rs | 16 +++ src/prolog/lib/builtins.pl | 62 +++++++- src/prolog/machine/machine_state.rs | 136 +++++++++++++----- src/prolog/machine/machine_state_impl.rs | 15 +- src/prolog/machine/system_calls.rs | 8 +- src/prolog/toplevel.rs | 2 +- src/tests.rs | 175 ++++++++++++----------- 9 files changed, 314 insertions(+), 155 deletions(-) diff --git a/src/main.rs b/src/main.rs index 1e4a7e29..a220f41a 100644 --- a/src/main.rs +++ b/src/main.rs @@ -11,7 +11,6 @@ use prolog::machine::*; #[cfg(test)] mod tests; -pub static BUILTINS: &str = include_str!("./prolog/lib/builtins.pl"); pub static LISTS: &str = include_str!("./prolog/lib/lists.pl"); pub static CONTROL: &str = include_str!("./prolog/lib/control.pl"); pub static QUEUES: &str = include_str!("./prolog/lib/queues.pl"); @@ -27,20 +26,6 @@ fn parse_and_compile_line(wam: &mut Machine, buffer: &str) } } -fn load_init_str(wam: &mut Machine, src_str: &str) -{ - match compile_listing(wam, src_str) { - EvalSession::Error(_) => panic!("failed to parse batch from string."), - _ => {} - } -} - -fn load_init_str_and_include(wam: &mut Machine, src_str: &str, module: &'static str) -{ - load_init_str(wam, src_str); - wam.use_module_in_toplevel(clause_name!(module)); -} - fn prolog_repl() { let mut wam = Machine::new(); diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index 34623fee..f4d47303 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -711,13 +711,31 @@ pub struct Rule { #[derive(Copy, Clone, PartialEq)] pub enum SystemClauseType { - SkipMaxList + CleanUpBlock, + EraseBall, + Fail, + GetBall, + GetCurrentBlock, + InstallNewBlock, + ResetBlock, + SetBall, + SkipMaxList, + UnwindStack } impl SystemClauseType { pub fn arity(&self) -> usize { match self { - &SystemClauseType::SkipMaxList => 4 + &SystemClauseType::CleanUpBlock => 1, + &SystemClauseType::EraseBall => 0, + &SystemClauseType::Fail => 0, + &SystemClauseType::GetBall => 1, + &SystemClauseType::GetCurrentBlock => 1, + &SystemClauseType::InstallNewBlock => 1, + &SystemClauseType::ResetBlock => 1, + &SystemClauseType::SetBall => 1, + &SystemClauseType::SkipMaxList => 4, + &SystemClauseType::UnwindStack => 0 } } @@ -727,13 +745,31 @@ impl SystemClauseType { pub fn name(&self) -> ClauseName { match self { + &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::GetCurrentBlock => clause_name!("$get_current_block"), + &SystemClauseType::InstallNewBlock => clause_name!("$install_new_block"), + &SystemClauseType::ResetBlock => clause_name!("$reset_block"), + &SystemClauseType::SetBall => clause_name!("$set_ball"), &SystemClauseType::SkipMaxList => clause_name!("$skip_max_list"), + &SystemClauseType::UnwindStack => clause_name!("$unwind_stack"), } } pub fn from(name: &str, arity: usize) -> Option { match (name, arity) { + ("$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), + ("$install_new_block", 1) => Some(SystemClauseType::InstallNewBlock), + ("$reset_block", 1) => Some(SystemClauseType::ResetBlock), + ("$set_ball", 1) => Some(SystemClauseType::SetBall), ("$skip_max_list", 4) => Some(SystemClauseType::SkipMaxList), + ("$unwind_stack", 0) => Some(SystemClauseType::UnwindStack), _ => None } } diff --git a/src/prolog/io.rs b/src/prolog/io.rs index 52876615..974876a8 100644 --- a/src/prolog/io.rs +++ b/src/prolog/io.rs @@ -601,6 +601,22 @@ pub fn compile_packet(wam: &mut Machine, tl: TopLevelPacket) -> EvalSession } } +pub static BUILTINS: &str = include_str!("./lib/builtins.pl"); + +pub fn load_init_str(wam: &mut Machine, src_str: &str) +{ + match compile_listing(wam, src_str) { + EvalSession::Error(_) => panic!("failed to parse batch from string."), + _ => {} + } +} + +pub fn load_init_str_and_include(wam: &mut Machine, src_str: &str, module: &'static str) +{ + load_init_str(wam, src_str); + wam.use_module_in_toplevel(clause_name!(module)); +} + pub fn compile_listing(wam: &mut Machine, src_str: &str) -> EvalSession { fn get_module_name(module: &Option) -> ClauseName { diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index 7a46bf8d..2d1856e8 100644 --- a/src/prolog/lib/builtins.pl +++ b/src/prolog/lib/builtins.pl @@ -1,8 +1,9 @@ :- op(400, yfx, /). -:- module(builtins, [(+)/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, (>=)/2, (=<)/2]). +:- 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]). % arithmetic operators. :- op(700, xfx, is). @@ -19,6 +20,7 @@ :- op(400, yfx, >>). :- op(400, yfx, mod). :- op(400, yfx, rem). +:- op(200, fy, -). % arithmetic comparison operators. :- op(700, xfx, >). @@ -27,3 +29,57 @@ :- op(700, xfx, =:=). :- op(700, xfx, >=). :- op(700, xfx, =<). + +% conditional operators. +:- op(1050, xfy, ->). +:- op(1100, xfy, ;). + +% unify. +:- op(700, xfx, =). + +% unify. +X = X. + +true. + +false :- '$fail'. + +% conditions. +/* +','(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). +','(G1, G2, _) :- G1, G2. + +;(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). +;(G, _, _) :- G. +;(_, G, _) :- G. + +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). +*/ + +% 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). +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(_, _, _) :- '$unwind_stack'. + +throw(Ball) :- '$set_ball'(Ball), '$unwind_stack'. diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index 7913137a..55d22ed9 100644 --- a/src/prolog/machine/machine_state.rs +++ b/src/prolog/machine/machine_state.rs @@ -400,37 +400,35 @@ pub(crate) trait CallPolicy: Any { Ok(()) } - fn call_n<'a>(&mut self, machine_st: &mut MachineState, arity: usize, + fn call_n<'a>(&mut self, machine_st: &mut MachineState, mut arity: usize, code_dirs: CodeDirs<'a>, lco: bool) -> CallResult { - loop { - if let Some((name, mut arity)) = machine_st.setup_call_n(arity) { - let user = clause_name!("user"); + while let Some((name, inner_arity)) = machine_st.setup_call_n(arity) { + let user = clause_name!("user"); - if machine_st.fail { - return Ok(()); - } - - match ClauseType::from(name.clone(), arity, None) { - ClauseType::CallN => { - machine_st.num_of_args = arity; - machine_st.handle_internal_call_n(); - - continue; - }, - ClauseType::BuiltIn(built_in) => - machine_st.setup_built_in_call(built_in, lco), - ClauseType::Inlined(inlined) => - machine_st.execute_inlined(&inlined), - ClauseType::Op(..) | ClauseType::Named(..) => - 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, arity)); - } - }; - } + match ClauseType::from(name.clone(), inner_arity, None) { + ClauseType::CallN => { + machine_st.handle_internal_call_n(inner_arity); + + if machine_st.fail { + return Ok(()); + } + + arity = inner_arity; + continue; + }, + ClauseType::BuiltIn(built_in) => + machine_st.setup_built_in_call(built_in, lco), + 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)?; + } else { + return Err(machine_st.existence_error(name, inner_arity)); + } + }; break; } @@ -441,10 +439,82 @@ pub(crate) trait CallPolicy: Any { fn system_call(&mut self, machine_st: &mut MachineState, ct: &SystemClauseType) -> CallResult { match ct { + &SystemClauseType::CleanUpBlock => { + let nb = machine_st.store(machine_st.deref(machine_st[temp_v!(1)].clone())); + + match nb { + Addr::Con(Constant::Usize(nb)) => { + let b = machine_st.b - 1; + + if nb > 0 && machine_st.or_stack[b].b == nb { + machine_st.b = machine_st.or_stack[nb - 1].b; + machine_st.or_stack.truncate(machine_st.b); + } + }, + _ => machine_st.fail = true + }; + + Ok(()) + }, + &SystemClauseType::EraseBall => { + machine_st.ball.reset(); + Ok(()) + }, + &SystemClauseType::Fail => { + machine_st.fail = true; + Ok(()) + }, + &SystemClauseType::GetBall => { + let addr = machine_st.store(machine_st.deref(machine_st[temp_v!(1)].clone())); + let h = machine_st.heap.h; + + if machine_st.ball.stub.len() > 0 { + machine_st.copy_and_align_ball_to_heap(); + } else { + machine_st.fail = true; + return Ok(()); + } + + let ball = machine_st.heap[h].as_addr(h); + + match addr.as_var() { + Some(r) => machine_st.bind(r, ball), + _ => machine_st.fail = true + }; + + Ok(()) + }, + &SystemClauseType::GetCurrentBlock => { + let c = Constant::Usize(machine_st.block); + let addr = machine_st[temp_v!(1)].clone(); + + machine_st.write_constant_to_var(addr, c); + Ok(()) + }, + &SystemClauseType::InstallNewBlock => { + machine_st.block = machine_st.b; + + let c = Constant::Usize(machine_st.block); + let addr = machine_st[temp_v!(1)].clone(); + + machine_st.write_constant_to_var(addr, c); + Ok(()) + }, + &SystemClauseType::ResetBlock => { + let addr = machine_st.deref(machine_st[temp_v!(1)].clone()); + machine_st.reset_block(addr); + Ok(()) + }, + &SystemClauseType::SetBall => { + machine_st.set_ball(); + Ok(()) + }, &SystemClauseType::SkipMaxList => { machine_st.skip_max_list()?; - machine_st.p += 1; - + Ok(()) + }, + &SystemClauseType::UnwindStack => { + machine_st.unwind_stack(); Ok(()) } } @@ -549,7 +619,7 @@ pub(crate) trait CallPolicy: Any { let key_pairs = key_pairs.into_iter().map(|kp| kp.1); let heap_addr = Addr::HeapCell(machine_st.to_list(key_pairs)); - + let r2 = machine_st[temp_v!(2)].clone(); machine_st.unify(r2, heap_addr); @@ -564,8 +634,10 @@ pub(crate) trait CallPolicy: Any { Ok(()) }, - &BuiltInClauseType::System(ref ct) => - self.system_call(machine_st, ct), + &BuiltInClauseType::System(ref ct) => { + self.system_call(machine_st, ct)?; + return_from_clause!(lco, machine_st) + } } } } diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index bc12c399..1e368c5f 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -80,7 +80,7 @@ impl MachineState { }; } - fn bind(&mut self, r1: Ref, a2: Addr) { + pub(super) fn bind(&mut self, r1: Ref, a2: Addr) { let t2 = self.store(a2); match r1 { @@ -273,7 +273,7 @@ impl MachineState { } } - fn write_constant_to_var(&mut self, addr: Addr, c: Constant) { + pub(super) fn write_constant_to_var(&mut self, addr: Addr, c: Constant) { let addr = self.deref(addr); match self.store(addr) { @@ -1011,9 +1011,9 @@ impl MachineState { } } - pub(super) fn handle_internal_call_n(&mut self) + pub(super) fn handle_internal_call_n(&mut self, arity: usize) { - let arity = self.num_of_args + 1; + let arity = arity + 1; let pred = self.registers[1].clone(); for i in 2 .. arity { @@ -1310,12 +1310,9 @@ impl MachineState { Ordering::Equal } - fn reset_block(&mut self, addr: Addr) { + pub(super) fn reset_block(&mut self, addr: Addr) { match self.store(addr) { - Addr::Con(Constant::Usize(b)) => { - self.block = b; - self.p += 1; - }, + Addr::Con(Constant::Usize(b)) => self.block = b, _ => self.fail = true }; } diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index 7f0238b2..1d1c55b1 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -152,11 +152,5 @@ impl MachineState { }; Ok(()) - } - - pub(super) fn execute_system(&mut self, ct: &SystemClauseType) -> Result<(), MachineError> { - match ct { - &SystemClauseType::SkipMaxList => self.skip_max_list() - } - } + } } diff --git a/src/prolog/toplevel.rs b/src/prolog/toplevel.rs index addb26e9..27986de4 100644 --- a/src/prolog/toplevel.rs +++ b/src/prolog/toplevel.rs @@ -393,7 +393,7 @@ impl RelationWorker { if name.as_str() == "!" || name.as_str() == "blocked_!" { Ok(QueryTerm::BlockedCut) } else { - Ok(QueryTerm::Clause(r, ClauseType::Named(name, CodeIndex::default()), vec![])) + Ok(QueryTerm::Clause(r, ClauseType::from(name, 0, None), vec![])) }, Term::Var(_, ref v) if v.as_str() == "!" => Ok(QueryTerm::UnblockedCut(Cell::default())), diff --git a/src/tests.rs b/src/tests.rs index df7cbae2..f965a388 100644 --- a/src/tests.rs +++ b/src/tests.rs @@ -933,11 +933,97 @@ fn test_queries_on_call_n() ["X = y"]]); } +#[test] +fn test_queries_on_arithmetic() +{ + let mut wam = Machine::new(); + load_init_str_and_include(&mut wam, BUILTINS, "builtins"); + + assert_prolog_success!(&mut wam, "?- X is 1, X is X.", [["X = 1"]]); + assert_prolog_failure!(&mut wam, "?- X is 1, X is X + 1."); + assert_prolog_success!(&mut wam, "?- X is 1, X is X + 0.", [["X = 1"]]); + assert_prolog_success!(&mut wam, "?- X is 1, X is X * 1.", [["X = 1"]]); + assert_prolog_failure!(&mut wam, "?- X is 1, X is X * 2."); + + assert_prolog_failure!(&mut wam, "?- X is 1 + a."); + assert_prolog_failure!(&mut wam, "?- X is 1 + Y."); + assert_prolog_success!(&mut wam, "?- Y is 2 + 2 - 2, X is 1 + Y, X = 3.", + [["X = 3", "Y = 2"]]); + assert_prolog_failure!(&mut wam, "?- Y is 2 + 2 - 2, X is 1 + Y, X = 2."); + + assert_prolog_success!(&mut wam, "?- 6 is 6."); + assert_prolog_success!(&mut wam, "?- 6 is 3 + 3."); + assert_prolog_success!(&mut wam, "?- 6 is 3 * 2."); + assert_prolog_failure!(&mut wam, "?- 7 is 3 * 2."); + assert_prolog_failure!(&mut wam, "?- 7 is 3.5 * 2."); + assert_prolog_success!(&mut wam, "?- 7.0 is 3.5 * 2."); + assert_prolog_success!(&mut wam, "?- 7.0 is 14 / 2."); + assert_prolog_failure!(&mut wam, "?- 4.666 is 14.0 / 3."); + assert_prolog_success!(&mut wam, "?- 4.0 is 8.0 / 2."); + + submit(&mut wam, "f(X) :- X is 5 // 0."); + + assert_prolog_success!(&mut wam, "?- catch(f(X), error(evaluation_error(E), _), true), E = zero_divisor.", + [["E = zero_divisor", "X = _1"]]); + + submit(&mut wam, "f(X) :- X is (5 rdiv 1) / 0."); + + assert_prolog_success!(&mut wam, "?- catch(f(X), error(evaluation_error(E), _), true), E = zero_divisor.", + [["E = zero_divisor", "X = _1"]]); + + submit(&mut wam, "f(X) :- X is 5.0 / 0."); + + assert_prolog_success!(&mut wam, "?- catch(f(X), error(evaluation_error(E), _), true), E = zero_divisor.", + [["E = zero_divisor", "X = _1"]]); + + assert_prolog_success!(&mut wam, "?- X is ((3 + 4) // 2) + 2 - 1 // 1, Y is 2+2, Z is X+Y.", + [["Y = 4", "X = 4", "Z = 8"]]); + + assert_prolog_success!(&mut wam, "?- X is ((3 + 4) // 2) + 2 - 1 // 1, Y is 2+2, Z = 8, Y is 4.", + [["Y = 4", "X = 4", "Z = 8"]]); + + assert_prolog_success!(&mut wam, "?- X is (3 rdiv 4) / 2, Y is 3 rdiv 8, X = Y.", + [["X = 3/8", "Y = 3/8"]]); + + assert_prolog_success!(&mut wam, "?- X is 10 xor -4, X is -10.", [["X = -10"]]); + assert_prolog_success!(&mut wam, "?- X is 4 xor -7, X is -3.", [["X = -3"]]); + assert_prolog_success!(&mut wam, "?- X is 10 xor 5 + 55, X = 70.", [["X = 70"]]); + + assert_prolog_success!(&mut wam, "?- X is 10 rem -3, X = 1.", [["X = 1"]]); + assert_prolog_success!(&mut wam, "?- X is 10 mod -3, X is -2.", [["X = -2"]]); + + assert_prolog_success!(&mut wam, "?- call(is, X, 3 + 4).", [["X = 7"]]); + + assert_prolog_success!(&mut wam, "?- Y is 3 + 3, call(is, X, Y + 4).", [["Y = 6", "X = 10"]]); + assert_prolog_success!(&mut wam, "?- call(is, X, 3 + 4.5).", [["X = 7.5"]]); + assert_prolog_success!(&mut wam, "?- X is 2 rdiv 3, call(is, Y, X*X).", [["X = 2/3", "Y = 4/9"]]); + + assert_prolog_failure!(&mut wam, "?- call(>, 3, 3 + 3)."); + assert_prolog_failure!(&mut wam, "?- X is 3 + 3, call(>, 3, X)."); + + assert_prolog_success!(&mut wam, "?- X is 3 + 3, call(<, 3, X).", [["X = 6"]]); + assert_prolog_success!(&mut wam, "?- X is 3 + 3, X =:= 3 + 3.", [["X = 6"]]); + + assert_prolog_success!(&mut wam, "?- catch(call(is, X, 3 // 0), error(E, _), true).", + [["X = _5", "E = evaluation_error(zero_divisor)"]]); + + assert_prolog_success!(&mut wam, "?- catch(call(is, X, 3 // 3), _, true).", [["X = 1"]]); + + submit(&mut wam, "f(X, Sum) :- ( integer(X) -> Sum is X + X * X + 3 ; + var(X) -> Sum = 1, X = 1 )."); + + assert_prolog_success!(&mut wam, "?- f(X, Sum).", [["X = 1", "Sum = 1"]]); + assert_prolog_success!(&mut wam, "?- f(5, Sum).", [["Sum = 33"]]); + assert_prolog_success!(&mut wam, "?- f(5, 33)."); + assert_prolog_failure!(&mut wam, "?- f(5, 32)."); +} + #[test] fn test_queries_on_exceptions() { let mut wam = Machine::new(); - + load_init_str_and_include(&mut wam, BUILTINS, "builtins"); + submit(&mut wam, "f(a). f(_) :- throw(stuff)."); submit(&mut wam, "handle(stuff)."); @@ -1037,91 +1123,7 @@ fn test_queries_on_exceptions() ["E = an_error_1", "X = _1"], ["E = an_error_2", "X = _1"]]); } - -#[test] -fn test_queries_on_arithmetic() -{ - let mut wam = Machine::new(); - - assert_prolog_success!(&mut wam, "?- X is 1, X is X.", [["X = 1"]]); - assert_prolog_failure!(&mut wam, "?- X is 1, X is X + 1."); - assert_prolog_success!(&mut wam, "?- X is 1, X is X + 0.", [["X = 1"]]); - assert_prolog_success!(&mut wam, "?- X is 1, X is X * 1.", [["X = 1"]]); - assert_prolog_failure!(&mut wam, "?- X is 1, X is X * 2."); - - assert_prolog_failure!(&mut wam, "?- X is 1 + a."); - assert_prolog_failure!(&mut wam, "?- X is 1 + Y."); - assert_prolog_success!(&mut wam, "?- Y is 2 + 2 - 2, X is 1 + Y, X = 3.", - [["X = 3", "Y = 2"]]); - assert_prolog_failure!(&mut wam, "?- Y is 2 + 2 - 2, X is 1 + Y, X = 2."); - - assert_prolog_success!(&mut wam, "?- 6 is 6."); - assert_prolog_success!(&mut wam, "?- 6 is 3 + 3."); - assert_prolog_success!(&mut wam, "?- 6 is 3 * 2."); - assert_prolog_failure!(&mut wam, "?- 7 is 3 * 2."); - assert_prolog_failure!(&mut wam, "?- 7 is 3.5 * 2."); - assert_prolog_success!(&mut wam, "?- 7.0 is 3.5 * 2."); - assert_prolog_success!(&mut wam, "?- 7.0 is 14 / 2."); - assert_prolog_failure!(&mut wam, "?- 4.666 is 14.0 / 3."); - assert_prolog_success!(&mut wam, "?- 4.0 is 8.0 / 2."); - - submit(&mut wam, "f(X) :- X is 5 // 0."); - - assert_prolog_success!(&mut wam, "?- catch(f(X), error(evaluation_error(E), _), true), E = zero_divisor.", - [["E = zero_divisor", "X = _1"]]); - - submit(&mut wam, "f(X) :- X is (5 rdiv 1) / 0."); - - assert_prolog_success!(&mut wam, "?- catch(f(X), error(evaluation_error(E), _), true), E = zero_divisor.", - [["E = zero_divisor", "X = _1"]]); - - submit(&mut wam, "f(X) :- X is 5.0 / 0."); - - assert_prolog_success!(&mut wam, "?- catch(f(X), error(evaluation_error(E), _), true), E = zero_divisor.", - [["E = zero_divisor", "X = _1"]]); - - assert_prolog_success!(&mut wam, "?- X is ((3 + 4) // 2) + 2 - 1 // 1, Y is 2+2, Z is X+Y.", - [["Y = 4", "X = 4", "Z = 8"]]); - - assert_prolog_success!(&mut wam, "?- X is ((3 + 4) // 2) + 2 - 1 // 1, Y is 2+2, Z = 8, Y is 4.", - [["Y = 4", "X = 4", "Z = 8"]]); - - assert_prolog_success!(&mut wam, "?- X is (3 rdiv 4) / 2, Y is 3 rdiv 8, X = Y.", - [["X = 3/8", "Y = 3/8"]]); - - assert_prolog_success!(&mut wam, "?- X is 10 xor -4, X is -10.", [["X = -10"]]); - assert_prolog_success!(&mut wam, "?- X is 4 xor -7, X is -3.", [["X = -3"]]); - assert_prolog_success!(&mut wam, "?- X is 10 xor 5 + 55, X = 70.", [["X = 70"]]); - - assert_prolog_success!(&mut wam, "?- X is 10 rem -3, X = 1.", [["X = 1"]]); - assert_prolog_success!(&mut wam, "?- X is 10 mod -3, X is -2.", [["X = -2"]]); - - assert_prolog_success!(&mut wam, "?- call(is, X, 3 + 4).", [["X = 7"]]); - - assert_prolog_success!(&mut wam, "?- Y is 3 + 3, call(is, X, Y + 4).", [["Y = 6", "X = 10"]]); - assert_prolog_success!(&mut wam, "?- call(is, X, 3 + 4.5).", [["X = 7.5"]]); - assert_prolog_success!(&mut wam, "?- X is 2 rdiv 3, call(is, Y, X*X).", [["X = 2/3", "Y = 4/9"]]); - - assert_prolog_failure!(&mut wam, "?- call(>, 3, 3 + 3)."); - assert_prolog_failure!(&mut wam, "?- X is 3 + 3, call(>, 3, X)."); - - assert_prolog_success!(&mut wam, "?- X is 3 + 3, call(<, 3, X).", [["X = 6"]]); - assert_prolog_success!(&mut wam, "?- X is 3 + 3, X =:= 3 + 3.", [["X = 6"]]); - - assert_prolog_success!(&mut wam, "?- catch(call(is, X, 3 // 0), error(E, _), true).", - [["X = _5", "E = evaluation_error(zero_divisor)"]]); - - assert_prolog_success!(&mut wam, "?- catch(call(is, X, 3 // 3), _, true).", [["X = 1"]]); - - submit(&mut wam, "f(X, Sum) :- ( integer(X) -> Sum is X + X * X + 3 ; - var(X) -> Sum = 1, X = 1 )."); - - assert_prolog_success!(&mut wam, "?- f(X, Sum).", [["X = 1", "Sum = 1"]]); - assert_prolog_success!(&mut wam, "?- f(5, Sum).", [["Sum = 33"]]); - assert_prolog_success!(&mut wam, "?- f(5, 33)."); - assert_prolog_failure!(&mut wam, "?- f(5, 32)."); -} - +/* #[test] fn test_queries_on_conditionals() { @@ -1714,3 +1716,4 @@ fn test_queries_on_skip_max_list() { assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 9, non_list, Xs).", [["Xs = non_list", "N = 0"]]); } +*/ From 0f980e204dd2bac135527ef78650df6d750cd02d Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Thu, 10 May 2018 19:47:53 -0600 Subject: [PATCH 07/20] add more tests that pass. --- src/prolog/ast.rs | 4 +- src/prolog/indexing.rs | 5 +- src/tests.rs | 154 +++++++++++++++++++++-------------------- 3 files changed, 83 insertions(+), 80 deletions(-) diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index f4d47303..09ef2c8a 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -1402,8 +1402,8 @@ impl ControlInstruction { #[derive(Clone)] pub enum IndexingInstruction { SwitchOnTerm(usize, usize, usize, usize), - SwitchOnConstant(usize, HashMap), - SwitchOnStructure(usize, HashMap<(ClauseName, usize), usize>) + SwitchOnConstant(usize, Rc>), + SwitchOnStructure(usize, Rc>) } impl From for Line { diff --git a/src/prolog/indexing.rs b/src/prolog/indexing.rs index 384a343f..48751fad 100644 --- a/src/prolog/indexing.rs +++ b/src/prolog/indexing.rs @@ -2,6 +2,7 @@ use prolog::ast::*; use std::collections::{HashMap, VecDeque}; use std::hash::Hash; +use std::rc::Rc; #[derive(Clone, Copy)] enum IntIndex { @@ -132,7 +133,7 @@ impl CodeOffsets { if con_ind.len() > 1 { let index = Self::flatten_index(con_ind, prelude.len()); - let instr = IndexingInstruction::SwitchOnConstant(index.len(), index); + let instr = IndexingInstruction::SwitchOnConstant(index.len(), Rc::new(index)); prelude.push_front(Line::from(instr)); @@ -152,7 +153,7 @@ impl CodeOffsets { if str_ind.len() > 1 { let index = Self::flatten_index(str_ind, prelude.len()); - let instr = IndexingInstruction::SwitchOnStructure(index.len(), index); + let instr = IndexingInstruction::SwitchOnStructure(index.len(), Rc::new(index)); prelude.push_front(Line::from(instr)); diff --git a/src/tests.rs b/src/tests.rs index f965a388..b19cdf79 100644 --- a/src/tests.rs +++ b/src/tests.rs @@ -1123,6 +1123,84 @@ fn test_queries_on_exceptions() ["E = an_error_1", "X = _1"], ["E = an_error_2", "X = _1"]]); } + +#[test] +fn test_queries_on_skip_max_list() { + let mut wam = Machine::new(); + load_init_str_and_include(&mut wam, BUILTINS, "builtins"); + + // test on proper and empty lists. + assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 5, [], Xs).", + [["Xs = []", "N = 0"]]); + assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 5, [a,b,c], Xs).", + [["Xs = []", "N = 3"]]); + assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 2, [a,b,c], Xs).", + [["Xs = [c]", "N = 2"]]); + assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 3, [a,b,c], Xs).", + [["Xs = []", "N = 3"]]); + + assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 0, [], Xs).", + [["Xs = []", "N = 0"]]); + assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 0, [a,b,c], Xs).", + [["Xs = [a, b, c]", "N = 0"]]); + assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 0, [a,b,c], Xs).", + [["Xs = [a, b, c]", "N = 0"]]); + assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 0, [a,b,c], Xs).", + [["Xs = [a, b, c]", "N = 0"]]); + + assert_prolog_failure!(&mut wam, "?- '$skip_max_list'(4, 0, [], Xs)."); + assert_prolog_failure!(&mut wam, "?- '$skip_max_list'(3, 0, [a,b,c], Xs)."); + assert_prolog_failure!(&mut wam, "?- '$skip_max_list'(2, 0, [a,b,c], Xs)."); + assert_prolog_failure!(&mut wam, "?- '$skip_max_list'(1, 0, [a,b,c], Xs)."); + + assert_prolog_success!(&mut wam, "?- '$skip_max_list'(0, 5, [], Xs).", + [["Xs = []"]]); + assert_prolog_success!(&mut wam, "?- '$skip_max_list'(3, 5, [a,b,c], Xs).", + [["Xs = []"]]); + assert_prolog_success!(&mut wam, "?- '$skip_max_list'(2, 2, [a,b,c], Xs).", + [["Xs = [c]"]]); + assert_prolog_success!(&mut wam, "?- '$skip_max_list'(3, 3, [a,b,c], Xs).", + [["Xs = []"]]); + + // tests on proper and empty lists with no max. + + // test on proper and empty lists. + assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, -1, [], Xs).", + [["Xs = []", "N = 0"]]); + assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, -1, [a,b,c], Xs).", + [["Xs = []", "N = 3"]]); + + assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, -1, [], Xs).", + [["Xs = []", "N = 0"]]); + + assert_prolog_failure!(&mut wam, "?- '$skip_max_list'(4, -1, [], Xs)."); + assert_prolog_success!(&mut wam, "?- '$skip_max_list'(3, -1, [a,b,c], Xs).", + [["Xs = []"]]); + + assert_prolog_success!(&mut wam, "?- '$skip_max_list'(0, -1, [], Xs).", + [["Xs = []"]]); + assert_prolog_success!(&mut wam, "?- '$skip_max_list'(3, -1, [a,b,c], Xs).", + [["Xs = []"]]); + + // tests on partial lists. + assert_prolog_success!(&mut wam, "?- '$skip_max_list'(3, 4, [a,b,c|X], Xs0).", + [["X = _1", "Xs0 = _1"]]); + assert_prolog_success!(&mut wam, "?- '$skip_max_list'(3, 3, [a,b,c|X], Xs0).", + [["X = _1", "Xs0 = _1"]]); + assert_prolog_failure!(&mut wam, "?- '$skip_max_list'(3, 2, [a,b,c|X], Xs0)."); + assert_prolog_failure!(&mut wam, "?- '$skip_max_list'(3, 1, [a,b,c|X], Xs0)."); + assert_prolog_failure!(&mut wam, "?- '$skip_max_list'(3, 0, [a,b,c|X], Xs0)."); + + // tests on cyclic lists. + assert_prolog_failure!(&mut wam, "?- Xs = [a,b|Xs], '$skip_max_list'(3, 5, X, Xs0)."); + assert_prolog_failure!(&mut wam, "?- X = [a,b|Y], Y = [c,d|X], '$skip_max_list'(4, 5, X, Xs0)."); + assert_prolog_failure!(&mut wam, "?- X = [a,b|Y], Y = [c,d|X], '$skip_max_list'(4, 3, X, Xs0)."); + + // tests on non lists. + assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 9, non_list, Xs).", + [["Xs = non_list", "N = 0"]]); +} + /* #[test] fn test_queries_on_conditionals() @@ -1640,80 +1718,4 @@ fn test_queries_on_call_with_inference_limit() [["R = inference_limit_exceeded", "X = _1"]]); } - -#[test] -fn test_queries_on_skip_max_list() { - let mut wam = Machine::new(); - - // test on proper and empty lists. - assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 5, [], Xs).", - [["Xs = []", "N = 0"]]); - assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 5, [a,b,c], Xs).", - [["Xs = []", "N = 3"]]); - assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 2, [a,b,c], Xs).", - [["Xs = [c]", "N = 2"]]); - assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 3, [a,b,c], Xs).", - [["Xs = []", "N = 3"]]); - - assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 0, [], Xs).", - [["Xs = []", "N = 0"]]); - assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 0, [a,b,c], Xs).", - [["Xs = [a, b, c]", "N = 0"]]); - assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 0, [a,b,c], Xs).", - [["Xs = [a, b, c]", "N = 0"]]); - assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 0, [a,b,c], Xs).", - [["Xs = [a, b, c]", "N = 0"]]); - - assert_prolog_failure!(&mut wam, "?- '$skip_max_list'(4, 0, [], Xs)."); - assert_prolog_failure!(&mut wam, "?- '$skip_max_list'(3, 0, [a,b,c], Xs)."); - assert_prolog_failure!(&mut wam, "?- '$skip_max_list'(2, 0, [a,b,c], Xs)."); - assert_prolog_failure!(&mut wam, "?- '$skip_max_list'(1, 0, [a,b,c], Xs)."); - - assert_prolog_success!(&mut wam, "?- '$skip_max_list'(0, 5, [], Xs).", - [["Xs = []"]]); - assert_prolog_success!(&mut wam, "?- '$skip_max_list'(3, 5, [a,b,c], Xs).", - [["Xs = []"]]); - assert_prolog_success!(&mut wam, "?- '$skip_max_list'(2, 2, [a,b,c], Xs).", - [["Xs = [c]"]]); - assert_prolog_success!(&mut wam, "?- '$skip_max_list'(3, 3, [a,b,c], Xs).", - [["Xs = []"]]); - - // tests on proper and empty lists with no max. - - // test on proper and empty lists. - assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, -1, [], Xs).", - [["Xs = []", "N = 0"]]); - assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, -1, [a,b,c], Xs).", - [["Xs = []", "N = 3"]]); - - assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, -1, [], Xs).", - [["Xs = []", "N = 0"]]); - - assert_prolog_failure!(&mut wam, "?- '$skip_max_list'(4, -1, [], Xs)."); - assert_prolog_success!(&mut wam, "?- '$skip_max_list'(3, -1, [a,b,c], Xs).", - [["Xs = []"]]); - - assert_prolog_success!(&mut wam, "?- '$skip_max_list'(0, -1, [], Xs).", - [["Xs = []"]]); - assert_prolog_success!(&mut wam, "?- '$skip_max_list'(3, -1, [a,b,c], Xs).", - [["Xs = []"]]); - - // tests on partial lists. - assert_prolog_success!(&mut wam, "?- '$skip_max_list'(3, 4, [a,b,c|X], Xs0).", - [["X = _1", "Xs0 = _1"]]); - assert_prolog_success!(&mut wam, "?- '$skip_max_list'(3, 3, [a,b,c|X], Xs0).", - [["X = _1", "Xs0 = _1"]]); - assert_prolog_failure!(&mut wam, "?- '$skip_max_list'(3, 2, [a,b,c|X], Xs0)."); - assert_prolog_failure!(&mut wam, "?- '$skip_max_list'(3, 1, [a,b,c|X], Xs0)."); - assert_prolog_failure!(&mut wam, "?- '$skip_max_list'(3, 0, [a,b,c|X], Xs0)."); - - // tests on cyclic lists. - assert_prolog_failure!(&mut wam, "?- Xs = [a,b|Xs], '$skip_max_list'(3, 5, X, Xs0)."); - assert_prolog_failure!(&mut wam, "?- X = [a,b|Y], Y = [c,d|X], '$skip_max_list'(4, 5, X, Xs0)."); - assert_prolog_failure!(&mut wam, "?- X = [a,b|Y], Y = [c,d|X], '$skip_max_list'(4, 3, X, Xs0)."); - - // tests on non lists. - assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 9, non_list, Xs).", - [["Xs = non_list", "N = 0"]]); -} */ From 5a631c17c7027accc2f201bfa847b4e6b627bbe8 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Thu, 10 May 2018 22:24:15 -0600 Subject: [PATCH 08/20] make system calls exempt from call policy. --- src/prolog/ast.rs | 85 +++--- src/prolog/codegen.rs | 28 +- src/prolog/io.rs | 36 --- src/prolog/machine/machine_state.rs | 320 +++++++++-------------- src/prolog/machine/machine_state_impl.rs | 153 ++--------- src/prolog/machine/mod.rs | 2 - src/prolog/machine/system_calls.rs | 110 +++++++- src/prolog/macros.rs | 38 +-- 8 files changed, 320 insertions(+), 452 deletions(-) diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index 09ef2c8a..2e50706a 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -561,9 +561,9 @@ pub enum Term { Var(Cell, Rc) } -#[derive(Clone, Copy, PartialEq)] +#[derive(Clone, PartialEq)] pub enum InlinedClauseType { - CompareNumber(CompareNumberQT, RegType, RegType), + CompareNumber(CompareNumberQT, ArithmeticTerm, ArithmeticTerm), IsAtom(RegType), IsAtomic(RegType), IsCompound(RegType), @@ -609,20 +609,23 @@ impl InlinedClauseType { 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, r1, r2)), + Some(InlinedClauseType::CompareNumber(CompareNumberQT::GreaterThan, a1, a2)), ("<", 2) => - Some(InlinedClauseType::CompareNumber(CompareNumberQT::LessThan, r1, r2)), + Some(InlinedClauseType::CompareNumber(CompareNumberQT::LessThan, a1, a2)), (">=", 2) => - Some(InlinedClauseType::CompareNumber(CompareNumberQT::GreaterThanOrEqual,r1, r2)), + Some(InlinedClauseType::CompareNumber(CompareNumberQT::GreaterThanOrEqual,a1, a2)), ("=<", 2) => - Some(InlinedClauseType::CompareNumber(CompareNumberQT::LessThanOrEqual, r1, r2)), + Some(InlinedClauseType::CompareNumber(CompareNumberQT::LessThanOrEqual, a1, a2)), ("=\\=", 2) => - Some(InlinedClauseType::CompareNumber(CompareNumberQT::NotEqual, r1, r2)), + Some(InlinedClauseType::CompareNumber(CompareNumberQT::NotEqual, a1, a2)), ("=:=", 2) => - Some(InlinedClauseType::CompareNumber(CompareNumberQT::Equal, r1, r2)), + Some(InlinedClauseType::CompareNumber(CompareNumberQT::Equal, a1, a2)), ("atom", 1) => Some(InlinedClauseType::IsAtom(r1)), ("atomic", 1) => Some(InlinedClauseType::IsAtomic(r1)), ("compound", 1) => Some(InlinedClauseType::IsCompound(r1)), @@ -716,10 +719,12 @@ pub enum SystemClauseType { Fail, GetBall, GetCurrentBlock, + GetCutPoint(RegType), InstallNewBlock, ResetBlock, SetBall, SkipMaxList, + Succeed, UnwindStack } @@ -731,10 +736,12 @@ impl SystemClauseType { &SystemClauseType::Fail => 0, &SystemClauseType::GetBall => 1, &SystemClauseType::GetCurrentBlock => 1, + &SystemClauseType::GetCutPoint(_) => 1, &SystemClauseType::InstallNewBlock => 1, &SystemClauseType::ResetBlock => 1, &SystemClauseType::SetBall => 1, &SystemClauseType::SkipMaxList => 4, + &SystemClauseType::Succeed => 0, &SystemClauseType::UnwindStack => 0 } } @@ -749,11 +756,13 @@ impl SystemClauseType { &SystemClauseType::EraseBall => clause_name!("$erase_ball"), &SystemClauseType::Fail => clause_name!("$fail"), &SystemClauseType::GetBall => clause_name!("$get_ball"), + &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"), &SystemClauseType::SetBall => clause_name!("$set_ball"), &SystemClauseType::SkipMaxList => clause_name!("$skip_max_list"), + &SystemClauseType::Succeed => clause_name!("$succeed"), &SystemClauseType::UnwindStack => clause_name!("$unwind_stack"), } } @@ -765,6 +774,7 @@ impl SystemClauseType { ("$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))), ("$install_new_block", 1) => Some(SystemClauseType::InstallNewBlock), ("$reset_block", 1) => Some(SystemClauseType::ResetBlock), ("$set_ball", 1) => Some(SystemClauseType::SetBall), @@ -790,7 +800,6 @@ pub enum BuiltInClauseType { KeySort, NotEq, Sort, - System(SystemClauseType) } #[derive(Clone)] @@ -799,7 +808,8 @@ pub enum ClauseType { CallN, Inlined(InlinedClauseType), Op(ClauseName, Fixity, CodeIndex), - Named(ClauseName, CodeIndex) + Named(ClauseName, CodeIndex), + System(SystemClauseType) } #[derive(Clone)] @@ -891,8 +901,7 @@ impl BuiltInClauseType { &BuiltInClauseType::Is => clause_name!("is"), &BuiltInClauseType::KeySort => clause_name!("keysort"), &BuiltInClauseType::NotEq => clause_name!("\\=="), - &BuiltInClauseType::Sort => clause_name!("sort"), - &BuiltInClauseType::System(system) => system.name() + &BuiltInClauseType::Sort => clause_name!("sort"), } } @@ -911,7 +920,6 @@ impl BuiltInClauseType { &BuiltInClauseType::KeySort => 2, &BuiltInClauseType::NotEq => 2, &BuiltInClauseType::Sort => 2, - &BuiltInClauseType::System(system) => system.arity() } } @@ -935,7 +943,7 @@ impl BuiltInClauseType { ("keysort", 2) => Some(BuiltInClauseType::KeySort), ("\\==", 2) => Some(BuiltInClauseType::NotEq), ("sort", 2) => Some(BuiltInClauseType::Sort), - _ => SystemClauseType::from(name, arity).map(BuiltInClauseType::System) + _ => None } } } @@ -946,6 +954,7 @@ impl ClauseType { &ClauseType::BuiltIn(ref built_in) => built_in.fixity(), &ClauseType::Inlined(InlinedClauseType::CompareNumber(..)) => Some(Fixity::In), &ClauseType::Op(_, fixity, _) => Some(fixity), + &ClauseType::System(ref system) => system.fixity(), _ => None } } @@ -954,9 +963,10 @@ impl ClauseType { match self { &ClauseType::CallN => clause_name!("call"), &ClauseType::BuiltIn(built_in) => built_in.name(), - &ClauseType::Inlined(inlined) => clause_name!(inlined.name()), + &ClauseType::Inlined(ref inlined) => clause_name!(inlined.name()), &ClauseType::Op(ref name, ..) => name.clone(), &ClauseType::Named(ref name, ..) => name.clone(), + &ClauseType::System(ref system) => system.name(), } } @@ -967,15 +977,19 @@ impl ClauseType { BuiltInClauseType::from(name.as_str(), arity) .map(ClauseType::BuiltIn) .unwrap_or_else(|| { - if let Some(fixity) = fixity { - ClauseType::Op(name, fixity, CodeIndex::default()) - } else if name.as_str() == "call" { - ClauseType::CallN - } else { - ClauseType::Named(name, CodeIndex::default()) - } + SystemClauseType::from(name.as_str(), arity) + .map(ClauseType::System) + .unwrap_or_else(|| { + if let Some(fixity) = fixity { + ClauseType::Op(name, fixity, CodeIndex::default()) + } else if name.as_str() == "call" { + ClauseType::CallN + } else { + ClauseType::Named(name, CodeIndex::default()) + } + }) }) - }) + }) } } @@ -1309,7 +1323,7 @@ impl Neg for Number { } } -#[derive(Clone)] +#[derive(Clone, PartialEq)] pub enum ArithmeticTerm { Reg(RegType), Interm(usize), @@ -1347,30 +1361,14 @@ pub enum ArithmeticInstruction { #[derive(Clone)] pub enum BuiltInInstruction { - CleanUpBlock, - CompareNumber(CompareNumberQT, ArithmeticTerm, ArithmeticTerm), - DefaultRetryMeElse(usize), - DefaultSetCutPoint(RegType), - DefaultTrustMe, - EraseBall, - Fail, GetArg(bool), // last call. - GetBall, - GetCurrentBlock, - GetCutPoint(RegType), InferenceLevel(RegType, RegType), InstallCleaner, InstallInferenceCounter(RegType, RegType, RegType), - InstallNewBlock, RemoveCallPolicyCheck, RemoveInferenceCounter(RegType, RegType), - ResetBlock, RestoreCutPolicy, - SetBall, SetCutPoint(RegType), - Succeed, - Unify, - UnwindStack } #[derive(Clone)] @@ -1379,8 +1377,7 @@ pub enum ControlInstruction { CallClause(ClauseType, usize, usize, bool), // name, arity, perm_vars after threshold, last call. CheckCpExecute, Deallocate, - GetCleanerCall, - Goto(usize, usize, bool), // p, arity, last call. + 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 @@ -1391,7 +1388,6 @@ impl ControlInstruction { match self { &ControlInstruction::CallClause(..) => true, &ControlInstruction::GetCleanerCall => true, - &ControlInstruction::Goto(..) => true, &ControlInstruction::IsClause(..) => true, &ControlInstruction::JmpBy(..) => true, _ => false @@ -1586,7 +1582,6 @@ impl From<(usize, ClauseName)> for CodeIndex { #[derive(Clone, PartialEq)] pub enum CodePtr { BuiltInClause(BuiltInClauseType, LocalCodePtr), // local is the successor call. - CallN(usize, LocalCodePtr), // the arity of the call, successor call. Local(LocalCodePtr) } @@ -1594,7 +1589,6 @@ impl CodePtr { pub fn local(&self) -> LocalCodePtr { match self { &CodePtr::BuiltInClause(_, ref local) - | &CodePtr::CallN(_, ref local) | &CodePtr::Local(ref local) => local.clone() } } @@ -1684,7 +1678,6 @@ impl Add for CodePtr { match self { CodePtr::Local(local) => CodePtr::Local(local + rhs), CodePtr::BuiltInClause(_, local) => CodePtr::Local(local + rhs), - CodePtr::CallN(_, local) => CodePtr::Local(local + rhs), } } } diff --git a/src/prolog/codegen.rs b/src/prolog/codegen.rs index 4e6d9ed3..de0f8018 100644 --- a/src/prolog/codegen.rs +++ b/src/prolog/codegen.rs @@ -232,14 +232,12 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator match ctrl.clone() { ControlInstruction::CallClause(ct, arity, pvs, false) => *ctrl = ControlInstruction::CallClause(ct, arity, pvs, true), - ControlInstruction::Goto(p, arity, false) => - *ctrl = ControlInstruction::Goto(p, arity, true), ControlInstruction::JmpBy(arity, offset, pvs, false) => *ctrl = ControlInstruction::JmpBy(arity, offset, pvs, true), ControlInstruction::IsClause(false, r, at) => *ctrl = ControlInstruction::IsClause(true, r, at), ControlInstruction::Proceed => {}, - _ => dealloc_index += 1 // = code.len() + _ => dealloc_index += 1 }, Some(&mut Line::Cut(CutInstruction::Cut(_))) => dealloc_index += 1, @@ -249,12 +247,12 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator dealloc_index } - fn compile_inlined(&mut self, ct: InlinedClauseType, terms: &'a Vec>, + fn compile_inlined(&mut self, ct: &InlinedClauseType, terms: &'a Vec>, term_loc: GenContext, code: &mut Code) -> Result<(), ParserError> { match ct { - InlinedClauseType::CompareNumber(cmp, ..) => { + &InlinedClauseType::CompareNumber(cmp, ..) => { let (mut lcode, at_1) = self.call_arith_eval(terms[0].as_ref(), 1)?; let (mut rcode, at_2) = self.call_arith_eval(terms[1].as_ref(), 2)?; @@ -265,7 +263,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator at_1.unwrap_or(interm!(1)), at_2.unwrap_or(interm!(2)))); }, - InlinedClauseType::IsAtom(..) => + &InlinedClauseType::IsAtom(..) => match terms[0].as_ref() { &Term::Constant(_, Constant::Atom(_)) => { code.push(succeed!()); @@ -278,7 +276,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator code.push(fail!()); } }, - InlinedClauseType::IsAtomic(..) => + &InlinedClauseType::IsAtomic(..) => match terms[0].as_ref() { &Term::AnonVar | &Term::Clause(..) | &Term::Cons(..) => { code.push(fail!()); @@ -291,7 +289,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator code.push(is_atomic!(r)); } }, - InlinedClauseType::IsCompound(..) => + &InlinedClauseType::IsCompound(..) => match terms[0].as_ref() { &Term::Clause(..) | &Term::Cons(..) => { code.push(succeed!()); @@ -304,7 +302,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator code.push(fail!()); } }, - InlinedClauseType::IsRational(..) => + &InlinedClauseType::IsRational(..) => match terms[0].as_ref() { &Term::Constant(_, Constant::Number(Number::Rational(_))) => { code.push(succeed!()); @@ -317,7 +315,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator code.push(fail!()); } }, - InlinedClauseType::IsFloat(..) => + &InlinedClauseType::IsFloat(..) => match terms[0].as_ref() { &Term::Constant(_, Constant::Number(Number::Float(_))) => { code.push(succeed!()); @@ -330,7 +328,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator code.push(fail!()); } }, - InlinedClauseType::IsString(..) => + &InlinedClauseType::IsString(..) => match terms[0].as_ref() { &Term::Constant(_, Constant::String(_)) => { code.push(succeed!()); @@ -343,7 +341,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator code.push(fail!()); } }, - InlinedClauseType::IsNonVar(..) => + &InlinedClauseType::IsNonVar(..) => match terms[0].as_ref() { &Term::AnonVar => { code.push(fail!()); @@ -356,7 +354,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator code.push(succeed!()); } }, - InlinedClauseType::IsInteger(..) => + &InlinedClauseType::IsInteger(..) => match terms[0].as_ref() { &Term::Constant(_, Constant::Number(Number::Integer(_))) => { code.push(succeed!()); @@ -369,7 +367,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator code.push(fail!()); }, }, - InlinedClauseType::IsVar(..) => + &InlinedClauseType::IsVar(..) => match terms[0].as_ref() { &Term::Constant(..) | &Term::Clause(..) | &Term::Cons(..) => { code.push(fail!()); @@ -446,7 +444,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator } } }, - &QueryTerm::Clause(_, ClauseType::Inlined(ct), ref terms) => + &QueryTerm::Clause(_, ClauseType::Inlined(ref ct), ref terms) => try!(self.compile_inlined(ct, terms, term_loc, code)), _ => { let num_perm_vars = if chunk_num == 0 { diff --git a/src/prolog/io.rs b/src/prolog/io.rs index 974876a8..576fa800 100644 --- a/src/prolog/io.rs +++ b/src/prolog/io.rs @@ -139,10 +139,6 @@ impl fmt::Display for ControlInstruction { write!(f, "deallocate"), &ControlInstruction::GetCleanerCall => write!(f, "get_cleaner_call"), - &ControlInstruction::Goto(p, arity, false) => - write!(f, "goto_call {}/{}", p, arity), - &ControlInstruction::Goto(p, arity, true) => - write!(f, "goto_execute {}/{}", p, arity), &ControlInstruction::IsClause(false, r, ref at) => write!(f, "is_call {}, {}", r, at), &ControlInstruction::IsClause(true, r, ref at) => @@ -173,56 +169,24 @@ impl fmt::Display for IndexedChoiceInstruction { impl fmt::Display for BuiltInInstruction { fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { match self { - &BuiltInInstruction::CleanUpBlock => - write!(f, "clean_up_block"), - &BuiltInInstruction::CompareNumber(cmp, ref at_1, ref at_2) => - write!(f, "number_test {}, {}, {} ", cmp, at_1, at_2), - &BuiltInInstruction::DefaultRetryMeElse(o) => - write!(f, "default_retry_me_else {}", o), - &BuiltInInstruction::DefaultSetCutPoint(r) => - write!(f, "default_set_cp {}", r), - &BuiltInInstruction::DefaultTrustMe => - write!(f, "default_trust_me"), &BuiltInInstruction::InstallInferenceCounter(r1, r2, r3) => write!(f, "install_inference_counter {}, {}, {}", r1, r2, r3), - &BuiltInInstruction::EraseBall => - write!(f, "erase_ball"), - &BuiltInInstruction::Fail => - write!(f, "false"), &BuiltInInstruction::GetArg(false) => write!(f, "get_arg_call X1, X2, X3"), &BuiltInInstruction::GetArg(true) => write!(f, "get_arg_execute X1, X2, X3"), - &BuiltInInstruction::GetBall => - write!(f, "get_ball X1"), - &BuiltInInstruction::GetCurrentBlock => - write!(f, "get_current_block X1"), - &BuiltInInstruction::GetCutPoint(r) => - write!(f, "get_cp {}", r), &BuiltInInstruction::InferenceLevel(r1, r2) => write!(f, "inference_level {}, {}", r1, r2), &BuiltInInstruction::InstallCleaner => write!(f, "install_cleaner"), - &BuiltInInstruction::InstallNewBlock => - write!(f, "install_new_block"), &BuiltInInstruction::RemoveCallPolicyCheck => write!(f, "remove_call_policy_check"), &BuiltInInstruction::RemoveInferenceCounter(r1, r2) => write!(f, "remove_inference_counter {}, {}", r1, r2), - &BuiltInInstruction::ResetBlock => - write!(f, "reset_block"), &BuiltInInstruction::RestoreCutPolicy => write!(f, "restore_cut_point"), - &BuiltInInstruction::SetBall => - write!(f, "set_ball"), &BuiltInInstruction::SetCutPoint(r) => write!(f, "set_cp {}", r), - &BuiltInInstruction::Succeed => - write!(f, "true"), - &BuiltInInstruction::UnwindStack => - write!(f, "unwind_stack"), - &BuiltInInstruction::Unify => - write!(f, "unify"), } } } diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index 55d22ed9..74ac779a 100644 --- a/src/prolog/machine/machine_state.rs +++ b/src/prolog/machine/machine_state.rs @@ -1,10 +1,10 @@ use prolog::and_stack::*; use prolog::ast::*; use prolog::copier::*; +use prolog::heap_print::*; use prolog::machine::machine_errors::MachineStub; use prolog::num::{BigInt, BigUint, Zero, One}; use prolog::or_stack::*; -use prolog::heap_print::*; use prolog::tabled_rc::*; use downcast::Any; @@ -227,56 +227,6 @@ pub struct MachineState { pub(crate) type CallResult = Result<(), Vec>; pub(crate) trait CallPolicy: Any { - fn context_call(&mut self, machine_st: &mut MachineState, name: ClauseName, - arity: usize, idx: CodeIndex, lco: bool) - -> CallResult - { - if lco { - self.try_execute(machine_st, name, arity, idx) - } else { - self.try_call(machine_st, name, arity, idx) - } - } - - fn try_call(&mut self, machine_st: &mut MachineState, name: ClauseName, - arity: usize, idx: CodeIndex) - -> CallResult - { - match idx.0.borrow().0 { - IndexPtr::Undefined => - return Err(machine_st.existence_error(name, arity)), - IndexPtr::Index(compiled_tl_index) => { - let module_name = idx.0.borrow().1.clone(); - - machine_st.cp.assign_if_local(machine_st.p.clone() + 1); - machine_st.num_of_args = arity; - machine_st.b0 = machine_st.b; - machine_st.p = dir_entry!(compiled_tl_index, module_name); - } - } - - Ok(()) - } - - fn try_execute<'a>(&mut self, machine_st: &mut MachineState, name: ClauseName, - arity: usize, idx: CodeIndex) - -> CallResult - { - match idx.0.borrow().0 { - IndexPtr::Undefined => - return Err(machine_st.existence_error(name, arity)), - IndexPtr::Index(compiled_tl_index) => { - let module_name = idx.0.borrow().1.clone(); - - machine_st.num_of_args = arity; - machine_st.b0 = machine_st.b; - machine_st.p = dir_entry!(compiled_tl_index, module_name); - } - } - - Ok(()) - } - fn retry_me_else(&mut self, machine_st: &mut MachineState, offset: usize) -> CallResult { let b = machine_st.b - 1; @@ -400,124 +350,54 @@ pub(crate) trait CallPolicy: Any { Ok(()) } - fn call_n<'a>(&mut self, machine_st: &mut MachineState, mut arity: usize, - code_dirs: CodeDirs<'a>, lco: bool) - -> CallResult + fn context_call(&mut self, machine_st: &mut MachineState, name: ClauseName, arity: usize, + idx: CodeIndex, lco: bool) + -> CallResult { - while let Some((name, inner_arity)) = machine_st.setup_call_n(arity) { - let user = clause_name!("user"); + if lco { + self.try_execute(machine_st, name, arity, idx) + } else { + self.try_call(machine_st, name, arity, idx) + } + } - match ClauseType::from(name.clone(), inner_arity, None) { - ClauseType::CallN => { - machine_st.handle_internal_call_n(inner_arity); - - if machine_st.fail { - return Ok(()); - } - - arity = inner_arity; - continue; - }, - ClauseType::BuiltIn(built_in) => - machine_st.setup_built_in_call(built_in, lco), - 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)?; - } else { - return Err(machine_st.existence_error(name, inner_arity)); - } - }; + fn try_call(&mut self, machine_st: &mut MachineState, name: ClauseName, + arity: usize, idx: CodeIndex) + -> CallResult + { + match idx.0.borrow().0 { + IndexPtr::Undefined => + return Err(machine_st.existence_error(name, arity)), + IndexPtr::Index(compiled_tl_index) => { + let module_name = idx.0.borrow().1.clone(); - break; + machine_st.cp.assign_if_local(machine_st.p.clone() + 1); + machine_st.num_of_args = arity; + machine_st.b0 = machine_st.b; + machine_st.p = dir_entry!(compiled_tl_index, module_name); + } } Ok(()) } - fn system_call(&mut self, machine_st: &mut MachineState, ct: &SystemClauseType) -> CallResult + fn try_execute<'a>(&mut self, machine_st: &mut MachineState, name: ClauseName, + arity: usize, idx: CodeIndex) + -> CallResult { - match ct { - &SystemClauseType::CleanUpBlock => { - let nb = machine_st.store(machine_st.deref(machine_st[temp_v!(1)].clone())); + match idx.0.borrow().0 { + IndexPtr::Undefined => + return Err(machine_st.existence_error(name, arity)), + IndexPtr::Index(compiled_tl_index) => { + let module_name = idx.0.borrow().1.clone(); - match nb { - Addr::Con(Constant::Usize(nb)) => { - let b = machine_st.b - 1; - - if nb > 0 && machine_st.or_stack[b].b == nb { - machine_st.b = machine_st.or_stack[nb - 1].b; - machine_st.or_stack.truncate(machine_st.b); - } - }, - _ => machine_st.fail = true - }; - - Ok(()) - }, - &SystemClauseType::EraseBall => { - machine_st.ball.reset(); - Ok(()) - }, - &SystemClauseType::Fail => { - machine_st.fail = true; - Ok(()) - }, - &SystemClauseType::GetBall => { - let addr = machine_st.store(machine_st.deref(machine_st[temp_v!(1)].clone())); - let h = machine_st.heap.h; - - if machine_st.ball.stub.len() > 0 { - machine_st.copy_and_align_ball_to_heap(); - } else { - machine_st.fail = true; - return Ok(()); - } - - let ball = machine_st.heap[h].as_addr(h); - - match addr.as_var() { - Some(r) => machine_st.bind(r, ball), - _ => machine_st.fail = true - }; - - Ok(()) - }, - &SystemClauseType::GetCurrentBlock => { - let c = Constant::Usize(machine_st.block); - let addr = machine_st[temp_v!(1)].clone(); - - machine_st.write_constant_to_var(addr, c); - Ok(()) - }, - &SystemClauseType::InstallNewBlock => { - machine_st.block = machine_st.b; - - let c = Constant::Usize(machine_st.block); - let addr = machine_st[temp_v!(1)].clone(); - - machine_st.write_constant_to_var(addr, c); - Ok(()) - }, - &SystemClauseType::ResetBlock => { - let addr = machine_st.deref(machine_st[temp_v!(1)].clone()); - machine_st.reset_block(addr); - Ok(()) - }, - &SystemClauseType::SetBall => { - machine_st.set_ball(); - Ok(()) - }, - &SystemClauseType::SkipMaxList => { - machine_st.skip_max_list()?; - Ok(()) - }, - &SystemClauseType::UnwindStack => { - machine_st.unwind_stack(); - Ok(()) + machine_st.num_of_args = arity; + machine_st.b0 = machine_st.b; + machine_st.p = dir_entry!(compiled_tl_index, module_name); } } + + Ok(()) } fn call_builtin<'a>(&mut self, machine_st: &mut MachineState, ct: &BuiltInClauseType, lco: bool) @@ -619,7 +499,7 @@ pub(crate) trait CallPolicy: Any { let key_pairs = key_pairs.into_iter().map(|kp| kp.1); let heap_addr = Addr::HeapCell(machine_st.to_list(key_pairs)); - + let r2 = machine_st[temp_v!(2)].clone(); machine_st.unify(r2, heap_addr); @@ -634,12 +514,95 @@ pub(crate) trait CallPolicy: Any { Ok(()) }, - &BuiltInClauseType::System(ref ct) => { - self.system_call(machine_st, ct)?; - return_from_clause!(lco, machine_st) - } } } + + fn call_n<'a>(&mut self, machine_st: &mut MachineState, mut arity: usize, + code_dirs: CodeDirs<'a>, lco: bool) + -> CallResult + { + while let Some((name, inner_arity)) = machine_st.setup_call_n(arity) { + let user = clause_name!("user"); + + match ClauseType::from(name.clone(), inner_arity, None) { + ClauseType::CallN => { + machine_st.handle_internal_call_n(inner_arity); + + if machine_st.fail { + return Ok(()); + } + + arity = inner_arity; + continue; + }, + 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)?; + } else { + return Err(machine_st.existence_error(name, inner_arity)); + }, + ClauseType::System(ct) => + return machine_st.system_call(&ct) + }; + + break; + } + + Ok(()) + } +} + +impl CallPolicy for CallWithInferenceLimitCallPolicy { + fn context_call(&mut self, machine_st: &mut MachineState, name: ClauseName, + arity: usize, idx: CodeIndex, lco: bool) + -> CallResult + { + self.prev_policy.context_call(machine_st, name, arity, idx, lco)?; + self.increment() + } + + fn retry_me_else(&mut self, machine_st: &mut MachineState, offset: usize) -> CallResult + { + self.prev_policy.retry_me_else(machine_st, offset)?; + self.increment() + } + + fn retry(&mut self, machine_st: &mut MachineState, offset: usize) -> CallResult + { + self.prev_policy.retry(machine_st, offset)?; + self.increment() + } + + fn trust_me(&mut self, machine_st: &mut MachineState) -> CallResult + { + self.prev_policy.trust_me(machine_st)?; + self.increment() + } + + fn trust(&mut self, machine_st: &mut MachineState, offset: usize) -> CallResult + { + self.prev_policy.trust(machine_st, offset)?; + self.increment() + } + + fn call_builtin<'a>(&mut self, machine_st: &mut MachineState, ct: &BuiltInClauseType, lco: bool) + -> CallResult + { + self.prev_policy.call_builtin(machine_st, ct, lco)?; + self.increment() + } + + fn call_n<'a>(&mut self, machine_st: &mut MachineState, arity: usize, code_dirs: CodeDirs<'a>, + lco: bool) + -> CallResult + { + self.prev_policy.call_n(machine_st, arity, code_dirs, lco)?; + self.increment() + } } downcast!(CallPolicy); @@ -714,39 +677,6 @@ impl CallWithInferenceLimitCallPolicy { } } -impl CallPolicy for CallWithInferenceLimitCallPolicy { - fn retry_me_else(&mut self, machine_st: &mut MachineState, offset: usize) -> CallResult - { - self.prev_policy.retry_me_else(machine_st, offset)?; - self.increment() - } - - fn retry(&mut self, machine_st: &mut MachineState, offset: usize) -> CallResult - { - self.prev_policy.retry(machine_st, offset)?; - self.increment() - } - - fn trust_me(&mut self, machine_st: &mut MachineState) -> CallResult - { - self.prev_policy.trust_me(machine_st)?; - self.increment() - } - - fn trust(&mut self, machine_st: &mut MachineState, offset: usize) -> CallResult - { - self.prev_policy.trust(machine_st, offset)?; - self.increment() - } - - fn call_builtin<'a>(&mut self, machine_st: &mut MachineState, ct: &BuiltInClauseType, lco: bool) - -> CallResult - { - self.prev_policy.call_builtin(machine_st, ct, lco)?; - self.increment() - } -} - pub(crate) trait CutPolicy: Any { fn cut(&mut self, &mut MachineState, RegType); } diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 1e368c5f..c8155120 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -296,7 +296,7 @@ impl MachineState { fn get_number(&self, at: &ArithmeticTerm) -> Result { match at { - &ArithmeticTerm::Reg(r) => self.arith_eval_by_metacall(r), + &ArithmeticTerm::Reg(r) => self.arith_eval_by_metacall(r), &ArithmeticTerm::Interm(i) => Ok(self.interms[i-1].clone()), &ArithmeticTerm::Number(ref n) => Ok(n.clone()), } @@ -1319,9 +1319,9 @@ impl MachineState { pub(super) fn execute_inlined(&mut self, inlined: &InlinedClauseType) { match inlined { - &InlinedClauseType::CompareNumber(cmp, r1, r2) => { - let n1 = try_or_fail!(self, self.arith_eval_by_metacall(r1)); - let n2 = try_or_fail!(self, self.arith_eval_by_metacall(r2)); + &InlinedClauseType::CompareNumber(cmp, ref at_1, ref at_2) => { + let n1 = try_or_fail!(self, self.get_number(at_1)); + let n2 = try_or_fail!(self, self.get_number(at_2)); self.compare_numbers(cmp, n1, n2); }, @@ -1400,34 +1400,13 @@ impl MachineState { } } - pub(super) fn execute_built_in_instr<'a>(&mut self, code_dirs: CodeDirs<'a>, - call_policy: &mut Box, - cut_policy: &mut Box, - instr: &BuiltInInstruction) + pub(super) + fn execute_built_in_instr<'a>(&mut self, code_dirs: CodeDirs<'a>, + call_policy: &mut Box, + cut_policy: &mut Box, + instr: &BuiltInInstruction) { - match instr { - &BuiltInInstruction::CompareNumber(cmp, ref at_1, ref at_2) => { - let n1 = try_or_fail!(self, self.get_number(at_1)); - let n2 = try_or_fail!(self, self.get_number(at_2)); - - self.compare_numbers(cmp, n1, n2); - }, - &BuiltInInstruction::DefaultRetryMeElse(o) => { - let mut call_policy = DefaultCallPolicy {}; - try_or_fail!(self, call_policy.retry_me_else(self, o)); - }, - &BuiltInInstruction::DefaultSetCutPoint(r) => { - let mut cut_policy = DefaultCutPolicy {}; - cut_policy.cut(self, r); - }, - &BuiltInInstruction::DefaultTrustMe => { - let mut call_policy = DefaultCallPolicy {}; - try_or_fail!(self, call_policy.trust_me(self)); - }, - &BuiltInInstruction::EraseBall => { - self.ball.reset(); - self.p += 1; - }, + match instr { &BuiltInInstruction::GetArg(lco) => try_or_fail!(self, { let val = self.try_get_arg(); @@ -1440,40 +1419,6 @@ impl MachineState { val }), - &BuiltInInstruction::GetCurrentBlock => { - let c = Constant::Usize(self.block); - let addr = self[temp_v!(1)].clone(); - - self.write_constant_to_var(addr, c); - self.p += 1; - }, - &BuiltInInstruction::GetBall => { - let addr = self.store(self.deref(self[temp_v!(1)].clone())); - let h = self.heap.h; - - if self.ball.stub.len() > 0 { - self.copy_and_align_ball_to_heap(); - } else { - self.fail = true; - return; - } - - let ball = self.heap[h].as_addr(h); - - match addr.as_var() { - Some(r) => { - self.bind(r, ball); - self.p += 1; - }, - _ => self.fail = true - }; - }, - &BuiltInInstruction::GetCutPoint(r) => { - let c = Constant::Usize(self.b); - self[r] = Addr::Con(c); - - self.p += 1; - }, &BuiltInInstruction::InferenceLevel(r1, r2) => { // X1 = R, X2 = B. let a1 = self[r1].clone(); let a2 = self.store(self.deref(self[r2].clone())); @@ -1597,57 +1542,8 @@ impl MachineState { self.p += 1; }, - &BuiltInInstruction::SetBall => { - self.set_ball(); - self.p += 1; - }, &BuiltInInstruction::SetCutPoint(r) => cut_policy.cut(self, r), - &BuiltInInstruction::CleanUpBlock => { - let nb = self.store(self.deref(self[temp_v!(1)].clone())); - - match nb { - Addr::Con(Constant::Usize(nb)) => { - let b = self.b - 1; - - if nb > 0 && self.or_stack[b].b == nb { - self.b = self.or_stack[nb - 1].b; - self.or_stack.truncate(self.b); - } - - self.p += 1; - }, - _ => self.fail = true - }; - }, - &BuiltInInstruction::InstallNewBlock => { - self.block = self.b; - let c = Constant::Usize(self.block); - let addr = self[temp_v!(1)].clone(); - - self.write_constant_to_var(addr, c); - self.p += 1; - }, - &BuiltInInstruction::ResetBlock => { - let addr = self.deref(self[temp_v!(1)].clone()); - self.reset_block(addr); - }, - &BuiltInInstruction::UnwindStack => - self.unwind_stack(), - &BuiltInInstruction::Fail => { - self.fail = true; - self.p += 1; - }, - &BuiltInInstruction::Succeed => { - self.p += 1; - }, - &BuiltInInstruction::Unify => { - let a1 = self[temp_v!(1)].clone(); - let a2 = self[temp_v!(2)].clone(); - - self.unify(a1, a2); - self.p += 1; - }, }; } @@ -1920,7 +1816,7 @@ impl MachineState { false } - pub(super) fn setup_built_in_call(&mut self, ct: BuiltInClauseType, lco: bool) + pub(super) fn setup_built_in_call(&mut self, ct: BuiltInClauseType) { self.num_of_args = ct.arity(); self.b0 = self.b; @@ -1964,8 +1860,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, @@ -1978,12 +1874,21 @@ impl MachineState { try_or_fail!(self, call_policy.call_n(self, arity, code_dirs, lco)), &ControlInstruction::CallClause(ClauseType::BuiltIn(ref ct), _, _, lco) => try_or_fail!(self, call_policy.call_builtin(self, ct, lco)), - &ControlInstruction::CallClause(ClauseType::Inlined(ref ct), _, _, lco) => + &ControlInstruction::CallClause(ClauseType::Inlined(ref ct), ..) => self.execute_inlined(ct), &ControlInstruction::CallClause(ClauseType::Named(ref name, ref idx), arity, _, lco) | &ControlInstruction::CallClause(ClauseType::Op(ref name, _, ref idx), arity, _, lco) => 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)); + + if lco { + self.p = CodePtr::Local(self.cp.clone()); + } else { + self.p += 1; + } + }, &ControlInstruction::CheckCpExecute => { let a = self.store(self.deref(self[temp_v!(2)].clone())); @@ -2025,8 +1930,6 @@ impl MachineState { self.fail = true; }, - &ControlInstruction::Goto(p, arity, lco) => - self.goto_ptr(dir_entry!(p, clause_name!("builtin")), arity, lco), &ControlInstruction::IsClause(lco, r, ref at) => { let a1 = self[r].clone(); let a2 = try_or_fail!(self, self.get_number(at)); @@ -2048,16 +1951,6 @@ impl MachineState { }; } - pub(super) fn goto_ptr(&mut self, p: CodePtr, arity: usize, lco:bool) { - if !lco { - self.cp.assign_if_local(self.p.clone() + 1); - } - - self.num_of_args = arity; - self.b0 = self.b; - self.p = p; - } - pub(super) fn execute_indexed_choice_instr(&mut self, instr: &IndexedChoiceInstruction, call_policy: &mut Box) { diff --git a/src/prolog/machine/mod.rs b/src/prolog/machine/mod.rs index 163c0b16..425ee1e4 100644 --- a/src/prolog/machine/mod.rs +++ b/src/prolog/machine/mod.rs @@ -234,8 +234,6 @@ 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)) } } diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index 1d1c55b1..715969e7 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -19,7 +19,7 @@ impl BrentAlgState { } } -impl MachineState { +impl MachineState { // a step in Brent's algorithm. fn brents_alg_step(&self, brent_st: &mut BrentAlgState) -> Option { @@ -54,8 +54,7 @@ impl MachineState { pub(super) fn detect_cycles_with_max(&self, max_steps: usize, addr: Addr) -> CycleSearchResult { let addr = self.store(self.deref(addr)); - - let mut hare = match addr { + let hare = match addr { Addr::Lis(offset) if max_steps > 0 => offset + 1, Addr::Lis(offset) => return CycleSearchResult::UntouchedList(offset), Addr::Con(Constant::EmptyList) => return CycleSearchResult::EmptyList, @@ -63,7 +62,7 @@ impl MachineState { }; let mut brent_st = BrentAlgState::new(hare); - + loop { if brent_st.steps == max_steps { return CycleSearchResult::PartialList(brent_st.steps, brent_st.hare); @@ -78,22 +77,21 @@ impl MachineState { pub(super) fn detect_cycles(&self, addr: Addr) -> CycleSearchResult { let addr = self.store(self.deref(addr)); - - let mut hare = match addr { + let hare = match addr { Addr::Lis(offset) => offset + 1, Addr::Con(Constant::EmptyList) => return CycleSearchResult::EmptyList, _ => return CycleSearchResult::NotList }; let mut brent_st = BrentAlgState::new(hare); - + loop { if let Some(result) = self.brents_alg_step(&mut brent_st) { return result; } } } - + fn finalize_skip_max_list(&mut self, n: usize, addr: Addr) { let target_n = self[temp_v!(1)].clone(); self.unify(Addr::Con(integer!(n)), target_n); @@ -111,7 +109,7 @@ impl MachineState { Number::Integer(ref max_steps) if max_steps.to_isize().map(|i| i >= -1).unwrap_or(false) => { let n = self.store(self.deref(self[temp_v!(1)].clone())); - + match n { Addr::Con(Constant::Number(Number::Integer(ref n))) if n.is_zero() => { let xs0 = self[temp_v!(3)].clone(); @@ -152,5 +150,97 @@ impl MachineState { }; Ok(()) - } + } + + pub(super) fn system_call(&mut self, ct: &SystemClauseType) -> CallResult + { + match ct { + &SystemClauseType::CleanUpBlock => { + let nb = self.store(self.deref(self[temp_v!(1)].clone())); + + match nb { + Addr::Con(Constant::Usize(nb)) => { + let b = self.b - 1; + + if nb > 0 && self.or_stack[b].b == nb { + self.b = self.or_stack[nb - 1].b; + self.or_stack.truncate(self.b); + } + }, + _ => self.fail = true + }; + + Ok(()) + }, + &SystemClauseType::EraseBall => { + self.ball.reset(); + Ok(()) + }, + &SystemClauseType::Fail => { + self.fail = true; + Ok(()) + }, + &SystemClauseType::GetBall => { + let addr = self.store(self.deref(self[temp_v!(1)].clone())); + let h = self.heap.h; + + if self.ball.stub.len() > 0 { + self.copy_and_align_ball_to_heap(); + } else { + self.fail = true; + return Ok(()); + } + + let ball = self.heap[h].as_addr(h); + + match addr.as_var() { + 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::InstallNewBlock => { + self.block = self.b; + + let c = Constant::Usize(self.block); + 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(()) + } + } + } } diff --git a/src/prolog/macros.rs b/src/prolog/macros.rs index a665add2..723b02c7 100644 --- a/src/prolog/macros.rs +++ b/src/prolog/macros.rs @@ -19,12 +19,6 @@ macro_rules! atom { ) } -macro_rules! compare_number_instr { - ($cmp: expr, $at_1: expr, $at_2: expr) => ( - Line::BuiltIn(BuiltInInstruction::CompareNumber($cmp, $at_1, $at_2)) - ) -} - macro_rules! interm { ($n: expr) => ( ArithmeticTerm::Interm($n) @@ -156,18 +150,6 @@ macro_rules! is_call { ) } -macro_rules! fail { - () => ( - Line::BuiltIn(BuiltInInstruction::Fail) - ) -} - -macro_rules! succeed { - () => ( - Line::BuiltIn(BuiltInInstruction::Succeed) - ) -} - macro_rules! set_cp { ($r:expr) => ( Line::BuiltIn(BuiltInInstruction::SetCutPoint($r)) @@ -192,6 +174,25 @@ macro_rules! rc_atom { ) } +macro_rules! succeed { + () => ( + call_clause!(ClauseType::System(SystemClauseType::Succeed), 0, 0) + ) +} + +macro_rules! fail { + () => ( + call_clause!(ClauseType::System(SystemClauseType::Fail), 0, 0) + ) +} + +macro_rules! compare_number_instr { + ($cmp: expr, $at_1: expr, $at_2: expr) => {{ + let ct = ClauseType::Inlined(InlinedClauseType::CompareNumber($cmp, $at_1, $at_2)); + call_clause!(ct, 2, 0) + }} +} + macro_rules! jmp_call { ($arity:expr, $offset:expr, $pvs:expr) => ( Line::Control(ControlInstruction::JmpBy($arity, $offset, $pvs, false)) @@ -250,3 +251,4 @@ macro_rules! top_level_code_ptr { CodePtr::Local(LocalCodePtr::TopLevel($p, $q_sz)) ) } + From 910bafef6189e3337814ef8ffda58c13fc03b292 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Thu, 10 May 2018 22:40:01 -0600 Subject: [PATCH 09/20] port remaining builtins to SystemClauseType --- src/prolog/ast.rs | 10 ++++++-- src/prolog/io.rs | 6 ----- src/prolog/machine/machine_state_impl.rs | 32 +----------------------- src/prolog/machine/system_calls.rs | 21 ++++++++++++++++ 4 files changed, 30 insertions(+), 39 deletions(-) diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index 2e50706a..ac62082a 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -714,6 +714,8 @@ pub struct Rule { #[derive(Copy, Clone, PartialEq)] pub enum SystemClauseType { + GetArg, + InferenceLevel(RegType, RegType), CleanUpBlock, EraseBall, Fail, @@ -731,6 +733,8 @@ pub enum SystemClauseType { impl SystemClauseType { pub fn arity(&self) -> usize { match self { + &SystemClauseType::GetArg => 3, + &SystemClauseType::InferenceLevel(..) => 2, &SystemClauseType::CleanUpBlock => 1, &SystemClauseType::EraseBall => 0, &SystemClauseType::Fail => 0, @@ -752,6 +756,8 @@ impl SystemClauseType { pub fn name(&self) -> ClauseName { match self { + &SystemClauseType::GetArg => clause_name!("$get_arg"), + &SystemClauseType::InferenceLevel(..) => clause_name!("$inference_level"), &SystemClauseType::CleanUpBlock => clause_name!("$clean_up_block"), &SystemClauseType::EraseBall => clause_name!("$erase_ball"), &SystemClauseType::Fail => clause_name!("$fail"), @@ -769,6 +775,8 @@ impl SystemClauseType { pub fn from(name: &str, arity: usize) -> Option { match (name, arity) { + ("$get_arg", 3) => Some(SystemClauseType::GetArg), + ("$inference_level", 2) => Some(SystemClauseType::InferenceLevel(temp_v!(0), temp_v!(0))), ("$clean_up_block", 1) => Some(SystemClauseType::CleanUpBlock), ("$erase_ball", 0) => Some(SystemClauseType::EraseBall), ("$fail", 0) => Some(SystemClauseType::Fail), @@ -1361,8 +1369,6 @@ pub enum ArithmeticInstruction { #[derive(Clone)] pub enum BuiltInInstruction { - GetArg(bool), // last call. - InferenceLevel(RegType, RegType), InstallCleaner, InstallInferenceCounter(RegType, RegType, RegType), RemoveCallPolicyCheck, diff --git a/src/prolog/io.rs b/src/prolog/io.rs index 576fa800..68659c79 100644 --- a/src/prolog/io.rs +++ b/src/prolog/io.rs @@ -171,12 +171,6 @@ impl fmt::Display for BuiltInInstruction { match self { &BuiltInInstruction::InstallInferenceCounter(r1, r2, r3) => write!(f, "install_inference_counter {}, {}, {}", r1, r2, r3), - &BuiltInInstruction::GetArg(false) => - write!(f, "get_arg_call X1, X2, X3"), - &BuiltInInstruction::GetArg(true) => - write!(f, "get_arg_execute X1, X2, X3"), - &BuiltInInstruction::InferenceLevel(r1, r2) => - write!(f, "inference_level {}, {}", r1, r2), &BuiltInInstruction::InstallCleaner => write!(f, "install_cleaner"), &BuiltInInstruction::RemoveCallPolicyCheck => diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index c8155120..9abe45be 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -1137,7 +1137,7 @@ impl MachineState { fail } - fn try_get_arg(&mut self) -> Result<(), MachineError> + pub(super) fn try_get_arg(&mut self) -> CallResult { let a1 = self.store(self.deref(self[temp_v!(1)].clone())); @@ -1407,36 +1407,6 @@ impl MachineState { instr: &BuiltInInstruction) { match instr { - &BuiltInInstruction::GetArg(lco) => - try_or_fail!(self, { - let val = self.try_get_arg(); - - if lco { - self.p = CodePtr::Local(self.cp.clone()); - } else { - self.p += 1; - } - - val - }), - &BuiltInInstruction::InferenceLevel(r1, r2) => { // X1 = R, X2 = B. - let a1 = self[r1].clone(); - let a2 = self.store(self.deref(self[r2].clone())); - - match a2 { - Addr::Con(Constant::Usize(bp)) => - if self.b <= bp + 1 { - let a2 = Addr::Con(atom!("!", self.atom_tbl)); - self.unify(a1, a2); - } else { - let a2 = Addr::Con(atom!("true", self.atom_tbl)); - self.unify(a1, a2); - }, - _ => self.fail = true - }; - - self.p += 1; - }, &BuiltInInstruction::InstallCleaner => { let addr = self[temp_v!(1)].clone(); let b = self.b; diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index 715969e7..d9500de0 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -3,6 +3,7 @@ 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; @@ -155,6 +156,26 @@ impl MachineState { pub(super) fn system_call(&mut self, ct: &SystemClauseType) -> CallResult { match ct { + &SystemClauseType::GetArg => + self.try_get_arg(), + &SystemClauseType::InferenceLevel(r1, r2) => { + let a1 = self[r1].clone(); + let a2 = self.store(self.deref(self[r2].clone())); + + match a2 { + Addr::Con(Constant::Usize(bp)) => + if self.b <= bp + 1 { + let a2 = Addr::Con(atom!("!", self.atom_tbl)); + self.unify(a1, a2); + } else { + let a2 = Addr::Con(atom!("true", self.atom_tbl)); + self.unify(a1, a2); + }, + _ => self.fail = true + }; + + Ok(()) + }, &SystemClauseType::CleanUpBlock => { let nb = self.store(self.deref(self[temp_v!(1)].clone())); From ba7e7ac895206a60bb30f80a960a46a3a0b7086b Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Thu, 10 May 2018 23:08:56 -0600 Subject: [PATCH 10/20] throw exception when call-ing a system instruction. --- src/main.rs | 4 +- src/prolog/ast.rs | 8 +- src/prolog/builtins.rs | 88 ---------------------- src/prolog/io.rs | 16 ++-- src/prolog/machine/machine_errors.rs | 93 +++++++++++++++++++++++- src/prolog/machine/machine_state.rs | 5 +- src/prolog/machine/machine_state_impl.rs | 18 ++--- src/prolog/machine/mod.rs | 6 +- src/prolog/machine/system_calls.rs | 4 +- src/prolog/macros.rs | 2 +- 10 files changed, 122 insertions(+), 122 deletions(-) diff --git a/src/main.rs b/src/main.rs index a220f41a..46aa4add 100644 --- a/src/main.rs +++ b/src/main.rs @@ -31,8 +31,8 @@ fn prolog_repl() { load_init_str_and_include(&mut wam, BUILTINS, "builtins"); // load_init_str(&mut wam, LISTS); -// load_init_str(&mut wam, CONTROL); -// load_init_str(&mut wam, QUEUES); + // load_init_str(&mut wam, CONTROL); + // load_init_str(&mut wam, QUEUES); loop { print!("prolog> "); diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index ac62082a..8137dfe8 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -1,3 +1,4 @@ +use prolog::builtins::*; use prolog::num::bigint::BigInt; use prolog::num::{Float, ToPrimitive, Zero}; use prolog::num::rational::Ratio; @@ -162,7 +163,7 @@ impl Module { pub fn new(module_decl: ModuleDecl) -> Self { Module { module_decl, code_dir: ModuleCodeDir::new(), - op_dir: OpDir::new() } + op_dir: default_op_dir() } } } @@ -1367,8 +1368,9 @@ pub enum ArithmeticInstruction { Neg(ArithmeticTerm, usize) } +// call and cut policy exempt instructions. #[derive(Clone)] -pub enum BuiltInInstruction { +pub enum PEInstruction { InstallCleaner, InstallInferenceCounter(RegType, RegType, RegType), RemoveCallPolicyCheck, @@ -1451,7 +1453,7 @@ pub type CompiledQuery = Vec; #[derive(Clone)] pub enum Line { Arithmetic(ArithmeticInstruction), - BuiltIn(BuiltInInstruction), + PolicyExempt(PEInstruction), Choice(ChoiceInstruction), Control(ControlInstruction), Cut(CutInstruction), diff --git a/src/prolog/builtins.rs b/src/prolog/builtins.rs index ab9d4903..6996b6ea 100644 --- a/src/prolog/builtins.rs +++ b/src/prolog/builtins.rs @@ -2,94 +2,6 @@ use prolog::ast::*; use std::collections::HashMap; -// from 7.12.2 b) of 13211-1:1995 -#[derive(Clone, Copy)] -pub enum ValidType { - Atom, - Atomic, - Byte, - Callable, - Character, - Compound, - Evaluable, - InByte, - InCharacter, - Integer, - List, - Number, - Pair, - PredicateIndicator, - Variable -} - -impl ValidType { - pub fn as_str(self) -> &'static str { - match self { - ValidType::Atom => "atom", - ValidType::Atomic => "atomic", - ValidType::Byte => "byte", - ValidType::Callable => "callable", - ValidType::Character => "character", - ValidType::Compound => "compound", - ValidType::Evaluable => "evaluable", - ValidType::InByte => "in_byte", - ValidType::InCharacter => "in_character", - ValidType::Integer => "integer", - ValidType::List => "list", - ValidType::Number => "number", - ValidType::Pair => "pair", - ValidType::PredicateIndicator => "predicate_indicator", - ValidType::Variable => "variable" - } - } -} - -// from 7.12.2 f) of 13211-1:1995 -#[derive(Clone, Copy)] -pub enum RepFlag { - Character, - CharacterCode, - InCharacterCode, - MaxArity, - MaxInteger, - MinInteger -} - -impl RepFlag { - pub fn as_str(self) -> &'static str { - match self { - RepFlag::Character => "character", - RepFlag::CharacterCode => "character_code", - RepFlag::InCharacterCode => "in_character_code", - RepFlag::MaxArity => "max_arity", - RepFlag::MaxInteger => "max_integer", - RepFlag::MinInteger => "min_integer" - } - } -} - -// from 7.12.2 g) of 13211-1:1995 -#[derive(Clone, Copy)] -pub enum EvalError { - FloatOverflow, - IntOverflow, - Undefined, - Underflow, - ZeroDivisor -} - -impl EvalError { - pub fn as_str(self) -> &'static str { - match self { - EvalError::FloatOverflow => "float_overflow", - EvalError::IntOverflow => "int_overflow", - EvalError::Undefined => "undefined", - EvalError::Underflow => "underflow", - EvalError::ZeroDivisor => "zero_divisor" - } - } -} - /* fn get_builtins() -> Code { vec![internal_call_n!(), // callN/N, 0. diff --git a/src/prolog/io.rs b/src/prolog/io.rs index 68659c79..bab5f0e4 100644 --- a/src/prolog/io.rs +++ b/src/prolog/io.rs @@ -166,20 +166,20 @@ impl fmt::Display for IndexedChoiceInstruction { } } -impl fmt::Display for BuiltInInstruction { +impl fmt::Display for PEInstruction { fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { match self { - &BuiltInInstruction::InstallInferenceCounter(r1, r2, r3) => + &PEInstruction::InstallInferenceCounter(r1, r2, r3) => write!(f, "install_inference_counter {}, {}, {}", r1, r2, r3), - &BuiltInInstruction::InstallCleaner => + &PEInstruction::InstallCleaner => write!(f, "install_cleaner"), - &BuiltInInstruction::RemoveCallPolicyCheck => + &PEInstruction::RemoveCallPolicyCheck => write!(f, "remove_call_policy_check"), - &BuiltInInstruction::RemoveInferenceCounter(r1, r2) => + &PEInstruction::RemoveInferenceCounter(r1, r2) => write!(f, "remove_inference_counter {}, {}", r1, r2), - &BuiltInInstruction::RestoreCutPolicy => + &PEInstruction::RestoreCutPolicy => write!(f, "restore_cut_point"), - &BuiltInInstruction::SetCutPoint(r) => + &PEInstruction::SetCutPoint(r) => write!(f, "set_cp {}", r), } } @@ -328,7 +328,7 @@ pub fn print_code(code: &Code) { for fact_instr in fact { println!("{}", fact_instr); }, - &Line::BuiltIn(ref instr) => + &Line::PolicyExempt(ref instr) => println!("{}", instr), &Line::Cut(ref cut) => println!("{}", cut), diff --git a/src/prolog/machine/machine_errors.rs b/src/prolog/machine/machine_errors.rs index 984cf4d2..df7d3e3f 100644 --- a/src/prolog/machine/machine_errors.rs +++ b/src/prolog/machine/machine_errors.rs @@ -1,5 +1,4 @@ use prolog::ast::*; -use prolog::builtins::*; use prolog::machine::machine_state::*; use prolog::num::bigint::BigInt; @@ -8,6 +7,94 @@ use std::rc::Rc; pub(super) type MachineError = Vec; pub(super) type MachineStub = Vec; +// from 7.12.2 b) of 13211-1:1995 +#[derive(Clone, Copy)] +pub enum ValidType { + Atom, + Atomic, + Byte, + Callable, + Character, + Compound, + Evaluable, + InByte, + InCharacter, + Integer, + List, + Number, + Pair, + PredicateIndicator, + Variable +} + +impl ValidType { + pub fn as_str(self) -> &'static str { + match self { + ValidType::Atom => "atom", + ValidType::Atomic => "atomic", + ValidType::Byte => "byte", + ValidType::Callable => "callable", + ValidType::Character => "character", + ValidType::Compound => "compound", + ValidType::Evaluable => "evaluable", + ValidType::InByte => "in_byte", + ValidType::InCharacter => "in_character", + ValidType::Integer => "integer", + ValidType::List => "list", + ValidType::Number => "number", + ValidType::Pair => "pair", + ValidType::PredicateIndicator => "predicate_indicator", + ValidType::Variable => "variable" + } + } +} + +// from 7.12.2 f) of 13211-1:1995 +#[derive(Clone, Copy)] +pub enum RepFlag { + Character, + CharacterCode, + InCharacterCode, + MaxArity, + MaxInteger, + MinInteger +} + +impl RepFlag { + pub fn as_str(self) -> &'static str { + match self { + RepFlag::Character => "character", + RepFlag::CharacterCode => "character_code", + RepFlag::InCharacterCode => "in_character_code", + RepFlag::MaxArity => "max_arity", + RepFlag::MaxInteger => "max_integer", + RepFlag::MinInteger => "min_integer" + } + } +} + +// from 7.12.2 g) of 13211-1:1995 +#[derive(Clone, Copy)] +pub enum EvalError { + FloatOverflow, + IntOverflow, + Undefined, + Underflow, + ZeroDivisor +} + +impl EvalError { + pub fn as_str(self) -> &'static str { + match self { + EvalError::FloatOverflow => "float_overflow", + EvalError::IntOverflow => "int_overflow", + EvalError::Undefined => "undefined", + EvalError::Underflow => "underflow", + EvalError::ZeroDivisor => "zero_divisor" + } + } +} + // used by '$skip_max_list'. pub(super) enum CycleSearchResult { EmptyList, @@ -125,7 +212,7 @@ impl MachineState { let mut error_form = vec![HeapCellValue::NamedStr(2, clause_name!("error"), None), HeapCellValue::Addr(Addr::HeapCell(h + 3)), HeapCellValue::Addr(Addr::HeapCell(h + 3 + err.len()))]; - + error_form.extend(err.into_iter()); error_form.extend(src.into_iter()); @@ -143,6 +230,6 @@ impl MachineState { self.registers[1] = Addr::HeapCell(h); self.set_ball(); - self.unwind_stack(); + self.unwind_stack(); } } diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index 74ac779a..be859058 100644 --- a/src/prolog/machine/machine_state.rs +++ b/src/prolog/machine/machine_state.rs @@ -2,7 +2,7 @@ use prolog::and_stack::*; use prolog::ast::*; use prolog::copier::*; use prolog::heap_print::*; -use prolog::machine::machine_errors::MachineStub; +use prolog::machine::machine_errors::*; use prolog::num::{BigInt, BigUint, Zero, One}; use prolog::or_stack::*; use prolog::tabled_rc::*; @@ -546,7 +546,8 @@ pub(crate) trait CallPolicy: Any { return Err(machine_st.existence_error(name, inner_arity)); }, ClauseType::System(ct) => - return machine_st.system_call(&ct) + return Err(machine_st.type_error(ValidType::Callable, + Addr::Con(Constant::Atom(name)))) }; break; diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 9abe45be..7958abf2 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -1401,13 +1401,11 @@ impl MachineState { } pub(super) - fn execute_built_in_instr<'a>(&mut self, code_dirs: CodeDirs<'a>, - call_policy: &mut Box, - cut_policy: &mut Box, - instr: &BuiltInInstruction) + fn execute_pe_instr<'a>(&mut self, code_dirs: CodeDirs<'a>, call_policy: &mut Box, + cut_policy: &mut Box, instr: &PEInstruction) { match instr { - &BuiltInInstruction::InstallCleaner => { + &PEInstruction::InstallCleaner => { let addr = self[temp_v!(1)].clone(); let b = self.b; let block = self.block; @@ -1425,7 +1423,7 @@ impl MachineState { self.p += 1; }, - &BuiltInInstruction::InstallInferenceCounter(r1, r2, r3) => { // A1 = B, A2 = L + &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())); @@ -1454,7 +1452,7 @@ impl MachineState { } }; }, - &BuiltInInstruction::RemoveCallPolicyCheck => { + &PEInstruction::RemoveCallPolicyCheck => { let restore_default = match call_policy.downcast_mut::().ok() { Some(call_policy) => { @@ -1480,7 +1478,7 @@ impl MachineState { self.p += 1; }, - &BuiltInInstruction::RemoveInferenceCounter(r1, r2) => { // A1 = B + &PEInstruction::RemoveInferenceCounter(r1, r2) => { // A1 = B match call_policy.downcast_mut::().ok() { Some(call_policy) => { let a1 = self.store(self.deref(self[r1].clone())); @@ -1498,7 +1496,7 @@ impl MachineState { self.p += 1; }, - &BuiltInInstruction::RestoreCutPolicy => { + &PEInstruction::RestoreCutPolicy => { let restore_default = if let Ok(cut_policy) = cut_policy.downcast_ref::() { cut_policy.out_of_cont_pts() @@ -1512,7 +1510,7 @@ impl MachineState { self.p += 1; }, - &BuiltInInstruction::SetCutPoint(r) => + &PEInstruction::SetCutPoint(r) => cut_policy.cut(self, r), }; } diff --git a/src/prolog/machine/mod.rs b/src/prolog/machine/mod.rs index 425ee1e4..5ef8748a 100644 --- a/src/prolog/machine/mod.rs +++ b/src/prolog/machine/mod.rs @@ -247,10 +247,10 @@ impl Machine { match instr { Line::Arithmetic(ref arith_instr) => self.ms.execute_arith_instr(arith_instr), - Line::BuiltIn(ref built_in_instr) => { + Line::PolicyExempt(ref built_in_instr) => { let code_dirs = CodeDirs::new(&self.code_dir, &self.modules); - self.ms.execute_built_in_instr(code_dirs, &mut self.call_policy, - &mut self.cut_policy, built_in_instr); + 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), diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index d9500de0..0662876b 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -165,10 +165,10 @@ impl MachineState { match a2 { Addr::Con(Constant::Usize(bp)) => if self.b <= bp + 1 { - let a2 = Addr::Con(atom!("!", self.atom_tbl)); + let a2 = Addr::Con(atom!("!")); self.unify(a1, a2); } else { - let a2 = Addr::Con(atom!("true", self.atom_tbl)); + let a2 = Addr::Con(atom!("true")); self.unify(a1, a2); }, _ => self.fail = true diff --git a/src/prolog/macros.rs b/src/prolog/macros.rs index 723b02c7..7881509c 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::BuiltIn(BuiltInInstruction::SetCutPoint($r)) + Line::PolicyExempt(PEInstruction::SetCutPoint($r)) ) } From 7455c2e9db20d5f8aeaaa01d0ed87371e02f7af9 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sat, 12 May 2018 00:30:34 -0600 Subject: [PATCH 11/20] 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), 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). 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() { From 0951bcff583415789d9748955444d913ea322736 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sat, 12 May 2018 01:21:31 -0600 Subject: [PATCH 12/20] add arg --- src/prolog/ast.rs | 3 +-- src/prolog/heap_print.rs | 4 ---- src/prolog/lib/builtins.pl | 12 +++++++++++- src/prolog/machine/machine_state.rs | 2 +- 4 files changed, 13 insertions(+), 8 deletions(-) diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index 4a7f747d..f9ea9c0c 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -1711,8 +1711,7 @@ impl Add for CodePtr { fn add(self, rhs: usize) -> Self::Output { match self { CodePtr::Local(local) => CodePtr::Local(local + rhs), - CodePtr::CallN(_, local) | CodePtr::BuiltInClause(_, local) => - CodePtr::Local(local + rhs), + CodePtr::CallN(_, local) | CodePtr::BuiltInClause(_, local) => CodePtr::Local(local + rhs), } } } diff --git a/src/prolog/heap_print.rs b/src/prolog/heap_print.rs index e7f5ea48..caa1b7b5 100644 --- a/src/prolog/heap_print.rs +++ b/src/prolog/heap_print.rs @@ -120,19 +120,15 @@ impl HCValueFormatter for TermFormatter { match fixity { Fixity::Post => { state_stack.push(TokenOrRedirect::Atom(ct.name())); - state_stack.push(TokenOrRedirect::Space); state_stack.push(TokenOrRedirect::Redirect); }, Fixity::Pre => { state_stack.push(TokenOrRedirect::Redirect); - state_stack.push(TokenOrRedirect::Space); state_stack.push(TokenOrRedirect::Atom(ct.name())); }, Fixity::In => { state_stack.push(TokenOrRedirect::Redirect); - state_stack.push(TokenOrRedirect::Space); state_stack.push(TokenOrRedirect::Atom(ct.name())); - state_stack.push(TokenOrRedirect::Space); state_stack.push(TokenOrRedirect::Redirect); } } diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index 92bcc6e6..a8fa00a0 100644 --- a/src/prolog/lib/builtins.pl +++ b/src/prolog/lib/builtins.pl @@ -3,7 +3,7 @@ :- 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, (==)/2, catch/3, + (-)/1, (>=)/2, (=<)/2, (->)/2, (;)/2, (==)/2, arg/3, catch/3, throw/1, true/0, false/0]). % arithmetic operators. @@ -86,3 +86,13 @@ handle_ball(Ball, C, R) :- Ball = C, !, '$erase_ball', call(R). handle_ball(_, _, _) :- '$unwind_stack'. throw(Ball) :- '$set_ball'(Ball), '$unwind_stack'. + +% arg. + +arg(N, Functor, Arg) :- var(N), !, functor(Functor, _, Arity), arg_(N, 1, Arity, Functor, Arg). +arg(N, Functor, Arg) :- integer(N), !, functor(Functor, _, Arity), '$get_arg'(N, Functor, Arg). +arg(N, Functor, Arg) :- throw(error(type_error(integer, N), arg/3)). + +arg_(N, N, N, Functor, Arg) :- !, '$get_arg'(N, Functor, Arg). +arg_(N, N, Arity, Functor, Arg) :- '$get_arg'(N, Functor, Arg). +arg_(N, N0, Arity, Functor, Arg) :- N0 < Arity, N1 is N0 + 1, arg_(N, N1, Arity, Functor, Arg). diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index 59efdc47..5e0889b7 100644 --- a/src/prolog/machine/machine_state.rs +++ b/src/prolog/machine/machine_state.rs @@ -511,7 +511,7 @@ pub(crate) trait CallPolicy: Any { let result = machine_st.arith_eval_by_metacall(temp_v!(2))?; machine_st.unify(a, Addr::Con(Constant::Number(result))); - machine_st.p += 1; + machine_st.p += 1; // TODO: change this!! Ok(()) }, From 569040953488e3d38dfe4e11f3ed3b53791d8346 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sat, 12 May 2018 15:51:20 -0600 Subject: [PATCH 13/20] correct faulty bind (two tests now fail: conjunctive_queries and lists) --- src/prolog/ast.rs | 83 ++++++++++++------------ src/prolog/codegen.rs | 2 +- src/prolog/machine/machine_errors.rs | 76 +++++++++++----------- src/prolog/machine/machine_state.rs | 58 ++++++++--------- src/prolog/machine/machine_state_impl.rs | 72 +++++++++++++------- src/prolog/machine/mod.rs | 5 +- src/prolog/macros.rs | 8 ++- 7 files changed, 163 insertions(+), 141 deletions(-) diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index f9ea9c0c..f17c97cd 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -592,21 +592,6 @@ impl InlinedClauseType { } } - pub fn arity(&self) -> usize { - match self { - &InlinedClauseType::CompareNumber(..) => 2, - &InlinedClauseType::IsAtom(..) => 1, - &InlinedClauseType::IsAtomic(..) => 1, - &InlinedClauseType::IsCompound(..) => 1, - &InlinedClauseType::IsInteger (..) => 1, - &InlinedClauseType::IsRational(..) => 1, - &InlinedClauseType::IsString(..) => 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); @@ -738,31 +723,6 @@ 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::CleanUpBlock => 1, - &SystemClauseType::EraseBall => 0, - &SystemClauseType::Fail => 0, - &SystemClauseType::GetBall => 1, - &SystemClauseType::GetCurrentBlock => 1, - &SystemClauseType::GetCutPoint => 1, - &SystemClauseType::InstallNewBlock => 1, - &SystemClauseType::ResetBlock => 1, - &SystemClauseType::SetBall => 1, - &SystemClauseType::SkipMaxList => 4, - &SystemClauseType::Succeed => 0, - &SystemClauseType::UnwindStack => 0 - } - } - pub fn fixity(&self) -> Option { None } @@ -1502,6 +1462,38 @@ pub enum Addr { Str(usize) } +impl PartialEq for Addr { + fn eq(&self, r: &Ref) -> bool { + self.as_var() == Some(*r) + } +} + +// for use in MachineState::bind. +impl PartialOrd for Addr { + fn partial_cmp(&self, r: &Ref) -> Option { + match self { + &Addr::StackCell(fr, sc) => + match *r { + Ref::HeapCell(_) => Some(Ordering::Greater), + Ref::StackCell(fr1, sc1) => + if fr1 < fr || (fr1 == fr && sc1 < sc) { + Some(Ordering::Greater) + } else if fr1 == fr && sc1 == sc { + Some(Ordering::Equal) + } else { + Some(Ordering::Less) + } + }, + &Addr::HeapCell(h) => + match r { + Ref::StackCell(..) => Some(Ordering::Less), + Ref::HeapCell(h1) => h.partial_cmp(h1) + }, + _ => None + } + } +} + impl Addr { pub fn is_ref(&self) -> bool { match self { @@ -1520,7 +1512,7 @@ impl Addr { pub fn is_protected(&self, e: usize) -> bool { match self { - &Addr::StackCell(fr, _) if fr > e => false, + &Addr::StackCell(addr, _) if addr >= e => false, _ => true } } @@ -1567,6 +1559,15 @@ pub enum Ref { StackCell(usize, usize) } +impl Ref { + pub fn as_addr(self) -> Addr { + match self { + Ref::HeapCell(h) => Addr::HeapCell(h), + Ref::StackCell(fr, sc) => Addr::StackCell(fr, sc) + } + } +} + #[derive(Clone, PartialEq)] pub enum HeapCellValue { Addr(Addr), diff --git a/src/prolog/codegen.rs b/src/prolog/codegen.rs index de0f8018..6a01d348 100644 --- a/src/prolog/codegen.rs +++ b/src/prolog/codegen.rs @@ -19,7 +19,7 @@ pub struct CodeGenerator { pub struct ConjunctInfo<'a> { pub perm_vs: VariableFixtures<'a>, pub num_of_chunks: usize, - pub has_deep_cut: bool + pub has_deep_cut: bool, } impl<'a> ConjunctInfo<'a> diff --git a/src/prolog/machine/machine_errors.rs b/src/prolog/machine/machine_errors.rs index df7d3e3f..a220cf9b 100644 --- a/src/prolog/machine/machine_errors.rs +++ b/src/prolog/machine/machine_errors.rs @@ -10,41 +10,41 @@ pub(super) type MachineStub = Vec; // from 7.12.2 b) of 13211-1:1995 #[derive(Clone, Copy)] pub enum ValidType { - Atom, - Atomic, - Byte, +// Atom, +// Atomic, +// Byte, Callable, - Character, +// Character, Compound, - Evaluable, - InByte, - InCharacter, +// Evaluable, +// InByte, +// InCharacter, Integer, List, - Number, +// Number, Pair, - PredicateIndicator, - Variable +// PredicateIndicator, +// Variable } impl ValidType { pub fn as_str(self) -> &'static str { match self { - ValidType::Atom => "atom", - ValidType::Atomic => "atomic", - ValidType::Byte => "byte", +// ValidType::Atom => "atom", +// ValidType::Atomic => "atomic", +// ValidType::Byte => "byte", ValidType::Callable => "callable", - ValidType::Character => "character", +// ValidType::Character => "character", ValidType::Compound => "compound", - ValidType::Evaluable => "evaluable", - ValidType::InByte => "in_byte", - ValidType::InCharacter => "in_character", +// ValidType::Evaluable => "evaluable", +// ValidType::InByte => "in_byte", +// ValidType::InCharacter => "in_character", ValidType::Integer => "integer", ValidType::List => "list", - ValidType::Number => "number", +// ValidType::Number => "number", ValidType::Pair => "pair", - ValidType::PredicateIndicator => "predicate_indicator", - ValidType::Variable => "variable" +// ValidType::PredicateIndicator => "predicate_indicator", +// ValidType::Variable => "variable" } } } @@ -52,23 +52,23 @@ impl ValidType { // from 7.12.2 f) of 13211-1:1995 #[derive(Clone, Copy)] pub enum RepFlag { - Character, - CharacterCode, - InCharacterCode, +// Character, +// CharacterCode, +// InCharacterCode, MaxArity, - MaxInteger, - MinInteger +// MaxInteger, +// MinInteger } impl RepFlag { pub fn as_str(self) -> &'static str { match self { - RepFlag::Character => "character", - RepFlag::CharacterCode => "character_code", - RepFlag::InCharacterCode => "in_character_code", +// RepFlag::Character => "character", +// RepFlag::CharacterCode => "character_code", +// RepFlag::InCharacterCode => "in_character_code", RepFlag::MaxArity => "max_arity", - RepFlag::MaxInteger => "max_integer", - RepFlag::MinInteger => "min_integer" +// RepFlag::MaxInteger => "max_integer", +// RepFlag::MinInteger => "min_integer" } } } @@ -76,20 +76,20 @@ impl RepFlag { // from 7.12.2 g) of 13211-1:1995 #[derive(Clone, Copy)] pub enum EvalError { - FloatOverflow, - IntOverflow, - Undefined, - Underflow, +// FloatOverflow, +// IntOverflow, +// Undefined, +// Underflow, ZeroDivisor } impl EvalError { pub fn as_str(self) -> &'static str { match self { - EvalError::FloatOverflow => "float_overflow", - EvalError::IntOverflow => "int_overflow", - EvalError::Undefined => "undefined", - EvalError::Underflow => "underflow", +// EvalError::FloatOverflow => "float_overflow", +// EvalError::IntOverflow => "int_overflow", +// EvalError::Undefined => "undefined", +// EvalError::Underflow => "underflow", EvalError::ZeroDivisor => "zero_divisor" } } diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index 5e0889b7..bbbdf618 100644 --- a/src/prolog/machine/machine_state.rs +++ b/src/prolog/machine/machine_state.rs @@ -222,6 +222,7 @@ pub struct MachineState { pub(super) block: usize, // an offset into the OR stack. pub(super) ball: Ball, pub(super) interms: Vec, // intermediate numbers. + pub(super) last_call: bool } pub(crate) type CallResult = Result<(), Vec>; @@ -323,8 +324,7 @@ pub(crate) trait CallPolicy: Any { let b = machine_st.b - 1; 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())); + for i in 1 .. n + 1 { machine_st.registers[i] = machine_st.or_stack[b][i].clone(); } @@ -352,10 +352,10 @@ pub(crate) trait CallPolicy: Any { } fn context_call(&mut self, machine_st: &mut MachineState, name: ClauseName, arity: usize, - idx: CodeIndex, lco: bool) + idx: CodeIndex) -> CallResult { - if lco { + if machine_st.last_call { self.try_execute(machine_st, name, arity, idx) } else { self.try_call(machine_st, name, arity, idx) @@ -401,14 +401,14 @@ pub(crate) trait CallPolicy: Any { Ok(()) } - fn call_builtin<'a>(&mut self, machine_st: &mut MachineState, ct: &BuiltInClauseType, lco: bool) + fn call_builtin<'a>(&mut self, machine_st: &mut MachineState, ct: &BuiltInClauseType) -> CallResult { match ct { &BuiltInClauseType::AcyclicTerm => { let addr = machine_st[temp_v!(1)].clone(); machine_st.fail = machine_st.is_cyclic_term(addr); - return_from_clause!(lco, machine_st) + return_from_clause!(machine_st.last_call, machine_st) }, &BuiltInClauseType::Compare => { let a1 = machine_st[temp_v!(1)].clone(); @@ -422,7 +422,7 @@ pub(crate) trait CallPolicy: Any { }); machine_st.unify(a1, c); - return_from_clause!(lco, machine_st) + return_from_clause!(machine_st.last_call, machine_st) }, &BuiltInClauseType::CompareTerm(qt) => { match qt { @@ -433,12 +433,12 @@ pub(crate) trait CallPolicy: Any { _ => machine_st.compare_term(qt) }; - return_from_clause!(lco, machine_st) + return_from_clause!(machine_st.last_call, machine_st) }, &BuiltInClauseType::CyclicTerm => { let addr = machine_st[temp_v!(1)].clone(); machine_st.fail = !machine_st.is_cyclic_term(addr); - return_from_clause!(lco, machine_st) + return_from_clause!(machine_st.last_call, machine_st) }, &BuiltInClauseType::Display => { let output = machine_st.print_term(machine_st[temp_v!(1)].clone(), @@ -446,27 +446,27 @@ pub(crate) trait CallPolicy: Any { PrinterOutputter::new()); println!("{}", output.result()); - return_from_clause!(lco, machine_st) + return_from_clause!(machine_st.last_call, machine_st) }, &BuiltInClauseType::DuplicateTerm => { machine_st.duplicate_term(); - return_from_clause!(lco, machine_st) + return_from_clause!(machine_st.last_call, machine_st) }, &BuiltInClauseType::Eq => { machine_st.fail = machine_st.eq_test(); - return_from_clause!(lco, machine_st) + return_from_clause!(machine_st.last_call, machine_st) }, &BuiltInClauseType::Ground => { machine_st.fail = machine_st.ground_test(); - return_from_clause!(lco, machine_st) + return_from_clause!(machine_st.last_call, machine_st) }, &BuiltInClauseType::Functor => { machine_st.try_functor()?; - return_from_clause!(lco, machine_st) + return_from_clause!(machine_st.last_call, machine_st) }, &BuiltInClauseType::NotEq => { machine_st.fail = !machine_st.eq_test(); - return_from_clause!(lco, machine_st) + return_from_clause!(machine_st.last_call, machine_st) }, &BuiltInClauseType::Sort => { machine_st.check_sort_errors()?; @@ -482,7 +482,7 @@ pub(crate) trait CallPolicy: Any { let r2 = machine_st[temp_v!(2)].clone(); machine_st.unify(r2, heap_addr); - return_from_clause!(lco, machine_st) + return_from_clause!(machine_st.last_call, machine_st) }, &BuiltInClauseType::KeySort => { machine_st.check_keysort_errors()?; @@ -504,22 +504,19 @@ pub(crate) trait CallPolicy: Any { let r2 = machine_st[temp_v!(2)].clone(); machine_st.unify(r2, heap_addr); - return_from_clause!(lco, machine_st) + return_from_clause!(machine_st.last_call, machine_st) }, &BuiltInClauseType::Is => { let a = machine_st[temp_v!(1)].clone(); let result = machine_st.arith_eval_by_metacall(temp_v!(2))?; machine_st.unify(a, Addr::Con(Constant::Number(result))); - machine_st.p += 1; // TODO: change this!! - - Ok(()) + return_from_clause!(machine_st.last_call, machine_st) }, } } - fn call_n<'a>(&mut self, machine_st: &mut MachineState, arity: usize, - code_dirs: CodeDirs<'a>, lco: bool) + fn call_n<'a>(&mut self, machine_st: &mut MachineState, arity: usize, code_dirs: CodeDirs<'a>) -> CallResult { if let Some((name, arity)) = machine_st.setup_call_n(arity) { @@ -541,11 +538,11 @@ pub(crate) trait CallPolicy: Any { machine_st.execute_inlined(&inlined), ClauseType::Op(..) | ClauseType::Named(..) => if let Some(idx) = code_dirs.get(name.clone(), arity, user) { - self.context_call(machine_st, name, arity, idx, lco)?; + self.context_call(machine_st, name, arity, idx)?; } else { return Err(machine_st.existence_error(name, arity)); }, - ClauseType::System(ct) => + ClauseType::System(_) => return Err(machine_st.type_error(ValidType::Callable, Addr::Con(Constant::Atom(name)))) }; @@ -557,10 +554,10 @@ pub(crate) trait CallPolicy: Any { impl CallPolicy for CallWithInferenceLimitCallPolicy { fn context_call(&mut self, machine_st: &mut MachineState, name: ClauseName, - arity: usize, idx: CodeIndex, lco: bool) + arity: usize, idx: CodeIndex) -> CallResult { - self.prev_policy.context_call(machine_st, name, arity, idx, lco)?; + self.prev_policy.context_call(machine_st, name, arity, idx)?; self.increment() } @@ -588,18 +585,17 @@ impl CallPolicy for CallWithInferenceLimitCallPolicy { self.increment() } - fn call_builtin<'a>(&mut self, machine_st: &mut MachineState, ct: &BuiltInClauseType, lco: bool) + fn call_builtin<'a>(&mut self, machine_st: &mut MachineState, ct: &BuiltInClauseType) -> CallResult { - self.prev_policy.call_builtin(machine_st, ct, lco)?; + self.prev_policy.call_builtin(machine_st, ct)?; self.increment() } - fn call_n<'a>(&mut self, machine_st: &mut MachineState, arity: usize, code_dirs: CodeDirs<'a>, - lco: bool) + fn call_n<'a>(&mut self, machine_st: &mut MachineState, arity: usize, code_dirs: CodeDirs<'a>) -> CallResult { - self.prev_policy.call_n(machine_st, arity, code_dirs, lco)?; + self.prev_policy.call_n(machine_st, arity, code_dirs)?; self.increment() } } diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 9cd820b8..71374ae9 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -49,7 +49,8 @@ impl MachineState { hb: 0, block: 0, ball: Ball::new(), - interms: vec![Number::default(); 256] + interms: vec![Number::default(); 256], + last_call: false } } @@ -80,16 +81,31 @@ impl MachineState { } pub(super) fn bind(&mut self, r1: Ref, a2: Addr) { - let t2 = self.store(a2); + let t1 = self.store(r1.as_addr()); + let t2 = self.store(a2.clone()); - match r1 { - Ref::StackCell(fr, sc) => - self.and_stack[fr][sc] = t2, - Ref::HeapCell(hc) => - self.heap[hc] = HeapCellValue::Addr(t2) - }; + if t1.is_ref() && (!t2.is_ref() || a2 < r1) { + match r1 { + Ref::StackCell(fr, sc) => + self.and_stack[fr][sc] = t2, + Ref::HeapCell(h) => + self.heap[h] = HeapCellValue::Addr(t2) + }; - self.trail(r1); + self.trail(r1); + } else { + match a2.as_var() { + Some(Ref::StackCell(fr, sc)) => { + self.and_stack[fr][sc] = t1; + self.trail(Ref::StackCell(fr, sc)); + }, + Some(Ref::HeapCell(h)) => { + self.heap[h] = HeapCellValue::Addr(t1); + self.trail(Ref::HeapCell(h)); + }, + None => {} + } + } } pub(super) @@ -711,9 +727,9 @@ impl MachineState { self.write_constant_to_var(addr, c.clone()); }, &FactInstruction::GetList(_, reg) => { - let addr = self.deref(self[reg].clone()); + let addr = self.store(self.deref(self[reg].clone())); - match self.store(addr.clone()) { + match addr { Addr::HeapCell(hc) => { let h = self.heap.h; @@ -955,10 +971,8 @@ impl MachineState { self.registers[arg] = self.heap[h].as_addr(h); } }, - &QueryInstruction::PutValue(norm, arg) => { - let addr = self.store(self.deref(self[norm].clone())); - self.registers[arg] = self[norm].clone(); - }, + &QueryInstruction::PutValue(norm, arg) => + self.registers[arg] = self[norm].clone(), &QueryInstruction::PutVariable(norm, arg) => { match norm { RegType::Perm(n) => { @@ -1724,20 +1738,26 @@ impl MachineState { match instr { &ControlInstruction::Allocate(num_cells) => self.allocate(num_cells), - &ControlInstruction::CallClause(ClauseType::CallN, arity, _, lco) => - try_or_fail!(self, call_policy.call_n(self, arity, code_dirs, lco)), - &ControlInstruction::CallClause(ClauseType::BuiltIn(ref ct), _, _, lco) => - try_or_fail!(self, call_policy.call_builtin(self, ct, lco)), + &ControlInstruction::CallClause(ClauseType::CallN, arity, _, lco) => { + self.last_call = lco; + try_or_fail!(self, call_policy.call_n(self, arity, code_dirs)); + }, + &ControlInstruction::CallClause(ClauseType::BuiltIn(ref ct), _, _, lco) => { + self.last_call = lco; + try_or_fail!(self, call_policy.call_builtin(self, ct)); + }, &ControlInstruction::CallClause(ClauseType::Inlined(ref ct), ..) => self.execute_inlined(ct), &ControlInstruction::CallClause(ClauseType::Named(ref name, ref idx), arity, _, lco) - | &ControlInstruction::CallClause(ClauseType::Op(ref name, _, ref idx), arity, _, lco) => - try_or_fail!(self, call_policy.context_call(self, name.clone(), arity, idx.clone(), - lco)), - &ControlInstruction::CallClause(ClauseType::System(ref ct), arity, _, lco) => { + | &ControlInstruction::CallClause(ClauseType::Op(ref name, _, ref idx), arity, _, lco) => { + self.last_call = lco; + try_or_fail!(self, call_policy.context_call(self, name.clone(), arity, idx.clone())); + }, + &ControlInstruction::CallClause(ClauseType::System(ref ct), _, _, lco) => { + self.last_call = lco; try_or_fail!(self, self.system_call(ct, call_policy, cut_policy)); - if lco { + if self.last_call { self.p = CodePtr::Local(self.cp.clone()); } else { self.p += 1; @@ -1785,11 +1805,13 @@ impl MachineState { self.fail = true; }, &ControlInstruction::IsClause(lco, r, ref at) => { + self.last_call = lco; + let a1 = self[r].clone(); let a2 = try_or_fail!(self, self.get_number(at)); self.unify(a1, Addr::Con(Constant::Number(a2))); - try_or_fail!(self, return_from_clause!(lco, self)); + try_or_fail!(self, return_from_clause!(self.last_call, self)); }, &ControlInstruction::JmpBy(arity, offset, _, lco) => { if !lco { diff --git a/src/prolog/machine/mod.rs b/src/prolog/machine/mod.rs index 74b261c8..e1112fae 100644 --- a/src/prolog/machine/mod.rs +++ b/src/prolog/machine/mod.rs @@ -233,9 +233,10 @@ impl Machine { CodePtr::Local(LocalCodePtr::DirEntry(p, _)) => Some(self.code[p].clone()), CodePtr::BuiltInClause(built_in, _) => - Some(call_clause!(ClauseType::BuiltIn(built_in), built_in.arity(), 0)), + Some(call_clause!(ClauseType::BuiltIn(built_in), built_in.arity(), + 0, self.ms.last_call)), CodePtr::CallN(arity, _) => - Some(call_clause!(ClauseType::CallN, arity, 0)) + Some(call_clause!(ClauseType::CallN, arity, 0, self.ms.last_call)) } } diff --git a/src/prolog/macros.rs b/src/prolog/macros.rs index 36a1b438..9019233c 100644 --- a/src/prolog/macros.rs +++ b/src/prolog/macros.rs @@ -134,7 +134,10 @@ macro_rules! is_var { macro_rules! call_clause { ($ct:expr, $arity:expr, $pvs:expr) => ( Line::Control(ControlInstruction::CallClause($ct, $arity, $pvs, false)) - ) + ); + ($ct:expr, $arity:expr, $pvs:expr, $lco:expr) => ( + Line::Control(ControlInstruction::CallClause($ct, $arity, $pvs, $lco)) + ) } macro_rules! proceed { @@ -144,9 +147,8 @@ macro_rules! proceed { } macro_rules! is_call { - ($r:expr, $at:expr) => ( + ($r:expr, $at:expr) => ( Line::Control(ControlInstruction::IsClause(false, $r, $at)) - ) } From b0bdf50a7811e9095721936363fb265318806f4c Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sat, 12 May 2018 18:23:57 -0600 Subject: [PATCH 14/20] parse negative numbers properly, handle length errors and failures properly. --- src/prolog/lib/builtins.pl | 36 ++++++++++++++++++++++++++++-- src/prolog/lib/lists.pl | 10 ++++----- src/prolog/machine/system_calls.rs | 4 ++-- src/prolog/parser | 2 +- src/tests.rs | 20 ++++++++--------- 5 files changed, 51 insertions(+), 21 deletions(-) diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index a8fa00a0..006fed1e 100644 --- a/src/prolog/lib/builtins.pl +++ b/src/prolog/lib/builtins.pl @@ -3,8 +3,8 @@ :- 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, (==)/2, arg/3, catch/3, - throw/1, true/0, false/0]). + (-)/1, (>=)/2, (=<)/2, (->)/2, (;)/2, (==)/2, (\==)/2, arg/3, + catch/3, throw/1, true/0, false/0, length/2]). % arithmetic operators. :- op(700, xfx, is). @@ -40,6 +40,7 @@ % term comparison. :- op(700, xfx, ==). +:- op(700, xfx, \==). % unify. X = X. @@ -96,3 +97,34 @@ arg(N, Functor, Arg) :- throw(error(type_error(integer, N), arg/3)). arg_(N, N, N, Functor, Arg) :- !, '$get_arg'(N, Functor, Arg). arg_(N, N, Arity, Functor, Arg) :- '$get_arg'(N, Functor, Arg). arg_(N, N0, Arity, Functor, Arg) :- N0 < Arity, N1 is N0 + 1, arg_(N, N1, Arity, Functor, Arg). + +% length. + +length(Xs, N) :- + var(N), !, + '$skip_max_list'(M, -1, Xs, Xs0), + ( Xs0 == [] -> N = M + ; var(Xs0) -> '$length_addendum'(Xs0, N, M)). + % ; throw(error(type_error(list, Xs), length/2))). +length(Xs, N) :- + integer(N), + N >= 0, !, + '$skip_max_list'(M, N, Xs, Xs0), + ( Xs0 == [] -> N = M + ; var(Xs0) -> R is N-M, '$length_rundown'(Xs0, R)). + % ; throw(error(type_error(list, Xs), length/2))). +length(_, N) :- + integer(N), !, + throw(error(domain_error(not_less_than_zero, N), length/2)). +length(_, N) :- + throw(error(type_error(integer, N), length/2)). + +'$length_addendum'([], N, N). +'$length_addendum'([_|Xs], N, M) :- + M1 is M + 1, + '$length_addendum'(Xs, N, M1). + +'$length_rundown'([], 0) :- !. +'$length_rundown'([_|Xs], N) :- + N1 is N-1, + '$length_rundown'(Xs, N1). diff --git a/src/prolog/lib/lists.pl b/src/prolog/lib/lists.pl index bd3ecd5d..11c0f275 100644 --- a/src/prolog/lib/lists.pl +++ b/src/prolog/lib/lists.pl @@ -1,5 +1,7 @@ -:- module(lists, [member/2, select/3, append/3, is_list/1, memberchk/2, reverse/2, maplist/2, - maplist/3, maplist/4, maplist/5, maplist/6, maplist/7, maplist/8, maplist/9]). +:- module(lists, [member/2, select/3, append/3, memberchk/2, + reverse/2, maplist/2, maplist/3, maplist/4, + maplist/5, maplist/6, maplist/7, maplist/8, + maplist/9]). member(X, [X|_]). member(X, [_|Xs]) :- member(X, Xs). @@ -10,10 +12,6 @@ select(X, [Y|Xs], [Y|Ys]) :- select(X, Xs, Ys). append([], R, R). append([X|L], R, [X|S]) :- append(L, R, S). -is_list(X) :- var(X), !, false. -is_list([]). -is_list([_|T]) :- is_list(T). - memberchk(X, Xs) :- member(X, Xs), !. reverse(Xs, Ys) :- reverse(Xs, [], Ys). diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index ada82b66..ca4d2468 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -103,10 +103,10 @@ impl MachineState { } pub(super) fn skip_max_list(&mut self) -> Result<(), MachineError> { - let max_steps = self.arith_eval_by_metacall(temp_v!(2))?; + let max_steps = self.store(self.deref(self[temp_v!(2)].clone())); match max_steps { - Number::Integer(ref max_steps) + Addr::Con(Constant::Number(Number::Integer(ref max_steps))) if max_steps.to_isize().map(|i| i >= -1).unwrap_or(false) => { let n = self.store(self.deref(self[temp_v!(1)].clone())); diff --git a/src/prolog/parser b/src/prolog/parser index 51e38dd2..7f9094ea 160000 --- a/src/prolog/parser +++ b/src/prolog/parser @@ -1 +1 @@ -Subproject commit 51e38dd24252431432ec7deb5ad80e2fc11a5753 +Subproject commit 7f9094eaedf235ffacb7c49f098593f22957fcfc diff --git a/src/tests.rs b/src/tests.rs index 81a2064f..6a8ae689 100644 --- a/src/tests.rs +++ b/src/tests.rs @@ -550,7 +550,7 @@ fn test_queries_on_lists() assert_prolog_failure!(&mut wam, "?- p([Z, W, Y])."); assert_prolog_success!(&mut wam, "?- p([Z | W]).", [["Z = _0", "W = [_0]"]]); assert_prolog_success!(&mut wam, "?- p([Z | [Z]]).", [["Z = _0"]]); - assert_prolog_success!(&mut wam, "?- p([Z | [W]]).", [["Z = _2", "W = _2"]]); + assert_prolog_success!(&mut wam, "?- p([Z | [W]]).", [["Z = _0", "W = _0"]]); assert_prolog_failure!(&mut wam, "?- p([Z | []])."); submit(&mut wam, "p([Z])."); @@ -581,7 +581,7 @@ fn test_queries_on_lists() assert_prolog_success!(&mut wam, "?- member([X, Y], [a, [b, c], [b, b], [Z, x], [d, f]]).", [["X = b", "Y = c", "Z = _14"], ["X = b", "Y = b", "Z = _14"], - ["X = _14", "Y = x", "Z = _14"], + ["X = _2", "Y = x", "Z = _2"], ["X = d", "Y = f", "Z = _14"]]); assert_prolog_failure!(&mut wam, "?- member([X, Y, Y], [a, [b, c], [b, b], [Z, x], [d, f]])."); assert_prolog_failure!(&mut wam, "?- member([X, Y, Z], [a, [b, c], [b, b], [Z, x], [d, f]])."); @@ -640,12 +640,12 @@ fn test_queries_on_conjuctive_queries() { submit(&mut wam, "q([f(g(x))], Z). q([f(g(y))], Y). q([f(g(z))], a)."); assert_prolog_success!(&mut wam, "?- p(X, Y), q(Y, Z).", - [["Z = _10", "X = a", "Y = [f(g(x))]"], - ["Z = _10", "X = a", "Y = [f(g(y))]"], + [["Z = _11", "X = a", "Y = [f(g(x))]"], + ["Z = _11", "X = a", "Y = [f(g(y))]"], ["Z = a", "X = a", "Y = [f(g(z))]"]]); assert_prolog_success!(&mut wam, "?- p(X, Y), !, q(Y, Z).", - [["X = a", "Y = [f(g(x))]", "Z = _10"], - ["X = a", "Y = [f(g(y))]", "Z = _10"], + [["X = a", "Y = [f(g(x))]", "Z = _11"], + ["X = a", "Y = [f(g(y))]", "Z = _11"], ["X = a", "Y = [f(g(z))]", "Z = a"]]); assert_prolog_success!(&mut wam, "?- p(X, Y), !, q(Y, X).", [["X = a", "Y = [f(g(x))]"], @@ -670,12 +670,12 @@ fn test_queries_on_conjuctive_queries() { ["Y = [f(g(z))]", "X = [f(g(x))]"], ["Y = [f(g(z))]", "X = [f(g(y))]"]]); assert_prolog_success!(&mut wam, "?- p(X, Y), q(Y, X).", - [["Y = [f(g(x))]", "X = s_0_2"], - ["Y = [f(g(y))]", "X = s_0_2"], + [["Y = [f(g(x))]", "X = _10"], + ["Y = [f(g(y))]", "X = _10"], ["Y = [f(g(z))]", "X = a"]]); assert_prolog_success!(&mut wam, "?- q(X, Y), p(Y, X).", - [["Y = s_0_1", "X = [f(g(x))]"], - ["Y = s_0_1", "X = [f(g(y))]"], + [["Y = _9", "X = [f(g(x))]"], + ["Y = _9", "X = [f(g(y))]"], ["Y = a" , "X = [f(g(z))]"]]); } From 175a5db5d7946cc017d3122647f4117b50e22627 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sun, 13 May 2018 14:10:48 -0600 Subject: [PATCH 15/20] parse the list functor --- src/prolog/ast.rs | 2 + src/prolog/lib/builtins.pl | 31 ++++- src/prolog/machine/machine_errors.rs | 25 +++- src/prolog/machine/machine_state_impl.rs | 140 ++++++++++++++--------- src/prolog/macros.rs | 6 - src/prolog/parser | 2 +- src/tests.rs | 2 +- 7 files changed, 140 insertions(+), 68 deletions(-) diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index f17c97cd..4eb14547 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -22,6 +22,8 @@ pub type Var = String; pub type Specifier = u32; +pub const MAX_ARITY: usize = 63; + pub const XFX: u32 = 0x0001; pub const XFY: u32 = 0x0002; pub const YFX: u32 = 0x0004; diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index 006fed1e..c55ba5d6 100644 --- a/src/prolog/lib/builtins.pl +++ b/src/prolog/lib/builtins.pl @@ -3,8 +3,8 @@ :- 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, (==)/2, (\==)/2, arg/3, - catch/3, throw/1, true/0, false/0, length/2]). + (-)/1, (>=)/2, (=<)/2, (,)/2, (->)/2, (;)/2, (==)/2, (\==)/2, + (=..)/2, arg/3, catch/3, throw/1, true/0, false/0, length/2]). % arithmetic operators. :- op(700, xfx, is). @@ -33,6 +33,7 @@ % unify. :- op(700, xfx, =). +:- op(700, xfx, =..). % conditional operators. :- op(1050, xfy, ->). @@ -105,14 +106,12 @@ length(Xs, N) :- '$skip_max_list'(M, -1, Xs, Xs0), ( Xs0 == [] -> N = M ; var(Xs0) -> '$length_addendum'(Xs0, N, M)). - % ; throw(error(type_error(list, Xs), length/2))). length(Xs, N) :- integer(N), N >= 0, !, '$skip_max_list'(M, N, Xs, Xs0), ( Xs0 == [] -> N = M ; var(Xs0) -> R is N-M, '$length_rundown'(Xs0, R)). - % ; throw(error(type_error(list, Xs), length/2))). length(_, N) :- integer(N), !, throw(error(domain_error(not_less_than_zero, N), length/2)). @@ -128,3 +127,27 @@ length(_, N) :- '$length_rundown'([_|Xs], N) :- N1 is N-1, '$length_rundown'(Xs, N1). + +Term =.. List :- + atomic(Term), !, + List = [Term]. +Term =.. List :- + compound(Term), !, + ( functor(Term, Name, NArgs) -> + List = [Name|Args], '$get_args'(Args, Term, 1, NArgs) + ; Term = [_|_] -> + List = ['.'|Term] ). +Term =.. List :- + var(Term), !, + ( List = [ATerm], atomic(ATerm) -> + Term = ATerm + ; List = [Name|Args] -> + functor(Term, Name, Args)). + +'$get_args'(Args, _, _, 0) :- + !, Args = []. +'$get_args'([Arg], Func, N, N) :- + !, '$get_arg'(N, Func, Arg). +'$get_args'([Arg|Args], Func, I0, N) :- + '$get_arg'(I0, Func, Arg), I1 is I0 + 1, + '$get_args'(Args, Func, I1, N). diff --git a/src/prolog/machine/machine_errors.rs b/src/prolog/machine/machine_errors.rs index a220cf9b..c232bb4d 100644 --- a/src/prolog/machine/machine_errors.rs +++ b/src/prolog/machine/machine_errors.rs @@ -10,8 +10,8 @@ pub(super) type MachineStub = Vec; // from 7.12.2 b) of 13211-1:1995 #[derive(Clone, Copy)] pub enum ValidType { -// Atom, -// Atomic, + Atom, + Atomic, // Byte, Callable, // Character, @@ -30,8 +30,8 @@ pub enum ValidType { impl ValidType { pub fn as_str(self) -> &'static str { match self { -// ValidType::Atom => "atom", -// ValidType::Atomic => "atomic", + ValidType::Atom => "atom", + ValidType::Atomic => "atomic", // ValidType::Byte => "byte", ValidType::Callable => "callable", // ValidType::Character => "character", @@ -49,6 +49,19 @@ impl ValidType { } } +#[derive(Clone, Copy)] +pub enum DomainError { + NotLessThanZero +} + +impl DomainError { + pub fn as_str(self) -> &'static str { + match self { + DomainError::NotLessThanZero => "not_less_than_zero" + } + } +} + // from 7.12.2 f) of 13211-1:1995 #[derive(Clone, Copy)] pub enum RepFlag { @@ -198,6 +211,10 @@ impl MachineState { error } + pub(super) fn domain_error(&self, error: DomainError, culprit: Addr) -> MachineError { + functor!("domain_error", 2, [heap_atom!(error.as_str()), HeapCellValue::Addr(culprit)]) + } + pub(super) fn instantiation_error(&self) -> MachineError { functor!("instantiation_error") } diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 71374ae9..cf133ed9 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -43,7 +43,7 @@ impl MachineState { mode: MachineMode::Write, and_stack: AndStack::new(), or_stack: OrStack::new(), - registers: vec![Addr::HeapCell(0); 64], + registers: vec![Addr::HeapCell(0); MAX_ARITY + 1], // self.registers[0] is never used. trail: Vec::new(), tr: 0, hb: 0, @@ -105,7 +105,7 @@ impl MachineState { }, None => {} } - } + } } pub(super) @@ -168,6 +168,21 @@ impl MachineState { self.bind(Ref::StackCell(fr, sc), d2), (_, Addr::StackCell(fr, sc)) => self.bind(Ref::StackCell(fr, sc), d1), + (Addr::Lis(a1), Addr::Str(a2)) | (Addr::Str(a2), Addr::Lis(a1)) => { + if let &HeapCellValue::NamedStr(n2, ref f2, _) = &self.heap[a2] { + if f2.as_str() == "." && n2 == 2 { + pdl.push(Addr::HeapCell(a1)); + pdl.push(Addr::HeapCell(a2 + 1)); + + pdl.push(Addr::HeapCell(a1 + 1)); + pdl.push(Addr::HeapCell(a2 + 2)); + + continue; + } + } + + self.fail = true; + }, (Addr::Lis(a1), Addr::Lis(a2)) => { pdl.push(Addr::HeapCell(a1)); pdl.push(Addr::HeapCell(a2)); @@ -175,11 +190,10 @@ impl MachineState { pdl.push(Addr::HeapCell(a1 + 1)); pdl.push(Addr::HeapCell(a2 + 1)); }, - (Addr::Con(c1), Addr::Con(c2)) => { + (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]; @@ -1415,69 +1429,91 @@ impl MachineState { } } + fn try_functor_unify_components(&mut self, name: Addr, arity: Addr) { + let a2 = self[temp_v!(2)].clone(); + let a3 = self[temp_v!(3)].clone(); + + self.unify(a2, name); + + if !self.fail { + self.unify(a3, arity); + } + } + + fn try_functor_compound_case(&mut self, name: ClauseName, arity: usize) { + let name = Addr::Con(Constant::Atom(name)); + let arity = Addr::Con(integer!(arity)); + + self.try_functor_unify_components(name, arity); + } + 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())); match a1.clone() { + Addr::Con(_) => + self.try_functor_unify_components(a1, Addr::Con(integer!(0))), Addr::Str(o) => match self.heap[o].clone() { - HeapCellValue::NamedStr(arity, name, _) => { - let name = Addr::Con(Constant::Atom(name)); // A2 - let arity = Addr::Con(Constant::Number(rc_integer!(arity))); - - let a2 = self[temp_v!(2)].clone(); - self.unify(a2, name); - - if !self.fail { - let a3 = self[temp_v!(3)].clone(); - self.unify(a3, arity); - } - }, + HeapCellValue::NamedStr(arity, name, _) => + self.try_functor_compound_case(name, arity), _ => self.fail = true }, + Addr::Lis(_) => + self.try_functor_compound_case(clause_name!("."), 2), Addr::HeapCell(_) | Addr::StackCell(_, _) => { let name = self.store(self.deref(self[temp_v!(2)].clone())); let arity = self.store(self.deref(self[temp_v!(3)].clone())); - if let Addr::Con(Constant::Atom(name)) = name { - if let Addr::Con(Constant::Number(Number::Integer(arity))) = arity { - let f_a = Addr::Str(self.heap.h); - let arity = match arity.to_usize() { - Some(arity) => arity, - None => { - self.fail = true; - return Ok(()); - } - }; - - if arity > 0 { - self.heap.push(HeapCellValue::NamedStr(arity, name, None)); - } else { - let c = Constant::Atom(name.clone()); - self.heap.push(HeapCellValue::Addr(Addr::Con(c))); - } - - for _ in 0 .. arity { - let h = self.heap.h; - self.heap.push(HeapCellValue::Addr(Addr::HeapCell(h))); - } - - self.unify(a1, f_a); - } else { - return Err(self.error_form(self.instantiation_error(), stub)); - } - } else { + if name.is_ref() || arity.is_ref() { // 8.5.1.3 a) & 8.5.1.3 b) return Err(self.error_form(self.instantiation_error(), stub)); } - }, - _ => { - let a2 = self[temp_v!(2)].clone(); - self.unify(a1, a2); - if !self.fail { - let a3 = self[temp_v!(3)].clone(); - self.unify(a3, Addr::Con(Constant::Number(rc_integer!(0)))); + if let Addr::Con(Constant::Number(Number::Integer(arity))) = arity { + let arity = match arity.to_isize() { + Some(arity) => arity, + None => { + self.fail = true; + return Ok(()); + } + }; + + if arity > MAX_ARITY as isize { + // 8.5.1.3 f) + return Err(self.error_form(self.representation_error(RepFlag::MaxArity), + stub)); + } else if arity < 0 { + // 8.5.1.3 g) + return Err(self.error_form(self.domain_error(DomainError::NotLessThanZero, + Addr::Con(integer!(arity))), + stub)); + } + + match name { + Addr::Con(_) if arity == 0 => + self.unify(a1, name), + Addr::Con(Constant::Atom(name)) => { + let f_a = Addr::Str(self.heap.h); + self.heap.push(HeapCellValue::NamedStr(arity as usize, name, None)); + + for _ in 0 .. arity { + let h = self.heap.h; + self.heap.push(HeapCellValue::Addr(Addr::HeapCell(h))); + } + + self.unify(a1, f_a); + }, + Addr::Con(_) => + return Err(self.error_form(self.type_error(ValidType::Atom, name), + stub)), // 8.5.1.3 e) + _ => + return Err(self.error_form(self.type_error(ValidType::Atomic, name), + stub)) // 8.5.1.3 c) + }; + } else if !arity.is_ref() { + // 8.5.1.3 d) + return Err(self.error_form(self.type_error(ValidType::Integer, arity), stub)); } } }; diff --git a/src/prolog/macros.rs b/src/prolog/macros.rs index 9019233c..79ecb6f5 100644 --- a/src/prolog/macros.rs +++ b/src/prolog/macros.rs @@ -164,12 +164,6 @@ macro_rules! integer { ) } -macro_rules! rc_integer { - ($e:expr) => ( - Number::Integer(Rc::new(BigInt::from($e))) - ) -} - macro_rules! rc_atom { ($e:expr) => ( Rc::new(String::from($e)) diff --git a/src/prolog/parser b/src/prolog/parser index 7f9094ea..ae747778 160000 --- a/src/prolog/parser +++ b/src/prolog/parser @@ -1 +1 @@ -Subproject commit 7f9094eaedf235ffacb7c49f098593f22957fcfc +Subproject commit ae747778688290ecf1c80b68cf34cf28bffac9f8 diff --git a/src/tests.rs b/src/tests.rs index 6a8ae689..42b6e3e5 100644 --- a/src/tests.rs +++ b/src/tests.rs @@ -1381,7 +1381,7 @@ fn test_queries_on_builtins() assert_prolog_success!(&mut wam, "?- length(Xs, 0).", [["Xs = []"]]); assert_prolog_success!(&mut wam, "?- length([a,b,[a,b,c]], 3)."); assert_prolog_failure!(&mut wam, "?- length([a,b,[a,b,c]], 2)."); - assert_prolog_success!(&mut wam, "?- catch(length(a, []), type_error(_, E), true).", + assert_prolog_success!(&mut wam, "?- catch(length(a, []), type_error(integer, E), true).", [["E = []"]]); assert_prolog_success!(&mut wam, "?- duplicate_term([1,2,3], [X,Y,Z]).", From 81d0538a5c8118adeb51dc9be181ea44b925b390 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sun, 13 May 2018 14:55:44 -0600 Subject: [PATCH 16/20] switch to machine implemented arg --- src/prolog/ast.rs | 7 ++- src/prolog/io.rs | 2 - src/prolog/lib/builtins.pl | 79 +++++++++++++----------- src/prolog/machine/machine_state.rs | 4 ++ src/prolog/machine/machine_state_impl.rs | 69 +++++++++++++++------ src/prolog/machine/system_calls.rs | 2 - 6 files changed, 101 insertions(+), 62 deletions(-) diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index 4eb14547..26a238dc 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -708,7 +708,6 @@ pub enum SystemClauseType { RemoveInferenceCounter, RestoreCutPolicy, SetCutPoint(RegType), - GetArg, InferenceLevel, CleanUpBlock, EraseBall, @@ -740,7 +739,6 @@ impl SystemClauseType { 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::CleanUpBlock => clause_name!("$clean_up_block"), &SystemClauseType::EraseBall => clause_name!("$erase_ball"), @@ -769,7 +767,6 @@ impl SystemClauseType { 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), ("$clean_up_block", 1) => Some(SystemClauseType::CleanUpBlock), ("$erase_ball", 0) => Some(SystemClauseType::EraseBall), @@ -790,6 +787,7 @@ impl SystemClauseType { #[derive(Copy, Clone, PartialEq)] pub enum BuiltInClauseType { AcyclicTerm, + Arg, Compare, CompareTerm(CompareTermQT), CyclicTerm, @@ -892,6 +890,7 @@ impl BuiltInClauseType { pub fn name(&self) -> ClauseName { match self { &BuiltInClauseType::AcyclicTerm => clause_name!("acyclic_term"), + &BuiltInClauseType::Arg => clause_name!("arg"), &BuiltInClauseType::Compare => clause_name!("compare"), &BuiltInClauseType::CompareTerm(qt) => clause_name!(qt.name()), &BuiltInClauseType::CyclicTerm => clause_name!("cyclic_term"), @@ -910,6 +909,7 @@ impl BuiltInClauseType { pub fn arity(&self) -> usize { match self { &BuiltInClauseType::AcyclicTerm => 1, + &BuiltInClauseType::Arg => 3, &BuiltInClauseType::Compare => 2, &BuiltInClauseType::CompareTerm(_) => 2, &BuiltInClauseType::CyclicTerm => 1, @@ -928,6 +928,7 @@ impl BuiltInClauseType { pub fn from(name: &str, arity: usize) -> Option { match (name, arity) { ("acyclic_term", 1) => Some(BuiltInClauseType::AcyclicTerm), + ("arg", 3) => Some(BuiltInClauseType::Arg), ("compare", 3) => Some(BuiltInClauseType::Compare), ("cyclic_term", 1) => Some(BuiltInClauseType::CyclicTerm), ("@>", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::GreaterThan)), diff --git a/src/prolog/io.rs b/src/prolog/io.rs index c9bea659..41e75b53 100644 --- a/src/prolog/io.rs +++ b/src/prolog/io.rs @@ -516,8 +516,6 @@ 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 c55ba5d6..b1e94b9a 100644 --- a/src/prolog/lib/builtins.pl +++ b/src/prolog/lib/builtins.pl @@ -4,7 +4,7 @@ (\/)/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, (;)/2, (==)/2, (\==)/2, - (=..)/2, arg/3, catch/3, throw/1, true/0, false/0, length/2]). + catch/3, throw/1, true/0, false/0, length/2]). % arithmetic operators. :- op(700, xfx, is). @@ -74,7 +74,48 @@ 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). -% exception handling. +/* +Term =.. List :- + atomic(Term), !, + List = [Term]. +Term =.. List :- + compound(Term), !, + ( functor(Term, Name, NArgs) -> + List = [Name|Args], '$get_args'(Args, Term, 1, NArgs) + ; Term = [_|_] -> + List = ['.'|Term] ). +Term =.. List :- + var(Term), !, + ( List = [ATerm], atomic(ATerm) -> + Term = ATerm + ; List = [Name|Args] -> + functor(Term, Name, Args)). + +'$get_args'(Args, _, _, 0) :- + !, Args = []. +'$get_args'([Arg], Func, N, N) :- + !, '$get_arg'(N, Func, Arg). +'$get_args'([Arg|Args], Func, I0, N) :- + '$get_arg'(I0, Func, Arg), I1 is I0 + 1, + '$get_args'(Args, Func, I1, N). +*/ + +% arg. + +/* The old, SWI Prolog-imitative arg/3. + +arg(N, Functor, Arg) :- var(N), !, functor(Functor, _, Arity), arg_(N, 1, Arity, Functor, Arg). +arg(N, Functor, Arg) :- integer(N), !, functor(Functor, _, Arity), '$get_arg'(N, Functor, Arg). +arg(N, Functor, Arg) :- throw(error(type_error(integer, N), arg/3)). + +arg_(N, N, N, Functor, Arg) :- !, '$get_arg'(N, Functor, Arg). +arg_(N, N, Arity, Functor, Arg) :- '$get_arg'(N, Functor, Arg). +arg_(N, N0, Arity, Functor, Arg) :- N0 < Arity, N1 is N0 + 1, arg_(N, N1, Arity, Functor, Arg). +*/ + +% The new, ISO Prolog compliant arg/3 is implemented in Rust. + +% exceptions. catch(G,C,R) :- '$get_current_block'(Bb), catch(G,C,R,Bb). @@ -89,16 +130,6 @@ handle_ball(_, _, _) :- '$unwind_stack'. throw(Ball) :- '$set_ball'(Ball), '$unwind_stack'. -% arg. - -arg(N, Functor, Arg) :- var(N), !, functor(Functor, _, Arity), arg_(N, 1, Arity, Functor, Arg). -arg(N, Functor, Arg) :- integer(N), !, functor(Functor, _, Arity), '$get_arg'(N, Functor, Arg). -arg(N, Functor, Arg) :- throw(error(type_error(integer, N), arg/3)). - -arg_(N, N, N, Functor, Arg) :- !, '$get_arg'(N, Functor, Arg). -arg_(N, N, Arity, Functor, Arg) :- '$get_arg'(N, Functor, Arg). -arg_(N, N0, Arity, Functor, Arg) :- N0 < Arity, N1 is N0 + 1, arg_(N, N1, Arity, Functor, Arg). - % length. length(Xs, N) :- @@ -127,27 +158,3 @@ length(_, N) :- '$length_rundown'([_|Xs], N) :- N1 is N-1, '$length_rundown'(Xs, N1). - -Term =.. List :- - atomic(Term), !, - List = [Term]. -Term =.. List :- - compound(Term), !, - ( functor(Term, Name, NArgs) -> - List = [Name|Args], '$get_args'(Args, Term, 1, NArgs) - ; Term = [_|_] -> - List = ['.'|Term] ). -Term =.. List :- - var(Term), !, - ( List = [ATerm], atomic(ATerm) -> - Term = ATerm - ; List = [Name|Args] -> - functor(Term, Name, Args)). - -'$get_args'(Args, _, _, 0) :- - !, Args = []. -'$get_args'([Arg], Func, N, N) :- - !, '$get_arg'(N, Func, Arg). -'$get_args'([Arg|Args], Func, I0, N) :- - '$get_arg'(I0, Func, Arg), I1 is I0 + 1, - '$get_args'(Args, Func, I1, N). diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index bbbdf618..8f9a9727 100644 --- a/src/prolog/machine/machine_state.rs +++ b/src/prolog/machine/machine_state.rs @@ -410,6 +410,10 @@ pub(crate) trait CallPolicy: Any { machine_st.fail = machine_st.is_cyclic_term(addr); return_from_clause!(machine_st.last_call, machine_st) }, + &BuiltInClauseType::Arg => { + machine_st.try_arg()?; + return_from_clause!(machine_st.last_call, machine_st) + }, &BuiltInClauseType::Compare => { let a1 = machine_st[temp_v!(1)].clone(); let a2 = machine_st[temp_v!(2)].clone(); diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index cf133ed9..4f697b28 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -5,7 +5,7 @@ use prolog::heap_iter::*; use prolog::heap_print::*; use prolog::machine::machine_errors::*; use prolog::machine::machine_state::*; -use prolog::num::{Integer, ToPrimitive, Zero}; +use prolog::num::{Integer, Signed, ToPrimitive, Zero}; use prolog::num::bigint::{BigInt, BigUint}; use prolog::num::rational::Ratio; use prolog::or_stack::*; @@ -1166,31 +1166,62 @@ impl MachineState { fail } - pub(super) fn try_get_arg(&mut self) -> CallResult + // arg(+N, +Term, ?Arg) + pub(super) fn try_arg(&mut self) -> CallResult { - let a1 = self.store(self.deref(self[temp_v!(1)].clone())); + let stub = self.functor_stub(clause_name!("arg"), 3); + let n = self.store(self.deref(self[temp_v!(1)].clone())); - if let Addr::Con(Constant::Number(Number::Integer(i))) = a1 { - let a2 = self.store(self.deref(self[temp_v!(2)].clone())); + match n { + Addr::HeapCell(_) | Addr::StackCell(..) => // 8.5.2.3 a) + return Err(self.error_form(self.instantiation_error(), stub)), + Addr::Con(Constant::Number(Number::Integer(n))) => { + if n.is_negative() { + // 8.5.2.3 e) + let n = Addr::Con(Constant::Number(Number::Integer(n))); + return Err(self.error_form(self.domain_error(DomainError::NotLessThanZero, + n), + stub)); + } + + let n = match n.to_usize() { + Some(n) => n, + None => { + self.fail = true; + return Ok(()); + } + }; - if let Addr::Str(o) = a2 { - match self.heap[o].clone() { - HeapCellValue::NamedStr(arity, _, _) => - match i.to_usize() { - Some(i) if 1 <= i && i <= arity => { + let term = self.store(self.deref(self[temp_v!(2)].clone())); + + match term { + Addr::HeapCell(_) | Addr::StackCell(..) => // 8.5.2.3 b) + return Err(self.error_form(self.instantiation_error(), stub)), + Addr::Str(o) => + match self.heap[o].clone() { + HeapCellValue::NamedStr(arity, _, _) if 1 <= n && n <= arity => { let a3 = self[temp_v!(3)].clone(); - let h_a = Addr::HeapCell(o + i); - + let h_a = Addr::HeapCell(o + n); + self.unify(a3, h_a); }, _ => self.fail = true }, - _ => self.fail = true - }; - } else { - let stub = self.functor_stub(clause_name!("arg"), 3); - return Err(self.error_form(self.type_error(ValidType::Compound, a2), stub)); - } + Addr::Lis(l) 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); + }, + _ => // 8.5.2.3 d) + return Err(self.error_form(self.type_error(ValidType::Compound, term), + stub)) + } + + + }, + _ => // 8.5.2.3 c) + return Err(self.error_form(self.type_error(ValidType::Integer, n), stub)) } Ok(()) @@ -1447,7 +1478,7 @@ impl MachineState { self.try_functor_unify_components(name, arity); } - pub(super) fn try_functor(&mut self) -> Result<(), MachineError> { + pub(super) fn try_functor(&mut self) -> CallResult { let stub = self.functor_stub(clause_name!("functor"), 3); let a1 = self.store(self.deref(self[temp_v!(1)].clone())); diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index ca4d2468..918bcd05 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -254,8 +254,6 @@ impl MachineState { }, &SystemClauseType::SetCutPoint(r) => cut_policy.cut(self, r), - &SystemClauseType::GetArg => - 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())); From 18e2e7760025994b8aa093d33d069c0cb8541515 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sun, 13 May 2018 17:02:33 -0600 Subject: [PATCH 17/20] add (=..)/2, arg/3 --- src/prolog/lib/builtins.pl | 84 +++++++++++++++--------- src/prolog/machine/machine_state_impl.rs | 24 ++++--- 2 files changed, 69 insertions(+), 39 deletions(-) diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index b1e94b9a..9531d7ab 100644 --- a/src/prolog/lib/builtins.pl +++ b/src/prolog/lib/builtins.pl @@ -3,8 +3,8 @@ :- 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, (;)/2, (==)/2, (\==)/2, - catch/3, throw/1, true/0, false/0, length/2]). + (-)/1, (>=)/2, (=<)/2, (,)/2, (->)/2, (;)/2, (=..)/2, (==)/2, + (\==)/2, catch/3, throw/1, true/0, false/0, length/2]). % arithmetic operators. :- op(700, xfx, is). @@ -31,8 +31,9 @@ :- op(700, xfx, >=). :- op(700, xfx, =<). -% unify. +% control. :- op(700, xfx, =). +:- op(900, fy, \+). :- op(700, xfx, =..). % conditional operators. @@ -43,6 +44,9 @@ :- op(700, xfx, ==). :- op(700, xfx, \==). +% the maximum arity flag. needs to be replaced with current_prolog_flag(max_arity, MAX_ARITY). +max_arity(63). + % unify. X = X. @@ -74,35 +78,10 @@ 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). -/* -Term =.. List :- - atomic(Term), !, - List = [Term]. -Term =.. List :- - compound(Term), !, - ( functor(Term, Name, NArgs) -> - List = [Name|Args], '$get_args'(Args, Term, 1, NArgs) - ; Term = [_|_] -> - List = ['.'|Term] ). -Term =.. List :- - var(Term), !, - ( List = [ATerm], atomic(ATerm) -> - Term = ATerm - ; List = [Name|Args] -> - functor(Term, Name, Args)). - -'$get_args'(Args, _, _, 0) :- - !, Args = []. -'$get_args'([Arg], Func, N, N) :- - !, '$get_arg'(N, Func, Arg). -'$get_args'([Arg|Args], Func, I0, N) :- - '$get_arg'(I0, Func, Arg), I1 is I0 + 1, - '$get_args'(Args, Func, I1, N). -*/ - % arg. -/* The old, SWI Prolog-imitative arg/3. +/* Here is the old, SWI Prolog-imitative arg/3. The new, ISO Prolog + * compliant arg/3 is implemented in Rust. arg(N, Functor, Arg) :- var(N), !, functor(Functor, _, Arity), arg_(N, 1, Arity, Functor, Arg). arg(N, Functor, Arg) :- integer(N), !, functor(Functor, _, Arity), '$get_arg'(N, Functor, Arg). @@ -111,9 +90,52 @@ arg(N, Functor, Arg) :- throw(error(type_error(integer, N), arg/3)). arg_(N, N, N, Functor, Arg) :- !, '$get_arg'(N, Functor, Arg). arg_(N, N, Arity, Functor, Arg) :- '$get_arg'(N, Functor, Arg). arg_(N, N0, Arity, Functor, Arg) :- N0 < Arity, N1 is N0 + 1, arg_(N, N1, Arity, Functor, Arg). + */ -% The new, ISO Prolog compliant arg/3 is implemented in Rust. +% univ. + +\+ Goal :- call(Goal), !, false. +\+ _. + +univ_errors(Term, List, N) :- + '$skip_max_list'(N, -1, List, R), + ( var(R) -> ( var(Term), throw(error(instantiation_error, (=..)/2)) % 8.5.3.3 a) + ; true ) + ; R \== [] -> throw(error(type_error(list, List), (=..)/2)) % 8.5.3.3 b) + ; List = [H|T] -> ( var(H), var(Term), % R == [] => List is a proper list. + throw(error(instantiation_error, (=..)/2)) % 8.5.3.3 c) + ; T \== [], nonvar(H), \+ atom(H), + throw(error(type_error(atom, H), (=..)/2)) % 8.5.3.3 d) + ; compound(H), T == [], + throw(error(type_error(atomic, H), (=..)/2)) % 8.5.3.3 e) + ; var(Term), max_arity(M), N - 1 > M, + throw(error(representation_error(max_arity), (=..)/2)) % 8.5.3.3 g) + ; true ) + ; var(Term) -> throw(error(domain_error(non_empty_list, List), (=..)/2)) % 8.5.3.3 f) + ; true ). + +Term =.. List :- univ_errors(Term, List, N), univ_worker(Term, List, N). + +univ_worker(Term, List, _) :- atomic(Term), !, List = [Term]. +univ_worker(Term, [Name|Args], N) :- + var(Term), !, + Arity is N-1, + functor(Term, Name, Arity), + '$get_args'(Args, Term, 1, Arity). +univ_worker(Term, List, _) :- + functor(Term, Name, Arity), + '$get_args'(Args, Term, 1, Arity), + List = [Name|Args]. + +'$get_args'(Args, _, _, 0) :- + !, Args = []. +'$get_args'([Arg], Func, N, N) :- + !, arg(N, Func, Arg). +'$get_args'([Arg|Args], Func, I0, N) :- + arg(I0, Func, Arg), + I1 is I0 + 1, + '$get_args'(Args, Func, I1, N). % exceptions. diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 4f697b28..e37a7058 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -1207,12 +1207,15 @@ impl MachineState { }, _ => self.fail = true }, - Addr::Lis(l) 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); - }, + Addr::Lis(l) => + 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; + }, _ => // 8.5.2.3 d) return Err(self.error_form(self.type_error(ValidType::Compound, term), stub)) @@ -1525,8 +1528,13 @@ impl MachineState { Addr::Con(_) if arity == 0 => self.unify(a1, name), Addr::Con(Constant::Atom(name)) => { - let f_a = Addr::Str(self.heap.h); - self.heap.push(HeapCellValue::NamedStr(arity as usize, name, None)); + let f_a = if name.as_str() == "." && arity == 2 { + Addr::Lis(self.heap.h) + } else { + let h = self.heap.h; + self.heap.push(HeapCellValue::NamedStr(arity as usize, name, None)); + Addr::Str(h) + }; for _ in 0 .. arity { let h = self.heap.h; From 9a88d179d1d38de2f59018e3de97431d4ff89efe Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Mon, 14 May 2018 16:43:49 -0600 Subject: [PATCH 18/20] remove IsClause --- src/prolog/ast.rs | 16 +++++++--------- src/prolog/codegen.rs | 9 ++++----- src/prolog/io.rs | 4 ---- src/prolog/machine/machine_state.rs | 10 +++++----- src/prolog/machine/machine_state_impl.rs | 11 +---------- src/prolog/machine/mod.rs | 2 +- src/prolog/macros.rs | 4 ++-- 7 files changed, 20 insertions(+), 36 deletions(-) diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index 26a238dc..04b93f28 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -784,7 +784,7 @@ impl SystemClauseType { } } -#[derive(Copy, Clone, PartialEq)] +#[derive(Clone, PartialEq)] pub enum BuiltInClauseType { AcyclicTerm, Arg, @@ -796,7 +796,7 @@ pub enum BuiltInClauseType { Eq, Functor, Ground, - Is, + Is(RegType, ArithmeticTerm), KeySort, NotEq, Sort, @@ -881,7 +881,7 @@ impl BuiltInClauseType { fn fixity(&self) -> Option { match self { &BuiltInClauseType::Compare | &BuiltInClauseType::CompareTerm(_) - | &BuiltInClauseType::NotEq | &BuiltInClauseType::Is | &BuiltInClauseType::Eq + | &BuiltInClauseType::NotEq | &BuiltInClauseType::Is(..) | &BuiltInClauseType::Eq => Some(Fixity::In), _ => None } @@ -899,7 +899,7 @@ impl BuiltInClauseType { &BuiltInClauseType::Eq => clause_name!("=="), &BuiltInClauseType::Functor => clause_name!("functor"), &BuiltInClauseType::Ground => clause_name!("ground"), - &BuiltInClauseType::Is => clause_name!("is"), + &BuiltInClauseType::Is(..) => clause_name!("is"), &BuiltInClauseType::KeySort => clause_name!("keysort"), &BuiltInClauseType::NotEq => clause_name!("\\=="), &BuiltInClauseType::Sort => clause_name!("sort"), @@ -918,7 +918,7 @@ impl BuiltInClauseType { &BuiltInClauseType::Eq => 2, &BuiltInClauseType::Functor => 3, &BuiltInClauseType::Ground => 1, - &BuiltInClauseType::Is => 2, + &BuiltInClauseType::Is(..) => 2, &BuiltInClauseType::KeySort => 2, &BuiltInClauseType::NotEq => 2, &BuiltInClauseType::Sort => 2, @@ -942,7 +942,7 @@ impl BuiltInClauseType { ("==", 2) => Some(BuiltInClauseType::Eq), ("functor", 3) => Some(BuiltInClauseType::Functor), ("ground", 1) => Some(BuiltInClauseType::Ground), - ("is", 2) => Some(BuiltInClauseType::Is), + ("is", 2) => Some(BuiltInClauseType::Is(temp_v!(1), ArithmeticTerm::Reg(temp_v!(2)))), ("keysort", 2) => Some(BuiltInClauseType::KeySort), ("\\==", 2) => Some(BuiltInClauseType::NotEq), ("sort", 2) => Some(BuiltInClauseType::Sort), @@ -965,7 +965,7 @@ impl ClauseType { pub fn name(&self) -> ClauseName { match self { &ClauseType::CallN => clause_name!("call"), - &ClauseType::BuiltIn(built_in) => built_in.name(), + &ClauseType::BuiltIn(ref built_in) => built_in.name(), &ClauseType::Inlined(ref inlined) => clause_name!(inlined.name()), &ClauseType::Op(ref name, ..) => name.clone(), &ClauseType::Named(ref name, ..) => name.clone(), @@ -1374,7 +1374,6 @@ pub enum ControlInstruction { CheckCpExecute, Deallocate, 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 } @@ -1384,7 +1383,6 @@ impl ControlInstruction { match self { &ControlInstruction::CallClause(..) => true, &ControlInstruction::GetCleanerCall => true, - &ControlInstruction::IsClause(..) => true, &ControlInstruction::JmpBy(..) => true, _ => false } diff --git a/src/prolog/codegen.rs b/src/prolog/codegen.rs index 6a01d348..1b1703e8 100644 --- a/src/prolog/codegen.rs +++ b/src/prolog/codegen.rs @@ -195,7 +195,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator GenContext::Last(chunk_num) } }; - + self.update_var_count(chunked_term.post_order_iter()); vs.mark_vars_in_chunk(chunked_term.post_order_iter(), lt_arity, term_loc); } @@ -234,8 +234,6 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator *ctrl = ControlInstruction::CallClause(ct, arity, pvs, true), ControlInstruction::JmpBy(arity, offset, pvs, false) => *ctrl = ControlInstruction::JmpBy(arity, offset, pvs, true), - ControlInstruction::IsClause(false, r, at) => - *ctrl = ControlInstruction::IsClause(true, r, at), ControlInstruction::Proceed => {}, _ => dealloc_index += 1 }, @@ -258,7 +256,7 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator code.append(&mut lcode); code.append(&mut rcode); - + code.push(compare_number_instr!(cmp, at_1.unwrap_or(interm!(1)), at_2.unwrap_or(interm!(2)))); @@ -414,7 +412,8 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator } else { Line::Cut(CutInstruction::Cut(perm_v!(1))) }), - &QueryTerm::Clause(_, ClauseType::BuiltIn(BuiltInClauseType::Is), ref terms) => + &QueryTerm::Clause(_, ClauseType::BuiltIn(BuiltInClauseType::Is(..)), ref terms) + => { let (mut acode, at) = self.call_arith_eval(terms[1].as_ref(), 1)?; code.append(&mut acode); diff --git a/src/prolog/io.rs b/src/prolog/io.rs index 41e75b53..9aa942b6 100644 --- a/src/prolog/io.rs +++ b/src/prolog/io.rs @@ -139,10 +139,6 @@ impl fmt::Display for ControlInstruction { write!(f, "deallocate"), &ControlInstruction::GetCleanerCall => write!(f, "get_cleaner_call"), - &ControlInstruction::IsClause(false, r, ref at) => - write!(f, "is_call {}, {}", r, at), - &ControlInstruction::IsClause(true, r, ref at) => - write!(f, "is_execute {}, {}", r, at), &ControlInstruction::JmpBy(arity, offset, pvs, false) => write!(f, "jmp_by_call {}/{}, {}", offset, arity, pvs), &ControlInstruction::JmpBy(arity, offset, pvs, true) => diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index 8f9a9727..7321182f 100644 --- a/src/prolog/machine/machine_state.rs +++ b/src/prolog/machine/machine_state.rs @@ -324,7 +324,7 @@ pub(crate) trait CallPolicy: Any { let b = machine_st.b - 1; let n = machine_st.or_stack[b].num_args(); - for i in 1 .. n + 1 { + for i in 1 .. n + 1 { machine_st.registers[i] = machine_st.or_stack[b][i].clone(); } @@ -510,11 +510,11 @@ pub(crate) trait CallPolicy: Any { return_from_clause!(machine_st.last_call, machine_st) }, - &BuiltInClauseType::Is => { - let a = machine_st[temp_v!(1)].clone(); - let result = machine_st.arith_eval_by_metacall(temp_v!(2))?; + &BuiltInClauseType::Is(r, ref at) => { + let a1 = machine_st[r].clone(); + let a2 = machine_st.get_number(at)?; - machine_st.unify(a, Addr::Con(Constant::Number(result))); + machine_st.unify(a1, Addr::Con(Constant::Number(a2))); return_from_clause!(machine_st.last_call, machine_st) }, } diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index e37a7058..0adc75d0 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -323,7 +323,7 @@ impl MachineState { }; } - fn get_number(&self, at: &ArithmeticTerm) -> Result { + pub(super) fn get_number(&self, at: &ArithmeticTerm) -> Result { match at { &ArithmeticTerm::Reg(r) => self.arith_eval_by_metacall(r), &ArithmeticTerm::Interm(i) => Ok(self.interms[i-1].clone()), @@ -1879,15 +1879,6 @@ impl MachineState { self.fail = true; }, - &ControlInstruction::IsClause(lco, r, ref at) => { - self.last_call = lco; - - let a1 = self[r].clone(); - let a2 = try_or_fail!(self, self.get_number(at)); - - self.unify(a1, Addr::Con(Constant::Number(a2))); - try_or_fail!(self, return_from_clause!(self.last_call, self)); - }, &ControlInstruction::JmpBy(arity, offset, _, lco) => { if !lco { self.cp.assign_if_local(self.p.clone() + 1); diff --git a/src/prolog/machine/mod.rs b/src/prolog/machine/mod.rs index e1112fae..d1848238 100644 --- a/src/prolog/machine/mod.rs +++ b/src/prolog/machine/mod.rs @@ -233,7 +233,7 @@ impl Machine { CodePtr::Local(LocalCodePtr::DirEntry(p, _)) => Some(self.code[p].clone()), CodePtr::BuiltInClause(built_in, _) => - Some(call_clause!(ClauseType::BuiltIn(built_in), built_in.arity(), + Some(call_clause!(ClauseType::BuiltIn(built_in.clone()), built_in.arity(), 0, self.ms.last_call)), CodePtr::CallN(arity, _) => Some(call_clause!(ClauseType::CallN, arity, 0, self.ms.last_call)) diff --git a/src/prolog/macros.rs b/src/prolog/macros.rs index 79ecb6f5..4124beca 100644 --- a/src/prolog/macros.rs +++ b/src/prolog/macros.rs @@ -147,8 +147,8 @@ macro_rules! proceed { } macro_rules! is_call { - ($r:expr, $at:expr) => ( - Line::Control(ControlInstruction::IsClause(false, $r, $at)) + ($r:expr, $at:expr) => ( + call_clause!(ClauseType::BuiltIn(BuiltInClauseType::Is($r, $at)), 2, 0) ) } From 8f1d721477a7a3168047b87ab15c53a65ca923e5 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Tue, 15 May 2018 00:23:42 -0600 Subject: [PATCH 19/20] move SGC and call inference instructions over to SystemClauseType --- src/prolog/ast.rs | 24 +++++++------- src/prolog/io.rs | 4 --- src/prolog/machine/machine_state.rs | 8 ++--- src/prolog/machine/machine_state_impl.rs | 40 ------------------------ src/prolog/machine/system_calls.rs | 35 +++++++++++++++++---- 5 files changed, 44 insertions(+), 67 deletions(-) diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index 04b93f28..47e1b11d 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -702,7 +702,9 @@ pub struct Rule { #[derive(Copy, Clone, PartialEq)] pub enum SystemClauseType { - InstallCleaner, + CheckCutPoint, + GetSCCCleaner, + InstallSCCCleaner, InstallInferenceCounter, RemoveCallPolicyCheck, RemoveInferenceCounter, @@ -730,7 +732,9 @@ impl SystemClauseType { pub fn name(&self) -> ClauseName { match self { - &SystemClauseType::InstallCleaner => clause_name!("$install_cleaner"), + &SystemClauseType::CheckCutPoint => clause_name!("$check_cp"), + &SystemClauseType::GetSCCCleaner => clause_name!("$get_scc_cleaner"), + &SystemClauseType::InstallSCCCleaner => clause_name!("$install_scc_cleaner"), &SystemClauseType::InstallInferenceCounter => clause_name!("$install_inference_counter"), &SystemClauseType::RemoveCallPolicyCheck => @@ -757,8 +761,10 @@ impl SystemClauseType { pub fn from(name: &str, arity: usize) -> Option { match (name, arity) { - ("$install_cleaner", 1) => - Some(SystemClauseType::InstallCleaner), + ("$check_cp", 1) => Some(SystemClauseType::CheckCutPoint), + ("$get_scc_cleaner", 1) => Some(SystemClauseType::GetSCCCleaner), + ("$install_scc_cleaner", 1) => + Some(SystemClauseType::InstallSCCCleaner), ("$install_inference_counter", 3) => Some(SystemClauseType::InstallInferenceCounter), ("$remove_call_policy_check", 1) => @@ -1362,18 +1368,11 @@ pub enum ArithmeticInstruction { Neg(ArithmeticTerm, usize) } -// call and cut policy exempt instructions. -#[derive(Clone)] -pub enum PEInstruction { -} - #[derive(Clone)] pub enum ControlInstruction { Allocate(usize), // num_frames. CallClause(ClauseType, usize, usize, bool), // name, arity, perm_vars after threshold, last call. - CheckCpExecute, - Deallocate, - GetCleanerCall, + Deallocate, JmpBy(usize, usize, usize, bool), // arity, global_offset, perm_vars after threshold, last call. Proceed } @@ -1382,7 +1381,6 @@ impl ControlInstruction { pub fn is_jump_instr(&self) -> bool { match self { &ControlInstruction::CallClause(..) => true, - &ControlInstruction::GetCleanerCall => true, &ControlInstruction::JmpBy(..) => true, _ => false } diff --git a/src/prolog/io.rs b/src/prolog/io.rs index 9aa942b6..ff6e195d 100644 --- a/src/prolog/io.rs +++ b/src/prolog/io.rs @@ -133,12 +133,8 @@ impl fmt::Display for ControlInstruction { write!(f, "execute {}/{}, {}", ct, arity, pvs), &ControlInstruction::CallClause(ref ct, arity, pvs, false) => write!(f, "call {}/{}, {}", ct, arity, pvs), - &ControlInstruction::CheckCpExecute => - write!(f, "check_cp_execute"), &ControlInstruction::Deallocate => write!(f, "deallocate"), - &ControlInstruction::GetCleanerCall => - write!(f, "get_cleaner_call"), &ControlInstruction::JmpBy(arity, offset, pvs, false) => write!(f, "jmp_by_call {}/{}, {}", offset, arity, pvs), &ControlInstruction::JmpBy(arity, offset, pvs, true) => diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index 7321182f..7fc0eeaf 100644 --- a/src/prolog/machine/machine_state.rs +++ b/src/prolog/machine/machine_state.rs @@ -701,14 +701,14 @@ impl CutPolicy for DefaultCutPolicy { } } -pub(crate) struct SetupCallCleanupCutPolicy { +pub(crate) struct SCCCutPolicy { // locations of cleaners, cut points, the previous block cont_pts: Vec<(Addr, usize, usize)> } -impl SetupCallCleanupCutPolicy { +impl SCCCutPolicy { pub(crate) fn new() -> Self { - SetupCallCleanupCutPolicy { cont_pts: vec![] } + SCCCutPolicy { cont_pts: vec![] } } pub(crate) fn out_of_cont_pts(&self) -> bool { @@ -724,7 +724,7 @@ impl SetupCallCleanupCutPolicy { } } -impl CutPolicy for SetupCallCleanupCutPolicy { +impl CutPolicy for SCCCutPolicy { fn cut(&mut self, machine_st: &mut MachineState, r: RegType) { let b = machine_st.b; diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 0adc75d0..9c1d625d 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -1838,47 +1838,7 @@ impl MachineState { self.p += 1; } }, - &ControlInstruction::CheckCpExecute => { - let a = self.store(self.deref(self[temp_v!(2)].clone())); - - match a { - Addr::Con(Constant::Usize(old_b)) if self.b > old_b + 1 => { - self.p = CodePtr::Local(self.cp.clone()); - }, - _ => { - self.num_of_args = 2; - self.b0 = self.b; - // goto sgc_on_success/2, 382. - self.p = dir_entry!(382, clause_name!("builtin")); - } - }; - }, &ControlInstruction::Deallocate => self.deallocate(), - &ControlInstruction::GetCleanerCall => { - let dest = self[temp_v!(1)].clone(); - - match cut_policy.downcast_mut::().ok() { - Some(sgc_policy) => - if let Some((addr, b_cutoff, prev_block)) = sgc_policy.pop_cont_pt() - { - self.p += 1; - - if self.b <= b_cutoff + 1 { - self.block = prev_block; - - if let Some(r) = dest.as_var() { - self.bind(r, addr); - return; - } - } else { - sgc_policy.push_cont_pt(addr, b_cutoff, prev_block); - } - }, - None => panic!("expected SetupCallCleanupCutPolicy trait object.") - }; - - self.fail = true; - }, &ControlInstruction::JmpBy(arity, offset, _, lco) => { if !lco { self.cp.assign_if_local(self.p.clone() + 1); diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index 918bcd05..75d80332 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -157,20 +157,43 @@ impl MachineState { -> CallResult { match ct { - &SystemClauseType::InstallCleaner => { + &SystemClauseType::CheckCutPoint => {}, + &SystemClauseType::GetSCCCleaner => { + let dest = self[temp_v!(1)].clone(); + + match cut_policy.downcast_mut::().ok() { + Some(sgc_policy) => + if let Some((addr, b_cutoff, prev_block)) = sgc_policy.pop_cont_pt() { + if self.b <= b_cutoff + 1 { + self.block = prev_block; + + if let Some(r) = dest.as_var() { + self.bind(r, addr); + return Ok(()); + } + } else { + sgc_policy.push_cont_pt(addr, b_cutoff, prev_block); + } + }, + None => panic!("expected SCCCutPolicy trait object.") + }; + + self.fail = true; + }, + &SystemClauseType::InstallSCCCleaner => { 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()); + if cut_policy.downcast_ref::().is_err() { + *cut_policy = Box::new(SCCCutPolicy::new()); } - match cut_policy.downcast_mut::().ok() + 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.") + SCCCutPolicy.") }; }, &SystemClauseType::InstallInferenceCounter => { // A1 = B, A2 = L @@ -242,7 +265,7 @@ impl MachineState { }, &SystemClauseType::RestoreCutPolicy => { let restore_default = - if let Ok(cut_policy) = cut_policy.downcast_ref::() { + if let Ok(cut_policy) = cut_policy.downcast_ref::() { cut_policy.out_of_cont_pts() } else { false From 06d896277c6c6167787f6c7b40d9c0bb285ba4fb Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Tue, 15 May 2018 22:47:36 -0600 Subject: [PATCH 20/20] major refactor --- Cargo.toml | 2 +- README.md | 6 +- src/main.rs | 10 +- src/prolog/ast.rs | 38 +- src/prolog/builtins.rs | 778 ----------------------- src/prolog/codegen.rs | 13 + src/prolog/compile.rs | 317 +++++++++ src/prolog/heap_print.rs | 6 +- src/prolog/io.rs | 333 +--------- src/prolog/iterators.rs | 9 + src/prolog/lib/builtins.pl | 71 ++- src/prolog/lib/control.pl | 10 +- src/prolog/lib/lists.pl | 35 +- src/prolog/lib/queues.pl | 2 + src/prolog/machine/machine_state.rs | 21 +- src/prolog/machine/machine_state_impl.rs | 21 +- src/prolog/machine/mod.rs | 33 +- src/prolog/machine/system_calls.rs | 52 +- src/prolog/macros.rs | 5 + src/prolog/mod.rs | 2 +- src/prolog/toplevel.rs | 18 +- src/tests.rs | 81 +-- 22 files changed, 587 insertions(+), 1276 deletions(-) delete mode 100644 src/prolog/builtins.rs create mode 100644 src/prolog/compile.rs diff --git a/Cargo.toml b/Cargo.toml index 3e19297a..b030b91e 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -1,6 +1,6 @@ [package] name = "rusty-wam" -version = "0.7.7" +version = "0.7.8" authors = ["Mark Thom"] [dependencies] diff --git a/README.md b/README.md index c1722354..4be008f5 100644 --- a/README.md +++ b/README.md @@ -26,11 +26,11 @@ Extend rusty-wam to include the following, among other features: associativity and precedence (_done_). * Bignum, rational number and floating point arithmetic (_done_). * Built-in control operators (`,`, `;`, `->`, etc.) (_done_). +* A revised, not-terrible module system (_in progress_). * Built-in predicates for list processing and top-level declarative control (`setup_call_control/3`, `call_with_inference_limit/3`, - etc.) (_done_). -* A rudimentary module system (_done_). -* Definite Clause Grammars (_in progress_). + etc.) (NEEDS REVISION) +* Definite Clause Grammars * Attributed variables using the SICStus Prolog interface and semantics. Adding coroutines like `dif/2`, `freeze/2`, etc. is straightforward with attributed variables. diff --git a/src/main.rs b/src/main.rs index 7bae9750..c4c749fe 100644 --- a/src/main.rs +++ b/src/main.rs @@ -5,16 +5,13 @@ extern crate termion; mod prolog; use prolog::ast::*; +use prolog::compile::*; use prolog::io::*; use prolog::machine::*; #[cfg(test)] mod tests; -pub static LISTS: &str = include_str!("./prolog/lib/lists.pl"); -pub static CONTROL: &str = include_str!("./prolog/lib/control.pl"); -pub static QUEUES: &str = include_str!("./prolog/lib/queues.pl"); - fn parse_and_compile_line(wam: &mut Machine, buffer: &str) { match parse_code(wam, buffer) { @@ -29,11 +26,6 @@ fn parse_and_compile_line(wam: &mut Machine, buffer: &str) 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, CONTROL); - // load_init_str(&mut wam, QUEUES); - loop { print!("prolog> "); diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index 47e1b11d..c5f24cb4 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -1,4 +1,3 @@ -use prolog::builtins::*; use prolog::num::bigint::BigInt; use prolog::num::{Float, ToPrimitive, Zero}; use prolog::num::rational::Ratio; @@ -161,6 +160,19 @@ pub struct Module { pub op_dir: OpDir } +pub fn default_op_dir() -> OpDir { + let module_name = clause_name!("builtins"); + let mut op_dir = OpDir::new(); + + 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 +} + +pub static BUILTINS: &str = include_str!("./lib/builtins.pl"); + impl Module { pub fn new(module_decl: ModuleDecl) -> Self { Module { module_decl, @@ -468,7 +480,7 @@ pub enum ParserError { Arithmetic(ArithmeticError), BackQuotedString, - BuiltInArityMismatch(&'static str), + // BuiltInArityMismatch(&'static str), UnexpectedChar(char), UnexpectedEOF, IO(IOError), @@ -682,6 +694,7 @@ pub enum QueryTerm { Clause(Cell, ClauseType, Vec>), BlockedCut, // a cut which is 'blocked by letters', like the P term in P -> Q. UnblockedCut(Cell), + GetLevelAndUnify(Cell, Rc), Jump(JumpStub) } @@ -690,7 +703,8 @@ impl QueryTerm { match self { &QueryTerm::Clause(_, _, ref subterms) => subterms.len(), &QueryTerm::BlockedCut | &QueryTerm::UnblockedCut(..) => 0, - &QueryTerm::Jump(ref vars) => vars.len() + &QueryTerm::Jump(ref vars) => vars.len(), + &QueryTerm::GetLevelAndUnify(..) => 1, } } } @@ -763,7 +777,7 @@ impl SystemClauseType { match (name, arity) { ("$check_cp", 1) => Some(SystemClauseType::CheckCutPoint), ("$get_scc_cleaner", 1) => Some(SystemClauseType::GetSCCCleaner), - ("$install_scc_cleaner", 1) => + ("$install_scc_cleaner", 2) => Some(SystemClauseType::InstallSCCCleaner), ("$install_inference_counter", 3) => Some(SystemClauseType::InstallInferenceCounter), @@ -940,7 +954,7 @@ impl BuiltInClauseType { ("@>", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::GreaterThan)), ("@<", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::LessThan)), ("@>=", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::GreaterThanOrEqual)), - ("@<=", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::LessThanOrEqual)), + ("@=<", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::LessThanOrEqual)), ("\\=@=", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::NotEqual)), ("=@=", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::Equal)), ("display", 1) => Some(BuiltInClauseType::Display), @@ -1040,6 +1054,7 @@ pub enum ChoiceInstruction { pub enum CutInstruction { Cut(RegType), GetLevel(RegType), + GetLevelAndUnify(RegType), NeckCut } @@ -1372,7 +1387,7 @@ pub enum ArithmeticInstruction { pub enum ControlInstruction { Allocate(usize), // num_frames. CallClause(ClauseType, usize, usize, bool), // name, arity, perm_vars after threshold, last call. - Deallocate, + Deallocate, JmpBy(usize, usize, usize, bool), // arity, global_offset, perm_vars after threshold, last call. Proceed } @@ -1481,7 +1496,7 @@ impl PartialOrd for Addr { Some(Ordering::Equal) } else { Some(Ordering::Less) - } + } }, &Addr::HeapCell(h) => match r { @@ -1635,13 +1650,6 @@ pub enum LocalCodePtr { } impl LocalCodePtr { - pub fn module_name(&self) -> ClauseName { - match self { - &LocalCodePtr::DirEntry(_, ref name) => name.clone(), - _ => ClauseName::BuiltIn("user") - } - } - pub fn assign_if_local(&mut self, cp: CodePtr) { match cp { CodePtr::Local(local) => *self = local, @@ -1690,7 +1698,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) } } diff --git a/src/prolog/builtins.rs b/src/prolog/builtins.rs deleted file mode 100644 index d3796300..00000000 --- a/src/prolog/builtins.rs +++ /dev/null @@ -1,778 +0,0 @@ -use prolog::ast::*; - -use std::collections::HashMap; - -/* -fn get_builtins() -> Code { - vec![internal_call_n!(), // callN/N, 0. - is_atomic!(temp_v!(1)), // atomic/1, 1. - proceed!(), - is_var!(temp_v!(1)), // var/1, 3. - proceed!(), - allocate!(4), // catch/3, 5. - fact![get_var_in_fact!(perm_v!(2), 1), - get_var_in_fact!(perm_v!(3), 2), - get_var_in_fact!(perm_v!(1), 3)], - query![put_var!(perm_v!(4), 1)], - get_current_block!(), - query![put_value!(perm_v!(2), 1), - put_value!(perm_v!(3), 2), - put_value!(perm_v!(1), 3), - put_unsafe_value!(4, 4)], - deallocate!(), - goto_execute!(12, 4), // goto catch/4. - try_me_else!(10), // catch/4, 12. - allocate!(3), - fact![get_var_in_fact!(perm_v!(3), 1), - get_var_in_fact!(perm_v!(2), 4)], - query![put_var!(perm_v!(1), 1)], - install_new_block!(), - query![put_value!(perm_v!(3), 1)], - call_n!(1), - query![put_value!(perm_v!(2), 1), - put_unsafe_value!(1, 2)], - deallocate!(), - goto_execute!(44, 2), //21: goto end_block/2. - default_trust_me!(), - allocate!(3), - fact![get_var_in_fact!(perm_v!(2), 2), - get_var_in_fact!(perm_v!(1), 3)], - query![get_var_in_query!(temp_v!(2), 1), - put_value!(temp_v!(4), 1)], - reset_block!(), - query![put_var!(perm_v!(3), 1)], - get_ball!(), - query![put_unsafe_value!(3, 1), - put_value!(perm_v!(2), 2), - put_value!(perm_v!(1), 3)], - deallocate!(), - goto_execute!(32, 2), // goto handle_ball/2. - try_me_else!(10), // handle_ball/2, 32. - allocate!(2), - get_level!(perm_v!(1)), - fact![get_var_in_fact!(perm_v!(2), 3)], - unify!(), - cut!(perm_v!(1)), - erase_ball!(), - query![put_value!(perm_v!(2), 1)], - deallocate!(), - execute_n!(1), - default_trust_me!(), - unwind_stack!(), - try_me_else!(9), // end_block/2, 44. - allocate!(1), - fact![get_var_in_fact!(perm_v!(1), 1)], - query![put_value!(temp_v!(2), 1)], - clean_up_block!(), - query![put_value!(perm_v!(1), 1)], - deallocate!(), - reset_block!(), - proceed!(), - default_trust_me!(), // 53. - allocate!(0), - query![get_var_in_query!(temp_v!(3), 1), - put_value!(temp_v!(2), 1)], - reset_block!(), - deallocate!(), - goto_execute!(61, 0), - set_ball!(), // throw/1, 59. - unwind_stack!(), - fail!(), // false/0, 61. - try_me_else!(7), // not/1, 62. - allocate!(1), - get_level!(perm_v!(1)), - call_n!(1), - cut!(perm_v!(1)), - deallocate!(), - goto_execute!(61, 0), - trust_me!(), - proceed!(), - duplicate_term!(), // duplicate_term/2, 71. - proceed!(), - fact![get_value!(temp_v!(1), 2)], // =/2, 73. - proceed!(), - proceed!(), // true/0, 75. - get_cp!(temp_v!(3)), // ','/2, 76. - try_me_else!(18), // ','/3, 77. - switch_on_term!(4, 1, 0, 0), - indexed_try!(4), - retry!(7), - trust!(10), - try_me_else!(4), - fact![get_constant!(atom!("!"), temp_v!(1)), - get_structure!(",", 2, temp_v!(2), Some(infix!())), - unify_variable!(temp_v!(1)), - unify_variable!(temp_v!(2))], - set_cp!(temp_v!(3)), - goto_execute!(77, 3), - retry_me_else!(4), - fact![get_constant!(atom!("!"), temp_v!(1)), - get_constant!(atom!("!"), temp_v!(2))], - set_cp!(temp_v!(3)), - proceed!(), - trust_me!(), - fact![get_constant!(atom!("!"), temp_v!(1))], - set_cp!(temp_v!(3)), - query![put_value!(temp_v!(2), 1)], - execute_n!(1), - retry_me_else!(8), // 95. - allocate!(3), - fact![get_structure!(",", 2, temp_v!(2), Some(infix!())), - unify_variable!(perm_v!(2)), - unify_variable!(perm_v!(1)), - get_var_in_fact!(perm_v!(3), 3)], - neck_cut!(), - call_n!(1), - query![put_unsafe_value!(2, 1), - put_unsafe_value!(1, 2), - put_value!(perm_v!(3), 3)], - deallocate!(), - goto_execute!(77, 3), - retry_me_else!(10), - allocate!(2), - get_level!(perm_v!(2)), - fact![get_constant!(atom!("!"), temp_v!(2)), - get_var_in_fact!(perm_v!(1), 3)], - neck_cut!(), - call_n!(1), - query![put_value!(perm_v!(1), 1)], - set_cp!(temp_v!(1)), - deallocate!(), - proceed!(), - trust_me!(), - allocate!(1), - fact![get_var_in_fact!(perm_v!(1), 2)], - call_n!(1), - query![put_value!(perm_v!(1), 1)], - deallocate!(), - execute_n!(1), - get_cp!(temp_v!(3)), // ';'/2, 120. - try_me_else!(16), // ';'/3, 121. - switch_on_term!(0, 12, 0, 1), // Fail on variable input. - indexed_try!(2), - trust!(5), - fact![get_structure!("->", 2, temp_v!(1), Some(infix!())), - unify_variable!(temp_v!(1)), - unify_variable!(temp_v!(4))], - query![put_value!(temp_v!(4), 2)], - goto_execute!(147, 3), // goto '->'/3. - retry_me_else!(5), - fact![get_structure!("->", 2, temp_v!(1), Some(infix!())), - unify_void!(2)], - set_cp!(temp_v!(3)), - query![put_value!(temp_v!(2), 1)], - execute_n!(1), - retry_me_else!(4), - fact![get_constant!(atom!("!"), temp_v!(1))], - set_cp!(temp_v!(3)), - proceed!(), - retry_me_else!(4), - fact![get_constant!(atom!("!"), temp_v!(2))], - set_cp!(temp_v!(3)), - proceed!(), - retry_me_else!(2), - execute_n!(1), - trust_me!(), - query![put_value!(temp_v!(2), 1)], - execute_n!(1), - get_cp!(temp_v!(3)), // '->'/2, 146. - try_me_else!(7), // '->'/3, 147. - allocate!(1), - fact![get_constant!(atom!("!"), temp_v!(2)), - get_var_in_fact!(perm_v!(1), 3)], - call_n!(1), - set_cp!(perm_v!(1)), - deallocate!(), - proceed!(), - trust_me!(), - allocate!(2), - fact![get_var_in_fact!(perm_v!(1), 2), - get_var_in_fact!(perm_v!(2), 3)], - call_n!(1), - set_cp!(perm_v!(2)), - query![put_unsafe_value!(1, 1)], - deallocate!(), - execute_n!(1), - functor_execute!(), // functor/3, 162. - is_integer!(temp_v!(1)), // integer/1, 163. - proceed!(), - get_arg_execute!(), // get_arg/3, 165. - try_me_else!(10), // arg/3, 166. - allocate!(4), - fact![get_var_in_fact!(perm_v!(1), 1), - get_var_in_fact!(perm_v!(2), 2), - get_var_in_fact!(perm_v!(4), 3)], - is_var!(perm_v!(1)), - neck_cut!(), - query![put_value!(perm_v!(2), 1), - put_var!(temp_v!(4), 2), - put_var!(perm_v!(3), 3)], - functor_call!(), - query![put_value!(perm_v!(1), 1), - put_constant!(Level::Shallow, integer!(1), temp_v!(2)), - put_unsafe_value!(3, 3), - put_value!(perm_v!(2), 4), - put_value!(perm_v!(4), 5)], - deallocate!(), - goto_execute!(189, 5), // goto arg_/5, 175. - retry_me_else!(10), - allocate!(3), - fact![get_var_in_fact!(perm_v!(1), 1), - get_var_in_fact!(perm_v!(2), 2), - get_var_in_fact!(perm_v!(3), 3)], - is_integer!(perm_v!(1)), - neck_cut!(), - query![put_value!(perm_v!(2), 1), - put_var!(temp_v!(4), 2), - put_var!(temp_v!(3), 3)], - functor_call!(), - query![put_value!(perm_v!(1), 1), - put_value!(perm_v!(2), 2), - put_value!(perm_v!(3), 3)], - deallocate!(), - goto_execute!(165, 3), // goto get_arg/3, 185. - trust_me!(), - query![get_var_in_query!(temp_v!(4), 1), - put_structure!("type_error", 2, temp_v!(2), None), - set_constant!(atom!(ValidType::Integer.as_str())), - set_value!(temp_v!(4)), - put_structure!("error", 2, temp_v!(1), None), - set_value!(temp_v!(2)), - set_void!(1)], - goto_execute!(59, 1), // goto throw/1. - try_me_else!(5), // arg_/5, 189. - fact![get_value!(temp_v!(1), 2), - get_value!(temp_v!(1), 3)], - neck_cut!(), - query![put_value!(temp_v!(4), 2), - put_value!(temp_v!(5), 3)], - goto_execute!(165, 3), // goto get_arg/3. - retry_me_else!(4), - fact![get_value!(temp_v!(1), 2)], - query![put_value!(temp_v!(4), 2), - get_var_in_query!(temp_v!(6), 3), - put_value!(temp_v!(5), 3)], - goto_execute!(165, 3), // goto get_arg/3, 197. - trust_me!(), - allocate!(5), - fact![get_var_in_fact!(perm_v!(2), 1), - get_var_in_fact!(perm_v!(4), 3), - get_var_in_fact!(perm_v!(3), 4), - get_var_in_fact!(perm_v!(5), 5)], - compare_number_instr!(CompareNumberQT::LessThan, - ArithmeticTerm::Reg(temp_v!(2)), - ArithmeticTerm::Reg(perm_v!(4))), - add!(ArithmeticTerm::Reg(temp_v!(2)), - ArithmeticTerm::Number(rc_integer!(1)), - 1), - query![put_var!(perm_v!(1), 1)], - is_call!(perm_v!(1), interm!(1)), - query![put_value!(perm_v!(2), 1), - put_unsafe_value!(1, 2), - put_value!(perm_v!(4), 3), - put_value!(perm_v!(3), 4), - put_value!(perm_v!(5), 5)], - deallocate!(), - goto_execute!(189, 5), // goto arg_/5, 207. - display!(), // display/1, 208. - proceed!(), - dynamic_is!(), // is/2, 210. - proceed!(), - dynamic_num_test!(cmp_gt!()), // >/2, 212. - proceed!(), - dynamic_num_test!(cmp_lt!()), // =/2, 216. - proceed!(), - dynamic_num_test!(cmp_lte!()), // ==)/2, 403. - compare_term_execute!(term_cmp_lte!()), // (@=<)/2, 404. - compare_term_execute!(term_cmp_gt!()), // (@>)/2, 405. - compare_term_execute!(term_cmp_lt!()), // (@<)/2, 406. - compare_term_execute!(term_cmp_eq!()), // (=@=)/2, 407. - compare_term_execute!(term_cmp_ne!()), // (\=@=)/2, 408. - allocate!(5), // call_with_inference_limit/3, 409. - fact![get_var_in_fact!(perm_v!(4), 1), - get_var_in_fact!(perm_v!(3), 2), - get_var_in_fact!(perm_v!(2), 3)], - query![put_var!(perm_v!(5), 1)], - get_current_block!(), - get_cp!(perm_v!(1)), - query![put_value!(perm_v!(4), 1), - put_value!(perm_v!(3), 2), - put_value!(perm_v!(2), 3), - put_value!(perm_v!(5), 4), - put_value!(perm_v!(1), 5)], - goto_call!(420, 5), // goto call_with_inference_limit/5, 415 - query![put_value!(perm_v!(1), 1)], - deallocate!(), - remove_call_policy_check!(), - proceed!(), - try_me_else!(19), // call_with_inference_limit/5, 420. - allocate!(9), - fact![get_var_in_fact!(perm_v!(9), 1), - get_var_in_fact!(perm_v!(5), 2), - get_var_in_fact!(perm_v!(8), 3), - get_var_in_fact!(perm_v!(3), 4), - get_var_in_fact!(perm_v!(4), 5)], - query![put_var!(perm_v!(1), 1)], - install_new_block!(), - query![put_var!(perm_v!(7), 3)], - install_inference_counter!(perm_v!(4), perm_v!(5), perm_v!(7)), - query![put_value!(perm_v!(9), 1)], - call_n!(1), - inference_level!(perm_v!(8), perm_v!(4)), - query![put_var!(perm_v!(6), 2)], - remove_inference_counter!(perm_v!(4), perm_v!(6)), - sub!(ArithmeticTerm::Reg(perm_v!(6)), - ArithmeticTerm::Reg(perm_v!(7)), - 1), - sub!(ArithmeticTerm::Reg(perm_v!(5)), - ArithmeticTerm::Interm(1), - 1), - query![put_var!(perm_v!(2), 1)], - is_call!(temp_v!(1), ArithmeticTerm::Interm(1)), - query![put_value!(perm_v!(4), 1), - put_value!(perm_v!(3), 2), - put_value!(perm_v!(1), 3), - put_value!(perm_v!(2), 4)], - deallocate!(), - goto_execute!(468, 4), // goto end_block/4, 468 - default_trust_me!(), // 439 - allocate!(3), - fact![get_var_in_fact!(perm_v!(1), 3), - get_var_in_fact!(perm_v!(3), 5)], - query![put_value!(temp_v!(4), 1)], - reset_block!(), - query![put_var!(temp_v!(3), 2)], - remove_inference_counter!(perm_v!(3), temp_v!(2)), - query![put_value!(perm_v!(3), 1), - put_var!(perm_v!(2), 2)], - jmp_call!(2, 5, 0), - erase_ball!(), - query![put_value!(perm_v!(3), 1), - put_unsafe_value!(2, 2), - put_value!(perm_v!(1), 3)], - deallocate!(), - goto_execute!(460, 3), // goto handle_ile/3, 451. - try_me_else!(5), // the inner clause. - query![put_value!(temp_v!(2), 1)], - get_ball!(), - neck_cut!(), - proceed!(), - default_trust_me!(), - remove_call_policy_check!(), - fail!(), - try_me_else!(4), // handle_ile/3, 460. - fact![get_structure!("inference_limit_exceeded", 1, temp_v!(2), None), - unify_value!(temp_v!(1)), - get_constant!(atom!("inference_limit_exceeded"), temp_v!(3))], - neck_cut!(), - proceed!(), - default_trust_me!(), - remove_call_policy_check!(), - query![put_value!(temp_v!(2), 1)], - goto_execute!(59, 1), // goto throw/1, 59. - try_me_else!(6), // end_block/4, 468. - query![put_value!(temp_v!(3), 1)], - clean_up_block!(), - query![put_value!(temp_v!(2), 1)], - reset_block!(), - proceed!(), - default_trust_me!(), - query![get_var_in_query!(temp_v!(5), 3), - put_value!(temp_v!(4), 2), - put_var!(temp_v!(6), 3)], - install_inference_counter!(temp_v!(1), temp_v!(4), temp_v!(6)), - query![put_value!(temp_v!(5), 1)], - reset_block!(), - fail!(), - compare_execute!(), // compare/3, 480. - is_atom!(temp_v!(1)), // atom/1, 481. - proceed!(), - sort_execute!(), // sort/2, 483. - keysort_execute!(), // keysort/2, 484. - acyclic_term_execute!(), // acyclic_term/1, 485. - cyclic_term_execute!(), // cyclic_term/1, 486. - ] -} */ - -pub fn default_op_dir() -> OpDir -{ - let mut op_dir = HashMap::new(); - let module_name = clause_name!("builtins"); - - 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())); - -/* - // control operators. - op_dir.insert((clause_name!("\\+"), Fixity::Pre), (FY, 900, builtin.clone())); - op_dir.insert((clause_name!("="), Fixity::In), (XFX, 700, builtin.clone())); - - // arithmetic operators. - op_dir.insert((clause_name!("is"), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("+"), Fixity::In), (YFX, 500, builtin.clone())); - op_dir.insert((clause_name!("-"), Fixity::In), (YFX, 500, builtin.clone())); - op_dir.insert((clause_name!("/\\"), Fixity::In), (YFX, 500, builtin.clone())); - op_dir.insert((clause_name!("\\/"), Fixity::In), (YFX, 500, builtin.clone())); - op_dir.insert((clause_name!("xor"), Fixity::In), (YFX, 500, builtin.clone())); - op_dir.insert((clause_name!("//"), Fixity::In), (YFX, 400, builtin.clone())); - op_dir.insert((clause_name!("div"), Fixity::In), (YFX, 400, builtin.clone())); - op_dir.insert((clause_name!("*"), Fixity::In), (YFX, 400, builtin.clone())); - op_dir.insert((clause_name!("-"), Fixity::Pre), (FY, 200, builtin.clone())); - op_dir.insert((clause_name!("rdiv"), Fixity::In), (YFX, 400, builtin.clone())); - op_dir.insert((clause_name!("<<"), Fixity::In), (YFX, 400, builtin.clone())); - op_dir.insert((clause_name!(">>"), Fixity::In), (YFX, 400, builtin.clone())); - op_dir.insert((clause_name!("mod"), Fixity::In), (YFX, 400, builtin.clone())); - op_dir.insert((clause_name!("rem"), Fixity::In), (YFX, 400, builtin.clone())); - - // arithmetic comparison operators. - op_dir.insert((clause_name!(">"), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("<"), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("=\\="), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("=:="), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!(">="), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("=<"), Fixity::In), (XFX, 700, builtin.clone())); - - // control operators. - op_dir.insert((clause_name!(";"), Fixity::In), (XFY, 1100, builtin.clone())); - op_dir.insert((clause_name!("->"), Fixity::In), (XFY, 1050, builtin.clone())); - - op_dir.insert((clause_name!("=.."), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("=="), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("\\=="), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("@=<"), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("@>="), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("@<"), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("@>"), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("=@="), Fixity::In), (XFX, 700, builtin.clone())); - op_dir.insert((clause_name!("\\=@="), Fixity::In), (XFX, 700, builtin.clone())); - - // there are 63 registers in the VM, so call/N is defined for all 0 <= N <= 62 - // (an extra register is needed for the predicate name) - for arity in 0 .. 63 { - code_dir.insert((clause_name!("call"), arity), CodeIndex::from((0, builtin.clone()))); - } - - code_dir.insert((clause_name!("atomic"), 1), CodeIndex::from((1, builtin.clone()))); - code_dir.insert((clause_name!("var"), 1), CodeIndex::from((3, builtin.clone()))); - code_dir.insert((clause_name!("false"), 0), CodeIndex::from((61, builtin.clone()))); - code_dir.insert((clause_name!("\\+"), 1), CodeIndex::from((62, builtin.clone()))); - code_dir.insert((clause_name!("duplicate_term"), 2), CodeIndex::from((71, builtin.clone()))); - code_dir.insert((clause_name!("catch"), 3), CodeIndex::from((5, builtin.clone()))); - code_dir.insert((clause_name!("throw"), 1), CodeIndex::from((59, builtin.clone()))); - code_dir.insert((clause_name!("="), 2), CodeIndex::from((73, builtin.clone()))); - code_dir.insert((clause_name!("true"), 0), CodeIndex::from((75, builtin.clone()))); - - code_dir.insert((clause_name!(","), 2), CodeIndex::from((76, builtin.clone()))); - code_dir.insert((clause_name!(";"), 2), CodeIndex::from((120, builtin.clone()))); - code_dir.insert((clause_name!("->"), 2), CodeIndex::from((146, builtin.clone()))); - - code_dir.insert((clause_name!("functor"), 3), CodeIndex::from((162, builtin.clone()))); - code_dir.insert((clause_name!("arg"), 3), CodeIndex::from((166, builtin.clone()))); - code_dir.insert((clause_name!("integer"), 1), CodeIndex::from((163, builtin.clone()))); - code_dir.insert((clause_name!("display"), 1), CodeIndex::from((208, builtin.clone()))); - - //code_dir.insert((clause_name!("is"), 2), CodeIndex::from((210, builtin.clone()))); - code_dir.insert((clause_name!(">"), 2), CodeIndex::from((212, builtin.clone()))); - code_dir.insert((clause_name!("<"), 2), CodeIndex::from((214, builtin.clone()))); - code_dir.insert((clause_name!(">="), 2), CodeIndex::from((216, builtin.clone()))); - code_dir.insert((clause_name!("=<"), 2), CodeIndex::from((218, builtin.clone()))); - code_dir.insert((clause_name!("=\\="), 2), CodeIndex::from((220, builtin.clone()))); - code_dir.insert((clause_name!("=:="), 2), CodeIndex::from((222, builtin.clone()))); - code_dir.insert((clause_name!("=.."), 2), CodeIndex::from((224, builtin.clone()))); - - code_dir.insert((clause_name!("length"), 2), CodeIndex::from((277, builtin.clone()))); - code_dir.insert((clause_name!("setup_call_cleanup"), 3), - CodeIndex::from((310, builtin.clone()))); - code_dir.insert((clause_name!("call_with_inference_limit"), 3), - CodeIndex::from((409, builtin.clone()))); - - code_dir.insert((clause_name!("compound"), 1), CodeIndex::from((388, builtin.clone()))); - code_dir.insert((clause_name!("rational"), 1), CodeIndex::from((390, builtin.clone()))); - code_dir.insert((clause_name!("string"), 1), CodeIndex::from((392, builtin.clone()))); - code_dir.insert((clause_name!("float"), 1), CodeIndex::from((394, builtin.clone()))); - code_dir.insert((clause_name!("nonvar"), 1), CodeIndex::from((396, builtin.clone()))); - - code_dir.insert((clause_name!("ground"), 1), CodeIndex::from((400, builtin.clone()))); - code_dir.insert((clause_name!("=="), 2), CodeIndex::from((401, builtin.clone()))); - code_dir.insert((clause_name!("\\=="), 2), CodeIndex::from((402, builtin.clone()))); - code_dir.insert((clause_name!("@>="), 2), CodeIndex::from((403, builtin.clone()))); - code_dir.insert((clause_name!("@=<"), 2), CodeIndex::from((404, builtin.clone()))); - code_dir.insert((clause_name!("@>"), 2), CodeIndex::from((405, builtin.clone()))); - code_dir.insert((clause_name!("@<"), 2), CodeIndex::from((406, builtin.clone()))); - code_dir.insert((clause_name!("=@="), 2), CodeIndex::from((407, builtin.clone()))); - code_dir.insert((clause_name!("\\=@="), 2), CodeIndex::from((408, builtin.clone()))); - code_dir.insert((clause_name!("compare"), 3), CodeIndex::from((480, builtin.clone()))); - code_dir.insert((clause_name!("atom"), 1), CodeIndex::from((481, builtin.clone()))); - - (code_dir, op_dir) - */ - op_dir -} - -/* -pub fn default_build() -> (Code, CodeDir, OpDir) -{ - let builtin_code = get_builtins(); - let (code_dir, op_dir) = build_code_and_op_dirs(); - - (builtin_code, code_dir, op_dir) -} -*/ diff --git a/src/prolog/codegen.rs b/src/prolog/codegen.rs index 1b1703e8..274b557d 100644 --- a/src/prolog/codegen.rs +++ b/src/prolog/codegen.rs @@ -404,6 +404,19 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator }; match *term { + &QueryTerm::GetLevelAndUnify(ref cell, ref var) => { + let mut target = Vec::new(); + + self.marker.reset_arg(1); + self.marker.mark_var(var.clone(), Level::Shallow, cell, + term_loc, &mut target); + + if !target.is_empty() { + code.push(Line::Query(target)); + } + + code.push(get_level_and_unify!(cell.get().norm())); + }, &QueryTerm::UnblockedCut(ref cell) => code.push(set_cp!(cell.get().norm())), &QueryTerm::BlockedCut => diff --git a/src/prolog/compile.rs b/src/prolog/compile.rs new file mode 100644 index 00000000..38900c3c --- /dev/null +++ b/src/prolog/compile.rs @@ -0,0 +1,317 @@ +use prolog::ast::*; +use prolog::debray_allocator::*; +use prolog::codegen::*; +use prolog::machine::*; +use prolog::toplevel::*; + +#[allow(dead_code)] +fn print_code(code: &Code) { + for clause in code { + match clause { + &Line::Arithmetic(ref arith) => + println!("{}", arith), + &Line::Fact(ref fact) => + for fact_instr in fact { + println!("{}", fact_instr); + }, + &Line::Cut(ref cut) => + println!("{}", cut), + &Line::Choice(ref choice) => + println!("{}", choice), + &Line::Control(ref control) => + println!("{}", control), + &Line::IndexedChoice(ref choice) => + println!("{}", choice), + &Line::Indexing(ref indexing) => + println!("{}", indexing), + &Line::Query(ref query) => + for query_instr in query { + println!("{}", query_instr); + } + } + } +} + +pub(crate) trait TLInfo { + fn update_entry_index(&self, &ClauseName, usize, CodeIndex, &mut CodeIndex, usize); + + // give the correct CodePtr offsets to CallClause's whose types are + // Named and Op. Enable late binding by setting to the default. + fn label_clauses(&self, code_size: usize, code_dir: &mut CodeDir, code: &mut Code) + { + for line in code.iter_mut() { + if let &mut Line::Control(ControlInstruction::CallClause(ref mut ct, a1, ..)) = line { + match ct { + &mut ClauseType::Named(ref n1, ref mut cp) + | &mut ClauseType::Op(ref n1, _, ref mut cp) => { + let entry = code_dir.entry((n1.clone(), a1)).or_insert(CodeIndex::default()); + self.update_entry_index(n1, a1, entry.clone(), cp, code_size); + }, + _ => {} + } + } + } + } +} + +struct DeclInfo { name: ClauseName, arity: usize, module_name: ClauseName } + +impl TLInfo for DeclInfo { + fn update_entry_index(&self, n1: &ClauseName, a1: usize, entry: CodeIndex, + cp: &mut CodeIndex, code_size: usize) + { + let (name, arity) = (self.name.clone(), self.arity); + + { + let mut entry = entry.0.borrow_mut(); + + if entry.0 == IndexPtr::Undefined { + if &name == n1 && arity == a1 { + entry.0 = IndexPtr::Index(code_size); + } + } + + entry.1 = self.module_name.clone(); + } + + *cp = entry; + } +} + +struct QueryInfo {} + +impl TLInfo for QueryInfo { + fn update_entry_index(&self, _: &ClauseName, _: usize, entry: CodeIndex, + cp: &mut CodeIndex, _: usize) + { + *cp = entry; + } +} + +pub fn parse_code(wam: &Machine, buffer: &str) -> Result +{ + let mut worker = TopLevelWorker::new(buffer.as_bytes(), wam.atom_tbl()); + worker.parse_code(&wam.op_dir) +} + +// throw errors if declaration or query found. +fn compile_relation(tl: &TopLevel) -> Result +{ + let mut cg = CodeGenerator::::new(); + + match tl { + &TopLevel::Declaration(_) | &TopLevel::Query(_) => + Err(ParserError::ExpectedRel), + &TopLevel::Predicate(ref clauses) => + cg.compile_predicate(&clauses.0), + &TopLevel::Fact(ref fact) => + Ok(cg.compile_fact(fact)), + &TopLevel::Rule(ref rule) => + cg.compile_rule(rule) + } +} + +// set first jmp_by_call or jmp_by_index instruction to code.len() - +// idx, where idx is the place it occurs. It only does this to the +// *first* uninitialized jmp index it encounters, then returns. +fn set_first_index(code: &mut Code) +{ + let code_len = code.len(); + + for (idx, line) in code.iter_mut().enumerate() { + match line { + &mut Line::Control(ControlInstruction::JmpBy(_, ref mut offset, ..)) if *offset == 0 => { + *offset = code_len - idx; + break; + }, + _ => {} + }; + } +} + +fn compile_appendix(code: &mut Code, queue: Vec) -> Result<(), ParserError> +{ + for tl in queue.iter() { + set_first_index(code); + code.append(&mut compile_relation(tl)?); + } + + Ok(()) +} + +fn compile_query(terms: Vec, queue: Vec, code_size: usize, + code_dir: &mut CodeDir) + -> Result<(Code, AllocVarDict), ParserError> +{ + let mut cg = CodeGenerator::::new(); + let mut code = try!(cg.compile_query(&terms)); + + compile_appendix(&mut code, queue)?; + + let query_info = QueryInfo {}; + query_info.label_clauses(code_size, code_dir, &mut code); + + Ok((code, cg.take_vars())) +} + +fn compile_decl(wam: &mut Machine, tl: TopLevel, queue: Vec) -> EvalSession +{ + match tl { + TopLevel::Declaration(Declaration::Op(op_decl)) => { + try_eval_session!(op_decl.submit(clause_name!("user"), &mut wam.op_dir)); + EvalSession::EntrySuccess + }, + TopLevel::Declaration(Declaration::UseModule(name)) => + wam.use_module_in_toplevel(name), + TopLevel::Declaration(Declaration::UseQualifiedModule(name, exports)) => + wam.use_qualified_module_in_toplevel(name, exports), + TopLevel::Declaration(_) => + EvalSession::from(ParserError::InvalidModuleDecl), + _ => { + let name = try_eval_session!(if let Some(name) = tl.name() { + Ok(name) + } else { + Err(SessionError::NamelessEntry) + }); + + let mut code = try_eval_session!(compile_relation(&tl)); + try_eval_session!(compile_appendix(&mut code, queue)); + + let decl_info = DeclInfo { name: name.clone(), arity: tl.arity(), + module_name: clause_name!("user") }; + + decl_info.label_clauses(wam.code_size(), &mut wam.code_dir, &mut code); + + if !code.is_empty() { + wam.add_user_code(name, tl.arity(), code, tl.as_predicate().ok().unwrap()) + } else { + EvalSession::from(SessionError::ImpermissibleEntry(String::from("no code generated."))) + } + } + } +} + +pub fn compile_packet(wam: &mut Machine, tl: TopLevelPacket) -> EvalSession +{ + match tl { + TopLevelPacket::Query(terms, queue) => + match compile_query(terms, queue, wam.code_size(), &mut wam.code_dir) { + Ok((mut code, vars)) => wam.submit_query(code, vars), + Err(e) => EvalSession::from(e) + }, + TopLevelPacket::Decl(tl, queue) => + compile_decl(wam, tl, queue) + } +} + +pub fn compile_listing(wam: &mut Machine, src_str: &str) -> EvalSession +{ + fn get_module_name(module: &Option) -> ClauseName { + match module { + &Some(ref module) => module.module_decl.name.clone(), + _ => ClauseName::BuiltIn("user") + } + } + + let mut module: Option = None; + + let mut code_dir = CodeDir::new(); + let mut op_dir = default_op_dir(); + + let mut code = Vec::new(); + + let mut worker = TopLevelWorker::new(src_str.as_bytes(), wam.atom_tbl()); + + let tls = { + let indices = MachineCodeIndex { code_dir: &mut code_dir, + op_dir: &mut op_dir }; + + try_eval_session!(worker.parse_batch(&wam, indices)) + }; + + for tl in tls { + match tl { + TopLevelPacket::Query(..) => + return EvalSession::from(ParserError::ExpectedRel), + TopLevelPacket::Decl(TopLevel::Declaration(Declaration::Module(module_decl)), _) => + if module.is_none() { + module = Some(Module::new(module_decl)); + } else { + return EvalSession::from(ParserError::InvalidModuleDecl); + }, + TopLevelPacket::Decl(TopLevel::Declaration(Declaration::UseModule(name)), _) => { + if let Some(ref submodule) = wam.get_module(name.clone()) { + if let Some(ref mut module) = module { + let mut code_index = machine_code_index!(&mut code_dir, &mut op_dir); + + module.use_module(submodule); + code_index.use_module(submodule); + + continue; + } + } else { + return EvalSession::from(SessionError::ModuleNotFound); + } + + wam.use_module_in_toplevel(name); + }, + TopLevelPacket::Decl(TopLevel::Declaration(Declaration::UseQualifiedModule(name, exports)), _) + => + { + if let Some(ref submodule) = wam.get_module(name.clone()) { + if let Some(ref mut module) = module { + let mut code_index = machine_code_index!(&mut code_dir, &mut op_dir); + + module.use_qualified_module(submodule, &exports); + code_index.use_qualified_module(submodule, &exports); + + continue; + } + } else { + return EvalSession::from(SessionError::ModuleNotFound); + } + + wam.use_qualified_module_in_toplevel(name, exports); + }, + TopLevelPacket::Decl(TopLevel::Declaration(Declaration::Op(..)), _) => {}, + TopLevelPacket::Decl(decl, queue) => { + let p = code.len() + wam.code_size(); + let mut decl_code = try_eval_session!(compile_relation(&decl)); + + try_eval_session!(compile_appendix(&mut decl_code, queue)); + + let name = try_eval_session!(if let Some(name) = decl.name() { + Ok(name) + } else { + Err(SessionError::NamelessEntry) + }); + + let module_name = get_module_name(&module); + let decl_info = DeclInfo { name, arity: decl.arity(), + module_name: module_name.clone() }; + + { + let idx = code_dir.entry((decl_info.name.clone(), decl_info.arity)) + .or_insert(CodeIndex::default()); + + set_code_index!(idx, IndexPtr::Index(p), module_name); + } + + decl_info.label_clauses(p, &mut code_dir, &mut decl_code); + code.extend(decl_code.into_iter()); + } + } + } + + if let Some(mut module) = module { + module.code_dir.extend(as_module_code_dir(code_dir)); + module.op_dir.extend(op_dir.into_iter()); + + wam.add_module(module, code); + } else { + wam.add_batched_code(code, code_dir); + wam.add_batched_ops(op_dir); + } + + EvalSession::EntrySuccess +} diff --git a/src/prolog/heap_print.rs b/src/prolog/heap_print.rs index caa1b7b5..4ce563ea 100644 --- a/src/prolog/heap_print.rs +++ b/src/prolog/heap_print.rs @@ -17,7 +17,7 @@ pub enum TokenOrRedirect { OpenList(Rc>), CloseList(Rc>), HeadTailSeparator, - Space +// Space } pub trait HCValueFormatter { @@ -283,8 +283,8 @@ impl<'a, Formatter: HCValueFormatter, Outputter: HCValueOutputter> loop { if let Some(loc_data) = self.state_stack.pop() { match loc_data { - TokenOrRedirect::Space => - self.outputter.append(" "), +// TokenOrRedirect::Space => +// self.outputter.append(" "), TokenOrRedirect::Atom(atom) => self.outputter.append(atom.as_str()), TokenOrRedirect::Redirect => diff --git a/src/prolog/io.rs b/src/prolog/io.rs index ff6e195d..70965751 100644 --- a/src/prolog/io.rs +++ b/src/prolog/io.rs @@ -1,10 +1,6 @@ use prolog::ast::*; -use prolog::builtins::*; -use prolog::codegen::*; -use prolog::debray_allocator::*; use prolog::heap_print::*; use prolog::machine::*; -use prolog::toplevel::*; use termion::raw::IntoRawMode; use termion::input::TermRead; @@ -255,7 +251,9 @@ impl fmt::Display for CutInstruction { &CutInstruction::NeckCut => write!(f, "neck_cut"), &CutInstruction::GetLevel(r) => - write!(f, "get_level {}", r) + write!(f, "get_level {}", r), + &CutInstruction::GetLevelAndUnify(r) => + write!(f, "get_level_and_unify {}", r) } } } @@ -291,40 +289,6 @@ impl fmt::Display for RegType { } } -#[allow(dead_code)] -pub fn print_code(code: &Code) { - for clause in code { - match clause { - &Line::Arithmetic(ref arith) => - println!("{}", arith), - &Line::Fact(ref fact) => - for fact_instr in fact { - println!("{}", fact_instr); - }, - &Line::Cut(ref cut) => - println!("{}", cut), - &Line::Choice(ref choice) => - println!("{}", choice), - &Line::Control(ref control) => - println!("{}", control), - &Line::IndexedChoice(ref choice) => - println!("{}", choice), - &Line::Indexing(ref indexing) => - println!("{}", indexing), - &Line::Query(ref query) => - for query_instr in query { - println!("{}", query_instr); - } - } - } -} - -pub fn parse_code(wam: &Machine, buffer: &str) -> Result -{ - let mut worker = TopLevelWorker::new(buffer.as_bytes(), wam.atom_tbl()); - worker.parse_code(&wam.op_dir) -} - pub enum Input { Quit, Clear, @@ -364,297 +328,6 @@ pub fn read() -> Input { } } -pub(crate) trait TLInfo { - fn update_entry_index(&self, &ClauseName, usize, CodeIndex, &mut CodeIndex, usize); - - // give the correct CodePtr offsets to CallClause's whose types are - // Named and Op. Enable late binding by setting to the default. - fn label_clauses(&self, code_size: usize, code_dir: &mut CodeDir, code: &mut Code) - { - for line in code.iter_mut() { - if let &mut Line::Control(ControlInstruction::CallClause(ref mut ct, a1, ..)) = line { - match ct { - &mut ClauseType::Named(ref n1, ref mut cp) - | &mut ClauseType::Op(ref n1, _, ref mut cp) => { - let entry = code_dir.entry((n1.clone(), a1)).or_insert(CodeIndex::default()); - self.update_entry_index(n1, a1, entry.clone(), cp, code_size); - }, - _ => {} - } - } - } - } -} - -struct DeclInfo { name: ClauseName, arity: usize, module_name: ClauseName } - -impl TLInfo for DeclInfo { - fn update_entry_index(&self, n1: &ClauseName, a1: usize, entry: CodeIndex, - cp: &mut CodeIndex, code_size: usize) - { - let (name, arity) = (self.name.clone(), self.arity); - - { - let mut entry = entry.0.borrow_mut(); - - if entry.0 == IndexPtr::Undefined { - if &name == n1 && arity == a1 { - entry.0 = IndexPtr::Index(code_size); - } - } - - entry.1 = self.module_name.clone(); - } - - *cp = entry; - } -} - -struct QueryInfo {} - -impl TLInfo for QueryInfo { - fn update_entry_index(&self, _: &ClauseName, _: usize, entry: CodeIndex, - cp: &mut CodeIndex, _: usize) - { - *cp = entry; - } -} - -// throw errors if declaration or query found. -fn compile_relation(tl: &TopLevel) -> Result -{ - let mut cg = CodeGenerator::::new(); - - match tl { - &TopLevel::Declaration(_) | &TopLevel::Query(_) => - Err(ParserError::ExpectedRel), - &TopLevel::Predicate(ref clauses) => - cg.compile_predicate(&clauses.0), - &TopLevel::Fact(ref fact) => - Ok(cg.compile_fact(fact)), - &TopLevel::Rule(ref rule) => - cg.compile_rule(rule) - } -} - -// set first jmp_by_call or jmp_by_index instruction to code.len() - -// idx, where idx is the place it occurs. It only does this to the -// *first* uninitialized jmp index it encounters, then returns. -fn set_first_index(code: &mut Code) -{ - let code_len = code.len(); - - for (idx, line) in code.iter_mut().enumerate() { - match line { - &mut Line::Control(ControlInstruction::JmpBy(_, ref mut offset, ..)) if *offset == 0 => { - *offset = code_len - idx; - break; - }, - _ => {} - }; - } -} - -fn compile_appendix(code: &mut Code, queue: Vec) -> Result<(), ParserError> -{ - for tl in queue.iter() { - set_first_index(code); - code.append(&mut compile_relation(tl)?); - } - - Ok(()) -} - -fn compile_query(terms: Vec, queue: Vec, code_size: usize, - code_dir: &mut CodeDir) - -> Result<(Code, AllocVarDict), ParserError> -{ - let mut cg = CodeGenerator::::new(); - let mut code = try!(cg.compile_query(&terms)); - - compile_appendix(&mut code, queue)?; - - let query_info = QueryInfo {}; - query_info.label_clauses(code_size, code_dir, &mut code); - - Ok((code, cg.take_vars())) -} - -fn compile_decl(wam: &mut Machine, tl: TopLevel, queue: Vec) -> EvalSession -{ - match tl { - TopLevel::Declaration(Declaration::Op(op_decl)) => { - try_eval_session!(op_decl.submit(clause_name!("user"), &mut wam.op_dir)); - EvalSession::EntrySuccess - }, - TopLevel::Declaration(Declaration::UseModule(name)) => - wam.use_module_in_toplevel(name), - TopLevel::Declaration(Declaration::UseQualifiedModule(name, exports)) => - wam.use_qualified_module_in_toplevel(name, exports), - TopLevel::Declaration(_) => - EvalSession::from(ParserError::InvalidModuleDecl), - _ => { - let name = try_eval_session!(if let Some(name) = tl.name() { - Ok(name) - } else { - Err(SessionError::NamelessEntry) - }); - - let mut code = try_eval_session!(compile_relation(&tl)); - try_eval_session!(compile_appendix(&mut code, queue)); - - let decl_info = DeclInfo { name: name.clone(), arity: tl.arity(), - module_name: clause_name!("user") }; - - decl_info.label_clauses(wam.code_size(), &mut wam.code_dir, &mut code); - - if !code.is_empty() { - wam.add_user_code(name, tl.arity(), code, tl.as_predicate().ok().unwrap()) - } else { - EvalSession::from(SessionError::ImpermissibleEntry(String::from("no code generated."))) - } - } - } -} - -pub fn compile_packet(wam: &mut Machine, tl: TopLevelPacket) -> EvalSession -{ - match tl { - TopLevelPacket::Query(terms, queue) => - match compile_query(terms, queue, wam.code_size(), &mut wam.code_dir) { - Ok((mut code, vars)) => wam.submit_query(code, vars), - Err(e) => EvalSession::from(e) - }, - TopLevelPacket::Decl(tl, queue) => - compile_decl(wam, tl, queue) - } -} - -pub static BUILTINS: &str = include_str!("./lib/builtins.pl"); - -pub fn load_init_str(wam: &mut Machine, src_str: &str) -{ - match compile_listing(wam, src_str) { - EvalSession::Error(_) => panic!("failed to parse batch from string."), - _ => {} - } -} - -pub fn load_init_str_and_include(wam: &mut Machine, src_str: &str, module: &'static str) -{ - load_init_str(wam, src_str); - wam.use_module_in_toplevel(clause_name!(module)); -} - -pub fn compile_listing(wam: &mut Machine, src_str: &str) -> EvalSession -{ - fn get_module_name(module: &Option) -> ClauseName { - match module { - &Some(ref module) => module.module_decl.name.clone(), - _ => ClauseName::BuiltIn("user") - } - } - - let mut module: Option = None; - - let mut code_dir = CodeDir::new(); - let mut op_dir = default_op_dir(); - - let mut code = Vec::new(); - - let mut worker = TopLevelWorker::new(src_str.as_bytes(), wam.atom_tbl()); - let tls = try_eval_session!(worker.parse_batch(&mut op_dir)); - - for tl in tls { - match tl { - TopLevelPacket::Query(..) => - return EvalSession::from(ParserError::ExpectedRel), - TopLevelPacket::Decl(TopLevel::Declaration(Declaration::Module(module_decl)), _) => - if module.is_none() { - // let builtin_op_dir = default_module_setup(module_decl.name.clone()); - - // code_dir.extend(builtin_code_dir.into_iter()); - // op_dir.extend(builtin_op_dir.into_iter()); - - module = Some(Module::new(module_decl)); - } else { - return EvalSession::from(ParserError::InvalidModuleDecl); - }, - TopLevelPacket::Decl(TopLevel::Declaration(Declaration::UseModule(name)), _) => { - if let Some(ref submodule) = wam.get_module(name.clone()) { - if let Some(ref mut module) = module { - let mut code_index = machine_code_index!(&mut code_dir, &mut op_dir); - - module.use_module(submodule); - code_index.use_module(submodule); - - continue; - } - } else { - return EvalSession::from(SessionError::ModuleNotFound); - } - - wam.use_module_in_toplevel(name); - }, - TopLevelPacket::Decl(TopLevel::Declaration(Declaration::UseQualifiedModule(name, exports)), _) => { - if let Some(ref submodule) = wam.get_module(name.clone()) { - if let Some(ref mut module) = module { - let mut code_index = machine_code_index!(&mut code_dir, &mut op_dir); - - module.use_qualified_module(submodule, &exports); - code_index.use_qualified_module(submodule, &exports); - - continue; - } - } else { - return EvalSession::from(SessionError::ModuleNotFound); - } - - wam.use_qualified_module_in_toplevel(name, exports); - }, - TopLevelPacket::Decl(TopLevel::Declaration(Declaration::Op(..)), _) => {}, - TopLevelPacket::Decl(decl, queue) => { - let p = code.len() + wam.code_size(); - let mut decl_code = try_eval_session!(compile_relation(&decl)); - - try_eval_session!(compile_appendix(&mut decl_code, queue)); - - let name = try_eval_session!(if let Some(name) = decl.name() { - Ok(name) - } else { - Err(SessionError::NamelessEntry) - }); - - let module_name = get_module_name(&module); - let decl_info = DeclInfo { name, arity: decl.arity(), - module_name: module_name.clone() }; - - { - let idx = code_dir.entry((decl_info.name.clone(), decl_info.arity)) - .or_insert(CodeIndex::default()); - - set_code_index!(idx, IndexPtr::Index(p), module_name); - } - - decl_info.label_clauses(p, &mut code_dir, &mut decl_code); - code.extend(decl_code.into_iter()); - } - } - } - - if let Some(mut module) = module { - module.code_dir.extend(as_module_code_dir(code_dir)); - module.op_dir.extend(op_dir.into_iter()); - - wam.add_module(module, code); - } else { - wam.add_batched_code(code, code_dir); - wam.add_batched_ops(op_dir); - } - - EvalSession::EntrySuccess -} - fn error_string(e: &String) -> String { format!("error: exception thrown: {}", e) } diff --git a/src/prolog/iterators.rs b/src/prolog/iterators.rs index 5ce7f36e..c887b4d8 100644 --- a/src/prolog/iterators.rs +++ b/src/prolog/iterators.rs @@ -57,6 +57,10 @@ impl<'a> QueryIterator<'a> { let state = TermIterState::Var(Level::Root, cell, rc_atom!("!")); QueryIterator { state_stack: vec![state] } }, + &QueryTerm::GetLevelAndUnify(ref cell, ref var) => { + let state = TermIterState::Var(Level::Root, cell, var.clone()); + QueryIterator { state_stack: vec![state] } + }, &QueryTerm::Jump(ref vars) => { let state_stack = vars.iter().rev().map(|t| { TermIterState::subterm_to_state(Level::Shallow, t) @@ -337,6 +341,11 @@ impl<'a> ChunkedIterator<'a> self.deep_cut_encountered = true; } }, + ChunkedTerm::BodyTerm(&QueryTerm::GetLevelAndUnify(..)) => { + result.push(term); + arity = 1; + break; + }, ChunkedTerm::BodyTerm(&QueryTerm::UnblockedCut(..)) => result.push(term), ChunkedTerm::BodyTerm(&QueryTerm::Clause(_, ClauseType::Inlined(_), _)) => diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index 9531d7ab..a53664b7 100644 --- a/src/prolog/lib/builtins.pl +++ b/src/prolog/lib/builtins.pl @@ -4,7 +4,8 @@ (\/)/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, (;)/2, (=..)/2, (==)/2, - (\==)/2, catch/3, throw/1, true/0, false/0, length/2]). + (\==)/2, (@=<)/2, (@>=)/2, (@<)/2, (@>)/2, (=@=)/2, (\=@=)/2, + catch/3, throw/1, true/0, false/0]). % arithmetic operators. :- op(700, xfx, is). @@ -43,6 +44,12 @@ % term comparison. :- op(700, xfx, ==). :- op(700, xfx, \==). +:- op(700, xfx, @=<). +:- op(700, xfx, @>=). +:- op(700, xfx, @<). +:- op(700, xfx, @>). +:- op(700, xfx, =@=). +:- op(700, xfx, \=@=). % the maximum arity flag. needs to be replaced with current_prolog_flag(max_arity, MAX_ARITY). max_arity(63). @@ -137,6 +144,39 @@ univ_worker(Term, List, _) :- I1 is I0 + 1, '$get_args'(Args, Func, I1, N). +% setup_call_cleanup. + +/* past work on setup_call_cleanup. + +setup_call_cleanup(S, G, C) :- + S, !, '$get_current_block'(Bb), + ( var(C) -> throw(error(instantiation_error, setup_call_cleanup/3)) + ; scc_helper(C, G, Bb) ). + +scc_helper(C, G, Bb) :- + '$get_level'(Cp), '$install_scc_cleaner'(C, NBb), call(G), + ( '$check_cp'(Cp) -> '$reset_block'(Bb), run_cleaners_without_handling(Cp) + ; true + ; '$reset_block'(NBb), '$fail'). +scc_helper(_, _, Bb) :- + '$reset_block'(Bb), '$get_ball'(Ball), + run_cleaners_with_handling, throw(Ball). +scc_helper(_, _, _) :- + run_cleaners_without_handling(Cp), false. + +run_cleaners_with_handling :- + '$get_scc_cleaner'(C), catch(C, _, true), !, + 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). +run_cleaners_without_handling(Cp) :- + '$set_cp'(Cp), '$restore_cut_policy'. + +*/ + % exceptions. catch(G,C,R) :- '$get_current_block'(Bb), catch(G,C,R,Bb). @@ -151,32 +191,3 @@ handle_ball(Ball, C, R) :- Ball = C, !, '$erase_ball', call(R). handle_ball(_, _, _) :- '$unwind_stack'. throw(Ball) :- '$set_ball'(Ball), '$unwind_stack'. - -% length. - -length(Xs, N) :- - var(N), !, - '$skip_max_list'(M, -1, Xs, Xs0), - ( Xs0 == [] -> N = M - ; var(Xs0) -> '$length_addendum'(Xs0, N, M)). -length(Xs, N) :- - integer(N), - N >= 0, !, - '$skip_max_list'(M, N, Xs, Xs0), - ( Xs0 == [] -> N = M - ; var(Xs0) -> R is N-M, '$length_rundown'(Xs0, R)). -length(_, N) :- - integer(N), !, - throw(error(domain_error(not_less_than_zero, N), length/2)). -length(_, N) :- - throw(error(type_error(integer, N), length/2)). - -'$length_addendum'([], N, N). -'$length_addendum'([_|Xs], N, M) :- - M1 is M + 1, - '$length_addendum'(Xs, N, M1). - -'$length_rundown'([], 0) :- !. -'$length_rundown'([_|Xs], N) :- - N1 is N-1, - '$length_rundown'(Xs, N1). diff --git a/src/prolog/lib/control.pl b/src/prolog/lib/control.pl index 2c1b113d..4f641e59 100644 --- a/src/prolog/lib/control.pl +++ b/src/prolog/lib/control.pl @@ -1,13 +1,19 @@ -:- module(control, [(\=)/2, between/3, call_cleanup/2, once/1, repeat/0]). +:- use_module(library(builtins)). +:- module(control, [(\=)/2, (\+)/1, between/3, once/1, repeat/0]). + +:- op(900, fy, \+). :- op(700, xfx, \=). once(G) :- G, !. +\+ G :- G, !, false. +\+ _. + 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/lib/lists.pl b/src/prolog/lib/lists.pl index 11c0f275..05725838 100644 --- a/src/prolog/lib/lists.pl +++ b/src/prolog/lib/lists.pl @@ -1,7 +1,36 @@ +:- use_module(library(builtins)). + :- module(lists, [member/2, select/3, append/3, memberchk/2, - reverse/2, maplist/2, maplist/3, maplist/4, - maplist/5, maplist/6, maplist/7, maplist/8, - maplist/9]). + reverse/2, length/2, maplist/2, maplist/3, + maplist/4, maplist/5, maplist/6, maplist/7, + maplist/8, maplist/9]). + +length(Xs, N) :- + var(N), !, + '$skip_max_list'(M, -1, Xs, Xs0), + ( Xs0 == [] -> N = M + ; var(Xs0) -> length_addendum(Xs0, N, M)). +length(Xs, N) :- + integer(N), + N >= 0, !, + '$skip_max_list'(M, N, Xs, Xs0), + ( Xs0 == [] -> N = M + ; var(Xs0) -> R is N-M, length_rundown(Xs0, R)). +length(_, N) :- + integer(N), !, + throw(error(domain_error(not_less_than_zero, N), length/2)). +length(_, N) :- + throw(error(type_error(integer, N), length/2)). + +length_addendum([], N, N). +length_addendum([_|Xs], N, M) :- + M1 is M + 1, + length_addendum(Xs, N, M1). + +length_rundown([], 0) :- !. +length_rundown([_|Xs], N) :- + N1 is N-1, + length_rundown(Xs, N1). member(X, [X|_]). member(X, [_|Xs]) :- member(X, Xs). diff --git a/src/prolog/lib/queues.pl b/src/prolog/lib/queues.pl index 1cc1e6c8..f1faf80b 100644 --- a/src/prolog/lib/queues.pl +++ b/src/prolog/lib/queues.pl @@ -1,3 +1,5 @@ +:- use_module(library(builtins)). + :- module(queues, [queue/1, queue/2, queue_head/3, queue_head_list/3, queue_last/3, queue_last_list/3, list_queue/2, queue_length/2]). diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index 7fc0eeaf..2dd2ba59 100644 --- a/src/prolog/machine/machine_state.rs +++ b/src/prolog/machine/machine_state.rs @@ -715,8 +715,8 @@ impl SCCCutPolicy { self.cont_pts.is_empty() } - pub(crate) fn push_cont_pt(&mut self, addr: Addr, b: usize, block: usize) { - self.cont_pts.push((addr, b, block)); + pub(crate) fn push_cont_pt(&mut self, addr: Addr, b: usize, prev_b: usize) { + self.cont_pts.push((addr, b, prev_b)); } pub(crate) fn pop_cont_pt(&mut self) -> Option<(Addr, usize, usize)> { @@ -729,7 +729,7 @@ impl CutPolicy for SCCCutPolicy { let b = machine_st.b; if let Addr::Con(Constant::Usize(b0)) = machine_st[r].clone() { - if b > b0 { + if b > b0 { machine_st.b = b0; machine_st.tidy_trail(); machine_st.or_stack.truncate(machine_st.b); @@ -737,14 +737,13 @@ impl CutPolicy for SCCCutPolicy { } else { machine_st.fail = true; return; - } - - if !self.out_of_cont_pts() { - machine_st.cp.assign_if_local(machine_st.p.clone()); - machine_st.num_of_args = 0; - machine_st.b0 = machine_st.b; - // goto_call run_cleaners_without_handling/0, 370. - machine_st.p = dir_entry!(370, clause_name!("builtin")); + } + + 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(); + } } } } diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 9c1d625d..06b9298d 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -1065,13 +1065,6 @@ impl MachineState { duplicator.duplicate_term(addr); } - pub(super) fn unwind_stack(&mut self) { - self.b = self.block; - self.or_stack.truncate(self.b); - - self.fail = true; - } - pub(super) fn setup_call_n(&mut self, arity: usize) -> Option { let stub = self.functor_stub(clause_name!("call"), arity + 1); @@ -1121,7 +1114,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 @@ -1945,6 +1945,13 @@ impl MachineState { self[r] = Addr::Con(Constant::Usize(b0)); self.p += 1; }, + &CutInstruction::GetLevelAndUnify(r) => { + let b0 = Addr::Con(Constant::Usize(self.b0)); + let a = self[r].clone(); + + self.unify(a, b0); + self.p += 1; + }, &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 d1848238..6753fc91 100644 --- a/src/prolog/machine/mod.rs +++ b/src/prolog/machine/mod.rs @@ -1,5 +1,5 @@ use prolog::ast::*; -use prolog::builtins::*; +use prolog::compile::*; use prolog::heap_print::*; use prolog::tabled_rc::*; @@ -17,9 +17,9 @@ use std::mem::swap; use std::ops::Index; use std::rc::Rc; -pub(super) struct MachineCodeIndex<'a> { - pub(super) code_dir: &'a mut CodeDir, - pub(super) op_dir: &'a mut OpDir, +pub struct MachineCodeIndex<'a> { + pub code_dir: &'a mut CodeDir, + pub op_dir: &'a mut OpDir, } pub struct Machine { @@ -66,24 +66,33 @@ impl<'a> SubModuleUser for MachineCodeIndex<'a> { self.code_dir.insert((name, arity), CodeIndex::from(idx)); } } + +static LISTS: &str = include_str!("../lib/lists.pl"); +static CONTROL: &str = include_str!("../lib/control.pl"); +static QUEUES: &str = include_str!("../lib/queues.pl"); impl Machine { pub fn new() -> Self { - let atom_tbl = Rc::new(RefCell::new(HashSet::new())); - let op_dir = default_op_dir(); //TODO: change to the builtins module once it's done. - //let (code, code_dir, op_dir) = default_build(); - - Machine { - ms: MachineState::new(atom_tbl), + let mut wam = Machine { + ms: MachineState::new(Rc::new(RefCell::new(HashSet::new()))), call_policy: Box::new(DefaultCallPolicy {}), cut_policy: Box::new(DefaultCutPolicy {}), code: Code::new(), code_dir: CodeDir::new(), term_dir: TermDir::new(), - op_dir, + op_dir: default_op_dir(), modules: HashMap::new(), cached_query: None - } + }; + + compile_listing(&mut wam, BUILTINS); + wam.use_module_in_toplevel(clause_name!("builtins")); + + compile_listing(&mut wam, LISTS); + compile_listing(&mut wam, CONTROL); + compile_listing(&mut wam, QUEUES); + + wam } fn remove_module(&mut self, module_name: ClauseName) { diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index 75d80332..bbf4d237 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -151,39 +151,57 @@ impl MachineState { Ok(()) } - - pub(super) fn system_call(&mut self, ct: &SystemClauseType, call_policy: &mut Box, + + fn install_new_block(&mut self, r: RegType) -> usize { + self.block = self.b; + + let c = Constant::Usize(self.block); + let addr = self[r].clone(); + + self.write_constant_to_var(addr, c); + self.block + } + + pub(super) fn system_call(&mut self, ct: &SystemClauseType, + call_policy: &mut Box, cut_policy: &mut Box,) -> CallResult { match ct { - &SystemClauseType::CheckCutPoint => {}, + &SystemClauseType::CheckCutPoint => { + let addr = self.store(self.deref(self[temp_v!(1)].clone())); + + match addr { + Addr::Con(Constant::Usize(old_b)) if self.b <= old_b + 2 => {}, + _ => self.fail = true + }; + }, &SystemClauseType::GetSCCCleaner => { let dest = self[temp_v!(1)].clone(); match cut_policy.downcast_mut::().ok() { Some(sgc_policy) => - if let Some((addr, b_cutoff, prev_block)) = sgc_policy.pop_cont_pt() { + if let Some((addr, b_cutoff, prev_b)) = sgc_policy.pop_cont_pt() { if self.b <= b_cutoff + 1 { - self.block = prev_block; + self.block = prev_b; if let Some(r) = dest.as_var() { - self.bind(r, addr); + self.bind(r, addr.clone()); return Ok(()); } } else { - sgc_policy.push_cont_pt(addr, b_cutoff, prev_block); + sgc_policy.push_cont_pt(addr, b_cutoff, prev_b); } }, None => panic!("expected SCCCutPolicy trait object.") }; - self.fail = true; + self.fail = true; }, &SystemClauseType::InstallSCCCleaner => { let addr = self[temp_v!(1)].clone(); let b = self.b; - let block = self.block; + let prev_block = self.block; if cut_policy.downcast_ref::().is_err() { *cut_policy = Box::new(SCCCutPolicy::new()); @@ -191,7 +209,10 @@ impl MachineState { match cut_policy.downcast_mut::().ok() { - Some(cut_policy) => cut_policy.push_cont_pt(addr, b, block), + Some(cut_policy) => { + self.install_new_block(temp_v!(2)); + cut_policy.push_cont_pt(addr, b, prev_block); + }, None => panic!("install_cleaner: should have installed \\ SCCCutPolicy.") }; @@ -292,7 +313,7 @@ impl MachineState { }, _ => self.fail = true }; - }, + }, &SystemClauseType::CleanUpBlock => { let nb = self.store(self.deref(self[temp_v!(1)].clone())); @@ -337,16 +358,11 @@ impl MachineState { &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; - - let c = Constant::Usize(self.block); - let addr = self[temp_v!(1)].clone(); - - self.write_constant_to_var(addr, c); + self.install_new_block(temp_v!(1)); }, &SystemClauseType::ResetBlock => { let addr = self.deref(self[temp_v!(1)].clone()); diff --git a/src/prolog/macros.rs b/src/prolog/macros.rs index 4124beca..ec289eca 100644 --- a/src/prolog/macros.rs +++ b/src/prolog/macros.rs @@ -248,3 +248,8 @@ macro_rules! top_level_code_ptr { ) } +macro_rules! get_level_and_unify { + ($r: expr) => ( + Line::Cut(CutInstruction::GetLevelAndUnify($r)) + ) +} diff --git a/src/prolog/mod.rs b/src/prolog/mod.rs index 954417f9..8403bb4a 100644 --- a/src/prolog/mod.rs +++ b/src/prolog/mod.rs @@ -9,8 +9,8 @@ pub mod ast; #[macro_use] pub mod allocator; pub mod toplevel; +pub mod compile; pub mod arithmetic; -pub mod builtins; pub mod codegen; pub mod copier; pub mod debray_allocator; diff --git a/src/prolog/toplevel.rs b/src/prolog/toplevel.rs index 673167f3..cfb5c0e2 100644 --- a/src/prolog/toplevel.rs +++ b/src/prolog/toplevel.rs @@ -1,4 +1,5 @@ use prolog::ast::*; +use prolog::machine::*; use prolog::num::*; use prolog::parser::parser::*; use prolog::tabled_rc::*; @@ -412,6 +413,12 @@ impl RelationWorker { self.queue.push_back(clauses); Ok(QueryTerm::Jump(stub)) + } else if name.as_str() == "$get_level" && terms.len() == 1 { + if let Term::Var(_, ref var) = *terms[0] { + Ok(QueryTerm::GetLevelAndUnify(Cell::default(), var.clone())) + } else { + Err(ParserError::InadmissibleQueryTerm) + } } else { Ok(QueryTerm::Clause(Cell::default(), ClauseType::from(name, terms.len(), fixity), @@ -558,7 +565,8 @@ impl TopLevelWorker { TopLevelWorker { parser: Parser::new(inner, atom_tbl) } } - pub fn parse_batch(&mut self, op_dir: &mut OpDir) -> Result, SessionError> + pub fn parse_batch<'a>(&mut self, wam: &Machine, mut indices: MachineCodeIndex<'a>) + -> Result, SessionError> { let mut preds = vec![]; let mut mod_name = clause_name!("user"); @@ -572,7 +580,7 @@ impl TopLevelWorker { while !self.parser.eof() { self.parser.reset(); // empty the parser stack of token descriptions. - let term = self.parser.read_term(&op_dir)?; + let term = self.parser.read_term(&indices.op_dir)?; let mut new_rel_worker = RelationWorker::new(); let tl = new_rel_worker.try_term_to_tl(term, true)?; @@ -584,8 +592,12 @@ impl TopLevelWorker { rel_worker.absorb(new_rel_worker); match tl { + TopLevel::Declaration(Declaration::UseModule(name)) => + if let Some(module) = wam.get_module(name) { + indices.use_module(module); + }, TopLevel::Declaration(Declaration::Op(op_decl)) => { - op_decl.submit(mod_name.clone(), op_dir)?; + op_decl.submit(mod_name.clone(), indices.op_dir)?; }, TopLevel::Declaration(Declaration::Module(actual_mod)) => { mod_name = actual_mod.name.clone(); diff --git a/src/tests.rs b/src/tests.rs index 42b6e3e5..2581884a 100644 --- a/src/tests.rs +++ b/src/tests.rs @@ -1,6 +1,6 @@ use prolog::ast::*; use prolog::heap_print::*; -use prolog::io::*; +use prolog::compile::*; use prolog::machine::*; use std::collections::HashSet; @@ -937,7 +937,6 @@ fn test_queries_on_call_n() fn test_queries_on_arithmetic() { let mut wam = Machine::new(); - load_init_str_and_include(&mut wam, BUILTINS, "builtins"); assert_prolog_success!(&mut wam, "?- X is 1, X is X.", [["X = 1"]]); assert_prolog_failure!(&mut wam, "?- X is 1, X is X + 1."); @@ -1022,7 +1021,6 @@ fn test_queries_on_arithmetic() fn test_queries_on_exceptions() { let mut wam = Machine::new(); - load_init_str_and_include(&mut wam, BUILTINS, "builtins"); submit(&mut wam, "f(a). f(_) :- throw(stuff)."); submit(&mut wam, "handle(stuff)."); @@ -1127,7 +1125,6 @@ fn test_queries_on_exceptions() #[test] fn test_queries_on_skip_max_list() { let mut wam = Machine::new(); - load_init_str_and_include(&mut wam, BUILTINS, "builtins"); // test on proper and empty lists. assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, 5, [], Xs).", @@ -1205,7 +1202,6 @@ fn test_queries_on_skip_max_list() { fn test_queries_on_conditionals() { let mut wam = Machine::new(); - 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\") @@ -1266,12 +1262,12 @@ fn test_queries_on_conditionals() [["X = a"], ["X = b"]]); } -/* #[test] fn test_queries_on_builtins() { let mut wam = Machine::new(); - + wam.use_module_in_toplevel(clause_name!("lists")); + assert_prolog_failure!(&mut wam, "?- atom(X)."); assert_prolog_success!(&mut wam, "?- atom(a)."); assert_prolog_failure!(&mut wam, "?- atom(\"string\")."); @@ -1295,33 +1291,14 @@ fn test_queries_on_builtins() assert_prolog_success!(&mut wam, "?- var(X), X = 3, atomic(X).", [["X = 3"]]); assert_prolog_failure!(&mut wam, "?- var(X), X = 3, var(X)."); - assert_prolog_success!(&mut wam, "?- arg(N, f(a,b,c,d), Arg).", - [["N = 1", "Arg = a"], - ["N = 2", "Arg = b"], - ["N = 3", "Arg = c"], - ["N = 4", "Arg = d"]]); - assert_prolog_success!(&mut wam, "?- arg(1, f(a,b,c,d), Arg).", [["Arg = a"]]); assert_prolog_success!(&mut wam, "?- arg(2, f(a,b,c,d), Arg).", [["Arg = b"]]); assert_prolog_success!(&mut wam, "?- arg(3, f(a,b,c,d), Arg).", [["Arg = c"]]); assert_prolog_success!(&mut wam, "?- arg(4, f(a,b,c,d), Arg).", [["Arg = d"]]); - assert_prolog_success!(&mut wam, "?- catch(arg(N, f, Arg), error(type_error(E, _), _), true).", - [["E = compound", "Arg = _3", "N = _1"]]); - - assert_prolog_success!(&mut wam, "?- catch(arg(N, _, Arg), error(E, _), true).", + assert_prolog_success!(&mut wam, "?- catch(arg(N, f, Arg), error(E, _), true).", [["E = instantiation_error", "Arg = _3", "N = _1"]]); - - assert_prolog_success!(&mut wam, "?- arg(N, f(X, Y, Z), arg_val).", - [["X = arg_val", "Y = _3", "N = 1", "Z = _4"], - ["X = _2", "Y = arg_val", "N = 2", "Z = _4"], - ["X = _2", "Y = _3", "N = 3", "Z = arg_val"]]); - - assert_prolog_success!(&mut wam, "?- arg(N, f(arg, not_arg, arg, X), arg).", - [["X = _5", "N = 1"], - ["X = _5", "N = 3"], - ["X = arg", "N = 4"]]); - + assert_prolog_failure!(&mut wam, "?- arg(N, f(arg, arg, arg), not_arg)."); assert_prolog_failure!(&mut wam, "?- arg(1, f(arg, not_arg, not_arg), not_arg)."); assert_prolog_success!(&mut wam, "?- arg(2, f(arg, not_arg, not_arg), not_arg)."); @@ -1343,7 +1320,7 @@ fn test_queries_on_builtins() assert_prolog_success!(&mut wam, "?- functor(Func, f, 4).", [["Func = f(_2, _3, _4, _5)"]]); assert_prolog_success!(&mut wam, "?- catch(functor(F, \"sdf\", 3), error(E, _), true).", - [["E = instantiation_error", "F = _1"]]); + [["E = type_error(atom, \"sdf\")", "F = _1"]]); assert_prolog_success!(&mut wam, "?- catch(functor(Func, F, 3), error(E, _), true).", [["E = instantiation_error", "Func = _1", "F = _2"]]); assert_prolog_success!(&mut wam, "?- catch(functor(Func, f, N), error(E, _), true).", @@ -1352,13 +1329,13 @@ fn test_queries_on_builtins() assert_prolog_success!(&mut wam, "?- X is 3, call(integer, X)."); assert_prolog_failure!(&mut wam, "?- X is 3 + 3.5, call(integer, X)."); - assert_prolog_success!(&mut wam, "?- X is 3 + 3.5, \\+ call(integer, X)."); - assert_prolog_success!(&mut wam, "?- X is 3 + 3.5, \\+ integer(X)."); +// assert_prolog_success!(&mut wam, "?- X is 3 + 3.5, \\+ call(integer, X)."); +// assert_prolog_success!(&mut wam, "?- X is 3 + 3.5, \\+ integer(X)."); assert_prolog_success!(&mut wam, "?- Func =.. [atom].", [["Func = atom"]]); assert_prolog_success!(&mut wam, "?- Func =.. [\"sdf\"].", [["Func = \"sdf\""]]); assert_prolog_success!(&mut wam, "?- Func =.. [1].", [["Func = 1"]]); - assert_prolog_success!(&mut wam, "?- catch(Func =.. [1,2], error(instantiation_error, _), true)."); + assert_prolog_success!(&mut wam, "?- catch(Func =.. [1,2], error(type_error(atom, 1), _), true)."); assert_prolog_success!(&mut wam, "?- f(1,2,3) =.. List.", [["List = [f, 1, 2, 3]"]]); assert_prolog_success!(&mut wam, "?- f(1,2,3) =.. [f,1,2,3]."); assert_prolog_failure!(&mut wam, "?- f(1,2,3) =.. [f,1]."); @@ -1366,23 +1343,23 @@ fn test_queries_on_builtins() assert_prolog_success!(&mut wam, "?- f(1,2,3) =.. [f,X,Y,Z].", [["X = 1", "Y = 2", "Z = 3"]]); + assert_prolog_success!(&mut wam, "?- length([a,b,c], N).", [["N = 3"]]); assert_prolog_success_with_limit!(&mut wam, "?- length(Xs, N).", [["N = 0", "Xs = []"], - ["N = 1", "Xs = [_3]"], - ["N = 2", "Xs = [_3, _6]"], - ["N = 3", "Xs = [_3, _6, _9]"], - ["N = 4", "Xs = [_3, _6, _9, _12]"], - ["N = 5", "Xs = [_3, _6, _9, _12, _15]"]], + ["N = 1", "Xs = [_4]"], + ["N = 2", "Xs = [_4, _8]"], + ["N = 3", "Xs = [_4, _8, _12]"], + ["N = 4", "Xs = [_4, _8, _12, _16]"], + ["N = 5", "Xs = [_4, _8, _12, _16, _20]"]], 6); - assert_prolog_success!(&mut wam, "?- length(Xs, 3).", [["Xs = [_2, _5, _8]"]]); - assert_prolog_success!(&mut wam, "?- length([a,b,c], N).", [["N = 3"]]); + assert_prolog_success!(&mut wam, "?- length(Xs, 3).", [["Xs = [_4, _8, _12]"]]); assert_prolog_success!(&mut wam, "?- length([], N).", [["N = 0"]]); assert_prolog_success!(&mut wam, "?- length(Xs, 0).", [["Xs = []"]]); assert_prolog_success!(&mut wam, "?- length([a,b,[a,b,c]], 3)."); assert_prolog_failure!(&mut wam, "?- length([a,b,[a,b,c]], 2)."); - assert_prolog_success!(&mut wam, "?- catch(length(a, []), type_error(integer, E), true).", - [["E = []"]]); + assert_prolog_success!(&mut wam, "?- catch(length(a, []), error(E, _), true).", + [["E = type_error(integer, [])"]]); assert_prolog_success!(&mut wam, "?- duplicate_term([1,2,3], [X,Y,Z]).", [["Z = 3", "Y = 2", "X = 1"]]); @@ -1497,15 +1474,15 @@ fn test_queries_on_builtins() assert_prolog_success!(&mut wam, "?- g(B) = B, g(A) = A, A =@= B."); assert_prolog_success!(&mut wam, "?- keysort([1-1, 1-1], Sorted).", - [["Sorted = [1 - 1, 1 - 1]"]]); + [["Sorted = [1-1, 1-1]"]]); assert_prolog_success!(&mut wam, "?- keysort([2-99, 1-a, 3-f(_), 1-z, 1-a, 2-44], Sorted).", - [["Sorted = [1 - a, 1 - z, 1 - a, 2 - 99, 2 - 44, 3 - f(_7)]"]]); + [["Sorted = [1-a, 1-z, 1-a, 2-99, 2-44, 3-f(_7)]"]]); assert_prolog_success!(&mut wam, "?- keysort([X-1,1-1],[2-1,1-1]).", [["X = 2"]]); assert_prolog_failure!(&mut wam, "?- Pairs = [a-a|Pairs], keysort(Pairs, _)."); assert_prolog_success!(&mut wam, "?- Pairs = [a-a|Pairs], catch(keysort(Pairs, _), error(E, _), true).", - [["E = type_error(list, [a - a | _21])", "Pairs = [a - a | Pairs]"]]); + [["E = type_error(list, [a-a | _22])", "Pairs = [a-a | Pairs]"]]); assert_prolog_success!(&mut wam, "?- keysort([], L).", [["L = []"]]); @@ -1514,9 +1491,9 @@ fn test_queries_on_builtins() assert_prolog_success!(&mut wam, "?- catch(keysort([],[a|a]),error(Pat, _),true).", [["Pat = type_error(list, [a | a])"]]); assert_prolog_success!(&mut wam, "?- catch(keysort(_, _), error(E, _), true).", - [["E = type_error(list, _12)"]]); + [["E = type_error(list, _13)"]]); assert_prolog_success!(&mut wam, "?- catch(keysort([a-1], [_|b]), error(E, _), true).", - [["E = type_error(list, [_23 | b])"]]); + [["E = type_error(list, [_24 | b])"]]); assert_prolog_success!(&mut wam, "?- catch(keysort([a-1], [a-b,c-d,a]), error(E, _), true).", [["E = type_error(pair, a)"]]); assert_prolog_success!(&mut wam, "?- catch(keysort([a], [a-b]), error(E, _), true).", @@ -1529,33 +1506,37 @@ fn test_queries_on_builtins() assert_prolog_success!(&mut wam, "?- sort([], L).", [["L = []"]]); assert_prolog_success!(&mut wam, "?- catch(sort(_, []), error(E, _), true).", - [["E = type_error(list, _12)"]]); + [["E = type_error(list, _13)"]]); assert_prolog_success!(&mut wam, "?- catch(sort([a,b,c], not_a_list), error(E, _), true).", [["E = type_error(list, not_a_list)"]]); assert_prolog_success!(&mut wam, "?- call(((G = 2 ; fail), B=3, !)).", [["G = 2", "B = 3"]]); + /* assert_prolog_success!(&mut wam, "?- call_with_inference_limit((setup_call_cleanup(S=1,(G=2;fail),display(S+G>B)), B=3, !), 100, R).", [["G = 2", "B = 3", "R = !", "S = 1"]]); assert_prolog_success!(&mut wam, "?- call_with_inference_limit((setup_call_cleanup(S=1,(G=2;fail),display(S+G>B)), B=3, !), 10, R).", [["S = _1", "G = _4", "B = _14", "R = inference_limit_exceeded"]]); + */ } +/* #[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, _, _)."); - assert_prolog_success!(&mut wam, "?- catch(setup_call_cleanup(true, throw(unthrown), _), instantiation_error, true)."); + assert_prolog_success!(&mut wam, "?- catch(setup_call_cleanup(true, throw(unthrown), _), error(instantiation_error, _), true)."); assert_prolog_success!(&mut wam, "?- setup_call_cleanup(true, true, (true ; throw(x)))."); assert_prolog_success!(&mut wam, "?- setup_call_cleanup(true, X = 1, X = 2).", [["X = 1"]]); assert_prolog_success!(&mut wam, "?- setup_call_cleanup(true, true, X = 2).", [["X = 2"]]); - assert_prolog_success!(&mut wam, "?- catch(setup_call_cleanup(true, X=true, X), E, true).", + assert_prolog_success!(&mut wam, "?- catch(setup_call_cleanup(true, X=true, X), error(E, _), true).", [["E = instantiation_error", "X = _1"]]); assert_prolog_success!(&mut wam, "?- catch(setup_call_cleanup(X=throw(ex), true, X), E, true).", [["E = ex", "X = _3"]]);