[nongnu] elpa/sweeprolog 9803b7dc24 5/6: ENHANCED: Improve DCG support

[ELPA Syncer]

branch: elpa/sweeprolog
commit 9803b7dc24e29b63324891374084e52e3ec9b9d4
Author: Eshel Yaron <me@eshelyaron.com>
Commit: Eshel Yaron <me@eshelyaron.com>

    ENHANCED: Improve DCG support
    
    Take into account DCG grammar rules and ensure they're supported all
    around.  Crucially, allow 'sweeprolog-describe-predicate' to display
    documentation for DCG grammar rules.
---
 sweep.pl            | 130 +++++++++++++++++++++++++++-------------------------
 sweeprolog-tests.el |  24 ++++++++--
 sweeprolog.el       | 122 ++++++++++++++++++++++++++++++++++++------------
 3 files changed, 179 insertions(+), 97 deletions(-)

diff --git a/sweep.pl b/sweep.pl
index e92d632c2a..a7c5c1a709 100644
--- a/sweep.pl
+++ b/sweep.pl
@@ -43,7 +43,7 @@
             sweep_predicate_location/2,
             sweep_predicate_apropos/2,
             sweep_predicates_collection/2,
-            sweep_functor_arity_pi/2,
+            sweep_module_functor_arity_pi/2,
             sweep_modules_collection/2,
             sweep_packs_collection/2,
             sweep_pack_install/2,
@@ -269,7 +269,9 @@ sweep_module_path_(Module, Path) :-
 sweep_module_path_(Module, Path) :-
     xref_module(Path, Module), !.
 sweep_module_path_(Module, Path) :-
-    '$autoload':library_index(_, Module, Path0), atom_concat(Path0, '.pl', 
Path).
+    '$autoload':library_index(_, Module, Path0), atom_concat(Path0, '.pl', 
Path), !.
+sweep_module_path_(user, _).
+
 
 sweep_predicate_properties(P0, Props) :-
     term_string(P, P0),
@@ -278,9 +280,9 @@ sweep_predicate_properties(P0, Props) :-
 
 sweep_predicate_html_documentation(P0, D) :-
     term_string(P1, P0),
