rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add assertz/1 and asserta/1

Browse Source
This commit is contained in:
Mark Thom
2019-03-02 00:27:40 -07:00
parent 818a971833
commit 2fb5408ab5
10 changed files with 238 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
src/prolog/instructions.rs
View File

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

52
src/prolog/lib/builtins.pl
View File

@@ -5,9 +5,9 @@
(div)/2, (//)/2, (rdiv)/2, (<<)/2, (>>)/2, (mod)/2, (rem)/2,
(>)/2, (<)/2, (=\=)/2, (=:=)/2, (-)/1, (>=)/2, (=<)/2, (,)/2,
(->)/2, (;)/2, (=..)/2, (==)/2, (\==)/2, (@=<)/2, (@>=)/2,
(@<)/2, (@>)/2, (=@=)/2, (\=@=)/2, (:)/2, bagof/3,
call_with_inference_limit/3, catch/3, clause/2,
current_prolog_flag/2, expand_goal/2, expand_term/2,
(@<)/2, (@>)/2, (=@=)/2, (\=@=)/2, (:)/2, asserta/1,
assertz/1, bagof/3, call_with_inference_limit/3, catch/3,
clause/2, current_prolog_flag/2, expand_goal/2, expand_term/2,
findall/3, findall/4, once/1, repeat/0, set_prolog_flag/2,
setof/3, setup_call_cleanup/3, term_variables/2, throw/1,
true/0, false/0, write/1, write_canonical/1, writeq/1,
@@ -459,8 +459,8 @@ setof(Template, Goal, Solution) :-
'$clause_body_is_valid'(B) :-
( var(B) -> true
; functor(B, Name, _) -> ( Name == '.' -> throw(error(type_error(callable, B), clause/2))
; true
; functor(B, Name, _) -> ( atom(Name), Name \= '.' -> true
; throw(error(type_error(callable, B), clause/2))
)
; throw(error(type_error(callable, B), clause/2))
).
@@ -477,3 +477,45 @@ clause(H, B) :-
)
; throw(error(type_error(callable, H), clause/2))
).
call_asserta(Head, Body, Name, Arity) :-
'$clause_body_is_valid'(Body),
functor(VarHead, Name, Arity),
findall((VarHead :- VarBody), clause(VarHead, VarBody), Clauses),
'$asserta'((Head :- Body), Clauses, Name, Arity).
asserta_clause(Head, Body) :-
( var(Head) -> throw(error(instantiation_error, asserta/1))
; functor(Head, Name, Arity), atom(Name), Name \== '.' ->
( '$no_such_predicate'(Head) -> call_asserta(Head, Body, Name, Arity)
; '$head_is_dynamic'(Head) -> call_asserta(Head, Body, Name, Arity)
; throw(error(permission_error(modify, static_procedure, Name/Arity), asserta/1))
)
; throw(error(type_error(callable, Head), asserta/1))
).
asserta(Clause) :-
( Clause \= (_ :- _) -> Head = Clause, Body = true, asserta_clause(Head, Body)
; Clause = (Head :- Body) -> asserta_clause(Head, Body)
).
call_assertz(Head, Body, Name, Arity) :-
'$clause_body_is_valid'(Body),
functor(VarHead, Name, Arity),
findall((VarHead :- VarBody), clause(VarHead, VarBody), Clauses),
'$assertz'((Head :- Body), Clauses, Name, Arity).
assertz_clause(Head, Body) :-
( var(Head) -> throw(error(instantiation_error, assertz/1))
; functor(Head, Name, Arity), atom(Name), Name \== '.' ->
( '$no_such_predicate'(Head) -> call_assertz(Head, Body, Name, Arity)
; '$head_is_dynamic'(Head) -> call_assertz(Head, Body, Name, Arity)
; throw(error(permission_error(modify, static_procedure, Name/Arity), assertz/1))
)
; throw(error(type_error(callable, Head), assertz/1))
).
assertz(Clause) :-
( Clause \= (_ :- _) -> Head = Clause, Body = true, assertz_clause(Head, Body)
; Clause = (Head :- Body) -> assertz_clause(Head, Body)
).

92
src/prolog/machine/dynamic_database.rs Normal file
View File

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

20
src/prolog/machine/machine_errors.rs
View File

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

26
src/prolog/machine/mod.rs
View File

@@ -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) => {},
// 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);

20
src/prolog/machine/system_calls.rs
View File

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

2
src/prolog/read.rs
View File

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

2
src/prolog/toplevel.rs
View File

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

42
src/tests.rs
View File

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