From 2fb5408ab5db850817cbf3580f085df71684573a Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sat, 2 Mar 2019 00:27:40 -0700 Subject: [PATCH] add assertz/1 and asserta/1 --- README.md | 3 + src/prolog/instructions.rs | 15 +++++ src/prolog/lib/builtins.pl | 52 +++++++++++++-- src/prolog/machine/dynamic_database.rs | 92 ++++++++++++++++++++++++++ src/prolog/machine/machine_errors.rs | 20 ------ src/prolog/machine/mod.rs | 26 ++++++-- src/prolog/machine/system_calls.rs | 20 ++++-- src/prolog/read.rs | 2 +- src/prolog/toplevel.rs | 2 +- src/tests.rs | 42 ++++++++++++ 10 files changed, 238 insertions(+), 36 deletions(-) create mode 100644 src/prolog/machine/dynamic_database.rs diff --git a/README.md b/README.md index db007f97..84b6989e 100644 --- a/README.md +++ b/README.md @@ -134,6 +134,8 @@ The following predicates are built-in to rusty-wam. * `acyclic_term/2` * `append/3` * `arg/3` +* `asserta/1` +* `assertz/1` * `atom/1` * `atomic/1` * `bagof/3` @@ -144,6 +146,7 @@ The following predicates are built-in to rusty-wam. * `call_residue_vars/2` * `can_be/2` * `catch/3` +* `clause/2` * `compare/3` * `compound/1` * `copy_term/2` diff --git a/src/prolog/instructions.rs b/src/prolog/instructions.rs index cdd19001..82ebe7c0 100644 --- a/src/prolog/instructions.rs +++ b/src/prolog/instructions.rs @@ -245,6 +245,8 @@ pub struct Module { #[derive(Copy, Clone, PartialEq)] pub enum SystemClauseType { + AssertDynamicPredicateToBack, + AssertDynamicPredicateToFront, CheckCutPoint, CopyToLiftedHeap, DeleteAttribute, @@ -301,6 +303,8 @@ pub enum SystemClauseType { impl SystemClauseType { pub fn name(&self) -> ClauseName { match self { + &SystemClauseType::AssertDynamicPredicateToBack => clause_name!("$asserta"), + &SystemClauseType::AssertDynamicPredicateToFront => clause_name!("$assertz"), &SystemClauseType::CheckCutPoint => clause_name!("$check_cp"), &SystemClauseType::CopyToLiftedHeap => clause_name!("$copy_to_lh"), &SystemClauseType::DeleteAttribute => clause_name!("$del_attr_non_head"), @@ -357,6 +361,8 @@ impl SystemClauseType { pub fn from(name: &str, arity: usize) -> Option { match (name, arity) { + ("$asserta", 4) => Some(SystemClauseType::AssertDynamicPredicateToFront), + ("$assertz", 4) => Some(SystemClauseType::AssertDynamicPredicateToBack), ("$check_cp", 1) => Some(SystemClauseType::CheckCutPoint), ("$copy_to_lh", 2) => Some(SystemClauseType::CopyToLiftedHeap), ("$del_attr_non_head", 1) => Some(SystemClauseType::DeleteAttribute), @@ -995,12 +1001,21 @@ pub enum DynamicAssertPlace { } impl DynamicAssertPlace { + #[inline] pub fn predicate_name(self) -> ClauseName { match self { DynamicAssertPlace::Back => clause_name!("assertz"), DynamicAssertPlace::Front => clause_name!("asserta") } } + + #[inline] + pub fn push_to_queue(self, addrs: &mut VecDeque, new_addr: Addr) { + match self { + DynamicAssertPlace::Back => addrs.push_back(new_addr), + DynamicAssertPlace::Front => addrs.push_front(new_addr) + } + } } #[derive(Clone, Copy, PartialEq)] diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index aeb08af5..82983ef7 100644 --- a/src/prolog/lib/builtins.pl +++ b/src/prolog/lib/builtins.pl @@ -5,9 +5,9 @@ (div)/2, (//)/2, (rdiv)/2, (<<)/2, (>>)/2, (mod)/2, (rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2, (-)/1, (>=)/2, (=<)/2, (,)/2, (->)/2, (;)/2, (=..)/2, (==)/2, (\==)/2, (@=<)/2, (@>=)/2, - (@<)/2, (@>)/2, (=@=)/2, (\=@=)/2, (:)/2, bagof/3, - call_with_inference_limit/3, catch/3, clause/2, - current_prolog_flag/2, expand_goal/2, expand_term/2, + (@<)/2, (@>)/2, (=@=)/2, (\=@=)/2, (:)/2, asserta/1, + assertz/1, bagof/3, call_with_inference_limit/3, catch/3, + clause/2, current_prolog_flag/2, expand_goal/2, expand_term/2, findall/3, findall/4, once/1, repeat/0, set_prolog_flag/2, setof/3, setup_call_cleanup/3, term_variables/2, throw/1, true/0, false/0, write/1, write_canonical/1, writeq/1, @@ -459,8 +459,8 @@ setof(Template, Goal, Solution) :- '$clause_body_is_valid'(B) :- ( var(B) -> true - ; functor(B, Name, _) -> ( Name == '.' -> throw(error(type_error(callable, B), clause/2)) - ; true + ; functor(B, Name, _) -> ( atom(Name), Name \= '.' -> true + ; throw(error(type_error(callable, B), clause/2)) ) ; throw(error(type_error(callable, B), clause/2)) ). @@ -477,3 +477,45 @@ clause(H, B) :- ) ; throw(error(type_error(callable, H), clause/2)) ). + +call_asserta(Head, Body, Name, Arity) :- + '$clause_body_is_valid'(Body), + functor(VarHead, Name, Arity), + findall((VarHead :- VarBody), clause(VarHead, VarBody), Clauses), + '$asserta'((Head :- Body), Clauses, Name, Arity). + +asserta_clause(Head, Body) :- + ( var(Head) -> throw(error(instantiation_error, asserta/1)) + ; functor(Head, Name, Arity), atom(Name), Name \== '.' -> + ( '$no_such_predicate'(Head) -> call_asserta(Head, Body, Name, Arity) + ; '$head_is_dynamic'(Head) -> call_asserta(Head, Body, Name, Arity) + ; throw(error(permission_error(modify, static_procedure, Name/Arity), asserta/1)) + ) + ; throw(error(type_error(callable, Head), asserta/1)) + ). + +asserta(Clause) :- + ( Clause \= (_ :- _) -> Head = Clause, Body = true, asserta_clause(Head, Body) + ; Clause = (Head :- Body) -> asserta_clause(Head, Body) + ). + +call_assertz(Head, Body, Name, Arity) :- + '$clause_body_is_valid'(Body), + functor(VarHead, Name, Arity), + findall((VarHead :- VarBody), clause(VarHead, VarBody), Clauses), + '$assertz'((Head :- Body), Clauses, Name, Arity). + +assertz_clause(Head, Body) :- + ( var(Head) -> throw(error(instantiation_error, assertz/1)) + ; functor(Head, Name, Arity), atom(Name), Name \== '.' -> + ( '$no_such_predicate'(Head) -> call_assertz(Head, Body, Name, Arity) + ; '$head_is_dynamic'(Head) -> call_assertz(Head, Body, Name, Arity) + ; throw(error(permission_error(modify, static_procedure, Name/Arity), assertz/1)) + ) + ; throw(error(type_error(callable, Head), assertz/1)) + ). + +assertz(Clause) :- + ( Clause \= (_ :- _) -> Head = Clause, Body = true, assertz_clause(Head, Body) + ; Clause = (Head :- Body) -> assertz_clause(Head, Body) + ). diff --git a/src/prolog/machine/dynamic_database.rs b/src/prolog/machine/dynamic_database.rs new file mode 100644 index 00000000..6b7ee6d5 --- /dev/null +++ b/src/prolog/machine/dynamic_database.rs @@ -0,0 +1,92 @@ +use prolog_parser::ast::*; + +use prolog::compile::*; +use prolog::heap_print::*; +use prolog::instructions::*; +use prolog::machine::*; +use prolog::machine::machine_errors::*; +use prolog::num::ToPrimitive; + +impl Machine { + fn get_dynamic_predicate_key(&self) -> PredicateKey { + let name = self.machine_st[temp_v!(3)].clone(); + let arity = self.machine_st[temp_v!(4)].clone(); + + let name = match self.machine_st.store(self.machine_st.deref(name)) { + Addr::Con(Constant::Atom(name, _)) => name, + _ => unreachable!() + }; + + let arity = match self.machine_st.store(self.machine_st.deref(arity)) { + Addr::Con(Constant::Number(Number::Integer(arity))) => + arity.to_usize().unwrap(), + _ => unreachable!() + }; + + (name, arity) + } + + fn print_new_dynamic_clause(&self, addrs: VecDeque) -> String + { + let mut output = PrinterOutputter::new(); + let (name, arity) = self.get_dynamic_predicate_key(); + + output.append(format!(":- dynamic({}/{}). ", name.as_str(), arity) + .as_str()); + + for addr in addrs { + let mut printer = HCPrinter::new(&self.machine_st, output); + printer.quoted = true; + + output = printer.print(addr); + output.append(". "); + } + + output.result() + } + + fn handle_eval_result_from_dynamic_compile(&mut self, result: EvalSession) + { + if let EvalSession::Error(e) = result { + println!("{}\r", e); + self.machine_st.fail = true; + } + } + + fn recompile_dynamic_predicate(&mut self, place: DynamicAssertPlace) + { + let stub = MachineError::functor_stub(place.predicate_name(), 1); + + let pred_str = match self.machine_st.try_from_list(temp_v!(2), stub) { + Ok(addrs) => { + let mut addrs = VecDeque::from(addrs); + let added_clause = self.machine_st[temp_v!(1)].clone(); + + place.push_to_queue(&mut addrs, added_clause); + self.print_new_dynamic_clause(addrs) + }, + Err(err) => + return self.machine_st.throw_exception(err) + }; + + let machine_st = mem::replace(&mut self.machine_st, MachineState::new()); + + let result = compile_user_module(self, pred_str.as_bytes()); + self.machine_st = machine_st; + + self.handle_eval_result_from_dynamic_compile(result); + } + + pub(super) + fn dynamic_transaction(&mut self, trans_type: DynamicTransactionType, p: LocalCodePtr) + { + match trans_type { + DynamicTransactionType::Abolish => {}, + DynamicTransactionType::Assert(place) => + self.recompile_dynamic_predicate(place), + DynamicTransactionType::Retract(idx) => {} + } + + self.machine_st.p = CodePtr::Local(p); + } +} diff --git a/src/prolog/machine/machine_errors.rs b/src/prolog/machine/machine_errors.rs index 653ada62..4a3af940 100644 --- a/src/prolog/machine/machine_errors.rs +++ b/src/prolog/machine/machine_errors.rs @@ -25,13 +25,6 @@ impl MachineError { functor!("/", 2, [name, heap_integer!(arity)], (400, YFX)) } - pub(super) fn static_modification_error(perm_error: PermissionError, culprit: Addr) -> Self { - let stub = functor!("permission_error", 3, [heap_atom!(perm_error.as_str()), - heap_atom!("static_procedure"), - HeapCellValue::Addr(culprit)]); - MachineError { stub, from: ErrorProvenance::Received } - } - pub(super) fn evaluation_error(eval_error: EvalError) -> Self { let stub = functor!("evaluation_error", 1, [heap_atom!(eval_error.as_str())]); MachineError { stub, from: ErrorProvenance::Received } @@ -160,19 +153,6 @@ impl ValidType { } } -#[derive(Clone, Copy)] -pub enum PermissionError { - Modify -} - -impl PermissionError { - pub fn as_str(self) -> &'static str { - match self { - PermissionError::Modify => "modify" - } - } -} - #[derive(Clone, Copy)] pub enum DomainError { NotLessThanZero diff --git a/src/prolog/machine/mod.rs b/src/prolog/machine/mod.rs index a35d3318..e9e79c5c 100644 --- a/src/prolog/machine/mod.rs +++ b/src/prolog/machine/mod.rs @@ -8,6 +8,7 @@ use prolog::heap_print::*; use prolog::instructions::*; mod attributed_variables; +mod dynamic_database; mod machine_errors; pub(super) mod machine_state; pub(super) mod term_expansion; @@ -69,19 +70,19 @@ impl IndexStore { -> bool { match ClauseType::from(name, arity, op_spec) { - ClauseType::Named(name, arity, _) => + ClauseType::Named(name, arity, _) => self.code_dir.contains_key(&(name, arity)), ClauseType::Op(op_decl, ..) => self.code_dir.contains_key(&(op_decl.name(), op_decl.arity())), _ => true } } - + #[inline] pub fn get_clause_subsection(&self, name: ClauseName, arity: usize) -> Option { self.dynamic_code_dir.get(&(name, arity)).cloned() } - + #[inline] pub fn take_module(&mut self, name: ClauseName) -> Option { self.modules.remove(&name) @@ -557,8 +558,23 @@ impl Machine { match self.machine_st.p { CodePtr::Local(LocalCodePtr::TopLevel(_, p)) if p > 0 => {}, - CodePtr::DynamicTransaction(trans_type, p) => {}, -// self.dynamic_transaction(trans_type, p), + CodePtr::DynamicTransaction(trans_type, p) => { + // self.code_repo.cached_query is about to be overwritten by the term expander, + // so hold onto it locally and restore it after the compiler has finished. + let cached_query = mem::replace(&mut self.code_repo.cached_query, vec![]); + self.dynamic_transaction(trans_type, p); + + if let CodePtr::Local(LocalCodePtr::TopLevel(_, 0)) = self.machine_st.p { + if heap_locs.is_empty() { + self.record_var_places(0, alloc_locs, heap_locs); + } + + self.code_repo.cached_query = cached_query; + break; + } + + self.code_repo.cached_query = cached_query; + }, _ => { if heap_locs.is_empty() { self.record_var_places(0, alloc_locs, heap_locs); diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index 2e1bc2c0..b2da5bd9 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -230,6 +230,20 @@ impl MachineState { -> CallResult { match ct { + &SystemClauseType::AssertDynamicPredicateToFront => { + let p = self.cp; + let trans_type = DynamicTransactionType::Assert(DynamicAssertPlace::Front); + + self.p = CodePtr::DynamicTransaction(trans_type, p); + return Ok(()); + }, + &SystemClauseType::AssertDynamicPredicateToBack => { + let p = self.cp; + let trans_type = DynamicTransactionType::Assert(DynamicAssertPlace::Back); + + self.p = CodePtr::DynamicTransaction(trans_type, p); + return Ok(()); + }, &SystemClauseType::LiftedHeapLength => { let a1 = self[temp_v!(1)].clone(); let lh_len = Addr::Con(Constant::Usize(self.lifted_heap.len())); @@ -260,7 +274,6 @@ impl MachineState { }; }, &SystemClauseType::CopyToLiftedHeap => - // now, stagger everything down by the length of the heap + lh offset. match self.store(self.deref(self[temp_v!(1)].clone())) { Addr::Con(Constant::Usize(lh_offset)) => { let copy_target = self[temp_v!(2)].clone(); @@ -304,10 +317,10 @@ impl MachineState { self.heap[h+1] = HeapCellValue::Addr(Addr::HeapCell(l+1)); self.trail(TrailRef::AttrVarLink(h+1, Addr::Lis(l))); }, - _ => {} + _ => unreachable!() } }, - _ => {} + _ => unreachable!() } }, &SystemClauseType::DynamicModuleResolution => { @@ -764,7 +777,6 @@ impl MachineState { }, &SystemClauseType::GetClause => { let head = self[temp_v!(1)].clone(); - let body = self[temp_v!(2)].clone(); let subsection = match self.store(self.deref(head)) { Addr::Str(s) => diff --git a/src/prolog/read.rs b/src/prolog/read.rs index 357b8b57..07f7a501 100644 --- a/src/prolog/read.rs +++ b/src/prolog/read.rs @@ -116,7 +116,7 @@ pub(crate) fn write_term_to_heap(term: &Term, machine_st: &mut MachineState) -> }, &TermRef::AnonVar(Level::Root) | &TermRef::Constant(Level::Root, ..) => machine_st.heap.push(HeapCellValue::Addr(term.as_addr(h))), - &TermRef::Var(Level::Root, _, ref name) => + &TermRef::Var(Level::Root, ..) => machine_st.heap.push(HeapCellValue::Addr(term.as_addr(h))), &TermRef::AnonVar(_) => { if let Some((arity, site_h)) = queue.pop_front() { diff --git a/src/prolog/toplevel.rs b/src/prolog/toplevel.rs index 2b28e56c..2fdd8335 100644 --- a/src/prolog/toplevel.rs +++ b/src/prolog/toplevel.rs @@ -832,7 +832,7 @@ impl<'a, R: Read> TopLevelBatchWorker<'a, R> { fn take_dynamic_clauses(&mut self) { let (name, arity) = match self.rel_worker.dynamic_clauses.first() { - Some((head, tail)) => + Some((head, _)) => (head.name().unwrap(), head.arity()), None => return diff --git a/src/tests.rs b/src/tests.rs index 3824cad9..14e854d4 100644 --- a/src/tests.rs +++ b/src/tests.rs @@ -1815,8 +1815,50 @@ insect(bee)."); assert_prolog_success!(&mut wam, "?- catch(clause(4, _), error(type_error(callable, 4), _), true)."); assert_prolog_success!(&mut wam, "?- catch(clause(elk(N), _), error(permission_error(access, private_procedure, elk/1), _), true)."); assert_prolog_success!(&mut wam, "?- catch(clause(atom(N), _), error(permission_error(access, private_procedure, atom/1), _), true)."); + + assert_prolog_success!(&mut wam, "?- asserta(legs(octopus, 8))."); + assert_prolog_success!(&mut wam, "?- asserta( (legs(A, 4) :- animal(A)) )."); + assert_prolog_success!(&mut wam, "?- asserta( (foo(X) :- X, call(X)) )."); + assert_prolog_success!(&mut wam, "?- catch(asserta(_), error(instantiation_error, _), true)."); + assert_prolog_failure!(&mut wam, "?- asserta(_)."); + assert_prolog_success!(&mut wam, "?- catch(asserta(4), error(type_error(callable, 4), _), true)."); + assert_prolog_failure!(&mut wam, "?- asserta(4)."); + assert_prolog_success!(&mut wam, "?- catch(asserta( (foo :- 4) ), error(type_error(callable, 4), _), true)."); + assert_prolog_failure!(&mut wam, "?- asserta( (foo :- 4) )."); + assert_prolog_success!(&mut wam, "?- catch(asserta( (atom(_) :- true) ), error(permission_error(modify, static_procedure, atom/1), _), true)."); + assert_prolog_failure!(&mut wam, "?- asserta( (atom(_) :- true) )."); + + submit(&mut wam, " +:- dynamic(cat/0). +cat. + +:- dynamic(dog/0). +dog :- true. + +elk(X) :- moose(X). + +:- dynamic(legs/2). +legs(A, 6) :- insect(A). +legs(A, 7) :- A, call(A). + +:- dynamic(insect/1). +insect(ant). +insect(bee)."); + + assert_prolog_success!(&mut wam, "?- assertz(legs(octopus, 8))."); + assert_prolog_success!(&mut wam, "?- assertz( (legs(A, 4) :- animal(A)) )."); + assert_prolog_success!(&mut wam, "?- assertz( (foo(X) :- X, call(X)) )."); + assert_prolog_success!(&mut wam, "?- catch(assertz(_), error(instantiation_error, _), true)."); + assert_prolog_failure!(&mut wam, "?- assertz(_)."); + assert_prolog_success!(&mut wam, "?- catch(assertz(4), error(type_error(callable, 4), _), true)."); + assert_prolog_failure!(&mut wam, "?- assertz(4)."); + assert_prolog_success!(&mut wam, "?- catch(assertz( (foo :- 4) ), error(type_error(callable, 4), _), true)."); + assert_prolog_failure!(&mut wam, "?- assertz( (foo :- 4) )."); + assert_prolog_success!(&mut wam, "?- catch(assertz( (atom(_) :- true) ), error(permission_error(modify, static_procedure, atom/1), _), true)."); + assert_prolog_failure!(&mut wam, "?- assertz( (atom(_) :- true) )."); } + #[test] fn test_queries_on_setup_call_cleanup() { -- 2.54.0