From 396c589743bb51dfc79b916eaefd3aa4e03b8298 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Wed, 17 Feb 2021 15:39:52 -0700 Subject: [PATCH] add second term expansion to capture the addition of hook predicates to the expansion process in loader.pl, loader.rs --- src/clause_types.rs | 13 +++++++- src/forms.rs | 12 ++++++++ src/loader.pl | 55 ++++++++++++++++++++++++++-------- src/machine/loader.rs | 42 ++++++++++++++++++++++++++ src/machine/machine_indices.rs | 2 ++ src/machine/mod.rs | 6 ++++ src/write.rs | 4 +++ 7 files changed, 120 insertions(+), 14 deletions(-) diff --git a/src/clause_types.rs b/src/clause_types.rs index b678bb7f..c9cb0332 100644 --- a/src/clause_types.rs +++ b/src/clause_types.rs @@ -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), diff --git a/src/forms.rs b/src/forms.rs index ad401cd4..9956c058 100644 --- a/src/forms.rs +++ b/src/forms.rs @@ -125,6 +125,18 @@ pub trait ClauseInfo { fn arity(&self) -> usize; } +impl ClauseInfo for PredicateKey { + #[inline] + fn name(&self) -> Option { + Some(self.0.clone()) + } + + #[inline] + fn arity(&self) -> usize { + self.1 + } +} + impl ClauseInfo for Term { fn name(&self) -> Option { match self { diff --git a/src/loader.pl b/src/loader.pl index 4607bdbd..e1868a2c 100644 --- a/src/loader.pl +++ b/src/loader.pl @@ -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) :- + !, + 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) :- !, - '$scoped_clause_to_evacuable'(Target, Clause, Evacuable). -compile_clause(Clause, Evacuable) :- - '$clause_to_evacuable'(Clause, 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) :- diff --git a/src/machine/loader.rs b/src/machine/loader.rs index 3ece45ba..08593238 100644 --- a/src/machine/loader.rs +++ b/src/machine/loader.rs @@ -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, diff --git a/src/machine/machine_indices.rs b/src/machine/machine_indices.rs index 2d0556d3..049cd5a0 100644 --- a/src/machine/machine_indices.rs +++ b/src/machine/machine_indices.rs @@ -446,6 +446,8 @@ pub enum REPLCodePtr { Asserta, Assertz, Retract, + IsConsistentWithTermQueue, + FlushTermQueue, } #[derive(Debug, Clone, PartialEq)] diff --git a/src/machine/mod.rs b/src/machine/mod.rs index 8360b3fe..b0613b74 100644 --- a/src/machine/mod.rs +++ b/src/machine/mod.rs @@ -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); diff --git a/src/write.rs b/src/write.rs index 95e9160c..49541f0b 100644 --- a/src/write.rs +++ b/src/write.rs @@ -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"), } } } -- 2.54.0