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

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

Browse Source
This commit is contained in:
Mark Thom
2019-03-02 16:57:45 -07:00
parent 2fb5408ab5
commit e4cb904470
12 changed files with 451 additions and 77 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
Cargo.lock generated
View File

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

4
Cargo.toml
View File

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

7
README.md
View File

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

17
src/prolog/instructions.rs
View File

@@ -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),
CannotOverwriteImport(String),
CannotOverwriteBuiltIn(ClauseName),
CannotOverwriteImport(ClauseName),
ModuleDoesNotContainExport,
ModuleNotFound,
NamelessEntry,
OpIsInfixAndPostFix,
ParserError(ParserError),
QueryFailure,
QueryFailureWithException(String),
QueryFailureWithException(ClauseName),
UserPrompt
}

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

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

82
src/prolog/machine/dynamic_database.rs
View File

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

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

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

24
src/prolog/machine/machine_state_impl.rs
View File

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

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

@@ -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),
&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
}

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

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

34
src/prolog/write.rs
View File

@@ -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<StringT: AsRef<str>>(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),
_ => {}

55
src/tests.rs
View File

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