From 380aae85bdc1bdac686c22af66a25df7ee1dc16d Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sun, 22 Sep 2019 16:06:50 -0600 Subject: [PATCH] add wam_instructions/2 to render predicate instructions as lists of functors --- Cargo.toml | 2 +- README.md | 3 +- src/prolog/clause_types.rs | 3 + src/prolog/instructions.rs | 417 ++++++++++++++++++++++- src/prolog/lib/diag.pl | 14 + src/prolog/machine/heap.rs | 6 + src/prolog/machine/machine_errors.rs | 2 +- src/prolog/machine/machine_state_impl.rs | 19 +- src/prolog/machine/mod.rs | 8 +- src/prolog/machine/system_calls.rs | 130 ++++++- src/prolog/macros.rs | 12 + src/prolog/mod.rs | 2 +- 12 files changed, 594 insertions(+), 24 deletions(-) create mode 100644 src/prolog/lib/diag.pl diff --git a/Cargo.toml b/Cargo.toml index e2d7fb5b..b8267697 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -1,6 +1,6 @@ [package] name = "scryer-prolog" -version = "0.8.90" +version = "0.8.91" authors = ["Mark Thom "] repository = "https://github.com/mthom/scryer-prolog" description = "A modern Prolog implementation written mostly in Rust." diff --git a/README.md b/README.md index 9cc5d8be..242db38d 100644 --- a/README.md +++ b/README.md @@ -240,6 +240,7 @@ The following predicates are built-in to Scryer. * `user:term_expansion/2` * `var/1` * `variant/2` +* `wam_instructions/2` * `write/1` * `write_canonical/1` * `writeq/1` @@ -361,7 +362,7 @@ been exported to the toplevel. To export them, write To load modules contained in files, the `library` functor can be omitted, prompting Scryer to search for the file (specified as an -atom) from its home directory: +atom) from its working directory: ``` ?- use_module('file.pl'). diff --git a/src/prolog/clause_types.rs b/src/prolog/clause_types.rs index 773dc5e0..9e5359f7 100644 --- a/src/prolog/clause_types.rs +++ b/src/prolog/clause_types.rs @@ -232,6 +232,7 @@ pub enum SystemClauseType { UnifyWithOccursCheck, UnwindStack, Variant, + WAMInstructions, WriteTerm } @@ -322,6 +323,7 @@ impl SystemClauseType { &SystemClauseType::UnifyWithOccursCheck => clause_name!("$unify_with_occurs_check"), &SystemClauseType::UnwindStack => clause_name!("$unwind_stack"), &SystemClauseType::Variant => clause_name!("$variant"), + &SystemClauseType::WAMInstructions => clause_name!("$wam_instructions"), &SystemClauseType::WriteTerm => clause_name!("$write_term"), } } @@ -412,6 +414,7 @@ impl SystemClauseType { ("$unify_with_occurs_check", 2) => Some(SystemClauseType::UnifyWithOccursCheck), ("$variant", 2) => Some(SystemClauseType::Variant), ("$write_term", 5) => Some(SystemClauseType::WriteTerm), + ("$wam_instructions", 3) => Some(SystemClauseType::WAMInstructions), _ => None } } diff --git a/src/prolog/instructions.rs b/src/prolog/instructions.rs index 3b639ce5..6e252c62 100644 --- a/src/prolog/instructions.rs +++ b/src/prolog/instructions.rs @@ -2,9 +2,48 @@ use prolog_parser::ast::*; use prolog::clause_types::*; use prolog::forms::*; +use prolog::machine::machine_errors::MachineStub; +use prolog::machine::machine_indices::*; + +use prolog::rug::Integer; use std::collections::{HashMap, VecDeque}; +fn reg_type_into_functor(r: RegType) -> MachineStub { + match r { + RegType::Temp(r) => + functor!("x", 1, [heap_integer!(Integer::from(r))]), + RegType::Perm(r) => + functor!("y", 1, [heap_integer!(Integer::from(r))]) + } +} + +impl Level { + fn into_functor(self) -> MachineStub { + match self { + Level::Root => + functor!("level", 1, [heap_atom!("root")]), + Level::Shallow => + functor!("level", 1, [heap_atom!("shallow")]), + Level::Deep => + functor!("level", 1, [heap_atom!("deep")]), + } + } +} + +impl ArithmeticTerm { + fn into_functor(&self) -> MachineStub { + match self { + &ArithmeticTerm::Reg(r) => + reg_type_into_functor(r), + &ArithmeticTerm::Interm(i) => + functor!("intermediate", 1, [heap_integer!(Integer::from(i))]), + &ArithmeticTerm::Number(ref n) => + vec![heap_con!(n.clone().to_constant())] + } + } +} + pub enum ChoiceInstruction { DefaultRetryMeElse(usize), DefaultTrustMe, @@ -13,6 +52,23 @@ pub enum ChoiceInstruction { TryMeElse(usize) } +impl ChoiceInstruction { + pub fn to_functor(&self) -> MachineStub { + match self { + &ChoiceInstruction::TryMeElse(offset) => + functor!("try_me_else", 1, [heap_integer!(Integer::from(offset))]), + &ChoiceInstruction::RetryMeElse(offset) => + functor!("retry_me_else", 1, [heap_integer!(Integer::from(offset))]), + &ChoiceInstruction::TrustMe => + vec![heap_atom!("trust_me")], + &ChoiceInstruction::DefaultRetryMeElse(offset) => + functor!("default_retry_me_else", 1, [heap_integer!(Integer::from(offset))]), + &ChoiceInstruction::DefaultTrustMe => + vec![heap_atom!("default_trust_me")], + } + } +} + pub enum CutInstruction { Cut(RegType), GetLevel(RegType), @@ -20,6 +76,30 @@ pub enum CutInstruction { NeckCut } +impl CutInstruction { + pub fn to_functor(&self, h: usize) -> MachineStub { + match self { + &CutInstruction::Cut(r) => { + let mut stub = functor!("cut", 1, [heap_str!(h + 2)]); + stub.append(&mut reg_type_into_functor(r)); + stub + }, + &CutInstruction::GetLevel(r) => { + let mut stub = functor!("get_level", 1, [heap_str!(h + 2)]); + stub.append(&mut reg_type_into_functor(r)); + stub + }, + &CutInstruction::GetLevelAndUnify(r) => { + let mut stub = functor!("get_level_and_unify", 1, [heap_str!(h + 2)]); + stub.append(&mut reg_type_into_functor(r)); + stub + }, + &CutInstruction::NeckCut => + vec![heap_atom!("neck_cut")] + } + } +} + pub enum IndexedChoiceInstruction { Retry(usize), Trust(usize), @@ -40,6 +120,17 @@ impl IndexedChoiceInstruction { &IndexedChoiceInstruction::Try(offset) => offset } } + + pub fn to_functor(&self) -> MachineStub { + match self { + &IndexedChoiceInstruction::Try(offset) => + functor!("try", 1, [heap_integer!(Integer::from(offset))]), + &IndexedChoiceInstruction::Trust(offset) => + functor!("trust", 1, [heap_integer!(Integer::from(offset))]), + &IndexedChoiceInstruction::Retry(offset) => + functor!("retry", 1, [heap_integer!(Integer::from(offset))]) + } + } } pub enum Line { @@ -56,12 +147,25 @@ pub enum Line { impl Line { pub fn is_head_instr(&self) -> bool { match self { - &Line::Cut(_) => true, + &Line::Cut(_) => true, &Line::Fact(_) => true, &Line::Query(_) => true, _ => false } } + + pub fn to_functor(&self, h: usize) -> MachineStub { + match self { + &Line::Arithmetic(ref arith_instr) => arith_instr.to_functor(h), + &Line::Choice(ref choice_instr) => choice_instr.to_functor(), + &Line::Control(ref control_instr) => control_instr.to_functor(), + &Line::Cut(ref cut_instr) => cut_instr.to_functor(h), + &Line::Fact(ref fact_instr) => fact_instr.to_functor(h), + &Line::Indexing(ref indexing_instr) => indexing_instr.to_functor(), + &Line::IndexedChoice(ref indexed_choice_instr) => indexed_choice_instr.to_functor(), + &Line::Query(ref query_instr) => query_instr.to_functor(h) + } + } } #[derive(Clone)] @@ -105,6 +209,118 @@ pub enum ArithmeticInstruction { BitwiseComplement(ArithmeticTerm, usize) } +fn arith_instr_unary_functor(h: usize, name: &'static str, at: &ArithmeticTerm, t: usize) + -> MachineStub +{ + let at_stub = at.into_functor(); + + let mut stub = functor!(name, 2, + [heap_cell!(h + 4), + heap_integer!(Integer::from(t))]); + + stub.extend(at_stub.into_iter()); + stub +} + +fn arith_instr_bin_functor(h: usize, name: &'static str, at_1: &ArithmeticTerm, + at_2: &ArithmeticTerm, t: usize) + -> MachineStub +{ + let at_1_stub = at_1.into_functor(); + let at_2_stub = at_2.into_functor(); + + let mut stub = functor!(name, 3, + [heap_cell!(h + 4), + heap_cell!(h + 4 + at_1_stub.len()), + heap_integer!(Integer::from(t))]); + + stub.extend(at_1_stub.into_iter()); + stub.extend(at_2_stub.into_iter()); + + stub +} + +impl ArithmeticInstruction { + pub fn to_functor(&self, h: usize) -> MachineStub { + match self { + &ArithmeticInstruction::Add(ref at_1, ref at_2, t) => + arith_instr_bin_functor(h, "add", at_1, at_2, t), + &ArithmeticInstruction::Sub(ref at_1, ref at_2, t) => + arith_instr_bin_functor(h, "sub", at_1, at_2, t), + &ArithmeticInstruction::Mul(ref at_1, ref at_2, t) => + arith_instr_bin_functor(h, "mul", at_1, at_2, t), + &ArithmeticInstruction::IntPow(ref at_1, ref at_2, t) => + arith_instr_bin_functor(h, "int_pow", at_1, at_2, t), + &ArithmeticInstruction::Pow(ref at_1, ref at_2, t) => + arith_instr_bin_functor(h, "pow", at_1, at_2, t), + &ArithmeticInstruction::IDiv(ref at_1, ref at_2, t) => + arith_instr_bin_functor(h, "idiv", at_1, at_2, t), + &ArithmeticInstruction::Max(ref at_1, ref at_2, t) => + arith_instr_bin_functor(h, "max", at_1, at_2, t), + &ArithmeticInstruction::Min(ref at_1, ref at_2, t) => + arith_instr_bin_functor(h, "min", at_1, at_2, t), + &ArithmeticInstruction::IntFloorDiv(ref at_1, ref at_2, t) => + arith_instr_bin_functor(h, "int_floor_div", at_1, at_2, t), + &ArithmeticInstruction::RDiv(ref at_1, ref at_2, t) => + arith_instr_bin_functor(h, "rdiv", at_1, at_2, t), + &ArithmeticInstruction::Div(ref at_1, ref at_2, t) => + arith_instr_bin_functor(h, "div", at_1, at_2, t), + &ArithmeticInstruction::Shl(ref at_1, ref at_2, t) => + arith_instr_bin_functor(h, "shl", at_1, at_2, t), + &ArithmeticInstruction::Shr(ref at_1, ref at_2, t) => + arith_instr_bin_functor(h, "shr", at_1, at_2, t), + &ArithmeticInstruction::Xor(ref at_1, ref at_2, t) => + arith_instr_bin_functor(h, "xor", at_1, at_2, t), + &ArithmeticInstruction::And(ref at_1, ref at_2, t) => + arith_instr_bin_functor(h, "and", at_1, at_2, t), + &ArithmeticInstruction::Or(ref at_1, ref at_2, t) => + arith_instr_bin_functor(h, "or", at_1, at_2, t), + &ArithmeticInstruction::Mod(ref at_1, ref at_2, t) => + arith_instr_bin_functor(h, "mod", at_1, at_2, t), + &ArithmeticInstruction::Rem(ref at_1, ref at_2, t) => + arith_instr_bin_functor(h, "rem", at_1, at_2, t), + &ArithmeticInstruction::ATan2(ref at_1, ref at_2, t) => + arith_instr_bin_functor(h, "rem", at_1, at_2, t), + &ArithmeticInstruction::Cos(ref at, t) => + arith_instr_unary_functor(h, "cos", at, t), + &ArithmeticInstruction::Sin(ref at, t) => + arith_instr_unary_functor(h, "sin", at, t), + &ArithmeticInstruction::Tan(ref at, t) => + arith_instr_unary_functor(h, "tan", at, t), + &ArithmeticInstruction::Log(ref at, t) => + arith_instr_unary_functor(h, "log", at, t), + &ArithmeticInstruction::Exp(ref at, t) => + arith_instr_unary_functor(h, "exp", at, t), + &ArithmeticInstruction::ACos(ref at, t) => + arith_instr_unary_functor(h, "acos", at, t), + &ArithmeticInstruction::ASin(ref at, t) => + arith_instr_unary_functor(h, "asin", at, t), + &ArithmeticInstruction::ATan(ref at, t) => + arith_instr_unary_functor(h, "atan", at, t), + &ArithmeticInstruction::Sqrt(ref at, t) => + arith_instr_unary_functor(h, "sqrt", at, t), + &ArithmeticInstruction::Abs(ref at, t) => + arith_instr_unary_functor(h, "abs", at, t), + &ArithmeticInstruction::Float(ref at, t) => + arith_instr_unary_functor(h, "float", at, t), + &ArithmeticInstruction::Truncate(ref at, t) => + arith_instr_unary_functor(h, "truncate", at, t), + &ArithmeticInstruction::Round(ref at, t) => + arith_instr_unary_functor(h, "round", at, t), + &ArithmeticInstruction::Ceiling(ref at, t) => + arith_instr_unary_functor(h, "ceiling", at, t), + &ArithmeticInstruction::Floor(ref at, t) => + arith_instr_unary_functor(h, "floor", at, t), + &ArithmeticInstruction::Neg(ref at, t) => + arith_instr_unary_functor(h, "-", at, t), + &ArithmeticInstruction::Plus(ref at, t) => + arith_instr_unary_functor(h, "+", at, t), + &ArithmeticInstruction::BitwiseComplement(ref at, t) => + arith_instr_unary_functor(h, "\\", at, t), + } + } +} + pub enum ControlInstruction { Allocate(usize), // num_frames. // name, arity, perm_vars after threshold, last call, use default call policy. @@ -122,6 +338,25 @@ impl ControlInstruction { _ => false } } + + pub fn to_functor(&self) -> MachineStub { + match self { + &ControlInstruction::Allocate(num_frames) => + functor!("allocate", 1, [heap_integer!(Integer::from(num_frames))]), + &ControlInstruction::CallClause(ref ct, arity, _, false, _) => + functor!("call", 2, [heap_con!(Constant::Atom(ct.name(), None)), + heap_integer!(Integer::from(arity))]), + &ControlInstruction::CallClause(ref ct, arity, _, true, _) => + functor!("execute", 2, [heap_con!(Constant::Atom(ct.name(), None)), + heap_integer!(Integer::from(arity))]), + &ControlInstruction::Deallocate => + vec![heap_atom!("deallocate")], + &ControlInstruction::JmpBy(_, offset, ..) => + functor!("jmp_by", 1, [heap_integer!(Integer::from(offset))]), + &ControlInstruction::Proceed => + vec![heap_atom!("proceed")] + } + } } pub enum IndexingInstruction { @@ -136,6 +371,25 @@ impl From for Line { } } +impl IndexingInstruction { + pub fn to_functor(&self) -> MachineStub { + match self { + &IndexingInstruction::SwitchOnTerm(vars, constants, lists, structures) => + functor!("switch_on_term", 4, + [heap_integer!(Integer::from(vars)), + heap_integer!(Integer::from(constants)), + heap_integer!(Integer::from(lists)), + heap_integer!(Integer::from(structures))]), + &IndexingInstruction::SwitchOnConstant(constants, _) => + functor!("switch_on_constant", 1, + [heap_integer!(Integer::from(constants))]), + &IndexingInstruction::SwitchOnStructure(structures, _) => + functor!("switch_on_structure", 1, + [heap_integer!(Integer::from(structures))]) + } + } +} + #[derive(Clone)] pub enum FactInstruction { GetConstant(Level, Constant, RegType), @@ -150,6 +404,80 @@ pub enum FactInstruction { UnifyVoid(usize) } +impl FactInstruction { + pub fn to_functor(&self, h: usize) -> MachineStub { + match self { + &FactInstruction::GetConstant(lvl, ref constant, r) => { + let mut stub = functor!("get_constant", 3, + [heap_str!(h + 4), + heap_con!(constant.clone()), + heap_str!(h + 6)]); + + stub.append(&mut lvl.into_functor()); + stub.append(&mut reg_type_into_functor(r)); + + stub + }, + &FactInstruction::GetList(lvl, r) => { + let mut stub = functor!("get_list", 2, + [heap_str!(h + 3), + heap_str!(h + 5)]); + stub.append(&mut lvl.into_functor()); + stub.append(&mut reg_type_into_functor(r)); + + stub + }, + &FactInstruction::GetStructure(ref ct, arity, r) => { + let mut stub = functor!("get_structure", 3, + [heap_con!(Constant::Atom(ct.name(), None)), + heap_integer!(Integer::from(arity)), + heap_str!(h + 4)]); + stub.append(&mut reg_type_into_functor(r)); + + stub + }, + &FactInstruction::GetValue(r, arg) => { + let mut stub = functor!("get_value", 2, + [heap_str!(h + 3), + heap_integer!(Integer::from(arg))]); + stub.append(&mut reg_type_into_functor(r)); + + stub + }, + &FactInstruction::GetVariable(r, arg) => { + let mut stub = functor!("get_variable", 2, + [heap_str!(h + 3), + heap_integer!(Integer::from(arg))]); + stub.append(&mut reg_type_into_functor(r)); + + stub + }, + &FactInstruction::UnifyConstant(ref constant) => + functor!("unify_constant", 1, [heap_con!(constant.clone())]), + &FactInstruction::UnifyLocalValue(r) => { + let mut stub = functor!("unify_local_value", 1, [heap_str!(h + 2)]); + stub.append(&mut reg_type_into_functor(r)); + + stub + }, + &FactInstruction::UnifyVariable(r) => { + let mut stub = functor!("unify_variable", 1, [heap_str!(h + 2)]); + stub.append(&mut reg_type_into_functor(r)); + + stub + }, + &FactInstruction::UnifyValue(r) => { + let mut stub = functor!("unify_value", 1, [heap_str!(h + 2)]); + stub.append(&mut reg_type_into_functor(r)); + + stub + }, + &FactInstruction::UnifyVoid(vars) => + functor!("unify_void", 1, [heap_integer!(Integer::from(vars))]) + } + } +} + #[derive(Clone)] pub enum QueryInstruction { GetVariable(RegType, usize), @@ -166,6 +494,93 @@ pub enum QueryInstruction { SetVoid(usize) } +impl QueryInstruction { + pub fn to_functor(&self, h: usize) -> MachineStub { + match self { + &QueryInstruction::PutUnsafeValue(norm, arg) => + functor!("put_unsafe_value", 2, + [heap_integer!(Integer::from(norm)), + heap_integer!(Integer::from(arg))]), + &QueryInstruction::PutConstant(lvl, ref constant, r) => { + let mut stub = functor!("put_constant", 3, + [heap_str!(h + 4), + heap_con!(constant.clone()), + heap_str!(h + 6)]); + + stub.append(&mut lvl.into_functor()); + stub.append(&mut reg_type_into_functor(r)); + + stub + }, + &QueryInstruction::PutList(lvl, r) => { + let mut stub = functor!("put_list", 2, + [heap_str!(h + 3), + heap_str!(h + 5)]); + + stub.append(&mut lvl.into_functor()); + stub.append(&mut reg_type_into_functor(r)); + + stub + }, + &QueryInstruction::PutStructure(ref ct, arity, r) => { + let mut stub = functor!("put_structure", 3, + [heap_con!(Constant::Atom(ct.name(), None)), + heap_integer!(Integer::from(arity)), + heap_str!(h + 4)]); + + stub.append(&mut reg_type_into_functor(r)); + stub + }, + &QueryInstruction::PutValue(r, arg) => { + let mut stub = functor!("put_value", 2, + [heap_str!(h + 3), + heap_integer!(Integer::from(arg))]); + + stub.append(&mut reg_type_into_functor(r)); + stub + }, + &QueryInstruction::GetVariable(r, arg) => { + let mut stub = functor!("get_variable", 2, + [heap_str!(h + 3), + heap_integer!(Integer::from(arg))]); + + stub.append(&mut reg_type_into_functor(r)); + stub + }, + &QueryInstruction::PutVariable(r, arg) => { + let mut stub = functor!("put_variable", 2, + [heap_str!(h + 3), + heap_integer!(Integer::from(arg))]); + + stub.append(&mut reg_type_into_functor(r)); + stub + }, + &QueryInstruction::SetConstant(ref constant) => + functor!("set_constant", 1, [heap_con!(constant.clone())]), + &QueryInstruction::SetLocalValue(r) => { + let mut stub = functor!("set_local_value", 1, [heap_str!(h + 2)]); + + stub.append(&mut reg_type_into_functor(r)); + stub + }, + &QueryInstruction::SetVariable(r) => { + let mut stub = functor!("set_variable", 1, [heap_str!(h + 2)]); + + stub.append(&mut reg_type_into_functor(r)); + stub + }, + &QueryInstruction::SetValue(r) => { + let mut stub = functor!("set_value", 1, [heap_str!(h + 2)]); + + stub.append(&mut reg_type_into_functor(r)); + stub + }, + &QueryInstruction::SetVoid(vars) => + functor!("set_void", 1, [heap_integer!(Integer::from(vars))]) + } + } +} + pub type CompiledFact = Vec; pub type ThirdLevelIndex = Vec; diff --git a/src/prolog/lib/diag.pl b/src/prolog/lib/diag.pl new file mode 100644 index 00000000..8e4799ed --- /dev/null +++ b/src/prolog/lib/diag.pl @@ -0,0 +1,14 @@ +:- module(diag, [wam_instructions/2]). + +:- use_module('src/prolog/lib/error'). + +wam_instructions(Clause, Listing) :- + ( nonvar(Clause) -> + Clause = Name / Arity, + must_be(atom, Name), + must_be(integer, Arity), + ( Arity >= 0 -> '$wam_instructions'(Name, Arity, Listing) + ; throw(error(domain_error(not_less_than_zero, Arity), wam_instructions/2)) + ) + ; throw(error(instantiation_error, wam_instructions/2)) + ). diff --git a/src/prolog/machine/heap.rs b/src/prolog/machine/heap.rs index d64654d9..ba0a9eac 100644 --- a/src/prolog/machine/heap.rs +++ b/src/prolog/machine/heap.rs @@ -74,6 +74,12 @@ impl Heap { self.push(HeapCellValue::Addr(Addr::Con(Constant::EmptyList))); head_addr } + + pub fn extend>(&mut self, iter: Iter) { + for hcv in iter { + self.push(hcv); + } + } } impl Index for Heap { diff --git a/src/prolog/machine/machine_errors.rs b/src/prolog/machine/machine_errors.rs index ae2bb38b..b9f630e9 100644 --- a/src/prolog/machine/machine_errors.rs +++ b/src/prolog/machine/machine_errors.rs @@ -5,7 +5,7 @@ use prolog::machine::machine_indices::*; use prolog::machine::machine_state::*; use prolog::rug::Integer; -pub(super) type MachineStub = Vec; +pub(crate) type MachineStub = Vec; #[derive(Clone, Copy)] enum ErrorProvenance { diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 486f2f0d..2d4f2380 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -10,6 +10,7 @@ use prolog::heap_print::*; use prolog::instructions::*; use prolog::machine::attributed_variables::*; use prolog::machine::and_stack::*; +use prolog::machine::code_repo::CodeRepo; use prolog::machine::copier::*; use prolog::machine::heap::*; use prolog::machine::or_stack::*; @@ -2975,6 +2976,7 @@ impl MachineState { } fn handle_call_clause(&mut self, indices: &mut IndexStore, + code_repo: &CodeRepo, call_policy: &mut Box, cut_policy: &mut Box, parsing_stream: &mut PrologStream, @@ -3010,22 +3012,25 @@ impl MachineState { try_or_fail!(self, call_policy.context_call(self, name.clone(), arity, idx.clone(), indices)), &ClauseType::System(ref ct) => - try_or_fail!(self, self.system_call(ct, indices, call_policy, cut_policy, + try_or_fail!(self, self.system_call(ct, code_repo, indices, call_policy, cut_policy, parsing_stream)) }; } - pub(super) fn execute_ctrl_instr(&mut self, indices: &mut IndexStore, - call_policy: &mut Box, - cut_policy: &mut Box, - parsing_stream: &mut PrologStream, - instr: &ControlInstruction) + pub(super) + fn execute_ctrl_instr(&mut self, + indices: &mut IndexStore, + code_repo: &CodeRepo, + call_policy: &mut Box, + cut_policy: &mut Box, + parsing_stream: &mut PrologStream, + instr: &ControlInstruction) { match instr { &ControlInstruction::Allocate(num_cells) => self.allocate(num_cells), &ControlInstruction::CallClause(ref ct, arity, _, lco, use_default_cp) => - self.handle_call_clause(indices, call_policy, cut_policy, + self.handle_call_clause(indices, code_repo, call_policy, cut_policy, parsing_stream, ct, arity, lco, use_default_cp), &ControlInstruction::Deallocate => self.deallocate(), diff --git a/src/prolog/machine/mod.rs b/src/prolog/machine/mod.rs index c8cbce26..2da2cbdd 100644 --- a/src/prolog/machine/mod.rs +++ b/src/prolog/machine/mod.rs @@ -688,7 +688,7 @@ impl MachineState { } fn dispatch_instr(&mut self, instr: &Line, indices: &mut IndexStore, policies: &mut MachinePolicies, - prolog_stream: &mut PrologStream) + code_repo: &CodeRepo, prolog_stream: &mut PrologStream) { match instr { &Line::Arithmetic(ref arith_instr) => @@ -698,7 +698,7 @@ impl MachineState { &Line::Cut(ref cut_instr) => self.execute_cut_instr(cut_instr, &mut policies.cut_policy), &Line::Control(ref control_instr) => - self.execute_ctrl_instr(indices, &mut policies.call_policy, + self.execute_ctrl_instr(indices, code_repo, &mut policies.call_policy, &mut policies.cut_policy, prolog_stream, control_instr), &Line::Fact(ref fact_instr) => { @@ -724,7 +724,7 @@ impl MachineState { None => return }; - self.dispatch_instr(instr.as_ref(), indices, policies, prolog_stream); + self.dispatch_instr(instr.as_ref(), indices, policies, code_repo, prolog_stream); } fn backtrack(&mut self) @@ -793,7 +793,7 @@ impl MachineState { None => return false }; - self.dispatch_instr(instr.as_ref(), indices, policies, prolog_stream); + self.dispatch_instr(instr.as_ref(), indices, policies, code_repo, prolog_stream); if self.fail { self.backtrack(); diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index 81f63c69..5b0a1987 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -6,6 +6,8 @@ use prolog_parser::tabled_rc::*; use prolog::clause_types::*; use prolog::forms::*; use prolog::heap_print::*; +use prolog::instructions::*; +use prolog::machine::code_repo::CodeRepo; use prolog::machine::copier::*; use prolog::machine::machine_errors::*; use prolog::machine::machine_indices::*; @@ -15,7 +17,7 @@ use prolog::ordered_float::OrderedFloat; use prolog::read::{PrologStream, readline}; use prolog::rug::Integer; -use std::collections::{HashMap, HashSet}; +use std::collections::{HashMap, HashSet, VecDeque}; use std::io::{stdout, Write}; use std::iter::once; use std::mem; @@ -34,6 +36,21 @@ impl BrentAlgState { } } +fn scan_for_trust_me(code: &Code, jmp_offsets: &mut VecDeque, after_idx: &mut usize) { + for (idx, instr) in code[*after_idx ..].iter().enumerate() { + match instr { + &Line::Choice(ChoiceInstruction::TrustMe) + | &Line::IndexedChoice(IndexedChoiceInstruction::Trust(..)) => { + *after_idx += idx; + return; + }, + &Line::Control(ControlInstruction::JmpBy(_, offset, ..)) => + jmp_offsets.push_back(*after_idx + idx + offset), + _ => {} + } + } +} + fn is_builtin_predicate(name: &ClauseName) -> bool { let in_builtins = name.owning_module().as_str() == "builtins"; let hidden_name = name.as_str().starts_with("$"); @@ -385,13 +402,61 @@ impl MachineState { Ok(()) } - pub(super) fn system_call(&mut self, - ct: &SystemClauseType, - indices: &mut IndexStore, - call_policy: &mut Box, - cut_policy: &mut Box, - current_input_stream: &mut PrologStream) - -> CallResult + fn create_instruction_functors(&mut self, code: &Code, first_idx: usize) -> Vec + { + let mut queue = VecDeque::new(); + let mut functors = vec![]; + let mut h = self.heap.h; + + queue.push_back(first_idx); + + while let Some(first_idx) = queue.pop_front() { + let mut last_idx = first_idx; + + loop { + match &code[last_idx] { + &Line::Choice(ChoiceInstruction::TryMeElse(..)) + | &Line::IndexedChoice(IndexedChoiceInstruction::Try(..)) => { + last_idx += 1; + scan_for_trust_me(code, &mut queue, &mut last_idx); + }, + &Line::Control(ControlInstruction::JmpBy(_, offset, _, false)) => { + queue.push_back(last_idx + offset); + last_idx += 1; + }, + &Line::Control(ControlInstruction::JmpBy(_, offset, _, true)) => { + queue.push_back(last_idx + offset); + break; + }, + &Line::Control(ControlInstruction::Proceed) + | &Line::Control(ControlInstruction::CallClause(_, _, _, true, _)) => + break, + _ => + last_idx += 1 + }; + } + + for instr in &code[first_idx .. last_idx + 1] { + let section = instr.to_functor(h); + functors.push(Addr::HeapCell(h)); + + h += section.len(); + self.heap.extend(section.into_iter()); + } + } + + functors + } + + pub(super) + fn system_call(&mut self, + ct: &SystemClauseType, + code_repo: &CodeRepo, + indices: &mut IndexStore, + call_policy: &mut Box, + cut_policy: &mut Box, + current_input_stream: &mut PrologStream) + -> CallResult { match ct { &SystemClauseType::AbolishClause => { @@ -1640,6 +1705,55 @@ impl MachineState { self.unwind_stack(), &SystemClauseType::Variant => self.fail = self.structural_eq_test(), + &SystemClauseType::WAMInstructions => { + let name = self[temp_v!(1)].clone(); + let arity = self[temp_v!(2)].clone(); + + let name = match self.store(self.deref(name)) { + Addr::Con(Constant::Atom(name, _)) => name, + _ => unreachable!() + }; + + let arity = match self.store(self.deref(arity)) { + Addr::Con(Constant::Integer(n)) => n, + _ => unreachable!() + }; + + let first_idx = match indices.code_dir.get(&(name.clone(), arity.to_usize().unwrap())) + { + Some(ref idx) => + if let Some(idx) = idx.local() { + idx + } else { + let arity = arity.to_usize().unwrap(); + let stub = MachineError::functor_stub(name.clone(), arity); + let h = self.heap.h; + + let err = MachineError::existence_error(h, ExistenceError::Procedure(name, arity)); + let err = self.error_form(err, stub); + + self.throw_exception(err); + return Ok(()); + }, + None => { + let arity = arity.to_usize().unwrap(); + let stub = MachineError::functor_stub(name.clone(), arity); + let h = self.heap.h; + + let err = MachineError::existence_error(h, ExistenceError::Procedure(name, arity)); + let err = self.error_form(err, stub); + + self.throw_exception(err); + return Ok(()); + } + }; + + let functors = self.create_instruction_functors(&code_repo.code, first_idx); + let listing = Addr::HeapCell(self.heap.to_list(functors.into_iter())); + let listing_var = self[temp_v!(3)].clone(); + + self.unify(listing, listing_var); + }, &SystemClauseType::WriteTerm => { let addr = self[temp_v!(1)].clone(); diff --git a/src/prolog/macros.rs b/src/prolog/macros.rs index 8ff8f36b..9d60643c 100644 --- a/src/prolog/macros.rs +++ b/src/prolog/macros.rs @@ -16,6 +16,18 @@ macro_rules! heap_integer { ) } +macro_rules! heap_cell { + ($i:expr) => ( + HeapCellValue::Addr(Addr::HeapCell($i)) + ) +} + +macro_rules! heap_con { + ($i:expr) => ( + HeapCellValue::Addr(Addr::Con($i)) + ) +} + macro_rules! heap_atom { ($name:expr) => ( HeapCellValue::Addr(Addr::Con(atom!($name))) diff --git a/src/prolog/mod.rs b/src/prolog/mod.rs index 435f20f8..6575f500 100644 --- a/src/prolog/mod.rs +++ b/src/prolog/mod.rs @@ -3,8 +3,8 @@ extern crate ordered_float; extern crate prolog_parser; extern crate rug; -pub mod instructions; #[macro_use] mod macros; +pub mod instructions; mod clause_types; #[macro_use] mod allocator; mod fixtures; -- 2.54.0