From e4cb9044709de4234c7a0a6afc250ccb132fe6f0 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sat, 2 Mar 2019 16:57:45 -0700 Subject: [PATCH] correct inlined calling bug in last call, add dynamic database manipulation predicates --- Cargo.lock | 8 +- Cargo.toml | 4 +- README.md | 7 +- src/prolog/instructions.rs | 17 +- src/prolog/lib/builtins.pl | 197 +++++++++++++++++++++-- src/prolog/machine/dynamic_database.rs | 82 +++++++--- src/prolog/machine/machine_errors.rs | 45 ++++++ src/prolog/machine/machine_state_impl.rs | 24 +-- src/prolog/machine/mod.rs | 22 +-- src/prolog/machine/system_calls.rs | 33 ++++ src/prolog/write.rs | 34 ++-- src/tests.rs | 55 +++++++ 12 files changed, 451 insertions(+), 77 deletions(-) diff --git a/Cargo.lock b/Cargo.lock index 31592201..8ec9cd09 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -86,8 +86,7 @@ dependencies = [ [[package]] name = "prolog_parser" -version = "0.8.0" -source = "registry+https://github.com/rust-lang/crates.io-index" +version = "0.8.1" dependencies = [ "num 0.2.0 (registry+https://github.com/rust-lang/crates.io-index)", "ordered-float 0.5.0 (registry+https://github.com/rust-lang/crates.io-index)", @@ -108,12 +107,12 @@ dependencies = [ [[package]] name = "rusty-wam" -version = "0.8.0" +version = "0.8.1" dependencies = [ "downcast 0.9.1 (registry+https://github.com/rust-lang/crates.io-index)", "num 0.2.0 (registry+https://github.com/rust-lang/crates.io-index)", "ordered-float 0.5.0 (registry+https://github.com/rust-lang/crates.io-index)", - "prolog_parser 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)", + "prolog_parser 0.8.1", "termion 1.5.1 (registry+https://github.com/rust-lang/crates.io-index)", ] @@ -152,7 +151,6 @@ source = "registry+https://github.com/rust-lang/crates.io-index" "checksum num-traits 0.1.41 (registry+https://github.com/rust-lang/crates.io-index)" = "cacfcab5eb48250ee7d0c7896b51a2c5eec99c1feea5f32025635f5ae4b00070" "checksum num-traits 0.2.5 (registry+https://github.com/rust-lang/crates.io-index)" = "630de1ef5cc79d0cdd78b7e33b81f083cbfe90de0f4b2b2f07f905867c70e9fe" "checksum ordered-float 0.5.0 (registry+https://github.com/rust-lang/crates.io-index)" = "58d25b6c0e47b20d05226d288ff434940296e7e2f8b877975da32f862152241f" -"checksum prolog_parser 0.8.0 (registry+https://github.com/rust-lang/crates.io-index)" = "531868706c63383ba9f3c0a72d6176c8367f38188f8b6e892e8cf7b451d63237" "checksum redox_syscall 0.1.32 (registry+https://github.com/rust-lang/crates.io-index)" = "ab105df655884ede59d45b7070c8a65002d921461ee813a024558ca16030eea0" "checksum redox_termios 0.1.1 (registry+https://github.com/rust-lang/crates.io-index)" = "7e891cfe48e9100a70a3b6eb652fef28920c117d366339687bd5576160db0f76" "checksum termion 1.5.1 (registry+https://github.com/rust-lang/crates.io-index)" = "689a3bdfaab439fd92bc87df5c4c78417d3cbe537487274e9b0b2dce76e92096" diff --git a/Cargo.toml b/Cargo.toml index 2f383e20..2395dd58 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -1,6 +1,6 @@ [package] name = "rusty-wam" -version = "0.8.0" +version = "0.8.1" authors = ["Mark Thom "] repository = "https://github.com/mthom/rusty-wam" description = "The Warren Abstract Machine in Rust." @@ -10,7 +10,7 @@ license = "BSD-3-Clause" downcast = "0.9.1" num = "0.2" ordered-float = "0.5.0" -prolog_parser = "0.8.0" +prolog_parser = "0.8.1" [dependencies.termion] version = "1.4.0" \ No newline at end of file diff --git a/README.md b/README.md index 84b6989e..e597fcf2 100644 --- a/README.md +++ b/README.md @@ -46,8 +46,8 @@ Extend rusty-wam to include the following, among other features: paper "Indexing `dif/2`" (_done_). * All-solutions predicates (`findall/{3,4}`, `bagof/3`, `setof/3`) (_done_). * Clause creation and destruction (`asserta/1`, `assertz/1`, - `retract/1`, `abolish/1`) with logical update semantics (_in progress_). -* Streams and predicates for stream control. + `retract/1`, `abolish/1`) with logical update semantics (_done_). +* Streams and predicates for stream control (_in progress_). * An incremental compacting garbage collector satisfying the five properties of "Precise Garbage Collection in Prolog." * Mode declarations. @@ -131,6 +131,7 @@ The following predicates are built-in to rusty-wam. * `(=..)/2` * `(->)/2` * `(;)/2` +* `abolish/1` * `acyclic_term/2` * `append/3` * `arg/3` @@ -150,6 +151,7 @@ The following predicates are built-in to rusty-wam. * `compare/3` * `compound/1` * `copy_term/2` +* `current_predicate/1` * `cyclic_term/1` * `dif/2` * `expand_goal/2` @@ -182,6 +184,7 @@ The following predicates are built-in to rusty-wam. * `rational/1` * `read/1` * `repeat/{0,1}` +* `retract/1` * `reverse/2` * `select/3` * `setof/3` diff --git a/src/prolog/instructions.rs b/src/prolog/instructions.rs index 82ebe7c0..64b88227 100644 --- a/src/prolog/instructions.rs +++ b/src/prolog/instructions.rs @@ -245,6 +245,7 @@ pub struct Module { #[derive(Copy, Clone, PartialEq)] pub enum SystemClauseType { + AbolishClause, AssertDynamicPredicateToBack, AssertDynamicPredicateToFront, CheckCutPoint, @@ -263,6 +264,7 @@ pub enum SystemClauseType { GetAttrVarQueueBeyond, GetBValue, GetClause, + GetCurrentPredicateList, GetLiftedHeapFromOffset, GetLiftedHeapFromOffsetDiff, GetSCCCleaner, @@ -275,6 +277,7 @@ pub enum SystemClauseType { RedoAttrVarBindings, RemoveCallPolicyCheck, RemoveInferenceCounter, + RetractClause, RestoreCutPolicy, SetCutPoint(RegType), InferenceLevel, @@ -303,6 +306,7 @@ pub enum SystemClauseType { impl SystemClauseType { pub fn name(&self) -> ClauseName { match self { + &SystemClauseType::AbolishClause => clause_name!("$abolish_clause"), &SystemClauseType::AssertDynamicPredicateToBack => clause_name!("$asserta"), &SystemClauseType::AssertDynamicPredicateToFront => clause_name!("$assertz"), &SystemClauseType::CheckCutPoint => clause_name!("$check_cp"), @@ -321,6 +325,7 @@ impl SystemClauseType { &SystemClauseType::GetAttrVarQueueBeyond => clause_name!("$get_attr_var_queue_beyond"), &SystemClauseType::GetLiftedHeapFromOffset => clause_name!("$get_lh_from_offset"), &SystemClauseType::GetLiftedHeapFromOffsetDiff => clause_name!("$get_lh_from_offset_diff"), + &SystemClauseType::GetCurrentPredicateList => clause_name!("$get_current_predicate_list"), &SystemClauseType::GetBValue => clause_name!("$get_b_value"), &SystemClauseType::GetClause => clause_name!("$get_clause"), &SystemClauseType::GetDoubleQuotes => clause_name!("$get_double_quotes"), @@ -344,6 +349,7 @@ impl SystemClauseType { &SystemClauseType::GetCutPoint => clause_name!("$get_cp"), &SystemClauseType::GetCurrentBlock => clause_name!("$get_current_block"), &SystemClauseType::InstallNewBlock => clause_name!("$install_new_block"), + &SystemClauseType::RetractClause => clause_name!("$retract_clause"), &SystemClauseType::ResetBlock => clause_name!("$reset_block"), &SystemClauseType::ReturnFromAttributeGoals => clause_name!("$return_from_attribute_goals"), &SystemClauseType::ReturnFromVerifyAttr => clause_name!("$return_from_verify_attr"), @@ -361,6 +367,7 @@ impl SystemClauseType { pub fn from(name: &str, arity: usize) -> Option { match (name, arity) { + ("$abolish_clause", 2) => Some(SystemClauseType::AbolishClause), ("$asserta", 4) => Some(SystemClauseType::AssertDynamicPredicateToFront), ("$assertz", 4) => Some(SystemClauseType::AssertDynamicPredicateToBack), ("$check_cp", 1) => Some(SystemClauseType::CheckCutPoint), @@ -377,6 +384,7 @@ impl SystemClauseType { ("$get_attr_list", 2) => Some(SystemClauseType::GetAttributedVariableList), ("$get_b_value", 1) => Some(SystemClauseType::GetBValue), ("$get_clause", 2) => Some(SystemClauseType::GetClause), + ("$get_current_predicate_list", 1) => Some(SystemClauseType::GetCurrentPredicateList), ("$get_lh_from_offset", 2) => Some(SystemClauseType::GetLiftedHeapFromOffset), ("$get_lh_from_offset_diff", 3) => Some(SystemClauseType::GetLiftedHeapFromOffsetDiff), ("$get_double_quotes", 1) => Some(SystemClauseType::GetDoubleQuotes), @@ -403,6 +411,7 @@ impl SystemClauseType { ("$get_cp", 1) => Some(SystemClauseType::GetCutPoint), ("$install_new_block", 1) => Some(SystemClauseType::InstallNewBlock), ("$reset_block", 1) => Some(SystemClauseType::ResetBlock), + ("$retract_clause", 4) => Some(SystemClauseType::RetractClause), ("$return_from_attribute_goals", 0) => Some(SystemClauseType::ReturnFromAttributeGoals), ("$return_from_verify_attr", 0) => Some(SystemClauseType::ReturnFromVerifyAttr), ("$set_ball", 1) => Some(SystemClauseType::SetBall), @@ -1022,7 +1031,7 @@ impl DynamicAssertPlace { pub enum DynamicTransactionType { Abolish, Assert(DynamicAssertPlace), - Retract(usize) // dynamic index of the clause to remove. + Retract // dynamic index of the clause to remove. } #[derive(Clone, PartialEq)] @@ -1533,15 +1542,15 @@ pub type HeapVarDict = HashMap, Addr>; pub type AllocVarDict = HashMap, VarData>; pub enum SessionError { - CannotOverwriteBuiltIn(String), - CannotOverwriteImport(String), + CannotOverwriteBuiltIn(ClauseName), + CannotOverwriteImport(ClauseName), ModuleDoesNotContainExport, ModuleNotFound, NamelessEntry, OpIsInfixAndPostFix, ParserError(ParserError), QueryFailure, - QueryFailureWithException(String), + QueryFailureWithException(ClauseName), UserPrompt } diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index 82983ef7..a8372b4e 100644 --- a/src/prolog/lib/builtins.pl +++ b/src/prolog/lib/builtins.pl @@ -3,15 +3,15 @@ :- module(builtins, [(=)/2, (\=)/2, (\+)/1, (+)/1, (+)/2, (**)/2, (*)/2, (-)/1, (-)/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, (\==)/2, (@=<)/2, (@>=)/2, - (@<)/2, (@>)/2, (=@=)/2, (\=@=)/2, (:)/2, asserta/1, + (>)/2, (<)/2, (=\=)/2, (=:=)/2, (>=)/2, (=<)/2, (,)/2, (->)/2, + (;)/2, (=..)/2, (==)/2, (\==)/2, (@=<)/2, (@>=)/2, (@<)/2, + (@>)/2, (=@=)/2, (\=@=)/2, (:)/2, abolish/1, 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, - write_term/2]). + clause/2, current_predicate/1, current_prolog_flag/2, + expand_goal/2, expand_term/2, findall/3, findall/4, once/1, + repeat/0, retract/1, 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, write_term/2]). /* this is an implementation specific declarative operator used to implement call_with_inference_limit/3 and setup_call_cleanup/3. switches to the default trust_me and retry_me_else. Indexing choice @@ -495,8 +495,8 @@ asserta_clause(Head, Body) :- ). asserta(Clause) :- - ( Clause \= (_ :- _) -> Head = Clause, Body = true, asserta_clause(Head, Body) - ; Clause = (Head :- Body) -> asserta_clause(Head, Body) + ( Clause \= (_ :- _) -> Head = Clause, Body = true, asserta_clause(Head, Body) + ; Clause = (Head :- Body) -> asserta_clause(Head, Body) ). call_assertz(Head, Body, Name, Arity) :- @@ -516,6 +516,179 @@ assertz_clause(Head, Body) :- ). assertz(Clause) :- - ( Clause \= (_ :- _) -> Head = Clause, Body = true, assertz_clause(Head, Body) - ; Clause = (Head :- Body) -> assertz_clause(Head, Body) + ( Clause \= (_ :- _) -> Head = Clause, Body = true, assertz_clause(Head, Body) + ; Clause = (Head :- Body) -> assertz_clause(Head, Body) + ). + +first_match_index([Clause0 | Clauses], Clause1, N0, N) :- + ( Clause0 \= Clause1 -> N1 is N0 + 1, + first_match_index(Clauses, Clause1, N1, N) + ; N0 = N, Clause0 = Clause1 + ). + +retract_clauses([Clause|Clauses0], Head, Body, Name, Arity) :- + functor(VarHead, Name, Arity), + findall((VarHead :- VarBody), clause(VarHead, VarBody), Clauses1), + first_match_index(Clauses1, (Head :- Body), 0, N), + ( Clauses0 == [] -> ! + ; true + ), + '$retract_clause'(Name, Arity, N, Clauses1). +retract_clauses([_|Clauses0], Head, Body, Name, Arity) :- + retract_clauses(Clauses0, Head, Body, Name, Arity). + +call_retract(Head, Body, Name, Arity) :- + findall((Head :- Body), clause(Head, Body), Clauses), + retract_clauses(Clauses, Head, Body, Name, Arity). + +retract_clause(Head, Body) :- + ( var(Head) -> throw(error(instantiation_error, retract/1)) + ; functor(Head, Name, Arity), atom(Name), Name \== '.' -> + ( '$head_is_dynamic'(Head) -> call_retract(Head, Body, Name, Arity) + ; '$no_such_predicate'(Head) -> '$fail' + ; throw(error(permission_error(modify, static_procedure, Name/Arity), retract/1)) + ) + ; throw(error(type_error(callable, Head), retract/1)) + ). + +retract(Clause) :- + ( Clause \= (_ :- _) -> Head = Clause, Body = true, retract_clause(Head, Body) + ; Clause = (Head :- Body) -> retract_clause(Head, Body) + ). + +abolish(Pred) :- + ( var(Pred) -> throw(error(instantiation_error), abolish/1) + ; Pred = Name/Arity -> + ( var(Name) -> throw(error(instantiation_error, abolish/1)) + ; var(Arity) -> throw(error(instantiation_error, abolish/1)) + ; integer(Arity) -> + ( \+ atom(Name) -> throw(error(type_error(atom, Name), abolish/1)) + ; Arity < 0 -> throw(domain_error(not_less_than_zero, Arity), abolish/1) + ; max_arity(N), Arity > N -> throw(representation_error(max_arity), abolish/1) + ; functor(Head, Name, Arity) -> + ( '$no_such_predicate'(Head) -> true + ; '$head_is_dynamic'(Head) -> '$abolish_clause'(Name, Arity) + ; throw(error(permission_error(modify, static_procedure, Pred), abolish/1)) + ) + ) + ; throw(error(type_error(integer, Arity), abolish/1)) + ) + ; throw(error(type_error(predicate_indicator, Pred), abolish/1)) + ). + +match_builtins(acyclic_term, 1). +match_builtins(arg, 3). +match_builtins(compare, 3). +match_builtins(cyclic_term, 1). +match_builtins(@>, 2). +match_builtins(@<, 2). +match_builtins(@>=, 2). +match_builtins(@=<, 2). +match_builtins(\\=@=, 2). +match_builtins(=@=, 2). +match_builtins(copy_term, 2). +match_builtins(==, 2). +match_builtins(functor, 3). +match_builtins(ground, 1). +match_builtins(is, 2). +match_builtins(keysort, 2). +match_builtins(nl, 0). +match_builtins(\\==, 2). +match_builtins(is_partial_string, 1). +match_builtins(partial_string, 2). +match_builtins(read, 1). +match_builtins(sort, 2). +match_builtins(>, 2). +match_builtins(<, 2). +match_builtins(>=, 2). +match_builtins(=<, 2). +match_builtins(=\\=, 2). +match_builtins(=:=, 2). +match_builtins(atom, 1). +match_builtins(atomic, 1). +match_builtins(compound, 1). +match_builtins(integer, 1). +match_builtins(rational, 1). +match_builtins(string, 1). +match_builtins(float, 1). +match_builtins(nonvar, 1). +match_builtins(var, 1). +match_builtins(call, 0). +match_builtins(call, 1). +match_builtins(call, 2). +match_builtins(call, 3). +match_builtins(call, 4). +match_builtins(call, 5). +match_builtins(call, 6). +match_builtins(call, 7). +match_builtins(call, 8). +match_builtins(call, 9). +match_builtins(call, 10). +match_builtins(call, 11). +match_builtins(call, 12). +match_builtins(call, 13). +match_builtins(call, 14). +match_builtins(call, 15). +match_builtins(call, 16). +match_builtins(call, 17). +match_builtins(call, 18). +match_builtins(call, 19). +match_builtins(call, 20). +match_builtins(call, 21). +match_builtins(call, 22). +match_builtins(call, 23). +match_builtins(call, 24). +match_builtins(call, 25). +match_builtins(call, 26). +match_builtins(call, 27). +match_builtins(call, 28). +match_builtins(call, 29). +match_builtins(call, 30). +match_builtins(call, 31). +match_builtins(call, 32). +match_builtins(call, 33). +match_builtins(call, 34). +match_builtins(call, 35). +match_builtins(call, 36). +match_builtins(call, 37). +match_builtins(call, 38). +match_builtins(call, 39). +match_builtins(call, 40). +match_builtins(call, 41). +match_builtins(call, 42). +match_builtins(call, 43). +match_builtins(call, 44). +match_builtins(call, 45). +match_builtins(call, 46). +match_builtins(call, 47). +match_builtins(call, 48). +match_builtins(call, 49). +match_builtins(call, 50). +match_builtins(call, 51). +match_builtins(call, 52). +match_builtins(call, 53). +match_builtins(call, 54). +match_builtins(call, 55). +match_builtins(call, 56). +match_builtins(call, 57). +match_builtins(call, 58). +match_builtins(call, 59). +match_builtins(call, 60). +match_builtins(call, 61). +match_builtins(call, 62). +match_builtins(call, 63). + +'$iterate_predicate_list'([Name/Arity|Preds], Name/Arity). +'$iterate_predicate_list'([_|Preds], Pred) :- + '$iterate_predicate_list'(Preds, Pred). +'$iterate_predicate_list'([], Name/Arity) :- + match_builtins(Name, Arity). + +current_predicate(Pred) :- + ( var(Pred) -> throw(error(type_error(predicate_indicator, Pred), current_predicate/1)) + ; Pred = _ / _ -> + ( '$get_current_predicate_list'(Ls), + '$iterate_predicate_list'(Ls, Pred) + ) + ; throw(error(type_error(predicate_indicator, Pred), current_predicate/1)) ). diff --git a/src/prolog/machine/dynamic_database.rs b/src/prolog/machine/dynamic_database.rs index 6b7ee6d5..f47fcfd1 100644 --- a/src/prolog/machine/dynamic_database.rs +++ b/src/prolog/machine/dynamic_database.rs @@ -8,9 +8,9 @@ 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(); + fn get_predicate_key(&self, name: RegType, arity: RegType) -> PredicateKey { + let name = self.machine_st[name].clone(); + let arity = self.machine_st[arity].clone(); let name = match self.machine_st.store(self.machine_st.deref(name)) { Addr::Con(Constant::Atom(name, _)) => name, @@ -26,13 +26,13 @@ impl Machine { (name, arity) } - fn print_new_dynamic_clause(&self, addrs: VecDeque) -> String + fn print_new_dynamic_clause(&self, addrs: VecDeque, name: RegType, arity: RegType) + -> String { let mut output = PrinterOutputter::new(); - let (name, arity) = self.get_dynamic_predicate_key(); + let (name, arity) = self.get_predicate_key(name, arity); - output.append(format!(":- dynamic({}/{}). ", name.as_str(), arity) - .as_str()); + output.append(format!(":- dynamic({}/{}). ", name.as_str(), arity).as_str()); for addr in addrs { let mut printer = HCPrinter::new(&self.machine_st, output); @@ -45,46 +45,90 @@ impl Machine { output.result() } - fn handle_eval_result_from_dynamic_compile(&mut self, result: EvalSession) + fn abolish_dynamic_clause(&mut self, name: RegType, arity: RegType) { - if let EvalSession::Error(e) = result { - println!("{}\r", e); - self.machine_st.fail = true; + let (name, arity) = self.get_predicate_key(name, arity); + + if let Some(idx) = self.indices.code_dir.get(&(name.clone(), arity)) { + set_code_index!(idx, IndexPtr::Undefined, clause_name!("user")); + } + + self.indices.code_dir.remove(&(name.clone(), arity)); + self.indices.dynamic_code_dir.remove(&(name, arity)); + } + + fn handle_eval_result_from_dynamic_compile(&mut self, pred_str: String, src: ClauseName) + { + 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; + + if let EvalSession::Error(err) = result { + let h = self.machine_st.heap.h; + let stub = MachineError::functor_stub(src, 1); + let err = MachineError::session_error(h, err); + let err = self.machine_st.error_form(err, stub); + + self.machine_st.throw_exception(err); } } 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) + self.print_new_dynamic_clause(addrs, temp_v!(3), temp_v!(4)) }, Err(err) => return self.machine_st.throw_exception(err) }; - let machine_st = mem::replace(&mut self.machine_st, MachineState::new()); + self.handle_eval_result_from_dynamic_compile(pred_str, place.predicate_name()); + } - let result = compile_user_module(self, pred_str.as_bytes()); - self.machine_st = machine_st; + fn retract_from_dynamic_predicate(&mut self) { + let index = self.machine_st[temp_v!(3)].clone(); + let index = match self.machine_st.store(self.machine_st.deref(index)) { + Addr::Con(Constant::Number(Number::Integer(n))) => n.to_usize().unwrap(), + _ => unreachable!() + }; + + let stub = MachineError::functor_stub(clause_name!("retract"), 1); + let pred_str = match self.machine_st.try_from_list(temp_v!(4), stub) { + Ok(addrs) => { + let mut addrs = VecDeque::from(addrs); + addrs.remove(index); + + if addrs.is_empty() { + self.abolish_dynamic_clause(temp_v!(1), temp_v!(2)); + return; + } + + self.print_new_dynamic_clause(addrs, temp_v!(1), temp_v!(2)) + }, + Err(err) => + return self.machine_st.throw_exception(err) + }; - self.handle_eval_result_from_dynamic_compile(result); + self.handle_eval_result_from_dynamic_compile(pred_str, clause_name!("retract")); } pub(super) fn dynamic_transaction(&mut self, trans_type: DynamicTransactionType, p: LocalCodePtr) { match trans_type { - DynamicTransactionType::Abolish => {}, + DynamicTransactionType::Abolish => + self.abolish_dynamic_clause(temp_v!(1), temp_v!(2)), DynamicTransactionType::Assert(place) => self.recompile_dynamic_predicate(place), - DynamicTransactionType::Retract(idx) => {} + DynamicTransactionType::Retract => + self.retract_from_dynamic_predicate() } self.machine_st.p = CodePtr::Local(p); diff --git a/src/prolog/machine/machine_errors.rs b/src/prolog/machine/machine_errors.rs index 4a3af940..4c019af8 100644 --- a/src/prolog/machine/machine_errors.rs +++ b/src/prolog/machine/machine_errors.rs @@ -60,6 +60,36 @@ impl MachineError { MachineError { stub, from: ErrorProvenance::Constructed } } + // so far, this function is only called wrt dynamic database + // transactions. their inapplicable error cases have been left + // unhandled. + pub(super) fn session_error(h: usize, err: SessionError) -> Self { + match err { + SessionError::ParserError(err) => Self::syntax_error(h, err), + SessionError::CannotOverwriteBuiltIn(pred_str) + | SessionError::CannotOverwriteImport(pred_str) => + Self::permission_error(PermissionError::Modify, pred_str), + SessionError::ModuleDoesNotContainExport => + Self::permission_error(PermissionError::Access, + clause_name!("module_does_not_contain_claimed_export")), + SessionError::ModuleNotFound => + Self::permission_error(PermissionError::Access, + clause_name!("module_does_not_exist")), + _ => unreachable!() + } + } + + pub(super) fn permission_error(err: PermissionError, pred_str: ClauseName) -> Self { + let pred_str = HeapCellValue::Addr(Addr::Con(Constant::Atom(pred_str, None))); + + let err = vec![heap_atom!(err.as_str()), pred_str]; + let mut stub = functor!("permission_error", 2); + + stub.extend(err.into_iter()); + + MachineError { stub, from: ErrorProvenance::Constructed } + } + pub(super) fn syntax_error(h: usize, err: ParserError) -> Self { let err = vec![heap_atom!(err.as_str())]; @@ -109,6 +139,21 @@ impl MachineError { } } +#[derive(Clone, Copy)] +pub enum PermissionError { + Access, + Modify, +} + +impl PermissionError { + pub fn as_str(self) -> &'static str { + match self { + PermissionError::Access => "access", + PermissionError::Modify => "modify" + } + } +} + // from 7.12.2 b) of 13211-1:1995 #[derive(Clone, Copy)] pub enum ValidType { diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 87340b86..675f9383 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -1423,7 +1423,7 @@ impl MachineState { for index in from .. self.ball.stub.len() { let heap_value = self.ball.stub[index].clone(); - + self.heap.push(match heap_value { HeapCellValue::Addr(addr) => HeapCellValue::Addr(addr - diff), _ => heap_value @@ -1768,7 +1768,7 @@ impl MachineState { let d = self.store(self.deref(self[r1].clone())); match d { - Addr::Con(Constant::Atom(..)) | Addr::Con(Constant::Char(_)) => self.p += 1, + Addr::Con(Constant::Atom(..)) | Addr::Con(Constant::Char(_)) => {}, _ => self.fail = true }; }, @@ -1776,7 +1776,7 @@ impl MachineState { let d = self.store(self.deref(self[r1].clone())); match d { - Addr::Con(_) => self.p += 1, + Addr::Con(_) => {}, _ => self.fail = true }; }, @@ -1784,7 +1784,7 @@ impl MachineState { let d = self.store(self.deref(self[r1].clone())); match d { - Addr::Con(Constant::Number(Number::Integer(_))) => self.p += 1, + Addr::Con(Constant::Number(Number::Integer(_))) => {}, _ => self.fail = true }; }, @@ -1792,7 +1792,7 @@ impl MachineState { let d = self.store(self.deref(self[r1].clone())); match d { - Addr::Str(_) | Addr::Lis(_) => self.p += 1, + Addr::Str(_) | Addr::Lis(_) => {}, _ => self.fail = true }; }, @@ -1800,7 +1800,7 @@ impl MachineState { let d = self.store(self.deref(self[r1].clone())); match d { - Addr::Con(Constant::Number(Number::Float(_))) => self.p += 1, + Addr::Con(Constant::Number(Number::Float(_))) => {}, _ => self.fail = true }; }, @@ -1808,7 +1808,7 @@ impl MachineState { let d = self.store(self.deref(self[r1].clone())); match d { - Addr::Con(Constant::Number(Number::Rational(_))) => self.p += 1, + Addr::Con(Constant::Number(Number::Rational(_))) => {}, _ => self.fail = true }; }, @@ -1816,7 +1816,7 @@ impl MachineState { let d = self.store(self.deref(self[r1].clone())); match d { - Addr::Con(Constant::String(_)) => self.p += 1, + Addr::Con(Constant::String(_)) => {}, _ => self.fail = true }; }, @@ -1825,14 +1825,14 @@ impl MachineState { match d { Addr::AttrVar(_) | Addr::HeapCell(_) | Addr::StackCell(..) => self.fail = true, - _ => self.p += 1 + _ => {} }; }, &InlinedClauseType::IsVar(r1) => { let d = self.store(self.deref(self[r1].clone())); match d { - Addr::AttrVar(_) | Addr::HeapCell(_) | Addr::StackCell(_,_) => self.p += 1, + Addr::AttrVar(_) | Addr::HeapCell(_) | Addr::StackCell(_,_) => {}, _ => self.fail = true }; }, @@ -1840,11 +1840,13 @@ impl MachineState { let d = self.store(self.deref(self[r1].clone())); match d { - Addr::Con(Constant::String(ref s)) if s.is_expandable() => self.p += 1, + Addr::Con(Constant::String(ref s)) if s.is_expandable() => {}, _ => self.fail = true }; } } + + self.set_p(); } fn try_functor_unify_components(&mut self, name: Addr, arity: Addr) { diff --git a/src/prolog/machine/mod.rs b/src/prolog/machine/mod.rs index e9e79c5c..2f104d51 100644 --- a/src/prolog/machine/mod.rs +++ b/src/prolog/machine/mod.rs @@ -24,12 +24,10 @@ use std::mem; use std::ops::Index; use std::rc::Rc; -//pub type DynamicPredicateClauses = VecDeque<(PredicateClause, VecDeque)>; #[derive(Copy, Clone)] pub struct DynamicPredicateInfo { pub(super) clauses_subsection_p: usize, // a LocalCodePtr::DirEntry value. -// clauses: DynamicPredicateClauses } impl Default for DynamicPredicateInfo { @@ -424,6 +422,8 @@ impl Machine { _ => { // ensure we don't try to overwrite the name/arity of a builtin. let err_str = format!("{}/{}", key.0, key.1); + let err_str = clause_name!(err_str, self.indices.atom_tbl()); + return Err(SessionError::CannotOverwriteBuiltIn(err_str)); } }; @@ -439,6 +439,7 @@ impl Machine { if existing_idx.module_name() != idx.module_name() { let err_str = format!("{}/{} from module {}", key.0, key.1, existing_idx.module_name().as_str()); + let err_str = clause_name!(err_str, self.indices.atom_tbl()); return Err(SessionError::CannotOverwriteImport(err_str)); } } @@ -479,18 +480,19 @@ impl Machine { self.code_repo.code.len() } - fn fail(&mut self, heap_locs: &HeapVarDict) -> EvalSession + fn fail(&mut self) -> EvalSession { if self.machine_st.ball.stub.len() > 0 { let h = self.machine_st.heap.h; self.machine_st.copy_and_align_ball_to_heap(0); - let error_str = self.machine_st.print_exception(Addr::HeapCell(h), - &heap_locs, - PrinterOutputter::new()) - .result(); + let err_str = self.machine_st.print_exception(Addr::HeapCell(h), + &HeapVarDict::new(), + PrinterOutputter::new()) + .result(); - EvalSession::from(SessionError::QueryFailureWithException(error_str)) + let err_str = clause_name!(err_str, self.indices.atom_tbl()); + EvalSession::from(SessionError::QueryFailureWithException(err_str)) } else { EvalSession::from(SessionError::QueryFailure) } @@ -504,7 +506,7 @@ impl Machine { self.run_query(&alloc_locs, &mut heap_locs); if self.machine_st.fail { - self.fail(&heap_locs) + self.fail() } else { EvalSession::InitialQuerySuccess(alloc_locs, heap_locs) } @@ -599,7 +601,7 @@ impl Machine { self.run_query(alloc_l, heap_l); if self.machine_st.fail { - self.fail(&heap_l) + self.fail() } else { EvalSession::SubsequentQuerySuccess } diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index b2da5bd9..5cd34506 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -183,6 +183,7 @@ impl MachineState { } #[inline] + pub(super) fn set_p(&mut self) { if self.last_call { self.p = CodePtr::Local(self.cp.clone()); @@ -230,6 +231,13 @@ impl MachineState { -> CallResult { match ct { + &SystemClauseType::AbolishClause => { + let p = self.cp; + let trans_type = DynamicTransactionType::Abolish; + + self.p = CodePtr::DynamicTransaction(trans_type, p); + return Ok(()); + }, &SystemClauseType::AssertDynamicPredicateToFront => { let p = self.cp; let trans_type = DynamicTransactionType::Assert(DynamicAssertPlace::Front); @@ -370,6 +378,24 @@ impl MachineState { self.p = CodePtr::Local(LocalCodePtr::UserTermExpansion(0)); return Ok(()); }, + &SystemClauseType::GetCurrentPredicateList => { + let mut addrs = vec![]; + + for (name, arity) in indices.code_dir.keys().cloned() { + let h = self.heap.h; + + self.heap.push(HeapCellValue::NamedStr(2, clause_name!("/"), Some((400, YFX)))); + self.heap.push(HeapCellValue::Addr(Addr::Con(Constant::Atom(name, None)))); + self.heap.push(heap_integer!(arity)); + + addrs.push(Addr::Str(h)); + } + + let list_addr = Addr::HeapCell(self.heap.to_list(addrs.into_iter())); + let target_addr = self[temp_v!(1)].clone(); + + self.unify(list_addr, target_addr); + }, &SystemClauseType::TruncateIfNoLiftedHeapGrowthDiff => self.truncate_if_no_lifted_heap_diff(|h| Addr::HeapCell(h)), &SystemClauseType::TruncateIfNoLiftedHeapGrowth => @@ -660,6 +686,13 @@ impl MachineState { None => panic!("remove_inference_counter: requires \\ CWILCallPolicy.") }, + &SystemClauseType::RetractClause => { + let p = self.cp; + let trans_type = DynamicTransactionType::Retract; + + self.p = CodePtr::DynamicTransaction(trans_type, p); + return Ok(()); + }, &SystemClauseType::ReturnFromAttributeGoals => { self.deallocate(); self.p = CodePtr::Local(LocalCodePtr::TopLevel(0, 0)); diff --git a/src/prolog/write.rs b/src/prolog/write.rs index 25b075e3..1f3436b3 100644 --- a/src/prolog/write.rs +++ b/src/prolog/write.rs @@ -9,8 +9,8 @@ use termion::event::Key; use std::io::{Write, stdin, stdout}; use std::fmt; -fn error_string(e: &String) -> String { - format!("error: exception thrown: {}", e) +fn error_string>(e: &StringT) -> String { + format!("error: exception thrown: {}", e.as_ref()) } impl fmt::Display for LocalCodePtr { @@ -375,7 +375,11 @@ pub fn print(wam: &mut Machine, result: EvalSession) { } if !wam.or_stack_is_empty() { - println!("true ."); + print!("true ."); + + if !heap_locs.is_empty() { + println!("\r"); + } } loop { @@ -384,13 +388,15 @@ pub fn print(wam: &mut Machine, result: EvalSession) { let bindings = wam.heap_view(&heap_locs, output).result(); let mut raw_stdout = stdout().into_raw_mode().unwrap(); - write!(raw_stdout, "{}", bindings).unwrap(); - raw_stdout.flush().unwrap(); - - let attr_goals = wam.attribute_goals(&heap_locs); - - if !attr_goals.is_empty() { - write!(raw_stdout, "\r\n{}\r\n", attr_goals).unwrap(); + if !heap_locs.is_empty() { + write!(raw_stdout, "{}", bindings).unwrap(); + raw_stdout.flush().unwrap(); + + let attr_goals = wam.attribute_goals(&heap_locs); + + if !attr_goals.is_empty() { + write!(raw_stdout, "\r\n{}\r\n", attr_goals).unwrap(); + } } if !wam.or_stack_is_empty() { @@ -419,11 +425,15 @@ pub fn print(wam: &mut Machine, result: EvalSession) { return; } } else { + if heap_locs.is_empty() { + write!(raw_stdout, "true.\r\n").unwrap(); + } else { + write!(raw_stdout, ".\r\n").unwrap(); + } + break; } } - - write!(stdout(), ".\n").unwrap(); }, EvalSession::Error(e) => println!("{}", e), _ => {} diff --git a/src/tests.rs b/src/tests.rs index 14e854d4..0c56bb16 100644 --- a/src/tests.rs +++ b/src/tests.rs @@ -1856,6 +1856,61 @@ insect(bee)."); 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) )."); + + submit(&mut wam, " +:- dynamic(legs/2). +legs(A, 4) :- animal(A). +legs(octopus, 8). +legs(A, 6) :- insect(A). +legs(spider, 8). +legs(B, 2) :- bird(B). + +:- dynamic(insect/1). +insect(ant). +insect(bee). + +:- dynamic(foo/1). +foo(X) :- call(X), call(X). +foo(X) :- call(X) -> call(X)."); + + assert_prolog_success!(&mut wam, "?- retract(legs(octopus, 8))."); + assert_prolog_failure!(&mut wam, "?- retract(legs(spider, 6))."); + assert_prolog_success!(&mut wam, "?- retract( (legs(X, 2) :- T) ).", + [["X = _1", "T = bird(_1)"]]); + assert_prolog_success!(&mut wam, "?- retract( (legs(X, Y) :- Z) ).", + [["X = _1", "Y = 4", "Z = animal(_1)"], + ["X = _1", "Y = 6", "Z = insect(_1)"], + ["X = spider", "Y = 8", "Z = true"]]); + assert_prolog_failure!(&mut wam, "?- retract( (legs(X, Y) :- Z) )."); + assert_prolog_success!(&mut wam, "?- retract(insect(I)).", + [["I = ant"], + ["I = bee"]]); + assert_prolog_success!(&mut wam, "?- retract(( foo(A) :- A, call(A) )).", + [["A = call(A)"]]); + assert_prolog_success!(&mut wam, "?- foo(atom(atom))."); + assert_prolog_success!(&mut wam, "?- retract(( foo(C) :- A -> B )).", + [["A = call(_1)", "B = call(_1)", "C = _1"]]); + assert_prolog_failure!(&mut wam, "?- retract( (X :- in_eec(Y)) )."); + assert_prolog_success!(&mut wam, "?- catch(retract( (X :- in_eec(Y)) ), error(instantiation_error, _), true)."); + assert_prolog_failure!(&mut wam, "?- retract( (4 :- X) )."); + assert_prolog_success!(&mut wam, "?- catch(retract( (4 :- X) ), error(type_error(callable, 4), _), true)."); + assert_prolog_failure!(&mut wam, "?- retract( (atom(X) :- X == '[]') )."); + assert_prolog_success!(&mut wam, "?- catch(retract( (atom(X) :- X == '[]') ), error(permission_error(modify, static_procedure, atom/1), _), true)."); + + submit(&mut wam, " +:- dynamic(foo/1). +foo(X) :- call(X), call(X). +foo(X) :- call(X) -> call(X)."); + + assert_prolog_success!(&mut wam, "?- abolish(foo/2)."); + assert_prolog_failure!(&mut wam, "?- abolish(foo/_)."); + assert_prolog_success!(&mut wam, "?- catch(abolish(foo/_), error(instantiation_error, abolish/1), true)."); + assert_prolog_failure!(&mut wam, "?- abolish(foo)."); + assert_prolog_success!(&mut wam, "?- catch(abolish(foo), error(type_error(predicate_indicator, foo), abolish/1), true)."); + assert_prolog_failure!(&mut wam, "?- abolish(foo(_))."); + assert_prolog_success!(&mut wam, "?- catch(abolish(foo(_)), error(type_error(predicate_indicator, foo(_)), abolish/1), true)."); + assert_prolog_failure!(&mut wam, "?- abolish(abolish/1)."); + assert_prolog_success!(&mut wam, "?- catch(abolish(abolish/1), error(permission_error(modify, static_procedure, abolish/1), abolish/1), true)."); } -- 2.54.0