[[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)",
[[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)",
]
"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"
[package]
name = "rusty-wam"
-version = "0.8.0"
+version = "0.8.1"
repository = "https://github.com/mthom/rusty-wam"
description = "The Warren Abstract Machine in Rust."
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"
\ No newline at end of file
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.
* `(=..)/2`
* `(->)/2`
* `(;)/2`
+* `abolish/1`
* `acyclic_term/2`
* `append/3`
* `arg/3`
* `compare/3`
* `compound/1`
* `copy_term/2`
+* `current_predicate/1`
* `cyclic_term/1`
* `dif/2`
* `expand_goal/2`
* `rational/1`
* `read/1`
* `repeat/{0,1}`
+* `retract/1`
* `reverse/2`
* `select/3`
* `setof/3`
#[derive(Copy, Clone, PartialEq)]
pub enum SystemClauseType {
+ AbolishClause,
AssertDynamicPredicateToBack,
AssertDynamicPredicateToFront,
CheckCutPoint,
GetAttrVarQueueBeyond,
GetBValue,
GetClause,
+ GetCurrentPredicateList,
GetLiftedHeapFromOffset,
GetLiftedHeapFromOffsetDiff,
GetSCCCleaner,
RedoAttrVarBindings,
RemoveCallPolicyCheck,
RemoveInferenceCounter,
+ RetractClause,
RestoreCutPolicy,
SetCutPoint(RegType),
InferenceLevel,
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"),
&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"),
&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"),
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),
("$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),
("$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),
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)]
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
}
:- 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
).
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) :-
).
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))
).
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,
(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);
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!()
+ };
+
+ 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(result);
+ 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);
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())];
}
}
+#[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 {
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
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
};
},
let d = self.store(self.deref(self[r1].clone()));
match d {
- Addr::Con(_) => self.p += 1,
+ Addr::Con(_) => {},
_ => self.fail = true
};
},
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
};
},
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
};
},
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
};
},
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
};
},
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
};
},
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
};
},
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) {
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 {
_ => {
// 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));
}
};
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));
}
}
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)
}
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)
}
self.run_query(alloc_l, heap_l);
if self.machine_st.fail {
- self.fail(&heap_l)
+ self.fail()
} else {
EvalSession::SubsequentQuerySuccess
}
}
#[inline]
+ pub(super)
fn set_p(&mut self) {
if self.last_call {
self.p = CodePtr::Local(self.cp.clone());
-> 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);
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 =>
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));
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 {
}
if !wam.or_stack_is_empty() {
- println!("true .");
+ print!("true .");
+
+ if !heap_locs.is_empty() {
+ println!("\r");
+ }
}
loop {
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() {
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),
_ => {}
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).");
}
projects / scryer-prolog.git / commitdiff