Merge pull request #2738 from adri326/fix-2275-dcgs-call-module

Fix dcgs using call(M:Pred) when M was left unassigned

Author: mthom

src/lib/builtins.pl

@@ -1175,7 +1175,7 @@
 % Asserts (inserts) a new clause (rule or fact) into the current module.
 % The clause will be inserted at the beginning of the module.
 asserta(Clause0) :-
-    loader:strip_subst_module(Clause0, user, Module, Clause),
+    loader:strip_module(Clause0, Module, Clause),
     asserta_(Module, Clause).
 
 asserta_(Module, (Head :- Body)) :-
@@ -1191,7 +1191,7 @@
 % Asserts (inserts) a new clause (rule or fact) into the current module.
 % The clase will be inserted at the end of the module.
 assertz(Clause0) :-
-    loader:strip_subst_module(Clause0, user, Module, Clause),
+    loader:strip_module(Clause0, Module, Clause),
     assertz_(Module, Clause).
 
 assertz_(Module, (Head :- Body)) :-
@@ -1211,15 +1211,9 @@
     loader:strip_module(Clause0, Module, Clause),
     (  Clause \= (_ :- _) ->
        loader:strip_module(Clause, Module, Head),
-       (  var(Module) -> Module = user
-       ;  true
-       ),
        Body = true,
        retract_module_clause(Head, Body, Module)
     ;  Clause = (Head :- Body) ->
-       (  var(Module) -> Module = user
-       ;  true
-       ),
        retract_module_clause(Head, Body, Module)
     ).
 
@@ -1374,10 +1368,6 @@
        '$get_db_refs'(_, _, _, PIs),
        lists:member(Pred, PIs)
     ;  loader:strip_module(Pred, Module, UnqualifiedPred),
-       (  var(Module),
-          \+ functor(Pred, (:), 2)
-       ;  atom(Module)
-       ),
        UnqualifiedPred = Name/Arity ->
        (  (  nonvar(Name), \+ atom(Name)
           ;  nonvar(Arity), \+ integer(Arity)

src/loader.pl

@@ -695,10 +695,9 @@
     (  MQ = specified(M) ->
        true
     ;  MQ = unspecified,
-       true
+       load_context(M)
     ).
 
-
 :- non_counted_backtracking strip_subst_module/4.
 
 strip_subst_module(Goal, M1, M2, G) :-

src/machine/system_calls.rs

@@ -104,6 +104,22 @@ use super::libraries;
 use super::preprocessor::to_op_decl;
 use super::preprocessor::to_op_decl_spec;
 
+/// Represents the presence (or absence) of a `module:` prefix to predicates, used to
+/// refer to predicates defined in a given `module` that haven't been imported
+/// (through `use_module/1`) or exported.
+///
+/// On the Rust side, [`MachineState::strip_module`] splits a given [`HeapCellValue`] into
+/// a pair of [`ModuleQuantification`] and `HeapCellValue`.
+///
+/// On the Prolog side, `strip_module(X, Y, Z)` is a wrapper around [`MachineState::strip_module`],
+/// which takes care of splitting the `X = module:predicate` pair into `Y = module` and
+/// `Z = predicate`. If no module prefix is present (ie. [`MachineState::strip_module`] returned
+/// `Unspecified`), then `strip_module/3` calls `load_context(Y)`, unifying `Y` with the currently
+/// loaded module (or `user`).
+///
+/// [`Machine::quantification_to_module_name`] provides a similar mechanism on the Rust side to
+/// obtain the currently loaded module in the `Unspecified` case.
+/// It also defaults to `user`, for instance if we are in the REPL.
 #[derive(Debug)]
 pub(crate) enum ModuleQuantification {
     Specified(HeapCellValue),

src/tests/module_resolution.pl

@@ -0,0 +1,8 @@
+:- module(module_resolution, [get_module/2]).
+
+get_module(P, M) :- strip_module(P, M, _).
+
+:- initialization((strip_module(hello, M, _), write(M), write('\n'))).
+:- initialization((loader:strip_module(hello, M, _), write(M), write('\n'))).
+:- initialization((get_module(hello, M), write(M), write('\n'))).
+:- initialization((module_resolution:get_module(hello, M), write(M), write('\n'))).

tests-pl/issue2725.pl

@@ -0,0 +1,35 @@
+:- module(issue2725, []).
+:- use_module(library(dcgs)).
+
+% Tests that the id/3 dcg can be called.
+% library(dcgs) currently expands it to id(X, Y, Z) :- phrase(X, Y, Z).
+id(X) --> X.
+call_id :-
+    id("Hello", X, []),
+    X = "Hello".
+:- initialization(call_id).
+
+test_default_strip_module :-
+    strip_module(hello, M, P),
+    nonvar(M),
+    M = issue2725,
+    nonvar(P),
+    P = hello,
+    strip_module(hello, issue2725, _),
+    strip_module(hello, M, P).
+:- initialization(test_default_strip_module).
+
+% Tests that strip_module followed by call works with or without the module: prefix.
+strip_module_call(Pred) :-
+    loader:strip_module(Pred, M, Pred0),
+    call(M:Pred0).
+
+my_true.
+
+test_strip_module_call :-
+    strip_module_call(my_true),
+    strip_module_call(issue2725:my_true).
+:- initialization(test_strip_module_call).
+
+% :- initialization(loader:prolog_load_context(module, M), write(M), write('\n')).
+% :- initialization(loader:load_context(user)).

tests/scryer/cli/src_tests/module_resolution.stderr

@@ -0,0 +1,6 @@
+module_resolution
+module_resolution
+module_resolution
+module_resolution
+user
+user

tests/scryer/cli/src_tests/module_resolution.stdout

@@ -0,0 +1,10 @@
+args = [
+    "-f",
+    "--no-add-history",
+    "src/tests/module_resolution.pl",
+    "-f",
+    "-g", "use_module(library(module_resolution))",
+    "-g", "get_module(some_predicate, M), write(M), write('\\n')",
+    "-g", "module_resolution:get_module(some_predicate, M), write(M), write('\\n')",
+    "-g", "halt"
+]

tests/scryer/cli/src_tests/module_resolution.toml

@@ -33,3 +33,13 @@ fn call_qualification() {
 fn load_context_unreachable() {
     load_module_test("tests-pl/load-context-unreachable.pl", "");
 }
+
+// Issue #2725: A dcg of the form `id(X) --> X.` would previously trigger an instantiation
+// error, as it would call `strip_module(X, M, P)` and later `call(M:P)`,
+// but `strip_module` left `M` uninstanciated if the `module:` prefix was unspecified.
+#[serial]
+#[test]
+#[cfg_attr(miri, ignore = "it takes too long to run")]
+fn issue2725_dcg_without_module() {
+    load_module_test("tests-pl/issue2725.pl", "");
+}