tag DCG constructs with module names for proper resolution

diff --git a/src/clause_types.rs b/src/clause_types.rs
index d3ba917c0916474f163c06500327825e032a4387..540bf779a78cc4abfa0e46cdba8ebf2079866afa 100644 (file)
--- 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 534edb06d750921780116f6750fe0b3843029458..ef9f555e462c6a2fa9ddc26f0bc0810bc68b67f4 100644 (file)
--- 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 f4cee25c6ee9b1a996d237ce80322b45c594711e..35a0f27d5b5d682a43410c1eb3221168023f2938 100644 (file)
--- 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 87d758be4fd9073ad03538493d6a145e7dd67e09..fb5d8ab138e5ca4c605d880ea7f1fbda326a3b8a 100644 (file)
--- 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 34cdd12ef5b85e58f40b4f374cce7f598c71ff9b..48c5ec8be93852b58f9a244e3ec85dc5fef40733 100644 (file)
--- 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()
     }