* `acyclic_term/2`
* `append/3`
* `arg/3`
+* `asserta/1`
+* `assertz/1`
* `atom/1`
* `atomic/1`
* `bagof/3`
* `call_residue_vars/2`
* `can_be/2`
* `catch/3`
+* `clause/2`
* `compare/3`
* `compound/1`
* `copy_term/2`
#[derive(Copy, Clone, PartialEq)]
pub enum SystemClauseType {
+ AssertDynamicPredicateToBack,
+ AssertDynamicPredicateToFront,
CheckCutPoint,
CopyToLiftedHeap,
DeleteAttribute,
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"),
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),
}
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)]
(div)/2, (//)/2, (rdiv)/2, (<<)/2, (>>)/2, (mod)/2, (rem)/2,
(>)/2, (<)/2, (=\=)/2, (=:=)/2, (-)/1, (>=)/2, (=<)/2, (,)/2,
(->)/2, (;)/2, (=..)/2, (==)/2, (\==)/2, (@=<)/2, (@>=)/2,
- (@<)/2, (@>)/2, (=@=)/2, (\=@=)/2, (:)/2, bagof/3,
- call_with_inference_limit/3, catch/3, clause/2,
- current_prolog_flag/2, expand_goal/2, expand_term/2,
+ (@<)/2, (@>)/2, (=@=)/2, (\=@=)/2, (:)/2, asserta/1,
+ assertz/1, bagof/3, call_with_inference_limit/3, catch/3,
+ clause/2, current_prolog_flag/2, expand_goal/2, expand_term/2,
findall/3, findall/4, once/1, repeat/0, set_prolog_flag/2,
setof/3, setup_call_cleanup/3, term_variables/2, throw/1,
true/0, false/0, write/1, write_canonical/1, writeq/1,
'$clause_body_is_valid'(B) :-
( var(B) -> true
- ; functor(B, Name, _) -> ( Name == '.' -> throw(error(type_error(callable, B), clause/2))
- ; true
+ ; functor(B, Name, _) -> ( atom(Name), Name \= '.' -> true
+ ; throw(error(type_error(callable, B), clause/2))
)
; throw(error(type_error(callable, B), clause/2))
).
)
; 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)
+ ).
--- /dev/null
+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);
+ }
+}
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 }
}
}
-#[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
use prolog::instructions::*;
mod attributed_variables;
+mod dynamic_database;
mod machine_errors;
pub(super) mod machine_state;
pub(super) mod term_expansion;
-> 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)
match self.machine_st.p {
CodePtr::Local(LocalCodePtr::TopLevel(_, p)) if p > 0 => {},
- CodePtr::DynamicTransaction(trans_type, p) => {},
-// self.dynamic_transaction(trans_type, p),
+ CodePtr::DynamicTransaction(trans_type, p) => {
+ // self.code_repo.cached_query is about to be overwritten by the term expander,
+ // so hold onto it locally and restore it after the compiler has finished.
+ let cached_query = mem::replace(&mut self.code_repo.cached_query, vec![]);
+ self.dynamic_transaction(trans_type, p);
+
+ if let CodePtr::Local(LocalCodePtr::TopLevel(_, 0)) = self.machine_st.p {
+ if heap_locs.is_empty() {
+ self.record_var_places(0, alloc_locs, heap_locs);
+ }
+
+ self.code_repo.cached_query = cached_query;
+ break;
+ }
+
+ self.code_repo.cached_query = cached_query;
+ },
_ => {
if heap_locs.is_empty() {
self.record_var_places(0, alloc_locs, heap_locs);
-> 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()));
};
},
&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();
self.heap[h+1] = HeapCellValue::Addr(Addr::HeapCell(l+1));
self.trail(TrailRef::AttrVarLink(h+1, Addr::Lis(l)));
},
- _ => {}
+ _ => unreachable!()
}
},
- _ => {}
+ _ => unreachable!()
}
},
&SystemClauseType::DynamicModuleResolution => {
},
&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) =>
},
&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() {
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
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()
{
projects / scryer-prolog.git / commitdiff