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

add second term expansion to capture the addition of hook predicates to the expansion process in loader.pl, loader.rs

Browse Source
This commit is contained in:
Mark Thom
2021-02-17 15:39:52 -07:00
parent 7670b81633
commit 396c589743
7 changed files with 120 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
src/clause_types.rs
View File

@@ -413,6 +413,12 @@ impl SystemClauseType {
clause_name!("$cpp_discontiguous_property")
}
&SystemClauseType::REPL(REPLCodePtr::AbolishClause) => clause_name!("$abolish_clause"),
&SystemClauseType::REPL(REPLCodePtr::IsConsistentWithTermQueue) => {
clause_name!("$is_consistent_with_term_queue")
}
&SystemClauseType::REPL(REPLCodePtr::FlushTermQueue) => {
clause_name!("$flush_term_queue")
}
&SystemClauseType::Close => clause_name!("$close"),
&SystemClauseType::CopyToLiftedHeap => clause_name!("$copy_to_lh"),
&SystemClauseType::DeleteAttribute => clause_name!("$del_attr_non_head"),
@@ -606,7 +612,6 @@ impl SystemClauseType {
("$atom_chars", 2) => Some(SystemClauseType::AtomChars),
("$atom_codes", 2) => Some(SystemClauseType::AtomCodes),
("$atom_length", 2) => Some(SystemClauseType::AtomLength),
// ("$abolish_module_clause", 3) => Some(SystemClauseType::AbolishModuleClause),
("$bind_from_register", 2) => Some(SystemClauseType::BindFromRegister),
("$call_continuation", 1) => Some(SystemClauseType::CallContinuation),
("$char_code", 2) => Some(SystemClauseType::CharCode),
@@ -761,6 +766,12 @@ impl SystemClauseType {
("$asserta", 5) => Some(SystemClauseType::REPL(REPLCodePtr::Asserta)),
("$assertz", 5) => Some(SystemClauseType::REPL(REPLCodePtr::Assertz)),
("$retract_clause", 4) => Some(SystemClauseType::REPL(REPLCodePtr::Retract)),
("$is_consistent_with_term_queue", 4) => {
Some(SystemClauseType::REPL(REPLCodePtr::IsConsistentWithTermQueue))
}
("$flush_term_queue", 1) => {
Some(SystemClauseType::REPL(REPLCodePtr::FlushTermQueue))
}
("$variant", 2) => Some(SystemClauseType::Variant),
("$wam_instructions", 4) => Some(SystemClauseType::WAMInstructions),
("$write_term", 7) => Some(SystemClauseType::WriteTerm),

12
src/forms.rs
View File

@@ -125,6 +125,18 @@ pub trait ClauseInfo {
fn arity(&self) -> usize;
}
impl ClauseInfo for PredicateKey {
#[inline]
fn name(&self) -> Option<ClauseName> {
Some(self.0.clone())
}
#[inline]
fn arity(&self) -> usize {
self.1
}
}
impl ClauseInfo for Term {
fn name(&self) -> Option<ClauseName> {
match self {

55
src/loader.pl
View File

@@ -117,18 +117,22 @@ load_loop(Stream, Evacuable) :-
'$conclude_load'(Evacuable)
; var(Term) ->
instantiation_error(load/1)
; expand_terms_and_goals(Term, Terms),
!,
( var(Terms) ->
instantiation_error(load/1)
; Terms = [_|_] ->
compile_dispatch_or_clause_on_list(Terms, Evacuable)
; compile_dispatch_or_clause(Terms, Evacuable)
),
; compile_term(Term, Evacuable),
load_loop(Stream, Evacuable)
).
compile_term(Term, Evacuable) :-
expand_terms_and_goals(Term, Terms),
!,
( var(Terms) ->
instantiation_error(load/1)
; Terms = [_|_] ->
compile_dispatch_or_clause_on_list(Terms, Evacuable)
; compile_dispatch_or_clause(Terms, Evacuable)
).
inner_meta_specs(0, HeadArg, InnerHeadArgs, InnerMetaSpecs) :-
!,
predicate_property(HeadArg, meta_predicate(InnerMetaSpecs)),
@@ -296,12 +300,37 @@ compile_declaration(initialization(Goal), Evacuable) :-
compile_clause((Target:Head :- Body), Evacuable) :-
!,
'$scoped_clause_to_evacuable'(Target, (Head :- Body), Evacuable).
compile_clause(Target:Clause, Evacuable) :-
functor(Head, Name, Arity),
( '$is_consistent_with_term_queue'(Target, Name, Arity, Evacuable) ->
'$scoped_clause_to_evacuable'(Target, (Head :- Body), Evacuable)
; '$flush_term_queue'(Evacuable),
compile_term((Target:Head :- Body), Evacuable)
).
compile_clause(Target:Head, Evacuable) :-
!,
'$scoped_clause_to_evacuable'(Target, Clause, Evacuable).
compile_clause(Clause, Evacuable) :-
'$clause_to_evacuable'(Clause, Evacuable).
functor(Head, Name, Arity),
( '$is_consistent_with_term_queue'(Target, Name, Arity, Evacuable) ->
'$scoped_clause_to_evacuable'(Target, Head, Evacuable)
; '$flush_term_queue'(Evacuable),
compile_term(Target:Head, Evacuable)
).
compile_clause((Head :- Body), Evacuable) :-
!,
prolog_load_context(module, Target),
functor(Head, Name, Arity),
( '$is_consistent_with_term_queue'(Target, Name, Arity, Evacuable) ->
'$clause_to_evacuable'((Head :- Body), Evacuable)
; '$flush_term_queue'(Evacuable),
compile_term((Head :- Body), Evacuable)
).
compile_clause(Head, Evacuable) :-
prolog_load_context(module, Target),
functor(Head, Name, Arity),
( '$is_consistent_with_term_queue'(Target, Name, Arity, Evacuable) ->
'$clause_to_evacuable'(Head, Evacuable)
; '$flush_term_queue'(Evacuable),
compile_term(Head, Evacuable)
).
prolog_load_context(source, Source) :-

42
src/machine/loader.rs
View File

@@ -1882,6 +1882,48 @@ impl Machine {
}
}
pub(crate) fn is_consistent_with_term_queue(&mut self) {
let module_name = atom_from!(
self.machine_st,
self.machine_st
.store(self.machine_st.deref(self.machine_st[temp_v!(1)]))
);
let key = self
.machine_st
.read_predicate_key(self.machine_st[temp_v!(2)], self.machine_st[temp_v!(3)]);
let compilation_target = match module_name.as_str() {
"user" => CompilationTarget::User,
_ => CompilationTarget::Module(module_name),
};
let (loader, evacuable_h) = self.loader_from_heap_evacuable(temp_v!(4));
loader.load_state.wam.machine_st.fail =
(!loader.predicates.is_empty() &&
loader.predicates.compilation_target != compilation_target) ||
!key.is_consistent(&loader.predicates);
let result = LiveTermStream::evacuate(loader);
self.restore_load_state_payload(result, evacuable_h);
}
pub(crate) fn flush_term_queue(&mut self) {
let (mut loader, evacuable_h) = self.loader_from_heap_evacuable(temp_v!(1));
let flush_term_queue = || {
if !loader.predicates.is_empty() {
loader.compile_and_submit()?;
}
LiveTermStream::evacuate(loader)
};
let result = flush_term_queue();
self.restore_load_state_payload(result, evacuable_h);
}
pub(crate) fn meta_predicate_property(&mut self) {
let module_name = atom_from!(
self.machine_st,

2
src/machine/machine_indices.rs
View File

@@ -446,6 +446,8 @@ pub enum REPLCodePtr {
Asserta,
Assertz,
Retract,
IsConsistentWithTermQueue,
FlushTermQueue,
}
#[derive(Debug, Clone, PartialEq)]

6
src/machine/mod.rs
View File

@@ -499,6 +499,12 @@ impl Machine {
REPLCodePtr::AbolishClause => {
self.abolish_clause();
}
REPLCodePtr::IsConsistentWithTermQueue => {
self.is_consistent_with_term_queue();
}
REPLCodePtr::FlushTermQueue => {
self.flush_term_queue();
}
}
self.machine_st.p = CodePtr::Local(p);

4
src/write.rs
View File

@@ -79,6 +79,10 @@ impl fmt::Display for REPLCodePtr {
write!(f, "REPLCodePtr::MultifileProperty"),
REPLCodePtr::DiscontiguousProperty =>
write!(f, "REPLCodePtr::DiscontiguousProperty"),
REPLCodePtr::IsConsistentWithTermQueue =>
write!(f, "REPLCodePtr::IsConsistentWithTermQueue"),
REPLCodePtr::FlushTermQueue =>
write!(f, "REPLCodePtr::FlushTermQueue"),
}
}
}