-    (   P1 = M:F/N
+    (   P1 = M:PI
     ->  true
-    ;   P1 = F/N, M = system
+    ;   P1 = PI, M = system
     ),
     (   (   current_module(M)
         ;   xref_module(_, M)
@@ -289,10 +291,10 @@ sweep_predicate_html_documentation(P0, D) :-
     ;   '$autoload':library_index(_, M, Path),
         xref_source(Path, [comments(store)])
     ),
-    (   M == system
-    ->  pldoc_man:load_man_object(F/N, _, _, DOM)
-    ;   doc_comment(M:F/N, Pos, _, Comment),
-        pldoc_html:pred_dom(M:F/N, [], Pos-Comment, DOM)
+    (   pldoc_man:load_man_object(M:PI, _, _, DOM)
+    ;   pldoc_man:load_man_object(PI, _, _, DOM)
+    ;   doc_comment(M:PI, Pos, _, Comment),
+        pldoc_html:pred_dom(M:PI, [], Pos-Comment, DOM)
     ),
     phrase(pldoc_html:html(DOM), HTML),
     with_output_to(string(D), html_write:print_html(HTML)).
@@ -324,23 +326,23 @@ sweep_module_description([M0|P], [M|[P|D]]) :-
 sweep_module_description([M0|P], [M|[P]]) :- atom_string(M0, M).
 
 sweep_predicate_references(MFN, Refs) :-
-    term_string(M:F/N, MFN),
-    pi_head(F/N, H),
-    findall([B, Path, From, Len],
-            (xref_called(Path0, H, B0, _, Line),
-             pi_head(B1, B0),
-             term_string(B1, B),
-             atom_string(Path0, Path),
-             reference_span(Path0, Line, H, From, Len)),
-            Refs,
-            Tail),
+    term_string(M:PI, MFN),
+    pi_head(PI, H),
     findall([B, Path, From, Len],
-            (xref_called(Path0, M:H, B0, _, Line),
+            ((   xref_called(Path0, H, B0, _, Line)
+             ;   xref_called(Path0, M:H, B0, _, Line)
+             ),
              pi_head(B1, B0),
-             term_string(B1, B),
+             (   B1 = M2:F/N
+             ->  true
+             ;   B1 = F/N,
+                 sweep_module_path_(M2, Path0)
+             ),
+             sweep_module_functor_arity_pi_(M2, F, N, B2),
+             term_string(B2, B),
              atom_string(Path0, Path),
              reference_span(Path0, Line, H, From, Len)),
-            Tail).
+            Refs).
 
 :- dynamic current_reference_span/2.
 
@@ -361,31 +363,30 @@ reference_span_(Head, goal_term(_, Goal), Beg0, Len) :-
 reference_span_(_, _, _, _) :- true.
 
 sweep_predicate_location(MFN, [Path|Line]) :-
-    term_string(M:F/N, MFN),
+    term_string(M:PI, MFN),
     !,
-    pi_head(F/N, H),
+    pi_head(PI, H),
     (   sweep_predicate_location_(M, H, Path, Line)
     ->  true
     ;   sweep_predicate_location_(H, Path, Line)
     ).
 sweep_predicate_location(FN, [Path|Line]) :-
-    term_string(F/N, FN),
-    !,
-    pi_head(F/N, H),
+    term_string(PI, FN),
+    pi_head(PI, H),
     sweep_predicate_location_(H, Path, Line).
 
 sweep_predicate_apropos(Query0, Matches) :-
     atom_string(Query, Query0),
     findall([S,Path|Line],
-            (prolog_help:apropos(Query, M:F/N, _, P), P >= 0.3,
-             format(string(S), '~W', [M:F/N, [quoted(true), 
character_escapes(true)]]),
-             pi_head(F/N, Head),
+            (prolog_help:apropos(Query, M:PI, _, P), P >= 0.3,
+             format(string(S), '~W', [M:PI, [quoted(true), 
character_escapes(true)]]),
+             catch(pi_head(PI, Head), _, fail),
              sweep_predicate_location_(M, Head, Path, Line)),
             Matches, Tail),
     findall([S,Path],
-            (prolog_help:apropos(Query, F/N, _, P), P >= 0.3,
-             format(string(S), '~W', [F/N, [quoted(true), 
character_escapes(true)]]),
-             pi_head(F/N, Head),
+            (prolog_help:apropos(Query, PI, _, P), P >= 0.3,
+             format(string(S), '~W', [PI, [quoted(true), 
character_escapes(true)]]),
+             catch(pi_head(PI, Head), _, fail),
              sweep_predicate_location_(Head, Path, Line)),
             Tail).
 
@@ -481,16 +482,19 @@ sweep_predicate_non_hidden([String|_]) :-
     \+ sub_string(String, _, _, _, ":'$").
 
 sweep_predicate_description(M:F/N, [S|T]) :-
-    sweep_predicate_description_(M, F, N, T),
+    sweep_module_functor_arity_pi_(M, F, N, MFA),
     format(string(S),
            '~W',
-           [M:F/N, [quoted(true), character_escapes(true)]]).
+           [MFA, [quoted(true), character_escapes(true)]]),
+    sweep_predicate_description_(MFA, T).
 
-sweep_predicate_description_(M, F, N, [D]) :-
-    doc_comment(M:F/N, _, D0, _), !, atom_string(D0, D).
-sweep_predicate_description_(_M, F, N, [D]) :-
-    man_object_property(F/N, summary(D0)), !, atom_string(D0, D).
-sweep_predicate_description_(_, _, _, []).
+sweep_predicate_description_(MFA, [D]) :-
+    doc_comment(MFA, _, D0, _), !, atom_string(D0, D).
+sweep_predicate_description_(MFA, [D]) :-
+    man_object_property(MFA, summary(D0)), !, atom_string(D0, D).
+sweep_predicate_description_(_:FA, [D]) :-
+    man_object_property(FA, summary(D0)), !, atom_string(D0, D).
+sweep_predicate_description_(_, []).
 
 sweep_packs_collection(SearchString, Packs) :-
     prolog_pack:query_pack_server(search(SearchString), true(Packs0), []),
@@ -627,10 +631,9 @@ sweep_expand_file_name_(Dir, Spec, Exp) :-
                                    solutions(all),
                                    extensions(['', '.pl'])]).
 
-sweep_path_module([], "user")    :- !.
 sweep_path_module(Path0, Module) :-
     atom_string(Path, Path0),
-    xref_module(Path, Module0),
+    sweep_module_path_(Module0, Path),
     atom_string(Module0, Module).
 
 
@@ -815,32 +818,35 @@ strip_det(Mode is _, Mode) :- !.
 strip_det(//(Mode), Mode) :- !.
 strip_det(Mode, Mode).
 
-sweep_functor_arity_pi([M,F0,A|_], PI) :-
-    !, atom_string(F, F0), term_string(M:F/A, PI).
-sweep_functor_arity_pi([F0,A|Path0], PI) :-
+sweep_module_functor_arity_pi([M0,F0,A], PI) :-
+    atom_string(M, M0),
     atom_string(F, F0),
-    pi_head(F/A, Head),
-    sweep_current_module(M0),
-    (   @(predicate_property(M:Head, visible), M0),
-        \+ @(predicate_property(M:Head, imported_from(_)), M0)
-    ->  T = M:F/A
-    ;   xref_defined(_, Head, imported(Other)), xref_module(Other, M)
-    ->  T = M:F/A
-    ;   string(Path0),
-        atom_string(Path, Path0),
-        xref_defined(Path, Head, _)
-    ->  T = M0:F/A
-    ;   T = F/A
-    ),
-    term_string(T, PI).
+    sweep_module_functor_arity_pi_(M, F, A, PI0),
+    term_string(PI0, PI).
+
+sweep_module_functor_arity_pi_(M, F, A, M:F//B) :-
+    sweep_grammar_rule(M, F, A),
+    !,
+    B is A - 2.
+sweep_module_functor_arity_pi_(M, F, A, M:F/A).
+
+sweep_grammar_rule(M, F, A) :-
+    xref_module(Source, M),
+    pi_head(F/A, H),
+    xref_defined(Source, H, dcg).
+sweep_grammar_rule(M, F, A) :-
+    pi_head(M:F/A, H),
+    predicate_property(H, non_terminal).
 
 sweep_current_module(Module) :-
     sweep_main_thread,
     user:sweep_funcall("buffer-file-name", String),
-    string(String),
-    atom_string(Path, String),
-    sweep_module_path_(Module, Path).
-sweep_current_module(user).
+    (   string(String)
+    ->  atom_string(Path, String),
+        sweep_module_path_(Module, Path)
+    ;   Module = user
+    ).
+
 
 sweep_beginning_of_last_predicate(Start, Next) :-
     sweep_source_id(Path),
diff --git a/sweeprolog-tests.el b/sweeprolog-tests.el
index d8ad5e2f17..ee6ec40903 100644
--- a/sweeprolog-tests.el
+++ b/sweeprolog-tests.el
@@ -343,9 +343,9 @@ baz.
     (find-file-literally temp)
     (sweeprolog-mode)
     (should (equal (sweeprolog-predicate-references 
"test_sweep_find_references:callee/0")
-                   (list (list "caller/0" temp 63 6)
-                         (list "caller/0" temp 76 6)
-                         (list "caller/0" temp 99 6))))))
+                   (list (list "test_sweep_find_references:caller/0" temp 63 6)
+                         (list "test_sweep_find_references:caller/0" temp 76 6)
+                         (list "test_sweep_find_references:caller/0" temp 99 
6))))))
 
 (ert-deftest forward-many-holes ()
   "Tests jumping over holes with `sweeprolog-forward-hole'."
@@ -698,10 +698,24 @@ foo(Bar).
     (goto-char (point-max))
     (backward-word)
     (should (equal (sweeprolog-identifier-at-point)
-                   "bar/1"))))
+                   "user:bar/1"))))
+
+(ert-deftest dcg-identifier-at-point ()
+  "Test recognizing DCG grammar rule definitions."
+  (let ((temp (make-temp-file "sweeprolog-test"
+                              nil
+                              "pl"
+                              ":- module(foobarbaz, []).
+foo(Bar) --> bar(Bar).")))
+    (find-file-literally temp)
+    (sweeprolog-mode)
+    (goto-char (point-max))
+    (beginning-of-line)
+    (should (equal (sweeprolog-identifier-at-point)
+                   "foobarbaz:foo//1"))))
 
 (ert-deftest definition-at-point ()
-  "Test recognizing predicate defintions."
+  "Test recognizing predicate definitions."
   (let ((temp (make-temp-file "sweeprolog-test"
                               nil
                               "pl"
diff --git a/sweeprolog.el b/sweeprolog.el
index e7b0a4f588..f620f734ab 100644
--- a/sweeprolog.el
+++ b/sweeprolog.el
@@ -917,7 +917,17 @@ PROJECT (only on Emacs 28 or later)."
     (`(compound "/"
                 (atom . ,functor)
                 ,arity)
-     (cons functor arity))))
+     (cons functor arity))
+    (`(compound ":"
+                (atom . ,_)
+                (compound "//"
+                          (atom . ,functor)
+                          ,arity))
+     (cons functor (+ arity 2)))
+    (`(compound "//"
+                (atom . ,functor)
+                ,arity)
+     (cons functor (+ arity 2)))))
 
 (defun sweeprolog--swipl-source-directory ()
   (when sweeprolog-swipl-sources
@@ -1031,38 +1041,94 @@ default."
             (cons start (point))))))))
 
 ;;;###autoload
-(defun sweeprolog-find-predicate (mfn)
-  "Jump to the definition of the Prolog predicate MFN.
-MFN must be a string of the form \"M:F/N\" where M is a Prolog
-module name, F is a functor name and N is its arity."
+(defun sweeprolog-find-predicate (mfa)
+  "Jump to the definition of the Prolog predicate MFA.
+MFA should be a string of the form \"M:F/A\" or \"M:F//A\", where
+M is a Prolog module name, F is a functor and A is its arity."
   (interactive (list (sweeprolog-read-predicate)))
-  (if-let ((loc (sweeprolog-predicate-location mfn)))
+  (if-let ((loc (sweeprolog-predicate-location mfa)))
       (let ((path (car loc))
             (line (or (cdr loc) 1)))
         (find-file path)
         (goto-char (point-min))
         (forward-line (1- line)))
-    (user-error "Unable to locate predicate %s" mfn)))
+    (user-error "Unable to locate predicate %s" mfa)))
+
+(defun sweeprolog--fragment-to-mfa (fragment buffer-module)
+  (pcase fragment
+    ((or `("head_term" ,kind ,functor ,arity)
+         `("head"      ,kind ,functor ,arity))
+     (pcase kind
+       ((or "unreferenced"
+            "meta"
+            "exported"
+            "hook"
+            "public"
+            "dynamic"
+            "multifile"
+            "local")
+        (list buffer-module functor arity))
+       ((or "def_iso"
+            "def_swi"
+            "iso"
+            "built_in")
+        (list "system" functor arity))
+       (`("imported" . ,file)
+        (list (sweeprolog-path-module file) functor arity))
+       (`("extern" ,module . ,_)
+        (list module functor arity))))
+    ((or `("goal_term" ,kind ,functor ,arity)
+         `("goal"      ,kind ,functor ,arity))
+     (pcase kind
+       ((or "meta"
+            "hook"
+            "dynamic"
+            "multifile"
+            "local"
+            "undefined"
+            "thread_local"
+            "expanded"
+            "recursion")
+        (list buffer-module functor arity))
+       ((or "def_iso"
+            "def_swi"
+            "iso"
+            "built_in"
+            "foreign")
+        (list "system" functor arity))
+       (`(,(or "imported" "autoload") . ,file)
+        (list (sweeprolog-path-module file) functor arity))
+       (`("extern" ,module . ,_)
+        (list module functor arity))
+       ((or "global"
+            `("global" . ,_))
+        (list "user" functor arity))))))
+
+(defun sweeprolog--mfa-to-pi (module functor arity)
+  (unless (eq functor 'variable)
+    (sweeprolog--query-once "sweep" "sweep_module_functor_arity_pi"
+                            (list module functor arity))))
+
+(defun sweeprolog-path-module (file)
+  (sweeprolog--query-once "sweep" "sweep_path_module" file))
+
+(defun sweeprolog-buffer-module (&optional buffer)
+  (sweeprolog-path-module (buffer-file-name buffer)))
 
 (defun sweeprolog-identifier-at-point (&optional point)
   (when (derived-mode-p 'sweeprolog-mode 'sweeprolog-top-level-mode)
     (setq point (or point (point)))
     (save-excursion
       (goto-char point)
-      (let ((id-at-point nil))
+      (let ((id-at-point nil)
+            (buffer-module (sweeprolog-buffer-module)))
         (sweeprolog-analyze-term-at-point
          (lambda (beg end arg)
            (when (<= beg point end)
-             (pcase arg
-               ((or `("head_term" ,_ ,f ,a)
-                    `("goal_term" ,_ ,f ,a)
-                    `("head" ,_ ,f ,a)
-                    `("goal" ,_ ,f ,a))
-                (setq id-at-point (list f a)))))))
-        (when (and id-at-point
-                   (not (eq (car id-at-point) 'variable)))
-          (sweeprolog--query-once "sweep" "sweep_functor_arity_pi"
-                                  (append id-at-point (buffer-file-name))))))))
+             (when-let ((mfa (sweeprolog--fragment-to-mfa arg buffer-module)))
+               (setq id-at-point mfa)))))
+        (when id-at-point
+          (apply #'sweeprolog--mfa-to-pi id-at-point))))))
 
 
 ;;;; Modules
@@ -5615,18 +5681,14 @@ GOAL."
 
 (defun sweeprolog-context-menu-for-predicate (menu tok _beg _end _point)
   "Extend MENU with predicate-related commands if TOK describes one."
-  (pcase tok
-    ((or `("head" ,_ ,f ,a)
-         `("goal" ,_ ,f ,a))
-     (let ((pred (sweeprolog--query-once "sweep" "sweep_functor_arity_pi"
-                                         (append (list f a)
-                                                 (buffer-file-name)))))
-       (setq sweeprolog-context-menu-predicate-at-click pred)
-       (define-key menu [sweeprolog-describe-predicate]
-                   `(menu-item "Describe This Predicate"
-                               sweeprolog-context-menu-describe-predicate
-                               :help ,(format "Describe predicate %s" pred)
-                               :keys "\\[sweeprolog-describe-predicate]"))))))
+  (when-let ((mfa (sweeprolog--fragment-to-mfa tok (sweeprolog-buffer-module)))
+             (pred (apply #'sweeprolog--mfa-to-pi mfa)))
+    (setq sweeprolog-context-menu-predicate-at-click pred)
+    (define-key menu [sweeprolog-describe-predicate]
+                `(menu-item "Describe This Predicate"
+                            sweeprolog-context-menu-describe-predicate
+                            :help ,(format "Describe predicate %s" pred)
+                            :keys "\\[sweeprolog-describe-predicate]"))))
 
 (defun sweeprolog-context-menu-for-module (menu tok _beg _end _point)
   "Extend MENU with module-related commands if TOK describes one."