Fix #2725 by calling load_context/1 in the unspecified branch of strip_module/3

This fixes #2725, by making it so that `strip_module(Pred, M, P), call(M:P)`
doesn't throw an `instanciation_error` when `Pred` isn't in the form `module:predicate`.

Now, `strip_module(hello, M, P)` will call `load_context(M)`, which unifies `M`
with the topmost module (or `user`).

Two new test cases are added: issue2725.pl, which tests the minimal case id(X) --> X.
and the strip_module(P, M, _), call(M:P) scenario, and module_resolution,
which tests the behavior of strip_module in a few scenarios.

diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl
index c705c6c8346d5d877b6528bcf67000040f42f1eb..745cbc48795f73f2c13800561f7e76b7a14ccb15 100644 (file)
--- a/src/lib/builtins.pl
+++ b/src/lib/builtins.pl
@@ -1175,7 +1175,7 @@ clause(H, B) :-
 % 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 @@ asserta_(Module, Fact) :-
 % 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 @@ retract(Clause0) :-
     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 @@ current_predicate(Pred) :-
        '$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)

diff --git a/src/loader.pl b/src/loader.pl
index 59d434d6c5c50b265a6df343ffc1de84ea60b466..cf3c144834d744146c68d2a4c26525a20c8de423 100644 (file)
--- a/src/loader.pl
+++ b/src/loader.pl
@@ -695,10 +695,9 @@ strip_module(Goal, M, G) :-
     (  MQ = specified(M) ->
        true
     ;  MQ = unspecified,
-       true
+       load_context(M)
     ).
 
-
 :- non_counted_backtracking strip_subst_module/4.
 
 strip_subst_module(Goal, M1, M2, G) :-

diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs
index 8d80926b9d4afc8c28b3763a1d5a62123a9db00a..eca9cf7839ff942ce16934d20100d68c9265c22e 100644 (file)
--- a/src/machine/system_calls.rs
+++ b/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),

diff --git a/src/tests/module_resolution.pl b/src/tests/module_resolution.pl
new file mode 100644 (file)
index 0000000..d81caea
--- /dev/null
+++ b/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'))).

diff --git a/tests-pl/issue2725.pl b/tests-pl/issue2725.pl
new file mode 100644 (file)
index 0000000..48f0fd8
--- /dev/null
+++ b/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)).

diff --git a/tests/scryer/cli/src_tests/module_resolution.stderr b/tests/scryer/cli/src_tests/module_resolution.stderr
new file mode 100644 (file)
index 0000000..e69de29

diff --git a/tests/scryer/cli/src_tests/module_resolution.stdout b/tests/scryer/cli/src_tests/module_resolution.stdout
new file mode 100644 (file)
index 0000000..7149b3e
--- /dev/null
+++ b/tests/scryer/cli/src_tests/module_resolution.stdout
@@ -0,0 +1,6 @@
+module_resolution
+module_resolution
+module_resolution
+module_resolution
+user
+user

diff --git a/tests/scryer/cli/src_tests/module_resolution.toml b/tests/scryer/cli/src_tests/module_resolution.toml
new file mode 100644 (file)
index 0000000..64db35d
--- /dev/null
+++ b/tests/scryer/cli/src_tests/module_resolution.toml
@@ -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"
+]

diff --git a/tests/scryer/issues.rs b/tests/scryer/issues.rs
index 207c490942bc1e1c76a137665401a67edb3651ac..784c20d0dc575ce01dccd1d82f3cf5ef9597d154 100644 (file)
--- a/tests/scryer/issues.rs
+++ b/tests/scryer/issues.rs
@@ -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", "");
+}