correct inlined calling bug in last call, add dynamic database manipulation predicates

Cargo.lock

@@ -86,8 +86,7 @@ dependencies = [
 
 [[package]]
 name = "prolog_parser"
-version = "0.8.0"
+version = "0.8.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
 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"

Cargo.toml

@@ -1,6 +1,6 @@
 [package]
 name = "rusty-wam"
-version = "0.8.0"
+version = "0.8.1"
 authors = ["Mark Thom <markjordanthom@gmail.com>"]
 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"

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_).
+  `retract/1`, `abolish/1`) with logical update semantics (_done_).
-* Streams and predicates for stream control.
+* 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`

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<SystemClauseType> {
         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<Rc<Var>, Addr>;
 pub type AllocVarDict = HashMap<Rc<Var>, VarData>;
 
 pub enum SessionError {
-    CannotOverwriteBuiltIn(String),
+    CannotOverwriteBuiltIn(ClauseName),
-    CannotOverwriteImport(String),
+    CannotOverwriteImport(ClauseName),
     ModuleDoesNotContainExport,
     ModuleNotFound,
     NamelessEntry,
     OpIsInfixAndPostFix,
     ParserError(ParserError),
     QueryFailure,
-    QueryFailureWithException(String),
+    QueryFailureWithException(ClauseName),
     UserPrompt
 }
 

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, (\==)/2, (@=<)/2, (@>=)/2,
+	(;)/2, (=..)/2, (==)/2, (\==)/2, (@=<)/2, (@>=)/2, (@<)/2,
-	(@<)/2, (@>)/2, (=@=)/2, (\=@=)/2, (:)/2, asserta/1,
+	(@>)/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,
+	clause/2, current_predicate/1, current_prolog_flag/2,
-	findall/3, findall/4, once/1, repeat/0, set_prolog_flag/2,
+	expand_goal/2, expand_term/2, findall/3, findall/4, once/1,
-	setof/3, setup_call_cleanup/3, term_variables/2, throw/1,
+	repeat/0, retract/1, set_prolog_flag/2, setof/3,
-	true/0, false/0, write/1, write_canonical/1, writeq/1,
+	setup_call_cleanup/3, term_variables/2, throw/1, true/0,
-	write_term/2]).
+	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
@@ -519,3 +519,176 @@ assertz(Clause) :-
     (  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))
+    ).

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 {
+    fn get_predicate_key(&self, name: RegType, arity: RegType) -> PredicateKey {
-        let name  = self.machine_st[temp_v!(3)].clone();
+        let name  = self.machine_st[name].clone();
-        let arity = self.machine_st[temp_v!(4)].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<Addr>) -> String
+    fn print_new_dynamic_clause(&self, addrs: VecDeque<Addr>, 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)
+        output.append(format!(":- dynamic({}/{}). ", name.as_str(), arity).as_str());
-                      .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 {
+        let (name, arity) = self.get_predicate_key(name, arity);
-            println!("{}\r", e);
+
-            self.machine_st.fail = true;
+        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());
+    fn retract_from_dynamic_predicate(&mut self) {
-        self.machine_st = machine_st;
+        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!()
+        };
 
-        self.handle_eval_result_from_dynamic_compile(result);
+        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(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);

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 {

src/prolog/machine/machine_state_impl.rs

@@ -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) {

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<TopLevel>)>;
 
 #[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),
+            let err_str = self.machine_st.print_exception(Addr::HeapCell(h),
-                                                            &heap_locs,
+                                                          &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
             }

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));

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 {
+fn error_string<StringT: AsRef<str>>(e: &StringT) -> String {
-    format!("error: exception thrown: {}", e)
+    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,6 +388,7 @@ 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();
 
+                if !heap_locs.is_empty() {
                     write!(raw_stdout, "{}", bindings).unwrap();
                     raw_stdout.flush().unwrap();
                     
@@ -392,6 +397,7 @@ pub fn print(wam: &mut Machine, result: EvalSession) {
                     if !attr_goals.is_empty() {
                         write!(raw_stdout, "\r\n{}\r\n", attr_goals).unwrap();
                     }
+                }
 
                 if !wam.or_stack_is_empty() {
                     raw_stdout.flush().unwrap();
@@ -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),
         _ => {}

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).");
 }