From 0e2db4a23e269dd59d0d15858f76a650e4f6bc6a Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Fri, 19 Nov 2021 23:00:56 -0700 Subject: [PATCH] tag DCG constructs with module names for proper resolution --- src/clause_types.rs | 4 +- src/lib/builtins.pl | 44 +++++----- src/lib/dcgs.pl | 120 ++++++++++++++++++---------- src/loader.pl | 33 +++++--- src/machine/attributed_variables.rs | 18 ++--- 5 files changed, 131 insertions(+), 88 deletions(-) diff --git a/src/clause_types.rs b/src/clause_types.rs index d3ba917c..540bf779 100644 --- a/src/clause_types.rs +++ b/src/clause_types.rs @@ -638,8 +638,8 @@ impl SystemClauseType { (atom!("$flush_output"), 1) => Some(SystemClauseType::FlushOutput), (atom!("$del_attr_non_head"), 1) => Some(SystemClauseType::DeleteAttribute), (atom!("$del_attr_head"), 1) => Some(SystemClauseType::DeleteHeadAttribute), - (atom!("$get_next_db_ref"), 2) => Some(SystemClauseType::GetNextDBRef), - (atom!("$get_next_op_db_ref"), 2) => Some(SystemClauseType::GetNextOpDBRef), + (atom!("$get_next_db_ref"), 4) => Some(SystemClauseType::GetNextDBRef), + (atom!("$get_next_op_db_ref"), 7) => Some(SystemClauseType::GetNextOpDBRef), (atom!("$module_call"), _) => Some(SystemClauseType::DynamicModuleResolution(arity - 2)), (atom!("$enqueue_attr_var"), 1) => Some(SystemClauseType::EnqueueAttributedVar), (atom!("$partial_string_tail"), 2) => Some(SystemClauseType::PartialStringTail), diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl index 534edb06..ef9f555e 100644 --- a/src/lib/builtins.pl +++ b/src/lib/builtins.pl @@ -61,61 +61,61 @@ call(G, A, B, C, D, E, F, G, H) :- '$call'(G, A, B, C, D, E, F, G, H). Module : Predicate :- - ( atom(Module) -> '$module_call'(Module, Predicate) - ; throw(error(type_error(atom, Module), (:)/2)) + ( atom(Module) -> '$module_call'(Module, Predicate) + ; throw(error(type_error(atom, Module), (:)/2)) ). % dynamic module resolution. :(Module, Predicate, A1) :- - ( atom(Module) -> '$module_call'(A1, Module, Predicate) - ; throw(error(type_error(atom, Module), (:)/2)) + ( atom(Module) -> '$module_call'(A1, Module, Predicate) + ; throw(error(type_error(atom, Module), (:)/2)) ). :(Module, Predicate, A1, A2) :- - ( atom(Module) -> '$module_call'(A1, A2, Module, Predicate) - ; throw(error(type_error(atom, Module), (:)/2)) + ( atom(Module) -> '$module_call'(A1, A2, Module, Predicate) + ; throw(error(type_error(atom, Module), (:)/2)) ). :(Module, Predicate, A1, A2, A3) :- - ( atom(Module) -> '$module_call'(A1, A2, A3, Module, Predicate) - ; throw(error(type_error(atom, Module), (:)/2)) + ( atom(Module) -> '$module_call'(A1, A2, A3, Module, Predicate) + ; throw(error(type_error(atom, Module), (:)/2)) ). :(Module, Predicate, A1, A2, A3, A4) :- - ( atom(Module) -> '$module_call'(A1, A2, A3, A4, Module, Predicate) - ; throw(error(type_error(atom, Module), (:)/2)) + ( atom(Module) -> '$module_call'(A1, A2, A3, A4, Module, Predicate) + ; throw(error(type_error(atom, Module), (:)/2)) ). :(Module, Predicate, A1, A2, A3, A4, A5) :- - ( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, Module, Predicate) - ; throw(error(type_error(atom, Module), (:)/2)) + ( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, Module, Predicate) + ; throw(error(type_error(atom, Module), (:)/2)) ). :(Module, Predicate, A1, A2, A3, A4, A5, A6) :- - ( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, Module, Predicate) - ; throw(error(type_error(atom, Module), (:)/2)) + ( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, Module, Predicate) + ; throw(error(type_error(atom, Module), (:)/2)) ). :(Module, Predicate, A1, A2, A3, A4, A5, A6, A7) :- - ( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, Module, Predicate) - ; throw(error(type_error(atom, Module), (:)/2)) + ( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, Module, Predicate) + ; throw(error(type_error(atom, Module), (:)/2)) ). :(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8) :- - ( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, Module, Predicate) - ; throw(error(type_error(atom, Module), (:)/2)) + ( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, Module, Predicate) + ; throw(error(type_error(atom, Module), (:)/2)) ). :(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8, A9) :- - ( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, A9, Module, Predicate) - ; throw(error(type_error(atom, Module), (:)/2)) + ( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, A9, Module, Predicate) + ; throw(error(type_error(atom, Module), (:)/2)) ). :(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10) :- - ( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, Module, Predicate) - ; throw(error(type_error(atom, Module), (:)/2)) + ( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, Module, Predicate) + ; throw(error(type_error(atom, Module), (:)/2)) ). % flags. diff --git a/src/lib/dcgs.pl b/src/lib/dcgs.pl index f4cee25c..35a0f27d 100644 --- a/src/lib/dcgs.pl +++ b/src/lib/dcgs.pl @@ -1,16 +1,25 @@ :- module(dcgs, [op(1105, xfy, '|'), - phrase/2, - phrase/3, - seq//1, - seqq//1, - ... //0 - ]). + phrase/2, + phrase/3, + seq//1, + seqq//1, + ... //0 + ]). :- use_module(library(error)). -:- use_module(library(lists), [append/3]). +:- use_module(library(lists), [append/3, member/2]). :- use_module(library(loader), [strip_module/3]). +load_context(GRBody, Module, GRBody0) :- + strip_module(GRBody, Module, GRBody0), + ( nonvar(Module) -> + true + ; prolog_load_context(module, Module) -> + true + ; true + ). + :- meta_predicate phrase(2, ?). :- meta_predicate phrase(2, ?, ?). @@ -18,77 +27,78 @@ phrase(GRBody, S0) :- phrase(GRBody, S0, []). - phrase(GRBody, S0, S) :- ( var(GRBody) -> throw(error(instantiation_error, phrase/3)) - ; strip_module(GRBody, Module, GRBody0), + ; load_context(GRBody, Module, GRBody0), dcg_constr(GRBody0) -> ( var(Module) -> phrase_(GRBody0, S0, S) - ; phrase_(Module:GRBody0, S0, S) + ; phrase_(GRBody0, S0, S, Module) ) ; functor(GRBody, _, _) -> call(GRBody, S0, S) ; throw(error(type_error(callable, GRBody), phrase/3)) ). +phrase_([], S, S, _). +phrase_(!, S, S, _). +phrase_((A, B), S0, S, M) :- + phrase(M:A, S0, S1), + phrase(M:B, S1, S). +phrase_((A -> B ; C), S0, S, M) :- + ( phrase(M:A, S0, S1) -> + phrase(M:B, S1, S) + ; phrase(M:C, S0, S) + ). +phrase_((A ; B), S0, S, M) :- + ( phrase(M:A, S0, S) + ; phrase(M:B, S0, S) + ). +phrase_((A | B), S0, S, M) :- + ( phrase(M:A, S0, S) + ; phrase(M:B, S0, S) + ). +phrase_({G}, S, S, M) :- + call(M:G). +phrase_(call(G), S0, S, M) :- + call(M:G, S0, S). +phrase_((A -> B), S0, S, M) :- + ( phrase(M:A, S0, S1) -> + phrase(M:B, S1, S) + ; fail + ). +phrase_(phrase(NonTerminal), S0, S, M) :- + phrase(NonTerminal, S0, S, M). +phrase_([T|Ts], S0, S, _) :- + append([T|Ts], S, S0). + phrase_([], S, S). phrase_(!, S, S). -phrase_(_:[], S, S) :- !. -phrase_(_:!, S, S) :- !. +phrase_(M:G, S0, S) :- + phrase_(G, S0, S, M). phrase_((A, B), S0, S) :- - phrase(A, S0, S1), phrase(B, S1, S). -phrase_(M:(A, B), S0, S) :- - !, - phrase(M:A, S0, S1), phrase(M:B, S1, S). + phrase(A, S0, S1), + phrase(B, S1, S). phrase_((A -> B ; C), S0, S) :- - !, ( phrase(A, S0, S1) -> phrase(B, S1, S) ; phrase(C, S0, S) ). -phrase_(M:(A -> B ; C), S0, S) :- - !, - ( phrase(M:A, S0, S1) -> - phrase(M:B, S1, S) - ; phrase(M:C, S0, S) - ). phrase_((A ; B), S0, S) :- ( phrase(A, S0, S) ; phrase(B, S0, S) ). -phrase_(M:(A ; B), S0, S) :- - !, - ( phrase(M:A, S0, S) ; phrase(M:B, S0, S) ). phrase_((A | B), S0, S) :- ( phrase(A, S0, S) ; phrase(B, S0, S) ). -phrase_(M:(A | B), S0, S) :- - !, - ( phrase(M:A, S0, S) ; phrase(M:B, S0, S) ). phrase_({G}, S0, S) :- ( call(G), S0 = S ). -phrase_(M:{G}, S0, S) :- - !, - ( call(M:G), S0 = S ). phrase_(call(G), S0, S) :- call(G, S0, S). -phrase_(M:call(G), S0, S) :- - !, - call(M:G, S0, S). phrase_((A -> B), S0, S) :- phrase((A -> B ; fail), S0, S). -phrase_(M:(A -> B), S0, S) :- - !, - phrase((M:A -> M:B ; fail), S0, S). phrase_(phrase(NonTerminal), S0, S) :- phrase(NonTerminal, S0, S). -phrase_(M:phrase(NonTerminal), S0, S) :- - !, - phrase(M:NonTerminal, S0, S). phrase_([T|Ts], S0, S) :- append([T|Ts], S, S0). -phrase_(_:[T|Ts], S0, S) :- - append([T|Ts], S, S0). - % The same version of the below two dcg_rule clauses, but with module scoping. dcg_rule(( M:NonTerminal, Terminals --> GRBody ), ( M:Head :- Body )) :- @@ -193,3 +203,25 @@ seqq([Es|Ess]) --> seq(Es), seqq(Ess). % Describes an arbitrary number of elements ... --> [] | [_], ... . + +user:goal_expansion(phrase(GRBody, S, S0), phrase(GRBody1, S, S0)) :- + strip_module(GRBody, M, GRBody0), + var(M), + prolog_load_context(module, M), + ( nonvar(GRBody0) -> + GRBody0 \== [], + dcg_constr(GRBody0), + predicate_property(GRBody0, meta_predicate(_)) + ), + GRBody1 = M:GRBody0. + +user:goal_expansion(phrase(GRBody, S), phrase(GRBody1, S, [])) :- + strip_module(GRBody, M, GRBody0), + var(M), + prolog_load_context(module, M), + ( nonvar(GRBody0) -> + GRBody0 \== [], + dcg_constr(GRBody0), + predicate_property(GRBody0, meta_predicate(_)) + ), + GRBody1 = M:GRBody0. diff --git a/src/loader.pl b/src/loader.pl index 87d758be..fb5d8ab1 100644 --- a/src/loader.pl +++ b/src/loader.pl @@ -315,6 +315,7 @@ compile_dispatch(user:goal_expansion(Term, Terms), Evacuable) :- compile_dispatch((user:goal_expansion(Term, Terms) :- Body), Evacuable) :- '$add_goal_expansion_clause'(user, (goal_expansion(Term, Terms) :- Body), Evacuable). + remove_module(Module, Evacuable) :- ( nonvar(Module), Module = library(ModuleName), @@ -708,17 +709,13 @@ expand_goal(UnexpandedGoals, Module, ExpandedGoals, HeadVars) :- ) ). -thread_goals(Goals0, Goals1, Functor) :- - ( var(Goals0) -> - Goals0 = Goals1 - ; ( Goals0 = [G | Gs] -> - ( Gs = [] -> - Goals1 = G - ; Goals1 =.. [Functor, G, Goals2], - thread_goals(Gs, Goals2, Functor) - ) - ; Goals1 = Goals0 - ) +thread_goals([SG|SGs], G, F) :- + ( SGs \== [], functor(G, F, 2) -> + arg(1, G, SG), + arg(2, G, Gs1), + thread_goals(SGs, Gs1, F) + ; SG = G, + SGs = [] ). thread_goals(Goals0, Goals1, Hole, Functor) :- @@ -734,6 +731,20 @@ thread_goals(Goals0, Goals1, Hole, Functor) :- ) ). +/* +thread_goals(Goals0, Goals1, Functor) :- + ( var(Goals0) -> + Goals0 = Goals1 + ; ( Goals0 = [G | Gs] -> + ( Gs = [] -> + Goals1 = G + ; Goals1 =.. [Functor, G, Goals2], + thread_goals(Gs, Goals2, Functor) + ) + ; Goals1 = Goals0 + ) + ). +*/ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % diff --git a/src/machine/attributed_variables.rs b/src/machine/attributed_variables.rs index 34cdd12e..48c5ec8b 100644 --- a/src/machine/attributed_variables.rs +++ b/src/machine/attributed_variables.rs @@ -86,21 +86,21 @@ impl MachineState { .iter() .filter_map(|h| { read_heap_cell!(self.store(self.deref(heap_loc_as_cell!(*h))), //Addr::HeapCell(*h))) { - (HeapCellValueTag::AttrVar, h) => { - Some(attr_var_as_cell!(h)) - } - _ => { - None - } + (HeapCellValueTag::AttrVar, h) => { + Some(attr_var_as_cell!(h)) + } + _ => { + None + } ) }) .collect(); attr_vars.sort_unstable_by(|a1, a2| { - compare_term_test!(self, *a1, *a2).unwrap_or(Ordering::Less) - }); + compare_term_test!(self, *a1, *a2).unwrap_or(Ordering::Less) + }); - attr_vars.dedup(); + attr_vars.dedup(); attr_vars.into_iter() } -- 2.54.0