add assertz/1 and asserta/1

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`

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<SystemClauseType> {
         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<Addr>, new_addr: Addr) {
+        match self {
+            DynamicAssertPlace::Back  => addrs.push_back(new_addr),
+            DynamicAssertPlace::Front => addrs.push_front(new_addr)
+        }
+    }
 }
 
 #[derive(Clone, Copy, PartialEq)]

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,
+	(@<)/2, (@>)/2, (=@=)/2, (\=@=)/2, (:)/2, asserta/1,
-	call_with_inference_limit/3, catch/3, clause/2,
+	assertz/1, bagof/3, call_with_inference_limit/3, catch/3,
-	current_prolog_flag/2, expand_goal/2, expand_term/2,
+	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))
+    ;  functor(B, Name, _) -> (  atom(Name), Name \= '.' -> true
-			      ;  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)
+    ).

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<Addr>) -> 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);
+    }
+}

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

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<DynamicPredicateInfo> {
         self.dynamic_code_dir.get(&(name, arity)).cloned()
     }
-    
+
     #[inline]
     pub fn take_module(&mut self, name: ClauseName) -> Option<Module> {
         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) => {},
+                CodePtr::DynamicTransaction(trans_type, p) => {
-//                  self.dynamic_transaction(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);

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

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

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

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