From: Mark Thom Date: Mon, 1 Feb 2021 23:09:19 +0000 (-0700) Subject: add module scoping to predicate_property, expand subgoals in module resolved predicates X-Git-Tag: v0.9.0~150^2~67^2~8 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=6ed77675120ff368a9d834239ea28d8c58d7f769;p=scryer-prolog.git add module scoping to predicate_property, expand subgoals in module resolved predicates --- diff --git a/src/clause_types.rs b/src/clause_types.rs index 91f6447e..aded0bb2 100644 --- a/src/clause_types.rs +++ b/src/clause_types.rs @@ -769,7 +769,7 @@ impl SystemClauseType { ("$prolog_lc_dir", 1) => Some(SystemClauseType::REPL(REPLCodePtr::LoadContextDirectory)), ("$prolog_lc_module", 1) => Some(SystemClauseType::REPL(REPLCodePtr::LoadContextModule)), ("$prolog_lc_stream", 1) => Some(SystemClauseType::REPL(REPLCodePtr::LoadContextStream)), - ("$cpp_meta_predicate_property", 3) => Some(SystemClauseType::REPL(REPLCodePtr::MetaPredicateProperty)), + ("$cpp_meta_predicate_property", 4) => Some(SystemClauseType::REPL(REPLCodePtr::MetaPredicateProperty)), ("$compile_pending_predicates", 1) => Some(SystemClauseType::REPL(REPLCodePtr::CompilePendingPredicates)), _ => None, } diff --git a/src/loader.pl b/src/loader.pl index 88d65770..2a472ebf 100644 --- a/src/loader.pl +++ b/src/loader.pl @@ -56,7 +56,6 @@ load_loop(Stream, Evacuable) :- ; var(Term) -> instantiation_error(load/1) ; expand_terms_and_goals(Term, Terms), - nl, write('Terms:'), write(Terms), nl, nl, !, ( var(Terms) -> instantiation_error(load/1) @@ -100,7 +99,7 @@ module_expanded_head_variables_([HeadArg | HeadArgs], [MetaSpec | MetaSpecs], He ; module_expanded_head_variables_(HeadArgs, MetaSpecs, HeadVars, HeadVars0) ). -module_expanded_head_variables(Head, MetaSpecs, HeadVars) :- +module_expanded_head_variables(Head, HeadVars) :- ( var(Head) -> instantiation_error(load/1) ; predicate_property(Head, meta_predicate(MetaSpecs)), @@ -110,15 +109,12 @@ module_expanded_head_variables(Head, MetaSpecs, HeadVars) :- ). -expand_terms_and_goals(Term, Terms) :- - expand_term(Term, Terms0), - ( var(Terms0) -> - instantiation_error(load/1) - ; Terms0 = (Head1 :- Body0) -> +expand_term_goals(Terms0, Terms) :- + ( Terms0 = (Head1 :- Body0) -> ( var(Head1) -> instantiation_error(load/1) ; prolog_load_context(module, Target), - module_expanded_head_variables(Head1, MetaSpecs, HeadVars), + module_expanded_head_variables(Head1, HeadVars), expand_goal(Body0, Target, Body1, HeadVars) ), Terms = (Head1 :- Body1) @@ -126,6 +122,16 @@ expand_terms_and_goals(Term, Terms) :- ). +expand_terms_and_goals(Term, Terms) :- + expand_term(Term, Terms0), + ( var(Terms0) -> + instantiation_error(load/1) + ; Terms0 = [_|_] -> + maplist(loader:expand_term_goals, Terms0, Terms) + ; expand_term_goals(Terms0, Terms) + ). + + expand_term(UnexpandedTerm, ExpandedTerm) :- user:term_expansion(UnexpandedTerm, ExpandedTerm). @@ -141,8 +147,7 @@ compile_dispatch_or_clause(Term, Evacuable, VNs) :- instantiation_error(load/1) ; compile_dispatch(Term, Evacuable, VNs) -> true - ; - compile_clause(Term, Evacuable, VNs) + ; compile_clause(Term, Evacuable, VNs) ). @@ -286,21 +291,30 @@ use_module(Module, Exports, Evacuable) :- -check_predicate_property(meta_predicate, Name, Arity, MetaPredicateTerm) :- +check_predicate_property(meta_predicate, Module, Name, Arity, MetaPredicateTerm) :- must_be(atom, Name), must_be(integer, Arity), - '$cpp_meta_predicate_property'(Name, Arity, MetaPredicateTerm). + '$cpp_meta_predicate_property'(Module, Name, Arity, MetaPredicateTerm). +extract_predicate_property(Property, PropertyType) :- + ( var(Property) -> + true + ; functor(Property, PropertyType, _) + ). + predicate_property(Callable, Property) :- ( var(Callable) -> instantiation_error(load/1) + ; Callable =.. [(:), Module, Callable0], + atom(Module) -> + functor(Callable0, Name, Arity), + extract_predicate_property(Property, PropertyType), + check_predicate_property(PropertyType, Module, Name, Arity, Property) ; functor(Callable, Name, Arity), - ( var(Property) -> - true - ; functor(Property, PropertyType, _) - ), - check_predicate_property(PropertyType, Name, Arity, Property) + extract_predicate_property(Property, PropertyType), + prolog_load_context(module, Module), + check_predicate_property(PropertyType, Module, Name, Arity, Property) ). @@ -363,8 +377,10 @@ expand_meta_predicate_subgoals([], _, _, [], _). expand_module_names(Goals, MetaSpecs, Module, ExpandedGoals, HeadVars) :- Goals =.. [GoalFunctor | SubGoals], - ( GoalFunctor == (:) -> - false + ( GoalFunctor == (:), + SubGoals = [M, SubGoal] -> + expand_module_names(SubGoal, MetaSpecs, Module, ExpandedSubGoal, HeadVars), + ExpandedGoals = M:ExpandedSubGoal ; expand_meta_predicate_subgoals(SubGoals, MetaSpecs, Module, ExpandedGoalList, HeadVars), ExpandedGoals =.. [GoalFunctor | ExpandedGoalList] ). diff --git a/src/machine/loader.rs b/src/machine/loader.rs index ef8cbbaf..88b023e7 100644 --- a/src/machine/loader.rs +++ b/src/machine/loader.rs @@ -1483,17 +1483,23 @@ impl Machine { pub(crate) fn meta_predicate_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 (predicate_name, arity) = self.machine_st.read_predicate_key( - self.machine_st[temp_v!(1)], self.machine_st[temp_v!(2)], + self.machine_st[temp_v!(3)], ); let compilation_target = - if let Some(load_context) = self.load_contexts.last() { - CompilationTarget::Module(load_context.module.clone()) - } else { - CompilationTarget::User + match module_name.as_str() { + "user" => CompilationTarget::User, + _ => CompilationTarget::Module(module_name), }; match self.indices.get_meta_predicate_spec(predicate_name, arity, &compilation_target) { @@ -1516,7 +1522,7 @@ impl Machine { ); self.machine_st.heap.push(HeapCellValue::Addr(Addr::HeapCell(list_loc))); - self.machine_st.unify(Addr::HeapCell(heap_loc), self.machine_st[temp_v!(3)]); + self.machine_st.unify(Addr::HeapCell(heap_loc), self.machine_st[temp_v!(4)]); } None => { self.machine_st.fail = true;