From: Mark Thom Date: Fri, 5 Feb 2021 09:16:14 +0000 (-0700) Subject: implement dynamic, multifile, and discontiguous properties and callable type checking... X-Git-Tag: v0.9.0~150^2~65^2~17 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=2d7f31a60d9376e2c06e168f40d8d7ed50e182f9;p=scryer-prolog.git implement dynamic, multifile, and discontiguous properties and callable type checking for predicate_property/2 --- diff --git a/src/clause_types.rs b/src/clause_types.rs index 435e1182..ac431691 100644 --- a/src/clause_types.rs +++ b/src/clause_types.rs @@ -400,6 +400,12 @@ impl SystemClauseType { clause_name!("$cpp_meta_predicate_property"), &SystemClauseType::REPL(REPLCodePtr::BuiltInProperty) => clause_name!("$cpp_built_in_property"), + &SystemClauseType::REPL(REPLCodePtr::DynamicProperty) => + clause_name!("$cpp_dynamic_property"), + &SystemClauseType::REPL(REPLCodePtr::MultifileProperty) => + clause_name!("$cpp_multifile_property"), + &SystemClauseType::REPL(REPLCodePtr::DiscontiguousProperty) => + clause_name!("$cpp_discontiguous_property"), &SystemClauseType::REPL(REPLCodePtr::CompilePendingPredicates) => clause_name!("$compile_pending_predicates"), &SystemClauseType::Close => clause_name!("$close"), @@ -773,6 +779,9 @@ impl SystemClauseType { ("$prolog_lc_stream", 1) => Some(SystemClauseType::REPL(REPLCodePtr::LoadContextStream)), ("$cpp_meta_predicate_property", 4) => Some(SystemClauseType::REPL(REPLCodePtr::MetaPredicateProperty)), ("$cpp_built_in_property", 2) => Some(SystemClauseType::REPL(REPLCodePtr::BuiltInProperty)), + ("$cpp_dynamic_property", 3) => Some(SystemClauseType::REPL(REPLCodePtr::DynamicProperty)), + ("$cpp_multifile_property", 3) => Some(SystemClauseType::REPL(REPLCodePtr::MultifileProperty)), + ("$cpp_discontiguous_property", 3) => Some(SystemClauseType::REPL(REPLCodePtr::DiscontiguousProperty)), ("$compile_pending_predicates", 1) => Some(SystemClauseType::REPL(REPLCodePtr::CompilePendingPredicates)), _ => None, } diff --git a/src/loader.pl b/src/loader.pl index 853842fb..e7bc3fa4 100644 --- a/src/loader.pl +++ b/src/loader.pl @@ -336,6 +336,13 @@ check_predicate_property(meta_predicate, Module, Name, Arity, MetaPredicateTerm) '$cpp_meta_predicate_property'(Module, Name, Arity, MetaPredicateTerm). check_predicate_property(built_in, _, Name, Arity, built_in) :- '$cpp_built_in_property'(Name, Arity). +check_predicate_property(dynamic, Module, Name, Arity, dynamic) :- + '$cpp_dynamic_property'(Module, Name, Arity). +check_predicate_property(multifile, Module, Name, Arity, multifile) :- + '$cpp_multifile_property'(Module, Name, Arity). +check_predicate_property(discontiguous, Module, Name, Arity, multifile) :- + '$cpp_discontiguous_property'(Module, Name, Arity). + extract_predicate_property(Property, PropertyType) :- @@ -356,12 +363,20 @@ predicate_property(Callable, Property) :- ; Callable =.. [(:), Module, Callable0], atom(Module) -> functor(Callable0, Name, Arity), - extract_predicate_property(Property, PropertyType), - check_predicate_property(PropertyType, Module, Name, Arity, Property) + ( atom(Name), + Name \== [] -> + extract_predicate_property(Property, PropertyType), + check_predicate_property(PropertyType, Module, Name, Arity, Property) + ; type_error(callable, Callable0, predicate_property/2) + ) ; functor(Callable, Name, Arity), - extract_predicate_property(Property, PropertyType), - load_context(Module), - check_predicate_property(PropertyType, Module, Name, Arity, Property) + ( atom(Name), + Name \== [] -> + extract_predicate_property(Property, PropertyType), + load_context(Module), + check_predicate_property(PropertyType, Module, Name, Arity, Property) + ; type_error(callable, Callable, predicate_property/2) + ) ). diff --git a/src/machine/loader.rs b/src/machine/loader.rs index 6687b545..802fa53e 100644 --- a/src/machine/loader.rs +++ b/src/machine/loader.rs @@ -549,6 +549,7 @@ impl<'a> Drop for LoadState<'a> { } } } + // TODO: necessary? unnecessary? // self.wam.code_repo.code.truncate(self.retraction_info.orig_code_extent); } @@ -1543,6 +1544,108 @@ impl Machine { } } + pub(crate) + fn dynamic_property(&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), + }; + + match self.indices.get_predicate_skeleton( + &compilation_target, + &key, + ) { + Some(skeleton) => { + self.machine_st.fail = !skeleton.is_dynamic; + } + None => { + self.machine_st.fail = true; + } + } + } + + pub(crate) + fn multifile_property(&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), + }; + + match self.indices.get_predicate_skeleton( + &compilation_target, + &key, + ) { + Some(skeleton) => { + self.machine_st.fail = !skeleton.is_multifile; + } + None => { + self.machine_st.fail = true; + } + } + } + + pub(crate) + fn discontiguous_property(&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), + }; + + match self.indices.get_predicate_skeleton( + &compilation_target, + &key, + ) { + Some(skeleton) => { + self.machine_st.fail = !skeleton.is_discontiguous; + } + None => { + self.machine_st.fail = true; + } + } + } + pub(crate) fn builtin_property(&mut self) { let key = diff --git a/src/machine/machine_indices.rs b/src/machine/machine_indices.rs index 869d4c92..0b0dc708 100644 --- a/src/machine/machine_indices.rs +++ b/src/machine/machine_indices.rs @@ -505,7 +505,6 @@ pub enum REPLCodePtr { AddDynamicPredicate, AddGoalExpansionClause, AddTermExpansionClause, - BuiltInProperty, ClauseToEvacuable, ConcludeLoad, DeclareModule, @@ -520,7 +519,11 @@ pub enum REPLCodePtr { PushLoadContext, PushLoadStatePayload, UseModule, + BuiltInProperty, MetaPredicateProperty, + MultifileProperty, + DiscontiguousProperty, + DynamicProperty, CompilePendingPredicates, UserAsserta, UserAssertz, diff --git a/src/machine/mod.rs b/src/machine/mod.rs index 56d8a704..239197ea 100644 --- a/src/machine/mod.rs +++ b/src/machine/mod.rs @@ -258,7 +258,7 @@ impl Machine { for arity in 1 .. 66 { let key = (clause_name!("call"), arity); - match loader.code_dir.get(&key).cloned() { + match loader.code_dir.get(&key) { Some(src_code_index) => { let target_code_index = target_module.code_dir .entry(key.clone()) @@ -482,6 +482,15 @@ impl Machine { REPLCodePtr::BuiltInProperty => { self.builtin_property(); } + REPLCodePtr::MultifileProperty => { + self.multifile_property(); + } + REPLCodePtr::DiscontiguousProperty => { + self.discontiguous_property(); + } + REPLCodePtr::DynamicProperty => { + self.dynamic_property(); + } REPLCodePtr::CompilePendingPredicates => { self.compile_pending_predicates(); } diff --git a/src/write.rs b/src/write.rs index bbb28e30..9079a2af 100644 --- a/src/write.rs +++ b/src/write.rs @@ -26,8 +26,6 @@ impl fmt::Display for REPLCodePtr { write!(f, "REPLCodePtr::AddGoalExpansionClause"), REPLCodePtr::AddTermExpansionClause => write!(f, "REPLCodePtr::AddTermExpansionClause"), - REPLCodePtr::BuiltInProperty => - write!(f, "REPLCodePtr::BuiltInProperty"), REPLCodePtr::UserAssertz => write!(f, "REPLCodePtr::UserAssertz"), REPLCodePtr::UserAsserta => @@ -64,6 +62,14 @@ impl fmt::Display for REPLCodePtr { write!(f, "REPLCodePtr::UseModule"), REPLCodePtr::MetaPredicateProperty => write!(f, "REPLCodePtr::MetaPredicateProperty"), + REPLCodePtr::BuiltInProperty => + write!(f, "REPLCodePtr::BuiltInProperty"), + REPLCodePtr::DynamicProperty => + write!(f, "REPLCodePtr::DynamicProperty"), + REPLCodePtr::MultifileProperty => + write!(f, "REPLCodePtr::MultifileProperty"), + REPLCodePtr::DiscontiguousProperty => + write!(f, "REPLCodePtr::DiscontiguousProperty"), REPLCodePtr::CompilePendingPredicates => write!(f, "REPLCodePtr::CompilePendingPredicates"), }